diff options
Diffstat (limited to 'lib/asn1')
84 files changed, 51744 insertions, 0 deletions
diff --git a/lib/asn1/AUTHORS b/lib/asn1/AUTHORS new file mode 100644 index 0000000000..0e9acee655 --- /dev/null +++ b/lib/asn1/AUTHORS @@ -0,0 +1,12 @@ + +Original Authors: +This asn.1 application was created by +Kenneth Lundin ([email protected]) +with help from Esko Vierum�ki. +The work was initially inspired by a previous ASN.1 compiler for Erlang +written by Claes Wikstr�m. +Version 1.1.1 - 1.2.6 +additional functionality and bugfixes by: +Kenneth Lundin ([email protected]) + +Contributors: diff --git a/lib/asn1/Makefile b/lib/asn1/Makefile new file mode 100644 index 0000000000..9c1b19605c --- /dev/null +++ b/lib/asn1/Makefile @@ -0,0 +1,99 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# +# Macros +# + +SUB_DIRECTORIES = src doc/src c_src + +include vsn.mk +VSN = $(ASN1_VSN) + +DIR_NAME = asn1-$(VSN) + +ifndef APP_RELEASE_DIR + APP_RELEASE_DIR = /tmp +endif + +ifndef APP_TAR_FILE + APP_TAR_FILE = $(APP_RELEASE_DIR)/$(DIR_NAME).tgz +endif + +APP_DIR = $(APP_RELEASE_DIR)/$(DIR_NAME) + + +SPECIAL_TARGETS = + +# +# Default Subdir Targets +# +include $(ERL_TOP)/make/otp_subdir.mk + + +.PHONY: info version + +info: + @echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)" + @echo "APP_DIR: $(APP_DIR)" + @echo "APP_TAR_FILE: $(APP_TAR_FILE)" + +version: + @echo "$(VSN)" + + +# ---------------------------------------------------- +# Application (source) release targets +# ---------------------------------------------------- +app_release: app_doc tar + +app_doc: + cd doc/src; $(MAKE) html man + +app_dir: $(APP_DIR) + +$(APP_DIR): + cat TAR.exclude > TAR.exclude2; \ + echo "asn1/TAR.exclude2" >> TAR.exclude2; \ + echo "asn1/priv/lib/$(TARGET)" >> TAR.exclude2; \ + echo "asn1/c_src/$(TARGET)" >> TAR.exclude2 + (cd ..; find asn1 -name 'findmerge.*' >> asn1/TAR.exclude2) + (cd ..; find asn1 -name '*.contrib*' >> asn1/TAR.exclude2) + (cd ..; find asn1 -name '*.keep*' >> asn1/TAR.exclude2) + (cd ..; find asn1 -name '*~' >> asn1/TAR.exclude2) + (cd ..; find asn1 -name 'erl_crash.dump' >> asn1/TAR.exclude2) + (cd ..; find asn1 -name '*.log' >> asn1/TAR.exclude2) + (cd ..; find asn1 -name 'core' >> asn1/TAR.exclude2) + (cd ..; find asn1 -name '.cmake.state' >> asn1/TAR.exclude2) + mkdir $(APP_DIR); \ + (cd ..; tar cfX - asn1/TAR.exclude2 asn1) | \ + (cd $(APP_DIR); tar xf -); \ + mv $(APP_DIR)/asn1/* $(APP_DIR)/; \ + rmdir $(APP_DIR)/asn1 + mkdir $(APP_DIR)/doc; \ + (cd doc; tar cf - man3 html) | (cd $(APP_DIR)/doc; tar xf -) + +tar: $(APP_TAR_FILE) + +$(APP_TAR_FILE): $(APP_DIR) + (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) + diff --git a/lib/asn1/c_src/Makefile b/lib/asn1/c_src/Makefile new file mode 100644 index 0000000000..53da8fd035 --- /dev/null +++ b/lib/asn1/c_src/Makefile @@ -0,0 +1,20 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/run_make.mk diff --git a/lib/asn1/c_src/Makefile.in b/lib/asn1/c_src/Makefile.in new file mode 100644 index 0000000000..b4a0cddba1 --- /dev/null +++ b/lib/asn1/c_src/Makefile.in @@ -0,0 +1,139 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +ERLANG_OSTYPE = @ERLANG_OSTYPE@ + +CC = @CC@ + +LD = @DED_LD@ +LIBS = @LIBS@ + +LIBDIR = $(ERL_TOP)/lib/asn1/priv/lib/$(TARGET) +OBJDIR = $(ERL_TOP)/lib/asn1/priv/obj/$(TARGET) + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(ASN1_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/asn1-$(VSN) + + +# ---------------------------------------------------- +# FLAGS misc +# ---------------------------------------------------- +ifeq ($(TYPE),debug) +TYPEMARKER = .debug +else +TYPEMARKER = +endif + +EI_LIBDIR = $(ERL_TOP)/lib/erl_interface/obj$(TYPEMARKER)/$(TARGET) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +EI_INCLUDES = -I$(ERL_TOP)/lib/erl_interface/include +DRIVER_INCLUDES = -I$(ERL_TOP)/erts/emulator/beam \ + -I$(ERL_TOP)/erts/emulator/sys/$(ERLANG_OSTYPE) +CFLAGS = $(DRIVER_INCLUDES) $(EI_INCLUDES) @DED_CFLAGS@ +LDFLAGS += @DED_LDFLAGS@ + +LD_INCL_EI = -L$(EI_LIBDIR) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +C_FILES = asn1_erl_driver.c + + +ifeq ($(TARGET),win32) +LD_EI = -lei_md +SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_drv.dll +OBJ_FILES = $(OBJDIR)/asn1_erl_drv.o +CLIB_FLAGS = +LN=cp +else +LD_EI = -lei +OBJ_FILES = $(OBJDIR)/asn1_erl_drv.o +ifeq ($(findstring vxworks,$(TARGET)),vxworks) +SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_drv.eld +CLIB_FLAGS = +else +SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_drv.so +CLIB_FLAGS = -lc +endif +LN= ln -s +endif + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +opt: $(OBJDIR) $(LIBDIR) $(SHARED_OBJ_FILES) + +debug: opt + +clean: + rm -f core *~ + rm -f $(LIBDIR)/* + rm -f $(OBJDIR)/* + +docs: + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + + +$(OBJ_FILES): $(C_FILES) $(OBJDIR) + $(CC) -c $(CFLAGS) -o $(OBJ_FILES) $(C_FILES) + +$(SHARED_OBJ_FILES): $(OBJ_FILES) $(LIBDIR) + $(LD) $(LDFLAGS) $(LD_INCL_EI) -o $(SHARED_OBJ_FILES) $(OBJ_FILES) $(LD_EI) $(CLIB_FLAGS) $(LIBS) + +$(LIBDIR): + -mkdir -p $(LIBDIR) + +$(OBJDIR): + -mkdir -p $(OBJDIR) + + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/priv/lib + $(INSTALL_DATA) $(SHARED_OBJ_FILES) $(RELSYSDIR)/priv/lib + $(INSTALL_DIR) $(RELSYSDIR)/c_src + $(INSTALL_DATA) $(C_FILES) $(RELSYSDIR)/c_src + +release_docs_spec: + diff --git a/lib/asn1/c_src/asn1_erl_driver.c b/lib/asn1/c_src/asn1_erl_driver.c new file mode 100644 index 0000000000..cd2e63a363 --- /dev/null +++ b/lib/asn1/c_src/asn1_erl_driver.c @@ -0,0 +1,1667 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <stdlib.h> +#include <stdio.h> +#include <string.h> +#include "erl_driver.h" +#include "ei.h" + + +/* #define ASN1_DEBUG 1 */ + +#define ASN1_OK 0 +#define ASN1_ERROR -1 +#define ASN1_COMPL_ERROR 1 +#define ASN1_MEMORY_ERROR 0 +#define ASN1_DECODE_ERROR 2 +#define ASN1_TAG_ERROR -3 +#define ASN1_LEN_ERROR -4 +#define ASN1_INDEF_LEN_ERROR -5 +#define ASN1_VALUE_ERROR -6 + + +#define ASN1_CLASS 0xc0 +#define ASN1_FORM 0x20 +#define ASN1_CLASSFORM (ASN1_CLASS | ASN1_FORM) +#define ASN1_TAG 0x1f +#define ASN1_LONG_TAG 0x7f + +#define ASN1_INDEFINITE_LENGTH 0x80 +#define ASN1_SHORT_DEFINITE_LENGTH 0 + +#define ASN1_PRIMITIVE 0 +#define ASN1_CONSTRUCTED 0x20 + +#define ASN1_COMPLETE 1 +#define ASN1_BER_TLV_DECODE 2 +#define ASN1_BER_TLV_PARTIAL_DECODE 3 + +#define ASN1_NOVALUE 0 + +#define ASN1_SKIPPED 0 +#define ASN1_OPTIONAL 1 +#define ASN1_CHOOSEN 2 + + +#define CEIL(X,Y) ((X-1) / Y + 1) + +#define INVMASK(X,M) (X & (M ^ 0xff)) +#define MASK(X,M) (X & M) + +typedef struct { + ErlDrvPort port; + int buffer_size; +} asn1_data; + +/* int min_alloc_bytes; */ + + +static ErlDrvData asn1_drv_start(ErlDrvPort, char *); + +static void asn1_drv_stop(ErlDrvData); + +int asn1_drv_control(ErlDrvData, unsigned int, char *, int, char **, int); + +int complete(ErlDrvBinary **,unsigned char *,unsigned char *, int); + +int insert_octets(int, unsigned char **, unsigned char **, int *); + +int insert_octets_except_unused(int, unsigned char **, unsigned char **, + int *, int); + +int insert_octets_as_bits_exact_len(int, int, unsigned char **, + unsigned char **, int *); + +int insert_octets_as_bits(int, unsigned char **, unsigned char **,int *); + +int pad_bits(int, unsigned char **, int *); + +int insert_least_sign_bits(int, unsigned char, unsigned char **, int *); + +int insert_most_sign_bits(int, unsigned char, unsigned char **, int *); + +int insert_bits_as_bits(int, int, unsigned char **, unsigned char **, int *); + +int insert_octets_unaligned(int, unsigned char **, unsigned char **, int); + +int realloc_memory(ErlDrvBinary **,int,unsigned char **,unsigned char **); + +int decode_begin(ErlDrvBinary **,unsigned char *, int, unsigned int *); + +int decode(ErlDrvBinary **,int *,unsigned char *,int *, int); + +int decode_tag(char *,int *,unsigned char *,int,int *); + +int decode_value(int *,unsigned char *,int *,ErlDrvBinary **,int ,int); + + +/* declaration of functions used for partial decode of a BER encoded + message */ + +int decode_partial(ErlDrvBinary **,unsigned char *, int); + +int skip_tag(unsigned char *,int *,int); + +int skip_length_and_value(unsigned char *,int *,int); + +int get_tag(unsigned char *,int *,int); + +int get_value(char *,unsigned char *,int *,int); + +static ErlDrvEntry asn1_drv_entry = { + NULL, /* init, always NULL for dynamic drivers */ + asn1_drv_start, /* start, called when port is opened */ + asn1_drv_stop, /* stop, called when port is closed */ + NULL, /* output, called when erlang has sent */ + NULL, /* ready_input, called when input descriptor ready */ + NULL, /* ready_output, called when output descriptor ready */ + "asn1_erl_drv", /* char *driver_name, the argument to open_port */ + NULL, /* finish, called when unloaded */ + NULL, /* void * that is not used (BC) */ + asn1_drv_control, /* control, port_control callback */ + NULL, /* timeout, called on timeouts */ + NULL, /* outputv, vector output interface */ + + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL, /* handle2 */ + NULL /* process_exit */ +}; + + + +DRIVER_INIT(asn1_erl_drv) /* must match name in driver_entry */ +{ + return &asn1_drv_entry; +} + +static ErlDrvData asn1_drv_start(ErlDrvPort port, char *buff) +{ + /* extern int min_alloc_bytes; */ + char *ptr; + asn1_data* d; + + d = (asn1_data*)driver_alloc(sizeof(asn1_data)); + set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); + d->port = port; + + if ((ptr = getenv("ASN1_MIN_BUF_SIZE")) == NULL) + d->buffer_size = 1024; + else + d->buffer_size = atoi(ptr); + return (ErlDrvData)d; +} + + +static void asn1_drv_stop(ErlDrvData handle) +{ + driver_free((char*)handle); +} + + + +int asn1_drv_control(ErlDrvData handle, + unsigned int command, + char *buf, + int buf_len, + char **res_buf, + int res_buf_len) +{ + char *complete_buf; + int complete_len, decode_len; + ErlDrvBinary *drv_binary; + ErlDrvBinary **drv_bin_ptr; + asn1_data* a_data; + int min_alloc_bytes; + unsigned int err_pos = 0; /* in case of error, return last correct position */ + int ret_err; /* return value in case of error in TLV decode, i.e. length of list in res_buf */ + + /* In case previous call to asn1_drv_control resulted in a change of + return value from binary to integer list */ + a_data = (asn1_data *)handle; + min_alloc_bytes = a_data->buffer_size; + set_port_control_flags(a_data->port, PORT_CONTROL_FLAG_BINARY); + + if (command == ASN1_COMPLETE) + { /* Do the PER complete encode step */ + if ((drv_binary = driver_alloc_binary(buf_len))==NULL) { + /* error handling */ + set_port_control_flags(a_data->port, 0); + return ASN1_MEMORY_ERROR; + } + complete_buf = drv_binary->orig_bytes; + if ((complete_len = complete(&drv_binary,complete_buf,buf,buf_len)) == ASN1_ERROR) + { + /* error handling due to failure in complete */ + /* printf("error when running complete\n\r"); */ + driver_free_binary(drv_binary); + set_port_control_flags(a_data->port, 0); + **res_buf = '1'; + return ASN1_COMPL_ERROR; + } + /* printf("complete_len=%dbuf_len=%d,orig_size=%d\n\r",complete_len,buf_len,drv_binary->orig_size); */ + /* now the message is complete packed, return to Erlang */ + /* if (complete_len < buf_len) {*/ + if (complete_len < drv_binary->orig_size) { + ErlDrvBinary *tmp; + if ((tmp=driver_realloc_binary(drv_binary,complete_len)) == NULL){ + /*error handling due to memory allocation failure */ + driver_free_binary(drv_binary); + set_port_control_flags(a_data->port, 0); + return ASN1_MEMORY_ERROR; + }else + drv_binary=tmp; + } + *res_buf = (char *)drv_binary; + return complete_len; + } else if (command == ASN1_BER_TLV_DECODE) { /* control == 2 */ + /* Do the tlv decode, + return the resulting term encoded on the Erlang + external format */ +/* printf("driver: buffer_len = %d, min_alloc_bytes = %d\r\n",buf_len,min_alloc_bytes); */ + if ((drv_binary = driver_alloc_binary((buf_len*5)+min_alloc_bytes))==NULL) { + /* error handling */ + set_port_control_flags(a_data->port, 0); + return ASN1_MEMORY_ERROR; + } + drv_bin_ptr = &drv_binary; + if ((decode_len = decode_begin(drv_bin_ptr,buf,buf_len,&err_pos)) <= ASN1_ERROR) + { + /* error handling due to failure in decode */ + char tmp_res_buf[5]; + driver_free_binary(*drv_bin_ptr); + set_port_control_flags(a_data->port, 0); + + if(decode_len==ASN1_ERROR) + tmp_res_buf[0]='1'; + else if(decode_len==ASN1_TAG_ERROR) + tmp_res_buf[0]='2'; + else if(decode_len==ASN1_LEN_ERROR) + tmp_res_buf[0]='3'; + else if(decode_len==ASN1_INDEF_LEN_ERROR) + tmp_res_buf[0]='4'; + else if(decode_len==ASN1_VALUE_ERROR) + tmp_res_buf[0]='5'; +/* printf("err_pos=%d\r\n",err_pos); */ +/* printf("decode_len:%d\r\n",decode_len); */ + ret_err = 1; + while(err_pos>0){ + tmp_res_buf[ret_err] =(char)err_pos;/* c;*/ + err_pos = err_pos >> 8; + ret_err++; + } + strncpy(*res_buf,tmp_res_buf,ret_err); + return ret_err; + } +/* printf("decode_len=%d\r\n",decode_len); */ + if (decode_len < ((buf_len * 5) + min_alloc_bytes)) { + /* not all memory was used => we have to reallocate */ + ErlDrvBinary *tmp; + if ((tmp=driver_realloc_binary(*drv_bin_ptr,decode_len)) == NULL){ + /*error handling due to memory allocation failure */ + driver_free_binary(*drv_bin_ptr); + set_port_control_flags(a_data->port, 0); + return ASN1_MEMORY_ERROR; + }else + *drv_bin_ptr=tmp; + } + *res_buf = (char *)(*drv_bin_ptr); + return decode_len; + } else { /*command == ASN1_BER_TLV_PARTIAL_DECODE */ + if ((drv_binary = driver_alloc_binary(buf_len))==NULL) { + /* error handling */ + set_port_control_flags(a_data->port, 0); + return ASN1_MEMORY_ERROR; + } + drv_bin_ptr = &drv_binary; + if ((decode_len = decode_partial(drv_bin_ptr,buf,buf_len)) + <= ASN1_ERROR) { + /* error handling due to failure in decode */ + driver_free_binary(*drv_bin_ptr); + set_port_control_flags(a_data->port, 0); + +/* printf("asn1_drv_control 1: decode_len=%d\r\n",decode_len); */ + + if(decode_len==ASN1_ERROR) + **res_buf = '1'; + return ASN1_DECODE_ERROR; + } + if (decode_len < buf_len) { + /* not all memory was used => we have to reallocate */ + ErlDrvBinary *tmp; +/* printf("asn1_drv_control 2: decode_len=%d\r\n",decode_len); */ + if ((tmp=driver_realloc_binary(*drv_bin_ptr,decode_len)) == NULL){ + /*error handling due to memory allocation failure */ + driver_free_binary(*drv_bin_ptr); + set_port_control_flags(a_data->port, 0); + return ASN1_MEMORY_ERROR; + }else + *drv_bin_ptr=tmp; + } + *res_buf = (char *)(*drv_bin_ptr); + return decode_len; + } +} + + + +/* + * + * This section defines functionality for the complete encode of a + * PER encoded message + * + */ + +int complete(ErlDrvBinary **drv_binary,unsigned char *complete_buf, + unsigned char *in_buf, int in_buf_len) +{ + int counter = in_buf_len; + /* counter keeps track of number of bytes left in the + input buffer */ + + int buf_space = in_buf_len; + /* This is the amount of allocated space left of the complete_buf. It + is possible when padding is applied that more space is needed than + was originally allocated. */ + + int buf_size = in_buf_len; + /* Size of the buffer. May become reallocated and thus other than + in_buf_len */ + + unsigned char *in_ptr, *ptr; + /* in_ptr points at the next byte in in_buf to be moved to + complete_buf. + ptr points into the new completed buffer, complete_buf, at the + position of the next byte that will be set */ + int unused = 8; + /* unused = [1,...,8] indicates how many of the rigthmost bits of + the byte that ptr points at that are unassigned */ + + int no_bits,no_bytes,in_unused,desired_len,ret, saved_mem, needed, pad_bits; + + unsigned char val; + + in_ptr = in_buf; + ptr = complete_buf; + *ptr = 0x00; + while(counter > 0) { + counter--; +/* printf("*in_ptr = %d\n\r",*in_ptr); */ + switch (*in_ptr) { + case 0: + /* just one zero-bit should be added to the buffer */ + if(unused == 1){ + unused = 8; + *++ptr = 0x00; + buf_space--; + } else + unused--; + break; + + case 1: + /* one one-bit should be added to the buffer */ + if(unused == 1){ + *ptr = *ptr | 1; + unused = 8; + *++ptr = 0x00; + buf_space--; + } else { + *ptr = *ptr | (1 << (unused - 1)); + unused--; + } + break; + + case 2: + /* align buffer to end of byte */ + if (unused != 8) { + *++ptr = 0x00; + buf_space--; + unused = 8; + } + break; + + case 10: + /* next byte in in_buf tells how many bits in the second next + byte that will be used */ + /* The leftmost unused bits in the value byte are supposed to be + zero bits */ + no_bits = (int)*(++in_ptr); + val = *(++in_ptr); + counter -= 2; + if ((ret=insert_least_sign_bits(no_bits,val,&ptr,&unused)) == ASN1_ERROR) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 20: + /* in this case the next value in_ptr points at holds the number + of following bytes that holds the value that will be inserted + in the completed buffer */ + no_bytes = (int)*(++in_ptr); + counter -= (no_bytes + 1); + if ((counter<0) || + (ret=insert_octets(no_bytes,&in_ptr,&ptr,&unused)) == ASN1_ERROR) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 21: + /* in this case the next two bytes in_ptr points at holds the number + of following bytes that holds the value that will be inserted + in the completed buffer */ + no_bytes = (int)*(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int)*(++in_ptr); + counter -= (2 + no_bytes); + if ((counter<0) || + (ret=insert_octets(no_bytes,&in_ptr,&ptr,&unused)) == ASN1_ERROR) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 30: + /* If we call the following bytes, in the buffer in_ptr points at, + By1,By2,Rest then Rest is the value that will be transfered to + the completed buffer. By1 tells how many of the rightmost bits in + Rest that should not be used. By2 is the length of Rest in bytes.*/ + in_unused = (int)*(++in_ptr); + no_bytes = (int)*(++in_ptr); + counter -= (2 + no_bytes); +/* printf("%d: case 30: in_unused=%d, no_bytes=%d,counter=%d\n\r",__LINE__,in_unused,no_bytes,counter); */ + ret = -4711; + if ((counter<0) || + (ret=insert_octets_except_unused(no_bytes,&in_ptr,&ptr,&unused,in_unused)) == ASN1_ERROR) + return ASN1_ERROR; +/* printf("%d: ret=%d\n\r",__LINE__, ret); */ + buf_space -= ret; + break; + + case 31: + /* If we call the following bytes, in the buffer in_ptr points at, + By1,By2,By3,Rest then Rest is the value that will be transfered to + the completed buffer. By1 tells how many of the rightmost bits in + Rest that should not be used. By2 and By3 is the length of + Rest in bytes.*/ + in_unused = (int)*(++in_ptr); + no_bytes = (int)*(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int)*(++in_ptr); + counter -= (3 + no_bytes); + if ((counter<0) || + (ret=insert_octets_except_unused(no_bytes,&in_ptr,&ptr,&unused,in_unused)) == ASN1_ERROR) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 40: + /* This case implies that next byte,By1,(..,By1,By2,Bin,...) + is the desired length of the completed value, maybe needs + padding zero bits or removal of trailing zero bits from Bin. + By2 is the length of Bin and Bin is the value that will be + put into the completed buffer. Each byte in Bin has the value + 1 or 0.*/ + desired_len = (int)*(++in_ptr); + no_bytes=(int)*(++in_ptr); + + /* This is the algorithm for need of memory reallocation: + Only when padding (cases 40 - 43,45 - 47) more memory may be + used than allocated. Therefore one has to keep track of how + much of the allocated memory that has been saved, i.e. the + difference between the number of parsed bytes of the input buffer + and the number of used bytes of the output buffer. + If saved memory is less than needed for the padding then we + need more memory. */ + saved_mem = buf_space - counter; + pad_bits = desired_len - no_bytes - unused; + needed = (pad_bits > 0) ? CEIL(pad_bits,8) : 0; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (realloc_memory(drv_binary,buf_size,&ptr, + &complete_buf) == ASN1_ERROR) + return ASN1_ERROR; + } + + counter -= (2 + no_bytes); + if ((counter<0) || + (ret=insert_octets_as_bits_exact_len(desired_len,no_bytes,&in_ptr, + &ptr,&unused)) == ASN1_ERROR) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 41: + /* Same as case 40 apart from By2, the length of Bin, which is in + two bytes*/ + desired_len = (int)*(++in_ptr); + no_bytes=(int)*(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int)*(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (realloc_memory(drv_binary,buf_size,&ptr, + &complete_buf) == ASN1_ERROR) + return ASN1_ERROR; + } + + counter -= (3 + no_bytes); + if ((counter<0) || + (ret=insert_octets_as_bits_exact_len(desired_len,no_bytes,&in_ptr, + &ptr,&unused)) == ASN1_ERROR) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 42: + /* Same as case 40 apart from By1, the desired length, which is in + two bytes*/ + desired_len = (int)*(++in_ptr); + desired_len = desired_len << 8; + desired_len = desired_len | (int)*(++in_ptr); + no_bytes=(int)*(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (realloc_memory(drv_binary,buf_size,&ptr, + &complete_buf) == ASN1_ERROR) + return ASN1_ERROR; + } + + counter -= (3 + no_bytes); + if ((counter<0) || + (ret=insert_octets_as_bits_exact_len(desired_len,no_bytes,&in_ptr, + &ptr,&unused)) == ASN1_ERROR) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 43: + /* Same as case 40 apart from By1 and By2, the desired length and + the length of Bin, which are in two bytes each. */ + desired_len = (int)*(++in_ptr); + desired_len = desired_len << 8; + desired_len = desired_len | (int)*(++in_ptr); + no_bytes=(int)*(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int)*(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (realloc_memory(drv_binary,buf_size,&ptr, + &complete_buf) == ASN1_ERROR) + return ASN1_ERROR; + } + + counter -= (4 + no_bytes); + if ((counter<0) || + (ret=insert_octets_as_bits_exact_len(desired_len,no_bytes,&in_ptr, + &ptr,&unused)) == ASN1_ERROR) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 45: + /* This case assumes that the following bytes in the incoming buffer + (called By1,By2,Bin) is By1, which is the number of bits (n) that + will be inserted in the completed buffer. By2 is the number of + bytes in Bin. Each bit in the buffer Bin should be inserted from + the leftmost until the nth.*/ + desired_len = (int)*(++in_ptr); + no_bytes=(int)*(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; +/* printf("buf_space=%d, counter=%d, needed=%d",buf_space,counter,needed); */ + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (realloc_memory(drv_binary,buf_size,&ptr, + &complete_buf) == ASN1_ERROR) + return ASN1_ERROR; + } + + counter -= (2 + no_bytes); +/* printf("calling insert_bits_as_bits: desired_len=%d, no_bytes=%d\n\r",desired_len,no_bytes); */ +/* printf("1in_ptr=%d\n\r",in_ptr); */ + + if((counter<0) || + (ret=insert_bits_as_bits(desired_len,no_bytes,&in_ptr, + &ptr,&unused)) == ASN1_ERROR) + return ASN1_ERROR; +/* printf("2in_ptr=%d, ptr=%d, complete_buf=%d\n\r",in_ptr,ptr,complete_buf); */ +/* printf("buf_space=%d, ret=%d, counter=%d\n\r",buf_space,ret,counter); */ + buf_space -= ret; + break; + + case 46: + /* Same as case 45 apart from By1, the desired length, which is + in two bytes. */ + desired_len = (int)*(++in_ptr); + desired_len = desired_len << 8; + desired_len = desired_len | (int)*(++in_ptr); + no_bytes=(int)*(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (realloc_memory(drv_binary,buf_size,&ptr, + &complete_buf) == ASN1_ERROR) + return ASN1_ERROR; + } + + counter -= (3 + no_bytes); + if((counter<0) || + (ret=insert_bits_as_bits(desired_len,no_bytes,&in_ptr, + &ptr,&unused)) == ASN1_ERROR) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 47: + /* Same as case 45 apart from By1 and By2, the desired length + and the length of Bin, which are in two bytes each. */ + desired_len = (int)*(++in_ptr); + desired_len = desired_len << 8; + desired_len = desired_len | (int)*(++in_ptr); + no_bytes=(int)*(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int)*(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (realloc_memory(drv_binary,buf_size,&ptr, + &complete_buf) == ASN1_ERROR) + return ASN1_ERROR; + } + + counter -= (4 + no_bytes); + if((counter<0) || + (ret=insert_bits_as_bits(desired_len,no_bytes,&in_ptr, + &ptr,&unused)) == ASN1_ERROR) + return ASN1_ERROR; + buf_space -= ret; + break; + + default: + return ASN1_ERROR; + } + in_ptr++; + } + /* The returned buffer must be at least one byte and + it must be octet aligned */ + if ((unused == 8) && (ptr != complete_buf)) + return (ptr - complete_buf); + else { + ptr++; /* octet align buffer */ + return (ptr - complete_buf); + } +} + + +int realloc_memory(ErlDrvBinary **drv_binary, + int amount, + unsigned char **ptr, + unsigned char **complete_buf) { + + ErlDrvBinary *tmp_bin; + int i; + +/* printf("realloc_momory: amount = %d\n",amount); */ + if ((tmp_bin=driver_realloc_binary(*drv_binary,amount)) == NULL) { + /*error handling due to memory allocation failure */ +/* printf("error when allocating memory\n"); */ + return ASN1_ERROR; + }else { + i = *ptr - *complete_buf; + *drv_binary=tmp_bin; + *complete_buf = (*drv_binary)->orig_bytes; + *ptr = *complete_buf + i; + } + return ASN1_OK; +} + + +int insert_most_sign_bits(int no_bits, + unsigned char val, + unsigned char **output_ptr, + int *unused) { + unsigned char *ptr = *output_ptr; + + if (no_bits < *unused){ + *ptr = *ptr | (val >> (8 - *unused)); + *unused -= no_bits; + } else if (no_bits == *unused) { + *ptr = *ptr | (val >> (8 - *unused)); + *unused = 8; + *++ptr = 0x00; + } else { + *ptr = *ptr | (val >> (8 - *unused)); + *++ptr = 0x00; + *ptr = *ptr | (val << *unused); + *unused = 8 - (no_bits - *unused); + } + *output_ptr = ptr; + return ASN1_OK; +} + + +int insert_least_sign_bits(int no_bits, + unsigned char val, + unsigned char **output_ptr, + int *unused) { + unsigned char *ptr = *output_ptr; + int ret = 0; + + if (no_bits < *unused){ + *ptr = *ptr | (val << (*unused - no_bits)); + *unused -= no_bits; + } else if (no_bits == *unused){ + *ptr = *ptr | val; + *unused = 8; + *++ptr = 0x00; + ret++; + } else { + /* first in the begun byte in the completed buffer insert + so many bits that fit, then insert the rest in next byte.*/ + *ptr = *ptr | (val >> (no_bits - *unused)); + *++ptr = 0x00; + ret++; + *ptr = *ptr | (val << (8 - (no_bits - *unused))); + *unused = 8 - (no_bits - *unused); + } + *output_ptr = ptr; + return ret; +} + +/* pad_bits adds no_bits bits in the buffer that output_ptr + points at. + */ +int pad_bits(int no_bits, unsigned char **output_ptr, int *unused) + { + unsigned char *ptr = *output_ptr; + int ret = 0; + + while (no_bits > 0) { + if(*unused == 1){ + *unused = 8; + *++ptr = 0x00; + ret++; + } else + (*unused)--; + no_bits--; + } + *output_ptr = ptr; + return ret; + } + + +/* insert_bits_as_bits removes no_bytes bytes from the buffer that in_ptr + points at and takes the desired_no leftmost bits from those removed + bytes and inserts them in the buffer(output buffer) that ptr points at. + The unused parameter tells how many bits that are not set in the + actual byte in the output buffer. If desired_no is more bits than the + input buffer has in no_bytes bytes, then zero bits is padded.*/ +int insert_bits_as_bits(int desired_no, + int no_bytes, + unsigned char **input_ptr, + unsigned char **output_ptr, + int *unused) +{ + unsigned char *in_ptr = *input_ptr; + unsigned char val; + int no_bits, ret, ret2; + + if (desired_no == (no_bytes * 8)) { + if(insert_octets_unaligned(no_bytes,&in_ptr,output_ptr,*unused) + == ASN1_ERROR) + return ASN1_ERROR; + ret = no_bytes; + } + else if (desired_no < (no_bytes * 8)) { +/* printf("insert_bits_as_bits 1\n\r"); */ + if(insert_octets_unaligned(desired_no/8,&in_ptr,output_ptr,*unused) + == ASN1_ERROR) + return ASN1_ERROR; +/* printf("insert_bits_as_bits 2\n\r"); */ + val = *++in_ptr; +/* printf("val = %d\n\r",(int)val); */ + no_bits = desired_no % 8; +/* printf("no_bits = %d\n\r",no_bits); */ + insert_most_sign_bits(no_bits,val,output_ptr,unused); + ret = CEIL(desired_no,8); + } + else { + if(insert_octets_unaligned(no_bytes,&in_ptr,output_ptr,*unused) + == ASN1_ERROR) + return ASN1_ERROR; + ret2 = pad_bits(desired_no - (no_bytes * 8),output_ptr,unused); +/* printf("ret2 = %d\n\r",ret2); */ + ret = CEIL(desired_no,8); +/* printf("ret = %d\n\r",ret); */ + } +/* printf("*unused = %d\n\r",*unused); */ + *input_ptr = in_ptr; + return ret; +} + + +/* insert_octets_as_bits_exact_len */ +int +insert_octets_as_bits_exact_len(int desired_len, + int in_buff_len, + unsigned char **in_ptr, + unsigned char **ptr, + int *unused) +{ + int ret = 0; + int ret2 = 0; + + if (desired_len == in_buff_len) { + if ((ret = insert_octets_as_bits(in_buff_len,in_ptr,ptr,unused)) == ASN1_ERROR) + return ASN1_ERROR; + } + else if(desired_len > in_buff_len) { + if((ret = insert_octets_as_bits(in_buff_len,in_ptr,ptr,unused)) == ASN1_ERROR) + return ASN1_ERROR; + /* now pad with zero bits */ +/* printf("~npad_bits: called with %d bits padding~n~n~r",desired_len - in_buff_len); */ + if ((ret2=pad_bits(desired_len - in_buff_len,ptr,unused)) == ASN1_ERROR) + return ASN1_ERROR; + } + else {/* desired_len < no_bits */ + if ((ret=insert_octets_as_bits(desired_len,in_ptr,ptr,unused)) == ASN1_ERROR) + return ASN1_ERROR; + /* now remove no_bits - desired_len bytes from in buffer */ + *in_ptr += (in_buff_len - desired_len); + } + return (ret+ret2); +} + + + +/* insert_octets_as_bits takes no_bytes bytes from the buffer that input_ptr + points at and inserts the least significant bit of it in the buffer that + output_ptr points at. Each byte in the input buffer must be 1 or 0 + otherwise the function returns ASN1_ERROR. The output buffer is concatenated + without alignment. + */ +int insert_octets_as_bits(int no_bytes, + unsigned char **input_ptr, + unsigned char **output_ptr, + int *unused) +{ + unsigned char *in_ptr = *input_ptr; + unsigned char *ptr = *output_ptr; + int used_bits = 8 - *unused; + + while (no_bytes > 0) { + switch (*++in_ptr) { + case 0: + if(*unused == 1){ + *unused = 8; + *++ptr = 0x00; + } else + (*unused)--; + break; + case 1: + if(*unused == 1){ + *ptr = *ptr | 1; + *unused = 8; + *++ptr = 0x00; + } else { + *ptr = *ptr | (1 << (*unused - 1)); + (*unused)--; + } + break; + default: + return ASN1_ERROR; + } + no_bytes--; + } + *input_ptr = in_ptr; + *output_ptr = ptr; + return ((used_bits+no_bytes) / 8); /*return number of new bytes + in completed buffer */ +} + +/* insert_octets inserts bytes from the input buffer, *input_ptr, + into the output buffer, *output_ptr. Before the first byte is + inserted the input buffer is aligned. + */ +int insert_octets(int no_bytes, + unsigned char **input_ptr, + unsigned char **output_ptr, + int *unused) +{ + unsigned char *in_ptr = *input_ptr; + unsigned char *ptr = *output_ptr; + int ret = 0; + + if (*unused != 8) {/* must align before octets are added */ + *++ptr = 0x00; + ret++; + *unused = 8; + } + while(no_bytes > 0) { + *ptr = *(++in_ptr); + *++ptr = 0x00; + /* *unused = *unused - 1; */ + no_bytes--; + } + *input_ptr = in_ptr; + *output_ptr = ptr; + return (ret + no_bytes); +} + +/* insert_octets_unaligned inserts bytes from the input buffer, *input_ptr, + into the output buffer, *output_ptr.No alignment is done. + */ +int insert_octets_unaligned(int no_bytes, + unsigned char **input_ptr, + unsigned char **output_ptr, + int unused) +{ + unsigned char *in_ptr = *input_ptr; + unsigned char *ptr = *output_ptr; + int n = no_bytes; + unsigned char val; + + while (n > 0) { + if (unused == 8) { + *ptr = *++in_ptr; + *++ptr = 0x00; + }else { + val = *++in_ptr; + *ptr = *ptr | val >> (8 - unused); + *++ptr = 0x00; + *ptr = val << unused; + } + n--; + } + *input_ptr = in_ptr; + *output_ptr = ptr; + return no_bytes; +} + + +int insert_octets_except_unused(int no_bytes, + unsigned char **input_ptr, + unsigned char **output_ptr, + int *unused, + int in_unused) +{ + unsigned char *in_ptr = *input_ptr; + unsigned char *ptr = *output_ptr; + int val, no_bits; + int ret = 0; + + if (in_unused == 0){ +/* printf("%d: insert_octets_except_unused: if\n\r",__LINE__); */ + if ((ret = insert_octets_unaligned(no_bytes,&in_ptr,&ptr, + *unused)) == ASN1_ERROR) + return ASN1_ERROR; + } + else { +/* printf("%d: insert_octets_except_unused: else\n\r",__LINE__); */ + if ((ret=insert_octets_unaligned(no_bytes - 1,&in_ptr,&ptr,*unused)) != ASN1_ERROR) { + val = (int) *(++in_ptr); + no_bits = 8 - in_unused; + /* no_bits is always less than *unused since the buffer is + octet aligned after insert:octets call, so the following + if clasuse is obsolete I think */ + if(no_bits < *unused){ + *ptr = *ptr | (val >> (8 - *unused)); + *unused = *unused - no_bits; + } else if (no_bits == *unused) { + *ptr = *ptr | (val >> (8 - *unused)); + *++ptr = 0x00; + ret++; + *unused = 8; + } else { + *ptr = *ptr | (val >> (8 - *unused)); + *++ptr = 0x00; + ret++; + *ptr = *ptr | (val << *unused); + *unused = 8 - (no_bits - *unused); + } + } else + return ASN1_ERROR; + } + *input_ptr = in_ptr; + *output_ptr = ptr; +/* printf("%d: insert_octets_except_unused: ret=%d\n\r",__LINE__,ret); */ + return ret; +} + + + +/* + * + * This section defines functionality for the partial decode of a + * BER encoded message + * + */ + +/* + * int decode(ErlDrvBinary **drv_binary,unsigned char *decode_buf, + * unsigned char *in_buf, int in_buf_len) + * drv_binary is a pointer to a pointer to an allocated driver binary. + * in_buf is a pointer into the buffer of incoming bytes. + * in_buf_len is the length of the incoming buffer. + * The function reads the bytes in the incoming buffer and structures + * it in a nested way as Erlang terms. The buffer contains data in the + * order tag - length - value. Tag, length and value has the following + * format: + * A tag is normally one byte but may be of any length, if the tag number + * is greater than 30. +----------+ + * |CL|C|NNNNN| + * +----------+ + * If NNNNN is 31 then will the 7 l.s.b of each of the following tag number + * bytes contain the tag number. Each tag number byte that is not the last one + * has the m.s.b. set to 1. + * The length can be short definite length (sdl), long definite length (ldl) + * or indefinite length (il). + * sdl: +---------+ the L bits is the length + * |0|LLLLLLL| + * +---------+ + * ldl: +---------+ +---------+ +---------+ +-----------+ + * |1|lllllll| |first len| | | |the Nth len| + * +---------+ +---------+ +---------+ ... +-----------+ + * The first byte tells how many len octets will follow, max 127 + * il: +---------+ +----------------------+ +--------+ +--------+ + * |1|0000000| |content octets (Value)| |00000000| |00000000| + * +---------+ +----------------------+ +--------+ +--------+ + * The value octets are preceded by one octet and followed by two + * exactly as above. The value must be some tag-length-value encoding. + * + * The function returns a value in Erlnag term format: + * {{TagNo,Value},Rest} + * TagNo is an integer ((CL bsl 16) + tag number) which limits the tag number + * to 65535. + * Value is a binary if the C bit in tag was unset, otherwise (if tag was + * constructed) Value is a list, List. + * List is like: [{TagNo,Value},{TagNo,Value},...] + * Rest is a binary, i.e. the undecoded part of the buffer. Most often Rest + * is the empty binary. + * If some error occured during the decoding of the in_buf an error is returned. + */ +int decode_begin(ErlDrvBinary **drv_binary,unsigned char *in_buf, int in_buf_len, unsigned int *err_pos) +{ + int maybe_ret; + char *decode_buf = (*drv_binary)->orig_bytes; + int ei_index = 0; + int ib_index = 0; + /* ei_index is the index used by the ei functions to encode an + Erlang term into the buffer decode_buf */ + /* ib_index is the index were to read the next byte from in_buf */ + + +#ifdef ASN1_DEBUG + printf("decode_begin1: ei_index=%d, ib_index=%d\n\r",ei_index,ib_index); +#endif + /* the first byte must be a "version magic" */ + if(ei_encode_version(decode_buf,&ei_index) == ASN1_ERROR) + return ASN1_ERROR; /* 1 byte */ +#ifdef ASN1_DEBUG + printf("decode_begin2: ei_index=%d, ib_index=%d\n\r",ei_index,ib_index); +#endif + if (ei_encode_tuple_header(decode_buf,&ei_index,2) == ASN1_ERROR) + return ASN1_ERROR; /* 2 bytes */ +#ifdef ASN1_DEBUG + printf("decode_begin3: ei_index=%d, ib_index=%d\n\r",ei_index,ib_index); +#endif + if((maybe_ret=decode(drv_binary,&ei_index,in_buf,&ib_index,in_buf_len)) <= ASN1_ERROR) + { + *err_pos = ib_index; +#ifdef ASN1_DEBUG + printf("err_pos=%d,ib_index=%d\r\n",*err_pos,ib_index); +#endif + return maybe_ret; + }; + + decode_buf = (*drv_binary)->orig_bytes; /* maybe a realloc during decode_value */ +#ifdef ASN1_DEBUG + printf("decode_begin4: in_buf_len=%d, ei_index=%d, ib_index=%d\n\r", + in_buf_len,ei_index,ib_index); +#endif + /* "{{TagNo,Value},Rest}" */ + if (ei_encode_binary(decode_buf,&ei_index,&(in_buf[ib_index]),in_buf_len-ib_index) + == ASN1_ERROR) /* at least 5 bytes */ + return ASN1_ERROR; +#ifdef ASN1_DEBUG + printf("decode_begin5: ei_index=%d, ib_index=%d\n\r",ei_index,ib_index); +#endif + return ei_index; +} + +int decode(ErlDrvBinary **drv_binary,int *ei_index,unsigned char *in_buf, + int *ib_index, int in_buf_len) +{ + int maybe_ret; + char *decode_buf = (*drv_binary)->orig_bytes; + int form; +#ifdef ASN1_DEBUG + printf("decode 1\n\r"); +#endif + if (((*drv_binary)->orig_size - *ei_index) < 19) {/* minimum amount of bytes */ + /* allocate more memory */ + if (realloc_decode_buf(drv_binary,(*drv_binary)->orig_size * 2) == + ASN1_ERROR) + return ASN1_ERROR; + decode_buf = (*drv_binary)->orig_bytes; + } +/* printf("decode 2\n\r"); */ + /* "{" */ + if (ei_encode_tuple_header(decode_buf,ei_index,2) == ASN1_ERROR) + return ASN1_ERROR; /* 2 bytes */ +#ifdef ASN1_DEBUG + printf("decode 3:orig_size=%d, ei_index=%d, ib_index=%d\n\r",(*drv_binary)->orig_size,*ei_index,*ib_index); +#endif + + /*buffer must hold at least two bytes*/ + if ((*ib_index +2) > in_buf_len) + return ASN1_VALUE_ERROR; + /* "{{TagNo," */ + if ((form = decode_tag(decode_buf,ei_index,in_buf,in_buf_len,ib_index)) <= ASN1_ERROR) + return form; /* 5 bytes */ +#ifdef ASN1_DEBUG + printf("i_i=%d,in_buf_len=%d\r\n",*ei_index,in_buf_len); +#endif + if (*ib_index >= in_buf_len){ + return ASN1_TAG_ERROR; + } +#ifdef ASN1_DEBUG + printf("decode 5 ib_index=%d\n\r",*ib_index); +#endif + /* buffer must hold at least one byte (0 as length and nothing as + value) */ + /* "{{TagNo,Value}," */ + if ((maybe_ret=decode_value(ei_index,in_buf,ib_index,drv_binary,form, + in_buf_len)) <= ASN1_ERROR) + return maybe_ret; /* at least 5 bytes */ +#ifdef ASN1_DEBUG + printf("decode 7\n\r"); +#endif + return *ei_index; +} + +/* + * decode_tag decodes the BER encoded tag in in_buf and puts it in the + * decode_buf encoded by the Erlang extern format as an Erlang term. + */ +int decode_tag(char *decode_buf,int *db_index,unsigned char *in_buf, + int in_buf_len, int *ib_index) +{ + int tag_no, tmp_tag, form; + + + /* first get the class of tag and bit shift left 16*/ + tag_no = ((MASK(in_buf[*ib_index],ASN1_CLASS)) << 10); + + form = (MASK(in_buf[*ib_index],ASN1_FORM)); +#ifdef ASN1_DEBUG + printf("decode_tag0:ii=%d, tag_no=%d, form=%d.\r\n", + *ib_index,tag_no,form); +#endif + + /* then get the tag number */ + if((tmp_tag = (int) INVMASK(in_buf[*ib_index],ASN1_CLASSFORM)) < 31) { + ei_encode_ulong(decode_buf,db_index,tag_no+tmp_tag); /* usual case */ + (*ib_index)++; +#ifdef ASN1_DEBUG + printf("decode_tag1:ii=%d.\r\n",*ib_index); +#endif + } + else + { + int n = 0; /* n is used to check that the 64K limit is not + exceeded*/ +#ifdef ASN1_DEBUG + printf("decode_tag1:ii=%d, in_buf_len=%d.\r\n",*ib_index,in_buf_len); +#endif + + /* should check that at least three bytes are left in + in-buffer,at least two tag byte and at least one length byte */ + if ((*ib_index +3) > in_buf_len) + return ASN1_VALUE_ERROR; + (*ib_index)++; +#ifdef ASN1_DEBUG + printf("decode_tag2:ii=%d.\r\n",*ib_index); +#endif + /* The tag is in the following bytes in in_buf as + 1ttttttt 1ttttttt ... 0ttttttt, where the t-bits + is the tag number*/ + /* In practice is the tag size limited to 64K, i.e. 16 bits. If + the tag is greater then 64K return an error */ + while (((tmp_tag = (int)in_buf[*ib_index]) >= 128) && n < 2){ + /* m.s.b. = 1 */ + tag_no = tag_no + (MASK(tmp_tag,ASN1_LONG_TAG) << 7); + (*ib_index)++; +#ifdef ASN1_DEBUG + printf("decode_tag3:ii=%d.\r\n",*ib_index); +#endif + n++; + }; + if ((n==2) && in_buf[*ib_index] > 3) + return ASN1_TAG_ERROR; /* tag number > 64K */ + tag_no = tag_no + in_buf[*ib_index]; + (*ib_index)++; +#ifdef ASN1_DEBUG + printf("decode_tag4:ii=%d.\r\n",*ib_index); +#endif + ei_encode_ulong(decode_buf,db_index,tag_no); + } + return form; +} + + +/* + * decode_value decodes the BER encoded length and value fields in the + * in_buf and puts the value part in the decode_buf as an Erlang term + * encoded by the Erlang extern format + */ +int decode_value(int *ei_index,unsigned char *in_buf, + int *ib_index,ErlDrvBinary **drv_binary,int form, + int in_buf_len) +{ + int maybe_ret; + char *decode_buf = (*drv_binary)->orig_bytes; + int len, lenoflen; + int indef = 0; + +#ifdef ASN1_DEBUG + printf("decode_value1:ib_index=%d\n\r",*ib_index); +#endif + if (((in_buf[*ib_index]) & 0x80) == ASN1_SHORT_DEFINITE_LENGTH) { + len = in_buf[*ib_index]; + if (len > (in_buf_len - (*ib_index + 1))) + return ASN1_LEN_ERROR; + } + else if (in_buf[*ib_index] == ASN1_INDEFINITE_LENGTH) + indef = 1; + else /* long definite length */ { + lenoflen = (in_buf[*ib_index] & 0x7f); /*length of length */ +#ifdef ASN1_DEBUG + printf("decode_value,lenoflen:%d\r\n",lenoflen); +#endif + len = 0; + while (lenoflen-- && (*ib_index <= in_buf_len)) { + (*ib_index)++; +#ifdef ASN1_DEBUG + printf("decode_value1:ii=%d.\r\n",*ib_index); +#endif + len = (len << 8) + in_buf[*ib_index]; + } + if (len > (in_buf_len - (*ib_index + 1))) + return ASN1_LEN_ERROR; + } + (*ib_index)++; +#ifdef ASN1_DEBUG + printf("decode_value2:ii=%d.\r\n",*ib_index); +#endif + if (indef == 1) + { /* in this case it is desireably to check that indefinite length + end bytes exist in inbuffer */ + while (!(in_buf[*ib_index]==0 && in_buf[*ib_index + 1]==0)) { +#ifdef ASN1_DEBUG + printf("decode_value while:ib_index=%d in_buf_len=%d\n\r", + *ib_index,in_buf_len); +#endif + if(*ib_index >= in_buf_len) + return ASN1_INDEF_LEN_ERROR; + ei_encode_list_header(decode_buf,ei_index,1); /* 5 bytes */ + if((maybe_ret=decode(drv_binary,ei_index,in_buf, + ib_index,in_buf_len)) <= ASN1_ERROR) + return maybe_ret; + decode_buf = (*drv_binary)->orig_bytes; + } + (*ib_index) += 2; /* skip the indefinite length end bytes */ +#ifdef ASN1_DEBUG + printf("decode_value3:ii=%d.\r\n",*ib_index); +#endif + ei_encode_empty_list(decode_buf,ei_index); /* 1 byte */ + } + else if (form == ASN1_CONSTRUCTED) + { + int end_index = *ib_index + len; + if(end_index > in_buf_len) + return ASN1_LEN_ERROR; + while (*ib_index < end_index) { + +#ifdef ASN1_DEBUG + printf("decode_value3:*ib_index=%d, end_index=%d\n\r",*ib_index,end_index); +#endif + ei_encode_list_header(decode_buf,ei_index,1); /* 5 bytes */ + if((maybe_ret=decode(drv_binary,ei_index,in_buf, + ib_index,in_buf_len))<=ASN1_ERROR) + return maybe_ret; + decode_buf = (*drv_binary)->orig_bytes; + } + ei_encode_empty_list(decode_buf,ei_index); /* 1 byte */ + } + else + { + if (((*drv_binary)->orig_size - *ei_index) < 10+len) { /* 5+len for the binary*/ + if (realloc_decode_buf(drv_binary,(*drv_binary)->orig_size * 2) == + ASN1_ERROR) + return ASN1_ERROR; + decode_buf = (*drv_binary)->orig_bytes; + } + if((*ib_index + len) > in_buf_len) + return ASN1_LEN_ERROR; + ei_encode_binary(decode_buf,ei_index,&in_buf[*ib_index],len); + *ib_index = *ib_index + len; +#ifdef ASN1_DEBUG + printf("decode_value4:ii=%d.\r\n",*ib_index); +#endif + } + return ASN1_OK; +} + +int realloc_decode_buf(ErlDrvBinary **drv_binary,int amount) { + ErlDrvBinary *tmp_bin; + + if ((tmp_bin=driver_realloc_binary(*drv_binary,amount)) == NULL) + return ASN1_ERROR; + *drv_binary = tmp_bin; + return ASN1_OK; +} + + + +/* + * int decode_partial(drv_binary,in_buf,in_buf_len) + */ +/* + * The in_buf contains two parts: first information about which value + * will be decoded, as a sequence of tags and tag codes, then the + * encoded BER value. First of all comes a length field that tells how + * many following bytes contains the sequence of tags. Then starts the + * BER encoded message. The tag sequence length field is a single + * byte. The sequence of tags/tag codes may be one of the codes + * ASN1_SKIPPED, ASN1_CHOOSEN and a tag or ASN1_OPTIONAL and a + * tag. ASN1_SKIPPED means that the following tag is mandatory and is + * skipped. ASN1_CHOOSEN means that the value of this tag shall, if + * this was the last tag in tag sequence, be returned or be searched + * in for the next tag. ASN1_OPTIONAL means that this tag shall be + * skipped but it may be missing. Each tag in the tag sequence + * correspond to a tag in the BER encoded message. If the decode + * arives to a position where there is no matching tag, an error is + * returned (if it wasn't the last tag and it was OPTIONAL). After the + * right value has been detected it is returned in the out_buf. + * + */ +int decode_partial(ErlDrvBinary **drv_binary,unsigned char *in_buf, int in_buf_len) +{ + char *out_buf = (*drv_binary)->orig_bytes; + int tag_index_val = 1; + int msg_index_val; + int *msg_index, *tag_index, tmp_index; + int tag_seq_length; + char tag_code; /* one of ASN1_SKIPPED, ASN1_OPTIONAL, ASN1_CHOOSEN */ + int wanted_tag, next_tag; + int buf_end_index = in_buf_len; + int ret = 0, length, old_index; + + tag_index = &tag_index_val; + tag_seq_length = in_buf[0]; + msg_index = &msg_index_val; + *msg_index = tag_seq_length + 1; + + +/* printf("decode_partial 1: in_buf_len=%d, tag_index=%d, msg_index=%d\r\n,tag_seq_length=%d\r\n",in_buf_len,*tag_index,*msg_index,tag_seq_length); */ + while(*tag_index < tag_seq_length) { + switch(in_buf[*tag_index]) { + case ASN1_SKIPPED: +/* printf("decode_partial ASN1_SKIPPED: in_buf[*msg_index]=%d\r\n",in_buf[*msg_index]); */ + (*tag_index)++; +/* printf("decode_partial ASN1_SKIPPED 2: *msg_index=%d\r\n",*msg_index); */ + skip_tag(in_buf,msg_index,buf_end_index); +/* printf("decode_partial ASN1_SKIPPED 3: *msg_index=%d\r\n",*msg_index); */ + skip_length_and_value(in_buf,msg_index,buf_end_index); +/* printf("decode_partial ASN1_SKIPPED 4: *msg_index=%d\r\n",*msg_index); */ + break; + case ASN1_OPTIONAL: + (*tag_index)++; +/* printf("decode_partial ASN1_OPTIONAL: in_buf[*tag_index]=%d\r\n",in_buf[*tag_index]); */ + wanted_tag = in_buf[*tag_index]; + (*tag_index)++; + tmp_index = *msg_index; + next_tag = get_tag(in_buf,msg_index,buf_end_index); + if (wanted_tag != next_tag) { + *msg_index = tmp_index; + } else + skip_length_and_value(in_buf,msg_index,buf_end_index); + break; + case ASN1_CHOOSEN: +/* printf("decode_partial ASN1_CHOOSEN: in_buf[*msg_index]=%d, *msg_index=%d\r\n",in_buf[*msg_index],*msg_index); */ + (*tag_index)++; + wanted_tag = in_buf[*tag_index]; + (*tag_index)++; + old_index = *msg_index; +/* printf("decode_partial ASN1_CHOOSEN 2: *msg_index=%d\r\n",*msg_index); */ + next_tag = get_tag(in_buf,msg_index,buf_end_index); +/* printf("decode_partial ASN1_CHOOSEN 3: *msg_index=%d\r\n,wanted_tag=%d, next_tag=%d\r\n",*msg_index,wanted_tag,next_tag); */ + if (wanted_tag != next_tag) + return ASN1_NOVALUE; /* an empty binary will be returned to Erlang */ + if (*tag_index == (tag_seq_length + 1)) { + /* get the value and return*/ + if((ret = get_value(out_buf,in_buf,msg_index,buf_end_index)) <= ASN1_ERROR) + return ASN1_ERROR; + return ret; + } + else { + /* calculate the length of the sub buffer and let *msg_index + be at the value part of this BER encoded type*/ + int indef; + indef = 0; + length = get_length(in_buf,msg_index,&indef,buf_end_index); +/* printf("decode_partial ASN1_CHOOSEN 4: length=%d, *msg_index=%d\r\n",length,*msg_index); */ + if ((length == 0) && (indef == 1)) { + /* indefinite length of value */ + old_index = *msg_index; + length = skip_length_and_value(in_buf,msg_index,buf_end_index); + *msg_index = old_index; + buf_end_index = *msg_index + length - 2; + /* remove two bytes due to indefinete length end zeros */ + } else + buf_end_index = (*msg_index + length); + } + break; + default: + return ASN1_ERROR; + } + } + return ASN1_ERROR; +} + + +/* + * int skip_tag(unsigned char *in_buf,int *index,int buf_len) + * steps past the BER encoded tag in in_buf and updates *index. + * Returns the number of skipped bytes. + */ +int skip_tag(unsigned char *in_buf,int *index,int buf_len) +{ + int start_index = *index; + if ((MASK(in_buf[*index],ASN1_TAG)) == 31){ + do { + (*index)++; + if (*index >= buf_len) + return ASN1_ERROR; + } + while(in_buf[*index] >=128); + } + (*index)++; + return (*index - start_index); +} + + +/* + * int skip_length_and_value(unsigned char *in_buf,int *index,int buf_len) + * steps past the BER encoded length and value in in_buf and updates *index. + * returns the length if the skipped "length value". + * Returns the number of skipped bytes. + */ +int skip_length_and_value(unsigned char *in_buf,int *index,int buf_len) +{ + long len; + int indef = 0, lenoflen; + int start_index = *index; + + if ((MASK(in_buf[*index],0x80)) == ASN1_SHORT_DEFINITE_LENGTH){ + len = in_buf[*index]; + if (len > (buf_len - (*index + 1))) + return ASN1_LEN_ERROR; + } else if (in_buf[*index] == ASN1_INDEFINITE_LENGTH) + indef = 1; + else /* long definite length */ { + lenoflen = (in_buf[*index] & 0x7f); /*length of length */ + len = 0; + while (lenoflen--) { + (*index)++; + len = (len << 8) + in_buf[*index]; + } + if (len > (buf_len - (*index + 1))) + return ASN1_LEN_ERROR; + } + (*index)++; + if (indef == 1) + { + while(!(in_buf[*index]==0 && in_buf[*index + 1]==0)) { + skip_tag(in_buf,index,buf_len); + skip_length_and_value(in_buf,index,buf_len); + } + (*index) += 2; + } + else + (*index) += len; + return (*index - start_index); +} + +/* int get_tag(unsigned char *in_buf,int *index) + * + * assumes next byte/bytes in in_buf is an encoded BER tag. A tag + * number has theoretically no upper limit in size. Here the tag + * number is assumed to be less than 64K. Returns an integer value + * on the format: + * xxxxxxxx xxxxxxcc tttttttt tttttttt + * the x-bits are 0 (insignificant) + * the c-bits are the class of the tag + * the t-bits are the tag number. This implies that the tag number + * is limited to 64K-1 + * + */ +int get_tag(unsigned char *in_buf,int *index,int buf_len) +{ + int tag_no = 0,tmp_tag = 0; + + tag_no = (MASK(in_buf[*index],ASN1_CLASSFORM)); + if ((MASK(in_buf[*index],ASN1_TAG)) == ASN1_TAG) { + /* long form of tag */ + do { + (*index)++; + if (*index >= buf_len) + return ASN1_TAG_ERROR; + tmp_tag = tmp_tag << 7; + tmp_tag += (MASK(in_buf[*index],ASN1_LONG_TAG)); + } while (in_buf[*index] >= 128); + (*index)++; + tag_no = tag_no + tmp_tag; + } else { + tag_no += (MASK(in_buf[*index],ASN1_TAG)); + (*index)++; + } + if (*index >= buf_len) + return ASN1_TAG_ERROR; + return tag_no; +} + + +/* + * int get_value(char *out_buf,unsigned char *in_buf, + * int *msg_index,int in_buf_len) + */ +/* assumes next byte/bytes in in_buf is an encoded BER value preceeded by a BER encoded length. Puts value in out_buf. + */ +int get_value(char *out_buf, + unsigned char *in_buf, + int *msg_index, + int in_buf_len) +{ + int len, lenoflen, indef=0, skip_len; + int ret=0; + int start_index, out_index = 0; + +/* printf("get_value 1\n\r"); */ + if (in_buf[*msg_index] < 0x80){ /* short definite length */ + len = in_buf[*msg_index]; +/* printf("short definite length\r\n"); */ + } else if (in_buf[*msg_index] > 0x80) { /* long definite length */ + lenoflen = (in_buf[*msg_index] & 0x7f); /*length of length */ + len = 0; + while (lenoflen--) { + (*msg_index)++; + len = (len << 8) + in_buf[*msg_index]; + } + if (len > (in_buf_len - (*msg_index + 1))) + return ASN1_LEN_ERROR; + } else + indef = 1; + (*msg_index)++; +/* printf("get_value 2: len = %d, *msg_index = %d\r\n",len,*msg_index); */ + if (indef == 1) { + while(!(in_buf[*msg_index]==0 && in_buf[*msg_index + 1]==0)) { + start_index = *msg_index; + skip_len = skip_tag(in_buf,msg_index,in_buf_len); +/* printf("get_value 3: skip_len=%d,start_index=%d,*msg_index=%d\n\r", */ +/* skip_len,start_index,*msg_index); */ + memcpy(&out_buf[ret],&in_buf[start_index],skip_len); + ret += skip_len; + start_index = *msg_index; + skip_len = skip_length_and_value(in_buf,msg_index,in_buf_len); +/* printf("get_value 4: skip_len=%d,start_index=%d,*msg_index=%d\n\r", */ +/* skip_len,start_index,*msg_index); */ + memcpy(&out_buf[ret],&in_buf[start_index],skip_len); + ret += skip_len; + } + return ret; + } + else + memcpy(&out_buf[ret],&in_buf[*msg_index],len); + return len; +} + + +/* + * int get_length(unsigned char *in_buf,int *msg_index) + * assumes next byte/bytes contain a BER encoded length field, + * which is decoded. The value of the length is returned. If it + * is an indefinite length the *indef is set to one. + */ +int get_length(unsigned char *in_buf,int *msg_index, + int *indef,int in_buf_len) +{ + int len=0, lenoflen; + + if (in_buf[*msg_index] < 0x80) /* short definite length */ + len = in_buf[*msg_index]; + else if (in_buf[*msg_index] > 0x80) { /* long definite length */ + lenoflen = (in_buf[*msg_index] & 0x7f); /*length of length */ + len = 0; + while (lenoflen--) { + (*msg_index)++; + len = (len << 8) + in_buf[*msg_index]; + } + if (len > (in_buf_len - (*msg_index + 1))) + return ASN1_LEN_ERROR; + } else + *indef = 1; + (*msg_index)++; + return len; +} diff --git a/lib/asn1/doc/erlmod/.gitignore b/lib/asn1/doc/erlmod/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/asn1/doc/erlmod/.gitignore diff --git a/lib/asn1/doc/html/.gitignore b/lib/asn1/doc/html/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/asn1/doc/html/.gitignore diff --git a/lib/asn1/doc/man3/.gitignore b/lib/asn1/doc/man3/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/asn1/doc/man3/.gitignore diff --git a/lib/asn1/doc/misc/.gitignore b/lib/asn1/doc/misc/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/asn1/doc/misc/.gitignore diff --git a/lib/asn1/doc/pdf/.gitignore b/lib/asn1/doc/pdf/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/asn1/doc/pdf/.gitignore diff --git a/lib/asn1/doc/src/Makefile b/lib/asn1/doc/src/Makefile new file mode 100644 index 0000000000..be8755f0ff --- /dev/null +++ b/lib/asn1/doc/src/Makefile @@ -0,0 +1,223 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk +VSN=$(ASN1_VSN) +APPLICATION=asn1 + + +# ---------------------------------------------------- +# Include dependency +# ---------------------------------------------------- + +ifndef DOCSUPPORT +include make.dep +endif + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +XML_APPLICATION_FILES = ref_man.xml +XML_REF3_FILES = asn1ct.xml \ + asn1rt.xml + +GEN_XML = \ + asn1_spec.xml + +XML_PART_FILES = \ + part.xml \ + part_notes.xml + +XML_HTML_FILE = \ + notes_history.xml + +XML_CHAPTER_FILES = \ + asn1_ug.xml \ + asn1_spec.xml \ + notes.xml + +BOOK_FILES = book.xml + +XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \ + $(GEN_XML) $(XML_PART_FILES) $(XML_CHAPTER_FILES) + +GIF_FILES = \ + exclusive_Win_But.gif \ + selective_Window2.gif \ + selective_TypeList.gif + +# ---------------------------------------------------- + +ASN1_FILES = \ + Seq.asn \ + Seq.asn1config + +INFO_FILE = ../../info +EXTRA_FILES = \ + $(DEFAULT_HTML_FILES) \ + $(ASN1_FILES) \ + $(XML_REF3_FILES:%.xml=$(HTMLDIR)/%.html) \ + $(XML_CHAPTER_FILES:%.xml=$(HTMLDIR)/%.html) + +MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) + +ifdef DOCSUPPORT + +HTML_REF_MAN_FILE = $(HTMLDIR)/index.html + +TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf + +else + +TEX_FILES_BOOK = \ + $(BOOK_FILES:%.xml=%.tex) \ + $(BOOK_FILES:%.xml=%.sgml) part.tex +TEX_FILES_REF_MAN = $(XML_REF3_FILES:%.xml=%.tex) \ + $(XML_APPLICATION_FILES:%.xml=%.tex) +TEX_FILES_USERS_GUIDE = \ + $(XML_CHAPTER_FILES:%.xml=%.tex) + +TOP_PDF_FILE = $(APPLICATION)-$(VSN).pdf +TOP_PS_FILE = $(APPLICATION)-$(VSN).ps + +$(TOP_PDF_FILE): book.dvi ../../vsn.mk + $(DVI2PS) $(DVIPS_FLAGS) -f $< | $(DISTILL) $(DISTILL_FLAGS) > $@ + +$(TOP_PS_FILE): book.dvi ../../vsn.mk + $(DVI2PS) $(DVIPS_FLAGS) -f $< > $@ + +endif + + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +XML_FLAGS += +DVIPS_FLAGS += + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- +$(HTMLDIR)/%.gif: %.gif + $(INSTALL_DATA) $< $@ + +ifdef DOCSUPPORT + +docs: pdf html man + +$(TOP_PDF_FILE): $(XML_FILES) + +pdf: $(TOP_PDF_FILE) + +html: gifs $(HTML_REF_MAN_FILE) + +clean clean_docs: + rm -rf $(HTMLDIR)/* + rm -f $(MAN3DIR)/* + rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) + rm -f $(GEN_XML) errs core *~ + +else + +ifeq ($(DOCTYPE),pdf) +docs: pdf +else +ifeq ($(DOCTYPE),ps) +docs: ps +else +docs: html gifs man +endif +endif + +pdf: $(TOP_PDF_FILE) + +ps: $(TOP_PS_FILE) + +html: $(HTML_FILES) + +clean clean_docs clean_tex: + rm -f $(TEX_FILES_USERS_GUIDE) $(TEX_FILES_REF_MAN) $(TEX_FILES_BOOK) + rm -f $(HTML_FILES) $(MAN3_FILES) + rm -f $(TOP_PDF_FILE) $(TOP_PS_FILE) + rm -f errs core *~ $(LATEX_CLEAN) + +endif + +man: $(MAN3_FILES) + +gifs: $(GIF_FILES:%=$(HTMLDIR)/%) + +debug opt: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +ifdef DOCSUPPORT + +release_docs_spec: docs + $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf + $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf + $(INSTALL_DIR) $(RELSYSDIR)/doc/html + $(INSTALL_DATA) $(HTMLDIR)/* \ + $(RELSYSDIR)/doc/html + $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) + $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 + $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 + +else + +ifeq ($(DOCTYPE),pdf) +release_docs_spec: pdf + $(INSTALL_DIR) $(RELEASE_PATH)/pdf + $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELEASE_PATH)/pdf +else +ifeq ($(DOCTYPE),ps) +release_docs_spec: ps + $(INSTALL_DIR) $(RELEASE_PATH)/ps + $(INSTALL_DATA) $(TOP_PS_FILE) $(RELEASE_PATH)/ps +else +release_docs_spec: docs + $(INSTALL_DIR) $(RELSYSDIR)/doc/html + $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ + $(HTML_APPHISTORY) $(RELSYSDIR)/doc/html + $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) + $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 + $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 +endif +endif + +endif + +release_spec: + + + diff --git a/lib/asn1/doc/src/Seq.asn b/lib/asn1/doc/src/Seq.asn new file mode 100644 index 0000000000..2f2c48cf02 --- /dev/null +++ b/lib/asn1/doc/src/Seq.asn @@ -0,0 +1,37 @@ +GUI DEFINITIONS AUTOMATIC TAGS ::= + +BEGIN + +Action ::= SEQUENCE + { + number INTEGER DEFAULT 15, + handle [0] Handle DEFAULT {number 12, on TRUE} + } + +Key ::= [11] EXPLICIT Button +Handle ::= [12] Key +Button ::= SEQUENCE + { + number INTEGER, + on BOOLEAN + } + +Window ::= CHOICE + { + vsn INTEGER, + status E + } + +Status ::= SEQUENCE + { + state INTEGER, + buttonList SEQUENCE OF Button, + enabled BOOLEAN OPTIONAL, + actions CHOICE { + possibleActions SEQUENCE OF Action, + noOfActions INTEGER + } + } + + +END diff --git a/lib/asn1/doc/src/Seq.asn1config b/lib/asn1/doc/src/Seq.asn1config new file mode 100644 index 0000000000..571cf4cd32 --- /dev/null +++ b/lib/asn1/doc/src/Seq.asn1config @@ -0,0 +1,3 @@ +{exclusive_decode,{'GUI', + [{decode_Window_exclusive,['Window',[{status,[{buttonList,parts},{actions,undecoded}]}]]}, + {decode_Button_exclusive,['Button',[{number,undecoded}]]}]}}. diff --git a/lib/asn1/doc/src/asn1_spec.xmlsrc b/lib/asn1/doc/src/asn1_spec.xmlsrc new file mode 100644 index 0000000000..8d61834da8 --- /dev/null +++ b/lib/asn1/doc/src/asn1_spec.xmlsrc @@ -0,0 +1,824 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2003</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>Specialized Decodes</title> + <prepared>EAB/UAB/UKH/KD Bertil Karlsson</prepared> + <docno></docno> + <date>2003-04-24</date> + <rev>D</rev> + <file>asn1_spec.xml</file> + </header> + <marker id="SpecializedDecodes"></marker> + <p>When performance is of highest priority and one is interested in + a limited part of the ASN.1 encoded message, before one decide what + to do with the rest of it, one may want to decode only this small + part. The situation may be a server that has to decide to which + addressee it will send a message. The addressee may be interested in + the entire message, but the server may be a bottleneck that one want + to spare any unnecessary load. Instead of making two <em>complete decodes</em> (the normal case of decode), one in the server and one + in the addressee, it is only necessary to make one <em>specialized decode</em>(in the server) and another complete decode(in the + addressee). The following specialized decodes <em>exclusive decode</em> and <em>selected decode</em> support to solve this and + similar problems. + </p> + <p>So far this functionality is only provided when using the + optimized BER_BIN version, that is when compiling with the + options <c>ber_bin</c> and <c>optimize</c>. It does also work + using the <c>driver</c> option. We have no intent to make this + available on the default BER version, but maybe in the PER_BIN + version (<c>per_bin</c>). + </p> + + <section> + <title>Exclusive Decode</title> + <p>The basic idea with exclusive + decode is that you specify which parts of the message you want to + exclude from being decoded. These parts remain encoded and are + returned in the value structure as binaries. They may be decoded + in turn by passing them to a certain <c>decode_part/2</c> + function. The performance gain is high when the message is large + and you can do an exclusive decode and later on one or several + decodes of the parts or a second complete decode instead of two or + more complete decodes. + </p> + + <section> + <title>How To Make It Work</title> + <p>In order to make exclusive decode work you have to do the + following: + </p> + <list type="bulleted"> + <item>First,decide the name of the function for the exclusive + decode.</item> + <item>Second, write instructions that must consist of the name + of the exclusive decode function, the name of the ASN.1 + specification and a notation that tells which parts of the + message structure will be excluded from decode. These + instructions shall be included in a configuration + file. </item> + <item>Third, compile with the additional option + <c>asn1config</c>. The compiler searches for a configuration + file with the same name as the ASN.1 spec but with the + extension .asn1config. This configuration file is not the same + as used for compilation of a set of files. See section + <seealso marker="#UndecodedPart">Writing an Exclusive Decode Instruction.</seealso></item> + </list> + </section> + + <section> + <title>User Interface</title> + <p>The run-time user interface for exclusive decode consists of + two different functions. First, the function for an exclusive + decode, whose name the user decides in the configuration + file. Second, the compiler generates a <c>decode_part/2</c> + function when exclusive decode is chosen. This function decodes + the parts that were left undecoded during the exclusive + decode. Both functions are described below. + </p> + <p>If the exclusive decode function has for example got the name + <c>decode_exclusive</c> and an ASN.1 encoded message + <c>Bin</c> shall be exclusive decoded, the call is:</p> + <pre> +{ok,Excl_Message} = 'MyModule':decode_exclusive(Bin) </pre> + <marker id="UndecodedPart"></marker> + <p>The result <c>Excl_Message</c> has the same structure as an + complete decode would have, except for the parts of the top-type + that were not decoded. The undecoded parts will be on their place + in the structure on the format <c>{Type_Key,Undecoded_Value}</c>. + </p> + <p>Each undecoded part that shall be decoded must be fed into the <c>decode_part/2</c> function,like:</p> + <pre> +{ok,Part_Message} = 'MyModule':decode_part(Type_Key,Undecoded_Value) </pre> + </section> + + <section> + <marker id="Exclusive Instruction"></marker> + <title>Writing an Exclusive Decode Instruction</title> + <p>This instruction is written in the configuration file on the + format:</p> + <pre> + +Exclusive_Decode_Instruction = {exclusive_decode,{Module_Name,Decode_Instructions}}. + +Module_Name = atom() + +Decode_Instructions = [Decode_Instruction]+ + +Decode_Instruction = {Exclusive_Decode_Function_Name,Type_List} + +Exclusive_Decode_Function_Name = atom() + +Type_List = [Top_Type,Element_List] + +Element_List = [Element]+ + +Element = {Name,parts} | + {Name,undecoded} | + {Name,Element_List} + +Top_Type = atom() + +Name = atom() + </pre> + <p>Observe that the instruction must be a valid Erlang term ended + by a dot. + </p> + <p>In the <c>Type_List</c> the "path" from the top type to each + undecoded sub-components is described. The top type of the path is + an atom, the name of it. The action on each component/type that + follows will be described by one of <c>{Name,parts}, {Name,undecoded}, {Name,Element_List}</c></p> + <p>The use and effect of the actions are: + </p> + <list type="bulleted"> + <item><c>{Name,undecoded}</c> Tells that the element will be + left undecoded during the exclusive decode. The type of Name may + be any ASN.1 type. The value of element Name will be returned as a + tuple,as mentioned <seealso marker="#UndecodedPart">above</seealso>, in the value structure of the top type.</item> + <item><c>{Name,parts}</c> The type of Name may be one of + SEQUENCE OF or SET OF. The action implies that the different + components of Name will be left undecoded. The value of Name + will be returned as a tuple, as <seealso marker="#UndecodedPart">above </seealso>, where the second element is a list of + binaries. That is because the representation of a SEQUENCE OF/ + SET OF in Erlang is a list of its internal type. Any of the + elements of this list or the entire list can be decoded by the + <c>decode_part</c> function.</item> + <item><c>{Name,Element_List}</c>This action is used when one or + more of the sub-types of Name will be exclusive decoded.</item> + </list> + <p>Name in the actions above may be a component name of a + SEQUENCE or a SET or a name of an alternative in a CHOICE. + </p> + </section> + + <section> + <title>Example</title> + <p>In the examples below we use the definitions from the following ASN.1 spec:</p> + <marker id="Asn1spec"></marker> + <codeinclude file="Seq.asn" tag="" type="none"></codeinclude> + <p>If <c>Button</c> is a top type and we want to exclude + component <c>number</c> from decode the Type_List in the + instruction in the configuration file will be + <c>['Button',[{number,undecoded}]]</c>. If we call the decode + function <c>decode_Button_exclusive</c> the Decode_Instruction + will be + <c>{decode_Button_exclusive,['Button',[{number,undecoded}]]}</c>. + </p> + <p>We also have another top type <c>Window</c> whose sub + component actions in type <c>Status</c> and the parts of component + <c>buttonList</c> shall be left undecoded. For this type we name + the function <c>decode__Window_exclusive</c>. The whole + Exclusive_Decode_Instruction configuration is as follows: </p> + <codeinclude file="Seq.asn1config" tag="" type="none"></codeinclude> + <p></p> + <image file="exclusive_Win_But.gif"> + <icaption>Figure symbolizes the bytes of a Window:status message. The components buttonList and actions are excluded from decode. Only state and enabled are decoded when decode__Window_exclusive is called. </icaption> + </image> + <p></p> + <p>Compiling GUI.asn including the configuration file is done like:</p> + <pre> +unix> erlc -bber_bin +optimize +asn1config GUI.asn + +erlang> asn1ct:compile('GUI',[ber_bin,optimize,asn1config]). </pre> + <p>The module can be used like:</p> + <pre> + +1> Button_Msg = {'Button',123,true}. +{'Button',123,true} +2> {ok,Button_Bytes} = 'GUI':encode('Button',Button_Msg). +{ok,[<<48>>, + [6], + [<<128>>, + [1], + 123], + [<<129>>, + [1], + 255]]} +3> {ok,Exclusive_Msg_Button} = 'GUI':decode_Button_exclusive(list_to_binary(Button_Bytes)). +{ok,{'Button',{'Button_number',<<28,1,123>>}, + true}} +4> 'GUI':decode_part('Button_number',<<128,1,123>>). +{ok,123} +5> Window_Msg = +{'Window',{status,{'Status',35, + [{'Button',3,true}, + {'Button',4,false}, + {'Button',5,true}, + {'Button',6,true}, + {'Button',7,false}, + {'Button',8,true}, + {'Button',9,true}, + {'Button',10,false}, + {'Button',11,true}, + {'Button',12,true}, + {'Button',13,false}, + {'Button',14,true}], + false, + {possibleActions,[{'Action',16,{'Button',17,true}}]}}}}. +{'Window',{status,{'Status',35, + [{'Button',3,true}, + {'Button',4,false}, + {'Button',5,true}, + {'Button',6,true}, + {'Button',7,false}, + {'Button',8,true}, + {'Button',9,true}, + {'Button',10,false}, + {'Button',11,true}, + {'Button',12,true}, + {'Button',13,false}, + {'Button',14,true}], + false, + {possibleActions,[{'Action',16,{'Button',17,true}}]}}}} +6> {ok,Window_Bytes}='GUI':encode('Window',Window_Msg). +{ok,[<<161>>, + [127], + [<<128>>, ... + + +8> {ok,{status,{'Status',Int,{Type_Key_SeqOf,Val_SEQOF}, +BoolOpt,{Type_Key_Choice,Val_Choice}}}}= +'GUI':decode_Window_status_exclusive(list_to_binary(Window_Bytes)). +{ok,{status,{'Status',35, + {'Status_buttonList',[<<48,6,128,1,3,129,1,255>>, + <<48,6,128,1,4,129,1,0>>, + <<48,6,128,1,5,129,1,255>>, + <<48,6,128,1,6,129,1,255>>, + <<48,6,128,1,7,129,1,0>>, + <<48,6,128,1,8,129,1,255>>, + <<48,6,128,1,9,129,1,255>>, + <<48,6,128,1,10,129,1,0>>, + <<48,6,128,1,11,129,1,255>>, + <<48,6,128,1,12,129,1,255>>, + <<48,6,128,1,13,129,1,0>>, + <<48,6,128,1,14,129,1,255>>]}, + false, + {'Status_actions', +<<163,21,160,19,48,17,2,1,16,160,12,172,10,171,8,48,6,128,1,...>>}}}} +10> 'GUI':decode_part(Type_Key_SeqOf,Val_SEQOF). +{ok,[{'Button',3,true}, + {'Button',4,false}, + {'Button',5,true}, + {'Button',6,true}, + {'Button',7,false}, + {'Button',8,true}, + {'Button',9,true}, + {'Button',10,false}, + {'Button',11,true}, + {'Button',12,true}, + {'Button',13,false}, + {'Button',14,true}]} +11> 'GUI':decode_part(Type_Key_SeqOf,hd(Val_SEQOF)). +{ok,{'Button',3,true}} +12> 'GUI':decode_part(Type_Key_Choice,Val_Choice). +{ok,{possibleActions,[{'Action',16,{'Button',17,true}}]}} + </pre> + </section> + </section> + + <section> + <title>Selective Decode</title> + <p>This specialized decode decodes one single subtype of a + constructed value. It is the fastest method to extract one sub + value. The typical use of this decode is when one want to + inspect, for instance a version number,to be able to decide what + to do with the entire value. The result is returned as + <c>{ok,Value}</c> or <c>{error,Reason}</c>. + </p> + + <section> + <title>How To Make It Work</title> + <p>The following steps are necessary: + </p> + <list type="bulleted"> + <item>Write instructions in the configuration + file. Including the name of a user function, the name of the ASN.1 + specification and a notation that tells which part of the type + will be decoded. </item> + <item>Compile with the additional option + <c>asn1config</c>. The compiler searches for a configuration file + with the same name as the ASN.1 spec but with the extension + .asn1config. In the same file you can provide configuration specs + for exclusive decode as well. The generated Erlang module has the + usual functionality for encode/decode preserved and the + specialized decode functionality added. </item> + </list> + </section> + + <section> + <title>User Interface</title> + <p>The only new user interface function is the one provided by the + user in the configuration file. You can invoke that function by + the <c>ModuleName:FunctionName</c> notation. + </p> + <p>So, if you have the following spec + <c>{selective_decode,{'ModuleName',[{selected_decode_Window,TypeList}]}}</c> + in the con-fig file, you do the selective decode by + <c>{ok,Result}='ModuleName':selected_decode_Window(EncodedBinary).</c></p> + </section> + + <section> + <marker id="Selective Instruction"></marker> + <title>Writing a Selective Decode Instruction</title> + <p>It is possible to describe one or many selective decode + functions in a configuration file, you have to use the following + notation:</p> + <pre> +Selective_Decode_Instruction = {selective_decode,{Module_Name,Decode_Instructions}}. + +Module_Name = atom() + +Decode_Instructions = [Decode_Instruction]+ + +Decode_Instruction = {Selective_Decode_Function_Name,Type_List} + +Selective_Decode_Function_Name = atom() + +Type_List = [Top_Type|Element_List] + +Element_List = Name|List_Selector + +Name = atom() + +List_Selector = [integer()] </pre> + <p>Observe that the instruction must be a valid Erlang term ended + by a dot. + </p> + <p>The <c>Module_Name</c> is the same as the name of the ASN.1 + spec, but without the extension. A <c>Decode_Instruction</c> is + a tuple with your chosen function name and the components from + the top type that leads to the single type you want to + decode. Notice that you have to choose a name of your function + that will not be the same as any of the generated functions. The + first element of the <c>Type_List</c> is the top type of the + encoded message. In the <c>Element_List</c> it is followed by + each of the component names that leads to selected type. Each of + the names in the <c>Element_List</c> must be constructed types + except the last name, which can be any type. + </p> + <p>The List_Selector makes it possible to choose one of the + encoded components in a SEQUENCE OF/ SET OF. It is also possible + to go further in that component and pick a sub type of that to + decode. So in the <c>Type_List</c>: <c>['Window',status,buttonList,[1],number]</c> the + component <c>buttonList</c> has to be a SEQUENCE OF or SET OF type. In + this example component <c>number</c> of the first of the encoded + elements in the SEQUENCE OF <c>buttonList</c> is selected. This apply on + the ASN.1 spec <seealso marker="#Asn1spec">above</seealso>. + </p> + </section> + + <section> + <title>Another Example</title> + <p>In this example we use the same ASN.1 spec as <seealso marker="#Asn1spec">above</seealso>. A valid selective decode + instruction is:</p> + <pre> +{selective_decode, + {'GUI', + [{selected_decode_Window1, + ['Window',status,buttonList, + [1], + number]}, + {selected_decode_Action, + ['Action',handle,number]}, + {selected_decode_Window2, + ['Window', + status, + actions, + possibleActions, + [1], + handle,number]}]}}. + </pre> + <p>The first <c>Decode_Instruction</c>, + <c>{selected_decode_Window1,['Window',status,buttonList,[1],number]}</c> + is commented in the previous section. The instruction + <c>{selected_decode_Action,['Action',handle,number]}</c> picks + the component <c>number</c> in the <c>handle</c> component of the type + <c>Action</c>. If we have the value <c>ValAction = {'Action',17,{'Button',4711,false}}</c> the internal value 4711 + should be picked by <c>selected_decode_Action</c>. In an Erlang + terminal it looks like:</p> + <pre> +ValAction = {'Action',17,{'Button',4711,false}}. +{'Action',17,{'Button',4711,false}} +7> {ok,Bytes}='GUI':encode('Action',ValAction). +... +8> BinBytes = list_to_binary(Bytes). +<<48,18,2,1,17,160,13,172,11,171,9,48,7,128,2,18,103,129,1,0>> +9> 'GUI':selected_decode_Action(BinBytes). +{ok,4711} +10> </pre> + <p>The third instruction, + <c>['Window',status,actions,possibleActions,[1],handle,number]</c>, + which is a little more complicated,</p> + <list type="bulleted"> + <item>starts with type <em>Window</em>. </item> + <item>Picks component <em>status</em> of <c>Window</c> that is + of type <c>Status</c>.</item> + <item>Then takes component <em>actions</em> of type + <c>Status</c>.</item> + <item>Then <em>possibleActions</em> of the internal defined + CHOICE type.</item> + <item>Thereafter it goes into the first component of the + SEQUENCE OF by <em>[1]</em>. That component is of type + <c>Action</c>.</item> + <item>The instruction next picks component + <em>handle</em>.</item> + <item>And finally component <em>number</em> of the type + <c>Button</c>.</item> + </list> + <p>The following figures shows which components are in the + TypeList + <c>['Window',status,actions,possibleActions,[1],handle,number]</c>. And + which part of a message that will be decoded by + selected_decode_Window2. + </p> + <p></p> + <image file="selective_TypeList.gif"> + <icaption>The elements specified in the config file for selective decode of a sub-value in a Window message</icaption> + </image> + <p></p> + <image file="selective_Window2.gif"> + <icaption>Figure symbolizes the bytes of a Window:status message. Only the marked element is decoded when selected_decode_Window2 is called. </icaption> + </image> + <p>With the following example you can examine that both + <c>selected_decode_Window2</c> and + <c>selected_decode_Window1</c> decodes the intended sub-value + of the value <c>Val</c></p> + <pre> +1> Val = {'Window',{status,{'Status',12, + [{'Button',13,true}, + {'Button',14,false}, + {'Button',15,true}, + {'Button',16,false}], + true, + {possibleActions,[{'Action',17,{'Button',18,false}}, + {'Action',19,{'Button',20,true}}, + {'Action',21,{'Button',22,false}}]}}}} +2> {ok,Bytes}='GUI':encode('Window',Val). +... +3> Bin = list_to_binary(Bytes). +<<161,101,128,1,12,161,32,48,6,128,1,13,129,1,255,48,6,128,1,14,129,1,0,48,6,128,1,15,129,...>> +4> 'GUI':selected_decode_Window1(Bin). +{ok,13} +5> 'GUI':selected_decode_Window2(Bin). +{ok,18} </pre> + <p>Observe that the value feed into the selective decode + functions must be a binary. + </p> + </section> + </section> + + <section> + <title>Performance</title> + <p>To give an indication on the possible performance gain using + the specialized decodes, some measures have been performed. The + relative figures in the outcome between selective, exclusive and + complete decode (the normal case) depends on the structure of + the type, the size of the message and on what level the + selective and exclusive decodes are specified. + </p> + + <section> + <title>ASN.1 Specifications, Messages and Configuration</title> + <p>The specs <seealso marker="#Asn1spec">GUI</seealso> and + <url href="http://www.itu.int/ITU-T/asn1/database/itu-t/h/h248/2002/MEDIA-GATEWAY-CONTROL.html">MEDIA-GATEWAY-CONTROL</url> + was used in the test. + </p> + <p>For the GUI spec the configuration looked like:</p> + <pre> +{selective_decode, + {'GUI', + [{selected_decode_Window1, + ['Window', + status,buttonList, + [1], + number]}, + {selected_decode_Window2, + ['Window', + status, + actions, + possibleActions, + [1], + handle,number]}]}}. + {exclusive_decode, + {'GUI', + [{decode_Window_status_exclusive, + ['Window', + [{status, + [{buttonList,parts}, + {actions,undecoded}]}]]}]}}. + </pre> + <p>The MEDIA-GATEWAY-CONTROL configuration was:</p> + <pre> +{exclusive_decode, + {'MEDIA-GATEWAY-CONTROL', + [{decode_MegacoMessage_exclusive, + ['MegacoMessage', + [{authHeader,undecoded}, + {mess, + [{mId,undecoded}, + {messageBody,undecoded}]}]]}]}}. +{selective_decode, + {'MEDIA-GATEWAY-CONTROL', + [{decode_MegacoMessage_selective, + ['MegacoMessage',mess,version]}]}}. + </pre> + <p>The corresponding values were:</p> + <pre> +{'Window',{status,{'Status',12, + [{'Button',13,true}, + {'Button',14,false}, + {'Button',15,true}, + {'Button',16,false}, + {'Button',13,true}, + {'Button',14,false}, + {'Button',15,true}, + {'Button',16,false}, + {'Button',13,true}, + {'Button',14,false}, + {'Button',15,true}, + {'Button',16,false}], + true, + {possibleActions, + [{'Action',17,{'Button',18,false}}, + {'Action',19,{'Button',20,true}}, + {'Action',21,{'Button',22,false}}, + {'Action',17,{'Button',18,false}}, + {'Action',19,{'Button',20,true}}, + {'Action',21,{'Button',22,false}}, + {'Action',17,{'Button',18,false}}, + {'Action',19,{'Button',20,true}}, + {'Action',21,{'Button',22,false}}, + {'Action',17,{'Button',18,false}}, + {'Action',19,{'Button',20,true}}, + {'Action',21,{'Button',22,false}}, + {'Action',17,{'Button',18,false}}, + {'Action',19,{'Button',20,true}}, + {'Action',21,{'Button',22,false}}, + {'Action',17,{'Button',18,false}}, + {'Action',19,{'Button',20,true}}, + {'Action',21,{'Button',22,false}}]}}}} + + +{'MegacoMessage',asn1_NOVALUE, + {'Message',1, + {ip4Address, + {'IP4Address',[125,125,125,111],55555}}, + {transactions, + [{transactionReply, + {'TransactionReply',50007,asn1_NOVALUE, + {actionReplies, + [{'ActionReply',0,asn1_NOVALUE,asn1_NOVALUE, + [{auditValueReply,{auditResult,{'AuditResult', + {'TerminationID',[],[255,255,255]}, + [{mediaDescriptor, + {'MediaDescriptor',asn1_NOVALUE, + {multiStream, + [{'StreamDescriptor',1, + {'StreamParms', + {'LocalControlDescriptor', + sendRecv, + asn1_NOVALUE, + asn1_NOVALUE, + [{'PropertyParm', + [0,11,0,7], + [[52,48]], + asn1_NOVALUE}]}, + {'LocalRemoteDescriptor', + [[{'PropertyParm', + [0,0,176,1], + [[48]], + asn1_NOVALUE}, + {'PropertyParm', + [0,0,176,8], + [[73,78,32,73,80,52,32,49,50,53,46,49, + 50,53,46,49,50,53,46,49,49,49]], + asn1_NOVALUE}, + {'PropertyParm', + [0,0,176,15], + [[97,117,100,105,111,32,49,49,49,49,32, + 82,84,80,47,65,86,80,32,32,52]], + asn1_NOVALUE}, + {'PropertyParm', + [0,0,176,12], + [[112,116,105,109,101,58,51,48]], + asn1_NOVALUE}]]}, + {'LocalRemoteDescriptor', + [[{'PropertyParm', + [0,0,176,1], + [[48]], + asn1_NOVALUE}, + {'PropertyParm', + [0,0,176,8], + [[73,78,32,73,80,52,32,49,50,52,46,49,50, + 52,46,49,50,52,46,50,50,50]], + asn1_NOVALUE}, + {'PropertyParm', + [0,0,176,15], + [[97,117,100,105,111,32,50,50,50,50,32,82, + 84,80,47,65,86,80,32,32,52]], + asn1_NOVALUE}, + {'PropertyParm', + [0,0,176,12], + [[112,116,105,109,101,58,51,48]], + asn1_NOVALUE}]]}}}]}}}, + {packagesDescriptor, + [{'PackagesItem',[0,11],1}, + {'PackagesItem',[0,11],1}]}, + {statisticsDescriptor, + [{'StatisticsParameter',[0,12,0,4],[[49,50,48,48]]}, + {'StatisticsParameter',[0,11,0,2],[[54,50,51,48,48]]}, + {'StatisticsParameter',[0,12,0,5],[[55,48,48]]}, + {'StatisticsParameter',[0,11,0,3],[[52,53,49,48,48]]}, + {'StatisticsParameter',[0,12,0,6],[[48,46,50]]}, + {'StatisticsParameter',[0,12,0,7],[[50,48]]}, + {'StatisticsParameter',[0,12,0,8],[[52,48]]}]}]}}}]}]}}}]}}} + </pre> + <p>The size of the encoded values was 458 bytes for GUI and 464 + bytes for MEDIA-GATEWAY-CONTROL. + </p> + </section> + + <section> + <title>Results</title> + <p>The ASN.1 specs in the test are compiled with the options + <c>ber_bin, optimize, driver</c> and <c>asn1config</c>. If the + <c>driver</c> option had been omitted there should have been + higher values for <c>decode</c> and <c>decode_part</c>. + </p> + <p>The test program runs 10000 decodes on the value, resulting + in a printout with the elapsed time in microseconds for the + total number of decodes. + </p> + <table> + <row> + <cell align="left" valign="top"><em>Function</em></cell> + <cell align="left" valign="top"><em>Time</em>(microseconds)</cell> + <cell align="left" valign="top"><em>Kind of Decode</em></cell> + <cell align="left" valign="top"><em>ASN.1 spec</em></cell> + <cell align="left" valign="top"><em>% of time vs. complete decode</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>decode_MegacoMessage_selective/1</c></cell> + <cell align="left" valign="middle"><c>374045</c></cell> + <cell align="left" valign="middle"><c>selective</c></cell> + <cell align="left" valign="middle"><c>MEDIA-GATEWAY-CONTROL</c></cell> + <cell align="left" valign="middle"><em>8.3</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>decode_MegacoMessage_exclusive/1</c></cell> + <cell align="left" valign="middle"><c>621107</c></cell> + <cell align="left" valign="middle"><c>exclusive</c></cell> + <cell align="left" valign="middle"><c>MEDIA-GATEWAY-CONTROL</c></cell> + <cell align="left" valign="middle"><em>13.8</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>decode/2</c></cell> + <cell align="left" valign="middle"><c>4507457</c></cell> + <cell align="left" valign="middle"><c>complete</c></cell> + <cell align="left" valign="middle"><c>MEDIA-GATEWAY-CONTROL</c></cell> + <cell align="left" valign="middle"><em>100</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>selected_decode_Window1/1</c></cell> + <cell align="left" valign="middle"><c>449585</c></cell> + <cell align="left" valign="middle"><c>selective</c></cell> + <cell align="left" valign="middle"><c>GUI</c></cell> + <cell align="left" valign="middle"><em>7.6</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>selected_decode_Window2/1</c></cell> + <cell align="left" valign="middle"><c>890666</c></cell> + <cell align="left" valign="middle"><c>selective</c></cell> + <cell align="left" valign="middle"><c>GUI</c></cell> + <cell align="left" valign="middle"><em>15.1</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>decode_Window_status_exclusive/1</c></cell> + <cell align="left" valign="middle"><c>1251878</c></cell> + <cell align="left" valign="middle"><c>exclusive</c></cell> + <cell align="left" valign="middle"><c>GUI</c></cell> + <cell align="left" valign="middle"><em>21.3</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>decode/2</c></cell> + <cell align="left" valign="middle"><c>5889197</c></cell> + <cell align="left" valign="middle"><c>complete</c></cell> + <cell align="left" valign="middle"><c>GUI</c></cell> + <cell align="left" valign="middle"><em>100</em></cell> + </row> + <tcaption>Results of complete, exclusive and selective decode</tcaption> + </table> + <p>Another interesting question is what the relation is between + a complete decode, an exclusive decode followed by + <c>decode_part</c> of the excluded parts and a selective decode + followed by a complete decode. Some situations may be compared to + this simulation, e.g. inspect a sub-value and later on look at + the entire value. The following table shows figures from this + test. The number of loops and time unit is the same as in the + previous test. + </p> + <table> + <row> + <cell align="left" valign="top"><em>Actions</em></cell> + <cell align="left" valign="top"><em>Function</em> </cell> + <cell align="left" valign="top"><em>Time</em>(microseconds)</cell> + <cell align="left" valign="top"><em>ASN.1 spec</em></cell> + <cell align="left" valign="top"><em>% of time vs. complete decode</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>complete</c></cell> + <cell align="left" valign="middle"><c>decode/2</c></cell> + <cell align="left" valign="middle"><c>4507457</c></cell> + <cell align="left" valign="middle"><c>MEDIA-GATEWAY-CONTROL</c></cell> + <cell align="left" valign="middle"><em>100</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>selective and complete</c></cell> + <cell align="left" valign="middle"><c>decode_­MegacoMessage_­selective/1</c></cell> + <cell align="left" valign="middle"><c>4881502</c></cell> + <cell align="left" valign="middle"><c>MEDIA-GATEWAY-CONTROL</c></cell> + <cell align="left" valign="middle"><em>108.3</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>exclusive and decode_part</c></cell> + <cell align="left" valign="middle"><c>decode_­MegacoMessage_­exclusive/1</c></cell> + <cell align="left" valign="middle"><c>5481034</c></cell> + <cell align="left" valign="middle"><c>MEDIA-GATEWAY-CONTROL</c></cell> + <cell align="left" valign="middle"><em>112.3</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>complete</c></cell> + <cell align="left" valign="middle"><c>decode/2</c></cell> + <cell align="left" valign="middle"><c>5889197</c></cell> + <cell align="left" valign="middle"><c>GUI</c></cell> + <cell align="left" valign="middle"><em>100</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>selective and complete</c></cell> + <cell align="left" valign="middle"><c>selected_­decode_­Window1/1</c></cell> + <cell align="left" valign="middle"><c>6337636</c></cell> + <cell align="left" valign="middle"><c>GUI</c></cell> + <cell align="left" valign="middle"><em>107.6</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>selective and complete</c></cell> + <cell align="left" valign="middle"><c>selected_­decode_­Window2/1</c></cell> + <cell align="left" valign="middle"><c>6795319</c></cell> + <cell align="left" valign="middle"><c>GUI</c></cell> + <cell align="left" valign="middle"><em>115.4</em></cell> + </row> + <row> + <cell align="left" valign="middle"><c>exclusive and decode_part</c></cell> + <cell align="left" valign="middle"><c>decode_­Window_­status_­exclusive/1</c></cell> + <cell align="left" valign="middle"><c>6249200</c></cell> + <cell align="left" valign="middle"><c>GUI</c></cell> + <cell align="left" valign="middle"><em>106.1</em></cell> + </row> + <tcaption>Results of complete, exclusive + decode_part and selective + complete decodes</tcaption> + </table> + <p>Other ASN.1 types and values can differ much from these + figures. Therefore it is important that you, in every case where + you intend to use either of these decodes, perform some tests + that shows if you will benefit your purpose. + </p> + </section> + + <section> + <title>Comments</title> + <p>Generally speaking the gain of selective and exclusive decode + in advance of complete decode is greater the bigger value and the + less deep in the structure you have to decode. One should also + prefer selective decode instead of exclusive decode if you are + interested in just one single sub-value.</p> + <p>Another observation is that the exclusive decode followed by + decode_part decodes is very attractive if the parts will be sent + to different servers for decoding or if one in some cases not is + interested in all parts.</p> + <p>The fastest selective decode are when the decoded type is a + primitive type and not so deep in the structure of the top + type. The <c>selected_decode_Window2</c> decodes a big constructed + value, which explains why this operation is relatively slow.</p> + <p>It may vary from case to case which combination of + selective/complete decode or exclusive/part decode is the fastest.</p> + </section> + </section> +</chapter> + diff --git a/lib/asn1/doc/src/asn1_ug.xml b/lib/asn1/doc/src/asn1_ug.xml new file mode 100644 index 0000000000..f2cd073ec8 --- /dev/null +++ b/lib/asn1/doc/src/asn1_ug.xml @@ -0,0 +1,1981 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>1997</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>Asn1</title> + <prepared>ETX/DN/SP Kenneth. Lundin</prepared> + <docno></docno> + <date>1999-03-25</date> + <rev>D</rev> + <file>asn1_ug.xml</file> + </header> + + <section> + <title>Introduction</title> + + <section> + <title>Features</title> + <p>The Asn1 application provides: + </p> + <list type="bulleted"> + <item>An ASN.1 compiler for Erlang, which generates encode and + decode functions to be used by Erlang programs sending and + receiving ASN.1 specified data.</item> + <item>Run-time functions used by the generated code.</item> + <item>Encoding rules supported are <em>BER</em>, the + specialized BER version <em>DER</em> and the basic form of + aligned and unaligned variants of <em>PER</em>.</item> + </list> + </section> + + <section> + <title>Overview</title> + <p>ASN.1 (Abstract Syntax Notation 1) defines the abstract + syntax of information. The purpose of ASN.1 is to have + a platform independent language to express types using a + standardized set of rules for the transformation of values of + a defined type, into a stream of bytes. This stream of bytes + can then be sent on a communication channel set up by the + lower layers in the stack of communication protocols e.g. + TCP/IP or encapsulated within UDP packets. This way, two + different applications written in two completely different + programming languages running on different computers with + different internal representation of data can exchange + instances of structured data types (instead of exchanging + bytes or bits). This makes programming faster and easier since no code + has to be written to process the transport format of the + data. + </p> + <p>To write a network application which processes ASN.1 encoded + messages, it is prudent and sometimes essential to have a set + of off-line development tools such as an ASN.1 compiler which + can generate the encode and decode logic for the specific ASN.1 + data types. It is also necessary to combine this with some + general language-specific runtime support for ASN.1 encoding and + decoding. + </p> + <p>The ASN.1 compiler must be directed towards a target language + or a set of closely related languages. This manual describes a + compiler which is directed towards the functional language + Erlang. In order to use this compiler, familiarity with the + language Erlang is essential. Therefore, the runtime support for ASN.1 is + also closely related to the language Erlang and + consist of a number of functions, which the + compiler uses. The types in ASN.1 and how to represent + values of those types in Erlang are described in this manual. + </p> + <p>The following document is structured so that the first part describes + how to use ASN.1 compiler, and then there are descriptions of all + the primitive and constructed ASN.1 types and their representation + in Erlang, + </p> + </section> + + <section> + <title>Prerequisites</title> + <p>It is assumed that the reader is familiar with the ASN.1 notation + as documented in the standard definition [<cite id="X.680"></cite>] which is + the primary text. It may also be helpful, but not necessary, + to read the standard definitions + [<cite id="X.681"></cite>] [<cite id="X.682"></cite>] [<cite id="X.683"></cite>] + [<cite id="X.690"></cite>] [<cite id="X.691"></cite>]. </p> + <p>A very good book explaining those reference texts is + [<cite id="DUBUISSON"></cite>], free to download at + <url href="http://www.oss.com/asn1/dubuisson.html">http://www.oss.com/asn1/dubuisson.html </url>. + </p> + <p>Knowledge of Erlang programming is also essential and reading the book + <em>Concurrent Programming in ERLANG</em>, + [<cite id="erlbook2"></cite>], is recommended. Part 1 of this is available on the web in + <url href="http://www.erlang.org/download/erlang-book-part1.pdf">PDF</url> format. + </p> + </section> + + <section> + <title>Capability</title> + <p>This application covers all features of ASN.1 up to the 1997 + edition of the specification. In the 2002 edition some new + extensions came up of which there are support only for some of + them. ECN (Cncoding Control Notation) and XML notation are still + unsupported. Though, the other features of 2002 edition are + fully or partly supported as shown below:</p> + <list type="bulleted"> + <item> + <p>Decimal notation (e.g., "1.5e3") for REAL values. The + NR1, NR2 and NR3 formats as explained in ISO6093 are + supported.</p> + </item> + <item> + <p>The RELATIVE-OID type for relative object identifiers are + fully supported.</p> + </item> + <item> + <p>The subtype constraint (CONTAINING/ENCODED BY) to + constrain the content of an octet string or a bit string is + parsed when compiling, but no further action is taken. This + constraint is not a PER-visible constraint.</p> + </item> + <item> + <p>The subtype constraint by regular expressions (PATTERN) for character string types is parsed when compiling, but no further action is taken. This constraint is not a PER-visible constraint.</p> + </item> + <item> + <p>Multiple-line comments as in C, <c>/* ... */</c>, are + supported.</p> + </item> + </list> + <p>It should also be added here that the encoding formats + supported are <em>BER</em>, <em>DER</em>, <em>PER aligned + basic</em> variant and <em>PER unaligned basic</em> variant.</p> + </section> + + </section> + + <section> + <title>Getting Started with Asn1</title> + + <section> + <title>A First Example</title> + <p>The following example demonstrates the basic functionality used to run + the Erlang ASN.1 compiler.</p> + <p>First, create a file called <c>People.asn</c> containing the following:</p> + <pre> +People DEFINITIONS IMPLICIT TAGS ::= + +BEGIN +EXPORTS Person; + +Person ::= [PRIVATE 19] SEQUENCE { + name PrintableString, + location INTEGER {home(0),field(1),roving(2)}, + age INTEGER OPTIONAL } +END </pre> + <p>This file (<c>people.asn</c>) must be compiled before it can be + used. + The ASN.1 compiler checks that the syntax is correct and that the + text represents proper ASN.1 code before generating an abstract + syntax tree. The code-generator then uses the abstract syntax + tree in order to generate code. + </p> + <p>The generated Erlang files will be placed in the current directory or + in the directory specified with the <c>{outdir,Dir}</c> option. + The following shows how the compiler + can be called from the Erlang shell:</p> + <pre> +1><input>asn1ct:compile("People",[ber_bin]).</input> +Erlang ASN.1 compiling "People.asn" +--{generated,"People.asn1db"}-- +--{generated,"People.hrl"}-- +--{generated,"People.erl"}-- +ok +2> </pre> + <p>The ASN.1 module People is now accepted and the abstract syntax tree + is saved in the <c>People.asn1db</c> file, the + generated Erlang code is compiled using the Erlang compiler and + loaded into the Erlang runtime system. Now there is a user interface + of encode/2 and decode/2 in the module People, which is invoked by: + <br></br> +<c><![CDATA['People':encode(<Type name>,<Value>),]]></c> <br></br> + + or <br></br> +<c><![CDATA['People':decode(<Type name>,<Value>),]]></c> <br></br> + + Alternatively one can use the <c><![CDATA[asn1rt:encode(<Module name> ,<Type name>,<Value>)]]></c> and <c><![CDATA[asn1rt:decode(< Module name>,<Type name>,<Value>)]]></c> calls. + However, they are not as efficient as the previous methods since they + result in an additional <c>apply/3</c> call.</p> + <p>Assume there is a network + application which receives instances of the ASN.1 defined + type Person, modifies and sends them back again:</p> + <code type="none"> +receive + {Port,{data,Bytes}} -> + case 'People':decode('Person',Bytes) of + {ok,P} -> + {ok,Answer} = 'People':encode('Person',mk_answer(P)), + Port ! {self(),{command,Answer}}; + {error,Reason} -> + exit({error,Reason}) + end + end, </code> + <p>In the example above, a series of bytes is received from an + external source and the bytes are then decoded into a valid + Erlang term. This was achieved with the call + <c>'People':decode('Person',Bytes)</c> which returned + an Erlang value of the ASN.1 type <c>Person</c>. Then an answer was + constructed and encoded using + <c>'People':encode('Person',Answer)</c> which takes an + instance of a defined ASN.1 type and transforms it to a + (possibly) nested list of bytes according to the BER or PER + encoding-rules. + <br></br> +The encoder and the decoder can also be run from + the shell. The following dialogue with the shell illustrates + how the functions + <c>asn1rt:encode/3</c> and <c>asn1rt:decode/3</c> are used.</p> + <pre> +2> <input>Rockstar = {'Person',"Some Name",roving,50}.</input> +{'Person',"Some Name",roving,50} +3> <input>{ok,Bytes} = asn1rt:encode('People','Person',Rockstar).</input> +{ok,[<<243>>, + [17], + [19,9,"Some Name"], + [2,1,[2]], + [2,1,"2"]]} +4> <input>Bin = list_to_binary(Bytes).</input> +<<243,17,19,9,83,111,109,101,32,78,97,109,101,2,1,2,2,1,50>> +5> <input>{ok,Person} = asn1rt:decode('People','Person',Bin).</input> +{ok,{'Person',"Some Name",roving,50}} +6> </pre> + <p>Notice that the result from <c>encode</c> is a nested list which + must be turned into a binary before the call to <c>decode</c>. A + binary is necessary as input to decode since the module was compiled + with the <c>ber_bin</c> option + The reason for returning a nested list is that it is faster to produce + and the <c>list_to_binary</c> operation is + performed automatically when the list is sent via the Erlang port mechanism.</p> + </section> + + <section> + <title>Module dependencies</title> + <p>It is common that asn1 modules import defined types, values and + other entities from another asn1 module.</p> + <p>Earlier versions of the asn1 compiler required that modules that + were imported from had to be compiled before the module that + imported. This caused problems when asn1 modules had circular + dependencies.</p> + <p>Now are referenced modules parsed when the compiler finds an + entity that is imported. There will not be any code generated for + the referenced module. However, the compiled module rely on + that the referenced modules also will be compiled.</p> + </section> + </section> + + <section> + <title>The Asn1 Application User Interface</title> + <p>The Asn1 application provides two separate user interfaces:</p> + <list type="bulleted"> + <item> + <p>The module <c>asn1ct</c> which provides the compile-time functions + (including the compiler).</p> + </item> + <item> + <p>The module <c>asn1rt</c> which provides the run-time functions. + However, it is preferable to use the generated <c>encode/2</c> and + <c>decode/2</c> functions in each module, ie. + Module:encode(Type,Value), in favor of the <c>asn1rt</c> + interface.</p> + </item> + </list> + <p>The reason for the division of the interface into compile-time + and run-time + is that only run-time modules (<c>asn1rt*</c>) need to be loaded in + an embedded system. + </p> + + <section> + <title>Compile-time Functions</title> + <p>The ASN.1 compiler can be invoked directly from the command-line + by means of the <c>erlc</c> program. This is convenient when compiling + many ASN.1 files from the command-line or when using Makefiles. + Here are some examples of how the <c>erlc</c> command can be used to invoke the + ASN.1 compiler:</p> + <pre> +erlc Person.asn +erlc -bper_bin Person.asn +erlc -bber_bin +optimize ../Example.asn +erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn </pre> + <p>The useful options for the ASN.1 compiler are:</p> + <taglist> + <tag><c>-b[ber | per | ber_bin | per_bin | uper_bin]</c></tag> + <item> + <p>Choice of encoding rules, if omitted <c>ber</c> is the + default. The <c>ber_bin</c> and <c>per_bin</c> options + allows for optimizations and are therefore recommended + instaed of the <c>ber</c> and <c>per</c> options.</p> + </item> + <tag><c>-o OutDirectory</c></tag> + <item> + <p>Where to put the generated files, default is the current + directory.</p> + </item> + <tag><c>-I IncludeDir</c></tag> + <item> + <p>Where to search for <c>.asn1db</c> files and asn1 + source specs in order to resolve references to other + modules. This option can be repeated many times if there + are several places to search in. The compiler will always + search the current directory first.</p> + </item> + <tag><c>+compact_bit_string</c></tag> + <item> + <p>Gives the user the option to use a compact format of the BIT + STRING type to save memory space, typing space and + increase encode/decode performance, for details see + <seealso marker="#BIT STRING">BIT STRING </seealso>type section.</p> + </item> + <tag><c>+der</c></tag> + <item> + <p>DER encoding rule. Only when using <c>-ber</c> or + <c>-ber_bin</c> option.</p> + </item> + <tag><c>+optimize</c></tag> + <item> + <p>This flag has effect only when used together with one of + <c>per_bin</c> or <c>ber_bin</c> flags. It gives time optimized + code in the generated modules and it uses another runtime module. + In the <c>per_bin</c> case a linked-in driver is used. The + result from an encode is a binary.</p> + <p><em>When this flag is used you cannot use the old format</em><c>{TypeName,Value}</c> when you encode values. Since it is + an unnecessary construct it has been removed in favor of + performance. It + is neither admitted to construct SEQUENCE or SET component values + with the format <c>{ComponentName,Value}</c> since it also is + unnecessary. The only case were it is necessary is in a CHOICE, + were you have to pass values to the right component by specifying + <c>{ComponentName,Value}</c>. See also about + <seealso marker="#TypeNameValue">{Typename,Value}</seealso> below + and in the sections for each type.</p> + </item> + <tag><c>+driver</c></tag> + <item> + <p>Together with the flags <c>ber_bin</c> and <c>optimize</c> + you choose to use a linked in driver for considerable faster + decode.</p> + </item> + <tag><c>+asn1config</c></tag> + <item> + <p>This functionality works together with the flags + <c>ber_bin</c> and <c>optimize</c>. You enables the + specialized decodes, see the <seealso marker="asn1_spec">Specialized Decode</seealso> chapter. + </p> + </item> + <tag><c>+undec_rest</c></tag> + <item> + <p>A buffer that holds a message, being decoded may + also have some following bytes. Now it is possible to get + those following bytes returned together with the decoded + value. If an asn1 spec is compiled with this option a tuple + <c>{ok,Value,Rest}</c> is returned. <c>Rest</c> may be a + list or a binary. Earlier versions of the compiler ignored + those following bytes.</p> + </item> + <tag><c>{inline,OutputName}</c></tag> + <item> + <p>Compiling with this option gives one output module + containing all asn1 run-time functionality. The asn1 specs + are provided in a target module <c>Module.set.asn</c> as + described in the <seealso marker="asn1ct#asn1set">reference manual</seealso>. The name of the resulting module + containing generated encode/decode functions and inlined + run-time functions will be <c>OutputName.erl</c>. The + merging/inlining of code is done by the <c>igor</c> module + of <c>syntax_tools</c>. By default the functions generated + from the first asn1 spec in the <c>.set.asn</c> are + exported, unless a <c>{export,[atom()]}</c> or + <c>{export_all,true}</c> option are provided. The list of + atoms are names of choosen asn1 specs from the + <c>.set.asn</c> file. See further examples of usage <seealso marker="#inlineExamples">below</seealso></p> + </item> + <tag><c>+'Any Erlc Option'</c></tag> + <item> + <p>You may add any option to the Erlang compiler when + compiling the generated Erlang files. Any option + unrecognised by the asn1 compiler will be passed to the + Erlang compiler.</p> + </item> + </taglist> + <p>For a complete description of <c>erlc</c> see Erts Reference Manual.</p> + <p>For preferred option use see <seealso marker="#preferred option use">Preferred Option Use</seealso> section.</p> + <p>The compiler and other compile-time functions can also be invoked from + the Erlang shell. Below follows a brief + description of the primary functions, for a + complete description of each function see + <seealso marker="asn1ct">the Asn1 Reference Manual</seealso>, the + <c>asn1ct</c> module.</p> + <p>The compiler is invoked by using <c>asn1ct:compile/1</c> with + default options, or <c>asn1ct:compile/2</c> if explicit options + are given. + Example:</p> + <pre> +asn1ct:compile("H323-MESSAGES.asn1"). </pre> + <p>which equals:</p> + <pre> +asn1ct:compile("H323-MESSAGES.asn1",[ber]). </pre> + <p>If one wants PER encoding with optimizations:</p> + <pre> +asn1ct:compile("H323-MESSAGES.asn1",[per_bin,optimize]). </pre> + <p>The generic encode and decode functions can be invoked like this:</p> + <pre> +asn1ct:encode('H323-MESSAGES','SomeChoiceType',{call,"octetstring"}). +asn1ct:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> + <p>Or, preferable like:</p> + <pre> +'H323-MESSAGES':encode('SomeChoiceType',{call,"octetstring"}). +'H323-MESSAGES':decode('SomeChoiceType',Bytes). </pre> + </section> + + <section> + <marker id="preferred option use"></marker> + <title>Preferred Option Use</title> + <p> + It may not be obvious which compile options best fit a + situation. This section describes the format of the result of + encode and decode. It also gives some performance statistics + when using certain options. Finally there is a recommendation + which option combinations should be used. + </p> + <p> + The default option is <c>ber</c>. It is the same backend as + <c>ber_bin</c> except that the result of encode is transformed + to a flat list. Below is a table that gives the different + formats of input and output of encode and decode using the + <em>allowed combinations</em> of coding and optimization + options: (EAVF stands for how ASN1 values are represented in + Erlang which is described in the <seealso + marker="#ASN1Types">ASN1 Types chapter</seealso>) + </p> + <table> + <row> + <cell align="left" valign="middle"><em>Encoding Rule</em></cell> + <cell align="left" valign="middle"><em>Compile options, allowed combinations</em></cell> + <cell align="left" valign="middle"><em>encode input</em></cell> + <cell align="left" valign="middle"><em>encode output</em></cell> + <cell align="left" valign="middle"><em>decode input</em></cell> + <cell align="left" valign="middle"><em>decode output</em></cell> + </row> + <row> + <cell align="left" valign="middle">BER</cell> + <cell align="left" valign="middle">[ber] (default)</cell> + <cell align="left" valign="middle">EAVF</cell> + <cell align="left" valign="middle">flat list</cell> + <cell align="left" valign="middle">flat list / binary</cell> + <cell align="left" valign="middle">EAVF</cell> + </row> + <row> + <cell align="left" valign="middle">BER</cell> + <cell align="left" valign="middle">[ber_bin]</cell> + <cell align="left" valign="middle">EAVF</cell> + <cell align="left" valign="middle">iolist</cell> + <cell align="left" valign="middle">binary</cell> + <cell align="left" valign="middle">EAVF</cell> + </row> + <row> + <cell align="left" valign="middle">BER</cell> + <cell align="left" valign="middle"><em>[ber_bin, optimize]</em></cell> + <cell align="left" valign="middle">EAVF</cell> + <cell align="left" valign="middle">iolist</cell> + <cell align="left" valign="middle">binary</cell> + <cell align="left" valign="middle">EAVF</cell> + </row> + <row> + <cell align="left" valign="middle">BER</cell> + <cell align="left" valign="middle"><em>[ber_bin, optimize, driver]</em></cell> + <cell align="left" valign="middle">EAVF</cell> + <cell align="left" valign="middle">iolist</cell> + <cell align="left" valign="middle">iolist / binary</cell> + <cell align="left" valign="middle">EAVF</cell> + </row> + <row> + <cell align="left" valign="middle">PER aligned variant</cell> + <cell align="left" valign="middle">[per]</cell> + <cell align="left" valign="middle">EAVF</cell> + <cell align="left" valign="middle">flat list</cell> + <cell align="left" valign="middle">flat list</cell> + <cell align="left" valign="middle">EAVF</cell> + </row> + <row> + <cell align="left" valign="middle">PER aligned variant</cell> + <cell align="left" valign="middle"><em>[per_bin]</em></cell> + <cell align="left" valign="middle">EAVF</cell> + <cell align="left" valign="middle">iolist / binary</cell> + <cell align="left" valign="middle">binary</cell> + <cell align="left" valign="middle">EAVF</cell> + </row> + <row> + <cell align="left" valign="middle">PER aligned variant</cell> + <cell align="left" valign="middle"><em>[per_bin, optimize]</em></cell> + <cell align="left" valign="middle">EAVF</cell> + <cell align="left" valign="middle">binary</cell> + <cell align="left" valign="middle">binary</cell> + <cell align="left" valign="middle">EAVF</cell> + </row> + <row> + <cell align="left" valign="middle">PER unaligned variant</cell> + <cell align="left" valign="middle"><em>[uper_bin]</em></cell> + <cell align="left" valign="middle">EAVF</cell> + <cell align="left" valign="middle">binary</cell> + <cell align="left" valign="middle">binary</cell> + <cell align="left" valign="middle">EAVF</cell> + </row> + + <row> + <cell align="left" valign="middle">DER</cell> + <cell align="left" valign="middle">[(ber), der]</cell> + <cell align="left" valign="middle">EAVF</cell> + <cell align="left" valign="middle">flat list</cell> + <cell align="left" valign="middle">flat list / binary</cell> + <cell align="left" valign="middle">EAVF</cell> + </row> + <row> + <cell align="left" valign="middle">DER</cell> + <cell align="left" valign="middle">[ber_bin, der]</cell> + <cell align="left" valign="middle">EAVF</cell> + <cell align="left" valign="middle">iolist</cell> + <cell align="left" valign="middle">binary</cell> + <cell align="left" valign="middle">EAVF</cell> + </row> + <row> + <cell align="left" valign="middle">DER</cell> + <cell align="left" valign="middle"><em>[ber_bin, optimize, der]</em></cell> + <cell align="left" valign="middle">EAVF</cell> + <cell align="left" valign="middle">iolist</cell> + <cell align="left" valign="middle">binary</cell> + <cell align="left" valign="middle">EAVF</cell> + </row> + <row> + <cell align="left" valign="middle">DER</cell> + <cell align="left" valign="middle"><em>[ber_bin, optimize, driver, der]</em></cell> + <cell align="left" valign="middle">EAVF</cell> + <cell align="left" valign="middle">iolist</cell> + <cell align="left" valign="middle">binary</cell> + <cell align="left" valign="middle">EAVF</cell> + </row> + + + <tcaption>The output / input formats for different combinations of compile options.</tcaption> + </table> + <p> + Encode / decode speed comparison in one user case for the above + alternatives (except <c>DER</c>) is showed in the table below. The + <c>DER</c> alternatives are slower than their corresponding + <c>BER</c> alternative. + </p> + + <table> + <row> + <cell align="left" valign="middle"><em>compile options</em></cell> + <cell align="left" valign="middle"><em>encode time</em></cell> + <cell align="left" valign="middle"><em>decode time</em></cell> + </row> + <row> + <cell align="left" valign="middle">[ber]</cell> + <cell align="left" valign="middle">120</cell> + <cell align="left" valign="middle">162</cell> + </row> + <row> + <cell align="left" valign="middle">[ber_bin]</cell> + <cell align="left" valign="middle">124</cell> + <cell align="left" valign="middle">154</cell> + </row> + <row> + <cell align="left" valign="middle"><em>[ber_bin, optimize]</em></cell> + <cell align="left" valign="middle">50</cell> + <cell align="left" valign="middle">78</cell> + </row> + <row> + <cell align="left" valign="middle"><em>[ber_bin, optimize, driver]</em></cell> + <cell align="left" valign="middle">50</cell> + <cell align="left" valign="middle">62</cell> + </row> + <row> + <cell align="left" valign="middle">[per]</cell> + <cell align="left" valign="middle">141</cell> + <cell align="left" valign="middle">133</cell> + </row> + <row> + <cell align="left" valign="middle"><em>[per_bin]</em></cell> + <cell align="left" valign="middle">125</cell> + <cell align="left" valign="middle">123</cell> + </row> + <row> + <cell align="left" valign="middle"><em>[per_bin, optimize]</em></cell> + <cell align="left" valign="middle">77</cell> + <cell align="left" valign="middle">72</cell> + </row> + <row> + <cell align="left" valign="middle"><em>[uper_bin]</em></cell> + <cell align="left" valign="middle">97</cell> + <cell align="left" valign="middle">104</cell> + </row> + <tcaption> + One example of difference in speed for the compile option alternatives. + </tcaption> + </table> + + <p> + The sole compile options <c>ber</c>, <c>ber_bin</c> and <c>per</c> + are kept for backwards compatibility and should not be used in + new code. + </p> + <p> + You are strongly recommended to use the appropriate alternative + of the bold typed options. The <c>optimize</c> and + <c>driver</c> options does not affect the encode or decode + result, just the time spent in run-time. When <c>ber_bin</c> and + <c>driver</c> or <c>per_bin, optimize</c> and <c>driver</c> is + combined the C-code driver is used in choosen parts of encode / + decode procedure. + </p> + <table> + <row> + <cell align="left" valign="middle"><em>Compile options, allowed combinations</em></cell> + <cell align="left" valign="middle"><em>use of linked-in driver</em></cell> + </row> + <row> + <cell align="left" valign="middle">[ber]</cell> + <cell align="left" valign="middle">no</cell> + </row> + <row> + <cell align="left" valign="middle">[ber_bin]</cell> + <cell align="left" valign="middle">no</cell> + </row> + <row> + <cell align="left" valign="middle"><em>[ber_bin, optimize]</em></cell> + <cell align="left" valign="middle">no</cell> + </row> + <row> + <cell align="left" valign="middle"><em>[ber_bin, optimize, driver]</em></cell> + <cell align="left" valign="middle">yes</cell> + </row> + <row> + <cell align="left" valign="middle">[per]</cell> + <cell align="left" valign="middle">no</cell> + </row> + <row> + <cell align="left" valign="middle"><em>[per_bin]</em></cell> + <cell align="left" valign="middle">no</cell> + </row> + <row> + <cell align="left" valign="middle"><em>[per_bin, optimize]</em></cell> + <cell align="left" valign="middle">yes</cell> + </row> + <row> + <cell align="left" valign="middle"><em>[uper_bin]</em></cell> + <cell align="left" valign="middle">no</cell> + </row> + + <row> + <cell align="left" valign="middle">[(ber), der]</cell> + <cell align="left" valign="middle">no</cell> + </row> + <row> + <cell align="left" valign="middle">[ber_bin, der]</cell> + <cell align="left" valign="middle">no</cell> + </row> + <row> + <cell align="left" valign="middle"><em>[ber_bin, optimize, der]</em></cell> + <cell align="left" valign="middle">no</cell> + </row> + <row> + <cell align="left" valign="middle"><em>[ber_bin, optimize, driver, der]</em></cell> + <cell align="left" valign="middle">yes</cell> + </row> + + + <tcaption>When the ASN1 linked-in driver is used.</tcaption> + </table> + + </section> + <section> + <title>Run-time Functions</title> + <p>A brief description of the major functions is given here. For a + complete description of each function see + <seealso marker="asn1rt"> the Asn1 Reference Manual</seealso>, the <c>asn1rt</c> module.</p> + <p>The generic run-time encode and decode functions can be invoked as below:</p> + <pre> +asn1rt:encode('H323-MESSAGES','SomeChoiceType',{call,"octetstring"}). +asn1rt:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> + <p>Or, preferable like:</p> + <pre> +'H323-MESSAGES':encode('SomeChoiceType',{call,"octetstring"}). +'H323-MESSAGES':decode('SomeChoiceType',Bytes). </pre> + <p>The asn1 linked-in driver is enabled in two occasions: encoding of + asn1 values when the asn1 spec is compiled with <c>per_bin</c> and + <c>optimize</c> or decode of encoded asn1 values when the asn1 spec is + compiled with <c>ber_bin</c>, <c>optimize</c> and <c>driver</c>. In + those cases the driver will be loaded automatically at the first call + to <c>encode</c>/<c>decode</c>. If one doesn't want the performance + overhead of the driver being loaded at the first call it is possible + to load the driver separately by <c>asn1rt:load_driver()</c>. </p> + <p>By invoking the function <c>info/0</c> in a generated module, one + gets information about which compiler options were used.</p> + </section> + + <section> + <title>Errors</title> + <p>Errors detected at + compile time appear on the screen together with + a line number indicating where in the source file the error + was detected. If no errors are found, an Erlang ASN.1 module will + be created as default.</p> + <p>The run-time encoders and decoders (in the <c>asn1rt</c> module) do + execute within a catch and returns <c>{ok, Data}</c> or + <c>{error, {asn1, Description}}</c> where + <c>Description</c> is + an Erlang term describing the error. </p> + </section> + </section> + + <section> + <marker id="inlineExamples"></marker> + <title>Multi File Compilation</title> + <p>There are various reasons for using a multi file compilation:</p> + <list type="bulleted"> + <item>You want to choose name for the generated module by + any reason. Maybe you need to compile the same specs for + different encoding/decoding standards.</item> + <item>You want only one resulting module.</item> + <item>If it is crucial to have a minimal system. Using + <c>{inline,OutputModule}</c> includes all necessary run-time + functions of the asn1 application, but skips those modules not + used.</item> + <item>Upgrading issues: Even if you upgrade your Erlang system + you may want to continue running the old asn1 run-time + functionality.</item> + <item>Performance issues: If you have an asn1 system with a lot + of cross references you may gain in performance. Meassurements + must be done for each case.</item> + </list> + <p>You may choose either the plain multi file compilation that just + merges the choosen asn1 specs or the <c>{inline,OutputModule}</c> + that also includes the used asn1 run-time functionality.</p> + <p>For both cases you need to specify which asn1 specs you will + compile in a module that must have the extension + <c>.set.asn</c>. You chose name of the module and provide the + names of the asn1 specs. For instance, if you have the specs + <c>File1.asn</c>, <c>File2.asn</c> and <c>File3.asn</c> your + module <c>MyModule.set.asn</c> will look like:</p> + <pre> +File1.asn +File2.asn +File3.asn </pre> + <p>If you compile with:</p> + <code type="none"> +~> erlc MyModule.set.asn </code> + <p>the result will be one merged module <c>MyModule.erl</c> with + the generated code from the three asn1 specs. But if you compile + with:</p> + <code type="none"> +~> erlc +"{inline,'OutputModule'}" MyModule.set.asn </code> + <p>the result will be a module <c>OutputModule.erl</c> that + contains all encode/decode functions for the three asn1 specs and + all used functions from the asn1 run-time modules, in this case + <c>asn1rt_ber_bin</c>. In the former case all encode/decode + functions are exported but in the latter only the encode/decode + functions of the first spec in the <c>.set.asn</c>, i.e. those + from <c>File1.asn</c>. + </p> + </section> + + <section> + <marker id="ASN1Types"></marker> + <title>The ASN.1 Types</title> + <p>This section describes the ASN.1 types including their + functionality, purpose and how values are assigned in Erlang. + </p> + <p>ASN.1 has both primitive and constructed types:</p> + <p></p> + <table> + <row> + <cell align="left" valign="middle"><em>Primitive types</em></cell> + <cell align="left" valign="middle"><em>Constructed types</em></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#BOOLEAN">BOOLEAN</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#SEQUENCE">SEQUENCE</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#INTEGER">INTEGER</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#SET">SET</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#REAL">REAL</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#CHOICE">CHOICE</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#NULL">NULL</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#SOF">SET OF and SEQUENCE OF</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#ENUMERATED">ENUMERATED</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#ANY">ANY</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#BIT STRING">BIT STRING</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#ANY">ANY DEFINED BY</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#OCTET STRING">OCTET STRING</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#NegotiationTypes">EXTERNAL</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#Character Strings">Character Strings</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#NegotiationTypes">EMBEDDED PDV</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#OBJECT IDENTIFIER">OBJECT IDENTIFIER</seealso></cell> + <cell align="left" valign="middle"><seealso marker="#NegotiationTypes">CHARACTER STRING</seealso></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#Object Descriptor">Object Descriptor</seealso></cell> + <cell align="left" valign="middle"></cell> + </row> + <row> + <cell align="left" valign="middle"><seealso marker="#The TIME types">The TIME types</seealso></cell> + <cell align="left" valign="middle"></cell> + </row> + <tcaption>The supported ASN.1 types</tcaption> + </table> + <marker id="TypeNameValue"></marker> + <note> + <p>Values of each ASN.1 type has its own representation in Erlang + described in the following subsections. Users shall provide + these values for encoding according to the representation, as + in the example below.</p> + </note> + <pre> +Operational ::= BOOLEAN --ASN.1 definition </pre> + <p>In Erlang code it may look like:</p> + <pre> +Val = true, +{ok,Bytes}=asn1rt:encode(MyModule,'Operational',Val), </pre> + <p>For historical reasons it is also possible to assign ASN.1 values + in Erlang using a tuple notation + with type and value as this</p> + <pre> +Val = {'Operational',true} </pre> + <warning> + <marker id="warning"></marker> + <p>The tuple notation, <c>{Typename, Value}</c> is only kept + because of backward compatibility and may be withdrawn in a + future release. If the notation is used the <c>Typename</c> + element must be spelled correctly, otherwise a run-time error + will occur. + </p> + <p>If the ASN.1 module is compiled with the flags + <c>per_bin</c> or <c>ber_bin</c> and <c>optimize</c> it is not + allowed to use the tuple notation. That possibility has been + removed due to performance reasons. Neither is it allowed to + use the <c>{ComponentName,Value}</c> notation in case of a + SEQUENCE or SET type.</p> + </warning> + <p>Below follows a description of how + values of each type can be represented in Erlang. + </p> + + <section> + <marker id="BOOLEAN"></marker> + <title>BOOLEAN</title> + <p>Booleans in ASN.1 express values that can be either + TRUE or FALSE. + The meanings assigned to TRUE or FALSE is beyond the scope + of this text. <br></br> + + In ASN.1 it is possible to have:</p> + <pre> +Operational ::= BOOLEAN + </pre> + <p>Assigning a value to the type Operational in Erlang is possible by + using the following Erlang code:</p> + <code type="erl"> +Myvar1 = true, + </code> + <p>Thus, in Erlang the atoms <c>true</c> and <c>false</c> are used + to encode a boolean value.</p> + </section> + + <section> + <marker id="INTEGER"></marker> + <title>INTEGER</title> + <p>ASN.1 itself specifies indefinitely large integers, and the Erlang + systems with versions 4.3 and higher, support very large + integers, in practice indefinitely large integers.</p> + <p>The concept of sub-typing can be applied to integers as well + as to other ASN.1 types. The details of sub-typing are not + explained here, for further info see [<cite id="X.680"></cite>]. A variety + of syntaxes are allowed when defining a type as an integer:</p> + <pre> +T1 ::= INTEGER +T2 ::= INTEGER (-2..7) +T3 ::= INTEGER (0..MAX) +T4 ::= INTEGER (0<..MAX) +T5 ::= INTEGER (MIN<..-99) +T6 ::= INTEGER {red(0),blue(1),white(2)} + </pre> + <p>The Erlang representation of an ASN.1 INTEGER is an integer or + an atom if a so called \011<c>Named NumberList</c> (see T6 above) + is specified.</p> + <p>Below is an example of Erlang code which assigns values for the + above types: </p> + <pre> +T1value = 0, +T2value = 6, +T6value1 = blue, +T6value2 = 0, +T6value3 = white + </pre> + <p>The Erlang variables above are now bound to valid instances of + ASN.1 defined types. This style of value can be passed directly + to the encoder for transformation into a series of bytes.</p> + <p>The decoder will return an atom if the value corresponds to a + symbol in the Named NumberList.</p> + </section> + + <section> + <marker id="REAL"></marker> + <title>REAL</title> + <p>In this version reals are not implemented. When they are, + the following + ASN.1 type is used:</p> + <pre> +R1 ::= REAL + </pre> + <p>Can be assigned a value in Erlang as:</p> + <pre> +R1value1 = 2.14, +R1value2 = {256,10,-2}, + </pre> + <p>In the last line note that the tuple {256,10,-2} is the real number + 2.56 in a special notation, which will encode faster than simply + stating the number as 2.56. The arity three tuple is + <c>{Mantissa,Base,Exponent}</c> i.e. Mantissa * Base^Exponent.</p> + </section> + + <section> + <marker id="NULL"></marker> + <title>NULL</title> + <p>Null is suitable in cases where supply and recognition of a value + is important but the actual value is not.</p> + <pre> +Notype ::= NULL + </pre> + <p>The NULL type can be assigned in Erlang:</p> + <pre> +N1 = 'NULL', + </pre> + <p>The actual value is the quoted atom 'NULL'.</p> + </section> + + <section> + <marker id="ENUMERATED"></marker> + <title>ENUMERATED</title> + <p>The enumerated type can be used, when the value we wish to + describe, may only take one of a set of predefined values.</p> + <pre> +DaysOfTheWeek ::= ENUMERATED { sunday(1),monday(2),tuesday(3), +\011wednesday(4),thursday(5),friday(6),saturday(7) } + </pre> + <p>For example to assign a weekday value in Erlang use the same atom + as in the <c>Enumerations</c> of the type definition:</p> + <pre> +Day1 = saturday, + </pre> + <p>The enumerated type is very similar to an integer type, when + defined with a set of predefined values. An enumerated type + differs from an integer in that it may only have specified + values, whereas an integer can also have any other value.</p> + </section> + + <section> + <marker id="BIT STRING"></marker> + <title>BIT STRING </title> + <p>The BIT STRING type can be used to model information which + is made up of arbitrary length series of bits. It is intended + to be used for a selection of flags, not for binary files. <br></br> + + In ASN.1 BIT STRING definitions may look like: + </p> + <pre> +Bits1 ::= BIT STRING +Bits2 ::= BIT STRING {foo(0),bar(1),gnu(2),gnome(3),punk(14)} + </pre> + <p>There are four different notations available for representation of + BIT STRING values in Erlang and as input to the encode functions.</p> + <list type="ordered"> + <item>A list of binary digits (0 or 1).</item> + <item>A hexadecimal number (or an integer). This format should be + avoided, since it is easy to misinterpret a <c>BIT STRING</c> + value in this format. This format may be withdrawn in a future + release.</item> + <item>A list of atoms corresponding to atoms in the <c>NamedBitList</c> + in the BIT STRING definition.</item> + <item>As <c>{Unused,Binary}</c> where <c>Unused</c> denotes how + many trailing zero-bits 0 to 7 that are unused in the least + significant byte in <c>Binary</c>. This notation is only + available when the ASN.1 files have been compiled with the + <em>+compact_bit_string</em> flag in the option list. In + this case it is possible to use all kinds of notation when + encoding. But the result when decoding is always in the + compact form. The benefit from this notation is a more + compact notation when one has large BIT STRINGs. The + encode/decode performance is also much better in the case of + large BIT STRINGs. </item> + </list> + <note> + <p>Note that it is advised not to use the integer format of a + BIT STRING, see the second point above.</p> + </note> + <pre> +Bits1Val1 = [0,1,0,1,1], +Bits1Val2 = 16#1A, +Bits1Val3 = {3,<<0:1,1:1,0:1,1:1,1:1,0:3>>} + </pre> + <p>Note that <c>Bits1Val1</c>, <c>Bits1Val2</c> and <c>Bits1Val3</c> + denote the same value.</p> + <pre> +Bits2Val1 = [gnu,punk], +Bits2Val2 = 2#1110, +Bits2Val3 = [bar,gnu,gnome], +Bits2Val4 = [0,1,1,1] + </pre> + <p>The above <c>Bits2Val2</c>, <c>Bits2Val3</c> and <c>Bits2Val4</c> + also all denote the same value.</p> + <p><c>Bits2Val1</c> is assigned symbolic values. The assignment means + that the bits corresponding to <c>gnu</c> and <c>punk</c> i.e. bits + 2 and 14 are set to 1 and the rest set to 0. The symbolic values + appear as a list of values. If a named value appears, which is not + specified in the type definition, a run-time error will occur.</p> + <p>The compact notation equivalent to the empty BIT STRING is + <c><![CDATA[{0,<<>>}]]></c>, which in the other notations is <c>[]</c> or + <c>0</c>.</p> + <p>BIT STRINGS may also be sub-typed with for example a SIZE + specification:</p> + <pre> +Bits3 ::= BIT STRING (SIZE(0..31)) </pre> + <p>This means that no bit higher than 31 can ever be set.</p> + </section> + + <section> + <marker id="OCTET STRING"></marker> + <title>OCTET STRING</title> + <p>The OCTET STRING is the simplest of all ASN.1 types The OCTET STRING + only moves or transfers e.g. binary files or other unstructured + information complying to two rules. + Firstly, the bytes consist of octets and secondly, encoding is + not required.</p> + <p>It is possible to have the following ASN.1 type definitions:</p> + <pre> +O1 ::= OCTET STRING +O2 ::= OCTET STRING (SIZE(28)) </pre> + <p>With the following example assignments in Erlang:</p> + <pre> +O1Val = [17,13,19,20,0,0,255,254], +O2Val = "must be exactly 28 chars....", </pre> + <p>Observe that <c>O1Val</c> is assigned a series of numbers between 0 + and 255 i.e. octets. + <c>O2Val</c> is assigned using the string notation. + </p> + </section> + + <section> + <marker id="Character Strings"></marker> + <title>Character Strings</title> + <p>ASN.1 supports a wide variety of character sets. The main difference + between OCTET STRINGS and the Character strings is that OCTET + STRINGS have no imposed semantics on the bytes delivered.</p> + <p>However, when using for instance the IA5String (which closely + resembles ASCII) the byte 65 (in decimal + notation) <em>means</em> the character 'A'. + </p> + <p>For example, if a defined type is to be a VideotexString and + an octet is received with the unsigned integer value X, then + the octet should be interpreted as specified in the standard + ITU-T T.100,T.101. + </p> + <p>The ASN.1 to Erlang compiler + will not determine the correct interpretation of each BER + (Basic Encoding Rules) string octet value with different + Character strings. Interpretation of octets is the + responsibility of the application. Therefore, from the BER + string point of view, octets appear to be very similar to + character strings and are compiled in the same way. + </p> + <p>It should be noted that when PER (Packed Encoding Rules) is + used, there is a significant difference in the encoding scheme + between OCTET STRINGS and other strings. The constraints + specified for a type are especially important for PER, where + they affect the encoding. + </p> + <p>Please note that <em>all</em> the Character strings are + supported and it is possible to use the following ASN.1 type + definitions:</p> + <pre> +Digs ::= NumericString (SIZE(1..3)) +TextFile ::= IA5String (SIZE(0..64000)) </pre> + <p>and the following Erlang assignments:</p> + <pre> +DigsVal1 = "456", +DigsVal2 = "123", +TextFileVal1 = "abc...xyz...", +TextFileVal2 = [88,76,55,44,99,121 .......... a lot of characters here ....] </pre> + <p>The Erlang representation for "BMPString" and + "UniversalString" is either a list of ASCII values or a list + of quadruples. The quadruple representation associates to the + Unicode standard representation of characters. The ASCII + characters are all represented by quadruples beginning with + three zeros like {0,0,0,65} for the 'A' character. When + decoding a value for these strings the result is a list of + quadruples, or integers when the value is an ASCII character. + The following example shows how it works:</p> + <p>In a file <c>PrimStrings.asn1</c> the type <c>BMP</c> is defined as + <br></br> +<c>BMP ::= BMPString</c> then using BER encoding (<c>ber_bin</c> + option)the input/output format will be:</p> + <pre> +1> <input>{ok,Bytes1} = asn1rt:encode('PrimStrings','BMP',[{0,0,53,53},{0,0,45,56}]).</input> +{ok,[30,4,"55-8"]} +2> <input>asn1rt:decode('PrimStrings','BMP',list_to_binary(Bytes1)).</input> +{ok,[{0,0,53,53},{0,0,45,56}]} +3> <input>{ok,Bytes2} = asn1rt:encode('PrimStrings','BMP',[{0,0,53,53},{0,0,0,65}]).</input> +{ok,[30,4,[53,53,0,65]]} +4> <input>asn1rt:decode('PrimStrings','BMP',list_to_binary(Bytes2)).</input> +{ok,[{0,0,53,53},65]} +5> <input>{ok,Bytes3} = asn1rt:encode('PrimStrings','BMP',"BMP string").</input> +{ok,[30,20,[0,66,0,77,0,80,0,32,0,115,0,116,0,114,0,105,0,110,0,103]]} +6> <input>asn1rt:decode('PrimStrings','BMP',list_to_binary(Bytes3)).</input> +{ok,"BMP string"} </pre> + <p>The UTF8String is represented in Erlang as a list of integers, + where each integer represents the unicode value of one + character. When a value shall be encoded one first has to + transform it to a UTF8 encoded binary, then it can be encoded by + asn1. When decoding the result is a UTF8 encoded binary, which + may be transformed to an integer list. The transformation + functions, <c>utf8_binary_to_list</c> and + <c>utf8_list_to_binary</c>, are in the <c>asn1rt</c> module. In + the example below we assume an asn1 definition <c>UTF ::= UTF8String</c> in a module <c>UTF.asn</c>:</p> + <pre> +1> <input>asn1ct:compile('UTF',[ber_bin]).</input> +Erlang ASN.1 version "1.4.3.3" compiling "UTF.asn" +Compiler Options: [ber_bin] +--{generated,"UTF.asn1db"}-- +--{generated,"UTF.erl"}-- +ok +2> <input>UTF8Val1 = "hello".</input> +"hello" +3> <input>{ok,UTF8bin1} = asn1rt:utf8_list_to_binary(UTF8Val1).</input> +{ok,<<104,101,108,108,111>>} +4> <input>{ok,B}='UTF':encode('UTF',UTF8bin1).</input> +{ok,[12, + 5, + <<104,101,108,108,111>>]} +5> <input>Bin = list_to_binary(B).</input> +<<12,5,104,101,108,108,111>> +6> <input>{ok,UTF8bin1}='UTF':decode('UTF',Bin).</input> +{ok,<<104,101,108,108,111>>} +7> <input>asn1rt:utf8_binary_to_list(UTF8bin1).</input> +{ok,"hello"} +8> <input>UTF8Val2 = [16#00,16#100,16#ffff,16#ffffff].</input> +[0,256,65535,16777215] +9> <input>{ok,UTF8bin2} = asn1rt:utf8_list_to_binary(UTF8Val2).</input> +{ok,<<0,196,128,239,191,191,248,191,191,191,191>>} +10> <input>{ok,B2} = 'UTF':encode('UTF',UTF8bin2).</input> +{ok,[12, + 11, + <<0,196,128,239,191,191,248,191,191,191,191>>]} +11> <input>Bin2 = list_to_binary(B2).</input> +<<12,11,0,196,128,239,191,191,248,191,191,191,191>> +12> <input>{ok,UTF8bin2} = 'UTF':decode('UTF',Bin2).</input> +{ok,<<0,196,128,239,191,191,248,191,191,191,191>>} +13> <input>asn1rt:utf8_binary_to_list(UTF8bin2).</input> +{ok,[0,256,65535,16777215]} +14> </pre> + </section> + + <section> + <marker id="OBJECT IDENTIFIER"></marker> + <title>OBJECT IDENTIFIER</title> + <p>The OBJECT IDENTIFIER is used whenever a unique identity is required. + An ASN.1 module, a transfer syntax, etc. is identified with an + OBJECT IDENTIFIER. Assume the example below:</p> + <pre> +Oid ::= OBJECT IDENTIFIER + </pre> + <p>Therefore, the example below is a valid Erlang instance of the + type 'Oid'.</p> + <pre> +OidVal1 = {1,2,55}, + </pre> + <p>The OBJECT IDENTIFIER value is simply a tuple with the + consecutive values which must be integers. + </p> + <p>The first value is limited to the values 0, 1 or 2 and the + second value must be in the range 0..39 when the first value + is 0 or 1. + </p> + <p>The OBJECT IDENTIFIER is a very important type and it is + widely used within different standards to uniquely identify + various objects. In [<cite id="DUBUISSON"></cite>], there is an + easy-to-understand description of the usage of + OBJECT IDENTIFIER.</p> + <p></p> + </section> + + <section> + <marker id="Object Descriptor"></marker> + <title>Object Descriptor</title> + <p>Values of this type can be assigned a value as an ordinary string i.e. <br></br> + + "This is the value of an Object descriptor"</p> + </section> + + <section> + <marker id="The TIME types"></marker> + <title>The TIME Types</title> + <p>Two different time types are defined within ASN.1, Generalized + Time and UTC (Universal Time Coordinated), both are assigned a + value as an ordinary string within double quotes i.e. + "19820102070533.8".</p> + <p>In case of DER encoding the compiler does not check the validity + of the time values. The DER requirements upon those strings is + regarded as a matter for the application to fulfill.</p> + </section> + + <section> + <marker id="SEQUENCE"></marker> + <title>SEQUENCE</title> + <p>The structured types of ASN.1 are constructed from other types + in a manner similar to the concepts of array and struct in C. + <br></br> + A SEQUENCE in ASN.1 is + comparable with a struct in C and a record in Erlang. + A SEQUENCE may be defined as:</p> + <pre> +Pdu ::= SEQUENCE { + a INTEGER, + b REAL, + c OBJECT IDENTIFIER, + d NULL } </pre> + <p>This is a 4-component structure called 'Pdu'. The major format + for representation of SEQUENCE in Erlang is the record format. + For each SEQUENCE and <c>SET</c> in an ASN.1 module an Erlang + record declaration is generated. For <c>Pdu</c> above, a record + like this is defined:</p> + <pre> +-record('Pdu',{a, b, c, d}). </pre> + <p>The record declarations for a module <c>M</c> are placed in a + separate <c>M.hrl</c> file.</p> + <p>Values can be assigned in Erlang as shown below:</p> + <pre> +MyPdu = #'Pdu'{a=22,b=77.99,c={0,1,2,3,4},d='NULL'}. </pre> + <p>It is also possible to specify the value for each component in + a SEQUENCE or a SET as <c>{ComponentName,Value}</c>. It is not + recommended and is not supported if the flags <c>per_bin</c> or + <c>ber_bin</c> and <c>optimize</c> were used when the module was + compiled.</p> + <p>The decode functions will return a record as result when decoding + a <c>SEQUENCE</c> or a <c>SET</c>. + <marker id="DEFAULT"></marker> +</p> + <p>A <c>SEQUENCE</c> and a <c>SET</c> may contain a component with a + <c>DEFAULT</c> key word followed by the actual value that is the + default value. In case of BER encoding it is optional to encode the + value if it equals the default value. If the application uses the + atom asn1_DEFAULT as value or if the value is a primitive value + that equals the default value the encoding omits the bytes for + this value, which is more efficient and it results in fever + bytes to send to the receiving application.</p> + <p>For instance, if the following types exists in a file "File.asn":</p> + <pre> +Seq1 ::= SEQUENCE { +\011a INTEGER DEFAULT 1, +\011b Seq2 DEFAULT {aa TRUE, bb 15} +} + +Seq2 ::= SEQUENCE { +\011aa BOOLEAN, +\011bb INTEGER +} + </pre> + <p>Some values and the corresponding encoding in an Erlang terminal + is shown below:</p> + <pre> +1> <input>asn1ct:compile('File').</input> +Erlang ASN.1 version "1.3.2" compiling "File.asn1" +Compiler Options: [] +--{generated,"File.asn1db"}-- +--{generated,"File.hrl"}-- +--{generated,"File.erl"}-- +ok +2> <input>'File':encode('Seq1',{'Seq1',asn1_DEFAULT,asn1_DEFAULT}).</input> +{ok,["0",[0],[[],[]]]} +3> <input>lists:flatten(["0",[0],[[],[]]]).</input> +[48,0] +4> <input>'File':encode('Seq1',{'Seq1',1,{'Seq2',true,15}}).</input> +{ok,["0","\\b",[[],["\\241",[6],[[[128],[1],"\\377"],[[129],[1],[15]]]]]]} +5> <input>lists:flatten(["0","\\b",[[],["\\241",[6],[[[128],[1],"\\377"],[[129],[1],[15]]]]]]).</input> +[48,8,161,6,128,1,255,129,1,15] +6> </pre> + <p>The result after command line 3, in the example above,shows that the + encoder omits the encoding of default values when they are specific + by asn1_DEFAULT. Line 5 shows that even primitive values that equals + the default value are detected and not encoded. But the constructed + value of component <c>b</c> in <c>Seq1</c> is not recognized as the + default value. Checking of default values in <c>BER</c> is not done + in case of complex values, because it would be to expensive. + <marker id="DEFAULT DER"></marker> +</p> + <p>But, the DER encoding format has stronger requirements regarding + default\011values both for SET and SEQUENCE. A more elaborate and time + expensive check of default values will take place. The following is + an example with the same types and values as above but with der + encoding format.</p> + <pre> +1> <input>asn1ct:compile('File',[der]).</input> +Erlang ASN.1 version "1.3.2" compiling "File.asn1" +Compiler Options: [der] +--{generated,"File.asn1db"}-- +--{generated,"File.hrl"}-- +--{generated,"File.erl"}-- +ok +2> <input>'File':encode('Seq1',{'Seq1',asn1_DEFAULT,asn1_DEFAULT}).</input> +{ok,["0",[0],[[],[]]]} +3> <input>lists:flatten(["0",[0],[[],[]]]).</input> +[48,0] +4> <input>'File':encode('Seq1',{'Seq1',1,{'Seq2',true,15}}).</input> +{ok,["0",[0],[[],[]]]} +5> <input>lists:flatten(["0",[0],[[],[]]]).</input> +[48,0] +6> + </pre> + <p>Line 5 shows that even values of constructed types is checked and if + it equals the default value it will not be encoded.</p> + </section> + + <section> + <marker id="SET"></marker> + <title>SET</title> + <p>The SET type is an unusual construct and normally the SEQUENCE + type is more appropriate to use. Set is also inefficient compared with SEQUENCE, as the components can be in any order. Hence, it must be possible + to distinguish every component in 'SET', both when + encoding and decoding a value of a type defined to be a SET. + The tags of all components must be different from each other + in order to be easily recognizable.</p> + <p>A SET may be defined as:</p> + <pre> +Pdu2 ::= SET { + a INTEGER, + b BOOLEAN, + c ENUMERATED {on(0),off(1)} } </pre> + <p>A SET is represented as an Erlang record. + For each SEQUENCE and <c>SET</c> in + an ASN.1 module an Erlang record declaration is generated. For + <c>Pdu2</c> above a record is defined like this:</p> + <pre> +-record('Pdu2',{a, b, c}). </pre> + <p>The record declarations for a module <c>M</c> are placed in a + separate <c>M.hrl</c> file.</p> + <p>Values can be assigned in Erlang as demonstrated below:</p> + <pre> +V = #'Pdu2'{a=44,b=false,c=off}. </pre> + <p>The decode functions will return a record as result when decoding + a SET. + </p> + <p>The difference between SET and SEQUENCE is that the order of + the components (in the BER encoded format) is undefined for SET + and defined as the lexical order from the ASN.1 definition for + SEQUENCE. The ASN.1 compiler for Erlang will always encode a + SET in the lexical order. The decode routines can handle SET + components encoded in any order but will always return the + result as a record. Since all components of the SET must be + distinguishable both in the encoding phase as well as the + decoding phase the following type is not allowed in a module + with EXPLICIT or IMPLICIT as tag-default :</p> + <p></p> + <pre> +Bad ::= SET {i INTEGER, + j INTEGER } </pre> + <p>The ASN.1 to Erlang compiler rejects the above type. We + shall not explain the concept of tag further here, we refer to + [<cite id="X.680"></cite>]. + </p> + <p>Encoding of a SET with components with DEFAULT values behaves + similar as a SEQUENCE, <seealso marker="#DEFAULT">see above</seealso>. The DER encoding format restrictions on DEFAULT + values is the same for SET as for SEQUENCE, and is supported by + the compiler, <seealso marker="#DEFAULT DER">see above</seealso>.</p> + <p>Moreover, in DER the elements of a SET will be sorted. If a + component is an untagged choice the sorting have to take place + in run-time. This fact emphasizes the following recommendation + if DER encoding format is used.</p> + <p>The concept of SET is an unusual + construct and one cannot think of one single application + where the set type is essential. (Imagine if someone + "invented'' the shuffled array in 'C') People tend to think + that 'SET' sounds nicer and more mathematical than 'SEQUENCE' + and hence use it when 'SEQUENCE' would have been more + appropriate. It is also most inefficient, since every correct + implementation of SET must always be prepared to accept the + components in any order. So, if possible use SEQUENCE instead + of SET.</p> + </section> + + <section> + <title>Notes about Extendability for SEQUENCE and SET</title> + <p>When a SEQUENCE or SET contains an extension marker and + extension components like this:</p> + <pre> +SExt ::= SEQUENCE { + a INTEGER, + ..., + b BOOLEAN } + </pre> + <p>It means that the type may get more components in newer + versions of the ASN.1 spec. In this case it has got a new + component <c>b</c>. Thus, incoming messages that will be decoded + may have more or fever components than this one. + </p> + <p>The component <c>b</c> will be treated as + an original component when encoding a message. In this case, as + it is not an optional element, it must be encoded. + </p> + <p>During decoding the <c>b</c> field of the record will get the decoded + value of the <c>b</c> + component if present and otherwise the value <c>asn1_NOVALUE</c>.</p> + </section> + + <section> + <marker id="CHOICE"></marker> + <title>CHOICE</title> + <p>The CHOICE type is a space saver and is similar to the concept of a + 'union' in the C-language. As with the previous SET-type, the + tags of all components of a CHOICE need to be distinct. If + AUTOMATIC TAGS are defined for the module (which is + preferable) the tags can be omitted completely in the ASN.1 + specification of a CHOICE. + </p> + <p>Assume:</p> + <pre> +T ::= CHOICE { + x [0] REAL, + y [1] INTEGER, + z [2] OBJECT IDENTIFIER } + </pre> + <p>It is then possible to assign values:</p> + <pre> +TVal1 = {y,17}, +TVal2 = {z,{0,1,2}}, + </pre> + <p>A CHOICE value is always represented as the tuple + <c>{ChoiceAlternative, Val}</c> where <c>ChoiceAlternative</c> + is an atom denoting the selected choice + alternative. + </p> + <p>It is also allowed to have a CHOICE type tagged as follow:</p> + <p></p> + <pre> +C ::= [PRIVATE 111] CHOICE { + C1, + C2 } + +C1 ::= CHOICE { + a [0] INTEGER, + b [1] BOOLEAN } + +C2 ::= CHOICE { + c [2] INTEGER, + d [3] OCTET STRING } </pre> + <p>In this case, the top type C appears to have no tags at all in + its components, however, both C1 and C2 are also defined as + CHOICE types and they have distinct tags among themselves. + Hence, the above type C is both legal and allowed. + </p> + + <section> + <title>Extendable CHOICE</title> + <p>When a CHOICE contains an extension marker and the decoder detects + an unknown alternative of the CHIOCE the value is represented as:</p> + <pre> +\011 {asn1_ExtAlt, BytesForOpenType} + </pre> + <p>Where <c>BytesForOpenType</c> is a list of bytes constituting the + encoding of the "unknown" CHOICE alternative. </p> + </section> + </section> + + <section> + <marker id="SOF"></marker> + <title>SET OF and SEQUENCE OF</title> + <p>The SET OF and SEQUENCE OF types correspond to the concept of an array + found in several programming languages. The Erlang syntax for + both of these types is straight forward. For example:</p> + <pre> +Arr1 ::= SET SIZE (5) OF INTEGER (4..9) +Arr2 ::= SEQUENCE OF OCTET STRING </pre> + <p>We may have the following in Erlang:</p> + <pre> +Arr1Val = [4,5,6,7,8], +Arr2Val = ["abc",[14,34,54],"Octets"], </pre> + <p>Please note that the definition of the SET OF type implies that + the order of the components is undefined, but in practice there is + no difference between SET OF and SEQUENCE OF. The ASN.1 compiler + for Erlang does not randomize the order of the SET OF components + before encoding.</p> + <p>However, in case of a value of the type <c>SET OF</c>, the DER + encoding format requires the elements to be sent in ascending + order of their encoding, which implies an expensive sorting + procedure in run-time. Therefore it is strongly recommended to + use <c>SEQUENCE OF</c> instead of <c>SET OF</c> if it is possible.</p> + </section> + + <section> + <marker id="ANY"></marker> + <title>ANY and ANY DEFINED BY</title> + <p>The types <c>ANY</c> and <c>ANY DEFINED BY</c> have been removed + from the standard since 1994. It is recommended not to use + these types any more. They may, however, exist in some old ASN.1 + modules. + The idea with this type was to leave a "hole" in a definition where + one could put unspecified data of any kind, even non ASN.1 data.</p> + <p>A value of this type is encoded as an <c>open type</c>.</p> + <p>Instead of <c>ANY</c>/<c>ANY DEFINED BY</c> one should use + <c>information object class</c>, <c>table constraints</c> and + <c>parameterization</c>. In particular the construct + <c>TYPE-IDENTIFIER.@Type</c> accomplish the same as the + deprecated <c>ANY</c>.</p> + <p>See also <seealso marker="#Information Object">Information object</seealso></p> + </section> + + <section> + <marker id="NegotiationTypes"></marker> + <title>EXTERNAL, EMBEDDED PDV and CHARACTER STRING</title> + <p>These types are used in presentation layer negotiation. They are + encoded according to their associated type, see [<cite id="X.680"></cite>].</p> + <p>The <c>EXTERNAL</c> type had a slightly different associated type + before 1994. [<cite id="X.691"></cite>] states that encoding shall follow + the older associate type. Therefore does generated encode/decode + functions convert values of the newer format to the older format + before encoding. This implies that it is allowed to use + <c>EXTERNAL</c> type values of either format for encoding. Decoded + values are always returned on the newer format.</p> + </section> + + <section> + <title>Embedded Named Types</title> + <p>The structured types previously described may very well have other named types + as their components. The general syntax to assign a value to the component C + of a named ASN.1 type T in Erlang is the record syntax + <c>#'T'{'C'=Value}</c>. + Where <c>Value</c> may be a value of yet another type T2.</p> + <p>For example:</p> + <pre> +B ::= SEQUENCE { + a Arr1, + b [0] T } + +Arr1 ::= SET SIZE (5) OF INTEGER (4..9) + +T ::= CHOICE { + x [0] REAL, + y [1] INTEGER, + z [2] OBJECT IDENTIFIER } </pre> + <p>The above example can be assigned like this in Erlang:</p> + <pre> +V2 = #'B'{a=[4,5,6,7,8], b={x,7.77}}. + </pre> + </section> + </section> + + <section> + <title>Naming of Records in .hrl Files</title> + <p>When an asn1 specification is compiled all defined types of + type SET or SEQUENCE will result in a corresponding record in the + generated hrl file. This is because the values for SET/SEQUENCE + as mentioned in sections above are represented as records.</p> + <p>Though there are some special cases of this functionality that + are presented below.</p> + + <section> + <title>Embedded Structured Types</title> + <p>It is also possible in ASN.1 to have components that are themselves + structured types. + For example, it is possible to have:</p> + <pre> +Emb ::= SEQUENCE { + a SEQUENCE OF OCTET STRING, + b SET { + a [0] INTEGER, + b [1] INTEGER DEFAULT 66}, + c CHOICE { + a INTEGER, + b FooType } } + +FooType ::= [3] VisibleString </pre> + <p>The following records are generated because of the type <c>Emb</c>:</p> + <pre> +-record('Emb,{a, b, c}). +-record('Emb_b',{a, b = asn1_DEFAULT}). % the embedded SET type + </pre> + <p>Values of the <c>Emb</c> type can be assigned like this:</p> + <code type="none"> +V = #'Emb'{a=["qqqq",[1,2,255]], + b = #'Emb_b'{a=99}, + c ={b,"Can you see this"}}. + </code> + <p>For an embedded type of type SEQUENCE/SET in a SEQUENCE/SET + the record name is extended with an underscore and the component + name. If the embedded structure is deeper with SEQUENCE, SET or + CHOICE types in the line, each component-/alternative-name will + be added to the recordname.</p> + <p>For example:</p> + <pre> +Seq ::= SEQUENCE{ + a\011CHOICE{ +\011b SEQUENCE { +\011 c INTEGER +\011 } +\011} +} </pre> + <p>will result in the following record:</p> + <pre> +-record('Seq_a_b',{c}). </pre> + <p>If the structured type has a component with an embedded + SEQUENCE OF/SET OF which embedded type in turn is a + SEQUENCE/SET it will give a record with the SEQOF/SETOF + addition as in the following example:</p> + <pre> +Seq ::= SEQUENCE { + a SEQUENCE OF SEQUENCE { +\011 b + } + c SET OF SEQUENCE { +\011 d + } +} </pre> + <p>This results in the records:</p> + <pre> +-record('Seq_a_SEQOF'{b}). +-record('Seq_c_SETOF'{d}). </pre> + <p>A parameterized type should be considered as an embedded + type. Each time a such type is referenced an instance of it is + defined. Thus in the following example a record with name + <c>'Seq_b'</c> is generated in the .hrl file and used to hold + values.</p> + <pre> +Seq ::= SEQUENCE { + b PType{INTEGER} +} + +PType{T} ::= SEQUENCE{ + id T +} </pre> + </section> + + <section> + <title>Recursive Types</title> + <p>Types may refer to themselves. Suppose:</p> + <pre> +Rec ::= CHOICE { + nothing [0] NULL, + something SEQUENCE { + a INTEGER, + b OCTET STRING, + c Rec }} </pre> + <p>This type is recursive; that is, it refers to itself. This is allowed + in ASN.1 and the ASN.1-to-Erlang compiler supports this recursive + type. A value for this type is assigned in Erlang as shown below:</p> + <pre> +V = {something,#'Rec_something'{a = 77, + b = "some octets here", + c = {nothing,'NULL'}}}. </pre> + </section> + </section> + + <section> + <title>ASN.1 Values</title> + <p>Values can be assigned to ASN.1 type within the ASN.1 code + itself, as opposed to the actions taken in the previous chapter where + a value was assigned to an ASN.1 type in Erlang. The full value + syntax of ASN.1 is supported and [X.680] describes in detail how + to assign values in ASN.1. Below is a short example:</p> + <pre> +TT ::= SEQUENCE { + a INTEGER, + b SET OF OCTET STRING } + +tt TT ::= {a 77,b {"kalle","kula"}} </pre> + <p>The value defined here could be used in several ways. + Firstly, it could be used as the value in some DEFAULT component:</p> + <pre> +SS ::= SET { + s [0] OBJECT IDENTIFIER, + val TT DEFAULT tt } </pre> + <p>It could also be used from inside an Erlang program. If the above ASN.1 + code was defined in ASN.1 module <c>Values</c>, then the ASN.1 value + <c>tt</c> can be reached from Erlang as + a function call to <c>'Values':tt()</c> as in the example below.</p> + <pre> +1> <input>Val = 'Values':tt().</input> +{'TT',77,["kalle","kula"]} +2> <input>{ok,Bytes} = 'Values':encode('TT',Val).</input> +{ok,["0", + [18], + [[[128],[1],"M"],["\\241","\\r",[[[4],[5],"kalle"],[[4],[4],"kula"]]]]]} +3> <input>FlatBytes = lists:flatten(Bytes).</input> +[48,18,128,1,77,161,13,4,5,107,97,108,108,101,4,4,107,117,108,97] +4> <input>'Values':decode('TT',FlatBytes).</input> +{ok,{'TT',77,["kalle","kula"]}} +5> + </pre> + <p>The above example shows that a function is generated by the compiler + that returns a valid Erlang representation of the value, even though + the value is of a complex type.</p> + <p>Furthermore, there is a macro generated for each value in the .hrl + file. So, the defined value <c>tt</c> can also be extracted by + <c>?tt</c> in application code.</p> + </section> + + <section> + <title>Macros</title> + <p>MACRO is not supported as the the type is no longer part of the + ASN.1 standard.</p> + </section> + + <section> + <marker id="Information Object"></marker> + <title>ASN.1 Information Objects (X.681)</title> + <p>Information Object Classes, Information Objects and Information + Object Sets, (in the following called classes, objects and + object sets respectively), are defined in the standard + definition [<cite id="X.681"></cite>]. In the following only a brief + explanation is given. </p> + <p>These constructs makes it possible to define open types, + i.e. values of that type can be of any ASN.1 type. It is also + possible to define relationships between different types and + values, since classes can hold types, values, objects, object + sets and other classes in its fields. + An Information Object Class may be defined in ASN.1 as:</p> + <pre> +GENERAL-PROCEDURE ::= CLASS { + &Message, + &Reply OPTIONAL, + &Error OPTIONAL, + &id PrintableString UNIQUE +} +WITH SYNTAX { + NEW MESSAGE &Message + [REPLY &Reply] + [ERROR &Error] + ADDRESS &id +} </pre> + <p>An object is an instance of a class and an object set is a set + containing objects of one specified class. A definition may look like + below.</p> + <p>The object <c>object1</c> is an instance of the CLASS + GENERAL-PROCEDURE and has one type field and one fixed type value + field. The object <c>object2</c> also has an OPTIONAL field ERROR, + which is a type field.</p> + <pre> +object1 GENERAL-PROCEDURE ::= { + NEW MESSAGE PrintableString + ADDRESS "home" +} + +object2 GENERAL-PROCEDURE ::= { + NEW MESSAGE INTEGER + ERROR INTEGER + ADDRESS "remote" +} </pre> + <p>The field ADDRESS is a UNIQUE field. Objects in an object set must + have unique values in their UNIQUE field, as in GENERAL-PROCEDURES: </p> + <pre> +GENERAL-PROCEDURES GENERAL-PROCEDURE ::= { + object1 | object2} </pre> + <p>One can not encode a class, object or object set, only referring to + it when defining other ASN.1 entities. Typically one refers to a + class and to object sets by table constraints and component + relation constraints [<cite id="X.682"></cite>] in ASN.1 types, as in: </p> + <pre> +StartMessage ::= SEQUENCE { + msgId GENERAL-PROCEDURE.&id ({GENERAL-PROCEDURES}), + content GENERAL-PROCEDURE.&Message\011({GENERAL-PROCEDURES}{@msgId}), + } </pre> + <p>In the type <c>StartMessage</c> the constraint following the + <c>content</c> field tells that in a value of type + <c>StartMessage</c> the value in the <c>content</c> field must + come from the same object that is choosen by the <c>msgId</c> + field.</p> + <p>So, the value <c>#'StartMessage'{msgId="home",content="Any Printable String"}</c> is legal to encode as a StartMessage + value, while the value <c>#'StartMessage'{msgId="remote", content="Some String"}</c> is illegal since the constraint + in StartMessage tells that when you have choosen a value from a + specific object in the object set GENERAL-PROCEDURES in the + msgId field you have to choose a value from that same object in + the content field too. In this second case it should have been + any INTEGER value.</p> + <p><c>StartMessage</c> can in the <c>content</c> field be + encoded with a value of any type that an object in the + <c>GENERAL-PROCEDURES</c> object set has in its <c>NEW MESSAGE</c> field. This field refers to a type field + <c><![CDATA[&Message]]></c> in the class. The <c>msgId</c> field is always + encoded as a PrintableString, since the field refers to a fixed type + in the class.</p> + </section> + + <section> + <title>Parameterization (X.683)</title> + <p>Parameterization, which is defined in the standard [<cite id="X.683"></cite>], can be used when defining types, values, value + sets, information object classes, information objects or + information object sets. + A part of a definition can be supplied as a parameter. For + instance, if a Type is used in a definition with certain + purpose, one want the typename to express the intention. This + can be done with parameterization.</p> + <p>When many types (or an other ASN.1 entity) only differs in some + minor cases, but the structure of the types are similar, only + one general type can be defined and the differences may be supplied + through parameters. </p> + <p>One example of use of parameterization is:</p> + <pre> +General{Type} ::= SEQUENCE +{ + number INTEGER, + string Type +} + +T1 ::= General{PrintableString} + +T2 ::= General{BIT STRING} + </pre> + <p>An example of a value that can be encoded as type T1 is {12,"hello"}.</p> + <p>Observe that the compiler not generates encode/decode functions for + parameterized types, only for the instances of the parameterized + types. So, if a file contains the types General{}, T1 and T2 above, + encode/decode functions will only be generated for T1 and T2. + </p> + </section> + + <section> + <title>Tags</title> + <p>Every built-in ASN.1 type, except CHOICE and ANY have a universal tag. + This is a unique number that clearly identifies the type. <br></br> + + It is essential for all users of ASN.1 to + understand all the details about tags.</p> + <p>Tags are implicitly encoded in the BER encoding as shown below, but + are hardly not accounted for in the PER encoding. In PER tags are + used for instance to sort the components of a SET.</p> + <p>There are four different types of tags.</p> + <taglist> + <tag><em>universal</em></tag> + <item> + <p>For types whose meaning is the same in all + applications. Such as integers, sequences and so on; that is, all the built in + types.</p> + </item> + <tag><em>application</em></tag> + <item> + <p>For application specific types for example, the types in + X.400 Message handling service have this sort of tag.</p> + </item> + <tag><em>private</em></tag> + <item> + <p>For your own private types.</p> + </item> + <tag><em>context</em></tag> + <item> + <p>This is used to distinguish otherwise indistinguishable + types in a specific context. For example, if we have two + components of a + CHOICE type that are both <c>INTEGER</c> values, there is no + way for the decoder to + decipher which component was actually chosen, since both + components will be + tagged as <c>INTEGER</c>. When this or similar situations occur, + one or both of the components should be given a context specific + to resolve the ambiguity.</p> + </item> + </taglist> + <p>The tag in the case of the 'Apdu' type [PRIVATE 1] is encoded to a + sequence of bytes making it possible for a + decoder to look at the (initial) bytes that arrive and determine + whether the rest of the bytes must be of the type associated + with that particular sequence of bytes. This means that each + tag must be uniquely associated with <em>only</em> one ASN.1 + type. + </p> + <p>Immediately following the tag is a sequence of bytes + informing the decoder of the length of the instance. This is + sometimes referred to as TLV (Tag length value) encoding. + Hence, the structure of a BER encoded series of bytes is as shown in the table below.</p> + <p></p> + <table> + <row> + <cell align="left" valign="middle">Tag</cell> + <cell align="left" valign="middle">Len</cell> + <cell align="left" valign="middle">Value</cell> + </row> + <tcaption>Structure of a BER encoded series of bytes</tcaption> + </table> + </section> + + <section> + <title>Encoding Rules</title> + <p>When the first recommendation on ASN.1 was released 1988 it was + accompanied with the Basic Encoding Rules, BER, as the only + alternative for encoding. + BER is a somewhat verbose protocol. It adopts a so-called TLV (type, + length, value) approach to encoding in which every element of the + encoding carries some type information, some length information and + then the value of that element. Where the element is itself + structured, then the Value part of the element is itself a series of + embedded TLV components, to whatever depth is necessary. In summary, + BER is not a compact encoding but is relatively fast and easy to + produce.</p> + <p>The DER (Distinguished Encoding Rule) encoding format was included in + the standard in 1994. It is a specialized form of BER, which gives + the encoder the option to encode some entities differently. For + instance, is the value for TRUE any octet with any bit set to one. But, + DER does not leave any such choices. The value for TRUE in the DER + case is encoded as the octet <c>11111111</c>. So, the same value + encoded by two different DER encoders must result in the same bit + stream.</p> + <p>A more compact encoding is achieved with the Packed Encoding + Rules PER which was introduced together with the revised + recommendation in 1994. PER takes a rather different approach from + that taken by BER. The first difference is that the tag part in + the TLV is omitted from the encodings, and any tags in the + notation are not encoded. The potential ambiguities are resolved + as follows:</p> + <list type="bulleted"> + <item> + <p>A CHOICE is encoded by first encoding a choice index which + identifies the chosen + alternative by its position in the notation.</p> + </item> + <item> + <p>The elements of a SEQUENCE are transmitted in textual + order. OPTIONAL or DEFAULT elements are preceded by a bit map + to identify which elements are present. After sorting the + elements of a SET in the "canonical tag order" as defined in + X.680 8.6 they are treated as a SEQUENCE regarding OPTIONAL + and DEFAULT elements. A SET is transferred in the sorted + order.</p> + </item> + </list> + <p>A second difference is that PER takes full account of the sub-typing + information in that the encoded bytes are affected by the constraints. + The BER encoded bytes are unaffected by the constraints. + PER uses the sub-typing information to for example omit length fields + whenever possible. </p> + <p>The run-time functions, sometimes take the constraints into account + both for BER and PER. For instance are SIZE constrained strings checked.</p> + <p>There are two variants of PER, <em>aligned</em> and <em>unaligned</em>. + In summary, PER results in compact encodings which require much more + computation to produce than BER. + </p> + </section> +</chapter> + diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml new file mode 100644 index 0000000000..9c04956e86 --- /dev/null +++ b/lib/asn1/doc/src/asn1ct.xml @@ -0,0 +1,379 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>1997</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>asn1ct</title> + <prepared>Kenneth Lundin</prepared> + <responsible>Kenneth Lundin</responsible> + <docno>1</docno> + <approved>Kenneth Lundin</approved> + <checked></checked> + <date>97-10-14</date> + <rev>A</rev> + <file>asn1.sgml</file> + </header> + <module>asn1ct</module> + <modulesummary>ASN.1 compiler and compile-time support functions</modulesummary> + <description> + <p>The ASN.1 compiler takes an ASN.1 module as input and generates a + corresponding Erlang module which can encode and decode the data-types + specified. Alternatively the compiler takes a specification module + (se below) specifying all input modules and generates one module with + encode/decode functions. There are also some generic functions which + can be used in during development of applications which handles ASN.1 + data (encoded as BER or PER).</p> + </description> + <funcs> + <func> + <name>compile(Asn1module) -> ok | {error,Reason}</name> + <name>compile(Asn1module , Options) -> ok | {error,Reason}</name> + <fsummary>Compile an ASN.1 module and generate encode/decode functions according to the encoding rules BER or PER.</fsummary> + <type> + <v>Asn1module = atom() | string()</v> + <v>Options = [Option| OldOption]</v> + <v>Option = ber_bin | per_bin | uper_bin | der | compact_bit_string | + noobj | {n2n,EnumTypeName} |{outdir,Dir} | {i,IncludeDir} | optimize | + driver | asn1config | undec_rest | {inline,OutputName} | inline</v> + <v>OldOption = ber | per</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Compiles the ASN.1 module <c>Asn1module</c> and generates an + Erlang module <c>Asn1module.erl</c> with encode and decode + functions for the types defined in <c>Asn1module</c>. For each + ASN.1 value defined in the module an Erlang function which + returns the value in Erlang representation is generated.</p> + <p>If <c>Asn1module</c> is a filename without extension first + <c>".asn1"</c> is assumed, then <c>".asn"</c> and finally + <c>".py"</c> (to be compatible with the old ASN.1 compiler). + Of course <c>Asn1module</c> can be a full pathname (relative or + absolute) including filename with (or without) extension. + <marker id="asn1set"></marker> +</p> + <p>If one wishes to compile a set of Asn1 modules into one + Erlang file with encode/decode functions one has to list all + involved files in a configuration file. This configuration + file must have a double extension ".set.asn", (".asn" can + alternatively be ".asn1" or ".py"). The input files' names + must be listed, within quotation marks (""), one at each row + in the file. If the input files are <c>File1.asn</c>, + <c>File2.asn</c> and <c>File3.asn</c> the configuration file + shall look like:</p> + <pre> +File1.asn +File2.asn +File3.asn </pre> + <p>The output files will in this case get their names from the + configuration file. If the configuration file has the name + <c>SetOfFiles.set.asn</c> the name of the output files will be + <c>SetOfFiles.hrl, SetOfFiles.erl and SetOfFiles.asn1db</c>.</p> + <p>Sometimes in a system of ASN.1 modules there are different + default tag modes, e.g. AUTOMATIC, IMPLICIT or EXPLICIT. The + multi file compilation resolves the default tagging as if + the modules were compiled separately.</p> + <p>Another unwanted effect that may occur in multi file compilation + is name collisions. The compiler solves this problem in two + ways: If the definitions are identical then the output module + keeps only one definition with the original name. But if + definitions only have same name and differs in the definition, + then they will be renamed. The new names will be the definition + name and the original module name concatenated.</p> + <p>If any name collision have occurred the compiler reports a + "NOTICE: ..." message that tells if a definition was renamed, + and the new name that must be used to encode/decode data.</p> + + <p> + <c>Options</c> is a list with options specific for the asn1 + compiler and options that are applied to the Erlang compiler. + The latter are those that not is recognized as asn1 specific. + For <em>preferred option use</em> see <seealso + marker="asn1_ug#preferred option use">Preferred Option Use + section in users guide</seealso>. Available options are: + </p> + <taglist> + <tag><c>ber | ber_bin | per | per_bin | uper_bin</c></tag> + <item> + <p> + The encoding rule to be used. The supported encoding rules + are BER (Basic Encoding Rules), + PER aligned (Packed Encoding Rules) and PER unaligned. + If the encoding rule option is omitted <c>ber</c> + is the default. + The <c>per_bin</c> option means the aligned + variant. To use the unaligned variant the <c>uper_bin</c> + option has to be used. + </p> + <p> + The generated Erlang module always gets the same name + as the ASN.1 module and as a consequence of this only one + encoding rule per ASN.1 module can be used at runtime. + </p> + <p> + The <c>ber_bin</c> and <c>per_bin</c> options are + equivalent with the <c>OldOptions</c> <c>ber</c> and <c>per</c> + with the difference that the generated encoding/decoding + functions take advantage of the bit syntax, which in most + cases increases the performance considerably. The result + from encoding is a binary or an iolist. + </p> + </item> + <tag><c>der</c></tag> + <item> + <p> + By this option the Distinguished Encoding Rules (DER) is chosen. + DER is regarded as a specialized variant of the BER encoding + rule, therefore the <c>der</c> option only makes sense together + with the <c>ber</c> or <c>ber_bin</c> option. + This option + sometimes adds sorting and value checks when encoding, which + implies a slower encoding. The decoding routines are the same + as for <c>ber</c>. + </p> + </item> + <tag><c>compact_bit_string</c></tag> + <item> + <p> + Makes it possible to use a compact notation for values + of the BIT STRING type in Erlang. The notation: + </p> + <pre> +BitString = {Unused,Binary}, +Unused = integer(), +Binary = binary() + </pre> + <p> + <c>Unused</c> must be a number in the range 0 to 7. It + tells how many bits in the least significant byte in + <c>Binary</c> that is unused. + For details see + <seealso marker="asn1_ug#BIT STRING"> + BIT STRING type section in users guide + </seealso>. + </p> + </item> + <tag><c>{n2n,EnumTypeName}</c></tag> + <item> + <p> + Tells the compiler to generate functions for conversion between + names (as atoms) and numbers and vice versa for the EnumTypeName specified. There can be multiple occurrences of this option in order to specify several type names. The type names must be declared as ENUMERATIONS in the ASN.1 spec. + If the EnumTypeName does not exist in the ASN.1 spec the + compilation will stop with an error code. + The generated conversion functions are named + <c>name2num_EnumTypeName/1</c> and + <c>num2name_EnumTypeName/1</c>. + </p> + </item> + <tag><c>noobj</c></tag> + <item> + <p>Do not compile (i.e do not produce object code) the generated + <c>.erl</c> file. If this option is omitted the generated Erlang module + will be compiled.</p> + </item> + <tag><c>{i,IncludeDir}</c></tag> + <item> + <p>Adds <c>IncludeDir</c> to the search-path for + <c>.asn1db</c> and asn1 source files. The compiler tries + to open a <c>.asn1db</c> file when a module imports + definitions from another ASN.1 module. If no + <c>.asn1db</c> file is found the asn1 source file is + parsed. Several <c>{i,IncludeDir}</c> can be given. + </p> + </item> + <tag><c>{outdir,Dir}</c></tag> + <item> + <p>Specifies the directory <c>Dir</c> where all generated files + shall be placed. If omitted the files are placed in the + current directory.</p> + </item> + <tag><c>optimize</c></tag> + <item> + <p>This option is only valid together with one of the + <c>per_bin</c> + or <c>ber_bin</c> option. It gives time optimized code + generated and it uses another runtime module and + in the <c>per_bin</c> case a linked-in driver. The result + in the <c>per_bin</c> case from an encode when compiled + with this option will be a binary.</p> + </item> + <tag><c>driver</c></tag> + <item> + <p>Option valid together with <c>ber_bin</c> and <c>optimize</c> + options. It enables the use of a linked-in driver that gives + considerable faster decode. In <c>ber_bin</c> the driver is + enabled only by explicit use of the option <c>driver</c>.</p> + </item> + <tag><c>asn1config</c></tag> + <item> + <p>When one of the specialized decodes, exclusive or + selective decode, is wanted one has to give instructions in + a configuration file. The option <c>asn1config</c> enables + specialized decodes and takes the configuration file, which + has the same name as the ASN.1 spec but with extension + <c>.asn1config</c>, in concern. + </p> + <p>The instructions for exclusive decode must follow the + <seealso marker="asn1_spec#Exclusive Instruction">instruction and grammar in the User's Guide</seealso>. + </p> + <p>You can also find the instructions for selective decode + in the + <seealso marker="asn1_spec#Selective Instruction">User's Guide</seealso>. + </p> + </item> + <tag><c>undec_rest</c></tag> + <item> + <p>A buffer that holds a message, being decoded may + also have some following bytes. Now it is possible to get + those following bytes returned together with the decoded + value. If an asn1 spec is compiled with this option a tuple + <c>{ok,Value,Rest}</c> is returned. <c>Rest</c> may be a + list or a binary. Earlier versions of the compiler ignored + those following bytes.</p> + </item> + <tag><c>{inline,OutputName}</c></tag> + <item> + <p>Compiling with this option gives one output module + containing all asn1 run-time functionality. The asn1 specs + are provided in a target module Module.set.asn as described + <seealso marker="#asn1set">above</seealso>. The name of the + resulting module containing generated encode/decode functions + and in-lined run-time functions will be + <c>OutputName.erl</c>. The merging/in-lining of code is done + by the <c>igor</c> module of <c>syntax_tools</c>. By default + the functions generated from the first asn1 spec in the + <c>.set.asn</c> are exported, unless a + <c>{export,[atom()]}</c> or <c>{export_all,true}</c> option + are provided. The list of atoms are names of chosen asn1 + specs from the <c>.set.asn</c> file.</p> + </item> + <tag><c>inline</c></tag> + <item> + <p>It is also possible to use the sole argument <c>inline</c>. + It is as <c>{inline,OutputName}</c>, but the output file gets the + default name of the source <c>.set.asn</c> file.</p> + </item> + </taglist> + <p>Any additional option that is applied will be passed to + the final step when the generated .erl file is compiled. + </p> + <p>The compiler generates the following files:</p> + <list type="bulleted"> + <item> + <p><c>Asn1module.hrl</c> (if any SET or SEQUENCE is defined)</p> + </item> + <item> + <p><c>Asn1module.erl</c> the Erlang module with encode, decode and value functions.</p> + </item> + <item> + <p><c>Asn1module.asn1db</c> intermediate format used by the compiler when modules IMPORTS + definitions from each other.</p> + </item> + </list> + </desc> + </func> + <func> + <name>encode(Module,Type,Value)-> {ok,Bytes} | {error,Reason}</name> + <fsummary>Encode an ASN.1 value.</fsummary> + <type> + <v>Module = Type = atom()</v> + <v>Value = term()</v> + <v>Bytes = [Int] when integer(Int), Int >= 0, Int =< 255</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Encodes <c>Value</c> of <c>Type</c> defined in the ASN.1 module + <c>Module</c>. Returns a list of bytes if successful. To get as fast execution as + possible the + encode function only performs rudimentary tests that the input + <c>Value</c> + is a correct instance of <c>Type</c>. The length of strings is for example + not always checked. Returns <c>{ok,Bytes}</c> if successful or + <c>{error,Reason}</c> if an error occurred. + </p> + </desc> + </func> + <func> + <name>decode(Module,Type,Bytes) -> {ok,Value}|{error,Reason}</name> + <fsummary>Decode from Bytes into an ASN.1 value.</fsummary> + <type> + <v>Module = Type = atom()</v> + <v>Value = Reason = term()</v> + <v>Bytes = [Int] when integer(Int), Int >= 0, Int =< 255</v> + </type> + <desc> + <p>Decodes <c>Type</c> from <c>Module</c> from the list of bytes + <c>Bytes</c>. Returns <c>{ok,Value}</c> if successful.</p> + </desc> + </func> + <func> + <name>validate(Module,Type,Value) -> ok | {error,Reason}</name> + <fsummary>Validate an ASN.1 value.</fsummary> + <type> + <v>Module = Type = atom()</v> + <v>Value = term()</v> + </type> + <desc> + <p>Validates that <c>Value</c> conforms to <c>Type</c> + from <c>Module</c>. <em>Not implemented in this version of the ASN.1 application.</em></p> + </desc> + </func> + <func> + <name>value(Module ,Type) -> {ok,Value} | {error,Reason}</name> + <fsummary>Create an ASN.1 value for test purposes.</fsummary> + <type> + <v>Module = Type = atom()</v> + <v>Value = term()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Returns an Erlang term which is an example of a valid Erlang + representation of a value of the ASN.1 type <c>Type</c>. The value + is a random value and subsequent calls to this function will for most + types return different values.</p> + </desc> + </func> + <func> + <name>test(Module) -> ok | {error,Reason}</name> + <name>test(Module,Type) -> ok | {error,Reason}</name> + <name>test(Module,Type,Value) -> ok | {error,Reason}</name> + <fsummary>Perform a test of encode and decode for types in an ASN.1 module.</fsummary> + <desc> + <p>Performs a test of encode and decode of all types in <c>Module</c>. + The generated functions are called by this function. + This function is useful during test to secure that the generated + encode and decode functions and the general runtime support work + as expected. <br></br> +<c>test/1</c> iterates over all types in <c>Module</c>. <br></br> +<c>test/2</c> tests type <c>Type</c> with a random value. <br></br> +<c><![CDATA[test/3 tests type <c>Type]]></c> with <c>Value</c>. <br></br> + + Schematically the following happens for each type in the module.</p> + <p></p> + <code type="none"> +{ok,Value} = asn1ct:value(Module,Type), +{ok,Bytes} = asn1ct:encode(Module,Type,Value), +{ok,Value} = asn1ct:decode(Module,Type,Bytes). </code> + </desc> + </func> + </funcs> + +</erlref> + diff --git a/lib/asn1/doc/src/asn1rt.xml b/lib/asn1/doc/src/asn1rt.xml new file mode 100644 index 0000000000..1217a07e9b --- /dev/null +++ b/lib/asn1/doc/src/asn1rt.xml @@ -0,0 +1,208 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>1997</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>asn1rt</title> + <prepared>Kenneth Lundin</prepared> + <responsible>Kenneth Lundin</responsible> + <docno>1</docno> + <approved>Kenneth Lundin</approved> + <checked></checked> + <date>97-10-04</date> + <rev>A</rev> + <file>asn1.sgml</file> + </header> + <module>asn1rt</module> + <modulesummary>ASN.1 runtime support functions</modulesummary> + <description> + <p>This module is the interface module for the ASN.1 runtime support functions. + To encode and decode ASN.1 types in runtime the functions in this module + should be used.</p> + </description> + + <funcs> + + <func> + <name>start() -> ok |{error,Reason}</name> + <fsummary>Starts the asn1 server.</fsummary> + <type> + <v>Reason = term()</v> + </type> + <desc> + <p>Starts the asn1 server that loads the drivers.</p> + <p>The server schedules a driver that is not blocked by + another caller. The driver is used by the asn1 application if + specs are compiled with options <c>[per_bin, optimize]</c> or + <c>[ber_bin, optimize, driver]</c>. The server will be started + automatically at encode/decode if it isn't done explicitly. If + encode/decode with driver is used in test or industrial code + it is a performance gain to start it explicitly to avoid the + one time load in run-time.</p> + </desc> + </func> + + <func> + <name>stop() -> ok |{error,Reason}</name> + <fsummary>Stops the asn1 server.</fsummary> + <type> + <v>Reason = term()</v> + </type> + <desc> + <p>Stops the asn1 server and unloads the drivers.</p> + </desc> + </func> + + <func> + <name>decode(Module,Type,Bytes) -> {ok,Value}|{error,Reason}</name> + <fsummary>Decode from bytes into an ASN.1 value.</fsummary> + <type> + <v>Module = Type = atom()</v> + <v>Value = Reason = term()</v> + <v>Bytes = binary | [Int] when integer(Int), Int >= 0, Int =< 255 | binary</v> + </type> + <desc> + <p>Decodes <c>Type</c> from <c>Module</c> from the list of bytes or + binary <c>Bytes</c>. If the module is compiled with <c>ber_bin</c> + or <c>per_bin</c> option <c>Bytes</c> must be a binary. + Returns <c>{ok,Value}</c> if successful.</p> + </desc> + </func> + + <func> + <name>encode(Module,Type,Value)-> {ok,BinOrList} | {error,Reason}</name> + <fsummary>Encode an ASN.1 value.</fsummary> + <type> + <v>Module = Type = atom()</v> + <v>Value = term()</v> + <v>BinOrList = Bytes | binary()</v> + <v>Bytes = [Int|binary|Bytes] when integer(Int), Int >= 0, Int =< 255</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Encodes <c>Value</c> of <c>Type</c> defined in the ASN.1 module + <c>Module</c>. Returns a possibly nested list of bytes and or binaries + if successful. If <c>Module</c> was compiled with the options <c>per_bin</c> and <c>optimize</c> the result is a binary. To get as + fast execution as possible the + encode function only performs rudimentary tests that the input + <c>Value</c> + is a correct instance of <c>Type</c>. The length of strings is for example + not always checked. </p> + </desc> + </func> + + <func> + <name>info(Module) -> {ok,Info} | {error,Reason}</name> + <fsummary>Returns compiler information about the Module.</fsummary> + <type> + <v>Module = atom()</v> + <v>Info = list()</v> + <v>Reason = term()</v> + </type> + <desc> + <p><c>info/1</c> returns the version of the asn1 compiler that was + used to compile the module. It also returns the compiler options + that was used.</p> + </desc> + </func> + + <func> + <name>load_driver() -> ok | {error,Reason}</name> + <fsummary>Loads the linked-in driver.</fsummary> + <type> + <v>Reason = term()</v> + </type> + <desc> + <p>This function loads the linked-in driver before the first call + to encode. If this function is not called the driver will be loaded + automatically at the first call to encode. If one doesn't want the + performance cost of a driver load when the application is running, + this function makes it possible to load the driver in an + initialization.</p> + <p>The driver is only used when encoding/decoding ASN.1 files that + were compiled with the options <c>per_bin</c> and <c>optimize</c>.</p> + </desc> + </func> + + <func> + <name>unload_driver() -> ok | {error,Reason}</name> + <fsummary>Unloads the linked-in driver.</fsummary> + <type> + <v>Reason = term()</v> + </type> + <desc> + <p>This function unloads the linked-in driver. + When the driver has been loaded it remains in the environment until + it is unloaded. Normally the driver should remain loaded, it is + crucial for the performance of ASN.1 encoding. </p> + <p>The driver is only used when ASN.1 modules have been compiled + with the flags <c>per_bin</c> and <c>optimize</c>.</p> + </desc> + </func> + + <func> + <name>utf8_binary_to_list(UTF8Binary) -> {ok,UnicodeList} | {error,Reason}</name> + <fsummary>Transforms an utf8 encoded binary to a unicode list.</fsummary> + <type> + <v>UTF8Binary = binary()</v> + <v>UnicodeList = [integer()]</v> + <v>Reason = term()</v> + </type> + <desc> + <p><c>utf8_binary_to_list/1</c> Transforms a UTF8 encoded binary + to a list of integers, where each integer represents one + character as its unicode value. The function fails if the binary + is not a properly encoded UTF8 string.</p> + </desc> + </func> + + <func> + <name>utf8_list_to_binary(UnicodeList) -> {ok,UTF8Binary} | {error,Reason}</name> + <fsummary>Transforms an unicode list ot an utf8 binary.</fsummary> + <type> + <v>UnicodeList = [integer()]</v> + <v>UTF8Binary = binary()</v> + <v>Reason = term()</v> + </type> + <desc> + <p><c>utf8_list_to_binary/1</c> Transforms a list of integers, + where each integer represents one character as its unicode + value, to a UTF8 encoded binary.</p> + </desc> + </func> + + <func> + <name>validate(Module,Type,Value) -> ok | {error,Reason}</name> + <fsummary>Validate an ASN.1 value.</fsummary> + <type> + <v>Module = Type = atom()</v> + <v>Value = term()</v> + </type> + <desc> + <p>Validates that <c>Value</c> conforms to <c>Type</c> + from <c>Module</c>. <em>Not implemented in this version of the ASN.1 application.</em></p> + </desc> + </func> + + </funcs> + +</erlref> + diff --git a/lib/asn1/doc/src/book.xml b/lib/asn1/doc/src/book.xml new file mode 100644 index 0000000000..718e6e7b17 --- /dev/null +++ b/lib/asn1/doc/src/book.xml @@ -0,0 +1,50 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE book SYSTEM "book.dtd"> + + +<book xmlns:xi="http://www.w3.org/2001/XInclude"> + <header titlestyle="normal"> + <copyright> + <year>1997</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>ASN.1</title> + <prepared>Kenneth Lundin</prepared> + <docno></docno> + <date>1997-12-01</date> + <rev>0.9</rev> + <file>book.sgml</file> + </header> + <insidecover> + </insidecover> + <pagetext>ASN.1</pagetext> + <preamble> + <contents level="2"></contents> + </preamble> + <parts lift="no"> + <xi:include href="part.xml"/> + </parts> + <applications> + <xi:include href="ref_man.xml"/> + </applications> + <releasenotes> + <xi:include href="notes.xml"/> + </releasenotes> + <listofterms></listofterms> + <index></index> +</book> + diff --git a/lib/asn1/doc/src/exclusive_Win_But.gif b/lib/asn1/doc/src/exclusive_Win_But.gif Binary files differnew file mode 100644 index 0000000000..86dea0547e --- /dev/null +++ b/lib/asn1/doc/src/exclusive_Win_But.gif diff --git a/lib/asn1/doc/src/exclusive_Win_But.ps b/lib/asn1/doc/src/exclusive_Win_But.ps new file mode 100644 index 0000000000..387b978c7f --- /dev/null +++ b/lib/asn1/doc/src/exclusive_Win_But.ps @@ -0,0 +1,465 @@ +%!PS-Adobe-2.0 +%%Title: exclusive_Win_But.ps +%%Creator: fig2dev Version 3.2 Patchlevel 1 +%%CreationDate: Tue Oct 28 13:39:26 2003 +%%For: bertil@super (Bertil Karlsson,UAB/F/P) +%%Orientation: Portrait +%%BoundingBox: 40 368 572 423 +%%Pages: 1 +%%BeginSetup +%%IncludeFeature: *PageSize Letter +%%EndSetup +%%Magnification: 1.0000 +%%EndComments +/MyAppDict 100 dict dup begin def +/$F2psDict 200 dict def +$F2psDict begin +$F2psDict /mtrx matrix put +/col-1 {0 setgray} bind def +/col0 {0.000 0.000 0.000 srgb} bind def +/col1 {0.000 0.000 1.000 srgb} bind def +/col2 {0.000 1.000 0.000 srgb} bind def +/col3 {0.000 1.000 1.000 srgb} bind def +/col4 {1.000 0.000 0.000 srgb} bind def +/col5 {1.000 0.000 1.000 srgb} bind def +/col6 {1.000 1.000 0.000 srgb} bind def +/col7 {1.000 1.000 1.000 srgb} bind def +/col8 {0.000 0.000 0.560 srgb} bind def +/col9 {0.000 0.000 0.690 srgb} bind def +/col10 {0.000 0.000 0.820 srgb} bind def +/col11 {0.530 0.810 1.000 srgb} bind def +/col12 {0.000 0.560 0.000 srgb} bind def +/col13 {0.000 0.690 0.000 srgb} bind def +/col14 {0.000 0.820 0.000 srgb} bind def +/col15 {0.000 0.560 0.560 srgb} bind def +/col16 {0.000 0.690 0.690 srgb} bind def +/col17 {0.000 0.820 0.820 srgb} bind def +/col18 {0.560 0.000 0.000 srgb} bind def +/col19 {0.690 0.000 0.000 srgb} bind def +/col20 {0.820 0.000 0.000 srgb} bind def +/col21 {0.560 0.000 0.560 srgb} bind def +/col22 {0.690 0.000 0.690 srgb} bind def +/col23 {0.820 0.000 0.820 srgb} bind def +/col24 {0.500 0.190 0.000 srgb} bind def +/col25 {0.630 0.250 0.000 srgb} bind def +/col26 {0.750 0.380 0.000 srgb} bind def +/col27 {1.000 0.500 0.500 srgb} bind def +/col28 {1.000 0.630 0.630 srgb} bind def +/col29 {1.000 0.750 0.750 srgb} bind def +/col30 {1.000 0.880 0.880 srgb} bind def +/col31 {1.000 0.840 0.000 srgb} bind def + +end +save +22.0 480.5 translate +1 -1 scale +.9 .9 scale % to make patterns same scale as in xfig + +% This junk string is used by the show operators +/PATsstr 1 string def +/PATawidthshow { % cx cy cchar rx ry string + % Loop over each character in the string + { % cx cy cchar rx ry char + % Show the character + dup % cx cy cchar rx ry char char + PATsstr dup 0 4 -1 roll put % cx cy cchar rx ry char (char) + false charpath % cx cy cchar rx ry char + /clip load PATdraw + % Move past the character (charpath modified the + % current point) + currentpoint % cx cy cchar rx ry char x y + newpath + moveto % cx cy cchar rx ry char + % Reposition by cx,cy if the character in the string is cchar + 3 index eq { % cx cy cchar rx ry + 4 index 4 index rmoveto + } if + % Reposition all characters by rx ry + 2 copy rmoveto % cx cy cchar rx ry + } forall + pop pop pop pop pop % - + currentpoint + newpath + moveto +} bind def +/PATcg { + 7 dict dup begin + /lw currentlinewidth def + /lc currentlinecap def + /lj currentlinejoin def + /ml currentmiterlimit def + /ds [ currentdash ] def + /cc [ currentrgbcolor ] def + /cm matrix currentmatrix def + end +} bind def +% PATdraw - calculates the boundaries of the object and +% fills it with the current pattern +/PATdraw { % proc + save exch + PATpcalc % proc nw nh px py + 5 -1 roll exec % nw nh px py + newpath + PATfill % - + restore +} bind def +% PATfill - performs the tiling for the shape +/PATfill { % nw nh px py PATfill - + PATDict /CurrentPattern get dup begin + setfont + % Set the coordinate system to Pattern Space + PatternGState PATsg + % Set the color for uncolored pattezns + PaintType 2 eq { PATDict /PColor get PATsc } if + % Create the string for showing + 3 index string % nw nh px py str + % Loop for each of the pattern sources + 0 1 Multi 1 sub { % nw nh px py str source + % Move to the starting location + 3 index 3 index % nw nh px py str source px py + moveto % nw nh px py str source + % For multiple sources, set the appropriate color + Multi 1 ne { dup PC exch get PATsc } if + % Set the appropriate string for the source + 0 1 7 index 1 sub { 2 index exch 2 index put } for pop + % Loop over the number of vertical cells + 3 index % nw nh px py str nh + { % nw nh px py str + currentpoint % nw nh px py str cx cy + 2 index show % nw nh px py str cx cy + YStep add moveto % nw nh px py str + } repeat % nw nh px py str + } for + 5 { pop } repeat + end +} bind def + +% PATkshow - kshow with the current pattezn +/PATkshow { % proc string + exch bind % string proc + 1 index 0 get % string proc char + % Loop over all but the last character in the string + 0 1 4 index length 2 sub { + % string proc char idx + % Find the n+1th character in the string + 3 index exch 1 add get % string proe char char+1 + exch 2 copy % strinq proc char+1 char char+1 char + % Now show the nth character + PATsstr dup 0 4 -1 roll put % string proc chr+1 chr chr+1 (chr) + false charpath % string proc char+1 char char+1 + /clip load PATdraw + % Move past the character (charpath modified the current point) + currentpoint newpath moveto + % Execute the user proc (should consume char and char+1) + mark 3 1 roll % string proc char+1 mark char char+1 + 4 index exec % string proc char+1 mark... + cleartomark % string proc char+1 + } for + % Now display the last character + PATsstr dup 0 4 -1 roll put % string proc (char+1) + false charpath % string proc + /clip load PATdraw + neewath + pop pop % - +} bind def +% PATmp - the makepattern equivalent +/PATmp { % patdict patmtx PATmp patinstance + exch dup length 7 add % We will add 6 new entries plus 1 FID + dict copy % Create a new dictionary + begin + % Matrix to install when painting the pattern + TilingType PATtcalc + /PatternGState PATcg def + PatternGState /cm 3 -1 roll put + % Check for multi pattern sources (Level 1 fast color patterns) + currentdict /Multi known not { /Multi 1 def } if + % Font dictionary definitions + /FontType 3 def + % Create a dummy encoding vector + /Encoding 256 array def + 3 string 0 1 255 { + Encoding exch dup 3 index cvs cvn put } for pop + /FontMatrix matrix def + /FontBBox BBox def + /BuildChar { + mark 3 1 roll % mark dict char + exch begin + Multi 1 ne {PaintData exch get}{pop} ifelse % mark [paintdata] + PaintType 2 eq Multi 1 ne or + { XStep 0 FontBBox aload pop setcachedevice } + { XStep 0 setcharwidth } ifelse + currentdict % mark [paintdata] dict + /PaintProc load % mark [paintdata] dict paintproc + end + gsave + false PATredef exec true PATredef + grestore + cleartomark % - + } bind def + currentdict + end % newdict + /foo exch % /foo newlict + definefont % newfont +} bind def +% PATpcalc - calculates the starting point and width/height +% of the tile fill for the shape +/PATpcalc { % - PATpcalc nw nh px py + PATDict /CurrentPattern get begin + gsave + % Set up the coordinate system to Pattern Space + % and lock down pattern + PatternGState /cm get setmatrix + BBox aload pop pop pop translate + % Determine the bounding box of the shape + pathbbox % llx lly urx ury + grestore + % Determine (nw, nh) the # of cells to paint width and height + PatHeight div ceiling % llx lly urx qh + 4 1 roll % qh llx lly urx + PatWidth div ceiling % qh llx lly qw + 4 1 roll % qw qh llx lly + PatHeight div floor % qw qh llx ph + 4 1 roll % ph qw qh llx + PatWidth div floor % ph qw qh pw + 4 1 roll % pw ph qw qh + 2 index sub cvi abs % pw ph qs qh-ph + exch 3 index sub cvi abs exch % pw ph nw=qw-pw nh=qh-ph + % Determine the starting point of the pattern fill + %(px, py) + 4 2 roll % nw nh pw ph + PatHeight mul % nw nh pw py + exch % nw nh py pw + PatWidth mul exch % nw nh px py + end +} bind def + +% Save the original routines so that we can use them later on +/oldfill /fill load def +/oldeofill /eofill load def +/oldstroke /stroke load def +/oldshow /show load def +/oldashow /ashow load def +/oldwidthshow /widthshow load def +/oldawidthshow /awidthshow load def +/oldkshow /kshow load def + +% These defs are necessary so that subsequent procs don't bind in +% the originals +/fill { oldfill } bind def +/eofill { oldeofill } bind def +/stroke { oldstroke } bind def +/show { oldshow } bind def +/ashow { oldashow } bind def +/widthshow { oldwidthshow } bind def +/awidthshow { oldawidthshow } bind def +/kshow { oldkshow } bind def +/PATredef { + MyAppDict begin + { + /fill { /clip load PATdraw newpath } bind def + /eofill { /eoclip load PATdraw newpath } bind def + /stroke { PATstroke } bind def + /show { 0 0 null 0 0 6 -1 roll PATawidthshow } bind def + /ashow { 0 0 null 6 3 roll PATawidthshow } + bind def + /widthshow { 0 0 3 -1 roll PATawidthshow } + bind def + /awidthshow { PATawidthshow } bind def + /kshow { PATkshow } bind def + } { + /fill { oldfill } bind def + /eofill { oldeofill } bind def + /stroke { oldstroke } bind def + /show { oldshow } bind def + /ashow { oldashow } bind def + /widthshow { oldwidthshow } bind def + /awidthshow { oldawidthshow } bind def + /kshow { oldkshow } bind def + } ifelse + end +} bind def +false PATredef +% Conditionally define setcmykcolor if not available +/setcmykcolor where { pop } { + /setcmykcolor { + 1 sub 4 1 roll + 3 { + 3 index add neg dup 0 lt { pop 0 } if 3 1 roll + } repeat + setrgbcolor - pop + } bind def +} ifelse +/PATsc { % colorarray + aload length % c1 ... cn length + dup 1 eq { pop setgray } { 3 eq { setrgbcolor } { setcmykcolor + } ifelse } ifelse +} bind def +/PATsg { % dict + begin + lw setlinewidth + lc setlinecap + lj setlinejoin + ml setmiterlimit + ds aload pop setdash + cc aload pop setrgbcolor + cm setmatrix + end +} bind def + +/PATDict 3 dict def +/PATsp { + true PATredef + PATDict begin + /CurrentPattern exch def + % If it's an uncolored pattern, save the color + CurrentPattern /PaintType get 2 eq { + /PColor exch def + } if + /CColor [ currentrgbcolor ] def + end +} bind def +% PATstroke - stroke with the current pattern +/PATstroke { + countdictstack + save + mark + { + currentpoint strokepath moveto + PATpcalc % proc nw nh px py + clip newpath PATfill + } stopped { + (*** PATstroke Warning: Path is too complex, stroking + with gray) = + cleartomark + restore + countdictstack exch sub dup 0 gt + { { end } repeat } { pop } ifelse + gsave 0.5 setgray oldstroke grestore + } { pop restore pop } ifelse + newpath +} bind def +/PATtcalc { % modmtx tilingtype PATtcalc tilematrix + % Note: tiling types 2 and 3 are not supported + gsave + exch concat % tilingtype + matrix currentmatrix exch % cmtx tilingtype + % Tiling type 1 and 3: constant spacing + 2 ne { + % Distort the pattern so that it occupies + % an integral number of device pixels + dup 4 get exch dup 5 get exch % tx ty cmtx + XStep 0 dtransform + round exch round exch % tx ty cmtx dx.x dx.y + XStep div exch XStep div exch % tx ty cmtx a b + 0 YStep dtransform + round exch round exch % tx ty cmtx a b dy.x dy.y + YStep div exch YStep div exch % tx ty cmtx a b c d + 7 -3 roll astore % { a b c d tx ty } + } if + grestore +} bind def +/PATusp { + false PATredef + PATDict begin + CColor PATsc + end +} bind def + +% left45 +11 dict begin +/PaintType 1 def +/PatternType 1 def +/TilingType 1 def +/BBox [0 0 1 1] def +/XStep 1 def +/YStep 1 def +/PatWidth 1 def +/PatHeight 1 def +/Multi 2 def +/PaintData [ + { clippath } bind + { 32 32 true [ 32 0 0 -32 0 32 ] + {<808080804040404020202020101010100808080804040404 + 020202020101010180808080404040402020202010101010 + 080808080404040402020202010101018080808040404040 + 202020201010101008080808040404040202020201010101 + 808080804040404020202020101010100808080804040404 + 0202020201010101>} + imagemask } bind +] def +/PaintProc { + pop + exec fill +} def +currentdict +end +/P4 exch def +1.1111 1.1111 scale %restore scale + +/cp {closepath} bind def +/ef {eofill} bind def +/gr {grestore} bind def +/gs {gsave} bind def +/sa {save} bind def +/rs {restore} bind def +/l {lineto} bind def +/m {moveto} bind def +/rm {rmoveto} bind def +/n {newpath} bind def +/s {stroke} bind def +/sh {show} bind def +/slc {setlinecap} bind def +/slj {setlinejoin} bind def +/slw {setlinewidth} bind def +/srgb {setrgbcolor} bind def +/rot {rotate} bind def +/sc {scale} bind def +/sd {setdash} bind def +/ff {findfont} bind def +/sf {setfont} bind def +/scf {scalefont} bind def +/sw {stringwidth} bind def +/tr {translate} bind def +/tnt {dup dup currentrgbcolor + 4 -2 roll dup 1 exch sub 3 -1 roll mul add + 4 -2 roll dup 1 exch sub 3 -1 roll mul add + 4 -2 roll dup 1 exch sub 3 -1 roll mul add srgb} + bind def +/shd {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll mul + 4 -2 roll mul srgb} bind def +/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def +/$F2psEnd {$F2psEnteredState restore end} def +%%EndProlog + +$F2psBegin +10 setmiterlimit +n -1000 2854 m -1000 -1000 l 10152 -1000 l 10152 2854 l cp clip + 0.06000 0.06000 sc +%%Page: 1 1 +% Polyline +7.500 slw +n 325 975 m 1125 975 l 1125 1575 l 325 1575 l cp gs col-1 s gr +% Polyline +n 1125 975 m 4650 975 l 4650 1575 l 1125 1575 l cp gs /PC [[1.00 1.00 1.00] [0.00 0.00 0.00]] def +15.00 15.00 sc P4 [16 0 0 -16 75.00 65.00] PATmp PATsp ef gr PATusp gs col-1 s gr +% Polyline +n 4650 975 m 5325 975 l 5325 1575 l 4650 1575 l cp gs col-1 s gr +% Polyline +n 5325 975 m 9140 975 l 9140 1575 l 5325 1575 l cp gs /PC [[1.00 1.00 1.00] [0.00 0.00 0.00]] def +15.00 15.00 sc P4 [16 0 0 -16 355.00 65.00] PATmp PATsp ef gr PATusp gs col-1 s gr +/Times-Roman ff 180.00 scf sf +4725 1800 m +gs 1 -1 sc (enabled) col-1 sh gr +/Times-Roman ff 180.00 scf sf +6450 1800 m +gs 1 -1 sc (actions:possibleActions) col-1 sh gr +/Times-Roman ff 180.00 scf sf +2550 1800 m +gs 1 -1 sc (buttonList) col-1 sh gr +/Times-Roman ff 180.00 scf sf +600 1800 m +gs 1 -1 sc (state) col-1 sh gr +$F2psEnd +rs +end +showpage diff --git a/lib/asn1/doc/src/fascicules.xml b/lib/asn1/doc/src/fascicules.xml new file mode 100644 index 0000000000..2488e7b57e --- /dev/null +++ b/lib/asn1/doc/src/fascicules.xml @@ -0,0 +1,18 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE fascicules SYSTEM "fascicules.dtd"> + +<fascicules> + <fascicule file="part" href="part_frame.html"> + User's Guide + </fascicule> + <fascicule file="ref_man" href="ref_man_frame.html" entry="yes"> + Reference Manual + </fascicule> + <fascicule file="part_notes" href="part_notes_frame.html"> + Release Notes + </fascicule> + <fascicule file="" href="../../../../doc/print.html"> + Off-Print + </fascicule> +</fascicules> + diff --git a/lib/asn1/doc/src/make.dep b/lib/asn1/doc/src/make.dep new file mode 100644 index 0000000000..eb2c0e9a98 --- /dev/null +++ b/lib/asn1/doc/src/make.dep @@ -0,0 +1,31 @@ +# ---------------------------------------------------- +# >>>> Do not edit this file <<<< +# This file was automaticly generated by +# /home/gandalf/otp/bin/docdepend +# ---------------------------------------------------- + + +# ---------------------------------------------------- +# TeX files that the DVI file depend on +# ---------------------------------------------------- + +book.dvi: asn1_spec.tex asn1_ug.tex asn1ct.tex asn1rt.tex \ + book.tex part.tex ref_man.tex + +# ---------------------------------------------------- +# Source inlined when transforming from source to LaTeX +# ---------------------------------------------------- + +asn1_spec.tex: Seq.asn Seq.asn1config + +book.tex: part.xml ref_man.xml + +asn1_ug.tex: ../../../../system/doc/definitions/cite.defs + +# ---------------------------------------------------- +# Pictures that the DVI file depend on +# ---------------------------------------------------- + +book.dvi: exclusive_Win_But.ps selective_TypeList.ps \ + selective_Window2.ps + diff --git a/lib/asn1/doc/src/note.gif b/lib/asn1/doc/src/note.gif Binary files differnew file mode 100644 index 0000000000..6fffe30419 --- /dev/null +++ b/lib/asn1/doc/src/note.gif diff --git a/lib/asn1/doc/src/notes.xml b/lib/asn1/doc/src/notes.xml new file mode 100644 index 0000000000..861de05a59 --- /dev/null +++ b/lib/asn1/doc/src/notes.xml @@ -0,0 +1,748 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2004</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>asn1 Release Notes</title> + <prepared>otp_appnotes</prepared> + <docno>nil</docno> + <date>nil</date> + <rev>nil</rev> + <file>notes.xml</file> + </header> + <p>This document describes the changes made to the asn1 application.</p> + + +<section><title>Asn1 1.6.12</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The documentation is now built with open source tools + (xsltproc and fop) that exists on most platforms. One + visible change is that the frames are removed.</p> + <p> + Own Id: OTP-8256</p> + </item> + </list> + </section> + +</section> + + +<section><title>Asn1 1.6.11</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + A new option <c>{n2n,TypeName}</c> can be used to + enable generation of conversion functions from name to number + and vice versa for selected ENUMERATION types. + The option can be repeated many times in order to specify several + types in the same file.<br/> + If the <c>TypeName</c> specified does not exists or is not an + ENUMERATION type, the compilation will be terminated with an + error code.<br/> + Below follows an example on how to use the option from the command line with <c>erlc</c>:<br/> + <c>erlc -bper_bin +optimize +driver +"{n2n,'CauseMisc'}" +"{n2n,'CausePcl'}" MyModyle.asn</c> + </p> + <p> + Own Id: OTP-8136 Aux Id: seq11347 </p> + </item> + <item> + <p> + Range checks added for BIT STRING with fixed SIZE + constraint.</p> + <p> + Own Id: OTP-7972 Aux Id: seq11280 </p> + </item> + <item> + <p> + Now support multiple-line comments in asn1-specs as + specified in ASN1 X.680 (07/2002), section 11.6.4</p> + <p> + Own Id: OTP-8043</p> + </item> + <item> + <p> + Now parses and adds abstract syntax for PATTERN subtype + constraint. No other action is taken on this type of + constraint.</p> + <p> + Own Id: OTP-8046</p> + </item> + <item> + <p> + The ASN1 subtype constraint <c>CONTAINING Type</c>, + <c>CONTAINING Type ENCODED BY Value</c> and <c>ENCODED BY + Value</c> now is parsed. Abstract syntax is added but no + further action in generated code is taken.</p> + <p> + Own Id: OTP-8047</p> + </item> + </list> + </section> + +</section> + +<section><title>Asn1 1.6.10</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A faulty receive case that catch-ed all messages in the + initialization of the driver has been removed, the + initialization has been restructured.</p> + <p> + Own Id: OTP-7954 Aux Id: seq11220 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The anonymous part of the decode that splits the ASN1 TLV + into Tag Value tuples has been optimized.</p> + <p> + Own Id: OTP-7953</p> + </item> + </list> + </section> + +</section> + +<section><title>Asn1 1.6.9</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Error that caused crash when drivers were loaded is now + corrected. Parallel driver for asn1 now enabled.</p> + <p> + Own Id: OTP-7904 Aux Id: seq11220 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Optimized code for ENUMERATION type in encoder/decoder.</p> + <p> + Own Id: OTP-7909</p> + </item> + </list> + </section> + +</section> + +<section><title>Asn1 1.6.8.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Removed parallel-driver functionality due to failure + when loading the driver.</p> + <p> + Own Id: OTP-7900 Aux Id: seq11220 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Generated code now uses guards that is not obsolete, e.g. + <c>is_integer/1</c> instead of <c>integer/1</c>.</p> + <p> + Own Id: OTP-7910</p> + </item> + </list> + </section> + +</section> + + +<section><title>Asn1 1.6.8</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A BIT STRING with a size constraint that has a single + value and an extension as in <c> BIT STRING (SIZE + (16,...))</c> was erroneous encoded/decoded. This is now + corrected and follows X.691 Section 15.6.</p> + <p> + Own Id: OTP-7876 Aux Id: seq11220 </p> + </item> + </list> + </section> + +</section> + <section><title>Asn1 1.6.7</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Now asn1 starts multiple drivers to enable simultaneous + encode/decode in different processes for the + asn1-backends using linked-in driver.</p> + <p> + Own Id: OTP-7801</p> + </item> + </list> + </section> + +</section> + +<section><title>Asn1 1.6.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Decode of an open_type when the value was empty tagged + type encoded with indefinite length failed. This is now + corrected.</p> + <p> + Own Id: OTP-7759 Aux Id: seq11166 </p> + </item> + <item> + <p> + Encode of BIT STRING with size of exact length, on + compact_bit_string format in UNALIGNED PER failed when + value had the right size, i.e. no padding needed.</p> + <p> + Own Id: OTP-7763 Aux Id: seq11182 </p> + </item> + </list> + </section> + +</section> + +<section><title>Asn1 1.6.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + For a BIT STRING with SIZE constraint higher than 255 + compiled with <c>[per_bin,optimize, + compact_bit_string]</c> an improper io-list was created + and sent to the c-driver for complete encoding. This + error has been resolved.</p> + <p> + Own Id: OTP-7734 Aux Id: seq11170 </p> + </item> + </list> + </section> + +</section> + +<section><title>Asn1 1.6.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A a SEQUENCE OF with a type that is a CHOICE with + ellipses occurred falsely a compile error. The error + causing that is now removed.</p> + <p> + Own Id: OTP-7708 Aux Id: seq11136 </p> + </item> + </list> + </section> + +</section> + +<section><title>Asn1 1.6.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + constrained number with a value-range greater than 512 now + has the proper interpretation of the values that causes + shift to the next number of units (bits), According to + limit condition <c>2^m < "range" =< 2^(m + 1)</c> then the + number of bits are m + 1.</p> + <p> + Own Id: OTP-7681 Aux Id: seq11114 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Can now handle default values of simple types that is + provided on its own format, i.e. not just as + asn1_DEFAULT.</p> + <p> + Own Id: OTP-7678 Aux Id: seq11114 </p> + </item> + </list> + </section> + +</section> + +<section><title>Asn1 1.6.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + comparison of two value definitions failed due to new + module name field in valuedef record. It is now + corrected.</p> + <p> + Own Id: OTP-7608</p> + </item> + </list> + </section> + +</section> + +<section><title>Asn1 1.6.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Bug regarding propagation of parameters of parameterized + type fixed.</p> + <p> + Own Id: OTP-7174 Aux Id: seq10864 </p> + </item> + <item> + <p> + A bug, related to instantiation of a parameterized type + with a type definition in the parameter-list, has been + removed. The definition of the parameter type was in + another module than the instance definition causing + limited module info.</p> + <p> + Own Id: OTP-7299 Aux Id: seq10864 </p> + </item> + <item> + <p> + Removed hard-coded name that may cause name collision.</p> + <p> + Own Id: OTP-7322 Aux Id: seq10864 </p> + </item> + <item> + <p> + Object set of a class with id with properties UNIQUE + OPTIONAL and the id field is lacking in the object is for + now treated as a object without a unique identifier, i.e. + no table is generated for this object.</p> + <p> + Own Id: OTP-7332 Aux Id: seq10864 </p> + </item> + <item> + <p> + Compiler crashed when failed to handle a OID as + ValueFromObject.</p> + <p> + Own Id: OTP-7476 Aux Id: seq10999 </p> + </item> + <item> + <p> + A corrupted encoding may cause a loop when a buffer of at + least two bytes of zero matches tag and length of a SET + component. This behavior occurred only with decoder + generated with <c>ber</c> or <c>ber_bin</c> options. Now a + control breaks the loop.</p> + <p> + Own Id: OTP-7533</p> + </item> + <item> + <p> + Encode of BIT STRING longer than 255 bits with a + <c>SIZE(integer())</c> constraint caused a crash when + spec was compiled with <c>per_bin, optimize</c> options.</p> + <p> + Own Id: OTP-7602 Aux Id: seq11079 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Now supports REAL type of base 2 and 10</p> + <p> + Own Id: OTP-7166 Aux Id: seq10864 </p> + </item> + <item> + <p> + By the asn1 compiler option <c>{record_name_prefix + Name}</c> a prefix is chosen to the name of the record + generated in the .hrl and used in the generated .erl + files.</p> + <p> + Own Id: OTP-7204 Aux Id: seq10853 </p> + </item> + <item> + <p> + The TypeFromObject production now covered</p> + <p> + Own Id: OTP-7295 Aux Id: seq10468 </p> + </item> + <item> + <p> + Extended support for ObjectSetFromObjects. Production + occurred as a part of the RootElementSetSpec of the + ObjectSetSpec. Added also support for Exclusion of + Element in ObjectSetSpec.</p> + <p> + Own Id: OTP-7306 Aux Id: seq10864 </p> + </item> + <item> + <p> + Now implements RELATIVE-OID</p> + <p> + Own Id: OTP-7334 Aux Id: seq10864 </p> + </item> + </list> + </section> + +</section> + +<section><title>Asn1 1.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Now is ordering, according to the canonical order, of + components in a SET added. Canonical order is described + in X.691 9.2 and X.680 8.6</p> + <p> + Own Id: OTP-7375 Aux Id: unaligned PER </p> + </item> + <item> + <p> + The precedence rules for extended constraints have been + misinterpreted. The rule says for instance that if there + are more than one constraint on a type that have + extension-mark, only the last of the extension-marks would + be kept. This affects the encoding of PER and is now + corrected.</p> + <p> + Own Id: OTP-7400 Aux Id: OTP-7335 </p> + </item> + <item> + <p> + A constrained number with a single-value constraint that + is extensible was falsely encoded/decoded in + aligned/unaligned PER. This is now corrected.</p> + <p> + Own Id: OTP-7403</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The ASN.1 compiler has got a new backend supporting PER + UNALIGNED. Previously it was only support for PER + ALIGNED.</p> + <p> + Own Id: OTP-7335</p> + </item> + <item> + <p> + Now the asn1-compiler handles unions and intersections of + PermittedAlphabet constraints.</p> + <p> + Own Id: OTP-7374 Aux Id: unaligned PER </p> + </item> + <item> + <p> + With the undocumented option <c>no_final_padding</c> the + whole encoded message is not padded to a border of a + byte. Thus the returned encoded message is a + <c>bitstring</c>.</p> + <p> + Own Id: OTP-7407</p> + </item> + </list> + </section> + +</section> + +<section><title>Asn1 1.5.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + When duplicates of object fields were removed only one + table access function for each unique identifier value + was generated. This can occur when several object sets + are merged by use of ObjectSetFromObjects.</p> + <p> + Own Id: OTP-7263 Aux Id: seq10864 </p> + </item> + <item> + <p> + DER: For some complex types and components with reference + to type in several steps the default value check function + was not generated. This is now fixed.</p> + <p> + Own Id: OTP-7268 Aux Id: seq10684 </p> + </item> + <item> + <p> + Now is the tag in a tagged type as parameter propagated + to the instance.</p> + <p> + Own Id: OTP-7273 Aux Id: seq10864 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Added type T61String that is similar to TeletexString</p> + <p> + Own Id: OTP-7264 Aux Id: seq10864 </p> + </item> + </list> + </section> + +</section> + + +<section><title>Asn1 1.5.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A bug related to renaming of types has been fixed.This + occurred using the .set.asn functionality.</p> + <p> + Own Id: OTP-7149 Aux Id: seq10853 </p> + </item> + <item> + <p> + syntax error in ASN1 value now correctly shown</p> + <p> + Own Id: OTP-7154 Aux Id: seq10864 </p> + </item> + <item> + <p> + Now a COMPONENTS OF construct in a parameterized type + is expanded correctly</p> + <p> + Own Id: OTP-7155 Aux Id: seq10864 </p> + </item> + <item> + <p> + Now the asn1-compiler also handles empty SEQUENCE DEFAULT + values as <c>{}</c>.</p> + <p> + Own Id: OTP-7169 Aux Id: seq10864 </p> + </item> + <item> + <p> + Now SelectionType gets the tag of the selected type.</p> + <p> + Own Id: OTP-7171 Aux Id: seq10864 </p> + </item> + <item> + <p> + Correction of generated code for decode of an open type + in a SEQUECNE OF/ SET OF</p> + <p> + Own Id: OTP-7193 Aux Id: seq10875 </p> + </item> + </list> + </section> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Misc improvements and bug corrections regarding default + values.</p> + <p> + Own Id: OTP-7199 Aux Id: seq10864 </p> + </item> + </list> + </section> + + + +</section> + +<section><title>Asn1 1.5</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Now generating records in .hrl file for instances of + parameterized SEQUENCE or SET.</p> + <p> + Own Id: OTP-6835</p> + </item> + <item> + <p> + Optimization using bitstr in encode/decode functions. Active with + <c>[per_bin, optimize]</c> options.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-6882</p> + </item> + </list> + </section> + +</section> + +<section><title>Asn1 1.4.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Parsing and encoding/decoding of type constrained with + SIZE with extension is now recovered.</p> + <p> + Own Id: OTP-6763</p> + </item> + <item> + <p> + <c>inline</c> failed because trying to use a removed + module.</p> + <p> + Own Id: OTP-6769</p> + </item> + <item> + <p> + Fixed problem with a reference to a type from an object. + The failure was caused bye change of type name when using + <c>inline</c> option.</p> + <p> + Own Id: OTP-6770</p> + </item> + <item> + <p> + Handling of decode pattern for exclusive decode was false + in the case when an un-decoded component had more than one + following elements that should be decoded.</p> + <p> + Own Id: OTP-6786</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Now the asn1-compiler supports two root lists in SEQUENCE + and SET according to alternative three in + ComponentTypeLists (X.680 07/2002 section 24.1), i.e. + with an extension list between two ellipses.</p> + <p> + Own Id: OTP-5067 Aux Id: seq8452 </p> + </item> + </list> + </section> + +</section> + + <section> + <title>Asn1 1.4.5</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Merging modules by <c>inline</c> earlier disabled the + driver (used in modules generated with + [optimized]/[optimized,driver] options). Now this is + repaired.</p> + <p>Own Id: OTP-6601</p> + </item> + <item> + <p>Checking phase now aware of which module an INSTANCE OF + is declared in.</p> + <p>Own Id: OTP-6702</p> + </item> + </list> + </section> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>The compiler now handle all forms of ObjectSetSpec + according to ITU-T recommendation X.681 (ISO/IEC + 8824-2:2002).</p> + <p>Own Id: OTP-6698</p> + </item> + <item> + <p>Enhanced support of referencing object sets by + ObjectSetFromObjects.</p> + <p>Own Id: OTP-6707</p> + </item> + <item> + <p>Support for parameterized object in an object set.</p> + <p>Own Id: OTP-6717</p> + </item> + </list> + </section> + + <!-- p>There are also release notes for <url href="notes_history.html">older versions</url>.</p --> + </section> +</chapter> + diff --git a/lib/asn1/doc/src/notes_history.xml b/lib/asn1/doc/src/notes_history.xml new file mode 100644 index 0000000000..e6c423e79e --- /dev/null +++ b/lib/asn1/doc/src/notes_history.xml @@ -0,0 +1,1782 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2006</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>ASN1 Release Notes</title> + <prepared>Bertil Karlsson</prepared> + <responsible></responsible> + <docno></docno> + <approved></approved> + <checked></checked> + <date>06-04-24</date> + <rev></rev> + <file>notes_history.sgml</file> + </header> + <p>This document describes the changes made to the asn1 system + from version to version. The intention of this document is to + list all incompatibilities as well as all enhancements and + bug-fixes for every release of the asn1 application. Each release of asn1 + thus constitutes one section in this document. The title of each + section is the version number of asn1.</p> + + + <section> + <title>Asn1 1.4.4.14</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Data in info/0 in generated code is moved to attribute + asn1_info, thus vsn value remains the same if compiler + options for asn1-spec differs but the generated code is + the same.</p> + <p>Own Id: OTP-6462</p> + </item> + <item> + <p>Dialyzer warnings on asn1 are removed, i.e. dead code + removed.</p> + <p>Own Id: OTP-6506</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.13</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Now it is possible to use 'asn1config' and 'inline' + options together. It is also possible to use 'inline' on + a single file like: + <c>asn1ct:compile("MyASN1spec.asn",[inline])</c>.</p> + <p>Own Id: OTP-6405</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.12</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>As a complement to the option "{inline,OutputFile}" it is + now possible to use the option "inline". Then asn1 creates + an output file with the name of the source .set file.</p> + <p>Own Id: OTP-6314</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.11</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>When compiling an asn1 source that reference a type in + another source the compiler uses the asn1db file of the + other source to resolve the reference. It also tests + whether the other source has been updated since the + asn1db file was generated. This last test was to brutal + in that it exits compilation when no source was found, + even though a asn1db file existed. Changed behavior from + a brutal exit to a warning.</p> + <p>Own Id: OTP-6143</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.10</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>asn1 encoding failed on BIT STRING with constraint + <c>(SIZE (32..MAX))</c>.</p> + <p>Own Id: OTP-5932</p> + </item> + <item> + <p>Race condition removed in server for variable names for + generated code.</p> + <p>Own Id: OTP-6111</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.9</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Now exists a default function clause for table lookup of + a table constraint. This causes a nice error instead of a + crash. Did also remove some obsolete funs ({Mod,Fun}) in + generated code.</p> + <p>Own Id: OTP-5783</p> + </item> + <item> + <p>ASN1-compiler failed to derive a value out of an external + reference in some certain cases, when compiling specs so + that the spec with the reference was compiled before the + spec with the defined value.</p> + <p>Own Id: OTP-5812 Aux Id: seq10133 </p> + </item> + <item> + <p>The documentation of how records of embedded types are + named is extended and made clearer by examples and rules. + The section "Naming of Records in .hrl Files" in the + User's Guide is added.</p> + <p>Own Id: OTP-5831 Aux Id: seq10133 </p> + </item> + <item> + <p>The compiler failed to give right name to record/function + of a parameterized type that was referenced through + another instance of a parameterized type in another + module. The fault occurred when modules were compiled in a + certain order. Now the compiler resolves the name + correctly.</p> + <p>Own Id: OTP-5832 Aux Id: seq10133 </p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.8</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>The dynamic sort of SET OF values now correctly handles + values encoded in the "ber_bin, der, optimize" mode, the + value of a SET OF is a list of binaries.</p> + <p>Own Id: OTP-5687</p> + </item> + <item> + <p>Bad code was generated for an INTEGER with value-range. If + the value that was encoded had a lower bound with + negative value it caused a crash. This bug is now + removed.</p> + <p>Own Id: OTP-5688 Aux Id: seq10049 </p> + </item> + <item> + <p>Compiler now handles wrong include paths by returning an + error if a referenced module is not available.</p> + <p>Own Id: OTP-5689</p> + </item> + <item> + <p>The bug causing a runtime error when encoding a type + defined by: <c>BIT STRING {a(1),b(2)}</c> with the value + [] in <c>per_bin</c> mode is now removed.</p> + <p>Own Id: OTP-5710 Aux Id: seq10066 </p> + </item> + </list> + </section> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Better handling of filename paths</p> + <p>Own Id: OTP-5701</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.7</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Effective constraint for <c>per</c> now corrected. For + instance <c>INTEGER (0|15..269)</c> didn't work properly.</p> + <p>Own Id: OTP-5477 Aux Id: OTP-5511 </p> + </item> + <item> + <p>Adjusted compiler so that functions in generated code + only are exported once.</p> + <p>Own Id: OTP-5509</p> + </item> + <item> + <p>Fixed the compiler failure when handling a value range + constraint with an extension mark that had the Lower + bound and/or Upper bound values as an external reference + to a defined value.</p> + <p>Own Id: OTP-5511 Aux Id: OTP-5466 </p> + </item> + <item> + <p>Removed sorting of elements for SEQUENCE OF. It shall + only be done in SET OF.</p> + <p>Own Id: OTP-5602</p> + </item> + <item> + <p>Corrected code that generated code causing badarith + warning.</p> + <p>Own Id: OTP-5616</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.6</title> + + <section> + <title>Known Bugs and Problems</title> + <list type="bulleted"> + <item> + <p>Compiler now correctly crashes when compiling bad values. + Failed for instance on INTEGER value that was a reference + to a defined value. Also solved problem with a union + constraint on an INTEGER.</p> + <p>Own Id: OTP-5457</p> + </item> + <item> + <p>Additional coverage of object set syntax.</p> + <p>Own Id: OTP-5466</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.5</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>A bug due to representation of open_type values is now + fixed. It could cause problem if one used the EXTERNAL + type.</p> + <p>Own Id: OTP-5302</p> + </item> + <item> + <p>Due to an internal error the same code could have been + generated more than one time. This happened for the + exclusive decode functionality.</p> + <p>Own Id: OTP-5378</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.4</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>Empty objects caused problems. There was trouble when an + object set referenced imported objects that in turn + referenced imported types. Lacked support of + SelectionType in object. All these have been attended.</p> + <p>Own Id: OTP-5240</p> + </item> + </list> + </section> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p>Now it is possible to inline asn1 run-time functionality + in the module generated by the asn1 compiler. Thus, it + will be only one module doing all encoding/decoding.</p> + <p>Own Id: OTP-5243</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.3</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>A class that was referenced in two steps caused a + compiler failure. It is now corrected.</p> + <p>Own Id: OTP-5103</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>Optionally make it possible to get the un-decoded rest along with + the return value. Compile with option <em>undec_rest</em>.</p> + <p>Own Id: OTP-5104</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.2</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>An error due to unchecked referenced imported type resulted + in missing tag in some table constraint cases. This error is + now corrected. Error occurred during decode in + <c>ber_bin optimized</c> version.</p> + <p>Own Id: OTP-5022</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4.1</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>When a referenced value in another module in turn referenced a + defined value the compilation crashed. This is due to the new + routines for compilation, that external references are resolved + during compilation, and not by the order in which modules are + compiled. This error is now corrected.</p> + <p>Own Id: OTP-4970</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.4</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>Functionality for parameterized class is added. Parsing failures on + WithSyntax spec is corrected.</p> + <p>Own Id: OTP-4893</p> + </item> + <item> + <p>The failure due to Parameterized Type when parameter is an object + set is corrected.</p> + <p>Own Id: OTP-4894</p> + <p>Aux Id: OTP-4893</p> + </item> + <item> + <p>Object Identifier values with two components and the first was a + value reference failed due to parsing conflicts. Now it is + corrected.</p> + <p>Own Id: OTP-4895</p> + </item> + <item> + <p>The erroneous comparison of file name and asn1 module name could + cause compilation failure. The situation for this failure is rare, + it requires that other processes modifies the compiled file during + the compilation procedure. It is now fixed.</p> + <p>Own Id: OTP-4944</p> + <p>Aux Id: seq8429</p> + </item> + <item> + <p>Selective decode was ignored when exclusive decode spec in asn1 + configfile was missing. Selective decode failed when the selected + type was the top type. These bugs are now removed.</p> + <p>Own Id: OTP-4953</p> + <p>Aux Id: seq8436</p> + </item> + <item> + <p>The test interface asn1ct:test/1,2,3 and asn1ct:value/2 failed for + open type and EXTERNAL. The bug is now removed.</p> + <p>Own Id: OTP-4955</p> + <p>Aux Id: seq8438)</p> + </item> + <item> + <p>Two equal functions were generated for two components referencing + the same type when they were picked by the action "parts". The bug + is now fixed.</p> + <p>Own Id: OTP-4957</p> + <p>Aux Id: seq8434</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>INTEGER with named number list and ENUMERATED can now be sub + constrained with names from the names list.</p> + <p>Own Id: OTP-4917</p> + </item> + <item> + <p>Now there is support for SelectionType (X 680 section 29)</p> + <p>Own Id: OTP-4918</p> + </item> + <item> + <p>The compiler now resolves circular dependencies. When asn1 specs + IMPORTS from each other so that there are circular dependencies.</p> + <p>Own Id: OTP-4919</p> + </item> + <item> + <p>Now is the asn1 type UTF8String supported. For user instructions + see documentation.</p> + <p>Own Id: OTP-4965</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.3.1</title> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <list type="bulleted"> + <item> + <p>The <c>{internal_error,...,{ unrecognized_type,...}}</c> + error occurring for a SET type when compiling with options + <c>[ber_bin,optimize,der]</c> is now corrected.</p> + <p>Own Id: OTP-4866</p> + </item> + <item> + <p>False encode of BIT STRING in PER (per_bin,optimize) is fixed. The error occurred when there was a type like BIT STRING (SIZE(C)) and C > 16.</p> + <p>Own Id: OTP-4869</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.3</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>Functionality to handle parameterized object sets have been added.</p> + <p>Own Id: OTP-4832</p> + </item> + <item> + <p>Bug causing duplicated function definitions using exclusive decode is removed.</p> + <p>Own Id: OTP-4833)</p> + </item> + <item> + <p>The race condition when loading asn1 driver is solved.</p> + <p>Own Id: OTP-4835</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>A specialized decode, <em>selective decode</em> is now available. It decodes a chosen internal sub-type of a constructed type.</p> + <p>Own Id: OTP-4856)</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.2.2</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>Release of Asn1 1.4.2.1 on R7B, The functionality is the same, but + the layer between the driver and the asn1 erlang code is different.</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.2.1</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>ObjectDescriptor does now work as part of a sequence, set or choice.</p> + <p>Own Id: OTP-4773</p> + </item> + <item> + <p>When a SEQUENCE that have extension mark was decoded inside a + SEQUENCE OF it could cause decode error due to a failure in + restbytes2. It is now corrected.</p> + <p>Own Id: OTP-4791)</p> + </item> + <item> + <p>Now the bug is fixed that caused the compiler crash on an untagged + optional open type.</p> + <p>Own Id: OTP-4792</p> + </item> + <item> + <p>The earlier exit caused by bad in-data is now fixed so it will + return an {error,Reason} tuple.</p> + return an {error,Reason} tuple.</p> + <p>Own Id: OTP-4797</p> + </item> + <item> + <p>Open type encoded with indefinite length is now correct decoded.</p> + <p>Own Id: OTP-4798</p> + </item> + <item> + <p>Now is absent optional open types handled correctly.</p> + <p>Own Id: OTP-4799</p> + </item> + <item> + <p>Now is the necessary functions available for sorting in run-time of + SET and SET OF components.</p> + <p>Own Id: OTP-4809</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.2</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>When a component in a SEQUENCE is a CHOICE (or reference to a CHOICE) + and the SEQUENCE's component and one of the alternatives in the CHOICE + have identical names, an error may occur if one doesn't use the + 'optimized' versions of the compiler. In the older versions (<c>ber, ber_bin, per, per_bin</c>) one could optionally apply a value of a + component as <c>{ComponentName,Value}</c>, and the generated code + chooses the second element of the tuple. However, a value of a CHOICE + must be applied as a tuple: <c>{AlternativeName,Value}</c>. Thus, + in the rare case described above and if the value to the SEQUENCE's + component is not in a tuple notation the + <c>{AlternativeName,Value}</c> will be peeled off in the SEQUENCE + and the value fed to the CHOICE will only be the <c>Value</c> + part of <c>{AlternativeName,Value}</c>, and the encoder crashes. + The best way to avoid this is to use the optimized version of the + compiler where the unnecessary tuple notation + <c>{ComponentName,Value}</c> no longer is allowed. Since it isn't + possible to solve this bug in the compiler.</p> + <p>Own Id: OTP-4693</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>Exclusive decode is enabled by a compiler option and a configuration + file. It makes it possible to leave parts of an ASN.1 encoded message + un-decoded.</p> + <p>Own Id: OTP-4744</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.1.1</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>The documentation about how extensibility is handled is now corrected.</p> + <p>Own Id: OTP-4663</p> + </item> + <item> + <p>Function in object now calls the exported function</p> + <p>Own Id: OTP-4665</p> + </item> + <item> + <p>Now is tags for ObjectClassFieldType analyzed correctly.</p> + <p>Own Id: OTP-4666</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4.1</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>Now is the Default value for an ENUMERATED returned as the name from + the NamedList when decoding.</p> + <p>Own Id: OTP-4633</p> + </item> + <item> + <p>It was an internal failure when permitted alphabet constraint existed + together with for instance a size constraint. E.g. when a + referenced type is constrained by a size constraint and the defined + type in turn is constrained by a permitted alphabet constraint.</p> + <p>Own Id: OTP-4559</p> + </item> + <item> + <p>Record is generated in hrl file for a CHOICE with extension mark + that has an internal SEQUENCE/SET definition.</p> + <p>Own Id: OTP-4560</p> + </item> + <item> + <p>Now is the length of a SEQUENCE/SET OF correctly encoded/decoded (PER).</p> + <p>Own Id: OTP-4590</p> + </item> + <item> + <p>The problem with unordered decoded terms when a component is a + ObjectClassFieldType has been solved.</p> + <p>Own Id: OTP-4591</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>More complex definitions with TableConstraints where the SimpleTable + and ComponentRelation are on different levels is now fully + supported.</p> + <p>Own Id: OTP-4631</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.4</title> + + <section> + <title>Fixed errors and malfunctions</title> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>Each generated .erl file have now a function info/0 that returns + information about the used compiler version and options.</p> + <p>Own Id: OTP-4373</p> + </item> + <item> + <p>When compiling an ASN.1 module the compiler generates an Erlang module + that is compiled by the Erlang compiler. Earlier it was not possible to + add options to the final step, the Erlang compilation. By adding any + option that is not recognized as a specific ASN.1 option it will be + passed to the final step like: <c>erlc +debug_info Mymodule.asn</c> or + <c>asn1ct:compile('Mymodule',[debug_info])</c>.</p> + <p>Own Id: OTP-4491</p> + </item> + <item> + <p>Earlier one couldn't multi file compile modules that had different + tagdefault, which now is possible. Equal Type/Value names in different + modules are resolved by renaming (concatenate type name and module + name): If two types with the same name T exist in module A and module B + they will get the new names TA and TB.</p> + <p>(Own Id: OTP-4492)</p> + <p>Aux Id: OTP-3983</p> + </item> + <item> + <p>BER: Encode/decode of data have been significantly improved. By use of + the compiler options <c>ber_bin</c> and <c>optimize</c>, + optimized code will be generated and the optimized run-time module will + be used.</p> + <p>Own Id: OTP-4493</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.3.3.1</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>Proper length encoding and padding implemented for a <c>BIT STRING</c> with + NamedNumberList and size constraint as value range. This functionality + didn't work in the rare occasion when the NamedNumberList is shorter + than the lower bound of the constraint.As in this example: + <c>TestS ::= BIT STRING {a (0),b (1)} (SIZE (3..8))</c></p> + <p>(Own Id: OTP-4353)</p> + </item> + <item> + <p>Bug in compiler, when an <c>OBJECT IDENTIFIER</c> value consisting of + two identifiers (Defined values or Name form identifiers) was falsely + interpreted causing a compiling error is now corrected.</p> + <p>(Own Id: OTP-4354)</p> + </item> + <item> + <p>Internal error in check phase that caused crash on + <c>ObjectClassFieldType</c> in ber_bin is corrected.</p> + <p>(Own Id: OTP-4390)</p> + </item> + <item> + <p>Tags for open types are handled according to <c>x.680 30.6c</c>, i.e. + open types shall not be tagged <c>IMPLICIT.</c></p> + <p>(Own Id: OTP-4395)</p> + <p>(Aux Id: OTP-4390)</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.3.3</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>Now gives the compiler an appropriate error report when exported + undefined types are detected.</p> + <p>(Own Id: OTP-4129)</p> + </item> + <item> + <p>The type <c>ObjectDescriptor</c> is now supported, previously the + implementation of encode/decode for this rarely used type was + incomplete.</p> + <p>(Own Id: OTP-4161)</p> + <p>(Aux Id: seq7165)</p> + </item> + <item> + <p>In case of per and compact_bit_string the rightmost byte were erroneous + truncated when the rightmost bits of that byte were zeros. This is now + corrected.</p> + <p>(Own Id: OTP-4200)</p> + </item> + <item> + <p>Bad match of return-value from decode_length in skipvalue/3 has now been + fixed.</p> + <p>(Own Id: OTP-4232)</p> + </item> + <item> + <p>Now is decode of ENUMERATED handled correctly, when tagged EXPLICIT.</p> + <p>(Own Id: OTP-4234)</p> + </item> + <item> + <p>The compiler now parses and handles the ValueFromObject construct.</p> + <p>(Own Id: OTP-4242)</p> + </item> + <item> + <p>Now does the compiler handle the case when the object set in simple + table and componentrelation constraints is of a CLASS without a UNIQUE + field. In this case is the octets, which is assumed to be encoded, + encoded as an open type.</p> + <p>(Own Id: OTP-4248)</p> + <p>(Aux Id: OTP-4242)</p> + </item> + <item> + <p>Compiler handles objects in AdditionalElementSetSpec in ObjectSetSpec, + i.e. the objects that are referred to after the ellipses in an object set.</p> + <p>(Own Id: OTP-4275)</p> + </item> + <item> + <p>Now are values with a component of type CHOICE encoded with indefinite + length correctly decoded.</p> + <p>(Own Id: OTP-4358)</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>The language constructs (from the old 1988 standard) <c>ANY</c> + and <c>ANY DEFINED BY</c> are now implemented.</p> + <p>(Own Id: OTP-2741)</p> + <p>(Aux Id: seq 1188)</p> + </item> + <item> + <p>Now it is checked in run-time if a <c>OBJECT IDENTIFIER</c> value is invalid</p> + <p>(Own Id: OTP-4235)</p> + </item> + <item> + <p>The ASN.1 types EXTERNAL,EMBEDDED PDV and CHARACTER STRING now have full support in the compiler.</p> + <p>(Own Id: OTP-4247)</p> + </item> + <item> + <p>A driver in C does the final job (complete) of the PER encoding when + files are compiled with <c>per_bin</c> and <c>optimize</c> flags. + It gives significant faster encoding for PER.</p> + <p>(Own Id: OTP-4355)</p> + </item> + <item> + <p>Encode and decode of PER encoding has been made faster by moving + analysis done in run-time to compile-time. These optimizations are + available by compiling ASN.1 files with options <c>per_bin</c> and + <c>optimize</c>.</p> + <p>(Own Id: OTP-4381)</p> + <p>(Aux Id: OTP-4355)</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.3.2</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>Now does the compiler check values (including referenced values), and + formats the value so it is suitable to use as input to encoding + functions.</p> + <p>(Own Id: OTP-3277)</p> + <p>(Aux Id: OTP-4103)</p> + </item> + <item> + <p>Unnecessary external function calls in generated code are now generated + as internal function calls.</p> + <p>(Own Id: OTP-4073)</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>Now is Information Objects supported in BER encoding.</p> + <p>(Own Id: OTP-3980)</p> + <p>(Aux Id: OTP-3979 OTP-3978)</p> + <p></p> + </item> + <item> + <p>PER: A new option <c>per_bin</c> is now supported. When used the + generated encode/decode functions use binaries and the bit syntax to + get better performance than the old <c>per</c> variant which used + lists. All values input to encode and returned from decode are + compatible between <c>per</c> and <c>per_bin</c> except for + open types which are represented as binaries with per_bin and octet + lists with per. We recommend that you use per_bin instead of per from + now on, the use of binaries will be the default in coming versions and + all improvements and optimizations for PER will be concentrated to that + solution.</p> + <p>(Own Id: OTP-4094)</p> + <p></p> + </item> + <item> + <p>Support for DER implemented. Used by flag +der when compiling. Include + the full BER encoding plus: sorting of SET components, sorting of + encoded elements in SET OF, full check of default values in SET and + SEQUENCE. See new documentation on DER in user_guide sections 1.3.1; + 1.4.11; 1.4.12; 1.4.14; 1.4.16 and 1.10, in the reference manual for + asn1ct.</p> + <p>(Own Id: OTP-4103)</p> + <p></p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.3.1</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>Do not generate record in .hrl file for SET types</p> + <p>Own Id: OTP-4025</p> + </item> + <item> + <p>Fixed internal error when using BIT STRINGs with Named Number List in combination with <c>compact_bit_string</c> and <c>ber_bin</c> options.</p> + <p>Own Id: OTP-4026</p> + <p>Aux Id: OTP-3982</p> + </item> + <item> + <p>The atom 'com' can now be used in ENUMERATED as an EnumerationItem.</p> + <p>Own Id: OTP-4037</p> + <p>Aux Id: Seq 7036</p> + </item> + <item> + <p>ber: Now it is possible (again) to encode data format "{Type,Value}" in a SEQUENCE OF RequestParameter, when RequestParameter is of type ENUMERATED. The {Type,Value} + notation is not recommended for use, it is redundant and exist only for very ancient backwards compatibility reasons. The "feature" might be removed in forthcoming versions.</p> + <p>Own Id: OTP-4057</p> + <p>Aux Id: Seq 7066</p> + </item> + <item> + <p>A bug in the parser, that caused failure on COMPONENTS OF is now removed.</p> + <p>Own Id: OTP-4058</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.3</title> + + <section> + <title>Known problems</title> + <list type="bulleted"> + <item> + <p>The compiler will now check that a value referenced by name + does exist.</p> + <p>Own Id: OTP-3277</p> + </item> + <item> + <p>BER:Decode of a type T ::= SEQUENCE OF C fails if C is encoded with indefinite length. + This is know corrected.</p> + <p>Own Id: OTP-3811</p> + <p>Aux Id: seq5040</p> + </item> + </list> + </section> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>The new parser handles imports when one import ends with FROM, a modulename and a reference to a objectidentifier followed by imports from other modules.</p> + <p>Own Id: OTP-3463</p> + </item> + <item> + <p>The compiler did not check that a name mentioned as EXPORTED + actually is defined within the module. + This is now corrected.</p> + <p>Own Id: OTP-3659</p> + </item> + <item> + <p>Removed bug caused by use of nested indefinite length</p> + <p>Own Id: OTP-3994</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>Now supporting most common use of parameterization according to X.683</p> + <p>(Own Id: OTP-3978)</p> + </item> + <item> + <p>PER: Now supporting most common use of Information Objects according to X.681. A new parser has been implemented. The error messages due to syntax errors are slightly different than previous. TableConstraint part of X.682 now also supported.</p> + <p>Own Id: OTP-3979</p> + </item> + <item> + <p>New compiler option added: <c>ber_bin</c>. The compiler generates code with new bit syntax. Run time functions uses bit syntax when feasible. Higher encoding/decoding performance in most cases. Se also comments for Asn1 1.2.9.3.</p> + <p>Own Id: OTP-3981</p> + </item> + <item> + <p>A more compact format of BIT STRING in Erlang is now available by use of the compiler option <c>compact_bit_string</c>. It is much faster when large BIT STRINGs are used.</p> + <p>Own Id: OTP-3982</p> + </item> + <item> + <p>Now possible to merge many ASN.1 input files to one Erlang file by use of a configuration file that lists the ASN.1 files.</p> + <p>Own Id: OTP-3983</p> + </item> + <item> + <p>New documentation in <em>User's Guide</em> in section:</p> + <p>3.1: New compile-time functions and options are described.</p> + <p>4.6: New compact format of BIT STRING is described.</p> + <p>4.8: Additional comments on character strings.</p> + <p>7: New section describing ASN.1 Information Objects.</p> + <p>8: New section describing Parameterization.</p> + <p><em>Reference Manual/asn1ct</em> New compile options are described.</p> + <p>Own Id: OTP-3984</p> + <p>Aux Id: OTP-3978, OTP-3979, OTP-3981, OTP-3982, OTP-3983</p> + </item> + <item> + <p>Added the functionality to invoke ASN1Mod:encode (and decode).</p> + <p>Own Id: OTP-3985</p> + </item> + <item> + <p>Performance improvements by removing not necessary use of apply when calling asn1rt:encode. Also other general improvements.</p> + <p>Own Id: OTP-3988</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.2.9.6</title> + + <section> + <title>Known problems</title> + <list type="bulleted"> + <item> + <p>The compiler does not check that an exported name actually exists in the ASN.1 module.</p> + <p>Own Id: OTP-3659</p> + </item> + <item> + <p>The compiler does not check that a value referenced by name does exist.</p> + <p>Own Id: OTP-3277</p> + </item> + <item> + <p>BER: The compiler does not take the extensions into account when checking if + the tags are unique in a SEQUENCE or SET.</p> + <p>Own Id: OTP-3304</p> + </item> + </list> + </section> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>PER: Trailing zeroes in a BIT STRING declared without named bits + should not be removed in the encodings.</p> + <p>Own Id: OTP-3830</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.2.9.5</title> + + <section> + <title>Known problems</title> + <p>Same as for 1.2.9.3.</p> + </section> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>PER: Constraints are not propagated when types are + referring to each other. Example:</p> + <code type="none"> + + TBCD-STRING ::= OCTET STRING + + LAI ::= TBCD-STRING (SIZE(3)) </code> + <p>The size constraint is not passed on during encode,decode + resulting in wrong encoding for PER , it is + coded with a length determinant which should not be there + when the length is fixed. For BER this does not matter because the constraints does + not affect the encodings.</p> + <p>Own Id: OTP-3713</p> + </item> + <item> + <p>The generated code gets wrong if there are several ENUMERATED fields in a SEQUENCE or SET, this is now corrected.</p> + <p>Own Id: OTP-3796</p> + </item> + <item> + <p>BER:Decode of a type T ::= SEQUENCE OF C fails if C is encoded with indefinite length. + This is know corrected.</p> + <p>Own Id: OTP-3811</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.2.9.3</title> + + <section> + <title>Known problems</title> + <list type="bulleted"> + <item> + <p>The compiler does not check that an exported name actually exists in the ASN.1 module.</p> + <p>Own Id: OTP-3659</p> + </item> + <item> + <p>The compiler does not check that a value referenced by name does exist.</p> + <p>Own Id: OTP-3277</p> + </item> + <item> + <p>BER: The compiler does not take the extensions into account when checking if + the tags are unique in a SEQUENCE or SET.</p> + <p>Own Id: OTP-3304</p> + </item> + </list> + </section> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>This version supports soft upgrade from versions 1.2.6 1.2.7.</p> + </item> + <item> + <p>In an ENUMERATED type like this:</p> + <code type="none"> +\011\011T ::= ENUMERATED { blue, green} </code> + <p>The symbols was encoded/decoded with the wrong values, i.e in + reverse order. This is now corrected.</p> + <p>Own Id: OTP-3700</p> + </item> + <item> + <p>PER: OCTET STRING with Size constrained to a single value i.e fixed size + was treated wrong during encode and decode. This is now corrected.</p> + <p>Own Id: OTP-3701</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>There is now a new compiler option <c>ber_bin</c> available that can be used to + generate encode/decode functions for BER that uses the new "bit-syntax" to + make the functions more efficient. The <c>ber_bin</c> option is used + as an alternative to the <c>ber</c> and <c>per</c> options.</p> + <p>The encode function then produces a + possibly nested list of binaries and integer lists. The decode function does + in this case require a single binary as input instead of a list. + The modules generated with this option require that you have an R7A or later + system, otherwise they will not compile and the runtime module asn1rt_ber_bin + can not be executed.</p> + <p>The ber_bin option is not officially supported in this version (will be + in a later version) but is provided for those who want to try it. + It should be significantly faster at decode and is slightly faster at encode. + Exactly how performance differs between this binary approach and the + list approach depends highly on the type of input. + Another thing worth noting is that both approaches still have a lot of + solutions in common which can be improved a lot to gain even better + performance.</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.2.9.2</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>BER: Encode/decode of extension components did not work properly. This is now corrected.</p> + <p>Own Id: OTP-3395</p> + <p>Aux Id: </p> + <p>PER:The encode/decode of NULL as an open type has been corrected. An open type must always have a length of at least 1 byte even if the contained + value (e.g NULL) encodes to nothing.</p> + <p>Own Id: OTP-3496</p> + <p>Aux Id: </p> + </item> + <item> + <p>BER:In the current implementation extension components of a SEQUENCE are required + to be present when they are specified as mandatory. This is an error, all extension + components are "optional" even if they are not specified to have the OPTIONAL or + DEFAULT property. This is now corrected.</p> + <p>Own Id: OTP-3278</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>The ASN.1 language feature <c>COMPONENTS OF</c> is now implemented.</p> + <p>Own Id: OTP-2515</p> + </item> + <item> + <p>The encoding and decoding of ENUMERATED and + INTEGER with NamedNumbers is made more efficient and thus + faster in runtime.</p> + <p>Own Id: OTP-3464</p> + <p>Aux Id:</p> + </item> + <item> + <p>Added support for encode/decode of open type which is + constrained to a specific type. Previously the value of + an open type had to be a list of octets, but now the Erlang + representation of the specific type used in the constraint + is used both as input to encode and as output from decode.</p> + <p>Own Id: OTP-3569</p> + <p>Aux Id: </p> + </item> + <item> + <p>PER: GeneralString, GraphicalString etc. i.e all strings + that are not so called "known-multiplier character + string types" are now supported by the runtime + encode/decode functions.</p> + <p>Own Id: OTP-3573</p> + <p>Aux Id:</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.2.6</title> + + <section> + <title>Known problems</title> + <list type="bulleted"> + <item> + <p>The ASN.1 language feature <c>COMPONENTS OF</c> is not implemented.</p> + <p>Own Id: OTP-2515</p> + </item> + <item> + <p>The compiler does not check that a value referenced by name does exist.</p> + <p>Own Id: OTP-3277</p> + </item> + <item> + <p>BER:In the current implementation extension components of a SEQUENCE are required + to be present when they are specified as mandatory. This is an error, all extension + components are "optional" even if they are not specified to have the OPTIONAL or + DEFAULT property.</p> + <p>Own Id: OTP-3278</p> + </item> + <item> + <p>BER: The compiler does not take the extensions into account when checking if + the tags are unique in a SEQUENCE or SET.</p> + <p>Own Id: OTP-3304</p> + </item> + </list> + </section> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>This version supports soft upgrade from versions 1.1.1, 1.1.5 and 1.1.6. + Two new runtime modules <c>asn1rt_ber_v1</c> and + <c>asn1rt_per_v1</c> are delivered together with the old ones. This makes + it possible to continue running applications with modules generated with the + previous version of the asn1 compiler while modules generated by this version + will use the new runtime modules. Note that it is only advice-able to continue + running old generates if they are working perfectly and have no need + for the corrections made in this version of the asn1 application.</p> + </item> + <item> + <p>BER: SEQUENCEs encoded with indefinite length was not correctly decoded. + This in now corrected.</p> + <p>Own Id: OTP-3352</p> + <p>Aux Id: Seq 4100</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.2.4</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>The compiler now detects multiple definitions of values and types and reports this as + an error. Previously this was detected when the generated Erlang module was compiled.</p> + <p>Own Id: OTP-3105</p> + </item> + <item> + <p>BER: An error regarding encoding of <c>ENUMERATED</c> present in asn1-1.1.1 + is corrected. The new version 1.1.2 of asn1 containing this correction is + delivered as a "patch".</p> + <p>Own Id: OTP-3169</p> + </item> + <item> + <p>BER: Decoding of <c>SEQUENCE OF</c> and <c>SET OF</c> with indefinite length is corrected. + The correction was first delivered in version 1.1.2.</p> + <p>Own Id: OTP-3170</p> + </item> + <item> + <p>BER: Encoding and decoding of <c>ENUMERATED</c> + with extensionmark + "..." did not work (crashed with a runtime error). This + has now been corrected. If an unknown enumerated value is + decoded (for an extensible enumerated type) + it is returned as <c>{asn1_enum,Value}</c> where + <c>Value</c> is an integer. Enumerated values in this format + are also accepted by the encoder. + ASN.1 modules containing + <c>ENUMERATED</c> with extensionmark should be + recompiled with the corrected + version of the compiler. The BER runtime functions are also + corrected. + Note that this correction has already been delivered as a + bugfix for R4B (OTP-2951).</p> + <p>Own Id: OTP-3202</p> + <p>Aux Id: Seq3745</p> + </item> + <item> + <p>BER: The primitive/constructed bit in the tag byte of an encoding + is not correct when it comes to user defined tags. + For example in </p> + <code type="none"> + T ::= [2] SEQUENCE { a BOOLEAN} </code> + <p>the tag 2 does not get the constructed bit set which it should. + This is now corrected.</p> + <p>Own Id: OTP-3241</p> + </item> + <item> + <p>The decoder can now detect if there are unexpected bytes + remaining when all components of a sequence are decoded. + The decoder will then return <c>{error,{asn1{unexpected,Bytes}}}</c></p> + <p>Own Id: OTP-3270</p> + </item> + <item> + <p>Values of type <c>OBJECT IDENTIFIER</c> was sometimes returned as an Erlang list + (ASN.1 constants) and sometimes as a tuple (from the decode functions). This is now + changed so that <c>OBJECT IDENTIFIER</c> values always are represented as an Erlang + tuple.</p> + <p>Own Id: OTP-3280</p> + </item> + <item> + <p>PER:The encode/decode functions could not handle integers with + a range greater than 16#7ffffff. This limit is now removed.</p> + <p>Own Id: OTP-3287</p> + </item> + <item> + <p>PER: The encoding/decoding of the length for a SET OF/SEQUENCE OF + was wrong if there was a size constraint. This is now corrected.</p> + <p>Own Id: OTP-3291</p> + </item> + <item> + <p>PER: Encoding of a constrained INTEGER (range > 16 k) was wrong for + the value 0. This is now corrected.</p> + <p>Own Id: OTP-3306</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>The ASN.1 module name and the filename where the ASN.1 + specification resides must match each other (has always been the + case). This is now checked by the compiler. The check requires that + the names match in a case or case insensitive way depending on the + characteristics for the current system.</p> + <p>Own Id: OTP-1843</p> + </item> + <item> + <p>PER: Encode/decode of an extension value (i.e not within the root set) for + <c>ENUMERATED</c> did not work properly. This is now corrected. + If an unknown enumerated value is + decoded (for an extensible enumerated type) + it is returned as <c>{asn1_enum,Value}</c> where + <c>Value</c> is an integer. Enumerated values in this format + are also accepted by the encoder (if the value is >= the number of known + extension values).</p> + <p>Own Id: OTP-2930</p> + </item> + <item> + <p>Unnecessary printouts from the compiler are removed. + The compiler version and the compiler options are now + printed to stdout.</p> + <p>Own Id: OTP-3276</p> + </item> + <item> + <p>In order to better suite the use of ASN.1 in embedded systems only + the modules needed in runtime are now listed in the <c>.app</c> file.</p> + <p>Own Id: OTP-3279</p> + </item> + <item> + <p>The compiler now supports extensionmarker in constraint specifications. + Example:</p> + <code type="none"> +INTEGER (0..10, ...) </code> + <p>In previous version this was reported as a syntax error.</p> + <p>Own Id: OTP-3281</p> + </item> + <item> + <p>A very limited part of ITU-T recommendation X.681 + Abstract Syntax Notation One (ASN.1): Information + object specification is now implemented. Specifically \011 + TYPE IDENTIFIER is recognized by the compiler.</p> + <p>Own Id: OTP-3325</p> + </item> + <item> + <p>Parameterization of ASN.1 specifications (ITU-T X.683) is now + supported to a limited extent.</p> + <p>Own Id: OTP-3326</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.1.3.1</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>BER Encoding and decoding of <c>ENUMERATED</c> + with extensionmark + "..." did not work (crashed with a runtime error). This + has now been corrected. If an unknown enumerated value is + decoded (for an extensible enumerated type) + it is returned as <c>{asn1_enum,Value}</c> where + <c>Value</c> is an integer. Enumerated values in this format + are also accepted by the encoder. + ASN.1 modules containing + <c>ENUMERATED</c> with extensionmark should be + recompiled with the corrected + version of the compiler. The BER runtime functions are also + corrected. + Note that this correction has already been delivered as a + bug-fix for R4B (OTP-2951).</p> + <p>Own Id: OTP-3202</p> + <p>Aux Id: Seq3745</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.1.1</title> + + <section> + <title>Known problems</title> + <list type="bulleted"> + <item> + <p>The syntactic construct <c>COMPONENTS OF</c> is not + implemented.</p> + <p>Own Id: OTP-2515</p> + </item> + <item> + <p><c>ANY</c> and <c>ANY DEFINED BY</c> are currently not + supported.</p> + <p>Own Id: OTP-2741</p> + <p>Aux Id: seq 1188</p> + </item> + <item> + <p>Multiple definitions of the same Type or Value is not detected + by the compiler. The error occurs when the generated Erlang + module is compiled.</p> + <p>Own Id: OTP-3105</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.1</title> + + <section> + <title>Known problems</title> + <list type="bulleted"> + <item> + <p>The primitive/constructed bit in the tag byte of an encoding + is not correct when it comes to user defined tags. + For example in</p> + <code type="none"> + T ::= [2] SEQUENCE { a BOOLEAN} </code> + <p>the tag 2 does not get the constructed bit set which it should. + This is now corrected.</p> + <p>Own Id: OTP-3241</p> + </item> + </list> + </section> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>The BER decoder failed to decode certain nested data types + where <c>IMPLICIT</c> tags where involved. + This is now corrected.</p> + <p>Own Id: OTP-2719</p> + <p>Aux Id: seq 1148</p> + </item> + <item> + <p>The handling of types with extension marker "..." is corrected. + Earlier each SEQUENCE and SET with an extension marker got an + extra field named <c>asn1_EXT</c> in the generated record. + This was a mistake and that field is now removed (concerns + both BER and BER).</p> + <p>Own Id: OTP-2724</p> + <p>Aux Id: seq 1148, OTP-2719</p> + </item> + <item> + <p>The decoder (both BER and PER) could not handle unnamed + bits of a <c>BIT STRING</c> if the type had any + named bits declared. This is now corrected and the unnamed + bits are returned as <c>{bit,Pos}</c> where Pos is the bit + position. The <c>{bit,Pos}</c> can be used as input to the + encoder too.</p> + <p>Own Id: OTP-2725</p> + <p>Aux Id: seq 1148,OTP-2719,OTP-2724</p> + </item> + <item> + <p>The functions <c>asn1rt:decode</c> and <c>asn1ct:decode</c> + did not always return <c>{ok,Result}</c> or + <c>{error,Reason}</c> as documented. This is now corrected.</p> + <p>Own Id: OTP-2730</p> + <p>Aux Id: seq 1158</p> + </item> + <item> + <p>The compiler did not accept CHOICE types as components + of a SEQUENCE or SET when + the modules tag default was IMPLICIT. + Example:</p> + <code type="none"> +C ::= CHOICE { ......} +A ::= SEQUENCE { +a [1] C, -- This was not accepted +..... </code> + <p>This was an error + caused by a misinterpretation of the ASN.1 standard. This + is now corrected.</p> + <p>Own Id: OTP-2731</p> + <p>Aux Id: seq 1163</p> + </item> + <item> + <p>When decoding a SEQUENCE A which contains an OPTIONAL component + b which is a SEQUENCE with mandatory components, the decoder + does not detect as an error that a mandatory component of b + is missing. The same error could occur also in other cases + with nested types and optional components of SEQUENCE or SET. + This is now corrected.</p> + <p>Own Id: OTP-2738</p> + <p>Aux Id: seq 1183</p> + </item> + <item> + <p>BER Encoding and decoding of <c>ENUMERATED</c> + with extensionmark + "..." did not work (crashed with a runtime error). This + has now been corrected. If an unknown enumerated value is + decoded (for an extensible enumerated type) + it is returned as <c>{asn1_enum,Value}</c> where + <c>Value</c> is an integer. Enumerated values in this format + are also accepted by the encoder. + ASN.1 modules containing + <c>ENUMERATED</c> with extensionmark should be + recompiled with the corrected + version of the compiler. The BER runtime functions are also + corrected.</p> + <p>Own Id: OTP-2951</p> + <p>Aux Id: Seq 1446 OTP-2929</p> + </item> + <item> + <p>The compiler does now accept all valid value notations + for the OBJECT IDENTIFIER type. The generated code for + those values is also corrected.</p> + <p>Own Id: OTP-3059</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>The code generated for BER is significantly enhanced resulting + in less code and around 300% better performance in runtime + for the encoding of complex ASN.1 values. The performance of + decoding is unchanged.</p> + <p>Own Id: OTP-2806</p> + </item> + </list> + </section> + </section> + + <section> + <title>Asn1 1.0.3</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>The <c>asn1.app</c> file is corrected.</p> + <p>Own Id: OTP-2640</p> + </item> + <item> + <p>The encoding of integers in BER did not comply with the + standard for all values. The values was not encoded + in the minimum number of octets as required. This is + now corrected in the runtime module <c>asn1rt_ber</c>.</p> + <p>Own Id: OTP-2666</p> + </item> + </list> + </section> + + <section> + <title>Improvements and new features</title> + <list type="bulleted"> + <item> + <p>The compiler now generates explicit exports directives for + all generated + functions that should be exported (instead of -compile(export_all)). + This eliminates the warnings from the Erlang compiler when + compiling the + generated file.</p> + <p>Own Id: OTP-1845</p> + </item> + </list> + </section> + </section> + + <section> + <title>R3B02 (Asn1 1.0.2)</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>The decoding of a BER encoded SEQUENCE with optional component + of type SEQUENCE (also with optional components) could result + in an error or wrong result if the tags are equal.</p> + <p>Own Id: OTP-2226</p> + </item> + <item> + <p>The encoding of (PER) SEQUENCE with extensionmark was wrong. + This is now corrected.</p> + <p>Own Id: OTP-2349</p> + </item> + </list> + </section> + </section> + + <section> + <title>R3A (Asn1 0.9)</title> + + <section> + <title>Fixed errors and malfunctions</title> + <list type="bulleted"> + <item> + <p>The asn1 compiler now detects the use of an implicit tag before <c>CHOICE</c> as an error (in accordance with the standard)</p> + <p>Own Id: OTP-1844</p> + </item> + <item> + <p>An OPTIONAL CHOICE embedded in SEQUENCE when BER coding + caused an error when generating decode code. This is now + corrected.</p> + <p>Own Id: OTP-1857</p> + <p>Aux Id: OTP-1848</p> + </item> + </list> + </section> + </section> + + <section> + <title>1 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. See the release notes for the latest version + for the exact details about new features. A list of missing features + and restrictions can be found in the chapter below.</p> + + <section> + <title>1.1 Missing features and other restrictions</title> + <p></p> + <list type="bulleted"> + <item> + <p>The encoding rules BER and PER (aligned) is supported. <em>PER (unaligned) IS NOT SUPPORTED</em>.</p> + </item> + <item> + <p>NOT SUPPORTED types <c>ANY</c> and <c>ANY DEFINED BY</c> + (is not in the standard any more).</p> + </item> + <item> + <p>NOT SUPPORTED types <c>EXTERNAL</c> and <c>EMBEDDED-PDV</c>. </p> + </item> + <item> + <p>NOT SUPPORTED type <c>REAL</c> (planned to be implemented). </p> + </item> + <item> + <p>The code generation support for value definitions in the ASN.1 notation is very limited + (planned to be enhanced).</p> + </item> + <item> + <p>The support for constraints is limited to:</p> + </item> + </list> + <list type="bulleted"> + <item> + <p>SizeConstraint SIZE(X)</p> + </item> + <item> + <p>SingleValue (1)</p> + </item> + <item> + <p>ValueRange (X..Y)</p> + </item> + <item> + <p>PermittedAlpabet FROM (but not for BMPString and UniversalString when generating PER).</p> + </item> + <item> + <p>Complex expressions in constraints is not supported (planned to be extended).</p> + </item> + <item> + <p>The current version of the compiler has very limited error checking:</p> + </item> + <item> + <p>Stops at first syntax error.</p> + </item> + <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.</p> + </item> + <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.</p> + </item> + </list> + <list type="bulleted"> + <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).</p> + </item> + <item> + <p>Only AUTOMATIC TAGS supported for PER.</p> + </item> + <item> + <p>Only EXPLICIT and IMPLICIT TAGS supported for BER.</p> + </item> + <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.</p> + </item> + </list> + </section> + </section> +</chapter> + diff --git a/lib/asn1/doc/src/part.xml b/lib/asn1/doc/src/part.xml new file mode 100644 index 0000000000..19ee64b4a0 --- /dev/null +++ b/lib/asn1/doc/src/part.xml @@ -0,0 +1,39 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<part xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>1997</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>Asn1 User's Guide</title> + <prepared>Kenneth Lundin</prepared> + <docno></docno> + <date>1999-02-12</date> + <rev>0.9</rev> + <file>part.sgml</file> + </header> + <description> + <p>The <em>Asn1</em> application + contains modules with compile-time and run-time support for ASN.1. + </p> + </description> + <xi:include href="asn1_ug.xml"/> + <xi:include href="asn1_spec.xml"/> +</part> + diff --git a/lib/asn1/doc/src/part_notes.xml b/lib/asn1/doc/src/part_notes.xml new file mode 100644 index 0000000000..b0a6887aa5 --- /dev/null +++ b/lib/asn1/doc/src/part_notes.xml @@ -0,0 +1,39 @@ +<?xml version="1.0" encoding="latin1" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<part xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>2004</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>Asn1 Release Notes</title> + <prepared>Ingela Anderton Andin</prepared> + <docno></docno> + <date>>2004-09-07</date> + <rev></rev> + <file>part_notes.sgml</file> + </header> + <description> + <p>The <em>Asn1</em> application + contains modules with compile-time and run-time support for ASN.1.</p> + <p>There are also release notes for + <url href="notes_history.html">older versions</url>.</p> + </description> + <xi:include href="notes.xml"/> +</part> + diff --git a/lib/asn1/doc/src/ref_man.xml b/lib/asn1/doc/src/ref_man.xml new file mode 100644 index 0000000000..a0af1f5be3 --- /dev/null +++ b/lib/asn1/doc/src/ref_man.xml @@ -0,0 +1,38 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE application SYSTEM "application.dtd"> + +<application xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>1997</year><year>2009</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>Asn1 Reference Manual</title> + <prepared>OTP Team</prepared> + <docno></docno> + <date>1997-10-04</date> + <rev>1.3.1</rev> + <file>application.sgml</file> + </header> + <description> + <p>The <em>Asn1</em> application + contains modules with compile-time and run-time support for ASN.1.</p> + </description> + <xi:include href="asn1ct.xml"/> + <xi:include href="asn1rt.xml"/> +</application> + diff --git a/lib/asn1/doc/src/selective_TypeList.gif b/lib/asn1/doc/src/selective_TypeList.gif Binary files differnew file mode 100644 index 0000000000..b1bf0a4f5b --- /dev/null +++ b/lib/asn1/doc/src/selective_TypeList.gif diff --git a/lib/asn1/doc/src/selective_TypeList.ps b/lib/asn1/doc/src/selective_TypeList.ps new file mode 100644 index 0000000000..0d1f301240 --- /dev/null +++ b/lib/asn1/doc/src/selective_TypeList.ps @@ -0,0 +1,266 @@ +%!PS-Adobe-2.0 +%%Title: selective_TypeList.ps +%%Creator: fig2dev Version 3.2 Patchlevel 1 +%%CreationDate: Tue Oct 28 15:52:00 2003 +%%For: bertil@super (Bertil Karlsson,UAB/F/P) +%%Orientation: Portrait +%%BoundingBox: 158 178 453 614 +%%Pages: 1 +%%BeginSetup +%%IncludeFeature: *PageSize Letter +%%EndSetup +%%Magnification: 1.0000 +%%EndComments +/$F2psDict 200 dict def +$F2psDict begin +$F2psDict /mtrx matrix put +/col-1 {0 setgray} bind def +/col0 {0.000 0.000 0.000 srgb} bind def +/col1 {0.000 0.000 1.000 srgb} bind def +/col2 {0.000 1.000 0.000 srgb} bind def +/col3 {0.000 1.000 1.000 srgb} bind def +/col4 {1.000 0.000 0.000 srgb} bind def +/col5 {1.000 0.000 1.000 srgb} bind def +/col6 {1.000 1.000 0.000 srgb} bind def +/col7 {1.000 1.000 1.000 srgb} bind def +/col8 {0.000 0.000 0.560 srgb} bind def +/col9 {0.000 0.000 0.690 srgb} bind def +/col10 {0.000 0.000 0.820 srgb} bind def +/col11 {0.530 0.810 1.000 srgb} bind def +/col12 {0.000 0.560 0.000 srgb} bind def +/col13 {0.000 0.690 0.000 srgb} bind def +/col14 {0.000 0.820 0.000 srgb} bind def +/col15 {0.000 0.560 0.560 srgb} bind def +/col16 {0.000 0.690 0.690 srgb} bind def +/col17 {0.000 0.820 0.820 srgb} bind def +/col18 {0.560 0.000 0.000 srgb} bind def +/col19 {0.690 0.000 0.000 srgb} bind def +/col20 {0.820 0.000 0.000 srgb} bind def +/col21 {0.560 0.000 0.560 srgb} bind def +/col22 {0.690 0.000 0.690 srgb} bind def +/col23 {0.820 0.000 0.820 srgb} bind def +/col24 {0.500 0.190 0.000 srgb} bind def +/col25 {0.630 0.250 0.000 srgb} bind def +/col26 {0.750 0.380 0.000 srgb} bind def +/col27 {1.000 0.500 0.500 srgb} bind def +/col28 {1.000 0.630 0.630 srgb} bind def +/col29 {1.000 0.750 0.750 srgb} bind def +/col30 {1.000 0.880 0.880 srgb} bind def +/col31 {1.000 0.840 0.000 srgb} bind def + +end +save +55.5 677.0 translate +1 -1 scale + +/cp {closepath} bind def +/ef {eofill} bind def +/gr {grestore} bind def +/gs {gsave} bind def +/sa {save} bind def +/rs {restore} bind def +/l {lineto} bind def +/m {moveto} bind def +/rm {rmoveto} bind def +/n {newpath} bind def +/s {stroke} bind def +/sh {show} bind def +/slc {setlinecap} bind def +/slj {setlinejoin} bind def +/slw {setlinewidth} bind def +/srgb {setrgbcolor} bind def +/rot {rotate} bind def +/sc {scale} bind def +/sd {setdash} bind def +/ff {findfont} bind def +/sf {setfont} bind def +/scf {scalefont} bind def +/sw {stringwidth} bind def +/tr {translate} bind def +/tnt {dup dup currentrgbcolor + 4 -2 roll dup 1 exch sub 3 -1 roll mul add + 4 -2 roll dup 1 exch sub 3 -1 roll mul add + 4 -2 roll dup 1 exch sub 3 -1 roll mul add srgb} + bind def +/shd {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll mul + 4 -2 roll mul srgb} bind def +/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def +/$F2psEnd {$F2psEnteredState restore end} def +%%EndProlog + +$F2psBegin +10 setmiterlimit +n -1000 9310 m -1000 -1000 l 7626 -1000 l 7626 9310 l cp clip + 0.06000 0.06000 sc +%%Page: 1 1 +% Arc +7.500 slw +gs clippath +2363 5348 m 2475 5400 l 2352 5407 l 2484 5432 l 2495 5373 l cp +clip +n 2470.1 5021.7 378.3 -100.7 89.3 arcn +gs col0 s gr + gr + +% arrowhead +n 2363 5348 m 2475 5400 l 2352 5407 l 2357 5378 l 2363 5348 l cp gs 0.00 setgray ef gr col0 s +% Arc +gs clippath +2384 7192 m 2475 7275 l 2355 7245 l 2474 7309 l 2502 7256 l cp +clip +n 2896.9 6337.5 1028.0 -114.2 114.2 arcn +gs col0 s gr + gr + +% arrowhead +n 2384 7192 m 2475 7275 l 2355 7245 l 2369 7218 l 2384 7192 l cp gs 0.00 setgray ef gr col0 s +% Arc +gs clippath +2448 7504 m 2550 7575 l 2427 7561 l 2553 7608 l 2575 7552 l cp +clip +n 2512.5 7462.5 118.6 -108.4 71.6 arcn +gs col0 s gr + gr + +% arrowhead +n 2448 7504 m 2550 7575 l 2427 7561 l 2438 7533 l 2448 7504 l cp gs 0.00 setgray ef gr col0 s +% Arc +gs clippath +2869 2255 m 2775 2175 l 2896 2202 l 2775 2141 l 2748 2195 l cp +clip +n 1347.8 5222.4 3365.1 42.6 -64.9 arcn +gs col0 s gr + gr + +% arrowhead +n 2869 2255 m 2775 2175 l 2896 2202 l 2882 2229 l 2869 2255 l cp gs 0.00 setgray ef gr col0 s +% Arc +gs clippath +5199 1837 m 5250 1950 l 5152 1874 l 5236 1980 l 5283 1943 l cp +clip +n 4021.7 2817.4 1503.7 -141.2 -35.2 arc +gs col0 s gr + gr + +% arrowhead +n 5199 1837 m 5250 1950 l 5152 1874 l 5176 1856 l 5199 1837 l cp gs 0.00 setgray ef gr col0 s +/Times-Roman ff 180.00 scf sf +2400 1350 m +gs 1 -1 sc (Action ::= SEQUENCE ) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 1590 m +gs 1 -1 sc ( { ) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 1830 m +gs 1 -1 sc ( number INTEGER DEFAULT 15,) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 2310 m +gs 1 -1 sc ( }) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 2790 m +gs 1 -1 sc (Key ::= [11] EXPLICIT Button) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 3030 m +gs 1 -1 sc (Handle ::= [12] Key) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 3270 m +gs 1 -1 sc (Button ::= SEQUENCE ) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 3510 m +gs 1 -1 sc ( {) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 3750 m +gs 1 -1 sc ( number INTEGER,) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 3990 m +gs 1 -1 sc ( on BOOLEAN) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 4230 m +gs 1 -1 sc ( }) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 4950 m +gs 1 -1 sc ( {) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 5190 m +gs 1 -1 sc ( vsn INTEGER,) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 5670 m +gs 1 -1 sc ( }) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 6150 m +gs 1 -1 sc (Status ::= SEQUENCE ) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 6390 m +gs 1 -1 sc ( {) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 6630 m +gs 1 -1 sc ( state INTEGER,) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 6870 m +gs 1 -1 sc ( buttonList SEQUENCE OF Button,) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 7110 m +gs 1 -1 sc ( enabled BOOLEAN OPTIONAL,) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 7830 m +gs 1 -1 sc ( noOfActions INTEGER) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 8070 m +gs 1 -1 sc ( }) col0 sh gr +/Times-Roman ff 180.00 scf sf +2400 8310 m +gs 1 -1 sc ( }) col0 sh gr +/Times-Roman ff 180.00 scf sf +3150 4725 m +gs 1 -1 sc (::= CHOICE) col0 sh gr +/Times-Bold ff 195.00 scf sf +2400 4710 m +gs 1 -1 sc (Window) col0 sh gr +/Times-Bold ff 195.00 scf sf +2400 5430 m +gs 1 -1 sc ( status) col0 sh gr +/Times-Roman ff 180.00 scf sf +3225 5475 m +gs 1 -1 sc (E) col0 sh gr +/Times-Roman ff 180.00 scf sf +3150 7350 m +gs 1 -1 sc (CHOICE {) col0 sh gr +/Times-Bold ff 195.00 scf sf +2400 7350 m +gs 1 -1 sc ( actions) col0 sh gr +/Times-Roman ff 180.00 scf sf +3975 7575 m +gs 1 -1 sc (SEQUENCE OF Action) col0 sh gr +/Times-Bold ff 195.00 scf sf +2400 7590 m +gs 1 -1 sc ( possibleActions) col0 sh gr +/Times-Roman ff 180.00 scf sf +5550 2100 m +gs 1 -1 sc (12, on TRUE}) col0 sh gr +/Times-Bold ff 195.00 scf sf +2400 2070 m +gs 1 -1 sc ( handle) col0 sh gr +/Times-Bold ff 195.00 scf sf +4950 2100 m +gs 1 -1 sc (number ) col0 sh gr +/Times-Roman ff 225.00 scf sf +1950 5100 m +gs 1 -1 sc (1) col0 sh gr +/Times-Roman ff 225.00 scf sf +1725 6450 m +gs 1 -1 sc (2) col0 sh gr +/Times-Roman ff 225.00 scf sf +2250 7575 m +gs 1 -1 sc (3) col0 sh gr +/Times-Roman ff 225.00 scf sf +4800 4950 m +gs 1 -1 sc (4) col0 sh gr +/Times-Roman ff 225.00 scf sf +4200 1200 m +gs 1 -1 sc (5) col0 sh gr +/Times-Roman ff 180.00 scf sf +3150 2100 m +gs 1 -1 sc ([0] Handle DEFAULT {) col0 sh gr +$F2psEnd +rs +showpage diff --git a/lib/asn1/doc/src/selective_Window2.gif b/lib/asn1/doc/src/selective_Window2.gif Binary files differnew file mode 100644 index 0000000000..9ee2b0710e --- /dev/null +++ b/lib/asn1/doc/src/selective_Window2.gif diff --git a/lib/asn1/doc/src/selective_Window2.ps b/lib/asn1/doc/src/selective_Window2.ps new file mode 100644 index 0000000000..d5a95ca591 --- /dev/null +++ b/lib/asn1/doc/src/selective_Window2.ps @@ -0,0 +1,515 @@ +%!PS-Adobe-2.0 +%%Title: selective_Window2.ps +%%Creator: fig2dev Version 3.2 Patchlevel 1 +%%CreationDate: Tue Oct 28 16:55:06 2003 +%%For: bertil@super (Bertil Karlsson,UAB/F/P) +%%Orientation: Landscape +%%BoundingBox: 134 128 460 713 +%%Pages: 1 +%%BeginSetup +%%IncludeFeature: *PageSize A4 +%%EndSetup +%%Magnification: 1.0000 +%%EndComments +/MyAppDict 100 dict dup begin def +/$F2psDict 200 dict def +$F2psDict begin +$F2psDict /mtrx matrix put +/col-1 {0 setgray} bind def +/col0 {0.000 0.000 0.000 srgb} bind def +/col1 {0.000 0.000 1.000 srgb} bind def +/col2 {0.000 1.000 0.000 srgb} bind def +/col3 {0.000 1.000 1.000 srgb} bind def +/col4 {1.000 0.000 0.000 srgb} bind def +/col5 {1.000 0.000 1.000 srgb} bind def +/col6 {1.000 1.000 0.000 srgb} bind def +/col7 {1.000 1.000 1.000 srgb} bind def +/col8 {0.000 0.000 0.560 srgb} bind def +/col9 {0.000 0.000 0.690 srgb} bind def +/col10 {0.000 0.000 0.820 srgb} bind def +/col11 {0.530 0.810 1.000 srgb} bind def +/col12 {0.000 0.560 0.000 srgb} bind def +/col13 {0.000 0.690 0.000 srgb} bind def +/col14 {0.000 0.820 0.000 srgb} bind def +/col15 {0.000 0.560 0.560 srgb} bind def +/col16 {0.000 0.690 0.690 srgb} bind def +/col17 {0.000 0.820 0.820 srgb} bind def +/col18 {0.560 0.000 0.000 srgb} bind def +/col19 {0.690 0.000 0.000 srgb} bind def +/col20 {0.820 0.000 0.000 srgb} bind def +/col21 {0.560 0.000 0.560 srgb} bind def +/col22 {0.690 0.000 0.690 srgb} bind def +/col23 {0.820 0.000 0.820 srgb} bind def +/col24 {0.500 0.190 0.000 srgb} bind def +/col25 {0.630 0.250 0.000 srgb} bind def +/col26 {0.750 0.380 0.000 srgb} bind def +/col27 {1.000 0.500 0.500 srgb} bind def +/col28 {1.000 0.630 0.630 srgb} bind def +/col29 {1.000 0.750 0.750 srgb} bind def +/col30 {1.000 0.880 0.880 srgb} bind def +/col31 {1.000 0.840 0.000 srgb} bind def + +end +save +77.5 92.5 translate + 90 rotate +1 -1 scale +.9 .9 scale % to make patterns same scale as in xfig + +% This junk string is used by the show operators +/PATsstr 1 string def +/PATawidthshow { % cx cy cchar rx ry string + % Loop over each character in the string + { % cx cy cchar rx ry char + % Show the character + dup % cx cy cchar rx ry char char + PATsstr dup 0 4 -1 roll put % cx cy cchar rx ry char (char) + false charpath % cx cy cchar rx ry char + /clip load PATdraw + % Move past the character (charpath modified the + % current point) + currentpoint % cx cy cchar rx ry char x y + newpath + moveto % cx cy cchar rx ry char + % Reposition by cx,cy if the character in the string is cchar + 3 index eq { % cx cy cchar rx ry + 4 index 4 index rmoveto + } if + % Reposition all characters by rx ry + 2 copy rmoveto % cx cy cchar rx ry + } forall + pop pop pop pop pop % - + currentpoint + newpath + moveto +} bind def +/PATcg { + 7 dict dup begin + /lw currentlinewidth def + /lc currentlinecap def + /lj currentlinejoin def + /ml currentmiterlimit def + /ds [ currentdash ] def + /cc [ currentrgbcolor ] def + /cm matrix currentmatrix def + end +} bind def +% PATdraw - calculates the boundaries of the object and +% fills it with the current pattern +/PATdraw { % proc + save exch + PATpcalc % proc nw nh px py + 5 -1 roll exec % nw nh px py + newpath + PATfill % - + restore +} bind def +% PATfill - performs the tiling for the shape +/PATfill { % nw nh px py PATfill - + PATDict /CurrentPattern get dup begin + setfont + % Set the coordinate system to Pattern Space + PatternGState PATsg + % Set the color for uncolored pattezns + PaintType 2 eq { PATDict /PColor get PATsc } if + % Create the string for showing + 3 index string % nw nh px py str + % Loop for each of the pattern sources + 0 1 Multi 1 sub { % nw nh px py str source + % Move to the starting location + 3 index 3 index % nw nh px py str source px py + moveto % nw nh px py str source + % For multiple sources, set the appropriate color + Multi 1 ne { dup PC exch get PATsc } if + % Set the appropriate string for the source + 0 1 7 index 1 sub { 2 index exch 2 index put } for pop + % Loop over the number of vertical cells + 3 index % nw nh px py str nh + { % nw nh px py str + currentpoint % nw nh px py str cx cy + 2 index show % nw nh px py str cx cy + YStep add moveto % nw nh px py str + } repeat % nw nh px py str + } for + 5 { pop } repeat + end +} bind def + +% PATkshow - kshow with the current pattezn +/PATkshow { % proc string + exch bind % string proc + 1 index 0 get % string proc char + % Loop over all but the last character in the string + 0 1 4 index length 2 sub { + % string proc char idx + % Find the n+1th character in the string + 3 index exch 1 add get % string proe char char+1 + exch 2 copy % strinq proc char+1 char char+1 char + % Now show the nth character + PATsstr dup 0 4 -1 roll put % string proc chr+1 chr chr+1 (chr) + false charpath % string proc char+1 char char+1 + /clip load PATdraw + % Move past the character (charpath modified the current point) + currentpoint newpath moveto + % Execute the user proc (should consume char and char+1) + mark 3 1 roll % string proc char+1 mark char char+1 + 4 index exec % string proc char+1 mark... + cleartomark % string proc char+1 + } for + % Now display the last character + PATsstr dup 0 4 -1 roll put % string proc (char+1) + false charpath % string proc + /clip load PATdraw + neewath + pop pop % - +} bind def +% PATmp - the makepattern equivalent +/PATmp { % patdict patmtx PATmp patinstance + exch dup length 7 add % We will add 6 new entries plus 1 FID + dict copy % Create a new dictionary + begin + % Matrix to install when painting the pattern + TilingType PATtcalc + /PatternGState PATcg def + PatternGState /cm 3 -1 roll put + % Check for multi pattern sources (Level 1 fast color patterns) + currentdict /Multi known not { /Multi 1 def } if + % Font dictionary definitions + /FontType 3 def + % Create a dummy encoding vector + /Encoding 256 array def + 3 string 0 1 255 { + Encoding exch dup 3 index cvs cvn put } for pop + /FontMatrix matrix def + /FontBBox BBox def + /BuildChar { + mark 3 1 roll % mark dict char + exch begin + Multi 1 ne {PaintData exch get}{pop} ifelse % mark [paintdata] + PaintType 2 eq Multi 1 ne or + { XStep 0 FontBBox aload pop setcachedevice } + { XStep 0 setcharwidth } ifelse + currentdict % mark [paintdata] dict + /PaintProc load % mark [paintdata] dict paintproc + end + gsave + false PATredef exec true PATredef + grestore + cleartomark % - + } bind def + currentdict + end % newdict + /foo exch % /foo newlict + definefont % newfont +} bind def +% PATpcalc - calculates the starting point and width/height +% of the tile fill for the shape +/PATpcalc { % - PATpcalc nw nh px py + PATDict /CurrentPattern get begin + gsave + % Set up the coordinate system to Pattern Space + % and lock down pattern + PatternGState /cm get setmatrix + BBox aload pop pop pop translate + % Determine the bounding box of the shape + pathbbox % llx lly urx ury + grestore + % Determine (nw, nh) the # of cells to paint width and height + PatHeight div ceiling % llx lly urx qh + 4 1 roll % qh llx lly urx + PatWidth div ceiling % qh llx lly qw + 4 1 roll % qw qh llx lly + PatHeight div floor % qw qh llx ph + 4 1 roll % ph qw qh llx + PatWidth div floor % ph qw qh pw + 4 1 roll % pw ph qw qh + 2 index sub cvi abs % pw ph qs qh-ph + exch 3 index sub cvi abs exch % pw ph nw=qw-pw nh=qh-ph + % Determine the starting point of the pattern fill + %(px, py) + 4 2 roll % nw nh pw ph + PatHeight mul % nw nh pw py + exch % nw nh py pw + PatWidth mul exch % nw nh px py + end +} bind def + +% Save the original routines so that we can use them later on +/oldfill /fill load def +/oldeofill /eofill load def +/oldstroke /stroke load def +/oldshow /show load def +/oldashow /ashow load def +/oldwidthshow /widthshow load def +/oldawidthshow /awidthshow load def +/oldkshow /kshow load def + +% These defs are necessary so that subsequent procs don't bind in +% the originals +/fill { oldfill } bind def +/eofill { oldeofill } bind def +/stroke { oldstroke } bind def +/show { oldshow } bind def +/ashow { oldashow } bind def +/widthshow { oldwidthshow } bind def +/awidthshow { oldawidthshow } bind def +/kshow { oldkshow } bind def +/PATredef { + MyAppDict begin + { + /fill { /clip load PATdraw newpath } bind def + /eofill { /eoclip load PATdraw newpath } bind def + /stroke { PATstroke } bind def + /show { 0 0 null 0 0 6 -1 roll PATawidthshow } bind def + /ashow { 0 0 null 6 3 roll PATawidthshow } + bind def + /widthshow { 0 0 3 -1 roll PATawidthshow } + bind def + /awidthshow { PATawidthshow } bind def + /kshow { PATkshow } bind def + } { + /fill { oldfill } bind def + /eofill { oldeofill } bind def + /stroke { oldstroke } bind def + /show { oldshow } bind def + /ashow { oldashow } bind def + /widthshow { oldwidthshow } bind def + /awidthshow { oldawidthshow } bind def + /kshow { oldkshow } bind def + } ifelse + end +} bind def +false PATredef +% Conditionally define setcmykcolor if not available +/setcmykcolor where { pop } { + /setcmykcolor { + 1 sub 4 1 roll + 3 { + 3 index add neg dup 0 lt { pop 0 } if 3 1 roll + } repeat + setrgbcolor - pop + } bind def +} ifelse +/PATsc { % colorarray + aload length % c1 ... cn length + dup 1 eq { pop setgray } { 3 eq { setrgbcolor } { setcmykcolor + } ifelse } ifelse +} bind def +/PATsg { % dict + begin + lw setlinewidth + lc setlinecap + lj setlinejoin + ml setmiterlimit + ds aload pop setdash + cc aload pop setrgbcolor + cm setmatrix + end +} bind def + +/PATDict 3 dict def +/PATsp { + true PATredef + PATDict begin + /CurrentPattern exch def + % If it's an uncolored pattern, save the color + CurrentPattern /PaintType get 2 eq { + /PColor exch def + } if + /CColor [ currentrgbcolor ] def + end +} bind def +% PATstroke - stroke with the current pattern +/PATstroke { + countdictstack + save + mark + { + currentpoint strokepath moveto + PATpcalc % proc nw nh px py + clip newpath PATfill + } stopped { + (*** PATstroke Warning: Path is too complex, stroking + with gray) = + cleartomark + restore + countdictstack exch sub dup 0 gt + { { end } repeat } { pop } ifelse + gsave 0.5 setgray oldstroke grestore + } { pop restore pop } ifelse + newpath +} bind def +/PATtcalc { % modmtx tilingtype PATtcalc tilematrix + % Note: tiling types 2 and 3 are not supported + gsave + exch concat % tilingtype + matrix currentmatrix exch % cmtx tilingtype + % Tiling type 1 and 3: constant spacing + 2 ne { + % Distort the pattern so that it occupies + % an integral number of device pixels + dup 4 get exch dup 5 get exch % tx ty cmtx + XStep 0 dtransform + round exch round exch % tx ty cmtx dx.x dx.y + XStep div exch XStep div exch % tx ty cmtx a b + 0 YStep dtransform + round exch round exch % tx ty cmtx a b dy.x dy.y + YStep div exch YStep div exch % tx ty cmtx a b c d + 7 -3 roll astore % { a b c d tx ty } + } if + grestore +} bind def +/PATusp { + false PATredef + PATDict begin + CColor PATsc + end +} bind def + +% crosshatch45 +11 dict begin +/PaintType 1 def +/PatternType 1 def +/TilingType 1 def +/BBox [0 0 1 1] def +/XStep 1 def +/YStep 1 def +/PatWidth 1 def +/PatHeight 1 def +/Multi 2 def +/PaintData [ + { clippath } bind + { 32 32 true [ 32 0 0 -32 0 32 ] + {<828282824444444428282828101010102828282844444444 + 828282820101010182828282444444442828282810101010 + 282828284444444482828282010101018282828244444444 + 282828281010101028282828444444448282828201010101 + 828282824444444428282828101010102828282844444444 + 8282828201010101>} + imagemask } bind +] def +/PaintProc { + pop + exec fill +} def +currentdict +end +/P6 exch def +1.1111 1.1111 scale %restore scale + +/cp {closepath} bind def +/ef {eofill} bind def +/gr {grestore} bind def +/gs {gsave} bind def +/sa {save} bind def +/rs {restore} bind def +/l {lineto} bind def +/m {moveto} bind def +/rm {rmoveto} bind def +/n {newpath} bind def +/s {stroke} bind def +/sh {show} bind def +/slc {setlinecap} bind def +/slj {setlinejoin} bind def +/slw {setlinewidth} bind def +/srgb {setrgbcolor} bind def +/rot {rotate} bind def +/sc {scale} bind def +/sd {setdash} bind def +/ff {findfont} bind def +/sf {setfont} bind def +/scf {scalefont} bind def +/sw {stringwidth} bind def +/tr {translate} bind def +/tnt {dup dup currentrgbcolor + 4 -2 roll dup 1 exch sub 3 -1 roll mul add + 4 -2 roll dup 1 exch sub 3 -1 roll mul add + 4 -2 roll dup 1 exch sub 3 -1 roll mul add srgb} + bind def +/shd {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll mul + 4 -2 roll mul srgb} bind def +/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def +/$F2psEnd {$F2psEnteredState restore end} def +%%EndProlog + +$F2psBegin +10 setmiterlimit +n -1000 7375 m -1000 -1000 l 11348 -1000 l 11348 7375 l cp clip + 0.06000 0.06000 sc +%%Page: 1 1 +% Polyline +7.500 slw +n 3150 975 m 3150 1500 l gs col0 s gr +% Polyline +n 4800 3600 m 9975 3600 l 9975 4125 l 4800 4125 l cp gs col0 s gr +% Polyline +n 5925 3600 m 5925 4125 l gs col0 s gr +% Polyline +n 7800 4200 m 7500 5325 l gs col0 s gr +% Polyline +n 5400 5550 m 7200 5550 l 7200 6075 l 5400 6075 l cp gs /PC [[1.00 1.00 1.00] [0.00 0.00 0.00]] def +15.00 15.00 sc P6 [16 0 0 -16 360.00 370.00] PATmp PATsp ef gr PATusp gs col0 s gr +% Polyline +n 7200 5550 m 9300 5550 l 9300 6075 l 7200 6075 l cp gs col0 s gr +% Polyline +n 2400 975 m 9700 975 l 9700 1500 l 2400 1500 l cp gs col0 s gr +% Polyline +n 6150 975 m 6150 1500 l gs col0 s gr +% Polyline +n 6825 975 m 6825 1500 l gs col0 s gr +% Polyline + [60] 0 sd +n 7800 975 m 7800 1500 l gs col0 s gr [] 0 sd +% Polyline + [60] 0 sd +n 8775 975 m 8775 1500 l gs col0 s gr [] 0 sd +% Polyline +gs clippath +6667 1636 m 6775 1575 l 6709 1679 l 6807 1586 l 6765 1543 l cp +clip +n 6775 1575 m 4800 3450 l gs col0 s gr gr + +% arrowhead +n 6667 1636 m 6775 1575 l 6709 1679 l col0 s +% Polyline +n 7850 1575 m 9975 3450 l gs col0 s gr +/Times-Roman ff 180.00 scf sf +600 1275 m +gs 1 -1 sc (Window:status message) col0 sh gr +/Times-Roman ff 180.00 scf sf +2550 1800 m +gs 1 -1 sc (state) col0 sh gr +/Times-Roman ff 180.00 scf sf +4275 1800 m +gs 1 -1 sc (buttonList) col0 sh gr +/Times-Roman ff 180.00 scf sf +8625 1875 m +gs 1 -1 sc (actions:possibleActions) col0 sh gr +/Times-Roman ff 180.00 scf sf +5025 4350 m +gs 1 -1 sc (number) col0 sh gr +/Times-Roman ff 180.00 scf sf +7275 4425 m +gs 1 -1 sc (handle) col0 sh gr +/Times-Roman ff 180.00 scf sf +5850 6375 m +gs 1 -1 sc (number) col0 sh gr +/Times-Roman ff 180.00 scf sf +8100 6375 m +gs 1 -1 sc (on) col0 sh gr +/Times-Roman ff 180.00 scf sf +6225 1800 m +gs 1 -1 sc (enabled) col0 sh gr +/Times-Roman ff 180.00 scf sf +7275 1350 m +gs 1 -1 sc ([1]) col0 sh gr +/Times-Roman ff 180.00 scf sf +8175 1350 m +gs 1 -1 sc ([2]) col0 sh gr +/Times-Roman ff 180.00 scf sf +9150 1350 m +gs 1 -1 sc ([3]) col0 sh gr +$F2psEnd +rs +end +showpage diff --git a/lib/asn1/doc/src/warning.gif b/lib/asn1/doc/src/warning.gif Binary files differnew file mode 100644 index 0000000000..96af52360e --- /dev/null +++ b/lib/asn1/doc/src/warning.gif diff --git a/lib/asn1/doc/users_guide/Makefile b/lib/asn1/doc/users_guide/Makefile new file mode 100644 index 0000000000..996b2582af --- /dev/null +++ b/lib/asn1/doc/users_guide/Makefile @@ -0,0 +1,69 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +OTP_MAKE_ROOT=/home/super/otp/otp_make +include $(OTP_MAKE_ROOT)/otp.mk + +# +# Release Macros +# + +# +# Common macros +# + +SGML_FILES= asn1.sgml + +FIG_FILES = + +GIF_FILES= + +PSFIG_FILES= + +USERS_GUIDE = users_guide.sgml + +EXTRA_GEN_FILES= $(SGML_FILES:.sgml=.html) \ + users_guide_frame.html users_guide_first.html \ + min_head.gif + +HTML_FILES= $(USERS_GUIDE:.sgml=.html) + +TEX_FILES= $(SGML_FILES:.sgml=.tex) $(USERS_GUIDE:.sgml=.tex) +DVI_FILES= $(USERS_GUIDE:.sgml=.dvi) +PS_FILES= $(USERS_GUIDE:.sgml=.ps) + + +# +# Make Rules +# +all $(DEFAULT_OPT_TARGETS) $(DEFAULT_DEBUG_TARGETS): $(HTML_FILES) $(TEX_FILES) $(DVI_FILES) $(PS_FILES) + +clean: + @rm -f *.toc *.log *.aux *.tex sgmls_output sgmls_errs $(HTML_FILES) $(EXTRA_GEN_FILES) $(TEX_FILES) $(DVI_FILES) $(PS_FILES) + +# +# Release Targets +# +include $(OTP_MAKE_ROOT)/otp_release_targets.mk + +release_variant: opt.$(TARGET) + $(MKPATH.$(TARGET)) $(RELEASE_PATH)/$(TARGET)/lib/asn1/doc/users_guide + $(INSTALLFILES.$(TARGET)) $(HTML_FILES) $(EXTRA_GEN_FILES) $(GIF_FILES) $(PS_FILES) $(RELEASE_PATH)/$(TARGET)/lib/asn1/doc/users_guide + + diff --git a/lib/asn1/doc/users_guide/users_guide.sgml b/lib/asn1/doc/users_guide/users_guide.sgml new file mode 100644 index 0000000000..9387e6b9ab --- /dev/null +++ b/lib/asn1/doc/users_guide/users_guide.sgml @@ -0,0 +1,34 @@ +<!doctype userguide PUBLIC "-//Stork//DTD userguide//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$ +--> +<userguide> + <header> + <title>ASN.1 User's Guide</> + <prepared>Kenneth Lundin</> + <responsible></> + <docno></> + <approved></> + <checked></> + <date>1997-01-09</> + <rev>1.0</> + <file>users_guide.sgml</> + </header> + <include file="asn1"> + +</userguide> diff --git a/lib/asn1/ebin/.gitignore b/lib/asn1/ebin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/asn1/ebin/.gitignore diff --git a/lib/asn1/examples/InfClass3.asn b/lib/asn1/examples/InfClass3.asn new file mode 100644 index 0000000000..6c1fd0f430 --- /dev/null +++ b/lib/asn1/examples/InfClass3.asn @@ -0,0 +1,36 @@ +InfClass3 DEFINITIONS ::= +BEGIN + +FUNCTION ::= CLASS { + &ArgumentType, + &ResultType DEFAULT NULL, + &code INTEGER + } + +ObjSet1 FUNCTION ::= { ... } + +object1 FUNCTION ::= { + &ArgumentType INTEGER, + &ResultType INTEGER, + &code 3 + } + +object2 FUNCTION ::= { + &ArgumentType INTEGER, + &ResultType INTEGER, + &code 2 + } + + +ObjSet2 FUNCTION ::= { + object1 | object2 } + +ParamType{FUNCTION:object} ::=SEQUENCE +{ + val1 INTEGER, + val2 object.&ArgumentType + } + +parTypVal{FUNCTION:object2} ParamType ::= {1,2} + +END diff --git a/lib/asn1/examples/Int.py b/lib/asn1/examples/Int.py new file mode 100644 index 0000000000..490d5a16ea --- /dev/null +++ b/lib/asn1/examples/Int.py @@ -0,0 +1,30 @@ +Int DEFINITIONS ::=
+BEGIN
+
+-- F.2.2.2
+-- Define the minimum and maximum allowed values of an integer type
+-- as named numbers.
+-- EXAMPLE
+
+ DayOfTheMonth ::= INTEGER {first(1), last(31)}
+ today DayOfTheMonth ::= first
+ unknown DayOfTheMonth ::= 0
+
+-- To restrict the value of DayOfTheMonth to just "first" and "last",
+-- one would write:
+
+ DayOfTheMonth2 ::= INTEGER {first(1), last(31)} (first | last)
+
+-- and to restrict the value of the DayOfTheMonth to all values
+-- between 1 and 31, inclusive, one would write:
+
+ DayOfTheMonth3 ::= INTEGER {first(1), last(31)} (first .. last)
+ dayOfTheMonth DayOfTheMonth3 ::= 4
+ + SmallInt ::= INTEGER (0..1000) + OrInt ::= INTEGER (10 | 20 | 30) + + small SmallInt ::= 17 + or OrInt ::= 20 +
+END
diff --git a/lib/asn1/examples/P-Record.asn b/lib/asn1/examples/P-Record.asn new file mode 100644 index 0000000000..13643efef3 --- /dev/null +++ b/lib/asn1/examples/P-Record.asn @@ -0,0 +1,59 @@ +P-Record DEFINITIONS ::= +BEGIN + + +PersonnelRecord ::= [APPLICATION 0] SET +{ name Name, + title VisibleString, + number EmployeeNumber, + dateOfHire Date, + nameOfSpouse [1] Name, + children SEQUENCE OF ChildInformation DEFAULT {} +} + +ChildInformation ::= SET +{ name Name OPTIONAL, + dateOfBirth Date OPTIONAL +} + +Name ::= [APPLICATION 1] SEQUENCE +{ givenName VisibleString, + initial VisibleString, + familyName VisibleString +} + +EmployeeNumber ::= [APPLICATION 2] INTEGER +Date ::= [APPLICATION 3] VisibleString -- YYYY MMDD + +v PersonnelRecord ::= +{ + name { + givenName "John", + initial "P", + familyName "Smith" + }, + title "Director", + number 51, + dateOfHire "19710917", + nameOfSpouse { + givenName "Mary", + initial "T", + familyName "Smith" + }, + children { + {name { + givenName "Ralph", + initial "T", + familyName "Smith" + } , + dateOfBirth "19571111"}, + {name { + givenName "Susan", + initial "B", + familyName "Jones" + } , + dateOfBirth "19590717" } + } +} + +END diff --git a/lib/asn1/examples/RANAPextract1.asn b/lib/asn1/examples/RANAPextract1.asn new file mode 100644 index 0000000000..fdd33d6027 --- /dev/null +++ b/lib/asn1/examples/RANAPextract1.asn @@ -0,0 +1,101 @@ +RANAPextract1 DEFINITIONS ::= +BEGIN + + +RANAP-ELEMENTARY-PROCEDURE ::= CLASS { + &InitiatingMessage , + &SuccessfulOutcome OPTIONAL, + &UnsuccessfulOutcome OPTIONAL, + &Outcome OPTIONAL, + &procedureCode ProcedureCode UNIQUE, + &criticality Criticality DEFAULT ignore +} +WITH SYNTAX { + INITIATING MESSAGE &InitiatingMessage + [SUCCESSFUL OUTCOME &SuccessfulOutcome] + [UNSUCCESSFUL OUTCOME &UnsuccessfulOutcome] + [OUTCOME &Outcome] + PROCEDURE CODE &procedureCode + [CRITICALITY &criticality] +} + +RANAP-PDU ::= CHOICE { + initiatingMessage InitiatingMessage, + -- successfulOutcome SuccessfulOutcome, + -- unsuccessfulOutcome UnsuccessfulOutcome, + -- outcome Outcome, + ... +} + +InitiatingMessage ::= SEQUENCE { + procedureCode RANAP-ELEMENTARY-PROCEDURE.&procedureCode ({RANAP-ELEMENTARY-PROCEDURES}), + criticality RANAP-ELEMENTARY-PROCEDURE.&criticality ({RANAP-ELEMENTARY-PROCEDURES}{@procedureCode}), + value RANAP-ELEMENTARY-PROCEDURE.&InitiatingMessage ({RANAP-ELEMENTARY-PROCEDURES}{@procedureCode}) +} + +iu-Release RANAP-ELEMENTARY-PROCEDURE ::= { + INITIATING MESSAGE Iu-ReleaseCommand + SUCCESSFUL OUTCOME Iu-ReleaseComplete + PROCEDURE CODE id-Iu-Release + CRITICALITY ignore +} + +relocationPreparation RANAP-ELEMENTARY-PROCEDURE ::= { + INITIATING MESSAGE Iu-ReleaseCommand + SUCCESSFUL OUTCOME Iu-ReleaseComplete + PROCEDURE CODE id-relocationPreparation + CRITICALITY notify +} + +testObject RANAP-ELEMENTARY-PROCEDURE ::= { + INITIATING MESSAGE Iu-ReleaseCommand + SUCCESSFUL OUTCOME Iu-ReleaseComplete + PROCEDURE CODE id-test + CRITICALITY notify +} + +testObject2 RANAP-ELEMENTARY-PROCEDURE ::= { + INITIATING MESSAGE Iu-ReleaseCommand + SUCCESSFUL OUTCOME Iu-ReleaseComplete + PROCEDURE CODE id-test2 + CRITICALITY notify +} + +RANAP-ELEMENTARY-PROCEDURES RANAP-ELEMENTARY-PROCEDURE ::= { + iu-Release | + relocationPreparation , + ... +} + +RANAP-ELEMENTARY-PROCEDURES2 RANAP-ELEMENTARY-PROCEDURE ::= { + {INITIATING MESSAGE Iu-ReleaseCommand + SUCCESSFUL OUTCOME Iu-ReleaseComplete + PROCEDURE CODE id-test + CRITICALITY notify} +} + +RANAP-ELEMENTARY-PROCEDURES3 RANAP-ELEMENTARY-PROCEDURE ::= { + iu-Release| + testObject, + ..., + relocationPreparation | + testObject2 +} + +Iu-ReleaseCommand ::= SEQUENCE { + first INTEGER, + second BOOLEAN +} + +Iu-ReleaseComplete ::= INTEGER (1..510) + +ProcedureCode ::= INTEGER (0..255) +Criticality ::= ENUMERATED { reject, ignore, notify } +id-Iu-Release INTEGER ::= 1 +id-relocationPreparation INTEGER ::= 2 +id-test INTEGER ::= 3 +id-test2 INTEGER ::= 4 + +END + + diff --git a/lib/asn1/examples/ecn_internaldoc.txt b/lib/asn1/examples/ecn_internaldoc.txt new file mode 100644 index 0000000000..71e2b7a2f1 --- /dev/null +++ b/lib/asn1/examples/ecn_internaldoc.txt @@ -0,0 +1,74 @@ +The ECN specification (X.692) describes how to make encodings +different from the standardised methods, BER and PER with variants. + +ECN has a system with inter-working modules including ordinary ASN1 +specs. There are any number of EDM (Encoding Definition Module) +modules. And always one ELM (Encoding Link Module). + +The EDMs contains definitions of encoding classes, encoding objects +and encoding object sets. They may also have IMPORTS and EXPORTS +clauses. Encoding classes tells the structure of the encoding. Besides +classes corresponding to types there are classes that define +determinants for length and presence. The objects tell how the actual +type that will be mapped to this object is encoded. + +The ELM is the module that links (applies) the various encodings, +defined in the EDMs, to the types in the ASN1 specs. + +The ASN1 specs are not affected by being part of an ECN application. + +The following requirements must be wholly or partly fulfilled to +enable the use of ECN in the OTP ASN1 compiler. + - Parsing of EDM and ELM modules. + - Extend the format of the abstract syntax tree or in other way + pass encoding information to code generation. + - Make possible to generate code with different encoding + methods. + - Unaligned PER backend. Often seems the unaligned PER encoding + as the prefferred main method in ECN applications. One of the + goals with ECN is to use less space for encoding to decrease + the use of bandwith in transmission. This goal is highly + supported by unaligned PER. + + +Parsing of EDM and ELM modules: +This should be done in a different parser than by the ASN1 +asn1ct_parser2.erl. The ECN syntax is quite extensive. A deeper +investigation must be done here. + +Extend format of abstract syntax: +To derive this format one has to consider both the explicit and +implicit defined encoding structures. +This addition of information should maybe be done after the check +phase of the ASN1 syntax. + +Code generation: +Initially one can just generate call-back functions when the encoding +differs from the default method. Nevertheless the information must be +present in the sytax tree so far. When the full functionality is +implemented one has to enable a finer granularity in the use of the +encoding rules. And also enable control of encoding on bit level. + +Unaligned PER backend: +Often in examples this variant of PER is used. It shouldn't be that +much work to add this encoding. Probably this will benefit the use of +the driver. + + +ECN can be used in for instance: + - Protocol systems that is not an ASN1 protocol. + - Specialized ASN1 protocols. + + +Need for ECN? + +Among the ASN1 systems that have been enabled for ECN are: +UMTS, +Bluetooth, +GPRS, +CAMEL phase 3 stage 2, +SS7, +SCCP, +and others. + +Inswitch has asked for it. diff --git a/lib/asn1/examples/encode_decode_formats.txt b/lib/asn1/examples/encode_decode_formats.txt new file mode 100644 index 0000000000..62774cf13b --- /dev/null +++ b/lib/asn1/examples/encode_decode_formats.txt @@ -0,0 +1,16 @@ +Compile options: | encode output | decode input | +------------------------------+-----------------------+-----------------| +ber (default) | flat list | flat list,binary| +ber_bin | iolist | binary | +ber_bin,optimize | iolist | binary | +ber_bin,optimize,driver | iolist | iolist,binary | +per | flat list | flat list | +per_bin | deep list | binary | +per_bin, optimize | binary | binary | +------------------------------+-----------------------+-----------------+ + + + + + +iolist: deep list with binaries and lists as componets
\ No newline at end of file diff --git a/lib/asn1/examples/recordnames.txt b/lib/asn1/examples/recordnames.txt new file mode 100644 index 0000000000..78e30ab510 --- /dev/null +++ b/lib/asn1/examples/recordnames.txt @@ -0,0 +1,51 @@ +For each ASN1 types SET and SEQUENCE a record is generated in the .hrl +file with the same name as the corresponding type. +A decoded value is also returned as a record with the apropriate name. +An internally defined type as the type in component 'a' in the +following example will result in a record with name 'Seq_a': + +Seq ::= SEQUENCE{ + a SEQUENCE{ + b INTEGER + } +} + +For each further internally defined type in a SET/SEQUENCE a +'_componentname' is added. + +If an internally defined type is an CHOICE alternative the record name +will get the alternative name as a unique part of the name. + +Seq ::= SEQUENCE{ + a CHOICE{ + b SEQUENCE { + c INTEGER + } + } +} + +This will produece a record 'Seq_a_b'. + +If an component is a SEQUENCE OF a SEQUENCE as in: +Seq ::= SEQUENCE { + a SEQUENCE OF SEQUENCE { + b + } + c SET OF SEQUENCE { + d + } +} +There will be a record 'Seq_a_SEQOF' and 'Seq_c_SETOF' + +A parameterized type should be considered as an internally defined +type. Each time a such type is referenced an instance of it is +defined. Thus in the following example a record 'Seq_b' is generated +in .hrl and used in .erl by decode. + +Seq ::= SEQUENCE { + b PType{INTEGER} +} + +PType{T} ::= SEQUENCE{ + id T +}
\ No newline at end of file diff --git a/lib/asn1/examples/test_driver.erl b/lib/asn1/examples/test_driver.erl new file mode 100644 index 0000000000..2bbdce4934 --- /dev/null +++ b/lib/asn1/examples/test_driver.erl @@ -0,0 +1,46 @@ +%%%------------------------------------------------------------------- +%%% File : test_driver.erl +%%% Author : Bertil Karlsson <bertil@finrod> +%%% Description : +%%% +%%% Created : 27 Mar 2002 by Bertil Karlsson <bertil@finrod> +%%%------------------------------------------------------------------- +-module(test_driver). + +-export([start/0, start/1, init/1, complete/1,complete/0]). + +start() -> + start("asn1_erl_drv"). + +start(SharedLib) -> + case erl_ddll:load_driver("../priv/bin/", SharedLib) of + ok -> ok; + {error, already_loaded} -> ok; + Error -> exit({error, could_not_load_driver,Error}) + end, + spawn(?MODULE, init, [SharedLib]). + +init(SharedLib) -> + Port = open_port({spawn, SharedLib}, []), + register(drv_complete,Port), + register(compl_pid,self()), + receive + stop -> + exit(goodbye) + end. + +complete(Data) -> + Ret=port_control(drv_complete,1,Data), + io:format("complete result:~n~p~n",[Ret]). + +complete() -> + %% The result should be <<64,192,17,17,24,96>> + Data1 = [<<0:8>>,<<1:8>>,<<2:8>>,<<10:8,2:8,3:8>>,<<20:8,2:8,17:8,17:8>>,<<30:8,2:8,1:8,24:8>>,<<31:8,2:8,0:8,1:8,24:8>>,<<2:8>>], + complete(Data1), + io:format("should have been:~n<<64,192,17,17,24,96>>~n"), + Data2 = [40,8,8,1,0,1,0,1,0,1,0,0,2,1,45,8,1,170,45,7,1,170], + complete(Data2), + io:format("should have been:~n<<170,0,213,85>>~n"), + Data3 = [40,8,8,1,0,1,0,1,0,1,0,0,2,1,45,8,1,170,45,8,1,170], + complete(Data3), + io:format("should have been:~n<<170,0,213,85,0>>~n"). diff --git a/lib/asn1/info b/lib/asn1/info new file mode 100644 index 0000000000..e20b398388 --- /dev/null +++ b/lib/asn1/info @@ -0,0 +1,2 @@ +group: comm +short: Provides support for Abstract Syntax Notation One diff --git a/lib/asn1/notes.html b/lib/asn1/notes.html new file mode 100644 index 0000000000..c7da5496c8 --- /dev/null +++ b/lib/asn1/notes.html @@ -0,0 +1,523 @@ +<HTML>
+<HEAD>
+ <TITLE>Asn1 Release Notes</TITLE>
+ <style type="text/css">
+<!--
+ body { background: white; margin: 3em }
+
+ body { font-family: Verdana, Arial, Helvetica, sans-serif }
+ h1 h2 h3 h4 { font-family: Verdana, Arial, Helvetica, sans-serif }
+ h1 { font-size: 48 }
+ p li { font-family: Verdana, Arial, Helvetica, sans-serif }
+-->
+ </style>
+</HEAD>
+
+<BODY BGCOLOR="#FFFFFF">
+
+<CENTER><H1>Asn1 Release Notes</H1></CENTER>
+
+<h2>Asn1 1.4.4.3</h2>
+
+<h3>Fixed errors and malfunctions</h3>
+
+<ul>
+
+ <li>A class that was referenced in two steps caused a compiler failure.
+ It is now corrected.
+ (Own Id: OTP-5103)<p>
+ </li>
+
+
+</ul>
+
+<h3>Improvements and new features</h3>
+
+<ul>
+ <li>
+ Optionally make it possible to get the undecoded rest along with
+ the return value. Compile with option <em>undec_rest</em>.
+ (Own Id: OTP-5104)<p>
+ </li>
+
+</ul>
+
+<!--- ----------------------------------------------------------------- --->
+
+<h2>Asn1 1.4.4.2</h2>
+
+<h3>Fixed errors and malfunctions</h3>
+
+<ul>
+
+ <li>An error due to unchecked referenced imported type resulted
+ in missing tag in some table constraint cases. This error is
+ now corrected. Error occured during decode in
+ <c>ber_bin optimized</c> version.
+ (Own Id: OTP-5022)<p>
+ </li>
+
+</ul>
+
+<!--- ----------------------------------------------------------------- --->
+
+<h2>Asn1 1.4.4.1</h2>
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Fixed errors and malfunctions</h3>
+
+<ul>
+
+ <li>When a referenced value in another module in turn referenced a
+ defined value the compilation crashed. This is due to the new
+ rutines for compilation, that external referencies are resolved
+ during compilation, and not by the order in which modules are
+ compiled. This error is now corrected.
+ (Own Id: OTP-4970)<p>
+ </li>
+
+</ul>
+
+
+
+<h2>Asn1 1.4.4</h2>
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Fixed errors and malfunctions</h3>
+
+<ul>
+
+ <li>
+ Functionality for parameterized class is added. Parsing failures on
+ WithSyntax spec is corrected.
+ (Own Id: OTP-4893)<p>
+ </li>
+
+ <li>
+ The failure due to Parameterized Type when parameter is an object
+ set is corrected.
+ (Own Id: OTP-4894)<p>
+ (Aux Id: OTP-4893)
+ </li>
+
+ <li>
+ Object Identifier values with two components and teh first was a
+ value reference failed due to parsing conflicts. Now it is
+ corrected.
+ (Own Id: OTP-4895)<p>
+ </li>
+
+ <li>
+ The errorounus comparison of file name and asn1 module name could
+ cause compilation failure. The situation for this failure is rare,
+ it requires that other processes modifies the compiled file during
+ the compilation procedure. It is now fixed.
+ (Own Id: OTP-4944)
+ (Aux Id: seq8429)<p>
+ </li>
+
+ <li>
+ Selective decode was ignored when exclusive decode spec in asn1
+ configfile was missing. Selective decode failed when the selected
+ type was the top type. These bugs are now removed.
+ (Own Id: OTP-4953)
+ (Aux Id: seq8436)<p>
+ </li>
+
+ <li>
+ The test interface asn1ct:test/1,2,3 and asn1ct:value/2 failed for
+ open type and EXTERNAL. The bug is now removed.
+ (Own Id: OTP-4955)
+ (Aux Id: seq8438)<p>
+ </li>
+
+ <li>
+ Two equal functions were generated for two components referencing
+ the same type when they were picked by the action "parts". The bug
+ is now fixed.
+ (Own Id: OTP-4957)
+ (Aux Id: seq8434)<p>
+ </li>
+
+</ul>
+
+<h3>Improvements and new features</h3>
+
+<ul>
+ <li>
+ INTEGER with named number list and ENUMERATED can now be sub
+ constrained with names from the names list.
+ (Own Id: OTP-4917)<p>
+ </li>
+
+ <li>
+ Now there is support for SelectionType (X 680 section 29)
+ (Own Id: OTP-4918)<p>
+ </li>
+
+ <li>
+ The compiler now resolves circular dependencies. When asn1 specs
+ IMPORTS from each other so that there are circular dependencies.
+ (Own Id: OTP-4919)<p>
+ </li>
+
+ <li>
+ Now is the asn1 type UTF8String supported. For user instructions
+ see documentation.
+ (Own Id: OTP-4965)<p>
+ </li>
+</ul>
+
+<h2>Asn1 1.4.3.2</h2>
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Improvements and new features</h3>
+
+<ul>
+ <li>Release of Asn1 1.4.3.1 on R7B, The functionality is the same, but
+ the layer between the driver and the asn1 erlang code is different.
+ </li>
+
+</ul>
+
+<!--- ----------------------------------------------------------------- --->
+
+
+<h2>Asn1 1.4.3.1</h2>
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Fixed errors and malfunctions</h3>
+
+<ul>
+
+ <li>
+ The <c>{internal_error,...,{ unrecognized_type,...}}</c> error occuring for a SET type when compiling with options <c>[ber_bin,optimize,der]</c> is now corrected.
+ (Own Id: OTP-4866)<p>
+ </li>
+
+ <li>
+ False encode of BIT STRING in PER (per_bin,optimize) is fixed. The error occured when there was a type like BIT STRING (SIZE(C)) and C > 16.
+ (Own Id: OTP-4869)<p>
+ </li>
+
+</ul>
+<!--- ----------------------------------------------------------------- --->
+
+
+<h2>Asn1 1.4.3</h2>
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Fixed errors and malfunctions</h3>
+
+<ul>
+
+ <li>
+ Functionality to handle parameterized object sets have been added.<br>
+ (Own Id: OTP-4832)<p>
+ </li>
+
+ <li>
+ Bug causing duplicated fuction definitions using exclusive decode is removed.<br>
+ (Own Id: OTP-4833)<p>
+ </li>
+
+ <li>
+ The race condition when loading asn1 driver is solved.<br>
+ (Own Id: OTP-4835)<p>
+ </li>
+
+</ul>
+<!--- ----------------------------------------------------------------- --->
+
+
+<h3>Improvements and new features</h3>
+
+<ul>
+
+ <li>
+ A specialized decode, <em>selective decode</em> is now available. It decodes a chosen internal sub-type of a constructed type.<br>
+ (Own Id: OTP-4856)<p>
+ </li>
+
+</ul>
+
+<!--- ----------------------------------------------------------------- --->
+
+
+<h2>Asn1 1.4.2.2</h2>
+
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Fixed errors and malfunctions</h3>
+
+<ul>
+ <li>Release of Asn1 1.4.2.1 on R7B, The functionality is the same, but
+ the layer between the driver and the asn1 erlang code is different.
+ </li>
+</ul>
+
+<!--- ----------------------------------------------------------------- --->
+
+
+
+<h2>Asn1 1.4.2.1</h2>
+
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Fixed errors and malfunctions</h3>
+
+<ul>
+
+ <li>
+ ObjectDescriptor does now work as part of a sequence, set or choice.<br>
+ (Own Id: OTP-4773)
+ </li>
+
+ <li>
+ When a SEQUENCE that have extension mark was decoded inside a
+ SEQUENCE OF it could cause decode error due to a failure in
+ restbytes2. It is now corrected.<br>
+ (Own Id: OTP-4791)<p>
+ </li>
+
+ <li>
+ Now the bug is fixed that caused the compiler crash on an untaged
+ optional open type.<br>
+ (Own Id: OTP-4792)
+ </li>
+
+ <li>
+ The earlier exit caused by bad indata is now fixed so it will
+ rreturn an {error,Reason} tuple.<br>
+ (Own Id: OTP-4797)
+ </li>
+
+ <li>
+ Open type encoded with indefinite length is now correct decoded.<br>
+ (Own Id: OTP-4798)
+ </li>
+
+ <li>
+ Now is absent optional open types handled correctly.<br>
+ (Own Id: OTP-4799)
+ </li>
+
+ <li>
+ Now is the necessary functions available for sorting in run-time of
+ SET and SET OF components.<br>
+ (Own Id: OTP-4809)
+ </li>
+
+</ul>
+<!--- ----------------------------------------------------------------- --->
+
+
+
+
+<h2>Asn1 1.4.2</h2>
+
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Fixed errors and malfunctions</h3>
+
+<ul>
+
+ <li>
+ When a component in a SEQUENCE is a CHOICE (or reference to a CHOICE)
+ and the SEQUENCE's component and one of the alternatives in the CHOICE
+ have identical names, an error may occur if one doesn't use the
+ 'optimized' versions of the compiler. In the older versions (<code>ber,
+ ber_bin, per, per_bin</code>) one could optionally apply a value of a
+ component as <code>{ComponentName,Value}</code>, and the generated code
+ chooses the second element of the tuple. However, a value of a CHOICE
+ must be applied as a tuple: <code>{AlternativeName,Value}</code>. Thus,
+ in the rare case described above and if the value to the SEQUENCE's
+ component is not in a tuple notation the
+ <code>{AlternativeName,Value}</code> will be peeled off in the SEQUENCE
+ and the value fed to the CHOICE will only be the <code>Value</code>
+ part of <code>{AlternativeName,Value}</code>, and the encoder crashes.
+ The best way to avoid this is to use the optimized version of the
+ compiler where the unnecessary tuple notation
+ <code>{ComponentName,Value}</code> no longer is allowed. Since it isn't
+ possible to solve this bug in the compiler.<br>
+ (Own Id: OTP-4693)<p>
+ </li>
+
+</ul>
+
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Improvements and new features</h3>
+
+<ul>
+
+ <li>
+ Exclusive decode is enabled by a compiler option and a configuration
+ file. It makes it possible to leave parts of an ASN.1 encoded message
+ undecoded.<br>
+ (Own Id: OTP-4744)<p>
+ </li>
+
+</ul>
+
+
+<!--- ################################################################# --->
+
+
+
+<h2>Asn1 1.4.1.1</h2>
+
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Fixed errors and malfunctions</h3>
+
+<ul>
+
+ <li>
+ The documentation about how extensibility is handled is now corrected.<br>
+ (Own Id: OTP-4663)<p>
+ </li>
+
+ <li>
+ Function in object now calls the exported function<br>
+ (Own Id: OTP-4665)<p>
+ </li>
+
+ <li>
+ Now is tags for ObjectClassFieldType analyzed correctly.
+ (Own Id: OTP-4666)<p>
+ </li>
+</ul>
+
+
+
+<h2>Asn1 1.4.1</h2>
+
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Fixed errors and malfunctions</h3>
+
+<ul>
+
+ <li>
+ Now is the Default value for an ENUMERATED returned as the name from
+ the NamedList when decoding.
+ (Own Id: OTP-4633)<p>
+ </li>
+
+ <li>
+ It was an internal failure when permitted alphabet constraint existed
+ together with for instance a size constraint. E.g. when a
+ referenced type is constrained by a size constraint and the defined
+ type in turn is constrained by a permitted alphabet constraint.<br>
+ (Own Id: OTP-4559)<p>
+ </li>
+
+ <li>
+ Record is generated in hrl file for a CHOICE with extension mark
+ that has an internal SEQUENCE/SET definition.
+ (Own Id: OTP-4560)<p>
+ </li>
+
+ <li>
+ Now is the length of a SEQUENCE/SET OF correctly encoded/decoded (PER).
+ (Own Id: OTP-4590)<p>
+ </li>
+
+ <li>
+ The problem with unordered decoded terms when a component is a
+ ObjectClassFieldType has been solved.
+ (Own Id: OTP-4591)
+ </li>
+</ul>
+
+
+<h3>Improvements and new features</h3>
+
+<ul>
+
+ <li>
+ More complex definitions with TableConstraints where the SimpleTable
+ and ComponentRelation are on different levels is now fully
+ supported. (Own Id: OTP-4631)
+ </li>
+
+</ul>
+
+
+<h2>Asn1 1.4</h2>
+
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Fixed errors and malfunctions</h3>
+
+
+<!--- ----------------------------------------------------------------- --->
+
+<h3>Improvements and new features</h3>
+
+<ul>
+
+ <li>
+ Each generated .erl file have now a function info/0 that returns
+ information about the used compiler version and options.<br>
+ (Own Id: OTP-4373)<p>
+ </li>
+
+ <li>
+ When compiling an ASN.1 module the compiler generates an Erlang module
+ that is compiled by the Erlang compiler. Earlier it was not possible to
+ add options to the final step, the Erlang compilation. By adding any
+ option that is not recognized as a specific ASN.1 option it will be
+ passed to the final step like: <code>erlc +debug_info
+ Mymodule.asn</code> or
+ <code>asn1ct:compile('Mymodule',[debug_info])</code>.<br>
+ (Own Id: OTP-4491)<p>
+ </li>
+
+ <li>
+ Earlier one couldn't multi file compile modules that had different
+ tagdefaul, which now is possible. Equal Type/Value names in different
+ modules are resolved by renaming (concatenate type name and module
+ name): If two types with the same name T exist in module A and module B
+ they will get the new names TA and TB.<br>
+ (Own Id: OTP-4492)<br>
+ (Aux Id: OTP-3983)<p>
+ </li>
+
+ <li>
+ BER: Encode/decode of data have been significantly improved. By use of
+ the compiler options <code>ber_bin</code> and <code>optimize</code>,
+ optimized code will be generated and the optimized run-time module will
+ be used.<br>
+ (Own Id: OTP-4493)<p>
+ </li>
+
+</ul>
+
+
+
+<p>
+There are also release notes for
+<a href="notes_history.html">older versions</a>.
+
+</body>
+</html>
+
+
+
+
+
+
diff --git a/lib/asn1/priv/bin/.gitignore b/lib/asn1/priv/bin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/asn1/priv/bin/.gitignore diff --git a/lib/asn1/release/.gitignore b/lib/asn1/release/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/asn1/release/.gitignore diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile new file mode 100644 index 0000000000..2733cde3f8 --- /dev/null +++ b/lib/asn1/src/Makefile @@ -0,0 +1,175 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# 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 +# + +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_bin \ + asn1rt_ber_bin \ + asn1rt_ber_bin_v2 \ + asn1rt_per_bin_rt2ct \ + asn1rt_uper_bin \ + asn1rt_check \ + asn1rt_driver_handler +# asn1_sup \ +# asn1_app \ +# asn1_server + + +# 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 +# ---------------------------------------------------- + +ifeq ($(USE_ASN1_HIPE),true) +ERL_COMPILE_FLAGS += +native +endif + +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: + + +info: + @echo "PARSER_SRC: $(PARSER_SRC)" + @echo "INSTALL_DATA: $(INSTALL_DATA)" +# ---------------------------------------------------- +# 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) $(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/asn1/src/Restrictions.txt b/lib/asn1/src/Restrictions.txt new file mode 100644 index 0000000000..73b725245d --- /dev/null +++ b/lib/asn1/src/Restrictions.txt @@ -0,0 +1,55 @@ +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/asn1/src/asn1.app.src b/lib/asn1/src/asn1.app.src new file mode 100644 index 0000000000..abacb0a1e9 --- /dev/null +++ b/lib/asn1/src/asn1.app.src @@ -0,0 +1,21 @@ +{application, asn1, + [{description, "The Erlang ASN1 compiler version %VSN%"}, + {vsn, "%VSN%"}, + {modules, [ + asn1rt, + asn1rt_per_bin, + asn1rt_per_bin_rt2ct, + asn1rt_uper_bin, + asn1rt_ber_bin, + asn1rt_ber_bin_v2, + asn1rt_check, + asn1rt_driver_handler + ]}, + {registered, [ + asn1_ns, + asn1db, + asn1_driver_owner + ]}, + {env, []}, + {applications, [kernel, stdlib]} + ]}. diff --git a/lib/asn1/src/asn1.appup.src b/lib/asn1/src/asn1.appup.src new file mode 100644 index 0000000000..753d308684 --- /dev/null +++ b/lib/asn1/src/asn1.appup.src @@ -0,0 +1,113 @@ +{"%VSN%", + [ + {"1.6.8", + [ + {load_module, asn1rt, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []}, + {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []}, + {load_module, asn1rt_check, soft_purge, soft_purge, []}, + {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []}, + {apply, {asn1rt_driver_handler,unload_driver,[]}} + ] + }, + {"1.6.8.1", + [ + {load_module, asn1rt, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []}, + {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []}, + {load_module, asn1rt_check, soft_purge, soft_purge, []}, + {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []}, + {apply, {asn1rt_driver_handler,unload_driver,[]}} + ] + }, + {"1.6.9", + [ + {load_module, asn1rt, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []}, + {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []}, + {load_module, asn1rt_check, soft_purge, soft_purge, []}, + {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []}, + {apply, {asn1rt_driver_handler,unload_driver,[]}} + ] + }, + {"1.6.10", + [ + {load_module, asn1rt, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []}, + {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []}, + {load_module, asn1rt_check, soft_purge, soft_purge, []}, + {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []}, + {apply, {asn1rt_driver_handler,unload_driver,[]}} + ] + } + ], + [ + {"1.6.8", + [ + {load_module, asn1rt, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []}, + {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []}, + {load_module, asn1rt_check, soft_purge, soft_purge, []}, + {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []}, + {apply, {asn1rt_driver_handler,unload_driver,[]}} + ] + }, + {"1.6.8.1", + [ + {load_module, asn1rt, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []}, + {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []}, + {load_module, asn1rt_check, soft_purge, soft_purge, []}, + {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []}, + {apply, {asn1rt_driver_handler,unload_driver,[]}} + ] + }, + {"1.6.9", + [ + {load_module, asn1rt, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []}, + {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []}, + {load_module, asn1rt_check, soft_purge, soft_purge, []}, + {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []}, + {apply, {asn1rt_driver_handler,unload_driver,[]}} + ] + }, + {"1.6.10", + [ + {load_module, asn1rt, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_per_bin_rt2ct, soft_purge, soft_purge, []}, + {load_module, asn1rt_uper_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin, soft_purge, soft_purge, []}, + {load_module, asn1rt_ber_bin_v2, soft_purge, soft_purge, []}, + {load_module, asn1rt_check, soft_purge, soft_purge, []}, + {load_module, asn1rt_driver_handler, soft_purge, soft_purge, []}, + {apply, {asn1rt_driver_handler,unload_driver,[]}} + ] + } + ]}. + + + + diff --git a/lib/asn1/src/asn1_app.erl b/lib/asn1/src/asn1_app.erl new file mode 100644 index 0000000000..2d3eed1743 --- /dev/null +++ b/lib/asn1/src/asn1_app.erl @@ -0,0 +1,38 @@ +%% ``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$ +%% + +%% Purpose : Application master for asn1. + +-module(asn1_app). + +-behaviour(application). + +-export([start/2, stop/1]). + +%% start/2(Type, StartArgs) -> {ok, Pid} | {ok, Pid, State} | +%% {error, Reason} +%% +start(_Type, _StartArgs) -> + asn1_sup:start_link(). + +%% stop(State) +%% +stop(_State) -> + ok. + + diff --git a/lib/asn1/src/asn1_db.erl b/lib/asn1/src/asn1_db.erl new file mode 100644 index 0000000000..f680b3d064 --- /dev/null +++ b/lib/asn1/src/asn1_db.erl @@ -0,0 +1,167 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(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])); + {From,{new_includes,[NewIncludes]}} -> + From ! {asn1db,done}, + dbloop(NewIncludes,Tab) + 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 -> + req({new_includes,Args}) + end. + + diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl new file mode 100644 index 0000000000..8a428b744c --- /dev/null +++ b/lib/asn1/src/asn1_records.hrl @@ -0,0 +1,118 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-ifdef(debug). +-define(dbg(Fmt, Args), ok=io:format("~p: " ++ Fmt, [?LINE|Args])). +-else. +-define(dbg(Fmt, Args), no_debug). +-endif. + +-define('RT_BER_BIN',"asn1rt_ber_bin"). +-define('RT_PER_BIN',"asn1rt_per_bin"). + +%% Some encoding are common for BER and PER. Shared code are in RT_COMMON +-define('RT_COMMON',asn1rt_ber_bin). + +-define('COMPLETE_ENCODE',1). +-define('TLV_DECODE',2). + + +-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,textual_order}). +-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,module}). +-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, + sourcedir}). + +%% state record used by back-end 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 tuples with function names,type etc +%% that have been generated. It is to prevent duplicates of referenced +%% functions, and to generate the correct decode_inc_disp functions. +%% suffix_index is a number that is used as a suffix to make function +%% names unique. It is increased for each additional step into a +%% constructed type in an exclusive decode. +%% current_suffix_index is the index of the top type that is generated +%% at the moment. It may be the same as the current suffix_index or an +%% earlier value of it. +-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=[], + generated_functions=[],suffix_index=1, + current_suffix_index}). diff --git a/lib/asn1/src/asn1_server.erl b/lib/asn1/src/asn1_server.erl new file mode 100644 index 0000000000..aeb59d8b0c --- /dev/null +++ b/lib/asn1/src/asn1_server.erl @@ -0,0 +1,107 @@ +%% ``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$ +%% + +%% Purpose: Provide complete encode/and pre-decode of asn1. +-module(asn1_server). + + + +-behaviour(gen_server). + +-export([start_link/0,client_port/0]). + +%% Internal exports, call-back functions. +-export([init/1,handle_call/3,handle_cast/2,handle_info/2,code_change/3, + terminate/2]). + + +%% Macros +-define(port_names, + { asn1_drv01, asn1_drv02, asn1_drv03, asn1_drv04, + asn1_drv05, asn1_drv06, asn1_drv07, asn1_drv08, + asn1_drv09, asn1_drv10, asn1_drv11, asn1_drv12, + asn1_drv13, asn1_drv14, asn1_drv15, asn1_drv16 }). +%%% -------------------------------------------------------- +%%% Interface Functions. +%%% -------------------------------------------------------- + +start_link() -> + gen_server:start_link({local, asn1_server}, asn1_server, [], []). + +init([]) -> + process_flag(trap_exit, true), + erl_ddll:start(), + PrivDir = code:priv_dir(asn1), + LibDir1 = filename:join([PrivDir, "lib"]), + case erl_ddll:load_driver(LibDir1, asn1_erl_drv) of + ok -> ok; + {error,_} -> + LibDir2 = + filename:join(LibDir1, + erlang:system_info(system_architecture)), + erl_ddll:load_driver(LibDir2, asn1_erl_drv) + end, + open_ports("asn1_erl_drv",size(?port_names)). + +open_ports(_,0) -> + {ok, []}; +open_ports(Cmd,N) -> + Port = open_port({spawn, Cmd}, []), + %% check that driver is loaded, linked and working + case catch port_control(Port, 0, []) of + {'EXIT', _} -> + {stop, nodriver}; + _ -> + register(element(N,?port_names), Port), + open_ports(Cmd,N-1) + end. + +client_port() -> + element(erlang:system_info(scheduler_id) rem size(?port_names) + 1, + ?port_names). + + +%%% -------------------------------------------------------- +%%% The call-back functions. +%%% -------------------------------------------------------- + +handle_call(_, _, State) -> + {noreply, State}. + +handle_cast(_, State) -> + {noreply, State}. + +handle_info({'EXIT', Pid, _Reason}, State) when is_pid(Pid) -> + {noreply, State}; + +handle_info({'EXIT', Port, Reason}, State) when is_port(Port) -> + {stop, {port_died, Reason}, State}; +handle_info(_, State) -> + {noreply, State}. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +terminate(_Reason, _State) -> + close_ports(size(?port_names)). + +close_ports(0) -> + ok; +close_ports(N) -> + element(N,?port_names) ! {self(), close}, %% almost same as port_close(Name) + close_ports(N-1). diff --git a/lib/asn1/src/asn1_sup.erl b/lib/asn1/src/asn1_sup.erl new file mode 100644 index 0000000000..a241dec6f4 --- /dev/null +++ b/lib/asn1/src/asn1_sup.erl @@ -0,0 +1,37 @@ +%% ``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$ +%% + +%% Purpose: Main supervisor in asn1 application. + +-module(asn1_sup). + +-behaviour(supervisor). + +-export([start_link/0, init/1]). + +start_link() -> + supervisor:start_link({local, asn1_sup}, asn1_sup, []). + + +%% init([]) +%% Returns: {ok, {SupFlags, [ChildSpec]}} +%% +init([]) -> + Child = {asn1_server, {asn1_server, start_link, []}, + permanent, 2000, worker, [asn1_server]}, + {ok, {{one_for_all, 10, 3600}, [Child]}}. diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl new file mode 100644 index 0000000000..e6fd3663dd --- /dev/null +++ b/lib/asn1/src/asn1ct.erl @@ -0,0 +1,2520 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct). + +%% 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, + maybe_rename_function/3,latest_sindex/0,current_sindex/0, + set_current_sindex/1,next_sindex/0,maybe_saved_sindex/2, + parse_and_save/2]). + +-include("asn1_records.hrl"). +-include_lib("stdlib/include/erl_compile.hrl"). +-include_lib("kernel/include/file.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(OPTIONAL_UNDECODED,opt_undec). +-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 is_list(Options) -> + Options1 = optimize_ber_bin(Options), + Options2 = includes(File,Options1), + Includes=[I||{i,I}<-Options2], + case (catch input_file_type(File,Includes)) of + {single_file,SuffixedFile} -> %% "e.g. "/tmp/File.asn" + (catch compile1(SuffixedFile,Options2)); + {multiple_files_file,SetBase,FileName} -> + FileList = get_file_list(FileName,Includes), +%% io:format("FileList: ~p~n",[FileList]), + case FileList of + L when is_list(L) -> + (catch compile_set(SetBase,FileList,Options2)); + Err -> + Err + end; + Err = {input_file_error,_Reason} -> + {error,Err}; + Err2 -> Err2 + end. + + +compile1(File,Options) when is_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(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]), + Ret = compile_erl(Continue4,OutFile,Options), + case inline(is_inline(Options), + inline_output(Options,filename:rootname(File)), + lists:concat([OutFile,".erl"]),Options) of + false -> + Ret; + InlineRet -> + InlineRet + end. + + +%%****************************************************************************%% +%% functions dealing with compiling of several input files to one output file %% +%%****************************************************************************%% + +%%% +%% inline/4 +%% merges the resulting erlang modules with +%% the appropriate run-time modules so the resulting module contains all +%% run-time asn1 functionality. Then compiles the resulting file to beam code. +%% The merging is done by the igor module. If this function is used in older +%% versions than R10B the igor module, part of user contribution syntax_tools, +%% must be provided. It is possible to pass options for the ASN1 compiler +%% Types: +%% Name -> atom() +%% Modules -> [filename()] +%% Options -> [term()] +%% filename() -> file:filename() +inline(true,Name,Module,Options) -> + RTmodule = get_runtime_mod(Options), + IgorOptions = igorify_options(remove_asn_flags(Options)), + IgorName = filename:rootname(filename:basename(Name)), +% io:format("*****~nName: ~p~nModules: ~p~nIgorOptions: ~p~n*****~n", +% [IgorName,Modules++RTmodule,IgorOptions]), + io:format("Inlining modules: ~p in ~p~n",[[Module]++RTmodule,IgorName]), + case catch igor:merge(IgorName,[Module]++RTmodule,[{preprocess,true},{stubs,false},{backups,false}]++IgorOptions) of + {'EXIT',{undef,Reason}} -> %% module igor first in R10B + io:format("Module igor in syntax_tools must be available:~n~p~n", + [Reason]), + {error,'no_compilation'}; + {'EXIT',Reason} -> + io:format("Merge by igor module failed due to ~p~n",[Reason]), + {error,'no_compilation'}; + _ -> +%% io:format("compiling output module: ~p~n",[generated_file(Name,IgorOptions)]), + erl_compile(generated_file(Name,IgorOptions),Options) + end; +inline(_,_,_,_) -> + false. + +%% compile_set/3 merges and compiles a number of asn1 modules +%% specified in a .set.asn file to one .erl file. +compile_set(SetBase,Files,Options) + when is_list(hd(Files)),is_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(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 + is_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) -> + + 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]), + + Ret = compile_erl(Continue2,OutFile,Options), + case inline(is_inline(Options), + inline_output(Options,filename:rootname(OutFile)), + lists:concat([OutFile,".erl"]),Options) of + false -> + Ret; + InlineRet -> + InlineRet + end. + +%% 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_mod(D1),unset_pos_mod(D2)). +compare_defs2(D,D) -> + equal; +compare_defs2(_,_) -> + not_equal. + +unset_pos_mod(Def) when is_record(Def,typedef) -> + Def#typedef{pos=undefined}; +unset_pos_mod(Def) when is_record(Def,classdef) -> + Def#classdef{pos=undefined}; +unset_pos_mod(Def) when is_record(Def,valuedef) -> + Def#valuedef{pos=undefined,module=undefined}; +unset_pos_mod(Def) when is_record(Def,ptypedef) -> + Def#ptypedef{pos=undefined}; +unset_pos_mod(Def) when is_record(Def,pvaluedef) -> + Def#pvaluedef{pos=undefined}; +unset_pos_mod(Def) when is_record(Def,pvaluesetdef) -> + Def#pvaluesetdef{pos=undefined}; +unset_pos_mod(Def) when is_record(Def,pobjectdef) -> + Def#pobjectdef{pos=undefined}; +unset_pos_mod(Def) when is_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_pos_of_def(_) -> + undefined. + + +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; +get_name_of_def(_) -> + undefined. + +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]), + lists:foreach(fun(X) -> ets:insert(original_imports,X) end,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 is_record(T,typedef)-> + #'Externaltypereference'{pos=0, + module=MName, + type=T#typedef.name}; + V when is_record(V,valuedef) -> + #'Externalvaluereference'{pos=0, + module=MName, + value=V#valuedef.name}; + C when is_record(C,classdef) -> + #'Externaltypereference'{pos=0, + module=MName, + type=C#classdef.name}; + P when is_record(P,ptypedef) -> + #'Externaltypereference'{pos=0, + module=MName, + type=P#ptypedef.name}; + PV when is_record(PV,pvaluesetdef) -> + #'Externaltypereference'{pos=0, + module=MName, + type=PV#pvaluesetdef.name}; + PO when is_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(Files,Options) -> + %% The files in Files already have their relative path and extension + lists:map( + fun(F)-> + case scan(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(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. + + +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 + is_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) -> + + start(Includes), + case asn1ct_check:storeindb(#state{erule=EncodingRule},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, + sourcedir=filename:dirname(File)}, + 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, + + Result = + case (catch asn1ct_gen:pgen(OutFile,EncodingRule, + M#module.name,GenTOrV)) of + {'EXIT',Reason2} -> + io:format("ERROR: ~p~n",[Reason2]), + {error,Reason2}; + _ -> + ok + end, + 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 Result of + {error,_} -> + {false,Result}; + ok -> + case lists:member(sg,Options) of + true -> % terminate here , with .erl file generated + {false,true}; + false -> + {true,true} + end + end; +generate({false,M},_,_,_) -> + {false,M}. + +%% parse_and_save parses an asn1 spec and saves the unchecked parse +%% tree in a data base file. +%% Does not support multifile compilation files +parse_and_save(Module,S) -> + Options = S#state.options, + SourceDir = S#state.sourcedir, + Includes = [I || {i,I} <-Options], + Options1 = optimize_ber_bin(Options), + + case get_input_file(Module,[SourceDir|Includes]) of + %% search for asn1 source + {file,SuffixedASN1source} -> + case dbfile_uptodate(SuffixedASN1source,Options1) of + false -> + parse_and_save1(S,SuffixedASN1source,Options1,Includes); + _ -> ok + end; + Err -> + io:format("Warning: could not do a consistency check of the ~p file: no asn1 source file was found.~n",[lists:concat([Module,".asn1db"])]), + {error,{asn1,input_file_error,Err}} + end. +parse_and_save1(S,File,Options,Includes) -> + Ext = filename:extension(File), + Base = filename:basename(File,Ext), + DbFile = outfile(Base,"asn1db",Options), + Continue1 = scan(File,Options), + M = + case parse(Continue1,File,Options) of + {true,Mod} -> Mod; + _ -> +%% io:format("~p~nnow I die!!!!!!!!!!!~n",[File]), + exit({error,{asn1,File,"no such file"}}) + end, +% start(["."|Includes]), + start(Includes), + case asn1ct_check:storeindb(S,M) of + ok -> + asn1_db:dbsave(DbFile,M#module.name) + end. + +get_input_file(Module,[]) -> + Module; +get_input_file(Module,[I|Includes]) -> + case (catch input_file_type(filename:join([I,Module]))) of + {single_file,FileName} -> +%% case file:read_file_info(FileName) of +%% {ok,_} -> + {file,FileName}; +%% _ -> get_input_file(Module,Includes) +%% end; + _ -> + get_input_file(Module,Includes) + end. + +dbfile_uptodate(File,Options) -> + EncodingRule = get_rule(Options), + Ext = filename:extension(File), + Base = filename:basename(File,Ext), + DbFile = outfile(Base,"asn1db",Options), + case file:read_file_info(DbFile) of + {error,enoent} -> + false; + {ok,FileInfoDb} -> + %% file exists, check date and finally encodingrule + {ok,FileInfoAsn} = file:read_file_info(File), + case FileInfoDb#file_info.mtime < FileInfoAsn#file_info.mtime of + true -> + %% date of asn1 spec newer than db file + false; + _ -> + %% date ok,check that same erule was used + Obase = case lists:keysearch(outdir, 1, Options) of + {value, {outdir, Odir}} -> + Odir; + _NotFound -> "" + end, + BeamFileName = outfile(Base,"beam",Options), + case file:read_file_info(BeamFileName) of + {ok,_} -> + code:add_path(Obase), + BeamFile = list_to_atom(Base), + BeamInfo = (catch BeamFile:info()), + case catch lists:keysearch(options,1,BeamInfo) of + {value,{options,OldOptions}} -> + case get_rule(OldOptions) of + EncodingRule -> true; + _ -> false + end; + _ -> false + end; + _ -> false + end + end + end. + + +compile_erl({true,_},OutFile,Options) -> + erl_compile(OutFile,Options); +compile_erl({false,true},_,_) -> + ok; +compile_erl({false,Result},_,_) -> + Result. + +input_file_type(Name,I) -> + case input_file_type(Name) of + {error,_} -> input_file_type2(filename:basename(Name),I); + Err={input_file_error,_} -> Err; + Res -> Res + end. +input_file_type2(Name,[I|Is]) -> + case input_file_type(filename:join([I,Name])) of + {error,_} -> input_file_type2(Name,Is); + Err={input_file_error,_} -> Err; + Res -> Res + end; +input_file_type2(Name,[]) -> + input_file_type(Name). + +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 -> + case file:read_file_info(lists:concat([File,".py"])) of + {ok,_FileInfo} -> + {single_file, lists:concat([File,".py"])}; + Error -> + Error + end + 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; + Asn1SFix -> + Base = filename:basename(File,Asn1SFix), + Ret = + case filename:extension(Base) of + [] -> + {single_file,File}; + SetSFix when (SetSFix == ".set") -> + {multiple_files_file, + list_to_atom(filename:basename(Base,SetSFix)), + File}; + _Error -> + throw({input_file_error,{'Bad input file',File}}) + end, + %% check that the file exists + case file:read_file_info(File) of + {ok,_} -> Ret; + Err -> Err + end + end. + +get_file_list(File,Includes) -> + case file:open(File,[read]) of + {error,Reason} -> + {error,{File,file:format_error(Reason)}}; + {ok,Stream} -> + get_file_list1(Stream,filename:dirname(File),Includes,[]) + end. + +get_file_list1(Stream,Dir,Includes,Acc) -> + Ret = io:get_line(Stream,''), + case Ret of + eof -> + file:close(Stream), + lists:reverse(Acc); + FileName -> + SuffixedNameList = + case (catch input_file_type(filename:join([Dir,lists:delete($\n,FileName)]),Includes)) of + {empty_name,[]} -> []; + {single_file,Name} -> [Name]; + {multiple_files_file,_,Name} -> + get_file_list(Name,Includes); + _Err -> + [] + end, + get_file_list1(Stream,Dir,Includes,SuffixedNameList++Acc) + end. + +get_rule(Options) -> + case [Rule ||Rule <-[per,ber,ber_bin,ber_bin_v2,per_bin,uper_bin], + Opt <- Options, + Rule==Opt] of + [Rule] -> + Rule; + [Rule|_] -> + Rule; + [] -> + ber + end. + +get_runtime_mod(Options) -> + RtMod1= + case get_rule(Options) of + per -> ["asn1rt_per_bin.erl"]; + ber -> ["asn1rt_ber_bin.erl"]; + per_bin -> + case lists:member(optimize,Options) of + true -> ["asn1rt_per_bin_rt2ct.erl"]; + _ -> ["asn1rt_per_bin.erl"] + end; + ber_bin -> ["asn1rt_ber_bin.erl"]; + ber_bin_v2 -> ["asn1rt_ber_bin_v2.erl"]; + uper_bin -> ["asn1rt_uper_bin.erl"] + end, + RtMod1++["asn1rt_check.erl","asn1rt_driver_handler.erl","asn1rt.erl"]. + + +erl_compile(OutFile,Options) -> +% io:format("Options:~n~p~n",[Options]), + case lists:member(noobj,Options) of + true -> + ok; + _ -> + ErlOptions = remove_asn_flags(Options), + %% io:format("~n~nc:c(~p,~p)~n~n",[OutFile,ErlOptions]), + 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, + X /= asn1config, + X /= record_name_prefix]. + +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. + +igorify_options(Options) -> + case lists:keysearch(outdir,1,Options) of + {value,{_,Dir}} -> + Options1 = lists:keydelete(outdir,1,Options), + [{dir,Dir}|Options1]; + _ -> + Options + end. + +generated_file(Name,Options) -> + case lists:keysearch(dir,1,Options) of + {value,{_,Dir}} -> + filename:join([Dir,filename:basename(Name)]); + _ -> + Name + end. + +debug_off(_Options) -> + erase(asndebug), + erase(asn_keyed_list). + + +outfile(Base, Ext, Opts) -> +% io:format("Opts. ~p~n",[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; + _ -> + lists:concat([Obase,".",Ext]) + end. + +optimize_ber_bin(Options) -> + case {lists:member(optimize,Options),lists:member(ber_bin,Options)} of + {true,true} -> + [ber_bin_v2|Options--[ber_bin]]; + _ -> Options + end. + +includes(File,Options) -> + Dir = filename:dirname(File), + Options2 = + case lists:member({i,"."},Options) of + false -> Options ++ [{i,"."}]; + _ -> Options + end, + case lists:member({i,Dir}, Options2) of + false -> Options2 ++ [{i,Dir}]; + _ -> Options2 + end. + +is_inline(Options) -> + case lists:member(inline,Options) of + true -> true; + _ -> + lists:keymember(inline,1,Options) + end. +inline_output(Options,Default) -> + case [X||{inline,X}<-Options] of + [OutputName] -> + OutputName; + _ -> + Default + 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 is_tuple(ParseRes) -> + io:format("~p~n",[ParseRes]), + ok; + ScanRes when is_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]; + uper_bin -> [uper_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 is_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 is_list(Module) -> + asn1rt:encode(list_to_atom(Module),Type,Term); +encode(Module,Type,Term) -> + asn1rt:encode(Module,Type,Term). + +decode(Module,Type,Bytes) when is_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 + is_list(Module) -> + list_to_atom(Module); + true -> + Module + end, + NewBytes = + case M:encoding_rule() of + ber -> + lists:flatten(Bytes); + ber_bin when is_binary(Bytes) -> + Bytes; + ber_bin -> + list_to_binary(Bytes); + ber_bin_v2 when is_binary(Bytes) -> + Bytes; + ber_bin_v2 -> + list_to_binary(Bytes); + per -> + lists:flatten(Bytes); + per_bin when is_binary(Bytes) -> + Bytes; + per_bin -> + list_to_binary(Bytes); + uper_bin -> + 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. + +vsn() -> + ?vsn. + + + +print_error_message([got,H|T]) when is_list(H) -> + io:format(" got:"), + print_listing(H,"and"), + print_error_message(T); +print_error_message([expected,H|T]) when is_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 is_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) -> + 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 is_tuple(TsAndVs) -> + %% read configure file + + ModName = + case lists:keysearch(asn1config,1,Options) of + {value,{_,MName}} -> MName; + _ -> M#module.name + end, +%% io:format("ModName: ~p~nM#module.name: ~p~n~n",[ModName,M#module.name]), + CfgList = read_config_file(ModName), + SelectedDecode = get_config_info(CfgList,selective_decode), + ExclusiveDecode = get_config_info(CfgList,exclusive_decode), + CommandList = + create_partial_decode_gen_info(M#module.name,SelectedDecode), + %% To convert CommandList to a proper list for the driver change + %% the list:[[choosen,Tag1],skip,[skip_optional,Tag2]] to L = + %% [5,2,Tag1,0,1,Tag2] where 5 is the length, and call + %% port_control(asn1_driver_port,3,[L| Bin]) + save_config(partial_decode,CommandList), + save_gen_state(selective_decode,SelectedDecode), +% io:format("selective_decode: CommandList:~n~p~nSelectedDecode:~n~p~n", +% [CommandList,SelectedDecode]), + CommandList2 = + create_partial_inc_decode_gen_info(M#module.name,ExclusiveDecode), +% io:format("partial_incomplete_decode = ~p~n",[CommandList2]), + Part_inc_tlv_tags = tlv_tags(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(exclusive_decode,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 is_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 is_list(Comps1),is_list(Comps2) -> + create_pdec_inc_command(ModName,Comps1 ++ Comps2,TNL,Acc); +%% The following two functionclauses matches on the type after the top type. This one if the top type had no tag, i.e. a CHOICE +create_pdec_inc_command(ModN,Clist,[CL|_Rest],[[]]) when is_list(CL) -> + create_pdec_inc_command(ModN,Clist,CL,[]); +create_pdec_inc_command(ModN,Clist,[CL|_Rest],Acc) when is_list(CL) -> + InnerDirectives=create_pdec_inc_command(ModN,Clist,CL,[]), + lists:reverse([InnerDirectives|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,concat_sequential(TagCommand,Acc)); + {Name,parts} -> + TagCommand = get_tag_command(TS,?PARTS,Prop), + create_pdec_inc_command(ModName,Comps,Cs,concat_sequential(TagCommand,Acc)); + L when is_list(L) -> % I guess this never happens due to previous function clause + %% 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 is_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,concat_sequential(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 is_list(List) -> +% [Command,Tag] = get_tag_command(TS,?ALTERNATIVE,Prop), + TagCommand = get_tag_command(TS,?ALTERNATIVE,Prop), + CompAcc = + create_pdec_inc_command(ModName, + get_components(TS#type.def),List,[]), + NewAcc = case TagCommand of + [Command,Tag] when is_atom(Command) -> + [[Command,Tag,CompAcc]|Acc]; + [L1,_L2|Rest] when is_list(L1) -> +% [LastComm|Comms] = lists:reverse(TagCommand), +% [concat_sequential(lists:reverse(Comms), +% [LastComm,CompAcc])|Acc] + case lists:reverse(TagCommand) of + [Atom|Comms]�when is_atom(Atom) -> + [concat_sequential(lists:reverse(Comms), + [Atom,CompAcc])|Acc]; + [[Command2,Tag2]|Comms] -> + [concat_sequential(lists:reverse(Comms), + [[Command2,Tag2,CompAcc]])|Acc] + end +% [concat_sequential(lists:reverse(Comms), +% InnerCommand)|Acc] + + end, + create_pdec_inc_command(ModName,{'CHOICE',Comps},Rest, +% [[Command,Tag,CompAcc]|Acc]); + NewAcc); + undecoded -> + TagCommand = get_tag_command(TS,?ALTERNATIVE_UNDECODED,Prop), + create_pdec_inc_command(ModName,{'CHOICE',Comps},Rest, + concat_sequential(TagCommand,Acc)); + parts -> + TagCommand = get_tag_command(TS,?ALTERNATIVE_PARTS,Prop), + create_pdec_inc_command(ModName,{'CHOICE',Comps},Rest, + concat_sequential(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, + concat_sequential(TagCommand,Acc)); +create_pdec_inc_command(M,{'CHOICE',{Cs1,Cs2}},TNL,Acc) + when is_list(Cs1),is_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 is_atom(T) -> + T; +partial_inc_dec_toptype([{T,_}|_]) when is_atom(T) -> + T; +partial_inc_dec_toptype([L|_]) when is_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,TypeLists}) -> + [create_partial_decode_gen_info1(ModName,TL) || TL <- TypeLists]; +create_partial_decode_gen_info(_,[]) -> + []; +create_partial_decode_gen_info(_M1,{M2,_}) -> + throw({error,{"wrong module name in asn1 config file", + M2}}). + +%create_partial_decode_gen_info1(ModName,{ModName,TypeList}) -> +create_partial_decode_gen_info1(ModName,{FuncName,TypeList}) -> + case TypeList of + [TopType|Rest] -> + case asn1_db:dbget(ModName,TopType) of + #typedef{typespec=TS} -> + TagCommand = get_tag_command(TS,?CHOOSEN), + Ret=create_pdec_command(ModName, + get_components(TS#type.def), + Rest,concat_tags(TagCommand,[])), + {FuncName,Ret}; + _ -> + throw({error,{"wrong type list in asn1 config file", + TypeList}}) + end; + _ -> + [] + end; +create_partial_decode_gen_info1(_,_) -> + ok. +% create_partial_decode_gen_info1(_,[]) -> +% []; +% create_partial_decode_gen_info1(_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) -> + Remove_empty_lists = + fun([[]|L],Res,Fun) -> + Fun(L,Res,Fun); + ([],Res,_) -> + Res; + ([H|L],Res,Fun) -> + Fun(L,[H|Res],Fun) + end, + Remove_empty_lists(Acc,[],Remove_empty_lists); +% 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,concat_tags(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],concat_tags(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) -> + #type{def=Def} = get_referenced_type(M,C1), + create_pdec_command(ModName,get_components(Def),TypeNameList, + Acc); +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,concat_tags(TagCommand,Acc)); + [N] when is_integer(N) -> + TagCommand = get_tag_command(TS,?SKIP), + create_pdec_command(ModName,Def,[[N-1]|Cs], + concat_tags(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={C1,C2}}) when is_list(C1),is_list(C2) -> + C1++C2; +get_components(#'SEQUENCE'{components=Components}) -> + Components; +get_components(#'SET'{components={C1,C2}}) when is_list(C1),is_list(C2) -> + C1++C2; +get_components(#'SET'{components=Components}) -> + Components; +get_components({'SEQUENCE OF',Components}) -> + Components; +get_components({'SET OF',Components}) -> + Components; +get_components(Def) -> + Def. + +concat_sequential(L=[A,B],Acc) when is_atom(A),is_binary(B) -> + [L|Acc]; +concat_sequential(L,Acc) when is_list(L) -> + concat_sequential1(lists:reverse(L),Acc); +concat_sequential(A,Acc) -> + [A|Acc]. +concat_sequential1([],Acc) -> + Acc; +concat_sequential1([[]],Acc) -> + Acc; +concat_sequential1([El|RestEl],Acc) when is_list(El) -> + concat_sequential1(RestEl,[El|Acc]); +concat_sequential1([mandatory|RestEl],Acc) -> + concat_sequential1(RestEl,[mandatory|Acc]); +concat_sequential1(L,Acc) -> + [L|Acc]. + + +many_tags([?SKIP])-> + false; +many_tags([?SKIP_OPTIONAL,_]) -> + false; +many_tags([?CHOOSEN,_]) -> + false; +many_tags(_) -> + true. + +concat_tags(Ts,Acc) -> + case many_tags(Ts) of + true when is_list(Ts) -> + lists:reverse(Ts)++Acc; + true -> + [Ts|Acc]; + false -> + [Ts|Acc] + end. +%% 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=[]},_) -> + []; +%% SKIP and SKIP_OPTIONAL shall return only one tag command regardless +get_tag_command(#type{},?SKIP) -> + ?SKIP; +get_tag_command(#type{tag=Tags},?SKIP_OPTIONAL) -> + Tag=hd(Tags), + [?SKIP_OPTIONAL,encode_tag_val(decode_class(Tag#tag.class), + Tag#tag.form,Tag#tag.number)]; +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)]]. + TC = get_tag_command(T#type{tag=[Tag]},Command), + TCs = get_tag_command(T#type{tag=Tags},Command), + case many_tags(TCs) of + true when is_list(TCs) -> + [TC|TCs]; + _ -> [TC|[TCs]] + end. + +%% 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,Prop) -> + [anonymous_dec_command(Command,Prop),encode_tag_val(decode_class(Tag#tag.class),Tag#tag.form, Tag#tag.number)]; +get_tag_command(#type{tag=Tag},Command,Prop) when is_record(Tag,tag) -> + get_tag_command(#type{tag=[Tag]},Command,Prop); +get_tag_command(T=#type{tag=[Tag|Tags]},Command,Prop) -> + [get_tag_command(T#type{tag=[Tag]},Command,Prop)|[ +% get_tag_command(T#type{tag=Tags},?MANDATORY,Prop)]]. + get_tag_command(T#type{tag=Tags},Command,Prop)]]. + +anonymous_dec_command(?UNDECODED,'OPTIONAL') -> + ?OPTIONAL_UNDECODED; +anonymous_dec_command(Command,_) -> + Command. + +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. + + +tlv_tags([]) -> + []; +tlv_tags([mandatory|Rest]) -> + [mandatory|tlv_tags(Rest)]; +tlv_tags([[Command,Tag]|Rest]) when is_atom(Command),is_binary(Tag) -> + [[Command,tlv_tag(Tag)]|tlv_tags(Rest)]; +tlv_tags([[Command,Directives]|Rest]) when is_atom(Command),is_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 is_list(L1),is_atom(TopType) -> + [{Name,TopType,tlv_tags(L1)}|tlv_tags(Rest)]; +tlv_tags([[Command,Tag,L1]|Rest]) when is_list(L1),is_binary(Tag) -> + [[Command,tlv_tag(Tag),tlv_tags(L1)]|tlv_tags(Rest)]; +tlv_tags([[mandatory|Rest]]) -> + [[mandatory|tlv_tags(Rest)]]; +tlv_tags([L=[L1|_]|Rest]) when is_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 is_atom(InfoType) -> + CfgList = read_config_file(ModuleName), + get_config_info(CfgList,InfoType). + + +read_config_file(ModuleName) -> + case file:consult(lists:concat([ModuleName,'.asn1config'])) 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 lists:keysearch(InfoType,1,CfgList) of + {value,{InfoType,Value}} -> + Value; + false -> + [] + end. + +%% save_config/2 saves the Info with the key Key +%% Before saving anything check if a table exists +%% The record gen_state is saved with the key {asn1_config,gen_state} +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 -> % Err is [] when nothing was saved in the ets table +%% 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(exclusive_decode,{_,ConfList},PartIncTlvTagList) -> + %ConfList=[{FunctionName,PatternList}|Rest] + State = + case get_gen_state() of + S when is_record(S,gen_state) -> S; + _ -> #gen_state{} + end, + StateRec = State#gen_state{inc_tag_pattern=PartIncTlvTagList, + inc_type_pattern=ConfList}, + save_config(gen_state,StateRec); +save_gen_state(_,_,_) -> +%% ok. + case get_gen_state() of + S when is_record(S,gen_state) -> ok; + _ -> save_config(gen_state,#gen_state{}) + end. + +save_gen_state(selective_decode,{_,Type_component_name_list}) -> +%% io:format("Selective_decode: ~p~n",[Type_component_name_list]), + State = + case get_gen_state() of + S when is_record(S,gen_state) -> S; + _ -> #gen_state{} + end, + StateRec = State#gen_state{type_pattern=Type_component_name_list}, + save_config(gen_state,StateRec); +save_gen_state(selective_decode,_) -> + ok. + +save_gen_state(GenState) when is_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 when is_record(GenState,gen_state) -> + get_gen_state_field(GenState,Field); + Err -> + exit({error,{asn1,{"false configuration file info",Err}}}) + 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_field(GS,generated_functions) -> + GS#gen_state.generated_functions; +get_gen_state_field(GS,suffix_index) -> + GS#gen_state.suffix_index; +get_gen_state_field(GS,current_suffix_index) -> + GS#gen_state.current_suffix_index. + +get_gen_state() -> + read_config_data(gen_state). + + +update_gen_state(Field,Data) -> + case get_gen_state() of + State when is_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 is_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_gen_state(generated_functions,State,Data) -> + save_gen_state(State#gen_state{generated_functions=Data}); +update_gen_state(suffix_index,State,Data) -> + save_gen_state(State#gen_state{suffix_index=Data}); +update_gen_state(current_suffix_index,State,Data) -> + save_gen_state(State#gen_state{current_suffix_index=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 is_list(List) -> update_gen_state(namelist,List); + [{Name,Atom}|Rest] when is_atom(Atom) -> update_gen_state(namelist,Rest); + Other -> Other + end. + +pop_namelist() -> + DeepTail = %% removes next element in order + fun([[{_,A}]|T],_Fun) when is_atom(A) -> T; + ([{_N,L}|T],_Fun) when is_list(L) -> [L|T]; + ([[]|T],Fun) -> Fun(T,Fun); + ([L1|L2],Fun) when is_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 is_list(L) -> next_namelist_el(L) + end. + +next_namelist_el([]) -> + []; +next_namelist_el([L]) when is_list(L) -> + next_namelist_el(L); +next_namelist_el([H|_]) when is_atom(H) -> + H; +next_namelist_el([L|T]) when is_list(L) -> + case next_namelist_el(L) of + [] -> + next_namelist_el([T]); + R -> + R + end; +next_namelist_el([H={_,A}|_]) when is_atom(A) -> + H. + +%% removes a bracket from the namelist +step_in_constructed() -> + case get_gen_state_field(namelist) of + [L] when is_list(L) -> + update_gen_state(namelist,L); + _ -> ok + end. + +is_function_generated(Name) -> + case get_gen_state_field(gen_refed_funcs) of + L when is_list(L) -> + lists:member(Name,L); + _ -> + false + end. + +get_tobe_refed_func(Name) -> + case get_gen_state_field(tobe_refed_funcs) of + L when is_list(L) -> + case lists:keysearch(Name,1,L) of + {_,Element} -> + Element; + _ -> + undefined + end; + _ -> + undefined + end. + +%% add_tobe_refed_func saves Data that is a three or four element +%% tuple. Do not save if it exists in generated_functions, because +%% then it will be or already is generated. +add_tobe_refed_func(Data) -> + %% + {Name,SI,Pattern} = + fun({N,Si,P,_}) -> {N,Si,P}; + (D) -> D end (Data), + NewData = + case SI of + I when is_integer(I) -> + fun(D) -> D end(Data); +% fun({N,Ix,P}) -> {N,Ix+1,P}; +% ({N,Ix,P,T}) -> {N,Ix+1,P,T} end (Data); + _ -> + fun({N,_,P}) -> {N,0,P}; + ({N,_,P,T}) -> {N,0,P,T} end (Data) + end, + + L = get_gen_state_field(generated_functions), + case generated_functions_member(get(currmod),Name,L,Pattern) of + true -> % it exists in generated_functions, it has already + % been generated or saved in tobe_refed_func + ok; + _ -> + add_once_tobe_refed_func(NewData), + %%only to get it saved in generated_functions + maybe_rename_function(tobe_refed,Name,Pattern) + end. + + + +%% Adds only one element with same Name and Index where Data = +%% {Name,Index,Pattern}. +add_once_tobe_refed_func(Data) -> + TRFL = get_gen_state_field(tobe_refed_funcs), + {Name,Index} = {element(1,Data),element(2,Data)}, + case lists:filter(fun({N,I,_}) when N==Name,I==Index ->true; + ({N,I,_,_}) when N==Name,I==Index -> true; + (_) -> false end,TRFL) of + [] -> +%% case lists:keysearch(element(1,Data),1,TRFL) of +%% false -> + update_gen_state(tobe_refed_funcs,[Data|TRFL]); + _ -> + ok + end. + + + +%% 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]). + +%% adds Data to gen_refed_funcs field in gen_state. +add_generated_refed_func(Data) -> + case is_function_generated(Data) of + true -> + ok; + _ -> + L = get_gen_state_field(gen_refed_funcs), + update_gen_state(gen_refed_funcs,[Data|L]) + end. + +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{}). + +%% adds Data to generated_functions field in gen_state. +add_generated_function(Data) -> + L = get_gen_state_field(generated_functions), + update_gen_state(generated_functions,[Data|L]). + + +%% Each type has its own index starting from 0. If index is 0 there is +%% no renaming. +maybe_rename_function(Mode,Name,Pattern) -> + case get_gen_state_field(generated_functions) of + [] when Mode==inc_disp -> add_generated_function({Name,0,Pattern}), + Name; + [] -> + exit({error,{asn1,internal_error_exclusive_decode}}); + L -> + case {Mode,generated_functions_member(get(currmod),Name,L)} of + {_,true} -> + L2 = generated_functions_filter(get(currmod),Name,L), + case lists:keysearch(Pattern,3,L2) of + false -> %name existed, but not pattern + NextIndex = length(L2), + %%rename function + Suffix = lists:concat(["_",NextIndex]), + NewName = + maybe_rename_function2(type_check(Name),Name, + Suffix), + add_generated_function({Name,NextIndex,Pattern}), + NewName; + Value -> % name and pattern existed + %% do not save any new index + Suffix = make_suffix(Value), + Name2 = + case Name of + #'Externaltypereference'{type=T} -> T; + _ -> Name + end, + lists:concat([Name2,Suffix]) + end; + {inc_disp,_} -> %% this is when + %% decode_partial_inc_disp/2 is + %% generated + add_generated_function({Name,0,Pattern}), + Name; + _ -> % this if call from add_tobe_refed_func + add_generated_function({Name,0,Pattern}), + Name + end + end. + + +maybe_rename_function2(record,#'Externaltypereference'{type=Name},Suffix) -> + lists:concat([Name,Suffix]); +maybe_rename_function2(list,List,Suffix) -> + lists:concat([asn1ct_gen:list2name(List),Suffix]); +maybe_rename_function2(Thing,Name,Suffix) + when Thing==atom;Thing==integer;Thing==string -> + lists:concat([Name,Suffix]). + +%% generated_functions_member/4 checks on both Name and Pattern if +%% the element exists in L +generated_functions_member(M,Name,L,Pattern) -> + case generated_functions_member(M,Name,L) of + true -> + L2 = generated_functions_filter(M,Name,L), + case lists:keysearch(Pattern,3,L2) of + {value,_} -> + true; + _ -> false + end; + _ -> false + end. + +generated_functions_member(_M,Name,[{Name,_,_}|_]) -> + true; +generated_functions_member(M,#'Externaltypereference'{module=M,type=T}, + [{#'Externaltypereference'{module=M,type=T} + ,_,_}|_]) -> + true; +generated_functions_member(M,#'Externaltypereference'{module=M,type=Name}, + [{Name,_,_}|_]) -> + true; +generated_functions_member(M,Name,[_|T]) -> + generated_functions_member(M,Name,T); +generated_functions_member(_,_,[]) -> + false. + +% generated_functions_member(M,Name,L) -> +% case lists:keymember(Name,1,L) of +% true -> +% true; +% _ -> +% generated_functions_member1(M,Name,L) +% end. +% generated_functions_member1(M,#'Externaltypereference'{module=M,type=Name},L) -> +% lists:keymember(Name,1,L); +% generated_functions_member1(_,_,_) -> false. + +generated_functions_filter(_,Name,L) when is_atom(Name);is_list(Name) -> + lists:filter(fun({N,_,_}) when N==Name -> true; + (_) -> false + end, L); +generated_functions_filter(M,#'Externaltypereference'{module=M,type=Name},L)-> + % remove toptypename from patterns + RemoveTType = + fun({N,I,[N,P]}) when N == Name -> + {N,I,P}; + ({#'Externaltypereference'{module=M1,type=N},I,P}) when M1==M -> + {N,I,P}; + (P) -> P + end, + L2 = lists:map(RemoveTType,L), + generated_functions_filter(M,Name,L2). + + +maybe_saved_sindex(Name,Pattern) -> + case get_gen_state_field(generated_functions) of + [] -> false; + L -> + case generated_functions_member(get(currmod),Name,L) of + true -> + L2 = generated_functions_filter(get(currmod),Name,L), + case lists:keysearch(Pattern,3,L2) of + {value,{_,I,_}} -> + I; + _ -> length(L2) % this should be length(L2)! + end; + _ -> false + end + end. + +next_sindex() -> + SI = get_gen_state_field(suffix_index), + update_gen_state(suffix_index,SI+1), + SI+1. + +latest_sindex() -> + get_gen_state_field(suffix_index). + +current_sindex() -> + get_gen_state_field(current_suffix_index). + +set_current_sindex(Index) -> + update_gen_state(current_suffix_index,Index). + + +type_check(A) when is_atom(A) -> + atom; +%% type_check(I) when is_integer(I) -> +%% integer; +type_check(L) when is_list(L) -> + Pred = fun(X) when X=<255 -> + false; + (_) -> true + end, + case lists:filter(Pred,L) of + [] -> + string; + _ -> + list + end; +type_check(#'Externaltypereference'{}) -> + record. + + make_suffix({_,{_,0,_}}) -> + ""; + make_suffix({_,{_,I,_}}) -> + lists:concat(["_",I]); + make_suffix(_) -> + "". diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl new file mode 100644 index 0000000000..f0a48a086b --- /dev/null +++ b/lib/asn1/src/asn1ct_check.erl @@ -0,0 +1,7399 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_check). + +%% Main Module for ASN.1 compile time functions + +%-compile(export_all). +-export([check/2,storeindb/2]). +%-define(debug,1). +-include("asn1_records.hrl"). +%%% The tag-number for universal types +-define(N_BOOLEAN, 1). +-define(N_INTEGER, 2). +-define(N_BIT_STRING, 3). +-define(N_OCTET_STRING, 4). +-define(N_NULL, 5). +-define(N_OBJECT_IDENTIFIER, 6). +-define(N_OBJECT_DESCRIPTOR, 7). +-define(N_EXTERNAL, 8). % constructed +-define(N_INSTANCE_OF,8). +-define(N_REAL, 9). +-define(N_ENUMERATED, 10). +-define(N_EMBEDDED_PDV, 11). % constructed +-define(N_UTF8String, 12). +-define('N_RELATIVE-OID',13). +-define(N_SEQUENCE, 16). +-define(N_SET, 17). +-define(N_NumericString, 18). +-define(N_PrintableString, 19). +-define(N_TeletexString, 20). +-define(N_VideotexString, 21). +-define(N_IA5String, 22). +-define(N_UTCTime, 23). +-define(N_GeneralizedTime, 24). +-define(N_GraphicString, 25). +-define(N_VisibleString, 26). +-define(N_GeneralString, 27). +-define(N_UniversalString, 28). +-define(N_CHARACTER_STRING, 29). % constructed +-define(N_BMPString, 30). + +-define(TAG_PRIMITIVE(Num), + case S#state.erule of + ber_bin_v2 -> + #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0}; + _ -> [] + end). +-define(TAG_CONSTRUCTED(Num), + case S#state.erule of + ber_bin_v2 -> + #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32}; + _ -> [] + end). + +-record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag +-record(newv,{type=unchanged,value=unchanged}). % used in check_value to update type and value + +check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> + %%Predicates used to filter errors + TupleIs = fun({T,_},T) -> true; + (_,_) -> false + end, + IsClass = fun(X) -> TupleIs(X,asn1_class) end, + IsObjSet = fun(X) -> TupleIs(X,objectsetdef) end, + IsPObjSet = fun(X) -> TupleIs(X,pobjectsetdef) end, + IsObject = fun(X) -> TupleIs(X,objectdef) end, + IsValueSet = fun(X) -> TupleIs(X,valueset) end, + Element2 = fun(X) -> element(2,X) end, + Element1 = fun(X) -> element(1,X) end, + + %% initialize internal book keeping + save_asn1db_uptodate(S,S#state.erule,S#state.mname), + put(top_module,S#state.mname), + + _Perror = checkp(S,ParameterizedTypes,[]), % must do this before the templates are used + + %% table to save instances of parameterized objects,object sets + asn1ct:create_ets_table(parameterized_objects,[named_table]), + asn1ct:create_ets_table(inlined_objects,[named_table]), + + + Terror = checkt(S,Types,[]), + ?dbg("checkt finished with errors:~n~p~n~n",[Terror]), + + %% get parameterized object sets sent to checkt/3 + %% and update Terror + + {PObjSetNames1,Terror2} = filter_errors(IsPObjSet,Terror), + + Verror = checkv(S,Values ++ ObjectSets,[]), %value sets may be parsed as object sets + ?dbg("checkv finished with errors:~n~p~n~n",[Verror]), + %% get information object classes wrongly sent to checkt/3 + %% and update Terror2 + + {AddClasses,Terror3} = filter_errors(IsClass,Terror2), + + NewClasses = Classes++AddClasses, + + Cerror = checkc(S,NewClasses,[]), + ?dbg("checkc finished with errors:~n~p~n~n",[Cerror]), + %% get object sets incorrectly sent to checkv/3 + %% and update Verror + + {ObjSetNames,Verror2} = filter_errors(IsObjSet,Verror), + + %% get parameterized object sets incorrectly sent to checkv/3 + %% and update Verror2 + + {PObjSetNames,Verror3} = filter_errors(IsPObjSet,Verror2), + + %% get objects incorrectly sent to checkv/3 + %% and update Verror3 + + {ObjectNames,Verror4} = filter_errors(IsObject,Verror3), + + NewObjects = Objects++ObjectNames, + NewObjectSets = ObjSetNames ++ PObjSetNames ++ PObjSetNames1, + + %% get value sets + %% and update Verror4 + + {ValueSetNames,Verror5} = filter_errors(IsValueSet,Verror4), + + {Oerror,ExclO,ExclOS} = checko(S,NewObjects ++ + NewObjectSets, + [],[],[]), + ?dbg("checko finished with errors:~n~p~n~n",[Oerror]), + InlinedObjTuples = ets:tab2list(inlined_objects), + InlinedObjects = lists:map(Element2,InlinedObjTuples), + ets:delete(inlined_objects), + ParameterizedElems = ets:tab2list(parameterized_objects), + ParObjectSets = lists:filter(fun({_OSName,objectset,_}) -> true; + (_)-> false end,ParameterizedElems), + ParObjectSetNames = lists:map(Element1,ParObjectSets), + ParTypes = lists:filter(fun({_TypeName,type,_}) -> true; + (_) -> false end, ParameterizedElems), + ParTypesNames = lists:map(Element1,ParTypes), + ets:delete(parameterized_objects), + put(asn1_reference,undefined), + + Exporterror = check_exports(S,S#state.module), + ImportError = check_imports(S,S#state.module), + + case {Terror3,Verror5,Cerror,Oerror,Exporterror,ImportError} of + {[],[],[],[],[],[]} -> + ContextSwitchTs = context_switch_in_spec(), + InstanceOf = instance_of_in_spec(S#state.mname), + NewTypes = lists:subtract(Types,AddClasses) ++ ContextSwitchTs + ++ InstanceOf ++ ParTypesNames, + NewValues = lists:subtract(Values,PObjSetNames++ObjectNames++ + ValueSetNames), + {ok, + {NewTypes,NewValues,ParameterizedTypes, + NewClasses,NewObjects,NewObjectSets}, + {NewTypes,NewValues,ParameterizedTypes,NewClasses, + lists:subtract(NewObjects,ExclO)++InlinedObjects, + lists:subtract(NewObjectSets,ExclOS)++ParObjectSetNames}}; + _ ->{error,{asn1,lists:flatten([Terror3,Verror5,Cerror, + Oerror,Exporterror,ImportError])}} + end. + +context_switch_in_spec() -> + L = [{external,'EXTERNAL'}, + {embedded_pdv,'EMBEDDED PDV'}, + {character_string,'CHARACTER STRING'}], + F = fun({T,TName},Acc) -> + case get(T) of + generate -> erase(T), + [TName|Acc]; + _ -> Acc + end + end, + lists:foldl(F,[],L). + +instance_of_in_spec(ModName) -> + case get(instance_of) of + L when is_list(L) -> + case lists:member(ModName,L) of + true -> + erase(instance_of), + ['INSTANCE OF']; + _ -> + erase(instance_of), + [] + end; + _ -> + [] + end. +instance_of_decl(ModName) -> + Mods = get_instance_of(), + case lists:member(ModName,Mods) of + true -> + ok; + _ -> + put(instance_of,[ModName|Mods]) + end. +get_instance_of() -> + case get(instance_of) of + undefined -> + []; + L -> + L + end. + +put_once(T,State) -> + %% state is one of undefined, unchecked, generate + %% undefined > unchecked > generate + case get(T) of + PrevS when PrevS > State -> + put(T,State); + _ -> + ok + 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 is_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. + +check_imports(S,Module = #module{ }) -> + case Module#module.imports of + {imports,[]} -> + []; + {imports,ImportList} when is_list(ImportList) -> + check_imports2(S,ImportList,[]); + _ -> + [] + end. +check_imports2(_S,[],Acc) -> + Acc; +check_imports2(S,[#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs],Acc) -> + NameOfDef = + fun(#'Externaltypereference'{type=N}) -> N; + (#'Externalvaluereference'{value=N}) -> N + end, + Module = NameOfDef(ModuleRef), + Refs = [{M,R}||{{M,_},R} <- [{catch get_referenced_type(S,Ref),Ref}||Ref <- Imports]], + {Illegal,Other} = lists:splitwith(fun({error,_}) -> true;(_) -> false end, + Refs), + ChainedRefs = [R||{M,R} <- Other, M =/= Module], + IllegalRefs = [R||{error,R} <- Illegal] ++ + [R||{M,R} <- ChainedRefs, + ok =/= chained_import(S,Module,M,NameOfDef(R))], + ReportError = + fun(Ref) -> + NewS=S#state{type=Ref,tname=NameOfDef(Ref)}, + error({import,"imported undefined entity",NewS}) + end, + check_imports2(S,SFMs,[ReportError(Err)||Err <- IllegalRefs]++Acc). + +chained_import(S,ImpMod,DefMod,Name) -> + %% Name is a referenced structure that is not defined in ImpMod, + %% but must be present in the Imports list of ImpMod. The chain of + %% imports of Name must end in DefMod. + NameOfDef = + fun(#'Externaltypereference'{type=N}) -> N; + (#'Externalvaluereference'{value=N}) -> N; + (Other) -> Other + end, + GetImports = + fun(_M_) -> + case asn1_db:dbget(_M_,'MODULE') of + #module{imports={imports,ImportList}} -> + ImportList; + _ -> [] + end + end, + FindNameInImports = + fun([],N,_) -> {no_mod,N}; + ([#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs],N,F) -> + case [NameOfDef(X)||X <- Imports, NameOfDef(X) =:= N] of + [] -> F(SFMs,N,F); + [N] -> {NameOfDef(ModuleRef),N} + end + end, + case GetImports(ImpMod) of + [] -> + error; + Imps -> + case FindNameInImports(Imps,Name,FindNameInImports) of + {no_mod,_} -> + error; + {DefMod,_} -> ok; + {OtherMod,_} -> + chained_import(S,OtherMod,DefMod,Name) + end + end. + +checkt(S,[Name|T],Acc) -> + ?dbg("Checking type ~p~n",[Name]), + Result = + case asn1_db:dbget(S#state.mname,Name) of + undefined -> + error({type,{internal_error,'???'},S}); + Type when is_record(Type,typedef) -> + NewS = S#state{type=Type,tname=Name}, + case catch(check_type(NewS,Type,Type#typedef.typespec)) of + {error,Reason} -> + error({type,Reason,NewS}); + {'EXIT',Reason} -> + error({type,{internal_error,Reason},NewS}); + {asn1_class,_ClassDef} -> + {asn1_class,Name}; + pobjectsetdef -> + {pobjectsetdef,Name}; + pvalueset -> + {pvalueset,Name}; + Ts -> + case Type#typedef.checked of + true -> % already checked and updated + ok; + _ -> + NewTypeDef = Type#typedef{checked=true,typespec = Ts}, + + asn1_db:dbput(NewS#state.mname,Name,NewTypeDef), % update the type + + ok + end + end + end, + case Result of + ok -> + checkt(S,T,Acc); + _ -> + checkt(S,T,[Result|Acc]) + end; +checkt(S,[],Acc) -> + case check_contextswitchingtypes(S,[]) of + [] -> + lists:reverse(Acc); + L -> + checkt(S,L,Acc) + end. + +check_contextswitchingtypes(S,Acc) -> + CSTList=[{external,'EXTERNAL'}, + {embedded_pdv,'EMBEDDED PDV'}, + {character_string,'CHARACTER STRING'}], + check_contextswitchingtypes(S,CSTList,Acc). + +check_contextswitchingtypes(S,[{T,TName}|Ts],Acc) -> + case get(T) of + unchecked -> + put(T,generate), + check_contextswitchingtypes(S,Ts,[TName|Acc]); + _ -> + check_contextswitchingtypes(S,Ts,Acc) + end; +check_contextswitchingtypes(_,[],Acc) -> + Acc. + +checkv(S,[Name|T],Acc) -> + ?dbg("Checking valuedef ~p~n",[Name]), + Result = case asn1_db:dbget(S#state.mname,Name) of + undefined -> error({value,{internal_error,'???'},S}); + Value when is_record(Value,valuedef); + is_record(Value,typedef); %Value set may be parsed as object set. + is_record(Value,pvaluedef); + is_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, + ClassName = Type#type.def, + 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 is_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}; + {asn1_param_class,_} -> ok; + 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 + is_record(Class,classdef) -> +% Class#classdef.typespec; + Class; + is_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 + is_record(Class,classdef) -> + Class#classdef{checked=true,typespec=C}; + is_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) -> + ?dbg("Checking object ~p~n",[Name]), + Result = + case asn1_db:dbget(S#state.mname,Name) of + undefined -> + error({type,{internal_error,'???'},S}); + Object when is_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 + is_record(O,'Object') -> + case O#'Object'.gen of + true -> + {ok,ExclO,ExclOS}; + false -> + {ok,[Name|ExclO],ExclOS} + end; + is_record(O,'ObjectSet') -> + case O#'ObjectSet'.gen of + true -> + {ok,ExclO,ExclOS}; + false -> + {ok,ExclO,[Name|ExclOS]} + end + end + end; + PObject when is_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 is_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; + _ -> + store_class(S,idle,CDef,Name), + CheckedTS = check_class(S,TS), + store_class(S,true,CDef#classdef{typespec=CheckedTS},Name), + CheckedTS + end; +check_class(S = #state{mname=M,tname=T},ClassSpec) + when is_record(ClassSpec,type) -> + Def = ClassSpec#type.def, + case Def of + #'Externaltypereference'{module=M,type=T} -> + #objectclass{fields=Def}; % in case of recursive definitions + Tref = #'Externaltypereference'{type=TName} -> + {MName,RefType} = get_referenced_type(S,Tref), + case is_class(S,RefType) of + true -> + NewState = update_state(S#state{type=RefType, + tname=TName},MName), + check_class(NewState,get_class_def(S,RefType)); + _ -> + error({class,{internal_error,RefType},S}) + end; + {pt,ClassRef,Params} -> + %% parameterized class + {_,PClassDef} = get_referenced_type(S,ClassRef), + NewParaList = + [match_parameters(S,TmpParam,S#state.parameters)|| + TmpParam <- Params], + instantiate_pclass(S,PClassDef,NewParaList) + end; +check_class(S,C) when is_record(C,objectclass) -> + NewFieldSpec = check_class_fields(S,C#objectclass.fields), + C#objectclass{fields=NewFieldSpec}; +check_class(_S,{poc,_ObjSet,_Params}) -> + 'fix this later'; +check_class(S,ClassName) -> + {RefMod,Def} = get_referenced_type(S,ClassName), + case Def of + ClassDef when is_record(ClassDef,classdef) -> + case ClassDef#classdef.checked of + true -> + ClassDef#classdef.typespec; + idle -> + ClassDef#classdef.typespec; + false -> + Name=ClassName#'Externaltypereference'.type, + store_class(S,idle,ClassDef,Name), +% NewS = S#state{mname=RefMod,type=Def,tname=Name}, + NewS = update_state(S#state{type=Def,tname=Name},RefMod), + CheckedTS = check_class(NewS,ClassDef#classdef.typespec), + store_class(S,true,ClassDef#classdef{typespec=CheckedTS},Name), + CheckedTS + end; + TypeDef when is_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 is_record(Ext,'Externaltypereference') -> + check_class(S,Ext) + end + end. + +instantiate_pclass(S=#state{parameters=_OldArgs},PClassDef,Params) -> + #ptypedef{args=Args,typespec=Type} = PClassDef, + MatchedArgs = match_args(S,Args, Params, []), +% NewS = S#state{type=Type,parameters=MatchedArgs++OldArgs,abscomppath=[]}, + NewS = S#state{type=Type,parameters=MatchedArgs,abscomppath=[]}, + check_class(NewS,#classdef{name=S#state.tname,typespec=Type}). + +store_class(S,Mode,ClassDef,ClassName) -> + NewCDef = ClassDef#classdef{checked=Mode}, + asn1_db:dbput(S#state.mname,ClassName,NewCDef). + +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, + Type2 = maybe_unchecked_OCFT(S,Type), + Cat = + case asn1ct_gen:type(asn1ct_gen:get_inner(Type2#type.def)) of + Def when is_record(Def,typereference); + is_record(Def,'Externaltypereference') -> + {_,D} = get_referenced_type(S,Def), + D; + {undefined,user} -> + %% neither of {primitive,bif} or {constructed,bif} + + {_,D} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Type#type.def}), + D; + _ -> + Type + end, + case Cat of + Class when is_record(Class,classdef) -> + %% Type must be a referenced type => change it + %% to an external reference. + ToExt = fun(#type{def= CE = #'Externaltypereference'{}}) -> CE; (T) -> T end, + {objectfield,Name,ToExt(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 = + 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 is_record(CheckedType,type) -> + CheckedType; + _ -> + error({class,"internal error, check_class_fields",S}) + end, + if + is_record(RefType,'Externaltypereference') -> + {objectsetfield,Name,Type,OSpec}; + is_record(RefType,classdef) -> + {objectsetfield,Name,Type,OSpec}; + is_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). + +maybe_unchecked_OCFT(S,Type) -> + case Type#type.def of + #'ObjectClassFieldType'{type=undefined} -> + check_type(S,#typedef{typespec=Type},Type); + _ -> + Type + end. + +if_current_checked_type(S,#type{def=Def}) -> + CurrentModule = S#state.mname, + CurrentCheckedName = S#state.tname, + MergedModules = S#state.inputmodules, + % CurrentCheckedModule = S#state.mname, + case Def of + #'Externaltypereference'{module=CurrentModule, + 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 is_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=get_datastr_name(Def)}, + {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}) -> + ?dbg("check_object ~p~n",[ObjectDef]), +%% io:format("check_object,object: ~p~n",[ObjectDef]), +% {MName,_ClassDef} = get_referenced_type(S,ClassRef), + NewClassRef = check_externaltypereference(S,ClassRef), + ClassDef = + case get_referenced_type(S,ClassRef) of + {MName,ClDef=#classdef{checked=false}} -> + NewState = update_state(S#state{type=ClDef, + tname=ClassRef#'Externaltypereference'.type},MName), + ObjClass= + check_class(NewState,ClDef), + #classdef{checked=true, + typespec=ObjClass}; + {_,_ClDef} when is_record(_ClDef,classdef) -> + _ClDef; + {MName,_TDef=#typedef{checked=false,pos=Pos, + name=_TName,typespec=TS}} -> + ClDef = #classdef{pos=Pos,name=_TName,typespec=TS}, + NewState = update_state(S#state{type=_TDef, + tname=ClassRef#'Externaltypereference'.type},MName), + ObjClass = + check_class(NewState,ClDef), + ClDef#classdef{checked=true,typespec=ObjClass}; + {_,_ClDef} -> + _ClDef + end, + NewObj = + case ObjectDef of + Def when is_tuple(Def), (element(1,Def)==object) -> + NewSettingList = check_objectdefn(S,Def,ClassDef), + #'Object'{def=NewSettingList}; + {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 + %% a not initialized parameterized object should be returned. + instantiate_po(S,ClassDef,Object,ArgsList); + {pv,{simpledefinedvalue,ObjRef},ArgList} -> + {_,Object} = get_referenced_type(S,ObjRef), + instantiate_po(S,ClassDef,Object,ArgList); + #'Externalvaluereference'{} -> + {_,Object} = get_referenced_type(S,ObjectDef), + check_object(S,Object,Object#typedef.typespec); + [] -> + %% An object with no fields. All class fields must be + %% optional or default. Check that all fields in + %% class are 'OPTIONAL' or 'DEFAULT' + class_fields_optional_check(S,ClassDef), + #'Object'{def={object,defaultsyntax,[]}}; + _ -> + 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=#'ObjectSet'{class=ClassRef}) -> +%% io:format("check_object,SET: ~p~n",[ObjSet#'ObjectSet'.set]), + ?dbg("check_object set: ~p~n",[ObjSet#'ObjectSet'.set]), + {_,ClassDef} = get_referenced_type(S,ClassRef), + NewClassRef = check_externaltypereference(S,ClassRef), + %% XXXXXXXXXX + case ObjSet of + #'ObjectSet'{set={'Externaltypereference',undefined,'MSAccessProtocol', + 'AllOperations'}} -> + ok; + _ -> + ok + end, + {UniqueFieldName,UniqueInfo} = + case (catch get_unique_fieldname(S,ClassDef)) of + {error,'__undefined_',_} -> + {{unique,undefined},{unique,undefined}}; + {asn1,Msg,_} -> error({class,Msg,S}); + {'EXIT',Msg} -> error({class,{internal_error,Msg},S}); + Other -> {element(1,Other),Other} + end, + NewObjSet= + case prepare_objset(ObjSet#'ObjectSet'.set) of + {set,SET,EXT} -> + CheckedSet = check_object_list(S,NewClassRef,SET), + NewSet = get_unique_valuelist(S,CheckedSet,UniqueInfo), + ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, + set=extensionmark(NewSet,EXT)}; + + {'SingleValue',ERef = #'Externalvaluereference'{}} -> + {RefedMod,ObjDef} = get_referenced_type(S,ERef), + #'Object'{def=CheckedObj} = + check_object(S,ObjDef,ObjDef#typedef.typespec), + + NewSet = get_unique_valuelist(S,[{{RefedMod,get_datastr_name(ObjDef)}, + CheckedObj}], + UniqueInfo), + ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, + set=NewSet}; + ['EXTENSIONMARK'] -> + ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, + set=['EXTENSIONMARK']}; + + OSref when is_record(OSref,'Externaltypereference') -> + {_,OS=#typedef{typespec=OSdef}} = get_referenced_type(S,OSref), + check_object(S,OS,OSdef); + + {Type,{'EXCEPT',Exclusion}} when is_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), + NewParamList = + [match_parameters(S,TmpParam,S#state.parameters)|| + TmpParam <- ParamList], + instantiate_pos(S,ClassRef,PObjSetDef,NewParamList); + + %% actually this is an ObjectSetFromObjects construct, it + %% is when the object set is retrieved from an object + %% field. + #type{def=#'ObjectClassFieldType'{classname=ObjName, + fieldname=FieldName}} -> + {RefedObjMod,TDef} = get_referenced_type(S,ObjName), + OS=TDef#typedef.typespec, + %% should get the right object set here. Get the field + %% FieldName out of the object set OS of class + %% OS#'ObjectSet'.class + OS2=check_object(S,TDef,OS), + NewSet=object_set_from_objects(S,RefedObjMod,FieldName,OS2), + ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, + set=NewSet}; + {'ObjectSetFromObjects',{_,_,ObjName},FieldName} -> + {RefedObjMod,TDef} = get_referenced_type(S,ObjName), + OS=TDef#typedef.typespec, + %% should get the right object set here. Get the field + %% FieldName out of the object set OS of class + %% OS#'ObjectSet'.class + OS2=check_object(S,TDef,OS), + NewSet=object_set_from_objects(S,RefedObjMod,FieldName,OS2), + ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, + set=NewSet}; + {'ObjectSetFromObjects',{_,ObjName},FieldName} -> + %% This is a ObjectSetFromObjects, i.e. + %% ObjectSetFromObjects ::= ReferencedObjects "." FieldName + %% with a defined object as ReferencedObjects. And + %% the FieldName of the Class (object) contains an object set. + {RefedObjMod,TDef} = get_referenced_type(S,ObjName), + O1 = TDef#typedef.typespec, + O2 = check_object(S,TDef,O1), + NewSet = object_set_from_objects(S,RefedObjMod,FieldName,O2), + OS2=ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, + set=NewSet}, + %%io:format("ObjectSet: ~p~n",[OS2]), + OS2; + {pos,{objectset,_,DefinedObjSet},Params} -> + {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet), + NewParamList = + [match_parameters(S,TmpParam,S#state.parameters)|| + TmpParam <- Params], + instantiate_pos(S,ClassRef,PObjSetDef,NewParamList); + Unknown -> + exit({error,{unknown_object_set,Unknown},S}) + end, + NewSet2 = remove_duplicate_objects(NewObjSet#'ObjectSet'.set), + NewObjSet2 = NewObjSet#'ObjectSet'{set=NewSet2}, + Gen = gen_incl_set(S,NewObjSet2#'ObjectSet'.set, + ClassDef), + ?dbg("check_object done~n",[]), + NewObjSet2#'ObjectSet'{class=NewClassRef,gen=Gen}. + +%% remove_duplicate_objects/1 remove duplicates of objects. +%% For instance may Set contain objects of same class from +%% different object sets that in fact might be duplicates. +remove_duplicate_objects(Set) when is_list(Set) -> + Pred = fun({A,B,_},{A,C,_}) when B =< C -> true; + ({A,_,_},{B,_,_}) when A < B -> true; + ('EXTENSIONMARK','EXTENSIONMARK') -> true; + (T,A) when is_tuple(T),is_atom(A) -> true;% EXTENSIONMARK last in list + (_,_) -> false + end, + lists:usort(Pred,Set). + +%% +extensionmark(L,true) -> + case lists:member('EXTENSIONMARK',L) of + true -> L; + _ -> L ++ ['EXTENSIONMARK'] + end; +extensionmark(L,_) -> + L. + +object_to_check(#typedef{typespec=ObjDef}) -> + ObjDef; +object_to_check(#valuedef{type=ClassName,value=ObjectRef}) -> + %% If the object definition is parsed as an object the ClassName + %% is parsed as a type + #'Object'{classname=ClassName#type.def,def=ObjectRef}. + +prepare_objset({'SingleValue',Set}) when is_list(Set) -> + {set,Set,false}; +prepare_objset(L=['EXTENSIONMARK']) -> + L; +prepare_objset(Set) when is_list(Set) -> + {set,Set,false}; +prepare_objset({{'SingleValue',Set},Ext}) -> + {set,merge_sets(Set,Ext),true}; +%%prepare_objset({Set,Ext}) when is_list(Set),is_list(Ext) -> +%% {set,lists:append([Set,Ext]),true}; +prepare_objset({Set,Ext}) when is_list(Set) -> + {set,merge_sets(Set,Ext),true}; +prepare_objset({ObjDef={object,definedsyntax,_ObjFields},_Ext}) -> + {set,[ObjDef],true}; +prepare_objset(ObjDef={object,definedsyntax,_ObjFields}) -> + {set,[ObjDef],false}; +prepare_objset({ObjDef=#type{},Ext}) when is_list(Ext) -> + {set,[ObjDef|Ext],true}; +prepare_objset(Ret) -> + Ret. + +class_fields_optional_check(S,#classdef{typespec=ClassSpec}) -> + Fields = ClassSpec#objectclass.fields, + class_fields_optional_check1(S,Fields). + +class_fields_optional_check1(_S,[]) -> + ok; +class_fields_optional_check1(S,[{typefield,_,'OPTIONAL'}|Rest]) -> + class_fields_optional_check1(S,Rest); +class_fields_optional_check1(S,[{fixedtypevaluefield,_,_,_,'OPTIONAL'}|Rest]) -> + class_fields_optional_check1(S,Rest); +class_fields_optional_check1(S,[{fixedtypevaluesetfield,_,_,'OPTIONAL'}|Rest]) -> + class_fields_optional_check1(S,Rest); +class_fields_optional_check1(S,[{objectfield,_,_,_,'OPTIONAL'}|Rest]) -> + class_fields_optional_check1(S,Rest); +class_fields_optional_check1(S,[{objectsetfield,_,_,'OPTIONAL'}|Rest]) -> + class_fields_optional_check1(S,Rest). + +%% ObjectSetFromObjects functionality + +%% The fieldname is a list of field names.They may be objects or +%% object sets. If ObjectSet is an object set the resulting object set +%% is the union of object sets if the last field name is an object +%% set. If the last field is an object the resulting object set is +%% the set of objects in ObjectSet. +object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet) -> + object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet,[]). +object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet,InterSect) + when is_record(ObjectSet,'ObjectSet') -> + #'ObjectSet'{class=Cl,set=Set} = ObjectSet, + {_,ClassDef} = get_referenced_type(S,Cl), + object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Set,InterSect,[]); +object_set_from_objects(S,RefedObjMod,FieldName,Object,InterSect) + when is_record(Object,'Object') -> + #'Object'{classname=Cl,def=Def}=Object, + object_set_from_objects(S,RefedObjMod,Cl,FieldName,[Def],InterSect,[]). +object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,['EXTENSIONMARK'|Os], + InterSect,Acc) -> + object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,%%Acc); + ['EXTENSIONMARK'|Acc]); +object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,[O|Os],InterSect,Acc) -> + case object_set_from_objects2(S,mod_of_obj(RefedObjMod,element(1,O)), + ClassDef,FieldName,element(3,O),InterSect) of + ObjS when is_list(ObjS) -> + object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,ObjS++Acc); + Obj -> + object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,[Obj|Acc]) + end; +object_set_from_objects(_S,_RefedObjMod,_ClassDef,_FieldName,[],InterSect,Acc) -> + %% For instance may Acc contain objects of same class from + %% different object sets that in fact might be duplicates. + remove_duplicate_objects(osfo_intersection(InterSect,Acc)). +%% Acc. +object_set_from_objects2(S,RefedObjMod,ClassDef,[{valuefieldreference,OName}], + Fields,_InterSect) -> + %% this is an object + case lists:keysearch(OName,1,Fields) of + {value,{_,TDef}} -> + mk_object_set_from_object(S,RefedObjMod,TDef,ClassDef); + _ -> + [] % it may be an absent optional field + end; +object_set_from_objects2(S,RefedObjMod,ClassDef,[{typefieldreference,OSName}], + Fields,_InterSect) -> + %% this is an object set + case lists:keysearch(OSName,1,Fields) of + {value,{_,TDef}} -> + case TDef#typedef.typespec of + #'ObjectSet'{class=_NextClName,set=NextSet} ->%% = TDef#typedef.typespec, + NextSet; + #'Object'{def=_ObjDef} -> + mk_object_set_from_object(S,RefedObjMod,TDef,ClassDef) +%% ObjDef + %% error({error,{internal,unexpected_object,TDef}}) + end; + _ -> + [] % it may be an absent optional field + end; +object_set_from_objects2(S,RefedObjMod,_ClassDef,[{valuefieldreference,OName}|Rest], + Fields,InterSect) -> + %% this is an object + case lists:keysearch(OName,1,Fields) of + {value,{_,TDef}} -> + #'Object'{classname=NextClName,def=ODef}=TDef#typedef.typespec, + {_,_,NextFields}=ODef, + {_,NextClass} = get_referenced_type(S,NextClName), + object_set_from_objects2(S,RefedObjMod,NextClass,Rest,NextFields,InterSect); + _ -> + [] + end; +object_set_from_objects2(S,RefedObjMod,_ClassDef,[{typefieldreference,OSName}|Rest], + Fields,InterSect) -> + %% this is an object set + Next = {NextClName,NextSet} = + case lists:keysearch(OSName,1,Fields) of + {value,{_,TDef}} when is_record(TDef,'ObjectSet') -> + #'ObjectSet'{class=NextClN,set=NextS} = TDef, + {NextClN,NextS}; + {value,{_,#typedef{typespec=OS}}} -> + %% objectsets in defined syntax will come here as typedef{} + %% #'ObjectSet'{class=NextClN,set=NextS} = OS, + case OS of + #'ObjectSet'{class=NextClN,set=NextS} -> + {NextClN,NextS}; + #'Object'{classname=NextClN,def=NextDef} -> + {NextClN,[NextDef]} + end; + _ -> + {[],[]} + end, + case Next of + {[],[]} -> + []; + _ -> + {_,NextClass} = get_referenced_type(S,NextClName), + object_set_from_objects(S,RefedObjMod,NextClass,Rest,NextSet,InterSect,[]) + end. + +mk_object_set_from_object(S,RefedObjMod,TDef,Class) -> + #'Object'{classname=_NextClName,def=ODef} = TDef#typedef.typespec, + {_,_,NextFields}=ODef, + + UniqueFieldName = + case (catch get_unique_fieldname(S,Class)) of + {error,'__undefined_',_} -> {unique,undefined}; + {asn1,Msg,_} -> error({class,Msg,S}); + {'EXIT',Msg} -> error({class,{internal_error,Msg},S}); + {Other,_} -> Other + end, + VDef = get_unique_value(S,NextFields,UniqueFieldName), + %% XXXXXXXXXXX + case VDef of + [] -> + ['EXTENSIONMARK']; + _ -> + {{RefedObjMod,get_datastr_name(TDef)},VDef,NextFields} + end. + + +mod_of_obj(_RefedObjMod,{NewMod,ObjName}) + when is_atom(NewMod),is_atom(ObjName) -> + NewMod; +mod_of_obj(RefedObjMod,_) -> + RefedObjMod. + + +merge_sets(Root,{'SingleValue',Ext}) -> + merge_sets(Root,Ext); +merge_sets(Root,Ext) when is_list(Root),is_list(Ext) -> + Root ++ Ext; +merge_sets(Root,Ext) when is_list(Ext) -> + [Root|Ext]; +merge_sets(Root,Ext) when is_list(Root) -> + Root++[Ext]; +merge_sets(Root,Ext) -> + [Root]++[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) -> + ?dbg("check_object_list: ~p~n",[ObjOrSet]), + case ObjOrSet of + ObjDef when is_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_mod,no_name},Def#'Object'.def}|Acc]); + {'SingleValue',Ref = #'Externalvaluereference'{}} -> + ?dbg("{SingleValue,Externalvaluereference}~n",[]), + {RefedMod,ObjName, + #'Object'{def=Def}} = check_referenced_object(S,Ref), + check_object_list(S,ClassRef,Objs,[{{RefedMod,ObjName},Def}|Acc]); + ObjRef when is_record(ObjRef,'Externalvaluereference') -> + ?dbg("Externalvaluereference~n",[]), + {RefedMod,ObjName, + #'Object'{def=Def}} = check_referenced_object(S,ObjRef), + check_object_list(S,ClassRef,Objs,[{{RefedMod,ObjName},Def}|Acc]); + {'ValueFromObject',{_,Object},FieldName} -> + {_,Def} = get_referenced_type(S,Object), + TypeDef = get_fieldname_element(S,Def,FieldName), + (TypeDef#typedef.typespec)#'ObjectSet'.set; + ObjSet when is_record(ObjSet,type) -> + ObjSetDef = + case ObjSet#type.def of + Ref when is_record(Ref,typereference); + is_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); + {pos,{objectset,_,DefinedObjectSet},Params} -> + OSDef = #type{def={pt,DefinedObjectSet,Params}}, + #'ObjectSet'{set=Set} = + check_object(S,ObjOrSet,#'ObjectSet'{class=ClassRef, + set=OSDef}), + check_object_list(S,ClassRef,Objs,Set ++ Acc); + {pv,{simpledefinedvalue,DefinedObject},Params} -> + Args = [match_parameters(S,Param,S#state.parameters)|| + Param<-Params], + #'Object'{def=Def} = + check_object(S,ObjOrSet, + #'Object'{classname=ClassRef , + def={po,{object,DefinedObject}, + Args}}), + check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def}|Acc]); + {'ObjectSetFromObjects',Os,FieldName} when is_tuple(Os) -> + NewSet = + check_ObjectSetFromObjects(S,element(size(Os),Os), + FieldName,[]), + check_object_list(S,ClassRef,Objs,NewSet++Acc); + {{'ObjectSetFromObjects',Os,FieldName},InterSection} + when is_tuple(Os) -> + NewSet = + check_ObjectSetFromObjects(S, element(size(Os),Os), + FieldName,InterSection), + check_object_list(S,ClassRef,Objs,NewSet++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). + +check_referenced_object(S,ObjRef) + when is_record(ObjRef,'Externalvaluereference')-> + case get_referenced_type(S,ObjRef) of + {RefedMod,ObjectDef} when is_record(ObjectDef,valuedef) -> + ?dbg("Externalvaluereference, ObjectDef: ~p~n",[ObjectDef]), + #type{def=ClassRef} = ObjectDef#valuedef.type, + Def = ObjectDef#valuedef.value, + {RefedMod,get_datastr_name(ObjectDef), + check_object(update_state(S,RefedMod),ObjectDef,#'Object'{classname=ClassRef, + def=Def})}; + {RefedMod,ObjectDef} when is_record(ObjectDef,typedef) -> + {RefedMod,get_datastr_name(ObjectDef), + check_object(update_state(S,RefedMod),ObjectDef,ObjectDef#typedef.typespec)} + end. + +check_ObjectSetFromObjects(S,ObjName,FieldName,InterSection) -> + {RefedMod,TDef} = get_referenced_type(S,ObjName), + ObjOrSet = check_object(update_state(S,RefedMod),TDef,TDef#typedef.typespec), + InterSec = prepare_intersection(S,InterSection), + _NewSet = object_set_from_objects(S,RefedMod,FieldName,ObjOrSet,InterSec). + +prepare_intersection(_S,[]) -> + []; +prepare_intersection(S,{'EXCEPT',ObjRef}) -> + except_names(S,ObjRef); +prepare_intersection(_S,T) -> + exit({error,{internal_error,not_implemented,object_set_from_objects,T}}). +except_names(_S,{'SingleValue',#'Externalvaluereference'{value=ObjName}}) -> + [{except,ObjName}]; +except_names(_,T) -> + exit({error,{internal_error,not_implemented,object_set_from_objects,T}}). + +osfo_intersection(InterSect,ObjList) -> + Res = [X|| X = {{_,N},_,_} <- ObjList, + lists:member({except,N},InterSect) == false], + case lists:member('EXTENSIONMARK',ObjList) of + true -> + Res ++ ['EXTENSIONMARK']; + _ -> + Res + 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 is_record(Def,typedef) -> + {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def, + check_fieldname_element(S,lists:keysearch(FieldName,1,ObjComps)); +get_fieldname_element(S,Def,[{_RefType,FieldName}|Rest]) + when is_record(Def,typedef) -> + %% As FieldName is followd by other FieldNames it has to be an + %% object or objectset. + {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def, + NewDef = check_fieldname_element(S,lists:keysearch(FieldName,1,ObjComps)), + ObjDef = fun(#'Object'{def=D}) -> D; + (#'ObjectSet'{set=Set}) -> Set + end + (NewDef), + case ObjDef of + L when is_list(L) -> + [get_fieldname_element(S,X,Rest) || X <- L]; + _ -> + get_fieldname_element(S,ObjDef,Rest) + end; +get_fieldname_element(S,{object,_,Fields},[{_RefType,FieldName}|Rest]) -> + NewDef = check_fieldname_element(S,lists:keysearch(FieldName,1,Fields)), + get_fieldname_element(S,NewDef,Rest); +get_fieldname_element(_S,Def,[]) -> + Def; +get_fieldname_element(_S,Def,[{_RefType,_FieldName}|_RestFName]) + when is_record(Def,typedef) -> + ok. + +check_fieldname_element(S,{value,{_,Def}}) -> + check_fieldname_element(S,Def); +check_fieldname_element(S,TDef) when is_record(TDef,typedef) -> + check_type(S,TDef,TDef#typedef.typespec); +check_fieldname_element(S,VDef) when is_record(VDef,valuedef) -> + check_value(S,VDef); +check_fieldname_element(S,Eref) + when is_record(Eref,'Externaltypereference'); + is_record(Eref,'Externalvaluereference') -> + {_,TDef}=get_referenced_type(S,Eref), + check_fieldname_element(S,TDef); +check_fieldname_element(S,Other) -> + throw({error,{assigned_object_error,"not_assigned_object",Other,S}}). + +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,no_unique_value,F}; + (V={_,_,_}) ->V; + ({A,B}) -> {A,no_unique_value,B} + end, ObjSet); +get_unique_valuelist(S,ObjSet,{UFN,Opt}) -> + get_unique_vlist(S,ObjSet,UFN,Opt,[]). + + +get_unique_vlist(_S,[],_,_,[]) -> + ['EXTENSIONMARK']; +get_unique_vlist(S,[],_,Opt,Acc) -> + case catch check_uniqueness(remove_duplicate_objects(Acc)) of + {asn1_error,_} when Opt =/= 'OPTIONAL' -> + error({'ObjectSet',"not unique objects in object set",S}); + {asn1_error,_} -> + lists:reverse(Acc); + _ -> + lists:reverse(Acc) + end; +get_unique_vlist(S,['EXTENSIONMARK'|Rest],UniqueFieldName,Opt,Acc) -> + get_unique_vlist(S,Rest,UniqueFieldName,Opt,Acc); +get_unique_vlist(S,[{ObjName,Obj}|Rest],UniqueFieldName,Opt,Acc) -> + {_,_,Fields} = Obj, + NewObjInf = + case get_unique_value(S,Fields,UniqueFieldName) of + #valuedef{value=V} -> [{ObjName,V,Fields}]; + [] -> []; % maybe the object only was a reference to an + % empty object set. + no_unique_value -> [{ObjName,no_unique_value,Fields}] + end, + get_unique_vlist(S,Rest,UniqueFieldName,Opt,NewObjInf++Acc); + +get_unique_vlist(S,[V={_,_,_}|Rest],UniqueFieldName,Opt,Acc) -> + get_unique_vlist(S,Rest,UniqueFieldName,Opt,[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 is_record(VDef,valuedef) -> + VDef; + {'ValueFromObject',Object,Name} -> + case Object of + {object,Ext} when is_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 is_atom(Value);is_number(Value) -> + #valuedef{value=Value,module=Module}; + {'CHOICE',{C,Value}} when is_atom(C) -> + %% #valuedef{value=normalize_value(S,element(3,Field),VDef,[])} + case Value of + Scalar when is_atom(Scalar);is_number(Scalar) -> + #valuedef{value=Value,module=Module}; + Eref = #'Externalvaluereference'{} -> + element(2,get_referenced_type(S,Eref)) + end + end; + false -> + case Fields of + [{_,#typedef{typespec=#'ObjectSet'{set=['EXTENSIONMARK']}}}] -> + []; + _ -> + no_unique_value + end + 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=#state{parameters=_OldArgs},_ClassDef,Object,ArgsList) when is_record(Object,pobjectdef) -> + FormalParams = get_pt_args(Object), + MatchedArgs = match_args(S,FormalParams,ArgsList,[]), +% NewS = S#state{type=Object,parameters=MatchedArgs++OldArgs}, + 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=#state{parameters=_OldArgs},ClassRef,ObjectSetDef,ArgsList) -> +% ClassName = ClassDef#classdef.name, + FormalParams = get_pt_args(ObjectSetDef), + OSet = case get_pt_spec(ObjectSetDef) of + {valueset,Set} -> +% #'ObjectSet'{class=name2Extref(S#state.mname, +% ClassName),set=Set}; + #'ObjectSet'{class=ClassRef,set=Set}; + Set when is_record(Set,'ObjectSet') -> Set; + _ -> + error({type,"parameterized object set failure",S}) + end, + MatchedArgs = match_args(S,FormalParams,ArgsList,[]), +% NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs++OldArgs}, + NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs}, + check_object(NewS,ObjectSetDef,OSet). + + +%% 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 -> + 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} -> + ClassRef = case element(3,C) of + #type{def=Ref} -> Ref; + Eref when is_record(Eref,'Externaltypereference') -> + Eref + end, + ClassFields = get_objclass_fields(S,ClassRef), + ObjDef = + case element(2,Field) of + TDef when is_record(TDef,typedef) -> + check_object(S,TDef,TDef#typedef.typespec); + ERef -> + {_,T} = get_referenced_type(S,ERef), + check_object(S,T,object_to_check(T)) + end, + case gen_incl(S,ObjDef#'Object'.def, + ClassFields) of + true -> + true; + _ -> + gen_incl1(S,Fields,CFields) + end; + _ -> + gen_incl1(S,Fields,CFields) + end; + _ -> + gen_incl1(S,Fields,CFields) + end. + +get_objclass_fields(S,Eref=#'Externaltypereference'{}) -> + {_,ClassDef} = get_referenced_type(S,Eref), + get_objclass_fields(S,ClassDef); +get_objclass_fields(S,CD=#classdef{typespec=#'Externaltypereference'{}}) -> + get_objclass_fields(S,CD#classdef.typespec); +get_objclass_fields(_,#classdef{typespec=CDef}) + when is_record(CDef,objectclass) -> + CDef#objectclass.fields. + + +%% first if no unique field in the class return false.(don't generate code) +gen_incl_set(S,Fields,#typedef{typespec=#type{def=Eref}}) + when is_record(Eref,'Externaltypereference') -> + %% When a Defined class is a reference toanother class definition + {_,CDef} = get_referenced_type(S,Eref), + gen_incl_set(S,Fields,CDef); +gen_incl_set(S,Fields,ClassDef) -> + case catch get_unique_fieldname(S,ClassDef) of + Tuple when is_tuple(Tuple), size(Tuple) =:= 3 -> + 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(_,['EXTENSIONMARK'|_],_) -> + true; +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 is_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 is_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,RestFields} = + convert_to_defaultfield(S,FName,[Spec|Fields],CField), + check_defaultfields(S,RestFields,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) -> + {MatchedField,RestFields,RestWS} = + match_field(S,Fields,WithSyntax,ClassFields), + if + is_list(MatchedField) -> + convert_definedsyntax(S,RestFields,RestWS,ClassFields, + lists:append(MatchedField,Acc)); + true -> + convert_definedsyntax(S,RestFields,RestWS,ClassFields, + [MatchedField|Acc]) + end. + +match_field(S,Fields,WithSyntax,ClassFields) -> + match_field(S,Fields,WithSyntax,ClassFields,[]). + +match_field(S,Fields,[W|Ws],ClassFields,Acc) when is_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 is_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 is_list(W) -> + case catch match_optional_field(S,Fields,W,ClassFields,[]) of + {'EXIT',_} when length(Ws) > 0 -> + match_optional_field(S,Fields,Ws,ClassFields,Ret); + {'EXIT',_} -> + {Ret,Fields}; + {asn1,{optional_matcherror,_,_}} when length(Ws) > 0 -> + match_optional_field(S,Fields,Ws,ClassFields,Ret); + {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], + [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); +%% am optional setting inside another optional setting may be "double-listed" +match_optional_field(S,[Setting],DefinedSyntax,ClassFields,Ret) + when is_list(Setting) -> + match_optional_field(S,Setting,DefinedSyntax,ClassFields,Ret); +%% identify and save field data +match_optional_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Ret) -> + ?dbg("matching optional field setting: ~p with user friendly syntax: ~p~n",[Setting,W]), + WorS = + case Setting of + Type when is_record(Type,type) -> Type; + {'ValueFromObject',_,_} -> Setting; + {object,_,_} -> Setting; + {_,_,WordOrSetting} -> WordOrSetting; + Other -> Other + end, + case lists:keysearch(W,2,ClassFields) of + false -> + throw({asn1,{optional_matcherror,WorS,W}}); + {value,CField} -> + {NewField,RestFields} = + convert_to_defaultfield(S,W,[WorS|Rest],CField), + match_optional_field(S,RestFields,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 is_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 is_list(W) -> +match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,Acc) when is_list(W), length(Acc) >= 1 -> + {Acc,Fields,WithSyntax}; +%% identify and skip word +%%match_mandatory_field(S,[{_,_,WorS}|Rest], +match_mandatory_field(S,[{_,_,#'Externaltypereference'{type=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) -> + ?dbg("matching field setting: ~p with user friendly syntax: ~p~n",[Setting,W]), + WorS = + case Setting of + {object,_,_} -> Setting; + {_,_,WordOrSetting} -> WordOrSetting; + Type when is_record(Type,type) -> Type; + Other -> Other + end, + case lists:keysearch(W,2,ClassFields) of + false -> + throw({asn1,{mandatory_matcherror,WorS,W}}); + {value,CField} -> + {NewField,RestFields} = + convert_to_defaultfield(S,W,[WorS|Rest],CField), + match_mandatory_field(S,RestFields,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 +%% A field may be a type, a fixed type value, an object, an objectset, +%% +convert_to_defaultfield(S,ObjFieldName,[OFS|RestOFS],CField)-> + ?dbg("convert field: ~p of type: ~p~n",[ObjFieldName,element(1,CField)]), + CurrMod = S#state.mname, + Strip_value_tag = + fun({value_tag,ValueSetting}) -> ValueSetting; + (VS) -> VS + end, + ObjFieldSetting = Strip_value_tag(OFS), + RestSettings = [Strip_value_tag(X)||X <- RestOFS], + case element(1,CField) of + typefield -> + TypeDef= + case ObjFieldSetting of + TypeRec when is_record(TypeRec,type) -> TypeRec#type.def; + TDef when is_record(TDef,typedef) -> + TDef#typedef{checked=true, + typespec=check_type(S,TDef, + TDef#typedef.typespec)}; + _ -> ObjFieldSetting + end, + {Type,SettingsLeft} = + if + is_record(TypeDef,typedef) -> {TypeDef,RestSettings}; + is_record(TypeDef,'ObjectClassFieldType') -> + T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting), + {oCFT_def(S,T),RestSettings}; +% #typedef{checked=true,name=Name,typespec=IT}; + is_tuple(TypeDef), element(1,TypeDef) == pt -> + %% this is an inlined type. If constructed + %% type save in data base + T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting), + #'Externaltypereference'{type=PtName} = + element(2,TypeDef), + NameList = [PtName,S#state.tname], + NewName = list_to_atom(asn1ct_gen:list2name(NameList)), + NewTDef=#typedef{checked=true,name=NewName, + typespec=T}, + asn1_db:dbput(S#state.mname,NewName,NewTDef), + %%asn1ct_gen:insert_once(parameterized_objects,{NewName,type,NewTDef}), + insert_once(S,parameterized_objects, + {NewName,type,NewTDef}), + {NewTDef,RestSettings}; + is_tuple(TypeDef), element(1,TypeDef)=='SelectionType' -> + T=check_type(S,#typedef{typespec=ObjFieldSetting}, + ObjFieldSetting), + Name = type_name(S,T), + {#typedef{checked=true,name=Name,typespec=T},RestSettings}; + true -> + case asn1ct_gen:type(asn1ct_gen:get_inner(TypeDef)) of + ERef = #'Externaltypereference'{module=CurrMod} -> + {RefMod,T} = get_referenced_type(S,ERef), + check_and_save(S,ERef#'Externaltypereference'{module=RefMod},T,RestSettings); + + ERef = #'Externaltypereference'{} -> + {RefMod,T} = get_referenced_type(S,ERef), + check_and_save(S,ERef#'Externaltypereference'{module=RefMod},T,RestSettings); + Bif when Bif=={primitive,bif};Bif=={constructed,bif} -> + T = check_type(S,#typedef{typespec=ObjFieldSetting}, + ObjFieldSetting), + {#typedef{checked=true,name=Bif,typespec=T},RestSettings}; + _OCFT = #'ObjectClassFieldType'{} -> + T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting), + %%io:format("OCFT=~p~n,T=~p~n",[OCFT,T]), + {#typedef{checked=true,typespec=T},RestSettings}; + _ -> + %this case should not happen any more + {Mod,T} = + get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}), + case Mod of + CurrMod -> + {T,RestSettings}; + ExtMod -> + #typedef{name=Name} = T, + {T#typedef{name={ExtMod,Name}},RestSettings} + end + end + end, + {{ObjFieldName,Type},SettingsLeft}; + fixedtypevaluefield -> + case ObjFieldName of + Val when is_atom(Val) -> + %% ObjFieldSetting can be a value,an objectidentifiervalue, + %% an element in an enumeration or namednumberlist etc. + ValRef = + case ObjFieldSetting of + ValSetting=#'Externalvaluereference'{} -> + ValSetting; + {'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); + ValSetting = #valuedef{} -> + ValSetting; + ValSetting = {'CHOICE',{Alt,_ChVal}} when is_atom(Alt) -> + #valuedef{type=element(3,CField), + value=ValSetting, + module=S#state.mname}; + ValSetting -> + #identifier{val=ValSetting} + end, + ?dbg("fixedtypevaluefield ValRef: ~p~n",[ValRef]), + case ValRef of + #valuedef{} -> + {{ObjFieldName,check_value(S,ValRef)},RestSettings}; + _ -> + ValDef = + case catch get_referenced_type(S,ValRef) of + {error,_} -> + NewValDef = + #valuedef{name=Val, + type=element(3,CField), + value=ObjFieldSetting, + module=S#state.mname}, + check_value(S,NewValDef); + {M,VDef} when is_record(VDef,valuedef) -> + check_value(update_state(S,M), + %%S#state{mname=M}, + VDef);%% XXX + {M,VDef} -> + check_value(update_state(S,M), + %%S#state{mname=M}, + #valuedef{name=Val, + type=element(3,CField), + value=VDef, + module=M}) + end, + {{ObjFieldName,ValDef},RestSettings} + end; + Val -> + {{ObjFieldName,Val},RestSettings} + end; + fixedtypevaluesetfield -> + {{ObjFieldName,ObjFieldSetting},RestSettings}; + objectfield -> + CheckObject = + fun(O) -> + O#typedef{checked=true,typespec= + check_object(S,O,O#typedef.typespec)} + end, + ObjectSpec = + case ObjFieldSetting of + Ref when is_record(Ref,'Externalvaluereference') -> + %% The object O might be a #valuedef{} if + %% e.g. the definition looks like + %% myobj SOMECLASS ::= referencedObject + {M,O} = get_referenced_type(S,Ref), + check_object(S,O,object_to_check(O)), + Ref#'Externalvaluereference'{module=M}; + + {'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), + CheckObject(ObjFromObj); + ObjDef={object,_,_} -> + %% An object defined inlined in another object + %% class is an objectfield, that implies that + %% {objectsetfield,TypeFieldName,DefinedObjecClass, + %% OptionalitySpec} + %% DefinedObjecClass = #'Externaltypereference'{}| + %% 'TYPE-IDENTIFIER' | 'ABSTRACT-SYNTAX' + ClassName = element(3,CField), + InlinedObjName= + list_to_atom(lists:concat([S#state.tname]++ + ['_',ObjFieldName])), + + ObjSpec = #'Object'{classname=ClassName, + def=ObjDef}, + CheckedObj= + check_object(S,#typedef{typespec=ObjSpec},ObjSpec), + InlObj = #typedef{checked=true,name=InlinedObjName, + typespec=CheckedObj}, + ObjKey = {InlinedObjName,InlinedObjName}, + %% asn1ct_gen:insert_once(inlined_objects,ObjKey), + insert_once(S,inlined_objects,ObjKey), + %% Which module to use here? Could it be other than top_module ? + %% asn1_db:dbput(S#state.mname,InlinedObjName,InlObj), + asn1_db:dbput(get(top_module),InlinedObjName,InlObj), + InlObj; + #type{def=Eref} when is_record(Eref,'Externaltypereference') -> + {_,O} = get_referenced_type(S,Eref), + CheckObject(O); + Other -> + {_,O} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Other}), + CheckObject(O) + end, + {{ObjFieldName,ObjectSpec},RestSettings}; + variabletypevaluefield -> + {{ObjFieldName,ObjFieldSetting},RestSettings}; + variabletypevaluesetfield -> + {{ObjFieldName,ObjFieldSetting},RestSettings}; +%% objectset_or_fixedtypevalueset_field -> +%% ok; + objectsetfield -> + ObjSetSpec = get_objectset_def(S,ObjFieldSetting,CField), + ?dbg("objectsetfield, ObjSetSpec:~p~n",[ObjSetSpec]), + {{ObjFieldName, + ObjSetSpec#typedef{checked=true, + typespec=check_object(S,ObjSetSpec, + ObjSetSpec#typedef.typespec)}},RestSettings} + end. + +get_objectset_def(S,Ref,CField) + when is_record(Ref,'Externaltypereference'); + is_record(Ref,'Externalvaluereference') -> + {_M,T}=get_referenced_type(S,Ref), + get_objectset_def2(S,T,CField); +get_objectset_def(S,ObjectList,CField) when is_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 + ?dbg("objectsetfield: ~p~n",[CField]), + get_objectset_def2(S,ObjectList,CField); +get_objectset_def(S,'EXTENSIONMARK',CField) -> + ?dbg("objectsetfield: ~p~n",[CField]), + get_objectset_def2(S,['EXTENSIONMARK'],CField); +get_objectset_def(_S,ObjFieldSetting={'SingleValue',_},CField) -> + %% a Union of defined objects + ?dbg("objectsetfield, SingleValue~n",[]), + union_of_defed_objs(CField,ObjFieldSetting); +get_objectset_def(_S,ObjFieldSetting={{'SingleValue',_},_},CField) -> + %% a Union of defined objects + ?dbg("objectsetfield, SingleValue~n",[]), + union_of_defed_objs(CField,ObjFieldSetting); +get_objectset_def(S,{object,_,[#type{def={'TypeFromObject', + {object,RefedObj}, + FieldName}}]},_CField) -> + %% This case occurs when an ObjectSetFromObjects + %% production is used + {_M,Def} = get_referenced_type(S,RefedObj), + get_fieldname_element(S,Def,FieldName); +get_objectset_def(S,{object,_,[{setting,_,ERef}]},CField) + when is_record(ERef,'Externaltypereference') -> + {_,T} = get_referenced_type(S,ERef), + get_objectset_def2(S,T,CField); +get_objectset_def(S,#type{def=ERef},_CField) + when is_record(ERef,'Externaltypereference') -> + {_,T} = get_referenced_type(S,ERef), + T; +get_objectset_def(S,ObjFieldSetting,CField) + when is_atom(ObjFieldSetting) -> + ERef = #'Externaltypereference'{module=S#state.mname, + type=ObjFieldSetting}, + {_,T} = get_referenced_type(S,ERef), + get_objectset_def2(S,T,CField). + +get_objectset_def2(_S,T = #typedef{typespec=#'Object'{}},_CField) -> + #typedef{typespec=#'Object'{classname=Class,def=Def}} = T, + T#typedef{typespec=#'ObjectSet'{class=Class,set=[Def]}}; +get_objectset_def2(_S,Set,CField) when is_list(Set) -> + {_,_,Type,_} = CField, + ClassDef = Type#type.def, + #typedef{typespec=#'ObjectSet'{class=ClassDef, + set=Set}}; +get_objectset_def2(_S,T = #typedef{typespec=#'ObjectSet'{}},_CField) -> + T; +get_objectset_def2(_S,T,_CField) -> + io:format("Warning get_objectset_def2: uncontrolled object set structure:~n~p~n",[T]). + +type_name(S,#type{def=Def}) -> + CurrMod = S#state.mname, + case asn1ct_gen:type(asn1ct_gen:get_inner(Def)) of + #'Externaltypereference'{module=CurrMod,type=Name} -> + Name; + #'Externaltypereference'{module=Mod,type=Name} -> + {Mod,Name}; + Bif when Bif=={primitive,bif};Bif=={constructed,bif} -> + Bif + end. + +merged_name(#state{inputmodules=[]},ERef) -> + ERef; +merged_name(S,ERef=#'Externaltypereference'{module=M}) -> + case {S#state.mname,lists:member(M,S#state.inputmodules)} of + {M,_} -> + ERef; + {MergeM,true} -> + %% maybe the reference is renamed + NewName = renamed_reference(S,ERef), + ERef#'Externaltypereference'{module=MergeM,type=NewName}; + {_,_} -> % i.e. M /= MergeM, not an inputmodule + ERef + end. + +oCFT_def(S,T) -> + case get_OCFT_inner(S,T) of + ERef=#'Externaltypereference'{} -> ERef; + {Name,Type} -> #typedef{checked=true,name=Name,typespec=Type}; + 'ASN1_OPEN_TYPE' -> + #typedef{checked=true,typespec=T#type{def='ASN1_OPEN_TYPE'}} + end. + +get_OCFT_inner(_S,T) -> +% Module=S#state.mname, + Def = T#type.def, + case Def#'ObjectClassFieldType'.type of + {fixedtypevaluefield,_,InnerType} -> + case asn1ct_gen:type(asn1ct_gen:get_inner(InnerType#type.def)) of + Bif when Bif=={primitive,bif};Bif=={constructed,bif} -> + {Bif,InnerType}; + ERef = #'Externaltypereference'{} -> + ERef + end; + 'ASN1_OPEN_TYPE' -> 'ASN1_OPEN_TYPE' + end. + + + +union_of_defed_objs({_,_,_ObjClass=#type{def=ClassDef},_},ObjFieldSetting) -> + #typedef{typespec=#'ObjectSet'{class = ClassDef, + set = ObjFieldSetting}}; +union_of_defed_objs({_,_,DefObjClassRef,_},ObjFieldSetting) + when is_record(DefObjClassRef,'Externaltypereference') -> + #typedef{typespec=#'ObjectSet'{class = DefObjClassRef, + set = ObjFieldSetting}}. + + +check_value(OldS,V) when is_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 is_record(Class,classdef) -> + throw({pobjectsetdef}); + _ -> continue + end + end; +check_value(_OldS,V) when is_record(V,pvaluedef) -> + %% Fix this case later + V; +check_value(OldS,V) when is_record(V,typedef) -> + %% This case when a value set has been parsed as an object set. + %% It may be a value set + ?dbg("check_value, V: ~p~n",[V]), + #typedef{typespec=TS} = V, + case TS of + #'ObjectSet'{class=ClassRef} -> + {RefM,TSDef} = get_referenced_type(OldS,ClassRef), + %%IsObjectSet(TSDef); + case TSDef of + #classdef{} -> throw({objectsetdef}); + #typedef{typespec=#type{def=Eref}} when + is_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, + module=RefM}), + {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 is_record(V,valuedef) -> + #valuedef{name=Name,checked=Checked,type=Vtype, + value=Value,module=ModName} = V, + ?dbg("check_value, V: ~p~n",[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}, + SVal = update_state(S,ModName), + NewDef = + case Def of + Ext when is_record(Ext,'Externaltypereference') -> + RecName = Ext#'Externaltypereference'.type, + {RefM,Type} = get_referenced_type(S,Ext), + %% If V isn't a value but an object Type is a #classdef{} + %%NewS = S#state{mname=RefM}, + NewS = update_state(S,RefM), + case Type of + #classdef{} -> + throw({objectdef}); + #typedef{} -> + case is_contextswitchtype(Type) of + true -> + #valuedef{value=CheckedVal}= + check_value(NewS,V#valuedef{type=Type#typedef.typespec}), + #newv{value=CheckedVal}; + _ -> + #valuedef{value=CheckedVal}= + check_value(NewS#state{recordtopname=[RecName|TopName]}, + V#valuedef{type=Type#typedef.typespec}), + #newv{value=CheckedVal} + end; + #type{} -> + %% A parameter that couldn't be categorized. + #valuedef{value=CheckedVal}= + check_value(NewS#state{recordtopname=[RecName|TopName]}, + V#valuedef{type=Type}), + #newv{value=CheckedVal} + end; + 'ANY' -> + case Value of + {opentypefieldvalue,ANYType,ANYValue} -> + CheckedV= + check_value(SVal,#valuedef{name=Name, + type=ANYType, + value=ANYValue, + module=ModName}), + #newv{value=CheckedV#valuedef.value}; + _ -> + throw({error,{asn1,{'cant check value of type',Def}}}) + end; + 'INTEGER' -> + ok=validate_integer(SVal,Value,[],Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + {'INTEGER',NamedNumberList} -> + ok=validate_integer(SVal,Value,NamedNumberList,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + {'BIT STRING',NamedNumberList} -> + ok=validate_bitstring(SVal,Value,NamedNumberList,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'NULL' -> + ok=validate_null(SVal,Value,Constr), + #newv{}; + 'OBJECT IDENTIFIER' -> + {ok,_}=validate_objectidentifier(SVal,Value,Constr), + #newv{value = normalize_value(SVal,Vtype,Value,[])}; + 'RELATIVE-OID' -> + {ok,_}=validate_relative_oid(SVal,Value,Constr), + #newv{value = Value}; + 'ObjectDescriptor' -> + ok=validate_objectdescriptor(SVal,Value,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'REAL' -> + ok = validate_real(SVal,Value,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + {'ENUMERATED',NamedNumberList} -> + ok=validate_enumerated(SVal,Value,NamedNumberList,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'BOOLEAN'-> + ok=validate_boolean(SVal,Value,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'OCTET STRING' -> + ok=validate_octetstring(SVal,Value,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'NumericString' -> + ok=validate_restrictedstring(SVal,Value,Def,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + TString when TString =:= 'TeletexString'; + TString =:= 'T61String' -> + ok=validate_restrictedstring(SVal,Value,Def,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'VideotexString' -> + ok=validate_restrictedstring(SVal,Value,Def,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'UTCTime' -> + #newv{value=normalize_value(SVal,Vtype,Value,[])}; +% exit({'cant check value of type' ,Def}); + 'GeneralizedTime' -> + #newv{value=normalize_value(SVal,Vtype,Value,[])}; +% exit({'cant check value of type' ,Def}); + 'GraphicString' -> + ok=validate_restrictedstring(SVal,Value,Def,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'VisibleString' -> + ok=validate_restrictedstring(SVal,Value,Def,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'GeneralString' -> + ok=validate_restrictedstring(SVal,Value,Def,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'PrintableString' -> + ok=validate_restrictedstring(SVal,Value,Def,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'IA5String' -> + ok=validate_restrictedstring(SVal,Value,Def,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'BMPString' -> + ok=validate_restrictedstring(SVal,Value,Def,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'UTF8String' -> + ok = validate_restrictedstring(SVal,Vtype,Value,Constr), + %%io:format("Vtype: ~p~nValue: ~p~n",[Vtype,Value]); + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + 'UniversalString' -> %added 6/12 -00 + ok = validate_restrictedstring(SVal,Value,Def,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,[])}; + Seq when is_record(Seq,'SEQUENCE') -> + {ok,SeqVal} = validate_sequence(SVal,Value, + Seq#'SEQUENCE'.components, + Constr), + #newv{value=normalize_value(SVal,Vtype,SeqVal,TopName)}; + {'SEQUENCE OF',Components} -> + ok=validate_sequenceof(SVal,Value,Components,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,TopName)}; + {'CHOICE',Components} -> + ok=validate_choice(SVal,Value,Components,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,TopName)}; + Set when is_record(Set,'SET') -> + ok=validate_set(SVal,Value,Set#'SET'.components, + Constr), + #newv{value=normalize_value(SVal,Vtype,Value,TopName)}; + {'SET OF',Components} -> + ok=validate_setof(SVal,Value,Components,Constr), + #newv{value=normalize_value(SVal,Vtype,Value,TopName)}; + {'SelectionType',SelName,SelT} -> + CheckedT = check_selectiontype(SVal,SelName,SelT), + NewV = V#valuedef{type=CheckedT}, + SelVDef=check_value(S#state{value=NewV},NewV), + #newv{value=SelVDef#valuedef.value}; + Other -> + exit({'cannot 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}=Ref, +validate_integer(S,#'Externalvaluereference'{value=Id}=Ref, + NamedNumberList,Constr) -> + case lists:keysearch(Id,1,NamedNumberList) of + {value,_} -> ok; + false -> validate_integer_ref(S,Ref,NamedNumberList,Constr) + %%error({value,"unknown NamedNumber",S}) + end; +validate_integer(S,Id,NamedNumberList,Constr) when is_atom(Id) -> + case lists:keysearch(Id,1,NamedNumberList) of + {value,_} -> ok; + false -> validate_integer_ref(S,Id,NamedNumberList,Constr) + %error({value,"unknown NamedNumber",S}) + end; +validate_integer(_S,Value,_NamedNumberList,Constr) when is_integer(Value) -> + check_integer_range(Value,Constr). + +validate_integer_ref(S,Id,_,_) when is_atom(Id) -> + error({value,"unknown integer referens",S}); +validate_integer_ref(S,Ref,NamedNumberList,Constr) -> + case get_referenced_type(S,Ref) of + {M,V} when is_record(V,valuedef) -> + NewS = update_state(S,M), + case check_value(NewS,V) of + #valuedef{type=#type{def='INTEGER'},value=Value} -> + validate_integer(NewS,Value,NamedNumberList,Constr); + _Err -> error({value,"unknown integer referens",S}) + end; + _ -> + error({value,"unknown integer referens",S}) + end. + + + +check_integer_range(Int,Constr) when is_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,ERef,C) -> + validate_objectidentifier(S,o_id,ERef,C). + +validate_objectidentifier(S,OID,ERef,C) + when is_record(ERef,'Externalvaluereference') -> + validate_objectidentifier(S,OID,[ERef],C); +validate_objectidentifier(S,OID,Tup,C) when is_tuple(Tup) -> + validate_objectidentifier(S,OID,tuple_to_list(Tup),C); +validate_objectidentifier(S,OID,L,_) -> + NewL = is_space_list(L,[]), + case validate_objectidentifier1(S,OID,NewL) of + NewL2 when is_list(NewL2) ->{ok,list_to_tuple(NewL2)}; + Other -> {ok,Other} + end. + +validate_objectidentifier1(S, OID, [Id|T]) + when is_record(Id,'Externalvaluereference') -> + case catch get_referenced_type(S,Id) of + {M,V} when is_record(V,valuedef) -> + NewS = update_state(S,M), + case check_value(NewS,V) of + #valuedef{type=#type{def=ERef},checked=true, + value=Value} when is_tuple(Value) -> + case is_object_id(OID,NewS,ERef) of + true -> + %% T must be a RELATIVE-OID + validate_oid(true,NewS, rel_oid, T, lists:reverse(tuple_to_list(Value))); + _ -> + error({value, {"illegal "++to_string(OID),[Id|T]}, S}) + end; + _ -> + error({value, {"illegal "++to_string(OID),[Id|T]}, S}) + end; + _ -> + validate_oid(true,S, OID, [Id|T], []) + end; +validate_objectidentifier1(S,OID,V) -> + validate_oid(true,S,OID,V,[]). + +validate_oid(false, S, OID, V, Acc) -> + error({value, {"illegal "++to_string(OID), V,Acc}, S}); +validate_oid(_,_, _, [], Acc) -> + lists:reverse(Acc); +validate_oid(_, S, OID, [Value|Vrest], Acc) when is_integer(Value) -> + validate_oid(valid_objectid(OID,Value,Acc),S, OID, Vrest, [Value|Acc]); +validate_oid(_, S, OID, [{'NamedNumber',_Name,Value}|Vrest], Acc) + when is_integer(Value) -> + validate_oid(valid_objectid(OID,Value,Acc), S, OID, Vrest, [Value|Acc]); +validate_oid(_, S, OID, [Id|Vrest], Acc) + when is_record(Id,'Externalvaluereference') -> + case catch get_referenced_type(S, Id) of + {M,V} when is_record(V,valuedef) -> + NewS = update_state(S,M), + NewVal = case check_value(NewS, V) of + #valuedef{checked=true,value=Value} -> + fun(Int) when is_integer(Int) -> [Int]; + (L) when is_list(L) -> L; + (T) when is_tuple(T) -> tuple_to_list(T) + end (Value); + _ -> + error({value, {"illegal "++to_string(OID), + [Id|Vrest],Acc}, S}) + end, + case NewVal of + List when is_list(List) -> + validate_oid(valid_objectid(OID,NewVal,Acc), NewS, + OID, Vrest,lists:reverse(NewVal)++Acc); + _ -> + NewVal + end; + _ -> + case reserved_objectid(Id#'Externalvaluereference'.value, Acc) of + Value when is_integer(Value) -> + validate_oid(valid_objectid(OID,Value,Acc), + S, OID,Vrest, [Value|Acc]); + false -> + error({value, {"illegal "++to_string(OID),[Id,Vrest],Acc}, S}) + end + end; +validate_oid(_, S, OID, [{Atom,Value}],[]) + when is_atom(Atom),is_integer(Value) -> + %% this case when an OBJECT IDENTIFIER value has been parsed as a + %% SEQUENCE value + Rec = #'Externalvaluereference'{module=S#state.mname, + value=Atom}, + validate_objectidentifier1(S, OID, [Rec,Value]); +validate_oid(_, S, OID, [{Atom,EVRef}],[]) + when is_atom(Atom),is_record(EVRef,'Externalvaluereference') -> + %% this case when an OBJECT IDENTIFIER value has been parsed as a + %% SEQUENCE value OTP-4354 + Rec = #'Externalvaluereference'{module=EVRef#'Externalvaluereference'.module, + value=Atom}, + validate_objectidentifier1(S, OID, [Rec,EVRef]); +validate_oid(_, S, OID, [Atom|Rest],Acc) when is_atom(Atom) -> + Rec = #'Externalvaluereference'{module=S#state.mname, + value=Atom}, + validate_oid(true,S, OID, [Rec|Rest],Acc); +validate_oid(_, S, OID, V, Acc) -> + error({value, {"illegal "++to_string(OID),V,Acc},S}). + +validate_relative_oid(S,Value,Constr) -> + validate_objectidentifier(S,rel_oid,Value,Constr). + +is_object_id(OID,S,ERef=#'Externaltypereference'{}) -> + {_,OI} = get_referenced_type(S,ERef), + is_object_id(OID,S,OI#typedef.typespec); +is_object_id(o_id,_S,'OBJECT IDENTIFIER') -> + true; +is_object_id(rel_oid,_S,'RELATIVE-OID') -> + true; +is_object_id(_,_S,'INTEGER') -> + true; +is_object_id(OID,S,#type{def=Def}) -> + is_object_id(OID,S,Def); +is_object_id(_,_S,_) -> + false. + +to_string(o_id) -> + "OBJECT IDENTIFIER"; +to_string(rel_oid) -> + "RELATIVE-OID". + +%% 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. + +valid_objectid(_OID,[],_Acc) -> + true; +valid_objectid(OID,[H|T],Acc) -> + case valid_objectid(OID, H, Acc) of + true -> + valid_objectid(OID,T,[H|Acc]); + _ -> + false + end; +valid_objectid(o_id,I,[]) when I =:= 0; I =:= 1; I =:= 2 -> true; +valid_objectid(o_id,_I,[]) -> false; +valid_objectid(o_id,I,[0]) when I >= 0; I =< 4 -> true; +valid_objectid(o_id,_I,[0]) -> false; +valid_objectid(o_id,I,[1]) when I =:= 0; I =:= 2; I =:= 3 -> true; +valid_objectid(o_id,_I,[1]) -> false; +valid_objectid(o_id,_I,[2]) -> true; +valid_objectid(_,_,_) -> true. + + + + + + +validate_objectdescriptor(_S,_Value,_Constr) -> + ok. + +validate_real(_S,_Value,_Constr) -> + ok. + +validate_enumerated(S,Id,NamedNumberList,_Constr) when is_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] -> + {ok,to_EXTERNAL1990(S,Value)}; + _ -> + {ok,Value} + end; + _ -> + {ok,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'; + {'RELATIVE-OID',_,_} -> + normalize_relative_oid(S,Value); + {'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); + {'ASN1_OPEN_TYPE',{typefield,_TF},NL} -> %an open type + normalize_objectclassfieldvalue(S,Value,NL); + Err -> + io:format("WARNING: could not check default value ~p~nType:~n~p~nNameList:~n~p~n",[Value,Type,Err]), + Value + end; +normalize_value(S,Type,Val,NameList) -> + normalize_value(S,Type,{'DEFAULT',Val},NameList). + +normalize_boolean(S,{Name,Bool},CType) when is_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 is_integer(Int) -> + Int; +normalize_integer(_S,{Name,Int},_) when is_atom(Name),is_integer(Int) -> + Int; +normalize_integer(S,{Name,Int=#'Externalvaluereference'{}}, + Type) when is_atom(Name) -> + normalize_integer(S,Int,Type); +normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) -> + case Type of + NNL when is_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. + %% E - list of ones and zeros, if Value already is normalized. + case Value of + {hstring,String} when is_list(String) -> + hstring_to_int(String); + {bstring,String} when is_list(String) -> + bstring_to_bitlist(String); + Rec when is_record(Rec,'Externalvaluereference') -> + get_normalized_value(S,Value,Type, + fun normalize_bitstring/3,[]); + RecList when is_list(RecList) -> + case Type of + NBL when is_list(NBL) -> + F = fun(#'Externalvaluereference'{value=Name}) -> + case lists:keysearch(Name,1,NBL) of + {value,{Name,_}} -> + Name; + Other -> + throw({error,Other}) + end; + (I) when I =:= 1; I =:= 0 -> + I; + (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 is_atom(Name) -> + normalize_bitstring(S,String,Type); + Other -> + io:format("WARNING: illegal default value ~p~n",[Other]), + Value + end. + +hstring_to_int(L) when is_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 is_record(Rec,'Externalvaluereference') -> + get_normalized_value(S,Value,CType, + fun normalize_octetstring/3,[]); + {Name,String} when is_atom(Name) -> + normalize_octetstring(S,String,CType); + List when is_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) -> + {ok,Val}=validate_objectidentifier(S,Value,[]), + Val. + +normalize_relative_oid(S,Value) -> + {ok,Val} = validate_relative_oid(S,Value,[]), + Val. + +normalize_objectdescriptor(Value) -> + Value. + +normalize_real(Value) -> + Value. + +normalize_enumerated(#'Externalvaluereference'{value=V},CType) + when is_list(CType) -> + normalize_enumerated2(V,CType); +normalize_enumerated(Value,CType) when is_atom(Value),is_list(CType) -> + normalize_enumerated2(Value,CType); +normalize_enumerated({Name,EnumV},CType) when is_atom(Name) -> + normalize_enumerated(EnumV,CType); +normalize_enumerated(Value,{CType1,CType2}) when is_list(CType1), is_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 is_atom(C) -> + case catch lists:keysearch(C,#'ComponentType'.name,CType) of + {value,#'ComponentType'{typespec=CT,name=Name}} -> + {C,normalize_value(S,CT,{'DEFAULT',V}, + [Name|NameList])}; + Other -> + io:format("WARNING: Wrong format of type/value ~p/~p~n", + [Other,V]), + {C,V} + end; +normalize_choice(S,{'DEFAULT',ValueList},CType,NameList) when is_list(ValueList) -> + lists:map(fun(X)-> normalize_choice(S,X,CType,NameList) end, ValueList); +normalize_choice(S,Val=#'Externalvaluereference'{},CType,NameList) -> + {M,#valuedef{value=V}}=get_referenced_type(S,Val), + normalize_choice(update_state(S,M),{'CHOICE',V},CType,NameList); +% get_normalized_value(S,Val,CType,fun normalize_choice/4,[NameList]); +normalize_choice(S,CV={Name,_ChoiceVal},CType,NameList) + when is_atom(Name) -> +% normalize_choice(S,ChoiceVal,CType,NameList). + normalize_choice(S,{'CHOICE',CV},CType,NameList); +normalize_choice(_S,V,_CType,_NameList) -> + exit({error,{bad_choice_value,V}}). + +%% normalize_choice(NameList,S,CVal = {'CHOICE',{_,_}},CType,_) -> +%% normalize_choice(S,CVal,CType,NameList); +%% normalize_choice(NameList,S,CVal={'DEFAULT',VL},CType,_) when is_list(VL)-> +%% normalize_choice(S,CVal,CType,NameList); +%% normalize_choice(NameList,S,CV={Name,_CV},CType,_) when is_atom(Name)-> +%% normalize_choice(S,{'CHOICE',CV},CType,NameList); +%% normalize_choice(_,_S,V,_,_) -> +%% V. + +normalize_sequence(S,Value,Components,NameList) + when is_tuple(Components) -> + normalize_sequence(S,Value,lists:flatten(tuple_to_list(Components)), + NameList); +normalize_sequence(S,{Name,Value},Components,NameList) + when is_atom(Name),is_list(Value) -> + normalize_sequence(S,Value,Components,NameList); +normalize_sequence(S,Value,Components,NameList) -> + normalized_record('SEQUENCE',S,Value,Components,NameList). + +normalize_set(S,Value,Components,NameList) when is_tuple(Components) -> + normalize_set(S,Value,lists:flatten(tuple_to_list(Components)),NameList); +normalize_set(S,{Name,Value},Components,NameList) + when is_atom(Name),is_list(Value) -> + normalized_record('SET',S,Value,Components,NameList); +normalize_set(S,Value,Components,NameList) -> + NewName = list_to_atom(asn1ct_gen:list2name(NameList)), + case is_record_normalized(S,NewName,Value,length(Components)) of + true -> + Value; + _ -> + SortedVal = sort_value(Components,Value), + normalized_record('SET',S,SortedVal,Components,NameList) + end. + +sort_value(Components,Value) -> + ComponentNames = lists:map(fun(#'ComponentType'{name=Cname}) -> Cname end, + Components), + sort_value1(ComponentNames,Value,[]). +sort_value1(_,V=#'Externalvaluereference'{},_) -> + %% sort later, get the value in normalize_seq_or_set + V; +sort_value1([N|Ns],Value,Acc) -> + case lists:keysearch(N,1,Value) of + {value,V} ->sort_value1(Ns,Value,[V|Acc]); + _ -> sort_value1(Ns,Value,Acc) + end; +sort_value1([],_,Acc) -> + lists:reverse(Acc). + +sort_val_if_set(['SET'|_],Val,Type) -> + sort_value(Type,Val); +sort_val_if_set(_,Val,_) -> + Val. + +normalized_record(SorS,S,Value,Components,NameList) -> + NewName = list_to_atom(lists:concat([get_record_prefix_name(S), + asn1ct_gen:list2name(NameList)])), + case is_record_normalized(S,NewName,Value,length(Components)) of + true -> + Value; + _ -> + 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 + end. +is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) -> + case get_referenced_type(S,V) of + {_M,#valuedef{type=_T1,value=V2}} -> + is_record_normalized(S,Name,V2,NumComps); + _ -> false + end; +is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) -> + (size(Value) =:= (NumComps + 1)) andalso (element(1,Value)=:=Name); +is_record_normalized(_,_,_,_) -> + false. + +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 is_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 is_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 is_record(Value,'Externalvaluereference') -> + get_normalized_value(S,Value,Type,fun normalize_s_of/5, + [SorS,NameList]). + + +%% normalize_restrictedstring handles all format of restricted strings. +%% tuple case +% normalize_restrictedstring(_S,[Int1,Int2],_) when is_integer(Int1),is_integer(Int2) -> +% {Int1,Int2}; +% %% quadruple case +% normalize_restrictedstring(_S,[Int1,Int2,Int3,Int4],_) when is_integer(Int1), +% is_integer(Int2), +% is_integer(Int3), +% is_integer(Int4) -> +% {Int1,Int2,Int3,Int4}; +%% character string list case +normalize_restrictedstring(S,[H|T],CType) when is_list(H);is_tuple(H) -> + [normalize_restrictedstring(S,H,CType)|normalize_restrictedstring(S,T,CType)]; +%% character sting case +normalize_restrictedstring(_S,CString,_) when is_list(CString) -> + CString; +%% definedvalue case or argument in a parameterized type +normalize_restrictedstring(S,ERef,CType) when is_record(ERef,'Externalvaluereference') -> + get_normalized_value(S,ERef,CType, + fun normalize_restrictedstring/3,[]); +%% +normalize_restrictedstring(S,{Name,Val},CType) when is_atom(Name) -> + normalize_restrictedstring(S,Val,CType). + +normalize_objectclassfieldvalue(S,{opentypefieldvalue,Type,Value},NameList) -> + %% An open type has per definition no type. Thus should the type + %% information of the default type be available at + %% encode/decode. But as encoding the default value causes special + %% treatment (no encoding) whatever type is used the type + %% information is not necessary in encode/decode. + normalize_value(S,Type,Value,NameList); +normalize_objectclassfieldvalue(_S,Other,_NameList) -> + %% If the type info was thrown away in an earlier step the value + %% is already normalized. + Other. + +get_normalized_value(S,Val,Type,Func,AddArg) -> + case catch get_referenced_type(S,Val) of + {ExtM,_VDef = #valuedef{type=_T1,value=V}} -> + %% should check that Type and T equals + V2 = sort_val_if_set(AddArg,V,Type), + call_Func(update_state(S,ExtM),V2,Type,Func,AddArg); + {error,_} -> + io:format("WARNING: default value not " + "comparable ~p~n",[Val]), + Val; + {ExtM,NewVal} -> + V2 = sort_val_if_set(AddArg,NewVal,Type), + call_Func(update_state(S,ExtM),V2,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 is_atom(Name) -> + {Name,Type,NameList}; + Ref when is_record(Ref,'Externaltypereference') -> + {_,#typedef{name=Name,typespec=RefedType}} = + get_referenced_type(S,Ref), + get_canonic_type(S,RefedType,[Name]); + {Name,T} when is_atom(Name) -> + {Name,T,NameList}; + Seq when is_record(Seq,'SEQUENCE') -> + {'SEQUENCE',Seq#'SEQUENCE'.components,NameList}; + Set when is_record(Set,'SET') -> + {'SET',Set#'SET'.components,NameList}; + #'ObjectClassFieldType'{type=T} -> + {'ASN1_OPEN_TYPE',T,NameList} + end, + {asn1ct_gen:unify_if_string(InnerType),NewType,NewNameList}. + + + +check_ptype(S,Type,Ts) when is_record(Ts,type) -> + %Tag = Ts#type.tag, + %Constr = Ts#type.constraint, + Def = Ts#type.def, + NewDef= + case Def of + Seq when is_record(Seq,'SEQUENCE') -> + Components = expand_components(S,Seq#'SEQUENCE'.components), + #newt{type=Seq#'SEQUENCE'{pname=get_datastr_name(Type), + components = Components}}; + Set when is_record(Set,'SET') -> + Components = expand_components(S,Set#'SET'.components), + #newt{type=Set#'SET'{pname=get_datastr_name(Type), + components = Components}}; + _Other -> + #newt{} + end, + Ts2 = case NewDef of + #newt{type=unchanged} -> + Ts; + #newt{type=TDef}-> + Ts#type{def=TDef} + end, + Ts2; +%parameterized class +check_ptype(_S,_PTDef,Ts) when is_record(Ts,objectclass) -> + throw({asn1_param_class,Ts}). + + +% check_type(S,Type,ObjSpec={{objectclassname,_},_}) -> +% check_class(S,ObjSpec); +check_type(_S,Type,Ts) when is_record(Type,typedef), + (Type#typedef.checked==true) -> + Ts; +check_type(_S,Type,Ts) when is_record(Type,typedef), + (Type#typedef.checked==idle) -> % the check is going on + Ts; +check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> + {Def,Tag,Constr,IsInlined} = + case match_parameters(S,Ts#type.def,S#state.parameters) of + #type{tag=PTag,constraint=_Ctmp,def=Dtmp,inlined=Inl} -> + {Dtmp,merge_tags(Ts#type.tag,PTag),Ts#type.constraint,Inl}; + #typedef{typespec=#type{tag=PTag,def=Dtmp,inlined=Inl}} -> + {Dtmp,merge_tags(Ts#type.tag,PTag),Ts#type.constraint,Inl}; + Dtmp -> + {Dtmp,Ts#type.tag,Ts#type.constraint,Ts#type.inlined} + end, + TempNewDef = #newt{type=Def,tag=Tag,constraint=Constr, + inlined=IsInlined}, + 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 is_record(Ext,'Externaltypereference') -> + {RefMod,RefTypeDef,IsParamDef} = + case get_referenced_type(S,Ext) of + {undefined,TmpTDef} -> %% A parameter + {get(top_module),TmpTDef,true}; + {TmpRefMod,TmpRefDef} -> + {TmpRefMod,TmpRefDef,false} + end, + case is_class(S,RefTypeDef) of + true -> throw({asn1_class,RefTypeDef}); + _ -> ok + end, + Ct = TestFun(Ext), + {RefType,ExtRef} = + case RefTypeDef#typedef.checked of + true -> + {RefTypeDef#typedef.typespec,Ext}; + _ -> + %% Put as idle to prevent recursive loops + NewRefTypeDef1 = RefTypeDef#typedef{checked=idle}, + asn1_db:dbput(RefMod, + get_datastr_name(NewRefTypeDef1), + NewRefTypeDef1), + NewS = S#state{mname=RefMod, + module=load_asn1_module(S,RefMod), + tname=get_datastr_name(NewRefTypeDef1), + type=NewRefTypeDef1, + abscomppath=[],recordtopname=[]}, + RefType1 = + check_type(NewS,RefTypeDef,RefTypeDef#typedef.typespec), + %% update the type and mark as checked + NewRefTypeDef2 = + RefTypeDef#typedef{checked=true,typespec = RefType1}, + TmpName = get_datastr_name(NewRefTypeDef2), + asn1_db:dbput(RefMod, + TmpName, + NewRefTypeDef2), + case {RefMod == get(top_module),IsParamDef} of + {true,true} -> + Key = {TmpName, + type, + NewRefTypeDef2}, + asn1ct_gen:insert_once(parameterized_objects, + Key); + _ -> ok + end, + {RefType1,#'Externaltypereference'{module=RefMod, + type=TmpName}} + 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 + NewS2 = S#state{type=#typedef{typespec=RefType}}, + NewC = + constraint_merge(NewS2, + check_constraints(NewS2,Constr)++ + RefType#type.constraint), + TempNewDef#newt{ + type = RefType#type.def, + tag = merge_tags(Ct,RefType#type.tag), + constraint = NewC}; + _ -> + %% Here we only expand the tags and keep the ext ref. + + NewExt = ExtRef#'Externaltypereference'{module=merged_mod(S,RefMod,Ext)}, + TempNewDef#newt{ + type = check_externaltypereference(S,NewExt), + 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))}; + 'REAL' -> + check_real(S,Constr), + TempNewDef#newt{tag=merge_tags(Tag,?TAG_PRIMITIVE(?N_REAL))}; + {'BIT STRING',NamedNumberList} -> + NewL = check_bitstring(S,NamedNumberList,Constr), +%% erlang:display({asn1ct_check,NamedNumberList,NewL}), + 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' -> + put_once(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)), + constraint=[]}; + 'EMBEDDED PDV' -> + put_once(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))}; + TString when TString =:= 'TeletexString'; + TString =:= 'T61String' -> + 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))}; + 'UTF8String' -> + check_restrictedstring(S,Def,Constr), + TempNewDef#newt{tag= + merge_tags(Tag,?TAG_PRIMITIVE(?N_UTF8String))}; + 'RELATIVE-OID' -> + check_relative_oid(S,Constr), + TempNewDef#newt{tag= + merge_tags(Tag,?TAG_PRIMITIVE(?'N_RELATIVE-OID'))}; + 'CHARACTER STRING' -> + put_once(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 is_record(Seq,'SEQUENCE') -> + RecordName = + case TopName of + [] -> + [get_datastr_name(Type)]; +% [Type#typedef.name]; + _ -> + TopName + end, + {TableCInf,Components} = + check_sequence(S#state{recordtopname= + RecordName}, + Type,Seq#'SEQUENCE'.components), + TempNewDef#newt{type=Seq#'SEQUENCE'{tablecinf=tablecinf_choose(Seq,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 is_record(Set,'SET') -> + RecordName= + case TopName of + [] -> + [get_datastr_name(Type)]; +% [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_choose(Set,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. + {_RefMod,Ptypedef} = get_referenced_type(S,Ptype), + notify_if_not_ptype(S,Ptypedef), + NewParaList = + [match_parameters(S,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}; + + OCFT=#'ObjectClassFieldType'{classname=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#'ObjectClassFieldType'{class=ClassSpec},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}; + + {'TypeFromObject',{object,Object},TypeField} -> + CheckedT = get_type_from_object(S,Object,TypeField), + TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag), + type=CheckedT#type.def}; + + {valueset,Vtype} -> + TempNewDef#newt{type={valueset,check_type(S,Type,Vtype)}}; + {'SelectionType',Name,T} -> + CheckedT = check_selectiontype(S,Name,T), + TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag), + type=CheckedT#type.def}; + 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)}; +check_type(_S,Type,Ts) -> + exit({error,{asn1,internal_error,Type,Ts}}). + +%% tablecinf_choose. A SEQUENCE or SET may be inserted in another +%% SEQUENCE or SET by the COMPONENTS OF directive. If this inserted +%% type is a referenced type that already has been checked it already +%% has its tableconstraint information. Furthermore this information +%% may be lost in the analysis in the new environment. Assume this +%% SEQUENCE/SET has a simpletable constraint and a componentrelation +%% constraint whose atlist points to the outermost component of its +%% "standalone" definition. This will cause the analysis to fail as it +%% will not find the right atlist component in the outermost +%% environment in the new inlined environment. +tablecinf_choose(SetOrSeq,false) -> + tablecinf_choose(SetOrSeq); +tablecinf_choose(_, TableCInf) -> + TableCInf. +tablecinf_choose(#'SET'{tablecinf=TCI}) -> + TCI; +tablecinf_choose(#'SEQUENCE'{tablecinf=TCI}) -> + TCI. + +get_innertag(_S,#'ObjectClassFieldType'{type=Type}) -> + case Type of +% #type{tag=Tag} -> Tag; +% {fixedtypevaluefield,_,#type{tag=[]}=T} -> get_taglist(S,T); + {fixedtypevaluefield,_,#type{tag=Tag}} -> Tag; + {TypeFieldName,_} when is_atom(TypeFieldName) -> []; + _ -> [] + end. + +get_type_from_object(S,Object,TypeField) + when is_record(Object,'Externaltypereference'); + is_record(Object,'Externalvaluereference') -> + {_,ObjectDef} = get_referenced_type(S,Object), + ObjSpec = check_object(S,ObjectDef,ObjectDef#typedef.typespec), + get_fieldname_element(S,ObjectDef#typedef{typespec=ObjSpec},TypeField). + +is_class(_S,#classdef{}) -> + true; +is_class(S,#typedef{typespec=#type{def=Eref}}) + when is_record(Eref,'Externaltypereference')-> + is_class(S,Eref); +is_class(S,Eref) when is_record(Eref,'Externaltypereference')-> + {_,NextDef} = get_referenced_type(S,Eref), + is_class(S,NextDef); +is_class(_,_) -> + false. + +get_class_def(_S,CD=#classdef{}) -> + CD; +get_class_def(S,#typedef{typespec=#type{def=Eref}}) + when is_record(Eref,'Externaltypereference') -> + {_,NextDef} = get_referenced_type(S,Eref), + get_class_def(S,NextDef). + +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. + + +merged_mod(S,RefMod,Ext) -> + case S of + #state{inputmodules=[]} -> + RefMod; + _ -> + Ext#'Externaltypereference'.module + end. + +%% maybe_open_type/2 -> #ObjectClassFieldType with updated fieldname and +%% 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'. +%% +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 last_fieldname(FieldRefList) of + {valuefieldreference,_} -> + OCFT#'ObjectClassFieldType'{fieldname=FieldNames, + type=Type}; + {typefieldreference,_} -> + case {catch get_unique_fieldname(S,#classdef{typespec=ClassSpec}), + asn1ct_gen:get_constraint(Constr,componentrelation)}of + {Tuple,_} when is_tuple(Tuple), size(Tuple) =:= 3 -> + OCFT#'ObjectClassFieldType'{fieldname=FieldNames, + type='ASN1_OPEN_TYPE'}; + {_,no} -> + OCFT#'ObjectClassFieldType'{fieldname=FieldNames, + type='ASN1_OPEN_TYPE'}; + _ -> + OCFT#'ObjectClassFieldType'{fieldname=FieldNames, + type=Type} + end + end. + +last_fieldname(FieldRefList) when is_list(FieldRefList) -> + lists:last(FieldRefList); +last_fieldname({FieldName,_}) when is_atom(FieldName) -> + [A|_] = atom_to_list(FieldName), + case is_lowercase(A) of + true -> + {valuefieldreference,FieldName}; + _ -> + {typefieldreference,FieldName} + 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 is_record(Ref,'Externaltypereference') -> + case get_referenced_type(S,Ref) of + {_,#classdef{}} -> + throw(pobjectsetdef); + {_,#typedef{}} -> + throw(pvalueset) + end; + T when is_record(T,type) -> % this must be a value set + throw(pvalueset) + end; +notify_if_not_ptype(_S,PT=#ptypedef{}) -> + %% this may be a parameterized CLASS, in that case throw an + %% asn1_class exception + case PT#ptypedef.typespec of + #objectclass{} -> throw({asn1_class,PT}); + _ -> ok + end; +notify_if_not_ptype(S,#pobjectsetdef{class=Cl}) -> + case Cl of + #'Externaltypereference'{} -> + case get_referenced_type(S,Cl) of + {_,#classdef{}} -> + throw(pobjectsetdef); + {_,#typedef{}} -> + throw(pvalueset) + end; + _ -> + throw(pobjectsetdef) + end; +notify_if_not_ptype(_S,PT) -> + throw({error,{"supposed to be a parameterized type",PT}}). +% fix me +instantiate_ptype(S,Ptypedef,ParaList) -> + #ptypedef{args=Args,typespec=Type} = Ptypedef, + NewType = check_ptype(S,Ptypedef,Type#type{inlined=yes}), + MatchedArgs = match_args(S,Args, ParaList, []), + OldArgs = S#state.parameters, + NewS = S#state{type=NewType,parameters=MatchedArgs++OldArgs,abscomppath=[]}, +%% NewS = S#state{type=NewType,parameters=MatchedArgs,abscomppath=[]}, + check_type(NewS, Ptypedef#ptypedef{typespec=NewType}, NewType). + +get_datastr_name(#typedef{name=N}) -> + N; +get_datastr_name(#classdef{name=N}) -> + N; +get_datastr_name(#valuedef{name=N}) -> + N; +get_datastr_name(#ptypedef{name=N}) -> + N; +get_datastr_name(#pvaluedef{name=N}) -> + N; +get_datastr_name(#pvaluesetdef{name=N}) -> + N; +get_datastr_name(#pobjectdef{name=N}) -> + N; +get_datastr_name(#pobjectsetdef{name=N}) -> + N. + + +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(S,FormalArgs, ActualArgs, Accumulator) -> Result +%% S = #state{} +%% FormalArgs = [term()] | [{Governor,Parameter}] +%% ActualArgs = [term()] +%% Accumulator = [term()] +%% Result = [{term(),term()}] | throw() +%% Governor = #type{} | Reference | 'TYPE-IDENTIFIER' | 'ABSTRACT-SYNTAX' +%% Parameter = Reference | {Governor,Reference} +%% Reference = #'Externaltypereference'{} | #'Externalvaluerference'{} +%% +%% Different categories of parameters and governors (Dubuisson p.382) +%% +----------------+-------------------------------+----------------------+ +%% |Governor is | Parameter name style | Parameter is | +%% +----------------+-------------------------------+----------------------+ +%% | absent | begins with uppercase,(bu) | a type | +%% | | | | +%% | a type | begins with a lowercase,(bl)| a value | +%% | | | | +%% | a type | begins with an uppercase | a value set | +%% | | | | +%% | absent | entirely in uppercase, (eu) | a class (or type) | +%% | | | | +%% | a class name | begins with a lowercase | an object | +%% | | | | +%% | a class name | begins with an uppercase | an object set | +%% +----------------+-------------------------------+----------------------+ +%% +%% Matches each of the formal parameters to corresponding actual +%% parameter, and changes format of the actual parameter according to +%% above table if necessary. +match_args(S,FA = [FormArg|Ft], AA = [ActArg|At], Acc) -> + OldParams = S#state.parameters, + case categorize_arg(S,FormArg,ActArg) of + [CategorizedArg] -> + match_args(S#state{parameters= + [{FormArg,CategorizedArg}|OldParams]}, + Ft, At, [{FormArg,CategorizedArg}|Acc]); + CategorizedArgs -> + match_args(S#state{parameters=CategorizedArgs++OldParams}, + FA, CategorizedArgs ++ AA, Acc) + end; +match_args(_S,[], [], Acc) -> + lists:reverse(Acc); +match_args(_,_, _, _) -> + throw({error,{asn1,{wrong_number_of_arguments}}}). + +%%%%%%%%%%%%%%%%% +%% categorize_arg(S,FormalArg,ActualArg) -> {FormalArg,CatgorizedActualArg} +%% +categorize_arg(S,{Governor,Param},ActArg) -> + case {governor_category(S,Governor),parameter_name_style(Param,ActArg)} of +%% {absent,beginning_uppercase} -> %% a type +%% categorize(S,type,ActArg); + {type,beginning_lowercase} -> %% a value + categorize(S,value,Governor,ActArg); + {type,beginning_uppercase} -> %% a value set + categorize(S,value_set,ActArg); +%% {absent,entirely_uppercase} -> %% a class +%% categorize(S,class,ActArg); + {{class,ClassRef},beginning_lowercase} -> + categorize(S,object,ActArg,ClassRef); + {{class,ClassRef},beginning_uppercase} -> + categorize(S,object_set,ActArg,ClassRef); + _ -> + [ActArg] + end; +categorize_arg(S,FormalArg,ActualArg) -> + %% governor is absent => a type or a class + case FormalArg of + #'Externaltypereference'{type=Name} -> + case is_class_name(Name) of + true -> + categorize(S,class,ActualArg); + _ -> + categorize(S,type,ActualArg) + end; + FA -> + throw({error,{unexpected_formal_argument,FA}}) + end. + +governor_category(S,#type{def=Eref}) + when is_record(Eref,'Externaltypereference') -> + governor_category(S,Eref); +governor_category(_S,#type{}) -> + type; +governor_category(S,Ref) when is_record(Ref,'Externaltypereference') -> + case is_class(S,Ref) of + true -> + {class,Ref}; + _ -> + type + end; +governor_category(_,Class) + when Class == 'TYPE-IDENTIFIER'; Class == 'ABSTRACT-SYNTAX' -> + class. +%% governor_category(_,_) -> +%% absent. + +%% parameter_name_style(Param,Data) -> Result +%% gets the Parameter and the name of the Data and if it exists tells +%% whether it begins with a lowercase letter or is partly or entirely +%% spelled with uppercase letters. Otherwise returns undefined +%% +parameter_name_style(_,#'Externaltypereference'{type=Name}) -> + name_category(Name); +parameter_name_style(_,#'Externalvaluereference'{value=Name}) -> + name_category(Name); +parameter_name_style(_,{valueset,_}) -> + %% It is a object set or value set + beginning_uppercase; +parameter_name_style(#'Externalvaluereference'{},_) -> + beginning_lowercase; +parameter_name_style(#'Externaltypereference'{type=Name},_) -> + name_category(Name); +parameter_name_style(_,_) -> + undefined. + +name_category(Atom) when is_atom(Atom) -> + name_category(atom_to_list(Atom)); +name_category([H|T]) -> + case is_lowercase(H) of + true -> + beginning_lowercase; + _ -> + case is_class_name(T) of + true -> + entirely_uppercase; + _ -> + beginning_uppercase + end + end; +name_category(_) -> + undefined. + +is_lowercase(X) when X >= $A,X =< $W -> + false; +is_lowercase(_) -> + true. + +is_class_name(Name) when is_atom(Name) -> + is_class_name(atom_to_list(Name)); +is_class_name(Name) -> + case [X||X <- Name, X >= $a,X =< $w] of + [] -> + true; + _ -> + false + end. + +%% categorize(S,Category,Parameter) -> CategorizedParameter +%% If Parameter has an abstract syntax of another category than +%% Category, transform it to a known syntax. +categorize(_S,type,{object,_,Type}) -> + %% One example of this case is an object with a parameterized type + %% having a locally defined type as parameter. + Def = fun(D = #type{}) -> + #typedef{name = new_reference_name("type_argument"), + typespec = D#type{inlined=yes}}; + ({setting,_,Eref}) when is_record(Eref,'Externaltypereference') -> + Eref; + (D) -> + D + end, + [Def(X)||X<-Type]; +categorize(_S,type,Def) when is_record(Def,type) -> + [#typedef{name = new_reference_name("type_argument"), + typespec = Def#type{inlined=yes}}]; +categorize(_,_,Def) -> + [Def]. +categorize(S,object_set,Def,ClassRef) -> + %% XXXXXXXXXX + case Def of + {'Externaltypereference',undefined,'MSAccessProtocol','AllOperations'} -> + ok; + _ -> + ok + end, + NewObjSetSpec = + check_object(S,Def,#'ObjectSet'{class = ClassRef, + set = parse_objectset(Def)}), + Name = new_reference_name("object_set_argument"), + %% XXXXXXXXXX + case Name of + internal_object_set_argument_78 -> + ok; + internal_object_set_argument_77 -> + ok; + _ -> + ok + end, + [save_object_set_instance(S,Name,NewObjSetSpec)]; +categorize(_S,object,Def,_ClassRef) -> + %% should be handled + [Def]; +categorize(_S,value,_Type,Value) when is_record(Value,valuedef) -> + [Value]; +categorize(S,value,Type,Value) -> +%% [check_value(S,#valuedef{type=Type,value=Value})]. + [#valuedef{type=Type,value=Value,module=S#state.mname}]. + + +parse_objectset({valueset,T=#type{}}) -> + [T]; +parse_objectset({valueset,Set}) -> + Set; +parse_objectset(#type{def=Ref}) when is_record(Ref,'Externaltypereference') -> + Ref; +parse_objectset(Set) -> + %% extend this later + Set. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% check_constraints/2 +%% +check_constraints(S,C) when is_list(C) -> + check_constraints(S, C, []); +check_constraints(S,C) when is_record(C,constraint) -> + check_constraints(S, C#constraint.c, []). + +resolv_tuple_or_list(S,List) when is_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) -> + Id = match_parameters(S,Val, S#state.parameters), + resolv_value1(S,Id). + +resolv_value1(S, ERef = #'Externalvaluereference'{value=Name}) -> + case catch resolve_namednumber(S,S#state.type,Name) of + V when is_integer(V) -> V; + _ -> + case get_referenced_type(S,ERef) of + {Err,_Reason} when Err == error; Err == 'EXIT' -> + throw({error,{asn1,{undefined_type_or_value, + Name}}}); + {_M,VDef} -> + resolv_value1(S,VDef) + end + end; +resolv_value1(S,{gt,V}) -> + case V of + Int when is_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 is_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' + resolve_value_from_object(S,Object,FieldName); +resolv_value1(_,#valuedef{checked=true,value=V}) -> + V; +resolv_value1(S,#valuedef{type=_T, + value={'ValueFromObject',{object,Object}, + [{valuefieldreference, + FieldName}]}}) -> + resolve_value_from_object(S,Object,FieldName); +resolv_value1(S,VDef = #valuedef{}) -> + #valuedef{value=Val} = check_value(S,VDef), + Val; +resolv_value1(_,V) -> + V. +resolve_value_from_object(S,Object,FieldName) -> + {_,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. + + + +resolve_namednumber(S,#typedef{typespec=Type},Name) -> + case Type#type.def of + {'ENUMERATED',NameList} -> + NamedNumberList=check_enumerated(S,NameList,Type#type.constraint), + N = normalize_enumerated(Name,NamedNumberList), + {value,{_,V}} = lists:keysearch(N,1,NamedNumberList), + V; + {'INTEGER',NameList} -> + NamedNumberList = check_enumerated(S,NameList,Type#type.constraint), + {value,{_,V}} = lists:keysearch(Name,1,NamedNumberList), + V; + _ -> + not_enumerated + end. + +check_constraints(S,[{'ContainedSubtype',Type} | Rest], Acc) -> + {RefMod,CTDef} = get_referenced_type(S,Type#type.def), + NewS = S#state{module=load_asn1_module(S,RefMod),mname=RefMod, + type=CTDef,tname=get_datastr_name(CTDef)}, + CType = check_type(NewS,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) -> + constraint_merge(S,Acc). + + +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 is_record(Ext,'Externaltypereference') -> + check_externaltypereference(S,Ext); + + +check_constraint(S,{'SizeConstraint',{Lb,Ub}}) + when is_list(Lb);is_tuple(Lb),size(Lb)==2 -> + NewLb = range_check(resolv_tuple_or_list(S,Lb)), + NewUb = range_check(resolv_tuple_or_list(S,Ub)), + {'SizeConstraint',{NewLb,NewUb}}; +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 is_list(L) -> + F = fun(A) -> resolv_value(S,A) end, + {'SingleValue',lists:map(F,L)}; + +check_constraint(S,{'SingleValue', V}) when is_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)}}; +%% In case of a constraint with extension marks like (1..Ub,...) +check_constraint(S,{VR={'ValueRange', {_Lb, _Ub}},Rest}) -> + {check_constraint(S,VR),Rest}; +check_constraint(_S,{'PermittedAlphabet',PA}) -> + {'PermittedAlphabet',permitted_alphabet_cnstr(PA)}; + +check_constraint(S,{valueset,Type}) -> + {valueset,check_type(S,S#state.tname,Type)}; + +check_constraint(_S,ST={simpletable,Type}) when is_atom(Type) -> + %% An already checked constraint + ST; +check_constraint(S,{simpletable,Type}) -> + Def = case Type of + #type{def=D} -> D; + {'SingleValue',ObjRef = #'Externalvaluereference'{}} -> + ObjRef + end, + C = match_parameters(S,Def,S#state.parameters), + case C of + #'Externaltypereference'{} -> + ERef = check_externaltypereference(S,C), + {simpletable,ERef#'Externaltypereference'.type}; + #type{def=#'Externaltypereference'{type=T}} -> + check_externaltypereference(S,C#type.def), + {simpletable,T}; + {valueset,#type{def=ERef=#'Externaltypereference'{}}} -> % this is an object set + {_,TDef} = get_referenced_type(S,ERef), + case TDef#typedef.typespec of + #'ObjectSet'{} -> + check_object(S,TDef,TDef#typedef.typespec), + {simpletable,ERef#'Externaltypereference'.type}; + Err -> + exit({error,{internal_error,Err}}) + end; + #'Externalvaluereference'{} -> + %% This is an object set with a referenced object + {_,TorVDef} = get_referenced_type(S,C), + GetObjectSet = + fun(#typedef{typespec=O}) when is_record(O,'Object') -> + #'ObjectSet'{class=O#'Object'.classname, + set={'SingleValue',C}}; + (#valuedef{type=Cl,value=O}) + when is_record(O,'Externalvaluereference'), + is_record(Cl,type) -> + %% an object might reference another object + #'ObjectSet'{class=Cl#type.def, + set={'SingleValue',O}}; + (Err) -> + exit({error,{internal_error,simpletable_constraint,Err}}) + end, + ObjSet = GetObjectSet(TorVDef), + {simpletable,check_object(S,Type,ObjSet)}; + #'ObjectSet'{} -> + io:format("ALERT: simpletable forbidden case!~n",[]), + {simpletable,check_object(S,Type,C)}; + {'ValueFromObject',{_,ORef},FieldName} -> + %% This is an ObjectFromObject + {_,Object} = get_referenced_type(S,ORef), + ChObject = check_object(S,Object, + Object#typedef.typespec), + ObjFromObj= + get_fieldname_element(S,Object#typedef{ + typespec=ChObject}, + FieldName), + {simpletable,ObjFromObj}; +%% ObjFromObj#typedef{checked=true,typespec= +%% check_object(S,ObjFromObj, +%% ObjFromObj#typedef.typespec)}}; + _ -> + check_type(S,S#state.tname,Type),%% this seems stupid. + OSName = Def#'Externaltypereference'.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(S,Objset,S#state.parameters), + ObjSetRef = + case RealObjset of + #'Externaltypereference'{} -> RealObjset; + #type{def=#'Externaltypereference'{}} -> RealObjset#type.def; + {valueset,OS = #type{def=#'Externaltypereference'{}}} -> OS#type.def + end, + Ext = check_externaltypereference(S,ObjSetRef), + {componentrelation,{objectset,Opos,Ext},Id}; + +check_constraint(S,Type) when is_record(Type,type) -> + #type{def=Def} = check_type(S,S#state.tname,Type), + Def; + +check_constraint(S,C) when is_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. + +permitted_alphabet_cnstr(T) when is_tuple(T) -> + permitted_alphabet_cnstr([T]); +permitted_alphabet_cnstr(L) when is_list(L) -> + VRexpand = fun({'ValueRange',{A,B}}) -> + {'SingleValue',expand_valuerange(A,B)}; + (Other) -> + Other + end, + L2 = lists:map(VRexpand,L), + %% first perform intersection + L3 = permitted_alphabet_intersection(L2), + [Res] = permitted_alphabet_union(L3), + Res. + +expand_valuerange([A],[A]) -> + [A]; +expand_valuerange([A],[B]) when A < B -> + [A|expand_valuerange([A+1],[B])]. + +permitted_alphabet_intersection(C) -> + permitted_alphabet_merge(C,intersection, []). + +permitted_alphabet_union(C) -> + permitted_alphabet_merge(C,union, []). + +permitted_alphabet_merge([],_,Acc) -> + lists:reverse(Acc); +permitted_alphabet_merge([{'SingleValue',L1}, + UorI, + {'SingleValue',L2}|Rest],UorI,Acc) + when is_list(L1),is_list(L2) -> + UI = ordsets:UorI([ordsets:from_list(L1),ordsets:from_list(L2)]), + permitted_alphabet_merge([{'SingleValue',UI}|Rest],UorI,Acc); +permitted_alphabet_merge([C1|Rest],UorI,Acc) -> + permitted_alphabet_merge(Rest,UorI,[C1|Acc]). + + +%% 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 is_tuple(H) -> + C; +constraint_merge(_S,[]) -> + []; +constraint_merge(S,C) -> + %% skip all extension but the last extension + C1 = filter_extensions(C), + %% perform all internal level intersections, intersections first + %% since they have precedence over unions + C2 = lists:map(fun(X)when is_list(X)->constraint_intersection(S,X); + (X) -> X end, + C1), + %% perform all internal level unions + C3 = lists:map(fun(X)when is_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 + NewCs = combine_constraints(S,CombSV,CombVR,CombSZ++RestC), + [X||X <- lists:flatten(NewCs), + X /= intersection, + X /= union]. + +%% 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 is_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 is_integer(A2)->true; + ({_,{A1,_B1}},{_,{'MAX',_B2}}) when is_integer(A1) -> true; + ({_,{A1,_B1}},{_,{A2,_B2}}) when is_integer(A1),is_integer(A2),A1<A2 -> true; + ({_,{A,B1}},{_,{A,B2}}) when B1=<B2->true; + (_,_)->false end, + % sort and remove duplicates + SortedVR = lists:sort(Fun,VR), + RemoveDup = fun([],_) ->[]; + ([H],_) -> [H]; + ([H,H|T],F) -> F([H|T],F); + ([H|T],F) -> [H|F(T,F)] + end, + + constraint_union_vr(RemoveDup(SortedVR,RemoveDup),[]). + +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,C1={'SingleValue',SV},C2={'ValueRange',VR={Lb,Ub}}) + when is_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 is_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(Val,List) -> + 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 = is_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 is_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 +%% constraints and all extensions but the last are removed. +filter_extensions([L]) when is_list(L) -> + [filter_extensions(L)]; +filter_extensions(C=[_H]) -> + C; +filter_extensions(C) when is_list(C) -> + filter_extensions(C,[], []). + +filter_extensions([],Acc,[]) -> + Acc; +filter_extensions([],Acc,[EC|ExtAcc]) -> + CwoExt = remove_extension(ExtAcc,[]), + CwoExt ++ [EC|Acc]; +filter_extensions([C={A,_E}|T],Acc,ExtAcc) when is_tuple(A) -> + filter_extensions(T,Acc,[C|ExtAcc]); +filter_extensions([C={'SizeConstraint',{A,_B}}|T],Acc,ExtAcc) + when is_list(A);is_tuple(A) -> + filter_extensions(T,Acc,[C|ExtAcc]); +filter_extensions([C={'PermittedAlphabet',{{'SingleValue',_},E}}|T],Acc,ExtAcc) + when is_tuple(E); is_list(E) -> + filter_extensions(T,Acc,[C|ExtAcc]); +filter_extensions([H|T],Acc,ExtAcc) -> + filter_extensions(T,[H|Acc],ExtAcc). + +remove_extension([],Acc) -> + Acc; +remove_extension([{'SizeConstraint',{A,_B}}|R],Acc) -> + remove_extension(R,[{'SizeConstraint',A}|Acc]); +remove_extension([{C,_E}|R],Acc) when is_tuple(C) -> + remove_extension(R,[C|Acc]); +remove_extension([{'PermittedAlphabet',{A={'SingleValue',_}, + E}}|R],Acc) + when is_tuple(E);is_list(E) -> + remove_extension(R,[{'PermittedAlphabet',A}|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 is_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 = is_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(_S,[C1={'SingleValue',SV}],[C2={'ValueRange',{_Lb,_Ub}}]) + when is_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}}) + %io:format("warning: could not analyze constraint ~p~n",[[C1,C2]]), + [C1,C2] + end; +intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2]) + when is_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}}); + %io:format("warning: could not analyze constraint ~p~n",[[C1,C2]]), + [C1,C2]; + [V] -> [{'SingleValue',V}]; + L -> [{'SingleValue',L}] + end. + + +%% Size constraint [{'SizeConstraint',1},{'SizeConstraint',{{1,64},[]}}] + +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 is_integer(Int),is_tuple(Range) -> + case Range of + {Lb,Ub} when Int >= Lb, + Int =< Ub -> + intersection_of_size(S,[C1|Rest]); + {{Lb,Ub},Ext} when is_list(Ext),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 is_integer(Int),is_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 is_integer(Int), + is_list(SV) -> + SV2=intersection_of_sv1(S,Int,SV), + intersection_of_sv(S,[SV2|Rest]); +intersection_of_sv(S,[{_,SV},{_,Int}|Rest]) when is_integer(Int), + is_list(SV) -> + SV2=intersection_of_sv1(S,Int,SV), + intersection_of_sv(S,[SV2|Rest]); +intersection_of_sv(S,[{_,SV1},{_,SV2}|Rest]) when is_list(SV1), + is_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 is_integer(Int),is_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 is_integer(Int) -> + true; +is_int_in_vr(Int,{_,{'MIN',Ub}}) when is_integer(Int),Int =< Ub -> + true; +is_int_in_vr(Int,{_,{Lb,'MAX'}}) when is_integer(Int),Int >= Lb -> + true; +is_int_in_vr(Int,{_,{Lb,Ub}}) when is_integer(Int),Int >= Lb,Int =< Ub -> + true; +is_int_in_vr(_,_) -> + false. + + +check_imported(S,Imodule,Name) -> + check_imported(S,Imodule,Name,false). +check_imported(S,Imodule,Name,IsParsed) -> + case asn1_db:dbget(Imodule,'MODULE') of + undefined when IsParsed == true -> + ErrStr = io_lib:format("Type ~s imported from non existing module ~s~n",[Name,Imodule]), + error({imported,ErrStr,S}); + undefined -> + parse_and_save(S,Imodule), + check_imported(S,Imodule,Name,true); + Im when is_record(Im,module) -> + case is_exported(Im,Name) of + false -> + ErrStr = io_lib:format("Imported type ~s not exported from module ~s~n",[Name,Imodule]), + error({imported,ErrStr,S}); + _ -> + ok + end + end, + ok. + +is_exported(Module,Name) when is_record(Module,module) -> + {exports,Exports} = Module#module.exports, + case Exports of + all -> + true; + [] -> + false; + L when is_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 -> + {NewMod,_} = get_referenced_type(S,Etref), + Etref#'Externaltypereference'{module=NewMod} + 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}; +%% case check_imported(S,Imodule,Name) of +%% ok -> +%% #'Externaltypereference'{module=Imodule,type=Name}; +%% Err -> +%% Err +%% end; + _ -> + %may be a renamed type in multi file compiling! + {M,T}=get_renamed_reference(S,Name,Emod), + NewName = asn1ct:get_name_of_def(T), + NewPos = asn1ct:get_pos_of_def(T), + #'Externaltypereference'{pos=NewPos, + module=M, + 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. + + +get_referenced_type(S,Ext) when is_record(Ext,'Externaltypereference') -> + case match_parameters(S,Ext, S#state.parameters) of + Ext -> + #'Externaltypereference'{pos=Pos,module=Emod,type=Etype} = Ext, + case S#state.mname of + Emod -> % a local reference in this module + get_referenced1(S,Emod,Etype,Pos); + _ ->% always when multi file compiling + case lists:member(Emod,S#state.inputmodules) of + true -> + get_referenced1(S,Emod,Etype,Pos); + false -> + get_referenced(S,Emod,Etype,Pos) + end + end; + ERef = #'Externaltypereference'{} -> + get_referenced_type(S,ERef); + Other -> + {undefined,Other} + end; +get_referenced_type(S=#state{mname=Emod}, + ERef=#'Externalvaluereference'{pos=P,module=Emod, + value=Eval}) -> + case match_parameters(S,ERef,S#state.parameters) of + ERef -> + get_referenced1(S,Emod,Eval,P); + OtherERef when is_record(OtherERef,'Externalvaluereference') -> + get_referenced_type(S,OtherERef); + Value -> + {Emod,Value} + end; +get_referenced_type(S,ERef=#'Externalvaluereference'{pos=Pos,module=Emod, + value=Eval}) -> + case match_parameters(S,ERef,S#state.parameters) of + ERef -> + case lists:member(Emod,S#state.inputmodules) of + true -> + get_referenced1(S,Emod,Eval,Pos); + false -> + get_referenced(S,Emod,Eval,Pos) + end; + OtherERef -> + get_referenced_type(S,OtherERef) + end; +get_referenced_type(S,#identifier{val=Name,pos=Pos}) -> + get_referenced1(S,undefined,Name,Pos); +get_referenced_type(_S,Type) -> + {undefined,Type}. + +%% 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) -> + ?dbg("get_referenced: ~p~n",[Ename]), + parse_and_save(S,Emod), + ?dbg("get_referenced,parse_and_save ~n",[]), + case asn1_db:dbget(Emod,Ename) of + undefined -> + %% May be an imported entity in module Emod or Emod may not exist + case asn1_db:dbget(Emod,'MODULE') of + undefined -> + case parse_and_save(S,Emod) of + ok -> + get_referenced(S,Emod,Ename,Pos); + _ -> + throw({error,{asn1,{module_not_found,Emod}}}) + end; + _ -> + NewS = update_state(S,Emod), + get_imported(NewS,Ename,Emod,Pos) + end; + T when is_record(T,typedef) -> + ?dbg("get_referenced T: ~p~n",[T]), + Spec = T#typedef.typespec, %% XXXX Spec may be something else than #type + case Spec of + #type{def=#typereference{}} -> + Tref = Spec#type.def, + 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 -> + ?dbg("get_referenced V: ~p~n",[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) -> + ?dbg("get_imported, Module: ~p, Name: ~p~n",[Module,Name]), + case imported(S,Name) of + {ok,Imodule} -> + parse_and_save(S,Imodule), + case asn1_db:dbget(Imodule,'MODULE') of + undefined -> + case parse_and_save(S,Imodule) of + ok -> + %% check with cover + get_referenced(S,Module,Name,Pos); + _ -> + throw({error,{asn1,{module_not_found,Imodule}}}) + end; + Im when is_record(Im,module) -> + case is_exported(Im,Name) of + false -> + throw({error, + {asn1,{not_exported,{Im,Name}}}}); + _ -> + ?dbg("get_imported, is_exported ~p, ~p~n",[Imodule,Name]), + get_referenced_type(S, + #'Externaltypereference' + {module=Imodule, + type=Name,pos=Pos}) + end + end; + _ -> + get_renamed_reference(S,Name,Module) + end. + +check_and_save(S,#'Externaltypereference'{module=M}=ERef,#typedef{checked=false}=TDef,Settings) + when S#state.mname /= M -> + %% This ERef is an imported type (or maybe a set.asn compilation) + NewS = S#state{mname=M,module=load_asn1_module(S,M), + type=TDef,tname=get_datastr_name(TDef)}, + Type=check_type(NewS,TDef,TDef#typedef.typespec),%XXX + CheckedTDef = TDef#typedef{checked=true, + typespec=Type}, + asn1_db:dbput(M,get_datastr_name(TDef),CheckedTDef), + {merged_name(S,ERef),Settings}; +check_and_save(S,#'Externaltypereference'{module=M,type=N}=Eref, + #ptypedef{name=Name,args=Params} = PTDef,Settings) -> + %% instantiate a parameterized type + %% The parameterized type should be saved as a type in the module + %% it was instantiated. + NewS = S#state{mname=M,module=load_asn1_module(S,M), + type=PTDef,tname=Name}, + {Args,RestSettings} = lists:split(length(Params),Settings), + Type = check_type(NewS,PTDef,#type{def={pt,Eref,Args}}), + ERefName = new_reference_name(N), + ERefNew = #'Externaltypereference'{type=ERefName,module=S#state.mname}, + NewTDef=#typedef{checked=true,name=ERefName, + typespec=Type}, + insert_once(S,parameterized_objects,{ERefName,type,NewTDef}), + asn1_db:dbput(S#state.mname,ERefNew#'Externaltypereference'.type, + NewTDef), + {ERefNew,RestSettings}; +check_and_save(_S,ERef,TDef,Settings) -> + %% This might be a renamed type in a set of specs, so rename the ERef + {ERef#'Externaltypereference'{type=asn1ct:get_name_of_def(TDef)},Settings}. + +save_object_set_instance(S,Name,ObjSetSpec) + when is_record(ObjSetSpec,'ObjectSet') -> + NewObjSet = #typedef{checked=true,name=Name,typespec=ObjSetSpec}, + asn1_db:dbput(S#state.mname,Name,NewObjSet), + case ObjSetSpec of + #'ObjectSet'{uniquefname={unique,undefined}} -> + ok; + _ -> + %% Should be generated iff + %% ObjSpec#'ObjectSet'.uniquefname /= {unique,undefined} + ObjSetKey = {Name,objectset,NewObjSet}, + %% asn1ct_gen:insert_once(parameterized_objects,ObjSetKey) + insert_once(S,parameterized_objects,ObjSetKey) + end, + #'Externaltypereference'{module=S#state.mname,type=Name}. + +%% load_asn1_module do not check that the module is saved. +%% If get_referenced_type is called before the module must +%% be saved. +load_asn1_module(#state{mname=M,module=Mod},M)-> + Mod; +load_asn1_module(_,M) -> + asn1_db:dbget(M,'MODULE'). + +parse_and_save(S,Module) when is_record(S,state) -> + Erule = S#state.erule, + case asn1db_member(S,Erule,Module) of + true -> + ok; + _ -> + case asn1ct:parse_and_save(Module,S) of + ok -> + save_asn1db_uptodate(S,Erule,Module); + Err -> + Err + end + end. + +asn1db_member(S,Erule,Module) -> + Asn1dbUTL = get_asn1db_uptodate(S), + lists:member({Erule,Module},Asn1dbUTL). + +save_asn1db_uptodate(S,Erule,Module) -> + Asn1dbUTL = get_asn1db_uptodate(S), + Asn1dbUTL2 = lists:keydelete(Module,2,Asn1dbUTL), + put_asn1db_uptodate([{Erule,Module}|Asn1dbUTL2]). + +get_asn1db_uptodate(S) -> + case get(asn1db_uptodate) of + undefined -> [{S#state.erule,S#state.mname}]; %initialize + L -> L + end. + +put_asn1db_uptodate(L) -> + put(asn1db_uptodate,L). + +update_state(S,undefined) -> + S; +update_state(S=#state{mname=ModuleName},ModuleName) -> + S; +update_state(S,ModuleName) -> + case lists:member(ModuleName,S#state.inputmodules) of + true -> + S; + _ -> + parse_and_save(S,ModuleName), + case asn1_db:dbget(ModuleName,'MODULE') of + RefedMod when is_record(RefedMod,module) -> + S#state{mname=ModuleName,module=RefedMod}; + _ -> throw({error,{asn1,{module_does_not_exist,ModuleName}}}) + end + end. + + +get_renamed_reference(S,Name,Module) -> + case renamed_reference(S,Name,Module) of + undefined -> + throw({error,{asn1,{undefined_type,Name}}}); + NewTypeName when NewTypeName =/= Name -> + get_referenced1(S,Module,NewTypeName,undefined) + end. +renamed_reference(S,#'Externaltypereference'{type=Name,module=Module}) -> + case renamed_reference(S,Name,Module) of + undefined -> + Name; + Other -> + Other + 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 -> undefined; + _ -> + case ets:match(renamed_defs,{'$1',Name,Module}) of + [] -> + case ets:info(original_imports) of + undefined -> + undefined; + _ -> + case ets:match(original_imports,{Module,'$1'}) of + [] -> + undefined; + [[ImportsList]] -> + case get_importmoduleoftype(ImportsList,Name) of + undefined -> + undefined; + NextMod -> + renamed_reference(S,Name,NextMod) + end + end + end; + [[NewTypeName]] -> + NewTypeName + 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(_S,Name,[]) -> + Name; + +match_parameters(_S,#'Externaltypereference'{type=Name},[{#'Externaltypereference'{type=Name},NewName}|_T]) -> + NewName; +match_parameters(_S,#'Externaltypereference'{type=Name},[{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> + NewName; +match_parameters(_S,#'Externalvaluereference'{value=Name},[{#'Externalvaluereference'{value=Name},NewName}|_T]) -> + NewName; +match_parameters(_S,#'Externalvaluereference'{value=Name},[{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) -> + NewName; +match_parameters(_S,#type{def=#'Externaltypereference'{module=M,type=Name}}, + [{#'Externaltypereference'{module=M,type=Name},Type}]) -> + Type; +match_parameters(_S,{valueset,#type{def=#'Externaltypereference'{type=Name}}}, + [{{_,#'Externaltypereference'{type=Name}},{valueset,#type{def=NewName}}}|_T]) -> + NewName; +match_parameters(_S,{valueset,#type{def=#'Externaltypereference'{type=Name}}}, + [{{_,#'Externaltypereference'{type=Name}}, + NewName=#type{def=#'Externaltypereference'{}}}|_T]) -> + NewName#type.def; +match_parameters(_S,{valueset,#type{def=#'Externaltypereference'{type=Name}}}, + [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> + NewName; +%% When a parameter is a parameterized element it has to be +%% instantiated now! +match_parameters(S,{valueset,T=#type{def={pt,_,_Args}}},_Parameters) -> + case catch check_type(S,#typedef{name=S#state.tname,typespec=T},T) of + pobjectsetdef -> + + {_,ObjRef,_Params} = T#type.def, + {_,ObjDef}=get_referenced_type(S,ObjRef), + %%ObjDef is a pvaluesetdef where the type field holds the class + ClassRef = + case ObjDef of + #pvaluesetdef{type=TDef} -> + TDef#type.def; + #pobjectsetdef{class=ClRef} -> ClRef + end, + %% The reference may not have the home module of the class + {HomeMod,_} = get_referenced_type(S,ClassRef), + RightClassRef = + ClassRef#'Externaltypereference'{module=HomeMod}, + + ObjectSet = #'ObjectSet'{class=RightClassRef,set=T}, + ObjSpec = check_object(S,#typedef{typespec=ObjectSet},ObjectSet), + Name = list_to_atom(asn1ct_gen:list2name([get_datastr_name(ObjDef)|S#state.recordtopname])), + save_object_set_instance(S,Name,ObjSpec); + pvaluesetdef -> error({pvaluesetdef,"parameterized valueset",S}); + {error,_Reason} -> error({type,"error in parameter",S}); + Ts when is_record(Ts,type) -> Ts#type.def + end; +%% same as previous, only depends on order of parsing +match_parameters(S,{valueset,{pos,{objectset,_,POSref},Args}},Parameters) -> + match_parameters(S,{valueset,#type{def={pt,POSref,Args}}},Parameters); +match_parameters(S,Name, [_H|T]) -> + %%io:format("match_parameters(~p,~p)~n",[Name,[H|T]]), + match_parameters(S,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) -> + []; +check_integer(S,NamedNumberList,_C) -> + case [X||X<-NamedNumberList,is_tuple(X),size(X)=:=2] of + NamedNumberList -> + %% An already checked integer with NamedNumberList + NamedNumberList; + _ -> + case check_unique(NamedNumberList,2) of + [] -> + check_int(S,NamedNumberList,[]); + L when is_list(L) -> + error({type,{duplicates,L},S}), + unchanged + end + end. + + +check_int(S,[{'NamedNumber',Id,Num}|T],Acc) when is_integer(Num) -> + check_int(S,T,[{Id,Num}|Acc]); +check_int(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) -> + Val = dbget_ex(S,S#state.mname,Name), + check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); +check_int(_S,[],Acc) -> + lists:keysort(2,Acc). + +check_real(_S,_Constr) -> + ok. + +check_bitstring(_S,[],_Constr) -> + []; +check_bitstring(S,NamedNumberList,_Constr) -> + case check_unique(NamedNumberList,2) of + [] -> + check_bitstr(S,NamedNumberList,[]); + L when is_list(L) -> + error({type,{duplicates,L},S}), + unchanged + end. + +check_bitstr(S,[{'NamedNumber',Id,Num}|T],Acc)when is_integer(Num) -> + check_bitstr(S,T,[{Id,Num}|Acc]); +check_bitstr(S,[{'NamedNumber',Id,Name}|T],Acc) when is_atom(Name) -> +%%check_bitstr(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) -> +%% io:format("asn1ct_check:check_bitstr/3 hej hop ~w~n",[Name]), + Val = dbget_ex(S,S#state.mname,Name), +%% io:format("asn1ct_check:check_bitstr/3: ~w~n",[Val]), + check_bitstr(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); +check_bitstr(S,[],Acc) -> + case check_unique(Acc,2) of + [] -> + lists:keysort(2,Acc); + L when is_list(L) -> + error({type,{duplicate_values,L},S}), + unchanged + end; +%% When a BIT STRING already is checked, for instance a COMPONENTS OF S +%% where S is a sequence that has a component that is a checked BS, the +%% NamedNumber list is a list of {atom(),integer()} elements. +check_bitstr(S,[El={Id,Num}|Rest],Acc) when is_atom(Id),is_integer(Num) -> + check_bitstr(S,Rest,[El|Acc]). + + +%% Check 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; + {_,#classdef{typespec=NextEref}} + when is_record(NextEref,'Externaltypereference') -> + check_type_identifier(S,NextEref); + {_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} -> + check_type_identifier(S,(TD#typedef.typespec)#type.def); + Err -> + error({type,{"object set in type INSTANCE OF " + "not of class TYPE-IDENTIFIER",Eref,Err},S}) + 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), + instance_of_decl(S#state.mname); +%% put(instance_of,{generate,S#state.mname}); + _ -> + instance_of_decl(S#state.mname), + 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=[{valuefieldreference,id}], + fieldname={id,[]}, + type={fixedtypevaluefield,id, + #type{def='OBJECT IDENTIFIER'}}}, + Typefield = + #'ObjectClassFieldType'{classname=TypeIdentifierRef, + class=[], +%% fieldname=[{typefieldreference,'Type'}], + 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 is_atom(Name), is_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,Root) when is_integer(Num) -> + check_enum(S,T,[{Id,Num}|Acc1],Acc2,Root); +check_enum(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc1,Acc2,Root) -> + Val = dbget_ex(S,S#state.mname,Name), + check_enum(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc1,Acc2,Root); +check_enum(S,['EXTENSIONMARK'|T],Acc1,Acc2,_Root) -> + NewAcc2 = lists:keysort(2,Acc1), + NewList = enum_number(lists:reverse(Acc2),NewAcc2,0,[],[]), + { NewList, check_enum(S,T,[],[],enum_counts(NewList))}; +check_enum(S,[Id|T],Acc1,Acc2,Root) when is_atom(Id) -> + check_enum(S,T,Acc1,[Id|Acc2],Root); +check_enum(_S,[],Acc1,Acc2,Root) -> + NewAcc2 = lists:keysort(2,Acc1), + enum_number(lists:reverse(Acc2),NewAcc2,0,[],Root). + + +% assign numbers to identifiers , numbers from 0 ... but must not +% be the same as already assigned to NamedNumbers +enum_number(Identifiers,NamedNumbers,Cnt,Acc,[]) -> + enum_number(Identifiers,NamedNumbers,Cnt,Acc); +enum_number(Identifiers,NamedNumbers,_Cnt,Acc,CountL) -> + enum_extnumber(Identifiers,NamedNumbers,Acc,CountL). + +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:append([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]). + +enum_extnumber(Identifiers,NamedNumbers,Acc,[C]) -> + check_add_enum_numbers(NamedNumbers,[C]), + enum_number(Identifiers,NamedNumbers,C,Acc); +enum_extnumber([H|T],[{Id,Num}|T2],Acc,[C|Counts]) when Num > C -> + enum_extnumber(T,[{Id,Num}|T2],[{H,C}|Acc],Counts); +enum_extnumber([],L2,Acc,Cnt) -> + check_add_enum_numbers(L2, Cnt), + lists:concat([lists:reverse(Acc),L2]); +enum_extnumber(_Identifiers,[{Id,Num}|_T2],_Acc,[C|_]) when Num < C -> +%% enum_extnumber(Identifiers,T2,[{Id,Num}|Acc],Counts); + exit({error,{asn1,"AdditionalEnumeration element with same number as root element",{Id,Num}}}); +enum_extnumber(Identifiers,[{Id,Num}|T2],Acc,[_C|Counts]) -> % Num =:= C + enum_extnumber(Identifiers,T2,[{Id,Num}|Acc],Counts); +enum_extnumber([H|T],[],Acc,[C|Counts]) -> + enum_extnumber(T,[],[{H,C}|Acc],Counts). + +enum_counts([]) -> + [0]; +enum_counts(L) -> + Used=[I||{_,I}<-L], + AddEnumLb = lists:max(Used) + 1, + lists:foldl(fun(El,AccIn)->lists:delete(El,AccIn) end, + lists:seq(0,AddEnumLb), + Used). +check_add_enum_numbers(L, Cnt) -> + Max = lists:max(Cnt), + Fun = fun({_,N}=El) when N < Max -> + case lists:member(N,Cnt) of + false -> + exit({error,{asn1,"AdditionalEnumeration element with same number as root element",El}}); + _ -> + ok + end; + (_) -> + ok + end, + lists:foreach(Fun,L). + + +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 ,is_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 is_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; + Ret = {Root1,NewE,Root2} -> + TagComps = Root1 ++ [Comp#'ComponentType'{prop='OPTIONAL'}|| Comp <- NewE]++Root2, + %% This is not correct handling if Extension + %% contains ExtensionAdditionGroups + 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 + {CRelInf,NewComps2} = componentrelation_leadingattr(S,NewComps), + + %% 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), + + {CRelInf,CompListWithTblInf}; + Dupl -> + throw({error,{asn1,{duplicate_components,Dupl}}}) + end. + +expand_components(S, [{'COMPONENTS OF',Type}|T]) -> + CompList = expand_components2(S,get_referenced_type(S,Type#type.def)), + expand_components(S,CompList) ++ expand_components(S,T); +expand_components(S,[H|T]) -> + [H|expand_components(S,T)]; +expand_components(_,[]) -> + []. +expand_components2(_S,{_,#typedef{typespec=#type{def=Seq}}}) + when is_record(Seq,'SEQUENCE') -> + case Seq#'SEQUENCE'.components of + {R1,_Ext,R2} -> R1 ++ R2; + {Root,_Ext} -> Root; + Root -> Root + end; +expand_components2(_S,{_,#typedef{typespec=#type{def=Set}}}) + when is_record(Set,'SET') -> + case Set#'SET'.components of + {R1,_Ext,R2} -> R1 ++ R2; + {Root,_Ext} -> Root; + Root -> Root + end; +expand_components2(_S,{_,#typedef{typespec=RefType=#type{def=#'Externaltypereference'{}}}}) -> + [{'COMPONENTS OF',RefType}]; +expand_components2(S,{_,PT={pt,_,_}}) -> + PTType = check_type(S,PT,#type{def=PT}), + expand_components2(S,{dummy,#typedef{typespec=PTType}}); +expand_components2(S,{_,OCFT = #'ObjectClassFieldType'{}}) -> + UncheckedType = #type{def=OCFT}, + Type = check_type(S,#typedef{typespec=UncheckedType},UncheckedType), + expand_components2(S,{undefined,oCFT_def(S,Type)}); +expand_components2(S,{_,ERef}) when is_record(ERef,'Externaltypereference') -> + expand_components2(S,get_referenced_type(S,ERef)); +expand_components2(_S,Err) -> + throw({error,{asn1,{illegal_COMPONENTS_OF,Err}}}). + + +check_unique_sequence_tags(S,[#'ComponentType'{prop=mandatory}|Rest]) -> + check_unique_sequence_tags(S,Rest); +check_unique_sequence_tags(S,[C|Rest]) when is_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 is_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 is_record(Component,type) -> + check_type(S,Type,Component). + +check_set(S,Type,Components) -> + {TableCInf,NewComponents} = check_sequence(S,Type,Components), + check_distinct_tags(NewComponents,[]), + case {lists:member(der,S#state.options),S#state.erule} of + {true,_} -> + {Sorted,SortedComponents} = sort_components(der,S,NewComponents), + {Sorted,TableCInf,SortedComponents}; + {_,PER} when PER =:= per; PER =:= per_bin; PER =:= uper_bin -> + {Sorted,SortedComponents} = sort_components(per,S,NewComponents), + {Sorted,TableCInf,SortedComponents}; + _ -> + {false,TableCInf,NewComponents} + end. + + +%% check that all tags are distinct according to X.680 26.3 +check_distinct_tags({C1,C2,C3},Acc) when is_list(C1),is_list(C2),is_list(C3) -> + check_distinct_tags(C1++C2++C3,Acc); +check_distinct_tags({C1,C2},Acc) when is_list(C1),is_list(C2) -> + check_distinct_tags(C1++C2,Acc); +check_distinct_tags([#'ComponentType'{tags=[T]}|Cs],Acc) -> + check_distinct(T,Acc), + check_distinct_tags(Cs,[T|Acc]); +check_distinct_tags([C=#'ComponentType'{tags=[T|Ts]}|Cs],Acc) -> + check_distinct(T,Acc), + check_distinct_tags([C#'ComponentType'{tags=Ts}|Cs],[T|Acc]); +check_distinct_tags([#'ComponentType'{tags=[]}|_Cs],_Acc) -> + throw({error,"Not distinct tags in SET"}); +check_distinct_tags([],_) -> + ok. +check_distinct(T,Acc) -> + case lists:member(T,Acc) of + true -> + throw({error,"Not distinct tags in SET"}); + _ -> ok + end. + +%% sorting in canonical order according to X.680 8.6, X.691 9.2 +%% DER: all components shall be sorted in canonical order. +%% PER: only root components shall be sorted in canonical order. The +%% extension components shall remain in textual order. +%% +sort_components(der,S=#state{tname=TypeName},Components) -> + {R1,Ext,R2} = extension(textual_order(Components)), + CompsList = case Ext of + noext -> R1; + _ -> R1 ++ Ext ++ R2 + end, + case {untagged_choice(S,CompsList),Ext} of + {false,noext} -> + {true,sort_components1(TypeName,CompsList,[],[],[],[])}; + {false,_} -> + {true,{sort_components1(TypeName,CompsList,[],[],[],[]), []}}; + {true,noext} -> + %% sort in run-time + {dynamic,R1}; + _ -> + {dynamic,{R1, Ext, R2}} + end; +sort_components(per,S=#state{tname=TypeName},Components) -> + {R1,Ext,R2} = extension(textual_order(Components)), + Root = tag_untagged_choice(S,R1++R2), + case Ext of + noext -> + {true,sort_components1(TypeName,Root,[],[],[],[])}; + _ -> + {true,{sort_components1(TypeName,Root,[],[],[],[]), + Ext}} + 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 (decode_type(T1) == 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. + +sort_universal_type(Components) -> + List = lists:map(fun(C) -> + #'ComponentType'{tags=[{_,T}|_]} = C, + {decode_type(T),C} + end, + Components), + SortedList = lists:keysort(1,List), + lists:map(fun(X)->element(2,X) end,SortedList). + +decode_type(I) when is_integer(I) -> + I; +decode_type(T) -> + asn1ct_gen_ber:decode_type(T). + +untagged_choice(_S,[#'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|_Rest]) -> + true; +untagged_choice(S,[#'ComponentType'{typespec=#type{tag=[],def=ExRef}}|Rest]) + when is_record(ExRef,'Externaltypereference')-> + case get_referenced_type(S,ExRef) of + {_,#typedef{typespec=#type{tag=[], + def={'CHOICE',_}}}} -> true; + _ -> untagged_choice(S,Rest) + end; +untagged_choice(S,[_|Rest]) -> + untagged_choice(S,Rest); +untagged_choice(_,[]) -> + false. + + +tag_untagged_choice(S,Cs) -> + tag_untagged_choice(S,Cs,[]). +tag_untagged_choice(S,[C = #'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|Rest],Acc) -> + TagList = C#'ComponentType'.tags, + TaggedC = C#'ComponentType'{tags=get_least_tag(TagList)}, + tag_untagged_choice(S,Rest,[TaggedC|Acc]); +tag_untagged_choice(S,[C = #'ComponentType'{typespec=#type{tag=[],def=ExRef}}|Rest],Acc) when is_record(ExRef,'Externaltypereference') -> + case get_referenced_type(S,ExRef) of + {_,#typedef{typespec=#type{tag=[], + def={'CHOICE',_}}}} -> + TagList = C#'ComponentType'.tags, + TaggedC = C#'ComponentType'{tags = get_least_tag(TagList)}, + tag_untagged_choice(S,Rest,[TaggedC|Acc]); + _ -> + tag_untagged_choice(S,Rest,[C|Acc]) + end; +tag_untagged_choice(S,[C|Rest],Acc) -> + tag_untagged_choice(S,Rest,[C|Acc]); +tag_untagged_choice(_S,[],Acc) -> + Acc. +get_least_tag([]) -> + []; +get_least_tag(TagList) -> + %% The smallest tag 'PRIVATE' < 'CONTEXT' < 'APPLICATION' < 'UNIVERSAL' + Pred = fun({'PRIVATE',_},{'CONTEXT',_}) -> true; + ({'CONTEXT',_},{'APPLICATION',_}) -> true; + ({'APPLICATION',_},{'UNIVERSAL',_}) -> true; + ({A,T1},{A,T2}) when T1 =< T2 -> true; (_,_) -> false + end, + [T|_] = lists:sort(Pred,TagList), + [T]. + +%% adds the textual order to the components to keep right order of +%% components in the asn1-value. +textual_order(Cs) -> + Fun = fun(C,Index) -> + {C#'ComponentType'{textual_order=Index},Index+1} + end, + {NewCs,_} = textual_order(Cs,Fun,1), + NewCs. +textual_order(Cs,Fun,IxIn) when is_list(Cs) -> + lists:mapfoldl(Fun,IxIn,Cs); +textual_order({Root,Ext},Fun,IxIn) -> + {NewRoot,IxR} = textual_order(Root,Fun,IxIn), + {NewExt,_} = textual_order(Ext,Fun,IxR), + {{NewRoot,NewExt},dummy}; +textual_order({Root1,Ext,Root2},Fun,IxIn) -> + {NewRoot1,IxR} = textual_order(Root1,Fun,IxIn), + {NewExt,IxE} = textual_order(Ext,Fun,IxR), + {NewRoot2,_} = textual_order(Root2,Fun,IxE), + {{NewRoot1,NewExt,NewRoot2},dummy}. + +extension(Components) when is_list(Components) -> + {Components,noext,[]}; +extension({Root,ExtList}) -> + ToOpt = fun(mandatory) -> + 'OPTIONAL'; + (X) -> X + end, + {Root, [X#'ComponentType'{prop=ToOpt(Y)}|| + X = #'ComponentType'{prop=Y}<-ExtList],[]}; +extension({Root1,ExtList,Root2}) -> + ToOpt = fun(mandatory) -> + 'OPTIONAL'; + (X) -> X + end, + {Root1, [X#'ComponentType'{prop=ToOpt(Y)}|| + X = #'ComponentType'{prop=Y}<-ExtList], Root2}. + +check_setof(S,Type,Component) when is_record(Component,type) -> + check_type(S,Type,Component). + +check_selectiontype(S,Name,#type{def=Eref}) + when is_record(Eref,'Externaltypereference') -> + {RefMod,TypeDef} = get_referenced_type(S,Eref), + NewS = S#state{module=load_asn1_module(S,RefMod), + mname=RefMod, + type=TypeDef, + tname=get_datastr_name(TypeDef)}, + check_selectiontype2(NewS,Name,TypeDef); +check_selectiontype(S,Name,Type=#type{def={pt,_,_}}) -> + TName = + case S#state.recordtopname of + [] -> + S#state.tname; + N -> N + end, + TDef = #typedef{name=TName,typespec=Type}, + check_selectiontype2(S,Name,TDef); +check_selectiontype(S,Name,Type) -> + Msg = lists:flatten(io_lib:format("SelectionType error: ~w < ~w must be a reference to a CHOICE.",[Name,Type])), + error({type,Msg,S}). + +check_selectiontype2(S,Name,TypeDef) -> + NewS = S#state{recordtopname=get_datastr_name(TypeDef)}, + CheckedType = check_type(NewS,TypeDef,TypeDef#typedef.typespec), + Components = get_choice_components(S,CheckedType#type.def), + case lists:keysearch(Name,#'ComponentType'.name,Components) of + {value,C} -> + %% The selected type will have the tag of the selected type. + _T = C#'ComponentType'.typespec; +% T#type{tag=def_to_tag(NewS,T#type.def)}; + _ -> + Msg = lists:flatten(io_lib:format("error checking SelectionType: ~w~n",[Name])), + error({type,Msg,S}) + end. + + +check_restrictedstring(_S,_Def,_Constr) -> + ok. + +check_objectidentifier(_S,_Constr) -> + ok. + +check_relative_oid(_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 is_list(Components) -> + case check_unique([C||C <- Components, + is_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; + + Dupl -> + throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}}) + end; +check_choice(_S,_,[]) -> + []. + +maybe_automatic_tags(S,C) -> + TagNos = tag_nums(C), + case (S#state.module)#module.tagdefault of + 'AUTOMATIC' -> + generate_automatic_tags(S,C,TagNos); + _ -> + %% 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,TagNos); + false -> + C + end + end. + +%% Pos == 1 for Root1, 2 for Ext, 3 for Root2 +tag_nums(Cl) -> + tag_nums(Cl,0,0). +tag_nums([{'EXTENSIONMARK',_,_}|Rest],Ext,Root2) -> + tag_nums_ext(Rest,Ext,Root2); +tag_nums([_|Rest],Ext,Root2) -> + tag_nums(Rest,Ext+1,Root2+1); +tag_nums([],Ext,Root2) -> + [0,Ext,Root2]. +tag_nums_ext([{'EXTENSIONMARK',_,_}|Rest],Ext,Root2) -> + tag_nums_root2(Rest,Ext,Root2); +tag_nums_ext([_|Rest],Ext,Root2) -> + tag_nums_ext(Rest,Ext,Root2); +tag_nums_ext([],Ext,_Root2) -> + [0,Ext,0]. +tag_nums_root2([_|Rest],Ext,Root2) -> + tag_nums_root2(Rest,Ext+1,Root2); +tag_nums_root2([],Ext,Root2) -> + [0,Ext,Root2]. + +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 + case ets:lookup(automatic_tags,Name) of +% true -> +% true; +% _ -> +% false + [] -> false; + _ -> true + 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|TagNos]) when is_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|TagNos])]; +generate_automatic_tags1([ExtMark|T],[_TagNo|TagNos]) -> % EXTENSIONMARK + [ExtMark | generate_automatic_tags1(T,TagNos)]; +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 is_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,Components) -> + check_each_component(S,Type,Components,[],[],[],root1). + +check_each_component(S = #state{abscomppath=Path,recordtopname=TopName},Type, + [C|Ct],Acc,Extacc,Acc2,Ext) when is_record(C,'ComponentType') -> + #'ComponentType'{name=Cname,typespec=Ts,prop=Prop} = C, + NewAbsCPath = + case Ts#type.def of + #'Externaltypereference'{} -> []; + _ -> [Cname|Path] + end,%%XXX Cname = 'per-message-indicators' + CheckedTs = check_type(S#state{abscomppath=NewAbsCPath, + recordtopname=[Cname|TopName]},Type,Ts), + NewTags = get_taglist(S,CheckedTs), + + NewProp = + case normalize_value(S,CheckedTs,Prop,[Cname|TopName]) of + mandatory -> mandatory; + 'OPTIONAL' -> 'OPTIONAL'; + DefaultValue -> {'DEFAULT',DefaultValue} + end, + NewC = C#'ComponentType'{typespec=CheckedTs,prop=NewProp,tags=NewTags}, + case Ext of + root1 -> + check_each_component(S,Type,Ct,[NewC|Acc],Extacc,Acc2,Ext); + ext -> + check_each_component(S,Type,Ct,Acc,[NewC|Extacc],Acc2,Ext); + root2 -> + check_each_component(S,Type,Ct,Acc,Extacc,[NewC|Acc2],Ext) + end; +check_each_component(S,Type,[_|Ct],Acc,Extacc,Acc2,root1) -> % skip 'EXTENSIONMARK' + check_each_component(S,Type,Ct,Acc,Extacc,Acc2,ext); +check_each_component(S,Type,[_|Ct],Acc,Extacc,Acc2,ext) -> % skip 'EXTENSIONMARK' + check_each_component(S,Type,Ct,Acc,Extacc,Acc2,root2); +check_each_component(_S,_,[_C|_Ct],_,_,_,root2) -> % '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,_,[],Acc1,ExtAcc,Acc2,root2) -> + {lists:reverse(Acc1),lists:reverse(ExtAcc),lists:reverse(Acc2)}; +check_each_component(_S,_,[],Acc,_,_,root1) -> + 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 is_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) -> + Cs = + case CompList of + {Comp1, EComps, Comp2} -> + Comp1++EComps++Comp2; + {Components,EComponents} when is_list(Components) -> + Components ++ EComponents; + CompList when is_list(CompList) -> + CompList + end, + + %% 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,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(S,#classdef{typespec=ClassDef})) of + {error,'__undefined_',_} -> + no_unique; + {asn1,Msg,_} -> + error({type,Msg,S}); + {'EXIT',Msg} -> + error({type,{internal_error,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 is_atom(ObjSet) -> + ObjSet; +object_set_mod_name(#state{mname=M}, + #'Externaltypereference'{module=M,type=T}) -> + {M,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_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,[])|get_simple_table_info(S,Cs,Rest)]; +get_simple_table_info(_,_,[]) -> + []. +get_simple_table_info1(S,Cs,[Cname|Cnames],Path) when is_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 constraint_member(simpletable,Cnstr) of + {true,{simpletable,_OSRef}} -> + simple_table_info(S,OCFT,Path); + _ -> + error({type,{"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). + + +simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef, + class=ObjectClass, + fieldname=FieldName},Path) -> + + 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(S,ClassDef)) of + {error,'__undefined_',_} -> no_unique; + {asn1,Msg,_} -> + error({type,Msg,S}); + {'EXIT',Msg} -> + error({type,{internal_error,Msg},S}); + {Other,_} -> Other + end, + {lists:reverse(Path),ObjectClassFieldName,UniqueName}; +simple_table_info(S,Type,_) -> + error({type,{"the type referenced by a componentrelation constraint must be a ObjectClassFieldType",Type},S}). + + +%% 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 constraint_member(componentrelation,Type#type.constraint) of +%% [{componentrelation,_,AtNotation}] -> + {true,{_,_,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,NamePath,CNames,AtNot); + _ -> + [] + end, + InnerAcc = + case {Type#type.inlined, + asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of + {no,{constructed,bif}} -> + {InnerCs,NewNamePath} = + case get_components(Type#type.def) of + {IC1,_IC2} -> {IC1 ++ IC1,[CName|NamePath]}; + T when is_record(T,type) -> {T,NamePath}; + IC -> {IC,[CName|NamePath]} + 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,NewNamePath,[]); + _ -> + [] + end, + any_component_relation(S,Cs,CNames,NamePath,InnerAcc++CRelPath++Acc); +any_component_relation(S,Type,CNames,NamePath,Acc) when is_record(Type,type) -> + CRelPath = + case constraint_member(componentrelation,Type#type.constraint) of + {true,{_,_,AtNotation}} -> + AtNot = extract_at_notation(AtNotation), + evaluate_atpath(S,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, + any_component_relation(S,InnerCs,CNames,NamePath,[]); + _ -> + [] + end, + InnerAcc ++ CRelPath ++ Acc; +any_component_relation(_,[],_,_,Acc) -> + Acc. + +constraint_member(componentrelation,[CRel={componentrelation,_,_}|_Rest]) -> + {true,CRel}; +constraint_member(simpletable,[ST={simpletable,_}|_Rest]) -> + {true,ST}; +constraint_member(Key,[_H|T]) -> + constraint_member(Key,T); +constraint_member(_,[]) -> + false. + +%% 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(S=#state{abscomppath=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},S}) + throw({type,{asn1,"failed to analyze at-path",AtPath},S}) + 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; +%do not step in inlined structures +get_components(any,{'SEQUENCE OF',T = #type{def=_Def,inlined=no}}) -> +% get_components(any,Def); + T; +get_components(any,{'SET OF',T = #type{def=_Def,inlined=no}}) -> +% get_components(any,Def); + T; +get_components(_,_) -> + []. + +get_choice_components(_S,{'CHOICE',Components}) when is_list(Components)-> + Components; +get_choice_components(_S,{'CHOICE',{C1,C2}}) when is_list(C1),is_list(C2) -> + C1++C2; +get_choice_components(S,ERef=#'Externaltypereference'{}) -> + {_RefMod,TypeDef}=get_referenced_type(S,ERef), + #typedef{typespec=TS} = TypeDef, + get_choice_components(S,TS#type.def). + +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] -> + case constraint_member(componentrelation,Constraint) of + {true,{_,{_,_,ObjectSet},AtList}} -> + [{_,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}; + _ -> + %% 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] -> + case constraint_member(componentrelation,Cons) of + {true,{_,{_,_,ObjectSet},AtList}} -> + %% 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(_S,ClassDef) when is_record(ClassDef,classdef) -> +%% {_,Fields,_} = ClassDef#classdef.typespec, + Fields = (ClassDef#classdef.typespec)#objectclass.fields, + get_unique_fieldname1(Fields,[]); +get_unique_fieldname(S,#typedef{typespec=#type{def=ClassRef}}) -> + %% A class definition may be referenced as + %% REFED-CLASS ::= DEFINED-CLASS and then REFED-CLASS is a typedef + {_M,ClassDef} = get_referenced_type(S,ClassRef), + get_unique_fieldname(S,ClassDef). + +get_unique_fieldname1([],[]) -> + throw({error,'__undefined_',[]}); +get_unique_fieldname1([],[Name]) -> + Name; +get_unique_fieldname1([],Acc) -> + throw({asn1,'only one UNIQUE field is allowed in CLASS',Acc}); +get_unique_fieldname1([{fixedtypevaluefield,Name,_,'UNIQUE',Opt}|Rest],Acc) -> + get_unique_fieldname1(Rest,[{Name,Opt}|Acc]); +get_unique_fieldname1([_H|T],Acc) -> + get_unique_fieldname1(T,Acc). + +get_tableconstraint_info(S,Type,{CheckedTs,EComps,CheckedTs2}) -> + {get_tableconstraint_info(S,Type,CheckedTs,[]), + get_tableconstraint_info(S,Type,EComps,[]), + get_tableconstraint_info(S,Type,CheckedTs2,[])}; +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'{} -> + NewOCFT = + OCFT#'ObjectClassFieldType'{class=[]}, + C#'ComponentType'{typespec= + CheckedTs#type{ + def=NewOCFT + }}; +% constraint=[{tableconstraint_info, +% FieldRef}]}}; + {'SEQUENCE OF',SOType} when is_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 is_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={FieldName,RestFieldName}) when is_atom(FieldName),is_list(RestFieldName)-> + Def; +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 + is_record(ERef,'Externaltypereference') -> + {MName,Type} = get_referenced_type(S,ERef), + NewS = update_state(S#state{type=Type, + tname=ERef#'Externaltypereference'.type},MName), + ClassSpec = check_class(NewS,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); +get_ObjectClassFieldType(S,ERef,{FieldName,Rest}) -> + get_ObjectClassFieldType(S,ERef,Rest ++ [FieldName]). + +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,FieldnameList=[{_FieldType,_PrimFieldName}|_]) -> + get_OCFType(S,Fields,[PFN||{_,PFN} <- FieldnameList]); +get_OCFType(S,Fields,[PrimFieldName|Rest]) -> + case lists:keysearch(PrimFieldName,2,Fields) of + {value,{fixedtypevaluefield,_,Type,_Unique,_OptSpec}} -> + {fixedtypevaluefield,PrimFieldName,Type}; + {value,{objectfield,_,ClassRef,_Unique,_OptSpec}} -> + {MName,ClassDef} = get_referenced_type(S,ClassRef), + NewS = update_state(S#state{type=ClassDef, + tname=get_datastr_name(ClassDef)}, + MName), + CheckedCDef = check_class(NewS,ClassDef), + get_OCFType(S,CheckedCDef#objectclass.fields,Rest); + {value,{objectsetfield,_,Type,_OptSpec}} -> + {MName,ClassDef} = get_referenced_type(S,Type#type.def), + NewS = update_state(S#state{type=ClassDef, + tname=get_datastr_name(ClassDef)}, + MName), + CheckedCDef = check_class(NewS,ClassDef), + get_OCFType(S,CheckedCDef#objectclass.fields,Rest); + + {value,Other} -> + {element(1,Other),PrimFieldName}; + _ -> + throw({error,lists:flatten(io_lib:format("undefined FieldName in ObjectClassFieldType: ~w",[PrimFieldName]))}) + end. + +get_taglist(S,Ext) when is_record(Ext,'Externaltypereference') -> + {_,T} = get_referenced_type(S,Ext), + get_taglist(S,T#typedef.typespec); +get_taglist(S,Tref) when is_record(Tref,typereference) -> + {_,T} = get_referenced_type(S,Tref), + get_taglist(S,T#typedef.typespec); +get_taglist(S,Type) when is_record(Type,type) -> + case Type#type.tag of + [] -> + get_taglist(S,Type#type.def); + [Tag|_] -> + [asn1ct_gen:def_to_tag(Tag)] + 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 is_list(FieldNameList) -> + case get_ObjectClassFieldType(S,ERef,FieldNameList) of + {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); + {TypeFieldName,_} when is_atom(TypeFieldName) -> []%should check if allowed + end; +get_taglist(S,{ObjCl,FieldNameList}) when is_record(ObjCl,objectclass), + is_list(FieldNameList) -> + case get_ObjectClassFieldType(S,ObjCl#objectclass.fields,FieldNameList) of + {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); + {TypeFieldName,_} when is_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 is_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,[]) -> + []. + +%% def_to_tag(S,Def) -> +%% case asn1ct_gen:def_to_tag(Def) of +%% {'UNIVERSAL',T} -> +%% case asn1ct_gen:prim_bif(T) of +%% true -> +%% ?TAG_PRIMITIVE(tag_number(T)); +%% _ -> +%% ?TAG_CONSTRUCTED(tag_number(T)) +%% end; +%% _ -> [] +%% end. +%% tag_number('BOOLEAN') -> 1; +%% tag_number('INTEGER') -> 2; +%% tag_number('BIT STRING') -> 3; +%% tag_number('OCTET STRING') -> 4; +%% tag_number('NULL') -> 5; +%% tag_number('OBJECT IDENTIFIER') -> 6; +%% tag_number('ObjectDescriptor') -> 7; +%% tag_number('EXTERNAL') -> 8; +%% tag_number('INSTANCE OF') -> 8; +%% tag_number('REAL') -> 9; +%% tag_number('ENUMERATED') -> 10; +%% tag_number('EMBEDDED PDV') -> 11; +%% tag_number('UTF8String') -> 12; +%% %%tag_number('RELATIVE-OID') -> 13; +%% tag_number('SEQUENCE') -> 16; +%% tag_number('SEQUENCE OF') -> 16; +%% tag_number('SET') -> 17; +%% tag_number('SET OF') -> 17; +%% tag_number('NumericString') -> 18; +%% tag_number('PrintableString') -> 19; +%% tag_number('TeletexString') -> 20; +%% %%tag_number('T61String') -> 20; +%% tag_number('VideotexString') -> 21; +%% tag_number('IA5String') -> 22; +%% tag_number('UTCTime') -> 23; +%% tag_number('GeneralizedTime') -> 24; +%% tag_number('GraphicString') -> 25; +%% tag_number('VisibleString') -> 26; +%% %%tag_number('ISO646String') -> 26; +%% tag_number('GeneralString') -> 27; +%% tag_number('UniversalString') -> 28; +%% tag_number('CHARACTER STRING') -> 29; +%% tag_number('BMPString') -> 30. + + +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 is_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(S,M) when is_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(S,NewM#module.name), + include_default_type(NewM#module.name), + Res. + +storeindb(Module,[H|T],ErrAcc) when is_record(H,typedef) -> + storeindb(Module,H#typedef.name,H,T,ErrAcc); +storeindb(Module,[H|T],ErrAcc) when is_record(H,valuedef) -> + storeindb(Module,H#valuedef.name,H,T,ErrAcc); +storeindb(Module,[H|T],ErrAcc) when is_record(H,ptypedef) -> + storeindb(Module,H#ptypedef.name,H,T,ErrAcc); +storeindb(Module,[H|T],ErrAcc) when is_record(H,classdef) -> + storeindb(Module,H#classdef.name,H,T,ErrAcc); +storeindb(Module,[H|T],ErrAcc) when is_record(H,pvaluesetdef) -> + storeindb(Module,H#pvaluesetdef.name,H,T,ErrAcc); +storeindb(Module,[H|T],ErrAcc) when is_record(H,pobjectdef) -> + storeindb(Module,H#pobjectdef.name,H,T,ErrAcc); +storeindb(Module,[H|T],ErrAcc) when is_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 is_record(H,typedef) -> + error({type,"already defined", + #state{mname=Module,type=H,tname=Name}}); + _Type when is_record(H,valuedef) -> + error({value,"already defined", + #state{mname=Module,value=H,vname=Name}}); + _Type when is_record(H,ptypedef) -> + error({ptype,"already defined", + #state{mname=Module,type=H,tname=Name}}); + _Type when is_record(H,pobjectdef) -> + error({ptype,"already defined", + #state{mname=Module,type=H,tname=Name}}); + _Type when is_record(H,pvaluesetdef) -> + error({ptype,"already defined", + #state{mname=Module,type=H,tname=Name}}); + _Type when is_record(H,pvaluedef) -> + error({ptype,"already defined", + #state{mname=Module,type=H,tname=Name}}); + _Type when is_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 is_record(H,typedef),is_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 is_record(H,typedef),is_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 is_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 is_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 is_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 is_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 is_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 is_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 is_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 is_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~n~p~n",[Pos,Mname,Typename,Msg]), + {error,{export,Pos,Mname,Typename,Msg}}; +error({import,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) -> + PosOfDef = + fun(#'Externaltypereference'{pos=P}) -> P; + (#'Externalvaluereference'{pos=P}) -> P + end, + Pos = PosOfDef(Ref), + io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]), + {error,{import,Pos,Mname,Typename,Msg}}; +% error({type,{Msg1,Msg2},#state{mname=Mname,type=Type,tname=Typename}}) +% when is_record(Type,typedef) -> +% io:format("asn1error:~p:~p:~p ~p~n", +% [Type#typedef.pos,Mname,Typename,Msg1]), +% {error,{type,Type#typedef.pos,Mname,Typename,Msg1,Msg2}}; +error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) + when is_record(Type,type) -> + io:format("asn1error:~p:~p~n~p~n", + [Mname,Typename,Msg]), + {error,{type,Mname,Typename,Msg}}; +error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) + when is_record(Type,typedef) -> + io:format("asn1error:~p:~p:~p~n~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 is_record(Type,ptypedef) -> + io:format("asn1error:~p:~p:~p~n~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 is_record(Value,valuedef) -> + io:format("asn1error:~p:~p:~p~n~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 is_record(Type,pobjectdef) -> + io:format("asn1error:~p:~p:~p~n~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}}) + when is_record(Value,valuedef) -> + io:format("asn1error:~p:~p:~p~n~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~n~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~n~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~n~p~n",[Pos,Mname,Typename,Msg]), + {error,{Other,Pos,Mname,Typename,Msg}}; +error({Other,Msg,#state{mname=Mname,type=Type,tname=Typename}}) -> + io:format("asn1error:~p:~p:~p~n~p~n",[asn1ct:get_pos_of_def(Type),Mname,Typename,Msg]), + {error,{Other,asn1ct:get_pos_of_def(Type),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', + tags=[{'UNIVERSAL',6}]}, + + Indirect_reference = + #'ComponentType'{name='indirect-reference', + typespec=#type{def='INTEGER'}, + prop='OPTIONAL', + tags=[{'UNIVERSAL',2}]}, + + Single_ASN1_type = + #'ComponentType'{name='single-ASN1-type', + typespec=#type{tag=[{tag,'CONTEXT',0, + 'EXPLICIT',32}], + def='ANY'}, + prop=mandatory, + tags=[{'CONTEXT',0}]}, + + Octet_aligned = + #'ComponentType'{name='octet-aligned', + typespec=#type{tag=[{tag,'CONTEXT',1, + 'IMPLICIT',0}], + def='OCTET STRING'}, + prop=mandatory, + tags=[{'CONTEXT',1}]}, + + Arbitrary = + #'ComponentType'{name=arbitrary, + typespec=#type{tag=[{tag,'CONTEXT',2, + 'IMPLICIT',0}], + def={'BIT STRING',[]}}, + prop=mandatory, + tags=[{'CONTEXT',2}]}, + + 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(S,Module) -> + NameAbsList = default_class_list(S), + 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, + include_default_class1(Module,Rest). + +default_class_list(S) -> + [{'TYPE-IDENTIFIER', + {objectclass, + [{fixedtypevaluefield, + id, + #type{tag=?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER), + def='OBJECT IDENTIFIER'}, + 'UNIQUE', + 'MANDATORY'}, + {typefield,'Type','MANDATORY'}], + {'WITH SYNTAX', + [{typefieldreference,'Type'}, + 'IDENTIFIED', + 'BY', + {valuefieldreference,id}]}}}, + {'ABSTRACT-SYNTAX', + {objectclass, + [{fixedtypevaluefield, + id, + #type{tag=?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER), + def='OBJECT IDENTIFIER'}, + 'UNIQUE', + 'MANDATORY'}, + {typefield,'Type','MANDATORY'}, + {fixedtypevaluefield, + property, + #type{tag=?TAG_PRIMITIVE(?N_BIT_STRING), + def={'BIT STRING',[]}}, + undefined, + {'DEFAULT', + [0,1,0]}}], + {'WITH SYNTAX', + [{typefieldreference,'Type'}, + 'IDENTIFIED', + 'BY', + {valuefieldreference,id}, + ['HAS', + 'PROPERTY', + {valuefieldreference,property}]]}}}]. + + +new_reference_name(Name) -> + case get(asn1_reference) of + undefined -> + put(asn1_reference,1), + list_to_atom(lists:concat([internal_,Name,"_",1])); + Num when is_integer(Num) -> + put(asn1_reference,Num+1), + list_to_atom(lists:concat([internal_,Name,"_",Num+1])) + end. + +get_record_prefix_name(S) -> + case lists:keysearch(record_name_prefix,1,S#state.options) of + {value,{_,Prefix}} -> + Prefix; + _ -> + "" + end. + +insert_once(S,Tab,Key) -> + case get(top_module) of + M when M == S#state.mname -> + asn1ct_gen:insert_once(Tab,Key), + ok; + _ -> + skipped + end. diff --git a/lib/asn1/src/asn1ct_constructed_ber.erl b/lib/asn1/src/asn1ct_constructed_ber.erl new file mode 100644 index 0000000000..51a241ffbd --- /dev/null +++ b/lib/asn1/src/asn1ct_constructed_ber.erl @@ -0,0 +1,1571 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_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,get_record_name_prefix/0]). + +% 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 is_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 + {Rl1,El,Rl2} -> Rl1 ++ El ++ Rl2; + {Rl,El} -> Rl ++ El; + _ -> CompList + end, + EncObj = + case TableConsInfo of + #simpletableattributes{usedclassfield=Used, + uniqueclassfield=Unique} when Used /= Unique -> + false; + %% ObjectSetRef, name of the object set in constraints + %% + %%{ObjectSetRef,AttrN,N,UniqueFieldName} + #simpletableattributes{objectsetname=ObjectSetRef, + c_name=AttrN, + c_index=N, + usedclassfield=UniqueFieldName, + uniqueclassfield=UniqueFieldName, + valueindex=ValueIndex + } -> + OSDef = + case ObjectSetRef 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}), + {ObjSetMod,ObjSetName} = + case ObjectSetRef of + {M,O} -> + {{asis,M},O}; + O -> + {"?MODULE",O} + end, + emit({" ",ObjSetMod,":'getenc_",ObjSetName,"'(",{asis,UniqueFieldName}, + ", ",nl}), +% emit({indent(35),"?RT_BER:cindex(",N+1,", Val,", +% {asis,AttrN},")),",nl}), + Length = fun(X,_LFun) when is_atom(X) -> + length(atom_to_list(X)); + (X,_LFun) when is_list(X) -> + length(X); + ({X1,X2},LFun) -> + LFun(X1,LFun) + LFun(X2,LFun) + end, + emit([indent(10+Length(ObjectSetRef,Length)), + "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("asn1rt_check: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 is_record(D,type) -> + asn1ct_name:start(), + asn1ct_name:new(tag), + #'SEQUENCE'{tablecinf=TableConsInfo,components=CList} = D#type.def, + Ext = extensible(CList), + {CompList,CompList2} = case CList of + {Rl1,El,Rl2} -> {Rl1 ++ El ++ Rl2,CList}; + {Rl,El} -> {Rl ++ El, Rl ++ El}; + _ -> {CList,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 {asn1ct_gen:get_constraint(CT#type.constraint,componentrelation),CT#type.tablecinf} of +% case {CT#type.constraint,CT#type.tablecinf} of + {no,[{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, + RecordName = lists:concat([get_record_name_prefix(),asn1ct_gen:list2rname(Typename)]), + case gen_dec_sequence_call(Erules,Typename,CompList2,Ext,DecObjInf) of + no_terms -> % an empty sequence + emit([nl,nl]), + demit({"Result = "}), %dbg + %% return value as record + asn1ct_name:new(rb), + emit([" {{'",RecordName,"'}, ",{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), + {ObjSetMod,ObjSetName} = + case ObjSet of + {M,O} -> + {{asis,M},O}; + _ -> + {"?MODULE",ObjSet} + end, + emit([DecObj," =",nl," ",ObjSetMod,":'getdec_",ObjSetName,"'(", +% {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 | extensible + end, + emit([" {",{next,bytes},",",{curr,rb},"} = ?RT_BER:restbytes2(RemBytes, ", + {curr,bytes},",",ExtStatus,"),",nl]), + asn1ct_name:new(rb), + case Typename of + ['EXTERNAL'] -> + emit([" OldFormat={'",RecordName, + "', "]), + mkvlist(asn1ct_name:all(term)), + emit(["},",nl]), + emit([" ASN11994Format =",nl, + " asn1rt_check:transform_to_EXTERNAL1994", + "(OldFormat),",nl]), + emit([" {ASN11994Format,",{next,bytes},", "]); + _ -> + emit([" {{'",RecordName,"', "]), + 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 is_record(D,type) -> + gen_encode_sequence(Erules,Typename,D). + +gen_decode_set(Erules,Typename,D) when is_record(D,type) -> + asn1ct_name:start(), + asn1ct_name:clear(), + asn1ct_name:new(term), + asn1ct_name:new(tag), + #'SET'{components=TCompList} = D#type.def, + Ext = extensible(TCompList), + ToOptional = fun(mandatory) -> + 'OPTIONAL'; + (X) -> X + end, + CompList = case TCompList of + {Rl1,El,Rl2} -> + Rl1 ++ [X#'ComponentType'{prop=ToOptional(Y)}||X = #'ComponentType'{prop=Y}<-El] ++ Rl2; + {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), + {ExtFlatten1,ExtFlatten2} = + case Ext of + noext -> {"",""}; + _ -> {"lists:flatten(",")"} + end, + emit([" 'dec_",asn1ct_gen:list2name(Typename), + "__result__'(lists:sort(",ExtFlatten1,"SetTerm",ExtFlatten2,"), 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),"_ -> ",nl]), + case Ext of + noext -> + emit([indent(9),"{[], Bytes,0}",nl]); + _ -> + asn1ct_name:new(rbCho), + emit([indent(9),"{RestBytes, ",{curr,rbCho}, + "} = ?RT_BER:skipvalue(Bytes),",nl, + indent(9),"{[], RestBytes, ",{curr,rbCho},"}",nl]) + end, + 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}), + RecordName = lists:concat([get_record_name_prefix(), + asn1ct_gen:list2rname(Typename)]), + case gen_dec_set_result(Erules,Typename,CompList) of + no_terms -> + %% return value as record + asn1ct_name:new(rb), + emit({" {{'",RecordName,"'}, Bytes, Rb}.",nl}); + _ -> + emit({nl," case ",{curr,termList}," of",nl}), + emit({" [] -> {{'",RecordName,"', "}), + 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 is_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 is_record(D,type) -> + asn1ct_name:start(), + asn1ct_name:clear(), + {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 is_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 is_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 when SeqOrSetOf=='SET OF' -> + emit([indent(3), + "{asn1rt_check: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), + mandatory,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 is_record(D,type) -> + ChoiceTag = D#type.tag, + {'CHOICE',CompList} = D#type.def, + Ext = extensible(CompList), + CompList1 = case CompList of + {Rl1,El,Rl2} -> Rl1 ++ El ++ Rl2; + {Rl,El} -> Rl ++ El; + _ -> CompList + end, + gen_enc_choice(Erules,Typename,ChoiceTag,CompList1,Ext), + emit({nl,nl}). + +gen_decode_choice(Erules,Typename,D) when is_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 + {Rl1,El,Rl2} -> Rl1 ++ El ++Rl2; + {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,textual_order=Order}|Rest],Pos,Ext,EncObj) -> + asn1ct_name:new(encBytes), + asn1ct_name:new(encLen), + CindexPos = + case Order of + undefined -> + Pos; + _ -> Order % der + end, + Element = + case TopType of + ['EXTERNAL'] -> + io_lib:format("?RT_BER:cindex(~w,NewVal,~w)",[CindexPos+1,Cname]); + _ -> + io_lib:format("?RT_BER:cindex(~w,Val,~w)",[CindexPos+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) + when is_list(CompList) -> + gen_dec_sequence_call1(Erules,TopType, CompList, 1, Ext,DecObjInf,[],[]); +gen_dec_sequence_call(Erules,TopType,CList,Ext,DecObjInf) -> + gen_dec_sequence_call2(Erules,TopType,CList,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_call2(_Erules,_TopType,{[],[],[]},_Ext,_DecObjInf) -> + no_terms; +gen_dec_sequence_call2(Erules,TopType,{Root1,EList,Root2},_Ext,DecObjInf) -> + {LA,ArgsAcc} = + case gen_dec_sequence_call1(Erules,TopType,Root1++EList,1, + extensible({Root1,EList}),DecObjInf,[],[]) of + no_terms -> + {[],[]}; + Res -> Res + end, + %% TagList is the tags of Root2 elements from the first up to and + %% including the first mandatory element. + TagList = get_root2_taglist(Root2,[]), + emit({com,nl}), + asn1ct_name:new(bytes), + emit([" {",{next,bytes},", ",{next,rb}, + "} = ?RT_BER:skip_ExtensionAdditions(", + {curr,bytes},", ",{asis,TagList},"),",nl]), + asn1ct_name:new(rb), + asn1ct_name:new(bytes), + gen_dec_sequence_call1(Erules,TopType,Root2, + length(Root1)+length(EList),noext, + DecObjInf,LA,ArgsAcc). + +%% returns a list of tags of the elements in the component (second +%% root) list up to and including the first mandatory tag. See 24.6 in +%% X.680 (7/2002) +get_root2_taglist([],Acc) -> + lists:reverse(Acc); +get_root2_taglist([#'ComponentType'{prop=Prop,typespec=Type}|Rest],Acc) -> + FirstTag = fun([])->[]; + ([H|_T])->H#tag{class=asn1ct_gen_ber:decode_class(H#tag.class)} + end(Type#type.tag), + case Prop of + mandatory -> + %% match_tags/ may be used + %% this is the last tag of interest -> return + lists:reverse([FirstTag|Acc]); + _ -> + get_root2_taglist(Rest,[FirstTag|Acc]) + end. + + +%%---------------------------- +%%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, + + Prop1 = case {Prop,Ext} of + {_,{ext,Epos,_Root2pos}} when Pos < Epos -> + Prop; + {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) -> + ExtCatch = case Ext of + noext ->""; + _ -> " catch" + end, + TagList = get_all_choice_tags(CompList), + emit({indent(3), + {curr,tagList}," = ",{asis,TagList},",",nl}), + emit({indent(3), + "case",ExtCatch," ?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) -> + 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). + + + +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) -> + 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 is_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}; + _ -> + case Type#type.tablecinf of + [{objfun,_}] -> {{no_attr,"ObjFun"},[]}; + _-> {false,[]} + end + end, + gen_enc_line(Erules,TopType,Cname,Type,"element(2,Val)",9, + mandatory,Assign,Encobj), + case {Type#type.def,Encobj} of + {#'ObjectClassFieldType'{},{no_attr,"ObjFun"}} -> + emit({",",nl,indent(9),"{",{curr,encBytes},", ", + {curr,encLen},"}"}); + _ -> ok + 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 is_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 is_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=C, + def=#'ObjectClassFieldType'{type={typefield,_}}}, + Element,Indent,OptOrMand=mandatory,EncObj) + when is_list(Element) -> + case asn1ct_gen:get_constraint(C,componentrelation) of + {componentrelation,_,_} -> + 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, + ["{",{curr,encBytes},",",{curr,encLen},"} = "], + EncObj) + end; + gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,EncObj) + when is_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 is_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{def=#'ObjectClassFieldType'{type={typefield,_}, + fieldname=RefedFieldName}}, + {componentrelation,_,_}} -> + {_LeadingAttrName,Fun} = EncObj, + case RefedFieldName of + {Name,RestFieldNames} when is_atom(Name),Name =/= notype -> + case OptOrMand of + mandatory -> ok; + _ -> + 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},", ",{curr,tmpLen}, + "} = "}), + emit({"?RT_BER:encode_open_type(",{curr,tmpBytes}, + ",",{asis,Tag},"),",nl}), + emit(IndDeep), + emit({"{",{next,tmpBytes},", ",{curr,tmpLen},"}"}) + end; + Err -> + throw({asn1,{'internal error',Err}}) + end; + _ -> + 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); + '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(Erules,TopType,Cname,WhatKind,dec,3), + emit([DecFunName,", ",{asis,Tag}]); + _ -> + {DecFunName, _, _} = + mkfunname(Erules,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} when CTag =/= [] -> % R9C-0.patch-34 + 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. + ObjSetName = case ObjSet of + {deep,OSName,_,_} -> + OSName; + _ -> ObjSet + end, + {[{ObjSetName,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), + {ObjSetMod,ObjSetName} = + case OSet of + {M,O} -> + {{asis,M},O}; + _ -> + {"?MODULE",OSet} + end, + emit({",",nl,"ObjFun = ",ObjSetMod,":'getdec_",ObjSetName,"'(", + {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 is_list(CompList) -> + noext; +extensible({RootList,ExtList}) -> + {ext,length(RootList)+1,length(ExtList)}; +extensible({_Rl1,_ExtL,_Rl2}) -> + extensible. + +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(Erule,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}; + 'ASN1_OPEN_TYPE' -> + case Arity of + 3 -> + F = lists:concat(["fun(A,_,C) -> ?RT_BER:decode_open_type(",Erule,",A,C) end"]), + {F, "?MODULE", F}; + 4 -> + F = lists:concat(["fun(A,_,C,_) -> ?RT_BER:decode_open_type(",Erule,",A,C) end"]), + {F, "?MODULE", F} + end + end. + +empty_lb(ber) -> + "[]"; +empty_lb(ber_bin) -> + "<<>>". + +rtmod(ber) -> + list_to_atom(?RT_BER_BIN); +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 is_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/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl new file mode 100644 index 0000000000..a55ac9db8e --- /dev/null +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -0,0 +1,1486 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_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,get_record_name_prefix/0]). +-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 is_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 + {Rl1,El,Rl2} -> Rl1 ++ El ++ Rl2; + {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=ObjectSetRef, + c_name=AttrN, + c_index=N, + usedclassfield=UniqueFieldName, + uniqueclassfield=UniqueFieldName, + valueindex=ValueIndex} -> %% N is index of attribute that determines constraint + OSDef = + case ObjectSetRef 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])), + {ObjSetMod,ObjSetName} = + case ObjectSetRef of + {M,O} -> + {{asis,M},O}; + _ -> + {"?MODULE",ObjectSetRef} + end, + emit([ObjectEncode," = ",nl]), + emit([" ",ObjSetMod,":'getenc_",ObjSetName,"'(",{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("asn1rt_check: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 is_record(D,type) -> + asn1ct_name:start(), + asn1ct_name:clear(), + asn1ct_name:new(tag), + #'SEQUENCE'{tablecinf=TableConsInfo,components=CList} = D#type.def, + Ext = extensible(CList), + {CompList,CompList2} = + case CList of + {Rl1,El,Rl2} -> {Rl1 ++ El ++ Rl2, CList}; + {Rl,El} -> {Rl ++ El, Rl ++ El}; + _ -> {CList, CList} + end, + + emit([" %%-------------------------------------------------",nl]), + emit([" %% decode tag and length ",nl]), + emit([" %%-------------------------------------------------",nl]), + + asn1ct_name:new(tlv), + case CompList of + [] -> % 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=ObjectSetRef, + c_name=AttrN, + usedclassfield=UniqueFieldName, + uniqueclassfield=UniqueFieldName, + valueindex=ValIndex} -> +% {ObjectSetRef,AttrN,_N,UniqueFieldName} ->%% N is index of attribute that determines constraint + F = fun(#'ComponentType'{typespec=CT})-> + case {asn1ct_gen:get_constraint(CT#type.constraint,componentrelation),CT#type.tablecinf} of + {no,[{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,ObjectSetRef,UniqueFieldName,ValIndex}}, + UniqueFieldName,ValIndex}; + false -> + {{AttrN,ObjectSetRef},UniqueFieldName,ValIndex} + end; + _ -> + {false,false,false} + end, + RecordName = lists:concat([get_record_name_prefix(), + asn1ct_gen:list2rname(Typename)]), + case gen_dec_sequence_call(Erules,Typename,CompList2,Ext,DecObjInf) of + no_terms -> % an empty sequence + emit([nl,nl]), + demit(["Result = "]), %dbg + %% return value as record + asn1ct_name:new(rb), + emit([" {'",RecordName,"'}.",nl,nl]); + {LeadingAttrTerm,PostponedDecArgs} -> + emit([com,nl,nl]), + case {LeadingAttrTerm,PostponedDecArgs} of + {[],[]} -> + ok; + {_,[]} -> + ok; + {[{ObjSetRef,LeadingAttr,Term}],PostponedDecArgs} -> + DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])), + ValueMatch = value_match(ValueIndex,Term), + {ObjSetMod,ObjSetName} = + case ObjSetRef of + {M,O} -> + {{asis,M},O}; + _ -> + {"?MODULE",ObjSetRef} + end, + emit([DecObj," =",nl, + " ",ObjSetMod,":'getdec_",ObjSetName,"'(", + {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 | extensible + 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={'",RecordName, + "', "]), + mkvlist(asn1ct_name:all(term)), + emit(["},",nl]), + emit([" asn1rt_check:transform_to_EXTERNAL1994", + "(OldFormat).",nl]); + _ -> + emit([" {'",RecordName,"', "]), + 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 is_record(D,type) -> + gen_encode_sequence(Erules,Typename,D). + +gen_decode_set(Erules,Typename,D) when is_record(D,type) -> + asn1ct_name:start(), + asn1ct_name:clear(), +%% asn1ct_name:new(term), + asn1ct_name:new(tag), + #'SET'{tablecinf=TableConsInfo,components=TCompList} = D#type.def, + Ext = extensible(TCompList), + ToOptional = fun(mandatory) -> + 'OPTIONAL'; + (X) -> X + end, + CompList = case TCompList of + {Rl1,El,Rl2} -> Rl1 ++ [X#'ComponentType'{prop=ToOptional(Y)}||X = #'ComponentType'{prop=Y}<-El] ++ Rl2; + {Rl,El} -> Rl ++ El; + _ -> TCompList + end, + + %% asn1ct_name:clear(), + asn1ct_name:new(tlv), + case CompList of + [] -> % empty sequence + true; + _ -> + emit([{curr,tlv}," = "]) + end, + emit(["?RT_BER:match_tags(",{prev,tlv},",TagIn), ",nl]), + asn1ct_name:new(v), + + + {DecObjInf,UniqueFName,ValueIndex} = + case TableConsInfo of +%% {ObjectSetRef,AttrN,_N,UniqueFieldName} ->%% N is index of attribute that determines constraint + #simpletableattributes{objectsetname=ObjectSetRef, + c_name=AttrN, + usedclassfield=UniqueFieldName, + uniqueclassfield=UniqueFieldName, + valueindex=ValIndex} -> + F = fun(#'ComponentType'{typespec=CT})-> + case {asn1ct_gen:get_constraint(CT#type.constraint, + componentrelation), + CT#type.tablecinf} of + {no,[{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,ObjectSetRef,UniqueFieldName,ValIndex}}, + UniqueFieldName,ValIndex}; + false -> + {{AttrN,ObjectSetRef},UniqueFieldName,ValIndex} + end; + _ -> + {false,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, + RecordName = lists:concat([get_record_name_prefix(), + asn1ct_gen:list2rname(Typename)]), + 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([" {'",RecordName,"'}.",nl]); + {LeadingAttrTerm,PostponedDecArgs} -> + emit([com,nl,nl]), + case {LeadingAttrTerm,PostponedDecArgs} of + {[],[]} -> + ok; + {_,[]} -> + ok; + {[{ObjSetRef,LeadingAttr,Term}],PostponedDecArgs} -> + DecObj = asn1ct_gen:un_hyphen_var(lists:concat(['DecObj',LeadingAttr,Term])), + ValueMatch = value_match(ValueIndex,Term), + {ObjSetMod,ObjSetName} = + case ObjSetRef of + {M,O} -> + {{asis,M},O}; + _ -> + {"?MODULE",ObjSetRef} + end, + emit([DecObj," =",nl, + " ",ObjSetMod,":'getdec_",ObjSetName,"'(", + {asis,UniqueFName},", ",ValueMatch,"),",nl]), + gen_dec_postponed_decs(DecObj,PostponedDecArgs) + end, + demit(["Result = "]), %dbg + %% return value as record + case Ext of + Extnsn when Extnsn =/= noext -> + 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([" {'",RecordName,"', "]), + mkvlist(asn1ct_name:all(term)), + emit(["}.",nl]) + end. + + +%%=============================================================================== +%%=============================================================================== +%%=============================================================================== +%% Encode/decode SEQUENCE OF and SET OF +%%=============================================================================== +%%=============================================================================== +%%=============================================================================== + +gen_encode_sof(Erules,Typename,_InnerTypename,D) when is_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 is_record(D,type) -> + asn1ct_name:start(), + asn1ct_name:clear(), + {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 is_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 is_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 when SeqOrSetOf=='SET OF'-> + emit([indent(3), + "{asn1rt_check: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), + mandatory,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 is_record(D,type) -> + ChoiceTag = D#type.tag, + {'CHOICE',CompList} = D#type.def, + Ext = extensible(CompList), + CompList1 = case CompList of + {Rl1,El,Rl2} -> Rl1 ++ El ++ Rl2; + {Rl,El} -> Rl ++ El; + _ -> CompList + end, + gen_enc_choice(Erules,Typename,ChoiceTag,CompList1,Ext), + emit([nl,nl]). + +gen_decode_choice(Erules,Typename,D) when is_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 + {Rl1,El,Rl2} -> Rl1 ++ El ++ Rl2; + {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,textual_order=Order}|Rest],Pos,Ext,EncObj) -> + asn1ct_name:new(encBytes), + asn1ct_name:new(encLen), + CindexPos = + case Order of + undefined -> + Pos; + _ -> Order % der + end, + Element = + case TopType of + ['EXTERNAL'] -> + io_lib:format("Cindex~w",[CindexPos]); + _ -> + io_lib:format("Cindex~w",[CindexPos]) + 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) + when is_list(CompList) -> + gen_dec_sequence_call1(Erules,TopType, CompList, 1, Ext,DecObjInf,[],[]); +gen_dec_sequence_call(Erules,TopType,CompList,Ext,DecObjInf) -> + gen_dec_sequence_call2(Erules,TopType, CompList, 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. + +gen_dec_sequence_call2(_Erules,_TopType, {[], [], []}, _Ext,_DecObjInf) -> + no_terms; +gen_dec_sequence_call2(Erules,TopType,{Root1,EList,Root2},_Ext,DecObjInf) -> + {LA,ArgsAcc} = + case gen_dec_sequence_call1(Erules,TopType,Root1++EList,1, + extensible({Root1,EList}),DecObjInf,[],[]) of + no_terms -> + {[],[]}; + Res -> Res + end, + %% TagList is the tags of Root2 elements from the first up to and + %% including the first mandatory element. + TagList = get_root2_taglist(Root2,[]), + emit({com,nl}), + emit([{curr,tlv}," = ?RT_BER:skip_ExtensionAdditions(", + {prev,tlv},", ",{asis,TagList},"),",nl]), + asn1ct_name:new(tlv), + gen_dec_sequence_call1(Erules,TopType,Root2, + length(Root1)+length(EList),noext, + DecObjInf,LA,ArgsAcc). + +%% returns a list of tags of the elements in the component (second +%% root) list up to and including the first mandatory tag. See 24.6 in +%% X.680 (7/2002) +get_root2_taglist([],Acc) -> + lists:reverse(Acc); +get_root2_taglist([#'ComponentType'{prop=Prop,typespec=Type}|Rest],Acc) -> + FirstTag = fun([])->[]; + ([H|_T])->(?ASN1CT_GEN_BER:decode_class(H#tag.class) bsl 10) + + H#tag.number + end(Type#type.tag), + case Prop of + mandatory -> + %% match_tags/ may be used + %% this is the last tag of interest -> return + lists:reverse([FirstTag|Acc]); + _ -> + get_root2_taglist(Rest,[FirstTag|Acc]) + end. + + + +%%---------------------------- +%%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, + + 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,NotFalse) + when NotFalse /= false -> + 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 is_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}; + _ -> + case Type#type.tablecinf of + [{objfun,_}] -> {{no_attr,"ObjFun"},[]}; + _ -> {false,[]} + end + end, + gen_enc_line(Erules,TopType,Cname,Type,"element(2,Val)",9, + mandatory,Assign,Encobj), + case {Type#type.def,Encobj} of + {#'ObjectClassFieldType'{},{no_attr,"ObjFun"}} -> + emit([",",nl,indent(9),"{",{curr,encBytes},", ", + {curr,encLen},"}"]); + _ -> ok + 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=C, + def=#'ObjectClassFieldType'{type={typefield,_}}}, + Element,Indent,OptOrMand=mandatory,EncObj) + when is_list(Element) -> + case asn1ct_gen:get_constraint(C,componentrelation) of + {componentrelation,_,_} -> + 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, + ["{",{curr,encBytes},",",{curr,encLen},"} = "], + EncObj) + end; +% gen_enc_line(Erules,TopType,Cname, +% Type=#type{constraint=[{componentrelation,_,_}], +% def=#'ObjectClassFieldType'{type={typefield,_}}}, +% Element,Indent,OptOrMand=mandatory,EncObj) +% when is_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 is_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 is_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 is_atom(Name), Name =/= notype -> + 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; + Err -> + throw({asn1,{'internal error',Err}}) + end; +%% {{#'ObjectClassFieldType'{type={objectfield,PrimFieldName1, +%% PFNList}},_}, +%% {componentrelation,_,_}} -> +%% %% this is when the dotted list in the FieldName has more +%% %% than one element +%% {_LeadingAttrName,Fun} = EncObj, +%% emit(["?RT_BER:encode_open_type(",Fun,"(",{asis,PrimFieldName1}, +%% ", ",Element,", ",{asis,PFNList},"))"]); + _ -> + case WhatKind of + {primitive,bif} -> + 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. + ObjSetName = case ObjSet of + {deep,OSName,_,_} -> + OSName; + _ -> ObjSet + end, + {[{ObjSetName,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), + {ObjSetMod,ObjSetName} = + case OSet of + {M,O} -> + {{asis,M},O}; + _ -> + {"?MODULE",OSet} + end, + emit([",",nl,"ObjFun = ",ObjSetMod,":'getdec_",ObjSetName,"'(", + {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 is_list(List) -> + Sindex = + case WhatKind of + #'Externaltypereference'{} -> +% asn1ct:maybe_rename_function(WhatKind,List), + SI = asn1ct:maybe_saved_sindex(WhatKind,List), + Saves = {WhatKind,SI,List}, + asn1ct:add_tobe_refed_func(Saves), + SI; + _ -> +% asn1ct:maybe_rename_function([Cname|TopType], +% List), + SI = asn1ct:maybe_saved_sindex([Cname|TopType],List), + Saves = {[Cname|TopType],SI,List,Type}, + asn1ct:add_tobe_refed_func(Saves), + SI + end, + asn1ct:update_gen_state(namelist,Rest), + Prefix=asn1ct:get_gen_state_field(prefix), +% Suffix = +% lists:concat(["_",asn1ct:latest_sindex()]), + Suffix = + case Sindex of + I when is_integer(I),I>0 -> lists:concat(["_",I]); + _ -> "" + end, + {DecFunName,_,_}= + mkfuncname(TopType,Cname,WhatKind,Prefix,Suffix), +% SuffixedName = +% lists:concat([DecFunName,asn1ct:latest_sindex()]), + 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 is_list(CompList) -> + noext; +extensible({RootList,ExtList}) -> + {ext,length(RootList)+1,length(ExtList)}; +extensible({_Rl1,_Ext,_Rl2}) -> + extensible. + + +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,Suffix) -> + CurrMod = get(currmod), + case WhatKind of + #'Externaltypereference'{module=CurrMod,type=EType} -> + F = lists:concat(["'",Prefix,EType,Suffix,"'"]), + {F, "?MODULE", F}; + #'Externaltypereference'{module=Mod,type=EType} -> + {lists:concat(["'",Mod,"':'",Prefix,EType,Suffix,"'"]),Mod, + lists:concat(["'",Prefix,EType,"'"])}; + {constructed,bif} -> + F = lists:concat(["'",Prefix, + asn1ct_gen:list2name([Cname|TopType]), + Suffix,"'"]), + {F, "?MODULE", F} + end. + +empty_lb(ber) -> + "[]"; +empty_lb(ber_bin) -> + "<<>>"; +empty_lb(ber_bin_v2) -> + "<<>>". + +value_match(Index,Value) when is_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/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl new file mode 100644 index 0000000000..2a1c0ebc6b --- /dev/null +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -0,0 +1,1393 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_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,get_record_name_prefix/0]). + +%% 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(Erule,Typename,D) when is_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(to_textual_order(CompList)),CompList} of + {[],EmptyCL} when EmptyCL == {[],[],[]};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 = ",Opt} = ?RT_PER:fixoptionals(", + 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 + {{ObjSetMod,ObjSetName},OSDef} = + case ObjectSet of + {Module,OSName} -> + {{{asis,Module},OSName},asn1_db:dbget(Module,OSName)}; + OSName -> + {{"?MODULE",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([" ",ObjSetMod,":'getenc_",ObjSetName,"'(", + {asis,UniqueFieldName},", ",nl]), + El = make_element(N+1,asn1ct_gen:mk_var(asn1ct_name:curr(val)),AttrN), + + Length = fun(X,_LFun) when is_atom(X) -> + length(atom_to_list(X)); + (X,_LFun) when is_list(X) -> + length(X); + ({X1,X2},LFun) -> + LFun(X1,LFun) + LFun(X2,LFun) + end, + Indent = 12 + Length(ObjectSet,Length), + 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(Erule,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 is_record(D,type) -> + asn1ct_name:start(), + asn1ct_name:clear(), + {CompList,TableConsInfo} = + case D#type.def of + #'SEQUENCE'{tablecinf=TCI,components=CL} -> + {add_textual_order(CL),TCI}; + #'SET'{tablecinf=TCI,components=CL} -> + {add_textual_order(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 {asn1ct_gen:get_constraint(CT#type.constraint,componentrelation),CT#type.tablecinf} of + {no,[{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(Erules,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), + {ObjSetMod,ObjSetName} = + case ObjSet of + {M,O} -> {{asis,M},O}; + _ -> {"?MODULE",ObjSet} + end, + emit({DecObj," =",nl," ",ObjSetMod,":'getdec_",ObjSetName,"'(", +% {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 + RecordName = lists:concat([get_record_name_prefix(), + asn1ct_gen:list2rname(Typename)]), + case Typename of + ['EXTERNAL'] -> + emit({" OldFormat={'",RecordName, + "'"}), + mkvlist(asn1ct_name:all(term)), + emit({"},",nl}), + emit({" ASN11994Format =",nl, + " asn1rt_check:transform_to_EXTERNAL1994", + "(OldFormat),",nl}), + emit(" {ASN11994Format,"); + _ -> + emit(["{{'",RecordName,"'"]), + mkvlist(textual_order(CompList,asn1ct_name:all(term))), + emit("},") + end, + emit({{var,asn1ct_name:curr(bytes)},"}"}), + emit({".",nl,nl}). + +textual_order([#'ComponentType'{textual_order=undefined}|_],TermList) -> + TermList; +textual_order(CompList,TermList) when is_list(CompList) -> + TermTuple = list_to_tuple(TermList), %% ['Term1','Term2',...'TermN'] + %% OrderList is ordered by canonical order of tags + TmpTuple = TermTuple, + OrderList = [Ix||#'ComponentType'{textual_order=Ix} <- CompList], + Fun = fun(X,{Tpl,Ix}) -> + + {setelement(X,Tpl,element(Ix,TermTuple)),Ix+1} + end, + {Ret,_} = lists:foldl(Fun,{TmpTuple,1},OrderList), +%% io:format("TermTuple: ~p~nOrderList: ~p~nRet: ~p~n",[TermTuple,OrderList,tuple_to_list(Ret)]), + tuple_to_list(Ret); +textual_order({Root,Ext},TermList) -> + textual_order(Root ++ Ext,TermList); +textual_order({Root1,Ext,Root2},TermList) -> + textual_order(Root1 ++ Ext ++ Root2, TermList). + +to_textual_order({Root,Ext}) -> + {to_textual_order(Root),Ext}; +to_textual_order(Cs) when is_list(Cs) -> + case Cs of + [#'ComponentType'{textual_order=undefined}|_] -> + Cs; + _ -> + lists:keysort(#'ComponentType'.textual_order,Cs) + end; +to_textual_order(Cs) -> + Cs. + +gen_dec_listofopentypes(_,[],_) -> + emit(nl); +gen_dec_listofopentypes(DecObj,[{_Cname,{FirstPFN,PFNList},Term,TmpTerm,Prop}|Rest],_Update) -> + + 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(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(Erule,Typename,D) when is_record(D,type) -> + {'CHOICE',CompList} = D#type.def, + emit({"[",nl}), + Ext = extensible(CompList), + gen_enc_choice(Erule,Typename,CompList,Ext), + emit({nl,"].",nl}). + +gen_decode_choice(Erules,Typename,D) when is_record(D,type) -> + asn1ct_name:start(), + asn1ct_name:clear(), + asn1ct_name:new(bytes), + {'CHOICE',CompList} = D#type.def, + Ext = extensible(CompList), + gen_dec_choice(Erules,Typename,CompList,Ext), + emit({".",nl}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Encode generator for SEQUENCE OF type + + +gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) -> + asn1ct_name:start(), + {_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(Erule,Typename,SeqOrSetOf,NewComponentType). + +gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> + asn1ct_name:start(), + {_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(Erules,Typename,SeqOrSetOf,NewComponentType). + +gen_encode_sof_components(Erule,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,Erule,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}); + 'ASN1_OPEN_TYPE' -> + gen_encode_prim_wrapper(Ctgenmod,Erule, + #type{def='ASN1_OPEN_TYPE'}, + false,"H"); + _ -> + emit({"'enc_",Conttype,"'(H)",nl,nl}) + end, + emit({" | Acc]).",nl}). + +gen_decode_sof_components(Erule,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()])), + CurrMod = get(currmod), + case asn1ct_gen:type(Conttype) of + {primitive,bif} -> + Ctgenmod:gen_dec_prim(Erule,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=CurrMod,type=EType} -> + emit({"'dec_",EType,"'(Bytes,telltype),",nl}); + #'Externaltypereference'{module=EMod,type=EType} -> + emit({"'",EMod,"':'dec_",EType,"'(Bytes,telltype),",nl}); + 'ASN1_OPEN_TYPE' -> + Ctgenmod:gen_dec_prim(Erule,#type{def='ASN1_OPEN_TYPE'}, + "Bytes"), + emit({com,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 is_list(CompList) -> + noext; +extensible({RootList,ExtList}) -> + {ext,length(RootList)+1,length(ExtList)}; +extensible({Rl1,Ext,_Rl2}) -> + {ext,length(Rl1)+1,length(Ext)}. + +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({L1,_Ext,L2}) -> optionals(L1++L2,[],2); +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',Val}}|Rest],Acc,Pos) -> + optionals(Rest,[{Pos,Val}|Acc],Pos+1); +optionals([#'ComponentType'{}|Rest],Acc,Pos) -> + optionals(Rest,Acc,Pos+1); +optionals([],Acc,_) -> + lists:reverse(Acc). + +%%%%%%%%%%%%%%%%%%%%%% +%% create_optionality_table(Cs=[#'ComponentType'{textual_order=undefined}|_]) -> +%% {NewCs,_} = lists:mapfoldl(fun(C,Num) -> +%% {C#'ComponentType'{textual_order=Num}, +%% Num+1} +%% end, +%% 1,Cs), +%% create_optionality_table(NewCs); +create_optionality_table(Cs) -> + IsOptional = fun('OPTIONAL') -> true; + ({'DEFAULT',_}) -> true; + (_) -> false + end, + OptionalsElNum = [TO || #'ComponentType'{prop = O,textual_order=TO} <- Cs, + IsOptional(O)], + {Table,_} = lists:mapfoldl(fun(X,Num) -> + {{Num,X},Num+1} + end, + 1,lists:sort(OptionalsElNum)), + Table. +get_optionality_pos(TextPos,OptTable) -> + case lists:keysearch(TextPos,2,OptTable) of + {value,{OptNum,_}} -> + OptNum; + _ -> + no_num + end. + +add_textual_order(Cs) when is_list(Cs) -> + {NewCs,_} = add_textual_order1(Cs,1), + NewCs; +add_textual_order({Root,Ext}) -> + {NewRoot,Num} = add_textual_order1(Root,1), + {NewExt,_} = add_textual_order1(Ext,Num), + {NewRoot,NewExt}; +add_textual_order({R1,Ext,R2}) -> + {NewR1,Num1} = add_textual_order1(R1,1), + {NewExt,Num2} = add_textual_order1(Ext,Num1), + {NewR2,_} = add_textual_order1(R2,Num2), + {NewR1,NewExt,NewR2}. +add_textual_order1(Cs=[#'ComponentType'{textual_order=Int}|_],I) + when is_integer(Int) -> + {Cs,I}; +add_textual_order1(Cs,NumIn) -> + lists:mapfoldl(fun(C,Num) -> + {C#'ComponentType'{textual_order=Num}, + Num+1} + end, + NumIn,Cs). + +gen_enc_components_call(Erule,TopType,{Root1,ExtList,Root2},MaybeComma,DynamicEnc,Ext) -> + Rpos = gen_enc_components_call1(Erule,TopType,Root1,1,MaybeComma,DynamicEnc,noext), + case Ext of + {ext,_,ExtNum} when ExtNum > 0 -> + emit([nl, + ",Extensions",nl]); + _ -> true + end, + Rpos2 = gen_enc_components_call1(Erule,TopType,ExtList,Rpos,MaybeComma,DynamicEnc,Ext), + gen_enc_components_call1(Erule,TopType,Root2,Rpos2,MaybeComma,DynamicEnc,noext); +gen_enc_components_call(Erule,TopType,{CompList,ExtList},MaybeComma,DynamicEnc,Ext) -> + %% The type has extensionmarker + Rpos = gen_enc_components_call1(Erule,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(Erule,TopType,ExtList,Rpos,MaybeComma,DynamicEnc,Ext); +gen_enc_components_call(Erule,TopType, CompList, MaybeComma, DynamicEnc, Ext) -> + %% The type has no extensionmarker + gen_enc_components_call1(Erule,TopType,CompList,1,MaybeComma,DynamicEnc,Ext). + +gen_enc_components_call1(Erule,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 + TermNo = + case C#'ComponentType'.textual_order of + undefined -> + Tpos; + CanonicalNum -> + CanonicalNum + end, + emit(MaybeComma), + case Prop of + 'OPTIONAL' -> + gen_enc_component_optional(Erule,TopType,Cname,Type,TermNo,DynamicEnc,Ext); + {'DEFAULT',DefVal} -> + gen_enc_component_default(Erule,TopType,Cname,Type,TermNo,DynamicEnc,Ext,DefVal); + _ -> + case Ext of + {ext,ExtPos,_} when Tpos >= ExtPos -> + gen_enc_component_optional(Erule,TopType,Cname,Type,TermNo,DynamicEnc,Ext); + _ -> + gen_enc_component_mandatory(Erule,TopType,Cname,Type,TermNo,DynamicEnc,Ext) + end + end, + + erase(component_type), + + case Rest of + [] -> + Tpos+1; + _ -> + emit({com,nl}), + gen_enc_components_call1(Erule,TopType,Rest,Tpos+1,"",DynamicEnc,Ext) + end; +gen_enc_components_call1(_Erule,_TopType,[],Pos,_,_,_) -> + Pos. + +gen_enc_component_default(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext,DefaultVal) -> + Element = make_element(Pos+1,"Val1",Cname), + emit({"case ",Element," of",nl}), +% emit({"asn1_DEFAULT -> [];",nl}), + emit({"DFLT when DFLT == asn1_DEFAULT; DFLT == ",{asis,DefaultVal}," -> [];",nl}), + + 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(Erule,TopType,Cname,Type,NextElement, Pos,DynamicEnc,Ext), + emit({nl,"end"}). +gen_enc_component_optional(Erule,TopType,Cname,Type,Pos,DynamicEnc,Ext) -> + Element = make_element(Pos+1,"Val1",Cname), + emit({"case ",Element," of",nl}), + + emit({"asn1_NOVALUE -> [];",nl}), + 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(Erule,TopType,Cname,Type,NextElement, Pos,DynamicEnc,Ext), + emit({nl,"end"}). + +gen_enc_component_mandatory(Erule,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(Erule,TopType,Cname,Type,[],Pos,DynamicEnc,Ext). + +gen_enc_line(Erule,TopType, Cname, Type, [], Pos,DynamicEnc,Ext) -> + Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val)),Cname), + gen_enc_line(Erule,TopType,Cname,Type,Element, Pos,DynamicEnc,Ext); +gen_enc_line(Erule,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 Ext of + {ext,_Ep1,_} -> + emit(["?RT_PER:encode_open_type(dummy,?RT_PER:complete("]); + _ -> true + end, + case Atype of + {typefield,_} -> + case DynamicEnc of + {_LeadingAttrName,Fun} -> + case (Type#type.def)#'ObjectClassFieldType'.fieldname of + {notype,T} -> + throw({error,{notype,type_from_object,T}}); + {Name,RestFieldNames} when is_atom(Name) -> + emit({"?RT_PER:encode_open_type([],?RT_PER:complete(",nl}), + 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,Erule,EncType, + false,Element); + 'ASN1_OPEN_TYPE' -> + case Type#type.def of + #'ObjectClassFieldType'{type=OpenType} -> + gen_encode_prim_wrapper(Ctgenmod,Erule, + #type{def=OpenType}, + false,Element); + _ -> + gen_encode_prim_wrapper(Ctgenmod,Erule,Type, + false,Element) + end; + {constructed,bif} -> + NewTypename = [Cname|TopType], + case {Type#type.tablecinf,DynamicEnc} of + {[{objfun,_}|_R],{_,EncFun}} -> + emit({"'enc_", + asn1ct_gen:list2name(NewTypename), + "'(",Element,", ",EncFun,")"}); + _ -> + emit({"'enc_", + asn1ct_gen:list2name(NewTypename), + "'(",Element,")"}) + end + end + end, + case Ext of + {ext,_Ep2,_} -> + emit(["))"]); + _ -> true + end. +gen_dec_components_call(Erule,TopType,{Root1,ExtList,Root2},MaybeComma,DecInfObj,Ext,NumberOfOptionals) -> + %% The type has extensionmarker + OptTable = create_optionality_table(Root1 ++ Root2), + {Rpos,AccTerm,AccBytes} = + gen_dec_components_call1(Erule,TopType, Root1, 1, OptTable, + 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(Erule,TopType,ExtList,Rpos, OptTable, "", + 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), + {_RPos2,AccTerm2,AccBytes2} = + gen_dec_components_call1(Erule,TopType,Root2,Epos,OptTable, + "",DecInfObj,noext,[],[],NumberOfOptionals), + {AccTerm++AccTermE++AccTerm2,AccBytes++AccBytesE++AccBytes2}; +gen_dec_components_call(Erule,TopType,{CompList,ExtList},MaybeComma, + DecInfObj,Ext,NumberOfOptionals) -> + %% The type has extensionmarker + OptTable = create_optionality_table(CompList), + {Rpos,AccTerm,AccBytes} = + gen_dec_components_call1(Erule,TopType, CompList, 1, OptTable, + 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(Erule,TopType,ExtList,Rpos, OptTable, + "",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(Erule,TopType,CompList,MaybeComma,DecInfObj, + Ext,NumberOfOptionals) -> + %% The type has no extensionmarker + OptTable = create_optionality_table(CompList), + {_,AccTerm,AccBytes} = + gen_dec_components_call1(Erule,TopType, CompList, 1, OptTable, + MaybeComma,DecInfObj,Ext,[],[], + NumberOfOptionals), + {AccTerm,AccBytes}. + + +gen_dec_components_call1(Erule,TopType, + [C=#'ComponentType'{name=Cname,typespec=Type,prop=Prop,textual_order=TextPos}|Rest], + Tpos,OptTable,MaybeComma,DecInfObj,Ext,AccTerm,AccBytes,NumberOfOptionals) -> + Pos = case Ext of + noext -> Tpos; + {ext,Epos,_Enum} -> Tpos - Epos + 1 + end, + emit(MaybeComma), + InnerType = + case Type#type.def of + #'ObjectClassFieldType'{type=InType} -> + InType; + Def -> + asn1ct_gen:get_inner(Def) + end, + + case InnerType of + #'Externaltypereference'{type=T} -> + emit({nl,"%% attribute number ",TextPos," with type ", + T,nl}); + IT when is_tuple(IT) -> + emit({nl,"%% attribute number ",TextPos," with type ", + element(2,IT),nl}); + _ -> + emit({nl,"%% attribute number ",TextPos," with type ", + InnerType,nl}) + end, + + IsMandatoryAndPredefinedTableC = + fun(noext,mandatory,{"got objfun through args","ObjFun"}) -> + true; + (_,_,{"got objfun through args","ObjFun"}) -> + false; + (_,_,_) -> + true + end, + case {InnerType,IsMandatoryAndPredefinedTableC(Ext,Prop,DecInfObj)} of +%% {typefield,_} when Ext == noext, Prop == mandatory -> + {{typefield,_},true} -> + %% DecInfObj /= {"got objfun through args","ObjFun"} | + %% (DecInfObj == {"got objfun through args","ObjFun"} & + %% Ext == noext & Prop == mandatory) + asn1ct_name:new(term), + asn1ct_name:new(tmpterm), + emit({"{",{curr,tmpterm},", ",{next,bytes},"} = "}); + %%{objectfield,_,_} when Ext == noext, Prop == mandatory -> + {{objectfield,_,_},true} -> + asn1ct_name:new(term), + asn1ct_name:new(tmpterm), + emit({"{",{curr,tmpterm},", ",{next,bytes},"} = "}); + _ -> + asn1ct_name:new(term), + emit({"{",{curr,term},",",{next,bytes},"} = "}) + end, + + case {Ext,Prop,is_optimized(Erule)} of + {noext,mandatory,_} -> ok; % generate nothing + {noext,_,_} -> %% OPTIONAL or DEFAULT + OptPos = get_optionality_pos(TextPos,OptTable), + Element = io_lib:format("Opt band (1 bsl ~w)",[NumberOfOptionals - OptPos]), + emit(["case ",Element," of",nl]), + emit([" _Opt",TextPos," when _Opt",TextPos," > 0 ->"]); + {_,_,false} -> %% extension element, not bitstring + emit(["case Extensions of",nl]), + emit([" _ when size(Extensions) >= ",Pos,",element(",Pos,",Extensions) == 1 ->",nl]); + _ -> + emit(["case Extensions of",nl]), + emit([" <<_:",Pos-1,",1:1,_/bitstring>> when bit_size(Extensions) >= ",Pos," ->",nl]) + end, + put(component_type,{true,C}), + {TermVar,BytesVar} = gen_dec_line(Erule,TopType,Cname,Type,Tpos,DecInfObj,Ext,Prop), + 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,"end"]); + _ -> + emit([";",nl,"_ ->",nl]), + gen_dec_component_no_val(TopType,Cname,Type,Prop,Tpos,Ext), + emit([nl,"end"]) + end, + asn1ct_name:new(bytes), + case Rest of + [] -> + {Tpos+1,AccTerm++TermVar,AccBytes++BytesVar}; + _ -> + emit({com,nl}), + gen_dec_components_call1(Erule,TopType,Rest,Tpos+1,OptTable, + "",DecInfObj,Ext, AccTerm++TermVar, + AccBytes++BytesVar,NumberOfOptionals) + end; + +gen_dec_components_call1(_,_TopType,[],Pos,_OptTable,_,_,_,AccTerm,AccBytes,_NumberOfOptionals) -> + {Pos,AccTerm,AccBytes}. + + +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(Erule,TopType,Cname,Type,Pos,DecInfObj,Ext,Prop) -> + 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, + + 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_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),"{",{asis,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. + if + Ext == noext andalso Prop == mandatory -> + ok; + true -> + asn1ct_name:new(tmpterm), + asn1ct_name:new(tmpbytes), + emit([nl," {",{curr,tmpterm},", ",{curr,tmpbytes},"} ="]) + end, + {Name,RestFieldNames} = + (Type#type.def)#'ObjectClassFieldType'.fieldname, + emit(["?RT_PER:decode_open_type(",{curr,bytes}, + ", []),",nl]), + if + Ext == noext andalso Prop == mandatory -> + emit([{curr,term}," =",nl," "]); + true -> + emit([" {"]) + end, + emit(["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"]), + if + Ext == noext andalso Prop == mandatory -> + ok; + true -> + emit([",",nl,{curr,tmpbytes},"}"]) + end, + []; + _ -> + emit(["?RT_PER:decode_open_type(",{curr,bytes}, + ", [])"]), + RefedFieldName = + (Type#type.def)#'ObjectClassFieldType'.fieldname, + + [{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(Erule,Btype, + BytesVar); + _ -> + Ctgenmod:gen_dec_prim(Erule,Type, + BytesVar) + end; + 'ASN1_OPEN_TYPE' -> + case Type#type.def of + #'ObjectClassFieldType'{type=OpenType} -> + Ctgenmod:gen_dec_prim(Erule,#type{def=OpenType}, + BytesVar); + _ -> + Ctgenmod:gen_dec_prim(Erule,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), + {ObjSetMod,ObjSetName} = + case OSet of + {M,O} -> {{asis,M},O}; + _ -> {"?MODULE",OSet} + end, + emit({",",nl,"ObjFun = ",ObjSetMod, + ":'getdec_",ObjSetName,"'(", + {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} -> + ObjSetRef = + case ObjSet of + {deep,OSName,_,_} -> + OSName; + _ -> ObjSet + end, + {[{ObjSetRef,Cname,asn1ct_gen:mk_var(asn1ct_name:curr(term))}], + SaveBytes}; + _ -> + {[],SaveBytes} + end. + +gen_enc_choice(Erule,TopType,CompList,Ext) -> + gen_enc_choice_tag(CompList, [], Ext), + emit({com,nl}), + emit({"case element(1,Val) of",nl}), + gen_enc_choice2(Erule,TopType, CompList, Ext), + emit({nl,"end"}). + +gen_enc_choice_tag({C1,C2},_,_) -> + 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_choice2(Erule,TopType, {L1,L2}, Ext) -> + gen_enc_choice2(Erule,TopType, L1 ++ L2, 0, Ext); +gen_enc_choice2(Erule,TopType, L, Ext) -> + gen_enc_choice2(Erule,TopType, L, 0, Ext). + +gen_enc_choice2(Erule,TopType,[H1,H2|T], Pos, Ext) +when is_record(H1,'ComponentType'), is_record(H2,'ComponentType') -> + Cname = H1#'ComponentType'.name, + Type = H1#'ComponentType'.typespec, + EncObj = + case asn1ct_gen:get_constraint(Type#type.constraint, + componentrelation) of + no -> + case Type#type.tablecinf of + [{objfun,_}|_] -> + {"got objfun through args","ObjFun"}; + _ ->false + end; + _ -> {no_attr,"ObjFun"} + end, + emit({{asis,Cname}," ->",nl}), + DoExt = case Ext of + {ext,ExtPos,_} when (Pos + 1) < ExtPos -> noext; + _ -> Ext + end, + gen_enc_line(Erule,TopType,Cname,Type,"element(2,Val)", + Pos+1,EncObj,DoExt), + emit({";",nl}), + gen_enc_choice2(Erule,TopType,[H2|T], Pos+1, Ext); +gen_enc_choice2(Erule,TopType,[H1|T], Pos, Ext) + when is_record(H1,'ComponentType') -> + Cname = H1#'ComponentType'.name, + Type = H1#'ComponentType'.typespec, + EncObj = + case asn1ct_gen:get_constraint(Type#type.constraint, + componentrelation) of + no -> + case Type#type.tablecinf of + [{objfun,_}|_] -> + {"got objfun through args","ObjFun"}; + _ ->false + end; + _ -> {no_attr,"ObjFun"} + end, + emit({{asis,H1#'ComponentType'.name}," ->",nl}), + DoExt = case Ext of + {ext,ExtPos,_} when (Pos + 1) < ExtPos -> noext; + _ -> Ext + end, + gen_enc_line(Erule,TopType,Cname,Type,"element(2,Val)", + Pos+1,EncObj,DoExt), + gen_enc_choice2(Erule,TopType,T, Pos+1, Ext); +gen_enc_choice2(_Erule,_,[], _, _) -> + true. + +gen_dec_choice(Erule,TopType,CompList,{ext,Pos,NumExt}) -> + emit({"{Ext,",{curr,bytes},"} = ?RT_PER:getbit(Bytes),",nl}), + asn1ct_name:new(bytes), + gen_dec_choice1(Erule,TopType,CompList,{ext,Pos,NumExt}); +gen_dec_choice(Erule,TopType,CompList,noext) -> + gen_dec_choice1(Erule,TopType,CompList,noext). + +gen_dec_choice1(Erule,TopType,CompList,noext) -> + emit({"{Choice,",{curr,bytes}, + "} = ?RT_PER:getchoice(",{prev,bytes},",", + length(CompList),", 0),",nl}), + emit({"{Cname,{Val,NewBytes}} = case Choice of",nl}), + gen_dec_choice2(Erule,TopType,CompList,noext), + emit({nl,"end,",nl}), + emit({nl,"{{Cname,Val},NewBytes}"}); +gen_dec_choice1(Erule,TopType,{RootList,ExtList},Ext) -> + NewList = RootList ++ ExtList, + gen_dec_choice1(Erule,TopType, NewList, Ext); +gen_dec_choice1(Erule,TopType,CompList,{ext,ExtPos,ExtNum}) -> + emit({"{Choice,",{curr,bytes}, + "} = ?RT_PER:getchoice(",{prev,bytes},",", + length(CompList)-ExtNum,",Ext ),",nl}), + emit({"{Cname,{Val,NewBytes}} = case Choice + Ext*",ExtPos-1," of",nl}), + gen_dec_choice2(Erule,TopType,CompList,{ext,ExtPos,ExtNum}), + case Erule of + per -> + emit([";",nl,"_ -> {asn1_ExtAlt,",nl, + " fun() -> ",nl, + " {XTerm,XBytes} = ?RT_PER:decode_open_type(", + {curr,bytes},",[]),",nl, + " {binary_to_list(XTerm),XBytes}",nl, + " end()}"]); + _ -> + emit([";",nl,"_ -> {asn1_ExtAlt, ?RT_PER:decode_open_type(", + {curr,bytes},",[])}"]) + end, + emit({nl,"end,",nl}), + emit({nl,"{{Cname,Val},NewBytes}"}). + + +gen_dec_choice2(Erule,TopType,L,Ext) -> + gen_dec_choice2(Erule,TopType,L,0,Ext). + +gen_dec_choice2(Erule,TopType,[H1,H2|T],Pos,Ext) +when is_record(H1,'ComponentType'), is_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(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext), + emit({";",nl}); + _ -> + emit({Pos," -> {",{asis,Cname},",",nl}), + wrap_gen_dec_line(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext), + emit({"};",nl}) + end, + gen_dec_choice2(Erule,TopType,[H2|T],Pos+1,Ext); +gen_dec_choice2(Erule,TopType,[H1,_H2|T],Pos,Ext) when is_record(H1,'ComponentType') -> + gen_dec_choice2(Erule,TopType,[H1|T],Pos,Ext); % skip extensionmark +gen_dec_choice2(Erule,TopType,[H1|T],Pos,Ext) when is_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(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext); + _ -> + emit({Pos," -> {",{asis,Cname},",",nl}), + wrap_gen_dec_line(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext), + emit("}") + end, + gen_dec_choice2(Erule,TopType,[T],Pos+1); +gen_dec_choice2(Erule,TopType,[_|T],Pos,Ext) -> + gen_dec_choice2(Erule,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 tuple_notation_allowed() of + true -> + io_lib:format("?RT_PER:cindex(~w,~s,~w)",[I,Val,Cname]); + _ -> + io_lib:format("element(~w,~s)",[I,Val]) + end. + +tuple_notation_allowed() -> + Options = get(encoding_options), + not (lists:member(optimize,Options) orelse lists:member(uper_bin,Options)). + +wrap_gen_dec_line(Erule,C,TopType,Cname,Type,Pos,DIO,Ext) -> + put(component_type,{true,C}), + gen_dec_line(Erule,TopType,Cname,Type,Pos,DIO,Ext,mandatory), + erase(component_type). + +get_components_prop() -> + case get(component_type) of + undefined -> + mandatory; + {true,#'ComponentType'{prop=Prop}} -> Prop + end. + + +value_match(Index,Value) when is_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}). + +is_optimized(per_bin) -> + lists:member(optimize,get(encoding_options)); +is_optimized(_Erule) -> + false. diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl new file mode 100644 index 0000000000..fefb92bb34 --- /dev/null +++ b/lib/asn1/src/asn1ct_gen.erl @@ -0,0 +1,2066 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_gen). + +-include("asn1_records.hrl"). +%%-compile(export_all). +-export([pgen_exports/3, + pgen_hrl/4, + gen_head/3, + demit/1, + emit/1, + get_inner/1,type/1,def_to_tag/1,prim_bif/1, + type_from_object/1, + get_typefromobject/1,get_fieldcategory/2, + get_classfieldcategory/2, + list2name/1, + list2rname/1, + constructed_suffix/2, + unify_if_string/1, + gen_check_call/7, + get_constraint/2, + insert_once/2, + rt2ct_suffix/1, + rt2ct_suffix/0, + index2suffix/1, + get_record_name_prefix/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 = {Types,_Values,_Ptypes,_Classes,_Objects,_ObjectSets}, + Indent) -> + N2nConvEnums = [CName|| {n2n,CName} <- get(encoding_options)], + case N2nConvEnums -- Types of + [] -> + ok; + UnmatchedTypes -> + exit({"Non existing ENUMERATION types used in n2n option", + UnmatchedTypes}) + end, + put(outfile,OutFile), + HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Indent), + asn1ct_name:start(), + ErlFile = lists:concat([OutFile,".erl"]), + Fid = fopen(ErlFile,[write]), + put(gen_file_out,Fid), + gen_head(Erules,Module,HrlGenerated), + pgen_exports(Erules,Module,TypeOrVal), + pgen_dispatcher(Erules,Module,TypeOrVal), + pgen_info(), + pgen_typeorval(wrap_ber(Erules),Module,N2nConvEnums,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,N2nConvEnums,{Types,Values,_Ptypes,_Classes,Objects,ObjectSets}) -> + Rtmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), + rt2ct_suffix(Erules)])), + pgen_types(Rtmod,Erules,N2nConvEnums,Module,Types), + pgen_values(Erules,Module,Values), + pgen_objects(Rtmod,Erules,Module,Objects), + pgen_objectsets(Rtmod,Erules,Module,ObjectSets), + case catch lists:member(der,get(encoding_options)) of + true -> + pgen_check_defaultval(Erules,Module); + _ -> ok + end, + pgen_partial_decode(Rtmod,Erules,Module). + +pgen_values(_,_,[]) -> + 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(Rtmod,Erules,N2nConvEnums,Module,[H|T]) -> + asn1ct_name:clear(), + Typedef = asn1_db:dbget(Module,H), + Rtmod:gen_encode(Erules,Typedef), + asn1ct_name:clear(), + Rtmod:gen_decode(Erules,Typedef), + case lists:member(H,N2nConvEnums) of + true -> + pgen_n2nconversion(Erules,Typedef); + _ -> + true + end, + pgen_types(Rtmod,Erules,N2nConvEnums,Module,T). + +pgen_n2nconversion(_Erules,#typedef{name=TypeName,typespec=#type{def={'ENUMERATED',{NN1,NN2}}}}) -> + NN = NN1 ++ NN2, + pgen_name2numfunc(TypeName,NN), + pgen_num2namefunc(TypeName,NN); +pgen_n2nconversion(_Erules,_) -> + true. + +pgen_name2numfunc(_TypeName,[]) -> + true; +pgen_name2numfunc(TypeName,[{Atom,Number}]) -> + emit(["name2num_",TypeName,"(",{asis,Atom},") ->",Number,".",nl,nl]); +pgen_name2numfunc(TypeName,[{Atom,Number}|NNRest]) -> + emit(["name2num_",TypeName,"(",{asis,Atom},") ->",Number,";",nl]), + pgen_name2numfunc(TypeName,NNRest). + +pgen_num2namefunc(_TypeName,[]) -> + true; +pgen_num2namefunc(TypeName,[{Atom,Number}]) -> + emit(["num2name_",TypeName,"(",Number,") ->",{asis,Atom},".",nl,nl]); +pgen_num2namefunc(TypeName,[{Atom,Number}|NNRest]) -> + emit(["num2name_",TypeName,"(",Number,") ->",{asis,Atom},";",nl]), + pgen_num2namefunc(TypeName,NNRest). + +pgen_objects(_,_,_,[]) -> + true; +pgen_objects(Rtmod,Erules,Module,[H|T]) -> + asn1ct_name:clear(), + Typedef = asn1_db:dbget(Module,H), + Rtmod:gen_obj_code(Erules,Module,Typedef), + pgen_objects(Rtmod,Erules,Module,T). + +pgen_objectsets(_,_,_,[]) -> + true; +pgen_objectsets(Rtmod,Erules,Module,[H|T]) -> + asn1ct_name:clear(), + TypeDef = asn1_db:dbget(Module,H), + Rtmod:gen_objectset_code(Erules,TypeDef), + pgen_objectsets(Rtmod,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(Rtmod,Erule,Module) when Erule == ber_bin_v2 -> + pgen_partial_inc_dec(Rtmod,Erule,Module), + pgen_partial_dec(Rtmod,Erule,Module); +pgen_partial_decode(_,_,_) -> + ok. + +pgen_partial_inc_dec(Rtmod,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(Rtmod,Erules,Module,PatternLists), + gen_partial_inc_dec_refed_funcs(Rtmod,Erules) + end. + +%% pgen_partial_inc_dec1 generates a function of the toptype in each +%% of the partial incomplete decoded types. +pgen_partial_inc_dec1(Rtmod,Erules,Module,[P|Ps]) -> + TopTypeName = asn1ct:partial_inc_dec_toptype(P), + TypeDef=asn1_db:dbget(Module,TopTypeName), + asn1ct_name:clear(), + asn1ct:update_gen_state(namelist,P), + asn1ct:update_gen_state(active,true), + asn1ct:update_gen_state(prefix,"dec-inc-"), + case asn1ct:maybe_saved_sindex(TopTypeName,P) of + I when is_integer(I),I > 0 -> +% io:format("Index:~p~n",[I]), + asn1ct:set_current_sindex(I); + _I -> + asn1ct:set_current_sindex(0), +% io:format("Index=~p~n",[_I]), + ok + end, + Rtmod:gen_decode(Erules,TypeDef), + gen_dec_part_inner_constr(Rtmod,Erules,TypeDef,[TopTypeName]), + pgen_partial_inc_dec1(Rtmod,Erules,Module,Ps); +pgen_partial_inc_dec1(_,_,_,[]) -> + ok. + +gen_partial_inc_dec_refed_funcs(Rtmod,Erule) when Erule == ber_bin_v2 -> + case asn1ct:next_refed_func() of + [] -> + ok; + {#'Externaltypereference'{module=M,type=Name},Sindex,Pattern} -> + TypeDef = asn1_db:dbget(M,Name), + asn1ct:update_gen_state(namelist,Pattern), + asn1ct:set_current_sindex(Sindex), + Rtmod:gen_inc_decode(Erule,TypeDef), + gen_dec_part_inner_constr(Rtmod,Erule,TypeDef,[Name]), + gen_partial_inc_dec_refed_funcs(Rtmod,Erule); + {Name,Sindex,Pattern,Type} -> + TypeDef=#typedef{name=asn1ct_gen:list2name(Name),typespec=Type}, + asn1ct:update_gen_state(namelist,Pattern), + asn1ct:set_current_sindex(Sindex), + Rtmod:gen_inc_decode(Erule,TypeDef), + gen_dec_part_inner_constr(Rtmod,Erule,TypeDef,Name), + gen_partial_inc_dec_refed_funcs(Rtmod,Erule) + end; +gen_partial_inc_dec_refed_funcs(_,_) -> + ok. + +pgen_partial_dec(_Rtmod,Erules,_Module) -> + Type_pattern = asn1ct:get_gen_state_field(type_pattern), +% io:format("Type_pattern: ~w~n",[Type_pattern]), + %% Get the typedef of the top type and follow into the choosen components until the last type/component. + pgen_partial_types(Erules,Type_pattern), + ok. + +pgen_partial_types(Erules,Type_pattern) -> + % until this functionality works on all back-ends + Options = get(encoding_options), + case lists:member(asn1config,Options) of + true -> + pgen_partial_types1(Erules,Type_pattern); + _ -> ok + end. + + +pgen_partial_types1(Erules,[{FuncName,[TopType|RestTypes]}|Rest]) -> +% emit([FuncName,"(Bytes) ->",nl]), + CurrMod = get(currmod), + TypeDef = asn1_db:dbget(CurrMod,TopType), + traverse_type_structure(Erules,TypeDef,RestTypes,FuncName, + TypeDef#typedef.name), + pgen_partial_types1(Erules,Rest); +pgen_partial_types1(_,[]) -> + ok; +pgen_partial_types1(_,undefined) -> + ok. + +%% traverse_type_structure searches the structure of TypeDef for next +%% type/component in TypeList until the last one. For the last type in +%% TypeList a decode function will be generated. +traverse_type_structure(Erules,Type,[],FuncName,TopTypeName) -> + %% this is the selected type + Ctmod = list_to_atom(lists:concat(["asn1ct_gen_",erule(Erules), + rt2ct_suffix(Erules)])), + TypeDef = + case Type of + #type{} -> + #typedef{name=TopTypeName,typespec=Type}; + #typedef{} -> Type + end, + Ctmod:gen_decode_selected(Erules,TypeDef,FuncName); % what if Type is #type{} +traverse_type_structure(Erules,#type{def=Def},[[N]],FuncName,TopTypeName) + when is_integer(N) -> % this case a decode of one of the elements in + % the SEQUENCE OF is required. + InnerType = asn1ct_gen:get_inner(Def), + case InnerType of + 'SEQUENCE OF' -> + {_,Type} = Def, + traverse_type_structure(Erules,Type,[],FuncName,TopTypeName); + WrongType -> + exit({error,{configuration_file_error,[N],"only for SEQUENCE OF components",WrongType}}) + end; +traverse_type_structure(Erules,Type,[[N]|Ts],FuncName,TopTypeName) + when is_integer(N) -> + traverse_type_structure(Erules,Type,Ts,FuncName,TopTypeName); +traverse_type_structure(Erules,#type{def=Def},[T|Ts],FuncName,TopTypeName) -> + InnerType = asn1ct_gen:get_inner(Def), + case InnerType of + 'SET' -> + #'SET'{components=Components} = Def, + C = get_component(T,Components), + traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts, + FuncName,[T|TopTypeName]); + 'SEQUENCE' -> + #'SEQUENCE'{components=Components} = Def, + C = get_component(T,Components), + traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts, + FuncName,[T|TopTypeName]); + 'CHOICE' -> + {_,Components} = Def, + C = get_component(T,Components), + traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts, + FuncName,[T|TopTypeName]); + 'SEQUENCE OF' -> + {_,Type} = Def, + traverse_SO_type_structure(Erules,Type,[T|Ts],FuncName, + TopTypeName); + 'SET OF' -> + {_,Type} = Def, + traverse_SO_type_structure(Erules,Type,[T|Ts],FuncName, + TopTypeName); + #'Externaltypereference'{module=M,type=TName} -> + TypeDef = asn1_db:dbget(M,TName), + traverse_type_structure(Erules,TypeDef,[T|Ts],FuncName, + [TypeDef#typedef.name]); + _ -> + traverse_type_structure(Erules,Def,Ts,FuncName,[T|TopTypeName]) + end; +traverse_type_structure(Erules,#typedef{typespec=Def},[T|Ts],FuncName, + TopTypeName) -> + InnerType = asn1ct_gen:get_inner(Def#type.def), + case InnerType of + 'SET' -> + #'SET'{components=Components} = Def#type.def, + C = get_component(T,Components), + traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts, + FuncName,[T|TopTypeName]); + 'SEQUENCE' -> + #'SEQUENCE'{components=Components} = Def#type.def, + C = get_component(T,Components), + traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts, + FuncName,[T|TopTypeName]); + 'CHOICE' -> + {_,Components} = Def#type.def, + C = get_component(T,Components), + traverse_type_structure(Erules,C#'ComponentType'.typespec,Ts, + FuncName,[T|TopTypeName]); + 'SEQUENCE OF' -> + {_,Type} = Def#type.def, + traverse_SO_type_structure(Erules,Type,[T|Ts],FuncName, + TopTypeName); + 'SET OF' -> + {_,Type} = Def#type.def, + traverse_SO_type_structure(Erules,Type,[T|Ts],FuncName, + TopTypeName); + #'Externaltypereference'{module=M,type=TName} -> + TypeDef = asn1_db:dbget(M,TName), + traverse_type_structure(Erules,TypeDef,[T|Ts],FuncName, + [TypeDef#typedef.name]); + _ -> %this may be a referenced type that shall be traversed or + %the selected type + traverse_type_structure(Erules,Def,Ts,FuncName,[T|TopTypeName]) + end. + +traverse_SO_type_structure(Erules,Type,[N|Rest],FuncName,TopTypeName) + when is_integer(N) -> + traverse_type_structure(Erules,Type,Rest,FuncName,TopTypeName); +traverse_SO_type_structure(Erules,Type,TypeList,FuncName,TopTypeName) -> + traverse_type_structure(Erules,Type,TypeList,FuncName,TopTypeName). + +get_component(Name,{C1,C2}) when is_list(C1),is_list(C2) -> + get_component(Name,C1++C2); +get_component(Name,[C=#'ComponentType'{name=Name}|_Cs]) -> + C; +get_component(Name,[_C|Cs]) -> + get_component(Name,Cs); +get_component(Name,_) -> + throw({error,{asn1,{internal_error,Name}}}). + +%% generate code for all inner types that are called from the top type +%% of the partial incomplete decode and are defined within the top +%% type.Constructed subtypes deeper in the structure will be generated +%% in turn after all top types have been generated. +gen_dec_part_inner_constr(Rtmod,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(Rtmod,Erules,Components,TypeName); + %% Continue generate the inner of each component + 'SEQUENCE' -> + #'SEQUENCE'{components=Components} = Def#type.def, + gen_dec_part_inner_types(Rtmod,Erules,Components,TypeName); + 'CHOICE' -> + {_,Components} = Def#type.def, + gen_dec_part_inner_types(Rtmod,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), + 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), + asn1ct_name:clear(), + Rtmod:gen_decode(Erules,[NameSuffix|TypeName],Type); + _ -> + ok + end. + +gen_dec_part_inner_types(Rtmod,Erules,[ComponentType|Rest],TypeName) -> + asn1ct_name:clear(), + Rtmod:gen_decode(Erules,TypeName,ComponentType), + gen_dec_part_inner_types(Rtmod,Erules,Rest,TypeName); +gen_dec_part_inner_types(Rtmod,Erules,{Comps1,Comps2},TypeName) + when is_list(Comps1),is_list(Comps2) -> + gen_dec_part_inner_types(Rtmod,Erules,Comps1 ++ Comps2,TypeName); +gen_dec_part_inner_types(_,_,[],_) -> + ok. + + +pgen_partial_incomplete_decode(Erule) -> + case asn1ct:get_gen_state_field(active) of + true -> + pgen_partial_incomplete_decode1(Erule), + asn1ct:reset_gen_state(); + _ -> + ok + end. +pgen_partial_incomplete_decode1(ber_bin_v2) -> + case asn1ct:read_config_data(partial_incomplete_decode) of + undefined -> + ok; + Data -> + lists:foreach(fun emit_partial_incomplete_decode/1,Data) + end, + GeneratedFs= asn1ct:get_gen_state_field(gen_refed_funcs), +% io:format("GeneratedFs :~n~p~n",[GeneratedFs]), + gen_part_decode_funcs(GeneratedFs,0); +pgen_partial_incomplete_decode1(_) -> ok. + +emit_partial_incomplete_decode({FuncName,TopType,Pattern}) -> + TypePattern = asn1ct:get_gen_state_field(inc_type_pattern), + TPattern = + case lists:keysearch(FuncName,1,TypePattern) of + {value,{_,TP}} -> TP; + _ -> exit({error,{asn1_internal_error,exclusive_decode}}) + end, + TopTypeName = + case asn1ct:maybe_saved_sindex(TopType,TPattern) of + I when is_integer(I),I>0 -> + lists:concat([TopType,"_",I]); + _ -> + atom_to_list(TopType) + end, + emit([{asis,FuncName},"(Bytes) ->",nl, + " decode_partial_incomplete('",TopTypeName,"',Bytes,",{asis,Pattern},").",nl]); +emit_partial_incomplete_decode(D) -> + throw({error,{asn1,{"bad data in asn1config file",D}}}). + +gen_part_decode_funcs([Data={Name,_,_,Type}|GeneratedFs],N) -> + InnerType = + case Type#type.def of + #'ObjectClassFieldType'{type=OCFTType} -> + OCFTType; + _ -> + get_inner(Type#type.def) + end, + WhatKind = type(InnerType), + TypeName=list2name(Name), + if + N > 0 -> emit([";",nl]); + true -> ok + end, + emit(["decode_inc_disp('",TypeName,"',Data) ->",nl]), + gen_part_decode_funcs(WhatKind,TypeName,Data), + gen_part_decode_funcs(GeneratedFs,N+1); +gen_part_decode_funcs([_H|T],N) -> + gen_part_decode_funcs(T,N); +gen_part_decode_funcs([],N) -> + if + N > 0 -> + emit([".",nl]); + true -> + ok + end. + +gen_part_decode_funcs(#'Externaltypereference'{module=M,type=T}, + _TypeName,Data) -> + #typedef{typespec=TS} = asn1_db:dbget(M,T), + InnerType = + case TS#type.def of + #'ObjectClassFieldType'{type=OCFTType} -> + OCFTType; + _ -> + get_inner(TS#type.def) + end, + WhatKind = type(InnerType), + gen_part_decode_funcs(WhatKind,[T],Data); +gen_part_decode_funcs({constructed,bif},TypeName, + {_Name,parts,Tag,_Type}) -> + emit([" case Data of",nl, + " L when is_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,{RootL1,ExtList,RootL2}) + when is_list(RootL1), is_list(RootL2) -> + gen_types(Erules,Tname,RootL1), + gen_types(Erules,Tname,ExtList), + gen_types(Erules,Tname,RootL2); +gen_types(Erules,Tname,{RootList,ExtList}) when is_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 is_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}) -> + EncName = ensure_atom(Name), + emit({{asis,EncName},"(_V,asn1_DEFAULT) ->",nl," true;",nl}), + emit({{asis,EncName},"(V,V) ->",nl," true;",nl}), + emit({{asis,EncName},"(V,{_,V}) ->",nl," true;",nl}), + case Def of + {'SEQUENCE OF',Type} -> + gen_check_sof(Name,'SEQOF',Type); + {'SET OF',Type} -> + gen_check_sof(Name,'SETOF',Type); + #'SEQUENCE'{components=Components} -> + gen_check_sequence(Name,Components); + #'SET'{components=Components} -> + gen_check_sequence(Name,Components); + {'CHOICE',Components} -> + gen_check_choice(Name,Components); + #'Externaltypereference'{type=T} -> + emit({{asis,EncName},"(DefaultValue,Value) ->",nl}), + emit({" '",list2name([T,check]),"'(DefaultValue,Value).",nl}); + MaybePrim -> + InnerType = get_inner(MaybePrim), + case type(InnerType) of + {primitive,bif} -> + emit({{asis,EncName},"(DefaultValue,Value) ->",nl," "}), + gen_prim_check_call(get_inner(InnerType),"DefaultValue","Value", + FType), + emit({".",nl,nl}); + _ -> + throw({asn1_error,{unknown,type,MaybePrim}}) + end + end. + +gen_check_sof(Name,SOF,Type) -> + EncName = ensure_atom(Name), + NewName = ensure_atom(list2name([sorted,Name])), + emit({{asis,EncName},"(V1,V2) ->",nl}), + emit({" ",{asis,NewName},"(lists:sort(V1),lists:sort(V2)).",nl,nl}), + emit({{asis,NewName},"([],[]) ->",nl," true;",nl}), + emit({{asis,NewName},"([DV|DVs],[V|Vs]) ->",nl," "}), + InnerType = get_inner(Type#type.def), + case type(InnerType) of + {primitive,bif} -> + gen_prim_check_call(get_inner(InnerType),"DV","V",Type), + emit({",",nl}); + {constructed,bif} -> + emit([{asis,ensure_atom(list2name([SOF,Name]))},"(DV, V),",nl]); + #'Externaltypereference'{type=T} -> + emit([{asis,ensure_atom(list2name([T,check]))},"(DV,V),",nl]); + 'ASN1_OPEN_TYPE' -> + emit(["DV = V,",nl]); + _ -> + emit(["DV = V,",nl]) + end, + emit({" ",{asis,NewName},"(DVs,Vs).",nl,nl}). + +gen_check_sequence(Name,Components) -> + emit([{asis,ensure_atom(Name)},"(DefaultValue,Value) ->",nl]), + gen_check_sequence(Name,Components,1). +gen_check_sequence(Name,[#'ComponentType'{name=N,typespec=Type}|Cs],Num) -> + InnerType = get_inner(Type#type.def), + NthDefV = ["element(",Num+1,",DefaultValue)"], + NthV = ["element(",Num+1,",Value)"], + gen_check_func_call(Name,Type,InnerType,NthDefV,NthV,N), + case Cs of + [] -> + emit({".",nl,nl}); + _ -> + emit({",",nl}), + gen_check_sequence(Name,Cs,Num+1) + end; +gen_check_sequence(_,[],_) -> + ok. + +gen_check_choice(Name,CList=[#'ComponentType'{}|_Cs]) -> + emit([{asis,ensure_atom(Name)},"({Id,DefaultValue},{Id,Value}) ->",nl]), + emit([" case Id of",nl]), + gen_check_choice_components(Name,CList,1). + +gen_check_choice_components(_,[],_)-> + ok; +gen_check_choice_components(Name,[#'ComponentType'{name=N,typespec=Type}| + Cs],Num) -> + Ind6 = " ", + InnerType = get_inner(Type#type.def), + emit({Ind6,"'",N,"' ->",nl,Ind6}), + gen_check_func_call(Name,Type,InnerType,{var,"defaultValue"}, + {var,"value"},N), + case Cs of + [] -> + emit({nl," end.",nl,nl}); + _ -> + emit({";",nl}), + gen_check_choice_components(Name,Cs,Num+1) + end. + +gen_check_func_call(Name,Type,InnerType,DefVal,Val,N) -> + case type(InnerType) of + {primitive,bif} -> + emit(" "), + gen_prim_check_call(get_inner(InnerType),DefVal,Val,Type); + #'Externaltypereference'{type=T} -> + emit({" ",{asis,ensure_atom(list2name([T,check]))},"(",DefVal,",",Val,")"}); + 'ASN1_OPEN_TYPE' -> + emit([" if",nl, + " ",DefVal," == ",Val," -> true;",nl, + " true -> throw({error,{asn1_open_type}})",nl, + " end",nl]); + {constructed,bif} -> + emit([" ",{asis,ensure_atom(list2name([N,Name]))},"(",DefVal,",",Val,")"]); + _ -> + emit([" if",nl, + " ",DefVal," == ",Val," -> true;",nl, + " true -> throw({error,{asn1_open_type}})",nl, + " end",nl]) + end. + + +%% VARIOUS GENERATOR STUFF +%% ************************************************* +%%************************************************** + +mk_var(X) when is_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 is_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 is_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 is_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 is_record(D,typedef) -> + gen_encode_constructed(Erules,Typename,InnerType,D#typedef.typespec). + +gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,type) -> + Rtmod = list_to_atom(lists:concat(["asn1ct_constructed_",erule(Erules)])), + asn1ct:step_in_constructed(), %% updates namelist for exclusive 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 is_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 [X || {n2n,X} <- get(encoding_options)] of + [] -> ok; + A2nNames -> + emit({"-export([",nl}), + gen_exports1(A2nNames,"name2num_",1), + emit({"-export([",nl}), + gen_exports1(A2nNames,"num2name_",1) + 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(), + gen_selected_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]).",nl]) + 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). + +gen_selected_decode_exports() -> + case asn1ct:get_gen_state_field(type_pattern) of + undefined -> + ok; + L -> + gen_selected_decode_exports(L) + end. + +gen_selected_decode_exports([]) -> + ok; +gen_selected_decode_exports([{FuncName,_}|Rest]) -> + emit(["-export([",FuncName,"/1"]), + gen_selected_decode_exports1(Rest). +gen_selected_decode_exports1([]) -> + emit(["]).",nl,nl]); +gen_selected_decode_exports1([{FuncName,_}|Rest]) -> + emit([",",nl," ",FuncName,"/1"]), + gen_selected_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]), + NoFinalPadding = lists:member(no_final_padding,get(encoding_options)), + 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)"; + uper_bin when NoFinalPadding == true -> + "?RT_PER:complete_NFP(encode_disp(Type,Data))"; + uper_bin -> "?RT_PER:complete(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]), + case Erules of + per -> + emit([" Bytes when is_binary(Bytes) ->",nl, + " {ok,binary_to_list(Bytes)};",nl, + " Bytes ->",nl, + " {ok,binary_to_list(list_to_binary(Bytes))}",nl, + " end.",nl,nl]); + _ -> + emit([" Bytes ->",nl, + " {ok,",EncWrap,"}",nl, + "end.",nl,nl]) + end, + +% 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, + + Return_rest = lists:member(undec_rest,get(encoding_options)), + Data = case {Erules,Return_rest} of + {ber_bin_v2,true} -> "Data0"; + _ -> "Data" + end, + + emit(["decode(Type,",Data,") ->",nl]), + DecAnonymous = + case {Erules,Return_rest} of + {ber_bin_v2,false} -> + io_lib:format("~s~s~s~n", + ["element(1,?RT_BER:decode(Data", + driver_parameter(),"))"]); + {ber_bin_v2,true} -> + emit(["{Data,Rest} = ?RT_BER:decode(Data0", + driver_parameter(),"),",nl]), + "Data"; + _ -> + "Data" + end, + DecWrap = case Erules of + ber -> "wrap_decode(Data)"; + ber_bin_v2 -> + DecAnonymous; + per -> "list_to_binary(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,Return_rest} of + {ber_bin_v2,false} -> + emit([" Result ->",nl, + " {ok,Result}",nl]); + {ber_bin_v2,true} -> + emit([" Result ->",nl, + " {ok,Result,Rest}",nl]); + {per,false} -> + emit([" {X,_Rest} ->",nl, + " {ok,if_binary2list(X)};",nl, + " {X,_Rest,_Len} ->",nl, + " {ok,if_binary2list(X)}",nl]); + {_,false} -> + emit([" {X,_Rest} ->",nl, + " {ok,X};",nl, + " {X,_Rest,_Len} ->",nl, + " {ok,X}",nl]); + {per,true} -> + emit([" {X,{_,Rest}} ->",nl, + " {ok,if_binary2list(X),Rest};",nl, + " {X,{_,Rest},_Len} ->",nl, + " {ok,if_binary2list(X),Rest};",nl, + " {X,Rest} ->",nl, + " {ok,if_binary2list(X),Rest};",nl, + " {X,Rest,_Len} ->",nl, + " {ok,if_binary2list(X),Rest}",nl]); + {per_bin,true} -> + emit([" {X,{_,Rest}} ->",nl, + " {ok,X,Rest};",nl, + " {X,{_,Rest},_Len} ->",nl, + " {ok,X,Rest};",nl, + " {X,Rest} ->",nl, + " {ok,X,Rest};",nl, + " {X,Rest,_Len} ->",nl, + " {ok,X,Rest}",nl]); + {uper_bin,true} -> + emit([" {X,{_,Rest}} ->",nl, + " {ok,X,Rest};",nl, + " {X,{_,Rest},_Len} ->",nl, + " {ok,X,Rest};",nl, + " {X,Rest} ->",nl, + " {ok,X,Rest};",nl, + " {X,Rest,_Len} ->",nl, + " {ok,X,Rest}",nl]); + _ -> + emit([" {X,Rest} ->",nl, + " {ok,X,Rest};",nl, + " {X,Rest,_Len} ->",nl, + " {ok,X,Rest}",nl]) + end, + emit(["end.",nl,nl]), + + case Erules of + per -> + emit(["if_binary2list(B) when is_binary(B) ->",nl, + " binary_to_list(B);",nl, + "if_binary2list(L) -> L.",nl,nl]); + _ -> + ok + end, + + gen_decode_partial_incomplete(Erules), + + 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]), + + 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]), + Driver = + case lists:member(driver,get(encoding_options)) of + true -> + ",driver"; + _ -> "" + end, + emit([" case catch decode_inc_disp(Type,element(1,?RT_BER:decode(Data0",Driver,"))) of",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; + {Data1,Data2} -> +% io:format("partial_incomplete_decode: ~p~ninc_type_pattern: ~p~n",[Data,Data2]), + gen_partial_inc_dispatcher(Data1,Data2) + end. +gen_partial_inc_dispatcher([{FuncName,TopType,_Pattern}|Rest],TypePattern) -> + TPattern = + case lists:keysearch(FuncName,1,TypePattern) of + {value,{_,TP}} -> TP; + _ -> exit({error,{asn1_internal_error,exclusive_decode}}) + end, + FuncName2=asn1ct:maybe_rename_function(inc_disp,TopType,TPattern), + TopTypeName = + case asn1ct:maybe_saved_sindex(TopType,TPattern) of + I when is_integer(I),I>0 -> + lists:concat([TopType,"_",I]); + _ -> + atom_to_list(TopType) + end, + emit(["decode_partial_inc_disp('",TopTypeName,"',Data) ->",nl, + " ",{asis,list_to_atom(lists:concat(["dec-inc-",FuncName2]))}, + "(Data);",nl]), + gen_partial_inc_dispatcher(Rest,TypePattern); +gen_partial_inc_dispatcher([],_) -> + emit(["decode_partial_inc_disp(Type,_Data) ->",nl, + " exit({error,{asn1,{undefined_type,Type}}}).",nl]). + +driver_parameter() -> + Options = get(encoding_options), + case lists:member(driver,Options) of + true -> + ",driver"; + _ -> "" + end. + +gen_wrapper() -> + emit(["wrap_encode(Bytes) when is_list(Bytes) ->",nl, + " binary_to_list(list_to_binary(Bytes));",nl, + "wrap_encode(Bytes) when is_binary(Bytes) ->",nl, + " binary_to_list(Bytes);",nl, + "wrap_encode(Bytes) -> Bytes.",nl,nl]), + emit(["wrap_decode(Bytes) when is_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() -> + emit(["info() ->",nl, + " case ?MODULE:module_info() of",nl, + " MI when is_list(MI) ->",nl, + " case lists:keysearch(attributes,1,MI) of",nl, + " {value,{_,Attributes}} when is_list(Attributes) ->",nl, + " case lists:keysearch(asn1_info,1,Attributes) of",nl, + " {value,{_,Info}} when is_list(Info) ->",nl, + " Info;",nl, + " _ ->",nl, + " []",nl, + " end;",nl, + " _ ->",nl, + " []",nl, + " end",nl, + " end.",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 is_atom(Variable) -> + emit({var,asn1ct_name:prev(Variable)}); + +emit({next,Variable}) when is_atom(Variable) -> + emit({var,asn1ct_name:next(Variable)}); + +emit({curr,Variable}) when is_atom(Variable) -> + emit({var,asn1ct_name:curr(Variable)}); + +emit({var,Variable}) when is_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 is_integer(What) -> + put_chars(get(gen_file_out),integer_to_list(What)); + +emit(What) when is_list(What), is_integer(hd(What)) -> + put_chars(get(gen_file_out),What); + +emit(What) when is_atom(What) -> + put_chars(get(gen_file_out),atom_to_list(What)); + +emit(What) when is_tuple(What) -> + emit_parts(tuple_to_list(What)); + +emit(What) when is_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 is_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 is_record(Tdef,typedef) -> + Name = [Tdef#typedef.name], + Type = Tdef#typedef.typespec, + gen_record(type,Name,Type,NumRecords); + +gen_record(Tdef,NumRecords) when is_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 is_list(Clist1), is_list(Clist2) -> + gen_record(TorPtype,Name,Clist1++Clist2,Num); +gen_record(TorPtype,Name,{Clist1,EClist,Clist2},Num) + when is_list(Clist1), is_list(EClist), is_list(Clist2) -> + gen_record(TorPtype,Name,Clist1++EClist++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 is_record(Type,type) -> + Def = Type#type.def, + Rec = case Def of + Seq when is_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 is_record(Set,'SET') -> + case Set#'SET'.pname of + false -> + {record,to_textual_order(Set#'SET'.components)}; + _Pname when TorPtype == type -> + false; + _ -> + {record,to_textual_order(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, + Prefix = get_record_name_prefix(), + emit({"-record('",Prefix,list2name(Name),"',{",nl}), + RootList = case CompList of + _ when is_list(CompList) -> + CompList; + {Rl,_} -> Rl; + {Rl1,_Ext,_Rl2} -> Rl1 + 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; + {Rootl1,Extl,Rootl2} -> + case Rootl1 of + [] -> true; + _ -> emit([",",nl]) + end, + emit(["%% with extensions",nl]), + gen_record2(Name,'SEQUENCE',Extl,"",ext), + case Extl of + [_H|_] when Rootl2 /= [] -> emit([",",nl]); + _ -> ok + end, + emit(["%% end of extensions",nl]), + gen_record2(Name,'SEQUENCE',Rootl2,"",noext), + emit(["}).",nl,nl]), + Rootl1++Extl++Rootl2; + _ -> + 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) -> + Options = get(encoding_options), + {Rtmac,Rtmod} = case Erules of + per -> + emit({"%% Generated by the Erlang ASN.1 PER-" + "compiler version:",asn1ct:vsn(),nl}), + {"RT_PER",?RT_PER_BIN}; + 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 + 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"}; + uper_bin -> + emit(["%% Generated by the Erlang ASN.1 UNALIGNED" + " PER-compiler version, utilizing" + " bit-syntax:", + asn1ct:vsn(),nl]), + {"RT_PER","asn1rt_uper_bin"} + 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]), + emit(["-asn1_info([{vsn,'",asn1ct:vsn(),"'},",nl, + " {module,'",Mod,"'},",nl, + " {options,",io_lib:format("~w",[Options]),"}]).",nl,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), + gen_record2(Name,SeqOrSet,T,", ", Extension). + +gen_record_default(#'ComponentType'{prop='OPTIONAL'}, _)-> + emit(" = asn1_NOVALUE"); +gen_record_default(#'ComponentType'{prop={'DEFAULT',_}}, _)-> + emit(" = asn1_DEFAULT"); +gen_record_default(_, _) -> + true. + +%% May only be a list or a two-tuple. +to_textual_order({Root,Ext}) -> + {to_textual_order(Root),Ext}; +to_textual_order(Cs={_R1,_Ext,_R2}) -> + Cs; +to_textual_order(Cs=[#'ComponentType'{textual_order=undefined}|_]) -> + Cs; +to_textual_order(Cs) when is_list(Cs) -> + lists:keysort(#'ComponentType'.textual_order,Cs). + + +gen_check_call(TopType,Cname,Type,InnerType,WhatKind,DefaultValue,Element) -> + case WhatKind of + {primitive,bif} -> + gen_prim_check_call(InnerType,DefaultValue,Element,Type); + #'Externaltypereference'{module=M,type=T} -> + %% generate function call + Name = list2name([T,check]), + emit({"'",Name,"'(",DefaultValue,", ",Element,")"}), + %% insert in ets table and do look ahead check + Typedef = asn1_db:dbget(M,T), + RefType = Typedef#typedef.typespec, + InType = asn1ct_gen:get_inner(RefType#type.def), + case insert_once(check_functions,{Name,RefType}) of + true -> + lookahead_innertype([T],InType,RefType); + _ -> + ok + end; + {constructed,bif} -> + NameList = [Cname|TopType], + Name = list2name(NameList ++ [check]), + emit({"'",Name,"'(",DefaultValue,", ",Element,")"}), + 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); + _ -> + %% Generate Dummy function call i.e. anything is accepted + emit(["fun() -> true end ()"]) + 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,")"}); + 'RELATIVE-OID' -> + 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, + insert_once(check_functions,{list2name([T,check]),RefType}), + InType = asn1ct_gen:get_inner(RefType#type.def), + case type(InType) of + {constructed,bif} -> + lookahead_innertype([T],InType,RefType); + Ref = #'Externaltypereference'{} -> + lookahead_reference(Ref); + _ -> + ok + end; +lookahead_innertype(_,_,_) -> + ok. + +lookahead_components(_,[]) -> ok; +lookahead_components(Name,[C|Cs]) -> + #'ComponentType'{name=Cname,typespec=Type} = C, + InType = asn1ct_gen:get_inner(Type#type.def), + case asn1ct_gen:type(InType) of + {constructed,bif} -> + case insert_once(check_functions, + {list2name([Cname|Name] ++ [check]),Type}) of + true -> + lookahead_innertype([Cname|Name],InType,Type); + _ -> + ok + end; + #'Externaltypereference'{module=RefMod,type=RefName} -> + Typedef = asn1_db:dbget(RefMod,RefName), + RefType = Typedef#typedef.typespec, + case insert_once(check_functions,{list2name([RefName,check]), + RefType}) of + true -> + lookahead_innertype([RefName],InType,RefType); + _ -> + ok + end; + _ -> + ok + end, + lookahead_components(Name,Cs). + +lookahead_sof(Name,SOF,SOFType) -> + Type = case SOFType#type.def of + {_,_Type} -> _Type; + _Type -> _Type + end, + InnerType = asn1ct_gen:get_inner(Type#type.def), + case asn1ct_gen:type(InnerType) of + {constructed,bif} -> + %% this is if a constructed type is defined in + %% the SEQUENCE OF type + NameList = [SOF|Name], + insert_once(check_functions, + {list2name(NameList ++ [check]),Type}), + lookahead_innertype(NameList,InnerType,Type); + Ref = #'Externaltypereference'{} -> + lookahead_reference(Ref); + _ -> + ok + end. + +lookahead_reference(#'Externaltypereference'{module=M,type=T}) -> + Typedef = asn1_db:dbget(M,T), + RefType = Typedef#typedef.typespec, + InType = get_inner(RefType#type.def), + case insert_once(check_functions, + {list2name([T,check]),RefType}) of + true -> + lookahead_innertype([T],InType,RefType); + _ -> + ok + end. + +insert_once(Table,Object) -> + _Info = ets:info(Table), + 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; + 'T61String' -> + restrictedstring; + 'VideotexString' -> + restrictedstring; + 'IA5String' -> + restrictedstring; + 'UTCTime' -> + restrictedstring; + 'GeneralizedTime' -> + restrictedstring; + 'GraphicString' -> + restrictedstring; + 'VisibleString' -> + restrictedstring; + 'GeneralString' -> + restrictedstring; + 'UniversalString' -> + restrictedstring; + 'BMPString' -> + restrictedstring; + 'UTF8String' -> + restrictedstring; + Other -> Other + end. + + + + + +get_inner(A) when is_atom(A) -> A; +get_inner(Ext) when is_record(Ext,'Externaltypereference') -> Ext; +get_inner(Tref) when is_record(Tref,typereference) -> Tref; +get_inner({fixedtypevaluefield,_,Type}) -> + if + is_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 is_tuple(T) -> + case element(1,T) of + Tuple when is_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 is_record(X,'Externaltypereference') -> + X; +type(X) when is_record(X,typereference) -> + X; +type('ASN1_OPEN_TYPE') -> + 'ASN1_OPEN_TYPE'; +type({fixedtypevaluefield,_Name,Type}) when is_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', + 'REAL', + 'OBJECT IDENTIFIER', + 'RELATIVE-OID', + 'ANY', + 'NULL', + 'BIT STRING' , + 'OCTET STRING' , + 'ObjectDescriptor', + 'NumericString', + 'TeletexString', + 'T61String', + 'VideotexString', + 'UTCTime', + 'GeneralizedTime', + 'GraphicString', + 'VisibleString', + 'GeneralString', + 'PrintableString', + 'IA5String', + 'UniversalString', + 'UTF8String', + '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 is_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 is_record(Type,type) -> + case Type#type.def of + {{objectclass,_,_},TypeFrObj} when is_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; +erule(uper_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(_) -> "". + +index2suffix(0) -> + ""; +index2suffix(N) -> + lists:concat(["_",N]). + +get_constraint(C,Key) -> + case lists:keysearch(Key,1,C) of + false -> + no; + {value,{_,V}} -> + V; + {value,Cnstr} -> + Cnstr + end. + +ensure_atom(Atom) when is_atom(Atom) -> + Atom; +ensure_atom(List) when is_list(List) -> + list_to_atom(List). + +get_record_name_prefix() -> + case lists:keysearch(record_name_prefix,1,get(encoding_options)) of + false -> + ""; + {value,{_,Prefix}} -> + Prefix + end. diff --git a/lib/asn1/src/asn1ct_gen_ber.erl b/lib/asn1/src/asn1ct_gen_ber.erl new file mode 100644 index 0000000000..7c432f29c3 --- /dev/null +++ b/lib/asn1/src/asn1ct_gen_ber.erl @@ -0,0 +1,1736 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_gen_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 is_record(Type,typedef) -> + gen_encode_user(Erules,Type). + +%%=============================================================================== +%% encode #{type, {tag, def, constraint}} +%%=============================================================================== + +gen_encode(Erules,Typename,Type) when is_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 is_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'{name=Cname,typespec=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 is_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 is_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 is_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 {_,",{curr,enumval},"}->", + {curr,enumval},";_->", Value," end) of",nl]), + asn1ct_name:new(enumval), + emit_enc_enumerated_cases(NamedNumberList,DoTag); + {'ENUMERATED',NamedNumberList} -> + + emit(["case (case ",Value," of {_,",{curr,enumval},"}->", + {curr,enumval},";_->", Value," end) of",nl]), + asn1ct_name:new(enumval), + emit_enc_enumerated_cases(NamedNumberList,DoTag); + + 'REAL' -> + emit_encode_func('real',Constraint,Value,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); + 'RELATIVE-OID' -> + emit_encode_func("relative_oid",Value,DoTag); + 'ObjectDescriptor' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_ObjectDescriptor,DoTag); + 'OCTET STRING' -> + emit_encode_func('octet_string',Constraint,Value,DoTag); + 'NumericString' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_NumericString,DoTag); + TString when TString == 'TeletexString'; + TString == 'T61String' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_TeletexString,DoTag); + 'VideotexString' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_VideotexString,DoTag); + 'GraphicString' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_GraphicString,DoTag); + 'VisibleString' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_VisibleString,DoTag); + 'GeneralString' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_GeneralString,DoTag); + 'PrintableString' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_PrintableString,DoTag); + 'IA5String' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_IA5String,DoTag); + 'UniversalString' -> + emit_encode_func('universal_string',Constraint,Value,DoTag); + 'UTF8String' -> + emit_encode_func('UTF8_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); + #'ObjectClassFieldType'{} -> + case asn1ct_gen:get_inner(D#type.def) of + {fixedtypevaluefield,_,InnerType} -> + gen_encode_prim(Erules,InnerType,DoTag,Value); + 'ASN1_OPEN_TYPE' -> + emit_encode_func('open_type', Value,DoTag); + XX -> + exit({'can not encode' ,XX}) + end; + XX -> + exit({'can not encode' ,XX}) + end. + + +emit_encode_func(Name,Value,Tags) when is_atom(Name) -> + emit_encode_func(atom_to_list(Name),Value,Tags); +emit_encode_func(Name,Value,Tags) -> + Fname = "?RT_BER:encode_" ++ Name, + emit([Fname,"(",Value,", ",Tags,")"]). + +emit_encode_func(Name,Constraint,Value,Tags) when is_atom(Name) -> + emit_encode_func(atom_to_list(Name),Constraint,Value,Tags); +emit_encode_func(Name,Constraint,Value,Tags) -> + Fname = "?RT_BER:encode_" ++ Name, + emit([Fname,"(",{asis,Constraint},", ",Value,", ",Tags,")"]). + +emit_encode_func(Name,Constraint,Value,Asis,Tags) when is_atom(Name) -> + emit_encode_func(atom_to_list(Name),Constraint,Value,Asis,Tags); +emit_encode_func(Name,Constraint,Value,Asis,Tags) -> + Fname = "?RT_BER:encode_" ++ Name, + emit([Fname,"(",{asis,Constraint},", ",Value, + ", ",{asis,Asis}, + ", ",Tags,")"]). + +emit_enc_enumerated_cases({L1,L2}, Tags) -> + emit_enc_enumerated_cases(L1++L2, Tags, ext); +emit_enc_enumerated_cases(L, Tags) -> + emit_enc_enumerated_cases(L, Tags, noext). + +emit_enc_enumerated_cases([{EnumName,EnumVal},H2|T], Tags, Ext) -> + emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), +%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), + emit_enc_enumerated_cases([H2|T], Tags, Ext); +emit_enc_enumerated_cases([{EnumName,EnumVal}], Tags, Ext) -> + emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), +%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), + case Ext of + noext -> emit([";",nl]); + ext -> +%% emit([";",nl,"{asn1_enum,",{curr,enumval},"} -> ", +%% "?RT_BER:encode_enumerated(",{curr,enumval},",",Tags,");",nl]), +%% asn1ct_name:new(enumval) + emit([";",nl]) + 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 is_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 is_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'{name=Cname,typespec=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 is_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; + 'REAL' -> + emit({"?RT_BER:decode_real(",BytesVar,",", + {asis,Constraint},","}), + 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; + 'RELATIVE-OID' -> + emit({"?RT_BER:decode_relative_oid(",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; + TString when TString == 'TeletexString'; + TString == 'T61String' -> + 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; + 'UTF8String' -> + emit({"?RT_BER:decode_UTF8_string",AsBin,"(", + BytesVar,","}), + false; + '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; + #'ObjectClassFieldType'{} -> + case asn1ct_gen:get_inner(Att#type.def) of + {fixedtypevaluefield,_,InnerType} -> + gen_dec_prim(Erules,InnerType,BytesVar,DoTag,TagIn,Length,Form,OptOrMand), + false; + 'ASN1_OPEN_TYPE' -> + emit(["?RT_BER:decode_open_type(", + re_wrap_erule(Erules),",", + BytesVar,","]), + false; + XX -> + exit({'can not decode' ,XX}) + end; + Other -> + exit({'can not decode' ,Other}) + end, + + NewLength = case DoLength of + true -> [", ", Length]; + false -> "" + end, + NewOptOrMand = case OptOrMand of + _ when is_list(OptOrMand) -> OptOrMand; + mandatory -> {asis,mandatory}; + _ -> {asis,opt_or_default} + end, + case {TagIn,NewTypeName} of + {_,#'ObjectClassFieldType'{}} -> + case asn1ct_gen:get_inner(Att#type.def) of + 'ASN1_OPEN_TYPE' -> + emit([{asis,DoTag},")"]); + _ -> ok + end; + {[],'ASN1_OPEN_TYPE'} -> + emit([{asis,DoTag},")"]); + {_,'ASN1_OPEN_TYPE'} -> + emit([TagIn,"++",{asis,DoTag},")"]); + {[],_} -> + emit([{asis,DoTag},NewLength,", ",NewOptOrMand,")"]); + _ when is_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 is_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 is_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'} -> %% OPTIONAL field in class + EmitFuncClause("Val, _"), %% Value must be anything + %% already encoded + emit([" {Val,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) -> + CurrentMod = get(currmod), + 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', ",{asis,Name}, + "}})"]); + {false,{'DEFAULT',_DefaultObject}} -> + exit({error,{asn1,{"not implemented yet",Name}}}); + {{Name,#'Externalvaluereference'{module=CurrentMod, + value=TypeName}},_} -> + EmitFuncClause(" Val, TagIn, [H|T]"), + emit({indent(3),"'enc_",TypeName,"'(H, Val, TagIn, T)"}); + {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> + EmitFuncClause(" Val, TagIn, [H|T]"), + emit({indent(3),"'",M,"':'enc_",TypeName,"'(H, Val, TagIn, T)"}); + {{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 is_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, + #'Externaltypereference'{module=M,type=T}) -> + CurrentMod = get(currmod), + TDef = asn1_db:dbget(M,T), + Def = TDef#typedef.typespec, + OTag = Def#type.tag, + Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], + if + M == CurrentMod -> + emit({" 'enc_",T,"'(Val, TagIn ++ ",{asis,Tag},")"}), + []; + true -> + emit({" '",M,"':'enc_",T,"'(Val, TagIn ++ ",{asis,Tag},")"}), + [] + end; +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("Bytes, _,"), +% emit([" asn1_NOVALUE"]), + emit([" {Bytes,[],0}"]), + []; + {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) -> + CurrentMod = get(currmod), + 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', ",{asis,Name}, + "}})"]); + {false,{'DEFAULT',_DefaultObject}} -> + exit({error,{asn1,{"not implemented yet",Name}}}); + {{Name,#'Externalvaluereference'{module=CurrentMod, + value=TypeName}},_} -> + EmitFuncClause("Bytes,TagIn,[H|T]"), + emit({indent(3),"'dec_",TypeName,"'(H, Bytes, TagIn, T)"}); + {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> + EmitFuncClause("Bytes,TagIn,[H|T]"), + emit({indent(3),"'",M,"':'dec_",TypeName, + "'(H, Bytes, TagIn, T)"}); + {{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_constr_type(Erules,[TypeDef|Rest]) when is_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, + #'Externaltypereference'{module=M,type=T}) -> + CurrentMod = get(currmod), + TDef = asn1_db:dbget(M,T), + Def = TDef#typedef.typespec, + OTag = Def#type.tag, + Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], + if + M == CurrentMod -> + emit({" 'dec_",T,"'(",Bytes, + ", opt_or_default,TagIn ++ ",{asis,Tag},")"}), + []; + true -> + emit({" '",M,"':'dec_",T, + "'(",Bytes,", opt_or_default,TagIn ++ ",{asis,Tag},")"}), + [] + end; +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,[{_,no_unique_value,_},T|Rest], + ClName,ClFields,NthObj,Acc) -> + %% No need to check that this class has property OPTIONAL for the + %% unique field, it was detected in the previous phase + gen_objset_enc(ObjSName,UniqueName,[T|Rest],ClName,ClFields,NthObj,Acc); +gen_objset_enc(ObjSetName,UniqueName,[{_,no_unique_value,_}], + _ClName,_ClFields,_NthObj,Acc) -> + %% No need to check that this class has property OPTIONAL for the + %% unique field, it was detected in the previous phase + emit_default_getenc(ObjSetName,UniqueName), + emit({".",nl,nl}), + Acc; +gen_objset_enc(ObjSName,UniqueName, + [{ObjName,Val,Fields},T|Rest],ClName,ClFields,NthObj,Acc)-> + emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val},") ->",nl}), + CurrMod = get(currmod), + {InternalFunc,NewNthObj}= + case ObjName of + {no_mod,no_name} -> + gen_inlined_enc_funs(Fields,ClFields,ObjSName,NthObj); + {CurrMod,Name} -> + emit({" fun 'enc_",Name,"'/4"}), + {[],NthObj}; + {ModuleName,Name} -> + emit_ext_fun(enc,ModuleName,Name), +% emit([" {'",ModuleName,"', 'enc_",Name,"'}"]), + {[],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}), + CurrMod = get(currmod), + {InternalFunc,_}= + case ObjName of + {no_mod,no_name} -> + gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj); + {CurrMod,Name} -> + emit({" fun 'enc_",Name,"'/4"}), + {[],NthObj}; + {ModuleName,Name} -> + emit_ext_fun(enc,ModuleName,Name), +% emit([" {'",ModuleName,"', 'enc_",Name,"'}"]), + {[],NthObj}; + _Other -> + emit({" fun 'enc_",ObjName,"'/4"}), + {[],NthObj} + end, + emit([";",nl]), + emit_default_getenc(ObjSetName,UniqueName), + 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 is_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(ObjSetName,UniqueName,['EXTENSIONMARK','EXTENSIONMARK'|Rest], + ClName,ClFields,NthObj,Acc) -> + gen_objset_enc(ObjSetName,UniqueName,['EXTENSIONMARK'|Rest], + ClName,ClFields,NthObj,Acc); +gen_objset_enc(ObjSetName,UniqueName,['EXTENSIONMARK'|Rest], + ClName,ClFields,NthObj,Acc) -> + gen_objset_enc(ObjSetName,UniqueName,Rest++['EXTENSIONMARK'], + ClName,ClFields,NthObj,Acc); +gen_objset_enc(_,_,[],_,_,_,Acc) -> + Acc. + +emit_ext_fun(EncDec,ModuleName,Name) -> + emit([indent(3),"fun(T,V,_O1,_O2) -> '",ModuleName,"':'",EncDec,"_", + Name,"'(T,V,_O1,_O2) end"]). + +emit_default_getenc(ObjSetName,UniqueName) -> + emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), + emit([indent(3),"fun(C,V,_,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V}, {unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). + +%% 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) -> + CurrMod = get(currmod), + InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_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 is_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); + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + #typedef{typespec=Type} = asn1_db:dbget(M,T), + OTag = Type#type.tag, + Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], + emit([indent(3),"fun(Type, Val, TagIn, _RestPrimFieldName) ->",nl, + indent(6),"case Type of",nl]), + emit([indent(9),{asis,Name}," ->",nl]), + if + M == CurrMod -> + emit([indent(12),"'enc_",T,"'(Val, TagIn ++ ", + {asis,Tag},")"]); + true -> + emit([indent(12),"'",M,"':'enc_",T,"'(Val,TagIn ++", + {asis,Tag},")"]) + end, + gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,[]); + false -> + %% This field was not present in the object thus there were no + %% type in the table and we therefore generate code that returns + %% the input for application treatment. + emit([indent(3),"fun(Type, Val, TagIn, _RestPrimFieldName) ->",nl, + indent(6),"case Type of",nl]), + emit([indent(9),{asis,Name}," ->",nl]), + emit([indent(12),"Len = case Val of",nl, + indent(15),"Bin when is_binary(Bin) -> size(Bin);",nl, + indent(15),"_ -> length(Val)",nl,indent(12),"end,",nl, + indent(12),"{Val,Len}"]), + gen_inlined_enc_funs1(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) -> + CurrMod = get(currmod), + InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), + {Acc2,NAdd}= + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_record(Type,type) -> + emit({";",nl}), + {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), + {Ret++Acc,N}; + {value,{_,Type}} when is_record(Type,typedef) -> + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), + {Ret++Acc,N}; + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + #typedef{typespec=Type} = asn1_db:dbget(M,T), + OTag = Type#type.tag, + Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + if + M == CurrMod -> + emit([indent(12),"'enc_",T,"'(Val, TagIn ++ ", + {asis,Tag},")"]); + true -> + emit([indent(12),"'",M,"':'enc_",T,"'(Val,TagIn ++", + {asis,Tag},")"]) + end, + {Acc,0}; + false -> + %% This field was not present in the object thus there were no + %% type in the table and we therefore generate code that returns + %% the input for application treatment. + emit([";",nl,indent(9),{asis,Name}," ->",nl]), + emit([indent(12),"Len = case Val of",nl, + indent(15),"Bin when is_binary(Bin) -> size(Bin);",nl, + indent(15),"_ -> length(Val)",nl,indent(12),"end,",nl, + indent(12),"{Val,Len}"]), + {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 is_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 is_atom(Def) -> + emit({indent(9),Def," ->",nl,indent(12)}), + gen_encode_prim(ber,Type,["TagIn ++ ",{asis,Tag}],"Val"); + TRef when is_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,[{_,no_unique_value,_},T|Rest], + ClName,ClFields,NthObj)-> + gen_objset_dec(Erules,ObjSName,UniqueName,[T|Rest],ClName,ClFields, + NthObj); +gen_objset_dec(_Erules,ObjSetName,UniqueName,[{_,no_unique_value,_}], + _ClName,_ClFields,_NthObj)-> + emit_default_getdec(ObjSetName,UniqueName), + emit({".",nl,nl}); +gen_objset_dec(Erules,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest], + ClName,ClFields,NthObj)-> + emit({"'getdec_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val}, + ") ->",nl}), + CurrMod = get(currmod), + NewNthObj= + case ObjName of + {no_mod,no_name} -> + gen_inlined_dec_funs(Erules,Fields,ClFields,ObjSName, + NthObj); + {CurrMod,Name} -> + emit({" fun 'dec_",Name,"'/4"}), + NthObj; + {ModName,Name} -> + emit_ext_fun(dec,ModName,Name), +% emit([" {'",ModName,"', 'dec_",Name,"'}"]), + 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}), + CurrMod = get(currmod), + case ObjName of + {no_mod,no_name} -> + gen_inlined_dec_funs(Erules,Fields,ClFields,ObjSetName, + NthObj); + {CurrMod,Name} -> + emit({" fun 'dec_",Name,"'/4"}); + {ModName,Name} -> + emit_ext_fun(dec,ModName,Name); +% emit([" {'",ModName,"', 'dec_",Name,"'}"]); + _Other -> + emit({" fun 'dec_",ObjName,"'/4"}) + end, + emit({";",nl}), + emit_default_getdec(ObjSetName,UniqueName), + 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 is_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(Erule,ObjSetName,UniqueName, + ['EXTENSIONMARK','EXTENSIONMARK'|Rest], + ClName,ClFields,NthObj) -> + gen_objset_dec(Erule,ObjSetName,UniqueName,['EXTENSIONMARK'|Rest], + ClName,ClFields,NthObj); +gen_objset_dec(Erule,ObjSetName,UniqueName,['EXTENSIONMARK'|Rest], + ClName,ClFields,NthObj) -> + gen_objset_dec(Erule,ObjSetName,UniqueName,Rest++['EXTENSIONMARK'], + ClName,ClFields,NthObj); +gen_objset_dec(_,_,_,[],_,_,_) -> + ok. + +emit_default_getdec(ObjSetName,UniqueName) -> + emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), + emit([indent(3),"fun(C,V,_,_) -> exit({{component,C},{value,V}, {unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). + +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, + CurrMod = get(currmod), + InternalDefFunName = [NthObj,Name,ObjSetName], + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_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 is_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); + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + #typedef{typespec=Type} = asn1_db:dbget(M,T), + OTag = Type#type.tag, + Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], + emit({indent(3),"fun(Type, Bytes, TagIn, _RestPrimFieldName) ->", + nl,indent(6),"case Type of",nl}), + emit({indent(9),{asis,Name}," ->",nl}), + if + M == CurrMod -> + emit([indent(12),"'dec_",T,"'(Bytes, ",DecProp, + ", TagIn ++ ",{asis,Tag},")"]); + true -> + emit([indent(12),"'",M,"':'dec_",T,"'(Bytes, ", + DecProp,", TagIn ++ ",{asis,Tag},")"]) + end, + gen_inlined_dec_funs1(Erules,Fields,Rest,ObjSetName,NthObj); + false -> + emit([indent(3),"fun(Type, Bytes, TagIn, _RestPrimFieldName) ->", + nl,indent(6),"case Type of",nl, + indent(9),{asis,Name}," ->",nl, + indent(12),"Len = case Bytes of",nl, + indent(15),"B when is_binary(B) -> size(B);",nl, + indent(15),"_ -> length(Bytes)",nl, + indent(12),"end,",nl, + indent(12),"{Bytes,[],Len}"]), + gen_inlined_dec_funs1(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, + CurrMod = get(currmod), + InternalDefFunName = [NthObj,Name,ObjSetName], + N= + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_record(Type,type) -> + emit({";",nl}), + emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName); + {value,{_,Type}} when is_record(Type,typedef) -> + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + emit_inner_of_decfun(Erules,Type,DecProp,InternalDefFunName); + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + #typedef{typespec=Type} = asn1_db:dbget(M,T), + OTag = Type#type.tag, + Tag = [X#tag{class=decode_class(X#tag.class)}|| X <- OTag], + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + if + M == CurrMod -> + emit([indent(12),"'dec_",T,"'(Bytes, ",DecProp, + ", TagIn ++ ",{asis,Tag},")"]); + true -> + emit([indent(12),"'",M,"':'dec_",T,"'(Bytes, ", + DecProp,", TagIn ++ ",{asis,Tag},")"]) + end, + 0; + false -> + emit([";",nl, + indent(9),{asis,Name}," ->",nl, + indent(12),"Len = case Bytes of",nl, + indent(15),"B when is_binary(B) -> size(B);",nl, + indent(15),"_ -> length(Bytes)",nl, + indent(12),"end,",nl, + indent(12),"{Bytes,[],Len}"]), + 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 is_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 is_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('ObjectDescriptor') -> 7; +decode_type('EXTERNAL') -> 8; +decode_type('REAL') -> 9; +decode_type('ENUMERATED') -> 10; +decode_type('EMBEDDED_PDV') -> 11; +decode_type('UTF8String') -> 12; +decode_type('RELATIVE-OID') -> 13; +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('T61String') -> 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 is_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/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl new file mode 100644 index 0000000000..b7ac0f407c --- /dev/null +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -0,0 +1,1833 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_gen_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,gen_decode_selected/3]). + +-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 is_record(Type,typedef) -> + gen_encode_user(Erules,Type). + +%%=============================================================================== +%% encode #{type, {tag, def, constraint}} +%%=============================================================================== + +gen_encode(Erules,Typename,Type) when is_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 is_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'{name=Cname,typespec=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 is_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 is_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 is_record(D,type) -> + +%%% Constraint is currently not used for BER (except for BitString) and therefore replaced +%%% with [] as a placeholder + BitStringConstraint = D#type.constraint, + Constraint = [], + asn1ct_name:new(enumval), + case D#type.def of + '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 ",Value," of",nl]), + emit_enc_enumerated_cases(NamedNumberList,DoTag); + {'ENUMERATED',NamedNumberList} -> + + emit(["case ",Value," of",nl]), + emit_enc_enumerated_cases(NamedNumberList,DoTag); + + 'REAL' -> + emit_encode_func('real',Constraint,Value,DoTag); + + {'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); + 'RELATIVE-OID' -> + emit_encode_func("relative_oid",Value,DoTag); + 'ObjectDescriptor' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_ObjectDescriptor,DoTag); + 'OCTET STRING' -> + emit_encode_func('octet_string',Constraint,Value,DoTag); + 'NumericString' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_NumericString,DoTag); + TString when TString == 'TeletexString'; + TString == 'T61String' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_TeletexString,DoTag); + 'VideotexString' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_VideotexString,DoTag); + 'GraphicString' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_GraphicString,DoTag); + 'VisibleString' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_VisibleString,DoTag); + 'GeneralString' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_GeneralString,DoTag); + 'PrintableString' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_PrintableString,DoTag); + 'IA5String' -> + emit_encode_func('restricted_string',Constraint,Value, + ?T_IA5String,DoTag); + 'UniversalString' -> + emit_encode_func('universal_string',Constraint,Value,DoTag); + 'UTF8String' -> + emit_encode_func('UTF8_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); + #'ObjectClassFieldType'{} -> + case asn1ct_gen:get_inner(D#type.def) of + {fixedtypevaluefield,_,InnerType} -> + gen_encode_prim(Erules,InnerType,DoTag,Value); + 'ASN1_OPEN_TYPE' -> + emit_encode_func('open_type', Value,DoTag); + XX -> + exit({'can not encode' ,XX}) + end; + XX -> + exit({'can not encode' ,XX}) + end. + + +emit_encode_func(Name,Value,Tags) when is_atom(Name) -> + emit_encode_func(atom_to_list(Name),Value,Tags); +emit_encode_func(Name,Value,Tags) -> + Fname = "?RT_BER:encode_" ++ Name, + emit([Fname,"(",Value,", ",Tags,")"]). + +emit_encode_func(Name,Constraint,Value,Tags) when is_atom(Name) -> + emit_encode_func(atom_to_list(Name),Constraint,Value,Tags); +emit_encode_func(Name,Constraint,Value,Tags) -> + Fname = "?RT_BER:encode_" ++ Name, + emit([Fname,"(",{asis,Constraint},", ",Value,", ",Tags,")"]). + +emit_encode_func(Name,Constraint,Value,Asis,Tags) when is_atom(Name) -> + emit_encode_func(atom_to_list(Name),Constraint,Value,Asis,Tags); +emit_encode_func(Name,Constraint,Value,Asis,Tags) -> + Fname = "?RT_BER:encode_" ++ Name, + emit([Fname,"(",{asis,Constraint},", ",Value, + ", ",{asis,Asis}, + ", ",Tags,")"]). + +emit_enc_enumerated_cases({L1,L2}, Tags) -> + emit_enc_enumerated_cases(L1++L2, Tags, ext); +emit_enc_enumerated_cases(L, Tags) -> + emit_enc_enumerated_cases(L, Tags, noext). + +emit_enc_enumerated_cases([{EnumName,EnumVal},H2|T], Tags, Ext) -> + emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), +%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,");",nl]), + emit_enc_enumerated_cases([H2|T], Tags, Ext); +emit_enc_enumerated_cases([{EnumName,EnumVal}], Tags, Ext) -> + emit([{asis,EnumName}," -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), +%% emit(["'",{asis,EnumName},"' -> ?RT_BER:encode_enumerated(",EnumVal,",",Tags,")"]), + case Ext of + noext -> emit([";",nl]); + ext -> + emit([";",nl]) +%% emit([";",nl,"{asn1_enum,",{curr,enumval},"} -> ", +%% "?RT_BER:encode_enumerated(",{curr,enumval},",",Tags,");",nl]), +%% asn1ct_name:new(enumval) + end, + emit([{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 is_record(Type,typedef) -> + Def = Type#typedef.typespec, + InnerTag = Def#type.tag , + + Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || X <- InnerTag], + + FunctionName = + case {asn1ct:get_gen_state_field(active), + asn1ct:get_gen_state_field(prefix)} of + {true,Pref} -> + %% prevent duplicated function definitions +% Pattern = asn1ct:get_gen_state_field(namelist), +% FuncName=asn1ct:maybe_rename_function(Type#typedef.name, +% Pattern), + case asn1ct:current_sindex() of + I when is_integer(I),I>0 -> + lists:concat([Pref,Type#typedef.name,"_",I]); + _-> + lists:concat([Pref,Type#typedef.name]) + end; % maybe the current_sindex must be reset + _ -> lists:concat(["dec_",Type#typedef.name]) + end, + emit({nl,nl}), + emit(["'",FunctionName,"'(Tlv) ->",nl]), + emit([" '",FunctionName,"'(Tlv, ",{asis,Tag},").",nl,nl]), + emit(["'",FunctionName,"'(Tlv, TagIn) ->",nl]), + dbdec(Type#typedef.name,"Tlv"), + gen_decode_user(Erules,Type). + +gen_inc_decode(Erules,Type) when is_record(Type,typedef) -> + Prefix = asn1ct:get_gen_state_field(prefix), + Suffix = asn1ct_gen:index2suffix(asn1ct:current_sindex()), + emit({nl,nl}), + emit(["'",Prefix,Type#typedef.name,Suffix,"'(Tlv, TagIn) ->",nl]), + gen_decode_user(Erules,Type). + +%% gen_decode_selected exported function for selected decode +gen_decode_selected(Erules,Type,FuncName) -> + emit([FuncName,"(Bin) ->",nl]), +% Pattern = asn1ct:get_gen_state_field(tag_pattern), + Patterns = asn1ct:read_config_data(partial_decode), + Pattern = + case lists:keysearch(FuncName,1,Patterns) of + {value,{_,P}} -> P; + false -> exit({error,{internal,no_pattern_saved}}) + end, + emit([" case ?RT_BER:decode_selective(",{asis,Pattern},",Bin) of",nl, + " {ok,Bin2} when is_binary(Bin2) ->",nl, + " {Tlv,_} = ?RT_BER:decode(Bin2),",nl]), + emit("{ok,"), + gen_decode_selected_type(Erules,Type), + emit(["};",nl," Err -> exit({error,{selctive_decode,Err}})",nl, + " end.",nl]). + +gen_decode_selected_type(_Erules,TypeDef) -> + Def = TypeDef#typedef.typespec, + InnerType = asn1ct_gen:get_inner(Def#type.def), + BytesVar = "Tlv", + Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || + X <- Def#type.tag], + case asn1ct_gen:type(InnerType) of + 'ASN1_OPEN_TYPE' -> + asn1ct_name:new(len), + gen_dec_prim(ber, Def#type{def='ASN1_OPEN_TYPE'}, + BytesVar,Tag, [] , + ?PRIMITIVE,"OptOrMand"); +% emit({";",nl}); + {primitive,bif} -> + asn1ct_name:new(len), + gen_dec_prim(ber, Def, BytesVar,Tag,[] , + ?PRIMITIVE,"OptOrMand"); +% emit([";",nl]); + {constructed,bif} -> + TopType = case TypeDef#typedef.name of + A when is_atom(A) -> [A]; + N -> N + end, + DecFunName = lists:concat(["'",dec,"_", + asn1ct_gen:list2name(TopType),"'"]), + emit([DecFunName,"(",BytesVar, + ", ",{asis,Tag},")"]); +% emit([";",nl]); + TheType -> + DecFunName = mkfuncname(TheType,dec), + emit([DecFunName,"(",BytesVar, + ", ",{asis,Tag},")"]) +% emit([";",nl]) + end. + +%%=============================================================================== +%% 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 for an inner +%% type of an exclusive decode top type.. +gen_decode(Erules,Typename,Type) when is_record(Type,type) -> + InnerType = asn1ct_gen:get_inner(Type#type.def), + FunctionName = + case asn1ct:get_gen_state_field(active) of + true -> +% Suffix = asn1ct_gen:index2suffix(SIndex), + Pattern = asn1ct:get_gen_state_field(namelist), + Suffix = + case asn1ct:maybe_saved_sindex(Typename,Pattern) of + I when is_integer(I),I>0 -> + lists:concat(["_",I]); + _ -> "" + end, + lists:concat(["'dec-inc-", + asn1ct_gen:list2name(Typename),Suffix]); + _ -> + lists:concat(["'dec_",asn1ct_gen:list2name(Typename)]) + end, +% io:format("Typename: ~p,~n",[Typename]), +% io:format("FunctionName: ~p~n",[FunctionName]), + 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]), + emit([FunctionName,"'(Tlv, TagIn",ObjFun,") ->",nl]), + dbdec(Typename,"Tlv"), + asn1ct_gen:gen_decode_constructed(Erules,Typename,InnerType,Type); + Rec when is_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'{name=Cname,typespec=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=[]}, + 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 is_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}); + 'REAL' -> + emit({"?RT_BER:decode_real(",BytesVar,","}), + add_func({decode_real,3}); + {'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}); + 'RELATIVE-OID' -> + emit({"?RT_BER:decode_relative_oid(",BytesVar,","}), + add_func({decode_relative_oid,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}); + TString when TString == 'TeletexString'; + TString == 'T61String' -> + emit({"?RT_BER:decode_restricted_string",AsBin,"(", + BytesVar,",",{asis,Constraint},",",{asis,?T_TeletexString},","}), + add_func({decode_restricted_string,4}); + '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}); + 'UTF8String' -> + emit({"?RT_BER:decode_UTF8_string",AsBin,"(", + BytesVar,","}), + add_func({decode_UTF8_string,2}); + '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}); + #'ObjectClassFieldType'{} -> + case asn1ct_gen:get_inner(Att#type.def) of + {fixedtypevaluefield,_,InnerType} -> + gen_dec_prim(Erules,InnerType,BytesVar,DoTag,TagIn,Form,OptOrMand); + 'ASN1_OPEN_TYPE' -> + emit(["?RT_BER:decode_open_type_as_binary(", + BytesVar,","]), + add_func({decode_open_type_as_binary,2}); + Other -> + exit({'can not decode' ,Other}) + end; + Other -> + exit({'can not decode' ,Other}) + end, + + case {DoTag,NewTypeName} of + {_,#'ObjectClassFieldType'{}} -> + case asn1ct_gen:get_inner(Att#type.def) of + 'ASN1_OPEN_TYPE' -> + emit([{asis,DoTag},")"]); + _ -> ok + end; + {{string,TagStr},'ASN1_OPEN_TYPE'} -> + emit([TagStr,")"]); + {_,'ASN1_OPEN_TYPE'} -> + emit([{asis,DoTag},")"]); + {{string,TagStr},_} -> + emit([TagStr,")"]); + _ when is_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 is_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 is_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("Val"), + emit([" {Val,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) -> + CurrentMod = get(currmod), + 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', ",{asis,Name}, + "}})"]); + {false,{'DEFAULT',_DefaultObject}} -> + exit({error,{asn1,{"not implemented yet",Name}}}); + {{Name,#'Externalvaluereference'{module=CurrentMod, + value=TypeName}},_} -> + EmitFuncClause(" Val, [H|T]"), + emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}); + {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> + EmitFuncClause(" Val, [H|T]"), + emit({indent(3),"'",M,"':'enc_",TypeName,"'(H, Val, T)"}); + {{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_constr_type(Erules,[TypeDef|Rest]) when is_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, + #'Externaltypereference'{module=M,type=T}) -> + CurrentMod = get(currmod), + TDef = asn1_db:dbget(M,T), + Def = TDef#typedef.typespec, + OTag = Def#type.tag, + Tag = [encode_tag_val(decode_class(X#tag.class), + X#tag.form,X#tag.number)|| + X <- OTag], + if + M == CurrentMod -> + emit({" 'enc_",T,"'(Val, ",{asis,Tag},")"}), + []; + true -> + emit({" '",M,"':'enc_",T,"'(Val, ",{asis,Tag},")"}), + [] + end; +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(" Bytes"), + emit([" Bytes"]), + []; + {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) -> + CurrentMod = get(currmod), + 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', ",{asis,Name}, + "}})"]); + {false,{'DEFAULT',_DefaultObject}} -> + exit({error,{asn1,{"not implemented yet",Name}}}); + {{Name,#'Externalvaluereference'{module=CurrentMod, + value=TypeName}},_} -> + EmitFuncClause("Bytes,[H|T]"), + emit({indent(3),"'dec_",TypeName,"'(H, Bytes, T)"}); + {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> + EmitFuncClause("Bytes,[H|T]"), + emit({indent(3),"'",M,"':'dec_",TypeName, + "'(H, Bytes, T)"}); + {{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 is_binary(Bytes) ->",nl, + " {Tlv,_}=?RT_BER:decode(Bytes),",nl, + " Tlv;",nl, + "tlv_format(Bytes) ->",nl, + " Bytes.",nl]). + + +gen_decode_constr_type(Erules,[TypeDef|Rest]) when is_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, + #'Externaltypereference'{module=M,type=T}) -> + CurrentMod = get(currmod), + TDef = asn1_db:dbget(M,T), + Def = TDef#typedef.typespec, + OTag = Def#type.tag, + Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || + X <- OTag], + if + M == CurrentMod -> + emit({" 'dec_",T,"'(",Bytes, + ", ",{asis,Tag},")"}), + []; + true -> + emit({" '",M,"':'dec_",T, + "'(",Bytes,", ",{asis,Tag},")"}), + [] + end; +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}), + CurrMod = get(currmod), + {InternalFunc,NewNthObj}= + case ObjName of + {no_mod,no_name} -> + gen_inlined_enc_funs(Fields,ClFields,ObjSName,NthObj); + {CurrMod,Name} -> + emit({" fun 'enc_",Name,"'/3"}), + {[],NthObj}; + {ModuleName,Name} -> + emit_ext_fun(enc,ModuleName,Name), +% emit([" {'",ModuleName,"', 'enc_",Name,"'}"]), + {[],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}), + CurrMod = get(currmod), + {InternalFunc,_} = + case ObjName of + {no_mod,no_name} -> + gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj); + {CurrMod,Name} -> + emit({" fun 'enc_",Name,"'/3"}), + {[],NthObj}; + {ModuleName,Name} -> + emit_ext_fun(enc,ModuleName,Name), +% emit([" {'",ModuleName,"', 'enc_",Name,"'}"]), + {[],NthObj}; + _ -> + emit({" fun 'enc_",ObjName,"'/3"}), + {[],NthObj} + end, + emit([";",nl]), + emit_default_getenc(ObjSetName,UniqueName), + 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 is_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. + +emit_ext_fun(EncDec,ModuleName,Name) -> + emit([indent(3),"fun(T,V,O) -> '",ModuleName,"':'",EncDec,"_", + Name,"'(T,V,O) end"]). + +emit_default_getenc(ObjSetName,UniqueName) -> + emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), + emit([indent(3),"fun(C,V,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V}, {unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). + +%% 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) -> + CurrMod = get(currmod), + InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_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 is_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); + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + emit([indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl, + indent(6),"case Type of",nl]), + emit([indent(9),{asis,Name}," ->",nl]), + if + M == CurrMod -> + emit([indent(12),"'enc_",T,"'(Val)"]); + true -> + #typedef{typespec=Type} = asn1_db:dbget(M,T), + OTag = Type#type.tag, +%% Tag = [encode_tag_val((decode_class(X#tag.class) bsl 10) + +%% X#tag.number) || +%% X <- OTag], + Tag = [encode_tag_val(decode_class(X#tag.class), + X#tag.form,X#tag.number) || + X <- OTag], + emit([indent(12),"'",M,"':'enc_",T,"'(Val, ",{asis,Tag},")"]) + end, + gen_inlined_enc_funs1(Fields,Rest,ObjSetName,NthObj,[]); + false -> + %% This field was not present in the object thus there + %% were no type in the table and we therefore generate + %% code that returns the input for application treatment. + emit([indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl, + indent(6),"case Type of",nl, + indent(9),{asis,Name}," ->",nl, + indent(12),"Len = case Val of",nl, + indent(15),"B when is_binary(B) -> size(B);",nl, + indent(15),"_ -> length(Val)",nl, + indent(12),"end,",nl, + indent(12),"{Val,Len}"]), + gen_inlined_enc_funs1(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) -> + CurrMod = get(currmod), + InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), + {Acc2,NAdd}= + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_record(Type,type) -> + emit({";",nl}), + {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), + {Ret++Acc,N}; + {value,{_,Type}} when is_record(Type,typedef) -> + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), + {Ret++Acc,N}; + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + if + M == CurrMod -> + emit([indent(12),"'enc_",T,"'(Val)"]); + true -> + #typedef{typespec=Type} = asn1_db:dbget(M,T), + OTag = Type#type.tag, + Tag = [encode_tag_val(decode_class(X#tag.class), + X#tag.form,X#tag.number) || + X <- OTag], + emit([indent(12),"'",M,"':'enc_",T,"'(Val, ",{asis,Tag},")"]) + end, + {Acc,0}; + false -> + %% This field was not present in the object thus there + %% were no type in the table and we therefore generate + %% code that returns the input for application + %% treatment. + emit([";",nl,indent(9),{asis,Name}," ->",nl]), + emit([indent(12),"Len = case Val of",nl, + indent(15),"Bin when is_binary(Bin) -> size(Bin);",nl, + indent(15),"_ -> length(Val)",nl,indent(12),"end,",nl, + indent(12),"{Val,Len}"]), + {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, ",{asis,Tag},")"]), + {[TDef#typedef{name=InternalDefFunName}],1}; + _ -> + emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val",{asis,Tag},")"}), + {[],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 is_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 is_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 is_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} -> + #typedef{typespec=ExtType} = asn1_db:dbget(ExtMod,T), + OTag = ExtType#type.tag, + Tag = [encode_tag_val(decode_class(X#tag.class), + X#tag.form,X#tag.number) || + X <- OTag], + emit([indent(9),T," ->",nl,indent(12),ExtMod,":'enc_", + T,"'(Val, ",{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]), + CurrMod = get(currmod), + NewNthObj= + case ObjName of + {no_mod,no_name} -> + gen_inlined_dec_funs(Fields,ClFields,ObjSName,NthObj); + {CurrMod,Name} -> + emit([" fun 'dec_",Name,"'/3"]), + NthObj; + {ModuleName,Name} -> + emit_ext_fun(dec,ModuleName,Name), +% emit([" {'",ModuleName,"', 'dec_",Name,"'}"]), + 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]), + CurrMod = get(currmod), + case ObjName of + {no_mod,no_name} -> + gen_inlined_dec_funs(Fields,ClFields,ObjSetName,NthObj); + {CurrMod,Name} -> + emit([" fun 'dec_",Name,"'/3"]); + {ModuleName,Name} -> + emit_ext_fun(dec,ModuleName,Name); +% emit([" {'",ModuleName,"', 'dec_",Name,"'}"]); + _ -> + emit([" fun 'dec_",ObjName,"'/3"]) + end, + emit([";",nl]), + emit_default_getdec(ObjSetName,UniqueName), + 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 is_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 is_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. + +emit_default_getdec(ObjSetName,UniqueName) -> + emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), + emit([indent(2), "fun(C,V,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). + +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, + CurrMod = get(currmod), + InternalDefFunName = [NthObj,Name,ObjSetName], + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_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 is_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); + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->", + nl,indent(6),"case Type of",nl]), + emit([indent(9),{asis,Name}," ->",nl]), + if + M == CurrMod -> + emit([indent(12),"'dec_",T,"'(Bytes)"]); + true -> + #typedef{typespec=Type} = asn1_db:dbget(M,T), + OTag = Type#type.tag, + Tag = [(decode_class(X#tag.class) bsl 10) + X#tag.number || + X <- OTag], + emit([indent(12),"'",M,"':'dec_",T,"'(Bytes, ",{asis,Tag},")"]) + end, + gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj); + false -> + emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->", + nl,indent(6),"case Type of",nl, + indent(9),{asis,Name}," ->",nl, + indent(12),"Len = case Bytes of",nl, + indent(15),"B when is_binary(B) -> size(B);",nl, + indent(15),"_ -> length(Bytes)",nl, + indent(12),"end,",nl, + indent(12),"{Bytes,[],Len}"]), + gen_inlined_dec_funs1(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, + CurrMod = get(currmod), + InternalDefFunName = [NthObj,Name,ObjSetName], + N= + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_record(Type,type) -> + emit([";",nl]), + emit_inner_of_decfun(Type,DecProp,InternalDefFunName); + {value,{_,Type}} when is_record(Type,typedef) -> + emit([";",nl,indent(9),{asis,Name}," ->",nl]), + emit_inner_of_decfun(Type,DecProp,InternalDefFunName); + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + emit([";",nl,indent(9),{asis,Name}," ->",nl]), + if + M == CurrMod -> + emit([indent(12),"'dec_",T,"'(Bytes)"]); + true -> + #typedef{typespec=Type} = asn1_db:dbget(M,T), + OTag = Type#type.tag, + Tag = [(decode_class(X#tag.class) bsl 10) + + X#tag.number || X <- OTag], + emit([indent(12),"'",M,"':'dec_",T,"'(Bytes, ",{asis,Tag},")"]) + end, + 0; + false -> + emit([";",nl, + indent(9),{asis,Name}," ->",nl, + indent(12),"Len = case Bytes of",nl, + indent(15),"B when is_binary(B) -> size(B);",nl, + indent(15),"_ -> length(Bytes)",nl, + indent(12),"end,",nl, + indent(12),"{Bytes,[],Len}"]), + 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, ", + {asis,Tag},")"]), + 0 + end; +emit_inner_of_decfun(#typedef{name=Name},_Prop,_) -> + emit([indent(12),"'dec_",Name,"'(Bytes)"]), + 0; +emit_inner_of_decfun(Type,Prop,_) when is_record(Type,type) -> + 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, ",{asis,Tag},")"]) + 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,Arg) -> + demit({"io:format(\"decoding: ",{asis,Type},"~w~n\",[",Arg,"]),",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('ObjectDescriptor') -> 7; +decode_type('EXTERNAL') -> 8; +decode_type('REAL') -> 9; +decode_type('ENUMERATED') -> 10; +decode_type('EMBEDDED_PDV') -> 11; +decode_type('UTF8String') -> 12; +decode_type('RELATIVE-OID') -> 13; +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('T61String') -> 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/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl new file mode 100644 index 0000000000..06d2489748 --- /dev/null +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -0,0 +1,1395 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_gen_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 is_record(Type,typedef) -> + gen_encode_user(Erules,Type). +%% case Type#typedef.typespec of +%% Def when is_record(Def,type) -> +%% gen_encode_user(Erules,Type); +%% Def when is_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 is_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 is_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 is_record(D,type) -> + Constraint = D#type.constraint, + asn1ct_name:new(enumval), + case D#type.def of + 'INTEGER' -> + emit({"?RT_PER:encode_integer(", %fel + {asis,effective_constraint(integer,Constraint)},",",Value,")"}); + {'INTEGER',NamedNumberList} -> + emit({"?RT_PER:encode_integer(", + {asis,effective_constraint(integer,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}}], + case Erules of + uper_bin -> + emit(["case ",Value," of",nl]); + _ -> + emit(["case (case ",Value," of {_,",{curr,enumval},"}-> ", + {curr,enumval},";_->", Value," end) of",nl]), + asn1ct_name:new(enumval) + end, +%% emit_enc_enumerated_cases(Erules,NewC, NewList++[{asn1_enum,length(Nlist1)-1}], 0); + emit_enc_enumerated_cases(Erules,NewC, NewList, 0); + {'ENUMERATED',NamedNumberList} -> + NewList = [X||{X,_} <- NamedNumberList], + NewC = [{'ValueRange',{0,length(NewList)-1}}], + case Erules of + uper_bin -> + emit(["case ",Value," of",nl]); + _ -> + emit(["case (case ",Value," of {_,",{curr,enumval}, + "}->",{curr,enumval},";_->",Value," end) of",nl]) + end, + emit_enc_enumerated_cases(Erules,NewC, NewList, 0); + + 'REAL' -> + emit({"?RT_PER:encode_real(",Value,")"}); + + {'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,")"}); + 'RELATIVE-OID' -> + emit({"?RT_PER:encode_relative_oid(",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,")"}); + TString when TString == 'TeletexString'; + TString == 'T61String' -> + 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,")"}); + 'UTF8String' -> + emit({"?RT_PER:encode_UTF8String(",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, ")"]); + #'ObjectClassFieldType'{} -> + case asn1ct_gen:get_inner(D#type.def) of + {fixedtypevaluefield,_,InnerType} -> + gen_encode_prim(Erules,InnerType,DoTag,Value); + T -> %% 'ASN1_OPEN_TYPE' + gen_encode_prim(Erules,D#type{def=T},DoTag,Value) + end; + XX -> + exit({asn1_error,nyi,XX}) + end. + + +emit_enc_enumerated_cases(Erule,C, [H], Count) -> + emit_enc_enumerated_case(Erule,C, H, Count), + case H of + 'EXT_MARK' -> ok; + _ -> + emit([";",nl]) + end, + emit([nl,"EnumVal -> exit({error,{asn1, {enumerated_not_in_range, EnumVal}}})"]), + emit([nl,"end"]); +emit_enc_enumerated_cases(Erule, C, ['EXT_MARK'|T], _Count) -> + emit_enc_enumerated_cases(Erule, C, T, 0); +emit_enc_enumerated_cases(Erule, C, [H1,H2|T], Count) -> + emit_enc_enumerated_case(Erule, C, H1, Count), + emit([";",nl]), + emit_enc_enumerated_cases(Erule, C, [H2|T], Count+1). + + + +emit_enc_enumerated_case(uper_bin,_C, {asn1_enum,High}, _) -> + emit([ + "{asn1_enum,EnumV} when is_integer(EnumV), EnumV > ",High," -> ", + "[<<1:1>>,?RT_PER:encode_small_number(EnumV)]"]); +emit_enc_enumerated_case(_Per,_C, {asn1_enum,High}, _) -> + emit([ + "{asn1_enum,EnumV} when is_integer(EnumV), EnumV > ",High," -> ", + "[{bit,1},?RT_PER:encode_small_number(EnumV)]"]); +emit_enc_enumerated_case(_Erule, _C, 'EXT_MARK', _Count) -> + true; +emit_enc_enumerated_case(uper_bin,_C, {1,EnumName}, Count) -> + emit(["'",EnumName,"' -> [<<1:1>>,?RT_PER:encode_small_number(",Count,")]"]); +emit_enc_enumerated_case(_Per,_C, {1,EnumName}, Count) -> + emit(["'",EnumName,"' -> [{bit,1},?RT_PER:encode_small_number(",Count,")]"]); +emit_enc_enumerated_case(uper_bin,C, {0,EnumName}, Count) -> + emit(["'",EnumName,"' -> [<<0:1>>,?RT_PER:encode_integer(",{asis,C},", ",Count,")]"]); +emit_enc_enumerated_case(_Per,C, {0,EnumName}, Count) -> + emit(["'",EnumName,"' -> [{bit,0},?RT_PER:encode_integer(",{asis,C},", ",Count,")]"]); +emit_enc_enumerated_case(_Erule, C, EnumName, Count) -> + emit(["'",EnumName,"' -> ?RT_PER:encode_integer(",{asis,C},", ",Count,")"]). + +%% 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), + greatest_common_range(SV,VR). + +effective_constr(_,[]) -> + []; +effective_constr('SingleValue',List) -> + SVList = lists:flatten(lists:map(fun(X)->element(2,X)end,List)), + % sort and remove duplicates + SortedSVList = lists:sort(SVList), + RemoveDup = fun([],_) ->[]; + ([H],_) -> [H]; + ([H,H|T],F) -> F([H|T],F); + ([H|T],F) -> [H|F(T,F)] + end, + + case RemoveDup(SortedSVList,RemoveDup) of + [N] -> + [{'SingleValue',N}]; + L when is_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(SV,VR) -> + greatest_common_range2(mk_vr(SV),mk_vr(VR)). +greatest_common_range2({_,Int},{'MIN',Ub}) when is_integer(Int), + Int > Ub -> + [{'ValueRange',{'MIN',Int}}]; +greatest_common_range2({_,Int},{Lb,Ub}) when is_integer(Int), + Int < Lb -> + [{'ValueRange',{Int,Ub}}]; +greatest_common_range2({_,Int},VR={_Lb,_Ub}) when is_integer(Int) -> + [{'ValueRange',VR}]; +greatest_common_range2({_,L},{Lb,Ub}) when is_list(L) -> + Min = least_Lb([Lb|L]), + Max = greatest_Ub([Ub|L]), + [{'ValueRange',{Min,Max}}]. + +mk_vr([{Type,I}]) when is_atom(Type), is_integer(I) -> + {I,I}; +mk_vr([{Type,{Lb,Ub}}]) when is_atom(Type) -> + {Lb,Ub}; +mk_vr(Other) -> + Other. + +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. + + +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. + + +%% Object code generating for encoding and decoding +%% ------------------------------------------------ + +gen_obj_code(Erules,_Module,Obj) when is_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(Erules, 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 is_record(Obj,pobjectdef) -> + ok. + + +gen_encode_objectfields(Erule,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("Val"), + case Erule of + uper_bin -> + emit(" Val"); + _ -> + emit(" [{octets,Val}]") + end, + []; + {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(Erule,ClassName,Rest,ObjName,ObjectFields, + MaybeConstr++ConstrAcc); +gen_encode_objectfields(Erule,ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], + ObjName,ObjectFields,ConstrAcc) -> + CurrentMod = get(currmod), + 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', ",{asis,Name}, + "}})"]); + {false,{'DEFAULT',_DefaultObject}} -> + exit({error,{asn1,{"not implemented yet",Name}}}); + {{Name,#'Externalvaluereference'{module=CurrentMod, + value=TypeName}},_} -> + EmitFuncClause(" Val, [H|T]"), + emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}); + {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> + EmitFuncClause(" Val, [H|T]"), + emit({indent(3),"'",M,"':'enc_",TypeName,"'(H, Val, T)"}); + {{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(Erule,ClassName,Rest,ObjName,ObjectFields,ConstrAcc); +gen_encode_objectfields(Erule,ClassName,[_C|Cs],O,OF,Acc) -> + gen_encode_objectfields(Erule,ClassName,Cs,O,OF,Acc); +gen_encode_objectfields(_, _,[],_,_,Acc) -> + Acc. + + +gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) -> + case is_already_generated(enc,TypeDef#typedef.name) of + true -> ok; + _ -> +%% FuncName = list_to_atom(lists:concat(["enc_",TypeDef#typedef.name])), + FuncName = asn1ct_gen:list2rname(TypeDef#typedef.name ++ [enc]), + emit(["'",FuncName,"'(Val) ->",nl]), + Def = TypeDef#typedef.typespec, + InnerType = asn1ct_gen:get_inner(Def#type.def), + asn1ct_gen:gen_encode_constructed(Erules,TypeDef#typedef.name, + InnerType,Def), + gen_encode_constr_type(Erules,Rest) + end; +gen_encode_constr_type(_,[]) -> + ok. + +gen_encode_field_call(_ObjName,_FieldName, + #'Externaltypereference'{module=M,type=T}) -> + CurrentMod = get(currmod), + if + M == CurrentMod -> + emit({" 'enc_",T,"'(Val)"}), + []; + true -> + emit({" '",M,"':'enc_",T,"'(Val)"}), + [] + end; +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]))}]; + [Type#typedef{name=[FieldName,ObjName]}]; + {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])), + [#typedef{name=[FieldName,ClassName], + 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("Bytes"), + emit([" {Bytes,[]}"]), + []; + {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) -> + CurrentMod = get(currmod), + 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', ",{asis,Name}, + "}})"]); + {false,{'DEFAULT',_DefaultObject}} -> + exit({error,{asn1,{"not implemented yet",Name}}}); + {{Name,#'Externalvaluereference'{module=CurrentMod, + value=TypeName}},_} -> + EmitFuncClause("Bytes,_,[H|T]"), + emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"}); + {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> + EmitFuncClause("Bytes,_,[H|T]"), + emit({indent(3),"'",M,"':'dec_",TypeName, + "'(H, Bytes, telltype, T)"}); + {{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, + #'Externaltypereference'{module=M,type=T}) -> + CurrentMod = get(currmod), + if + M == CurrentMod -> + emit([" 'dec_",T,"'(",Bytes,", telltype)"]), + []; + true -> + emit([" '",M,"':'dec_",T,"'(",Bytes,", telltype)"]), + [] + end; +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]))}]; + [Type#typedef{name=[FieldName,ObjName]}]; + {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])), + [#typedef{name=[FieldName,ClassName], + 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,[TypeDef|Rest]) when is_record(TypeDef,typedef) -> + case is_already_generated(dec,TypeDef#typedef.name) of + true -> ok; + _ -> + gen_decode(Erules,TypeDef#typedef{name=asn1ct_gen:list2rname(TypeDef#typedef.name)}) + end, + gen_decode_constr_type(Erules,Rest); +gen_decode_constr_type(_,[]) -> + ok. + + +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(Erules,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(Erule,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest], + ClName,ClFields,NthObj,Acc)-> + emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val}, + ") ->",nl}), + CurrMod = get(currmod), + {InternalFunc,NewNthObj}= + case ObjName of + {no_mod,no_name} -> + gen_inlined_enc_funs(Erule,Fields,ClFields,ObjSName,NthObj); + {CurrMod,Name} -> + emit({" fun 'enc_",Name,"'/3"}), + {[],0}; + {ModName,Name} -> + emit_ext_encfun(ModName,Name), +% emit([" {'",ModName,"', 'enc_",Name,"'}"]), + {[],0}; + _Other -> + emit({" fun 'enc_",ObjName,"'/3"}), + {[],0} + end, + emit({";",nl}), + gen_objset_enc(Erule,ObjSName,UniqueName,[T|Rest],ClName,ClFields, + NewNthObj,InternalFunc ++ Acc); +gen_objset_enc(Erule,ObjSetName,UniqueName, + [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) -> + + emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",", + {asis,Val},") ->",nl}), + CurrMod = get(currmod), + {InternalFunc,_}= + case ObjName of + {no_mod,no_name} -> + gen_inlined_enc_funs(Erule,Fields,ClFields,ObjSetName,NthObj); + {CurrMod,Name} -> + emit({" fun 'enc_",Name,"'/3"}), + {[],NthObj}; + {ModName,Name} -> + emit_ext_encfun(ModName,Name), +% emit([" {'",ModName,"', 'enc_",Name,"'}"]), + {[],NthObj}; + _Other -> + emit({" fun 'enc_",ObjName,"'/3"}), + {[],NthObj} + end, + emit([";",nl]), + emit_default_getenc(ObjSetName,UniqueName), + emit({".",nl,nl}), + InternalFunc++Acc; +gen_objset_enc(Erule,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, + _ClFields,_NthObj,Acc) -> + emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), + emit({indent(3),"fun(_, Val, _) ->",nl}), + case Erule of + uper_bin -> + emit([indent(6),"Val",nl]); + _ -> + emit([indent(6),"[{octets,Val}]",nl]) + end, + emit({indent(3),"end.",nl,nl}), + Acc; +gen_objset_enc(_,_,_,[],_,_,_,Acc) -> + Acc. + +emit_ext_encfun(ModuleName,Name) -> + emit([indent(4),"fun(T,V,O) -> '",ModuleName,"':'enc_", + Name,"'(T,V,O) end"]). + +emit_default_getenc(ObjSetName,UniqueName) -> + emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), + emit([indent(4),"fun(C,V,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]). + + +%% 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(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName,NthObj) -> + CurrMod = get(currmod), + InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_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(Erule,Fields,Rest,ObjSetName,NthObj+N,Ret); + {value,{_,Type}} when is_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(Erule,Fields,Rest,ObjSetName,NthObj+N,Ret); + {value,{_,#'Externaltypereference'{module=CurrMod,type=T}}} -> + emit({indent(3),"fun(Type, Val, _) ->",nl, + indent(6),"case Type of",nl}), + emit({indent(9),{asis,Name}," ->",nl}), + emit([indent(12),"'enc_",T,"'(Val)"]), +% {Ret,N} = emit_inner_of_fun(TDef,InternalDefFunName), + gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]); + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + emit({indent(3),"fun(Type, Val, _) ->",nl, + indent(6),"case Type of",nl}), + emit({indent(9),{asis,Name}," ->",nl}), + emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]), + gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]); + false when Erule == uper_bin -> + emit([indent(3),"fun(Type,Val,_) ->",nl, + indent(6),"case Type of",nl, + indent(9),{asis,Name}," -> Val",nl]), + gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]); + false -> + emit([indent(3),"fun(Type,Val,_) ->",nl, + indent(6),"case Type of",nl, + indent(9),{asis,Name}," -> [{octets,Val}]",nl]), + gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]) + end; +gen_inlined_enc_funs(Erule,Fields,[_H|Rest],ObjSetName,NthObj) -> + gen_inlined_enc_funs(Erule,Fields,Rest,ObjSetName,NthObj); +gen_inlined_enc_funs(_,_,[],_,NthObj) -> + {[],NthObj}. + +gen_inlined_enc_funs1(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName, + NthObj,Acc) -> + CurrentMod = get(currmod), + InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), + {Acc2,NAdd}= + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_record(Type,type) -> + emit({";",nl}), + {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), + {Ret++Acc,N}; + {value,{_,Type}} when is_record(Type,typedef) -> + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + {Ret,N}=emit_inner_of_fun(Type,InternalDefFunName), + {Ret++Acc,N}; + {value,{_,#'Externaltypereference'{module=CurrentMod,type=T}}} -> + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + emit([indent(12),"'enc_",T,"'(Val)"]), + {Acc,0}; + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]), + {Acc,0}; + false when Erule == uper_bin -> + emit([";",nl, + indent(9),{asis,Name}," -> ",nl, + "Val",nl]), + {Acc,0}; + false -> + emit([";",nl, + indent(9),{asis,Name}," -> ",nl, + "[{octets,Val}]",nl]), + {Acc,0} + end, + gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+NAdd,Acc2); +gen_inlined_enc_funs1(Erule,Fields,[_H|Rest],ObjSetName,NthObj,Acc)-> + gen_inlined_enc_funs1(Erule,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 is_record(Type,type) -> + CurrMod = get(currmod), + case Type#type.def of + Def when is_atom(Def) -> + emit({indent(9),Def," ->",nl,indent(12)}), + gen_encode_prim(erules,Type,dotag,"Val"); + TRef when is_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}), + CurrMod = get(currmod), + NewNthObj= + case ObjName of + {no_mod,no_name} -> + gen_inlined_dec_funs(Fields,ClFields,ObjSName,NthObj); + {CurrMod,Name} -> + emit([" fun 'dec_",Name,"'/4"]), + NthObj; + {ModName,Name} -> + emit_ext_decfun(ModName,Name), +% emit([" {'",ModName,"', 'dec_",Name,"'}"]), + 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}), + CurrMod=get(currmod), + case ObjName of + {no_mod,no_name} -> + gen_inlined_dec_funs(Fields,ClFields,ObjSetName,NthObj); + {CurrMod,Name} -> + emit([" fun 'dec_",Name,"'/4"]); + {ModName,Name} -> + emit_ext_decfun(ModName,Name); +% emit([" {'",ModName,"', 'dec_",Name,"'}"]); + _Other -> + emit({" fun 'dec_",ObjName,"'/4"}) + end, + emit([";",nl]), + emit_default_getdec(ObjSetName,UniqueName), + 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. + +emit_ext_decfun(ModuleName,Name) -> + emit([indent(3),"fun(T,V,O1,O2) -> '",ModuleName,"':'dec_", + Name,"'(T,V,O1,O2) end"]). + +emit_default_getdec(ObjSetName,UniqueName) -> + emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), + emit([indent(2), "fun(C,V,_,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]). + + +gen_inlined_dec_funs(Fields,[{typefield,Name,_}|Rest], + ObjSetName,NthObj) -> + CurrMod = get(currmod), + InternalDefFunName = [NthObj,Name,ObjSetName], + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_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 is_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); + {value,{_,#'Externaltypereference'{module=CurrMod,type=T}}} -> + emit({indent(3),"fun(Type, Val, _, _) ->",nl, + indent(6),"case Type of",nl}), + emit({indent(9),{asis,Name}," ->",nl}), + emit([indent(12),"'dec_",T,"'(Val, telltype)"]), + gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj); + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + emit({indent(3),"fun(Type, Val, _, _) ->",nl, + indent(6),"case Type of",nl}), + emit({indent(9),{asis,Name}," ->",nl}), + emit([indent(12),"'",M,"':'dec_",T,"'(Val, telltype)"]), + gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj); + false -> + emit([indent(3),"fun(Type, Val, _, _) ->",nl, + indent(6),"case Type of",nl, + indent(9),{asis,Name}," ->{Val,Type}"]), + gen_inlined_dec_funs1(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) -> + CurrentMod = get(currmod), + InternalDefFunName = [NthObj,Name,ObjSetName], + N=case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_record(Type,type) -> + emit({";",nl}), + emit_inner_of_decfun(Type,InternalDefFunName); + {value,{_,Type}} when is_record(Type,typedef) -> + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + emit_inner_of_decfun(Type,InternalDefFunName); + {value,{_,#'Externaltypereference'{module=CurrentMod,type=T}}} -> + emit([";",nl,indent(9),{asis,Name}," ->",nl]), + emit([indent(12),"'dec_",T,"'(Val,telltype)"]), + 0; + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + emit([";",nl,indent(9),{asis,Name}," ->",nl]), + emit([indent(12),"'",M,"'",":'dec_",T,"'(Val,telltype)"]), + 0; + false -> + emit([";",nl, + indent(9),{asis,Name}," ->{Val,Type}"]), + 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 is_record(Type,type) -> + CurrMod = get(currmod), + case Type#type.def of + Def when is_atom(Def) -> + emit({indent(9),Def," ->",nl,indent(12)}), + gen_dec_prim(erules,Type,"Val"); + TRef when is_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 is_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 is_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 is_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 is_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,effective_constraint(integer,Constraint)},")"}); + {'INTEGER',NamedNumberList} -> + emit({"?RT_PER:decode_integer(",BytesVar,",", + {asis,effective_constraint(integer,Constraint)},",", + {asis,NamedNumberList},")"}); + + 'REAL' -> + emit({"?RT_PER:decode_real(",BytesVar,")"}); + + {'BIT STRING',NamedNumberList} -> + case get(compact_bit_string) of + true -> + emit({"?RT_PER:decode_compact_bit_string(", + BytesVar,",",{asis,Constraint},",", + {asis,NamedNumberList},")"}); + _ -> + emit({"?RT_PER:decode_bit_string(",BytesVar,",", + {asis,Constraint},",", + {asis,NamedNumberList},")"}) + end; + 'NULL' -> + emit({"?RT_PER:decode_null(", + BytesVar,")"}); + 'OBJECT IDENTIFIER' -> + emit({"?RT_PER:decode_object_identifier(", + BytesVar,")"}); + 'RELATIVE-OID' -> + emit({"?RT_PER:decode_relative_oid(", + 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},")"}); + TString when TString == 'TeletexString'; + TString == 'T61String' -> + 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},")"}); + 'UTF8String' -> + emit({"?RT_PER:decode_UTF8String(",BytesVar,")"}); + 'ANY' -> + case Erules of + per -> + emit(["fun() -> {XTerm,YTermXBytes} = ?RT_PER:decode_open_type(",BytesVar,",",{asis,Constraint}, "), {binary_to_list(XTerm),XBytes} end ()"]); + _ -> + emit(["?RT_PER:decode_open_type(",BytesVar,",", + {asis,Constraint}, ")"]) + end; + '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,")"]); + _ -> + case Erules of + per -> + emit(["fun() -> {XTerm,XBytes} = ?RT_PER:decode_open_type(",BytesVar,", []), {binary_to_list(XTerm),XBytes} end()"]); + _ -> + emit(["?RT_PER:decode_open_type(",BytesVar,",[])"]) + end + end; + #'ObjectClassFieldType'{} -> + case asn1ct_gen:get_inner(Att#type.def) of + {fixedtypevaluefield,_,InnerType} -> + gen_dec_prim(Erules,InnerType,BytesVar); + T -> + gen_dec_prim(Erules,Att#type{def=T},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/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl new file mode 100644 index 0000000000..56f895828a --- /dev/null +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -0,0 +1,1798 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_gen_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 is_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 is_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 is_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 is_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(Erules,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(Erules,EffectiveConstr,Value,NamedNumberList); + {'ENUMERATED',{Nlist1,Nlist2}} -> + NewList = lists:append([[{0,X}||{X,_} <- Nlist1],['EXT_MARK'],[{1,X}||{X,_} <- Nlist2]]), + NewC = [{'ValueRange',{0,length(Nlist1)-1}}], + emit(["case ",Value," of",nl]), +%% emit_enc_enumerated_cases(Erules,NewC, NewList++[{asn1_enum,length(Nlist1)-1}], 0); + emit_enc_enumerated_cases(Erules,NewC, NewList, 0); + {'ENUMERATED',NamedNumberList} -> + NewList = [X||{X,_} <- NamedNumberList], + NewC = effective_constraint(integer, + [{'ValueRange', + {0,length(NewList)-1}}]), + NewVal = enc_enum_cases(Value,NewList), + emit_enc_integer(Erules,NewC,NewVal); + + 'REAL' -> + emit({"?RT_PER:encode_real(",Value,")"}); + + {'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,")"}); + 'RELATIVE-OID' -> + emit({"?RT_PER:encode_relative_oid(",Value,")"}); + 'ObjectDescriptor' -> + emit({"?RT_PER:encode_ObjectDescriptor(",{asis,Constraint}, + ",",Value,")"}); + 'BOOLEAN' -> + emit({"case ",Value," of",nl, + " true -> [1];",nl, + " false -> [0];",nl, + " _ -> exit({error,{asn1,{encode_boolean,",Value,"}}})",nl, + "end"}); + 'OCTET STRING' -> + emit_enc_octet_string(Erules,Constraint,Value); + + 'NumericString' -> + emit_enc_known_multiplier_string('NumericString',Constraint,Value); + TString when TString == 'TeletexString'; + TString == 'T61String' -> + 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); + 'UTF8String' -> + emit({"?RT_PER:encode_UTF8String(",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, ")"]); + #'ObjectClassFieldType'{} -> + case asn1ct_gen:get_inner(D#type.def) of + {fixedtypevaluefield,_,InnerType} -> + gen_encode_prim(Erules,InnerType,DoTag,Value); + T -> %% 'ASN1_OPEN_TYPE' + gen_encode_prim(Erules,D#type{def=T},DoTag,Value) + end; + XX -> + exit({asn1_error,nyi,XX}) + end. + +emit_enc_known_multiplier_string(StringType,C,Value) -> + SizeC = + case get_constraint(C,'SizeConstraint') of + L when is_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 is_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(_Erules,Constraint,Value) -> + case get_constraint(Constraint,'SizeConstraint') of + 0 -> + emit({" []"}); + 1 -> + asn1ct_name:new(tmpval), + emit({" begin",nl}), + emit({" [",{curr,tmpval},"] = ",Value,",",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({" [[10,8,",{curr,tmpval},"],[10,8,", + {next,tmpval},"]]",nl}), + emit(" end"), + asn1ct_name:new(tmpval); + Sv when is_integer(Sv),Sv =< 256 -> + asn1ct_name:new(tmpval), + emit({" begin",nl}), + emit({" case length(",Value,") of",nl}), + emit([" ",{curr,tmpval}," when ",{curr,tmpval}," == ",Sv," ->"]), + emit([" [2,20,",{curr,tmpval},",",Value,"];",nl]), + emit({" _ -> exit({error,{value_out_of_bounds,", + Value,"}})", nl," end",nl}), + emit(" end"); + Sv when is_integer(Sv),Sv =< 65535 -> + asn1ct_name:new(tmpval), + emit({" begin",nl}), + emit({" case length(",Value,") of",nl}), + emit([" ",{curr,tmpval}," when ",{curr,tmpval}," == ",Sv," ->"]), + emit([" [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'; + is_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(Erules,C,Value,NNL) -> + EncVal = enc_integer_NNL_cases(Value,NNL), + emit_enc_integer(Erules,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 is_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(_Erule,[{'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(_Erule,[{_,{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(_Erule,[{_,{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(_Erule,[{_,{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(_Erule,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(Erule, C, [H], Count) -> + emit_enc_enumerated_case(Erule, C, H, Count), + case H of + 'EXT_MARK' -> + ok; + _ -> + emit([";",nl]) + end, + emit([nl,"EnumVal -> exit({error,{asn1, {enumerated_not_in_range, EnumVal}}})"]), + emit([nl,"end"]); +emit_enc_enumerated_cases(Erule, C, ['EXT_MARK'|T], _Count) -> + emit_enc_enumerated_cases(Erule, C, T, 0); +emit_enc_enumerated_cases(Erule, C, [H1,H2|T], Count) -> + emit_enc_enumerated_case(Erule, C, H1, Count), + emit([";",nl]), + emit_enc_enumerated_cases(Erule, 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(_Erule,_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 is_integer(EnumV), EnumV > ",High," -> ", +%% "[1,?RT_PER:encode_small_number(EnumV)]"]); +emit_enc_enumerated_case(_Erule,_C, {1,EnumName}, Count) -> + %% ENUMERATED with extensionmark + %% values higher than extension root + emit(["'",EnumName,"' -> [1,?RT_PER:encode_small_number(",Count,")]"]); +emit_enc_enumerated_case(_Erule,C, {0,EnumName}, Count) -> + %% ENUMERATED with extensionmark + %% values within extension root +%% emit(["'",EnumName,"' -> [0,?RT_PER:encode_integer(",{asis,C},", ",Count,")]"]); + emit(["'",EnumName,"' -> ",{asis,[0|asn1rt_per_bin_rt2ct:encode_integer(C,Count)]}]); +emit_enc_enumerated_case(_Erule, _C, 'EXT_MARK', _Count) -> + true. +%% %% This clause is invoked in case of an ENUMERATED without extension mark +%% emit_enc_enumerated_case(_Erule,_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) -> + get_constraint(C,'SizeConstraint'). + +effective_constr(_,[]) -> + []; +effective_constr('SingleValue',List) -> + SVList = lists:flatten(lists:map(fun(X)->element(2,X)end,List)), + % sort and remove duplicates + RemoveDup = fun([],_) ->[]; + ([H],_) -> [H]; + ([H,H|T],F) -> F([H|T],F); + ([H|T],F) -> [H|F(T,F)] + end, + + case RemoveDup(SVList,RemoveDup) of + [N] -> + [{'SingleValue',N}]; + L when is_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 is_integer(Int), + Int > Ub -> + [{'ValueRange',{'MIN',Int}}]; +greatest_common_range([{_,Int}],[{_,{Lb,Ub}}]) when is_integer(Int), + Int < Lb -> + [{'ValueRange',{Int,Ub}}]; +greatest_common_range([{_,Int}],VR=[{_,{_Lb,_Ub}}]) when is_integer(Int) -> + VR; +greatest_common_range([{_,L}],[{_,{Lb,Ub}}]) when is_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. + + + + +pre_encode(integer,[]) -> + []; +pre_encode(integer,C=[{'SingleValue',_}]) -> + C; +pre_encode(integer,C=[{'ValueRange',VR={Lb,Ub}}]) when is_integer(Lb),is_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 is_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(Erules,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(_Erules,_Module,Obj) when is_record(Obj,pobjectdef) -> + ok. + +gen_encode_objectfields(Erules,ClassName,[{typefield,Name,OptOrMand}|Rest], + ObjName,ObjectFields,ConstrAcc) -> + EmitFuncClause = + fun(V) -> + emit(["'enc_",ObjName,"'(",{asis,Name}, + ",",V,",_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("Val"), + emit([" if",nl, + " is_list(Val) ->",nl, + " NewVal = list_to_binary(Val),",nl, + " [20,size(NewVal),NewVal];",nl, + " is_binary(Val) ->",nl, + " [20,size(Val),Val]",nl, + " end"]), + []; + {false,{'DEFAULT',DefaultType}} -> + EmitFuncClause("Val"), + gen_encode_default_call(Erules,ClassName,Name,DefaultType); + {{Name,TypeSpec},_} -> + %% A specified field owerwrites any 'DEFAULT' or + %% 'OPTIONAL' field in the class + EmitFuncClause("Val"), + gen_encode_field_call(Erules,ObjName,Name,TypeSpec) + end, + case more_genfields(Rest) of + true -> + emit([";",nl]); + false -> + emit([".",nl]) + end, + gen_encode_objectfields(Erules,ClassName,Rest,ObjName,ObjectFields, + MaybeConstr++ConstrAcc); +gen_encode_objectfields(Erules,ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], + ObjName,ObjectFields,ConstrAcc) -> + CurrentMod = get(currmod), + 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', ",{asis,Name}, + "}})"]); + {false,{'DEFAULT',_DefaultObject}} -> + exit({error,{asn1,{"not implemented yet",Name}}}); + {{Name,#'Externalvaluereference'{module=CurrentMod, + value=TypeName}},_} -> + EmitFuncClause(" Val, [H|T]"), + emit({indent(3),"'enc_",TypeName,"'(H, Val, T)"}); + {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> + EmitFuncClause(" Val, [H|T]"), + emit({indent(3),"'",M,"':'enc_",TypeName,"'(H, Val, T)"}); + {{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(Erules,ClassName,Rest,ObjName,ObjectFields,ConstrAcc); +gen_encode_objectfields(Erules,ClassName,[_C|Cs],O,OF,Acc) -> + gen_encode_objectfields(Erules,ClassName,Cs,O,OF,Acc); +gen_encode_objectfields(_Erules,_,[],_,_,Acc) -> + Acc. + + + +gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_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(_Erule,_ObjName,_FieldName, + #'Externaltypereference'{module=M,type=T}) -> + CurrentMod = get(currmod), + if + M == CurrentMod -> + emit({" 'enc_",T,"'(Val)"}), + []; + true -> + emit({" '",M,"':'enc_",T,"'(Val)"}), + [] + end; +gen_encode_field_call(Erule,ObjName,FieldName,Type) -> + Def = Type#typedef.typespec, + case Type#typedef.name of + {primitive,bif} -> + gen_encode_prim(Erule,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(Erules,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(Erules,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("Bytes"), + emit([" {Bytes,[]}"]), + []; + {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) -> + CurrentMod = get(currmod), + 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', ",{asis,Name}, + "}})"]); + {false,{'DEFAULT',_DefaultObject}} -> + exit({error,{asn1,{"not implemented yet",Name}}}); + {{Name,#'Externalvaluereference'{module=CurrentMod, + value=TypeName}},_} -> + EmitFuncClause("Bytes,_,[H|T]"), + emit({indent(3),"'dec_",TypeName,"'(H, Bytes, telltype, T)"}); + {{Name,#'Externalvaluereference'{module=M,value=TypeName}},_} -> + EmitFuncClause("Bytes,_,[H|T]"), + emit({indent(3),"'",M,"':'dec_",TypeName, + "'(H, Bytes, telltype, T)"}); + {{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, + #'Externaltypereference'{module=M,type=T}) -> + CurrentMod = get(currmod), + if + M == CurrentMod -> + emit([" 'dec_",T,"'(",Bytes,", telltype)"]), + []; + true -> + emit([" '",M,"':'dec_",T,"'(",Bytes,", telltype)"]), + [] + end; +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,[TypeDef|Rest]) when is_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. + +%% 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(Erule,ObjSetName,UniqueFName,Set,ClassName,ClassDef)-> + ClassFields = (ClassDef#classdef.typespec)#objectclass.fields, + InternalFuncs= + gen_objset_enc(Erule,ObjSetName,UniqueFName,Set,ClassName, + ClassFields,1,[]), + gen_objset_dec(ObjSetName,UniqueFName,Set,ClassName,ClassFields,1), + gen_internal_funcs(Erule,InternalFuncs). + +gen_objset_enc(_Erule,_,{unique,undefined},_,_,_,_,_) -> + %% There is no unique field in the class of this object set + %% don't bother about the constraint + []; +gen_objset_enc(Erule,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest], + ClName,ClFields,NthObj,Acc)-> + emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",", + {asis,Val},") ->",nl}), + CurrMod = get(currmod), + {InternalFunc,NewNthObj}= + case ObjName of + {no_mod,no_name} -> + gen_inlined_enc_funs(Erule,Fields,ClFields,ObjSName,NthObj); + {CurrMod,Name} -> + emit({" fun 'enc_",Name,"'/3"}), + {[],NthObj}; + {ModName,Name} -> + emit_ext_encfun(ModName,Name), +% emit([" {'",ModName,"', 'enc_",Name,"'}"]), + {[],NthObj}; + _ -> + emit({" fun 'enc_",ObjName,"'/3"}), + {[],NthObj} + end, + emit({";",nl}), + gen_objset_enc(Erule,ObjSName,UniqueName,[T|Rest],ClName,ClFields, + NewNthObj,InternalFunc++Acc); +gen_objset_enc(Erule,ObjSetName,UniqueName, + [{ObjName,Val,Fields}],_ClName,ClFields,NthObj,Acc) -> + + emit({"'getenc_",ObjSetName,"'(",{asis,UniqueName},",", + {asis,Val},") ->",nl}), + CurrMod = get(currmod), + {InternalFunc,_}= + case ObjName of + {no_mod,no_name} -> + gen_inlined_enc_funs(Erule,Fields,ClFields,ObjSetName,NthObj); + {CurrMod,Name} -> + emit({" fun 'enc_",Name,"'/3"}), + {[],NthObj}; + {ModName,Name} -> + emit_ext_encfun(ModName,Name), +% emit([" {'",ModName,"', 'enc_",Name,"'}"]), + {[],NthObj}; + _ -> + emit({" fun 'enc_",ObjName,"'/3"}), + {[],NthObj} + end, + emit([";",nl]), + emit_default_getenc(ObjSetName,UniqueName), + emit({".",nl,nl}), + InternalFunc++Acc; +gen_objset_enc(_Erule,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, + _ClFields,_NthObj,Acc) -> + emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), + emit({indent(3),"fun(_, Val, _) ->",nl}), + emit({indent(6),"BinVal = if",nl}), + emit({indent(9),"is_list(Val) -> list_to_binary(Val);",nl}), + emit({indent(9),"true -> Val",nl}), + emit({indent(6),"end,",nl}), + emit({indent(6),"Size = size(BinVal),",nl}), + emit({indent(6),"if",nl}), + emit({indent(9),"Size < 256 ->",nl}), + emit({indent(12),"[20,Size,BinVal];",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(_Erule,_,_,[],_,_,_,Acc) -> + Acc. + +emit_ext_encfun(ModuleName,Name) -> + emit([indent(4),"fun(T,V,O) -> '",ModuleName,"':'enc_", + Name,"'(T,V,O) end"]). + +emit_default_getenc(ObjSetName,UniqueName) -> + emit(["'getenc_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), + emit([indent(4),"fun(C,V,_) -> exit({'Type not compatible with table constraint',{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]). + + +%% 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(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName,NthObj) -> + CurrMod = get(currmod), + InternalDefFunName=asn1ct_gen:list2name([NthObj,Name,ObjSetName]), + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_record(Type,type) -> + emit({indent(3),"fun(Type, Val, _) ->",nl, + indent(6),"case Type of",nl}), + {Ret,N}=emit_inner_of_fun(Erule,Type,InternalDefFunName), + gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+N,Ret); + {value,{_,Type}} when is_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(Erule,Type,InternalDefFunName), + gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+N,Ret); + {value,{_,#'Externaltypereference'{module=CurrMod,type=T}}} -> + emit({indent(3),"fun(Type, Val, _) ->",nl, + indent(6),"case Type of",nl}), + emit({indent(9),{asis,Name}," ->",nl}), + emit([indent(12),"'enc_",T,"'(Val)"]), +% {Ret,N} = emit_inner_of_fun(Erule,TDef,InternalDefFunName), + gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]); + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + emit({indent(3),"fun(Type, Val, _) ->",nl, + indent(6),"case Type of",nl}), + emit({indent(9),{asis,Name}," ->",nl}), + emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]), + gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]); + false -> + emit([indent(3),"fun(Type, Val, _) ->",nl, + indent(6),"case Type of",nl, + indent(9),{asis,Name}," ->",nl, + indent(12),"Size = case Val of",nl, + indent(15),"B when is_binary(B) -> size(B);",nl, + indent(15),"_ -> length(Val)",nl, + indent(12),"end,",nl, + indent(12),"if",nl, + indent(15),"Size < 256 -> [20,Size,Val];",nl, + indent(15),"true -> [21,<<Size:16>>,Val]",nl, + indent(12),"end"]), + gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,[]) + end; +gen_inlined_enc_funs(Erule,Fields,[_|Rest],ObjSetName,NthObj) -> + gen_inlined_enc_funs(Erule,Fields,Rest,ObjSetName,NthObj); +gen_inlined_enc_funs(_Erule,_,[],_,NthObj) -> + {[],NthObj}. + +gen_inlined_enc_funs1(Erule,Fields,[{typefield,Name,_}|Rest],ObjSetName, + NthObj,Acc) -> + CurrentMod = get(currmod), + InternalDefFunName = asn1ct_gen:list2name([NthObj,Name,ObjSetName]), + {Acc2,NAdd}= + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_record(Type,type) -> + emit({";",nl}), + {Ret,N}=emit_inner_of_fun(Erule,Type,InternalDefFunName), + {Ret++Acc,N}; + {value,{_,Type}} when is_record(Type,typedef) -> + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + {Ret,N}=emit_inner_of_fun(Erule,Type,InternalDefFunName), + {Ret++Acc,N}; + {value,{_,#'Externaltypereference'{module=CurrentMod,type=T}}} -> + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + emit([indent(12),"'enc_",T,"'(Val)"]), + {Acc,0}; + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + emit([indent(12),"'",M,"'",":'enc_",T,"'(Val)"]), + {Acc,0}; + false -> + emit([";",nl, + indent(9),{asis,Name}," ->",nl, + indent(12),"Size = case Val of",nl, + indent(15),"B when is_binary(B) -> size(B);",nl, + indent(15),"_ -> length(Val)",nl, + indent(12),"end,",nl, + indent(12),"if",nl, + indent(15),"Size < 256 -> [20,Size,Val];",nl, + indent(15),"true -> [21,<<Size:16>>,Val]",nl, + indent(12),"end"]), + {Acc,0} + end, + gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj+NAdd,Acc2); +gen_inlined_enc_funs1(Erule,Fields,[_|Rest],ObjSetName,NthObj,Acc)-> + gen_inlined_enc_funs1(Erule,Fields,Rest,ObjSetName,NthObj,Acc); +gen_inlined_enc_funs1(_Erule,_,[],_,NthObj,Acc) -> + emit({nl,indent(6),"end",nl}), + emit({indent(3),"end"}), + {Acc,NthObj}. + +emit_inner_of_fun(Erule,TDef=#typedef{name={ExtMod,Name},typespec=Type}, + InternalDefFunName) -> + case {ExtMod,Name} of + {primitive,bif} -> + emit(indent(12)), + gen_encode_prim(Erule,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(_Erule,#typedef{name=Name},_) -> + emit({indent(12),"'enc_",Name,"'(Val)"}), + {[],0}; +emit_inner_of_fun(Erule,Type,_) when is_record(Type,type) -> + CurrMod = get(currmod), + case Type#type.def of + Def when is_atom(Def) -> + emit({indent(9),Def," ->",nl,indent(12)}), + gen_encode_prim(Erule,Type,dotag,"Val"); + TRef when is_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}), + CurrMod = get(currmod), + NewNthObj= + case ObjName of + {no_mod,no_name} -> + gen_inlined_dec_funs(Fields,ClFields,ObjSName,NthObj); + {CurrMod,Name} -> + emit([" fun 'dec_",Name,"'/4"]), + NthObj; + {ModName,Name} -> + emit_ext_decfun(ModName,Name), +% emit([" {'",ModName,"', 'dec_",Name,"'}"]), + 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}), + CurrMod=get(currmod), + case ObjName of + {no_mod,no_name} -> + gen_inlined_dec_funs(Fields,ClFields,ObjSetName,NthObj); + {CurrMod,Name} -> + emit([" fun 'dec_",Name,"'/4"]); + {ModName,Name} -> + emit_ext_decfun(ModName,Name); +% emit([" {'",ModName,"', 'dec_",Name,"'}"]); + _ -> + emit({" fun 'dec_",ObjName,"'/4"}) + end, + emit([";",nl]), + emit_default_getdec(ObjSetName,UniqueName), + 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. + +emit_ext_decfun(ModuleName,Name) -> + emit([indent(3),"fun(T,V,O1,O2) -> '",ModuleName,"':'dec_", + Name,"'(T,V,O1,O2) end"]). + +emit_default_getdec(ObjSetName,UniqueName) -> + emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), + emit([indent(2), "fun(C,V,_,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]). + + +gen_inlined_dec_funs(Fields,[{typefield,Name,_}|Rest], + ObjSetName,NthObj) -> + CurrMod = get(currmod), + InternalDefFunName = [NthObj,Name,ObjSetName], + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_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 is_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); + {value,{_,#'Externaltypereference'{module=CurrMod,type=T}}} -> + emit({indent(3),"fun(Type, Val, _, _) ->",nl, + indent(6),"case Type of",nl}), + emit({indent(9),{asis,Name}," ->",nl}), + emit([indent(12),"'dec_",T,"'(Val, telltype)"]), + gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj); + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + emit({indent(3),"fun(Type, Val, _, _) ->",nl, + indent(6),"case Type of",nl}), + emit({indent(9),{asis,Name}," ->",nl}), + emit([indent(12),"'",M,"':'dec_",T,"'(Val, telltype)"]), + gen_inlined_dec_funs1(Fields,Rest,ObjSetName,NthObj); + false -> + emit([indent(3),"fun(Type, Val, _, _) ->",nl, + indent(6),"case Type of",nl, + indent(9),{asis,Name}," -> {Val,Type}"]), + gen_inlined_dec_funs1(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) -> + CurrentMod = get(currmod), + InternalDefFunName = [NthObj,Name,ObjSetName], + N= + case lists:keysearch(Name,1,Fields) of + {value,{_,Type}} when is_record(Type,type) -> + emit({";",nl}), + emit_inner_of_decfun(Type,InternalDefFunName); + {value,{_,Type}} when is_record(Type,typedef) -> + emit({";",nl,indent(9),{asis,Name}," ->",nl}), + emit_inner_of_decfun(Type,InternalDefFunName); + {value,{_,#'Externaltypereference'{module=CurrentMod,type=T}}} -> + emit([";",nl,indent(9),{asis,Name}," ->",nl]), + emit([indent(12),"'dec_",T,"'(Val,telltype)"]), + 0; + {value,{_,#'Externaltypereference'{module=M,type=T}}} -> + emit([";",nl,indent(9),{asis,Name}," ->",nl]), + emit([indent(12),"'",M,"':'dec_",T,"'(Val,telltype)"]), + 0; + false -> + emit([";",nl, + indent(9),{asis,Name}," -> {Val,Type}"]), + 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 is_record(Type,type) -> + CurrMod = get(currmod), + case Type#type.def of + Def when is_atom(Def) -> + emit({indent(9),Def," ->",nl,indent(12)}), + gen_dec_prim(erules,Type,"Val"); + TRef when is_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 is_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 is_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 is_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 is_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},")"}); + + 'REAL' -> + emit(["?RT_PER:decode_real(",BytesVar,")"]); + + {'BIT STRING',NamedNumberList} -> + case get(compact_bit_string) of + true -> + emit({"?RT_PER:decode_compact_bit_string(", + BytesVar,",",{asis,Constraint},",", + {asis,NamedNumberList},")"}); + _ -> + emit({"?RT_PER:decode_bit_string(",BytesVar,",", + {asis,Constraint},",", + {asis,NamedNumberList},")"}) + end; + 'NULL' -> + emit({"?RT_PER:decode_null(", + BytesVar,")"}); + 'OBJECT IDENTIFIER' -> + emit({"?RT_PER:decode_object_identifier(", + BytesVar,")"}); + 'RELATIVE-OID' -> + emit({"?RT_PER:decode_relative_oid(", + 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} -> + NewNNL = [X||{X,_} <- NamedNumberList], + NewC = effective_constraint(integer, + [{'ValueRange',{0,length(NewNNL)-1}}]), + emit_dec_enumerated(BytesVar,NewC,NewNNL); + 'BOOLEAN'-> + emit({"?RT_PER:decode_boolean(",BytesVar,")"}); + + 'OCTET STRING' -> + emit_dec_octet_string(Constraint,BytesVar); + + 'NumericString' -> + emit_dec_known_multiplier_string('NumericString', + Constraint,BytesVar); + TString when TString == 'TeletexString'; + TString == 'T61String' -> + 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); + 'GeneralizedTime' -> + emit_dec_known_multiplier_string('VisibleString', + Constraint,BytesVar); + 'GraphicString' -> + emit({"?RT_PER:decode_GraphicString(",BytesVar,",", + {asis,Constraint},")"}); + + 'VisibleString' -> + emit_dec_known_multiplier_string('VisibleString', + Constraint,BytesVar); + 'GeneralString' -> + emit({"?RT_PER:decode_GeneralString(",BytesVar,",", + {asis,Constraint},")"}); + + 'PrintableString' -> + emit_dec_known_multiplier_string('PrintableString', + Constraint,BytesVar); + 'IA5String' -> + emit_dec_known_multiplier_string('IA5String',Constraint,BytesVar); + + 'BMPString' -> + emit_dec_known_multiplier_string('BMPString',Constraint,BytesVar); + + 'UniversalString' -> + emit_dec_known_multiplier_string('UniversalString', + Constraint,BytesVar); + + 'UTF8String' -> + emit({"?RT_PER:decode_UTF8String(",BytesVar,")"}); + '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; + #'ObjectClassFieldType'{} -> + case asn1ct_gen:get_inner(Att#type.def) of + {fixedtypevaluefield,_,InnerType} -> + gen_dec_prim(Erules,InnerType,BytesVar); + T -> + gen_dec_prim(Erules,Att#type{def=T},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 is_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 is_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,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([Name|Rest],Tmpremain,No) -> + io_lib:format("~w->{~w,~s};",[No,Name,Tmpremain])++ + dec_enumerated_cases(Rest,Tmpremain,No+1); +dec_enumerated_cases([],_,_) -> + "". diff --git a/lib/asn1/src/asn1ct_name.erl b/lib/asn1/src/asn1ct_name.erl new file mode 100644 index 0000000000..a6aa4255cc --- /dev/null +++ b/lib/asn1/src/asn1ct_name.erl @@ -0,0 +1,233 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_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} -> + unregister(asn1_ns), + 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 -> + case catch register(Name, spawn(Mod,Fun, Args)) of + {'EXIT',{badarg,_}} -> + start_server(Name,Mod,Fun,Args); + _ -> + ok + end; + _Pid -> + already_started + end. diff --git a/lib/asn1/src/asn1ct_parser.yrl b/lib/asn1/src/asn1ct_parser.yrl new file mode 100644 index 0000000000..083162f191 --- /dev/null +++ b/lib/asn1/src/asn1ct_parser.yrl @@ -0,0 +1,1177 @@ +%%<copyright> +%% <year>1997-2008</year> +%% <holder>Ericsson AB, All Rights Reserved</holder> +%%</copyright> +%%<legalnotice> +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% The Initial Developer of the Original Code is Ericsson AB. +%%</legalnotice>
+%%
+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: /main/release/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/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl new file mode 100644 index 0000000000..9d2df72f5b --- /dev/null +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -0,0 +1,3063 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_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},{'{',_L2},{'}',_L3}|Rest]) -> + {identifier2Extvalueref(Vref),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 is_record(Sl,'SymbolsFromModule') -> + parse_SymbolsFromModuleList(Rest,[SymbolsFromModule|Acc]); + _ -> + {lists:reverse([SymbolsFromModule|Acc]),Rest} + end. + +parse_SymbolsFromModule(Tokens) -> + SetRefModuleName = + fun(N) -> + fun(X) when is_record(X,'Externaltypereference')-> + X#'Externaltypereference'{module=N}; + (X) when is_record(X,'Externalvaluereference')-> + X#'Externalvaluereference'{module=N} + end + end, + {SymbolList,Rest} = parse_SymbolList(Tokens), + case Rest of + [{'FROM',_L1},Tref = {typereference,_,Name},Ref={identifier,_L2,_Id},C={',',_}|Rest2] -> + NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList), + {#'SymbolsFromModule'{symbols=NewSymbolList, + module=tref2Exttref(Tref)},[Ref,C|Rest2]}; + + %% This a special case when there is only one Symbol imported + %% from the next module. No other way to distinguish Ref from + %% a part of the GlobalModuleReference of Name. + [{'FROM',_L1},Tref = {typereference,_,Name},Ref = {identifier,_L2,_Id},From = {'FROM',_}|Rest2] -> + NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList), + {#'SymbolsFromModule'{symbols=NewSymbolList, + module=tref2Exttref(Tref)},[Ref,From|Rest2]}; + [{'FROM',_L1},Tref = {typereference,_,Name},{identifier,_L2,_Id}|Rest2] -> + NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList), + {#'SymbolsFromModule'{symbols=NewSymbolList, + 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 is_list(L) -> + %% 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)) + 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 is_list(L) -> + Result; + Error -> + parse_or(Tokens,Frest,[Error|ErrList]) + end. + +parse_or_tag(Tokens,Flist) -> + parse_or_tag(Tokens,Flist,[]). + +parse_or_tag(_Tokens,[],ErrList) -> + case ErrList of + [] -> + throw({asn1_error,{parse_or_tag,ErrList}}); + L when is_list(L) -> + %% 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)) + end; +parse_or_tag(Tokens,[{Tag,Fun}|Frest],ErrList) when is_function(Fun) -> + case (catch Fun(Tokens)) of + Exit = {'EXIT',_Reason} -> + parse_or_tag(Tokens,Frest,[Exit|ErrList]); + AsnErr = {asn1_error,_} -> + parse_or_tag(Tokens,Frest,[AsnErr|ErrList]); + AsnAssErr = {asn1_assignment_error,_} -> + parse_or_tag(Tokens,Frest,[AsnAssErr|ErrList]); + {ParseRes,Rest} when is_list(Rest) -> + {{Tag,ParseRes},Rest}; + Error -> + parse_or_tag(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) -> Ret +%% +%% Tokens = [Tok] +%% Tok = tuple() +%% Ret = #type{} +%% +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 is_record(Tag,tag)-> + {[Tag#tag{type='IMPLICIT'}],Rest31}; + [{'EXPLICIT',_}|Rest31] when is_record(Tag,tag)-> + {[Tag#tag{type='EXPLICIT'}],Rest31}; + Rest31 when is_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 is_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 is_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([{'RELATIVE-OID',_}|Rest]) -> + {#type{def='RELATIVE-OID'},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}; + _ -> + {ComponentTypeLists,Rest3}=parse_ComponentTypeLists2(Rest2,[#'EXTENSIONMARK'{pos=Line}]), + case Rest3 of + [{'}',_}|Rest4] -> + {#type{def=#'SEQUENCE'{components=ComponentTypeLists}},Rest4}; + _ -> + throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module), + [got,get_token(hd(Rest3)),expected,'}']}}) + end +% _ -> % Seq case 4,17-19,23-26 will fail here +% 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]), + #constraint{c=C} = Constraint, + Constraint2 = Constraint#constraint{c={'SizeConstraint',C}}, + 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]), + #constraint{c=C} = Constraint, + Constraint2 = Constraint#constraint{c={'SizeConstraint',C}}, + 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(Tokens=[{typereference,_L1,_Module},{'.',_}, + {typereference,_,_TypeName},{'{',_}|_Rest]) -> + parse_ParameterizedType(Tokens); +parse_DefinedType([{typereference,L1,Module},{'.',_},{typereference,_,TypeName}|Rest]) -> + {#type{def = #'Externaltypereference'{pos=L1,module=Module,type=TypeName}},Rest}; +parse_DefinedType([{typereference,L1,TypeName}|Rest]) -> + case is_pre_defined_class(TypeName) of + false -> + {#type{def = #'Externaltypereference'{pos=L1,module=get(asn1_module), + type=TypeName}},Rest}; + _ -> + throw({asn1_error, + {L1,get(asn1_module), + [got,TypeName,expected, + [typereference,'typereference.typereference', + 'typereference typereference']]}}) + end; +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) -> {Ret,Rest} +%% Tokens = [Tok] +%% Tok = tuple() +%% Ret = {'SingleValue',list()} | list() | +%% +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 is_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 is_list(V2) -> + {[V1] ++ [union|V2],Rest3}; + {V1,V2} -> + {[V1,union,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 is_list(V2) -> + {[V1] ++ [union|V2],Rest3}; + {V1,V2} -> + {[V1,union,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 is_list(V2) -> + {[V1] ++ [intersection|V2],Rest2}; + {V1,V2} -> + {[V1,intersection,V2],Rest2} + end. + +%% parse_IElemsRec(Tokens) -> Result +%% Result ::= {'SingleValue',ordered_set()} | list() +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 is_list(V2) -> + {[V1] ++ [intersection|V2],Rest3}; + {V1,V2} -> + {[V1,intersection,V2],Rest3} + 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 is_list(V2) -> + {[V1] ++ [intersection|V2],Rest3}; + {V1,V2} -> + {[V1,intersection,V2],Rest3} + end; +parse_IElemsRec(Tokens) -> + {[],Tokens}. + +%% parse_IntersectionElements(Tokens) -> {Result,Rest} +%% Result ::= InterSec | {InterSec,{'EXCEPT',Exclusion}} +%% InterSec ::= {'ALL',{'EXCEPT',Exclusions}} | Unions +%% Unions ::= {'SingleValue',list()} | list() (see parse_Unions) +%% Exclusions ::= InterSec +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(Tokens) -> {Result,Rest} +%% Result ::= {'ALL',{'EXCEPT',Exclusions}} | Unions +%% Exclusions ::= {'ALL',{'EXCEPT',Exclusions}} | Unions +%% Unions ::= {'SingleValue',list()} | list() (see parse_Unions) +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_ObjectSetElements/1, + fun parse_SubtypeElements/1, +% fun parse_Value/1, +% fun parse_Type/1, + fun parse_Object/1, + fun parse_DefinedObjectSet/1], + case (catch parse_or(Tokens,Flist)) of + {'EXIT',Reason} -> + exit(Reason); + Err = {asn1_error,_} -> + throw(Err); + Result = {Val,_} when is_record(Val,type) -> + Result; + + 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,Rest5} of + {'UNIQUE',[{Del,_}|_]} when Del =:= ','; Del =:= '}' -> + 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; + {_,[{Del,_}|_]} when Del =:= ','; Del =:= '}' -> + {{object_or_fixedtypevalue_field,VFieldName,Type,Unique,OptionalitySpec},Rest5}; + _ -> + throw({asn1_error,{L1,get(asn1_module), + [got,get_token(hd(Rest5)),expected,[',','}']]}}) + end; +parse_FixedTypeValueFieldSpec(Tokens) -> + throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), + [got,get_token(hd(Tokens)),expected,valuefieldreference]}}). + +parse_VariableTypeValueFieldSpec([{valuefieldreference,L,VFieldName}|Rest]) -> + {FieldRef,Rest2} = parse_FieldName(Rest), + {OptionalitySpec,Rest3} = parse_ValueOptionalitySpec(Rest2), + case Rest3 of + [{Del,_}|_] when Del =:= ','; Del =:= '}' -> + {{variabletypevaluefield,VFieldName,FieldRef,OptionalitySpec},Rest3}; + _ -> + throw({asn1_error,{L,get(asn1_module), + [got,get_token(hd(Rest3)),expected,[',','}']]}}) + end; +parse_VariableTypeValueFieldSpec(Tokens) -> + throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), + [got,get_token(hd(Tokens)),expected,valuefieldreference]}}). + +parse_ObjectFieldSpec([{valuefieldreference,L,VFieldName}|Rest]) -> + {Class,Rest2} = parse_DefinedObjectClass(Rest), + {OptionalitySpec,Rest3} = parse_ObjectOptionalitySpec(Rest2), + case Rest3 of + [{Del,_}|_] when Del =:= ','; Del =:= '}' -> + {{objectfield,VFieldName,Class,undefined,OptionalitySpec},Rest3}; + _ -> + throw({asn1_error,{L,get(asn1_module), + [got,get_token(hd(Rest3)),expected,[',','}']]}}) + end; +parse_ObjectFieldSpec(Tokens) -> + throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), + [got,get_token(hd(Tokens)),expected,valuefieldreference]}}). + +parse_TypeFieldSpec([{typefieldreference,L,TFieldName}|Rest]) -> + {OptionalitySpec,Rest2} = parse_TypeOptionalitySpec(Rest), + case Rest2 of + [{Del,_}|_] when Del =:= ','; Del =:= '}' -> + {{typefield,TFieldName,OptionalitySpec},Rest2}; + _ -> + throw({asn1_error,{L,get(asn1_module), + [got,get_token(hd(Rest2)),expected,[',','}']]}}) + end; +parse_TypeFieldSpec(Tokens) -> + throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), + [got,get_token(hd(Tokens)),expected,typefieldreference]}}). + +parse_FixedTypeValueSetFieldSpec([{typefieldreference,L,TFieldName}|Rest]) -> + {Type,Rest2} = parse_Type(Rest), + {OptionalitySpec,Rest3} = parse_ValueSetOptionalitySpec(Rest2), + case Rest3 of + [{Del,_}|_] when Del =:= ','; Del =:= '}' -> + {{objectset_or_fixedtypevalueset_field,TFieldName,Type, + OptionalitySpec},Rest3}; + _ -> + throw({asn1_error,{L,get(asn1_module), + [got,get_token(hd(Rest3)),expected,[',','}']]}}) + end; +parse_FixedTypeValueSetFieldSpec(Tokens) -> + throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), + [got,get_token(hd(Tokens)),expected,typefieldreference]}}). + +parse_VariableTypeValueSetFieldSpec([{typefieldreference,L,TFieldName}|Rest]) -> + {FieldRef,Rest2} = parse_FieldName(Rest), + {OptionalitySpec,Rest3} = parse_ValueSetOptionalitySpec(Rest2), + case Rest3 of + [{Del,_}|_] when Del =:= ','; Del =:= '}' -> + {{variabletypevaluesetfield,TFieldName,FieldRef,OptionalitySpec},Rest3}; + _ -> + throw({asn1_error,{L,get(asn1_module), + [got,get_token(hd(Rest3)),expected,[',','}']]}}) + end; +parse_VariableTypeValueSetFieldSpec(Tokens) -> + throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), + [got,get_token(hd(Tokens)),expected,typefieldreference]}}). + +parse_ObjectSetFieldSpec([{typefieldreference,L,TFieldName}|Rest]) -> + {Class,Rest2} = parse_DefinedObjectClass(Rest), + {OptionalitySpec,Rest3} = parse_ObjectSetOptionalitySpec(Rest2), + case Rest3 of + [{Del,_}|_] when Del =:= ','; Del =:= '}' -> + {{objectsetfield,TFieldName,Class,OptionalitySpec},Rest3}; + _ -> + throw({asn1_error,{L,get(asn1_module), + [got,get_token(hd(Rest3)),expected,[',','}']]}}) + end; +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) -> Ret +%% Tokens = [Tok] +%% Tok = tuple() +%% Ret = {object,_} | {object, _, _} +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. + + +%% DefinedSyntaxToken ::= Literal | Setting +%% Literal ::= word | ',' +%% Setting ::= Type | Value | ValueSet | Object | ObjectSet +%% word equals typereference, but no lower cases +parse_DefinedSyntaxToken([{',',L1}|Rest]) -> + {{',',L1},Rest}; +%% ObjectClassFieldType or a defined type with a constraint. +%% Should also be able to parse a parameterized type. It may be +%% impossible to distinguish between a parameterized type and a Literal +%% followed by an object set. +parse_DefinedSyntaxToken(Tokens=[{typereference,L1,_Name},{T,_}|_Rest]) + when T == '.'; T == '(' -> + case catch parse_Setting(Tokens) of + {asn1_error,_} -> + throw({asn1_error,{L1,get(asn1_module), + [got,hd(Tokens), expected,['Word',setting]]}}); + {'EXIT',Reason} -> + exit(Reason); + Result -> + Result + end; +parse_DefinedSyntaxToken(Tokens=[TRef={typereference,L1,Name}|Rest]) -> + case is_word(Name) of + false -> + case lookahead_definedsyntax(Rest) of + word_or_setting -> + {{setting,L1,tref2Exttref(TRef)},Rest}; + _ -> + parse_Setting(Tokens) + end; + true -> + %% {{word_or_setting,L1,Name},Rest} + {{word_or_setting,L1,tref2Exttref(TRef)},Rest} + end; +parse_DefinedSyntaxToken(Tokens) -> + case catch parse_Setting(Tokens) of + {asn1_error,_} -> + parse_Word(Tokens); + {'EXIT',Reason} -> + exit(Reason); + Result -> + Result + end. + +lookahead_definedsyntax([{typereference,_,Name}|_Rest]) -> + case is_word(Name) of + true -> word_or_setting; + _ -> setting + end; +lookahead_definedsyntax([{'}',_}|_Rest]) -> + word_or_setting; +lookahead_definedsyntax(_) -> + setting. + +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,tref2Exttref(Pos,Name)},Rest} + end. + +parse_Setting(Tokens) -> + Flist = [{type_tag,fun parse_Type/1}, + {value_tag,fun parse_Value/1}, + {object_tag,fun parse_Object/1}, + {objectset_tag,fun parse_ObjectSet/1}], + case (catch parse_or_tag(Tokens,Flist)) of + {'EXIT',Reason} -> + exit(Reason); + AsnErr = {asn1_error,_} -> + throw(AsnErr); + Result = {{value_tag,_},_} -> + Result; + {{Tag,Setting},Rest} when is_atom(Tag) -> + {Setting,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(Tokens) -> {Ret,Rest} +%% Tokens = [Tok] +%% Tok = tuple() +%% Ret = {[],tuple()} | +%% {list(),list()} | +%% list() | +%% ['EXTENSIONMARK'] | +%% {'ALL',{'EXCEPT',Exclusions}} | +%% {'SingleValue',SV} +%% SV = list() | #'Externalvaluereference'{} | {definedvalue,term()} +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]) -> + case Rest of + [{',',_}|Rest2] -> + {Elements,Rest3}=parse_ElementSetSpecs(Rest2), + {{[],Elements},Rest3}; + _ -> + {['EXTENSIONMARK'],Rest} + end; +parse_ObjectSetSpec(Tokens) -> + parse_ElementSetSpecs(Tokens). + +% moved fun parse_Object/1 and fun parse_DefinedObjectSet/1 to parse_Elements +%% parse_ObjectSetElements(Tokens) -> {Result,Rest} +%% Result ::= {'ObjectSetFromObjects',Objects,Name} | {pos,ObjectSet,Params} +%% Objects ::= ReferencedObjects +%% ReferencedObjects ::= (see parse_ReferencedObjects/1) +%% Name ::= [FieldName] +%% FieldName ::= {typefieldreference,atom()} | {valuefieldreference,atom()} +%% ObjectSet ::= {objectset,integer(),#'Externaltypereference'{}} +%% Params ::= list() (see parse_ActualParameterList/1) +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) -> {Result,Rest} +%% Result ::= DefObject | DefObjSet | +%% {po,DefObject,Params} | {pos,DefObjSet,Params} | +%% +%% DefObject ::= {object,#'Externaltypereference'{}} | +%% {object,#'Externalvaluereference'{}} +%% DefObjSet ::= {objectset,integer(),#'Externaltypereference'{}} +%% Params ::= list() +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,'.']}}) + end. + +%% parse_ObjectSetFromObjects(Tokens) -> {Result,Rest} +%% Result ::= {'ObjectSetFromObjects',Objects,Name} +%% Objects ::= ReferencedObject (see parse_ReferencedObjects/1) +%% Name ::= [FieldName] +%% FieldName ::= {typefieldreference,atom()} | +%% {valuefieldreference,atom()} +parse_ObjectSetFromObjects(Tokens) -> + {Objects,Rest} = parse_ReferencedObjects(Tokens), + case Rest of + [{'.',_}|Rest2] -> + {Name,Rest3} = parse_FieldName(Rest2), + case lists:last(Name) of + {typefieldreference,_FieldName} -> + {{'ObjectSetFromObjects',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,'.']}}) + 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, + fun parse_ContentsConstraint/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.']]}}). + +parse_ContentsConstraint([{'CONTAINING',_}|Rest]) -> + {Type,Rest2} = parse_Type(Rest), + case Rest2 of + [{'ENCODED',_},{'BY',_}|Rest3] -> + {Value,Rest4} = parse_Value(Rest3), + {{contentsconstraint,Type,Value},Rest4}; + _ -> + {{contentsconstraint,Type,[]},Rest2} + end; +parse_ContentsConstraint([{'ENCODED',_},{'BY',_}|Rest]) -> + {Value,Rest2} = parse_Value(Rest), + {{contentsconstraint,[],Value},Rest2}; +parse_ContentsConstraint(Tokens) -> + throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), + [got,get_token(hd(Tokens)),expected, + 'CONTAINING','or','ENCODED BY']}}). + + +% 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(Tokens) -> Result +%% Result = {#ptypedef{},Rest} | throw() +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(Tokens) -> Result +%% Result = {#pvaluedef{},Rest} | throw() +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(Tokens) -> Result +%% Result = {#pvaluesetdef{},Rest} | throw() +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(Tokens) -> Result +%% Result = {#ptypedef{},Rest} | throw() +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(Tokens) -> Result +%% Result = {#pobjectdef{},Rest} | throw() +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(Tokens) -> Result +%% Result = {#pobjectsetdef{},Rest} | throw{} +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(Tokens) -> Result +%% Result = [Parameter] +%% Parameter = {Governor,Reference} | Reference +%% Governor = Type | DefinedObjectClass +%% Type = #type{} +%% DefinedObjectClass = #'Externaltypereference'{} | +%% 'ABSTRACT-SYNTAX' | 'TYPE-IDENTIFIER' +%% Reference = #'Externaltypereference'{} | #'Externalvaluereference'{} +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([Id={identifier,_,_Value}|Rest]) -> + {{simpledefinedvalue,identifier2Extvalueref(Id)},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 + is_atom(Token) -> + Item = atom_to_list(Token), + is_word(Item); + is_list(Token), length(Token) == 1 -> + check_one_char_word(Token); + is_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 is_list(V) -> + ordsets:from_list(V); +to_set(V) -> + ordsets:from_list([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); % 5 - 13 + _ -> + {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) -> %% first Extensionmark + 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}; + [{',',_},{'...',_}|_] ->%% here comes the dubble ellipse + {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); + [{'...',L1}|_Rest] -> + {#'EXTENSIONMARK'{pos=L1},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]); + [{'...',_}|Rest01] -> + {lists:reverse([Element|Acc]),Rest01}; + _ -> + {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([_VsnNr = {number,_,_},{':',_}|Rest],Acc) -> + %% ignor version number for now + parse_ExtensionAdditions(Rest,Acc); +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) -> Ret +%% Tokens = [Tok] +%% Tok = tuple() +%% Ret = term() +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(Tokens=[{'NULL',_},{':',_}|_Rest]) -> + parse_ObjectClassFieldValue(Tokens); +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). + +parse_DefinedValue(Tokens=[{identifier,_,_},{'{',_}|_Rest]) -> + parse_ParameterizedValue(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, + module=get(asn1_module)},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 catch lookahead_assignment(Rest4) of + ok -> + {#valuedef{pos=L1,name=IdName,type=Type,value=Value, + module=get(asn1_module)},Rest4}; + Error -> + throw(Error) +%% 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; +parse_SubtypeElements([{'PATTERN',_}|Tokens]) -> + {Value,Rest} = parse_Value(Tokens), + {{pattern,Value},Rest}; +%% SingleValue +%% ContainedSubtype +%% ValueRange +%% TypeConstraint +%% Moved fun parse_Value/1 and fun parse_Type/1 to parse_Elements +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 is_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,[],[])}; + +%% An arg with a constraint with extension marker will look like +%% [#constraint{c={Root,Ext}}|Rest] + +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 is_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 is_list(V) -> + %%sort and remove duplicates + V2 = {'SingleValue', + ordsets:from_list(lists:flatten(V))}, + {'PermittedAlphabet',V2}; + {'PermittedAlphabet',{'SingleValue',V}} -> + V2 = {'SingleValue',[V]}, + {'PermittedAlphabet',V2}; + {'SizeConstraint',Sc} -> + {'SizeConstraint',fixup_size_constraint(Sc)}; + + List when is_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 is_list(L) -> + ordsets:from_list(L); +fixup_size_constraint({'SingleValue',L}) -> + {L,L}; +fixup_size_constraint({'SizeConstraint',C}) -> + %% this is a second SIZE + fixup_size_constraint(C); +fixup_size_constraint({C1,C2}) -> + %% this is with extension marks + {turn2vr(fixup_size_constraint(C1)), extension_size(fixup_size_constraint(C2))}; +fixup_size_constraint(CList) when is_list(CList) -> + [fixup_constraint(Xc)||Xc <- CList]. + +turn2vr(L) when is_list(L) -> + L2 =[X||X<-ordsets:from_list(L),is_integer(X)], + case L2 of + [H|_] -> + {H,hd(lists:reverse(L2))}; + _ -> + L + end; +turn2vr(VR) -> + VR. +extension_size({I,I}) -> + [I]; +extension_size({I1,I2}) -> + [I1,I2]; +extension_size(C) -> + C. + +get_line({_,Pos,Token}) when is_integer(Pos),is_atom(Token) -> + Pos; +get_line({Token,Pos}) when is_integer(Pos),is_atom(Token) -> + Pos; +get_line(_) -> + undefined. + +get_token({_,Pos,Token}) when is_integer(Pos),is_atom(Token) -> + Token; +get_token({'$end',Pos}) when is_integer(Pos) -> + undefined; +get_token({Token,Pos}) when is_integer(Pos),is_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 is_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 is_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 is_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. + +is_pre_defined_class('TYPE-IDENTIFIER') -> + true; +is_pre_defined_class('ABSTRACT-SYNTAX') -> + true; +is_pre_defined_class(_) -> + false. + diff --git a/lib/asn1/src/asn1ct_pretty_format.erl b/lib/asn1/src/asn1ct_pretty_format.erl new file mode 100644 index 0000000000..a01c1db8c5 --- /dev/null +++ b/lib/asn1/src/asn1ct_pretty_format.erl @@ -0,0 +1,201 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%% 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_list(H) =:= false , is_tuple(H) =:= false -> + 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/asn1/src/asn1ct_tok.erl b/lib/asn1/src/asn1ct_tok.erl new file mode 100644 index 0000000000..27116c46c5 --- /dev/null +++ b/lib/asn1/src/asn1ct_tok.erl @@ -0,0 +1,391 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_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 is_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); + {multiline_comment,NestingLevel} -> + {RestL,Lno2} = process_skip_multiline_comment(Stream,Lno,NestingLevel), + process(RestL,Stream,Lno2,R); + T -> + %%io:format('toks:~w~n',[T]), + process(Stream,Lno,[T|R]) + end. + +process_skip_multiline_comment(Stream,Lno,NestingLevel) -> + process_skip_multiline_comment(io:get_line(Stream, ''), + Stream, Lno + 1, NestingLevel). +process_skip_multiline_comment(eof,_Stream,Lno,_NestingLevel) -> + io:format("Tokeniser error on line: ~w, premature end of multiline comment~n",[Lno]), + exit(0); +process_skip_multiline_comment(Line,Stream,Lno,NestingLevel) -> + case catch skip_multiline_comment(Line,NestingLevel) of + {multiline_comment,NestingLevel2} -> + process_skip_multiline_comment(Stream,Lno,NestingLevel2); + T -> + {T,Lno} + 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) -> + tokenise(skip_multiline_comment(T,0),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). + + +skip_multiline_comment([],L) -> + throw({multiline_comment,L}); +skip_multiline_comment([$*,$/|T],0) -> + T; +skip_multiline_comment([$*,$/|T],Level) -> + skip_multiline_comment(T,Level - 1); +skip_multiline_comment([$/,$*|T],Level) -> + skip_multiline_comment(T,Level + 1); +skip_multiline_comment([_|T],Level) -> + skip_multiline_comment(T,Level). + + +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('CONTAINING') -> true; +reserved_word('DEFAULT') -> true; +reserved_word('DEFINED') -> true; +reserved_word('DEFINITIONS') -> true; +reserved_word('EMBEDDED') -> true; +reserved_word('ENCODED') -> 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('PATTERN') -> 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('RELATIVE-OID') -> 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('UTF8String') -> rstrtype; +reserved_word('VideotexString') -> rstrtype; +reserved_word('VisibleString') -> rstrtype; +reserved_word('WITH') -> true; +reserved_word(_) -> false. diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl new file mode 100644 index 0000000000..d9a7e5374a --- /dev/null +++ b/lib/asn1/src/asn1ct_value.erl @@ -0,0 +1,459 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1ct_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]). +-export([i_random/1]). + + +%% 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 is_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 is_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,get_encoding_rule(M)); + 'ASN1_OPEN_TYPE' -> + case Type#type.constraint of + [#'Externaltypereference'{type=TrefConstraint}] -> + get_type(M,TrefConstraint,no); + _ -> + ERule = get_encoding_rule(M), + open_type_value(ERule) + end; + {constructed,bif} when Typename == ['EXTERNAL'] -> + Val=get_type_constructed(M,Typename,InnerType,Type), + asn1rt_check:transform_to_EXTERNAL1994(Val); + {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 is_atom(A) -> A; +get_inner(Ext) when is_record(Ext,'Externaltypereference') -> Ext; +get_inner({typereference,_Pos,Name}) -> Name; +get_inner(T) when is_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 is_tuple(T) -> element(1,T). + + + +get_type_constructed(M,Typename,InnerType,D) when is_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',to_textual_order(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 is_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,Erule) -> + 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); + _ -> + case C of + [] -> + lists:nth(random(length(NN)),NN); + _ -> + lists:nth((fun(0)->1;(X)->X end(i_random(C))),NN) + end + end; + Enum when is_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; + _ -> + case C of + [] -> + lists:nth(random(length(NN)),NN); + _ -> + lists:nth((fun(0)->1;(X)->X end(i_random(C))),NN) + end + end; + {'BIT STRING',NamedNumberList} -> + NN = [X||{X,_} <- NamedNumberList], + case NN of + [] -> + Bl1 =lists:reverse(adjust_list(size_random(C),[1,0,1,1])), + Bl2 = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end,Bl1)), + case {length(Bl2),get_constraint(C,'SizeConstraint')} of + {Len,Len} -> + Bl2; + {_Len,Int} when is_integer(Int) -> + Bl1; + {Len,{Min,_}} when Min > Len -> + Bl1; + _ -> + Bl2 + end; + _ -> + [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]); + 'RELATIVE-OID' -> + Len = random(5), + Olist = [(random(16#ffff)-1)||_X <-lists:seq(1,Len)], + list_to_tuple(Olist); + 'ObjectDescriptor' -> + "Dummy ObjectDescriptor"; + 'REAL' -> + %% Base is 2 or 10, format is string (base 10) or tuple + %% (base 2 or 10) + %% Tuple: {Mantissa, Base, Exponent} + case random(3) of + 1 -> + %% base 2 + case random(3) of + 3 -> + {129,2,10}; + 2 -> + {1,2,1}; + _ -> + {2#11111111,2,2} + end; +%% Sign1 = random_sign(integer), +%% Sign2 = random_sign(integer), +%% {Sign1*random(10000),2,Sign2*random(1028)}; +%% 2 -> +%% %% base 10 tuple format +%% Sign1 = random_sign(integer), +%% Sign2 = random_sign(integer), +%% {Sign1*random(10000),10,Sign2*random(1028)}; + _ -> + %% base 10 string format, NR3 format + case random(2) of + 2 -> + "123.E10"; + _ -> + "-123.E-10" + end + end; + '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")); + 'T61String' -> + adjust_list(size_random(C),c_string(C,"T61String")); + '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")); + 'UTF8String' -> + {ok,Res}=asn1rt:utf8_list_to_binary(adjust_list(random(50),[$U,$T,$F,$8,$S,$t,$r,$i,$n,$g,16#ffff,16#fffffff,16#ffffff,16#fffff,16#fff])), + case Erule of + per -> + binary_to_list(Res); + _ -> + Res + end; + 'UniversalString' -> + adjust_list(size_random(C),c_string(C,"UniversalString")); + XX -> + exit({asn1_error,nyi,XX}) + end. + +c_string(C,Default) -> + case get_constraint(C,'PermittedAlphabet') of + {'SingleValue',Sv} when is_list(Sv) -> + Sv; + {'SingleValue',V} when is_integer(V) -> + [V]; + no -> + Default + end. + +%% FIXME: +%% random_sign(integer) -> +%% case random(2) of +%% 2 -> +%% -1; +%% _ -> +%% 1 +%% end; +%% random_sign(string) -> +%% case random(2) of +%% 2 -> +%% "-"; +%% _ -> +%% "" +%% 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 is_integer(Lb),is_integer(Ub) -> + if + Ub-Lb =< 4 -> + c_random({Lb,Ub},no); + true -> + c_random({Lb,Lb+4},no) + end; + {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 is_integer(Lb),is_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 is_integer(S) -> + S; + {_,S} when is_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. + +get_encoding_rule(M) -> + Mod = + if is_list(M) -> + list_to_atom(M); + true ->M + end, + case (catch Mod:encoding_rule()) of + A when is_atom(A) -> + A; + _ -> unknown + end. + +open_type_value(ber) -> + [4,9,111,112,101,110,95,116,121,112,101]; +open_type_value(ber_bin) -> + [4,9,111,112,101,110,95,116,121,112,101]; +% <<4,9,111,112,101,110,95,116,121,112,101>>; +open_type_value(ber_bin_v2) -> + [4,9,111,112,101,110,95,116,121,112,101]; +% <<4,9,111,112,101,110,95,116,121,112,101>>; +open_type_value(per) -> + "\n\topen_type"; %octet string value "open_type" +open_type_value(per_bin) -> + "\n\topen_type"; +% <<10,9,111,112,101,110,95,116,121,112,101>>; +open_type_value(_) -> + [4,9,111,112,101,110,95,116,121,112,101]. + +to_textual_order({Root,Ext}) -> + {to_textual_order(Root),Ext}; +to_textual_order(Cs) when is_list(Cs) -> + case Cs of + [#'ComponentType'{textual_order=undefined}|_] -> + Cs; + _ -> + lists:keysort(#'ComponentType'.textual_order,Cs) + end. diff --git a/lib/asn1/src/asn1rt.erl b/lib/asn1/src/asn1rt.erl new file mode 100644 index 0000000000..9ef68efab5 --- /dev/null +++ b/lib/asn1/src/asn1rt.erl @@ -0,0 +1,210 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1rt). + +%% Runtime functions for ASN.1 (i.e encode, decode) + +-include("asn1_records.hrl"). + +-export([encode/2,encode/3,decode/3,load_driver/0,unload_driver/0,info/1]). + +-export([utf8_binary_to_list/1,utf8_list_to_binary/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. + +%% asn1-1.6.8.1 +%% load_driver() -> +%% asn1rt_driver_handler:load_driver(), +%% receive +%% driver_ready -> +%% ok; +%% Err={error,_Reason} -> +%% Err; +%% Error -> +%% {error,Error} +%% end. + +%% asn1-1.6.9 + load_driver() -> + case catch asn1rt_driver_handler:load_driver() of + ok -> + ok; + {error,{already_started,asn1}} -> + ok; + Err -> + {error,Err} + 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. + +%% utf8_binary_to_list/1 transforms a utf8 encoded binary to a list of +%% unicode elements, where each element is the unicode integer value +%% of a utf8 character. +%% Bin is a utf8 encoded value. The return value is either {ok,Val} or +%% {error,Reason}. Val is a list of integers, where each integer is a +%% unicode character value. +utf8_binary_to_list(Bin) when is_binary(Bin) -> + utf8_binary_to_list(Bin,[]). + +utf8_binary_to_list(<<>>,Acc) -> + {ok,lists:reverse(Acc)}; +utf8_binary_to_list(Bin,Acc) -> + Len = utf8_binary_len(Bin), + case catch split_binary(Bin,Len) of + {CharBin,RestBin} -> + case utf8_binary_char(CharBin) of + C when is_integer(C) -> + utf8_binary_to_list(RestBin,[C|Acc]); + Err -> Err + end; + Err -> {error,{asn1,{bad_encoded_utf8string,Err}}} + end. + +utf8_binary_len(<<0:1,_:7,_/binary>>) -> + 1; +utf8_binary_len(<<1:1,1:1,0:1,_:5,_/binary>>) -> + 2; +utf8_binary_len(<<1:1,1:1,1:1,0:1,_:4,_/binary>>) -> + 3; +utf8_binary_len(<<1:1,1:1,1:1,1:1,0:1,_:3,_/binary>>) -> + 4; +utf8_binary_len(<<1:1,1:1,1:1,1:1,1:1,0:1,_:2,_/binary>>) -> + 5; +utf8_binary_len(<<1:1,1:1,1:1,1:1,1:1,1:1,0:1,_:1,_/binary>>) -> + 6; +utf8_binary_len(Bin) -> + {error,{asn1,{bad_utf8_length,Bin}}}. + +utf8_binary_char(<<0:1,Int:7>>) -> + Int; +utf8_binary_char(<<_:2,0:1,Int1:5,1:1,0:1,Int2:6>>) -> + (Int1 bsl 6) bor Int2; +utf8_binary_char(<<_:3,0:1,Int1:4,1:1,0:1,Int2:6,1:1,0:1,Int3:6>>) -> + <<Res:16>> = <<Int1:4,Int2:6,Int3:6>>, + Res; +utf8_binary_char(<<_:4,0:1,Int1:3,Rest/binary>>) -> + <<1:1,0:1,Int2:6,1:1,0:1,Int3:6,1:1,0:1,Int4:6>> = Rest, + <<Res:24>> = <<0:3,Int1:3,Int2:6,Int3:6,Int4:6>>, + Res; +utf8_binary_char(<<_:5,0:1,Int1:2,Rest/binary>>) -> + <<1:1,0:1,Int2:6,1:1,0:1,Int3:6,1:1,0:1,Int4:6,1:1,0:1,Int5:6>> = Rest, + <<Res:32>> = <<0:6,Int1:2,Int2:6,Int3:6,Int4:6,Int5:6>>, + Res; +utf8_binary_char(<<_:6,0:1,I:1,Rest/binary>>) -> + <<1:1,0:1,Int2:6,1:1,0:1,Int3:6,1:1,0:1,Int4:6,1:1,0:1, + Int5:6,1:1,0:1,Int6:6>> = Rest, + <<Res:32>> = <<0:1,I:1,Int2:6,Int3:6,Int4:6,Int5:6,Int6:6>>, + Res; +utf8_binary_char(Err) -> + {error,{asn1,{bad_utf8_character_encoding,Err}}}. + + +%% macros used for utf8 encoding +-define(bit1to6_into_utf8byte(I),16#80 bor (I band 16#3f)). +-define(bit7to12_into_utf8byte(I),16#80 bor ((I band 16#fc0) bsr 6)). +-define(bit13to18_into_utf8byte(I),16#80 bor ((I band 16#3f000) bsr 12)). +-define(bit19to24_into_utf8byte(I),16#80 bor ((Int band 16#fc0000) bsr 18)). +-define(bit25to30_into_utf8byte(I),16#80 bor ((Int band 16#3f000000) bsr 24)). + +%% utf8_list_to_binary/1 transforms a list of integers to a +%% binary. Each element in the input list has the unicode (integer) +%% value of an utf8 character. +%% The return value is either {ok,Bin} or {error,Reason}. The +%% resulting binary is utf8 encoded. +utf8_list_to_binary(List) -> + utf8_list_to_binary(List,[]). + +utf8_list_to_binary([],Acc) when is_list(Acc) -> + {ok,list_to_binary(lists:reverse(Acc))}; +utf8_list_to_binary([],Acc) -> + {error,{asn1,Acc}}; +utf8_list_to_binary([H|T],Acc) -> + case catch utf8_encode(H,Acc) of + NewAcc when is_list(NewAcc) -> + utf8_list_to_binary(T,NewAcc); + Err -> Err + end. + + +utf8_encode(Int,Acc) when Int < 128 -> + %% range 16#00000000 - 16#0000007f + %% utf8 encoding: 0xxxxxxx + [Int|Acc]; +utf8_encode(Int,Acc) when Int < 16#800 -> + %% range 16#00000080 - 16#000007ff + %% utf8 encoding: 110xxxxx 10xxxxxx + [?bit1to6_into_utf8byte(Int),16#c0 bor (Int bsr 6)|Acc]; +utf8_encode(Int,Acc) when Int < 16#10000 -> + %% range 16#00000800 - 16#0000ffff + %% utf8 encoding: 1110xxxx 10xxxxxx 10xxxxxx + [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), + 16#e0 bor ((Int band 16#f000) bsr 12)|Acc]; +utf8_encode(Int,Acc) when Int < 16#200000 -> + %% range 16#00010000 - 16#001fffff + %% utf8 encoding: 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx + [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), + ?bit13to18_into_utf8byte(Int), + 16#f0 bor ((Int band 16#1c0000) bsr 18)|Acc]; +utf8_encode(Int,Acc) when Int < 16#4000000 -> + %% range 16#00200000 - 16#03ffffff + %% utf8 encoding: 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx + [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), + ?bit13to18_into_utf8byte(Int),?bit19to24_into_utf8byte(Int), + 16#f8 bor ((Int band 16#3000000) bsr 24)|Acc]; +utf8_encode(Int,Acc) -> + %% range 16#04000000 - 16#7fffffff + %% utf8 encoding: 1111110x 10xxxxxx ...(total 6 bytes) 10xxxxxx + [?bit1to6_into_utf8byte(Int),?bit7to12_into_utf8byte(Int), + ?bit13to18_into_utf8byte(Int),?bit19to24_into_utf8byte(Int), + ?bit25to30_into_utf8byte(Int), + 16#fc bor ((Int band 16#40000000) bsr 30)|Acc]. diff --git a/lib/asn1/src/asn1rt_ber_bin.erl b/lib/asn1/src/asn1rt_ber_bin.erl new file mode 100644 index 0000000000..71d78377d4 --- /dev/null +++ b/lib/asn1/src/asn1rt_ber_bin.erl @@ -0,0 +1,2497 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(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, encode_real/3, + decode_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_relative_oid/2,decode_relative_oid/3, + encode_restricted_string/4,decode_restricted_string/6, + encode_universal_string/3,decode_universal_string/5, + encode_UTF8_string/3, decode_UTF8_string/3, + 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,skip_ExtensionAdditions/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_UTF8String, 12). +-define('N_RELATIVE-OID',13). +-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 is_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}. + {RemBytes,size(Bytes)}. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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(L, Bytes, Rb) -> + skipvalue(L, Bytes, Rb, 0). + +skipvalue(indefinite, Bytes, Rb, IndefLevel) -> + {T,Bytes2,R2} = decode_tag(Bytes), + {{L,Bytes3},R3} = decode_length(Bytes2), + case {T,L} of + {_,indefinite} -> + skipvalue(indefinite,Bytes3,Rb+R2+R3,IndefLevel+1); + {{0,0,0},0} when IndefLevel =:= 0 -> + %% See X690 8.1.5 NOTE, end of indefinite content + {Bytes3,Rb+2}; + {{0,0,0},0} -> + skipvalue(indefinite,Bytes3,Rb+2,IndefLevel - 1); + _ -> + <<_:L/binary, RestBytes/binary>> = Bytes3, + skipvalue(indefinite,RestBytes,Rb+R2+R3+L, IndefLevel) + %%{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(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. + +%%% +%% skips byte sequence of Bytes that do not match a tag in Tags +skip_ExtensionAdditions(Bytes,Tags) -> + skip_ExtensionAdditions(Bytes,Tags,0). +skip_ExtensionAdditions(<<>>,_Tags,RmB) -> + {<<>>,RmB}; +skip_ExtensionAdditions(Bytes,Tags,RmB) -> + case catch decode_tag(Bytes) of + {'EXIT',_Reason} -> + tag_error(no_data,Tags,Bytes,'OPTIONAL'); + {_T={Class,_Form,TagNo},_Bytes2,_R2} -> + case [X||X=#tag{class=Cl,number=TN} <- Tags,Cl==Class,TN==TagNo] of + [] -> + %% skip this TLV and continue with next + {Bytes3,R3} = skipvalue(Bytes), + skip_ExtensionAdditions(Bytes3,Tags,RmB+R3); + _ -> + {Bytes,RmB} + end + end. + + + +%%=============================================================================== +%%=============================================================================== +%%=============================================================================== +%% Optionals, preset not filled optionals with asn1_NOVALUE +%%=============================================================================== +%%=============================================================================== +%%=============================================================================== + +% converts a list to a record if necessary +list_to_record(Name,List) when is_list(List) -> + list_to_tuple([Name|List]); +list_to_record(_Name,Tuple) when is_tuple(Tuple) -> + Tuple. + + +fixoptionals(OptList,Val) when is_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 is_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 is_list(Val) -> + {Val,size(list_to_binary(Val))}; +encode_open_type(Val) -> + {Val, size(Val)}. + +%% +encode_open_type(Val, []) when is_list(Val) -> + {Val,size(list_to_binary(Val))}; +encode_open_type(Val,[]) -> + {Val, size(Val)}; +encode_open_type(Val, Tag) when is_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, + {_Tag, Len, RemainingBuffer, RemovedBytes} = decode_tag_and_length(Bytes), + {_RemainingBuffer2, RemovedBytes2} = skipvalue(Len, RemainingBuffer, RemovedBytes), + N = RemovedBytes2, + <<Val:N/binary, RemainingBytes/binary>> = Bytes, +% {Val, RemainingBytes, Len + RemovedBytes}. + {Val,RemainingBytes,N}. + +decode_open_type(<<>>,[]=ExplTag) -> % R9C-0.patch-40 + exit({error, {asn1,{no_optional_tag, ExplTag}}}); +decode_open_type(Bytes,ExplTag) -> + {Tag, Len, RemainingBuffer, RemovedBytes} = decode_tag_and_length(Bytes), + case {Tag,ExplTag} of +% {{Class,Form,32},[#tag{class=Class,number=No,form=32}]} -> +% {_Tag2, Len2, RemainingBuffer2, RemovedBytes2} = decode_tag_and_length(RemainingBuffer), +% {_RemainingBuffer3, RemovedBytes3} = skipvalue(Len2, RemainingBuffer2, RemovedBytes2), +% N = RemovedBytes3, +% <<_:RemovedBytes/unit:8,Val:N/binary,RemainingBytes/binary>> = Bytes, +% {Val, RemainingBytes, N + RemovedBytes}; + {{Class,Form,No},[#tag{class=Class,number=No,form=Form}]} -> + {_RemainingBuffer2, RemovedBytes2} = + skipvalue(Len, RemainingBuffer), + N = RemovedBytes2, + <<_:RemovedBytes/unit:8,Val:N/binary,RemainingBytes/binary>> = Bytes, + {Val, RemainingBytes, N + RemovedBytes}; + _ -> + {_RemainingBuffer2, RemovedBytes2} = + skipvalue(Len, RemainingBuffer, RemovedBytes), + N = RemovedBytes2, + <<Val:N/binary, RemainingBytes/binary>> = Bytes, + {Val, RemainingBytes, N} + 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 is_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 is_integer(Val) -> + {EncVal,Len}=encode_integer(C, Val), + dotag_universal(?N_INTEGER,EncVal,Len); +encode_integer(C, Val, Tag) when is_integer(Val) -> + dotag(Tag, ?N_INTEGER, encode_integer(C, Val)); +encode_integer(C,{Name,Val},Tag) when is_atom(Name) -> + encode_integer(C,Val,Tag); +encode_integer(_, Val, _) -> + exit({error,{asn1, {encode_integer, Val}}}). + + + +encode_integer(C, Val, NamedNumberList, Tag) when is_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 is_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 is_integer(Val)-> + {EncVal,Len} = encode_integer(false,Val), + dotag_universal(?N_ENUMERATED,EncVal,Len); +encode_enumerated(Val, DoTag) when is_integer(Val)-> + dotag(DoTag, ?N_ENUMERATED, encode_integer(false,Val)); +encode_enumerated({Name,Val}, DoTag) when is_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 is_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 is_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 is_integer(Val) -> + dotag(DoTag, ?N_ENUMERATED, encode_integer(C,Val)); + +encode_enumerated(C, {Name,Val}, NamedNumberList, DoTag) when is_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(_C,0, DoTag) -> + dotag(DoTag, ?N_REAL, {[],0}); +encode_real(_C,'PLUS-INFINITY', DoTag) -> + dotag(DoTag, ?N_REAL, {[64],1}); +encode_real(_C,'MINUS-INFINITY', DoTag) -> + dotag(DoTag, ?N_REAL, {[65],1}); +encode_real(C,Val, DoTag) when is_tuple(Val); is_list(Val) -> + dotag(DoTag, ?N_REAL, encode_real(C,Val)). + +%%%%%%%%%%%%%% +%% only base 2 encoding! +%% binary encoding: +%% +------------+ +------------+ +-+-+-+-+---+---+ +%% | (tag)9 | | n + p + 1 | |1|S|BB |FF |EE | +%% +------------+ +------------+ +-+-+-+-+---+---+ +%% +%% +------------+ +------------+ +%% | | | | +%% +------------+ ...+------------+ +%% n octets for exponent +%% +%% +------------+ +------------+ +%% | | | | +%% +------------+ ...+------------+ +%% p octets for pos mantissa +%% +%% S is 0 for positive sign +%% 1 for negative sign +%% BB: encoding base, 00 = 2, (01 = 8, 10 = 16) +%% 01 and 10 not used +%% FF: scale factor 00 = 0 (used in base 2 encoding) +%% EE: encoding of the exponent: +%% 00 - on the following octet +%% 01 - on the 2 following octets +%% 10 - on the 3 following octets +%% 11 - encoding of the length of the two's-complement encoding of +%% exponent on the following octet, and two's-complement +%% encoding of exponent on the other octets. +%% +%% In DER and base 2 encoding the mantissa is encoded as value 0 or +%% bit shifted until it is an odd number. Thus, do this for BER as +%% well. +%% This interface also used by RT_COMMON +encode_real(_C,{Mantissa, Base, Exponent}) when Base =:= 2 -> +%% io:format("Mantissa: ~w Base: ~w, Exp: ~w~n",[Man, Base, Exp]), + {Man,ExpAdd} = truncate_zeros(Mantissa), %% DER adjustment + Exp = Exponent + ExpAdd, + OctExp = if Exp >= 0 -> list_to_binary(encode_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]), + SFactor = 0, + OctExpLen = size(OctExp), + if OctExpLen > 255 -> + exit({error,{asn1, {to_big_exp_in_encode_real, OctExpLen}}}); + true -> true %% make real assert later.. + end, + {LenCode, EOctets} = case OctExpLen of % bit 2,1 + 1 -> {0, OctExp}; + 2 -> {1, OctExp}; + 3 -> {2, OctExp}; + _ -> {3, <<OctExpLen, OctExp/binary>>} + end, + BB = 0, %% 00 for base 2 + FirstOctet = <<1:1,SignBit:1,BB:2,SFactor:2,LenCode:2>>, + OctMantissa = if Man > 0 -> list_to_binary(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(C,{Mantissa,Base,Exponent}) + when Base =:= 10, is_integer(Mantissa), is_integer(Exponent) -> + %% always encode as NR3 due to DER on the format + %% mmmm.Eseeee where + %% m := digit + %% s := '-' | '+' | [] + %% '+' only allowed in +0 + %% e := digit + %% ex: 1234.E-5679 +%% {Man,AddExp} = truncate_zeros(Mantissa,0), +%% ManNum = trunc(Mantissa), +%% {TruncatedMan,NumZeros} = truncate_zeros10(Mantissa), + ManStr = integer_to_list(Mantissa), + + encode_real_as_string(C,ManStr,Exponent); +encode_real(_C,{_,Base,_}) -> + exit({error,{asn1, {encode_real_non_supported_encodeing, Base}}}); +%% base 10 +encode_real(C,Real) when is_list(Real) -> + %% The Real string may come in as a NR1, NR2 or NR3 string. + {Mantissa, Exponent} = + case string:tokens(Real,"Ee") of + [NR2] -> + {NR2,0}; + [NR3MB,NR3E] -> + %% remove beginning zeros + {NR3MB,list_to_integer(NR3E)} + end, + + %% .Decimal | Number | Number.Decimal + ZeroDecimal = + fun("0") -> ""; + (L) -> L + end, + {NewMantissa,LenDecimal} = + case Mantissa of + [$.|Dec] -> + NewMan = remove_trailing_zeros(Dec), + {NewMan,length(ZeroDecimal(NewMan))}; + _ -> + case string:tokens(Mantissa,",.") of + [Num] -> %% No decimal-mark + {integer_to_list(list_to_integer(Num)),0}; + [Num,Dec] -> + NewDec = ZeroDecimal(remove_trailing_zeros(Dec)), + NewMan = integer_to_list(list_to_integer(Num)) ++ NewDec, + {integer_to_list(list_to_integer(NewMan)), + length(NewDec)} + end + end, + +% DER_Exponent = integer_to_list(Exponent - ExpReduce), + encode_real_as_string(C,NewMantissa,Exponent - LenDecimal). + +encode_real_as_string(_C,Mantissa,Exponent) + when is_list(Mantissa), is_integer(Exponent) -> + %% Remove trailing zeros in Mantissa and add this to Exponent + TruncMant = remove_trailing_zeros(Mantissa), + + ExpIncr = length(Mantissa) - length(TruncMant), + + ExpStr = integer_to_list(Exponent + ExpIncr), + + ExpBin = + case ExpStr of + "0" -> + <<"E+0">>; + _ -> + ExpB = list_to_binary(ExpStr), + <<$E,ExpB/binary>> + end, + ManBin = list_to_binary(TruncMant), + NR3 = 3, + {<<NR3,ManBin/binary,$.,ExpBin/binary>>,2 + size(ManBin) + size(ExpBin)}. + +remove_trailing_zeros(IntStr) -> + case lists:dropwhile(fun($0)-> true; + (_) -> false + end, lists:reverse(IntStr)) of + [] -> + "0"; + ReversedIntStr -> + lists:reverse(ReversedIntStr) + end. + +truncate_zeros(Num) -> + truncate_zeros(Num,0). +truncate_zeros(0,Sum) -> + {0,Sum}; +truncate_zeros(M,Sum) -> + case M band 16#f =:= M band 16#e of + true -> truncate_zeros(M bsr 1,Sum+1); + _ -> {M,Sum} + end. + + +%%============================================================================ +%% decode real value +%% +%% decode_real([OctetBufferList], tuple|value, tag|notag) -> +%% {{Mantissa, Base, Exp} | realval | PLUS-INFINITY | MINUS-INFINITY | 0, +%% RestBuff} +%% +%% only for base 2 decoding sofar!! +%%============================================================================ + +decode_real(Buffer, C, Tags, OptOrMand) -> + NewTags = new_tags(Tags,#tag{class=?UNIVERSAL,number=?N_REAL}), + decode_real_notag(Buffer, C, NewTags, OptOrMand). + +%% This interface used by RT_COMMON +decode_real(Buffer,Len) -> + decode_real2(Buffer,[],Len,0). + +decode_real_notag(Buffer, C, Tags, OptOrMand) -> + {_RestTags, {{_,Len}, Buffer0, Rb0}} = + check_tags_i(Tags, Buffer, OptOrMand), + decode_real2(Buffer0, C, Len, Rb0). + +decode_real2(Buffer, _C, 0, _RemBytes) -> + {0,Buffer}; +decode_real2(Buffer0, _C, Len, RemBytes1) -> + <<First, Buffer2/binary>> = Buffer0, + if + First =:= 2#01000000 -> {'PLUS-INFINITY', Buffer2}; + First =:= 2#01000001 -> {'MINUS-INFINITY', Buffer2}; +%% First =:= 2#00000000 -> {0, Buffer2}; + First =:= 1 orelse First =:= 2 orelse First =:= 3 -> + %% charcter string encoding of base 10 + {NRx,Rest} = split_binary(Buffer2,Len-1), + {binary_to_list(NRx),Rest,Len}; + true -> + %% have some check here to verify only supported bases (2) + %% not base 8 or 16 + <<_B7:1,Sign:1,BB:2,_FF:2,EE:2>> = <<First>>, + Base = + case BB of + 0 -> 2; % base 2, only one so far + _ -> exit({error,{asn1, {non_supported_base, BB}}}) + end, + {FirstLen, {Exp, Buffer3,_Rb2}, RemBytes2} = + case EE of + 0 -> {2, decode_integer2(1, Buffer2, RemBytes1), RemBytes1+1}; + 1 -> {3, decode_integer2(2, Buffer2, RemBytes1), RemBytes1+2}; + 2 -> {4, decode_integer2(3, Buffer2, RemBytes1), RemBytes1+3}; + 3 -> + <<ExpLen1,RestBuffer/binary>> = Buffer2, + { ExpLen1 + 2, + decode_integer2(ExpLen1, RestBuffer, RemBytes1), + RemBytes1+ExpLen1} + end, + %% io:format("FirstLen: ~w, Exp: ~w, Buffer3: ~w ~n", + + Length = Len - FirstLen, + <<LongInt:Length/unit:8,RestBuff/binary>> = Buffer3, + {{Mantissa, Buffer4}, RemBytes3} = + if Sign =:= 0 -> + %% io:format("sign plus~n"), + {{LongInt, RestBuff}, 1 + Length}; + true -> + %% io:format("sign minus~n"), + {{-LongInt, RestBuff}, 1 + Length} + end, + {{Mantissa, Base, Exp}, Buffer4, RemBytes2+RemBytes3} + end. + + +%%============================================================================ +%% 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 is_integer(Unused), is_binary(BinBits) -> + encode_bin_bit_string(C,Bin,NamedBitList,DoTag); +encode_bit_string(C, [FirstVal | RestVal], NamedBitList, DoTag) when is_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 is_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 is_integer(IntegerVal) -> + BitListVal = int_to_bitlist(IntegerVal), + encode_bit_string_bits(C, BitListVal, NamedBitList, DoTag); + +encode_bit_string(C, {Name,BitList}, NamedBitList, DoTag) when is_atom(Name) -> + encode_bit_string(C, BitList, NamedBitList, DoTag). + + + +int_to_bitlist(0) -> + []; +int_to_bitlist(Int) when is_integer(Int), Int >= 0 -> + [Int band 1 | int_to_bitlist(Int bsr 1)]. + + +%%================================================================= +%% Encode BIT STRING of the form {Unused,BinBits}. +%% Unused is the number of unused bits in the last byte in BinBits +%% and BinBits is a binary representing the BIT STRING. +%%================================================================= +encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList,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 is_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 is_list(BitListVal) -> + {Len,Unused,OctetList} = + case get_constraint(C,'SizeConstraint') of + no -> + encode_bitstring(BitListVal); + Constr={Min,_Max} when is_integer(Min) -> + 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({{_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; +encode_constr_bit_str_bits({Min,Max},BitListVal,_DoTag) -> + BitLen = length(BitListVal), + if + BitLen > Max -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {maximum,Max}}}}}); + BitLen < Min -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {minimum,Min}}}}}); + true -> + 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 is_binary(OctetList) -> + dotag_universal(?N_OCTET_STRING,OctetList,size(OctetList)); +encode_octet_string(_C, OctetList, DoTag) when is_binary(OctetList) -> + dotag(DoTag, ?N_OCTET_STRING, {OctetList,size(OctetList)}); +encode_octet_string(_C, OctetList, DoTag) when is_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 is_list(OctetList) -> +% dotag(DoTag, ?N_OCTET_STRING, {OctetList,length(OctetList)}); +encode_octet_string(C, {Name,OctetList}, DoTag) when is_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 is_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 is_atom(Cname), is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); +e_object_identifier({Cname, V}) when is_atom(Cname), is_list(V) -> + e_object_identifier(V); +e_object_identifier(V) when is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); + +%%%%%%%%%%%%%%% +%% e_object_identifier([List of Obect Identifiers]) -> +%% {[Encoded Octetlist of ObjIds], IntLength} +%% +e_object_identifier([E1, E2 | Tail]) -> + Head = 40*E1 + E2, % wow! + {H,Lh} = mk_object_val(Head), + {R,Lr} = 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). + + +%%%%%%%%%%% +%% 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). + +%%============================================================================ +%% RELATIVE-OID, ITU_T X.690 Chapter 8.20 +%% +%% encode Relative Object Identifier +%%============================================================================ +encode_relative_oid({Name,Val},TagIn) when is_atom(Name) -> + encode_relative_oid(Val,TagIn); +encode_relative_oid(Val,TagIn) when is_tuple(Val) -> + encode_relative_oid(tuple_to_list(Val),TagIn); +encode_relative_oid(Val,[]) -> + {EncVal,Len} = enc_relative_oid(Val), + dotag_universal(?'N_RELATIVE-OID',EncVal,Len); +encode_relative_oid(Val, DoTag) -> + dotag(DoTag, ?'N_RELATIVE-OID', enc_relative_oid(Val)). + +enc_relative_oid(Val) -> + lists:mapfoldl(fun(X,AccIn) -> + {SO,L}=mk_object_val(X), + {SO,L+AccIn} + end + ,0,Val). + +%%============================================================================ +%% decode Relative Object Identifier value +%% (Buffer, HasTag, TotalLen) -> {{ObjId}, Remain, RemovedBytes} +%%============================================================================ +decode_relative_oid(Buffer, Tags, OptOrMand) -> + NewTags = new_tags(Tags,#tag{class=?UNIVERSAL, + number=?'N_RELATIVE-OID'}), + decode_relative_oid_notag(Buffer, NewTags, OptOrMand). + +decode_relative_oid_notag(Buffer, Tags, OptOrMand) -> + {_RestTags, {_FormLen={_,Len}, Buffer0, Rb0}} = + check_tags_i(Tags, Buffer, OptOrMand), + {ObjVals,Buffer01} = + dec_subidentifiers(Buffer0,0,[],Len), + {list_to_tuple(ObjVals), Buffer01, Rb0+Len}. + +%%============================================================================ +%% Restricted character string types, ITU_T X.690 Chapter 8.21 +%% +%% encode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings +%%============================================================================ +encode_restricted_string(_C, OctetList, StringType, []) + when is_binary(OctetList) -> + dotag_universal(StringType,OctetList,size(OctetList)); +encode_restricted_string(_C, OctetList, StringType, DoTag) + when is_binary(OctetList) -> + dotag(DoTag, StringType, {OctetList, size(OctetList)}); +encode_restricted_string(_C, OctetList, StringType, []) + when is_list(OctetList) -> + dotag_universal(StringType,OctetList,length(OctetList)); +encode_restricted_string(_C, OctetList, StringType, DoTag) + when is_list(OctetList) -> + dotag(DoTag, StringType, {OctetList, length(OctetList)}); +encode_restricted_string(C,{Name,OctetL},StringType,DoTag) when is_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 is_list(Val) -> + {length(Val),Val}; + ?N_BIT_STRING when is_tuple(Val) -> + {(size(element(2,Val))*8) - element(1,Val),Val}; + _ when is_binary(Val) -> + {size(Val),binary_to_list(Val)}; + _ when is_list(Val) -> + {length(Val), Val} + end, + case Range of + _ when StrLen == no_check -> + NewVal; + [] -> % No length constraint + NewVal; + {Lb,Ub} when StrLen >= Lb, Ub >= StrLen -> % variable length constraint + NewVal; + {{Lb,_Ub},[]} when StrLen >= Lb -> + NewVal; + {{Lb,_Ub},_Ext=[MinExt|_]} when StrLen >= Lb; StrLen >= MinExt -> + NewVal; + {{Lb1,Ub1},{Lb2,Ub2}} when StrLen >= Lb1, StrLen =< Ub1; + StrLen =< Ub2, StrLen >= Lb2 -> + NewVal; + StrLen -> % fixed length constraint + NewVal; + {_,_} -> + exit({error,{asn1,{length,Range,Val}}}); + _Len when is_integer(_Len) -> + exit({error,{asn1,{length,Range,Val}}}); + _ -> % some strange constraint that we don't support yet + NewVal + end. + + +%%============================================================================= +%% 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 is_binary(Val),is_binary(AccVal) -> + {<<AccVal/binary,Val/binary>>,AccRb+Rb}; + _ when is_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 is_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 UTF8 string +%%============================================================================ +encode_UTF8_string(_,UTF8String,[]) when is_binary(UTF8String) -> + dotag_universal(?N_UTF8String,UTF8String,size(UTF8String)); +encode_UTF8_string(_,UTF8String,DoTag) when is_binary(UTF8String) -> + dotag(DoTag,?N_UTF8String,{UTF8String,size(UTF8String)}); +encode_UTF8_string(_,UTF8String,[]) -> + dotag_universal(?N_UTF8String,UTF8String,length(UTF8String)); +encode_UTF8_string(_,UTF8String,DoTag) -> + dotag(DoTag,?N_UTF8String,{UTF8String,length(UTF8String)}). + + + +%%============================================================================ +%% decode UTF8 string +%%============================================================================ + +decode_UTF8_string(Buffer, Tags, OptOrMand) -> + NewTags = new_tags(Tags, #tag{class=?UNIVERSAL,number=?N_UTF8String}), + decode_UTF8_string_notag(Buffer, NewTags, OptOrMand). + +decode_UTF8_string_notag(Buffer, Tags, OptOrMand) -> + {RestTags, {FormLen, Buffer0, Rb0}} = + check_tags_i(Tags, Buffer, OptOrMand), + case FormLen of + {?CONSTRUCTED,Len} -> + %% an UTF8String may be encoded as a constructed type + {Buffer00,RestBytes} = split_list(Buffer0,Len), + {Val01, Buffer01, Rb01} = + decode_UTF8_string_notag(Buffer00,RestTags,OptOrMand), + {Buffer02, Rb02} = restbytes2(RestBytes,Buffer01,noext), + {Val01, Buffer02, Rb0+Rb01+Rb02}; + {_,Len} -> + <<Result:Len/binary,RestBuff/binary>> = Buffer0, + {Result,RestBuff,Rb0 + Len} + end. + + +%%============================================================================ +%% encode BMP string +%%============================================================================ + +encode_BMP_string(C, {Name,BMPString}, DoTag) when is_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 is_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 is_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 is_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, MandOrOpt) -> + check_if_valid_tag2_error(Tag,MandOrOpt); + +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. + +-spec(check_if_valid_tag2_error/2 :: (term(),atom()) -> no_return()). + +check_if_valid_tag2_error(Tag,mandatory) -> + exit({error,{asn1,{invalid_tag,Tag}}}); +check_if_valid_tag2_error(Tag,_) -> + exit({error,{asn1,{no_optional_tag,Tag}}}). + +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) -> 'ObjectDescriptor'; +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) -> + case Fun3(Bytes, OptOrMand) of + {_Term, _Remain, 0} -> + {lists:reverse(Acc),Bytes,Rb}; + {Term, Remain, Rb1} -> + Fun3(Bytes, OptOrMand), + decode_set(Rb+Rb1, indefinite, Remain, OptOrMand, Fun3, [Term|Acc]) + end; +%% {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) -> + case Fun3(Bytes, OptOrMand) of + {_Term, _Remain, 0} -> + {lists:reverse(Acc),Bytes,Rb}; + {Term, Remain, Rb1} -> + Fun3(Bytes, OptOrMand), + decode_set(Rb+Rb1, Num-Rb1, Remain, OptOrMand, Fun3, [Term|Acc]) + end. +%% {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 is_list(L1),is_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/asn1/src/asn1rt_ber_bin_v2.erl b/lib/asn1/src/asn1rt_ber_bin_v2.erl new file mode 100644 index 0000000000..a3bb570282 --- /dev/null +++ b/lib/asn1/src/asn1rt_ber_bin_v2.erl @@ -0,0 +1,2037 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(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, + skip_ExtensionAdditions/2]). +-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/3,decode_real/2, + 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_relative_oid/2,decode_relative_oid/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_UTF8_string/3,decode_UTF8_string/2, + 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,decode_selective/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 is_list(TlvVal) -> + %% constructed form of value + encode_tlv(TlvTag,TlvVal,?CONSTRUCTED); +encode({TlvTag,TlvVal}) -> + encode_tlv(TlvTag,TlvVal,?PRIMITIVE); +encode(Bin) when is_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, + encode_tag_val({Class bsl 6,Form,(ClassTagNo - (Class bsl 16))}). + +encode_tlv_val(TlvL) when is_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)}. + +%% asn1-1.6.8.1 +%% decode(B,driver) -> +%% case catch port_control(asn1_driver_port,2,B) of +%% Bin when is_binary(Bin) -> +%% binary_to_term(Bin); +%% List when is_list(List) -> handle_error(List,B); +%% {'EXIT',{badarg,Reason}} -> +%% asn1rt_driver_handler:load_driver(), +%% receive +%% driver_ready -> +%% case catch port_control(asn1_driver_port,2,B) of +%% Bin2 when is_binary(Bin2) -> binary_to_term(Bin2); +%% List when is_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. + +%% asn1-1.6.9 +decode(B,driver) -> + case catch control(?TLV_DECODE,B) of + Bin when is_binary(Bin) -> + binary_to_term(Bin); + List when is_list(List) -> handle_error(List,B); + {'EXIT',{badarg,_Reason}} -> + case asn1rt:load_driver() of + ok -> + case control(?TLV_DECODE,B) of + Bin when is_binary(Bin) -> binary_to_term(Bin); + List when is_list(List) -> handle_error(List,B) + end; + Err -> + Err + end + end. + + +handle_error([],_)-> + exit({error,{asn1,{"memory allocation problem"}}}); +handle_error([$1|_],L) -> % error in driver + exit({error,{asn1,L}}); +handle_error([$2|T],L) -> % error in driver due to wrong tag + exit({error,{asn1,{"bad tag after byte:",error_pos(T),L}}}); +handle_error([$3|T],L) -> % error in driver due to length error + exit({error,{asn1,{"bad length field after byte:", + error_pos(T),L}}}); +handle_error([$4|T],L) -> % error in driver due to indefinite length error + exit({error,{asn1, + {"indefinite length without end bytes after byte:", + error_pos(T),L}}}); +handle_error([$5|T],L) -> % error in driver due to indefinite length error + exit({error,{asn1,{"bad encoded value after byte:", + error_pos(T),L}}}); +handle_error(ErrL,L) -> + exit({error,{asn1,ErrL,L}}). + +error_pos([]) -> + "unknown position"; +error_pos([B])-> + B; +error_pos([B|Bs]) -> + BS = 8 * length(Bs), + B bsl BS + error_pos(Bs). +%% asn1-1.6.9 +control(Cmd, Data) -> + Port = asn1rt_driver_handler:client_port(), + erlang:port_control(Port, Cmd, Data). + +decode(Bin) when is_binary(Bin) -> + decode_primitive(Bin); +decode(Tlv) -> % assume it is a tlv + {Tlv,<<>>}. + + +decode_primitive(Bin) -> + {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), + case Form of + 1 -> % constructed + {{TagNo,decode_constructed(V)},Rest}; + 0 -> % primitive + {{TagNo,V},Rest}; + 2 -> % constructed indefinite + {Vlist,Rest2} = decode_constructed_indefinite(V,[]), + {{TagNo,Vlist},Rest2} + end. + +decode_constructed(Bin) when byte_size(Bin) =:= 0 -> + []; +decode_constructed(Bin) -> + {Tlv,Rest} = decode_primitive(Bin), + [Tlv|decode_constructed(Rest)]. + +decode_constructed_indefinite(<<0,0,Rest/binary>>,Acc) -> + {lists:reverse(Acc),Rest}; +decode_constructed_indefinite(Bin,Acc) -> + {Tlv,Rest} = decode_primitive(Bin), + decode_constructed_indefinite(Rest, [Tlv|Acc]). + +%% decode_primitive_incomplete/2 decodes an encoded message incomplete +%% by help of the pattern attribute (first argument). +decode_primitive_incomplete([[default,TagNo]],Bin) -> %default + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,[],Rest); + _ -> + %{asn1_DEFAULT,Bin} + asn1_NOVALUE + end; +decode_primitive_incomplete([[default,TagNo,Directives]],Bin) -> %default, constructed type, Directives points into this type + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,Directives,Rest); + _ -> + %{asn1_DEFAULT,Bin} + asn1_NOVALUE + end; +decode_primitive_incomplete([[opt,TagNo]],Bin) -> %optional + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,[],Rest); + _ -> + %{{TagNo,asn1_NOVALUE},Bin} + asn1_NOVALUE + end; +decode_primitive_incomplete([[opt,TagNo,Directives]],Bin) -> %optional + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,Directives,Rest); + _ -> + %{{TagNo,asn1_NOVALUE},Bin} + asn1_NOVALUE + end; +%% An optional that shall be undecoded +decode_primitive_incomplete([[opt_undec,Tag]],Bin) -> + case decode_tag_and_length(Bin) of + {_,Tag,_,_} -> + decode_incomplete_bin(Bin); + _ -> + asn1_NOVALUE + end; +%% A choice alternative that shall be undecoded +decode_primitive_incomplete([[alt_undec,TagNo]|RestAlts],Bin) -> +% decode_incomplete_bin(Bin); +% case decode_tlv(Bin) of + case decode_tag_and_length(Bin) of +% {{_Form,TagNo,_Len,_V},_R} -> + {_,TagNo,_,_} -> + decode_incomplete_bin(Bin); + _ -> + decode_primitive_incomplete(RestAlts,Bin) + end; +decode_primitive_incomplete([[alt,TagNo]|RestAlts],Bin) -> + case decode_tag_and_length(Bin) of + {_Form,TagNo,V,Rest} -> + {{TagNo,V},Rest}; + _ -> + decode_primitive_incomplete(RestAlts,Bin) + end; +decode_primitive_incomplete([[alt,TagNo,Directives]|RestAlts],Bin) -> + case decode_tag_and_length(Bin) of + {Form,TagNo,V,Rest} -> + decode_incomplete2(Form,TagNo,V,Directives,Rest); + _ -> + decode_primitive_incomplete(RestAlts,Bin) + end; +decode_primitive_incomplete([[alt_parts,TagNo]],Bin) -> + case decode_tag_and_length(Bin) of + {_Form,TagNo,V,Rest} -> + {{TagNo,V},Rest}; + _ -> + asn1_NOVALUE + end; +decode_primitive_incomplete([[alt_parts,TagNo]|RestAlts],Bin) -> + case decode_tag_and_length(Bin) of + {_Form,TagNo,V,Rest} -> + {{TagNo,decode_parts_incomplete(V)},Rest}; + _ -> + decode_primitive_incomplete(RestAlts,Bin) + end; +decode_primitive_incomplete([[undec,_TagNo]|_RestTag],Bin) -> %incomlete decode + decode_incomplete_bin(Bin); +decode_primitive_incomplete([[parts,TagNo]|_RestTag],Bin) -> + case decode_tag_and_length(Bin) of + {_Form,TagNo,V,Rest} -> + {{TagNo,decode_parts_incomplete(V)},Rest}; + Err -> + {error,{asn1,"tag failure",TagNo,Err}} + end; +decode_primitive_incomplete([mandatory|RestTag],Bin) -> + {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), + decode_incomplete2(Form,TagNo,V,RestTag,Rest); +%% A choice that is a toptype or a mandatory component of a +%% SEQUENCE or SET. +decode_primitive_incomplete([[mandatory|Directives]],Bin) -> + {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), + decode_incomplete2(Form,TagNo,V,Directives,Rest); +decode_primitive_incomplete([],Bin) -> + decode_primitive(Bin). + +%% decode_parts_incomplete/1 receives a number of values encoded in +%% sequence and returns the parts as unencoded binaries +decode_parts_incomplete(<<>>) -> + []; +decode_parts_incomplete(Bin) -> + {ok,Rest} = skip_tag(Bin), + {ok,Rest2} = skip_length_and_value(Rest), + LenPart = 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(_Form=2,TagNo,V,TagMatch,_) -> + %% constructed indefinite length + {Vlist,Rest2} = decode_constr_indef_incomplete(TagMatch,V,[]), + {{TagNo,Vlist},Rest2}; +decode_incomplete2(1,TagNo,V,[TagMatch],Rest) when is_list(TagMatch) -> + {{TagNo,decode_constructed_incomplete(TagMatch,V)},Rest}; +decode_incomplete2(1,TagNo,V,TagMatch,Rest) -> + {{TagNo,decode_constructed_incomplete(TagMatch,V)},Rest}; +decode_incomplete2(0,TagNo,V,_TagMatch,Rest) -> + {{TagNo,V},Rest}. + +decode_constructed_incomplete([Tags=[Ts]],Bin) when is_list(Ts) -> + decode_constructed_incomplete(Tags,Bin); +decode_constructed_incomplete(_TagMatch,<<>>) -> + []; +decode_constructed_incomplete([mandatory|RestTag],Bin) -> + {Tlv,Rest} = decode_primitive(Bin), + [Tlv|decode_constructed_incomplete(RestTag,Rest)]; +decode_constructed_incomplete(Directives=[[Alt,_]|_],Bin) + when Alt == alt_undec; Alt == alt; Alt == alt_parts -> + {_Form,TagNo,V,Rest} = decode_tag_and_length(Bin), + case incomplete_choice_alt(TagNo,Directives) of + {alt_undec,_} -> + LenA = size(Bin)-size(Rest), + <<A:LenA/binary,Rest/binary>> = Bin, + A; + {alt,InnerDirectives} -> + {Tlv,Rest} = decode_primitive_incomplete(InnerDirectives,V), + {TagNo,Tlv}; + {alt_parts,_} -> + [{TagNo,decode_parts_incomplete(V)}]; + no_match -> %% if a choice alternative was encoded that + %% was not specified in the config file, + %% thus decode component anonomous. + {Tlv,_}=decode_primitive(Bin), + Tlv + end; +decode_constructed_incomplete([TagNo|RestTag],Bin) -> +%% {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_constructed_incomplete([],Rest)]. + +decode_constr_indef_incomplete(_TagMatch,<<0,0,Rest/binary>>,Acc) -> + {lists:reverse(Acc),Rest}; +decode_constr_indef_incomplete([Tag|RestTags],Bin,Acc) -> +% {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,Directives}; +incomplete_choice_alt(TagNo,[D]) when is_list(D) -> + incomplete_choice_alt(TagNo,D); +incomplete_choice_alt(TagNo,[_H|Directives]) -> + incomplete_choice_alt(TagNo,Directives); +incomplete_choice_alt(_,[]) -> + no_match. + + + + +%% decode_selective(Pattern, Binary) the first argument is a pattern that tells +%% what to do with the next element the second is the BER encoded +%% message as a binary +%% Returns {ok,Value} or {error,Reason} +%% Value is a binary that in turn must be decoded to get the decoded +%% value. +decode_selective([],Binary) -> + {ok,Binary}; +decode_selective([skip|RestPattern],Binary)-> + {ok,RestBinary}=skip_tag(Binary), + {ok,RestBinary2}=skip_length_and_value(RestBinary), + decode_selective(RestPattern,RestBinary2); +decode_selective([[skip_optional,Tag]|RestPattern],Binary) -> + case skip_optional_tag(Tag,Binary) of + {ok,RestBinary} -> + {ok,RestBinary2}=skip_length_and_value(RestBinary), + decode_selective(RestPattern,RestBinary2); + missing -> + decode_selective(RestPattern,Binary) + end; +decode_selective([[choosen,Tag]],Binary) -> + return_value(Tag,Binary); +% case skip_optional_tag(Tag,Binary) of %may be optional/default +% {ok,RestBinary} -> +% {ok,Value} = get_value(RestBinary); +% missing -> +% {ok,<<>>} +% end; +decode_selective([[choosen,Tag]|RestPattern],Binary) -> + case skip_optional_tag(Tag,Binary) of + {ok,RestBinary} -> + {ok,Value} = get_value(RestBinary), + decode_selective(RestPattern,Value); + missing -> + {ok,<<>>} + end; +decode_selective(P,_) -> + {error,{asn1,{partial_decode,"bad pattern",P}}}. + +return_value(Tag,Binary) -> + {ok,{Tag,RestBinary}}=get_tag(Binary), + {ok,{LenVal,_RestBinary2}} = get_length_and_value(RestBinary), + {ok,<<Tag/binary,LenVal/binary>>}. + + +%% skip_tag and skip_length_and_value are rutines used both by +%% decode_partial_incomplete and decode_selective (decode/2). + +skip_tag(<<_:3,31:5,Rest/binary>>)-> + skip_long_tag(Rest); +skip_tag(<<_:3,_Tag:5,Rest/binary>>) -> + {ok,Rest}. + +skip_long_tag(<<1:1,_:7,Rest/binary>>) -> + skip_long_tag(Rest); +skip_long_tag(<<0:1,_:7,Rest/binary>>) -> + {ok,Rest}. + +skip_optional_tag(<<>>,Binary) -> + {ok,Binary}; +skip_optional_tag(<<Tag,RestTag/binary>>,<<Tag,Rest/binary>>) -> + skip_optional_tag(RestTag,Rest); +skip_optional_tag(_,_) -> + missing. + + + + +skip_length_and_value(Binary) -> + case decode_length(Binary) of + {indefinite,RestBinary} -> + skip_indefinite_value(RestBinary); + {Length,RestBinary} -> + <<_:Length/unit:8,Rest/binary>> = RestBinary, + {ok,Rest} + end. + +skip_indefinite_value(<<0,0,Rest/binary>>) -> + {ok,Rest}; +skip_indefinite_value(Binary) -> + {ok,RestBinary}=skip_tag(Binary), + {ok,RestBinary2} = skip_length_and_value(RestBinary), + skip_indefinite_value(RestBinary2). + +get_value(Binary) -> + case decode_length(Binary) of + {indefinite,RestBinary} -> + get_indefinite_value(RestBinary,[]); + {Length,RestBinary} -> + <<Value:Length/binary,_Rest/binary>> = RestBinary, + {ok,Value} + end. + +get_indefinite_value(<<0,0,_Rest/binary>>,Acc) -> + {ok,list_to_binary(lists:reverse(Acc))}; +get_indefinite_value(Binary,Acc) -> + {ok,{Tag,RestBinary}}=get_tag(Binary), + {ok,{LenVal,RestBinary2}} = get_length_and_value(RestBinary), + get_indefinite_value(RestBinary2,[LenVal,Tag|Acc]). + +get_tag(<<H:1/binary,Rest/binary>>) -> + case H of + <<_:3,31:5>> -> + get_long_tag(Rest,[H]); + _ -> {ok,{H,Rest}} + end. +get_long_tag(<<H:1/binary,Rest/binary>>,Acc) -> + case H of + <<0:1,_:7>> -> + {ok,{list_to_binary(lists:reverse([H|Acc])),Rest}}; + _ -> + get_long_tag(Rest,[H|Acc]) + end. + +get_length_and_value(Bin = <<0:1,Length:7,_T/binary>>) -> + <<Len,Val:Length/binary,Rest/binary>> = Bin, + {ok,{<<Len,Val/binary>>, Rest}}; +get_length_and_value(Bin = <<1:1,0:7,_T/binary>>) -> + get_indefinite_length_and_value(Bin); +get_length_and_value(<<1:1,LL:7,T/binary>>) -> + <<Length:LL/unit:8,Rest/binary>> = T, + <<Value:Length/binary,Rest2/binary>> = Rest, + {ok,{<<1:1,LL:7,Length:LL/unit:8,Value/binary>>,Rest2}}. + +get_indefinite_length_and_value(<<H,T/binary>>) -> + get_indefinite_length_and_value(T,[H]). + +get_indefinite_length_and_value(<<0,0,Rest/binary>>,Acc) -> + {ok,{list_to_binary(lists:reverse(Acc)),Rest}}; +get_indefinite_length_and_value(Binary,Acc) -> + {ok,{Tag,RestBinary}}=get_tag(Binary), + {ok,{LenVal,RestBinary2}}=get_length_and_value(RestBinary), + get_indefinite_length_and_value(RestBinary2,[LenVal,Tag|Acc]). + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% match_tags takes a Tlv (Tag, Length, Value) structure and matches +%% it with the tags in TagList. If the tags does not match the function +%% crashes otherwise it returns the remaining Tlv after that the tags have +%% been removed. +%% +%% match_tags(Tlv, TagList) +%% + +match_tags({T,V},[T]) -> + V; +match_tags({T,V}, [T|Tt]) -> + match_tags(V,Tt); +match_tags([{T,V}],[T|Tt]) -> + match_tags(V, Tt); +match_tags(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. + +%%% +%% skips components that do not match a tag in Tags +skip_ExtensionAdditions([],_Tags) -> + []; +skip_ExtensionAdditions(TLV=[{Tag,_}|Rest],Tags) -> + case [X||X=T<-Tags,T==Tag] of + [] -> + %% skip this TLV and continue with next + skip_ExtensionAdditions(Rest,Tags); + _ -> + TLV + end. + + +%%=============================================================================== +%%=============================================================================== +%%=============================================================================== +%% Optionals, preset not filled optionals with asn1_NOVALUE +%%=============================================================================== +%%=============================================================================== +%%=============================================================================== + +% converts a list to a record if necessary +list_to_record(Name,List) when is_list(List) -> + list_to_tuple([Name|List]); +list_to_record(_Name,Tuple) when is_tuple(Tuple) -> + Tuple. + + +fixoptionals(OptList,Val) when is_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>>. + + +%%=============================================================================== +%% Decode a tag +%% +%% decode_tag(OctetListBuffer) -> {{Form, (Class bsl 16)+ TagNo}, RestOfBuffer, RemovedBytes} +%%=============================================================================== + +decode_tag_and_length(<<Class:2, Form:1, TagNo:5, 0:1, Length:7, V:Length/binary, RestBuffer/binary>>) when TagNo < 31 -> + {Form, (Class bsl 16) + TagNo, V, RestBuffer}; +decode_tag_and_length(<<Class:2, 1:1, TagNo:5, 1:1, 0:7, T/binary>>) when TagNo < 31 -> + {2, (Class bsl 16) + TagNo, T, <<>>}; +decode_tag_and_length(<<Class:2, Form:1, TagNo:5, 1:1, LL:7, Length:LL/unit:8,V:Length/binary, T/binary>>) when TagNo < 31 -> + {Form, (Class bsl 16) + TagNo, V, T}; +decode_tag_and_length(<<Class:2, Form:1, 31:5, 0:1, TagNo:7, 0:1, Length:7, V:Length/binary, RestBuffer/binary>>) -> + {Form, (Class bsl 16) + TagNo, V, RestBuffer}; +decode_tag_and_length(<<Class:2, 1:1, 31:5, 0:1, TagNo:7, 1:1, 0:7, T/binary>>) -> + {2, (Class bsl 16) + TagNo, T, <<>>}; +decode_tag_and_length(<<Class:2, Form:1, 31:5, 0:1, TagNo:7, 1:1, LL:7, Length:LL/unit:8, V:Length/binary, T/binary>>) -> + {Form, (Class bsl 16) + TagNo, V, T}; +decode_tag_and_length(<<Class:2, Form:1, 31:5, 1:1, TagPart1:7, 0:1, TagPartLast, Buffer/binary>>) -> + TagNo = (TagPart1 bsl 7) bor TagPartLast, + {Length, RestBuffer} = decode_length(Buffer), + << V:Length/binary, RestBuffer2/binary>> = RestBuffer, + {Form, (Class bsl 16) + TagNo, V, RestBuffer2}; +decode_tag_and_length(<<Class:2, Form:1, 31:5, Buffer/binary>>) -> + {TagNo, Buffer1} = decode_tag(Buffer, 0), + {Length, RestBuffer} = decode_length(Buffer1), + << V:Length/binary, RestBuffer2/binary>> = RestBuffer, + {Form, (Class bsl 16) + TagNo, V, RestBuffer2}. + + + +%% 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 is_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 is_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 is_binary(Bin) -> + {InnerTlv,_} = decode(Bin), + InnerTlv; + TlvBytes -> TlvBytes + end. + + +decode_open_type_as_binary(Tlv,TagIn)-> + case match_tags(Tlv,TagIn) of + V when is_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 is_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 is_integer(Val) -> + encode_tags(Tag, encode_integer(C, Val)); +encode_integer(C,{Name,Val},Tag) when is_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 is_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 is_integer(SingleValue) -> + exit({error,{asn1,{integer_range,Range,Int}}}); + _ -> % some strange constraint that we don't support yet + Int + end. + +number2name(Int,[]) -> + Int; +number2name(Int,NamedNumberList) -> + case lists: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 is_integer(Val)-> + encode_tags(TagIn, encode_integer(false,Val)); +encode_enumerated({Name,Val}, TagIn) when is_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 is_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 is_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 is_integer(Val) -> + encode_tags(TagIn, encode_integer(C,Val)); + +encode_enumerated(C, {Name,Val}, NamedNumberList, TagIn) when is_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(_C,0, TagIn) -> + encode_tags(TagIn, {[],0}); +encode_real(_C,'PLUS-INFINITY', TagIn) -> + encode_tags(TagIn, {[64],1}); +encode_real(_C,'MINUS-INFINITY', TagIn) -> + encode_tags(TagIn, {[65],1}); +encode_real(C,Val, TagIn) when is_tuple(Val); is_list(Val) -> + encode_tags(TagIn, encode_real(C,Val)). + + + +encode_real(C,Val) -> + ?RT_COMMON:encode_real(C,Val). + + +%%============================================================================ +%% decode real value +%% +%% decode_real([OctetBufferList], tuple|value, tag|notag) -> +%% {{Mantissa, Base, Exp} | realval | PLUS-INFINITY | MINUS-INFINITY | 0, +%% RestBuff} +%% +%% only for base 2 and 10 decoding sofar!! +%%============================================================================ + +decode_real(Tlv, Tags) -> + Buffer = match_tags(Tlv,Tags), + decode_real_notag(Buffer). + +decode_real_notag(Buffer) -> + Len = + case Buffer of + Bin when is_binary(Bin) -> + size(Bin); + {_T,_V} -> + exit({error,{asn1,{real_not_in_primitive_form,Buffer}}}) + end, + {Val,_Rest,Len} = ?RT_COMMON:decode_real(Buffer,Len), + Val. +%% 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 is_integer(Unused), is_binary(BinBits) -> + encode_bin_bit_string(C,Bin,NamedBitList,TagIn); +encode_bit_string(C, [FirstVal | RestVal], NamedBitList, TagIn) when is_atom(FirstVal) -> + encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn); + +encode_bit_string(C, [{bit,X} | RestVal], NamedBitList, TagIn) -> + encode_bit_string_named(C, [{bit,X} | RestVal], NamedBitList, TagIn); + +encode_bit_string(C, [FirstVal| RestVal], NamedBitList, TagIn) when is_integer(FirstVal) -> + encode_bit_string_bits(C, [FirstVal | RestVal], NamedBitList, TagIn); + +encode_bit_string(_C, 0, _NamedBitList, TagIn) -> + encode_tags(TagIn, <<0>>,1); + +encode_bit_string(_C, [], _NamedBitList, TagIn) -> + encode_tags(TagIn, <<0>>,1); + +encode_bit_string(C, IntegerVal, NamedBitList, TagIn) when is_integer(IntegerVal) -> + BitListVal = int_to_bitlist(IntegerVal), + encode_bit_string_bits(C, BitListVal, NamedBitList, TagIn); + +encode_bit_string(C, {Name,BitList}, NamedBitList, TagIn) when is_atom(Name) -> + encode_bit_string(C, BitList, NamedBitList, TagIn). + + + +int_to_bitlist(0) -> + []; +int_to_bitlist(Int) when is_integer(Int), Int >= 0 -> + [Int band 1 | int_to_bitlist(Int bsr 1)]. + + +%%================================================================= +%% Encode BIT STRING of the form {Unused,BinBits}. +%% Unused is the number of unused bits in the last byte in BinBits +%% and BinBits is a binary representing the BIT STRING. +%%================================================================= +encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList,TagIn)-> + case get_constraint(C,'SizeConstraint') of + no -> + remove_unused_then_dotag(TagIn, Unused, BinBits); + {_Min,Max} -> + BBLen = (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 is_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 is_list(BitListVal) -> + case get_constraint(C,'SizeConstraint') of + no -> + {Len, Unused, OctetList} = encode_bitstring(BitListVal), + %%add unused byte to the Len + encode_tags(TagIn, [Unused | OctetList], Len+1); + Constr={Min,_Max} when is_integer(Min) -> + %% Max may be an integer or 'MAX' + encode_constr_bit_str_bits(Constr,BitListVal,TagIn); + {Constr={_,_},[]} ->%Constr={Min,Max} + %% constraint with extension mark + encode_constr_bit_str_bits(Constr,BitListVal,TagIn); + Constr={{_,_},{_,_}} ->%{{Min1,Max1},{Min2,Max2}} + %% constraint with extension mark + encode_constr_bit_str_bits(Constr,BitListVal,TagIn); + Size -> + case length(BitListVal) of + BitSize when BitSize == Size -> + {Len, Unused, OctetList} = encode_bitstring(BitListVal), + %%add unused byte to the Len + encode_tags(TagIn, [Unused | OctetList], Len+1); + BitSize when BitSize < Size -> + PaddedList = pad_bit_list(Size-BitSize,BitListVal), + {Len, Unused, OctetList} = encode_bitstring(PaddedList), + %%add unused byte to the Len + encode_tags(TagIn, [Unused | OctetList], Len+1); + BitSize -> + exit({error,{asn1, + {bitstring_length, {{was,BitSize},{should_be,Size}}}}}) + end + + end. + +encode_constr_bit_str_bits({{_Min1,Max1},{Min2,Max2}},BitListVal,TagIn) -> + BitLen = length(BitListVal), + case BitLen of + Len when Len > Max2 -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {maximum,Max2}}}}}); + Len when Len > Max1, Len < Min2 -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {not_allowed_interval, + Max1,Min2}}}}}); + _ -> + {Len, Unused, OctetList} = encode_bitstring(BitListVal), + %%add unused byte to the Len + encode_tags(TagIn, [Unused, OctetList], Len+1) + end; +encode_constr_bit_str_bits({Min,Max},BitListVal,TagIn) -> + BitLen = length(BitListVal), + if + BitLen > Max -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {maximum,Max}}}}}); + BitLen < Min -> + exit({error,{asn1,{bitstring_length,{{was,BitLen}, + {minimum,Max}}}}}); + true -> + {Len, Unused, OctetList} = encode_bitstring(BitListVal), + %%add unused byte to the Len + encode_tags(TagIn, [Unused, OctetList], Len+1) + end. + + +%% returns a list of length Size + length(BitListVal), with BitListVal +%% as the most significant elements followed by padded zero elements +pad_bit_list(Size,BitListVal) -> + Tail = lists:duplicate(Size,0), + lists:append(BitListVal,Tail). + +%%================================================================= +%% Do the actual encoding +%% ([bitlist]) -> {ListLen, UnusedBits, OctetList} +%%================================================================= + +encode_bitstring([B8, B7, B6, B5, B4, B3, B2, B1 | Rest]) -> + Val = (B8 bsl 7) bor (B7 bsl 6) bor (B6 bsl 5) bor (B5 bsl 4) bor + (B4 bsl 3) bor (B3 bsl 2) bor (B2 bsl 1) bor B1, + encode_bitstring(Rest, [Val], 1); +encode_bitstring(Val) -> + {Unused, Octet} = unused_bitlist(Val, 7, 0), + {1, Unused, [Octet]}. + +encode_bitstring([B8, B7, B6, B5, B4, B3, B2, B1 | Rest], Ack, Len) -> + Val = (B8 bsl 7) bor (B7 bsl 6) bor (B6 bsl 5) bor (B5 bsl 4) bor + (B4 bsl 3) bor (B3 bsl 2) bor (B2 bsl 1) bor B1, + encode_bitstring(Rest, [Ack | [Val]], Len + 1); +%%even multiple of 8 bits.. +encode_bitstring([], Ack, Len) -> + {Len, 0, Ack}; +%% unused bits in last octet +encode_bitstring(Rest, Ack, Len) -> +% 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 is_binary(OctetList) -> + encode_tags(TagIn, OctetList, size(OctetList)); +encode_octet_string(_C, OctetList, TagIn) when is_list(OctetList) -> + encode_tags(TagIn, OctetList, length(OctetList)); +encode_octet_string(C, {Name,OctetList}, TagIn) when is_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 is_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 is_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 is_atom(Cname), is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); +e_object_identifier({Cname, V}) when is_atom(Cname), is_list(V) -> + e_object_identifier(V); +e_object_identifier(V) when is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); + +%%%%%%%%%%%%%%% +%% e_object_identifier([List of Obect Identifiers]) -> +%% {[Encoded Octetlist of ObjIds], IntLength} +%% +e_object_identifier([E1, E2 | Tail]) -> + Head = 40*E1 + E2, % wow! + {H,Lh} = mk_object_val(Head), + {R,Lr} = 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). + + +%%%%%%%%%%% +%% 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]). + +%%============================================================================ +%% RELATIVE-OID, ITU_T X.690 Chapter 8.20 +%% +%% encode Relative Object Identifier +%%============================================================================ +encode_relative_oid({Name,Val},TagIn) when is_atom(Name) -> + encode_relative_oid(Val,TagIn); +encode_relative_oid(Val,TagIn) when is_tuple(Val) -> + encode_relative_oid(tuple_to_list(Val),TagIn); +encode_relative_oid(Val,TagIn) -> + encode_tags(TagIn, enc_relative_oid(Val)). + +enc_relative_oid(Tuple) when is_tuple(Tuple) -> + enc_relative_oid(tuple_to_list(Tuple)); +enc_relative_oid(Val) -> + lists:mapfoldl(fun(X,AccIn) -> + {SO,L}=mk_object_val(X), + {SO,L+AccIn} + end + ,0,Val). + +%%============================================================================ +%% decode Relative Object Identifier value +%% (Buffer, HasTag, TotalLen) -> {{ObjId}, Remain, RemovedBytes} +%%============================================================================ +decode_relative_oid(Tlv, Tags) -> + Val = match_tags(Tlv, Tags), + ObjVals = dec_subidentifiers(Val,0,[]), + list_to_tuple(ObjVals). + +%%============================================================================ +%% Restricted character string types, ITU_T X.690 Chapter 8.20 +%% +%% encode Numeric Printable Teletex Videotex Visible IA5 Graphic General strings +%%============================================================================ +%% The StringType arg is kept for future use but might be removed +encode_restricted_string(_C, OctetList, _StringType, TagIn) + when is_binary(OctetList) -> + encode_tags(TagIn, OctetList, size(OctetList)); +encode_restricted_string(_C, OctetList, _StringType, TagIn) + when is_list(OctetList) -> + encode_tags(TagIn, OctetList, length(OctetList)); +encode_restricted_string(C,{Name,OctetL}, StringType, TagIn) when is_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 is_binary(Val),is_binary(AccVal) -> +% {<<AccVal/binary,Val/binary>>,AccRb+Rb}; +% _ when is_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 is_list(Val) -> + {length(Val),Val}; + ?N_BIT_STRING when is_tuple(Val) -> + {(size(element(2,Val))*8) - element(1,Val),Val}; + _ when is_binary(Val) -> + {size(Val),binary_to_list(Val)}; + _ when is_list(Val) -> + {length(Val), Val} + end, + case Range of + _ when StrLen == no_check -> + NewVal; + [] -> % No length constraint + NewVal; + {Lb,Ub} when StrLen >= Lb, Ub >= StrLen -> % variable length constraint + NewVal; + {{Lb,_Ub},[]} when StrLen >= Lb -> + NewVal; + {{Lb,_Ub},_Ext=[Min|_]} when StrLen >= Lb; StrLen >= Min -> + NewVal; + {{Lb1,Ub1},{Lb2,Ub2}} when StrLen >= Lb1, StrLen =< Ub1; + StrLen =< Ub2, StrLen >= Lb2 -> + NewVal; + StrLen -> % fixed length constraint + NewVal; + {_,_} -> + exit({error,{asn1,{length,Range,Val}}}); + _Len when is_integer(_Len) -> + exit({error,{asn1,{length,Range,Val}}}); + _ -> % some strange constraint that we don't support yet + NewVal + end. + + +%%============================================================================ +%% encode Universal string +%%============================================================================ + +encode_universal_string(C, {Name, Universal}, TagIn) when is_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 UTF8 string +%%============================================================================ + +encode_UTF8_string(_C,UTF8String,TagIn) when is_binary(UTF8String) -> + encode_tags(TagIn, UTF8String, size(UTF8String)); +encode_UTF8_string(_C,UTF8String,TagIn) -> + encode_tags(TagIn, UTF8String, length(UTF8String)). + + +%%============================================================================ +%% decode UTF8 string +%%============================================================================ + +decode_UTF8_string(Tlv,TagsIn) -> + Val = match_tags(Tlv, TagsIn), + case Val of + PartList = [_H|_T] -> % constructed val + collect_parts(PartList); + Bin -> + Bin + end. + + +%%============================================================================ +%% encode BMP string +%%============================================================================ + +encode_BMP_string(C, {Name,BMPString}, TagIn) when is_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 is_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 is_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 is_list(L) -> + collect_parts(Rest,[collect_parts(L)|Acc]); +collect_parts([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest],_Acc) -> + collect_parts_bit(Rest,[Bits],Unused); +collect_parts([{_T,V}|Rest],Acc) -> + collect_parts(Rest,[V|Acc]); +collect_parts([],Acc) -> + list_to_binary(lists:reverse(Acc)). + +collect_parts_bit([{?N_BIT_STRING,<<Unused,Bits/binary>>}|Rest],Acc,Uacc) -> + collect_parts_bit(Rest,[Bits|Acc],Unused+Uacc); +collect_parts_bit([],Acc,Uacc) -> + list_to_binary([Uacc|lists:reverse(Acc)]). + + + + + + + + + + + + + + + + + + + + diff --git a/lib/asn1/src/asn1rt_check.erl b/lib/asn1/src/asn1rt_check.erl new file mode 100644 index 0000000000..59a74a7078 --- /dev/null +++ b/lib/asn1/src/asn1rt_check.erl @@ -0,0 +1,361 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(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]). + +-export([dynamicsort_SET_components/1, + dynamicsort_SETOF/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 is_integer(Value) -> + true; +check_int(DefValue,Value,NNL) when is_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 is_integer(H) -> +% true; +% check_bitstring(V,V,_) when is_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 is_integer(Int),is_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 is_integer(Int),is_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 is_integer(H1),is_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 is_integer(H1),is_atom(H2) -> + L3 = bit_list_to_nbl(L1,NBL,0,[]), + check_bitstring(L3,L2,NBL); +%% Both default value and user value as a list of atoms +check_bitstring(L1=[H1|T1],L2=[H2|_T2],_) + when is_atom(H1),is_atom(H2),length(L1) == length(L2) -> + case lists:member(H1,L2) of + true -> + check_bitstring1(T1,L2); + false -> throw({error,L2}) + end; +%% Default value as a list of atoms and user value as a list of 1 and 0 +check_bitstring(L1=[H1|_T1],L2=[H2|_T2],NBL) when is_atom(H1),is_integer(H2) -> + L3 = bit_list_to_nbl(L2,NBL,0,[]), + check_bitstring(L1,L3,NBL); +%% 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 is_list(L),is_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 is_tuple(DOI),is_tuple(OI) -> + check_objectidentifier1(tuple_to_list(DOI),tuple_to_list(OI)); +check_objectidentifier(_,OI) -> + throw({error,OI}). + +check_objectidentifier1([V|Rest1],[V|Rest2]) -> + check_objectidentifier1(Rest1,Rest2,V); +check_objectidentifier1([V1|Rest1],[V2|Rest2]) -> + case reserved_objectid(V2,[]) of + V1 -> + check_objectidentifier1(Rest1,Rest2,[V1]); + V -> + throw({error,V}) + end. +check_objectidentifier1([V|Rest1],[V|Rest2],Above) -> + check_objectidentifier1(Rest1,Rest2,[V|Above]); +check_objectidentifier1([V1|Rest1],[V2|Rest2],Above) -> + case reserved_objectid(V2,Above) of + V1 -> + check_objectidentifier1(Rest1,Rest2,[V1|Above]); + V -> + throw({error,V}) + 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 is_integer(Int),is_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 is_list(V1),is_tuple(V2) -> + check_restrictedstring(V1,tuple_to_list(V2)); +check_restrictedstring(V1,V2) -> + throw({error,{restricted,string,V1,V2}}). + +transform_to_EXTERNAL1990(Val) when is_tuple(Val),size(Val) == 4 -> + transform_to_EXTERNAL1990(tuple_to_list(Val),[]); +transform_to_EXTERNAL1990(Val) when is_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,[Presentation_Cid,Transfer_syntax|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 is_list(Data_value)-> + list_to_tuple(lists:reverse([{'octet-aligned',Data_value}, + Data_val_desc|Acc])); +transform_to_EXTERNAL1990([Data_val_desc,Data_value],Acc) + when is_binary(Data_value)-> + list_to_tuple(lists:reverse([{'octet-aligned',binary_to_list(Data_value)}, + Data_val_desc|Acc])); +transform_to_EXTERNAL1990([Data_value],Acc) when is_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 is_list(Val);is_binary(Val) -> + {'EXTERNAL',Identification,Data_v_desc,Val}; + + _ -> + V + end. + + +%% dynamicsort_SET_components(Arg) -> +%% Res Arg -> list() +%% Res -> list() +%% Sorts the elements in Arg according to the encoded tag in +%% increasing order. +dynamicsort_SET_components(ListOfEncCs) -> + BinL = lists:map(fun(X) -> list_to_binary(X) end,ListOfEncCs), + TagBinL = lists:map(fun(X) -> + {{T,_,TN},_,_} = asn1rt_ber_bin:decode_tag(X), + {{T,TN},X} + end,BinL), + ClassTagNoSorted = lists:keysort(1,TagBinL), + lists:map(fun({_,El}) -> El end,ClassTagNoSorted). + +%% dynamicsort_SETOF(Arg) -> Res +%% Arg -> list() +%% Res -> list() +%% Sorts the elements in Arg in increasing size +dynamicsort_SETOF(ListOfEncVal) -> + BinL = lists:map(fun(L) when is_list(L) -> list_to_binary(L); + (B) -> B end,ListOfEncVal), + lists:sort(BinL). diff --git a/lib/asn1/src/asn1rt_driver_handler.erl b/lib/asn1/src/asn1rt_driver_handler.erl new file mode 100644 index 0000000000..c95b243ae0 --- /dev/null +++ b/lib/asn1/src/asn1rt_driver_handler.erl @@ -0,0 +1,141 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(asn1rt_driver_handler). + +-include("asn1_records.hrl"). + +-export([load_driver/0,unload_driver/0,client_port/0]). + +%% Internal exports +-export([init/2]). + +%% Macros +-define(port_names, + { asn1_drv01, asn1_drv02, asn1_drv03, asn1_drv04, + asn1_drv05, asn1_drv06, asn1_drv07, asn1_drv08, + asn1_drv09, asn1_drv10, asn1_drv11, asn1_drv12, + asn1_drv13, asn1_drv14, asn1_drv15, asn1_drv16 }). + +%%% -------------------------------------------------------- +%%% Interface Functions. +%%% -------------------------------------------------------- +load_driver() -> + load_driver(noreason). + +load_driver(Reason) -> + Ref = make_ref(), + case whereis(asn1_driver_owner) of % to prevent unnecessary spawn + Pid when is_pid(Pid) -> + asn1_driver_owner ! {self(),Ref,are_you_ready}, + receive + {Ref,driver_ready} -> + ok + after 10000 -> + {error,{timeout,waiting_for_drivers}} + end; + _ -> + {_,Mref} = spawn_monitor(asn1rt_driver_handler, init, [self(),Ref]), + receive + {'DOWN', Mref, _, _, NewReason} -> + case NewReason of + Reason -> {error,Reason}; + _ -> load_driver(NewReason) + end; + {Ref,driver_ready} -> + erlang:demonitor(Mref), + ok; + {Ref,Error = {error,_Reason}} -> + erlang:demonitor(Mref), + Error + after 10000 -> %% 10 seconds + {error,{timeout,waiting_for_drivers}} + end + end. + +init(FromPid,FromRef) -> + register(asn1_driver_owner,self()), + Dir = filename:join([code:priv_dir(asn1),"lib"]), + case catch erl_ddll:load_driver(Dir,asn1_erl_drv) of + ok -> + Result = open_named_ports(), + catch (FromPid ! {FromRef,Result}), + loop(Result); + {error,Err} -> % if erl_ddll:load_driver fails + ForErr = erl_ddll:format_error(Err), + OSDir = filename:join(Dir,erlang:system_info(system_architecture)), + case catch erl_ddll:load_driver(OSDir,asn1_erl_drv) of + ok -> + Result = open_named_ports(), + catch (FromPid ! {FromRef,Result}), + loop(Result); + {error,Err2} -> +% catch (FromPid ! {FromRef,Error}) + ForErr2 = erl_ddll:format_error(Err2), + catch (FromPid ! {FromRef,{error,{{Dir,ForErr},{OSDir,ForErr2}}}}) + end + end. + + +open_named_ports() -> + open_named_ports(size(?port_names)). + +open_named_ports(0) -> + driver_ready; +open_named_ports(N) -> + case catch open_port({spawn,"asn1_erl_drv"},[]) of + {'EXIT',Reason} -> + {error,{port_error,Reason}}; + Port -> + register(element(N,?port_names),Port), + open_named_ports(N-1) + end. + +loop(Result) -> + receive + {_FromPid,_FromRef,unload} -> + close_ports(size(?port_names)), + erl_ddll:unload_driver(asn1_erl_drv), + ok; + {FromPid,FromRef,are_you_ready} -> + catch (FromPid ! {FromRef,driver_ready}), + loop(Result); + _ -> + loop(Result) + end. + +unload_driver() -> + case whereis(asn1_driver_owner) of + Pid when is_pid(Pid) -> + Pid ! {self(),make_ref(),unload}, + ok; + _ -> + ok + end. + +close_ports(0) -> + ok; +close_ports(N) -> + element(N,?port_names) ! {self(), close}, %% almost same as port_close(Name) + close_ports(N-1). + +client_port() -> + element(erlang:system_info(scheduler_id) rem size(?port_names) + 1, + ?port_names). diff --git a/lib/asn1/src/asn1rt_per_bin.erl b/lib/asn1/src/asn1rt_per_bin.erl new file mode 100644 index 0000000000..6bbca26209 --- /dev/null +++ b/lib/asn1/src/asn1rt_per_bin.erl @@ -0,0 +1,2287 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(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, + encode_real/1, decode_real/1, + encode_relative_oid/1, decode_relative_oid/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_UTF8String/1, decode_UTF8String/1, + encode_BMPString/2, decode_BMPString/2, + encode_IA5String/2, decode_IA5String/2, + encode_NumericString/2, decode_NumericString/2, + encode_ObjectDescriptor/2, decode_ObjectDescriptor/1 + ]). +-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 is_tuple(Tuple) -> + Tuple; +list_to_record(Name,List) when is_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 is_tuple(Val) -> + fixoptionals1(OptList,Val,[]); + +fixoptionals(OptList,Val) when is_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 is_tuple(Val) -> + Bits = fixoptionals(OptList,Val,0), + {Val,{bits,OptLength,Bits}}; + +fixoptionals([],_Val,Acc) -> + %% Optbits + Acc; +fixoptionals([{Pos,DefVal}|Ot],Val,Acc) -> + case element(Pos,Val) of + asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); + DefVal -> fixoptionals(Ot,Val,Acc bsl 1); + _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) + end; +fixoptionals([Pos|Ot],Val,Acc) -> + case element(Pos,Val) of + asn1_NOVALUE -> fixoptionals(Ot,Val,Acc bsl 1); + asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); + _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) + end. + + +getext(Bytes) when is_tuple(Bytes) -> + getbit(Bytes); +getext(Bytes) when is_binary(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 is_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 is_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 is_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 is_binary(Bin) -> + getbits({0,Bin},Num). + + + +% getoctet(Bytes) when is_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 is_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 is_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 is_integer(N), Len1 > 1 -> + [{bits,1,0}, % the value is in the root set + encode_integer([{'ValueRange',{0,Len1-1}}],N)]; + N when is_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 is_integer(N2) -> + encode_small_number(N2); + false -> + unknown_choice_alt + end] + end; +set_choice(Alt,L,Len) -> + case set_choice_tag(Alt,L) of + N when is_integer(N), Len > 1 -> + encode_integer([{'ValueRange',{0,Len-1}}],N); + N when is_integer(N) -> + []; % no encoding if only 0 or 1 alternative + false -> + [unknown_choice_alt] + end. + +set_choice_tag(Alt,Choices) -> + set_choice_tag(Alt,Choices,0). + +set_choice_tag(Alt,[Alt|_Rest],Tag) -> + Tag; +set_choice_tag(Alt,[_H|Rest],Tag) -> + set_choice_tag(Alt,Rest,Tag+1); +set_choice_tag(_Alt,[],_Tag) -> + false. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_fragmented_XXX; decode of values encoded fragmented according +%% to ITU-T X.691 clause 10.9.3.8. The unit (XXX) is either bits, octets, +%% characters or number of components (in a choice,sequence or similar). +%% Buffer is a buffer {Used, Bin}. +%% C is the constrained length. +%% If the buffer is not aligned, this function does that. +decode_fragmented_bits({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 is_integer(Int),C == size(BinBits) -> + {BinBits,{0,Bin}}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,BinBits}}}) + end; +decode_fragmented_bits(<<0:1,Len:7,Bin/binary>>,C,Acc) -> + 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 is_integer(Int),C == (size(BinBits) - ((8 - Used) rem 8)) -> + Result; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,BinBits}}}) + end. + + +decode_fragmented_octets({0,Bin},C) -> + decode_fragmented_octets(Bin,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 is_integer(Int), C == size(Octets) -> + {Octets,{0,Bin}}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,Octets}}}) + 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 is_integer(Int),size(BinOctets) == Int -> + {BinOctets,Bin2}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,BinOctets}}}) + 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 is_list(Val) -> + Bin = list_to_binary(Val), + [encode_length(undefined,size(Bin)),{octets,Bin}]; % octets implies align +encode_open_type(_C, Val) when is_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 is_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 is_integer(V) -> + encode_integer(C,V); +encode_integer(C,{Name,V},NamedNumberList) when is_atom(Name) -> + encode_integer(C,V,NamedNumberList). + +encode_integer(C,{Name,Val}) when is_atom(Name) -> + encode_integer(C,Val); + +encode_integer([{Rc,_Ec}],Val) when is_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 is_list(C) -> + case get_constraint(C,'SingleValue') of + no -> + encode_integer1(C,Val); + V when is_integer(V),V == Val -> + []; % a type restricted to a single value encodes to nothing + V when is_list(V) -> + case lists:member(Val,V) of + true -> + encode_integer1(C,Val); + _ -> + exit({error,{asn1,{illegal_value,Val}}}) + end; + _ -> + exit({error,{asn1,{illegal_value,Val}}}) + end. + +encode_integer1(C, Val) -> + case VR = get_constraint(C,'ValueRange') of + no -> + encode_unconstrained_number(Val); + {Lb,'MAX'} -> + encode_semi_constrained_number(Lb,Val); + %% positive with range + {Lb,Ub} when Val >= Lb, + Ub >= Val -> + encode_constrained_number(VR,Val); + _ -> + exit({error,{asn1,{illegal_value,VR,Val}}}) + end. + +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 is_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 is_integer(V) -> + {V,Buffer}; + V when is_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 is_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 is_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 is_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 == 1 -> + []; + 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 == 1 -> + {0,Buffer}; + Range == 2 -> + getbits(Buffer,1); + Range =< 4 -> + getbits(Buffer,2); + Range =< 8 -> + getbits(Buffer,3); + Range =< 16 -> + getbits(Buffer,4); + Range =< 32 -> + getbits(Buffer,5); + Range =< 64 -> + getbits(Buffer,6); + Range =< 128 -> + getbits(Buffer,7); + Range =< 255 -> + getbits(Buffer,8); + Range =< 256 -> + getoctets(Buffer,1); + Range =< 65536 -> + getoctets(Buffer,2); + Range =< 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 is_integer(Lb), Lb >= 0 -> % Ub > 65535 + encode_length(undefined,Len); +encode_length({Vr={Lb,Ub},Ext},Len) + when Ub =< 65535 ,Lb >= 0, Len=<Ub, is_list(Ext) -> + %% constrained extensible + [{bits,1,0},encode_constrained_number(Vr,Len)]; +encode_length({{Lb,_Ub},Ext},Len) when is_list(Ext) -> + [{bits,1,1},encode_semi_constrained_number(Lb,Len)]; +encode_length(SingleValue,_Len) when is_integer(SingleValue) -> + []. + +%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension +%% additions in a sequence or set +encode_small_length(Len) when Len =< 64 -> +%% [{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(Buffer,{Lb,_}) when is_integer(Lb), Lb >= 0 -> % Ub > 65535 + decode_length(Buffer,undefined); +decode_length(Buffer,{VR={_Lb,_Ub},Ext}) when is_list(Ext) -> + case getbit(Buffer) of + {0,Buffer2} -> + decode_length(Buffer2, VR); + {1,Buffer2} -> + decode_length(Buffer2, undefined) + end; +%% {0,Buffer2} = getbit(Buffer), +%% decode_length(Buffer2, VR); + + +%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 is_integer(SingleValue) -> + {SingleValue,Buffer}. + + + % X.691:11 +encode_boolean(true) -> + {bits,1,1}; +encode_boolean(false) -> + {bits,1,0}; +encode_boolean({Name,Val}) when is_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 is_tuple(Ntup1), is_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 is_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 is_atom(NewVal) -> {NewVal,Buffer3}; + _ -> {{asn1_enum,Val},Buffer3} + end + end; + +decode_enumerated(Buffer,C,NamedNumberTup) when is_tuple(NamedNumberTup) -> + {Val,Buffer2} = decode_integer(Buffer,C), + case catch (element(Val+1,NamedNumberTup)) of + NewVal when is_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 is_integer(Unused), + is_binary(BinBits) -> + encode_bin_bit_string(C,Bin,NamedBitList); + +%% when the value is a list of named bits +encode_bit_string(C, LoNB=[FirstVal | _RestVal], NamedBitList) when is_atom(FirstVal) -> + ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), + BitList = make_and_set_list(ToSetPos,0), + encode_bit_string(C,BitList,NamedBitList); + +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 is_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 is_integer(V),V=<16 -> % fixed length 16 bits or less +% pad_list(V,BitList); +% V when is_integer(V) -> % fixed length 16 bits or more +% [align,pad_list(V,BitList)]; % should be another case for V >= 65537 +% {Lb,Ub} when is_integer(Lb),is_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 is_list(BitListValue) -> + BitListToBinary = + %% fun that transforms a list of 1 and 0 to a tuple: + %% {UnusedBitsInLastByte, Binary} + fun([1|T],Acc,N,Fun) -> + Fun(T,(Acc bsl 1)+1,N+1,Fun); + ([0|T],Acc,N,Fun) -> + Fun(T,(Acc bsl 1),N+1,Fun); + ([_H|_T],_,_,_) -> + exit({error,{asn1,{bitstring_bitlist,BitListValue}}}); + ([],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;(_)->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 is_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 is_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 is_integer(V),V=<16 -> + {Unused2,Bin2} = pad_list(V,UnusedAndBin1), + <<BitVal:V,_:Unused2>> = Bin2, + {bits,V,BitVal}; + V when is_integer(V) -> + [align, pad_list(V, UnusedAndBin1)]; + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + [encode_length({Lb,Ub},size(Bin1)*8 - Unused1), + align,UnusedAndBin1]; + {{Fix,Fix},L} when is_integer(Fix),is_list(L) -> + %% X.691 � 15.6, the rest of this paragraph is covered by + %% the last, ie. Sc, clause in this case + case (size(Bin1)*8)-Unused1 of + Size when Size =< Fix, Fix =< 16 -> + {Unused2,Bin2} = pad_list(Fix,UnusedAndBin), + <<BitVal:Fix,_:Unused2>> = Bin2, + [{bits,1,0},{bits,Fix,BitVal}]; + Size when Size =< Fix -> + [{bits,1,0},align, pad_list(Fix, UnusedAndBin1)]; + Size -> + [{bits,1,1},encode_length(undefined,Size), + align,UnusedAndBin1] + end; + 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,<<>>},C) -> + case C of + Int when is_integer(Int),Int > 0 -> + %% this padding see OTP-4353 + pad_list(Int,{0,<<>>}); + _ -> {0,<<>>} + end; +remove_trailing_bin(NamedNumberList, {_Unused,Bin},C) -> + Size = size(Bin)-1, + <<Bfront:Size/binary, LastByte:8>> = Bin, + %% clear the Unused bits to be sure + Unused1 = trailingZeroesInNibble(LastByte band 15), + Unused2 = + case Unused1 of + 4 -> + 4 + trailingZeroesInNibble(LastByte bsr 4); + _ -> Unused1 + end, + case Unused2 of + 8 -> + remove_trailing_bin(NamedNumberList,{0,Bfront},C); + _ -> + case C of + Int when is_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 is_integer(Lb) -> + Lb; +lower_bound({Lb,_}) when is_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 is_integer(V),V=<16 -> %fixed length 16 bits or less + compact_bit_string(Buffer,V,NamedNumberList); + V when is_integer(V),V=<65536 -> %fixed length > 16 bits + Bytes2 = align(Buffer), + compact_bit_string(Bytes2,V,NamedNumberList); + V when is_integer(V) -> % V > 65536 => fragmented value + {Bin,Buffer2} = decode_fragmented_bits(Buffer,V), + case Buffer2 of + {0,_} -> {{0,Bin},Buffer2}; + {U,_} -> {{8-U,Bin},Buffer2} + end; + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + %% This case may demand decoding of fragmented length/value + {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList); + no -> + %% This case may demand decoding of fragmented length/value + {Len,Bytes2} = decode_length(Buffer,undefined), + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList); + {{Fix,Fix},L} = Sc when is_list(L), is_integer(Fix), Fix =< 16 -> + %% X.691 �15.6, special case of extension marker + case decode_length(Buffer,Sc) of + {Len,Bytes2} when Len > Fix -> + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList); + {Len,Bytes2} -> + compact_bit_string(Bytes2,Len,NamedNumberList) + end; + Sc -> + {Len,Bytes2} = decode_length(Buffer,Sc), + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList) + end. + + +%%%%%%%%%%%%%%% +%% The result is presented as a list of named bits (if possible) +%% else as a list of 0 and 1. +%% +decode_bit_string(Buffer, C, NamedNumberList) -> + case get_constraint(C,'SizeConstraint') of + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList); + no -> + {Len,Bytes2} = decode_length(Buffer,undefined), + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList); + 0 -> % fixed length + {[],Buffer}; % nothing to encode + V when is_integer(V),V=<16 -> % fixed length 16 bits or less + bit_list_or_named(Buffer,V,NamedNumberList); + V when is_integer(V),V=<65536 -> + Bytes2 = align(Buffer), + bit_list_or_named(Bytes2,V,NamedNumberList); + V when is_integer(V) -> + Bytes2 = align(Buffer), + {BinBits,_} = decode_fragmented_bits(Bytes2,V), + bit_list_or_named(BinBits,V,NamedNumberList); + {{Fix,Fix},L} = Sc when is_list(L), is_integer(Fix), Fix =< 16 -> + %% X.691 �15.6, special case of extension marker + case decode_length(Buffer,Sc) of + {Len,Bytes2} when Len > Fix -> + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList); + {Len,Bytes2} when Len > 16 -> + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList); + {Len,Bytes2} -> + bit_list_or_named(Bytes2,Len,NamedNumberList) + end; + Sc -> %% X.691 �15.6, 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 is_integer(Int), Int > 0 -> + [Int band 1 | int_to_bitlist(Int bsr 1)]; +int_to_bitlist(0) -> + []. + + +%%%%%%%%%%%%%%%%%% +%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> +%% [sorted_list_of_bitpositions_to_set] + +get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); + +get_all_bitposes([Val | Rest], NamedBitList, Ack) -> + case lists: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_string2(C,Val). + +encode_octet_string2(C,{_Name,Val}) -> + encode_octet_string2(C,Val); +encode_octet_string2(C,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 is_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 is_integer(Sv), Sv =<65535 -> % fixed length + getoctets_as_list(Bytes,Sv); + Sv when is_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 is_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 is_atom(Name) -> + encode_restricted_string(aligned,Val); + +encode_restricted_string(aligned,Val) when is_list(Val)-> + [encode_length(undefined,length(Val)),{octets,Val}]. + +encode_known_multiplier_string(aligned,StringType,C,_Ext,{Name,Val}) when is_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 is_integer(Ub), Ub*NumBits =< 16 -> + Result; + 0 -> + []; + Ub when is_integer(Ub),Ub =<65535 -> % fixed length + [align,Result]; + {Ub,Lb} -> + [encode_length({Ub,Lb},length(Val)),align,Result]; + Vl when is_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 is_integer(Ub), Ub*NumBits =< 16 -> + chars_decode(Bytes,NumBits,StringType,C,Ub); + Ub when is_integer(Ub),Ub =<65535 -> % fixed length + Bytes1 = align(Bytes), + chars_decode(Bytes1,NumBits,StringType,C,Ub); + 0 -> + {[],Bytes}; + Vl when is_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 is_integer(NumOfChars) -> + 16 + charbits1(NumOfChars bsr 16). + +charbits1(0) -> + 0; +charbits1(NumOfChars) -> + 1 + charbits1(NumOfChars bsr 1). + + +chars_decode(Bytes,_,'BMPString',C,Len) -> + case get_constraint(C,'PermittedAlphabet') of + no -> + getBMPChars(Bytes,Len); + _ -> + exit({error,{asn1, + {'not implemented', + "BMPString with PermittedAlphabet constraint"}}}) + end; +chars_decode(Bytes,NumBits,StringType,C,Len) -> + CharInTab = get_CharInTab(C,StringType), + chars_decode2(Bytes,CharInTab,NumBits,Len). + + +chars_decode2(Bytes,CharInTab,NumBits,Len) -> + chars_decode2(Bytes,CharInTab,NumBits,Len,[]). + +chars_decode2(Bytes,_CharInTab,_NumBits,0,Acc) -> + {lists:reverse(Acc),Bytes}; +chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) when NumBits > 8 -> + {Char,Bytes2} = getbits(Bytes,NumBits), + Result = + if + Char < 256 -> Char; + true -> + list_to_tuple(binary_to_list(<<Char:32>>)) + end, + chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Result|Acc]); +% chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) 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]). + + +%% UTF8String +encode_UTF8String(Val) when is_binary(Val) -> + [encode_length(undefined,size(Val)),{octets,Val}]; +encode_UTF8String(Val) -> + Bin = list_to_binary(Val), + encode_UTF8String(Bin). + +decode_UTF8String(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), + {list_to_binary(Octs),Bytes3}. + + + % X.691:17 +encode_null(_) -> []. % encodes to nothing +%encode_null({Name,Val}) when is_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 is_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 is_atom(Cname),is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); +e_object_identifier({Cname,V}) when is_atom(Cname),is_list(V) -> + e_object_identifier(V); +e_object_identifier(V) when is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); + +%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) +e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> + Head = 40*E1 + E2, % weird + e_object_elements([Head|Tail],[]); +e_object_identifier(Oid=[_,_|_Tail]) -> + exit({error,{asn1,{'illegal_value',Oid}}}). + +e_object_elements([],Acc) -> + lists:reverse(Acc); +e_object_elements([H|T],Acc) -> + e_object_elements(T,[e_object_element(H)|Acc]). + +e_object_element(Num) when Num < 128 -> + [Num]; +e_object_element(Num) -> + [e_o_e(Num bsr 7)|[Num band 2#1111111]]. +e_o_e(Num) when Num < 128 -> + Num bor 2#10000000; +e_o_e(Num) -> + [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]]. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_object_identifier(Bytes) -> {ObjId,RemainingBytes} +%% ObjId -> {integer(),integer(),...} % at least 2 integers +%% RemainingBytes -> [integer()] when integer() (0..255) +decode_object_identifier(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), + [First|Rest] = dec_subidentifiers(Octs,0,[]), + Idlist = if + First < 40 -> + [0,First|Rest]; + First < 80 -> + [1,First - 40|Rest]; + true -> + [2,First - 80|Rest] + end, + {list_to_tuple(Idlist),Bytes3}. + +dec_subidentifiers([H|T],Av,Al) when H >=16#80 -> + dec_subidentifiers(T,(Av bsl 7) + (H band 16#7F),Al); +dec_subidentifiers([H|T],Av,Al) -> + dec_subidentifiers(T,0,[(Av bsl 7) + H |Al]); +dec_subidentifiers([],_Av,Al) -> + lists:reverse(Al). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_relative_oid(Val) -> CompleteList +%% encode_relative_oid({Name,Val}) -> CompleteList +encode_relative_oid({Name,Val}) when is_atom(Name) -> + encode_relative_oid(Val); +encode_relative_oid(Val) when is_tuple(Val) -> + encode_relative_oid(tuple_to_list(Val)); +encode_relative_oid(Val) when is_list(Val) -> + Octets = list_to_binary([e_object_element(X)||X <- Val]), + [encode_length(undefined,size(Octets)),{octets,Octets}]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_relative_oid(Val) -> {ROID,Rest} +%% decode_relative_oid({Name,Val}) -> {ROID,Rest} +decode_relative_oid(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), + ObjVals = dec_subidentifiers(Octs,0,[]), + {list_to_tuple(ObjVals),Bytes3}. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_real(Val) -> CompleteList +%% encode_real({Name,Val}) -> CompleteList +encode_real({Name,Val}) when is_atom(Name) -> + encode_real(Val); +encode_real(Real) -> + {EncVal,Len} = ?RT_COMMON:encode_real([],Real), + [encode_length(undefined,Len),{octets,EncVal}]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_real(Val) -> {REALvalue,Rest} +%% decode_real({Name,Val}) -> {REALvalue,Rest} +decode_real(Bytes) -> + {Len,{0,Bytes2}} = decode_length(Bytes,undefined), + {RealVal,Rest,Len} = ?RT_COMMON:decode_real(Bytes2,Len), + {RealVal,{0,Rest}}. + + +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 is_list(InList) -> +% complete1(InList,[]); +% complete1(InList) -> +% complete1([InList],[]). + +% complete1([{debug,_}|T], Acc) -> +% complete1(T,Acc); +% complete1([H|T],Acc) when is_list(H) -> +% {NewH,NewAcclen} = complete1(H,Acc), +% complete1(T,NewH,NewAcclen); + +% complete1([{0,Bin}|T],Acc,0) when is_binary(Bin) -> +% complete1(T,[Bin|Acc],0); +% complete1([{Unused,Bin}|T],Acc,0) when is_integer(Unused),is_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 is_integer(Unused),is_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 ,is_integer(Val) -> +% % complete1([{octets,<<Val:N/unit:8>>}|T],Acc,Acclen); +% complete1([{octets,N,Val}|T],Acc,Acclen) when N =< 4 ,is_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 is_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 is_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 is_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 is_list(InList) -> + complete1(InList,[],[]); +complete1(InList) -> + complete1([InList],[],[]). + +complete1([],Acc,Bacc) -> + {Acc,Bacc}; +complete1([H|T],Acc,Bacc) when is_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 is_binary(Bin) -> + complete1(T,[Acc|Bin],[]); +complete1([{Unused,Bin}|T],Acc,[]) when is_integer(Unused),is_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 is_integer(Unused),is_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/asn1/src/asn1rt_per_bin_rt2ct.erl b/lib/asn1/src/asn1rt_per_bin_rt2ct.erl new file mode 100644 index 0000000000..f4aecf9322 --- /dev/null +++ b/lib/asn1/src/asn1rt_per_bin_rt2ct.erl @@ -0,0 +1,1885 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(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, + encode_real/1, decode_real/1, + encode_relative_oid/1, decode_relative_oid/1, + complete/1]). + + +-export([encode_open_type/2, decode_open_type/2]). + +-export([encode_GeneralString/2, decode_GeneralString/2, + encode_GraphicString/2, decode_GraphicString/2, + encode_TeletexString/2, decode_TeletexString/2, + encode_VideotexString/2, decode_VideotexString/2, + encode_ObjectDescriptor/2, decode_ObjectDescriptor/1, + encode_UTF8String/1,decode_UTF8String/1 + ]). + +-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 is_tuple(Tuple) -> + Tuple; +list_to_record(Name,List) when is_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) -> + [0]; +setchoiceext(false) -> + [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 is_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,DefVal}|Ot],Val,Acc) -> + case element(Pos,Val) of + asn1_DEFAULT -> fixoptionals(Ot,Val,[0|Acc]); + DefVal -> fixoptionals(Ot,Val,[0|Acc]); + _ -> fixoptionals(Ot,Val,[1|Acc]) + end; +fixoptionals([Pos|Ot],Val,Acc) -> + case element(Pos,Val) of + asn1_NOVALUE -> fixoptionals(Ot,Val,[0|Acc]); + asn1_DEFAULT -> fixoptionals(Ot,Val,[0|Acc]); + _ -> fixoptionals(Ot,Val,[1|Acc]) + end. + + +getext(Bytes) when is_bitstring(Bytes) -> + getbit(Bytes). + +getextension(0, Bytes) -> + {<<>>,Bytes}; +getextension(1, Bytes) -> + {Len,Bytes2} = decode_small_length(Bytes), + getbits_as_binary(Len,Bytes2).% {Bin,Bytes3}. + +fixextensions({ext,ExtPos,ExtNum},Val) -> + case fixextensions(ExtPos,ExtNum+ExtPos,Val,0) of + 0 -> []; + ExtBits -> + [encode_small_length(ExtNum),pre_complete_bits(ExtNum,ExtBits)] + end. + +fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> + Acc; +fixextensions(Pos,ExtPos,Val,Acc) -> + Bit = case catch(element(Pos+1,Val)) of + asn1_NOVALUE -> + 0; + asn1_NOEXTVALUE -> + 0; + {'EXIT',_} -> + 0; + _ -> + 1 + end, + fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). + +skipextensions(Bytes,Nr,ExtensionBitstr) when is_bitstring(ExtensionBitstr) -> + Prev = Nr - 1, + case ExtensionBitstr of + <<_:Prev,1:1,_/bitstring>> -> + {_,Bytes2} = decode_open_type(Bytes,[]), + skipextensions(Bytes2, Nr+1, ExtensionBitstr); + <<_:Prev,0:1,_/bitstring>> -> + skipextensions(Bytes, Nr+1, ExtensionBitstr); + _ -> + 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) -> + getbits_as_binary(NumOpt,Bytes). + +%% new version used in generates from r8b_patch/3 and later +getoptionals2(Bytes,NumOpt) -> + {_,_} = getbits(Bytes,NumOpt). + + +%% getbits_as_binary(Num,Bytes) -> {Bin,Rest} +%% Num = integer(), +%% Bytes = bitstring(), +%% Bin = bitstring(), +%% Rest = bitstring() +getbits_as_binary(Num,Bytes) when is_bitstring(Bytes) -> + <<BS:Num/bitstring,Rest/bitstring>> = Bytes, + {BS,Rest}. + +getbits_as_list(Num,Bytes) when is_bitstring(Bytes) -> + <<BitStr:Num/bitstring,Rest/bitstring>> = Bytes, + {[ B || <<B:1>> <= BitStr],Rest}. + + +getbit(Buffer) -> + <<B:1,Rest/bitstring>> = Buffer, + {B,Rest}. + + +getbits(Buffer,Num) when is_bitstring(Buffer) -> + <<Bs:Num,Rest/bitstring>> = Buffer, + {Bs,Rest}. + +align(Bin) when is_binary(Bin) -> + Bin; +align(BitStr) when is_bitstring(BitStr) -> + AlignBits = bit_size(BitStr) rem 8, + <<_:AlignBits,Rest/binary>> = BitStr, + Rest. + + +%% First align buffer, then pick the first Num octets. +%% Returns octets as an integer with bit significance as in buffer. +getoctets(Buffer,Num) when is_binary(Buffer) -> + <<Val:Num/integer-unit:8,RestBin/binary>> = Buffer, + {Val,RestBin}; +getoctets(Buffer,Num) when is_bitstring(Buffer) -> + AlignBits = bit_size(Buffer) rem 8, + <<_:AlignBits,Val:Num/integer-unit:8,RestBin/binary>> = Buffer, + {Val,RestBin}. + + +%% First align buffer, then pick the first Num octets. +%% Returns octets as a binary +getoctets_as_bin(Bin,Num) when is_binary(Bin) -> + <<Octets:Num/binary,RestBin/binary>> = Bin, + {Octets,RestBin}; +getoctets_as_bin(Bin,Num) when is_bitstring(Bin) -> + AlignBits = bit_size(Bin) rem 8, + <<_:AlignBits,Val:Num/binary,RestBin/binary>> = Bin, + {Val,RestBin}. + + +%% same as above but returns octets as a List +getoctets_as_list(Buffer,Num) -> + {Bin,Buffer2} = getoctets_as_bin(Buffer,Num), + {binary_to_list(Bin),Buffer2}. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings +%% Alt = atom() +%% Altnum = integer() | {integer(),integer()}% number of alternatives +%% Choices = [atom()] | {[atom()],[atom()]} +%% When Choices is a tuple the first list is the Rootset and the +%% second is the Extensions and then Altnum must also be a tuple with the +%% lengths of the 2 lists +%% +set_choice(Alt,{L1,L2},{Len1,_Len2}) -> + case set_choice_tag(Alt,L1) of + N when is_integer(N), Len1 > 1 -> +% [{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 is_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 is_integer(N2) -> + encode_small_number(N2); + false -> + unknown_choice_alt + end] + end; +set_choice(Alt,L,Len) -> + case set_choice_tag(Alt,L) of + N when is_integer(N), Len > 1 -> + encode_constrained_number({0,Len-1},N); + N when is_integer(N) -> + []; % no encoding if only 0 or 1 alternative + false -> + [unknown_choice_alt] + end. + +set_choice_tag(Alt,Choices) -> + set_choice_tag(Alt,Choices,0). + +set_choice_tag(Alt,[Alt|_Rest],Tag) -> + Tag; +set_choice_tag(Alt,[_H|Rest],Tag) -> + set_choice_tag(Alt,Rest,Tag+1); +set_choice_tag(_Alt,[],_Tag) -> + false. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_fragmented_XXX; decode of values encoded fragmented according +%% to ITU-T X.691 clause 10.9.3.8. The unit (XXX) is either bits, octets, +%% characters or number of components (in a choice,sequence or similar). +%% Buffer is a buffer binary(). +%% C is the constrained length. +%% If the buffer is not aligned, this function does that. +decode_fragmented_bits(Buffer,C) when is_binary(Buffer) -> + decode_fragmented_bits(Buffer,C,[]); +decode_fragmented_bits(Buffer,C) when is_bitstring(Buffer) -> + AlignBits = bit_size(Buffer) rem 8, + <<_:AlignBits,Rest/binary>> = Buffer, + decode_fragmented_bits(Rest,C,[]). + +decode_fragmented_bits(<<3:2,Len:6,Bin/binary>>,C,Acc) -> + {Value,Bin2} = split_binary(Bin, Len * ?'16K'), % Len = 1 | 2 | 3 | 4 + decode_fragmented_bits(Bin2,C,[Value|Acc]); +decode_fragmented_bits(<<0:1,0:7,Bin/binary>>,C,Acc) -> + BinBits = erlang:list_to_bitstring(lists:reverse(Acc)), + case C of + Int when is_integer(Int),C == bit_size(BinBits) -> + {BinBits,Bin}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,BinBits}}}) + end; +decode_fragmented_bits(<<0:1,Len:7,Bin/binary>>,C,Acc) -> + <<Value:Len/bitstring,Rest/bitstring>> = Bin, + BinBits = erlang:list_to_bitstring([Value|Acc]), + case C of + Int when is_integer(Int),C == bit_size(BinBits) -> + {BinBits,Rest}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,BinBits}}}) + end. + + +decode_fragmented_octets(Bin,C) -> + decode_fragmented_octets(Bin,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 is_integer(Int), C == size(Octets) -> + {Octets,Bin}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,Octets}}}) + 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 is_integer(Int),size(BinOctets) == Int -> + {BinOctets,Bin2}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,BinOctets}}}) + 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 is_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_open_type(_Constraint, Val) when is_binary(Val) -> + 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 is_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 is_integer(V) -> + encode_integer(C,V); +encode_integer(C,{Name,V},NamedNumberList) when is_atom(Name) -> + encode_integer(C,V,NamedNumberList). + +encode_integer(C,{Name,Val}) when is_atom(Name) -> + encode_integer(C,Val); + +encode_integer([{Rc,_Ec}],Val) when is_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 is_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 is_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 is_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 is_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 is_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 == 1 -> []; + 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 == 1 -> + {0,Buffer}; + Range == 2 -> + getbits(Buffer,1); + Range =< 4 -> + getbits(Buffer,2); + Range =< 8 -> + getbits(Buffer,3); + Range =< 16 -> + getbits(Buffer,4); + Range =< 32 -> + getbits(Buffer,5); + Range =< 64 -> + getbits(Buffer,6); + Range =< 128 -> + getbits(Buffer,7); + Range =< 255 -> + getbits(Buffer,8); + Range =< 256 -> + getoctets(Buffer,1); + Range =< 65536 -> + getoctets(Buffer,2); + Range =< 16#1000000 -> + {Len,Bytes2} = decode_length(Buffer,{1,3}), + {Octs,Bytes3} = getoctets_as_bin(Bytes2,Len), + {dec_pos_integer(Octs),Bytes3}; + Range =< 16#100000000 -> + {Len,Bytes2} = decode_length(Buffer,{1,4}), + {Octs,Bytes3} = getoctets_as_bin(Bytes2,Len), + {dec_pos_integer(Octs),Bytes3}; + Range =< 16#10000000000 -> + {Len,Bytes2} = decode_length(Buffer,{1,5}), + {Octs,Bytes3} = getoctets_as_bin(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_bin(Bytes2,Len), + {dec_integer(Ints),Bytes3}. + + +dec_pos_integer(Ints) -> + decpint(Ints). +dec_integer(Bin = <<0:1,_:7,_/binary>>) -> + decpint(Bin); +dec_integer(<<_:1,B:7,BitStr/bitstring>>) -> + Size = bit_size(BitStr), + <<I:Size>> = BitStr, + (-128 + B) bsl bit_size(BitStr) bor I. + + + +decpint(Bin) -> + Size = bit_size(Bin), + <<Int:Size>> = Bin, + Int. + +%% 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 is_integer(Lb), Lb >= 0 -> % Ub > 65535 + encode_length(undefined,Len); +encode_length({Vr={Lb,Ub},Ext},Len) + when Ub =< 65535 ,Lb >= 0,Len=<Ub, is_list(Ext) -> + %% constrained extensible + [0,encode_constrained_number(Vr,Len)]; +encode_length({{Lb,_},Ext},Len) when is_list(Ext) -> + [1,encode_semi_constrained_number(Lb,Len)]; +encode_length(SingleValue,_Len) when is_integer(SingleValue) -> + []. + +%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension +%% additions in a sequence or set +encode_small_length(Len) when Len =< 64 -> +%% [{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(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 + case align(Buffer) of + <<0:1,Oct:7,Rest/binary>> -> + {Oct,Rest}; + <<2:2,Val:14,Rest/binary>> -> + {Val,Rest}; + <<3:2,_Val:14,_Rest/binary>> -> + %% this case should be fixed + exit({error,{asn1,{decode_length,{nyi,above_16k}}}}) + end; + +decode_length(Buffer,{Lb,Ub}) when Ub =< 65535 ,Lb >= 0 -> % constrained + decode_constrained_number(Buffer,{Lb,Ub}); +decode_length(Buffer,{Lb,_Ub}) when is_integer(Lb), Lb >= 0 -> % Ub > 65535 + decode_length(Buffer,undefined); +decode_length(Buffer,{{Lb,Ub},Ext}) when is_list(Ext) -> + case getbit(Buffer) of + {0,Buffer2} -> + decode_length(Buffer2, {Lb,Ub}); + {1,Buffer2} -> + decode_length(Buffer2, undefined) + end; + + +%When does this case occur with {_,_Lb,Ub} ?? +% X.691:10.9.3.5 +decode_length(Bin,{_,_Lb,_Ub}) -> % Unconstrained or large Ub NOTE! this case does not cover case when Ub > 65535 + case Bin of + <<0:1,Val:7,Rest/bitstring>> -> + {Val,Rest}; + _ -> + case align(Bin) of + <<2:2,Val:14,Rest/binary>> -> + {Val,Rest}; + <<3:2,_:14,_Rest/binary>> -> + exit({error,{asn1,{decode_length,{nyi,length_above_64K}}}}) + end + end; +decode_length(Buffer,SingleValue) when is_integer(SingleValue) -> + {SingleValue,Buffer}. + + + % 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 is_tuple(Ntup1), is_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 is_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 is_atom(NewVal) -> {NewVal,Buffer3}; + _ -> {{asn1_enum,Val},Buffer3} + end + end; + +decode_enumerated(Buffer,C,NamedNumberTup) when is_tuple(NamedNumberTup) -> + {Val,Buffer2} = decode_integer(Buffer,C), + case catch (element(Val+1,NamedNumberTup)) of + NewVal when is_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 is_integer(Unused), + is_binary(BinBits) -> + encode_bin_bit_string(C,Bin,NamedBitList); + +%% when the value is a list of named bits + +encode_bit_string(C, LoNB=[FirstVal | _RestVal], NamedBitList) when is_atom(FirstVal) -> + ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), + BitList = make_and_set_list(ToSetPos,0), + encode_bit_string(C,BitList,NamedBitList);% consider the constraint + +encode_bit_string(C, BL=[{bit,_} | _RestVal], NamedBitList) -> + ToSetPos = get_all_bitposes(BL, NamedBitList, []), + BitList = make_and_set_list(ToSetPos,0), + encode_bit_string(C,BitList,NamedBitList); + +%% when the value is a list of ones and zeroes +encode_bit_string(Int, BitListValue, _) + when is_list(BitListValue),is_integer(Int),Int =< 16 -> + %% The type is constrained by a single value size constraint + %% range_check(Int,length(BitListValue)), + [40,Int,length(BitListValue),BitListValue]; +encode_bit_string(Int, BitListValue, _) + when is_list(BitListValue),is_integer(Int), Int =< 255 -> + %% The type is constrained by a single value size constraint + %% range_check(Int,length(BitListValue)), + [2,40,Int,length(BitListValue),BitListValue]; +encode_bit_string(Int, BitListValue, _) + when is_list(BitListValue),is_integer(Int), Int < ?'64K' -> + {Code,DesiredLength,Length} = + case length(BitListValue) of + B1 when B1 > Int -> + exit({error,{'BIT_STRING_length_greater_than_SIZE', + Int,BitListValue}}); + B1 when B1 =< 255,Int =< 255 -> + {40,Int,B1}; + B1 when B1 =< 255 -> + {42,<<Int:16>>,B1}; + B1 -> + {43,<<Int:16>>,<<B1:16>>} + end, + %% The type is constrained by a single value size constraint + [2,Code,DesiredLength,Length,BitListValue]; +encode_bit_string(no, BitListValue,[]) + when is_list(BitListValue) -> + [encode_length(undefined,length(BitListValue)), + 2,BitListValue]; +encode_bit_string({{Fix,Fix},Ext}, BitListValue,[]) + when is_integer(Fix), is_list(Ext) -> + case length(BitListValue) of + Len when Len =< Fix -> + [0,encode_bit_string(Fix,BitListValue,[])]; + _ -> + [1,encode_bit_string(no,BitListValue,[])] + end; +encode_bit_string(C, BitListValue,[]) + when is_list(BitListValue) -> + [encode_length(C,length(BitListValue)), + 2,BitListValue]; +encode_bit_string(no, BitListValue,_NamedBitList) + when is_list(BitListValue) -> + %% this case with an unconstrained BIT STRING can be made more efficient + %% if the complete driver can take a special code so the length field + %% is encoded there. + NewBitLVal = lists:reverse(lists:dropwhile(fun(0)->true;(1)->false end, + lists:reverse(BitListValue))), + [encode_length(undefined,length(NewBitLVal)), + 2,NewBitLVal]; +encode_bit_string({{Fix,Fix},Ext}, BitListValue,_NamedBitList) + when is_integer(Fix), is_list(Ext) -> + case length(BitListValue) of + Len when Len =< Fix -> + [0,encode_bit_string(Fix,BitListValue,_NamedBitList)]; + _ -> + [1,encode_bit_string(no,BitListValue,_NamedBitList)] + end; +encode_bit_string(C,BitListValue,_NamedBitList) + when is_list(BitListValue) ->% C = {_,'MAX'} +% NewBitLVal = 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]; + + +%% when the value is an integer +encode_bit_string(C, IntegerVal, NamedBitList) when is_integer(IntegerVal)-> + BitList = int_to_bitlist(IntegerVal), + encode_bit_string(C,BitList,NamedBitList); + +%% when the value is a tuple +encode_bit_string(C,{Name,Val}, NamedBitList) when is_atom(Name) -> + encode_bit_string(C,Val,NamedBitList). + +bit_string_trailing_zeros(BitList,C) when is_integer(C) -> + bit_string_trailing_zeros1(BitList,C,C); +bit_string_trailing_zeros(BitList,{Lb,Ub}) when is_integer(Lb) -> + bit_string_trailing_zeros1(BitList,Lb,Ub); +bit_string_trailing_zeros(BitList,{{Lb,Ub},_}) when is_integer(Lb) -> + bit_string_trailing_zeros1(BitList,Lb,Ub); +bit_string_trailing_zeros(BitList,_) -> + BitList. + +bit_string_trailing_zeros1(BitList,Lb,Ub) -> + case length(BitList) of + Lb -> BitList; + B when B<Lb -> BitList++lists:duplicate(Lb-B,0); + D -> F = fun(L,LB,LB,_,_)->lists:reverse(L); + ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun); + (L,L1,_,UB,_)when L1 =< UB -> lists:reverse(L); + (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING, + BitList}}) end, + F(lists:reverse(BitList),D,Lb,Ub,F) + end. + +%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. +%% Unused = integer(),i.e. number unused bits in least sign. byte of +%% BinBits = binary(). +encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList) + when is_integer(C),C=<16 -> + range_check(C,bit_size(BinBits) - Unused), + [45,C,size(BinBits),BinBits]; +encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList) + when is_integer(C), C =< 255 -> + range_check(C,bit_size(BinBits) - Unused), + [2,45,C,size(BinBits),BinBits]; +encode_bin_bit_string(C,{Unused,BinBits},_NamedBitList) + when is_integer(C), C =< 65535 -> + range_check(C,bit_size(BinBits) - Unused), + case size(BinBits) of + Size when Size =< 255 -> + [2,46,<<C:16>>,Size,BinBits]; + Size -> + [2,47,<<C:16>>,<<Size:16>>,BinBits] + end; +%% encode_bin_bit_string(C,{_Unused,BinBits},_NamedBitList) +%% when is_integer(C) -> +%% exit({error,{asn1, {bitstring_size, not_supported, C}}}); +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 + {Lb,Ub} when is_integer(Lb),is_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)]; + {{Fix,Fix},Ext} when is_integer(Fix),is_list(Ext) -> + %%[encode_length(Sc,size(Bin1)*8 - Unused1), + case size(Bin1)*8 - Unused1 of + Size when Size =< Fix -> + [0,encode_bin_bit_string(Fix,UnusedAndBin,NamedBitList)]; + _Size -> + [1,encode_bin_bit_string(no,UnusedAndBin,NamedBitList)] + end; + Sc -> + Size=size(Bin1), + [encode_length(Sc,Size*8 - Unused1), + 2,octets_unused_to_complete(Unused1,Size,Bin1)] + end. + +range_check(C,C) when is_integer(C) -> + ok; +range_check(C1,C2) when is_integer(C1) -> + exit({error,{asn1,{bit_string_out_of_range,{C1,C2}}}}). + +remove_trailing_bin([], {Unused,Bin}) -> + {Unused,Bin}; +remove_trailing_bin(_NamedNumberList,{_Unused,<<>>}) -> + {0,<<>>}; +remove_trailing_bin(NamedNumberList, {_Unused,Bin}) -> + Size = 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 is_integer(V),V=<16 -> %fixed length 16 bits or less + compact_bit_string(Buffer,V,NamedNumberList); + V when is_integer(V),V=<65536 -> %fixed length > 16 bits + Bytes2 = align(Buffer), + compact_bit_string(Bytes2,V,NamedNumberList); + V when is_integer(V) -> % V > 65536 => fragmented value + {BitStr,Buffer2} = decode_fragmented_bits(Buffer,V), + case bit_size(BitStr) band 7 of + 0 -> {{0,BitStr},Buffer2}; + N -> {{8-N,<<BitStr/bitstring,0:(8-N)>>},Buffer2} + end; + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + %% This case may demand decoding of fragmented length/value + {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList); + no -> + %% This case may demand decoding of fragmented length/value + {Len,Bytes2} = decode_length(Buffer,undefined), + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList); + {{Fix,Fix},Ext} = Sc when is_integer(Fix), is_list(Ext) -> + case decode_length(Buffer,Sc) of + {Len,Bytes2} when Len > Fix -> + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList); + {Len,Bytes2} when Len > 16 -> + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList); + {Len,Bytes2} -> + compact_bit_string(Bytes2,Len,NamedNumberList) + end; + Sc -> + {Len,Bytes2} = decode_length(Buffer,Sc), + Bytes3 = align(Bytes2), + compact_bit_string(Bytes3,Len,NamedNumberList) + end. + + +%%%%%%%%%%%%%%% +%% The result is presented as a list of named bits (if possible) +%% else as a list of 0 and 1. +%% +decode_bit_string(Buffer, C, NamedNumberList) -> + case get_constraint(C,'SizeConstraint') of + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList); + no -> + {Len,Bytes2} = decode_length(Buffer,undefined), + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList); + 0 -> % fixed length + {[],Buffer}; % nothing to encode + V when is_integer(V),V=<16 -> % fixed length 16 bits or less + bit_list_or_named(Buffer,V,NamedNumberList); + V when is_integer(V),V=<65536 -> + Bytes2 = align(Buffer), + bit_list_or_named(Bytes2,V,NamedNumberList); + V when is_integer(V) -> + Bytes2 = align(Buffer), + {BinBits,_Bytes3} = decode_fragmented_bits(Bytes2,V), + bit_list_or_named(BinBits,V,NamedNumberList); + {{Fix,Fix},Ext} =Sc when is_integer(Fix), is_list(Ext) -> + case decode_length(Buffer,Sc) of + {Len,Bytes2} when Len > Fix -> + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList); + {Len,Bytes2} when Len > 16 -> + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList); + {Len,Bytes2} -> + bit_list_or_named(Bytes2,Len,NamedNumberList) + end; + Sc -> % extension marker + {Len,Bytes2} = decode_length(Buffer,Sc), + Bytes3 = align(Bytes2), + bit_list_or_named(Bytes3,Len,NamedNumberList) + end. + + +%% if no named bits are declared we will return a +%% {Unused,Bits}. Unused = integer(), +%% Bits = binary(). +compact_bit_string(Buffer,Len,[]) -> + {BitStr,Rest} = getbits_as_binary(Len,Buffer), % {{Unused,BinBits},NewBuffer} + PadLen = (8 - (bit_size(BitStr) rem 8)) rem 8, + {{PadLen,<<BitStr/bitstring,0:PadLen>>},Rest}; +compact_bit_string(Buffer,Len,NamedNumberList) -> + bit_list_or_named(Buffer,Len,NamedNumberList). + + +%% if no named bits are declared we will return a +%% BitList = [0 | 1] + +bit_list_or_named(Buffer,Len,[]) -> + getbits_as_list(Len,Buffer); + +%% if there are named bits declared we will return a named +%% BitList where the names are atoms and unnamed bits represented +%% as {bit,Pos} +%% BitList = [atom() | {bit,Pos}] +%% Pos = integer() + +bit_list_or_named(Buffer,Len,NamedNumberList) -> + {BitList,Rest} = getbits_as_list(Len,Buffer), + {bit_list_or_named1(0,BitList,NamedNumberList,[]), Rest}. + +bit_list_or_named1(Pos,[0|Bt],Names,Acc) -> + bit_list_or_named1(Pos+1,Bt,Names,Acc); +bit_list_or_named1(Pos,[1|Bt],Names,Acc) -> + case lists: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 is_integer(Int), Int > 0 -> + [Int band 1 | int_to_bitlist(Int bsr 1)]; +int_to_bitlist(0) -> + []. + + +%%%%%%%%%%%%%%%%%% +%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> +%% [sorted_list_of_bitpositions_to_set] + +get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); + +get_all_bitposes([Val | Rest], NamedBitList, Ack) -> + case lists: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([], _) -> + []. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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 is_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(<<B1,Bytes/bitstring>>,1,false) -> +%% {B1,Bytes2} = getbits(Bytes,8), + {[B1],Bytes}; +decode_octet_string(<<B1,B2,Bytes/bitstring>>,2,false) -> +%% {Bs,Bytes2}= getbits(Bytes,16), +%% {binary_to_list(<<Bs:16>>),Bytes2}; + {[B1,B2],Bytes}; +decode_octet_string(Bytes,Sv,false) when is_integer(Sv),Sv=<65535 -> + %% Bytes2 = align(Bytes), + %% getoctets_as_list aligns buffer before it picks octets + getoctets_as_list(Bytes,Sv); +decode_octet_string(Bytes,Sv,false) when is_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(Bytes2,Len); +decode_octet_string(Bytes,Sv,false) when is_list(Sv) -> + {Len,Bytes2} = decode_length(Bytes,{hd(Sv),lists:max(Sv)}), +%% Bytes3 = align(Bytes2), + getoctets_as_list(Bytes2,Len); +decode_octet_string(Bytes,no,false) -> + {Len,Bytes2} = decode_length(Bytes,undefined), +%% Bytes3 = align(Bytes2), + getoctets_as_list(Bytes2,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 is_atom(Name) -> + encode_restricted_string(aligned,Val); + +encode_restricted_string(aligned,Val) when is_list(Val)-> + Len = length(Val), + [encode_length(undefined,Len),octets_to_complete(Len,Val)]. + + +encode_known_multiplier_string(StringType,SizeC,NumBits,CharOutTab,{Name,Val}) when is_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 is_integer(Ub), Ub*NumBits =< 16 -> + Result; + Ub when is_integer(Ub),Ub =<65535 -> % fixed length + [2,Result]; + {Ub,Lb} -> + [encode_length({Ub,Lb},length(Val)),2,Result]; + no -> + [encode_length(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 is_integer(Ub), Ub*NumBits =< 16 -> + chars_decode(Bytes,NumBits,StringType,CharInTab,Ub); + Ub when is_integer(Ub),Ub =<65535 -> % fixed length + Bytes1 = align(Bytes), + chars_decode(Bytes1,NumBits,StringType,CharInTab,Ub); + Vl when is_list(Vl) -> + {Len,Bytes1} = decode_length(Bytes,{hd(Vl),lists:max(Vl)}), + Bytes2 = align(Bytes1), + chars_decode(Bytes2,NumBits,StringType,CharInTab,Len); + no -> + {Len,Bytes1} = decode_length(Bytes,undefined), + Bytes2 = align(Bytes1), + chars_decode(Bytes2,NumBits,StringType,CharInTab,Len); + {Lb,Ub}-> + {Len,Bytes1} = decode_length(Bytes,{Lb,Ub}), + Bytes2 = align(Bytes1), + chars_decode(Bytes2,NumBits,StringType,CharInTab,Len) + end. + +encode_GeneralString(_C,Val) -> + encode_restricted_string(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(<<T/binary>>, 0, Acc) -> + {lists:reverse(Acc),T}; +getBMPChars(<<0,O2,Bytes1/bitstring>>, Len, Acc) -> + getBMPChars(Bytes1,Len-1,[O2|Acc]); +getBMPChars(<<O1,O2,Bytes1/bitstring>>, Len, Acc) -> + getBMPChars(Bytes1,Len-1,[{0,0,O1,O2}|Acc]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% chars_encode(C,StringType,Value) -> ValueList +%% +%% encodes chars according to the per rules taking the constraint PermittedAlphabet +%% into account. +%% This function 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>>]. + + +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 is_atom(Name) -> +% encode_null(Val). + +decode_null(Bytes) -> + {'NULL',Bytes}. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_UTF8String(Val) -> CompleteList +%% Val -> <<utf8encoded binary>> +%% CompleteList -> [apropriate codes and values for driver complete] +%% +encode_UTF8String(Val) when is_binary(Val) -> + [encode_length(undefined,size(Val)), + octets_to_complete(size(Val),Val)]; +encode_UTF8String(Val) -> + encode_UTF8String(list_to_binary(Val)). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_UTF8String(Bytes) -> {Utf8Binary,RemainingBytes} +%% Utf8Binary -> <<utf8 encoded binary>> +%% RemainingBytes -> <<buffer>> +decode_UTF8String(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {_Bin,_Bytes3} = getoctets_as_bin(Bytes2,Len). + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_object_identifier(Val) -> CompleteList +%% encode_object_identifier({Name,Val}) -> CompleteList +%% Val -> {Int1,Int2,...,IntN} % N >= 2 +%% Name -> atom() +%% Int1 -> integer(0..2) +%% Int2 -> integer(0..39) when Int1 (0..1) else integer() +%% Int3-N -> integer() +%% CompleteList -> [{bits,8,Val}|{octets,Ol}|align|...] +%% +encode_object_identifier({Name,Val}) when is_atom(Name) -> + encode_object_identifier(Val); +encode_object_identifier(Val) -> + OctetList = e_object_identifier(Val), + Octets = list_to_binary(OctetList), + [encode_length(undefined,size(Octets)), + octets_to_complete(size(Octets),Octets)]. + +e_object_identifier({'OBJECT IDENTIFIER',V}) -> + e_object_identifier(V); +e_object_identifier({Cname,V}) when is_atom(Cname),is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); +e_object_identifier({Cname,V}) when is_atom(Cname),is_list(V) -> + e_object_identifier(V); +e_object_identifier(V) when is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); + +%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) +e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> + Head = 40*E1 + E2, % weird + e_object_elements([Head|Tail],[]); +e_object_identifier(Oid=[_,_|_Tail]) -> + exit({error,{asn1,{'illegal_value',Oid}}}). + +e_object_elements([],Acc) -> + lists:reverse(Acc); +e_object_elements([H|T],Acc) -> + e_object_elements(T,[e_object_element(H)|Acc]). + +e_object_element(Num) when Num < 128 -> + [Num]; +e_object_element(Num) -> + [e_o_e(Num bsr 7)|[Num band 2#1111111]]. +e_o_e(Num) when Num < 128 -> + Num bor 2#10000000; +e_o_e(Num) -> + [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]]. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_object_identifier(Bytes) -> {ObjId,RemainingBytes} +%% ObjId -> {integer(),integer(),...} % at least 2 integers +%% RemainingBytes -> [integer()] when integer() (0..255) +decode_object_identifier(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), + [First|Rest] = dec_subidentifiers(Octs,0,[]), + Idlist = if + First < 40 -> + [0,First|Rest]; + First < 80 -> + [1,First - 40|Rest]; + true -> + [2,First - 80|Rest] + end, + {list_to_tuple(Idlist),Bytes3}. + +dec_subidentifiers([H|T],Av,Al) when H >=16#80 -> + dec_subidentifiers(T,(Av bsl 7) + (H band 16#7F),Al); +dec_subidentifiers([H|T],Av,Al) -> + dec_subidentifiers(T,0,[(Av bsl 7) + H |Al]); +dec_subidentifiers([],_Av,Al) -> + lists:reverse(Al). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_relative_oid(Val) -> CompleteList +%% encode_relative_oid({Name,Val}) -> CompleteList +encode_relative_oid({Name,Val}) when is_atom(Name) -> + encode_relative_oid(Val); +encode_relative_oid(Val) when is_tuple(Val) -> + encode_relative_oid(tuple_to_list(Val)); +encode_relative_oid(Val) when is_list(Val) -> + Octets = list_to_binary([e_object_element(X)||X <- Val]), + [encode_length(undefined,size(Octets)), + octets_to_complete(size(Octets),Octets)]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_relative_oid(Val) -> CompleteList +%% decode_relative_oid({Name,Val}) -> CompleteList +decode_relative_oid(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), + ObjVals = dec_subidentifiers(Octs,0,[]), + {list_to_tuple(ObjVals),Bytes3}. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_real(Val) -> CompleteList +%% encode_real({Name,Val}) -> CompleteList +encode_real({Name,Val}) when is_atom(Name) -> + encode_real(Val); +encode_real(Real) -> + {EncVal,Len} = ?RT_COMMON:encode_real([],Real), + [encode_length(undefined,Len),octets_to_complete(size(EncVal),EncVal)]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_real(Val) -> {REALvalue,Rest} +%% decode_real({Name,Val}) -> {REALvalue,Rest} +decode_real(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {RealVal,Rest,Len} = ?RT_COMMON:decode_real(Bytes2,Len), + {RealVal,Rest}. + + +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 is_list(InList) -> + complete1(InList,[],[]); + complete1(InList) -> + complete1([InList],[],[]). + + complete1([],Acc,Bacc) -> + {Acc,Bacc}; + complete1([H|T],Acc,Bacc) when is_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 is_binary(Bin) -> + complete1(T,[Acc|Bin],[]); + complete1([{Unused,Bin}|T],Acc,[]) when is_integer(Unused),is_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 is_integer(Unused),is_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. + +%% asn1-1.6.8.1_dev +%% complete(L) -> +%% case catch port_control(asn1_driver_port,1,L) of +%% Bin when is_binary(Bin) -> +%% Bin; +%% List when is_list(List) -> handle_error(List,L); +%% {'EXIT',{badarg,Reason}} -> +%% asn1rt_driver_handler:load_driver(), +%% receive +%% driver_ready -> +%% case catch port_control(asn1_driver_port,1,L) of +%% Bin2 when is_binary(Bin2) -> Bin2; +%% List when is_list(List) -> handle_error(List,L); +%% {'EXIT',Reason2={badarg,_R}} -> +%% exit({"failed to call driver probably due to bad asn1 value",Reason2}); +%% Reason2 -> exit(Reason2) +%% 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. + +%% asn1-1.6.9 +complete(L) -> + case catch control(?COMPLETE_ENCODE,L) of + Bin when is_binary(Bin) -> + Bin; + List when is_list(List) -> handle_error(List,L); + {'EXIT',{badarg,_Reason}} -> + case asn1rt:load_driver() of + ok -> + case control(?COMPLETE_ENCODE,L) of + Bin when is_binary(Bin) ->Bin; + List when is_list(List) -> handle_error(List,L) + end; + Err -> + Err + end + end. + + +handle_error([],_)-> + exit({error,{asn1,{"memory allocation problem in driver"}}}); +handle_error("1",L) -> % error in complete in driver + exit({error,{asn1,L}}); +handle_error(ErrL,L) -> + exit({error,{asn1,ErrL,L}}). + +%% asn1-1.6.9 +control(Cmd, Data) -> + Port = asn1rt_driver_handler:client_port(), + erlang:port_control(Port, Cmd, Data). + +-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/asn1/src/asn1rt_uper_bin.erl b/lib/asn1/src/asn1rt_uper_bin.erl new file mode 100644 index 0000000000..a964b835ae --- /dev/null +++ b/lib/asn1/src/asn1rt_uper_bin.erl @@ -0,0 +1,1635 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1rt_uper_bin). + +%% encoding / decoding of PER unaligned + +-include("asn1_records.hrl"). + +%%-compile(export_all). + + -export([cindex/3, list_to_record/2]). + -export([setext/1, fixoptionals/3, + fixextensions/2, + getext/1, getextension/2, skipextensions/3, getbit/1, getchoice/3 ]). + -export([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_relative_oid/1, decode_relative_oid/1, + encode_object_identifier/1, decode_object_identifier/1, + encode_real/1, decode_real/1, + complete/1, complete_NFP/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_UTF8String/1, decode_UTF8String/1, + encode_BMPString/2, decode_BMPString/2, + encode_IA5String/2, decode_IA5String/2, + encode_NumericString/2, decode_NumericString/2, + encode_ObjectDescriptor/2, decode_ObjectDescriptor/1 + ]). + +-define('16K',16384). +-define('32K',32768). +-define('64K',65536). + + +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 is_tuple(Tuple) -> + Tuple; +list_to_record(Name,List) when is_list(List) -> + list_to_tuple([Name|List]). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% setext(true|false) -> CompleteList +%% + +setext(false) -> + <<0:1>>; +setext(true) -> + <<1:1>>. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% This is the new fixoptionals/3 which is used by the new generates +%% +fixoptionals(OptList,OptLength,Val) when is_tuple(Val) -> + Bits = fixoptionals(OptList,Val,0), + {Val,<<Bits:OptLength>>}; + +fixoptionals([],_Val,Acc) -> + %% Optbits + Acc; +fixoptionals([{Pos,DefVal}|Ot],Val,Acc) -> + case element(Pos,Val) of + asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); + DefVal -> fixoptionals(Ot,Val,Acc bsl 1); + _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) + end; +fixoptionals([Pos|Ot],Val,Acc) -> + case element(Pos,Val) of + asn1_NOVALUE -> fixoptionals(Ot,Val,Acc bsl 1); + asn1_DEFAULT -> fixoptionals(Ot,Val,Acc bsl 1); + _ -> fixoptionals(Ot,Val,(Acc bsl 1) + 1) + end. + + +getext(Bytes) when is_bitstring(Bytes) -> + getbit(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),<<ExtBits:ExtNum>>] + end. + +fixextensions(Pos,MaxPos,_,Acc) when Pos >= MaxPos -> + Acc; +fixextensions(Pos,ExtPos,Val,Acc) -> + Bit = case catch(element(Pos+1,Val)) of + asn1_NOVALUE -> + 0; + asn1_NOEXTVALUE -> + 0; + {'EXIT',_} -> + 0; + _ -> + 1 + end, + fixextensions(Pos+1,ExtPos,Val,(Acc bsl 1)+Bit). + +skipextensions(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}). + + +%%%%%%%%%%%%%%% +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 is_bitstring(Bytes) -> + <<BS:Num/bitstring,Rest/bitstring>> = Bytes, + {BS,Rest}. + +getbits_as_list(Num,Bytes) when is_bitstring(Bytes) -> + <<BitStr:Num/bitstring,Rest/bitstring>> = Bytes, + {[ B || <<B:1>> <= BitStr],Rest}. + +getbit(Buffer) -> + <<B:1,Rest/bitstring>> = Buffer, + {B,Rest}. + + +getbits(Buffer,Num) when is_bitstring(Buffer) -> + <<Bs:Num,Rest/bitstring>> = Buffer, + {Bs,Rest}. + + + +%% Pick the first Num octets. +%% Returns octets as an integer with bit significance as in buffer. +getoctets(Buffer,Num) when is_bitstring(Buffer) -> + <<Val:Num/integer-unit:8,RestBitStr/bitstring>> = Buffer, + {Val,RestBitStr}. + +%% Pick the first Num octets. +%% Returns octets as a binary +getoctets_as_bin(Bin,Num) when is_bitstring(Bin) -> + <<Octets:Num/binary,RestBin/bitstring>> = Bin, + {Octets,RestBin}. + +%% same as above but returns octets as a List +getoctets_as_list(Buffer,Num) -> + {Bin,Buffer2} = getoctets_as_bin(Buffer,Num), + {binary_to_list(Bin),Buffer2}. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% set_choice(Alt,Choices,Altnum) -> ListofBitSettings +%% Alt = atom() +%% Altnum = integer() | {integer(),integer()}% number of alternatives +%% Choices = [atom()] | {[atom()],[atom()]} +%% When Choices is a tuple the first list is the Rootset and the +%% second is the Extensions and then Altnum must also be a tuple with the +%% lengths of the 2 lists +%% +set_choice(Alt,{L1,L2},{Len1,_Len2}) -> + case set_choice_tag(Alt,L1) of + N when is_integer(N), Len1 > 1 -> + [<<0:1>>, % the value is in the root set + encode_integer([{'ValueRange',{0,Len1-1}}],N)]; + N when is_integer(N) -> + <<0:1>>; % no encoding if only 0 or 1 alternative + false -> + [<<1:1>>, % extension value + case set_choice_tag(Alt,L2) of + N2 when is_integer(N2) -> + encode_small_number(N2); + false -> + unknown_choice_alt + end] + end; +set_choice(Alt,L,Len) -> + case set_choice_tag(Alt,L) of + N when is_integer(N), Len > 1 -> + encode_integer([{'ValueRange',{0,Len-1}}],N); + N when is_integer(N) -> + []; % no encoding if only 0 or 1 alternative + false -> + [unknown_choice_alt] + end. + +set_choice_tag(Alt,Choices) -> + set_choice_tag(Alt,Choices,0). + +set_choice_tag(Alt,[Alt|_Rest],Tag) -> + Tag; +set_choice_tag(Alt,[_H|Rest],Tag) -> + set_choice_tag(Alt,Rest,Tag+1); +set_choice_tag(_Alt,[],_Tag) -> + false. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_fragmented_XXX; decode of values encoded fragmented according +%% to ITU-T X.691 clause 10.9.3.8. The unit (XXX) is either bits, octets, +%% characters or number of components (in a choice,sequence or similar). +%% Buffer is a buffer {Used, Bin}. +%% C is the constrained length. +%% If the buffer is not aligned, this function does that. +decode_fragmented_bits(Buffer,C) -> + decode_fragmented_bits(Buffer,C,[]). +decode_fragmented_bits(<<3:2,Len:6,BitStr/bitstring>>,C,Acc) -> +%% {Value,Bin2} = split_binary(Bin, Len * ?'16K'), + FragLen = (Len*?'16K') div 8, + <<Value:FragLen/binary,BitStr2/bitstring>> = BitStr, + decode_fragmented_bits(BitStr2,C,[Value|Acc]); +decode_fragmented_bits(<<0:1,0:7,BitStr/bitstring>>,C,Acc) -> + BinBits = list_to_binary(lists:reverse(Acc)), + case C of + Int when is_integer(Int),C == size(BinBits) -> + {BinBits,BitStr}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,BinBits}}}) + end; +decode_fragmented_bits(<<0:1,Len:7,BitStr/bitstring>>,C,Acc) -> + <<Val:Len/bitstring,Rest/bitstring>> = BitStr, +%% <<Value:Len/binary-unit:1,Bin2/binary>> = Bin, + ResBitStr = list_to_bitstring(lists:reverse([Val|Acc])), + case C of + Int when is_integer(Int),C == bit_size(ResBitStr) -> + {ResBitStr,Rest}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,ResBitStr}}}) + end. + + +decode_fragmented_octets({0,Bin},C) -> + decode_fragmented_octets(Bin,C,[]). + +decode_fragmented_octets(<<3:2,Len:6,BitStr/bitstring>>,C,Acc) -> + FragLen = Len * ?'16K', + <<Value:FragLen/binary,Rest/bitstring>> = BitStr, + decode_fragmented_octets(Rest,C,[Value|Acc]); +decode_fragmented_octets(<<0:1,0:7,Bin/bitstring>>,C,Acc) -> + Octets = list_to_binary(lists:reverse(Acc)), + case C of + Int when is_integer(Int), C == size(Octets) -> + {Octets,Bin}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,Octets}}}) + end; +decode_fragmented_octets(<<0:1,Len:7,BitStr/bitstring>>,C,Acc) -> + <<Value:Len/binary-unit:8,BitStr2/binary>> = BitStr, + BinOctets = list_to_binary(lists:reverse([Value|Acc])), + case C of + Int when is_integer(Int),size(BinOctets) == Int -> + {BinOctets,BitStr2}; + Int when is_integer(Int) -> + exit({error,{asn1,{illegal_value,C,BinOctets}}}) + 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 is_list(Val) -> + encode_open_type(C, list_to_binary(Val)); +encode_open_type(_C, Val) when is_binary(Val) -> + [encode_length(undefined,size(Val)),Val]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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 is_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 is_integer(V) -> + encode_integer(C,V); +encode_integer(C,{Name,V},NamedNumberList) when is_atom(Name) -> + encode_integer(C,V,NamedNumberList). + +encode_integer(C,{Name,Val}) when is_atom(Name) -> + encode_integer(C,Val); + +encode_integer([{Rc,_Ec}],Val) when is_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,_}}} -> + [<<1:1>>,encode_unconstrained_number(Val)]; + Encoded -> + [<<0:1>>,Encoded] + end; +encode_integer(C,Val ) when is_list(C) -> + case get_constraint(C,'SingleValue') of + no -> + encode_integer1(C,Val); + V when is_integer(V),V == Val -> + []; % a type restricted to a single value encodes to nothing + V when is_list(V) -> + case lists:member(Val,V) of + true -> + encode_integer1(C,Val); + _ -> + exit({error,{asn1,{illegal_value,Val}}}) + end; + _ -> + exit({error,{asn1,{illegal_value,Val}}}) + end. + +encode_integer1(C, Val) -> + case VR = get_constraint(C,'ValueRange') of + no -> + encode_unconstrained_number(Val); + {Lb,'MAX'} -> + encode_semi_constrained_number(Lb,Val); + %% positive with range + {Lb,Ub} when Val >= Lb, + Ub >= Val -> + encode_constrained_number(VR,Val); + _ -> + exit({error,{asn1,{illegal_value,VR,Val}}}) + end. + +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 is_tuple(Rc) -> + {Ext,Buffer2} = getext(Buffer), + case Ext of + 0 -> decode_integer(Buffer2,[Rc]); %% Value in root of constraint + 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 is_integer(V) -> + {V,Buffer}; + V when is_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 is_atom(Name) -> + encode_small_number(Val); +encode_small_number(Val) when Val =< 63 -> + <<Val:7>>; +encode_small_number(Val) -> + [<<1:1>>,encode_semi_constrained_number(0,Val)]. + +decode_small_number(Bytes) -> + {Bit,Bytes2} = getbit(Bytes), + case Bit of + 0 -> + getbits(Bytes2,6); + 1 -> + decode_semi_constrained_number(Bytes2,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 is_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) -> + %% encoding in minimum no of octets preceeded by a length + Val2 = Val - Lb, +%% NumBits = num_bits(Val2), + Bin = eint_bin_positive(Val2), + Size = size(Bin), + if + Size < 128 -> + [<<Size>>,Bin]; % equiv with encode_length(undefined,Len) but faster + Size < 16384 -> + [<<2:2,Size:14>>,Bin]; + true -> + [encode_length(undefined,Size),Bin] + 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 is_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, + NumBits = num_bits(Range), + <<Val2:NumBits>>; +encode_constrained_number(Range,Val) -> + exit({error,{asn1,{integer_range,Range,value,Val}}}). + + +decode_constrained_number(Buffer,{Lb,Ub}) -> + Range = Ub - Lb + 1, + NumBits = num_bits(Range), + {Val,Remain} = getbits(Buffer,NumBits), + {Val+Lb,Remain}. + +%% X.691:10.8 Encoding of an unconstrained whole number + +encode_unconstrained_number(Val) when Val >= 0 -> + Oct = eint_bin_2Cs(Val), + Len = size(Oct), + if + Len < 128 -> + [<<Len>>,Oct]; % equiv with encode_length(undefined,Len) but faster + Len < 16384 -> + [<<2:2,Len:14>>,Oct]; + true -> + [encode_length(undefined,Len),<<Len:16>>,Oct] + end; +encode_unconstrained_number(Val) -> % negative + Oct = enint(Val,[]), + Len = size(Oct), + if + Len < 128 -> + [<<Len>>,Oct]; % equiv with encode_length(undefined,Len) but faster + Len < 16384 -> + [<<2:2,Len:14>>,Oct]; + true -> + [encode_length(undefined,Len),Oct] + end. + + +eint_bin_2Cs(Int) -> + case eint_bin_positive(Int) of + Bin = <<B,_/binary>> when B > 16#7f -> + <<0,Bin/binary>>; + Bin -> Bin + end. + +%% returns the integer as a binary +eint_bin_positive(Val) when Val < 16#100 -> + <<Val>>; +eint_bin_positive(Val) when Val < 16#10000 -> + <<Val:16>>; +eint_bin_positive(Val) when Val < 16#1000000 -> + <<Val:24>>; +eint_bin_positive(Val) when Val < 16#100000000 -> + <<Val:32>>; +eint_bin_positive(Val) -> + list_to_binary([eint_bin_positive2(Val bsr 32)|<<Val:32>>]). +eint_bin_positive2(Val) when Val < 16#100 -> + <<Val>>; +eint_bin_positive2(Val) when Val < 16#10000 -> + <<Val:16>>; +eint_bin_positive2(Val) when Val < 16#1000000 -> + <<Val:24>>; +eint_bin_positive2(Val) when Val < 16#100000000 -> + <<Val:32>>; +eint_bin_positive2(Val) -> + [eint_bin_positive2(Val bsr 32)|<<Val:32>>]. + + + + +enint(-1, [B1|T]) when B1 > 127 -> + list_to_binary([B1|T]); +enint(N, Acc) -> + enint(N bsr 8, [N band 16#ff|Acc]). + +decode_unconstrained_number(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {Ints,Bytes3} = getoctets_as_bin(Bytes2,Len), + {dec_integer(Ints),Bytes3}. + +dec_integer(Bin = <<0:1,_:7,_/bitstring>>) -> + decpint(Bin); +dec_integer(<<_:1,B:7,BitStr/bitstring>>) -> + Size = bit_size(BitStr), + <<I:Size>> = BitStr, + (-128 + B) bsl bit_size(BitStr) bor I. + +decpint(Bin) -> + Size = bit_size(Bin), + <<Int:Size>> = Bin, + Int. + + +%% 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 -> + <<Len>>; + Len < 16384 -> + <<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 is_integer(Lb), Lb >= 0 -> % Ub > 65535 + encode_length(undefined,Len); +encode_length({Vr={Lb,Ub},Ext},Len) + when Ub =< 65535 ,Lb >= 0, Len=<Ub, is_list(Ext) -> + %% constrained extensible + [<<0:1>>,encode_constrained_number(Vr,Len)]; +encode_length({{Lb,_Ub},Ext},Len) when is_list(Ext) -> + [<<1:1>>,encode_semi_constrained_number(Lb,Len)]; +encode_length(SingleValue,_Len) when is_integer(SingleValue) -> + []. + +%% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension +%% additions in a sequence or set +encode_small_length(Len) when Len =< 64 -> + <<(Len-1):7>>; +encode_small_length(Len) -> + [<<1:1>>,encode_length(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). + +%% un-constrained +decode_length(<<0:1,Oct:7,Rest/bitstring>>,undefined) -> + {Oct,Rest}; +decode_length(<<2:2,Val:14,Rest/bitstring>>,undefined) -> + {Val,Rest}; +decode_length(<<3:2,_:14,_Rest/bitstring>>,undefined) -> + exit({error,{asn1,{decode_length,{nyi,above_16k}}}}); + +decode_length(Buffer,{Lb,Ub}) when Ub =< 65535 ,Lb >= 0 -> % constrained + decode_constrained_number(Buffer,{Lb,Ub}); +decode_length(Buffer,{Lb,_}) when is_integer(Lb), Lb >= 0 -> % Ub > 65535 + decode_length(Buffer,undefined); +decode_length(Buffer,{VR={_Lb,_Ub},Ext}) when is_list(Ext) -> + {0,Buffer2} = getbit(Buffer), + decode_length(Buffer2, VR); + + +%When does this case occur with {_,_Lb,Ub} ?? +% X.691:10.9.3.5 +decode_length(Bin,{_,_Lb,_Ub}) -> %when Len =< 127 -> % Unconstrained or large Ub NOTE! this case does not cover case when Ub > 65535 + case Bin of + <<0:1,Val:7,Rest/bitstring>> -> + {Val,Rest}; + <<2:2,Val:14,Rest/bitstring>> -> + {Val,Rest}; + <<3:2,_:14,_Rest/bitstring>> -> + exit({error,{asn1,{decode_length,{nyi,length_above_64K}}}}) + end; +decode_length(Buffer,SingleValue) when is_integer(SingleValue) -> + {SingleValue,Buffer}. + + + % X.691:11 +encode_boolean(true) -> + <<1:1>>; +encode_boolean(false) -> + <<0:1>>; +encode_boolean({Name,Val}) when is_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 is_tuple(Ntup1), is_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 is_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 is_atom(NewVal) -> {NewVal,Buffer3}; + _ -> {{asn1_enum,Val},Buffer3} + end + end; + +decode_enumerated(Buffer,C,NamedNumberTup) when is_tuple(NamedNumberTup) -> + {Val,Buffer2} = decode_integer(Buffer,C), + case catch (element(Val+1,NamedNumberTup)) of + NewVal when is_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 is_integer(Unused), + is_binary(BinBits) -> + encode_bin_bit_string(get_constraint(C,'SizeConstraint'),Bin,NamedBitList); + +encode_bit_string(C, BitListVal, NamedBitList) -> + encode_bit_string1(get_constraint(C,'SizeConstraint'), BitListVal, NamedBitList). +%% when the value is a list of named bits +encode_bit_string1(C, LoNB=[FirstVal | _RestVal], NamedBitList) when is_atom(FirstVal) -> + ToSetPos = get_all_bitposes(LoNB, NamedBitList, []), + BitList = make_and_set_list(ToSetPos,0), + encode_bit_string1(C,BitList,NamedBitList); + +encode_bit_string1(C, BL=[{bit,_No} | _RestVal], NamedBitList) -> + ToSetPos = get_all_bitposes(BL, NamedBitList, []), + BitList = make_and_set_list(ToSetPos,0), + encode_bit_string1(C,BitList,NamedBitList); +%% when the value is a list of ones and zeroes +encode_bit_string1(Int, BitListValue, _) + when is_list(BitListValue),is_integer(Int) -> + %% The type is constrained by a single value size constraint + bit_list2bitstr(Int,BitListValue); +encode_bit_string1(no, BitListValue,[]) + when is_list(BitListValue) -> + Len = length(BitListValue), + [encode_length(undefined,Len),bit_list2bitstr(Len,BitListValue)]; +encode_bit_string1(C, BitListValue,[]) + when is_list(BitListValue) -> + Len = length(BitListValue), + [encode_length(C,Len),bit_list2bitstr(Len,BitListValue)]; +encode_bit_string1(no, BitListValue,_NamedBitList) + when is_list(BitListValue) -> + %% 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))), + Len = length(NewBitLVal), + [encode_length(undefined,Len),bit_list2bitstr(Len,NewBitLVal)]; +encode_bit_string1(C,BitListValue,_NamedBitList) + when is_list(BitListValue) ->% C = {_,'MAX'} + NewBitStr = bitstr_trailing_zeros(BitListValue,C), + [encode_length(C,bit_size(NewBitStr)),NewBitStr]; + + +%% when the value is an integer +encode_bit_string1(C, IntegerVal, NamedBitList) when is_integer(IntegerVal)-> + BitList = int_to_bitlist(IntegerVal), + encode_bit_string1(C,BitList,NamedBitList); + +%% when the value is a tuple +encode_bit_string1(C,{Name,Val}, NamedBitList) when is_atom(Name) -> + encode_bit_string1(C,Val,NamedBitList). + +bit_list2bitstr(Len,BitListValue) -> + case length(BitListValue) of + Len -> + << <<B:1>> ||B <- BitListValue>>; + L when L > Len -> % truncate + << << <<B:1>> ||B <- BitListValue>> :Len/bitstring>>; + L -> % Len > L -> pad + << << <<B:1>> ||B <- BitListValue>>/bitstring ,0:(Len-L)>> + end. + +adjust_trailing_zeros(Len,Bin) when Len == bit_size(Bin) -> + Bin; +adjust_trailing_zeros(Len,Bin) when Len > bit_size(Bin) -> + <<Bin/bitstring,0:(Len-bit_size(Bin))>>; +adjust_trailing_zeros(Len,Bin) -> + <<Bin:Len/bitstring>>. + +bitstr_trailing_zeros(BitList,C) when is_integer(C) -> + bitstr_trailing_zeros1(BitList,C,C); +bitstr_trailing_zeros(BitList,{Lb,Ub}) when is_integer(Lb) -> + bitstr_trailing_zeros1(BitList,Lb,Ub); +bitstr_trailing_zeros(BitList,{{Lb,Ub},_}) when is_integer(Lb) -> + bitstr_trailing_zeros1(BitList,Lb,Ub); +bitstr_trailing_zeros(BitList,_) -> + bit_list2bitstr(length(BitList),BitList). + +bitstr_trailing_zeros1(BitList,Lb,Ub) -> + case length(BitList) of + Lb -> bit_list2bitstr(Lb,BitList); + B when B<Lb -> bit_list2bitstr(Lb,BitList); + D -> F = fun(L,LB,LB,_,_)->bit_list2bitstr(LB,lists:reverse(L)); + ([0|R],L1,LB,UB,Fun)->Fun(R,L1-1,LB,UB,Fun); + (L,L1,_,UB,_)when L1 =< UB -> + bit_list2bitstr(L1,lists:reverse(L)); + (_,_L1,_,_,_) ->exit({error,{list_length_BIT_STRING, + BitList}}) end, + F(lists:reverse(BitList),D,Lb,Ub,F) + end. + +%% encode_bin_bit_string/3, when value is a tuple of Unused and BinBits. +%% Unused = integer(),i.e. number unused bits in least sign. byte of +%% BinBits = binary(). +encode_bin_bit_string(C,{_,BinBits},_NamedBitList) + when is_integer(C),C=<16 -> + adjust_trailing_zeros(C,BinBits); +encode_bin_bit_string(C,{_Unused,BinBits},_NamedBitList) + when is_integer(C) -> + adjust_trailing_zeros(C,BinBits); +encode_bin_bit_string(C,UnusedAndBin={_,_},NamedBitList) -> + %% removes all trailing bits if NamedBitList is not empty + BitStr = remove_trailing_bin(NamedBitList,UnusedAndBin), + case C of + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + [encode_length({Lb,Ub},bit_size(BitStr)),BitStr]; + no -> + [encode_length(undefined,bit_size(BitStr)),BitStr]; + Sc -> + [encode_length(Sc,bit_size(BitStr)),BitStr] + end. + + +remove_trailing_bin([], {Unused,Bin}) -> + BS = bit_size(Bin)-Unused, + <<BitStr:BS/bitstring,_:Unused>> = Bin, + BitStr; +remove_trailing_bin(_NamedNumberList,{_Unused,<<>>}) -> + <<>>; +remove_trailing_bin(NamedNumberList, {_Unused,Bin}) -> + Size = size(Bin)-1, + <<Bfront:Size/binary, LastByte:8>> = Bin, + + %% clear the Unused bits to be sure + Unused1 = trailingZeroesInNibble(LastByte band 15), + Unused2 = + case Unused1 of + 4 -> + 4 + trailingZeroesInNibble(LastByte bsr 4); + _ -> Unused1 + end, + case Unused2 of + 8 -> + remove_trailing_bin(NamedNumberList,{0,Bfront}); + _ -> + BS = bit_size(Bin) - Unused2, + <<BitStr:BS/bitstring,_:Unused2>> = Bin, + BitStr + end. + +trailingZeroesInNibble(0) -> + 4; +trailingZeroesInNibble(1) -> + 0; +trailingZeroesInNibble(2) -> + 1; +trailingZeroesInNibble(3) -> + 0; +trailingZeroesInNibble(4) -> + 2; +trailingZeroesInNibble(5) -> + 0; +trailingZeroesInNibble(6) -> + 1; +trailingZeroesInNibble(7) -> + 0; +trailingZeroesInNibble(8) -> + 3; +trailingZeroesInNibble(9) -> + 0; +trailingZeroesInNibble(10) -> + 1; +trailingZeroesInNibble(11) -> + 0; +trailingZeroesInNibble(12) -> %#1100 + 2; +trailingZeroesInNibble(13) -> + 0; +trailingZeroesInNibble(14) -> + 1; +trailingZeroesInNibble(15) -> + 0. + +%%%%%%%%%%%%%%% +%% The result is presented as a list of named bits (if possible) +%% else as a tuple {Unused,Bits}. Unused is the number of unused +%% bits, least significant bits in the last byte of Bits. Bits is +%% the BIT STRING represented as a binary. +%% +decode_compact_bit_string(Buffer, C, NamedNumberList) -> + case get_constraint(C,'SizeConstraint') of + 0 -> % fixed length + {{8,0},Buffer}; + V when is_integer(V),V=<16 -> %fixed length 16 bits or less + compact_bit_string(Buffer,V,NamedNumberList); + V when is_integer(V),V=<65536 -> %fixed length > 16 bits + compact_bit_string(Buffer,V,NamedNumberList); + V when is_integer(V) -> % V > 65536 => fragmented value + {Bin,Buffer2} = decode_fragmented_bits(Buffer,V), + PadLen = (8 - (bit_size(Bin) rem 8)) rem 8, + {{PadLen,<<Bin/bitstring,0:PadLen>>},Buffer2}; +%% {0,_} -> {{0,Bin},Buffer2}; +%% {U,_} -> {{8-U,Bin},Buffer2} + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + %% This case may demand decoding of fragmented length/value + {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), + compact_bit_string(Bytes2,Len,NamedNumberList); + no -> + %% This case may demand decoding of fragmented length/value + {Len,Bytes2} = decode_length(Buffer,undefined), + compact_bit_string(Bytes2,Len,NamedNumberList); + Sc -> + {Len,Bytes2} = decode_length(Buffer,Sc), + compact_bit_string(Bytes2,Len,NamedNumberList) + end. + + +%%%%%%%%%%%%%%% +%% The result is presented as a list of named bits (if possible) +%% else as a list of 0 and 1. +%% +decode_bit_string(Buffer, C, NamedNumberList) -> + case get_constraint(C,'SizeConstraint') of + {Lb,Ub} when is_integer(Lb),is_integer(Ub) -> + {Len,Bytes2} = decode_length(Buffer,{Lb,Ub}), + bit_list_or_named(Bytes2,Len,NamedNumberList); + no -> + {Len,Bytes2} = decode_length(Buffer,undefined), + bit_list_or_named(Bytes2,Len,NamedNumberList); + 0 -> % fixed length + {[],Buffer}; % nothing to encode + V when is_integer(V),V=<16 -> % fixed length 16 bits or less + bit_list_or_named(Buffer,V,NamedNumberList); + V when is_integer(V),V=<65536 -> + bit_list_or_named(Buffer,V,NamedNumberList); + V when is_integer(V) -> + {BinBits,_} = decode_fragmented_bits(Buffer,V), + bit_list_or_named(BinBits,V,NamedNumberList); + Sc -> % extension marker + {Len,Bytes2} = decode_length(Buffer,Sc), + bit_list_or_named(Bytes2,Len,NamedNumberList) + end. + + +%% if no named bits are declared we will return a +%% {Unused,Bits}. Unused = integer(), +%% Bits = binary(). +compact_bit_string(Buffer,Len,[]) -> + {BitStr,Rest} = getbits_as_binary(Len,Buffer), % {{Unused,BinBits},NewBuffer} + PadLen = (8 - (bit_size(BitStr) rem 8)) rem 8, + {{PadLen,<<BitStr/bitstring,0:PadLen>>},Rest}; +compact_bit_string(Buffer,Len,NamedNumberList) -> + bit_list_or_named(Buffer,Len,NamedNumberList). + + +%% if no named bits are declared we will return a +%% BitList = [0 | 1] + +bit_list_or_named(Buffer,Len,[]) -> + getbits_as_list(Len,Buffer); + +%% if there are named bits declared we will return a named +%% BitList where the names are atoms and unnamed bits represented +%% as {bit,Pos} +%% BitList = [atom() | {bit,Pos}] +%% Pos = integer() + +bit_list_or_named(Buffer,Len,NamedNumberList) -> + {BitList,Rest} = getbits_as_list(Len,Buffer), + {bit_list_or_named1(0,BitList,NamedNumberList,[]), Rest}. + +bit_list_or_named1(Pos,[0|Bt],Names,Acc) -> + bit_list_or_named1(Pos+1,Bt,Names,Acc); +bit_list_or_named1(Pos,[1|Bt],Names,Acc) -> + case lists: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 is_integer(Int), Int > 0 -> + [Int band 1 | int_to_bitlist(Int bsr 1)]; +int_to_bitlist(0) -> + []. + + +%%%%%%%%%%%%%%%%%% +%% get_all_bitposes([list of named bits to set], named_bit_db, []) -> +%% [sorted_list_of_bitpositions_to_set] + +get_all_bitposes([{bit,ValPos}|Rest], NamedBitList, Ack) -> + get_all_bitposes(Rest, NamedBitList, [ValPos | Ack ]); + +get_all_bitposes([Val | Rest], NamedBitList, Ack) -> + case lists: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([], _) -> + []. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% X.691:16 +%% encode_octet_string(Constraint,Val) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +encode_octet_string(C,{_Name,Val}) -> + encode_octet_string(C,Val); +encode_octet_string(C,Val) -> + case get_constraint(C,'SizeConstraint') of + 0 -> + <<>>; + 1 -> + list_to_binary(Val); + 2 -> + list_to_binary(Val); + Sv when Sv =<65535, Sv == length(Val) -> % fixed length + list_to_binary(Val); + VR = {_,_} -> + [encode_length(VR,length(Val)),list_to_binary(Val)]; + Sv when is_list(Sv) -> + [encode_length({hd(Sv),lists:max(Sv)},length(Val)),list_to_binary(Val)]; + no -> + [encode_length(undefined,length(Val)),list_to_binary(Val)] + end. + +decode_octet_string(Bytes,C) -> + decode_octet_string1(Bytes,get_constraint(C,'SizeConstraint')). +decode_octet_string1(<<B1,Bytes/bitstring>>,1) -> + {[B1],Bytes}; +decode_octet_string1(<<B1,B2,Bytes/bitstring>>,2) -> + {[B1,B2],Bytes}; +decode_octet_string1(Bytes,Sv) when is_integer(Sv),Sv=<65535 -> + getoctets_as_list(Bytes,Sv); +decode_octet_string1(Bytes,Sv) when is_integer(Sv) -> + decode_fragmented_octets(Bytes,Sv); +decode_octet_string1(Bytes,{Lb,Ub}) -> + {Len,Bytes2} = decode_length(Bytes,{Lb,Ub}), + getoctets_as_list(Bytes2,Len); +decode_octet_string1(Bytes,Sv) when is_list(Sv) -> + {Len,Bytes2} = decode_length(Bytes,{hd(Sv),lists:max(Sv)}), + getoctets_as_list(Bytes2,Len); +decode_octet_string1(Bytes,no) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + getoctets_as_list(Bytes2,Len). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Restricted char string types +%% (NumericString, PrintableString,VisibleString,IA5String,BMPString,UniversalString) +%% X.691:26 and X.680:34-36 +%%encode_restricted_string('BMPString',Constraints,Extension,Val) + + +encode_restricted_string({Name,Val}) when is_atom(Name) -> + encode_restricted_string(Val); + +encode_restricted_string(Val) when is_list(Val)-> + [encode_length(undefined,length(Val)),list_to_binary(Val)]. + +encode_known_multiplier_string(StringType,C,{Name,Val}) when is_atom(Name) -> + encode_known_multiplier_string(StringType,C,Val); + +encode_known_multiplier_string(StringType,C,Val) -> + Result = chars_encode(C,StringType,Val), + NumBits = get_NumBits(C,StringType), + case get_constraint(C,'SizeConstraint') of + Ub when is_integer(Ub), Ub*NumBits =< 16 -> + Result; + 0 -> + []; + Ub when is_integer(Ub),Ub =<65535 -> % fixed length + Result; + {Ub,Lb} -> + [encode_length({Ub,Lb},length(Val)),Result]; + Vl when is_list(Vl) -> + [encode_length({lists:min(Vl),lists:max(Vl)},length(Val)),Result]; + no -> + [encode_length(undefined,length(Val)),Result] + end. + +decode_restricted_string(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + getoctets_as_list(Bytes2,Len). + +decode_known_multiplier_string(Bytes,StringType,C,_Ext) -> + NumBits = get_NumBits(C,StringType), + case get_constraint(C,'SizeConstraint') of + Ub when is_integer(Ub), Ub*NumBits =< 16 -> + chars_decode(Bytes,NumBits,StringType,C,Ub); + Ub when is_integer(Ub),Ub =<65535 -> % fixed length + chars_decode(Bytes,NumBits,StringType,C,Ub); + 0 -> + {[],Bytes}; + Vl when is_list(Vl) -> + {Len,Bytes1} = decode_length(Bytes,{hd(Vl),lists:max(Vl)}), + chars_decode(Bytes1,NumBits,StringType,C,Len); + no -> + {Len,Bytes1} = decode_length(Bytes,undefined), + chars_decode(Bytes1,NumBits,StringType,C,Len); + {Lb,Ub}-> + {Len,Bytes1} = decode_length(Bytes,{Lb,Ub}), + chars_decode(Bytes1,NumBits,StringType,C,Len) + end. + + +encode_NumericString(C,Val) -> + encode_known_multiplier_string('NumericString',C,Val). +decode_NumericString(Bytes,C) -> + decode_known_multiplier_string(Bytes,'NumericString',C,false). + +encode_PrintableString(C,Val) -> + encode_known_multiplier_string('PrintableString',C,Val). +decode_PrintableString(Bytes,C) -> + decode_known_multiplier_string(Bytes,'PrintableString',C,false). + +encode_VisibleString(C,Val) -> % equivalent with ISO646String + encode_known_multiplier_string('VisibleString',C,Val). +decode_VisibleString(Bytes,C) -> + decode_known_multiplier_string(Bytes,'VisibleString',C,false). + +encode_IA5String(C,Val) -> + encode_known_multiplier_string('IA5String',C,Val). +decode_IA5String(Bytes,C) -> + decode_known_multiplier_string(Bytes,'IA5String',C,false). + +encode_BMPString(C,Val) -> + encode_known_multiplier_string('BMPString',C,Val). +decode_BMPString(Bytes,C) -> + decode_known_multiplier_string(Bytes,'BMPString',C,false). + +encode_UniversalString(C,Val) -> + encode_known_multiplier_string('UniversalString',C,Val). +decode_UniversalString(Bytes,C) -> + decode_known_multiplier_string(Bytes,'UniversalString',C,false). + + +%% end of known-multiplier strings for which PER visible constraints are +%% applied + +encode_GeneralString(_C,Val) -> + encode_restricted_string(Val). +decode_GeneralString(Bytes,_C) -> + decode_restricted_string(Bytes). + +encode_GraphicString(_C,Val) -> + encode_restricted_string(Val). +decode_GraphicString(Bytes,_C) -> + decode_restricted_string(Bytes). + +encode_ObjectDescriptor(_C,Val) -> + encode_restricted_string(Val). +decode_ObjectDescriptor(Bytes) -> + decode_restricted_string(Bytes). + +encode_TeletexString(_C,Val) -> % equivalent with T61String + encode_restricted_string(Val). +decode_TeletexString(Bytes,_C) -> + decode_restricted_string(Bytes). + +encode_VideotexString(_C,Val) -> + encode_restricted_string(Val). +decode_VideotexString(Bytes,_C) -> + decode_restricted_string(Bytes). + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% getBMPChars(Bytes,Len) ->{BMPcharList,RemainingBytes} +%% +getBMPChars(Bytes,1) -> + {O1,Bytes2} = getbits(Bytes,8), + {O2,Bytes3} = getbits(Bytes2,8), + if + O1 == 0 -> + {[O2],Bytes3}; + true -> + {[{0,0,O1,O2}],Bytes3} + end; +getBMPChars(Bytes,Len) -> + getBMPChars(Bytes,Len,[]). + +getBMPChars(Bytes,0,Acc) -> + {lists:reverse(Acc),Bytes}; +getBMPChars(Bytes,Len,Acc) -> + {Octs,Bytes1} = getoctets_as_list(Bytes,2), + case Octs of + [0,O2] -> + getBMPChars(Bytes1,Len-1,[O2|Acc]); + [O1,O2]-> + getBMPChars(Bytes1,Len-1,[{0,0,O1,O2}|Acc]) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% chars_encode(C,StringType,Value) -> ValueList +%% +%% encodes chars according to the per rules taking the constraint PermittedAlphabet +%% into account. +%% This function does only encode the value part and NOT the length + +chars_encode(C,StringType,Value) -> + case {StringType,get_constraint(C,'PermittedAlphabet')} of + {'UniversalString',{_,_Sv}} -> + exit({error,{asn1,{'not implemented',"UniversalString with PermittedAlphabet constraint"}}}); + {'BMPString',{_,_Sv}} -> + exit({error,{asn1,{'not implemented',"BMPString with PermittedAlphabet constraint"}}}); + _ -> + {NumBits,CharOutTab} = {get_NumBits(C,StringType),get_CharOutTab(C,StringType)}, + chars_encode2(Value,NumBits,CharOutTab) + end. + +chars_encode2([H|T],NumBits,{Min,Max,notab}) when H =< Max, H >= Min -> + %%[{bits,NumBits,H-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; + [<<(H-Min):NumBits>>|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})]; + Ch = exit_if_false(H,element(H-Min+1,Tab)), + [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,Tab})]; +chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,notab}) -> + %% no value range check here (ought to be, but very expensive) +%% [{bits,NumBits,((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min}|chars_encode2(T,NumBits,{Min,Max,notab})]; + Ch = ((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min, + [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; +chars_encode2([{A,B,C,D}|T],NumBits,{Min,Max,Tab}) -> + %% no value range check here (ought to be, but very expensive) +%% [{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})]; + Ch = exit_if_false({A,B,C,D},element(((((((A bsl 8)+B) bsl 8)+C) bsl 8)+D)-Min,Tab)), + [<<Ch:NumBits>>|chars_encode2(T,NumBits,{Min,Max,notab})]; +chars_encode2([H|_T],_,{_,_,_}) -> + exit({error,{asn1,{illegal_char_value,H}}}); +chars_encode2([],_,_) -> + []. + +exit_if_false(V,false)-> + exit({error,{asn1,{"illegal value according to Permitted alphabet constraint",V}}}); +exit_if_false(_,V) ->V. + + +get_NumBits(C,StringType) -> + case get_constraint(C,'PermittedAlphabet') of + {'SingleValue',Sv} -> + charbits(length(Sv)); + no -> + case StringType of + 'IA5String' -> + charbits(128); % 16#00..16#7F + 'VisibleString' -> + charbits(95); % 16#20..16#7E + 'PrintableString' -> + charbits(74); % [$\s,$',$(,$),$+,$,,$-,$.,$/,"0123456789",$:,$=,$?,$A..$Z,$a..$z + 'NumericString' -> + charbits(11); % $ ,"0123456789" + 'UniversalString' -> + 32; + 'BMPString' -> + 16 + end + end. + +get_CharOutTab(C,StringType) -> + get_CharTab(C,StringType,out). + +get_CharInTab(C,StringType) -> + get_CharTab(C,StringType,in). + +get_CharTab(C,StringType,InOut) -> + case get_constraint(C,'PermittedAlphabet') of + {'SingleValue',Sv} -> + get_CharTab2(C,StringType,hd(Sv),lists:max(Sv),Sv,InOut); + no -> + case StringType of + 'IA5String' -> + {0,16#7F,notab}; + 'VisibleString' -> + get_CharTab2(C,StringType,16#20,16#7F,notab,InOut); + 'PrintableString' -> + Chars = lists:sort( + " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), + get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars,InOut); + 'NumericString' -> + get_CharTab2(C,StringType,16#20,$9," 0123456789",InOut); + 'UniversalString' -> + {0,16#FFFFFFFF,notab}; + 'BMPString' -> + {0,16#FFFF,notab} + end + end. + +get_CharTab2(C,StringType,Min,Max,Chars,InOut) -> + BitValMax = (1 bsl get_NumBits(C,StringType))-1, + if + Max =< BitValMax -> + {0,Max,notab}; + true -> + case InOut of + out -> + {Min,Max,create_char_tab(Min,Chars)}; + in -> + {Min,Max,list_to_tuple(Chars)} + end + end. + +create_char_tab(Min,L) -> + list_to_tuple(create_char_tab(Min,L,0)). +create_char_tab(Min,[Min|T],V) -> + [V|create_char_tab(Min+1,T,V+1)]; +create_char_tab(_Min,[],_V) -> + []; +create_char_tab(Min,L,V) -> + [false|create_char_tab(Min+1,L,V)]. + +%% See Table 20.3 in Dubuisson +charbits(NumOfChars) when NumOfChars =< 2 -> 1; +charbits(NumOfChars) when NumOfChars =< 4 -> 2; +charbits(NumOfChars) when NumOfChars =< 8 -> 3; +charbits(NumOfChars) when NumOfChars =< 16 -> 4; +charbits(NumOfChars) when NumOfChars =< 32 -> 5; +charbits(NumOfChars) when NumOfChars =< 64 -> 6; +charbits(NumOfChars) when NumOfChars =< 128 -> 7; +charbits(NumOfChars) when NumOfChars =< 256 -> 8; +charbits(NumOfChars) when NumOfChars =< 512 -> 9; +charbits(NumOfChars) when NumOfChars =< 1024 -> 10; +charbits(NumOfChars) when NumOfChars =< 2048 -> 11; +charbits(NumOfChars) when NumOfChars =< 4096 -> 12; +charbits(NumOfChars) when NumOfChars =< 8192 -> 13; +charbits(NumOfChars) when NumOfChars =< 16384 -> 14; +charbits(NumOfChars) when NumOfChars =< 32768 -> 15; +charbits(NumOfChars) when NumOfChars =< 65536 -> 16; +charbits(NumOfChars) when is_integer(NumOfChars) -> + 16 + charbits1(NumOfChars bsr 16). + +charbits1(0) -> + 0; +charbits1(NumOfChars) -> + 1 + charbits1(NumOfChars bsr 1). + + +chars_decode(Bytes,_,'BMPString',C,Len) -> + case get_constraint(C,'PermittedAlphabet') of + no -> + getBMPChars(Bytes,Len); + _ -> + exit({error,{asn1, + {'not implemented', + "BMPString with PermittedAlphabet constraint"}}}) + end; +chars_decode(Bytes,NumBits,StringType,C,Len) -> + CharInTab = get_CharInTab(C,StringType), + chars_decode2(Bytes,CharInTab,NumBits,Len). + + +chars_decode2(Bytes,CharInTab,NumBits,Len) -> + chars_decode2(Bytes,CharInTab,NumBits,Len,[]). + +chars_decode2(Bytes,_CharInTab,_NumBits,0,Acc) -> + {lists:reverse(Acc),Bytes}; +chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) when NumBits > 8 -> + {Char,Bytes2} = getbits(Bytes,NumBits), + Result = + if + Char < 256 -> Char; + true -> + list_to_tuple(binary_to_list(<<Char:32>>)) + end, + chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Result|Acc]); +chars_decode2(Bytes,{Min,Max,notab},NumBits,Len,Acc) -> + {Char,Bytes2} = getbits(Bytes,NumBits), + chars_decode2(Bytes2,{Min,Max,notab},NumBits,Len -1,[Char+Min|Acc]); + +%% BMPString and UniversalString with PermittedAlphabet is currently not supported +chars_decode2(Bytes,{Min,Max,CharInTab},NumBits,Len,Acc) -> + {Char,Bytes2} = getbits(Bytes,NumBits), + chars_decode2(Bytes2,{Min,Max,CharInTab},NumBits,Len -1,[element(Char+1,CharInTab)|Acc]). + + +%% UTF8String +encode_UTF8String(Val) when is_binary(Val) -> + [encode_length(undefined,size(Val)),Val]; +encode_UTF8String(Val) -> + Bin = list_to_binary(Val), + encode_UTF8String(Bin). + +decode_UTF8String(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + getoctets_as_bin(Bytes2,Len). + + + % X.691:17 +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 -> [binary()|bitstring()|list()] +%% +encode_object_identifier({Name,Val}) when is_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 + [encode_length(undefined,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 is_atom(Cname),is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); +e_object_identifier({Cname,V}) when is_atom(Cname),is_list(V) -> + e_object_identifier(V); +e_object_identifier(V) when is_tuple(V) -> + e_object_identifier(tuple_to_list(V)); + +%% E1 = 0|1|2 and (E2 < 40 when E1 = 0|1) +e_object_identifier([E1,E2|Tail]) when E1 >= 0, E1 < 2, E2 < 40 ; E1==2 -> + Head = 40*E1 + E2, % weird + e_object_elements([Head|Tail],[]); +e_object_identifier(Oid=[_,_|_Tail]) -> + exit({error,{asn1,{'illegal_value',Oid}}}). + +e_object_elements([],Acc) -> + lists:reverse(Acc); +e_object_elements([H|T],Acc) -> + e_object_elements(T,[e_object_element(H)|Acc]). + +e_object_element(Num) when Num < 128 -> + [Num]; +e_object_element(Num) -> + [e_o_e(Num bsr 7)|[Num band 2#1111111]]. +e_o_e(Num) when Num < 128 -> + Num bor 2#10000000; +e_o_e(Num) -> + [e_o_e(Num bsr 7)|[(Num band 2#1111111) bor 2#10000000]]. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_object_identifier(Bytes) -> {ObjId,RemainingBytes} +%% ObjId -> {integer(),integer(),...} % at least 2 integers +%% RemainingBytes -> [integer()] when integer() (0..255) +decode_object_identifier(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), + [First|Rest] = dec_subidentifiers(Octs,0,[]), + Idlist = if + First < 40 -> + [0,First|Rest]; + First < 80 -> + [1,First - 40|Rest]; + true -> + [2,First - 80|Rest] + end, + {list_to_tuple(Idlist),Bytes3}. + +dec_subidentifiers([H|T],Av,Al) when H >=16#80 -> + dec_subidentifiers(T,(Av bsl 7) + (H band 16#7F),Al); +dec_subidentifiers([H|T],Av,Al) -> + dec_subidentifiers(T,0,[(Av bsl 7) + H |Al]); +dec_subidentifiers([],_Av,Al) -> + lists:reverse(Al). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_relative_oid(Val) -> CompleteList +%% encode_relative_oid({Name,Val}) -> CompleteList +encode_relative_oid({Name,Val}) when is_atom(Name) -> + encode_relative_oid(Val); +encode_relative_oid(Val) when is_tuple(Val) -> + encode_relative_oid(tuple_to_list(Val)); +encode_relative_oid(Val) when is_list(Val) -> + Octets = list_to_binary([e_object_element(X)||X <- Val]), + [encode_length(undefined,size(Octets)),Octets]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_relative_oid(Val) -> CompleteList +%% decode_relative_oid({Name,Val}) -> CompleteList +decode_relative_oid(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + {Octs,Bytes3} = getoctets_as_list(Bytes2,Len), + ObjVals = dec_subidentifiers(Octs,0,[]), + {list_to_tuple(ObjVals),Bytes3}. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% encode_real(Val) -> CompleteList +%% encode_real({Name,Val}) -> CompleteList +encode_real({Name,Val}) when is_atom(Name) -> + encode_real(Val); +encode_real(Real) -> + {EncVal,Len} = ?RT_COMMON:encode_real([],Real), + [encode_length(undefined,Len),EncVal]. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% decode_real(Val) -> {REALvalue,Rest} +%% decode_real({Name,Val}) -> {REALvalue,Rest} +decode_real(Bytes) -> + {Len,Bytes2} = decode_length(Bytes,undefined), + <<Bytes3:Len/binary,Rest/bitstring>> = Bytes2, + {RealVal,Rest,Len} = ?RT_COMMON:decode_real(Bytes3,Len), + {RealVal,Rest}. + + +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(InList) when is_list(InList) -> + case complete1(InList) of + <<>> -> + <<0>>; + Res -> + case bit_size(Res) band 7 of + 0 -> Res; + Bits -> <<Res/bitstring,0:(8-Bits)>> + end + end; +complete(InList) when is_binary(InList) -> + InList; +complete(InList) when is_bitstring(InList) -> + PadLen = 8 - (bit_size(InList) band 7), + <<InList/bitstring,0:PadLen>>. + +complete1(L) when is_list(L) -> + list_to_bitstring(L). + +%% Special version of complete that does not align the completed message. +complete_NFP(InList) when is_list(InList) -> + list_to_bitstring(InList); +complete_NFP(InList) when is_bitstring(InList) -> + InList. + +%% unaligned helpers + +%% 10.5.6 NOTE: If "range" satisfies the inequality 2^m < "range" =< +%% 2^(m+1) then the number of bits = m + 1 +num_bits(1) -> 0; +num_bits(2) -> 1; +num_bits(R) when R =< 4 -> + 2; +num_bits(R) when R =< 8 -> + 3; +num_bits(R) when R =< 16 -> + 4; +num_bits(R) when R =< 32 -> + 5; +num_bits(R) when R =< 64 -> + 6; +num_bits(R) when R =< 128 -> + 7; +num_bits(R) when R =< 256 -> + 8; +num_bits(R) when R =< 512 -> + 9; +num_bits(R) when R =< 1024 -> + 10; +num_bits(R) -> + 1+num_bits(R bsr 1). diff --git a/lib/asn1/src/notes_history.sgml b/lib/asn1/src/notes_history.sgml new file mode 100644 index 0000000000..107459b37d --- /dev/null +++ b/lib/asn1/src/notes_history.sgml @@ -0,0 +1,100 @@ +<!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$ +--> +<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/asn1/src/notes_latest.sgml b/lib/asn1/src/notes_latest.sgml new file mode 100644 index 0000000000..5a397ecbc2 --- /dev/null +++ b/lib/asn1/src/notes_latest.sgml @@ -0,0 +1,100 @@ +<!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$ +--> +<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> + + + diff --git a/lib/asn1/vsn.mk b/lib/asn1/vsn.mk new file mode 100644 index 0000000000..c79d833320 --- /dev/null +++ b/lib/asn1/vsn.mk @@ -0,0 +1,315 @@ +#next version number to use is 1.6.13 | 1.7 | 2.0 +ASN1_VSN = 1.6.12 + +TICKETS = OTP-8256 + +TICKETS_1.6.12 = \ + OTP-8256 + +TICKETS_1.6.11 = \ + OTP-8136 \ + OTP-8047 \ + OTP-8046 \ + OTP-8043 \ + OTP-7972 + +TICKETS_1.6.10 = \ + OTP-7954 \ + OTP-7953 + +TICKETS_1.6.10 = \ + OTP-7954 \ + OTP-7953 + +TICKETS_1.6.9 = \ + OTP-7909 \ + OTP-7904 + +TICKETS_1.6.8.1 = \ + OTP-7900 \ + OTP-7910 + +TICKETS_1.6.8 = \ + OTP-7876 + +TICKETS_1.6.7 = \ + OTP-7801 \ + OTP-7806 + +TICKETS_1.6.6 = \ + OTP-7759 \ + OTP-7763 + +TICKETS_1.6.5 = \ + OTP-7734 + +TICKETS_1.6.4 = \ + OTP-7708 + +TICKETS_1.6.3 = \ + OTP-7681 \ + OTP-7678 + +TICKETS_1.6.2 = \ + OTP-7608 + +TICKETS_1.6.1 = \ + OTP-7602 \ + OTP-7533 \ + OTP-7476 \ + OTP-7334 \ + OTP-7332 \ + OTP-7322 \ + OTP-7306 \ + OTP-7299 \ + OTP-7295 \ + OTP-7204 \ + OTP-7174 \ + OTP-7166 + +TICKETS_1.6 = \ + OTP-7407 \ + OTP-7403 \ + OTP-7400 \ + OTP-7375 \ + OTP-7374 \ + OTP-7335 + +TICKETS_1.5.2 = \ + OTP-7263 \ + OTP-7264 \ + OTP-7268 \ + OTP-7269 \ + OTP-7273 + +TICKETS_1.5.1 = \ + OTP-7149 \ + OTP-7151 \ + OTP-7154 \ + OTP-7155 \ + OTP-7169 \ + OTP-7171 \ + OTP-7193 \ + OTP-7199 + +TICKETS_1.5 = \ + OTP-6835 \ + OTP-6882 + +TICKETS_1.4.7 = \ + OTP-6828 + +TICKETS_1.4.6 = \ + OTP-5067 \ + OTP-6763 \ + OTP-6769 \ + OTP-6770 \ + OTP-6786 + +TICKETS_1.4.5 = \ + OTP-6493 \ + OTP-6601 \ + OTP-6695 \ + OTP-6698 \ + OTP-6702 \ + OTP-6707 \ + OTP-6717 + +TICKETS_1.4.4.14 = \ + OTP-6462 \ + OTP-6506 + +TICKETS_1.4.4.13 = \ + OTP-6405 + +TICKETS_1.4.4.12 = \ + OTP-6314 + +TICKETS_1.4.4.11 = \ + OTP-6143 + +TICKETS_1.4.4.10 = \ + OTP-6111 \ + OTP-5932 + +TICKETS_1.4.4.9 = \ + OTP-5783 \ + OTP-5788 \ + OTP-5812 \ + OTP-5831 \ + OPT-5832 + +TICKETS_1.4.4.8 = \ + OTP-5687 \ + OTP-5688 \ + OTP-5689 \ + OTP-5701 \ + OTP-5710 + +TICKETS_1.4.4.7 = \ + OTP-5477 \ + OTP-5509 \ + OTP-5511 \ + OTP-5602 \ + OTP-5616 + +TICKETS_1.4.4.6 = \ + OTP-5457 \ + OTP-5466 + +TICKETS_1.4.4.5 = \ + OTP-5302 \ + OTP-5378 + +TICKETS_1.4.4.4 = \ + OTP-5240 \ + OTP-5243 + +TICKETS_1.4.4.3 = \ + OTP-5103 \ + OTP-5104 + +TICKETS_1.4.4.2 = \ + OTP-5022 + +TICKETS_1.4.4.1 = \ + OTP-4970 + +TICKETS_1.4.4 = \ + OTP-4893 \ + OTP-4894 \ + OTP-4895 \ + OTP-4917 \ + OTP-4918 \ + OTP-4919 \ + OTP-4944 \ + OTP-4953 \ + OTP-4955 \ + OTP-4957 \ + OTP-4965 + +TICKETS_1.4.3.1 = \ + OTP-4866 \ + OTP-4869 \ + OTP-4872 + +TICKETS_1.4.3 = \ + OTP-4832 \ + OTP-4833 \ + OTP-4835 \ + OTP-4856 + +TICKETS_1.4.2.1 = \ + OTP-4773 \ + OTP-4791 \ + OTP-4792 \ + OTP-4797 \ + OTP-4798 \ + OTP-4799 \ + OTP-4809 + +# OTP R9C +TICKETS_1.4.2 = \ + OTP-4693 \ + OTP-4744 + +TICKETS_1.4.1.1 = \ + OTP-4663 \ + OTP-4665 \ + OTP-4666 + +TICKETS_1.4.1 = \ + OTP-4559 \ + OTP-4560 \ + OTP-4590 \ + OTP-4591 \ + OTP-4592 \ + OTP-4631 \ + OTP-4633 + +TICKETS_1.4 = \ + OTP-3304 + +TICKETS_1.3.3.1 = \ + OTP-4353 \ + OTP-4354 \ + OTP-4390 \ + OTP-4395 + +TICKETS_1.3.3 = \ + OTP-4381 \ + OTP-4358 \ + OTP-4355 \ + OTP-4275 \ + OTP-4248 \ + OTP-4247 \ + OTP-4242 \ + OTP-4235 \ + OTP-4234 \ + OTP-4232 \ + OTP-4200 \ + OTP-4161 \ + OTP-4129 + +TICKETS_1.3.2 = \ + OTP-4094 \ + OTP-4103 \ + OTP-3980 \ + OTP-4073 + +TICKETS_1.3.1.1 = \ + OTP-4037 \ + OTP-4057 \ + OTP-4058 + +TICKETS_1.3.1 = \ + OTP-4025 \ + OTP-4026 + +TICKETS_1.3 = \ + OTP-3463 \ + OTP-3659 \ + OTP-3978 \ + OTP-3979 \ + OTP-3981 \ + OTP-3982 \ + OTP-3983 \ + OTP-3985 \ + OTP-3988 \ + OTP-3984 \ + OTP-3994 + +TICKETS_1.2.9.6 = \ + OTP-3830 + +TICKETS_1.2.9.5 = \ + OTP-3713 \ + OTP-3796 \ + OTP-3811 + +TICKETS_1.2.9.3 = \ + OTP-3700 \ + OTP-3701 + +TICKETS_1.2.9.2 = \ + OTP-xxxx + +TICKETS_1.2.9.1 = \ + OTP-xxxx + +TICKETS_1.2.9 = \ + OTP-3569 \ + OTP-3573 + +TICKETS_1.2.8 = \ + OTP-3496 + +TICKETS_1.2.7 = \ + OTP-3395 + +TICKETS_1.2.6 = \ + OTP-3352 + +TICKETS_1.2.5 = \ + OTP-3341 + |
