diff options
254 files changed, 17897 insertions, 12809 deletions
diff --git a/.gitignore b/.gitignore index a3e03dc46f..7ccedd3ff3 100644 --- a/.gitignore +++ b/.gitignore @@ -287,13 +287,13 @@ JAVADOC-GENERATED # otp_mibs -/lib/otp_mibs/include/[A-Z]*.hrl +/lib/otp_mibs/include/OTP*.hrl /lib/otp_mibs/mibs/v1/OTP*.mib.v1 /lib/otp_mibs/priv/mibs/OTP*.bin # os_mon -/lib/os_mon/include/[A-Z]*.hrl +/lib/os_mon/include/OTP*.hrl /lib/os_mon/mibs/v1/OTP*.mib.v1 /lib/os_mon/priv/mibs/OTP*.bin diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam Binary files differindex fd53a2e0f9..a4965abd48 100644 --- a/bootstrap/lib/compiler/ebin/beam_a.beam +++ b/bootstrap/lib/compiler/ebin/beam_a.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex 07f663b2c6..6f4180ee07 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex 8e531126d2..ecc8933bef 100644 --- a/bootstrap/lib/stdlib/ebin/erl_pp.beam +++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam diff --git a/erts/configure.in b/erts/configure.in index b9c9a76ef6..c47c211c4e 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -624,6 +624,7 @@ case $chk_arch_ in armv5teb) ARCH=arm;; armv5tel) ARCH=arm;; armv5tejl) ARCH=arm;; + armv6l) ARCH=arm;; armv7l) ARCH=arm;; tile) ARCH=tile;; *) ARCH=noarch;; diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index a68e62d051..8dca7402e8 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -657,10 +657,11 @@ <p>Se also <seealso marker="stdlib:io#printable_range/0"> io:printable_range/0</seealso>.</p> </item> - <tag><marker id="+P"/><marker id="max_processes"><c><![CDATA[+P Number]]></c></marker></tag> + <tag><marker id="+P"/><marker id="max_processes"><c><![CDATA[+P Number|legacy]]></c></marker></tag> <item> <p>Sets the maximum number of simultaneously existing processes for this - system. Valid range for <c>Number</c> is <c>[1024-134217727]</c></p> + system if a <c>Number</c> is passed as value. Valid range for + <c>Number</c> is <c>[1024-134217727]</c></p> <p><em>NOTE</em>: The actual maximum chosen may be much larger than the <c>Number</c> passed. Currently the runtime system often, but not always, chooses a value that is a power of 2. This might, @@ -668,11 +669,19 @@ checked by calling <seealso marker="erlang#system_info_process_limit">erlang:system_info(process_limit)</seealso>.</p> <p>The default value is <c>262144</c></p> + <p>If <c>legacy</c> is passed as value, the legacy algorithm for + allocation of process identifiers will be used. Using the legacy + algorithm, identifiers will be allocated in a strictly increasing + fashion until largest possible identifier has been reached. Note that + this algorithm suffers from performance issues and can under certain + circumstances be extremely expensive. The legacy algoritm is deprecated, + and the <c>legacy</c> option is scheduled for removal in OTP-R18.</p> </item> - <tag><marker id="+Q"/><marker id="max_ports"><c><![CDATA[+Q Number]]></c></marker></tag> + <tag><marker id="+Q"/><marker id="max_ports"><c><![CDATA[+Q Number|legacy]]></c></marker></tag> <item> <p>Sets the maximum number of simultaneously existing ports for this - system. Valid range for <c>Number</c> is <c>[1024-134217727]</c></p> + system if a Number is passed as value. Valid range for <c>Number</c> + is <c>[1024-134217727]</c></p> <p><em>NOTE</em>: The actual maximum chosen may be much larger than the actual <c>Number</c> passed. Currently the runtime system often, but not always, chooses a value that is a power of 2. This might, @@ -691,6 +700,13 @@ for setting the maximum number of simultaneously existing ports. This environment variable is deprecated, and scheduled for removal in OTP-R17, but can still be used.</p> + <p>If <c>legacy</c> is passed as value, the legacy algorithm for + allocation of port identifiers will be used. Using the legacy + algorithm, identifiers will be allocated in a strictly increasing + fashion until largest possible identifier has been reached. Note that + this algorithm suffers from performance issues and can under certain + circumstances be extremely expensive. The legacy algoritm is deprecated, + and the <c>legacy</c> option is scheduled for removal in OTP-R18.</p> </item> <tag><marker id="compat_rel"><c><![CDATA[+R ReleaseNumber]]></c></marker></tag> <item> diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml index c73cdfd290..2ffb55c6ab 100644 --- a/erts/doc/src/erts_alloc.xml +++ b/erts/doc/src/erts_alloc.xml @@ -75,10 +75,6 @@ segments are allocated, cached segments are used if possible instead of creating new segments. This in order to reduce the number of system calls made.</item> - <tag><c>sbmbc_alloc</c></tag> - <item>Allocator used by other allocators for allocation of carriers - where only small blocks are placed. Currently this allocator is - disabled by default.</item> </taglist> <p><c>sys_alloc</c> is always enabled and cannot be disabled. <c>mseg_alloc</c> is always enabled if it is @@ -86,9 +82,7 @@ allocators can be <seealso marker="#M_e">enabled or disabled</seealso>. By default all allocators are enabled. When an allocator is disabled, <c>sys_alloc</c> is used instead of - the disabled allocator. <c>sbmbc_alloc</c> is an exception. If - <c>sbmbc_alloc</c> is disabled, other allocators will not handle - small blocks in separate carriers.</p> + the disabled allocator.</p> <p>The main idea with the <c>erts_alloc</c> library is to separate memory blocks that are used differently into different memory areas, and by this achieving less memory fragmentation. By @@ -106,20 +100,15 @@ following does <em>not</em> apply to them.</p> <p>An allocator manages multiple areas, called carriers, in which memory blocks are placed. A carrier is either placed in a - separate memory segment (allocated via <c>mseg_alloc</c>), in - the heap segment (allocated via <c>sys_alloc</c>), or inside - another carrier (in case it is a carrier created by - <c>sbmbc_alloc</c>). Multiblock + separate memory segment (allocated via <c>mseg_alloc</c>), or in + the heap segment (allocated via <c>sys_alloc</c>). Multiblock carriers are used for storage of several blocks. Singleblock carriers are used for storage of one block. Blocks that are larger than the value of the singleblock carrier threshold (<seealso marker="#M_sbct">sbct</seealso>) parameter are placed in singleblock carriers. Blocks that are smaller than the value of the <c>sbct</c> parameter are placed in multiblock - carriers. Blocks that are smaller than the small block multiblock - carrier threshold (<seealso marker="#M_sbmbct">sbmbct</seealso>) - will be placed in multiblock carriers only used for small blocks. - Normally an allocator creates a "main multiblock + carriers. Normally an allocator creates a "main multiblock carrier". Main multiblock carriers are never deallocated. The size of the main multiblock carrier is determined by the value of the <seealso marker="#M_mmbcs">mmbcs</seealso> parameter.</p> @@ -140,9 +129,7 @@ <c>sbct</c> parameter should be larger than the value of the <c>lmbcs</c> parameter, the allocator may have to create multiblock carriers that are larger than the value of the - <c>lmbcs</c> parameter, though. The size of multiblock carriers - for small blocks is determined by the small block multiblock - carrier size (<seealso marker="#M_sbmbcs">sbmbcs</seealso>). + <c>lmbcs</c> parameter, though. Singleblock carriers allocated via <c>mseg_alloc</c> are sized to whole pages.</p> <p>Sizes of carriers allocated via <c>sys_alloc</c> are @@ -183,6 +170,15 @@ used. The time complexity is proportional to log N, where N is the number of free blocks.</p> </item> + <tag>Address order first fit carrier address order best fit</tag> + <item> + <p>Strategy: Find the <em>carrier</em> with the lowest address that + can satisfy the requested block size, then find a block within + that carrier using the "adress order best fit" strategy.</p> + <p>Implementation: Balanced binary search trees are + used. The time complexity is proportional to log N, where + N is the number of free blocks.</p> + </item> <tag>Good fit</tag> <item> <p>Strategy: Try to find the best fit, but settle for the best fit @@ -219,11 +215,6 @@ but can only satisfy a limited amount of requests.</p> </section> - <note><p> - Currently only allocators using the best fit and the address order - best fit strategies are able to use "small block multi block carriers". - </p></note> - <section> <marker id="flags"></marker> <title>System Flags Effecting erts_alloc</title> @@ -245,7 +236,6 @@ the currently present allocators:</p> <list type="bulleted"> <item><c>B: binary_alloc</c></item> - <item><c>C: sbmbc_alloc</c></item> <item><c>D: std_alloc</c></item> <item><c>E: ets_alloc</c></item> <item><c>F: fix_alloc</c></item> @@ -319,10 +309,42 @@ subsystem identifier, only the specific allocator identified will be effected:</p> <taglist> - <tag><marker id="M_as"><c><![CDATA[+M<S>as bf|aobf|aoff|gf|af]]></c></marker></tag> + <tag><marker id="M_acul"><c><![CDATA[+M<S>acul <utilization>|de]]></c></marker></tag> + <item> + Abandon carrier utilization limit. A valid + <c><![CDATA[<utilization>]]></c> is an integer in the range + <c>[0, 100]</c> representing utilization in percent. When a + utilization value larger than zero is used, allocator instances + are allowed to abandon multiblock carriers. Currently the default + is zero. If <c>de</c> (default enabled) is passed instead of a + <c><![CDATA[<utilization>]]></c>, a recomended non zero utilization + value will be used. The actual value chosen depend on allocator + type and may be changed between ERTS versions. Carriers will be + abandoned when memory utilization in the allocator instance falls + below the utilization value used. Once a carrier has been abandoned, + no new allocations will be made in it. When an allocator instance + gets an increased multiblock carrier need, it will first try to + fetch an abandoned carrier from an allocator instances of the same + allocator type. If no abandoned carrier could be fetched, it will + create a new empty carrier. When an abandoned carrier has been + fetched it will function as an ordinary carrier. This feature has + special requirements on the + <seealso marker="#M_as">allocation strategy</seealso> used. Currently + only the <c>aoff</c> and the <c>aoffcaobf</c> strategies support + abandoned carriers. This feature also requires + <seealso marker="#M_t">multiple thread specific instances</seealso> + to be enabled. When enabling this feature, multiple thread specific + instances will be enabled if not already enabled, and the + <c>aoffcaobf</c> strategy will be enabled if current strategy does not + support abandoned carriers. This feature can be enabled on all + allocators based on the <c>alloc_util</c> framework with the + exception of <c>temp_alloc</c> (which would be pointless). + </item> + <tag><marker id="M_as"><c><![CDATA[+M<S>as bf|aobf|aoff|aoffcaobf|gf|af]]></c></marker></tag> <item> Allocation strategy. Valid strategies are <c>bf</c> (best fit), <c>aobf</c> (address order best fit), <c>aoff</c> (address order first fit), + <c>aoffcaobf</c> (address order first fit carrier address order best fit), <c>gf</c> (good fit), and <c>af</c> (a fit). See <seealso marker="#strategy">the description of allocation strategies</seealso> in "the <c>alloc_util</c> framework" section.</item> <tag><marker id="M_asbcst"><c><![CDATA[+M<S>asbcst <size>]]></c></marker></tag> @@ -416,20 +438,6 @@ smaller than this threshold will be placed in multiblock carriers. On 32-bit Unix style OS this threshold can not be set higher than 8 megabytes.</item> - <tag><marker id="M_sbmbcs"><c><![CDATA[+M<S>sbmbcs <size>]]></c></marker></tag> - <item> - Small block multiblock carrier size (in bytes). Memory blocks smaller - than the small block multiblock carrier threshold - (<seealso marker="#M_sbmbct">sbmbct</seealso>) will be placed in - multiblock carriers used for small blocks only. This parameter - determines the size of such carriers. - </item> - <tag><marker id="M_sbmbct"><c><![CDATA[+M<S>sbmbct <size>]]></c></marker></tag> - <item> - Small block multiblock carrier threshold (in bytes). Memory blocks - smaller than this threshold will be placed in multiblock carriers - used for small blocks only. - </item> <tag><marker id="M_smbcs"><c><![CDATA[+M<S>smbcs <size>]]></c></marker></tag> <item> Smallest (<c>mseg_alloc</c>) multiblock carrier size (in diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index fb4cde0e76..58e83540e1 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -559,13 +559,14 @@ GENERATE += $(TTF_DIR)/driver_tab.c # Preloaded code. # # This list must be consistent with PRE_LOADED_MODULES in -# lib/kernel/src/Makefile. +# erts/preloaded/src/Makefile. ifeq ($(TARGET),win32) # On windows the preloaded objects are in a resource object. PRELOAD_OBJ = $(OBJDIR)/beams.$(RES_EXT) PRELOAD_SRC = $(TARGET)/beams.rc $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ $(ERL_TOP)/erts/preloaded/ebin/init.beam \ + $(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \ $(ERL_TOP)/erts/preloaded/ebin/zlib.beam \ @@ -579,6 +580,7 @@ PRELOAD_OBJ = $(OBJDIR)/preload.o PRELOAD_SRC = $(TARGET)/preload.c $(PRELOAD_SRC): $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ $(ERL_TOP)/erts/preloaded/ebin/init.beam \ + $(ERL_TOP)/erts/preloaded/ebin/prim_eval.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \ $(ERL_TOP)/erts/preloaded/ebin/zlib.beam \ diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index ce60bb9bbc..7d86e486f1 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -248,6 +248,7 @@ atom get_data atom get_seq_token atom get_tcw atom getenv +atom gather_gc_info_result atom gather_sched_wall_time_result atom getting_linked atom getting_unlinked @@ -322,6 +323,7 @@ atom maximum atom max_tables max_processes atom mbuf_size atom memory +atom memory_internal atom memory_types atom message atom message_binary diff --git a/erts/emulator/beam/erl_afit_alloc.c b/erts/emulator/beam/erl_afit_alloc.c index b45201af42..eca4e3b3bb 100644 --- a/erts/emulator/beam/erl_afit_alloc.c +++ b/erts/emulator/beam/erl_afit_alloc.c @@ -48,10 +48,9 @@ struct AFFreeBlock_t_ { #define MIN_MBC_FIRST_FREE_SZ (4*1024) /* Prototypes of callback functions */ -static Block_t * get_free_block (Allctr_t *, Uint, - Block_t *, Uint, Uint32); -static void link_free_block (Allctr_t *, Block_t *, Uint32); -static void unlink_free_block (Allctr_t *, Block_t *, Uint32); +static Block_t * get_free_block (Allctr_t *, Uint, Block_t *, Uint); +static void link_free_block (Allctr_t *, Block_t *); +static void unlink_free_block (Allctr_t *, Block_t *); static Eterm info_options (Allctr_t *, char *, int *, @@ -84,8 +83,7 @@ erts_afalc_start(AFAllctr_t *afallctr, sys_memcpy((void *) afallctr, (void *) &zero.allctr, sizeof(AFAllctr_t)); - init->sbmbct = 0; /* Small mbc not supported by afit */ - + allctr->mbc_header_size = sizeof(Carrier_t); allctr->min_mbc_size = MIN_MBC_SZ; allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ; allctr->min_block_size = sizeof(AFFreeBlock_t); @@ -100,6 +98,9 @@ erts_afalc_start(AFAllctr_t *afallctr, allctr->get_next_mbc_size = NULL; allctr->creating_mbc = NULL; allctr->destroying_mbc = NULL; + allctr->add_mbc = NULL; + allctr->remove_mbc = NULL; + allctr->largest_fblk_in_mbc = NULL; allctr->init_atoms = init_atoms; #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG @@ -116,8 +117,7 @@ erts_afalc_start(AFAllctr_t *afallctr, } static Block_t * -get_free_block(Allctr_t *allctr, Uint size, Block_t *cand_blk, Uint cand_size, - Uint32 flags) +get_free_block(Allctr_t *allctr, Uint size, Block_t *cand_blk, Uint cand_size) { AFAllctr_t *afallctr = (AFAllctr_t *) allctr; @@ -135,7 +135,7 @@ get_free_block(Allctr_t *allctr, Uint size, Block_t *cand_blk, Uint cand_size, } static void -link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) +link_free_block(Allctr_t *allctr, Block_t *block) { AFFreeBlock_t *blk = (AFFreeBlock_t *) block; AFAllctr_t *afallctr = (AFAllctr_t *) allctr; @@ -156,7 +156,7 @@ link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) } static void -unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) +unlink_free_block(Allctr_t *allctr, Block_t *block) { AFFreeBlock_t *blk = (AFFreeBlock_t *) block; AFAllctr_t *afallctr = (AFAllctr_t *) allctr; diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 9de4ef1ff9..a547191d6d 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -71,6 +71,23 @@ #define AU_ALLOC_DEFAULT_ENABLE(X) (X) #endif +#define ERTS_ALC_DEFAULT_ENABLED_ACUL 60 +#define ERTS_ALC_DEFAULT_ENABLED_ACUL_EHEAP_ALLOC 45 +#define ERTS_ALC_DEFAULT_ENABLED_ACUL_LL_ALLOC 85 + +#define ERTS_ALC_DEFAULT_ACUL 0 +#define ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC 0 +#define ERTS_ALC_DEFAULT_ACUL_LL_ALLOC 0 + +#ifndef ERTS_SMP +# undef ERTS_ALC_DEFAULT_ACUL +# define ERTS_ALC_DEFAULT_ACUL 0 +# undef ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC +# define ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC 0 +# undef ERTS_ALC_DEFAULT_ACUL_LL_ALLOC +# define ERTS_ALC_DEFAULT_ACUL_LL_ALLOC 0 +#endif + #ifdef DEBUG static Uint install_debug_functions(void); #if 0 @@ -101,11 +118,9 @@ typedef union { char align_aoffa[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(AOFFAllctr_t))]; } ErtsAllocatorState_t; -static ErtsAllocatorState_t sbmbc_alloc_state; static ErtsAllocatorState_t std_alloc_state; static ErtsAllocatorState_t ll_alloc_state; #if HALFWORD_HEAP -static ErtsAllocatorState_t sbmbc_low_alloc_state; static ErtsAllocatorState_t std_low_alloc_state; static ErtsAllocatorState_t ll_low_alloc_state; #endif @@ -120,6 +135,7 @@ static ErtsAllocatorState_t fix_alloc_state; typedef struct { erts_smp_atomic32_t refc; int only_sz; + int internal; Uint req_sched; Process *proc; Eterm ref; @@ -162,6 +178,7 @@ enum allctr_type { struct au_init { int enable; int thr_spec; + int carrier_migration_allowed; enum allctr_type atype; struct { AllctrInit_t util; @@ -200,7 +217,6 @@ typedef struct { char *mtrace; char *nodename; } instr; - struct au_init sbmbc_alloc; struct au_init sl_alloc; struct au_init std_alloc; struct au_init ll_alloc; @@ -211,13 +227,12 @@ typedef struct { struct au_init driver_alloc; struct au_init fix_alloc; #if HALFWORD_HEAP - struct au_init sbmbc_low_alloc; struct au_init std_low_alloc; struct au_init ll_low_alloc; #endif } erts_alc_hndl_args_init_t; -#define ERTS_AU_INIT__ {0, 0, GOODFIT, DEFAULT_ALLCTR_INIT, {1,1,1,1}} +#define ERTS_AU_INIT__ {0, 0, 1, GOODFIT, DEFAULT_ALLCTR_INIT, {1,1,1,1}} #define SET_DEFAULT_ALLOC_OPTS(IP) \ do { \ @@ -225,32 +240,13 @@ do { \ sys_memcpy((void *) (IP), (void *) &aui__, sizeof(struct au_init)); \ } while (0) -static void -set_default_sbmbc_alloc_opts(struct au_init *ip) +static ERTS_INLINE void +set_default_acul(struct au_init *ip, int acul) { - SET_DEFAULT_ALLOC_OPTS(ip); - ip->enable = 0; - ip->thr_spec = 0; - ip->atype = BESTFIT; - ip->init.bf.ao = 1; - ip->init.util.ramv = 0; - ip->init.util.mmsbc = 0; - ip->init.util.mmmbc = 500; - ip->init.util.sbct = ~((UWord) 0); - ip->init.util.name_prefix = "sbmbc_"; - ip->init.util.alloc_no = ERTS_ALC_A_SBMBC; -#ifndef SMALL_MEMORY - ip->init.util.mmbcs = 2*1024*1024; /* Main carrier size */ -#else - ip->init.util.mmbcs = 1*1024*1024; /* Main carrier size */ -#endif - ip->init.util.ts = ERTS_ALC_MTA_SBMBC; - ip->init.util.asbcst = 0; - ip->init.util.rsbcst = 0; - ip->init.util.rsbcmt = 0; - ip->init.util.rmbcmt = 0; - ip->init.util.sbmbct = 0; - ip->init.util.sbmbcs = 0; + ip->thr_spec = 1; + ip->atype = AOFIRSTFIT; + ip->init.aoff.bf_within_carrier = 1; + ip->init.util.acul = acul; } static void @@ -258,8 +254,12 @@ set_default_sl_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); +#if ERTS_ALC_DEFAULT_ACUL + set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL); +#else ip->thr_spec = 1; ip->atype = GOODFIT; +#endif ip->init.util.name_prefix = "sl_"; ip->init.util.mmmbc = 5; ip->init.util.alloc_no = ERTS_ALC_A_SHORT_LIVED; @@ -282,8 +282,12 @@ set_default_std_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); +#if ERTS_ALC_DEFAULT_ACUL + set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL); +#else ip->thr_spec = 1; ip->atype = BESTFIT; +#endif ip->init.util.name_prefix = "std_"; ip->init.util.mmmbc = 5; ip->init.util.alloc_no = ERTS_ALC_A_STANDARD; @@ -300,9 +304,13 @@ set_default_ll_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); +#if ERTS_ALC_DEFAULT_ACUL_LL_ALLOC + set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL_LL_ALLOC); +#else ip->thr_spec = 0; ip->atype = BESTFIT; ip->init.bf.ao = 1; +#endif ip->init.util.ramv = 0; ip->init.util.mmsbc = 0; ip->init.util.mmmbc = 0; @@ -319,8 +327,6 @@ set_default_ll_alloc_opts(struct au_init *ip) ip->init.util.rsbcst = 0; ip->init.util.rsbcmt = 0; ip->init.util.rmbcmt = 0; - ip->init.util.sbmbct = 0; - ip->init.util.sbmbcs = 0; } static void @@ -329,6 +335,7 @@ set_default_temp_alloc_opts(struct au_init *ip) SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); ip->thr_spec = 1; + ip->carrier_migration_allowed = 0; ip->atype = AFIT; ip->init.util.name_prefix = "temp_"; ip->init.util.alloc_no = ERTS_ALC_A_TEMPORARY; @@ -351,8 +358,12 @@ set_default_eheap_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); +#if ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC + set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC); +#else ip->thr_spec = 1; ip->atype = GOODFIT; +#endif ip->init.util.mmmbc = 100; ip->init.util.name_prefix = "eheap_"; ip->init.util.alloc_no = ERTS_ALC_A_EHEAP; @@ -374,8 +385,12 @@ set_default_binary_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); +#if ERTS_ALC_DEFAULT_ACUL + set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL); +#else ip->thr_spec = 1; ip->atype = BESTFIT; +#endif ip->init.util.mmmbc = 50; ip->init.util.name_prefix = "binary_"; ip->init.util.alloc_no = ERTS_ALC_A_BINARY; @@ -392,8 +407,12 @@ set_default_ets_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); +#if ERTS_ALC_DEFAULT_ACUL + set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL); +#else ip->thr_spec = 1; ip->atype = BESTFIT; +#endif ip->init.util.mmmbc = 100; ip->init.util.name_prefix = "ets_"; ip->init.util.alloc_no = ERTS_ALC_A_ETS; @@ -410,8 +429,12 @@ set_default_driver_alloc_opts(struct au_init *ip) { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); +#if ERTS_ALC_DEFAULT_ACUL + set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL); +#else ip->thr_spec = 1; ip->atype = BESTFIT; +#endif ip->init.util.name_prefix = "driver_"; ip->init.util.alloc_no = ERTS_ALC_A_DRIVER; #ifndef SMALL_MEMORY @@ -428,8 +451,12 @@ set_default_fix_alloc_opts(struct au_init *ip, { SET_DEFAULT_ALLOC_OPTS(ip); ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); +#if ERTS_ALC_DEFAULT_ACUL + set_default_acul(ip, ERTS_ALC_DEFAULT_ACUL); +#else ip->thr_spec = 1; ip->atype = BESTFIT; +#endif ip->init.bf.ao = 1; ip->init.util.name_prefix = "fix_"; ip->init.util.fix_type_size = fix_type_sizes; @@ -527,6 +554,39 @@ static void adjust_fix_alloc_sizes(UWord extra_block_size) } } +static ERTS_INLINE int +strategy_support_carrier_migration(struct au_init *auip) +{ + /* + * Currently only aoff and aoffcaobf support carrier + * migration, i.e, type AOFIRSTFIT. + */ + return auip->atype == AOFIRSTFIT; +} + +static ERTS_INLINE void +check_disable_carrier_migration(struct au_init *auip) +{ + if (!strategy_support_carrier_migration(auip) || !auip->thr_spec) + auip->init.util.acul = 0; +} + +static ERTS_INLINE void +ensure_carrier_migration_support(struct au_init *auip) +{ + auip->thr_spec = 1; /* Need thread preferred */ + + /* + * If strategy cannot handle carrier migration, + * default to a strategy that can... + */ + if (!strategy_support_carrier_migration(auip)) { + /* Default to aoffcaobf */ + auip->atype = AOFIRSTFIT; + auip->init.aoff.bf_within_carrier = 1; + } +} + void erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) { @@ -565,7 +625,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) hdbg_init(); #endif - erts_have_sbmbc_alloc = 0; ncpu = eaiop->ncpu; if (ncpu < 1) ncpu = 1; @@ -575,7 +634,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) erts_sys_alloc_init(); erts_init_utils_mem(); - set_default_sbmbc_alloc_opts(&init.sbmbc_alloc); set_default_sl_alloc_opts(&init.sl_alloc); set_default_std_alloc_opts(&init.std_alloc); set_default_ll_alloc_opts(&init.ll_alloc); @@ -591,7 +649,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) handle_args(argc, argv, &init); #ifndef ERTS_SMP - init.sbmbc_alloc.thr_spec = 0; init.sl_alloc.thr_spec = 0; init.std_alloc.thr_spec = 0; init.ll_alloc.thr_spec = 0; @@ -604,7 +661,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) if (init.erts_alloc_config) { /* Adjust flags that erts_alloc_config won't like */ - init.sbmbc_alloc.thr_spec = 0; init.temp_alloc.thr_spec = 0; init.sl_alloc.thr_spec = 0; init.std_alloc.thr_spec = 0; @@ -616,13 +672,22 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.fix_alloc.thr_spec = 0; } + check_disable_carrier_migration(&init.sl_alloc); + check_disable_carrier_migration(&init.std_alloc); + check_disable_carrier_migration(&init.ll_alloc); + check_disable_carrier_migration(&init.eheap_alloc); + check_disable_carrier_migration(&init.binary_alloc); + check_disable_carrier_migration(&init.ets_alloc); + check_disable_carrier_migration(&init.driver_alloc); + check_disable_carrier_migration(&init.fix_alloc); + + #ifdef ERTS_SMP /* Only temp_alloc can use thread specific interface */ if (init.temp_alloc.thr_spec) init.temp_alloc.thr_spec = erts_no_schedulers; /* Others must use thread preferred interface */ - adjust_tpref(&init.sbmbc_alloc, erts_no_schedulers); adjust_tpref(&init.sl_alloc, erts_no_schedulers); adjust_tpref(&init.std_alloc, erts_no_schedulers); adjust_tpref(&init.ll_alloc, erts_no_schedulers); @@ -641,7 +706,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) * The following allocators cannot be run with afit strategy. * Make sure they don't... */ - refuse_af_strategy(&init.sbmbc_alloc); refuse_af_strategy(&init.sl_alloc); refuse_af_strategy(&init.std_alloc); refuse_af_strategy(&init.ll_alloc); @@ -685,11 +749,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) #if HALFWORD_HEAP /* Init low memory variants by cloning */ - init.sbmbc_low_alloc = init.sbmbc_alloc; - init.sbmbc_low_alloc.init.util.name_prefix = "sbmbc_low_"; - init.sbmbc_low_alloc.init.util.alloc_no = ERTS_ALC_A_SBMBC_LOW; - init.sbmbc_low_alloc.init.util.low_mem = 1; - init.std_low_alloc = init.std_alloc; init.std_low_alloc.init.util.name_prefix = "std_low_"; init.std_low_alloc.init.util.alloc_no = ERTS_ALC_A_STANDARD_LOW; @@ -702,13 +761,11 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) init.ll_low_alloc.init.util.force = 1; init.ll_low_alloc.init.util.low_mem = 1; - set_au_allocator(ERTS_ALC_A_SBMBC_LOW, &init.sbmbc_low_alloc, ncpu); set_au_allocator(ERTS_ALC_A_STANDARD_LOW, &init.std_low_alloc, ncpu); set_au_allocator(ERTS_ALC_A_LONG_LIVED_LOW, &init.ll_low_alloc, ncpu); #endif /* HALFWORD */ set_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc, ncpu); - set_au_allocator(ERTS_ALC_A_SBMBC, &init.sbmbc_alloc, ncpu); set_au_allocator(ERTS_ALC_A_SHORT_LIVED, &init.sl_alloc, ncpu); set_au_allocator(ERTS_ALC_A_STANDARD, &init.std_alloc, ncpu); set_au_allocator(ERTS_ALC_A_LONG_LIVED, &init.ll_alloc, ncpu); @@ -735,20 +792,6 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) erts_mtrace_init(init.instr.mtrace, init.instr.nodename); - /* sbmbc_alloc() needs to be started first */ - start_au_allocator(ERTS_ALC_A_SBMBC, - &init.sbmbc_alloc, - &sbmbc_alloc_state); -#if HALFWORD_HEAP - start_au_allocator(ERTS_ALC_A_SBMBC_LOW, - &init.sbmbc_low_alloc, - &sbmbc_low_alloc_state); - erts_have_sbmbc_alloc = (init.sbmbc_alloc.enable - && init.sbmbc_low_alloc.enable); -#else - erts_have_sbmbc_alloc = init.sbmbc_alloc.enable; -#endif - start_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc, &temp_alloc_state); @@ -1138,6 +1181,7 @@ get_kb_value(char *param_end, char** argv, int* ip) return ((Uint) tmp)*1024; } +#if 0 static Uint get_byte_value(char *param_end, char** argv, int* ip) { @@ -1151,6 +1195,7 @@ get_byte_value(char *param_end, char** argv, int* ip) bad_value(param, param_end, value); return (Uint) tmp; } +#endif static Uint get_amount_value(char *param_end, char** argv, int* ip) @@ -1166,17 +1211,59 @@ get_amount_value(char *param_end, char** argv, int* ip) return (Uint) tmp; } +static Uint +get_acul_value(struct au_init *auip, char *param_end, char** argv, int* ip) +{ + Sint tmp; + char *rest; + char *param = argv[*ip]+1; + char *value = get_value(param_end, argv, ip); + if (sys_strcmp(value, "de") == 0) { + switch (auip->init.util.alloc_no) { + case ERTS_ALC_A_LONG_LIVED: +#if HALFWORD_HEAP + case ERTS_ALC_A_LONG_LIVED_LOW: +#endif + return ERTS_ALC_DEFAULT_ENABLED_ACUL_LL_ALLOC; + case ERTS_ALC_A_EHEAP: + return ERTS_ALC_DEFAULT_ENABLED_ACUL_EHEAP_ALLOC; + default: + return ERTS_ALC_DEFAULT_ENABLED_ACUL; + } + } + errno = 0; + tmp = (Sint) ErtsStrToSint(value, &rest, 10); + if (errno != 0 || rest == value || tmp < 0 || 100 < tmp) + bad_value(param, param_end, value); + return (Uint) tmp; +} + static void handle_au_arg(struct au_init *auip, char* sub_param, char** argv, - int* ip) + int* ip, + int u_switch) { char *param = argv[*ip]+1; switch (sub_param[0]) { case 'a': - if(has_prefix("asbcst", sub_param)) { + if (has_prefix("acul", sub_param)) { + if (!auip->carrier_migration_allowed) { + if (!u_switch) + goto bad_switch; + else { + /* ignore */ + (void) get_acul_value(auip, sub_param + 4, argv, ip); + break; + } + } + ensure_carrier_migration_support(auip); + + auip->init.util.acul = get_acul_value(auip, sub_param + 4, argv, ip); + } + else if(has_prefix("asbcst", sub_param)) { auip->init.util.asbcst = get_kb_value(sub_param + 6, argv, ip); } else if(has_prefix("as", sub_param)) { @@ -1197,21 +1284,22 @@ handle_au_arg(struct au_init *auip, } else if (strcmp("aoff", alg) == 0) { auip->atype = AOFIRSTFIT; + auip->init.aoff.bf_within_carrier = 0; + } + else if (strcmp("aoffcaobf", alg) == 0) { + auip->atype = AOFIRSTFIT; + auip->init.aoff.bf_within_carrier = 1; } else { bad_value(param, sub_param + 1, alg); } + check_disable_carrier_migration(auip); } else goto bad_switch; break; case 'e': auip->enable = get_bool_value(sub_param+1, argv, ip); -#if !HAVE_ERTS_SBMBC - if (auip->init.util.alloc_no == ERTS_ALC_A_SBMBC) { - auip->enable = 0; - } -#endif break; case 'l': if (has_prefix("lmbcs", sub_param)) { @@ -1271,18 +1359,6 @@ handle_au_arg(struct au_init *auip, if(has_prefix("sbct", sub_param)) { auip->init.util.sbct = get_kb_value(sub_param + 4, argv, ip); } - else if (has_prefix("sbmbcs", sub_param)) { -#if HAVE_ERTS_SBMBC - auip->init.util.sbmbcs = -#endif - get_byte_value(sub_param + 6, argv, ip); - } - else if (has_prefix("sbmbct", sub_param)) { -#if HAVE_ERTS_SBMBC - auip->init.util.sbmbct = -#endif - get_byte_value(sub_param + 6, argv, ip); - } else if (has_prefix("smbcs", sub_param)) { auip->default_.smbcs = 0; auip->init.util.smbcs = get_kb_value(sub_param + 5, argv, ip); @@ -1298,6 +1374,7 @@ handle_au_arg(struct au_init *auip, } else if (res == 0) { auip->thr_spec = 0; + check_disable_carrier_migration(auip); break; } goto bad_switch; @@ -1312,7 +1389,6 @@ static void handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) { struct au_init *aui[] = { - &init->sbmbc_alloc, &init->binary_alloc, &init->std_alloc, &init->ets_alloc, @@ -1339,25 +1415,22 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) case 'M': switch (argv[i][2]) { case 'B': - handle_au_arg(&init->binary_alloc, &argv[i][3], argv, &i); - break; - case 'C': - handle_au_arg(&init->sbmbc_alloc, &argv[i][3], argv, &i); + handle_au_arg(&init->binary_alloc, &argv[i][3], argv, &i, 0); break; case 'D': - handle_au_arg(&init->std_alloc, &argv[i][3], argv, &i); + handle_au_arg(&init->std_alloc, &argv[i][3], argv, &i, 0); break; case 'E': - handle_au_arg(&init->ets_alloc, &argv[i][3], argv, &i); + handle_au_arg(&init->ets_alloc, &argv[i][3], argv, &i, 0); break; case 'F': - handle_au_arg(&init->fix_alloc, &argv[i][3], argv, &i); + handle_au_arg(&init->fix_alloc, &argv[i][3], argv, &i, 0); break; case 'H': - handle_au_arg(&init->eheap_alloc, &argv[i][3], argv, &i); + handle_au_arg(&init->eheap_alloc, &argv[i][3], argv, &i, 0); break; case 'L': - handle_au_arg(&init->ll_alloc, &argv[i][3], argv, &i); + handle_au_arg(&init->ll_alloc, &argv[i][3], argv, &i, 0); break; case 'M': if (has_prefix("amcbf", argv[i]+3)) { @@ -1383,13 +1456,13 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) } break; case 'R': - handle_au_arg(&init->driver_alloc, &argv[i][3], argv, &i); + handle_au_arg(&init->driver_alloc, &argv[i][3], argv, &i, 0); break; case 'S': - handle_au_arg(&init->sl_alloc, &argv[i][3], argv, &i); + handle_au_arg(&init->sl_alloc, &argv[i][3], argv, &i, 0); break; case 'T': - handle_au_arg(&init->temp_alloc, &argv[i][3], argv, &i); + handle_au_arg(&init->temp_alloc, &argv[i][3], argv, &i, 0); break; case 'Y': { /* sys_alloc */ if (has_prefix("tt", param+2)) { @@ -1448,9 +1521,6 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) else if (strcmp("max", arg) == 0) { for (a = 0; a < aui_sz; a++) aui[a]->enable = 1; -#if !HAVE_ERTS_SBMBC - init->sbmbc_alloc.enable = 0; -#endif } else if (strcmp("config", arg) == 0) { init->erts_alloc_config = 1; @@ -1478,6 +1548,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) for (a = 0; a < aui_sz; a++) { aui[a]->thr_spec = 0; + check_disable_carrier_migration(aui[a]); aui[a]->init.util.ramv = 0; aui[a]->init.util.mmmbc = 10; aui[a]->init.util.lmbcs = 5*1024*1024; @@ -1542,7 +1613,7 @@ handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) argv[start + 1] = val; i = start; } - handle_au_arg(aui[a], &argv[i][3], argv, &i); + handle_au_arg(aui[a], &argv[i][3], argv, &i, 1); } } break; @@ -2088,15 +2159,11 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) return am_badarg; } - /* All alloc_util allocators except sbmbc_alloc *have* to be enabled */ + /* All alloc_util allocators *have* to be enabled */ for (ai = ERTS_ALC_A_MIN; ai <= ERTS_ALC_A_MAX; ai++) { switch (ai) { case ERTS_ALC_A_SYSTEM: - case ERTS_ALC_A_SBMBC: -#if HALFWORD_HEAP - case ERTS_ALC_A_SBMBC_LOW: -#endif break; default: if (!erts_allctrs_info[ai].enabled @@ -2136,12 +2203,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) * Often not thread safe and usually never * contain any allocated memory. */ - case ERTS_ALC_A_SBMBC: - /* Included in other allocators */ -#if HALFWORD_HEAP - case ERTS_ALC_A_SBMBC_LOW: - /* Included in other allocators */ -#endif continue; case ERTS_ALC_A_EHEAP: save = &size.processes; @@ -2176,7 +2237,6 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) if (want_tot_or_sys || want.processes || want.processes_used) { - int max_processes = erts_ptab_max(&erts_proc); UWord tmp; if (ERTS_MEM_NEED_ALL_ALCU) @@ -2186,7 +2246,7 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) fi, ERTS_ALC_NO_FIXED_SIZES); tmp = alcu_size(ERTS_ALC_A_EHEAP, NULL, 0); } - tmp += max_processes*sizeof(erts_smp_atomic_t); + tmp += erts_ptab_mem_size(&erts_proc); tmp += erts_bif_timer_memory_size(); tmp += erts_tot_link_lh_size(); @@ -2312,13 +2372,11 @@ struct aa_values { Eterm erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc) { -#define MAX_AA_VALUES (23) +#define MAX_AA_VALUES (24) struct aa_values values[MAX_AA_VALUES]; Eterm res = THE_NON_VALUE; int i, length; Uint reserved_atom_space, atom_space; - int max_processes = erts_ptab_max(&erts_proc); - int max_ports = erts_ptab_max(&erts_port); if (proc) { ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN @@ -2349,8 +2407,8 @@ erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc) values[i].arity = 2; values[i].name = "static"; - values[i].ui[0] = - max_ports*sizeof(erts_smp_atomic_t) /* Port table */ + values[i].ui[0] = + sizeof(ErtsPTab)*2 /* proc & port tables */ + erts_timer_wheel_memory_size(); /* Timer wheel */ i++; @@ -2429,7 +2487,12 @@ erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc) values[i].arity = 2; values[i].name = "process_table"; - values[i].ui[0] = max_processes*sizeof(Process*); + values[i].ui[0] = erts_ptab_mem_size(&erts_proc); + i++; + + values[i].arity = 2; + values[i].name = "port_table"; + values[i].ui[0] = erts_ptab_mem_size(&erts_port); i++; values[i].arity = 2; @@ -2583,7 +2646,7 @@ erts_allocator_info(int to, void *arg) as = erts_allctr_thr_spec[a].allctr[ai]; } /* Binary alloc has its own thread safety... */ - erts_alcu_info(as, 0, &to, arg, NULL, NULL); + erts_alcu_info(as, 0, 0, &to, arg, NULL, NULL); } else { switch (a) { @@ -2845,6 +2908,7 @@ reply_alloc_info(void *vair) int i; Eterm (*info_func)(Allctr_t *, int, + int, int *, void *, Uint **, @@ -2973,8 +3037,8 @@ reply_alloc_info(void *vair) allctr = erts_allctr_thr_spec[ai].allctr[0]; else allctr = erts_allctrs_info[ai].extra; - ainfo = info_func(allctr, hpp != NULL, NULL, - NULL, hpp, szp); + ainfo = info_func(allctr, air->internal, hpp != NULL, + NULL, NULL, hpp, szp); ainfo = erts_bld_tuple(hpp, szp, 3, alloc_atom, make_small(0), ainfo); } @@ -3009,7 +3073,7 @@ reply_alloc_info(void *vair) alloc_atom = erts_bld_atom(hpp, szp, (char *) ERTS_ALC_A2AD(ai)); allctr = erts_allctr_thr_spec[ai].allctr[sched_id]; - ainfo = info_func(allctr, hpp != NULL, NULL, + ainfo = info_func(allctr, air->internal, hpp != NULL, NULL, NULL, hpp, szp); ai_list = erts_bld_cons(hpp, szp, erts_bld_tuple( @@ -3065,7 +3129,8 @@ int erts_request_alloc_info(struct process *c_p, Eterm ref, Eterm allocs, - int only_sz) + int only_sz, + int internal) { ErtsAllocInfoReq *air = aireq_alloc(); Eterm req_ai[ERTS_ALC_A_MAX+1+2] = {0}; @@ -3077,6 +3142,8 @@ erts_request_alloc_info(struct process *c_p, air->only_sz = only_sz; + air->internal = internal; + air->proc = c_p; if (is_not_internal_ref(ref)) @@ -3271,14 +3338,13 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3) init.atype = GOODFIT; init.init.util.name_prefix = (char *) a1; init.init.util.ts = a2 ? 1 : 0; - init.init.util.sbmbct = 0; if ((char **) a3) { char **argv = (char **) a3; int i = 0; while (argv[i]) { if (argv[i][0] == '-' && argv[i][1] == 't') - handle_au_arg(&init, &argv[i][2], argv, &i); + handle_au_arg(&init, &argv[i][2], argv, &i, 0); else return (UWord) NULL; i++; @@ -3398,6 +3464,11 @@ UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3) ERTS_ALC_TEST_ABORT; break; #endif /* #ifdef USE_THREADS */ +#ifdef ERTS_SMP + case 0xf13: return (UWord) 1; +#else + case 0xf13: return (UWord) 0; +#endif default: break; } diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index 9cafd8ddc8..d9fdfc6f58 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -65,7 +65,7 @@ Eterm erts_allocator_options(void *proc); struct process; int erts_request_alloc_info(struct process *c_p, Eterm ref, Eterm allocs, - int only_sz); + int only_sz, int internal); #define ERTS_ALLOC_INIT_DEF_OPTS_INITER {0} typedef struct { @@ -100,14 +100,6 @@ UWord erts_alc_test(UWord, #define ERTS_ALC_MIN_LONG_LIVED_TIME (10*60*1000) -#if HALFWORD_HEAP -#define ERTS_IS_SBMBC_ALLOCATOR_NO__(NO) \ - ((NO) == ERTS_ALC_A_SBMBC || (NO) == ERTS_ALC_A_SBMBC_LOW) -#else -#define ERTS_IS_SBMBC_ALLOCATOR_NO__(NO) \ - ((NO) == ERTS_ALC_A_SBMBC) -#endif - typedef struct { int alloc_util; int enabled; diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 5a92ab7f24..095ad24387 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -76,11 +76,6 @@ allocator SYSTEM true sys_alloc -allocator SBMBC true sbmbc_alloc -+if halfword -allocator SBMBC_LOW true sbmbc_low_alloc -+endif - +if smp allocator TEMPORARY true temp_alloc @@ -146,7 +141,6 @@ class SYSTEM system_data # # <TYPE> <ALLOCATOR> <CLASS> <DESCRIPTION> -type SBMBC SBMBC SYSTEM small_block_mbc type PROC FIXED_SIZE PROCESSES proc type PORT DRIVER SYSTEM port type ATOM LONG_LIVED ATOM atom_entry @@ -351,7 +345,6 @@ type SSB SHORT_LIVED PROCESSES ssb +if halfword -type SBMBC_LOW SBMBC_LOW SYSTEM small_block_mbc_low type DDLL_PROCESS STANDARD_LOW SYSTEM ddll_processes type MONITOR_LH STANDARD_LOW PROCESSES monitor_lh type NLINK_LH STANDARD_LOW PROCESSES nlink_lh @@ -366,6 +359,7 @@ type MONITOR_SH STANDARD_LOW PROCESSES monitor_sh type NLINK_SH STANDARD_LOW PROCESSES nlink_sh type AINFO_REQ STANDARD_LOW SYSTEM alloc_info_request type SCHED_WTIME_REQ STANDARD_LOW SYSTEM sched_wall_time_request +type GC_INFO_REQ STANDARD_LOW SYSTEM gc_info_request +else # "fullword" @@ -383,6 +377,7 @@ type MONITOR_SH FIXED_SIZE PROCESSES monitor_sh type NLINK_SH FIXED_SIZE PROCESSES nlink_sh type AINFO_REQ SHORT_LIVED SYSTEM alloc_info_request type SCHED_WTIME_REQ SHORT_LIVED SYSTEM sched_wall_time_request +type GC_INFO_REQ SHORT_LIVED SYSTEM gc_info_request +endif diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 53062979a6..b19e603a5f 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -71,21 +71,16 @@ #define ALLOC_ZERO_EQ_NULL 0 +#ifndef ERTS_MSEG_FLG_2POW +# define ERTS_MSEG_FLG_2POW 0 +#endif +#ifndef ERTS_MSEG_FLG_NONE +# define ERTS_MSEG_FLG_NONE 0 +#endif + static int atoms_initialized = 0; static int initialized = 0; -int erts_have_sbmbc_alloc; - -#if HAVE_ERTS_MSEG - -#define MSEG_UNIT_SHIFT MSEG_ALIGN_BITS -#define MSEG_UNIT_SZ (1 << MSEG_UNIT_SHIFT) -#define MSEG_UNIT_MASK ((~(UWord)0) << MSEG_UNIT_SHIFT) - -#define MSEG_UNIT_FLOOR(X) ((X) & MSEG_UNIT_MASK) -#define MSEG_UNIT_CEILING(X) MSEG_UNIT_FLOOR((X) + ~MSEG_UNIT_MASK) - -#endif #define INV_SYS_ALLOC_CARRIER_MASK ((UWord) (sys_alloc_carrier_size - 1)) #define SYS_ALLOC_CARRIER_MASK (~INV_SYS_ALLOC_CARRIER_MASK) @@ -110,13 +105,12 @@ static Uint max_mseg_carriers; #define ONE_GIGA (1000000000) -#define INC_CC(CC) ((CC).no == ONE_GIGA - 1 \ - ? ((CC).giga_no++, (CC).no = 0) \ - : (CC).no++) +#define ERTS_ALC_CC_GIGA_VAL(CC) ((CC) / ONE_GIGA) +#define ERTS_ALC_CC_VAL(CC) ((CC) % ONE_GIGA) + +#define INC_CC(CC) ((CC)++) -#define DEC_CC(CC) ((CC).no == 0 \ - ? ((CC).giga_no--, (CC).no = ONE_GIGA - 1) \ - : (CC).no--) +#define DEC_CC(CC) ((CC)--) /* Multi block carrier (MBC) memory layout in R16: @@ -173,14 +167,6 @@ MBC after deallocating first block: #define SET_BLK_SZ_FTR(B, SZ) \ (((FreeBlkFtr_t *) (((char *) (B)) + (SZ)))[-1] = (SZ)) -#define THIS_FREE_BLK_HDR_FLG (((UWord) 1) << 0) -#define PREV_FREE_BLK_HDR_FLG (((UWord) 1) << 1) -#define LAST_BLK_HDR_FLG (((UWord) 1) << 2) - -/* Special flag combo for (allocated) SBC blocks -*/ -#define SBC_BLK_HDR_FLG (THIS_FREE_BLK_HDR_FLG | PREV_FREE_BLK_HDR_FLG | LAST_BLK_HDR_FLG) - #define SET_MBC_ABLK_SZ(B, SZ) \ (ASSERT(((SZ) & FLG_MASK) == 0), \ (B)->bhdr = (((B)->bhdr) & ~MBC_ABLK_SZ_MASK) | (SZ)) @@ -222,18 +208,7 @@ MBC after deallocating first block: ASSERT(((UWord)(F) & (~FLG_MASK|THIS_FREE_BLK_HDR_FLG|PREV_FREE_BLK_HDR_FLG)) == THIS_FREE_BLK_HDR_FLG), \ (B)->bhdr = ((Sz) | (F)), \ (B)->u.carrier = (C)) - -# define ABLK_TO_MBC(B) \ - (ASSERT(IS_MBC_BLK(B) && IS_ALLOCED_BLK(B)), \ - (Carrier_t*)((MSEG_UNIT_FLOOR((UWord)(B)) - \ - (((B)->bhdr >> MBC_ABLK_OFFSET_SHIFT) << MSEG_UNIT_SHIFT)))) - -# define FBLK_TO_MBC(B) \ - (ASSERT(IS_MBC_BLK(B) && IS_FREE_BLK(B)), \ - (B)->u.carrier) -# define BLK_TO_MBC(B) (IS_FREE_BLK(B) ? FBLK_TO_MBC(B) : ABLK_TO_MBC(B)) - # define IS_MBC_FIRST_ABLK(AP,B) \ ((((UWord)(B) & ~MSEG_UNIT_MASK) == MBC_HEADER_SIZE(AP)) \ && ((B)->bhdr & MBC_ABLK_OFFSET_MASK) == 0) @@ -272,10 +247,6 @@ MBC after deallocating first block: (B)->bhdr = ((Sz) | (F)), \ (B)->carrier = (C)) -# define BLK_TO_MBC(B) ((B)->carrier) -# define ABLK_TO_MBC(B) BLK_TO_MBC(B) -# define FBLK_TO_MBC(B) BLK_TO_MBC(B) - # define IS_MBC_FIRST_BLK(AP,B) \ ((char*)(B) == (char*)((B)->carrier) + MBC_HEADER_SIZE(AP)) # define IS_MBC_FIRST_ABLK(AP,B) IS_MBC_FIRST_BLK(AP,B) @@ -300,8 +271,6 @@ MBC after deallocating first block: ((B)->bhdr & PREV_FREE_BLK_HDR_FLG) #define IS_PREV_BLK_ALLOCED(B) \ (!IS_PREV_BLK_FREE((B))) -#define IS_FREE_BLK(B) \ - (ASSERT(!IS_SBC_BLK(B)), (B)->bhdr & THIS_FREE_BLK_HDR_FLG) #define IS_ALLOCED_BLK(B) \ (!IS_FREE_BLK((B))) #define IS_LAST_BLK(B) \ @@ -318,13 +287,6 @@ MBC after deallocating first block: #define GET_BLK_HDR_FLGS(B) \ ((B)->bhdr & FLG_MASK) -#define IS_SBC_BLK(B) \ - (((B)->bhdr & FLG_MASK) == SBC_BLK_HDR_FLG) -#define IS_MBC_BLK(B) \ - (!IS_SBC_BLK((B))) - -#define MBC_BLK_SZ(B) (IS_FREE_BLK(B) ? MBC_FBLK_SZ(B) : MBC_ABLK_SZ(B)) - #define NXT_BLK(B) \ (ASSERT(IS_MBC_BLK(B)), \ (Block_t *) (((char *) (B)) + MBC_BLK_SZ((B)))) @@ -338,9 +300,96 @@ MBC after deallocating first block: /* Carriers ... */ -#define SBC_HEADER_SIZE (UNIT_CEILING(sizeof(Carrier_t) + ABLK_HDR_SZ) \ - - ABLK_HDR_SZ) -#define MBC_HEADER_SIZE(AP) SBC_HEADER_SIZE +/* #define ERTS_ALC_CPOOL_DEBUG */ + +#if defined(DEBUG) && !defined(ERTS_ALC_CPOOL_DEBUG) +# define ERTS_ALC_CPOOL_DEBUG +#endif + +#ifndef ERTS_SMP +# undef ERTS_ALC_CPOOL_DEBUG +#endif + +#ifdef ERTS_ALC_CPOOL_DEBUG +# define ERTS_ALC_CPOOL_ASSERT(A) \ + ((void) ((A) \ + ? 1 \ + : (erts_alcu_assert_failed(#A, \ + (char *) __FILE__, \ + __LINE__, \ + (char *) __func__), \ + 0))) +#else +# define ERTS_ALC_CPOOL_ASSERT(A) ((void) 1) +#endif + +#ifdef ERTS_SMP +#define ERTS_ALC_IS_CPOOL_ENABLED(A) ((A)->cpool.util_limit) +#else +#define ERTS_ALC_IS_CPOOL_ENABLED(A) (0) +#endif + +#ifdef ERTS_SMP + +#define ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON 1000 +#define ERTS_ALC_CPOOL_ALLOC_OP_INC 8 +#define ERTS_ALC_CPOOL_FREE_OP_DEC 10 + +#define ERTS_ALC_CPOOL_ALLOC_OP(A) \ +do { \ + if ((A)->cpool.disable_abandon < ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON) { \ + (A)->cpool.disable_abandon += ERTS_ALC_CPOOL_ALLOC_OP_INC; \ + if ((A)->cpool.disable_abandon > ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON) \ + (A)->cpool.disable_abandon = ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON; \ + } \ +} while (0) + + +#if ERTS_ALC_CPOOL_ALLOC_OP_INC >= ERTS_ALC_CPOOL_FREE_OP_DEC +# error "Implementation assume ERTS_ALC_CPOOL_ALLOC_OP_INC < ERTS_ALC_CPOOL_FREE_OP_DEC" +#endif + +#define ERTS_ALC_CPOOL_REALLOC_OP(A) \ +do { \ + if ((A)->cpool.disable_abandon) { \ + (A)->cpool.disable_abandon -= (ERTS_ALC_CPOOL_FREE_OP_DEC \ + - ERTS_ALC_CPOOL_ALLOC_OP_INC); \ + if ((A)->cpool.disable_abandon < 0) \ + (A)->cpool.disable_abandon = 0; \ + } \ +} while (0) + +#define ERTS_ALC_CPOOL_FREE_OP(A) \ +do { \ + if ((A)->cpool.disable_abandon) { \ + (A)->cpool.disable_abandon -= ERTS_ALC_CPOOL_FREE_OP_DEC; \ + if ((A)->cpool.disable_abandon < 0) \ + (A)->cpool.disable_abandon = 0; \ + } \ +} while (0) + +#else +#define ERTS_ALC_CPOOL_ALLOC_OP(A) +#define ERTS_ALC_CPOOL_REALLOC_OP(A) +#define ERTS_ALC_CPOOL_FREE_OP(A) +#endif + +#define ERTS_CRR_ALCTR_FLG_IN_POOL (((erts_aint_t) 1) << 0) +#define ERTS_CRR_ALCTR_FLG_BUSY (((erts_aint_t) 1) << 1) + +#ifdef ERTS_SMP +#define SBC_HEADER_SIZE \ + (UNIT_CEILING(sizeof(Carrier_t) \ + - sizeof(ErtsAlcCPoolData_t) \ + + ABLK_HDR_SZ) \ + - ABLK_HDR_SZ) +#else +#define SBC_HEADER_SIZE \ + (UNIT_CEILING(sizeof(Carrier_t) \ + + ABLK_HDR_SZ) \ + - ABLK_HDR_SZ) +#endif +#define MBC_HEADER_SIZE(AP) ((AP)->mbc_header_size) #define MSEG_CARRIER_HDR_FLAG (((UWord) 1) << 0) @@ -352,7 +401,8 @@ MBC after deallocating first block: #define SCH_SBC SBC_CARRIER_HDR_FLAG #define SET_CARRIER_HDR(C, Sz, F, AP) \ - (ASSERT(((Sz) & FLG_MASK) == 0), (C)->chdr = ((Sz) | (F)), (C)->allctr = (AP)) + (ASSERT(((Sz) & FLG_MASK) == 0), (C)->chdr = ((Sz) | (F)), \ + erts_smp_atomic_init_nob(&(C)->allctr, (erts_aint_t) (AP))) #define BLK_TO_SBC(B) \ ((Carrier_t *) (((char *) (B)) - SBC_HEADER_SIZE)) @@ -385,6 +435,7 @@ MBC after deallocating first block: #define CFLG_FORCE_SYS_ALLOC (1 << 3) #define CFLG_FORCE_SIZE (1 << 4) #define CFLG_MAIN_CARRIER (1 << 5) +#define CFLG_NO_CPOOL (1 << 6) #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG static void check_blk_carrier(Allctr_t *, Block_t *); @@ -412,11 +463,7 @@ static void check_blk_carrier(Allctr_t *, Block_t *); ASSERT(((AP)->mbcs.curr.norm.sys_alloc.no \ && (AP)->mbcs.curr.norm.sys_alloc.size) \ || (!(AP)->mbcs.curr.norm.sys_alloc.no \ - && !(AP)->mbcs.curr.norm.sys_alloc.size)); \ - ASSERT(((AP)->sbmbcs.curr.small_block.no \ - && (AP)->sbmbcs.curr.small_block.size) \ - || (!(AP)->sbmbcs.curr.small_block.no \ - && !(AP)->sbmbcs.curr.small_block.size)) + && !(AP)->mbcs.curr.norm.sys_alloc.size)); #else #define DEBUG_CHECK_CARRIER_NO_SZ(AP) @@ -487,17 +534,6 @@ do { \ + (AP)->mbcs.curr.norm.sys_alloc.size) -#define STAT_SBMBC_ALLOC(AP, CSZ) \ -do { \ - (AP)->sbmbcs.curr.small_block.no++; \ - (AP)->sbmbcs.curr.small_block.size += (CSZ); \ - if ((AP)->sbmbcs.max.no < (AP)->sbmbcs.curr.small_block.no) \ - (AP)->sbmbcs.max.no = (AP)->sbmbcs.curr.small_block.no; \ - if ((AP)->sbmbcs.max.size < (AP)->sbmbcs.curr.small_block.size) \ - (AP)->sbmbcs.max.size = (AP)->sbmbcs.curr.small_block.size; \ - DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ -} while (0) - #define STAT_MSEG_MBC_ALLOC(AP, CSZ) \ do { \ (AP)->mbcs.curr.norm.mseg.no++; \ @@ -514,13 +550,19 @@ do { \ DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ } while (0) -#define STAT_SBMBC_FREE(AP, CSZ) \ +#define STAT_MBC_CPOOL_FETCH(AP, CRR) \ do { \ - ASSERT((AP)->sbmbcs.curr.small_block.no > 0); \ - (AP)->sbmbcs.curr.small_block.no--; \ - ASSERT((AP)->sbmbcs.curr.small_block.size >= (CSZ)); \ - (AP)->sbmbcs.curr.small_block.size -= (CSZ); \ - DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ + UWord csz__ = CARRIER_SZ((CRR)); \ + if (IS_MSEG_CARRIER((CRR))) \ + STAT_MSEG_MBC_ALLOC((AP), csz__); \ + else \ + STAT_SYS_ALLOC_MBC_ALLOC((AP), csz__); \ + (AP)->mbcs.blocks.curr.no += (CRR)->cpool.blocks; \ + if ((AP)->mbcs.blocks.max.no < (AP)->mbcs.blocks.curr.no) \ + (AP)->mbcs.blocks.max.no = (AP)->mbcs.blocks.curr.no; \ + (AP)->mbcs.blocks.curr.size += (CRR)->cpool.blocks_size; \ + if ((AP)->mbcs.blocks.max.size < (AP)->mbcs.blocks.curr.size) \ + (AP)->mbcs.blocks.max.size = (AP)->mbcs.blocks.curr.size; \ } while (0) #define STAT_MSEG_MBC_FREE(AP, CSZ) \ @@ -541,28 +583,88 @@ do { \ DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ } while (0) -#define STAT_MBC_BLK_ALLOC(AP, BSZ, FLGS) \ +#define STAT_MBC_CPOOL_INSERT(AP, CRR) \ +do { \ + UWord csz__ = CARRIER_SZ((CRR)); \ + if (IS_MSEG_CARRIER((CRR))) \ + STAT_MSEG_MBC_FREE((AP), csz__); \ + else \ + STAT_SYS_ALLOC_MBC_FREE((AP), csz__); \ + ERTS_ALC_CPOOL_ASSERT((AP)->mbcs.blocks.curr.no \ + >= (CRR)->cpool.blocks); \ + (AP)->mbcs.blocks.curr.no -= (CRR)->cpool.blocks; \ + ERTS_ALC_CPOOL_ASSERT((AP)->mbcs.blocks.curr.size \ + >= (CRR)->cpool.blocks_size); \ + (AP)->mbcs.blocks.curr.size -= (CRR)->cpool.blocks_size; \ +} while (0) + +#ifdef ERTS_SMP +#define STAT_MBC_BLK_ALLOC_CRR(CRR, BSZ) \ +do { \ + (CRR)->cpool.blocks++; \ + (CRR)->cpool.blocks_size += (BSZ); \ +} while (0) +#else +#define STAT_MBC_BLK_ALLOC_CRR(CRR, BSZ) ((void) (CRR)) /* Get rid of warning */ +#endif + +#define STAT_MBC_BLK_ALLOC(AP, CRR, BSZ, FLGS) \ do { \ - CarriersStats_t *cstats__ = (((FLGS) & ERTS_ALCU_FLG_SBMBC) \ - ? &(AP)->sbmbcs \ - : &(AP)->mbcs); \ + CarriersStats_t *cstats__ = &(AP)->mbcs; \ cstats__->blocks.curr.no++; \ if (cstats__->blocks.max.no < cstats__->blocks.curr.no) \ cstats__->blocks.max.no = cstats__->blocks.curr.no; \ cstats__->blocks.curr.size += (BSZ); \ if (cstats__->blocks.max.size < cstats__->blocks.curr.size) \ cstats__->blocks.max.size = cstats__->blocks.curr.size; \ + STAT_MBC_BLK_ALLOC_CRR((CRR), (BSZ)); \ } while (0) -#define STAT_MBC_BLK_FREE(AP, BSZ, FLGS) \ +static ERTS_INLINE int +stat_cpool_mbc_blk_free(Allctr_t *allctr, + Carrier_t *crr, + Carrier_t **busy_pcrr_pp, + UWord blksz) +{ +#ifdef ERTS_SMP + + ERTS_ALC_CPOOL_ASSERT(crr->cpool.blocks > 0); + crr->cpool.blocks--; + ERTS_ALC_CPOOL_ASSERT(crr->cpool.blocks_size >= blksz); + crr->cpool.blocks_size -= blksz; + + if (!busy_pcrr_pp || !*busy_pcrr_pp) + return 0; + + ERTS_ALC_CPOOL_ASSERT(crr == *busy_pcrr_pp); + +#ifdef ERTS_ALC_CPOOL_DEBUG + ERTS_ALC_CPOOL_ASSERT( + erts_atomic_dec_read_nob(&allctr->cpool.stat.no_blocks) >= 0); + ERTS_ALC_CPOOL_ASSERT( + erts_atomic_add_read_nob(&allctr->cpool.stat.blocks_size, + -((erts_aint_t) blksz)) >= 0); +#else + erts_atomic_dec_nob(&allctr->cpool.stat.no_blocks); + erts_atomic_add_nob(&allctr->cpool.stat.blocks_size, + -((erts_aint_t) blksz)); +#endif + + return 1; +#else + return 0; +#endif +} + +#define STAT_MBC_BLK_FREE(AP, CRR, BPCRRPP, BSZ, FLGS) \ do { \ - CarriersStats_t *cstats__ = (((FLGS) & ERTS_ALCU_FLG_SBMBC) \ - ? &(AP)->sbmbcs \ - : &(AP)->mbcs); \ - ASSERT(cstats__->blocks.curr.no > 0); \ - cstats__->blocks.curr.no--; \ - ASSERT(cstats__->blocks.curr.size >= (BSZ)); \ - cstats__->blocks.curr.size -= (BSZ); \ + if (!stat_cpool_mbc_blk_free((AP), (CRR), (BPCRRPP), (BSZ))) { \ + CarriersStats_t *cstats__ = &(AP)->mbcs; \ + ASSERT(cstats__->blocks.curr.no > 0); \ + cstats__->blocks.curr.no--; \ + ASSERT(cstats__->blocks.curr.size >= (BSZ)); \ + cstats__->blocks.curr.size -= (BSZ); \ + } \ } while (0) /* Debug stuff... */ @@ -613,13 +715,42 @@ do { \ #define ERTS_ALCU_DBG_CHK_THR_ACCESS(A) #endif - static void make_name_atoms(Allctr_t *allctr); static Block_t *create_carrier(Allctr_t *, Uint, UWord); -static void destroy_carrier(Allctr_t *, Block_t *); -static void mbc_free(Allctr_t *allctr, void *p); +static void destroy_carrier(Allctr_t *, Block_t *, Carrier_t **); +static void mbc_free(Allctr_t *allctr, void *p, Carrier_t **busy_pcrr_pp); +static void dealloc_block(Allctr_t *, void *, int); + +/* internal data... */ + +#if 0 + +static ERTS_INLINE void * +internal_alloc(UWord size) +{ + void *res = erts_sys_alloc(0, NULL, size); + if (!res) + erts_alloc_enomem(ERTS_ALC_T_UNDEF, size); + return res; +} +static ERTS_INLINE void * +internal_realloc(void *ptr, UWord size) +{ + void *res = erts_sys_realloc(0, NULL, ptr, size); + if (!res) + erts_alloc_enomem(ERTS_ALC_T_UNDEF, size); + return res; +} + +static ERTS_INLINE void +internal_free(void *ptr) +{ + erts_sys_free(0, NULL, ptr); +} + +#endif /* mseg ... */ @@ -781,10 +912,35 @@ unlink_carrier(CarrierList_t *cl, Carrier_t *crr) } } -static Block_t *create_sbmbc(Allctr_t *allctr, Uint umem_sz); -static void destroy_sbmbc(Allctr_t *allctr, Block_t *blk); -static Block_t *create_carrier(Allctr_t *, Uint, UWord); -static void destroy_carrier(Allctr_t *, Block_t *); +#ifdef ERTS_SMP + +static ERTS_INLINE void +clear_busy_pool_carrier(Allctr_t *allctr, Carrier_t *crr) +{ + if (crr) { + erts_aint_t max_size; + erts_aint_t new_val; + + max_size = (erts_aint_t) allctr->largest_fblk_in_mbc(allctr, crr); + erts_atomic_set_nob(&crr->cpool.max_size, max_size); + + new_val = (((erts_aint_t) allctr)|ERTS_CRR_ALCTR_FLG_IN_POOL); + +#ifdef ERTS_ALC_CPOOL_DEBUG + { + erts_aint_t old_val = new_val|ERTS_CRR_ALCTR_FLG_BUSY; + + ERTS_ALC_CPOOL_ASSERT(old_val + == erts_smp_atomic_xchg_relb(&crr->allctr, + new_val)); + } +#else + erts_smp_atomic_set_relb(&crr->allctr, new_val); +#endif + } +} + +#endif #if 0 #define ERTS_DBG_CHK_FIX_LIST(A, FIX, IX, B) \ @@ -806,13 +962,154 @@ chk_fix_list(Allctr_t *allctr, ErtsAlcFixList_t *fix, int ix, int before) #define ERTS_DBG_CHK_FIX_LIST(A, FIX, IX, B) #endif -erts_aint32_t -erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs) +static void *mbc_alloc(Allctr_t *allctr, Uint size); + +#ifdef ERTS_SMP +typedef struct { + ErtsAllctrDDBlock_t ddblock__; /* must be first */ + ErtsAlcType_t fix_type; +} ErtsAllctrFixDDBlock_t; +#endif + +static ERTS_INLINE void +dealloc_fix_block(Allctr_t *allctr, + ErtsAlcType_t type, + void *ptr, + int dec_cc_on_redirect) +{ +#ifdef ERTS_SMP + /* May be redirected... */ + ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type = type; +#endif + dealloc_block(allctr, ptr, dec_cc_on_redirect); +} + +static ERTS_INLINE void +sched_fix_shrink(Allctr_t *allctr, int on) +{ + if (on && !allctr->fix_shrink_scheduled) { + allctr->fix_shrink_scheduled = 1; + erts_set_aux_work_timeout(allctr->ix, + (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM + | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC), + 1); + } + else if (!on && allctr->fix_shrink_scheduled) { + allctr->fix_shrink_scheduled = 0; + erts_set_aux_work_timeout(allctr->ix, + (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM + | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC), + 0); + } +} + +static ERTS_INLINE void +fix_cpool_check_shrink(Allctr_t *allctr, + ErtsAlcType_t type, + ErtsAlcFixList_t *fix, + Carrier_t **busy_pcrr_pp) +{ + if (fix->u.cpool.shrink_list > 0) { + if (fix->list_size == 0) + fix->u.cpool.shrink_list = 0; + else { + void *p; +#ifdef ERTS_SMP + if (busy_pcrr_pp) { + clear_busy_pool_carrier(allctr, *busy_pcrr_pp); + *busy_pcrr_pp = NULL; + } +#endif + fix->u.cpool.shrink_list--; + p = fix->list; + fix->list = *((void **) p); + fix->list_size--; + if (fix->u.cpool.min_list_size > fix->list_size) + fix->u.cpool.min_list_size = fix->list_size; + + fix->u.cpool.allocated--; + dealloc_fix_block(allctr, type, p, 0); + } + } +} + +static ERTS_INLINE void * +fix_cpool_alloc(Allctr_t *allctr, ErtsAlcType_t type, Uint size) +{ + void *res; + ErtsAlcFixList_t *fix; + + ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type + && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE); + + fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE]; + + res = fix->list; + if (res) { + fix->list = *((void **) res); + fix->list_size--; + if (fix->u.cpool.min_list_size > fix->list_size) + fix->u.cpool.min_list_size = fix->list_size; + fix->u.cpool.used++; + fix_cpool_check_shrink(allctr, type, fix, NULL); + return res; + } + if (size < 2*sizeof(UWord)) + size += sizeof(UWord); + if (size >= allctr->sbc_threshold) { + Block_t *blk; + blk = create_carrier(allctr, size, CFLG_SBC); + res = blk ? BLK2UMEM(blk) : NULL; + } + else + res = mbc_alloc(allctr, size); + if (res) { + fix->u.cpool.used++; + fix->u.cpool.allocated++; + } + return res; +} + +static ERTS_INLINE void +fix_cpool_free(Allctr_t *allctr, + ErtsAlcType_t type, + void *p, + Carrier_t **busy_pcrr_pp) +{ + ErtsAlcFixList_t *fix; + + ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type + && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE); + + fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE]; + + fix->u.cpool.used--; + + if ((!busy_pcrr_pp || !*busy_pcrr_pp) + && !fix->u.cpool.shrink_list + && fix->list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) { + *((void **) p) = fix->list; + fix->list = p; + fix->list_size++; + sched_fix_shrink(allctr, 1); + } + else { + Block_t *blk = UMEM2BLK(p); + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk, NULL); + else + mbc_free(allctr, p, busy_pcrr_pp); + fix->u.cpool.allocated--; + fix_cpool_check_shrink(allctr, type, fix, busy_pcrr_pp); + } +} + +static ERTS_INLINE erts_aint32_t +fix_cpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs) { int all_empty = 1; erts_aint32_t res = 0; int ix, o; - ErtsAlcFixList_t *fix = allctr->fix; int flush = flgs == 0; #ifdef USE_THREADS @@ -821,56 +1118,204 @@ erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs) #endif for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) { + ErtsAlcFixList_t *fix = &allctr->fix[ix]; + ErtsAlcType_t type; ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); - if (flgs & ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM) { - fix[ix].limit = fix[ix].max_used; - if (fix[ix].limit < fix[ix].used) - fix[ix].limit = fix[ix].used; - fix[ix].max_used = fix[ix].used; - ASSERT(fix[ix].limit >= 0); - - } - if (flush) { - fix[ix].limit = 0; - fix[ix].max_used = fix[ix].used; - ASSERT(fix[ix].limit >= 0); + if (flush) + fix->u.cpool.shrink_list = fix->list_size; + else if (flgs & ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM) { + fix->u.cpool.shrink_list = fix->u.cpool.min_list_size; + fix->u.cpool.min_list_size = fix->list_size; } + type = (ErtsAlcType_t) (ix + ERTS_ALC_N_MIN_A_FIXED_SIZE); for (o = 0; o < ERTS_ALC_FIX_MAX_SHRINK_OPS || flush; o++) { - Block_t *blk; void *ptr; - if (!flush && fix[ix].limit >= fix[ix].allocated) + if (fix->u.cpool.shrink_list == 0) break; - if (fix[ix].list_size == 0) + if (fix->list_size == 0) { + fix->u.cpool.shrink_list = 0; break; - ptr = fix[ix].list; - fix[ix].list = *((void **) ptr); - fix[ix].list_size--; + } + ptr = fix->list; + fix->list = *((void **) ptr); + fix->list_size--; + fix->u.cpool.shrink_list--; + fix->u.cpool.allocated--; + dealloc_fix_block(allctr, type, ptr, 0); + } + if (fix->u.cpool.min_list_size > fix->list_size) + fix->u.cpool.min_list_size = fix->list_size; + if (fix->list_size != 0) { + if (fix->u.cpool.shrink_list > 0) + res |= ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC; + all_empty = 0; + } + } + + if (all_empty) + sched_fix_shrink(allctr, 0); + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_unlock(&allctr->mutex); +#endif - blk = UMEM2BLK(ptr); + return res; +} +static ERTS_INLINE void * +fix_nocpool_alloc(Allctr_t *allctr, ErtsAlcType_t type, Uint size) +{ + ErtsAlcFixList_t *fix; + void *res; + + ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type + && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE); + + fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE]; + + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); + fix->u.nocpool.used++; + res = fix->list; + if (res) { + fix->list_size--; + fix->list = *((void **) res); + if (fix->list && fix->u.nocpool.allocated > fix->u.nocpool.limit) { + Block_t *blk; + void *p = fix->list; + fix->list = *((void **) p); + fix->list_size--; + blk = UMEM2BLK(p); if (IS_SBC_BLK(blk)) - destroy_carrier(allctr, blk); + destroy_carrier(allctr, blk, NULL); else - mbc_free(allctr, ptr); + mbc_free(allctr, p, NULL); + fix->u.nocpool.allocated--; + } + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); + return res; + } + if (size < 2*sizeof(UWord)) + size += sizeof(UWord); + if (fix->u.nocpool.limit < fix->u.nocpool.used) + fix->u.nocpool.limit = fix->u.nocpool.used; + if (fix->u.nocpool.max_used < fix->u.nocpool.used) + fix->u.nocpool.max_used = fix->u.nocpool.used; + fix->u.nocpool.allocated++; - fix[ix].allocated--; + if (size >= allctr->sbc_threshold) { + Block_t *blk; + blk = create_carrier(allctr, size, CFLG_SBC); + res = blk ? BLK2UMEM(blk) : NULL; + } + else + res = mbc_alloc(allctr, size); + + if (!res) { + fix->u.nocpool.allocated--; + fix->u.nocpool.used--; + } + return res; +} + +static ERTS_INLINE void +fix_nocpool_free(Allctr_t *allctr, + ErtsAlcType_t type, + void *p) +{ + Block_t *blk; + ErtsAlcFixList_t *fix; + + ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type + && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE); + + fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE]; + + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); + fix->u.nocpool.used--; + if (fix->u.nocpool.allocated < fix->u.nocpool.limit + && fix->list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) { + *((void **) p) = fix->list; + fix->list = p; + fix->list_size++; + sched_fix_shrink(allctr, 1); + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); + return; + } + fix->u.nocpool.allocated--; + if (fix->list && fix->u.nocpool.allocated > fix->u.nocpool.limit) { + blk = UMEM2BLK(p); + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk, NULL); + else + mbc_free(allctr, p, NULL); + p = fix->list; + fix->list = *((void **) p); + fix->list_size--; + fix->u.nocpool.allocated--; + } + + blk = UMEM2BLK(p); + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk, NULL); + else + mbc_free(allctr, p, NULL); + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); +} + +static ERTS_INLINE erts_aint32_t +fix_nocpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs) +{ + int all_empty = 1; + erts_aint32_t res = 0; + int ix, o; + int flush = flgs == 0; + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_lock(&allctr->mutex); +#endif + + for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) { + ErtsAlcFixList_t *fix = &allctr->fix[ix]; + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); + if (flgs & ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM) { + fix->u.nocpool.limit = fix->u.nocpool.max_used; + if (fix->u.nocpool.limit < fix->u.nocpool.used) + fix->u.nocpool.limit = fix->u.nocpool.used; + fix->u.nocpool.max_used = fix->u.nocpool.used; + ASSERT(fix->u.nocpool.limit >= 0); + + } + if (flush) { + fix->u.nocpool.limit = 0; + fix->u.nocpool.max_used = fix->u.nocpool.used; + ASSERT(fix->u.nocpool.limit >= 0); } - if (fix[ix].list_size != 0) { - if (fix[ix].limit < fix[ix].allocated) + for (o = 0; o < ERTS_ALC_FIX_MAX_SHRINK_OPS || flush; o++) { + void *ptr; + + if (!flush && fix->u.nocpool.limit >= fix->u.nocpool.allocated) + break; + if (fix->list_size == 0) + break; + ptr = fix->list; + fix->list = *((void **) ptr); + fix->list_size--; + dealloc_block(allctr, ptr, 0); + fix->u.nocpool.allocated--; + } + if (fix->list_size != 0) { + if (fix->u.nocpool.limit < fix->u.nocpool.allocated) res |= ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC; all_empty = 0; } ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); } - if (all_empty && allctr->fix_shrink_scheduled) { - allctr->fix_shrink_scheduled = 0; - erts_set_aux_work_timeout(allctr->ix, - (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM - | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC), - 0); - } + if (all_empty) + sched_fix_shrink(allctr, 0); #ifdef USE_THREADS if (allctr->thread_safe) @@ -880,13 +1325,18 @@ erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs) return res; } -#ifdef ERTS_SMP +erts_aint32_t +erts_alcu_fix_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs) +{ + if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + return fix_cpool_alloc_shrink(allctr, flgs); + else + return fix_nocpool_alloc_shrink(allctr, flgs); +} -typedef struct { - ErtsAllctrDDBlock_t ddblock__; /* must be first */ - ErtsAlcType_t fix_type; -}ErtsAllctrFixDDBlock_t; +static void dealloc_carrier(Allctr_t *allctr, Carrier_t *crr, Uint mseg_flags); +#ifdef ERTS_SMP static ERTS_INLINE Allctr_t* get_pref_allctr(void *extra) @@ -902,6 +1352,9 @@ get_pref_allctr(void *extra) return tspec->allctr[pref_ix]; } +#define ERTS_ALC_TS_PREF_LOCK_IF_USED (1) +#define ERTS_ALC_TS_PREF_LOCK_NO (0) + /* SMP note: * get_used_allctr() must be safe WITHOUT locking the allocator while * concurrent threads may be updating adjacent blocks. @@ -910,22 +1363,85 @@ get_pref_allctr(void *extra) * the "PREV_FREE" flag bit. */ static ERTS_INLINE Allctr_t* -get_used_allctr(void *extra, void *p, UWord *sizep) +get_used_allctr(Allctr_t *pref_allctr, int pref_lock, void *p, UWord *sizep, + Carrier_t **busy_pcrr_pp) { Block_t* blk = UMEM2BLK(p); - Carrier_t* crr; + Carrier_t *crr; + erts_aint_t iallctr; + Allctr_t *used_allctr; + + *busy_pcrr_pp = NULL; if (IS_SBC_BLK(blk)) { crr = BLK_TO_SBC(blk); if (sizep) *sizep = SBC_BLK_SZ(blk) - ABLK_HDR_SZ; + iallctr = erts_smp_atomic_read_dirty(&crr->allctr); } else { crr = ABLK_TO_MBC(blk); + if (sizep) *sizep = MBC_ABLK_SZ(blk) - ABLK_HDR_SZ; + if (!ERTS_ALC_IS_CPOOL_ENABLED(pref_allctr)) + iallctr = erts_smp_atomic_read_dirty(&crr->allctr); + else { + int locked_pref_allctr = 0; + iallctr = erts_smp_atomic_read_ddrb(&crr->allctr); + + if (ERTS_ALC_TS_PREF_LOCK_IF_USED == pref_lock + && pref_allctr->thread_safe) { + used_allctr = (Allctr_t *) (iallctr & ~FLG_MASK); + if (pref_allctr == used_allctr) { + erts_mtx_lock(&pref_allctr->mutex); + locked_pref_allctr = 1; + } + } + + while ((iallctr & ((~FLG_MASK)|ERTS_CRR_ALCTR_FLG_IN_POOL)) + == (((erts_aint_t) pref_allctr)|ERTS_CRR_ALCTR_FLG_IN_POOL)) { + erts_aint_t act; + + ERTS_ALC_CPOOL_ASSERT(!(iallctr & ERTS_CRR_ALCTR_FLG_BUSY)); + act = erts_smp_atomic_cmpxchg_ddrb(&crr->allctr, + iallctr|ERTS_CRR_ALCTR_FLG_BUSY, + iallctr); + if (act == iallctr) { + *busy_pcrr_pp = crr; + break; + } + iallctr = act; + } + + used_allctr = (Allctr_t *) (iallctr & ~FLG_MASK); + + if (ERTS_ALC_TS_PREF_LOCK_IF_USED == pref_lock) { + if (locked_pref_allctr && used_allctr != pref_allctr) { + /* Was taken out of pool; now owned by someone else */ + erts_mtx_unlock(&pref_allctr->mutex); + } + } + + ERTS_ALC_CPOOL_ASSERT( + (((iallctr & ~FLG_MASK) == (erts_aint_t) pref_allctr) + ? (((iallctr & FLG_MASK) == ERTS_CRR_ALCTR_FLG_IN_POOL) + || ((iallctr & FLG_MASK) == 0)) + : 1)); + + return used_allctr; + } + } + + used_allctr = (Allctr_t *) (iallctr & ~FLG_MASK); + + if (ERTS_ALC_TS_PREF_LOCK_IF_USED == pref_lock + && used_allctr == pref_allctr + && pref_allctr->thread_safe) { + erts_mtx_lock(&pref_allctr->mutex); } - return crr->allctr; + + return used_allctr; } static void @@ -1020,7 +1536,7 @@ check_insert_marker(ErtsAllctrDDQueue_t *ddq, erts_aint_t ilast) } static ERTS_INLINE int -ddq_enqueue(ErtsAlcType_t type, ErtsAllctrDDQueue_t *ddq, void *ptr, int cinit) +ddq_enqueue(ErtsAllctrDDQueue_t *ddq, void *ptr, int cinit) { int last_elem; int um_refc_ix = 0; @@ -1121,6 +1637,59 @@ store_earliest_thr_prgr(ErtsThrPrgrVal *prev_val, ErtsAllctrDDQueue_t *ddq) } } +static void +check_pending_dealloc_carrier(Allctr_t *allctr, + int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, + int *need_more_work); + +static void +handle_delayed_fix_dealloc(Allctr_t *allctr, void *ptr) +{ + ErtsAlcType_t type; + + type = ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type; + + ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type + && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE); + + if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + fix_nocpool_free(allctr, type, ptr); + else { + Block_t *blk = UMEM2BLK(ptr); + Carrier_t *busy_pcrr_p; + Allctr_t *used_allctr; + + if (IS_SBC_BLK(blk)) { + busy_pcrr_p = NULL; + goto doit; + } + + used_allctr = get_used_allctr(allctr, ERTS_ALC_TS_PREF_LOCK_NO, ptr, + NULL, &busy_pcrr_p); + if (used_allctr == allctr) { + doit: + fix_cpool_free(allctr, type, ptr, &busy_pcrr_p); + clear_busy_pool_carrier(allctr, busy_pcrr_p); + } + else { + /* Carrier migrated; need to redirect block to new owner... */ + int cinit = used_allctr->dd.ix - allctr->dd.ix; + + ERTS_ALC_CPOOL_ASSERT(!busy_pcrr_p); + + DEC_CC(allctr->calls.this_free); + + ((ErtsAllctrFixDDBlock_t *) ptr)->fix_type = type; + if (ddq_enqueue(&used_allctr->dd.q, ptr, cinit)) + erts_alloc_notify_delayed_dealloc(used_allctr->ix); + } + } +} + +static void +schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr); + static ERTS_INLINE int handle_delayed_dealloc(Allctr_t *allctr, int allctr_locked, @@ -1152,7 +1721,6 @@ handle_delayed_dealloc(Allctr_t *allctr, while (1) { Block_t *blk; void *ptr; - int ix; if (use_limit && ++ops > ops_limit) { if (ddq->head.first != ddq->head.unref_end) { @@ -1181,52 +1749,29 @@ handle_delayed_dealloc(Allctr_t *allctr, res = 1; - INC_CC(allctr->calls.this_free); - - if (fix) { - ErtsAlcType_t type; - - type = ((ErtsAllctrFixDDBlock_t*) ptr)->fix_type; - ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE; - ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); - fix[ix].used--; - if (fix[ix].allocated < fix[ix].limit - && fix[ix].list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) { - *((void **) ptr) = fix[ix].list; - fix[ix].list = ptr; - fix[ix].list_size++; - if (!allctr->fix_shrink_scheduled) { - allctr->fix_shrink_scheduled = 1; - erts_set_aux_work_timeout( - allctr->ix, - (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM - | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC), - 1); - } - ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); - continue; - } - fix[ix].allocated--; - if (fix[ix].list && fix[ix].allocated > fix[ix].limit) { - blk = UMEM2BLK(ptr); - if (IS_SBC_BLK(blk)) - destroy_carrier(allctr, blk); - else - mbc_free(allctr, ptr); - ptr = fix[ix].list; - fix[ix].list = *((void **) ptr); - fix[ix].list_size--; - fix[ix].allocated--; - } + blk = UMEM2BLK(ptr); + if (IS_FREE_LAST_MBC_BLK(blk)) { + /* + * A multiblock carrier that previously has been migrated away + * from us and now is back to be deallocated... + * + * Note that we cannot use FBLK_TO_MBC(blk) since it + * data has been overwritten by the queue. + */ + Carrier_t *crr = FIRST_BLK_TO_MBC(allctr, blk); + ERTS_ALC_CPOOL_ASSERT(ERTS_ALC_IS_CPOOL_ENABLED(allctr)); + ERTS_ALC_CPOOL_ASSERT(allctr == crr->cpool.orig_allctr); + schedule_dealloc_carrier(allctr, crr); } + else { - blk = UMEM2BLK(ptr); + INC_CC(allctr->calls.this_free); - if (IS_SBC_BLK(blk)) - destroy_carrier(allctr, blk); - else - mbc_free(allctr, ptr); - ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); + if (fix) + handle_delayed_fix_dealloc(allctr, ptr); + else + dealloc_block(allctr, ptr, 1); + } } if (need_thr_progress && !(need_thr_prgr | need_mr_wrk)) { @@ -1236,6 +1781,12 @@ handle_delayed_dealloc(Allctr_t *allctr, store_earliest_thr_prgr(thr_prgr_p, ddq); } + if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + check_pending_dealloc_carrier(allctr, + need_thr_progress, + thr_prgr_p, + need_more_work); + if (allctr->thread_safe && !allctr_locked) erts_mtx_unlock(&allctr->mutex); return res; @@ -1250,13 +1801,59 @@ enqueue_dealloc_other_instance(ErtsAlcType_t type, if (allctr->fix) ((ErtsAllctrFixDDBlock_t*) ptr)->fix_type = type; - if (ddq_enqueue(type, &allctr->dd.q, ptr, cinit)) + if (ddq_enqueue(&allctr->dd.q, ptr, cinit)) erts_alloc_notify_delayed_dealloc(allctr->ix); } #endif #ifdef ERTS_SMP +static void +set_new_allctr_abandon_limit(Allctr_t *allctr); +static void +abandon_carrier(Allctr_t *allctr, Carrier_t *crr); + + +static ERTS_INLINE void +check_abandon_carrier(Allctr_t *allctr, Block_t *fblk, Carrier_t **busy_pcrr_pp) +{ + Carrier_t *crr; + + if (busy_pcrr_pp && *busy_pcrr_pp) + return; + + if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + return; + + allctr->cpool.check_limit_count--; + if (--allctr->cpool.check_limit_count <= 0) + set_new_allctr_abandon_limit(allctr); + + if (!erts_thr_progress_is_managed_thread()) + return; + + if (allctr->cpool.disable_abandon) + return; + + if (allctr->mbcs.blocks.curr.size > allctr->cpool.abandon_limit) + return; + + + crr = FBLK_TO_MBC(fblk); + + if (allctr->main_carrier == crr) + return; + + if (crr->cpool.blocks_size > crr->cpool.abandon_limit) + return; + + if (crr->cpool.thr_prgr != ERTS_THR_PRGR_INVALID + && !erts_thr_progress_has_reached(crr->cpool.thr_prgr)) + return; + + abandon_carrier(allctr, crr); +} + void erts_alcu_check_delayed_dealloc(Allctr_t *allctr, int limit, @@ -1274,78 +1871,88 @@ erts_alcu_check_delayed_dealloc(Allctr_t *allctr, } #endif -#define ERTS_ALCU_HANDLE_DD_IN_OP(Allctr, Locked) \ - handle_delayed_dealloc((Allctr), (Locked), 1, \ +#define ERTS_ALCU_HANDLE_DD_IN_OP(Allctr, Locked) \ + handle_delayed_dealloc((Allctr), (Locked), 1, \ ERTS_ALCU_DD_OPS_LIM_LOW, NULL, NULL, NULL) +static void +dealloc_block(Allctr_t *allctr, void *ptr, int dec_cc_on_redirect) +{ + Block_t *blk = UMEM2BLK(ptr); + + ERTS_SMP_LC_ASSERT(!allctr->thread_safe + || erts_lc_mtx_is_locked(&allctr->mutex)); + + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk, NULL); +#ifndef ERTS_SMP + else + mbc_free(allctr, ptr, NULL); +#else + else if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + mbc_free(allctr, ptr, NULL); + else { + Carrier_t *busy_pcrr_p; + Allctr_t *used_allctr; + used_allctr = get_used_allctr(allctr, ERTS_ALC_TS_PREF_LOCK_NO, ptr, + NULL, &busy_pcrr_p); + if (used_allctr == allctr) { + mbc_free(allctr, ptr, &busy_pcrr_p); + clear_busy_pool_carrier(allctr, busy_pcrr_p); + } + else { + /* Carrier migrated; need to redirect block to new owner... */ + int cinit = used_allctr->dd.ix - allctr->dd.ix; + + ERTS_ALC_CPOOL_ASSERT(!busy_pcrr_p); + + if (dec_cc_on_redirect) + DEC_CC(allctr->calls.this_free); + if (ddq_enqueue(&used_allctr->dd.q, ptr, cinit)) + erts_alloc_notify_delayed_dealloc(used_allctr->ix); + } + } +#endif +} + /* Multi block carrier alloc/realloc/free ... */ /* NOTE! mbc_alloc() may in case of memory shortage place the requested * block in a sbc. */ static ERTS_INLINE void * -mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp, Uint32 *alcu_flgsp) +mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp) { Block_t *blk; Uint get_blk_sz; - Uint sbmbct; ASSERT(size); ASSERT(size < allctr->sbc_threshold); *blk_szp = get_blk_sz = UMEMSZ2BLKSZ(allctr, size); - sbmbct = allctr->sbmbc_threshold; - if (sbmbct) { - if (get_blk_sz < sbmbct) { - *alcu_flgsp |= ERTS_ALCU_FLG_SBMBC; - if (get_blk_sz + allctr->min_block_size > sbmbct) { - /* Since we use block size to determine if blocks are - located in sbmbc or not... */ - get_blk_sz += allctr->min_block_size; - } - } - } - -#ifdef ERTS_SMP - if (allctr->dd.use) - ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1); -#endif - - blk = (*allctr->get_free_block)(allctr, get_blk_sz, NULL, 0, *alcu_flgsp); - -#ifdef ERTS_SMP - if (!blk && allctr->dd.use) { - if (ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1)) - blk = (*allctr->get_free_block)(allctr, get_blk_sz, NULL, 0, - *alcu_flgsp); - } -#endif + blk = (*allctr->get_free_block)(allctr, get_blk_sz, NULL, 0); if (!blk) { - if ((*alcu_flgsp) & ERTS_ALCU_FLG_SBMBC) - blk = create_sbmbc(allctr, get_blk_sz); - else { - blk = create_carrier(allctr, get_blk_sz, CFLG_MBC); + blk = create_carrier(allctr, get_blk_sz, CFLG_MBC); #if !HALFWORD_HEAP && !HAVE_SUPER_ALIGNED_MB_CARRIERS - if (!blk) { - /* Emergency! We couldn't create the carrier as we wanted. - Try to place it in a sys_alloced sbc. */ - blk = create_carrier(allctr, - size, - (CFLG_SBC - | CFLG_FORCE_SIZE - | CFLG_FORCE_SYS_ALLOC)); - } -#endif + if (!blk) { + /* Emergency! We couldn't create the carrier as we wanted. + Try to place it in a sys_alloced sbc. */ + blk = create_carrier(allctr, + size, + (CFLG_SBC + | CFLG_FORCE_SIZE + | CFLG_FORCE_SYS_ALLOC)); } +#endif } #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG if (IS_MBC_BLK(blk)) { - (*allctr->link_free_block)(allctr, blk, *alcu_flgsp); + (*allctr->link_free_block)(allctr, blk); HARD_CHECK_BLK_CARRIER(allctr, blk); - (*allctr->unlink_free_block)(allctr, blk, *alcu_flgsp); + (*allctr->unlink_free_block)(allctr, blk); } #endif @@ -1359,8 +1966,7 @@ mbc_alloc_finalize(Allctr_t *allctr, UWord flags, Carrier_t *crr, Uint want_blk_sz, - int valid_blk_info, - Uint32 alcu_flgs) + int valid_blk_info) { Uint blk_sz; Uint nxt_blk_sz; @@ -1392,7 +1998,7 @@ mbc_alloc_finalize(Allctr_t *allctr, SET_PREV_BLK_FREE(allctr, nxt_nxt_blk); } } - (*allctr->link_free_block)(allctr, nxt_blk, alcu_flgs); + (*allctr->link_free_block)(allctr, nxt_blk); ASSERT(IS_NOT_LAST_BLK(blk)); ASSERT(IS_FREE_BLK(nxt_blk)); @@ -1433,7 +2039,8 @@ mbc_alloc_finalize(Allctr_t *allctr, ASSERT(ABLK_TO_MBC(blk) == crr); } - STAT_MBC_BLK_ALLOC(allctr, blk_sz, alcu_flgs); + ERTS_ALC_CPOOL_ALLOC_OP(allctr); + STAT_MBC_BLK_ALLOC(allctr, crr, blk_sz, alcu_flgs); ASSERT(IS_ALLOCED_BLK(blk)); ASSERT(blk_sz == MBC_BLK_SZ(blk)); @@ -1453,8 +2060,7 @@ mbc_alloc(Allctr_t *allctr, Uint size) { Block_t *blk; Uint blk_sz; - Uint32 alcu_flgs = 0; - blk = mbc_alloc_block(allctr, size, &blk_sz, &alcu_flgs); + blk = mbc_alloc_block(allctr, size, &blk_sz); if (!blk) return NULL; if (IS_MBC_BLK(blk)) @@ -1464,35 +2070,34 @@ mbc_alloc(Allctr_t *allctr, Uint size) GET_BLK_HDR_FLGS(blk), FBLK_TO_MBC(blk), blk_sz, - 1, - alcu_flgs); + 1); return BLK2UMEM(blk); } static void -mbc_free(Allctr_t *allctr, void *p) +mbc_free(Allctr_t *allctr, void *p, Carrier_t **busy_pcrr_pp) { Uint is_first_blk; Uint is_last_blk; - Uint32 alcu_flgs = 0; Uint blk_sz; Block_t *blk; Block_t *nxt_blk; - + Carrier_t *crr; ASSERT(p); blk = UMEM2BLK(p); blk_sz = MBC_ABLK_SZ(blk); - if (blk_sz < allctr->sbmbc_threshold) - alcu_flgs |= ERTS_ALCU_FLG_SBMBC; ASSERT(IS_MBC_BLK(blk)); ASSERT(blk_sz >= allctr->min_block_size); HARD_CHECK_BLK_CARRIER(allctr, blk); - STAT_MBC_BLK_FREE(allctr, blk_sz, alcu_flgs); + crr = ABLK_TO_MBC(blk); + + ERTS_ALC_CPOOL_FREE_OP(allctr); + STAT_MBC_BLK_FREE(allctr, crr, busy_pcrr_pp, blk_sz, alcu_flgs); is_first_blk = IS_MBC_FIRST_ABLK(allctr, blk); is_last_blk = IS_LAST_BLK(blk); @@ -1501,7 +2106,7 @@ mbc_free(Allctr_t *allctr, void *p) ASSERT(!is_first_blk); /* Coalesce with previous block... */ blk = PREV_BLK(blk); - (*allctr->unlink_free_block)(allctr, blk, alcu_flgs); + (*allctr->unlink_free_block)(allctr, blk); blk_sz += MBC_FBLK_SZ(blk); is_first_blk = IS_MBC_FIRST_FBLK(allctr, blk); @@ -1517,7 +2122,7 @@ mbc_free(Allctr_t *allctr, void *p) nxt_blk = BLK_AFTER(blk, blk_sz); if (IS_FREE_BLK(nxt_blk)) { /* Coalesce with next block... */ - (*allctr->unlink_free_block)(allctr, nxt_blk, alcu_flgs); + (*allctr->unlink_free_block)(allctr, nxt_blk); blk_sz += MBC_FBLK_SZ(nxt_blk); SET_MBC_FBLK_SZ(blk, blk_sz); @@ -1550,19 +2155,20 @@ mbc_free(Allctr_t *allctr, void *p) if (is_first_blk && is_last_blk && allctr->main_carrier != FIRST_BLK_TO_MBC(allctr, blk)) { - if (alcu_flgs & ERTS_ALCU_FLG_SBMBC) - destroy_sbmbc(allctr, blk); - else - destroy_carrier(allctr, blk); + destroy_carrier(allctr, blk, busy_pcrr_pp); } else { - (*allctr->link_free_block)(allctr, blk, alcu_flgs); + (*allctr->link_free_block)(allctr, blk); HARD_CHECK_BLK_CARRIER(allctr, blk); +#ifdef ERTS_SMP + check_abandon_carrier(allctr, blk, busy_pcrr_pp); +#endif } } static void * -mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) +mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs, + Carrier_t **busy_pcrr_pp) { void *new_p; Uint old_blk_sz; @@ -1576,11 +2182,6 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) Uint is_last_blk; #endif /* #ifndef MBC_REALLOC_ALWAYS_MOVES */ -#ifdef ERTS_SMP - if (allctr->dd.use) - ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1); -#endif - ASSERT(p); ASSERT(size); ASSERT(size < allctr->sbc_threshold); @@ -1594,13 +2195,13 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) if (alcu_flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) return NULL; #else /* !MBC_REALLOC_ALWAYS_MOVES */ + +#ifdef ERTS_SMP + if (busy_pcrr_pp && *busy_pcrr_pp) + goto realloc_move; /* Don't want to use carrier in pool */ +#endif + get_blk_sz = blk_sz = UMEMSZ2BLKSZ(allctr, size); - if ((alcu_flgs & ERTS_ALCU_FLG_SBMBC) - && (blk_sz + allctr->min_block_size > allctr->sbmbc_threshold)) { - /* Since we use block size to determine if blocks are - located in sbmbc or not... */ - get_blk_sz = blk_sz + allctr->min_block_size; - } ASSERT(IS_ALLOCED_BLK(blk)); ASSERT(IS_MBC_BLK(blk)); @@ -1648,8 +2249,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) new_blk = (*allctr->get_free_block)(allctr, get_blk_sz, cand_blk, - cand_blk_sz, - alcu_flgs); + cand_blk_sz); if (new_blk || cand_blk != blk) goto move_into_new_blk; } @@ -1671,8 +2271,11 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) nxt_blk = BLK_AFTER(blk, blk_sz); - STAT_MBC_BLK_FREE(allctr, old_blk_sz, alcu_flgs); - STAT_MBC_BLK_ALLOC(allctr, blk_sz, alcu_flgs); + crr = ABLK_TO_MBC(blk); + + ERTS_ALC_CPOOL_REALLOC_OP(allctr); + STAT_MBC_BLK_FREE(allctr, crr, NULL, old_blk_sz, alcu_flgs); + STAT_MBC_BLK_ALLOC(allctr, crr, blk_sz, alcu_flgs); ASSERT(MBC_BLK_SZ(blk) >= allctr->min_block_size); @@ -1680,7 +2283,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) if (IS_FREE_BLK(nxt_nxt_blk)) { /* Coalesce with next free block... */ nxt_blk_sz += MBC_FBLK_SZ(nxt_nxt_blk); - (*allctr->unlink_free_block)(allctr, nxt_nxt_blk, alcu_flgs); + (*allctr->unlink_free_block)(allctr, nxt_nxt_blk); is_last_blk = GET_LAST_BLK_HDR_FLG(nxt_nxt_blk); } @@ -1690,12 +2293,11 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz); } - crr = ABLK_TO_MBC(blk); SET_MBC_FBLK_HDR(nxt_blk, nxt_blk_sz, SBH_THIS_FREE | (is_last_blk ? SBH_LAST_BLK : 0), crr); - (*allctr->link_free_block)(allctr, nxt_blk, alcu_flgs); + (*allctr->link_free_block)(allctr, nxt_blk); ASSERT(IS_ALLOCED_BLK(blk)); @@ -1718,6 +2320,10 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) HARD_CHECK_BLK_CARRIER(allctr, blk); +#ifdef ERTS_SMP + check_abandon_carrier(allctr, nxt_blk, NULL); +#endif + return p; } @@ -1727,11 +2333,12 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) nxt_blk = BLK_AFTER(blk, old_blk_sz); nxt_blk_sz = MBC_BLK_SZ(nxt_blk); if (IS_FREE_BLK(nxt_blk) && get_blk_sz <= old_blk_sz + nxt_blk_sz) { + Carrier_t* crr = ABLK_TO_MBC(blk); /* Grow into next block... */ HARD_CHECK_BLK_CARRIER(allctr, blk); - (*allctr->unlink_free_block)(allctr, nxt_blk, alcu_flgs); + (*allctr->unlink_free_block)(allctr, nxt_blk); nxt_blk_sz -= blk_sz - old_blk_sz; is_last_blk = IS_LAST_BLK(nxt_blk); @@ -1756,7 +2363,6 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) } } else { - Carrier_t* crr = ABLK_TO_MBC(blk); SET_MBC_ABLK_SZ(blk, blk_sz); nxt_blk = BLK_AFTER(blk, blk_sz); @@ -1767,15 +2373,15 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) else SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz); - (*allctr->link_free_block)(allctr, nxt_blk, alcu_flgs); + (*allctr->link_free_block)(allctr, nxt_blk); ASSERT(IS_FREE_BLK(nxt_blk)); ASSERT(FBLK_TO_MBC(nxt_blk) == crr); } - STAT_MBC_BLK_FREE(allctr, old_blk_sz, alcu_flgs); - STAT_MBC_BLK_ALLOC(allctr, blk_sz, alcu_flgs); - + ERTS_ALC_CPOOL_REALLOC_OP(allctr); + STAT_MBC_BLK_FREE(allctr, crr, NULL, old_blk_sz, alcu_flgs); + STAT_MBC_BLK_ALLOC(allctr, crr, blk_sz, alcu_flgs); ASSERT(IS_ALLOCED_BLK(blk)); ASSERT(blk_sz == MBC_BLK_SZ(blk)); @@ -1828,13 +2434,16 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) if (cand_blk_sz < get_blk_sz) { /* We wont fit in cand_blk get a new one */ +#ifdef ERTS_SMP + realloc_move: +#endif #endif /* !MBC_REALLOC_ALWAYS_MOVES */ new_p = mbc_alloc(allctr, size); if (!new_p) return NULL; sys_memcpy(new_p, p, MIN(size, old_blk_sz - ABLK_HDR_SZ)); - mbc_free(allctr, p); + mbc_free(allctr, p, busy_pcrr_pp); return new_p; @@ -1847,8 +2456,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) new_blk = (*allctr->get_free_block)(allctr, get_blk_sz, cand_blk, - cand_blk_sz, - alcu_flgs); + cand_blk_sz); move_into_new_blk: /* * new_blk, and cand_blk have to be correctly set @@ -1862,11 +2470,10 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) GET_BLK_HDR_FLGS(new_blk), FBLK_TO_MBC(new_blk), blk_sz, - 1, - alcu_flgs); + 1); new_p = BLK2UMEM(new_blk); sys_memcpy(new_p, p, MIN(size, old_blk_sz - ABLK_HDR_SZ)); - mbc_free(allctr, p); + mbc_free(allctr, p, NULL); return new_p; } else { @@ -1886,7 +2493,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) HARD_CHECK_BLK_CARRIER(allctr, blk); - (*allctr->unlink_free_block)(allctr, new_blk, alcu_flgs); /* prev */ + (*allctr->unlink_free_block)(allctr, new_blk); /* prev */ if (is_last_blk) new_blk_flgs |= LAST_BLK_HDR_FLG; @@ -1895,7 +2502,7 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) if (IS_FREE_BLK(nxt_blk)) { new_blk_flgs |= GET_LAST_BLK_HDR_FLG(nxt_blk); new_blk_sz += MBC_FBLK_SZ(nxt_blk); - (*allctr->unlink_free_block)(allctr, nxt_blk, alcu_flgs); + (*allctr->unlink_free_block)(allctr, nxt_blk); } } @@ -1920,10 +2527,10 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) new_blk_flgs, crr, blk_sz, - 0, - alcu_flgs); + 0); - STAT_MBC_BLK_FREE(allctr, old_blk_sz, alcu_flgs); + ERTS_ALC_CPOOL_FREE_OP(allctr); + STAT_MBC_BLK_FREE(allctr, crr, NULL, old_blk_sz, alcu_flgs); return new_p; } @@ -1931,6 +2538,635 @@ mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint32 alcu_flgs) #endif /* !MBC_REALLOC_ALWAYS_MOVES */ } +#ifdef ERTS_SMP + +#define ERTS_ALC_MAX_DEALLOC_CARRIER 10 +#define ERTS_ALC_CPOOL_MAX_FETCH_INSPECT 10 +#define ERTS_ALC_CPOOL_CHECK_LIMIT_COUNT 100 +#define ERTS_ALC_CPOOL_MAX_NO_CARRIERS 5 +#define ERTS_ALC_CPOOL_INSERT_ALLOWED_OFFSET 100 +#define ERTS_ALC_CPOOL_MAX_FAILED_STAT_READS 3 + +#define ERTS_ALC_CPOOL_PTR_MOD_MRK (((erts_aint_t) 1) << 0) +#define ERTS_ALC_CPOOL_PTR_DEL_MRK (((erts_aint_t) 1) << 1) + +#define ERTS_ALC_CPOOL_PTR_MRKS \ + (ERTS_ALC_CPOOL_PTR_MOD_MRK | ERTS_ALC_CPOOL_PTR_DEL_MRK) + +/* + * When setting multiple mod markers we always + * set mod markers in pointer order and always + * on next pointers before prev pointers. + */ + +typedef union { + ErtsAlcCPoolData_t sentinel; + char align__[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsAlcCPoolData_t))]; +} ErtsAlcCrrPool_t; + +#if ERTS_ALC_A_INVALID != 0 +# error "Carrier pool implementation assumes ERTS_ALC_A_INVALID == 0" +#endif +#if ERTS_ALC_A_MIN <= ERTS_ALC_A_INVALID +# error "Carrier pool implementation assumes ERTS_ALC_A_MIN > ERTS_ALC_A_INVALID" +#endif + +/* + * The pool is only allowed to be manipulated by managed + * threads except in the alloc_SUITE:cpool case. In this + * test case carrier_pool[ERTS_ALC_A_INVALID] will be + * used. + */ + +static ErtsAlcCrrPool_t carrier_pool[ERTS_ALC_A_MAX+1] erts_align_attribute(ERTS_CACHE_LINE_SIZE); + +#define ERTS_ALC_CPOOL_MAX_BACKOFF (1 << 8) + +static int +backoff(int n) +{ + int i; + + for (i = 0; i < n; i++) + ERTS_SPIN_BODY; + + if (n >= ERTS_ALC_CPOOL_MAX_BACKOFF) + return ERTS_ALC_CPOOL_MAX_BACKOFF; + else + return n << 1; +} + +static int +cpool_dbg_is_in_pool(Allctr_t *allctr, Carrier_t *crr) +{ + ErtsAlcCPoolData_t *sentinel = &carrier_pool[allctr->alloc_no].sentinel; + ErtsAlcCPoolData_t *cpdp = sentinel; + Carrier_t *tmp_crr; + + while (1) { + cpdp = (ErtsAlcCPoolData_t *) (erts_atomic_read_ddrb(&cpdp->next) & ~FLG_MASK); + if (cpdp == sentinel) + return 0; + tmp_crr = (Carrier_t *) (((char *) cpdp) - offsetof(Carrier_t, cpool)); + if (tmp_crr == crr) + return 1; + } +} + +static int +cpool_is_empty(Allctr_t *allctr) +{ + ErtsAlcCPoolData_t *sentinel = &carrier_pool[allctr->alloc_no].sentinel; + return ((erts_atomic_read_rb(&sentinel->next) == (erts_aint_t) sentinel) + && (erts_atomic_read_rb(&sentinel->prev) == (erts_aint_t) sentinel)); +} + +static ERTS_INLINE ErtsAlcCPoolData_t * +cpool_aint2cpd(erts_aint_t aint) +{ + return (ErtsAlcCPoolData_t *) (aint & ~ERTS_ALC_CPOOL_PTR_MRKS); +} + +static ERTS_INLINE erts_aint_t +cpool_read(erts_atomic_t *aptr) +{ + return erts_atomic_read_acqb(aptr); +} + +static ERTS_INLINE void +cpool_init(erts_atomic_t *aptr, erts_aint_t val) +{ + erts_atomic_set_nob(aptr, val); +} + +static ERTS_INLINE void +cpool_set_mod_marked(erts_atomic_t *aptr, erts_aint_t new, erts_aint_t old) +{ +#ifdef ERTS_ALC_CPOOL_DEBUG + erts_aint_t act = erts_atomic_xchg_relb(aptr, new); + ERTS_ALC_CPOOL_ASSERT(act == (old | ERTS_ALC_CPOOL_PTR_MOD_MRK)); +#else + erts_atomic_set_relb(aptr, new); +#endif +} + + +static ERTS_INLINE erts_aint_t +cpool_try_mod_mark_exp(erts_atomic_t *aptr, erts_aint_t exp) +{ + ERTS_ALC_CPOOL_ASSERT((exp & ERTS_ALC_CPOOL_PTR_MOD_MRK) == 0); + return erts_atomic_cmpxchg_nob(aptr, exp | ERTS_ALC_CPOOL_PTR_MOD_MRK, exp); +} + +static ERTS_INLINE erts_aint_t +cpool_mod_mark_exp(erts_atomic_t *aptr, erts_aint_t exp) +{ + int b; + erts_aint_t act; + ERTS_ALC_CPOOL_ASSERT((exp & ERTS_ALC_CPOOL_PTR_MOD_MRK) == 0); + while (1) { + act = erts_atomic_cmpxchg_nob(aptr, + exp | ERTS_ALC_CPOOL_PTR_MOD_MRK, + exp); + if (act == exp) + return exp; + b = 1; + do { + if ((act & ~ERTS_ALC_CPOOL_PTR_MOD_MRK) != exp) + return act; + b = backoff(b); + act = erts_atomic_read_nob(aptr); + } while (act != exp); + } +} + +static ERTS_INLINE erts_aint_t +cpool_mod_mark(erts_atomic_t *aptr) +{ + int b; + erts_aint_t act, exp; + act = cpool_read(aptr); + while (1) { + b = 1; + while (act & ERTS_ALC_CPOOL_PTR_MOD_MRK) { + b = backoff(b); + act = erts_atomic_read_nob(aptr); + } + exp = act; + act = erts_atomic_cmpxchg_acqb(aptr, + exp | ERTS_ALC_CPOOL_PTR_MOD_MRK, + exp); + if (act == exp) + return exp; + } +} + +static void +cpool_insert(Allctr_t *allctr, Carrier_t *crr) +{ + ErtsAlcCPoolData_t *cpd1p, *cpd2p; + erts_aint_t val; + ErtsAlcCPoolData_t *sentinel = &carrier_pool[allctr->alloc_no].sentinel; + + ERTS_ALC_CPOOL_ASSERT(allctr->alloc_no == ERTS_ALC_A_INVALID /* testcase */ + || erts_thr_progress_is_managed_thread()); + ERTS_ALC_CPOOL_ASSERT(erts_smp_atomic_read_nob(&crr->allctr) + == (erts_aint_t) allctr); + + erts_atomic_add_nob(&allctr->cpool.stat.blocks_size, + (erts_aint_t) crr->cpool.blocks_size); + erts_atomic_add_nob(&allctr->cpool.stat.no_blocks, + (erts_aint_t) crr->cpool.blocks); + erts_atomic_add_nob(&allctr->cpool.stat.carriers_size, + (erts_aint_t) CARRIER_SZ(crr)); + erts_atomic_inc_nob(&allctr->cpool.stat.no_carriers); + + erts_smp_atomic_set_nob(&crr->allctr, + ((erts_aint_t) allctr)|ERTS_CRR_ALCTR_FLG_IN_POOL); + + /* + * We search in 'next' direction and begin by passing + * one element before trying to insert. This in order to + * avoid contention with threads fetching elements. + */ + + val = cpool_read(&sentinel->next); + + /* Find a predecessor to be, and set mod marker on its next ptr */ + + while (1) { + cpd1p = cpool_aint2cpd(val); + if (cpd1p == sentinel) { + val = cpool_mod_mark(&cpd1p->next); + break; + } + val = cpool_read(&cpd1p->next); + if (!(val & ERTS_ALC_CPOOL_PTR_MRKS)) { + erts_aint_t tmp = cpool_try_mod_mark_exp(&cpd1p->next, val); + if (tmp == val) { + val = tmp; + break; + } + val = tmp; + } + } + + /* Set mod marker on prev ptr of the to be successor */ + + cpd2p = cpool_aint2cpd(val); + + cpool_init(&crr->cpool.next, (erts_aint_t) cpd2p); + cpool_init(&crr->cpool.prev, (erts_aint_t) cpd1p); + + val = (erts_aint_t) cpd1p; + + while (1) { + int b; + erts_aint_t tmp; + + tmp = cpool_mod_mark_exp(&cpd2p->prev, val); + if (tmp == val) + break; + b = 1; + do { + b = backoff(b); + tmp = cpool_read(&cpd2p->prev); + } while (tmp != val); + } + + /* Write pointers to this element in successor and predecessor */ + + cpool_set_mod_marked(&cpd1p->next, + (erts_aint_t) &crr->cpool, + (erts_aint_t) cpd2p); + cpool_set_mod_marked(&cpd2p->prev, + (erts_aint_t) &crr->cpool, + (erts_aint_t) cpd1p); +} + +static void +cpool_delete(Allctr_t *allctr, Allctr_t *prev_allctr, Carrier_t *crr) +{ + ErtsAlcCPoolData_t *cpd1p, *cpd2p; + erts_aint_t val; +#ifdef ERTS_ALC_CPOOL_DEBUG + ErtsAlcCPoolData_t *sentinel = &carrier_pool[allctr->alloc_no].sentinel; +#endif + + ERTS_ALC_CPOOL_ASSERT(allctr->alloc_no == ERTS_ALC_A_INVALID /* testcase */ + || erts_thr_progress_is_managed_thread()); + ERTS_ALC_CPOOL_ASSERT(sentinel != &crr->cpool); + + /* Set mod marker on next ptr of our predecessor */ + + val = (erts_aint_t) &crr->cpool; + while (1) { + erts_aint_t tmp; + cpd1p = cpool_aint2cpd(cpool_read(&crr->cpool.prev)); + tmp = cpool_mod_mark_exp(&cpd1p->next, val); + if (tmp == val) + break; + } + + /* Set mod marker on our next ptr */ + + val = cpool_mod_mark(&crr->cpool.next); + + /* Set mod marker on the prev ptr of our successor */ + + cpd2p = cpool_aint2cpd(val); + + val = (erts_aint_t) &crr->cpool; + + while (1) { + int b; + erts_aint_t tmp; + + tmp = cpool_mod_mark_exp(&cpd2p->prev, val); + if (tmp == val) + break; + b = 1; + do { + b = backoff(b); + tmp = cpool_read(&cpd2p->prev); + } while (tmp != val); + } + + /* Set mod marker on our prev ptr */ + + val = (erts_aint_t) cpd1p; + + while (1) { + int b; + erts_aint_t tmp; + + tmp = cpool_mod_mark_exp(&crr->cpool.prev, val); + if (tmp == val) + break; + b = 1; + do { + b = backoff(b); + tmp = cpool_read(&cpd2p->prev); + } while (tmp != val); + } + + /* Write pointers past this element in predecessor and successor */ + + cpool_set_mod_marked(&cpd1p->next, + (erts_aint_t) cpd2p, + (erts_aint_t) &crr->cpool); + cpool_set_mod_marked(&cpd2p->prev, + (erts_aint_t) cpd1p, + (erts_aint_t) &crr->cpool); + + /* Repleace mod markers with delete markers on this element */ + cpool_set_mod_marked(&crr->cpool.next, + ((erts_aint_t) cpd2p) | ERTS_ALC_CPOOL_PTR_DEL_MRK, + ((erts_aint_t) cpd2p) | ERTS_ALC_CPOOL_PTR_MOD_MRK); + cpool_set_mod_marked(&crr->cpool.prev, + ((erts_aint_t) cpd1p) | ERTS_ALC_CPOOL_PTR_DEL_MRK, + ((erts_aint_t) cpd1p) | ERTS_ALC_CPOOL_PTR_MOD_MRK); + + crr->cpool.thr_prgr = erts_thr_progress_later(NULL); + + erts_atomic_add_nob(&prev_allctr->cpool.stat.blocks_size, + -((erts_aint_t) crr->cpool.blocks_size)); + erts_atomic_add_nob(&prev_allctr->cpool.stat.no_blocks, + -((erts_aint_t) crr->cpool.blocks)); + erts_atomic_add_nob(&prev_allctr->cpool.stat.carriers_size, + -((erts_aint_t) CARRIER_SZ(crr))); + erts_atomic_dec_wb(&prev_allctr->cpool.stat.no_carriers); + +} + +static Carrier_t * +cpool_fetch(Allctr_t *allctr, UWord size) +{ + int i; + Carrier_t *crr; + ErtsAlcCPoolData_t *cpdp; + ErtsAlcCPoolData_t *sentinel = &carrier_pool[allctr->alloc_no].sentinel; + + ERTS_ALC_CPOOL_ASSERT(allctr->alloc_no == ERTS_ALC_A_INVALID /* testcase */ + || erts_thr_progress_is_managed_thread()); + + i = 0; + + /* First; check our own pending dealloc carrier list... */ + crr = allctr->cpool.dc_list.last; + while (crr && i < ERTS_ALC_CPOOL_MAX_FETCH_INSPECT) { + if (erts_atomic_read_nob(&crr->cpool.max_size) >= size) { + unlink_carrier(&allctr->cpool.dc_list, crr); +#ifdef ERTS_ALC_CPOOL_DEBUG + ERTS_ALC_CPOOL_ASSERT(erts_smp_atomic_xchg_nob(&crr->allctr, + ((erts_aint_t) allctr)) + == (((erts_aint_t) allctr) & ~FLG_MASK)); +#else + erts_smp_atomic_set_nob(&crr->allctr, ((erts_aint_t) allctr)); +#endif + return crr; + } + crr = crr->prev; + i++; + } + + /* ... then the pool ... */ + + /* + * We search in 'prev' direction and begin by passing + * one element before trying to fetch. This in order to + * avoid contention with threads inserting elements. + */ + + cpdp = cpool_aint2cpd(cpool_read(&sentinel->prev)); + if (cpdp == sentinel) + return NULL; + + while (i < ERTS_ALC_CPOOL_MAX_FETCH_INSPECT) { + erts_aint_t exp; + cpdp = cpool_aint2cpd(cpool_read(&cpdp->prev)); + if (cpdp == sentinel) { + cpdp = cpool_aint2cpd(cpool_read(&cpdp->prev)); + if (cpdp == sentinel) + return NULL; + i = ERTS_ALC_CPOOL_MAX_FETCH_INSPECT; /* Last one to inspect */ + } + crr = (Carrier_t *) (((char *) cpdp) - offsetof(Carrier_t, cpool)); + exp = erts_smp_atomic_read_rb(&crr->allctr); + if (((exp & (ERTS_CRR_ALCTR_FLG_IN_POOL|ERTS_CRR_ALCTR_FLG_BUSY)) + == ERTS_CRR_ALCTR_FLG_IN_POOL) + && (erts_atomic_read_nob(&cpdp->max_size) >= size)) { + erts_aint_t act; + /* Try to fetch it... */ + act = erts_smp_atomic_cmpxchg_mb(&crr->allctr, + (erts_aint_t) allctr, + exp); + if (act == exp) { + cpool_delete(allctr, ((Allctr_t *) (act & ~FLG_MASK)), crr); + return crr; + } + } + i++; + } + return NULL; +} + +static void +check_pending_dealloc_carrier(Allctr_t *allctr, + int *need_thr_progress, + ErtsThrPrgrVal *thr_prgr_p, + int *need_more_work) +{ + Carrier_t *crr = allctr->cpool.dc_list.first; + + if (crr) { + ErtsThrPrgrVal current = erts_thr_progress_current(); + int i = 0; + + do { + Carrier_t *dcrr; + + if (!erts_thr_progress_has_reached_this(current, crr->cpool.thr_prgr)) + break; + + dcrr = crr; + crr = crr->next; + dealloc_carrier(allctr, dcrr, ERTS_MSEG_FLG_2POW); + i++; + } while (crr && i < ERTS_ALC_MAX_DEALLOC_CARRIER); + + allctr->cpool.dc_list.first = crr; + if (!crr) + allctr->cpool.dc_list.last = NULL; + else { + crr->prev = NULL; + + if (need_more_work) { + ERTS_ALC_CPOOL_ASSERT(need_thr_progress && thr_prgr_p); + if (erts_thr_progress_has_reached_this(current, crr->cpool.thr_prgr)) + *need_more_work = 1; + else { + *need_thr_progress = 1; + if (*thr_prgr_p == ERTS_THR_PRGR_INVALID + || erts_thr_progress_cmp(crr->cpool.thr_prgr, + *thr_prgr_p) < 0) { + *thr_prgr_p = crr->cpool.thr_prgr; + } + } + } + } + } +} + +static void +schedule_dealloc_carrier(Allctr_t *allctr, Carrier_t *crr) +{ + Allctr_t *used_allctr; + int check_pending_dealloc; + erts_aint_t max_size; + + if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr)) { + dealloc_carrier(allctr, crr, ERTS_MSEG_FLG_2POW); + return; + } + + used_allctr = crr->cpool.orig_allctr; + + if (allctr != used_allctr) { + Block_t *blk = MBC_TO_FIRST_BLK(allctr, crr); + int cinit = used_allctr->dd.ix - allctr->dd.ix; + + /* + * Receiver will recognize that this is a carrier to + * deallocate since the block is an mbc block that + * is free and last in carrier... + */ + ERTS_ALC_CPOOL_ASSERT(IS_FREE_LAST_MBC_BLK(blk)); + + ERTS_ALC_CPOOL_ASSERT(IS_MBC_FIRST_ABLK(allctr, blk)); + ERTS_ALC_CPOOL_ASSERT(crr == FBLK_TO_MBC(blk)); + ERTS_ALC_CPOOL_ASSERT(crr == FIRST_BLK_TO_MBC(used_allctr, blk)); + + if (ddq_enqueue(&used_allctr->dd.q, BLK2UMEM(blk), cinit)) + erts_alloc_notify_delayed_dealloc(used_allctr->ix); + return; + } + + if (crr->cpool.thr_prgr == ERTS_THR_PRGR_INVALID + || erts_thr_progress_has_reached(crr->cpool.thr_prgr)) { + dealloc_carrier(allctr, crr, ERTS_MSEG_FLG_2POW); + return; + } + + max_size = (erts_aint_t) allctr->largest_fblk_in_mbc(allctr, crr); + erts_atomic_set_nob(&crr->cpool.max_size, max_size); + + crr->next = NULL; + crr->prev = allctr->cpool.dc_list.last; + if (allctr->cpool.dc_list.last) { + check_pending_dealloc = 1; + allctr->cpool.dc_list.last->next = crr; + } + else { + check_pending_dealloc = 0; + allctr->cpool.dc_list.first = crr; + } + allctr->cpool.dc_list.last = crr; + if (check_pending_dealloc) + check_pending_dealloc_carrier(allctr, NULL, NULL, NULL); + erts_alloc_ensure_handle_delayed_dealloc_call(allctr->ix); +} + +static ERTS_INLINE void +cpool_init_carrier_data(Allctr_t *allctr, Carrier_t *crr) +{ + erts_atomic_init_nob(&crr->cpool.next, ERTS_AINT_NULL); + erts_atomic_init_nob(&crr->cpool.prev, ERTS_AINT_NULL); + crr->cpool.orig_allctr = allctr; + crr->cpool.thr_prgr = ERTS_THR_PRGR_INVALID; + erts_atomic_init_nob(&crr->cpool.max_size, 0); + crr->cpool.blocks = 0; + crr->cpool.blocks_size = 0; + if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + crr->cpool.abandon_limit = 0; + else { + UWord csz = CARRIER_SZ(crr); + UWord limit = csz*allctr->cpool.util_limit; + if (limit > csz) + limit /= 100; + else + limit = (csz/100)*allctr->cpool.util_limit; + crr->cpool.abandon_limit = limit; + } +} + +static void +set_new_allctr_abandon_limit(Allctr_t *allctr) +{ + UWord limit; + UWord csz; + + allctr->cpool.check_limit_count = ERTS_ALC_CPOOL_CHECK_LIMIT_COUNT; + + csz = allctr->mbcs.curr.norm.mseg.size; + csz += allctr->mbcs.curr.norm.sys_alloc.size; + + limit = csz*allctr->cpool.util_limit; + if (limit > csz) + limit /= 100; + else + limit = (csz/100)*allctr->cpool.util_limit; + + allctr->cpool.abandon_limit = limit; +} + +static void +abandon_carrier(Allctr_t *allctr, Carrier_t *crr) +{ + erts_aint_t max_size; + + STAT_MBC_CPOOL_INSERT(allctr, crr); + + unlink_carrier(&allctr->mbc_list, crr); + + allctr->remove_mbc(allctr, crr); + + max_size = (erts_aint_t) allctr->largest_fblk_in_mbc(allctr, crr); + erts_atomic_set_nob(&crr->cpool.max_size, max_size); + + cpool_insert(allctr, crr); + + set_new_allctr_abandon_limit(allctr); +} + +static void +cpool_read_stat(Allctr_t *allctr, UWord *nocp, UWord *cszp, UWord *nobp, UWord *bszp) +{ + int i; + UWord noc = 0, csz = 0, nob = 0, bsz = 0; + + /* + * We try to get consistent values, but after + * ERTS_ALC_CPOOL_MAX_FAILED_STAT_READS failed + * tries we give up and present what we got... + */ + for (i = 0; i <= ERTS_ALC_CPOOL_MAX_FAILED_STAT_READS; i++) { + UWord tnoc, tcsz, tnob, tbsz; + + tnoc = (UWord) (nocp + ? erts_atomic_read_nob(&allctr->cpool.stat.no_carriers) + : 0); + tcsz = (UWord) (cszp + ? erts_atomic_read_nob(&allctr->cpool.stat.carriers_size) + : 0); + tnob = (UWord) (nobp + ? erts_atomic_read_nob(&allctr->cpool.stat.no_blocks) + : 0); + tbsz = (UWord) (bszp + ? erts_atomic_read_nob(&allctr->cpool.stat.blocks_size) + : 0); + if (tnoc == noc && tcsz == csz && tnob == nob && tbsz == bsz) + break; + noc = tnoc; + csz = tcsz; + nob = tnob; + bsz = tbsz; + ERTS_THR_READ_MEMORY_BARRIER; + } + + if (nocp) + *nocp = noc; + if (cszp) + *cszp = csz; + if (nobp) + *nobp = nob; + if (bszp) + *bszp = bsz; +} + + +#endif /* ERTS_SMP */ + #ifdef DEBUG #if HAVE_ERTS_MSEG @@ -1974,81 +3210,6 @@ static void CHECK_1BLK_CARRIER(Allctr_t* A, int SBC, int MSEGED, Carrier_t* C, #endif static Block_t * -create_sbmbc(Allctr_t *allctr, Uint umem_sz) -{ - Block_t *blk; - Uint blk_sz; - Uint crr_sz = allctr->sbmbc_size; - Carrier_t *crr; - -#if HALFWORD_HEAP - if (allctr->mseg_opt.low_mem) - crr = erts_alloc(ERTS_ALC_T_SBMBC_LOW, crr_sz); - else -#endif - crr = erts_alloc(ERTS_ALC_T_SBMBC, crr_sz); - - INC_CC(allctr->calls.sbmbc_alloc); - SET_CARRIER_HDR(crr, crr_sz, SCH_SYS_ALLOC|SCH_MBC, allctr); - - blk = MBC_TO_FIRST_BLK(allctr, crr); - - blk_sz = UNIT_FLOOR(crr_sz - MBC_HEADER_SIZE(allctr)); - - SET_MBC_FBLK_HDR(blk, blk_sz, SBH_THIS_FREE|SBH_LAST_BLK, crr); - - link_carrier(&allctr->sbmbc_list, crr); - - STAT_SBMBC_ALLOC(allctr, crr_sz); - CHECK_1BLK_CARRIER(allctr, 0, 0, crr, crr_sz, blk, blk_sz); - if (allctr->creating_mbc) - (*allctr->creating_mbc)(allctr, crr, ERTS_ALCU_FLG_SBMBC); - - DEBUG_SAVE_ALIGNMENT(crr); - return blk; -} - -static void -destroy_sbmbc(Allctr_t *allctr, Block_t *blk) -{ - Uint crr_sz; - Carrier_t *crr; - - ASSERT(IS_MBC_BLK(blk)); - ASSERT(IS_MBC_FIRST_FBLK(allctr, blk)); - - crr = FIRST_BLK_TO_MBC(allctr, blk); - crr_sz = CARRIER_SZ(crr); - -#ifdef DEBUG - if (!allctr->stopped) { - ASSERT(IS_LAST_BLK(blk)); - -#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG - (*allctr->link_free_block)(allctr, blk, ERTS_ALCU_FLG_SBMBC); - HARD_CHECK_BLK_CARRIER(allctr, blk); - (*allctr->unlink_free_block)(allctr, blk, ERTS_ALCU_FLG_SBMBC); -#endif - } -#endif - - STAT_SBMBC_FREE(allctr, crr_sz); - - unlink_carrier(&allctr->sbmbc_list, crr); - if (allctr->destroying_mbc) - (*allctr->destroying_mbc)(allctr, crr, ERTS_ALCU_FLG_SBMBC); - - INC_CC(allctr->calls.sbmbc_free); - -#if HALFWORD_HEAP - if (allctr->mseg_opt.low_mem) - erts_free(ERTS_ALC_T_SBMBC_LOW, crr); - else -#endif - erts_free(ERTS_ALC_T_SBMBC, crr); -} - -static Block_t * create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) { Block_t *blk; @@ -2077,6 +3238,24 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz); +#ifdef ERTS_SMP + allctr->cpool.disable_abandon = ERTS_ALC_CPOOL_MAX_DISABLE_ABANDON; + + if ((flags & (CFLG_MBC|CFLG_NO_CPOOL)) == CFLG_MBC + && ERTS_ALC_IS_CPOOL_ENABLED(allctr) + && erts_thr_progress_is_managed_thread()) { + crr = cpool_fetch(allctr, blk_sz); + if (crr) { + STAT_MBC_CPOOL_FETCH(allctr, crr); + link_carrier(&allctr->mbc_list, crr); + (*allctr->add_mbc)(allctr, crr); + blk = (*allctr->get_free_block)(allctr, blk_sz, NULL, 0); + ASSERT(blk); + return blk; + } + } +#endif + #if HAVE_ERTS_MSEG if (flags & CFLG_FORCE_SYS_ALLOC) @@ -2204,11 +3383,15 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) allctr->main_carrier = crr; } +#ifdef ERTS_SMP + cpool_init_carrier_data(allctr, crr); +#endif + link_carrier(&allctr->mbc_list, crr); CHECK_1BLK_CARRIER(allctr, 0, is_mseg, crr, crr_sz, blk, blk_sz); if (allctr->creating_mbc) - (*allctr->creating_mbc)(allctr, crr, 0); + (*allctr->creating_mbc)(allctr, crr); } @@ -2352,14 +3535,21 @@ resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, UWord flags) } static void -destroy_carrier(Allctr_t *allctr, Block_t *blk) +dealloc_carrier(Allctr_t *allctr, Carrier_t *crr, Uint mseg_flags) { - Uint crr_sz; - Carrier_t *crr; #if HAVE_ERTS_MSEG - Uint is_mseg = 0; - Uint mseg_flags = ERTS_MSEG_FLG_NONE; + if (IS_MSEG_CARRIER(crr)) + alcu_mseg_dealloc(allctr, crr, CARRIER_SZ(crr), mseg_flags); + else #endif + alcu_sys_free(allctr, crr); +} + +static void +destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp) +{ + Uint crr_sz; + Carrier_t *crr; if (IS_SBC_BLK(blk)) { Uint blk_sz = SBC_BLK_SZ(blk); @@ -2372,7 +3562,6 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk) #if HAVE_ERTS_MSEG if (IS_MSEG_CARRIER(crr)) { - is_mseg++; ASSERT(crr_sz % MSEG_UNIT_SZ == 0); STAT_MSEG_SBC_FREE(allctr, crr_sz, blk_sz); } @@ -2382,6 +3571,7 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk) unlink_carrier(&allctr->sbc_list, crr); + dealloc_carrier(allctr, crr, ERTS_MSEG_FLG_NONE); } else { ASSERT(IS_MBC_FIRST_FBLK(allctr, blk)); @@ -2400,30 +3590,36 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk) } #endif -#if HAVE_ERTS_MSEG - if (IS_MSEG_CARRIER(crr)) { - is_mseg++; - ASSERT(crr_sz % MSEG_UNIT_SZ == 0); - STAT_MSEG_MBC_FREE(allctr, crr_sz); - mseg_flags = ERTS_MSEG_FLG_2POW; + if (allctr->destroying_mbc) + (*allctr->destroying_mbc)(allctr, crr); + +#ifdef ERTS_SMP + if (busy_pcrr_pp && *busy_pcrr_pp) { + ERTS_ALC_CPOOL_ASSERT(*busy_pcrr_pp == crr); + *busy_pcrr_pp = NULL; + cpool_delete(allctr, allctr, crr); } else #endif - STAT_SYS_ALLOC_MBC_FREE(allctr, crr_sz); + { + unlink_carrier(&allctr->mbc_list, crr); +#if HAVE_ERTS_MSEG + if (IS_MSEG_CARRIER(crr)) { + ASSERT(crr_sz % MSEG_UNIT_SZ == 0); + STAT_MSEG_MBC_FREE(allctr, crr_sz); + } + else +#endif + STAT_SYS_ALLOC_MBC_FREE(allctr, crr_sz); + } - unlink_carrier(&allctr->mbc_list, crr); - if (allctr->destroying_mbc) - (*allctr->destroying_mbc)(allctr, crr, 0); +#ifdef ERTS_SMP + schedule_dealloc_carrier(allctr, crr); +#else + dealloc_carrier(allctr, crr, ERTS_MSEG_FLG_2POW); +#endif } - -#if HAVE_ERTS_MSEG - if (is_mseg) { - alcu_mseg_dealloc(allctr, crr, crr_sz, mseg_flags); - } - else -#endif - alcu_sys_free(allctr, crr); } @@ -2457,19 +3653,19 @@ static struct { Eterm lmbcs; Eterm smbcs; Eterm mbcgs; - Eterm sbmbcs; - Eterm sbmbct; + Eterm acul; #if HAVE_ERTS_MSEG Eterm mmc; #endif Eterm ycs; - /* Eterm sbmbcs; */ - Eterm fix_types; Eterm mbcs; +#ifdef ERTS_SMP + Eterm mbcs_pool; +#endif Eterm sbcs; Eterm sys_alloc_carriers_size; @@ -2494,8 +3690,6 @@ static struct { Eterm mseg_dealloc; Eterm mseg_realloc; #endif - Eterm sbmbc_alloc; - Eterm sbmbc_free; #ifdef DEBUG Eterm end_of_atoms; #endif @@ -2551,19 +3745,19 @@ init_atoms(Allctr_t *allctr) AM_INIT(lmbcs); AM_INIT(smbcs); AM_INIT(mbcgs); - AM_INIT(sbmbcs); - AM_INIT(sbmbct); + AM_INIT(acul); #if HAVE_ERTS_MSEG AM_INIT(mmc); #endif AM_INIT(ycs); - /*AM_INIT(sbmbcs);*/ - AM_INIT(fix_types); AM_INIT(mbcs); +#ifdef ERTS_SMP + AM_INIT(mbcs_pool); +#endif AM_INIT(sbcs); AM_INIT(sys_alloc_carriers_size); @@ -2588,8 +3782,6 @@ init_atoms(Allctr_t *allctr) AM_INIT(mseg_dealloc); AM_INIT(mseg_realloc); #endif - AM_INIT(sbmbc_free); - AM_INIT(sbmbc_alloc); #ifdef DEBUG for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) { @@ -2637,19 +3829,22 @@ ensure_atoms_initialized(Allctr_t *allctr) * that would fit a small when size check is done may need to be built * as a big when the actual build is performed. Caller is required to * HRelease after build. + * + * Note, bld_unstable_uint() should have been called bld_unstable_uword() + * but we do not want to rename it... */ static ERTS_INLINE Eterm -bld_unstable_uint(Uint **hpp, Uint *szp, Uint ui) +bld_unstable_uint(Uint **hpp, Uint *szp, UWord ui) { Eterm res = THE_NON_VALUE; if (szp) - *szp += BIG_UINT_HEAP_SIZE; + *szp += BIG_UWORD_HEAP_SIZE(~((UWord) 0)); if (hpp) { if (IS_USMALL(0, ui)) res = make_small(ui); else { - res = uint_to_big(ui, *hpp); - *hpp += BIG_UINT_HEAP_SIZE; + res = uword_to_big(ui, *hpp); + *hpp += BIG_UWORD_HEAP_SIZE(ui); } } return res; @@ -2675,8 +3870,24 @@ add_4tup(Uint **hpp, Uint *szp, Eterm *lp, bld_cons(hpp, szp, bld_tuple(hpp, szp, 4, el1, el2, el3, el4), *lp); } +static ERTS_INLINE void +add_fix_types(Allctr_t *allctr, int internal, Uint **hpp, Uint *szp, + Eterm *lp, Eterm fix) +{ + if (allctr->fix) { + if (!ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + add_2tup(hpp, szp, lp, am.fix_types, fix); + else if (internal) + add_3tup(hpp, szp, lp, + am.fix_types, + erts_bld_uword(hpp, szp, ~((UWord) 0)), + fix); + } +} + static Eterm sz_info_fix(Allctr_t *allctr, + int internal, int *print_to_p, void *print_to_arg, Uint **hpp, @@ -2684,36 +3895,67 @@ sz_info_fix(Allctr_t *allctr, { Eterm res; int ix; - ErtsAlcFixList_t *fix = allctr->fix; - ASSERT(fix); + ASSERT(allctr->fix); res = NIL; - for (ix = ERTS_ALC_NO_FIXED_SIZES-1; ix >= 0; ix--) { - ErtsAlcType_t n = ix + ERTS_ALC_N_MIN_A_FIXED_SIZE; - Uint alloced = (fix[ix].type_size * fix[ix].allocated); - Uint used = fix[ix].type_size*fix[ix].used; - - if (print_to_p) { - int to = *print_to_p; - void *arg = print_to_arg; - erts_print(to, - arg, - "fix type: %s %bpu %bpu\n", - (char *) ERTS_ALC_N2TD(n), - alloced, - used); - } + if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) { + + if (internal) { + for (ix = ERTS_ALC_NO_FIXED_SIZES-1; ix >= 0; ix--) { + ErtsAlcFixList_t *fix = &allctr->fix[ix]; + UWord alloced = fix->type_size * fix->u.cpool.allocated; + UWord used = fix->type_size * fix->u.cpool.used; + + if (print_to_p) { + int to = *print_to_p; + void *arg = print_to_arg; + erts_print(to, + arg, + "fix type internal: %s %bpu %bpu\n", + (char *) ERTS_ALC_N2TD(ERTS_ALC_N_MIN_A_FIXED_SIZE + + ix), + alloced, + used); + } - if (hpp || szp) { - add_3tup(hpp, szp, &res, - fix_type_atoms[ix], - bld_unstable_uint(hpp, szp, alloced), - bld_unstable_uint(hpp, szp, used)); + if (hpp || szp) { + add_3tup(hpp, szp, &res, + fix_type_atoms[ix], + bld_unstable_uint(hpp, szp, alloced), + bld_unstable_uint(hpp, szp, used)); + } + } } } + else { + for (ix = ERTS_ALC_NO_FIXED_SIZES-1; ix >= 0; ix--) { + ErtsAlcFixList_t *fix = &allctr->fix[ix]; + UWord alloced = fix->type_size * fix->u.nocpool.allocated; + UWord used = fix->type_size*fix->u.nocpool.used; + + if (print_to_p) { + int to = *print_to_p; + void *arg = print_to_arg; + erts_print(to, + arg, + "fix type: %s %bpu %bpu\n", + (char *) ERTS_ALC_N2TD(ERTS_ALC_N_MIN_A_FIXED_SIZE + + ix), + alloced, + used); + } + + if (hpp || szp) { + add_3tup(hpp, szp, &res, + fix_type_atoms[ix], + bld_unstable_uint(hpp, szp, alloced), + bld_unstable_uint(hpp, szp, used)); + } + } + } return res; } @@ -2727,9 +3969,7 @@ sz_info_carriers(Allctr_t *allctr, Uint *szp) { Eterm res = THE_NON_VALUE; - Uint curr_size = (cs == &allctr->sbmbcs - ? cs->curr.small_block.size - : cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size); + UWord curr_size = cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size; if (print_to_p) { int to = *print_to_p; @@ -2743,7 +3983,7 @@ sz_info_carriers(Allctr_t *allctr, cs->blocks.max_ever.size); erts_print(to, arg, - "%scarriers size: %beu %bpu %bpu\n", + "%scarriers size: %bpu %bpu %bpu\n", prefix, curr_size, cs->max.size, @@ -2767,6 +4007,62 @@ sz_info_carriers(Allctr_t *allctr, return res; } +#ifdef ERTS_SMP + +static Eterm +info_cpool(Allctr_t *allctr, + int sz_only, + char *prefix, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + Eterm res = THE_NON_VALUE; + UWord noc, csz, nob, bsz; + + noc = csz = nob = bsz = ~0; + if (print_to_p || hpp) { + if (sz_only) + cpool_read_stat(allctr, NULL, &csz, NULL, &bsz); + else + cpool_read_stat(allctr, &noc, &csz, &nob, &bsz); + } + + if (print_to_p) { + int to = *print_to_p; + void *arg = print_to_arg; + if (!sz_only) + erts_print(to, arg, "%sblocks: %bpu\n", prefix, nob); + erts_print(to, arg, "%sblocks size: %bpu\n", prefix, bsz); + if (!sz_only) + erts_print(to, arg, "%scarriers: %bpu\n", prefix, noc); + erts_print(to, arg, "%scarriers size: %bpu\n", prefix, csz); + } + + if (hpp || szp) { + res = NIL; + add_2tup(hpp, szp, &res, + am.carriers_size, + bld_unstable_uint(hpp, szp, csz)); + if (!sz_only) + add_2tup(hpp, szp, &res, + am.carriers, + bld_unstable_uint(hpp, szp, noc)); + add_2tup(hpp, szp, &res, + am.blocks_size, + bld_unstable_uint(hpp, szp, bsz)); + if (!sz_only) + add_2tup(hpp, szp, &res, + am.blocks, + bld_unstable_uint(hpp, szp, nob)); + } + + return res; +} + +#endif /* ERTS_SMP */ + static Eterm info_carriers(Allctr_t *allctr, CarriersStats_t *cs, @@ -2777,17 +4073,10 @@ info_carriers(Allctr_t *allctr, Uint *szp) { Eterm res = THE_NON_VALUE; - Uint curr_no, curr_size; - int small_block = cs == &allctr->sbmbcs; - - if (small_block) { - curr_no = cs->curr.small_block.no; - curr_size = cs->curr.small_block.size; - } - else { - curr_no = cs->curr.norm.mseg.no + cs->curr.norm.sys_alloc.no; - curr_size = cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size; - } + UWord curr_no, curr_size; + + curr_no = cs->curr.norm.mseg.no + cs->curr.norm.sys_alloc.no; + curr_size = cs->curr.norm.mseg.size + cs->curr.norm.sys_alloc.size; if (print_to_p) { int to = *print_to_p; @@ -2808,75 +4097,67 @@ info_carriers(Allctr_t *allctr, cs->blocks.max_ever.size); erts_print(to, arg, - "%scarriers: %beu %bpu %bpu\n", + "%scarriers: %bpu %bpu %bpu\n", prefix, curr_no, cs->max.no, cs->max_ever.no); - if (!small_block) { #if HAVE_ERTS_MSEG - erts_print(to, - arg, - "%smseg carriers: %bpu\n", - prefix, - cs->curr.norm.mseg.no); -#endif - erts_print(to, - arg, - "%ssys_alloc carriers: %bpu\n", - prefix, - cs->curr.norm.sys_alloc.no); - } erts_print(to, arg, - "%scarriers size: %beu %bpu %bpu\n", + "%smseg carriers: %bpu\n", + prefix, + cs->curr.norm.mseg.no); +#endif + erts_print(to, + arg, + "%ssys_alloc carriers: %bpu\n", + prefix, + cs->curr.norm.sys_alloc.no); + erts_print(to, + arg, + "%scarriers size: %bpu %bpu %bpu\n", prefix, curr_size, cs->max.size, cs->max_ever.size); - if (!small_block) { #if HAVE_ERTS_MSEG - erts_print(to, - arg, - "%smseg carriers size: %bpu\n", - prefix, - cs->curr.norm.mseg.size); -#endif - erts_print(to, - arg, - "%ssys_alloc carriers size: %bpu\n", - prefix, - cs->curr.norm.sys_alloc.size); - } + erts_print(to, + arg, + "%smseg carriers size: %bpu\n", + prefix, + cs->curr.norm.mseg.size); +#endif + erts_print(to, + arg, + "%ssys_alloc carriers size: %bpu\n", + prefix, + cs->curr.norm.sys_alloc.size); } if (hpp || szp) { res = NIL; - if (!small_block) { - add_2tup(hpp, szp, &res, - am.sys_alloc_carriers_size, - bld_unstable_uint(hpp, szp, cs->curr.norm.sys_alloc.size)); + add_2tup(hpp, szp, &res, + am.sys_alloc_carriers_size, + bld_unstable_uint(hpp, szp, cs->curr.norm.sys_alloc.size)); #if HAVE_ERTS_MSEG - add_2tup(hpp, szp, &res, - am.mseg_alloc_carriers_size, - bld_unstable_uint(hpp, szp, cs->curr.norm.mseg.size)); + add_2tup(hpp, szp, &res, + am.mseg_alloc_carriers_size, + bld_unstable_uint(hpp, szp, cs->curr.norm.mseg.size)); #endif - } add_4tup(hpp, szp, &res, am.carriers_size, bld_unstable_uint(hpp, szp, curr_size), bld_unstable_uint(hpp, szp, cs->max.size), bld_unstable_uint(hpp, szp, cs->max_ever.size)); - if (!small_block) { - add_2tup(hpp, szp, &res, - am.sys_alloc_carriers, - bld_unstable_uint(hpp, szp, cs->curr.norm.sys_alloc.no)); + add_2tup(hpp, szp, &res, + am.sys_alloc_carriers, + bld_unstable_uint(hpp, szp, cs->curr.norm.sys_alloc.no)); #if HAVE_ERTS_MSEG - add_2tup(hpp, szp, &res, - am.mseg_alloc_carriers, - bld_unstable_uint(hpp, szp, cs->curr.norm.mseg.no)); + add_2tup(hpp, szp, &res, + am.mseg_alloc_carriers, + bld_unstable_uint(hpp, szp, cs->curr.norm.mseg.no)); #endif - } add_4tup(hpp, szp, &res, am.carriers, bld_unstable_uint(hpp, szp, curr_no), @@ -2935,16 +4216,10 @@ info_calls(Allctr_t *allctr, if (print_to_p) { #define PRINT_CC_4(TO, TOA, NAME, CC) \ - if ((CC).giga_no == 0) \ - erts_print(TO, TOA, "%s calls: %b32u\n", NAME, CC.no); \ - else \ - erts_print(TO, TOA, "%s calls: %b32u%09lu\n", NAME, CC.giga_no, CC.no) + erts_print(TO, TOA, "%s calls: %b64u\n", NAME, CC) #define PRINT_CC_5(TO, TOA, PRFX, NAME, CC) \ - if ((CC).giga_no == 0) \ - erts_print(TO, TOA, "%s%s calls: %b32u\n",PRFX,NAME,CC.no); \ - else \ - erts_print(TO, TOA, "%s%s calls: %b32u%09lu\n",PRFX,NAME,CC.giga_no,CC.no) + erts_print(TO, TOA, "%s%s calls: %b64u\n",PRFX,NAME,CC) char *prefix = allctr->name_prefix; int to = *print_to_p; @@ -2954,9 +4229,6 @@ info_calls(Allctr_t *allctr, PRINT_CC_5(to, arg, prefix, "free", allctr->calls.this_free); PRINT_CC_5(to, arg, prefix, "realloc", allctr->calls.this_realloc); - PRINT_CC_4(to, arg, "sbmbc_alloc", allctr->calls.sbmbc_alloc); - PRINT_CC_4(to, arg, "sbmbc_free", allctr->calls.sbmbc_free); - #if HAVE_ERTS_MSEG PRINT_CC_4(to, arg, "mseg_alloc", allctr->calls.mseg_alloc); PRINT_CC_4(to, arg, "mseg_dealloc", allctr->calls.mseg_dealloc); @@ -2983,50 +4255,42 @@ info_calls(Allctr_t *allctr, add_3tup(hpp, szp, &res, am.sys_realloc, - bld_unstable_uint(hpp, szp, allctr->calls.sys_realloc.giga_no), - bld_unstable_uint(hpp, szp, allctr->calls.sys_realloc.no)); + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.sys_realloc)), + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.sys_realloc))); add_3tup(hpp, szp, &res, am.sys_free, - bld_unstable_uint(hpp, szp, allctr->calls.sys_free.giga_no), - bld_unstable_uint(hpp, szp, allctr->calls.sys_free.no)); + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.sys_free)), + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.sys_free))); add_3tup(hpp, szp, &res, am.sys_alloc, - bld_unstable_uint(hpp, szp, allctr->calls.sys_alloc.giga_no), - bld_unstable_uint(hpp, szp, allctr->calls.sys_alloc.no)); + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.sys_alloc)), + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.sys_alloc))); #if HAVE_ERTS_MSEG add_3tup(hpp, szp, &res, am.mseg_realloc, - bld_unstable_uint(hpp, szp, allctr->calls.mseg_realloc.giga_no), - bld_unstable_uint(hpp, szp, allctr->calls.mseg_realloc.no)); + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.mseg_realloc)), + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.mseg_realloc))); add_3tup(hpp, szp, &res, am.mseg_dealloc, - bld_unstable_uint(hpp, szp, allctr->calls.mseg_dealloc.giga_no), - bld_unstable_uint(hpp, szp, allctr->calls.mseg_dealloc.no)); + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.mseg_dealloc)), + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.mseg_dealloc))); add_3tup(hpp, szp, &res, am.mseg_alloc, - bld_unstable_uint(hpp, szp, allctr->calls.mseg_alloc.giga_no), - bld_unstable_uint(hpp, szp, allctr->calls.mseg_alloc.no)); + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.mseg_alloc)), + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.mseg_alloc))); #endif add_3tup(hpp, szp, &res, - am.sbmbc_free, - bld_unstable_uint(hpp, szp, allctr->calls.sbmbc_free.giga_no), - bld_unstable_uint(hpp, szp, allctr->calls.sbmbc_free.no)); - add_3tup(hpp, szp, &res, - am.sbmbc_alloc, - bld_unstable_uint(hpp, szp, allctr->calls.sbmbc_alloc.giga_no), - bld_unstable_uint(hpp, szp, allctr->calls.sbmbc_alloc.no)); - add_3tup(hpp, szp, &res, allctr->name.realloc, - bld_unstable_uint(hpp, szp, allctr->calls.this_realloc.giga_no), - bld_unstable_uint(hpp, szp, allctr->calls.this_realloc.no)); + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.this_realloc)), + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.this_realloc))); add_3tup(hpp, szp, &res, allctr->name.free, - bld_unstable_uint(hpp, szp, allctr->calls.this_free.giga_no), - bld_unstable_uint(hpp, szp, allctr->calls.this_free.no)); + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.this_free)), + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.this_free))); add_3tup(hpp, szp, &res, allctr->name.alloc, - bld_unstable_uint(hpp, szp, allctr->calls.this_alloc.giga_no), - bld_unstable_uint(hpp, szp, allctr->calls.this_alloc.no)); + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_GIGA_VAL(allctr->calls.this_alloc)), + bld_unstable_uint(hpp, szp, ERTS_ALC_CC_VAL(allctr->calls.this_alloc))); } return res; @@ -3040,6 +4304,7 @@ info_options(Allctr_t *allctr, Uint *szp) { Eterm res = THE_NON_VALUE; + int acul; if (!allctr) { if (print_to_p) @@ -3051,6 +4316,12 @@ info_options(Allctr_t *allctr, return res; } +#ifdef ERTS_SMP + acul = allctr->cpool.util_limit; +#else + acul = 0; +#endif + if (print_to_p) { char topt[21]; /* Enough for any 64-bit integer */ if (allctr->t) @@ -3079,9 +4350,8 @@ info_options(Allctr_t *allctr, #endif "option lmbcs: %beu\n" "option smbcs: %beu\n" - "option mbcgs: %beu\n" - "option sbmbcs: %beu\n" - "option sbmbct: %beu\n", + "option mbcgs: %beu\n", + "option acul: %d\n", topt, allctr->ramv ? "true" : "false", #if HALFWORD_HEAP @@ -3102,8 +4372,7 @@ info_options(Allctr_t *allctr, allctr->largest_mbc_size, allctr->smallest_mbc_size, allctr->mbc_growth_stages, - allctr->sbmbc_size, - allctr->sbmbc_threshold); + acul); } res = (*allctr->info_options)(allctr, "option ", print_to_p, print_to_arg, @@ -3111,11 +4380,8 @@ info_options(Allctr_t *allctr, if (hpp || szp) { add_2tup(hpp, szp, &res, - am.sbmbct, - bld_uint(hpp, szp, allctr->sbmbc_threshold)); - add_2tup(hpp, szp, &res, - am.sbmbcs, - bld_uint(hpp, szp, allctr->sbmbc_size)); + am.acul, + bld_uint(hpp, szp, (UWord) acul)); add_2tup(hpp, szp, &res, am.mbcgs, bld_uint(hpp, szp, allctr->mbc_growth_stages)); @@ -3261,13 +4527,17 @@ erts_alcu_info_options(Allctr_t *allctr, Eterm erts_alcu_sz_info(Allctr_t *allctr, + int internal, int begin_max_period, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) { - Eterm res, sbmbcs, mbcs, sbcs, fix = THE_NON_VALUE; + Eterm res, mbcs, sbcs, fix = THE_NON_VALUE; +#ifdef ERTS_SMP + Eterm mbcs_pool; +#endif res = THE_NON_VALUE; @@ -3296,30 +4566,35 @@ erts_alcu_sz_info(Allctr_t *allctr, = allctr->sbcs.curr.norm.mseg.no + allctr->sbcs.curr.norm.sys_alloc.no; allctr->sbcs.blocks.max.no = allctr->sbcs.max.no; - update_max_ever_values(&allctr->sbmbcs); update_max_ever_values(&allctr->mbcs); update_max_ever_values(&allctr->sbcs); if (allctr->fix) - fix = sz_info_fix(allctr, print_to_p, print_to_arg, hpp, szp); - sbmbcs = sz_info_carriers(allctr, &allctr->sbmbcs, "sbmbcs ", print_to_p, - print_to_arg, hpp, szp); + fix = sz_info_fix(allctr, internal, print_to_p, print_to_arg, hpp, szp); mbcs = sz_info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p, print_to_arg, hpp, szp); +#ifdef ERTS_SMP + if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + mbcs_pool = info_cpool(allctr, 1, "mbcs_pool ", print_to_p, + print_to_arg, hpp, szp); + else + mbcs_pool = THE_NON_VALUE; /* shut up annoying warning... */ +#endif sbcs = sz_info_carriers(allctr, &allctr->sbcs, "sbcs ", print_to_p, print_to_arg, hpp, szp); if (hpp || szp) { res = NIL; add_2tup(hpp, szp, &res, am.sbcs, sbcs); +#ifdef ERTS_SMP + if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + add_2tup(hpp, szp, &res, am.mbcs_pool, mbcs_pool); +#endif add_2tup(hpp, szp, &res, am.mbcs, mbcs); - add_2tup(hpp, szp, &res, am.sbmbcs, sbmbcs); - if (allctr->fix) - add_2tup(hpp, szp, &res, am.fix_types, fix); + add_fix_types(allctr, internal, hpp, szp, &res, fix); } if (begin_max_period) { - reset_max_values(&allctr->sbmbcs); reset_max_values(&allctr->mbcs); reset_max_values(&allctr->sbcs); } @@ -3338,13 +4613,17 @@ erts_alcu_sz_info(Allctr_t *allctr, Eterm erts_alcu_info(Allctr_t *allctr, + int internal, int begin_max_period, int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) { - Eterm res, sett, sbmbcs, mbcs, sbcs, calls, fix = THE_NON_VALUE; + Eterm res, sett, mbcs, sbcs, calls, fix = THE_NON_VALUE; +#ifdef ERTS_SMP + Eterm mbcs_pool; +#endif res = THE_NON_VALUE; @@ -3373,7 +4652,6 @@ erts_alcu_info(Allctr_t *allctr, = allctr->sbcs.curr.norm.mseg.no + allctr->sbcs.curr.norm.sys_alloc.no; allctr->sbcs.blocks.max.no = allctr->sbcs.max.no; - update_max_ever_values(&allctr->sbmbcs); update_max_ever_values(&allctr->mbcs); update_max_ever_values(&allctr->sbcs); @@ -3387,11 +4665,16 @@ erts_alcu_info(Allctr_t *allctr, sett = info_options(allctr, print_to_p, print_to_arg, hpp, szp); if (allctr->fix) - fix = sz_info_fix(allctr, print_to_p, print_to_arg, hpp, szp); - sbmbcs = info_carriers(allctr, &allctr->sbmbcs, "sbmbcs ", print_to_p, - print_to_arg, hpp, szp); + fix = sz_info_fix(allctr, internal, print_to_p, print_to_arg, hpp, szp); mbcs = info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p, print_to_arg, hpp, szp); +#ifdef ERTS_SMP + if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + mbcs_pool = info_cpool(allctr, 0, "mbcs_pool ", print_to_p, + print_to_arg, hpp, szp); + else + mbcs_pool = THE_NON_VALUE; /* shut up annoying warning... */ +#endif sbcs = info_carriers(allctr, &allctr->sbcs, "sbcs ", print_to_p, print_to_arg, hpp, szp); calls = info_calls(allctr, print_to_p, print_to_arg, hpp, szp); @@ -3401,10 +4684,12 @@ erts_alcu_info(Allctr_t *allctr, add_2tup(hpp, szp, &res, am.calls, calls); add_2tup(hpp, szp, &res, am.sbcs, sbcs); +#ifdef ERTS_SMP + if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + add_2tup(hpp, szp, &res, am.mbcs_pool, mbcs_pool); +#endif add_2tup(hpp, szp, &res, am.mbcs, mbcs); - add_2tup(hpp, szp, &res, am.sbmbcs, sbmbcs); - if (allctr->fix) - add_2tup(hpp, szp, &res, am.fix_types, fix); + add_fix_types(allctr, internal, hpp, szp, &res, fix); add_2tup(hpp, szp, &res, am.options, sett); add_3tup(hpp, szp, &res, am.versions, @@ -3413,7 +4698,6 @@ erts_alcu_info(Allctr_t *allctr, } if (begin_max_period) { - reset_max_values(&allctr->sbmbcs); reset_max_values(&allctr->mbcs); reset_max_values(&allctr->sbcs); } @@ -3441,22 +4725,37 @@ erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size, ErtsAlcUFixInfo_t * size->carriers = allctr->mbcs.curr.norm.mseg.size; size->carriers += allctr->mbcs.curr.norm.sys_alloc.size; - size->carriers += allctr->sbmbcs.curr.small_block.size; size->carriers += allctr->sbcs.curr.norm.mseg.size; size->carriers += allctr->sbcs.curr.norm.sys_alloc.size; size->blocks = allctr->mbcs.blocks.curr.size; - size->blocks += allctr->sbmbcs.blocks.curr.size; size->blocks += allctr->sbcs.blocks.curr.size; +#ifdef ERTS_SMP + if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) { + UWord csz, bsz; + cpool_read_stat(allctr, NULL, &csz, NULL, &bsz); + size->blocks += bsz; + size->carriers += csz; + } +#endif + if (fi) { int ix; for (ix = 0; ix < fisz; ix++) { if (allctr->fix) { - fi[ix].allocated += (allctr->fix[ix].type_size - * allctr->fix[ix].allocated); - fi[ix].used += (allctr->fix[ix].type_size - * allctr->fix[ix].used); + if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) { + fi[ix].allocated += (allctr->fix[ix].type_size + * allctr->fix[ix].u.cpool.allocated); + fi[ix].used += (allctr->fix[ix].type_size + * allctr->fix[ix].u.cpool.used); + } + else { + fi[ix].allocated += (allctr->fix[ix].type_size + * allctr->fix[ix].u.nocpool.allocated); + fi[ix].used += (allctr->fix[ix].type_size + * allctr->fix[ix].u.nocpool.used); + } } } } @@ -3474,7 +4773,6 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) { Allctr_t *allctr = (Allctr_t *) extra; void *res; - ErtsAlcFixList_t *fix; ASSERT(initialized); @@ -3492,57 +4790,21 @@ do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) INC_CC(allctr->calls.this_alloc); - fix = allctr->fix; - if (fix) { - int ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE; - ASSERT((unsigned)ix < ERTS_ALC_NO_FIXED_SIZES); - ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); - ASSERT(size <= fix[ix].type_size); - fix[ix].used++; - res = fix[ix].list; - if (res) { - fix[ix].list_size--; - fix[ix].list = *((void **) res); - if (fix[ix].list && fix[ix].allocated > fix[ix].limit) { - void *p = fix[ix].list; - Block_t *blk; - fix[ix].list = *((void **) p); - fix[ix].list_size--; - blk = UMEM2BLK(p); - if (IS_SBC_BLK(blk)) - destroy_carrier(allctr, blk); - else - mbc_free(allctr, p); - fix[ix].allocated--; - } - ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); - return res; - } - size = fix[ix].type_size; - if (fix[ix].limit < fix[ix].used) - fix[ix].limit = fix[ix].used; - if (fix[ix].max_used < fix[ix].used) - fix[ix].max_used = fix[ix].used; - fix[ix].allocated++; + if (allctr->fix) { + if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + return fix_cpool_alloc(allctr, type, size); + else + return fix_nocpool_alloc(allctr, type, size); } if (size >= allctr->sbc_threshold) { Block_t *blk; -#ifdef ERTS_SMP - if (allctr->dd.use) - ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1); -#endif blk = create_carrier(allctr, size, CFLG_SBC); res = blk ? BLK2UMEM(blk) : NULL; } else res = mbc_alloc(allctr, size); - if (!res && fix) { - int ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE; - fix[ix].allocated--; - fix[ix].used--; - } return res; } @@ -3611,9 +4873,22 @@ erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size) if (pref_allctr->thread_safe) erts_mtx_lock(&pref_allctr->mutex); +#ifdef ERTS_SMP + ASSERT(pref_allctr->dd.use); + ERTS_ALCU_HANDLE_DD_IN_OP(pref_allctr, 1); +#endif + ERTS_ALCU_DBG_CHK_THR_ACCESS(pref_allctr); res = do_erts_alcu_alloc(type, pref_allctr, size); + +#ifdef ERTS_SMP + if (!res && ERTS_ALCU_HANDLE_DD_IN_OP(pref_allctr, 1)) { + /* Cleaned up a bit more; try one more time... */ + res = do_erts_alcu_alloc(type, pref_allctr, size); + } +#endif + if (pref_allctr->thread_safe) erts_mtx_unlock(&pref_allctr->mutex); @@ -3630,9 +4905,9 @@ erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size) /* ------------------------------------------------------------------------- */ static ERTS_INLINE void -do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p) +do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p, + Carrier_t **busy_pcrr_pp) { - int ix; Allctr_t *allctr = (Allctr_t *) extra; ASSERT(initialized); @@ -3644,57 +4919,28 @@ do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p) ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr); if (p) { - ErtsAlcFixList_t *fix = allctr->fix; - Block_t *blk; INC_CC(allctr->calls.this_free); - if (fix) { - ix = type - ERTS_ALC_N_MIN_A_FIXED_SIZE; - ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); - fix[ix].used--; - if (fix[ix].allocated < fix[ix].limit - && fix[ix].list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) { - *((void **) p) = fix[ix].list; - fix[ix].list = p; - fix[ix].list_size++; - if (!allctr->fix_shrink_scheduled) { - allctr->fix_shrink_scheduled = 1; - erts_set_aux_work_timeout( - allctr->ix, - (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM - | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC), - 1); - } - ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); - return; - } - fix[ix].allocated--; - if (fix[ix].list && fix[ix].allocated > fix[ix].limit) { - blk = UMEM2BLK(p); - if (IS_SBC_BLK(blk)) - destroy_carrier(allctr, blk); - else - mbc_free(allctr, p); - p = fix[ix].list; - fix[ix].list = *((void **) p); - fix[ix].list_size--; - fix[ix].allocated--; - } + if (allctr->fix) { + if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) + fix_cpool_free(allctr, type, p, busy_pcrr_pp); + else + fix_nocpool_free(allctr, type, p); + } + else { + Block_t *blk = UMEM2BLK(p); + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk, NULL); + else + mbc_free(allctr, p, busy_pcrr_pp); } - - blk = UMEM2BLK(p); - if (IS_SBC_BLK(blk)) - destroy_carrier(allctr, blk); - else - mbc_free(allctr, p); - ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); } } void erts_alcu_free(ErtsAlcType_t type, void *extra, void *p) { - do_erts_alcu_free(type, extra, p); + do_erts_alcu_free(type, extra, p, NULL); } #ifdef USE_THREADS @@ -3704,7 +4950,7 @@ erts_alcu_free_ts(ErtsAlcType_t type, void *extra, void *p) { Allctr_t *allctr = (Allctr_t *) extra; erts_mtx_lock(&allctr->mutex); - do_erts_alcu_free(type, extra, p); + do_erts_alcu_free(type, extra, p, NULL); erts_mtx_unlock(&allctr->mutex); } @@ -3726,7 +4972,7 @@ erts_alcu_free_thr_spec(ErtsAlcType_t type, void *extra, void *p) if (allctr->thread_safe) erts_mtx_lock(&allctr->mutex); - do_erts_alcu_free(type, allctr, p); + do_erts_alcu_free(type, allctr, p, NULL); if (allctr->thread_safe) erts_mtx_unlock(&allctr->mutex); @@ -3736,10 +4982,12 @@ void erts_alcu_free_thr_pref(ErtsAlcType_t type, void *extra, void *p) { if (p) { + Carrier_t *busy_pcrr_p; Allctr_t *pref_allctr, *used_allctr; pref_allctr = get_pref_allctr(extra); - used_allctr = get_used_allctr(extra, p, NULL); + used_allctr = get_used_allctr(pref_allctr, ERTS_ALC_TS_PREF_LOCK_IF_USED, + p, NULL, &busy_pcrr_p); if (pref_allctr != used_allctr) enqueue_dealloc_other_instance(type, used_allctr, @@ -3747,12 +4995,11 @@ erts_alcu_free_thr_pref(ErtsAlcType_t type, void *extra, void *p) (used_allctr->dd.ix - pref_allctr->dd.ix)); else { - if (used_allctr->thread_safe) - erts_mtx_lock(&used_allctr->mutex); ERTS_ALCU_DBG_CHK_THR_ACCESS(used_allctr); - do_erts_alcu_free(type, used_allctr, p); - if (used_allctr->thread_safe) - erts_mtx_unlock(&used_allctr->mutex); + do_erts_alcu_free(type, used_allctr, p, &busy_pcrr_p); + clear_busy_pool_carrier(used_allctr, busy_pcrr_p); + if (pref_allctr->thread_safe) + erts_mtx_unlock(&pref_allctr->mutex); } } } @@ -3768,7 +5015,8 @@ do_erts_alcu_realloc(ErtsAlcType_t type, void *extra, void *p, Uint size, - Uint32 alcu_flgs) + Uint32 alcu_flgs, + Carrier_t **busy_pcrr_pp) { Allctr_t *allctr = (Allctr_t *) extra; Block_t *blk; @@ -3793,7 +5041,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type, #if ALLOC_ZERO_EQ_NULL if (!size) { ASSERT(p); - do_erts_alcu_free(type, extra, p); + do_erts_alcu_free(type, extra, p, busy_pcrr_pp); INC_CC(allctr->calls.this_realloc); DEC_CC(allctr->calls.this_free); return NULL; @@ -3804,32 +5052,9 @@ do_erts_alcu_realloc(ErtsAlcType_t type, blk = UMEM2BLK(p); - if (allctr->sbmbc_threshold > 0) { - Uint old_sz, new_sz, lim; - lim = allctr->sbmbc_threshold; - old_sz = BLK_SZ(blk); - new_sz = UMEMSZ2BLKSZ(allctr, size); - if ((old_sz < lim && lim <= new_sz) - || (new_sz < lim && lim <= old_sz)) { - /* *Need* to move it... */ - - INC_CC(allctr->calls.this_realloc); - res = do_erts_alcu_alloc(type, extra, size); - DEC_CC(allctr->calls.this_alloc); - - sys_memcpy(res, p, MIN(size, old_sz - ABLK_HDR_SZ)); - - do_erts_alcu_free(type, extra, p); - DEC_CC(allctr->calls.this_free); - return res; - } - if (old_sz < lim) - alcu_flgs |= ERTS_ALCU_FLG_SBMBC; - } - if (size < allctr->sbc_threshold) { if (IS_MBC_BLK(blk)) - res = mbc_realloc(allctr, p, size, alcu_flgs); + res = mbc_realloc(allctr, p, size, alcu_flgs, busy_pcrr_pp); else { Uint used_sz = SBC_HEADER_SIZE + ABLK_HDR_SZ + size; Uint crr_sz; @@ -3868,16 +5093,12 @@ do_erts_alcu_realloc(ErtsAlcType_t type, sys_memcpy((void*) res, (void*) p, MIN(SBC_BLK_SZ(blk) - ABLK_HDR_SZ, size)); - destroy_carrier(allctr, blk); + destroy_carrier(allctr, blk, NULL); } } } else { Block_t *new_blk; -#ifdef ERTS_SMP - if (allctr->dd.use) - ERTS_ALCU_HANDLE_DD_IN_OP(allctr, 1); -#endif if(IS_SBC_BLK(blk)) { do_carrier_resize: #if HALFWORD_HEAP @@ -3896,7 +5117,7 @@ do_erts_alcu_realloc(ErtsAlcType_t type, sys_memcpy((void *) res, (void *) p, MIN(MBC_ABLK_SZ(blk) - ABLK_HDR_SZ, size)); - mbc_free(allctr, p); + mbc_free(allctr, p, busy_pcrr_pp); } else res = NULL; @@ -3910,7 +5131,7 @@ void * erts_alcu_realloc(ErtsAlcType_t type, void *extra, void *p, Uint size) { void *res; - res = do_erts_alcu_realloc(type, extra, p, size, 0); + res = do_erts_alcu_realloc(type, extra, p, size, 0, NULL); DEBUG_CHECK_ALIGNMENT(res); return res; } @@ -3931,7 +5152,7 @@ erts_alcu_realloc_mv(ErtsAlcType_t type, void *extra, void *p, Uint size) if (cpy_size > size) cpy_size = size; sys_memcpy(res, p, cpy_size); - do_erts_alcu_free(type, extra, p); + do_erts_alcu_free(type, extra, p, NULL); } DEBUG_CHECK_ALIGNMENT(res); return res; @@ -3946,7 +5167,7 @@ erts_alcu_realloc_ts(ErtsAlcType_t type, void *extra, void *ptr, Uint size) Allctr_t *allctr = (Allctr_t *) extra; void *res; erts_mtx_lock(&allctr->mutex); - res = do_erts_alcu_realloc(type, extra, ptr, size, 0); + res = do_erts_alcu_realloc(type, extra, ptr, size, 0, NULL); erts_mtx_unlock(&allctr->mutex); DEBUG_CHECK_ALIGNMENT(res); return res; @@ -3970,7 +5191,7 @@ erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size) if (cpy_size > size) cpy_size = size; sys_memcpy(res, p, cpy_size); - do_erts_alcu_free(type, extra, p); + do_erts_alcu_free(type, extra, p, NULL); } erts_mtx_unlock(&allctr->mutex); DEBUG_CHECK_ALIGNMENT(res); @@ -3997,7 +5218,7 @@ erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra, if (allctr->thread_safe) erts_mtx_lock(&allctr->mutex); - res = do_erts_alcu_realloc(type, allctr, ptr, size, 0); + res = do_erts_alcu_realloc(type, allctr, ptr, size, 0, NULL); if (allctr->thread_safe) erts_mtx_unlock(&allctr->mutex); @@ -4040,7 +5261,7 @@ erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra, if (cpy_size > size) cpy_size = size; sys_memcpy(res, ptr, cpy_size); - do_erts_alcu_free(type, allctr, ptr); + do_erts_alcu_free(type, allctr, ptr, NULL); if (allctr->thread_safe) erts_mtx_unlock(&allctr->mutex); } @@ -4057,40 +5278,64 @@ realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size, void *res; Allctr_t *pref_allctr, *used_allctr; UWord old_user_size; + Carrier_t *busy_pcrr_p; +#ifdef ERTS_SMP + int retried; +#endif if (!p) return erts_alcu_alloc_thr_pref(type, extra, size); pref_allctr = get_pref_allctr(extra); - used_allctr = get_used_allctr(extra, p, &old_user_size); + + if (pref_allctr->thread_safe) + erts_mtx_lock(&pref_allctr->mutex); + +#ifdef ERTS_SMP + ASSERT(pref_allctr->dd.use); + ERTS_ALCU_HANDLE_DD_IN_OP(pref_allctr, 1); + retried = 0; +restart: +#endif + + used_allctr = get_used_allctr(pref_allctr, ERTS_ALC_TS_PREF_LOCK_NO, + p, &old_user_size, &busy_pcrr_p); ASSERT(used_allctr && pref_allctr); if (!force_move && used_allctr == pref_allctr) { - if (used_allctr->thread_safe) - erts_mtx_lock(&used_allctr->mutex); ERTS_ALCU_DBG_CHK_THR_ACCESS(used_allctr); res = do_erts_alcu_realloc(type, used_allctr, p, size, - 0); - if (used_allctr->thread_safe) - erts_mtx_unlock(&used_allctr->mutex); + 0, + &busy_pcrr_p); + clear_busy_pool_carrier(used_allctr, busy_pcrr_p); +#ifdef ERTS_SMP + if (!res && !retried && ERTS_ALCU_HANDLE_DD_IN_OP(pref_allctr, 1)) { + /* Cleaned up a bit more; try one more time... */ + retried = 1; + goto restart; + } +#endif + if (pref_allctr->thread_safe) + erts_mtx_unlock(&pref_allctr->mutex); } else { - if (pref_allctr->thread_safe) - erts_mtx_lock(&pref_allctr->mutex); res = do_erts_alcu_alloc(type, pref_allctr, size); - if (pref_allctr->thread_safe && used_allctr != pref_allctr) { - erts_mtx_unlock(&pref_allctr->mutex); - } - if (res) { - DEBUG_CHECK_ALIGNMENT(res); + if (!res) + goto unlock_ts_return; + else { - sys_memcpy(res, p, MIN(size,old_user_size)); + DEBUG_CHECK_ALIGNMENT(res); if (used_allctr != pref_allctr) { + if (pref_allctr->thread_safe) + erts_mtx_unlock(&pref_allctr->mutex); + + sys_memcpy(res, p, MIN(size, old_user_size)); + enqueue_dealloc_other_instance(type, used_allctr, p, @@ -4098,8 +5343,14 @@ realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size, - pref_allctr->dd.ix)); } else { - do_erts_alcu_free(type, used_allctr, p); + + sys_memcpy(res, p, MIN(size, old_user_size)); + + do_erts_alcu_free(type, used_allctr, p, &busy_pcrr_p); ASSERT(pref_allctr == used_allctr); + clear_busy_pool_carrier(used_allctr, busy_pcrr_p); + + unlock_ts_return: if (pref_allctr->thread_safe) erts_mtx_unlock(&pref_allctr->mutex); } @@ -4213,6 +5464,17 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) if (sz > allctr->min_block_size) allctr->min_block_size = sz; } + + allctr->cpool.dc_list.first = NULL; + allctr->cpool.dc_list.last = NULL; + allctr->cpool.abandon_limit = 0; + allctr->cpool.disable_abandon = 0; + erts_atomic_init_nob(&allctr->cpool.stat.blocks_size, 0); + erts_atomic_init_nob(&allctr->cpool.stat.no_blocks, 0); + erts_atomic_init_nob(&allctr->cpool.stat.carriers_size, 0); + erts_atomic_init_nob(&allctr->cpool.stat.no_carriers, 0); + allctr->cpool.check_limit_count = ERTS_ALC_CPOOL_CHECK_LIMIT_COUNT; + allctr->cpool.util_limit = init->acul; #endif allctr->sbc_threshold = init->sbct; @@ -4232,27 +5494,6 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) } #endif - - - allctr->sbmbc_threshold = init->sbmbct; - - if (!erts_have_sbmbc_alloc - || ERTS_IS_SBMBC_ALLOCATOR_NO__(allctr->alloc_no)) - allctr->sbmbc_threshold = 0; - - if (!allctr->sbmbc_threshold) - allctr->sbmbc_size = 0; - else { - Uint min_size; - allctr->sbmbc_size = init->sbmbcs; - min_size = allctr->sbmbc_threshold; - min_size += allctr->min_block_size; - min_size += MBC_HEADER_SIZE(allctr); - if (allctr->sbmbc_size < min_size) - allctr->sbmbc_size = min_size; - } - - #if HAVE_ERTS_MSEG if (allctr->mseg_opt.abs_shrink_th > ~((UWord) 0) / 100) allctr->mseg_opt.abs_shrink_th = ~((UWord) 0) / 100; @@ -4264,16 +5505,12 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) #ifdef ERTS_ENABLE_LOCK_COUNT erts_mtx_init_x_opt(&allctr->mutex, - ERTS_IS_SBMBC_ALLOCATOR_NO__(allctr->alloc_no) - ? "sbmbc_alloc" - : "alcu_allocator", + "alcu_allocator", make_small(allctr->alloc_no), ERTS_LCNT_LT_ALLOC); #else erts_mtx_init_x(&allctr->mutex, - ERTS_IS_SBMBC_ALLOCATOR_NO__(allctr->alloc_no) - ? "sbmbc_alloc" - : "alcu_allocator", + "alcu_allocator", make_small(allctr->alloc_no)); #endif /*ERTS_ENABLE_LOCK_COUNT*/ @@ -4292,6 +5529,8 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) if (!allctr->get_next_mbc_size) allctr->get_next_mbc_size = get_next_mbc_size; + if (allctr->mbc_header_size < sizeof(Carrier_t)) + goto error; #ifdef ERTS_SMP allctr->dd.use = 0; if (init->tpref) { @@ -4300,6 +5539,9 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) allctr->dd.ix = init->ix; } #endif + allctr->mbc_header_size = (UNIT_CEILING(allctr->mbc_header_size + + ABLK_HDR_SZ) + - ABLK_HDR_SZ); if (allctr->main_carrier_size) { Block_t *blk; @@ -4308,6 +5550,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) allctr->main_carrier_size, CFLG_MBC | CFLG_FORCE_SIZE + | CFLG_NO_CPOOL #if !HALFWORD_HEAP && !HAVE_SUPER_ALIGNED_MB_CARRIERS | CFLG_FORCE_SYS_ALLOC #endif @@ -4315,7 +5558,7 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) if (!blk) goto error; - (*allctr->link_free_block)(allctr, blk, 0); + (*allctr->link_free_block)(allctr, blk); HARD_CHECK_BLK_CARRIER(allctr, blk); @@ -4326,16 +5569,24 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) allctr->fix = init->fix; allctr->fix_shrink_scheduled = 0; for (i = 0; i < ERTS_ALC_NO_FIXED_SIZES; i++) { - allctr->fix[i].max_used = 0; - allctr->fix[i].limit = 0; allctr->fix[i].type_size = init->fix_type_size[i]; allctr->fix[i].list_size = 0; allctr->fix[i].list = NULL; - allctr->fix[i].allocated = 0; - allctr->fix[i].used = 0; #ifdef ERTS_SMP ASSERT(allctr->fix[i].type_size >= sizeof(ErtsAllctrFixDDBlock_t)); #endif + if (ERTS_ALC_IS_CPOOL_ENABLED(allctr)) { + allctr->fix[i].u.cpool.min_list_size = 0; + allctr->fix[i].u.cpool.shrink_list = 0; + allctr->fix[i].u.cpool.allocated = 0; + allctr->fix[i].u.cpool.used = 0; + } + else { + allctr->fix[i].u.nocpool.max_used = 0; + allctr->fix[i].u.nocpool.limit = 0; + allctr->fix[i].u.nocpool.allocated = 0; + allctr->fix[i].u.nocpool.used = 0; + } } } @@ -4360,11 +5611,9 @@ erts_alcu_stop(Allctr_t *allctr) allctr->stopped = 1; while (allctr->sbc_list.first) - destroy_carrier(allctr, SBC2BLK(allctr, allctr->sbc_list.first)); + destroy_carrier(allctr, SBC2BLK(allctr, allctr->sbc_list.first), NULL); while (allctr->mbc_list.first) - destroy_carrier(allctr, MBC_TO_FIRST_BLK(allctr, allctr->mbc_list.first)); - while (allctr->sbmbc_list.first) - destroy_sbmbc(allctr, MBC_TO_FIRST_BLK(allctr, allctr->sbmbc_list.first)); + destroy_carrier(allctr, MBC_TO_FIRST_BLK(allctr, allctr->mbc_list.first), NULL); #ifdef USE_THREADS if (allctr->thread_safe) @@ -4378,6 +5627,14 @@ erts_alcu_stop(Allctr_t *allctr) void erts_alcu_init(AlcUInit_t *init) { +#ifdef ERTS_SMP + int i; + for (i = 0; i <= ERTS_ALC_A_MAX; i++) { + ErtsAlcCPoolData_t *sentinel = &carrier_pool[i].sentinel; + erts_atomic_init_nob(&sentinel->next, (erts_aint_t) sentinel); + erts_atomic_init_nob(&sentinel->prev, (erts_aint_t) sentinel); + } +#endif ASSERT(SBC_BLK_SZ_MASK == MBC_FBLK_SZ_MASK); /* see BLK_SZ */ #if HAVE_ERTS_MSEG ASSERT(erts_mseg_unit_size() == MSEG_UNIT_SZ); @@ -4440,8 +5697,35 @@ erts_alcu_test(UWord op, UWord a1, UWord a2) case 0x019: return (UWord) PREV_BLK((Block_t *) a1); case 0x01a: return (UWord) IS_MBC_FIRST_BLK((Allctr_t*)a1, (Block_t *) a2); case 0x01b: return (UWord) sizeof(Unit_t); + case 0x01c: return (unsigned long) BLK_TO_MBC((Block_t*) a1); + case 0x01d: ((Allctr_t*) a1)->add_mbc((Allctr_t*)a1, (Carrier_t*)a2); break; + case 0x01e: ((Allctr_t*) a1)->remove_mbc((Allctr_t*)a1, (Carrier_t*)a2); break; +#ifdef ERTS_SMP + case 0x01f: return (UWord) sizeof(ErtsAlcCrrPool_t); + case 0x020: + SET_CARRIER_HDR((Carrier_t *) a2, 0, SCH_SYS_ALLOC|SCH_MBC, (Allctr_t *) a1); + cpool_init_carrier_data((Allctr_t *) a1, (Carrier_t *) a2); + return (UWord) a2; + case 0x021: + cpool_insert((Allctr_t *) a1, (Carrier_t *) a2); + return (UWord) a2; + case 0x022: + cpool_delete((Allctr_t *) a1, (Allctr_t *) a1, (Carrier_t *) a2); + return (UWord) a2; + case 0x023: return (UWord) cpool_is_empty((Allctr_t *) a1); + case 0x024: return (UWord) cpool_dbg_is_in_pool((Allctr_t *) a1, (Carrier_t *) a2); +#else + case 0x01f: return (UWord) 0; + case 0x020: return (UWord) 0; + case 0x021: return (UWord) 0; + case 0x022: return (UWord) 0; + case 0x023: return (UWord) 0; + case 0x024: return (UWord) 0; +#endif + default: ASSERT(0); return ~((UWord) 0); } + return 0; } /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ @@ -4449,6 +5733,20 @@ erts_alcu_test(UWord op, UWord a1, UWord a2) \* */ void +erts_alcu_assert_failed(char* expr, char* file, int line, char *func) +{ + fflush(stdout); + fprintf(stderr, "%s:%d:%s(): Assertion failed: %s\n", + file, line, func, expr); + fflush(stderr); +#if defined(__WIN__) || defined(__WIN32__) + DebugBreak(); +#else + abort(); +#endif +} + +void erts_alcu_verify_unused(Allctr_t *allctr) { UWord no; @@ -4456,12 +5754,10 @@ erts_alcu_verify_unused(Allctr_t *allctr) no = allctr->sbcs.curr.norm.mseg.no; no += allctr->sbcs.curr.norm.sys_alloc.no; no += allctr->mbcs.blocks.curr.no; - no += allctr->sbmbcs.blocks.curr.no; if (no) { UWord sz = allctr->sbcs.blocks.curr.size; sz += allctr->mbcs.blocks.curr.size; - sz += allctr->sbmbcs.blocks.curr.size; erl_exit(ERTS_ABORT_EXIT, "%salloc() used when expected to be unused!\n" "Total amount of blocks allocated: %bpu\n" @@ -4595,7 +5891,7 @@ check_blk_carrier(Allctr_t *allctr, Block_t *iblk) cl = &allctr->mbc_list; } -#if 0 /* FIXIT sbmbc */ +#ifdef DEBUG if (cl->first == crr) { ASSERT(!crr->prev); } diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index 4773598561..5e52b9b733 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -55,8 +55,7 @@ typedef struct { UWord lmbcs; UWord smbcs; UWord mbcgs; - UWord sbmbct; - UWord sbmbcs; + int acul; void *fix; size_t *fix_type_size; @@ -100,8 +99,7 @@ typedef struct { 10*1024*1024, /* (bytes) lmbcs: largest mbc size */\ 1024*1024, /* (bytes) smbcs: smallest mbc size */\ 10, /* (amount) mbcgs: mbc growth stages */\ - 256, /* (bytes) sbmbct: small block mbc threshold */\ - 8*1024, /* (bytes) sbmbcs: small block mbc size */ \ + 0, /* (%) acul: abandon carrier utilization limit */\ /* --- Data not options -------------------------------------------- */\ NULL, /* (ptr) fix */\ NULL /* (ptr) fix_type_size */\ @@ -134,8 +132,7 @@ typedef struct { 1024*1024, /* (bytes) lmbcs: largest mbc size */\ 128*1024, /* (bytes) smbcs: smallest mbc size */\ 10, /* (amount) mbcgs: mbc growth stages */\ - 256, /* (bytes) sbmbct: small block mbc threshold */\ - 8*1024, /* (bytes) sbmbcs: small block mbc size */ \ + 0, /* (%) acul: abandon carrier utilization limit */\ /* --- Data not options -------------------------------------------- */\ NULL, /* (ptr) fix */\ NULL /* (ptr) fix_type_size */\ @@ -165,8 +162,8 @@ void erts_alcu_free_thr_pref(ErtsAlcType_t, void *, void *); #endif Eterm erts_alcu_au_info_options(int *, void *, Uint **, Uint *); Eterm erts_alcu_info_options(Allctr_t *, int *, void *, Uint **, Uint *); -Eterm erts_alcu_sz_info(Allctr_t *, int, int *, void *, Uint **, Uint *); -Eterm erts_alcu_info(Allctr_t *, int, int *, void *, Uint **, Uint *); +Eterm erts_alcu_sz_info(Allctr_t *, int, int, int *, void *, Uint **, Uint *); +Eterm erts_alcu_info(Allctr_t *, int, int, int *, void *, Uint **, Uint *); void erts_alcu_init(AlcUInit_t *); void erts_alcu_current_size(Allctr_t *, AllctrSize_t *, ErtsAlcUFixInfo_t *, int); @@ -181,7 +178,6 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t); #define ERL_ALLOC_UTIL_IMPL__ #define ERTS_ALCU_FLG_FAIL_REALLOC_MOVE (((Uint32) 1) << 0) -#define ERTS_ALCU_FLG_SBMBC (((Uint32) 1) << 1) #ifdef USE_THREADS #define ERL_THREADS_EMU_INTERNAL__ @@ -221,8 +217,15 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t); #define MBC_FBLK_SZ_MASK UNIT_MASK #define CARRIER_SZ_MASK UNIT_MASK - #if HAVE_ERTS_MSEG + +# define MSEG_UNIT_SHIFT MSEG_ALIGN_BITS +# define MSEG_UNIT_SZ (1 << MSEG_UNIT_SHIFT) +# define MSEG_UNIT_MASK ((~(UWord)0) << MSEG_UNIT_SHIFT) + +# define MSEG_UNIT_FLOOR(X) ((X) & MSEG_UNIT_MASK) +# define MSEG_UNIT_CEILING(X) MSEG_UNIT_FLOOR((X) + ~MSEG_UNIT_MASK) + # ifdef ARCH_64 # define MBC_ABLK_OFFSET_BITS 24 # elif HAVE_SUPER_ALIGNED_MB_CARRIERS @@ -238,10 +241,8 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t); # define MBC_ABLK_OFFSET_SHIFT (sizeof(UWord)*8 - MBC_ABLK_OFFSET_BITS) # define MBC_ABLK_OFFSET_MASK (~((UWord)0) << MBC_ABLK_OFFSET_SHIFT) # define MBC_ABLK_SZ_MASK (~MBC_ABLK_OFFSET_MASK & ~FLG_MASK) -# define HAVE_ERTS_SBMBC 0 #else # define MBC_ABLK_SZ_MASK (~FLG_MASK) -# define HAVE_ERTS_SBMBC 1 #endif #define MBC_ABLK_SZ(B) (ASSERT_EXPR(!is_sbc_blk(B)), (B)->bhdr & MBC_ABLK_SZ_MASK) @@ -251,18 +252,37 @@ erts_aint32_t erts_alcu_fix_alloc_shrink(Allctr_t *, erts_aint32_t); #define CARRIER_SZ(C) \ ((C)->chdr & CARRIER_SZ_MASK) -extern int erts_have_sbmbc_alloc; - typedef union {char c[ERTS_ALLOC_ALIGN_BYTES]; long l; double d;} Unit_t; +#ifdef ERTS_SMP + +typedef struct { + erts_atomic_t next; + erts_atomic_t prev; + Allctr_t *orig_allctr; + ErtsThrPrgrVal thr_prgr; + erts_atomic_t max_size; + UWord abandon_limit; + UWord blocks; + UWord blocks_size; +} ErtsAlcCPoolData_t; + +#endif + typedef struct Carrier_t_ Carrier_t; struct Carrier_t_ { UWord chdr; Carrier_t *next; Carrier_t *prev; - Allctr_t *allctr; + erts_smp_atomic_t allctr; +#ifdef ERTS_SMP + ErtsAlcCPoolData_t cpool; /* Overwritten by block if sbc */ +#endif }; +#define ERTS_ALC_CARRIER_TO_ALLCTR(C) \ + ((Allctr_t *) (erts_smp_atomic_read_nob(&(C)->allctr) & ~FLG_MASK)) + typedef struct { Carrier_t *first; Carrier_t *last; @@ -280,12 +300,46 @@ typedef struct { #endif } Block_t; +#define THIS_FREE_BLK_HDR_FLG (((UWord) 1) << 0) +#define PREV_FREE_BLK_HDR_FLG (((UWord) 1) << 1) +#define LAST_BLK_HDR_FLG (((UWord) 1) << 2) + +#define SBC_BLK_HDR_FLG /* Special flag combo for (allocated) SBC blocks */\ + (THIS_FREE_BLK_HDR_FLG | PREV_FREE_BLK_HDR_FLG | LAST_BLK_HDR_FLG) + +/* + * FREE_LAST_MBC_BLK_HDR_FLGS is a special flag combo used for + * distinguishing empty mbc's from allocated blocks in + * handle_delayed_dealloc(). + */ +#define FREE_LAST_MBC_BLK_HDR_FLGS (THIS_FREE_BLK_HDR_FLG | LAST_BLK_HDR_FLG) + +#define IS_FREE_LAST_MBC_BLK(B) \ + (((B)->bhdr & FLG_MASK) == FREE_LAST_MBC_BLK_HDR_FLGS) + +#define IS_SBC_BLK(B) (((B)->bhdr & FLG_MASK) == SBC_BLK_HDR_FLG) +#define IS_MBC_BLK(B) (!IS_SBC_BLK((B))) +#define IS_FREE_BLK(B) (ASSERT(IS_MBC_BLK(B)), \ + (B)->bhdr & THIS_FREE_BLK_HDR_FLG) + +#if MBC_ABLK_OFFSET_BITS +# define FBLK_TO_MBC(B) (ASSERT(IS_MBC_BLK(B) && IS_FREE_BLK(B)), \ + (B)->u.carrier) +# define ABLK_TO_MBC(B) \ + (ASSERT(IS_MBC_BLK(B) && !IS_FREE_BLK(B)), \ + (Carrier_t*)((MSEG_UNIT_FLOOR((UWord)(B)) - \ + (((B)->bhdr >> MBC_ABLK_OFFSET_SHIFT) << MSEG_UNIT_SHIFT)))) +# define BLK_TO_MBC(B) (IS_FREE_BLK(B) ? FBLK_TO_MBC(B) : ABLK_TO_MBC(B)) +#else +# define FBLK_TO_MBC(B) ((B)->carrier) +# define ABLK_TO_MBC(B) ((B)->carrier) +# define BLK_TO_MBC(B) ((B)->carrier) +#endif +#define MBC_BLK_SZ(B) (IS_FREE_BLK(B) ? MBC_FBLK_SZ(B) : MBC_ABLK_SZ(B)) + typedef UWord FreeBlkFtr_t; /* Footer of a free block */ -typedef struct { - UWord giga_no; - UWord no; -} CallCounter_t; +typedef Uint64 CallCounter_t; typedef struct { UWord no; @@ -298,7 +352,6 @@ typedef struct { StatValues_t mseg; StatValues_t sys_alloc; } norm; - StatValues_t small_block; } curr; StatValues_t max; StatValues_t max_ever; @@ -358,10 +411,20 @@ typedef struct { size_t type_size; SWord list_size; void *list; - SWord max_used; - SWord limit; - SWord allocated; - SWord used; + union { + struct { + SWord max_used; + SWord limit; + SWord allocated; + SWord used; + } nocpool; + struct { + int min_list_size; + int shrink_list; + UWord allocated; + UWord used; + } cpool; + } u; } ErtsAlcFixList_t; struct Allctr_t_ { @@ -409,37 +472,56 @@ struct Allctr_t_ { Uint largest_mbc_size; Uint smallest_mbc_size; Uint mbc_growth_stages; - Uint sbmbc_threshold; - Uint sbmbc_size; #if HAVE_ERTS_MSEG ErtsMsegOpt_t mseg_opt; #endif /* */ + Uint mbc_header_size; Uint min_mbc_size; Uint min_mbc_first_free_size; Uint min_block_size; /* Carriers */ - CarrierList_t sbmbc_list; CarrierList_t mbc_list; CarrierList_t sbc_list; +#ifdef ERTS_SMP + struct { + CarrierList_t dc_list; + UWord abandon_limit; + int disable_abandon; + int check_limit_count; + int util_limit; + struct { + erts_atomic_t blocks_size; + erts_atomic_t no_blocks; + erts_atomic_t carriers_size; + erts_atomic_t no_carriers; + } stat; + } cpool; +#endif /* Main carrier (if there is one) */ Carrier_t * main_carrier; /* Callback functions (first 4 are mandatory) */ Block_t * (*get_free_block) (Allctr_t *, Uint, - Block_t *, Uint, Uint32); - void (*link_free_block) (Allctr_t *, Block_t *, Uint32); - void (*unlink_free_block) (Allctr_t *, Block_t *, Uint32); + Block_t *, Uint); + void (*link_free_block) (Allctr_t *, Block_t *); + void (*unlink_free_block) (Allctr_t *, Block_t *); Eterm (*info_options) (Allctr_t *, char *, int *, void *, Uint **, Uint *); Uint (*get_next_mbc_size) (Allctr_t *); - void (*creating_mbc) (Allctr_t *, Carrier_t *, Uint32); - void (*destroying_mbc) (Allctr_t *, Carrier_t *, Uint32); + void (*creating_mbc) (Allctr_t *, Carrier_t *); + void (*destroying_mbc) (Allctr_t *, Carrier_t *); + + /* The three callbacks below are needed to support carrier migration */ + void (*add_mbc) (Allctr_t *, Carrier_t *); + void (*remove_mbc) (Allctr_t *, Carrier_t *); + UWord (*largest_fblk_in_mbc) (Allctr_t *, Carrier_t *); + void (*init_atoms) (void); #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG @@ -471,8 +553,6 @@ struct Allctr_t_ { CallCounter_t this_alloc; CallCounter_t this_free; CallCounter_t this_realloc; - CallCounter_t sbmbc_alloc; - CallCounter_t sbmbc_free; CallCounter_t mseg_alloc; CallCounter_t mseg_dealloc; CallCounter_t mseg_realloc; @@ -483,8 +563,7 @@ struct Allctr_t_ { CarriersStats_t sbcs; CarriersStats_t mbcs; - CarriersStats_t sbmbcs; - + #ifdef DEBUG #ifdef USE_THREADS struct { @@ -503,6 +582,8 @@ void erts_alcu_verify_unused_ts(Allctr_t *allctr); UWord erts_alcu_test(UWord, UWord, UWord); +void erts_alcu_assert_failed(char* expr, char* file, int line, char *func); + #ifdef DEBUG int is_sbc_blk(Block_t*); #endif diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c index b916cb6198..f73ac2eb6e 100644 --- a/erts/emulator/beam/erl_ao_firstfit_alloc.c +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c @@ -28,11 +28,16 @@ * * This module is a callback-module for erl_alloc_util.c * - * Algorithm: The tree nodes are free-blocks ordered in address order. + * AOFF Algorithm: + * The tree nodes are ordered in address order. * Every node also keeps the size of the largest block in its - * sub-tree ('max_size'). By that we can start from root and keep + * sub-tree ('max_sz'). By that we can start from root and keep * left (for low addresses) while dismissing entire sub-trees with * too small blocks. + * AOFFCBF: + * The only difference for "bestfit within carrier" is the tree + * sorting order. Blocks within the same carrier are sorted + * wrt size instead of address. * * Authors: Rickard Green/Sverker Eriksson */ @@ -85,21 +90,45 @@ typedef struct AOFF_RBTree_t_ AOFF_RBTree_t; struct AOFF_RBTree_t_ { Block_t hdr; - Uint flags; AOFF_RBTree_t *parent; AOFF_RBTree_t *left; AOFF_RBTree_t *right; - Uint max_sz; /* of all blocks in this sub-tree */ + Uint32 flags; + Uint32 max_sz; /* of all blocks in this sub-tree */ }; #define AOFF_BLK_SZ(B) MBC_FBLK_SZ(&(B)->hdr) +typedef struct AOFF_Carrier_t_ AOFF_Carrier_t; + +struct AOFF_Carrier_t_ { + Carrier_t crr; + AOFF_RBTree_t rbt_node; /* My node in the carrier tree */ + AOFF_RBTree_t* root; /* Root of my block tree */ +}; +#define RBT_NODE_TO_MBC(PTR) ((AOFF_Carrier_t*)((char*)(PTR) - offsetof(AOFF_Carrier_t, rbt_node))) + +/* + To support carrier migration we keep two kinds of rb-trees: + 1. One tree of carriers for each allocator instance. + 2. One tree of free blocks for each carrier. + Both trees use the same node structure AOFF_RBTree_t and implementation. + Carrier nodes thus contain a phony Block_t header 'rbt_node.hdr'. + The size value of such a phony block is the size of the largest free block in + that carrier, i.e same as 'max_sz' of the root node of its block tree. +*/ + #ifdef HARD_DEBUG -static AOFF_RBTree_t * check_tree(AOFF_RBTree_t* root, Uint); +# define HARD_CHECK_IS_MEMBER(ROOT,NODE) rbt_assert_is_member(ROOT,NODE) +# define HARD_CHECK_TREE(CRR,BF,ROOT,SZ) check_tree(CRR, BF, ROOT, SZ) +static AOFF_RBTree_t * check_tree(Carrier_t* within_crr, int bestfit, AOFF_RBTree_t* root, Uint); +#else +# define HARD_CHECK_IS_MEMBER(ROOT,NODE) +# define HARD_CHECK_TREE(CRR,BF,ROOT,SZ) #endif -/* Calculate 'max_size' of tree node x by only looking at the direct children - * of x and x itself. +/* Calculate 'max_sz' of tree node x by only looking at 'max_sz' of the + * direct children of x and the size x itself. */ static ERTS_INLINE Uint node_max_size(AOFF_RBTree_t *x) { @@ -113,7 +142,7 @@ static ERTS_INLINE Uint node_max_size(AOFF_RBTree_t *x) return sz; } -/* Set new possibly lower 'max_size' of node and propagate change toward root +/* Set new possibly lower 'max_sz' of node and propagate change toward root */ static ERTS_INLINE void lower_max_size(AOFF_RBTree_t *node, AOFF_RBTree_t* stop_at) @@ -132,32 +161,53 @@ static ERTS_INLINE void lower_max_size(AOFF_RBTree_t *node, else ASSERT(new_max == old_max); } +static ERTS_INLINE SWord cmp_blocks(int bestfit, + AOFF_RBTree_t* lhs, AOFF_RBTree_t* rhs) +{ + ASSERT(lhs != rhs); + ASSERT(!bestfit || FBLK_TO_MBC(&lhs->hdr) == FBLK_TO_MBC(&rhs->hdr)); + if (bestfit) { + SWord diff = (SWord)AOFF_BLK_SZ(lhs) - (SWord)AOFF_BLK_SZ(rhs); + if (diff) return diff; + } + return (char*)lhs - (char*)rhs; +} + +static ERTS_INLINE SWord cmp_cand_blk(int bestfit, + Block_t* cand_blk, AOFF_RBTree_t* rhs) +{ + if (bestfit) { + if (BLK_TO_MBC(cand_blk) == FBLK_TO_MBC(&rhs->hdr)) { + SWord diff = (SWord)MBC_BLK_SZ(cand_blk) - (SWord)MBC_FBLK_SZ(&rhs->hdr); + if (diff) return diff; + } + } + return (char*)cand_blk - (char*)rhs; +} + /* Prototypes of callback functions */ -static Block_t* aoff_get_free_block(Allctr_t *, Uint, Block_t *, Uint, Uint32 flags); -static void aoff_link_free_block(Allctr_t *, Block_t*, Uint32 flags); -static void aoff_unlink_free_block(Allctr_t *allctr, Block_t *del, Uint32 flags); +static Block_t* aoff_get_free_block(Allctr_t *, Uint, Block_t *, Uint); +static void aoff_link_free_block(Allctr_t *, Block_t*); +static void aoff_unlink_free_block(Allctr_t *allctr, Block_t *del); +static void aoff_creating_mbc(Allctr_t*, Carrier_t*); +static void aoff_destroying_mbc(Allctr_t*, Carrier_t*); +static void aoff_add_mbc(Allctr_t*, Carrier_t*); +static void aoff_remove_mbc(Allctr_t*, Carrier_t*); +static UWord aoff_largest_fblk_in_mbc(Allctr_t*, Carrier_t*); + +/* Generic tree functions used by both carrier and block trees. */ +static void rbt_delete(AOFF_RBTree_t** root, AOFF_RBTree_t* del); +static void rbt_insert(int bestfit, AOFF_RBTree_t** root, AOFF_RBTree_t* blk); +static AOFF_RBTree_t* rbt_search(AOFF_RBTree_t* root, Uint size); +#ifdef HARD_DEBUG +static int rbt_assert_is_member(AOFF_RBTree_t* root, AOFF_RBTree_t* node); +#endif static Eterm info_options(Allctr_t *, char *, int *, void *, Uint **, Uint *); static void init_atoms(void); - -#ifdef DEBUG - -/* Destroy all tree fields */ -#define DESTROY_TREE_NODE(N) \ - sys_memset((void *) (((Block_t *) (N)) + 1), \ - 0xff, \ - (sizeof(AOFF_RBTree_t) - sizeof(Block_t))) - -#else - -#define DESTROY_TREE_NODE(N) - -#endif - - static int atoms_initialized = 0; void @@ -184,11 +234,14 @@ erts_aoffalc_start(AOFFAllctr_t *alc, sys_memcpy((void *) alc, (void *) &zero.allctr, sizeof(AOFFAllctr_t)); + alc->bf_within_carrier = aoffinit->bf_within_carrier; + allctr->mbc_header_size = sizeof(AOFF_Carrier_t); allctr->min_mbc_size = MIN_MBC_SZ; allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ; allctr->min_block_size = sizeof(AOFF_RBTree_t); - allctr->vsn_str = ERTS_ALC_AOFF_ALLOC_VSN_STR; + allctr->vsn_str = aoffinit->bf_within_carrier ? + ERTS_ALC_AOFF_CBF_ALLOC_VSN_STR : ERTS_ALC_AOFF_ALLOC_VSN_STR; /* Callback functions */ @@ -199,8 +252,11 @@ erts_aoffalc_start(AOFFAllctr_t *alc, allctr->info_options = info_options; allctr->get_next_mbc_size = NULL; - allctr->creating_mbc = NULL; - allctr->destroying_mbc = NULL; + allctr->creating_mbc = aoff_creating_mbc; + allctr->destroying_mbc = aoff_destroying_mbc; + allctr->add_mbc = aoff_add_mbc; + allctr->remove_mbc = aoff_remove_mbc; + allctr->largest_fblk_in_mbc = aoff_largest_fblk_in_mbc; allctr->init_atoms = init_atoms; #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG @@ -306,7 +362,6 @@ replace(AOFF_RBTree_t **root, AOFF_RBTree_t *x, AOFF_RBTree_t *y) y->max_sz = x->max_sz; lower_max_size(y, NULL); - DESTROY_TREE_NODE(x); } static void @@ -403,21 +458,47 @@ tree_insert_fixup(AOFF_RBTree_t** root, AOFF_RBTree_t *blk) } static void -aoff_unlink_free_block(Allctr_t *allctr, Block_t *del, Uint32 flags) +aoff_unlink_free_block(Allctr_t *allctr, Block_t *del) +{ +#ifdef HARD_DEBUG + AOFFAllctr_t* alc = (AOFFAllctr_t*)allctr; +#endif + AOFF_Carrier_t *crr = (AOFF_Carrier_t*) FBLK_TO_MBC(del); + + ASSERT(crr->rbt_node.hdr.bhdr == crr->root->max_sz); + HARD_CHECK_IS_MEMBER(alc->mbc_root, &crr->rbt_node); + HARD_CHECK_TREE(&crr->crr, alc->bf_within_carrier, crr->root, 0); + + rbt_delete(&crr->root, (AOFF_RBTree_t*)del); + + HARD_CHECK_TREE(&crr->crr, alc->bf_within_carrier, crr->root, 0); + + /* Update the carrier tree with a potentially new (lower) max_sz + */ + if (crr->root) { + if (crr->rbt_node.hdr.bhdr == crr->root->max_sz) { + return; + } + ASSERT(crr->rbt_node.hdr.bhdr > crr->root->max_sz); + crr->rbt_node.hdr.bhdr = crr->root->max_sz; + } + else { + crr->rbt_node.hdr.bhdr = 0; + } + lower_max_size(&crr->rbt_node, NULL); +} + +static void +rbt_delete(AOFF_RBTree_t** root, AOFF_RBTree_t* del) { - AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr; - AOFF_RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) - ? &alc->sbmbc_root : &alc->mbc_root); Uint spliced_is_black; - AOFF_RBTree_t *x, *y, *z = (AOFF_RBTree_t *) del; + AOFF_RBTree_t *x, *y, *z = del; AOFF_RBTree_t null_x; /* null_x is used to get the fixup started when we splice out a node without children. */ - null_x.parent = NULL; + HARD_CHECK_IS_MEMBER(*root, del); -#ifdef HARD_DEBUG - check_tree(*root, 0); -#endif + null_x.parent = NULL; /* Remove node from tree... */ @@ -572,26 +653,43 @@ aoff_unlink_free_block(Allctr_t *allctr, Block_t *del, Uint32 flags) RBT_ASSERT(!null_x.right); } } - - DESTROY_TREE_NODE(del); - -#ifdef HARD_DEBUG - check_tree(*root, 0); -#endif } static void -aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) +aoff_link_free_block(Allctr_t *allctr, Block_t *block) { - AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr; + AOFFAllctr_t* alc = (AOFFAllctr_t*) allctr; AOFF_RBTree_t *blk = (AOFF_RBTree_t *) block; - AOFF_RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) - ? &alc->sbmbc_root : &alc->mbc_root); + AOFF_RBTree_t *crr_node; + AOFF_Carrier_t *blk_crr = (AOFF_Carrier_t*) FBLK_TO_MBC(block); Uint blk_sz = AOFF_BLK_SZ(blk); -#ifdef HARD_DEBUG - check_tree(*root, 0); -#endif + ASSERT(allctr == ERTS_ALC_CARRIER_TO_ALLCTR(&blk_crr->crr)); + ASSERT(blk_crr->rbt_node.hdr.bhdr == (blk_crr->root ? blk_crr->root->max_sz : 0)); + HARD_CHECK_IS_MEMBER(alc->mbc_root, &blk_crr->rbt_node); + HARD_CHECK_TREE(&blk_crr->crr, alc->bf_within_carrier, blk_crr->root, 0); + + rbt_insert(alc->bf_within_carrier, &blk_crr->root, blk); + + /* Update the carrier tree with a potential new (larger) max_sz + */ + crr_node = &blk_crr->rbt_node; + if (blk_sz > crr_node->hdr.bhdr) { + ASSERT(blk_sz == blk_crr->root->max_sz); + crr_node->hdr.bhdr = blk_sz; + while (blk_sz > crr_node->max_sz) { + crr_node->max_sz = blk_sz; + crr_node = crr_node->parent; + if (!crr_node) break; + } + } + HARD_CHECK_TREE(&blk_crr->crr, alc->bf_within_carrier, blk_crr->root, 0); +} + +static void +rbt_insert(int bestfit, AOFF_RBTree_t** root, AOFF_RBTree_t* blk) +{ + Uint blk_sz = AOFF_BLK_SZ(blk); blk->flags = 0; blk->left = NULL; @@ -609,7 +707,7 @@ aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) if (x->max_sz < blk_sz) { x->max_sz = blk_sz; } - if (blk < x) { + if (cmp_blocks(bestfit, blk, x) < 0) { if (!x->left) { blk->parent = x; x->left = blk; @@ -625,7 +723,6 @@ aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) } x = x->right; } - } /* Insert block into size tree */ @@ -635,38 +732,59 @@ aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) if (IS_RED(blk->parent)) tree_insert_fixup(root, blk); } - -#ifdef HARD_DEBUG - check_tree(*root, 0); -#endif } -static Block_t * -aoff_get_free_block(Allctr_t *allctr, Uint size, - Block_t *cand_blk, Uint cand_size, Uint32 flags) +static AOFF_RBTree_t* +rbt_search(AOFF_RBTree_t* root, Uint size) { - AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr; - AOFF_RBTree_t *x = ((flags & ERTS_ALCU_FLG_SBMBC) - ? alc->sbmbc_root : alc->mbc_root); - AOFF_RBTree_t *blk = NULL; -#ifdef HARD_DEBUG - AOFF_RBTree_t* dbg_blk = check_tree(x, size); -#endif + AOFF_RBTree_t* x = root; - ASSERT(!cand_blk || cand_size >= size); - - while (x) { + ASSERT(x); + for (;;) { if (x->left && x->left->max_sz >= size) { x = x->left; } else if (AOFF_BLK_SZ(x) >= size) { - blk = x; - break; + return x; } else { x = x->right; + if (!x) { + return NULL; + } } } +} + +static Block_t * +aoff_get_free_block(Allctr_t *allctr, Uint size, + Block_t *cand_blk, Uint cand_size) +{ + AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr; + AOFF_RBTree_t *crr_node = alc->mbc_root; + AOFF_Carrier_t* crr; + AOFF_RBTree_t *blk = NULL; +#ifdef HARD_DEBUG + AOFF_RBTree_t* dbg_blk; +#endif + + ASSERT(!cand_blk || cand_size >= size); + + /* Get first-fit carrier + */ + if (!crr_node || !(blk=rbt_search(crr_node, size))) { + return NULL; + } + crr = RBT_NODE_TO_MBC(blk); + + /* Get block within carrier tree + */ +#ifdef HARD_DEBUG + dbg_blk = HARD_CHECK_TREE(&crr->crr, alc->bf_within_carrier, crr->root, size); +#endif + + blk = rbt_search(crr->root, size); + ASSERT(blk); #ifdef HARD_DEBUG ASSERT(blk == dbg_blk); @@ -675,15 +793,87 @@ aoff_get_free_block(Allctr_t *allctr, Uint size, if (!blk) return NULL; - if (cand_blk && cand_blk < &blk->hdr) { + if (cand_blk && cmp_cand_blk(alc->bf_within_carrier, cand_blk, blk) < 0) { return NULL; /* cand_blk was better */ } - aoff_unlink_free_block(allctr, (Block_t *) blk, flags); + aoff_unlink_free_block(allctr, (Block_t *) blk); return (Block_t *) blk; } +static void aoff_creating_mbc(Allctr_t *allctr, Carrier_t *carrier) +{ + AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr; + AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier; + AOFF_RBTree_t **root = &alc->mbc_root; + + HARD_CHECK_TREE(NULL, 0, *root, 0); + + /* Link carrier in address order tree + */ + crr->rbt_node.hdr.bhdr = 0; + rbt_insert(0, root, &crr->rbt_node); + + /* aoff_link_free_block will add free block later */ + crr->root = NULL; + + HARD_CHECK_TREE(NULL, 0, *root, 0); +} + +static void aoff_destroying_mbc(Allctr_t *allctr, Carrier_t *carrier) +{ + AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr; + AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier; + AOFF_RBTree_t *root = alc->mbc_root; + + if (crr->rbt_node.parent || &crr->rbt_node == root) { + aoff_remove_mbc(allctr, carrier); + } + /*else already removed */ +} + +static void aoff_add_mbc(Allctr_t *allctr, Carrier_t *carrier) +{ + AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr; + AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier; + AOFF_RBTree_t **root = &alc->mbc_root; + + HARD_CHECK_TREE(NULL, 0, *root, 0); + + /* Link carrier in address order tree + */ + rbt_insert(0, root, &crr->rbt_node); + + HARD_CHECK_TREE(NULL, 0, *root, 0); +} + +static void aoff_remove_mbc(Allctr_t *allctr, Carrier_t *carrier) +{ + AOFFAllctr_t *alc = (AOFFAllctr_t *) allctr; + AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier; + AOFF_RBTree_t **root = &alc->mbc_root; + + ASSERT(allctr == ERTS_ALC_CARRIER_TO_ALLCTR(carrier)); + HARD_CHECK_TREE(NULL, 0, *root, 0); + + rbt_delete(root, &crr->rbt_node); + crr->rbt_node.parent = NULL; + crr->rbt_node.left = NULL; + crr->rbt_node.right = NULL; + crr->rbt_node.max_sz = crr->rbt_node.hdr.bhdr; + + HARD_CHECK_TREE(NULL, 0, *root, 0); +} + +static UWord aoff_largest_fblk_in_mbc(Allctr_t* allctr, Carrier_t* carrier) +{ + AOFF_Carrier_t *crr = (AOFF_Carrier_t*) carrier; + + ASSERT(allctr == ERTS_ALC_CARRIER_TO_ALLCTR(carrier)); + ASSERT(crr->rbt_node.hdr.bhdr == (crr->root ? crr->root->max_sz : 0)); + return crr->rbt_node.hdr.bhdr; +} /* * info_options() @@ -692,6 +882,7 @@ aoff_get_free_block(Allctr_t *allctr, Uint size, static struct { Eterm as; Eterm aoff; + Eterm aoffcaobf; #ifdef DEBUG Eterm end_of_atoms; #endif @@ -720,6 +911,7 @@ init_atoms(void) #endif AM_INIT(as); AM_INIT(aoff); + AM_INIT(aoffcaobf); #ifdef DEBUG for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) { @@ -749,6 +941,7 @@ info_options(Allctr_t *allctr, Uint **hpp, Uint *szp) { + AOFFAllctr_t* alc = (AOFFAllctr_t*) allctr; Eterm res = THE_NON_VALUE; if (print_to_p) { @@ -756,7 +949,7 @@ info_options(Allctr_t *allctr, print_to_arg, "%sas: %s\n", prefix, - "aoff"); + alc->bf_within_carrier ? "aoffcaobf" : "aoff"); } if (hpp || szp) { @@ -766,7 +959,8 @@ info_options(Allctr_t *allctr, __FILE__, __LINE__);; res = NIL; - add_2tup(hpp, szp, &res, am.as, am.aoff); + add_2tup(hpp, szp, &res, am.as, + alc->bf_within_carrier ? am.aoffcaobf : am.aoff); } return res; @@ -784,14 +978,19 @@ UWord erts_aoffalc_test(UWord op, UWord a1, UWord a2) { switch (op) { - case 0x500: return (UWord) 0; /* IS_AOBF */ - case 0x501: return (UWord) ((AOFFAllctr_t *) a1)->mbc_root; + case 0x501: { + AOFF_RBTree_t *node = ((AOFFAllctr_t *) a1)->mbc_root; + Uint size = (Uint) a2; + node = node ? rbt_search(node, size) : NULL; + return (UWord) (node ? RBT_NODE_TO_MBC(node)->root : NULL); + } case 0x502: return (UWord) ((AOFF_RBTree_t *) a1)->parent; case 0x503: return (UWord) ((AOFF_RBTree_t *) a1)->left; case 0x504: return (UWord) ((AOFF_RBTree_t *) a1)->right; case 0x506: return (UWord) IS_BLACK((AOFF_RBTree_t *) a1); - case 0x508: return (UWord) 1; /* IS_AOFF */ + case 0x508: return (UWord) 0; /* IS_BF_ALGO */ case 0x509: return (UWord) ((AOFF_RBTree_t *) a1)->max_sz; + case 0x50a: return (UWord) ((AOFFAllctr_t *) a1)->bf_within_carrier; default: ASSERT(0); return ~((UWord) 0); } } @@ -804,6 +1003,16 @@ erts_aoffalc_test(UWord op, UWord a1, UWord a2) #ifdef HARD_DEBUG +static int rbt_assert_is_member(AOFF_RBTree_t* root, AOFF_RBTree_t* node) +{ + while (node != root) { + ASSERT(node->parent); + ASSERT(node->parent->left == node || node->parent->right == node); + node = node->parent; + } + return 1; +} + #define IS_LEFT_VISITED(FB) ((FB)->flags & LEFT_VISITED_FLG) #define IS_RIGHT_VISITED(FB) ((FB)->flags & RIGHT_VISITED_FLG) @@ -840,12 +1049,14 @@ static void print_tree(AOFF_RBTree_t*); */ static AOFF_RBTree_t * -check_tree(AOFF_RBTree_t* root, Uint size) +check_tree(Carrier_t* within_crr, int bestfit, AOFF_RBTree_t* root, Uint size) { AOFF_RBTree_t *res = NULL; Sint blacks; Sint curr_blacks; AOFF_RBTree_t *x; + Carrier_t* crr; + Uint depth, max_depth, node_cnt; #ifdef PRINT_TREE print_tree(root); @@ -859,12 +1070,16 @@ check_tree(AOFF_RBTree_t* root, Uint size) ASSERT(!x->parent); curr_blacks = 1; blacks = -1; + depth = 1; + max_depth = 0; + node_cnt = 0; while (x) { if (!IS_LEFT_VISITED(x)) { SET_LEFT_VISITED(x); if (x->left) { x = x->left; + ++depth; if (IS_BLACK(x)) curr_blacks++; continue; @@ -880,6 +1095,7 @@ check_tree(AOFF_RBTree_t* root, Uint size) SET_RIGHT_VISITED(x); if (x->right) { x = x->right; + ++depth; if (IS_BLACK(x)) curr_blacks++; continue; @@ -891,6 +1107,16 @@ check_tree(AOFF_RBTree_t* root, Uint size) } } + ++node_cnt; + if (depth > max_depth) + max_depth = depth; + + if (within_crr) { + crr = FBLK_TO_MBC(&x->hdr); + ASSERT(crr == within_crr); + ASSERT((char*)x > (char*)crr); + ASSERT(((char*)x + AOFF_BLK_SZ(x)) <= ((char*)crr + CARRIER_SZ(crr))); + } if (IS_RED(x)) { ASSERT(IS_BLACK(x->right)); @@ -901,13 +1127,13 @@ check_tree(AOFF_RBTree_t* root, Uint size) if (x->left) { ASSERT(x->left->parent == x); - ASSERT(x->left < x); + ASSERT(cmp_blocks(bestfit, x->left, x) < 0); ASSERT(x->left->max_sz <= x->max_sz); } if (x->right) { ASSERT(x->right->parent == x); - ASSERT(x->right > x); + ASSERT(cmp_blocks(bestfit, x->right, x) > 0); ASSERT(x->right->max_sz <= x->max_sz); } ASSERT(x->max_sz >= AOFF_BLK_SZ(x)); @@ -916,7 +1142,7 @@ check_tree(AOFF_RBTree_t* root, Uint size) || x->max_sz == (x->right ? x->right->max_sz : 0)); if (size && AOFF_BLK_SZ(x) >= size) { - if (!res || x < res) { + if (!res || cmp_blocks(bestfit, x, res) < 0) { res = x; } } @@ -926,10 +1152,11 @@ check_tree(AOFF_RBTree_t* root, Uint size) if (IS_BLACK(x)) curr_blacks--; x = x->parent; - + --depth; } - + ASSERT(depth == 0 || (!root && depth==1)); ASSERT(curr_blacks == 0); + ASSERT((1 << (max_depth/2)) <= node_cnt); UNSET_LEFT_VISITED(root); UNSET_RIGHT_VISITED(root); @@ -954,9 +1181,9 @@ print_tree_aux(AOFF_RBTree_t *x, int indent) for (i = 0; i < indent; i++) { putc(' ', stderr); } - fprintf(stderr, "%s: sz=%lu addr=0x%lx max_size=%lu\r\n", + fprintf(stderr, "%s: sz=%lu addr=0x%lx max_size=%u\r\n", IS_BLACK(x) ? "BLACK" : "RED", - AOFF_BLK_SZ(x), (Uint)x, x->max_sz); + AOFF_BLK_SZ(x), (Uint)x, (unsigned)x->max_sz); print_tree_aux(x->left, indent + INDENT_STEP); } } diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.h b/erts/emulator/beam/erl_ao_firstfit_alloc.h index 21c36c6654..87427e8e62 100644 --- a/erts/emulator/beam/erl_ao_firstfit_alloc.h +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.h @@ -24,11 +24,12 @@ #include "erl_alloc_util.h" #define ERTS_ALC_AOFF_ALLOC_VSN_STR "0.9" +#define ERTS_ALC_AOFF_CBF_ALLOC_VSN_STR "0.9" typedef struct AOFFAllctr_t_ AOFFAllctr_t; typedef struct { - int dummy; + int bf_within_carrier; } AOFFAllctrInit_t; #define ERTS_DEFAULT_AOFF_ALLCTR_INIT {0/*dummy*/} @@ -51,7 +52,7 @@ struct AOFFAllctr_t_ { Allctr_t allctr; /* Has to be first! */ struct AOFF_RBTree_t_* mbc_root; - struct AOFF_RBTree_t_* sbmbc_root; + int bf_within_carrier; }; UWord erts_aoffalc_test(UWord, UWord, UWord); diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c index ed843a51fb..58e53c3d00 100644 --- a/erts/emulator/beam/erl_bestfit_alloc.c +++ b/erts/emulator/beam/erl_bestfit_alloc.c @@ -89,21 +89,21 @@ static RBTree_t * check_tree(RBTree_t, int, Uint); #endif -static void tree_delete(Allctr_t *allctr, Block_t *del, Uint32 flags); +static void tree_delete(Allctr_t *allctr, Block_t *del); /* Prototypes of callback functions */ /* "address order best fit" specific callback functions */ static Block_t * aobf_get_free_block (Allctr_t *, Uint, - Block_t *, Uint, Uint32); -static void aobf_link_free_block (Allctr_t *, Block_t *, Uint32); + Block_t *, Uint); +static void aobf_link_free_block (Allctr_t *, Block_t *); #define aobf_unlink_free_block tree_delete /* "best fit" specific callback functions */ static Block_t * bf_get_free_block (Allctr_t *, Uint, - Block_t *, Uint, Uint32); -static void bf_link_free_block (Allctr_t *, Block_t *, Uint32); -static ERTS_INLINE void bf_unlink_free_block (Allctr_t *, Block_t *, Uint32); + Block_t *, Uint); +static void bf_link_free_block (Allctr_t *, Block_t *); +static ERTS_INLINE void bf_unlink_free_block (Allctr_t *, Block_t *); static Eterm info_options (Allctr_t *, char *, int *, @@ -179,6 +179,7 @@ erts_bfalc_start(BFAllctr_t *bfallctr, bfallctr->address_order = bfinit->ao; + allctr->mbc_header_size = sizeof(Carrier_t); allctr->min_mbc_size = MIN_MBC_SZ; allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ; allctr->min_block_size = (bfinit->ao @@ -207,6 +208,9 @@ erts_bfalc_start(BFAllctr_t *bfallctr, allctr->get_next_mbc_size = NULL; allctr->creating_mbc = NULL; allctr->destroying_mbc = NULL; + allctr->add_mbc = NULL; + allctr->remove_mbc = NULL; + allctr->largest_fblk_in_mbc = NULL; allctr->init_atoms = init_atoms; #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG @@ -407,13 +411,11 @@ tree_insert_fixup(RBTree_t **root, RBTree_t *blk) * callback function in the address order case. */ static void -tree_delete(Allctr_t *allctr, Block_t *del, Uint32 flags) +tree_delete(Allctr_t *allctr, Block_t *del) { BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; Uint spliced_is_black; - RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) - ? &bfallctr->sbmbc_root - : &bfallctr->mbc_root); + RBTree_t **root = &bfallctr->mbc_root; RBTree_t *x, *y, *z = (RBTree_t *) del; RBTree_t null_x; /* null_x is used to get the fixup started when we splice out a node without children. */ @@ -586,12 +588,10 @@ tree_delete(Allctr_t *allctr, Block_t *del, Uint32 flags) \* */ static void -aobf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) +aobf_link_free_block(Allctr_t *allctr, Block_t *block) { BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; - RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) - ? &bfallctr->sbmbc_root - : &bfallctr->mbc_root); + RBTree_t **root = &bfallctr->mbc_root; RBTree_t *blk = (RBTree_t *) block; Uint blk_sz = BF_BLK_SZ(blk); @@ -647,21 +647,18 @@ aobf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) #if 0 /* tree_delete() is directly used instead */ static void -aobf_unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) +aobf_unlink_free_block(Allctr_t *allctr, Block_t *block) { - tree_delete(allctr, block, flags); + tree_delete(allctr, block); } #endif static Block_t * aobf_get_free_block(Allctr_t *allctr, Uint size, - Block_t *cand_blk, Uint cand_size, - Uint32 flags) + Block_t *cand_blk, Uint cand_size) { BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; - RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) - ? &bfallctr->sbmbc_root - : &bfallctr->mbc_root); + RBTree_t **root = &bfallctr->mbc_root; RBTree_t *x = *root; RBTree_t *blk = NULL; Uint blk_sz; @@ -694,7 +691,7 @@ aobf_get_free_block(Allctr_t *allctr, Uint size, return NULL; /* cand_blk was better */ } - aobf_unlink_free_block(allctr, (Block_t *) blk, flags); + aobf_unlink_free_block(allctr, (Block_t *) blk); return (Block_t *) blk; } @@ -705,12 +702,10 @@ aobf_get_free_block(Allctr_t *allctr, Uint size, \* */ static void -bf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) +bf_link_free_block(Allctr_t *allctr, Block_t *block) { BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; - RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) - ? &bfallctr->sbmbc_root - : &bfallctr->mbc_root); + RBTree_t **root = &bfallctr->mbc_root; RBTree_t *blk = (RBTree_t *) block; Uint blk_sz = BF_BLK_SZ(blk); @@ -779,12 +774,10 @@ bf_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) } static ERTS_INLINE void -bf_unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) +bf_unlink_free_block(Allctr_t *allctr, Block_t *block) { BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; - RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) - ? &bfallctr->sbmbc_root - : &bfallctr->mbc_root); + RBTree_t **root = &bfallctr->mbc_root; RBTree_t *x = (RBTree_t *) block; if (IS_LIST_ELEM(x)) { @@ -812,7 +805,7 @@ bf_unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) } else { /* Remove from tree */ - tree_delete(allctr, block, flags); + tree_delete(allctr, block); } DESTROY_LIST_ELEM(x); @@ -821,13 +814,10 @@ bf_unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) static Block_t * bf_get_free_block(Allctr_t *allctr, Uint size, - Block_t *cand_blk, Uint cand_size, - Uint32 flags) + Block_t *cand_blk, Uint cand_size) { BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; - RBTree_t **root = ((flags & ERTS_ALCU_FLG_SBMBC) - ? &bfallctr->sbmbc_root - : &bfallctr->mbc_root); + RBTree_t **root = &bfallctr->mbc_root; RBTree_t *x = *root; RBTree_t *blk = NULL; Uint blk_sz; @@ -867,7 +857,7 @@ bf_get_free_block(Allctr_t *allctr, Uint size, the tree node */ blk = LIST_NEXT(blk) ? LIST_NEXT(blk) : blk; - bf_unlink_free_block(allctr, (Block_t *) blk, flags); + bf_unlink_free_block(allctr, (Block_t *) blk); return (Block_t *) blk; } @@ -984,7 +974,7 @@ erts_bfalc_test(UWord op, UWord a1, UWord a2) case 0x205: return (UWord) ((RBTreeList_t *) a1)->next; case 0x206: return (UWord) IS_BLACK((RBTree_t *) a1); case 0x207: return (UWord) IS_TREE_NODE((RBTree_t *) a1); - case 0x208: return (UWord) 0; /* IS_AOFF */ + case 0x208: return (UWord) 1; /* IS_BF_ALGO */ default: ASSERT(0); return ~((UWord) 0); } } diff --git a/erts/emulator/beam/erl_bestfit_alloc.h b/erts/emulator/beam/erl_bestfit_alloc.h index f2d2f07d7a..be8b2b871d 100644 --- a/erts/emulator/beam/erl_bestfit_alloc.h +++ b/erts/emulator/beam/erl_bestfit_alloc.h @@ -55,7 +55,6 @@ struct BFAllctr_t_ { Allctr_t allctr; /* Has to be first! */ RBTree_t * mbc_root; - RBTree_t * sbmbc_root; int address_order; }; diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 54eefe8d12..74a37f374d 100755 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -59,6 +59,7 @@ static Export* alloc_info_trap = NULL; static Export* alloc_sizes_trap = NULL; static Export *gather_sched_wall_time_res_trap; +static Export *gather_gc_info_res_trap; #define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) @@ -1670,13 +1671,22 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ sel = *tp++; - if (sel == am_allocator_sizes) { + if (sel == am_memory_internal) { + switch (arity) { + case 3: + if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 1, 1)) + return am_true; + default: + goto badarg; + } + } + else if (sel == am_allocator_sizes) { switch (arity) { case 2: ERTS_BIF_PREP_TRAP1(ret, alloc_sizes_trap, BIF_P, *tp); return ret; case 3: - if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 1)) + if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 1, 0)) return am_true; default: goto badarg; @@ -1735,7 +1745,7 @@ info_1_tuple(Process* BIF_P, /* Pointer to current process. */ ERTS_BIF_PREP_TRAP1(ret, alloc_info_trap, BIF_P, *tp); return ret; case 3: - if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 0)) + if (erts_request_alloc_info(BIF_P, tp[0], tp[1], 0, 0)) return am_true; default: goto badarg; @@ -3103,18 +3113,10 @@ BIF_RETTYPE statistics_1(BIF_ALIST_1) res = TUPLE2(hp, cs, SMALL_ZERO); BIF_RET(res); } else if (BIF_ARG_1 == am_garbage_collection) { - Uint hsz = 4; - ErtsGCInfo gc_info; - Eterm gcs; - Eterm recl; - erts_gc_info(&gc_info); - (void) erts_bld_uint(NULL, &hsz, gc_info.garbage_collections); - (void) erts_bld_uint(NULL, &hsz, gc_info.reclaimed); - hp = HAlloc(BIF_P, hsz); - gcs = erts_bld_uint(&hp, NULL, gc_info.garbage_collections); - recl = erts_bld_uint(&hp, NULL, gc_info.reclaimed); - res = TUPLE3(hp, gcs, recl, SMALL_ZERO); - BIF_RET(res); + res = erts_gc_info_request(BIF_P); + if (is_non_value(res)) + BIF_RET(am_undefined); + BIF_TRAP1(gather_gc_info_res_trap, BIF_P, res); } else if (BIF_ARG_1 == am_reductions) { Uint reds; Uint diff; @@ -4082,6 +4084,8 @@ erts_bif_info_init(void) alloc_sizes_trap = erts_export_put(am_erlang, am_alloc_sizes, 1); gather_sched_wall_time_res_trap = erts_export_put(am_erlang, am_gather_sched_wall_time_result, 1); + gather_gc_info_res_trap + = erts_export_put(am_erlang, am_gather_gc_info_result, 1); process_info_init(); os_info_init(); } diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 298909c921..0d12e658d9 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -47,10 +47,6 @@ */ #define ALENGTH(a) (sizeof(a)/sizeof(a[0])) -static erts_smp_spinlock_t info_lck; -static Uint garbage_cols; /* no of garbage collections */ -static Uint reclaimed; /* no of words reclaimed in GCs */ - # define STACK_SZ_ON_HEAP(p) ((p)->hend - (p)->stop) # define OverRunCheck(P) \ if ((P)->stop < (P)->htop) { \ @@ -120,6 +116,8 @@ static void offset_rootset(Process *p, Sint offs, char* area, Uint area_size, static void offset_off_heap(Process* p, Sint offs, char* area, Uint area_size); static void offset_mqueue(Process *p, Sint offs, char* area, Uint area_size); +static void init_gc_info(ErtsGCInfo *gcip); + #ifdef HARDDEBUG static void disallow_heap_frag_ref_in_heap(Process* p); static void disallow_heap_frag_ref_in_old_heap(Process* p); @@ -137,13 +135,41 @@ static int num_heap_sizes; /* Number of heap sizes. */ Uint erts_test_long_gc_sleep; /* Only used for testing... */ +typedef struct { + Process *proc; + Eterm ref; + Eterm ref_heap[REF_THING_SIZE]; + Uint req_sched; + erts_smp_atomic32_t refc; +} ErtsGCInfoReq; + +#if !HALFWORD_HEAP +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(gcireq, + ErtsGCInfoReq, + 5, + ERTS_ALC_T_GC_INFO_REQ) +#else +static ERTS_INLINE ErtsGCInfoReq * +gcireq_alloc(void) +{ + return erts_alloc(ERTS_ALC_T_GC_INFO_REQ, + sizeof(ErtsGCInfoReq)); +} + +static ERTS_INLINE void +gcireq_free(ErtsGCInfoReq *ptr) +{ + erts_free(ERTS_ALC_T_GC_INFO_REQ, ptr); +} +#endif + /* * Initialize GC global data. */ void erts_init_gc(void) { - int i = 0; + int i = 0, ix; Sint max_heap_size = 0; ASSERT(offsetof(ProcBin,thing_word) == offsetof(struct erl_off_heap_header,thing_word)); @@ -156,9 +182,6 @@ erts_init_gc(void) ASSERT(offsetof(ProcBin,next) == offsetof(ErlFunThing,next)); ASSERT(offsetof(ProcBin,next) == offsetof(ExternalThing,next)); - erts_smp_spinlock_init(&info_lck, "gc_info"); - garbage_cols = 0; - reclaimed = 0; erts_test_long_gc_sleep = 0; /* @@ -199,6 +222,16 @@ erts_init_gc(void) } } num_heap_sizes = i; + + for (ix = 0; ix < erts_no_schedulers; ix++) { + ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(ix); + init_gc_info(&esdp->gc_info); + } + +#if !HALFWORD_HEAP + init_gcireq_alloc(); +#endif + } /* @@ -287,17 +320,6 @@ erts_heap_sizes(Process* p) return res; } -void -erts_gc_info(ErtsGCInfo *gcip) -{ - if (gcip) { - erts_smp_spin_lock(&info_lck); - gcip->garbage_collections = garbage_cols; - gcip->reclaimed = reclaimed; - erts_smp_spin_unlock(&info_lck); - } -} - void erts_offset_heap(Eterm* hp, Uint sz, Sint offs, Eterm* low, Eterm* high) { @@ -378,6 +400,7 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) Uint reclaimed_now = 0; int done = 0; Uint ms1, s1, us1; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); #ifdef USE_VM_PROBES DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE); #endif @@ -455,11 +478,9 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) monitor_large_heap(p); } - erts_smp_spin_lock(&info_lck); - garbage_cols++; - reclaimed += reclaimed_now; - erts_smp_spin_unlock(&info_lck); - + esdp->gc_info.garbage_cols++; + esdp->gc_info.reclaimed += reclaimed_now; + FLAGS(p) &= ~F_FORCE_GC; #ifdef CHECK_FOR_HOLES @@ -2543,6 +2564,110 @@ offset_rootset(Process *p, Sint offs, char* area, Uint area_size, offset_one_rootset(p, offs, area, area_size, objv, nobj); } +static void +init_gc_info(ErtsGCInfo *gcip) +{ + gcip->reclaimed = 0; + gcip->garbage_cols = 0; +} + +static void +reply_gc_info(void *vgcirp) +{ + Uint64 reclaimed = 0, garbage_cols = 0; + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + ErtsGCInfoReq *gcirp = (ErtsGCInfoReq *) vgcirp; + ErtsProcLocks rp_locks = (gcirp->req_sched == esdp->no + ? ERTS_PROC_LOCK_MAIN + : 0); + Process *rp = gcirp->proc; + Eterm ref_copy = NIL, msg; + Eterm *hp = NULL; + Eterm **hpp; + Uint sz, *szp; + ErlOffHeap *ohp = NULL; + ErlHeapFragment *bp = NULL; + + ASSERT(esdp); + + reclaimed = esdp->gc_info.reclaimed; + garbage_cols = esdp->gc_info.garbage_cols; + + sz = 0; + hpp = NULL; + szp = &sz; + + while (1) { + if (hpp) + ref_copy = STORE_NC(hpp, ohp, gcirp->ref); + else + *szp += REF_THING_SIZE; + + msg = erts_bld_tuple(hpp, szp, 3, + make_small(esdp->no), + erts_bld_uint64(hpp, szp, garbage_cols), + erts_bld_uint64(hpp, szp, reclaimed)); + + msg = erts_bld_tuple(hpp, szp, 2, ref_copy, msg); + if (hpp) + break; + + hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, &rp_locks); + szp = NULL; + hpp = &hp; + } + + erts_queue_message(rp, &rp_locks, bp, msg, NIL +#ifdef USE_VM_PROBES + , NIL +#endif + ); + + if (gcirp->req_sched == esdp->no) + rp_locks &= ~ERTS_PROC_LOCK_MAIN; + + if (rp_locks) + erts_smp_proc_unlock(rp, rp_locks); + + erts_smp_proc_dec_refc(rp); + + if (erts_smp_atomic32_dec_read_nob(&gcirp->refc) == 0) + gcireq_free(vgcirp); +} + +Eterm +erts_gc_info_request(Process *c_p) +{ + ErtsSchedulerData *esdp = ERTS_PROC_GET_SCHDATA(c_p); + Eterm ref; + ErtsGCInfoReq *gcirp; + Eterm *hp; + + gcirp = gcireq_alloc(); + ref = erts_make_ref(c_p); + hp = &gcirp->ref_heap[0]; + + gcirp->proc = c_p; + gcirp->ref = STORE_NC(&hp, NULL, ref); + gcirp->req_sched = esdp->no; + erts_smp_atomic32_init_nob(&gcirp->refc, + (erts_aint32_t) erts_no_schedulers); + + erts_smp_proc_add_refc(c_p, (Sint32) erts_no_schedulers); + +#ifdef ERTS_SMP + if (erts_no_schedulers > 1) + erts_schedule_multi_misc_aux_work(1, + erts_no_schedulers, + reply_gc_info, + (void *) gcirp); +#endif + + reply_gc_info((void *) gcirp); + + return ref; +} + #if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) static int diff --git a/erts/emulator/beam/erl_goodfit_alloc.c b/erts/emulator/beam/erl_goodfit_alloc.c index 79d8b40f8c..e9d8249ee1 100644 --- a/erts/emulator/beam/erl_goodfit_alloc.c +++ b/erts/emulator/beam/erl_goodfit_alloc.c @@ -163,10 +163,10 @@ BKT_MIN_SZ(GFAllctr_t *gfallctr, int ix) /* Prototypes of callback functions */ static Block_t * get_free_block (Allctr_t *, Uint, - Block_t *, Uint, Uint32); -static void link_free_block (Allctr_t *, Block_t *, Uint32); -static void unlink_free_block (Allctr_t *, Block_t *, Uint32); -static void update_last_aux_mbc (Allctr_t *, Carrier_t *, Uint32); + Block_t *, Uint); +static void link_free_block (Allctr_t *, Block_t *); +static void unlink_free_block (Allctr_t *, Block_t *); +static void update_last_aux_mbc (Allctr_t *, Carrier_t *); static Eterm info_options (Allctr_t *, char *, int *, void *, Uint **, Uint *); static void init_atoms (void); @@ -203,8 +203,7 @@ erts_gfalc_start(GFAllctr_t *gfallctr, sys_memcpy((void *) gfallctr, (void *) &zero.allctr, sizeof(GFAllctr_t)); - init->sbmbct = 0; /* Small mbc not yet supported by goodfit */ - + allctr->mbc_header_size = sizeof(Carrier_t); allctr->min_mbc_size = MIN_MBC_SZ; allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ; allctr->min_block_size = sizeof(GFFreeBlock_t); @@ -222,7 +221,9 @@ erts_gfalc_start(GFAllctr_t *gfallctr, allctr->get_next_mbc_size = NULL; allctr->creating_mbc = update_last_aux_mbc; allctr->destroying_mbc = update_last_aux_mbc; - + allctr->add_mbc = NULL; + allctr->remove_mbc = NULL; + allctr->largest_fblk_in_mbc = NULL; allctr->init_atoms = init_atoms; #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG @@ -384,7 +385,7 @@ search_bucket(Allctr_t *allctr, int ix, Uint size) static Block_t * get_free_block(Allctr_t *allctr, Uint size, - Block_t *cand_blk, Uint cand_size, Uint32 flags) + Block_t *cand_blk, Uint cand_size) { GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; int unsafe_bi, min_bi; @@ -403,7 +404,7 @@ get_free_block(Allctr_t *allctr, Uint size, if (blk) { if (cand_blk && cand_size <= MBC_FBLK_SZ(blk)) return NULL; /* cand_blk was better */ - unlink_free_block(allctr, blk, flags); + unlink_free_block(allctr, blk); return blk; } if (min_bi < NO_OF_BKTS - 1) { @@ -423,14 +424,14 @@ get_free_block(Allctr_t *allctr, Uint size, ASSERT(blk); if (cand_blk && cand_size <= MBC_FBLK_SZ(blk)) return NULL; /* cand_blk was better */ - unlink_free_block(allctr, blk, flags); + unlink_free_block(allctr, blk); return blk; } static void -link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) +link_free_block(Allctr_t *allctr, Block_t *block) { GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; GFFreeBlock_t *blk = (GFFreeBlock_t *) block; @@ -451,7 +452,7 @@ link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) } static void -unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) +unlink_free_block(Allctr_t *allctr, Block_t *block) { GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; GFFreeBlock_t *blk = (GFFreeBlock_t *) block; @@ -472,7 +473,7 @@ unlink_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) } static void -update_last_aux_mbc(Allctr_t *allctr, Carrier_t *mbc, Uint32 flags) +update_last_aux_mbc(Allctr_t *allctr, Carrier_t *mbc) { GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index e6a96d427f..b3a3c3d403 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -131,8 +131,10 @@ extern void ConWaitForExit(void); static void erl_init(int ncpu, int proc_tab_sz, + int legacy_proc_tab, int port_tab_sz, - int port_tab_sz_ignore_files); + int port_tab_sz_ignore_files, + int legacy_port_tab); static erts_atomic_t exiting; @@ -280,7 +282,9 @@ erts_short_init(void) int ncpu = early_init(NULL, NULL); erl_init(ncpu, ERTS_DEFAULT_MAX_PROCESSES, + 0, ERTS_DEFAULT_MAX_PORTS, + 0, 0); erts_initialized = 1; } @@ -288,19 +292,21 @@ erts_short_init(void) static void erl_init(int ncpu, int proc_tab_sz, + int legacy_proc_tab, int port_tab_sz, - int port_tab_sz_ignore_files) + int port_tab_sz_ignore_files, + int legacy_port_tab) { init_benchmarking(); erts_init_monitors(); - erts_init_gc(); erts_init_time(); erts_init_sys_common_misc(); - erts_init_process(ncpu, proc_tab_sz); + erts_init_process(ncpu, proc_tab_sz, legacy_proc_tab); erts_init_scheduling(no_schedulers, no_schedulers_online); erts_init_cpu_topology(); /* Must be after init_scheduling */ + erts_init_gc(); /* Must be after init_scheduling */ erts_alloc_late_init(); H_MIN_SIZE = erts_next_heap_size(H_MIN_SIZE, 0); @@ -327,7 +333,7 @@ erl_init(int ncpu, init_dist(); erl_drv_thr_init(); erts_init_async(); - erts_init_io(port_tab_sz, port_tab_sz_ignore_files); + erts_init_io(port_tab_sz, port_tab_sz_ignore_files, legacy_port_tab); init_load(); erts_init_bif(); erts_init_bif_chksum(); @@ -923,6 +929,9 @@ erl_start(int argc, char **argv) int proc_tab_sz = ERTS_DEFAULT_MAX_PROCESSES; int port_tab_sz = ERTS_DEFAULT_MAX_PORTS; int port_tab_sz_ignore_files = 0; + int legacy_proc_tab = 0; + int legacy_port_tab = 0; + envbufsz = sizeof(envbuf); if (erts_sys_getenv_raw(ERL_MAX_ETS_TABLES_ENV, envbuf, &envbufsz) == 0) @@ -1268,27 +1277,35 @@ erl_start(int argc, char **argv) case 'P': /* set maximum number of processes */ arg = get_arg(argv[i]+2, argv[i+1], &i); - errno = 0; - proc_tab_sz = strtol(arg, NULL, 10); - if (errno != 0 - || proc_tab_sz < ERTS_MIN_PROCESSES - || ERTS_MAX_PROCESSES < proc_tab_sz) { - erts_fprintf(stderr, "bad number of processes %s\n", arg); - erts_usage(); + if (strcmp(arg, "legacy") == 0) + legacy_proc_tab = 1; + else { + errno = 0; + proc_tab_sz = strtol(arg, NULL, 10); + if (errno != 0 + || proc_tab_sz < ERTS_MIN_PROCESSES + || ERTS_MAX_PROCESSES < proc_tab_sz) { + erts_fprintf(stderr, "bad number of processes %s\n", arg); + erts_usage(); + } } break; case 'Q': /* set maximum number of ports */ arg = get_arg(argv[i]+2, argv[i+1], &i); - errno = 0; - port_tab_sz = strtol(arg, NULL, 10); - if (errno != 0 - || port_tab_sz < ERTS_MIN_PROCESSES - || ERTS_MAX_PROCESSES < port_tab_sz) { - erts_fprintf(stderr, "bad number of ports %s\n", arg); - erts_usage(); + if (strcmp(arg, "legacy") == 0) + legacy_port_tab = 1; + else { + errno = 0; + port_tab_sz = strtol(arg, NULL, 10); + if (errno != 0 + || port_tab_sz < ERTS_MIN_PROCESSES + || ERTS_MAX_PROCESSES < port_tab_sz) { + erts_fprintf(stderr, "bad number of ports %s\n", arg); + erts_usage(); + } + port_tab_sz_ignore_files = 1; } - port_tab_sz_ignore_files = 1; break; case 'S' : /* Was handled in early_init() just read past it */ @@ -1642,8 +1659,10 @@ erl_start(int argc, char **argv) erl_init(ncpu, proc_tab_sz, + legacy_proc_tab, port_tab_sz, - port_tab_sz_ignore_files); + port_tab_sz_ignore_files, + legacy_port_tab); load_preloaded(); erts_end_staging_code_ix(); diff --git a/erts/emulator/beam/erl_instrument.c b/erts/emulator/beam/erl_instrument.c index 1aea3f65bc..df7c443387 100644 --- a/erts/emulator/beam/erl_instrument.c +++ b/erts/emulator/beam/erl_instrument.c @@ -1236,8 +1236,6 @@ erts_instr_init(int stat, int map_stat) sys_memzero((void *) stats->n, sizeof(Stat_t)*(ERTS_ALC_N_MAX+1)); for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { - if (ERTS_IS_SBMBC_ALLOCATOR_NO__(i)) - continue; if (erts_allctrs_info[i].enabled) stats->ap[i] = &stats->a[i]; else @@ -1251,8 +1249,6 @@ erts_instr_init(int stat, int map_stat) erts_instr_memory_map = 1; erts_instr_stat = 1; for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { - if (ERTS_IS_SBMBC_ALLOCATOR_NO__(i)) - continue; erts_allctrs[i].alloc = map_stat_alloc; erts_allctrs[i].realloc = map_stat_realloc; erts_allctrs[i].free = map_stat_free; @@ -1265,8 +1261,6 @@ erts_instr_init(int stat, int map_stat) else { erts_instr_stat = 1; for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { - if (ERTS_IS_SBMBC_ALLOCATOR_NO__(i)) - continue; erts_allctrs[i].alloc = stat_alloc; erts_allctrs[i].realloc = stat_realloc; erts_allctrs[i].free = stat_free; diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index a1d270adba..bc59fe55d4 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -150,7 +150,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "instr_x", NULL }, { "instr", NULL }, { "alcu_allocator", "index" }, - { "sbmbc_alloc", "index" }, { "mseg", NULL }, #if HALFWORD_HEAP { "pmmap", NULL }, diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 53cb01a8c6..f753de8f52 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -1928,18 +1928,21 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p) break; case ERTS_PORT_TASK_INPUT: erts_stale_drv_select(pp->common.id, + ERTS_Port2ErlDrvPort(pp), ptp->u.alive.td.io.event, DO_READ, 1); break; case ERTS_PORT_TASK_OUTPUT: erts_stale_drv_select(pp->common.id, + ERTS_Port2ErlDrvPort(pp), ptp->u.alive.td.io.event, DO_WRITE, 1); break; case ERTS_PORT_TASK_EVENT: erts_stale_drv_select(pp->common.id, + ERTS_Port2ErlDrvPort(pp), ptp->u.alive.td.io.event, 0, 1); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 7415a5721f..88eb224f84 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -485,7 +485,7 @@ release_process(void *vproc) /* initialize the scheduler */ void -erts_init_process(int ncpu, int proc_tab_size) +erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab) { #ifdef ERTS_SMP @@ -505,7 +505,8 @@ erts_init_process(int ncpu, int proc_tab_size) (ErtsPTabElementCommon *) &erts_invalid_process.common, proc_tab_size, sizeof(Process), - "process_table"); + "process_table", + legacy_proc_tab); last_reductions = 0; last_exact_reductions = 0; @@ -1326,6 +1327,17 @@ erts_alloc_notify_delayed_dealloc(int ix) ERTS_SSI_AUX_WORK_DD); } +void +erts_alloc_ensure_handle_delayed_dealloc_call(int ix) +{ +#ifdef DEBUG + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + ASSERT(!esdp || ix == (int) esdp->no); +#endif + set_aux_work_flags_wakeup_nob(ERTS_SCHED_SLEEP_INFO_IX(ix-1), + ERTS_SSI_AUX_WORK_DD); +} + static ERTS_INLINE erts_aint32_t handle_delayed_dealloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting) { @@ -4670,8 +4682,8 @@ erts_init_scheduling(int no_schedulers, int no_schedulers_online) esdp->reductions = 0; init_sched_wall_time(&esdp->sched_wall_time); - erts_port_task_handle_init(&esdp->nosuspend_port_task_handle); + } init_misc_aux_work(); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 5a1f6bbe8d..865ac6c43f 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -420,6 +420,11 @@ typedef struct { } ErtsSchedWallTime; typedef struct { + Uint64 reclaimed; + Uint64 garbage_cols; +} ErtsGCInfo; + +typedef struct { int sched; erts_aint32_t aux_work; } ErtsDelayedAuxWorkWakeupJob; @@ -507,6 +512,7 @@ struct ErtsSchedulerData_ { Uint64 reductions; ErtsSchedWallTime sched_wall_time; + ErtsGCInfo gc_info; ErtsPortTaskHandle nosuspend_port_task_handle; #ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC @@ -1126,6 +1132,7 @@ void erts_early_init_scheduling(int); void erts_init_scheduling(int, int); Eterm erts_sched_wall_time_request(Process *c_p, int set, int enable); +Eterm erts_gc_info_request(Process *c_p); Uint64 erts_get_proc_interval(void); Uint64 erts_ensure_later_proc_interval(Uint64); Uint64 erts_step_proc_interval(void); @@ -1333,6 +1340,7 @@ int erts_is_multi_scheduling_blocked(void); Eterm erts_multi_scheduling_blockers(Process *); void erts_start_schedulers(void); void erts_alloc_notify_delayed_dealloc(int); +void erts_alloc_ensure_handle_delayed_dealloc_call(int); void erts_smp_notify_check_children_needed(void); #endif #if ERTS_USE_ASYNC_READY_Q @@ -1352,7 +1360,7 @@ void erts_schedule_multi_misc_aux_work(int ignore_self, erts_aint32_t erts_set_aux_work_timeout(int, erts_aint32_t, int); void erts_sched_notify_check_cpu_bind(void); Uint erts_active_schedulers(void); -void erts_init_process(int, int); +void erts_init_process(int, int, int); Eterm erts_process_status(Process *, ErtsProcLocks, Process *, Eterm); Uint erts_run_queues_len(Uint *); void erts_add_to_runq(Process *); diff --git a/erts/emulator/beam/erl_ptab.c b/erts/emulator/beam/erl_ptab.c index 5bbc71c659..8da135b2c8 100644 --- a/erts/emulator/beam/erl_ptab.c +++ b/erts/emulator/beam/erl_ptab.c @@ -34,6 +34,8 @@ typedef struct ErtsPTabListBifData_ ErtsPTabListBifData; +#define ERTS_PTAB_NEW_MAX_RESERVE_FAIL 1000 + #define ERTS_PTAB_LIST_BIF_TAB_INSPECT_INDICES_PER_RED 25 #define ERTS_PTAB_LIST_BIF_TAB_CHUNK_SIZE 1000 #define ERTS_PTAB_LIST_BIF_MIN_START_REDS \ @@ -415,6 +417,27 @@ last_data_cmp(Uint64 ld1, Uint64 ld2) #define ERTS_PTAB_LastData2EtermData(LD) \ ((Eterm) ((LD) & ~(~((Uint64) 0) << ERTS_PTAB_ID_DATA_SIZE))) +static ERTS_INLINE Uint32 +ix_to_free_id_data_ix(ErtsPTab *ptab, Uint32 ix) +{ + Uint32 dix; + + dix = ((ix & ptab->r.o.dix_cl_mask) << ptab->r.o.dix_cl_shift); + dix += ((ix >> ptab->r.o.dix_cli_shift) & ptab->r.o.dix_cli_mask); + ASSERT(0 <= dix && dix < ptab->r.o.max); + return dix; +} + +UWord +erts_ptab_mem_size(ErtsPTab *ptab) +{ + UWord size = ptab->r.o.max*sizeof(erts_smp_atomic_t); + if (ptab->r.o.free_id_data) + size += ptab->r.o.max*sizeof(Uint32); + return size; +} + + void erts_ptab_init_table(ErtsPTab *ptab, ErtsAlcType_t atype, @@ -422,10 +445,11 @@ erts_ptab_init_table(ErtsPTab *ptab, ErtsPTabElementCommon *invalid_element, int size, UWord element_size, - char *name) + char *name, + int legacy) { - size_t tab_sz; - int bits; + size_t tab_sz, alloc_sz; + Uint32 bits, cl, cli, ix, ix_per_cache_line, tab_cache_lines; char *tab_end; erts_smp_atomic_t *tab_entry; erts_smp_rwmtx_opt_t rwmtx_opts = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER; @@ -448,7 +472,10 @@ erts_ptab_init_table(ErtsPTab *ptab, ptab->r.o.max = size; tab_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(size*sizeof(erts_smp_atomic_t)); - ptab->r.o.tab = erts_alloc_permanent_cache_aligned(atype, tab_sz); + alloc_sz = tab_sz; + if (!legacy) + alloc_sz += ERTS_ALC_CACHE_LINE_ALIGN_SIZE(size*sizeof(Uint32)); + ptab->r.o.tab = erts_alloc_permanent_cache_aligned(atype, alloc_sz); tab_end = ((char *) ptab->r.o.tab) + tab_sz; tab_entry = ptab->r.o.tab; while (tab_end > ((char *) tab_entry)) { @@ -456,28 +483,57 @@ erts_ptab_init_table(ErtsPTab *ptab, tab_entry++; } - ptab->r.o.tab_cache_lines = tab_sz/ERTS_CACHE_LINE_SIZE; - ptab->r.o.pix_per_cache_line = (ERTS_CACHE_LINE_SIZE - / sizeof(erts_smp_atomic_t)); + tab_cache_lines = tab_sz/ERTS_CACHE_LINE_SIZE; + ix_per_cache_line = (ERTS_CACHE_LINE_SIZE/sizeof(erts_smp_atomic_t)); ASSERT((ptab->r.o.max & (ptab->r.o.max - 1)) == 0); /* power of 2 */ - ASSERT((ptab->r.o.pix_per_cache_line - & (ptab->r.o.pix_per_cache_line - 1)) == 0); /* power of 2 */ - ASSERT((ptab->r.o.tab_cache_lines - & (ptab->r.o.tab_cache_lines - 1)) == 0); /* power of 2 */ - - ptab->r.o.pix_mask - = (1 << bits) - 1; - ptab->r.o.pix_cl_mask - = ptab->r.o.tab_cache_lines-1; - ptab->r.o.pix_cl_shift - = erts_fit_in_bits_int32(ptab->r.o.pix_per_cache_line-1); - ptab->r.o.pix_cli_shift - = erts_fit_in_bits_int32(ptab->r.o.pix_cl_mask); - ptab->r.o.pix_cli_mask - = (1 << (bits - ptab->r.o.pix_cli_shift)) - 1; + ASSERT((ix_per_cache_line & (ix_per_cache_line - 1)) == 0); /* power of 2 */ + ASSERT((tab_cache_lines & (tab_cache_lines - 1)) == 0); /* power of 2 */ + + ptab->r.o.pix_mask = (1 << bits) - 1; + ptab->r.o.pix_cl_mask = tab_cache_lines-1; + ptab->r.o.pix_cl_shift = erts_fit_in_bits_int32(ix_per_cache_line-1); + ptab->r.o.pix_cli_shift = erts_fit_in_bits_int32(ptab->r.o.pix_cl_mask); + ptab->r.o.pix_cli_mask = (1 << (bits - ptab->r.o.pix_cli_shift)) - 1; ASSERT(ptab->r.o.pix_cl_shift + ptab->r.o.pix_cli_shift == bits); + if (legacy) { + ptab->r.o.free_id_data = NULL; + ptab->r.o.dix_cl_mask = 0; + ptab->r.o.dix_cl_shift = 0; + ptab->r.o.dix_cli_shift = 0; + ptab->r.o.dix_cli_mask = 0; + } + else { + + tab_sz = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(size*sizeof(Uint32)); + ptab->r.o.free_id_data = (Uint32 *) tab_end; + + tab_cache_lines = tab_sz/ERTS_CACHE_LINE_SIZE; + ix_per_cache_line = (ERTS_CACHE_LINE_SIZE/sizeof(Uint32)); + + ptab->r.o.dix_cl_mask = tab_cache_lines-1; + ptab->r.o.dix_cl_shift = erts_fit_in_bits_int32(ix_per_cache_line-1); + ptab->r.o.dix_cli_shift = erts_fit_in_bits_int32(ptab->r.o.dix_cl_mask); + ptab->r.o.dix_cli_mask = (1 << (bits - ptab->r.o.dix_cli_shift)) - 1; + + ASSERT((ix_per_cache_line & (ix_per_cache_line - 1)) == 0); /* power of 2 */ + ASSERT((tab_cache_lines & (tab_cache_lines - 1)) == 0); /* power of 2 */ + + ASSERT(ptab->r.o.dix_cl_shift + ptab->r.o.dix_cli_shift == bits); + + ix = 0; + for (cl = 0; cl < tab_cache_lines; cl++) { + for (cli = 0; cli < ix_per_cache_line; cli++) { + ptab->r.o.free_id_data[ix] = cli*tab_cache_lines+cl; + ix++; + } + } + + erts_smp_atomic32_init_nob(&ptab->vola.tile.aid_ix, -1); + erts_smp_atomic32_init_nob(&ptab->vola.tile.fid_ix, -1); + + } ptab->r.o.invalid_element = invalid_element; ptab->r.o.invalid_data = erts_ptab_id2data(ptab, invalid_element->id); ptab->r.o.release_element = release_element; @@ -522,9 +578,7 @@ erts_ptab_new_element(ErtsPTab *ptab, void *init_arg, void (*init_ptab_el)(void *, Eterm)) { - int pix; - Uint64 ld, exp_ld; - Eterm data; + Uint32 pix, ix, data; erts_aint32_t count; erts_aint_t invalid = (erts_aint_t) ptab->r.o.invalid_element; @@ -551,62 +605,108 @@ erts_ptab_new_element(ErtsPTab *ptab, ptab_el->u.alive.started_interval = erts_smp_current_interval_nob(erts_ptab_interval(ptab)); - ld = last_data_read_acqb(ptab); + if (ptab->r.o.free_id_data) { - /* Reserve slot */ - while (1) { - ld++; - pix = erts_ptab_data2pix(ptab, ERTS_PTAB_LastData2EtermData(ld)); - if (erts_smp_atomic_read_nob(&ptab->r.o.tab[pix]) == ERTS_AINT_NULL) { - erts_aint_t val; - val = erts_smp_atomic_cmpxchg_relb(&ptab->r.o.tab[pix], - invalid, - ERTS_AINT_NULL); + ix = (Uint32) erts_smp_atomic32_inc_read_acqb(&ptab->vola.tile.aid_ix); + ix = ix_to_free_id_data_ix(ptab, ix); + + data = ptab->r.o.free_id_data[ix]; + + init_ptab_el(init_arg, (Eterm) data); + +#ifdef ERTS_SMP + erts_smp_atomic32_init_nob(&ptab_el->refc, 1); +#endif + + pix = erts_ptab_data2pix(ptab, (Eterm) data); + +#ifdef DEBUG + ASSERT(ERTS_AINT_NULL == erts_smp_atomic_xchg_relb(&ptab->r.o.tab[pix], + (erts_aint_t) ptab_el)); +#else + erts_smp_atomic_set_relb(&ptab->r.o.tab[pix], (erts_aint_t) ptab_el); +#endif + + erts_ptab_runlock(ptab); - if (ERTS_AINT_NULL == val) - break; - } } + else { + int rlocked = ERTS_PTAB_NEW_MAX_RESERVE_FAIL; + Uint64 ld, exp_ld; + /* Deprecated legacy algorithm... */ + + restart: + + ptab_el->u.alive.started_interval + = erts_smp_current_interval_nob(erts_ptab_interval(ptab)); - data = ERTS_PTAB_LastData2EtermData(ld); + ld = last_data_read_acqb(ptab); + + /* Reserve slot */ + while (1) { + ld++; + pix = erts_ptab_data2pix(ptab, ERTS_PTAB_LastData2EtermData(ld)); + if (erts_smp_atomic_read_nob(&ptab->r.o.tab[pix]) + == ERTS_AINT_NULL) { + erts_aint_t val; + val = erts_smp_atomic_cmpxchg_relb(&ptab->r.o.tab[pix], + invalid, + ERTS_AINT_NULL); + + if (ERTS_AINT_NULL == val) + break; + } + if (rlocked && --rlocked == 0) { + erts_ptab_runlock(ptab); + erts_ptab_rwlock(ptab); + goto restart; + } + } - if (data == ptab->r.o.invalid_data) { - /* Do not use invalid data; fix it... */ - ld += ptab->r.o.max; - ASSERT(pix == erts_ptab_data2pix(ptab, - ERTS_PTAB_LastData2EtermData(ld))); data = ERTS_PTAB_LastData2EtermData(ld); - ASSERT(data != ptab->r.o.invalid_data); - } - exp_ld = last_data_read_nob(ptab); + if (data == ptab->r.o.invalid_data) { + /* Do not use invalid data; fix it... */ + ld += ptab->r.o.max; + ASSERT(pix == erts_ptab_data2pix(ptab, + ERTS_PTAB_LastData2EtermData(ld))); + data = ERTS_PTAB_LastData2EtermData(ld); + ASSERT(data != ptab->r.o.invalid_data); + } - /* Move last data forward */ - while (1) { - Uint64 act_ld; - if (last_data_cmp(ld, exp_ld) < 0) - break; - act_ld = last_data_cmpxchg_relb(ptab, ld, exp_ld); - if (act_ld == exp_ld) - break; - exp_ld = act_ld; - } + exp_ld = last_data_read_nob(ptab); + + /* Move last data forward */ + while (1) { + Uint64 act_ld; + if (last_data_cmp(ld, exp_ld) < 0) + break; + act_ld = last_data_cmpxchg_relb(ptab, ld, exp_ld); + if (act_ld == exp_ld) + break; + exp_ld = act_ld; + } - init_ptab_el(init_arg, data); + init_ptab_el(init_arg, data); #ifdef ERTS_SMP - erts_smp_atomic32_init_nob(&ptab_el->refc, 1); + erts_smp_atomic32_init_nob(&ptab_el->refc, 1); #endif - /* Move into slot reserved */ + /* Move into slot reserved */ #ifdef DEBUG - ASSERT(invalid == erts_smp_atomic_xchg_relb(&ptab->r.o.tab[pix], + ASSERT(invalid == erts_smp_atomic_xchg_relb(&ptab->r.o.tab[pix], (erts_aint_t) ptab_el)); #else - erts_smp_atomic_set_relb(&ptab->r.o.tab[pix], (erts_aint_t) ptab_el); + erts_smp_atomic_set_relb(&ptab->r.o.tab[pix], (erts_aint_t) ptab_el); #endif - erts_ptab_runlock(ptab); + if (rlocked) + erts_ptab_runlock(ptab); + else + erts_ptab_rwunlock(ptab); + + } return 1; } @@ -647,7 +747,9 @@ erts_ptab_delete_element(ErtsPTab *ptab, ErtsPTabElementCommon *ptab_el) { int maybe_save; - int pix = erts_ptab_id2pix(ptab, ptab_el->id); + Uint32 pix, ix, data; + + pix = erts_ptab_id2pix(ptab, ptab_el->id); ASSERT(erts_get_scheduler_id()); /* *Need* to be a scheduler */ @@ -660,6 +762,26 @@ erts_ptab_delete_element(ErtsPTab *ptab, erts_smp_atomic_set_relb(&ptab->r.o.tab[pix], ERTS_AINT_NULL); + if (ptab->r.o.free_id_data) { + + /* Next data for this slot... */ + data = (Uint32) erts_ptab_id2data(ptab, ptab_el->id); + data += ptab->r.o.max; + data &= ~(~((Uint32) 0) << ERTS_PTAB_ID_DATA_SIZE); + if (data == ptab->r.o.invalid_data) { /* make sure not invalid */ + data += ptab->r.o.max; + data &= ~(~((Uint32) 0) << ERTS_PTAB_ID_DATA_SIZE); + } + + ASSERT(data != ptab->r.o.invalid_data); + ASSERT(pix == erts_ptab_data2pix(ptab, data)); + + ix = (Uint32) erts_smp_atomic32_inc_read_relb(&ptab->vola.tile.fid_ix); + ix = ix_to_free_id_data_ix(ptab, ix); + + ptab->r.o.free_id_data[ix] = data; + } + ASSERT(erts_smp_atomic32_read_nob(&ptab->vola.tile.count) > 0); erts_smp_atomic32_dec_relb(&ptab->vola.tile.count); @@ -1280,42 +1402,86 @@ erts_ptab_test_next_id(ErtsPTab *ptab, int set, Uint next) erts_ptab_rwlock(ptab); - if (!set) - ld = last_data_read_nob(ptab); - else { + if (ptab->r.o.free_id_data) { + Uint32 aid_ix, dix; - ld = (Uint64) next; - data = ERTS_PTAB_LastData2EtermData(ld); - if (ptab->r.o.invalid_data == data) { - ld += ptab->r.o.max; - ASSERT(erts_ptab_data2pix(ptab, data) - == erts_ptab_data2pix(ptab, - ERTS_PTAB_LastData2EtermData(ld))); + if (set) { + Uint32 max_ix, ser, num, start; + max_ix = ptab->r.o.max - 1; + ser = next & ~max_ix; + start = num = next & max_ix; + + aid_ix = (Uint32) erts_smp_atomic32_read_nob(&ptab->vola.tile.aid_ix) + 1; + + do { + Uint32 pix = erts_ptab_data2pix(ptab, num); + if (ERTS_AINT_NULL == erts_ptab_pix2intptr_nob(ptab, pix)) { + dix = ix_to_free_id_data_ix(ptab, aid_ix); + ptab->r.o.free_id_data[dix] = ser + num; + ASSERT(pix == erts_ptab_data2pix(ptab, ser+num)); + if (aid_ix == max_ix) + aid_ix = 0; + else + aid_ix++; + } + if (num == max_ix) + num = 0; + else + num++; + } while (num != start); + +#ifdef DEBUG + if (aid_ix == 0) + aid_ix = max_ix; + else + aid_ix--; + ASSERT((aid_ix & max_ix) == (((Uint32) erts_atomic32_read_nob(&ptab->vola.tile.fid_ix)) & max_ix)); +#endif } - last_data_set_relb(ptab, ld); + + aid_ix = (Uint32) erts_smp_atomic32_read_nob(&ptab->vola.tile.aid_ix) + 1; + dix = ix_to_free_id_data_ix(ptab, aid_ix); + res = (Sint) ptab->r.o.free_id_data[dix]; } + else { + /* Deprecated legacy algorithm... */ + if (!set) + ld = last_data_read_nob(ptab); + else { - while (1) { - int pix; - ld++; - pix = (int) (ld % ptab->r.o.max); - if (first_pix < 0) - first_pix = pix; - else if (pix == first_pix) { - res = -1; - break; - } - if (ERTS_AINT_NULL == erts_ptab_pix2intptr_nob(ptab, pix)) { + ld = (Uint64) next; data = ERTS_PTAB_LastData2EtermData(ld); if (ptab->r.o.invalid_data == data) { ld += ptab->r.o.max; ASSERT(erts_ptab_data2pix(ptab, data) == erts_ptab_data2pix(ptab, ERTS_PTAB_LastData2EtermData(ld))); + } + last_data_set_relb(ptab, ld); + } + + while (1) { + int pix; + ld++; + pix = (int) (ld % ptab->r.o.max); + if (first_pix < 0) + first_pix = pix; + else if (pix == first_pix) { + res = -1; + break; + } + if (ERTS_AINT_NULL == erts_ptab_pix2intptr_nob(ptab, pix)) { data = ERTS_PTAB_LastData2EtermData(ld); + if (ptab->r.o.invalid_data == data) { + ld += ptab->r.o.max; + ASSERT(erts_ptab_data2pix(ptab, data) + == erts_ptab_data2pix(ptab, + ERTS_PTAB_LastData2EtermData(ld))); + data = ERTS_PTAB_LastData2EtermData(ld); + } + res = data; + break; } - res = data; - break; } } diff --git a/erts/emulator/beam/erl_ptab.h b/erts/emulator/beam/erl_ptab.h index 7fa1251900..84ff7d0de4 100644 --- a/erts/emulator/beam/erl_ptab.h +++ b/erts/emulator/beam/erl_ptab.h @@ -94,18 +94,23 @@ typedef struct { erts_smp_atomic_t last_data; #endif erts_smp_atomic32_t count; + erts_smp_atomic32_t aid_ix; + erts_smp_atomic32_t fid_ix; } ErtsPTabVolatileData; typedef struct { erts_smp_atomic_t *tab; + Uint32 *free_id_data; Uint32 max; - Uint32 tab_cache_lines; - Uint32 pix_per_cache_line; Uint32 pix_mask; Uint32 pix_cl_mask; Uint32 pix_cl_shift; Uint32 pix_cli_mask; Uint32 pix_cli_shift; + Uint32 dix_cl_mask; + Uint32 dix_cl_shift; + Uint32 dix_cli_mask; + Uint32 dix_cli_shift; ErtsPTabElementCommon *invalid_element; Eterm invalid_data; void (*release_element)(void *); @@ -179,7 +184,8 @@ void erts_ptab_init_table(ErtsPTab *ptab, ErtsPTabElementCommon *invalid_element, int size, UWord element_size, - char *name); + char *name, + int legacy); int erts_ptab_new_element(ErtsPTab *ptab, ErtsPTabElementCommon *ptab_el, void *init_arg, @@ -187,6 +193,7 @@ int erts_ptab_new_element(ErtsPTab *ptab, void erts_ptab_delete_element(ErtsPTab *ptab, ErtsPTabElementCommon *ptab_el); int erts_ptab_initialized(ErtsPTab *ptab); +UWord erts_ptab_mem_size(ErtsPTab *ptab); ERTS_GLB_INLINE erts_interval_t *erts_ptab_interval(ErtsPTab *ptab); ERTS_GLB_INLINE int erts_ptab_max(ErtsPTab *ptab); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 012c1c7e6a..d5e727bcba 100755 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -688,12 +688,6 @@ void MD5Final(unsigned char [16], MD5_CTX *); /* ggc.c */ - -typedef struct { - Uint garbage_collections; - Uint reclaimed; -} ErtsGCInfo; - void erts_gc_info(ErtsGCInfo *gcip); void erts_init_gc(void); int erts_garbage_collect(Process*, int, Eterm*, int); @@ -724,15 +718,15 @@ int erts_add_driver_entry(ErlDrvEntry *drv, DE_Handle *handle, int driver_list_l void erts_destroy_driver(erts_driver_t *drv); int erts_save_suspend_process_on_port(Port*, Process*); Port *erts_open_driver(erts_driver_t*, Eterm, char*, SysDriverOpts*, int *, int *); -void erts_init_io(int, int); +void erts_init_io(int, int, int); void erts_raw_port_command(Port*, byte*, Uint); void driver_report_exit(ErlDrvPort, int); LineBuf* allocate_linebuf(int); int async_ready(Port *, void*); -ErtsPortNames *erts_get_port_names(Eterm); +ErtsPortNames *erts_get_port_names(Eterm, ErlDrvPort); void erts_free_port_names(ErtsPortNames *); Uint erts_port_ioq_size(Port *pp); -void erts_stale_drv_select(Eterm, ErlDrvEvent, int, int); +void erts_stale_drv_select(Eterm, ErlDrvPort, ErlDrvEvent, int, int); Port *erts_get_heart_port(void); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index b6b7b47bd6..01e130bd64 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -2707,7 +2707,8 @@ erts_port_link(Process *c_p, Port *prt, Eterm to, Eterm *refp) } void erts_init_io(int port_tab_size, - int port_tab_size_ignore_files) + int port_tab_size_ignore_files, + int legacy_port_tab) { ErlDrvEntry** dp; UWord common_element_size; @@ -2750,7 +2751,8 @@ void erts_init_io(int port_tab_size, (ErtsPTabElementCommon *) &erts_invalid_port.common, port_tab_size, common_element_size, /* Doesn't need to be excact */ - "port_table"); + "port_table", + legacy_port_tab); erts_smp_atomic_init_nob(&erts_bytes_out, 0); erts_smp_atomic_init_nob(&erts_bytes_in, 0); @@ -4812,7 +4814,8 @@ int async_ready(Port *p, void* data) static void report_missing_drv_callback(Port *p, char *drv_type, char *callback) { - ErtsPortNames *pnp = erts_get_port_names(p->common.id); + ErtsPortNames *pnp = erts_get_port_names(p->common.id, + ERTS_Port2ErlDrvPort(p)); char *unknown = "<unknown>"; char *drv_name = pnp->driver_name ? pnp->driver_name : unknown; char *prt_name = pnp->name ? pnp->name : unknown; @@ -4827,15 +4830,25 @@ report_missing_drv_callback(Port *p, char *drv_type, char *callback) void erts_stale_drv_select(Eterm port, + ErlDrvPort drv_port, ErlDrvEvent hndl, int mode, int deselect) { char *type; - ErlDrvPort drv_port = ERTS_Port2ErlDrvPort(erts_port_lookup_raw(port)); - ErtsPortNames *pnp = erts_get_port_names(port); + ErtsPortNames *pnp; erts_dsprintf_buf_t *dsbufp; + if (drv_port == ERTS_INVALID_ERL_DRV_PORT) { + Port *prt = erts_port_lookup_raw(port); + if (prt) + drv_port = ERTS_Port2ErlDrvPort(port); + else + drv_port = ERTS_INVALID_ERL_DRV_PORT; + } + + pnp = erts_get_port_names(port, drv_port); + switch (mode) { case ERL_DRV_READ | ERL_DRV_WRITE: type = "Input/Output"; @@ -4870,12 +4883,16 @@ erts_stale_drv_select(Eterm port, } ErtsPortNames * -erts_get_port_names(Eterm id) +erts_get_port_names(Eterm id, ErlDrvPort drv_port) { - Port *prt = erts_port_lookup_raw(id); + Port *prt; ErtsPortNames *pnp; ASSERT(is_nil(id) || is_internal_port(id)); + prt = ERTS_ErlDrvPort2Port(drv_port); + if (prt == ERTS_INVALID_ERL_DRV_PORT) + prt = erts_port_lookup_raw(id); + if (!prt) { pnp = erts_alloc(ERTS_ALC_T_PORT_NAMES, sizeof(ErtsPortNames)); pnp->name = NULL; @@ -4887,6 +4904,7 @@ erts_get_port_names(Eterm id) size_t pnp_len = sizeof(ErtsPortNames); #ifndef DEBUG pnp_len += 100; /* In most cases 100 characters will be enough... */ + ASSERT(prt->common.id == id); #endif pnp = erts_alloc(ERTS_ALC_T_PORT_NAMES, pnp_len); do { diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 6cc1295973..595b0488a8 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -1679,10 +1679,10 @@ static void invoke_pwritev(void *data) { d->again = 0; } } else - ASSERT(written == FILE_SEGMENT_WRITE); + ASSERT(written >= FILE_SEGMENT_WRITE); MUTEX_LOCK(d->c.writev.q_mtx); - driver_deq(d->c.pwritev.port, size); + driver_deq(d->c.pwritev.port, written); MUTEX_UNLOCK(d->c.writev.q_mtx); done: EF_FREE(iov); /* Free our copy of the vector, nothing to restore */ diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 853dd90c34..7035dc77df 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -874,7 +874,7 @@ need2steal(ErtsDrvEventState *state, int mode) static void print_driver_name(erts_dsprintf_buf_t *dsbufp, Eterm id) { - ErtsPortNames *pnp = erts_get_port_names(id); + ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT); if (!pnp->name && !pnp->driver_name) erts_dsprintf(dsbufp, "%s ", "<unknown>"); else { @@ -1357,8 +1357,8 @@ bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport, "Bad %s fd in erts_poll()! fd=%d, ", io_str, (int) state->fd); if (is_nil(port)) { - ErtsPortNames *ipnp = erts_get_port_names(inport); - ErtsPortNames *opnp = erts_get_port_names(outport); + ErtsPortNames *ipnp = erts_get_port_names(inport, ERTS_INVALID_ERL_DRV_PORT); + ErtsPortNames *opnp = erts_get_port_names(outport, ERTS_INVALID_ERL_DRV_PORT); erts_dsprintf(dsbufp, "ports=%T/%T, drivers=%s/%s, names=%s/%s\n", is_nil(inport) ? am_undefined : inport, is_nil(outport) ? am_undefined : outport, @@ -1370,7 +1370,7 @@ bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport, erts_free_port_names(opnp); } else { - ErtsPortNames *pnp = erts_get_port_names(port); + ErtsPortNames *pnp = erts_get_port_names(port, ERTS_INVALID_ERL_DRV_PORT); erts_dsprintf(dsbufp, "port=%T, driver=%s, name=%s\n", is_nil(port) ? am_undefined : port, pnp->driver_name ? pnp->driver_name : "<unknown>", @@ -1390,7 +1390,7 @@ bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport, static void stale_drv_select(Eterm id, ErtsDrvEventState *state, int mode) { - erts_stale_drv_select(id, (ErlDrvEvent) state->fd, mode, 0); + erts_stale_drv_select(id, ERTS_INVALID_ERL_DRV_PORT, (ErlDrvEvent) state->fd, mode, 0); deselect(state, mode); } @@ -1774,7 +1774,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters) err = 1; } else { - ErtsPortNames *pnp = erts_get_port_names(id); + ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT); erts_printf(" inport=%T inname=%s indrv=%s ", id, pnp->name ? pnp->name : "unknown", @@ -1791,7 +1791,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters) err = 1; } else { - ErtsPortNames *pnp = erts_get_port_names(id); + ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT); erts_printf(" outport=%T outname=%s outdrv=%s ", id, pnp->name ? pnp->name : "unknown", @@ -1827,7 +1827,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters) err = 1; } else { - ErtsPortNames *pnp = erts_get_port_names(id); + ErtsPortNames *pnp = erts_get_port_names(id, ERTS_INVALID_ERL_DRV_PORT); erts_printf(" port=%T name=%s drv=%s ", id, pnp->name ? pnp->name : "unknown", diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 22b5d93983..33abd45982 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -28,7 +28,8 @@ bucket_index/1, bucket_mask/1, rbtree/1, - mseg_clear_cache/1]). + mseg_clear_cache/1, + cpool/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -40,7 +41,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [basic, coalesce, threads, realloc_copy, bucket_index, - bucket_mask, rbtree, mseg_clear_cache]. + bucket_mask, rbtree, mseg_clear_cache, cpool]. groups() -> []. @@ -105,6 +106,10 @@ mseg_clear_cache(suite) -> []; mseg_clear_cache(doc) -> []; mseg_clear_cache(Cfg) -> ?line drv_case(Cfg). +cpool(suite) -> []; +cpool(doc) -> []; +cpool(Cfg) -> ?line drv_case(Cfg). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% %% Internal functions %% diff --git a/erts/emulator/test/alloc_SUITE_data/Makefile.src b/erts/emulator/test/alloc_SUITE_data/Makefile.src index 035415d73e..1d4286e671 100644 --- a/erts/emulator/test/alloc_SUITE_data/Makefile.src +++ b/erts/emulator/test/alloc_SUITE_data/Makefile.src @@ -23,7 +23,8 @@ TEST_DRVS = basic@dll@ \ bucket_index@dll@ \ bucket_mask@dll@ \ rbtree@dll@ \ - mseg_clear_cache@dll@ + mseg_clear_cache@dll@ \ + cpool@dll@ CC = @CC@ LD = @LD@ diff --git a/erts/emulator/test/alloc_SUITE_data/allocator_test.h b/erts/emulator/test/alloc_SUITE_data/allocator_test.h index c0396ddb61..c37b074f93 100644 --- a/erts/emulator/test/alloc_SUITE_data/allocator_test.h +++ b/erts/emulator/test/alloc_SUITE_data/allocator_test.h @@ -75,6 +75,15 @@ typedef void* erts_cond; #define PREV_BLK(B) ((Block_t *) ALC_TEST1(0x019, (B))) #define IS_MBC_FIRST_BLK(A,B) ((Ulong) ALC_TEST2(0x01a, (A), (B))) #define UNIT_SZ ((Ulong) ALC_TEST0(0x01b)) +#define BLK_TO_MBC(B) ((Carrier_t *) ALC_TEST1(0x01c, (B))) +#define ADD_MBC(A, C) ((void) ALC_TEST2(0x01d, (A), (C))) +#define REMOVE_MBC(A, C) ((void) ALC_TEST2(0x01e, (A), (C))) +#define ZERO_CRR_SIZE ((Ulong) ALC_TEST0(0x01f)) +#define ZERO_CRR_INIT(A,B) ((Carrier_t *) ALC_TEST2(0x020, (A), (B))) +#define CPOOL_INSERT(A,B) ((Carrier_t *) ALC_TEST2(0x021, (A), (B))) +#define CPOOL_DELETE(A,B) ((Carrier_t *) ALC_TEST2(0x022, (A), (B))) +#define CPOOL_IS_EMPTY(A) ((int) ALC_TEST1(0x023, (A))) +#define CPOOL_IS_IN_POOL(A,B) ((int) ALC_TEST2(0x024, (A), (B))) /* From erl_goodfit_alloc.c */ #define BKT_IX(A, S) ((Ulong) ALC_TEST2(0x100, (A), (S))) @@ -84,15 +93,16 @@ typedef void* erts_cond; /* From erl_bestfit_alloc.c and erl_ao_firstfit_alloc.c */ #define IS_AOBF(A) ((Ulong) ALC_TEST1(RBT_OP(0), (A))) -#define RBT_ROOT(A) ((RBT_t *) ALC_TEST1(RBT_OP(1), (A))) +#define RBT_ROOT(A,SZ) ((RBT_t *) ALC_TEST2(RBT_OP(1), (A), (SZ))) #define RBT_PARENT(T) ((RBT_t *) ALC_TEST1(RBT_OP(2), (T))) #define RBT_LEFT(T) ((RBT_t *) ALC_TEST1(RBT_OP(3), (T))) #define RBT_RIGHT(T) ((RBT_t *) ALC_TEST1(RBT_OP(4), (T))) #define RBT_NEXT(T) ((RBTL_t *) ALC_TEST1(RBT_OP(5), (T))) #define RBT_IS_BLACK(T) ((Ulong) ALC_TEST1(RBT_OP(6), (T))) #define RBT_IS_TREE(T) ((Ulong) ALC_TEST1(RBT_OP(7), (T))) -#define IS_AOFF(A) ((Ulong) ALC_TEST1(RBT_OP(8), (A))) +#define IS_BF_ALGO(A) ((Ulong) ALC_TEST1(RBT_OP(8), (A))) #define RBT_MAX_SZ(T) ((Ulong) ALC_TEST1(RBT_OP(9), (T))) +#define IS_CBF(A) ((Ulong) ALC_TEST1(RBT_OP(0xa), (A))) /* From erl_mseg.c */ #define HAVE_MSEG() ((int) ALC_TEST0(0x400)) @@ -129,5 +139,6 @@ typedef void* erts_cond; #define THR_CREATE(F, A) ((erts_thread) ALC_TEST2(0xf10, (F), (A))) #define THR_JOIN(T) ((void) ALC_TEST1(0xf11, (T))) #define THR_EXIT(R) ((void) ALC_TEST1(0xf12, (R))) +#define IS_SMP_ENABLED ((int) ALC_TEST0(0xf13)) #endif diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.c b/erts/emulator/test/alloc_SUITE_data/coalesce.c index 981fa6d43e..36710bf7b5 100644 --- a/erts/emulator/test/alloc_SUITE_data/coalesce.c +++ b/erts/emulator/test/alloc_SUITE_data/coalesce.c @@ -267,7 +267,7 @@ void testcase_run(TestCaseState_t *tcs) { char *argv_org[] = {"-tsmbcs511","-tmmbcs511", "-tsbct512", "-trmbcmt100", "-tas", NULL, NULL}; - char *alg[] = {"af", "gf", "bf", "aobf", "aoff", NULL}; + char *alg[] = {"af", "gf", "bf", "aobf", "aoff", "aoffcaobf", NULL}; int i; for (i = 0; alg[i]; i++) { diff --git a/erts/emulator/test/alloc_SUITE_data/cpool.c b/erts/emulator/test/alloc_SUITE_data/cpool.c new file mode 100644 index 0000000000..276ed7be04 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/cpool.c @@ -0,0 +1,157 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2013. 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% + */ + + +#ifndef __WIN32__ +#include <sys/types.h> +#include <unistd.h> +#include <errno.h> +#endif +#include <stdio.h> +#include <stdarg.h> +#include <string.h> +#include "testcase_driver.h" +#include "allocator_test.h" + +#define FATAL_ASSERT(A) \ + ((void) ((A) \ + ? 1 \ + : (fatal_assert_failed(#A, \ + (char *) __FILE__, \ + __LINE__), \ + 0))) + +static void +fatal_assert_failed(char* expr, char* file, int line) +{ + fflush(stdout); + fprintf(stderr, "%s:%d: Assertion failed: %s\n", + file, line, expr); + fflush(stderr); + abort(); +} + +#define TEST_NO_THREADS 10 +#define TEST_NO_CARRIERS_PER_THREAD 100000 +#define TEST_CARRIERS_OFFSET 5 + +static Allctr_t *alloc = NULL; + +static void stop_allocator(void) +{ + if (alloc) { + STOP_ALC(alloc); + alloc = NULL; + } +} + + +void *thread_func(void *arg); + +char * +testcase_name(void) +{ + return "cpool"; +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + stop_allocator(); +} + +void * +thread_func(void *arg) +{ + Carrier_t *crr = (Carrier_t *) arg; + int i; + + for (i = 0; i < (TEST_NO_CARRIERS_PER_THREAD+TEST_CARRIERS_OFFSET); i++) { + int d; + if (i < TEST_NO_CARRIERS_PER_THREAD) { + CPOOL_INSERT(alloc, crr[i]); + if ((i & 0x7) == 0) + FATAL_ASSERT(CPOOL_IS_IN_POOL(alloc, crr[i])); + } + d = i-TEST_CARRIERS_OFFSET; + if (d >= 0) { + CPOOL_DELETE(alloc, crr[d]); + if ((d & 0x7) == 0) + FATAL_ASSERT(!CPOOL_IS_IN_POOL(alloc, crr[d])); + } + } + for (i = 0; i < TEST_NO_CARRIERS_PER_THREAD; i++) + FATAL_ASSERT(!CPOOL_IS_IN_POOL(alloc, crr[i])); + return NULL; +} + +static struct { + erts_thread tid; + Carrier_t *crr[TEST_NO_CARRIERS_PER_THREAD]; +} threads[TEST_NO_THREADS] = {{0}}; + +void +testcase_run(TestCaseState_t *tcs) +{ + int no_threads, t, c; + char *block, *p; + Ulong zcrr_sz; + + if (!IS_SMP_ENABLED) + testcase_skipped(tcs, "No SMP support"); + + alloc = START_ALC("Zero carrier allocator", 1, NULL); + + zcrr_sz = ZERO_CRR_SIZE; + + block = p = ALLOC(alloc, zcrr_sz*TEST_NO_THREADS*TEST_NO_CARRIERS_PER_THREAD); + + ASSERT(tcs, block != NULL); + + for (t = 0; t < TEST_NO_THREADS; t++) { + for (c = 0; c < TEST_NO_CARRIERS_PER_THREAD; c++) { + Carrier_t *crr = (Carrier_t *) p; + p += zcrr_sz; + ZERO_CRR_INIT(alloc, crr); + threads[t].crr[c] = crr; + } + } + + no_threads = 0; + for (t = 0; t < TEST_NO_THREADS; t++) { + threads[t].tid = THR_CREATE(thread_func, (void *) threads[t].crr); + if (threads[t].tid) { + testcase_printf(tcs, "Successfully created thread %d\n", t); + no_threads++; + } + else { + testcase_printf(tcs, "Failed to create thread %d\n", t); + break; + } + } + + for (t = 0; t < no_threads; t++) + THR_JOIN(threads[t].tid); + + FATAL_ASSERT(CPOOL_IS_EMPTY(alloc)); + + FREE(alloc, block); + + ASSERT(tcs, no_threads == TEST_NO_THREADS); +} diff --git a/erts/emulator/test/alloc_SUITE_data/rbtree.c b/erts/emulator/test/alloc_SUITE_data/rbtree.c index 4e7f821baf..702f075304 100644 --- a/erts/emulator/test/alloc_SUITE_data/rbtree.c +++ b/erts/emulator/test/alloc_SUITE_data/rbtree.c @@ -85,7 +85,7 @@ print_tree(TestCaseState_t *tcs, RBT_t *root) static RBT_t * check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) { - enum { BF, AOBF, AOFF }type; + enum { BF, AOBF, AOFF, AOFFCAOBF }type; int i, max_i; char stk[128]; RBT_t *root, *x, *y, *res; @@ -94,11 +94,16 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) res = NULL; - if (IS_AOBF(alc)) type = AOBF; - else if (IS_AOFF(alc)) type = AOFF; - else type = BF; + if (IS_BF_ALGO(alc)) { + if (IS_AOBF(alc)) type = AOBF; + else type = BF; + } + else { /* AOFF_ALGO */ + if (IS_CBF(alc)) type = AOFFCAOBF; + else type = AOFF; + } - root = RBT_ROOT(alc); + root = RBT_ROOT(alc, size); #ifdef PRINT_TREE print_tree(tcs, root); @@ -188,6 +193,15 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) ASSERT(tcs, y < x); ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x)); break; + case AOFFCAOBF: + { + void* x_crr = BLK_TO_MBC(x); + void* y_crr = BLK_TO_MBC(y); + ASSERT(tcs, (y < x && (x_crr != y_crr || x_sz == y_sz)) + || (y_sz < x_sz && x_crr == y_crr)); + ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x)); + break; + } } } @@ -207,6 +221,15 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) ASSERT(tcs, y > x); ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x)); break; + case AOFFCAOBF: + { + void* x_crr = BLK_TO_MBC(x); + void* y_crr = BLK_TO_MBC(y); + ASSERT(tcs, (y > x && (x_crr != y_crr || x_sz == y_sz)) + || (y_sz > x_sz && x_crr == y_crr)); + ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x)); + break; + } } } @@ -239,7 +262,18 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) res = x; } break; + case AOFFCAOBF: + if (BLK_TO_MBC(x) != BLK_TO_MBC(res) || x_sz == y_sz) { + if (x < res) { + res = x; + } + } + else if (x_sz < y_sz) { + res = x; + } + break; } + } } @@ -263,17 +297,20 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) } static void -do_check(TestCaseState_t *tcs, Allctr_t *a, Ulong size) +do_check(TestCaseState_t *tcs, Allctr_t *a, Ulong size, int ignore_null) { Ulong sz = ((size + 7) / 8)*8; void *tmp; Block_t *x, *y; x = (Block_t *) check_tree(tcs, a, sz); + if (!x && ignore_null) + return; + tmp = ALLOC(a, sz - ABLK_HDR_SZ); ASSERT(tcs, tmp); y = UMEM2BLK(tmp); - if (IS_AOBF(a)) { + if (!(IS_BF_ALGO(a) && !IS_AOBF(a))) { ASSERT(tcs, x == y); } else { @@ -306,7 +343,7 @@ test_it(TestCaseState_t *tcs) blk[i] = NULL; } if (i % (NO_BLOCKS/2) == 0) - do_check(tcs, a, 50); + do_check(tcs, a, 50, 0); } for (i = 0; i < NO_BLOCKS; i++) { @@ -315,7 +352,7 @@ test_it(TestCaseState_t *tcs) blk[i] = NULL; } if (i % (NO_BLOCKS/2) == 0) - do_check(tcs, a, 200); + do_check(tcs, a, 200, 0); } for (i = 0; i < NO_BLOCKS; i++) { @@ -324,20 +361,101 @@ test_it(TestCaseState_t *tcs) blk[i] = NULL; } if (i % (NO_BLOCKS/2) == 0) - do_check(tcs, a, 100); + do_check(tcs, a, 100, 0); } - do_check(tcs, a, 250); + do_check(tcs, a, 250, 0); for (i = 0; i < NO_BLOCKS; i++) { FREE(a, fence[i]); if (i % (NO_BLOCKS/3) == 0) - do_check(tcs, a, 300); + do_check(tcs, a, 300, 0); + } + + ASSERT(tcs, RBT_ROOT(a,0)); + ASSERT(tcs, !RBT_LEFT(RBT_ROOT(a,0))); + ASSERT(tcs, !RBT_RIGHT(RBT_ROOT(a,0))); +} + + +static int is_single_ablk_in_mbc(Allctr_t* a, void* ptr, void* crr) +{ + Block_t* blk = UMEM2BLK(ptr); + if (crr == BLK_TO_MBC(blk)) { + Block_t* first = MBC_TO_FIRST_BLK(a, crr); + if (blk == first || (IS_FREE_BLK(first) && blk == NXT_BLK(first))) { + Block_t* nxt; + if (IS_LAST_BLK(blk)) { + return 1; + } + nxt = NXT_BLK(blk); + return IS_FREE_BLK(nxt) && IS_LAST_BLK(nxt); + } + } + return 0; +} + +static void +test_carrier_migration(TestCaseState_t *tcs) +{ + int i, j; + Allctr_t* a = ((rbtree_test_data *) tcs->extra)->allocator; + void **blk = ((rbtree_test_data *) tcs->extra)->blk; + void **fence = ((rbtree_test_data *) tcs->extra)->fence; + void *crr, *p, *free_crr; + Ulong min_blk_sz; + + min_blk_sz = MIN_BLK_SZ(a); + + for (i = 0; i < NO_BLOCKS; i++) { + blk[i] = ALLOC(a, min_blk_sz + i % 500); + fence[i] = ALLOC(a, 1); + ASSERT(tcs, blk[i] && fence[i]); + } + + for (j = 0; j < NO_BLOCKS; j += 997) { + crr = BLK_TO_MBC(UMEM2BLK(blk[j])); + REMOVE_MBC(a, crr); + + for (i = 0; i < NO_BLOCKS; i++) { + if (i % 3 == 0) { + if (is_single_ablk_in_mbc(a, blk[i], crr)) { + crr = NULL; /* about to destroy the removed mbc */ + } + FREE(a, blk[i]); + blk[i] = NULL; + } + if (i % (NO_BLOCKS/2) == 0) + do_check(tcs, a, 50, 1); + } + + for (i = 0; i < NO_BLOCKS; i++) { + if (i % 3 == 0) { + ASSERT(tcs, !blk[i]); + blk[i] = ALLOC(a, min_blk_sz + i % 500); + ASSERT(tcs, BLK_TO_MBC(UMEM2BLK(blk[i])) != crr); + } + if (i % (NO_BLOCKS/2) == 0) + do_check(tcs, a, 50, 1); + } + if (crr) { + ADD_MBC(a, crr); + } + } + + for (crr = FIRST_MBC(a); crr; crr = NEXT_C(crr)) { + REMOVE_MBC(a, crr); } - ASSERT(tcs, RBT_ROOT(a)); - ASSERT(tcs, !RBT_LEFT(RBT_ROOT(a))); - ASSERT(tcs, !RBT_RIGHT(RBT_ROOT(a))); + p = ALLOC(a, 1); + free_crr = BLK_TO_MBC(UMEM2BLK(p)); + FREE(a, p); + + for (crr = FIRST_MBC(a); crr; crr = NEXT_C(crr)) { + ASSERT(tcs, free_crr != crr); + } + + ASSERT(tcs, !RBT_ROOT(a,0)); } @@ -369,6 +487,7 @@ testcase_run(TestCaseState_t *tcs) char *argv1[] = {"-tasbf", NULL}; char *argv2[] = {"-tasaobf", NULL}; char *argv3[] = {"-tasaoff", NULL}; + char *argv4[] = {"-tasaoffcaobf", NULL}; Allctr_t *a; rbtree_test_data *td; @@ -390,6 +509,7 @@ testcase_run(TestCaseState_t *tcs) td->allocator = a = START_ALC("rbtree_bf_", 0, argv1); ASSERT(tcs, a); + ASSERT(tcs, IS_BF_ALGO(a)); ASSERT(tcs, !IS_AOBF(a)); test_it(tcs); @@ -407,6 +527,7 @@ testcase_run(TestCaseState_t *tcs) td->allocator = a = START_ALC("rbtree_aobf_", 0, argv2); ASSERT(tcs, a); + ASSERT(tcs, IS_BF_ALGO(a)); ASSERT(tcs, IS_AOBF(a)); test_it(tcs); @@ -424,11 +545,34 @@ testcase_run(TestCaseState_t *tcs) td->allocator = a = START_ALC("rbtree_aoff_", 0, argv3); ASSERT(tcs, a); + ASSERT(tcs, !IS_BF_ALGO(a)); + ASSERT(tcs, !IS_CBF(a)); test_it(tcs); + test_carrier_migration(tcs); STOP_ALC(a); td->allocator = NULL; testcase_printf(tcs, "Address order first fit test succeeded!\n"); + + /* Address order first fit, best fit within carrier */ + + testcase_printf(tcs, "Starting test of aoffcaobf...\n"); + + current_rbt_type_op_base = AO_FIRSTFIT_OP_BASE; + td->allocator = a = START_ALC("rbtree_aoffcaobf_", 0, argv4); + + ASSERT(tcs, a); + ASSERT(tcs, !IS_BF_ALGO(a)); + ASSERT(tcs, IS_CBF(a)); + + test_it(tcs); + test_carrier_migration(tcs); + + STOP_ALC(a); + td->allocator = NULL; + + testcase_printf(tcs, "aoffcaobf test succeeded!\n"); + } diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index dfba7d098f..104bdf8aec 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -2582,10 +2582,9 @@ driver_alloc_size() -> MemInfo -> CS = lists:foldl( fun ({instance, _, L}, Acc) -> - {value,{_,SBMBCS}} = lists:keysearch(sbmbcs, 1, L), {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), - [SBMBCS,MBCS,SBCS | Acc] + [MBCS,SBCS | Acc] end, [], MemInfo), diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index dcf58fa474..9a70e8646a 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1368,10 +1368,9 @@ tmpmem() -> MemInfo -> MSBCS = lists:foldl( fun ({instance, _, L}, Acc) -> - {value,{_,SBMBCS}} = lists:keysearch(sbmbcs, 1, L), {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), - [SBMBCS,MBCS,SBCS | Acc] + [MBCS,SBCS | Acc] end, [], MemInfo), diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 13aa0f4c00..e467e844b3 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -92,7 +92,7 @@ spawn_driver/1, spawn_executable/1, close_deaf_port/1, unregister_name/1, parallelism_option/1]). --export([]). +-export([do_iter_max_ports/2]). %% Internal exports. -export([tps/3]). @@ -635,9 +635,16 @@ iter_max_ports_test(Config) -> {win32,_} -> 4; _ -> 10 end, - L = do_iter_max_ports(Iters, Command), + %% Run on a different node in order to limit the effect if this test fails. + Dir = filename:dirname(code:which(?MODULE)), + {ok,Node} = test_server:start_node(test_iter_max_socks,slave, + [{args,"+Q 2048 -pa " ++ Dir}]), + L = rpc:call(Node,?MODULE,do_iter_max_ports,[Iters, Command]), + test_server:stop_node(Node), + io:format("Result: ~p",[L]), all_equal(L), + all_equal(L), test_server:timetrap_cancel(Dog), {comment, "Max ports: " ++ integer_to_list(hd(L))}. @@ -670,7 +677,7 @@ close_ports([]) -> ok. open_ports(Name, Settings) -> - test_server:sleep(50), + test_server:sleep(5), case catch open_port(Name, Settings) of P when is_port(P) -> [P| open_ports(Name, Settings)]; diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index 863cd2d654..72f3e8fe85 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -1494,6 +1494,7 @@ processes_bif_cleaner() -> spawn_initial_hangarounds(Cleaner) -> TabSz = erlang:system_info(process_limit), + erts_debug:set_internal_state(next_pid,TabSz), spawn_initial_hangarounds(Cleaner, TabSz, TabSz*2, @@ -1538,14 +1539,21 @@ hangaround(Cleaner, Type) -> spawn_initial_hangarounds(_Cleaner, NP, Max, Len, HAs) when NP > Max -> {Len, HAs}; spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) -> - erts_debug:set_internal_state(next_pid,NP), + Skip = 30, HA1 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], [{priority, low}]), HA2 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], [{priority, normal}]), HA3 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], [{priority, high}]), - spawn_initial_hangarounds(Cleaner, NP+30, Max, Len+3, [HA1,HA2,HA3|HAs]). + spawn_drop(Skip), + spawn_initial_hangarounds(Cleaner, NP+Skip, Max, Len+3, [HA1,HA2,HA3|HAs]). + +spawn_drop(N) when N =< 0 -> + ok; +spawn_drop(N) -> + spawn(fun () -> ok end), + spawn_drop(N-1). do_processes(WantReds) -> erts_debug:set_internal_state(reds_left, WantReds), diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl index ba0ba804ca..6615873392 100644 --- a/erts/emulator/test/send_term_SUITE.erl +++ b/erts/emulator/test/send_term_SUITE.erl @@ -175,10 +175,6 @@ chk_temp_alloc() -> %% Verify that we havn't got anything allocated by temp_alloc lists:foreach( fun ({instance, _, TI}) -> - ?line {value, {sbmbcs, SBMBCInfo}} - = lists:keysearch(sbmbcs, 1, TI), - ?line {value, {blocks, 0, _, _}} - = lists:keysearch(blocks, 1, SBMBCInfo), ?line {value, {mbcs, MBCInfo}} = lists:keysearch(mbcs, 1, TI), ?line {value, {blocks, 0, _, _}} diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 31d9b2e0ad..01134dd718 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -64,7 +64,6 @@ static const char plusM_au_allocs[]= { 'u', /* all alloc_util allocators */ 'B', /* binary_alloc */ - 'C', /* sbmbc_alloc */ 'D', /* std_alloc */ 'E', /* ets_alloc */ 'F', /* fix_alloc */ @@ -80,6 +79,7 @@ static const char plusM_au_allocs[]= { static char *plusM_au_alloc_switches[] = { "as", "asbcst", + "acul", "e", "t", "lmbcs", @@ -95,8 +95,6 @@ static char *plusM_au_alloc_switches[] = { "rsbcst", "sbct", "smbcs", - "sbmbcs", - "sbmbct", NULL }; diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index f99059cb72..691b32e143 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -31,6 +31,8 @@ # -debug Run debug compiled emulator # -gdb Run the debug compiled emulator in emacs and gdb. # You have to start beam in gdb using "run". +# -rgdb Run the debug compiled emulator in gdb. +# You have to start beam in gdb using "run". # -break F Run the debug compiled emulator in emacs and gdb and set break. # The session is started, i.e. "run" is already don for you. # -xxgdb FIXME currently disabled @@ -178,6 +180,10 @@ while [ $# -gt 0 ]; do ;; "-gdb") shift + GDB=egdb + ;; + "-rgdb") + shift GDB=gdb ;; "-break") @@ -188,6 +194,12 @@ while [ $# -gt 0 ]; do ;; "-core") shift + GDB=egdb + core="$1" + shift + ;; + "-rcore") + shift GDB=gdb core="$1" shift @@ -285,6 +297,27 @@ if [ "x$GDB" = "x" ]; then else exec $EXEC $eeargs $xargs ${1+"$@"} fi +elif [ "x$GDB" = "xgdb" ]; then + case "x$core" in + x) + # Get emu args to use from erlexec... + beam_args=`$EXEC -emu_args_exit ${1+"$@"}` + gdbcmd="--args $EMU_NAME $beam_args" + ;; + x/*) + gdbcmd="$EMU_NAME ${core}" + GDBBP= + ;; + *) + dir=`pwd` + gdbcmd="$EMU_NAME ${dir}/${core}" + GDBBP= + ;; + esac + cmdfile="/tmp/.cerlgdb.$$" + echo "source $ROOTDIR/erts/etc/unix/etp-commands" > $cmdfile + # Fire up gdb in emacs... + exec gdb $GDBBP -x $cmdfile $gdbcmd else if [ "x$EMACS" = "x" ]; then EMACS=emacs diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 308cb99be5..947fbe7c24 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/prim_eval.beam b/erts/preloaded/ebin/prim_eval.beam Binary files differnew file mode 100644 index 0000000000..6c7b7e5262 --- /dev/null +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/src/.gitignore b/erts/preloaded/src/.gitignore new file mode 100644 index 0000000000..e4658fe142 --- /dev/null +++ b/erts/preloaded/src/.gitignore @@ -0,0 +1 @@ +prim_eval.abstr diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile index a224b6a5d4..f53809e765 100644 --- a/erts/preloaded/src/Makefile +++ b/erts/preloaded/src/Makefile @@ -32,7 +32,7 @@ STATIC_EBIN=../ebin include $(ERL_TOP)/erts/vsn.mk include $(ERL_TOP)/lib/kernel/vsn.mk -PRE_LOADED_MODULES = \ +PRE_LOADED_ERL_MODULES = \ erl_prim_loader \ init \ prim_file \ @@ -43,10 +43,17 @@ PRE_LOADED_MODULES = \ erlang \ erts_internal +PRE_LOADED_BEAM_MODULES = \ + prim_eval + +PRE_LOADED_MODULES = $(PRE_LOADED_ERL_MODULES) $(PRE_LOADED_BEAM_MODULES) + RELSYSDIR = $(RELEASE_PATH)/lib/erts-$(VSN) # not $(RELEASE_PATH)/erts-$(VSN)/preloaded -ERL_FILES= $(PRE_LOADED_MODULES:%=%.erl) +ERL_FILES= $(PRE_LOADED_ERL_MODULES:%=%.erl) +BEAM_FILES= $(PRE_LOADED_BEAM_MODULES:%=%.S) +STUBS_FILES= $(PRE_LOADED_BEAM_MODULES:%=%.erl) TARGET_FILES = $(PRE_LOADED_MODULES:%=$(EBIN)/%.$(EMULATOR)) STATIC_TARGET_FILES = $(PRE_LOADED_MODULES:%=$(STATIC_EBIN)/%.$(EMULATOR)) @@ -70,7 +77,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: $(INSTALL_DIR) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src" + $(INSTALL_DATA) $(ERL_FILES) $(BEAM_FILES) $(STUBS_FILES) "$(RELSYSDIR)/src" $(INSTALL_DIR) "$(RELSYSDIR)/ebin" $(INSTALL_DATA) $(STATIC_TARGET_FILES) "$(RELSYSDIR)/ebin" @@ -80,6 +87,19 @@ release_docs_spec: list_preloaded: @echo $(PRE_LOADED_MODULES) +# +# Combine a BEAM assembly script file a stub Erlang file into a BEAM file. +# See add_abstract_chunk script. +# + +prim_eval.abstr: prim_eval.erl + $(V_ERLC) $(ERL_COMPILE_FLAGS) -o$(dir $@) +dabstr $< + +prim_eval.beam: prim_eval.S prim_eval.abstr + $(gen_verbose) + $(V_at)$(ERLC) $(ERL_COMPILE_FLAGS) $< + $(V_at)escript add_abstract_code $@ prim_eval.abstr || (rm $@; exit 1) + # Include dependencies -- list below added by PaN $(EBIN)/erl_prim_loader.beam: $(KERNEL_SRC)/inet_boot.hrl $(KERNEL_INCLUDE)/file.hrl $(EBIN)/prim_file.beam: $(KERNEL_INCLUDE)/file.hrl diff --git a/erts/preloaded/src/add_abstract_code b/erts/preloaded/src/add_abstract_code new file mode 100644 index 0000000000..e670156d21 --- /dev/null +++ b/erts/preloaded/src/add_abstract_code @@ -0,0 +1,34 @@ +#!/usr/bin/env escript +%% -*- erlang -*- + +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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% +%% + +-mode(compile). + +-export([main/1]). + +main([BeamFile,AbstrFile]) -> + {ok,_,Chunks0} = beam_lib:all_chunks(BeamFile), + {ok,Abstr} = file:consult(AbstrFile), + Chunks = lists:keyreplace("Abst", 1, Chunks0, + {"Abst",term_to_binary({raw_abstract_v1,Abstr})}), + {ok,Module} = beam_lib:build_module(Chunks), + ok = file:write_file(BeamFile, Module), + init:stop(). diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 7106c0a4fb..a8a4425b63 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -45,7 +45,8 @@ -export([alloc_info/1, alloc_sizes/1]). -export([gather_sched_wall_time_result/1, - await_sched_wall_time_modifications/2]). + await_sched_wall_time_modifications/2, + gather_gc_info_result/1]). -deprecated([hash/2]). @@ -3113,8 +3114,8 @@ max(A, _) -> A. | 'atom' | 'atom_used' | 'binary' | 'code' | 'ets' | 'low' | 'maximum'. --define(CARRIER_ALLOCS, [mseg_alloc, sbmbc_alloc, sbmbc_low_alloc]). --define(LOW_ALLOCS, [sbmbc_low_alloc, ll_low_alloc, std_low_alloc]). +-define(CARRIER_ALLOCS, [mseg_alloc]). +-define(LOW_ALLOCS, [ll_low_alloc, std_low_alloc]). -define(ALL_NEEDED_ALLOCS, (erlang:system_info(alloc_util_allocators) -- ?CARRIER_ALLOCS)). @@ -3281,12 +3282,16 @@ get_blocks_size([{blocks_size, Sz, _, _} | Rest], Acc) -> get_blocks_size(Rest, Acc+Sz); get_blocks_size([{_, _, _, _} | Rest], Acc) -> get_blocks_size(Rest, Acc); +get_blocks_size([{blocks_size, Sz} | Rest], Acc) -> + get_blocks_size(Rest, Acc+Sz); +get_blocks_size([{_, _} | Rest], Acc) -> + get_blocks_size(Rest, Acc); get_blocks_size([], Acc) -> Acc. blocks_size([{Carriers, SizeList} | Rest], Acc) when Carriers == mbcs; - Carriers == sbcs; - Carriers == sbmbcs -> + Carriers == mbcs_pool; + Carriers == sbcs -> blocks_size(Rest, get_blocks_size(SizeList, Acc)); blocks_size([_ | Rest], Acc) -> blocks_size(Rest, Acc); @@ -3305,6 +3310,9 @@ get_fix_proc([], Acc) -> fix_proc([{fix_types, SizeList} | _Rest], Acc) -> get_fix_proc(SizeList, Acc); +fix_proc([{fix_types, Mask, SizeList} | _Rest], Acc) -> + {A, U} = get_fix_proc(SizeList, Acc), + {Mask, A, U}; fix_proc([_ | Rest], Acc) -> fix_proc(Rest, Acc); fix_proc([], Acc) -> @@ -3356,13 +3364,21 @@ au_mem_data(#memory{total = Tot, processes_used = ProcU, system = Sys} = Mem, [{fix_alloc, _, Data} | Rest]) -> - {A, U} = fix_proc(Data, {0, 0}), Sz = blocks_size(Data, 0), - au_mem_data(Mem#memory{total = Tot+Sz, - processes = Proc+A, - processes_used = ProcU+U, - system = Sys+Sz-A}, - Rest); + case fix_proc(Data, {0, 0}) of + {A, U} -> + au_mem_data(Mem#memory{total = Tot+Sz, + processes = Proc+A, + processes_used = ProcU+U, + system = Sys+Sz-A}, + Rest); + {Mask, A, U} -> + au_mem_data(Mem#memory{total = Tot+Sz, + processes = Mask band (Proc+A), + processes_used = Mask band (ProcU+U), + system = Mask band (Sys+Sz-A)}, + Rest) + end; au_mem_data(#memory{total = Tot, system = Sys, low = Low} = Mem, @@ -3380,7 +3396,7 @@ au_mem_data(EMD, []) -> au_mem_data(Allocs) -> Ref = erlang:make_ref(), - erlang:system_info({allocator_sizes, Ref, Allocs}), + erlang:system_info({memory_internal, Ref, Allocs}), receive_emd(Ref). receive_emd(_Ref, EMD, 0) -> @@ -3536,3 +3552,20 @@ sched_wall_time(Ref, N, Acc) -> {Ref, undefined} -> sched_wall_time(Ref, N-1, undefined); {Ref, SWT} -> sched_wall_time(Ref, N-1, [SWT|Acc]) end. + +-spec erlang:gather_gc_info_result(Ref) -> [{pos_integer(), + pos_integer(), + 0}] when + Ref :: reference(). + +gather_gc_info_result(Ref) when erlang:is_reference(Ref) -> + gc_info(Ref, erlang:system_info(schedulers), {0,0}). + +gc_info(_Ref, 0, {Colls,Recl}) -> + {Colls,Recl,0}; +gc_info(Ref, N, {OrigColls,OrigRecl}) -> + receive + {Ref, {_,Colls, Recl}} -> + gc_info(Ref, N-1, {Colls+OrigColls,Recl+OrigRecl}) + end. + diff --git a/erts/preloaded/src/prim_eval.S b/erts/preloaded/src/prim_eval.S new file mode 100644 index 0000000000..958a79a1da --- /dev/null +++ b/erts/preloaded/src/prim_eval.S @@ -0,0 +1,70 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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, prim_eval}. + +%% This module uses low-level BEAM instructions for the message queue facility +%% to allow erl_eval to evaluate receive expressions correctly. + +{exports, [{'receive',2},{module_info,0},{module_info,1}]}. + +{attributes, []}. + +{labels, 10}. + + +{function, 'receive', 2, 2}. + {label,1}. + {func_info,{atom,prim_eval},{atom,'receive'},2}. + {label,2}. + {allocate,2,2}. + {move,{x,1},{y,0}}. + {move,{x,0},{y,1}}. + {label,3}. + {loop_rec,{f,5},{x,0}}. + {move,{y,1},{x,1}}. + {call_fun,1}. + {test,is_ne_exact,{f,4},[{x,0},{atom,nomatch}]}. + remove_message. + {deallocate,2}. + return. + {label,4}. + {loop_rec_end,{f,3}}. + {label,5}. + {wait_timeout,{f,3},{y,0}}. + timeout. + {move,{atom,timeout},{x,0}}. + {deallocate,2}. + return. + + +{function, module_info, 0, 8}. + {label,6}. + {func_info,{atom,prim_eval},{atom,module_info},0}. + {label,7}. + {move,{atom,prim_eval},{x,0}}. + {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. + + +{function, module_info, 1, 10}. + {label,8}. + {func_info,{atom,prim_eval},{atom,module_info},1}. + {label,9}. + {move,{x,0},{x,1}}. + {move,{atom,prim_eval},{x,0}}. + {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. diff --git a/erts/preloaded/src/prim_eval.erl b/erts/preloaded/src/prim_eval.erl new file mode 100644 index 0000000000..ec5af8c138 --- /dev/null +++ b/erts/preloaded/src/prim_eval.erl @@ -0,0 +1,28 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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(prim_eval). + +%% This module is simply a stub which abstract code gets included in the result +%% of compilation of prim_eval.S, to keep Dialyzer happy. + +-export(['receive'/2]). + +-spec 'receive'(fun((term()) -> nomatch | T), timeout()) -> T. +'receive'(_, _) -> + erlang:nif_error(stub). diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl index 78968ed405..9abc73c081 100644 --- a/erts/test/z_SUITE.erl +++ b/erts/test/z_SUITE.erl @@ -190,8 +190,13 @@ file_inspect(#core_search_conf{file = File}, Core) -> probably_a_core end. -mk_readable(F) -> - catch file:write_file_info(F, #file_info{mode = 8#00444}). +mk_readable(F) -> + try + {ok, Old} = file:read_file_info(F), + file:write_file_info(F, Old#file_info{mode = 8#00444}) + catch + _:_ -> io:format("Failed to \"chmod\" core file ~p\n", [F]) + end. ignore_core(C) -> filelib:is_regular(filename:join([filename:dirname(C), diff --git a/lib/asn1/src/asn1_db.erl b/lib/asn1/src/asn1_db.erl index 843fc66c9c..e96ca9ae25 100644 --- a/lib/asn1/src/asn1_db.erl +++ b/lib/asn1/src/asn1_db.erl @@ -19,31 +19,22 @@ %% -module(asn1_db). --export([dbstart/1,dbnew/1,dbsave/2,dbload/1,dbput/3,dbget/2,dbget_all/1]). --export([dbget_all_mod/1,dbclear/0,dberase_module/1,dbstop/0]). +-export([dbstart/1,dbnew/1,dbsave/2,dbput/3,dbget/2]). +-export([dbstop/0]). -record(state, {parent, monitor, includes, table}). %% Interface dbstart(Includes) -> Parent = self(), - case get(?MODULE) of - undefined -> - put(?MODULE, spawn_link(fun() -> init(Parent, Includes) end)), - true; - _Pid -> - req({new_includes, Includes}) - end. + undefined = get(?MODULE), %Assertion. + put(?MODULE, spawn_link(fun() -> init(Parent, Includes) end)), + ok. 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}). +dbsave(OutFile, Module) -> cast({save, OutFile, Module}). +dbput(Module, K, V) -> cast({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}). -dbclear() -> req(clear). -dberase_module({module,M}) -> req({delete_mod, M}). dbstop() -> Resp = req(stop), erase(?MODULE), Resp. %% Internal functions @@ -59,8 +50,13 @@ req(Request) -> exit({db_error,Info}) end. +cast(Request) -> + get(?MODULE) ! Request, + ok. + reply({Ref,From}, Response) -> - From ! {{Ref,?MODULE}, Response}. + From ! {{Ref,?MODULE}, Response}, + ok. init(Parent, Includes) -> MRef = erlang:monitor(process, Parent), @@ -70,10 +66,9 @@ init(Parent, Includes) -> loop(#state{parent = Parent, monitor = MRef, table = Table, includes = Includes} = State) -> receive - {From, {set, Mod, K2, V}} -> + {set, Mod, K2, V} -> [{_, Modtab}] = ets:lookup(Table, Mod), ets:insert(Modtab, {K2, V}), - reply(From, ok), loop(State); {From, {get, Mod, K2}} -> Result = case ets:lookup(Table, Mod) of @@ -85,44 +80,16 @@ loop(#state{parent = Parent, monitor = MRef, table = Table, _Error -> reply(From, undefined) end, loop(State); - {From, {all_mod, Mod}} -> - [{_, Modtab}] = ets:lookup(Table, Mod), - reply(From, ets:tab2list(Modtab)), - loop(State); - {From, {delete_mod, Mod}} -> - [{_, Modtab}] = ets:lookup(Table, Mod), - ets:delete(Modtab), - ets:delete(Table, Mod), - reply(From, ok), - loop(State); - {From, {save, OutFile, Mod}} -> + {save, OutFile, Mod} -> [{_,Mtab}] = ets:lookup(Table, Mod), - reply(From, ets:tab2file(Mtab, OutFile)), - loop(State); - {From, {load, Mod}} -> - Result = case ets:lookup(Table, Mod) of - [] -> opentab(Table, Mod, Includes); - [{_, Modtab}] -> {ok, Modtab} - end, - reply(From, Result), + ok = ets:tab2file(Mtab, OutFile), loop(State); {From, {new, Mod}} -> - case ets:lookup(Table, Mod) of - [{_, Modtab}] -> ets:delete(Modtab); - _ -> true - end, + [] = ets:lookup(Table, Mod), %Assertion. ModTableId = ets:new(list_to_atom(lists:concat(["asn1_",Mod])), []), ets:insert(Table, {Mod, ModTableId}), reply(From, ok), loop(State); - {From, clear} -> - [ets:delete(Mt) || {_, Mt} <- ets:tab2list(Table)], - ets:delete(Table), - reply(From, cleared), - loop(State#state{table = ets:new(asn1, [set])}); - {From, {new_includes, NewIncludes}} -> - reply(From, true), - loop(State#state{includes = NewIncludes}); {From, stop} -> reply(From, stopped); %% Nothing to store {'DOWN', MRef, process, Parent, Reason} -> diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl index 16d14c2e7b..396ba0fcfa 100644 --- a/lib/asn1/src/asn1_records.hrl +++ b/lib/asn1/src/asn1_records.hrl @@ -45,9 +45,7 @@ -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, diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 770b92cbc3..8e71a5697c 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -25,21 +25,20 @@ %%-compile(export_all). %% Public exports -export([compile/1, compile/2]). --export([start/0, start/1]). -export([encode/2, encode/3, decode/3]). -export([test/1, test/2, test/3, value/2, value/3]). %% Application internal exports -export([compile_asn/3,compile_asn1/3,compile_py/3,compile/3, vsn/0, 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, +-export([read_config_data/1,get_gen_state_field/1, + partial_inc_dec_toptype/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, + generated_refed_func/1,next_refed_func/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, + maybe_rename_function/3,current_sindex/0, + set_current_sindex/1,maybe_saved_sindex/2, parse_and_save/2,verbose/3,warning/3,warning/4,error/3]). -export([get_bit_string_format/0]). @@ -82,7 +81,6 @@ %% %% - compile(File) -> compile(File,[]). @@ -96,14 +94,30 @@ compile(File, Options0) when is_list(Options0) -> Error end. +-record(st, + {file=[], + files=[], + inputmodules=[], + code, + opts=[], + outfile, + dbfile, + includes=[], + erule, + error=none, + run + }). + compile_proc(File, Includes, Options) -> + Erule = get_rule(Options), + St = #st{opts=Options,includes=Includes,erule=Erule}, case input_file_type(File, Includes) of {single_file, SuffixedFile} -> %% "e.g. "/tmp/File.asn" - compile1(SuffixedFile, Options); + compile1(SuffixedFile, St); {multiple_files_file, SetBase, FileName} -> case get_file_list(FileName, Includes) of FileList when is_list(FileList) -> - compile_set(SetBase, FileList, Options); + compile_set(SetBase, FileList, St); Err -> Err end; @@ -111,22 +125,222 @@ compile_proc(File, Includes, Options) -> {error, Err} end. -compile1(File,Options) when is_list(Options) -> - verbose("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,File],Options), - verbose("Compiler Options: ~p~n",[Options],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), - Continue1 = scan(File,Options), - Continue2 = parse(Continue1,File,Options), - Continue3 = check(Continue2,File,OutFile,Includes,EncodingRule, - DbFile,Options,[]), - Continue4 = generate(Continue3,OutFile,EncodingRule,Options), - compile_erl(Continue4, OutFile, Options). +set_passes() -> + [{pass,scan_parse,fun set_scan_parse_pass/1}, + {pass,merge,fun merge_pass/1}|common_passes()]. + +single_passes() -> + [{pass,scan,fun scan_pass/1}, + {pass,parse,fun parse_pass/1}|common_passes()]. + +parse_and_save_passes() -> + [{pass,scan,fun scan_pass/1}, + {pass,parse,fun parse_pass/1}, + {pass,save,fun save_pass/1}]. + +common_passes() -> + [{pass,check,fun check_pass/1}, + {iff,abs,{pass,abs_listing,fun abs_listing/1}}, + {pass,generate,fun generate_pass/1}, + {unless,noobj,{pass,compile,fun compile_pass/1}}]. + +scan_pass(#st{file=File}=St) -> + case asn1ct_tok:file(File) of + {error,Reason} -> + {error,St#st{error=Reason}}; + Tokens when is_list(Tokens) -> + {ok,St#st{code=Tokens}} + end. + +set_scan_parse_pass(#st{files=Files}=St) -> + try + L = set_scan_parse_pass_1(Files, St), + {ok,St#st{code=L}} + catch + throw:Error -> + {error,St#st{error=Error}} + end. + +set_scan_parse_pass_1([F|Fs], St) -> + case asn1ct_tok:file(F) of + {error,Error} -> + throw(Error); + Tokens when is_list(Tokens) -> + case catch asn1ct_parser2:parse(Tokens) of + {ok,M} -> + [M|set_scan_parse_pass_1(Fs, St)]; + {error,ErrorTerm} -> + throw(handle_parse_error(ErrorTerm, St)) + end + end; +set_scan_parse_pass_1([], _) -> []. + +parse_pass(#st{code=Tokens}=St) -> + case catch asn1ct_parser2:parse(Tokens) of + {ok,M} -> + {ok,St#st{code=M}}; + {error,ErrorTerm} -> + {error,St#st{error=handle_parse_error(ErrorTerm, St)}} + end. + +handle_parse_error(ErrorTerm, #st{file=File,opts=Opts}) -> + case ErrorTerm of + {{Line,_Mod,Message},_TokTup} -> + if + is_integer(Line) -> + BaseName = filename:basename(File), + error("syntax error at line ~p in module ~s:~n", + [Line,BaseName], Opts); + true -> + error("syntax error in module ~p:~n", + [File], Opts) + end, + print_error_message(Message), + Message; + {Line,_Mod,[Message,Token]} -> + error("syntax error: ~p ~p at line ~p~n", + [Message,Token,Line], Opts), + {Line,[Message,Token]} + end. + +merge_pass(#st{file=Base,code=Code}=St) -> + M = merge_modules(Code, Base), + {ok,St#st{code=M}}. + +check_pass(#st{code=M,file=File,includes=Includes, + erule=Erule,dbfile=DbFile,opts=Opts, + inputmodules=InputModules}=St) -> + start(Includes), + case asn1ct_check:storeindb(#state{erule=Erule}, M) of + ok -> + Module = asn1_db:dbget(M#module.name, 'MODULE'), + State = #state{mname=Module#module.name, + module=Module#module{typeorval=[]}, + erule=Erule, + inputmodules=InputModules, + options=Opts, + sourcedir=filename:dirname(File)}, + case asn1ct_check:check(State, Module#module.typeorval) of + {error,Reason} -> + {error,St#st{error=Reason}}; + {ok,NewTypeOrVal,GenTypeOrVal} -> + NewM = Module#module{typeorval=NewTypeOrVal}, + asn1_db:dbput(NewM#module.name, 'MODULE', NewM), + asn1_db:dbsave(DbFile, M#module.name), + verbose("--~p--~n", [{generated,DbFile}], Opts), + {ok,St#st{code={M,GenTypeOrVal}}} + end; + {error,Reason} -> + {error,St#st{error=Reason}} + end. + +save_pass(#st{code=M,erule=Erule,dbfile=DbFile}=St) -> + ok = asn1ct_check:storeindb(#state{erule=Erule}, M), + asn1_db:dbsave(DbFile,M#module.name), + {ok,St}. + +abs_listing(#st{code={M,_},outfile=OutFile}) -> + pretty2(M#module.name, OutFile++".abs"), + done. +generate_pass(#st{code=Code,outfile=OutFile,erule=Erule,opts=Opts}=St0) -> + St = St0#st{code=undefined}, %Reclaim heap space + case generate(Code, OutFile, Erule, Opts) of + {error,Reason} -> + {error,St#st{error=Reason}}; + ok -> + {ok,St} + end. + +compile_pass(#st{outfile=OutFile,opts=Opts0}=St) -> + asn1_db:dbstop(), %Reclaim memory. + asn1ct_table:delete([renamed_defs,original_imports,automatic_tags]), + Opts = remove_asn_flags(Opts0), + case c:c(OutFile, Opts) of + {ok,_Module} -> + {ok,St}; + _ -> + {error,St} + end. + +run_passes(Passes, #st{opts=Opts}=St) -> + Run = case lists:member(time, Opts) of + false -> + fun(_, Pass, S) -> Pass(S) end; + true -> + fun run_tc/3 + end, + run_passes_1(Passes, St#st{run=Run}). + +run_tc(Name, Fun, St) -> + Before0 = statistics(runtime), + Val = (catch Fun(St)), + After0 = statistics(runtime), + {Before_c, _} = Before0, + {After_c, _} = After0, + io:format("~-31s: ~10.2f s\n", + [Name,(After_c-Before_c) / 1000]), + Val. + +run_passes_1([{unless,Opt,Pass}|Passes], #st{opts=Opts}=St) -> + case proplists:get_bool(Opt, Opts) of + false -> + run_passes_1([Pass|Passes], St); + true -> + run_passes_1(Passes, St) + end; +run_passes_1([{iff,Opt,Pass}|Passes], #st{opts=Opts}=St) -> + case proplists:get_bool(Opt, Opts) of + true -> + run_passes_1([Pass|Passes], St); + false -> + run_passes_1(Passes, St) + end; +run_passes_1([{pass,Name,Pass}|Passes], #st{run=Run}=St0) + when is_function(Pass, 1) -> + try Run(Name, Pass, St0) of + {ok,St} -> + run_passes_1(Passes, St); + {error,#st{error=Errors}} -> + {Structured,AllErrors} = clean_errors(Errors), + print_structured_errors(Structured), + {error,AllErrors}; + done -> + ok + catch + Class:Error -> + Stk = erlang:get_stacktrace(), + io:format("Internal error: ~p:~p\n~p\n", + [Class,Error,Stk]), + {error,{internal_error,{Class,Error}}} + end; +run_passes_1([], _St) -> + ok. + +clean_errors(Errors) when is_list(Errors) -> + F = fun({structured_error,_,_,_}) -> true; + (_) -> false + end, + {Structured0,AdHoc} = lists:partition(F, Errors), + Structured = lists:sort(Structured0), + {Structured,Structured ++ AdHoc}; +clean_errors(AdHoc) -> {[],AdHoc}. + +print_structured_errors([_|_]=Errors) -> + _ = [io:format("~ts:~w: ~ts\n", [F,L,M:format_error(E)]) || + {structured_error,{F,L},M,E} <- Errors], + ok; +print_structured_errors(_) -> ok. + +compile1(File, #st{opts=Opts}=St0) -> + verbose("Erlang ASN.1 version ~p, compiling ~p~n", [?vsn,File], Opts), + verbose("Compiler Options: ~p~n", [Opts], Opts), + Passes = single_passes(), + Base = filename:rootname(filename:basename(File)), + OutFile = outfile(Base, "", Opts), + DbFile = outfile(Base, "asn1db", Opts), + St1 = St0#st{file=File,outfile=OutFile,dbfile=DbFile}, + run_passes(Passes, St1). %%****************************************************************************%% %% functions dealing with compiling of several input files to one output file %% @@ -134,53 +348,20 @@ compile1(File,Options) when is_list(Options) -> %% 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 - verbose("Erlang ASN.1 version ~p compiling ~p ~n",[?vsn,Files],Options), - verbose("Compiler Options: ~p~n",[Options],Options), - OutFile = outfile(SetBase,"",Options), - DbFile = outfile(SetBase,"asn1db",Options), - Includes = [I || {i,I} <- Options], - EncodingRule = get_rule(Options), - 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, - 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), - - asn1ct_table:delete([renamed_defs, original_imports, automatic_tags]), - - compile_erl(Continue2, OutFile, Options). +compile_set(SetBase, Files, #st{opts=Opts}=St0) -> + verbose("Erlang ASN.1 version ~p compiling ~p ~n", [?vsn,Files], Opts), + verbose("Compiler Options: ~p~n",[Opts], Opts), + OutFile = outfile(SetBase, "", Opts), + DbFile = outfile(SetBase, "asn1db", Opts), + InputModules = [begin + F1 = filename:basename(F0), + F = filename:rootname(F1), + list_to_atom(F) + end || F0 <- Files], + St = St0#st{file=SetBase,files=Files,outfile=OutFile, + dbfile=DbFile,inputmodules=InputModules}, + Passes = set_passes(), + run_passes(Passes, St). %% 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 @@ -188,8 +369,7 @@ check_set(ParseRes,SetBase,OutFile,Includes,EncRule,DbFile, %% 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), +merge_modules(ModuleList, CommonName) -> NewModuleList = remove_name_collisions(ModuleList), case asn1ct_table:size(renamed_defs) of 0 -> asn1ct_table:delete(renamed_defs); @@ -379,6 +559,8 @@ get_pos_of_def(#pobjectdef{pos=Pos}) -> Pos; get_pos_of_def(#pobjectsetdef{pos=Pos}) -> Pos; +get_pos_of_def(#'Externalvaluereference'{pos=Pos}) -> + Pos; get_pos_of_def(_) -> undefined. @@ -651,123 +833,9 @@ 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} -> - error("~p~n",[Reason],Options), - {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), - error("syntax error at line ~p in module ~s:~n", - [Line,BaseName],Options); - true -> - error("syntax error in module ~p:~n", - [File],Options) - end, - print_error_message(Message), - {false,{error,Message}}; - {error,{Line,_Mod,[Message,Token]}} -> - error("syntax error: ~p ~p at line ~p~n", - [Message,Token,Line],Options), - {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 -> - error("~p~n",[OtherError],Options) - 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), - verbose("--~p--~n",[{generated,DbFile}],Options), - {true,{M,NewM,GenTypeOrVal}} - end; - ErrorList = {error,_} -> - {false,ErrorList} - end; -check({false,M},_,_,_,_,_,_,_) -> - {false,M}. - -generate({true,{M,_Module,GenTOrV}}, OutFile, EncodingRule, Options) -> +generate({M,GenTOrV}, OutFile, EncodingRule, Options) -> debug_on(Options), setup_bit_string_format(Options), put(encoding_options,Options), @@ -796,19 +864,7 @@ generate({true,{M,_Module,GenTOrV}}, OutFile, EncodingRule, Options) -> erase(tlv_format), % used in ber erase(class_default_type),% used in ber asn1ct_table: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}. + Result. setup_bit_string_format(Opts) -> Format = case {lists:member(compact_bit_string, Opts), @@ -836,14 +892,13 @@ get_bit_string_format() -> parse_and_save(Module,S) -> Options = S#state.options, SourceDir = S#state.sourcedir, - Includes = [I || {i,I} <-Options], - - case get_input_file(Module,[SourceDir|Includes]) of + Includes = [I || {i,I} <- Options], + case get_input_file(Module, [SourceDir|Includes]) of %% search for asn1 source {file,SuffixedASN1source} -> case dbfile_uptodate(SuffixedASN1source,Options) of false -> - parse_and_save1(S,SuffixedASN1source,Options,Includes); + parse_and_save1(S, SuffixedASN1source, Options); _ -> ok end; Err -> @@ -851,24 +906,14 @@ parse_and_save(Module,S) -> [lists:concat([Module,".asn1db"])],Options), {error,{asn1,input_file_error,Err}} end. -parse_and_save1(S,File,Options,Includes) -> + +parse_and_save1(#state{erule=Erule}, File, Options) -> 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. + Base = filename:basename(File, Ext), + DbFile = outfile(Base, "asn1db", Options), + St = #st{file=File,dbfile=DbFile,erule=Erule}, + Passes = parse_and_save_passes(), + run_passes(Passes, St). get_input_file(Module,[]) -> Module; @@ -926,13 +971,6 @@ dbfile_uptodate(File,Options) -> 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); @@ -1064,22 +1102,6 @@ translate_options([H|T]) -> [H|translate_options(T)]; translate_options([]) -> []. -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), @@ -1216,7 +1238,6 @@ make_erl_options(Opts) -> 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]), @@ -1251,10 +1272,6 @@ pretty2(Module,AbsFile) -> 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). @@ -2097,52 +2114,6 @@ update_namelist(Name) -> 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 @@ -2382,14 +2353,6 @@ maybe_saved_sindex(Name,Pattern) -> 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). diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 0622998445..f94550b0a4 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -25,7 +25,7 @@ %-compile(export_all). %% Avoid warning for local function error/1 clashing with autoimported BIF. -compile({no_auto_import,[error/1]}). --export([check/2,storeindb/2]). +-export([check/2,storeindb/2,format_error/1]). %-define(debug,1). -include("asn1_records.hrl"). %%% The tag-number for universal types @@ -73,7 +73,6 @@ 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 @@ -92,14 +91,14 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> 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 + _ = checkp(S, ParameterizedTypes), %must do this before the templates are used %% table to save instances of parameterized objects,object sets asn1ct_table:new(parameterized_objects), asn1ct_table:new(inlined_objects), - Terror = checkt(S,Types,[]), + Terror = checkt(S, Types), ?dbg("checkt finished with errors:~n~p~n~n",[Terror]), %% get parameterized object sets sent to checkt/3 @@ -107,7 +106,7 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> {PObjSetNames1,Terror2} = filter_errors(IsPObjSet,Terror), - Verror = checkv(S,Values ++ ObjectSets,[]), %value sets may be parsed as object sets + 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 @@ -116,7 +115,7 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> NewClasses = Classes++AddClasses, - Cerror = checkc(S,NewClasses,[]), + 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 @@ -175,8 +174,9 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> {NewTypes,NewValues,ParameterizedTypes,NewClasses, lists:subtract(NewObjects,ExclO)++InlinedObjects, lists:subtract(NewObjectSets,ExclOS)++ParObjectSetNames}}; - _ ->{error,{asn1,lists:flatten([Terror3,Verror5,Cerror, - Oerror,Exporterror,ImportError])}} + _ -> + {error,lists:flatten([Terror3,Verror5,Cerror, + Oerror,Exporterror,ImportError])} end. context_switch_in_spec() -> @@ -338,51 +338,40 @@ chained_import(S,ImpMod,DefMod,Name) -> 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) +checkt(S0, Names) -> + Check = fun do_checkt/3, + + %% NOTE: check_type/3 will store information in the process + %% dictionary if context switching types are encountered; + %% therefore we must force the evaluation order. + Types = check_fold(S0, Names, Check), + CtxtSwitch = check_contextswitchingtypes(S0, []), + check_fold(S0, lists:reverse(CtxtSwitch), Check) ++ Types. + +do_checkt(S, Name, #typedef{typespec=TypeSpec}=Type0) -> + NewS = S#state{type=Type0,tname=Name}, + try check_type(NewS, Type0, TypeSpec) of + #type{}=Ts -> + case Type0#typedef.checked of + true -> %already checked and updated + ok; + _ -> + Type = Type0#typedef{checked=true, + typespec=Ts}, + asn1_db:dbput(NewS#state.mname, + Name, Type), + ok + end + catch + {error,Reason} -> + error({type,Reason,NewS}); + {asn1_class,_ClassDef} -> + {asn1_class,Name}; + pobjectsetdef -> + {pobjectsetdef,Name}; + pvalueset -> + {pvalueset,Name} end. check_contextswitchingtypes(S,Acc) -> @@ -402,131 +391,86 @@ check_contextswitchingtypes(S,[{T,TName}|Ts],Acc) -> 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). - +checkv(S, Names) -> + check_fold(S, Names, fun do_checkv/3). + +do_checkv(S, Name, 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}, + try check_value(NewS, Value) of + {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 + catch + {error,Reason} -> + error({value,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} + end. +%% Check parameterized types. +checkp(S, Names) -> + check_fold(S, Names, fun do_checkp/3). +do_checkp(S0, Name, #ptypedef{typespec=TypeSpec}=Type0) -> + S = S0#state{type=Type0,tname=Name}, + try check_ptype(S, Type0, TypeSpec) of + #type{}=Ts -> + Type = Type0#ptypedef{checked=true,typespec=Ts}, + asn1_db:dbput(S#state.mname, Name, Type), + ok + catch + {error,Reason} -> + error({type,Reason,S}); + {asn1_class,_ClassDef} -> + {asn1_class,Name}; + {asn1_param_class,_} -> + ok + end. -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 +%% Check class definitions. +checkc(S, Names) -> + check_fold(S, Names, fun do_checkc/3). + +do_checkc(S0, Name, Class0) -> + {Class1,ClassSpec} = + case Class0 of + #classdef{} -> + {Class0,Class0}; + #typedef{} -> + {#classdef{name=Name},Class0#typedef.typespec} 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). + S = S0#state{type=Class0,tname=Name}, + try check_class(S, ClassSpec) of + C -> + Class = Class1#classdef{checked=true,typespec=C}, + asn1_db:dbput(S#state.mname, Name, Class), + ok + catch + {error,Reason} -> + error({class,Reason,S}) + end. checko(S,[Name|Os],Acc,ExclO,ExclOS) -> ?dbg("Checking object ~p~n",[Name]), @@ -695,8 +639,7 @@ check_class_fields(S,[F|Fields],Acc) -> 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') -> + Def when is_record(Def,'Externaltypereference') -> {_,D} = get_referenced_type(S,Def), D; {undefined,user} -> @@ -876,14 +819,6 @@ check_object(S, ?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_',_} -> @@ -1233,8 +1168,7 @@ check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> ObjSet when is_record(ObjSet,type) -> ObjSetDef = case ObjSet#type.def of - Ref when is_record(Ref,typereference); - is_record(Ref,'Externaltypereference') -> + Ref when is_record(Ref,'Externaltypereference') -> {_,D} = get_referenced_type(S,ObjSet#type.def), D; Other -> @@ -1826,10 +1760,6 @@ convert_to_defaultfield(S,ObjFieldName,[OFS|RestOFS],CField)-> 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} = @@ -2140,172 +2070,72 @@ check_value(S,#valuedef{pos=Pos,name=Name,type=Type, 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,_} -> +check_value(S, #valuedef{}=V) -> + ?dbg("check_value, V: ~p~n",[V0]), + case V of + #valuedef{checked=true} -> 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 + #valuedef{checked=false} -> + check_valuedef(S, V) + end. + +check_valuedef(#state{recordtopname=TopName}=S0, V0) -> + #valuedef{name=Name,type=Vtype,value=Value,module=ModName} = V0, + V = V0#valuedef{checked=true}, + Def = Vtype#type.def, + Constr = Vtype#type.constraint, + S1 = S0#state{type=Vtype,tname=Def,value=V0,vname=Name}, + SVal = update_state(S1, ModName), + case Def of + #'Externaltypereference'{type=RecName}=Ext -> + {RefM,Type} = get_referenced_type(S1, Ext), + %% If V isn't a value but an object Type is a #classdef{} + S2 = update_state(S1, RefM), + case Type of + #classdef{} -> + throw({objectdef}); + #typedef{typespec=TypeSpec} -> + S3 = case is_contextswitchtype(Type) of + true -> + S2; + false -> + S2#state{recordtopname=[RecName|TopName]} + end, + #valuedef{value=CheckedVal} = + check_value(S3, V0#valuedef{type=TypeSpec}), + V#valuedef{value=CheckedVal}; + #type{} -> + %% A parameter that couldn't be categorized. + #valuedef{value=CheckedVal} = + check_value(S2#state{recordtopname=[RecName|TopName]}, + V#valuedef{type=Type}), + V#valuedef{value=CheckedVal} + end; + 'ANY' -> + {opentypefieldvalue,ANYType,ANYValue} = Value, + CheckedV = check_value(SVal,#valuedef{name=Name, + type=ANYType, + value=ANYValue, + module=ModName}), + V#valuedef{value=CheckedV#valuedef.value}; + 'INTEGER' -> + ok = validate_integer(SVal, Value, [], Constr), + V#valuedef{value=normalize_value(SVal, Vtype, Value, [])}; + {'INTEGER',NamedNumberList} -> + ok = validate_integer(SVal, Value, NamedNumberList, Constr), + V#valuedef{value=normalize_value(SVal, Vtype, Value, [])}; + #'SEQUENCE'{components=Components} -> + {ok,SeqVal} = validate_sequence(SVal, Value, + Components, Constr), + V#valuedef{value=normalize_value(SVal, Vtype, + SeqVal, TopName)}; + {'SelectionType',SelName,SelT} -> + CheckedT = check_selectiontype(SVal, SelName, SelT), + NewV = V#valuedef{type=CheckedT}, + SelVDef = check_value(S1#state{value=NewV}, NewV), + V#valuedef{value=SelVDef#valuedef.value}; + _ -> + V#valuedef{value=normalize_value(SVal, Vtype, Value, TopName)} end. is_contextswitchtype(#typedef{name='EXTERNAL'})-> @@ -2358,23 +2188,7 @@ validate_integer_ref(S,Ref,NamedNumberList,Constr) -> -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) -> +check_integer_range(_Int, Constr) when is_list(Constr) -> ok. %%------------ @@ -2390,9 +2204,6 @@ is_space_list([],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); @@ -2490,9 +2301,6 @@ validate_oid(_, S, OID, [Atom|Rest],Acc) when is_atom(Atom) -> 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); @@ -2579,43 +2387,6 @@ 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}]} -> @@ -2630,18 +2401,6 @@ validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) -> {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]) -> @@ -2667,7 +2426,8 @@ normalize_value(_,_,mandatory,_) -> mandatory; normalize_value(_,_,'OPTIONAL',_) -> 'OPTIONAL'; -normalize_value(S,Type,{'DEFAULT',Value},NameList) -> +normalize_value(S0, Type, {'DEFAULT',Value}, NameList) -> + S = S0#state{value=Value}, case catch get_canonic_type(S,Type,NameList) of {'BOOLEAN',CType,_} -> normalize_boolean(S,Value,CType); @@ -2892,12 +2652,12 @@ hstring_to_octetlist([H|T],BSL,Acc) when H >= $0; H =< $9 -> hstring_to_octetlist([],_,Acc) -> lists:reverse(Acc). -normalize_objectidentifier(S,Value) -> - {ok,Val}=validate_objectidentifier(S,Value,[]), +normalize_objectidentifier(S, Value) -> + {ok,Val} = validate_objectidentifier(S, o_id, Value, []), Val. normalize_relative_oid(S,Value) -> - {ok,Val} = validate_relative_oid(S,Value,[]), + {ok,Val} = validate_objectidentifier(S, rel_oid, Value, []), Val. normalize_objectdescriptor(Value) -> @@ -2906,29 +2666,20 @@ normalize_objectdescriptor(Value) -> normalize_real(Value) -> Value. -normalize_enumerated(S,#'Externalvaluereference'{value=V},CType) - when is_list(CType) -> - normalize_enumerated2(S,V,CType); -normalize_enumerated(S,Value,CType) when is_atom(Value),is_list(CType) -> - normalize_enumerated2(S,Value,CType); -normalize_enumerated(S,{Name,EnumV},CType) when is_atom(Name) -> - normalize_enumerated(S,EnumV,CType); -normalize_enumerated(S,Value,{CType1,CType2}) when is_list(CType1), is_list(CType2)-> - normalize_enumerated(S,Value,CType1++CType2); -normalize_enumerated(S,V,CType) -> - asn1ct:warning("Enumerated unknown type ~p~n",[CType],S, - "Enumerated unknown type"), - V. -normalize_enumerated2(S,V,Enum) -> - case lists:keysearch(V,1,Enum) of - {value,{Val,_}} -> Val; - _ -> - asn1ct:warning("enumerated value is not correct ~p~n",[V],S, - "enumerated value is not correct"), - V +normalize_enumerated(S, Id, {Base,Ext}) -> + %% Extensible ENUMERATED. + normalize_enumerated(S, Id, Base++Ext); +normalize_enumerated(S, #'Externalvaluereference'{value=Id}, + NamedNumberList) -> + normalize_enumerated(S, Id, NamedNumberList); +normalize_enumerated(S, Id, NamedNumberList) when is_atom(Id) -> + case lists:keymember(Id, 1, NamedNumberList) of + true -> + Id; + false -> + throw(asn1_error(S, S#state.value, {undefined,Id})) 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}} -> @@ -3535,10 +3286,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> 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), @@ -3575,7 +3322,15 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> _ -> MergedTag end, - TempNewDef#newt{type=NewTypeDef,tag=Ct}; + case TopName of + [] when Type#typedef.name =/= undefined -> + %% This is a top-level type. + #type{def=Simplified} = + simplify_type(#type{def=NewTypeDef}), + TempNewDef#newt{type=Simplified,tag=Ct}; + _ -> + TempNewDef#newt{type=NewTypeDef,tag=Ct} + end; {'TypeFromObject',{object,Object},TypeField} -> CheckedT = get_type_from_object(S,Object,TypeField), @@ -3591,29 +3346,14 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> 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)}; + #newt{type=TDef,tag=NewTags,constraint=NewConstr,inlined=Inlined} = NewDef, + Ts#type{def=TDef, + inlined=Inlined, + constraint=check_constraints(S, NewConstr), + tag=lists:map(fun(#tag{type={default,TTx}}=TempTag) -> + TempTag#tag{type=TTx}; + (Other) -> Other + end, NewTags)}; check_type(_S,Type,Ts) -> exit({error,{asn1,internal_error,Type,Ts}}). @@ -3625,6 +3365,28 @@ get_non_typedef(S, Tref0) -> Type end. + +%% +%% Simplify the backends by getting rid of an #'ObjectClassFieldType'{} +%% with a type known at compile time. +%% + +simplify_comps(Comps) -> + [simplify_comp(Comp) || Comp <- Comps]. + +simplify_comp(#'ComponentType'{typespec=Type0}=C) -> + Type = simplify_type(Type0), + C#'ComponentType'{typespec=Type}; +simplify_comp(Other) -> Other. + +simplify_type(#type{tag=Tag,def=Inner}=T) -> + case Inner of + #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}} -> + Type#type{tag=Tag}; + _ -> + T + end. + %% 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 @@ -4003,26 +3765,10 @@ categorize(_S,type,Def) when is_record(Def,type) -> 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 @@ -4048,9 +3794,7 @@ parse_objectset(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, []). + check_constraints(S, C, []). resolv_tuple_or_list(S,List) when is_list(List) -> lists:map(fun(X)->resolv_value(S,X) end, List); @@ -4077,23 +3821,19 @@ resolv_value1(S, ERef = #'Externalvaluereference'{value=Name}) -> resolv_value1(S,VDef) end end; -resolv_value1(S,{gt,V}) -> - case V of +resolv_value1(S, {gt,V}) -> + case resolv_value1(S, V) of Int when is_integer(Int) -> - V + 1; - #valuedef{value=Int} -> - 1 + resolv_value(S,Int); + Int + 1; Other -> - throw({error,{asn1,{undefined_type_or_value,Other}}}) + throw({error,{asn1,{not_integer_value,Other}}}) end; -resolv_value1(S,{lt,V}) -> - case V of +resolv_value1(S, {lt,V}) -> + case resolv_value1(S, V) of Int when is_integer(Int) -> - V - 1; - #valuedef{value=Int} -> - resolv_value(S,Int) - 1; + Int - 1; Other -> - throw({error,{asn1,{undefined_type_or_value,Other}}}) + throw({error,{asn1,{not_integer_value,Other}}}) end; resolv_value1(S,{'ValueFromObject',{object,Object},[{valuefieldreference, FieldName}]}) -> @@ -4356,7 +4096,42 @@ normalize_cs([{'ValueRange',{Sv,Sv}}|Cs]) -> [{'SingleValue',Sv}|normalize_cs(Cs)]; normalize_cs([{'ValueRange',{'MIN','MAX'}}|Cs]) -> normalize_cs(Cs); -normalize_cs(Other) -> Other. +normalize_cs([{'SizeConstraint',C0}|Cs]) -> + case normalize_size_constraint(C0) of + none -> + normalize_cs(Cs); + C -> + [{'SizeConstraint',C}|normalize_cs(Cs)] + end; +normalize_cs([H|T]) -> + [H|normalize_cs(T)]; +normalize_cs([]) -> []. + +%% Normalize a size constraint to make it non-ambiguous and +%% easy to interpret for the backends. +%% +%% Returns one of the following terms: +%% {LowerBound,UpperBound} +%% {{LowerBound,UpperBound},[]} % Extensible +%% none % Remove size constraint from list +%% +%% where: +%% LowerBound = integer() +%% UpperBound = integer() | 'MAX' + +normalize_size_constraint(Sv) when is_integer(Sv) -> + {Sv,Sv}; +normalize_size_constraint({Root,Ext}) when is_list(Ext) -> + {normalize_size_constraint(Root),[]}; +normalize_size_constraint({{_,_},Ext}) when is_integer(Ext) -> + normalize_size_constraint(Ext); +normalize_size_constraint([H|T]) -> + {H,lists:last(T)}; +normalize_size_constraint({0,'MAX'}) -> + none; +normalize_size_constraint({Lb,Ub}=Range) + when is_integer(Lb), is_integer(Ub) orelse Ub =:= 'MAX' -> + Range. is_range(Prev, [H|T]) when Prev =:= H - 1 -> is_range(H, T); is_range(_, [_|_]) -> false; @@ -4925,19 +4700,7 @@ get_referenced(S,Emod,Ename,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; + {Emod,T}; % should add check that T is exported here V -> ?dbg("get_referenced V: ~p~n",[V]), {Emod,V} @@ -5385,14 +5148,14 @@ iof_associated_type1(S,C) -> prop=mandatory, tags=[{'CONTEXT',0}]}], #'SEQUENCE'{tablecinf=TableCInf, - components=IOFComponents}. + components=simplify_comps(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}}) -> +instance_of_constraints(S, [{simpletable,Type}]) -> #type{def=#'Externaltypereference'{type=Name}} = Type, ModuleName = S#state.mname, ObjectSetRef=#'Externaltypereference'{module=ModuleName, @@ -5403,7 +5166,8 @@ instance_of_constraints(S,#constraint{c={simpletable,Type}}) -> [{innermost, [#'Externalvaluereference'{module=ModuleName, value=type}]}]}], - TableCInf=#simpletableattributes{objectsetname=Name, + Mod = S#state.mname, + TableCInf=#simpletableattributes{objectsetname={Mod,Name}, c_name='type-id', c_index=1, usedclassfield=id, @@ -5539,46 +5303,37 @@ check_sequence(S,Type,Comps) -> %% the involved class removed, as the class of the object %% set. CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2), - %% If encoding rule is in the PER family the Root Components - %% after the second extension mark should be encoded before - %% all extensions i.e together with the first Root components NewComps3 = textual_order(CompListWithTblInf), - CompListTuple = - complist_as_tuple(is_erule_per(S#state.erule),NewComps3), + NewComps4 = simplify_comps(NewComps3), + CompListTuple = complist_as_tuple(NewComps4), {CRelInf,CompListTuple}; Dupl -> throw({error,{asn1,{duplicate_components,Dupl}}}) end. -complist_as_tuple(Per,CompList) -> - complist_as_tuple(Per,CompList,[],[],[],root). +complist_as_tuple(CompList) -> + complist_as_tuple(CompList, [], [], [], root). -complist_as_tuple(Per,[#'EXTENSIONMARK'{}|T],Acc,Ext,Acc2,root) -> - complist_as_tuple(Per,T,Acc,Ext,Acc2,ext); -complist_as_tuple(Per,[#'EXTENSIONMARK'{}|T],Acc,Ext,Acc2,ext) -> - complist_as_tuple(Per,T,Acc,Ext,Acc2,root2); -complist_as_tuple(_Per,[#'EXTENSIONMARK'{}|_T],_Acc,_Ext,_Acc2,root2) -> +complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, root) -> + complist_as_tuple(T, Acc, Ext, Acc2, ext); +complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, ext) -> + complist_as_tuple(T, Acc, Ext, Acc2, root2); +complist_as_tuple([#'EXTENSIONMARK'{}|_T], _Acc, _Ext, _Acc2, root2) -> throw({error,{asn1,{too_many_extension_marks}}}); -complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,root) -> - complist_as_tuple(Per,T,[C|Acc],Ext,Acc2,root); -complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,ext) -> - complist_as_tuple(Per,T,Acc,[C|Ext],Acc2,ext); -complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,root2) -> - complist_as_tuple(Per,T,Acc,Ext,[C|Acc2],root2); -complist_as_tuple(_Per,[],Acc,_Ext,_Acc2,root) -> +complist_as_tuple([C|T], Acc, Ext, Acc2, root) -> + complist_as_tuple(T, [C|Acc], Ext, Acc2, root); +complist_as_tuple([C|T], Acc, Ext, Acc2, ext) -> + complist_as_tuple(T, Acc, [C|Ext], Acc2, ext); +complist_as_tuple([C|T], Acc, Ext, Acc2, root2) -> + complist_as_tuple(T, Acc, Ext, [C|Acc2], root2); +complist_as_tuple([], Acc, _Ext, _Acc2, root) -> lists:reverse(Acc); -complist_as_tuple(_Per,[],Acc,Ext,_Acc2,ext) -> +complist_as_tuple([], Acc, Ext, _Acc2, ext) -> {lists:reverse(Acc),lists:reverse(Ext)}; -%%complist_as_tuple(_Per = true,[],Acc,Ext,Acc2,root2) -> -%% {lists:reverse(Acc)++lists:reverse(Acc2),lists:reverse(Ext)}; -complist_as_tuple(_Per,[],Acc,Ext,Acc2,root2) -> +complist_as_tuple([], Acc, Ext, Acc2, root2) -> {lists:reverse(Acc),lists:reverse(Ext),lists:reverse(Acc2)}. -is_erule_per(per) -> true; -is_erule_per(uper) -> true; -is_erule_per(ber) -> false. - 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); @@ -5622,7 +5377,7 @@ take_only_rootset([H|T]) -> [H|take_only_rootset(T)]. check_unique_sequence_tags(S,CompList) -> - TagComps = case complist_as_tuple(false,CompList) of + TagComps = case complist_as_tuple(CompList) of {R1,Ext,R2} -> R1 ++ [C#'ComponentType'{prop='OPTIONAL'}|| C = #'ComponentType'{} <- Ext]++R2; @@ -5657,7 +5412,7 @@ 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). + simplify_type(check_type(S, Type, Component)). check_set(S,Type,Components) -> {TableCInf,NewComponents} = check_sequence(S,Type,Components), @@ -5879,7 +5634,7 @@ extension({Root1,ExtList,Root2}) -> X = #'ComponentType'{prop=Y}<-ExtList], Root2}. check_setof(S,Type,Component) when is_record(Component,type) -> - check_type(S,Type,Component). + simplify_type(check_type(S, Type, Component)). check_selectiontype(S,Name,#type{def=Eref}) when is_record(Eref,'Externaltypereference') -> @@ -5943,8 +5698,9 @@ check_choice(S,Type,Components) when is_list(Components) -> ('ExtensionAdditionGroupEnd') -> false; (_) -> true end,NewComps), - check_unique_tags(S,NewComps2), - complist_as_tuple(is_erule_per(S#state.erule),NewComps2); + NewComps3 = simplify_comps(NewComps2), + check_unique_tags(S, NewComps3), + complist_as_tuple(NewComps3); Dupl -> throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}}) end; @@ -6322,7 +6078,7 @@ get_simple_table_info1(S,#'ComponentType'{typespec=TS},Cnames,Path) -> simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef, class=ObjectClass, fieldname=FieldName},Path) -> - + ObjectClassFieldName = case FieldName of {LastFieldName,[]} -> LastFieldName; @@ -6875,9 +6631,6 @@ get_OCFType(S,Fields,[PrimFieldName|Rest]) -> 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 [] -> @@ -7047,60 +6800,27 @@ storeindb(S,M) when is_record(M,module) -> 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,[]), + Res = storeindb(#state{mname=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 +storeindb(#state{mname=Module}=S, [H|T], Errors) -> + Name = asn1ct:get_name_of_def(H), + 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. + asn1_db:dbput(Module, Name, H), + storeindb(S, T, Errors); + Prev -> + PrevLine = asn1ct:get_pos_of_def(Prev), + {error,Error} = asn1_error(S, H, {already_defined,Name,PrevLine}), + storeindb(S, T, [Error|Errors]) + end; +storeindb(_, [], []) -> + ok; +storeindb(_, [], [_|_]=Errors) -> + {error,Errors}. + findtypes_and_values(TVList) -> findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values, @@ -7140,8 +6860,20 @@ findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) -> {lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc), lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}. - - +asn1_error(#state{mname=Where}, Item, Error) -> + Pos = asn1ct:get_pos_of_def(Item), + {error,{structured_error,{Where,Pos},?MODULE,Error}}. + +format_error({already_defined,Name,PrevLine}) -> + io_lib:format("the name ~p has already been defined at line ~p", + [Name,PrevLine]); +format_error({undefined,Name}) -> + io_lib:format("'~s' is referenced, but is not defined", [Name]); +format_error(Other) -> + io_lib:format("~p", [Other]). + +error({_,{structured_error,_,_,_}=SE,_}) -> + SE; 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]), @@ -7444,3 +7176,13 @@ insert_once(S,Tab,Key) -> _ -> skipped end. + +check_fold(S, [H|T], Check) -> + Type = asn1_db:dbget(S#state.mname, H), + case Check(S, H, Type) of + ok -> + check_fold(S, T, Check); + Error -> + [Error|check_fold(S, T, Check)] + end; +check_fold(_, [], Check) when is_function(Check, 3) -> []. diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index 341a04761b..761faa53c5 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -114,30 +114,16 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> 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]), + {ObjSetMod,ObjSetName} = ObjectSetRef, + OSDef = asn1_db:dbget(ObjSetMod, ObjSetName), 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]), + emit([ObjectEncode," = ",nl, + " ",{asis,ObjSetMod},":'getenc_",ObjSetName, + "'(",{asis,UniqueFieldName},", ",nl]), ValueMatch = value_match(ValueIndex, lists:concat(["Cindex",N])), emit([indent(35),ValueMatch,"),",nl]), @@ -183,7 +169,6 @@ gen_encode_sequence(Erules,Typename,D) when is_record(D,type) -> 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=CList0} = D#type.def, @@ -258,15 +243,9 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> {[{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, + {ObjSetMod,ObjSetName} = ObjSetRef, emit([DecObj," =",nl, - " ",ObjSetMod,":'getdec_",ObjSetName,"'(", + " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(", {asis,UniqueFName},", ",ValueMatch,"),",nl]), gen_dec_postponed_decs(DecObj,PostponedDecArgs) end, @@ -349,7 +328,6 @@ gen_encode_set(Erules,Typename,D) when is_record(D,type) -> 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=TCompList0} = D#type.def, @@ -444,15 +422,9 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> {[{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, + {ObjSetMod,ObjSetName} = ObjSetRef, emit([DecObj," =",nl, - " ",ObjSetMod,":'getdec_",ObjSetName,"'(", + " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(", {asis,UniqueFName},", ",ValueMatch,"),",nl]), gen_dec_postponed_decs(DecObj,PostponedDecArgs) end, @@ -504,7 +476,6 @@ gen_encode_sof(Erules,Typename,_InnerTypename,D) when is_record(D,type) -> 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}; @@ -1002,9 +973,7 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj) {componentrelation,_,_}} -> {_LeadingAttrName,Fun} = EncObj, case RefedFieldName of -%% {notype,T} -> -%% throw({error,{notype,type_from_object,T}}); - {Name,RestFieldNames} when is_atom(Name), Name =/= notype -> + {Name,RestFieldNames} when is_atom(Name) -> case OptOrMand of mandatory -> ok; _ -> @@ -1035,17 +1004,8 @@ gen_enc_line(Erules,TopType,Cname,Type,Element,Indent,OptOrMand,Assign,EncObj) _ -> 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},")"]); + ?ASN1CT_GEN_BER:gen_encode_prim(ber, Type, {asis,Tag}, + Element); 'ASN1_OPEN_TYPE' -> case Type#type.def of #'ObjectClassFieldType'{} -> %Open Type @@ -1266,15 +1226,9 @@ gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand, {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,")"]); + {ObjSetMod,ObjSetName} = OSet, + emit([",",nl,"ObjFun = ",{asis,ObjSetMod},":'getdec_",ObjSetName, + "'(",{asis,UniqueFName},", ",ValueMatch,")"]); _ -> ok end, @@ -1288,9 +1242,6 @@ gen_dec_call1({primitive,bif},InnerType,Erules,TopType,Cname,Type,BytesVar, asn1ct:update_gen_state(namelist,Rest), 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) @@ -1458,9 +1409,7 @@ 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} -> + #'Externaltypereference'{module=XModule,type=Name} -> emit([nl,"%% attribute ",Cname,"(",Pos,") External ",XModule,":",Name]); _ -> emit([nl,"%% attribute ",Cname,"(",Pos,") with type ",InnerType]) diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index aa5ee18c80..efb55cf015 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -143,40 +143,21 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> 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 + {Module,ObjSetName} = ObjectSet, + #typedef{typespec=#'ObjectSet'{gen=Gen}} = + asn1_db:dbget(Module, ObjSetName), + case 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))), - - 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, + El = make_element(N+1, asn1ct_gen:mk_var(asn1ct_name:curr(val))), + ValueMatch = value_match(ValueIndex, El), + emit([ObjectEncode," =",nl, + " ",{asis,Module},":'getenc_",ObjSetName,"'(", + {asis,UniqueFieldName},", ",nl, + " ",ValueMatch,"),",nl]), {AttrN,ObjectEncode}; - _ -> + false -> false end; _ -> @@ -227,7 +208,6 @@ gen_decode_constructed(Erule, Typename, #type{}=D) -> Imm0 = gen_dec_constructed_imm(Erule, Typename, #type{}=D), Imm = opt_imm(Imm0), asn1ct_name:start(), - asn1ct_name:clear(), emit_gen_dec_imm(Imm), emit([".",nl,nl]). @@ -365,14 +345,10 @@ gen_dec_constructed_imm_2(Typename, CompList, {[{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}), + {ObjSetMod,ObjSetName} = ObjSet, + emit([DecObj," =",nl, + " ",{asis,ObjSetMod},":'getdec_",ObjSetName,"'(", + {asis,UniqueFName},", ",ValueMatch,"),",nl]), gen_dec_listofopentypes(DecObj,ListOfOpenTypes,false) end, %% we don't return named lists any more Cnames = mkcnamelist(CompList), @@ -489,7 +465,6 @@ gen_encode_choice(Erule,Typename,D) when is_record(D,type) -> 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_enc(CompList), @@ -504,12 +479,8 @@ 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, + SizeConstraint = asn1ct_imm:effective_constraint(bitstring, + D#type.constraint), ObjFun = case D#type.tablecinf of [{objfun,_}|_R] -> @@ -521,13 +492,7 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) -> 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_encode_sof_components(Erule, Typename, SeqOrSetOf, ComponentType). %% Logic copied from asn1_per_bin_rt2ct:encode_constrained_number @@ -565,7 +530,7 @@ gen_encode_length(per, {Lb,Ub}) when Ub =< 65535, Lb >= 0 -> gen_encode_length(Erules, SizeConstraint) -> emit([nl,indent(3), case SizeConstraint of - undefined -> + no -> {call,Erules,encode_length,["length(Val)"]}; _ -> {call,Erules,encode_length, @@ -576,12 +541,8 @@ gen_encode_length(Erules, SizeConstraint) -> 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, + SizeConstraint = asn1ct_imm:effective_constraint(bitstring, + D#type.constraint), ObjFun = case D#type.tablecinf of [{objfun,_}|_R] -> @@ -593,13 +554,7 @@ gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> emit([",",nl, "'dec_",asn1ct_gen:list2name(Typename), "_components'(",Num,", ",Buf,ObjFun,", []).",nl,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_decode_sof_components(Erules, Typename, SeqOrSetOf, ComponentType). is_aligned(per) -> true; is_aligned(uper) -> false. @@ -629,10 +584,9 @@ gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> Conttype = asn1ct_gen:get_inner(Cont#type.def), Currmod = get(currmod), - Ctgenmod = asn1ct_gen:ct_gen_module(Erule), case asn1ct_gen:type(Conttype) of {primitive,bif} -> - gen_encode_prim_wrapper(Ctgenmod,Erule,Cont,false,"H"); + asn1ct_gen_per:gen_encode_prim(Erule, Cont, "H"); {constructed,bif} -> NewTypename = [Constructed_Suffix|Typename], emit({"'enc_",asn1ct_gen:list2name(NewTypename),"'(H", @@ -642,9 +596,9 @@ gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> #'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"); + asn1ct_gen_per:gen_encode_prim(Erule, + #type{def='ASN1_OPEN_TYPE'}, + "H"); _ -> emit({"'enc_",Conttype,"'(H)",nl,nl}) end, @@ -668,7 +622,6 @@ gen_decode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> Cont#type.def), Conttype = asn1ct_gen:get_inner(Cont#type.def), Ctgenmod = asn1ct_gen:ct_gen_module(Erule), - CurrMod = get(currmod), case asn1ct_gen:type(Conttype) of {primitive,bif} -> Ctgenmod:gen_dec_prim(Erule,Cont,"Bytes"), @@ -677,12 +630,9 @@ gen_decode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> 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}); + #'Externaltypereference'{}=Etype -> + asn1ct_gen_per:gen_dec_external(Etype, "Bytes"), + emit([com,nl]); 'ASN1_OPEN_TYPE' -> Ctgenmod:gen_dec_prim(Erule,#type{def='ASN1_OPEN_TYPE'}, "Bytes"), @@ -1004,7 +954,6 @@ gen_enc_line(Erule,TopType, Cname, Type, [], Pos,DynamicEnc,Ext) -> Element = make_element(Pos+1,asn1ct_gen:mk_var(asn1ct_name:curr(val))), gen_enc_line(Erule,TopType,Cname,Type,Element, Pos,DynamicEnc,Ext); gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> - Ctgenmod = asn1ct_gen:ct_gen_module(Erule), Atype = case Type of #type{def=#'ObjectClassFieldType'{type=InnerType}} -> @@ -1026,8 +975,6 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> 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) -> asn1ct_func:need({Erule,complete,1}), asn1ct_func:need({Erule,encode_open_type,1}), @@ -1057,29 +1004,17 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> #'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); + asn1ct_gen_per:gen_encode_prim(Erule, Type, Element); 'ASN1_OPEN_TYPE' -> case Type#type.def of #'ObjectClassFieldType'{type=OpenType} -> - gen_encode_prim_wrapper(Ctgenmod,Erule, - #type{def=OpenType}, - false,Element); + asn1ct_gen_per:gen_encode_prim(Erule, + #type{def=OpenType}, + Element); _ -> - gen_encode_prim_wrapper(Ctgenmod,Erule,Type, - false,Element) + asn1ct_gen_per:gen_encode_prim(Erule, Type, + Element) end; {constructed,bif} -> NewTypename = [Cname|TopType], @@ -1235,68 +1170,67 @@ gen_dec_comp_call(Comp, Erule, TopType, Tpos, OptTable, DecInfObj, end end end, - - OptOrDef = - case {Ext,Prop} of - {noext,mandatory} -> - ignore; - {noext,_} -> %% OPTIONAL or DEFAULT - OptPos = get_optionality_pos(TextPos, OptTable), - Element = io_lib:format("Opt band (1 bsl ~w)", - [NumberOfOptionals - OptPos]), - fun(St) -> - emit(["case ",Element," of",nl]), - emit([" _Opt",TextPos," when _Opt",TextPos," > 0 ->"]), - St - end; - {{ext,_,_},_} -> %Extension - fun(St) -> - emit(["case Extensions of",nl, - " <<_:",Pos-1,",1:1,_/bitstring>> ->",nl]), - St - end - end, - Lines = gen_dec_line_imm(Erule, TopType, Comp, Tpos, DecInfObj, Ext), - Postamble = - case {Ext,Prop} of - {noext,mandatory} -> - ignore; - {noext,_} -> - fun(St) -> - emit([";",nl,"0 ->"]), - emit(["{"]), - gen_dec_component_no_val(Ext,Prop), - emit({",",{curr,bytes},"}",nl}), - emit([nl,"end"]), - St - end; - _ -> - fun(St) -> - emit([";",nl,"_ ->",nl]), - emit(["{"]), - case Type of - #type{def=#'SEQUENCE'{ - extaddgroup=Number2, - components=ExtGroupCompList2}} - when is_integer(Number2)-> - emit({"{extAddGroup,"}), - gen_dec_extaddGroup_no_val(Ext,ExtGroupCompList2), - emit({"}"}); - _ -> - gen_dec_component_no_val(Ext, Prop) - end, - emit({",",{curr,bytes},"}",nl}), - emit([nl,"end"]), - St - end - end, + {Pre,Post} = comp_call_pre_post(Ext, Prop, Pos, Type, TextPos, + OptTable, NumberOfOptionals, Ext), + Lines = gen_dec_seq_line_imm(Erule, TopType, Comp, Tpos, DecInfObj, Ext), AdvBuffer = {ignore,fun(St) -> asn1ct_name:new(bytes), St end}, - [{group,[{safe,Comment},{safe,Preamble}, - OptOrDef|Lines]++ - [Postamble,{safe,AdvBuffer}]}]. + [{group,[{safe,Comment},{safe,Preamble}] ++ Pre ++ + Lines ++ Post ++ [{safe,AdvBuffer}]}]. + +comp_call_pre_post(noext, mandatory, _, _, _, _, _, _) -> + {[],[]}; +comp_call_pre_post(noext, Prop, _, _, TextPos, OptTable, NumOptionals, Ext) -> + %% OPTIONAL or DEFAULT + OptPos = get_optionality_pos(TextPos, OptTable), + Element = case NumOptionals - OptPos of + 0 -> + "Opt band 1"; + Shift -> + lists:concat(["(Opt bsr ",Shift,") band 1"]) + end, + {[fun(St) -> + emit(["case ",Element," of",nl, + "1 ->",nl]), + St + end], + [fun(St) -> + emit([";",nl, + "0 ->",nl, + "{"]), + gen_dec_component_no_val(Ext, Prop), + emit([",",{curr,bytes},"}",nl, + "end"]), + St + end]}; +comp_call_pre_post({ext,_,_}, Prop, Pos, Type, _, _, _, Ext) -> + %% Extension + {[fun(St) -> + emit(["case Extensions of",nl, + " <<_:",Pos-1,",1:1,_/bitstring>> ->",nl]), + St + end], + [fun(St) -> + emit([";",nl, + "_ ->",nl, + "{"]), + case Type of + #type{def=#'SEQUENCE'{ + extaddgroup=Number2, + components=ExtGroupCompList2}} + when is_integer(Number2)-> + emit("{extAddGroup,"), + gen_dec_extaddGroup_no_val(Ext, ExtGroupCompList2), + emit("}"); + _ -> + gen_dec_component_no_val(Ext, Prop) + end, + emit([",",{curr,bytes},"}",nl, + "end"]), + St + end]}. is_mandatory_predef_tab_c(noext, mandatory, {"got objfun through args","ObjFun"}) -> @@ -1324,13 +1258,17 @@ gen_dec_component_no_val({ext,_,_},mandatory) -> emit({"asn1_NOVALUE"}). -gen_dec_line(Erule, TopType, Comp, Pos, DecInfObj, Ext) -> - Imm0 = gen_dec_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext), +gen_dec_choice_line(Erule, TopType, Comp, Pre) -> + Imm0 = gen_dec_line_imm(Erule, TopType, Comp, false, Pre), Init = {ignore,fun(_) -> {[],[]} end}, Imm = [{group,[Init|Imm0]}], emit_gen_dec_imm(Imm). -gen_dec_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext) -> +gen_dec_seq_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext) -> + Pre = gen_dec_line_open_type(Erule, Ext, Pos), + gen_dec_line_imm(Erule, TopType, Comp, DecInfObj, Pre). + +gen_dec_line_imm(Erule, TopType, Comp, DecInfObj, Pre) -> #'ComponentType'{name=Cname,typespec=Type} = Comp, Atype = case Type of @@ -1339,9 +1277,7 @@ gen_dec_line_imm(Erule, TopType, Comp, Pos, DecInfObj, Ext) -> _ -> asn1ct_gen:get_inner(Type#type.def) end, - - Pre = gen_dec_line_open_type(Erule, Ext, Pos), - Decode = gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj, Ext), + Decode = gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj), Post = fun({SaveBytes,Finish}) -> {AccTerm,AccBytes} = Finish(), @@ -1385,7 +1321,7 @@ gen_dec_line_open_type(_, _, _) -> end}. gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp, - DecInfObj, Ext) -> + DecInfObj) -> #'ComponentType'{name=Cname,typespec=Type,prop=Prop} = Comp, fun({_BytesVar,PrevSt}) -> case DecInfObj of @@ -1417,7 +1353,7 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp, %% objfun though arguments on function %% invocation. if - Ext == noext andalso Prop == mandatory -> + Prop =:= mandatory -> ok; true -> asn1ct_name:new(tmpterm), @@ -1431,7 +1367,7 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp, asn1ct_imm:dec_code_gen(Imm, BytesVar), emit([com,nl]), if - Ext == noext andalso Prop == mandatory -> + Prop =:= mandatory -> emit([{curr,term}," =",nl," "]); true -> emit([" {"]) @@ -1448,7 +1384,7 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp, emit([indent(6),{curr,tmpterm},nl]), emit([indent(2),"end"]), if - Ext == noext andalso Prop == mandatory -> + Prop =:= mandatory -> ok; true -> emit([",",nl,{curr,tmpbytes},"}"]) @@ -1468,7 +1404,7 @@ gen_dec_line_special(Erule, {typefield,_}, _TopType, Comp, end end; gen_dec_line_special(Erule, {objectfield,PrimFieldName1,PFNList}, _TopType, - Comp, _DecInfObj, _Ext) -> + Comp, _DecInfObj) -> fun({_BytesVar,PrevSt}) -> Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)), BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), @@ -1480,7 +1416,7 @@ gen_dec_line_special(Erule, {objectfield,PrimFieldName1,PFNList}, _TopType, Prop}], {SaveBytes,PrevSt} end; -gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj, _Ext) -> +gen_dec_line_special(Erule, Atype, TopType, Comp, DecInfObj) -> case gen_dec_line_other(Erule, Atype, TopType, Comp) of Fun when is_function(Fun, 1) -> fun({BytesVar,PrevSt}) -> @@ -1503,38 +1439,24 @@ gen_dec_line_dec_inf(Comp, DecInfObj) -> {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, + {ObjSetMod,ObjSetName} = OSet, + emit([",",nl, + "ObjFun = ",{asis,ObjSetMod}, ":'getdec_",ObjSetName,"'(", - {asis,UniqueFName},", ",ValueMatch,")"}); + {asis,UniqueFName},", ",ValueMatch,")"]); _ -> ok end. gen_dec_line_other(Erule, Atype, TopType, Comp) -> #'ComponentType'{name=Cname,typespec=Type} = Comp, - CurrMod = get(currmod), case asn1ct_gen:type(Atype) of - #'Externaltypereference'{module=CurrMod,type=EType} -> + #'Externaltypereference'{}=Etype -> fun(BytesVar) -> - emit({"'dec_",EType,"'(",BytesVar,",telltype)"}) - end; - #'Externaltypereference'{module=Mod,type=EType} -> - fun(BytesVar) -> - emit({"'",Mod,"':'dec_",EType,"'(",BytesVar, - ",telltype)"}) + asn1ct_gen_per:gen_dec_external(Etype, BytesVar) end; {primitive,bif} -> - case Atype of - {fixedtypevaluefield,_,Btype} -> - asn1ct_gen_per:gen_dec_imm(Erule, Btype); - _ -> - asn1ct_gen_per:gen_dec_imm(Erule, Type) - end; + asn1ct_gen_per:gen_dec_imm(Erule, Type); 'ASN1_OPEN_TYPE' -> case Type#type.def of #'ObjectClassFieldType'{type=OpenType} -> @@ -1542,14 +1464,6 @@ gen_dec_line_other(Erule, Atype, TopType, Comp) -> _ -> asn1ct_gen_per:gen_dec_imm(Erule, Type) end; - #typereference{val=Dname} -> - fun(BytesVar) -> - emit({"'dec_",Dname,"'(",BytesVar,",telltype)"}) - end; - {notype,_} -> - fun(BytesVar) -> - emit({"'dec_",Atype,"'(",BytesVar,",telltype)"}) - end; {constructed,bif} -> NewTypename = [Cname|TopType], case Type#type.tablecinf of @@ -1605,16 +1519,14 @@ get_name_list([], Acc) -> gen_enc_choice2(Erule,TopType, {L1,L2}, Ext) -> - gen_enc_choice2(Erule,TopType, L1 ++ L2, 0, Ext); -gen_enc_choice2(Erule,TopType, {L1,L2,L3}, Ext) -> - gen_enc_choice2(Erule,TopType, L1 ++ L3 ++ L2, 0, Ext); + gen_enc_choice2(Erule, TopType, L1 ++ L2, 0, [], Ext); +gen_enc_choice2(Erule, TopType, {L1,L2,L3}, Ext) -> + gen_enc_choice2(Erule, TopType, L1 ++ L3 ++ L2, 0, [], Ext); gen_enc_choice2(Erule,TopType, L, Ext) -> - gen_enc_choice2(Erule,TopType, L, 0, 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, +gen_enc_choice2(Erule, TopType, [H|T], Pos, Sep0, Ext) -> + #'ComponentType'{name=Cname,typespec=Type} = H, EncObj = case asn1ct_gen:get_constraint(Type#type.constraint, componentrelation) of @@ -1622,130 +1534,157 @@ when is_record(H1,'ComponentType'), is_record(H2,'ComponentType') -> 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 + _ -> + false end; - _ -> {no_attr,"ObjFun"} + _ -> + {no_attr,"ObjFun"} end, - emit({{asis,H1#'ComponentType'.name}," ->",nl}), + emit([Sep0,{asis,Cname}," ->",nl]), DoExt = case Ext of - {ext,ExtPos,_} when (Pos + 1) < ExtPos -> noext; + {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_enc_line(Erule, TopType, Cname, Type, "element(2, Val)", + Pos+1, EncObj, DoExt), + Sep = [";",nl], + gen_enc_choice2(Erule, TopType, T, Pos+1, Sep, Ext); +gen_enc_choice2(_, _, [], _, _, _) -> ok. + +%% Generate the code for CHOICE. If the CHOICE is extensible, +%% the structure of the generated code is as follows: +%% +%% case Bytes of +%% <<0:1,Bytes1/bitstring>> -> +%% Choice = <Decode INTEGER (0..LastRootChoice) from Bytes1> +%% case Choice of +%% 0 -> <Decode>; +%% : +%% LastRootChoice -> <Decode> +%% end; +%% <<1:1,Bytes1/bitstring>> -> +%% Choice = <Decode normally small number from Bytes1> +%% TmpVal = <Decode open type> +%% case Choice of +%% 0 -> <Decode TmpVal>; +%% : +%% LastExtension -> <Decode TmpVal>; +%% _ -> <Return TmpVal since the type is unknown> +%% end +%% end +%% +%% The return value from the generated function always looks like: +%% {{ChoiceTag,Value},RemainingBuffer} +%% where ChoiceTag will be 'asn1_ExtAlt' for an unknown extension. +%% +%% If the CHOICE is not extensible, the top-level case is omitted +%% and only the code in the first case arm is generated. -gen_dec_choice(Erule,TopType,CompList,{ext,Pos,NumExt}) -> - emit(["{Ext,",{curr,bytes},"} = ", - {call,Erule,getbit,["Bytes"]},com,nl]), +gen_dec_choice(Erule, TopType, CompList, {ext,_,_}=Ext) -> + {RootList,ExtList} = split_complist(CompList), + emit(["case Bytes of",nl]), + case RootList of + [] -> + ok; + [_|_] -> + emit(["<<0:1,Bytes1/bitstring>> ->",nl]), + asn1ct_name:new(bytes), + gen_dec_choice1(Erule, TopType, RootList, noext), + emit([";",nl,nl]) + end, + emit(["<<1:1,Bytes1/bitstring>> ->",nl]), + asn1ct_name:clear(), + asn1ct_name:new(bytes), 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}, - "} = ",{call,Erule,getchoice, - [{prev,bytes},length(CompList),"0"]},com,nl, - "{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,{RootList,ExtList,RootList2},Ext) -> - NewList = RootList ++ RootList2 ++ ExtList, - gen_dec_choice1(Erule,TopType, NewList, Ext); -gen_dec_choice1(Erule,TopType,CompList,{ext,ExtPos,ExtNum}) -> - emit(["{Choice,",{curr,bytes},"} = ", - {call,Erule,getchoice, - [{prev,bytes},length(CompList)-ExtNum,"Ext"]},com,nl]), - emit({"{Cname,{Val,NewBytes}} = case Choice + Ext*",ExtPos-1," of",nl}), - gen_dec_choice2(Erule,TopType,CompList,{ext,ExtPos,ExtNum}), + gen_dec_choice1(Erule, TopType, ExtList, Ext), + emit([nl,"end"]); +gen_dec_choice(Erule, TopType, CompList, noext) -> + gen_dec_choice1(Erule, TopType, CompList, noext). + +split_complist({Root1,Ext,Root2}) -> + {Root1++Root2,Ext}; +split_complist({_,_}=CompList) -> + CompList. + +gen_dec_choice1(Erule, TopType, CompList, noext=Ext) -> + emit_getchoice(Erule, CompList, Ext), + emit(["case Choice of",nl]), + Pre = {safe,fun(St) -> + {asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), + fun() -> St end} + end}, + gen_dec_choice2(Erule, TopType, CompList, Pre), + emit([nl,"end"]); +gen_dec_choice1(Erule, TopType, CompList, {ext,_,_}=Ext) -> + emit_getchoice(Erule, CompList, Ext), Imm = asn1ct_imm:per_dec_open_type(is_aligned(Erule)), + emit(["begin",nl]), BytesVar = asn1ct_gen:mk_var(asn1ct_name:curr(bytes)), - emit([";",nl, - "_ ->",nl]), - {TmpTerm,TmpBuf} = asn1ct_imm:dec_slim_cg(Imm, BytesVar), - emit([com,nl, - "{asn1_ExtAlt,{",TmpTerm,com,TmpBuf,"}}",nl, - "end,",nl,nl, - "{{Cname,Val},NewBytes}"]). - + {Dst,DstBuf} = asn1ct_imm:dec_slim_cg(Imm, BytesVar), + emit([nl, + "end,",nl, + "case Choice of",nl]), + Pre = {safe,fun(St) -> + emit(["{TmpVal,_} = "]), + {Dst, + fun() -> + emit([",",nl, + "{TmpVal,",DstBuf,"}"]), + St + end} + end}, + gen_dec_choice2(Erule, TopType, CompList, Pre), + case CompList of + [] -> ok; + [_|_] -> emit([";",nl]) + end, + emit(["_ ->",nl, + "{{asn1_ExtAlt,",Dst,"},",DstBuf,"}",nl, + "end"]). + +emit_getchoice(Erule, CompList, Ext) -> + Al = is_aligned(Erule), + Imm = case {Ext,CompList} of + {noext,[_]} -> + {value,0}; + {noext,_} -> + asn1ct_imm:per_dec_constrained(0, length(CompList)-1, Al); + {{ext,_,_},_} -> + asn1ct_imm:per_dec_normally_small_number(Al) + end, + emit(["{Choice,",{curr,bytes},"} = ",nl]), + BytesVar = asn1ct_gen:mk_var(asn1ct_name:prev(bytes)), + asn1ct_imm:dec_code_gen(Imm, BytesVar), + emit([com,nl]). gen_dec_choice2(Erule,TopType,L,Ext) -> - gen_dec_choice2(Erule,TopType,L,0,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, +gen_dec_choice2(Erule, TopType, [H0|T], Pos, Sep0, Pre) -> + #'ComponentType'{name=Cname,typespec=Type} = H0, + H = H0#'ComponentType'{prop=mandatory}, + emit([Sep0,Pos," ->",nl]), 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("{Cname,{Val,NewBytes}} = begin\n"), + gen_dec_choice_line(Erule, TopType, H, Pre), + emit([nl, + "end,",nl, + "{{Cname,Val},NewBytes}"]); _ -> - emit({Pos," -> {",{asis,Cname},",",nl}), - wrap_gen_dec_line(Erule,H1,TopType,Cname,Type,Pos+1,false,Ext), - emit("}") + emit("{Val,NewBytes} = begin\n"), + gen_dec_choice_line(Erule, TopType, H, Pre), + emit([nl, + "end,",nl, + "{{",{asis,Cname},",Val},NewBytes}"]) 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. + Sep = [";",nl], + gen_dec_choice2(Erule, TopType, T, Pos+1, Sep, Pre); +gen_dec_choice2(_, _, [], _, _, _) -> ok. 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_elements(I,Val,ExtCnames) -> make_elements(I,Val,ExtCnames,[]). @@ -1816,14 +1755,6 @@ wrap_extensionAdditionGroups([H|T],ExtAddGrpLenPos,Acc,ExtAddGroupDiff,ExtGroupN wrap_extensionAdditionGroups([],_,Acc,_,_) -> lists:reverse(Acc). - -wrap_gen_dec_line(Erule,C,TopType,_Cname,_Type,Pos,DIO,Ext) -> - put(component_type,{true,C}), - gen_dec_line(Erule, TopType, C#'ComponentType'{prop=mandatory}, - Pos, DIO, Ext), - erase(component_type). - - value_match(Index,Value) when is_atom(Value) -> value_match(Index,atom_to_list(Value)); value_match([],Value) -> @@ -1835,9 +1766,5 @@ value_match1(Value,[],Acc,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) -> true; is_optimized(uper) -> false. diff --git a/lib/asn1/src/asn1ct_func.erl b/lib/asn1/src/asn1ct_func.erl index 2d221ca1b9..262bef6862 100644 --- a/lib/asn1/src/asn1ct_func.erl +++ b/lib/asn1/src/asn1ct_func.erl @@ -37,9 +37,13 @@ need(MFA) -> cast({need,MFA}). generate(Fd) -> - req({generate,Fd}), + Used0 = req(get_used), erase(?MODULE), - ok. + Used = sofs:set(Used0, [mfa]), + Code = sofs:relation(asn1ct_rtt:code(), [{mfa,code}]), + Funcs0 = sofs:image(Code, Used), + Funcs = sofs:to_external(Funcs0), + ok = file:write(Fd, Funcs). req(Req) -> gen_server:call(get(?MODULE), Req, infinity). @@ -64,9 +68,8 @@ handle_cast({need,MFA}, #st{used=Used0}=St) -> {noreply,St} end. -handle_call({generate,Fd}, _From, #st{used=Used}=St) -> - generate(Fd, Used), - {stop,normal,ok,St}. +handle_call(get_used, _From, #st{used=Used}=St) -> + {stop,normal,gb_sets:to_list(Used),St}. terminate(_, _) -> ok. @@ -75,14 +78,6 @@ call_args([A|As], Sep) -> [Sep,A|call_args(As, ", ")]; call_args([], _) -> []. -generate(Fd, Used0) -> - Used1 = gb_sets:to_list(Used0), - Used = sofs:set(Used1, [mfa]), - Code = sofs:relation(asn1ct_rtt:code(), [{mfa,code}]), - Funcs0 = sofs:image(Code, Used), - Funcs = sofs:to_external(Funcs0), - io:put_chars(Fd, Funcs). - pull_in_deps(Ws0, Used0) -> case gb_sets:is_empty(Ws0) of true -> diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 76c4182160..9095e145a3 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -21,15 +21,9 @@ -include("asn1_records.hrl"). --export([pgen_exports/3, - pgen_hrl/5, - gen_head/3, - demit/1, +-export([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, @@ -41,7 +35,6 @@ index2suffix/1, get_record_name_prefix/0]). -export([pgen/5, - pgen_module/6, mk_var/1, un_hyphen_var/1]). -export([gen_encode_constructed/4, @@ -75,7 +68,7 @@ pgen_module(OutFile,Erules,Module, HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Options,Indent), asn1ct_name:start(), ErlFile = lists:concat([OutFile,".erl"]), - Fid = fopen(ErlFile,[write]), + Fid = fopen(ErlFile), put(gen_file_out,Fid), asn1ct_func:start_link(), gen_head(Erules,Module,HrlGenerated), @@ -115,8 +108,7 @@ pgen_values(Erules,Module,[H|T]) -> gen_value(Valuedef), pgen_values(Erules,Module,T). -pgen_types(_,_,_,Module,[]) -> - gen_value_match(Module), +pgen_types(_, _, _, _, []) -> true; pgen_types(Rtmod,Erules,N2nConvEnums,Module,[H|T]) -> asn1ct_name:clear(), @@ -580,22 +572,6 @@ gen_types(Erules,Tname,Type) when is_record(Type,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); @@ -1131,7 +1107,7 @@ pgen_info() -> open_hrl(OutFile,Module) -> File = lists:concat([OutFile,".hrl"]), - Fid = fopen(File,[write]), + Fid = fopen(File), put(gen_file_out,Fid), gen_hrlhead(Module). @@ -1146,80 +1122,67 @@ demit(Term) -> end. % always generation +emit(Term) -> + ok = file:write(get(gen_file_out), do_emit(Term)). -emit({external,_M,T}) -> - emit(T); +do_emit({external,_M,T}) -> + do_emit(T); -emit({prev,Variable}) when is_atom(Variable) -> - emit({var,asn1ct_name:prev(Variable)}); +do_emit({prev,Variable}) when is_atom(Variable) -> + do_emit({var,asn1ct_name:prev(Variable)}); -emit({next,Variable}) when is_atom(Variable) -> - emit({var,asn1ct_name:next(Variable)}); +do_emit({next,Variable}) when is_atom(Variable) -> + do_emit({var,asn1ct_name:next(Variable)}); -emit({curr,Variable}) when is_atom(Variable) -> - emit({var,asn1ct_name:curr(Variable)}); +do_emit({curr,Variable}) when is_atom(Variable) -> + do_emit({var,asn1ct_name:curr(Variable)}); -emit({var,Variable}) when is_atom(Variable) -> +do_emit({var,Variable}) when is_atom(Variable) -> [Head|V] = atom_to_list(Variable), - emit([Head-32|V]); + [Head-32|V]; -emit({var,Variable}) -> +do_emit({var,Variable}) -> [Head|V] = Variable, - emit([Head-32|V]); - -emit({asis,What}) -> - format(get(gen_file_out),"~w",[What]); - -emit({call,M,F,A}) -> - asn1ct_func:call(M, F, A); - -emit(nl) -> - nl(get(gen_file_out)); - -emit(com) -> - emit(","); + [Head-32|V]; -emit(tab) -> - put_chars(get(gen_file_out)," "); +do_emit({asis,What}) -> + io_lib:format("~w", [What]); -emit(What) when is_integer(What) -> - put_chars(get(gen_file_out),integer_to_list(What)); +do_emit({call,M,F,A}) -> + MFA = {M,F,length(A)}, + asn1ct_func:need(MFA), + [atom_to_list(F),"(",call_args(A, "")|")"]; -emit(What) when is_list(What), is_integer(hd(What)) -> - put_chars(get(gen_file_out),What); +do_emit(nl) -> + "\n"; -emit(What) when is_atom(What) -> - put_chars(get(gen_file_out),atom_to_list(What)); +do_emit(com) -> + ","; -emit(What) when is_tuple(What) -> - emit_parts(tuple_to_list(What)); +do_emit(tab) -> + " "; -emit(What) when is_list(What) -> - emit_parts(What); +do_emit(What) when is_integer(What) -> + integer_to_list(What); -emit(X) -> - exit({'cant emit ',X}). +do_emit(What) when is_list(What), is_integer(hd(What)) -> + What; -emit_parts([]) -> true; -emit_parts([H|T]) -> - emit(H), - emit_parts(T). +do_emit(What) when is_atom(What) -> + atom_to_list(What); -format(undefined,X,Y) -> - io:format(X,Y); -format(X,Y,Z) -> - io:format(X,Y,Z). +do_emit(What) when is_tuple(What) -> + [do_emit(E) || E <- tuple_to_list(What)]; -nl(undefined) -> io:nl(); -nl(X) -> io:nl(X). +do_emit(What) when is_list(What) -> + [do_emit(E) || E <- What]. -put_chars(undefined,X) -> - io:put_chars(X); -put_chars(Y,X) -> - io:put_chars(Y,X). +call_args([A|As], Sep) -> + [Sep,do_emit(A)|call_args(As, ", ")]; +call_args([], _) -> []. -fopen(F, ModeList) -> - case file:open(F, ModeList) of +fopen(F) -> + case file:open(F, [write,raw,delayed_write]) of {ok, Fd} -> Fd; {error, Reason} -> @@ -1671,7 +1634,6 @@ unify_if_string(PrimType) -> 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) -> @@ -1704,8 +1666,6 @@ get_inner(T) when is_tuple(T) -> 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) -> @@ -1713,15 +1673,6 @@ type({fixedtypevaluefield,_Name,Type}) when is_record(Type,type) -> 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}; @@ -1740,7 +1691,6 @@ prim_bif(X) -> 'REAL', 'OBJECT IDENTIFIER', 'RELATIVE-OID', - 'ANY', 'NULL', 'BIT STRING' , 'OCTET STRING' , @@ -1784,15 +1734,6 @@ def_to_tag(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) -> @@ -1808,34 +1749,6 @@ get_fieldtype([Field|Rest],FieldName) -> 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 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1902,7 +1815,7 @@ index2suffix(N) -> ct_gen_module(ber) -> asn1ct_gen_ber_bin_v2; ct_gen_module(per) -> - asn1ct_gen_per_rt2ct; + asn1ct_gen_per; ct_gen_module(uper) -> asn1ct_gen_per. diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index de0adef2b2..8ab49aec2c 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -24,9 +24,7 @@ -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]). @@ -59,18 +57,6 @@ -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). - - %%=============================================================================== %%=============================================================================== %%=============================================================================== @@ -83,8 +69,8 @@ pgen(OutFile,Erules,Module,TypeOrVal) -> %% encode #{typedef, {pos, name, typespec}} %%=============================================================================== -gen_encode(Erules,Type) when is_record(Type,typedef) -> - gen_encode_user(Erules,Type). +gen_encode(Erules, #typedef{}=D) -> + gen_encode_user(Erules, #typedef{}=D, true). %%=============================================================================== %% encode #{type, {tag, def, constraint}} @@ -134,20 +120,28 @@ gen_encode(Erules,Tname,#'ComponentType'{name=Cname,typespec=Type}) -> NewType = Type#type{tag=[]}, gen_encode(Erules,NewTname,NewType). -gen_encode_user(Erules,D) when is_record(D,typedef) -> +gen_encode_user(Erules, #typedef{}=D, Wrapper) -> 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]), - emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val, TagIn) ->",nl}), + FuncName = "'enc_" ++ asn1ct_gen:list2name(Typename) ++ "'", + case Wrapper of + true -> + %% This is a top-level type. Generate an 'enc_Type'/1 + %% wrapper. + OTag = Type#type.tag, + Tag0 = [encode_tag_val(decode_class(Class), Form, Number) || + #tag{class=Class,form=Form,number=Number} <- OTag], + Tag = lists:reverse(Tag0), + emit([FuncName,"(Val) ->",nl, + " ",FuncName,"(Val, ",{asis,Tag},").",nl,nl]); + false -> + ok + end, + emit([FuncName,"(Val, TagIn) ->",nl]), CurrentMod = get(currmod), case asn1ct_gen:type(InnerType) of {constructed,bif} -> @@ -155,8 +149,6 @@ gen_encode_user(Erules,D) when is_record(D,typedef) -> {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} -> @@ -169,8 +161,8 @@ gen_encode_user(Erules,D) when is_record(D,typedef) -> emit([".",nl]) end. -gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> - BitStringConstraint = D#type.constraint, +gen_encode_prim(_Erules, #type{}=D, DoTag, Value) -> + BitStringConstraint = get_size_constraint(D#type.constraint), asn1ct_name:new(enumval), Type = case D#type.def of 'OCTET STRING' -> restricted_string; @@ -184,6 +176,8 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> 'GeneralString' -> restricted_string; 'PrintableString' -> restricted_string; 'IA5String' -> restricted_string; + 'UTCTime' -> restricted_string; + 'GeneralizedTime' -> restricted_string; Other -> Other end, case Type of @@ -208,8 +202,6 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> call(encode_bit_string, [{asis,BitStringConstraint},Value, {asis,NamedNumberList},DoTag]); - 'ANY' -> - call(encode_open_type, [Value,DoTag]); 'NULL' -> call(encode_null, [Value,DoTag]); 'OBJECT IDENTIFIER' -> @@ -222,19 +214,8 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> call(encode_UTF8_string, [Value,DoTag]); 'BMPString' -> call(encode_BMP_string, [Value,DoTag]); - 'UTCTime' -> - call(encode_utc_time, [Value,DoTag]); - 'GeneralizedTime' -> - call(encode_generalized_time, [Value,DoTag]); 'ASN1_OPEN_TYPE' -> - call(encode_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' -> - call(encode_open_type, [Value,DoTag]) - end + call(encode_open_type, [Value,DoTag]) end. emit_enc_enumerated_cases({L1,L2}, Tags) -> @@ -470,32 +451,18 @@ gen_decode_user(Erules,D) when is_record(D,typedef) -> end. -gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> +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, + Constraint = get_size_constraint(Att#type.constraint), + IntConstr = int_constr(Att#type.constraint), AsBin = case get(binary_strings) of true -> "_as_bin"; _ -> "" end, NewTypeName = case Typename of - 'ANY' -> 'ASN1_OPEN_TYPE'; 'OCTET STRING' -> restricted_string; 'NumericString' -> restricted_string; 'TeletexString' -> restricted_string; @@ -506,6 +473,9 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> 'GeneralString' -> restricted_string; 'PrintableString' -> restricted_string; 'IA5String' -> restricted_string; + 'ObjectDescriptor'-> restricted_string; + 'UTCTime' -> restricted_string; + 'GeneralizedTime' -> restricted_string; _ -> Typename end, case NewTypeName of @@ -513,14 +483,27 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> emit(["decode_boolean(",BytesVar,","]), need(decode_boolean, 2); 'INTEGER' -> - emit(["decode_integer(",BytesVar,",", - {asis,int_constr(SingleValue,ValueRange)},","]), - need(decode_integer, 3); + case IntConstr of + [] -> + emit(["decode_integer(",BytesVar,","]), + need(decode_integer, 2); + {_,_} -> + emit(["decode_integer(",BytesVar,",", + {asis,IntConstr},","]), + need(decode_integer, 3) + end; {'INTEGER',NamedNumberList} -> - emit(["decode_integer(",BytesVar,",", - {asis,int_constr(SingleValue,ValueRange)},",", - {asis,NamedNumberList},","]), - need(decode_integer, 4); + case IntConstr of + [] -> + emit(["decode_named_integer(",BytesVar,",", + {asis,NamedNumberList},","]), + need(decode_named_integer, 3); + {_,_} -> + emit(["decode_named_integer(",BytesVar,",", + {asis,IntConstr},",", + {asis,NamedNumberList},","]), + need(decode_named_integer, 4) + end; {'ENUMERATED',NamedNumberList} -> emit(["decode_enumerated(",BytesVar,",", {asis,NamedNumberList},","]), @@ -538,10 +521,6 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> 'RELATIVE-OID' -> emit(["decode_relative_oid(",BytesVar,","]), need(decode_relative_oid, 2); - 'ObjectDescriptor' -> - emit(["decode_restricted_string(", - BytesVar,",",{asis,Constraint},","]), - need(decode_restricted_string, 3); restricted_string -> emit(["decode_restricted_string",AsBin,"(",BytesVar,","]), case Constraint of @@ -563,31 +542,10 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> emit(["decode_BMP_string",AsBin,"(", BytesVar,",",{asis,Constraint},","]), need(decode_BMP_string, 3); - 'UTCTime' -> - emit(["decode_utc_time",AsBin,"(", - BytesVar,",",{asis,Constraint},","]), - need(decode_utc_time, 3); - 'GeneralizedTime' -> - emit(["decode_generalized_time",AsBin,"(", - BytesVar,",",{asis,Constraint},","]), - need(decode_generalized_time, 3); 'ASN1_OPEN_TYPE' -> emit(["decode_open_type_as_binary(", BytesVar,","]), - need(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(["decode_open_type_as_binary(", - BytesVar,","]), - need(decode_open_type_as_binary, 2); - Other -> - exit({'cannot decode',Other}) - end; - Other -> - exit({'cannot decode',Other}) + need(decode_open_type_as_binary, 2) end, TagStr = case DoTag of @@ -604,25 +562,27 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> {call,ber,match_tags,[BytesVar,TagStr]},com,nl, {call,real_common,decode_real,[{curr,tmpbuf}]},nl, "end",nl]); - #'ObjectClassFieldType'{} -> - case asn1ct_gen:get_inner(Att#type.def) of - 'ASN1_OPEN_TYPE' -> - emit([TagStr,")"]); - _ -> ok - end; _ -> emit([TagStr,")"]) end. - -int_constr([],[]) -> - []; -int_constr([],ValueRange) -> - ValueRange; -int_constr(SingleValue,[]) -> - SingleValue; -int_constr(SV,VR) -> - [SV,VR]. +%% Simplify an integer constraint so that we can efficiently test it. +-spec int_constr(term()) -> [] | {integer(),integer()|'MAX'}. +int_constr(C) -> + case asn1ct_imm:effective_constraint(integer, C) of + [{_,[]}] -> + %% Extension - ignore constraint. + []; + [{'ValueRange',{'MIN',_}}] -> + %% Tricky to implement efficiently - ignore it. + []; + [{'ValueRange',{_,_}=Range}] -> + Range; + [{'SingleValue',Sv}] -> + {Sv,Sv}; + [] -> + [] + end. gen_dec_bit_string(BytesVar, _Constraint, [_|_]=NNL, TagStr) -> call(decode_named_bit_string, @@ -664,9 +624,7 @@ gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) -> 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. + emit_tlv_format_function(). gen_encode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], ObjName,ObjectFields,ConstrAcc) -> @@ -757,7 +715,7 @@ gen_encode_objectfields(_,[],_,_,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) + false -> gen_encode_user(Erules, TypeDef, false) end, gen_encode_constr_type(Erules,Rest); gen_encode_constr_type(_,[]) -> @@ -815,8 +773,8 @@ gen_encode_default_call(ClassName,FieldName,Type) -> 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)"]), + emit([" 'enc_",ClassName,'_',FieldName,"'", + "(Val, ",{asis,Tag},")"]), [#typedef{name=list_to_atom(lists:concat([ClassName,'_',FieldName])), typespec=Type}]; {primitive,bif} -> @@ -964,7 +922,10 @@ 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) + emit([nl,nl, + "'dec_",TypeDef#typedef.name, + "'(Tlv, TagIn) ->",nl]), + gen_decode_user(Erules, TypeDef) end, gen_decode_constr_type(Erules,Rest); gen_decode_constr_type(_,[]) -> @@ -1108,54 +1069,29 @@ 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, +gen_objset_enc(Erules, ObjSetName, UniqueName, + [{ObjName,Val,Fields}|T], ClName, ClFields, NthObj,Acc)-> - emit({"'getenc_",ObjSName,"'(",{asis,UniqueName},",",{asis,Val}, - ") ->",nl}), + emit(["'getenc_",ObjSetName,"'(",{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; + emit({";",nl}), + gen_objset_enc(Erules, ObjSetName, UniqueName, T, ClName, ClFields, + NewNthObj, InternalFunc ++ Acc); %% See X.681 Annex E for the following case gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, _ClFields,_NthObj,Acc) -> @@ -1167,7 +1103,9 @@ gen_objset_enc(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, emit({indent(6),"{Val,Len}",nl}), emit({indent(3),"end.",nl,nl}), Acc; -gen_objset_enc(_,_,_,[],_,_,_,Acc) -> +gen_objset_enc(_, ObjSetName, UniqueName, [], _, _, _, Acc) -> + emit_default_getenc(ObjSetName, UniqueName), + emit({".",nl,nl}), Acc. emit_ext_fun(EncDec,ModuleName,Name) -> @@ -1181,78 +1119,34 @@ emit_default_getenc(ObjSetName,UniqueName) -> %% 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, [{typefield,_,_}|_]=T, ObjSetName, NthObj) -> + emit([indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl, + indent(6),"case Type of",nl]), + gen_inlined_enc_funs1(Fields, T, ObjSetName, [], NthObj, []); 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) -> +gen_inlined_enc_funs1(Fields, [{typefield,Name,_}|Rest], ObjSetName, + Sep0, NthObj, Acc0) -> + emit(Sep0), + Sep = [";",nl], 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}), + {Acc,NAdd} = + case lists:keyfind(Name,1,Fields) of + {_,#type{}=Type} -> + {Ret,N} = emit_inner_of_fun(Type,InternalDefFunName), + {Ret++Acc0,N}; + {_,#typedef{}=Type} -> + emit([indent(9),{asis,Name}," ->",nl]), + {Ret,N} = emit_inner_of_fun(Type, InternalDefFunName), + {Ret++Acc0,N}; + {_,#'Externaltypereference'{module=M,type=T}} -> + emit([indent(9),{asis,Name}," ->",nl]), if - M == CurrMod -> + M =:= CurrMod -> emit([indent(12),"'enc_",T,"'(Val)"]); true -> #typedef{typespec=Type} = asn1_db:dbget(M,T), @@ -1260,27 +1154,30 @@ gen_inlined_enc_funs1(Fields,[{typefield,Name,_}|Rest],ObjSetName, 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},")"]) + emit([indent(12),"'",M,"':'enc_",T,"'(Val, ", + {asis,Tag},")"]) end, - {Acc,0}; + {Acc0,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) -> byte_size(Bin);",nl, - indent(15),"_ -> length(Val)",nl,indent(12),"end,",nl, + emit([indent(9),{asis,Name}," ->",nl, + indent(12),"Len = case Val of",nl, + indent(15),"Bin when is_binary(Bin) -> " + "byte_size(Bin);",nl, + indent(15),"_ -> length(Val)",nl, + indent(12),"end,",nl, indent(12),"{Val,Len}"]), - {Acc,0} + {Acc0,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"}), + gen_inlined_enc_funs1(Fields, Rest, ObjSetName, Sep, NthObj+NAdd, Acc); +gen_inlined_enc_funs1(Fields,[_|Rest], ObjSetName, Sep, NthObj, Acc)-> + gen_inlined_enc_funs1(Fields, Rest, ObjSetName, Sep, NthObj, Acc); +gen_inlined_enc_funs1(_, [], _, _, NthObj, Acc) -> + emit([nl,indent(6),"end",nl, + indent(3),"end"]), {Acc,NthObj}. emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type}, @@ -1319,10 +1216,6 @@ emit_inner_of_fun(Type,_) when is_record(Type,type) -> 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)"]); @@ -1345,8 +1238,8 @@ 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)-> +gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], + ClName, ClFields, NthObj)-> emit(["'getdec_",ObjSName,"'(",{asis,UniqueName},",", {asis,Val},") ->",nl]), CurrMod = get(currmod), @@ -1359,35 +1252,14 @@ gen_objset_dec(Erules,ObjSName,UniqueName,[{ObjName,Val,Fields},T|Rest], 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, ObjSName, UniqueName, T, ClName, + ClFields, NewNthObj); gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, _ClFields,_NthObj) -> emit(["'getdec_",ObjSetName,"'(_, _) ->",nl]), @@ -1401,86 +1273,41 @@ gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, indent(4),"end",nl]), emit([indent(2),"end.",nl,nl]), ok; -gen_objset_dec(_,_,_,[],_,_,_) -> +gen_objset_dec(_, ObjSetName, UniqueName, [], _, _, _) -> + emit_default_getdec(ObjSetName, UniqueName), + emit([".",nl,nl]), 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) -> byte_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_funs(Fields, ClFields, ObjSetName, NthObj) -> + emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",nl, + indent(6),"case Type of",nl]), + gen_inlined_dec_funs1(Fields, ClFields, ObjSetName, "", NthObj). -gen_inlined_dec_funs1(Fields,[{typefield,Name,Prop}|Rest], - ObjSetName,NthObj) -> +gen_inlined_dec_funs1(Fields, [{typefield,Name,Prop}|Rest], + ObjSetName, Sep0, NthObj) -> + emit(Sep0), + Sep = [";",nl], 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]), + N = case lists:keyfind(Name, 1, Fields) of + {_,#type{}=Type} -> emit_inner_of_decfun(Type,DecProp,InternalDefFunName); - {value,{_,Type}} when is_record(Type,typedef) -> - emit([";",nl,indent(9),{asis,Name}," ->",nl]), + {_,#typedef{}=Type} -> + emit([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]), + {_,#'Externaltypereference'{module=M,type=T}} -> + emit([indent(9),{asis,Name}," ->",nl]), + CurrMod = get(currmod), if - M == CurrMod -> + M =:= CurrMod -> emit([indent(12),"'dec_",T,"'(Bytes)"]); true -> #typedef{typespec=Type} = asn1_db:dbget(M,T), @@ -1491,21 +1318,20 @@ gen_inlined_dec_funs1(Fields,[{typefield,Name,Prop}|Rest], end, 0; false -> - emit([";",nl, - indent(9),{asis,Name}," ->",nl, + emit([indent(9),{asis,Name}," ->",nl, indent(12),"Len = case Bytes of",nl, - indent(15),"B when is_binary(B) -> size(B);",nl, + indent(15),"B when is_binary(B) -> byte_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"]), + gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj+N); +gen_inlined_dec_funs1(Fields, [_|Rest], ObjSetName, Sep, NthObj)-> + gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj); +gen_inlined_dec_funs1(_, [], _, _, NthObj) -> + emit([nl,indent(6),"end",nl, + indent(3),"end"]), NthObj. emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type},Prop, @@ -1561,10 +1387,9 @@ emit_inner_of_decfun(Type,Prop,_) when is_record(Type,type) -> 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_encode_user(Erules, TypeDef, false), + emit([nl,nl, + "'dec_",TypeDef#typedef.name,"'(Tlv, TagIn) ->",nl]), gen_decode_user(Erules,TypeDef), gen_internal_funcs(Erules,Rest). @@ -1615,46 +1440,23 @@ 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} -> +mkfuncname(#'Externaltypereference'{module=Mod,type=EType}, DecOrEnc) -> + CurrMod = get(currmod), + case CurrMod of + Mod -> lists:concat(["'",DecOrEnc,"_",EType,"'"]); - 'ASN1_OPEN_TYPE' -> - lists:concat(["'",DecOrEnc,"_",WhatKind,"'"]) - + _ -> + lists:concat(["'",Mod,"':'",DecOrEnc,"_",EType,"'"]) end. -get_constraint(C,Key) -> - case lists:keysearch(Key,1,C) of - false -> - no; - {value,{_,V}} -> - V +get_size_constraint(C) -> + case lists:keyfind('SizeConstraint', 1, C) of + false -> []; + {_,{_,[]}} -> []; %Extensible. + {_,{Sv,Sv}} -> Sv; + {_,{_,_}=Tc} -> Tc end. - get_class_fields(#classdef{typespec=ObjClass}) -> ObjClass#objectclass.fields; get_class_fields(#objectclass{fields=Fields}) -> diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index fac233532b..30c9ab9365 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -26,28 +26,16 @@ %-compile(export_all). -export([gen_dec_imm/2]). --export([pgen/4,gen_dec_prim/3,gen_encode_prim/4]). +-export([gen_dec_prim/3,gen_encode_prim/3]). -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]). +-export([gen_dec_external/2]). -export([extaddgroup2sequence/1]). -import(asn1ct_gen, [emit/1,demit/1]). -import(asn1ct_func, [call/3]). -%% 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 @@ -96,36 +84,44 @@ gen_encode_user(Erules,D) when is_record(D,typedef) -> emit({"'enc_",asn1ct_gen:list2name(Typename),"'(Val) ->",nl}), case asn1ct_gen:type(InnerType) of {primitive,bif} -> - gen_encode_prim(Erules,Def,"false"), + gen_encode_prim(Erules, Def), emit({".",nl}); 'ASN1_OPEN_TYPE' -> - gen_encode_prim(Erules,Def#type{def='ASN1_OPEN_TYPE'},"false"), + gen_encode_prim(Erules, Def#type{def='ASN1_OPEN_TYPE'}), 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}) + emit({"'",Emod,"':'enc_",Etype,"'(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) -> +gen_encode_prim(Erules, D) -> + Value = asn1ct_gen:mk_var(asn1ct_name:curr(val)), + gen_encode_prim(Erules, D, Value). + +gen_encode_prim(Erules, #type{def={'ENUMERATED',{N1,N2}}}, Value) -> + NewList = [{0,X} || {X,_} <- N1] ++ ['EXT_MARK'] ++ + [{1,X} || {X,_} <- N2], + NewC = {0,length(N1)-1}, + emit(["case ",Value," of",nl]), + emit_enc_enumerated_cases(Erules, NewC, NewList, 0); +gen_encode_prim(Erules, #type{def={'ENUMERATED',NNL}}, Value) -> + NewList = [X || {X,_} <- NNL], + NewC = {0,length(NewList)-1}, + emit(["case ",Value," of",nl]), + emit_enc_enumerated_cases(Erules, NewC, NewList, 0); +gen_encode_prim(per=Erules, D, Value) -> + asn1ct_gen_per_rt2ct:gen_encode_prim(Erules, D, Value); +gen_encode_prim(Erules, #type{}=D, Value) -> Constraint = D#type.constraint, - asn1ct_name:new(enumval), + SizeConstr = asn1ct_imm:effective_constraint(bitstring, Constraint), + Pa = case lists:keyfind('PermittedAlphabet', 1, Constraint) of + false -> no; + {_,Pa0} -> Pa0 + end, case D#type.def of 'INTEGER' -> Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)}, @@ -135,23 +131,10 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> Args = [{asis,asn1ct_imm:effective_constraint(integer,Constraint)}, Value,{asis,NamedNumberList}], call(Erules, encode_integer, Args); - {'ENUMERATED',{Nlist1,Nlist2}} -> - NewList = [{0,X} || {X,_} <- Nlist1] ++ ['EXT_MARK'] ++ - [{1,X} || {X,_} <- Nlist2], - NewC = {0,length(Nlist1)-1}, - emit(["case ",Value," of",nl]), - emit_enc_enumerated_cases(Erules, NewC, NewList, 0); - {'ENUMERATED',NamedNumberList} -> - NewList = [X || {X,_} <- NamedNumberList], - NewC = {0,length(NewList)-1}, - emit(["case ",Value," of",nl]), - emit_enc_enumerated_cases(Erules, NewC, NewList, 0); - 'REAL' -> emit_enc_real(Erules, Value); {'BIT STRING',NamedNumberList} -> - SizeConstr = get_constraint(Constraint, 'SizeConstraint'), call(Erules, encode_bit_string, [{asis,SizeConstr},Value, {asis,NamedNumberList}]); @@ -167,7 +150,7 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> 'BOOLEAN' -> call(Erules, encode_boolean, [Value]); 'OCTET STRING' -> - case get_constraint(Constraint, 'SizeConstraint') of + case SizeConstr of 0 -> emit("[]"); no -> @@ -176,34 +159,40 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> call(Erules, encode_octet_string, [{asis,C},Value]) end; 'NumericString' -> - call(Erules, encode_NumericString, [{asis,Constraint},Value]); + call(Erules, encode_NumericString, [{asis,SizeConstr}, + {asis,Pa},Value]); TString when TString == 'TeletexString'; TString == 'T61String' -> call(Erules, encode_TeletexString, [{asis,Constraint},Value]); 'VideotexString' -> call(Erules, encode_VideotexString, [{asis,Constraint},Value]); 'UTCTime' -> - call(Erules, encode_VisibleString, [{asis,Constraint},Value]); + call(Erules, encode_VisibleString, [{asis,SizeConstr}, + {asis,Pa},Value]); 'GeneralizedTime' -> - call(Erules, encode_VisibleString, [{asis,Constraint},Value]); + call(Erules, encode_VisibleString, [{asis,SizeConstr}, + {asis,Pa},Value]); 'GraphicString' -> call(Erules, encode_GraphicString, [{asis,Constraint},Value]); 'VisibleString' -> - call(Erules, encode_VisibleString, [{asis,Constraint},Value]); + call(Erules, encode_VisibleString, [{asis,SizeConstr}, + {asis,Pa},Value]); 'GeneralString' -> call(Erules, encode_GeneralString, [{asis,Constraint},Value]); 'PrintableString' -> - call(Erules, encode_PrintableString, [{asis,Constraint},Value]); + call(Erules, encode_PrintableString, [{asis,SizeConstr}, + {asis,Pa},Value]); 'IA5String' -> - call(Erules, encode_IA5String, [{asis,Constraint},Value]); + call(Erules, encode_IA5String, [{asis,SizeConstr}, + {asis,Pa},Value]); 'BMPString' -> - call(Erules, encode_BMPString, [{asis,Constraint},Value]); + call(Erules, encode_BMPString, [{asis,SizeConstr}, + {asis,Pa},Value]); 'UniversalString' -> - call(Erules, encode_UniversalString, [{asis,Constraint},Value]); + call(Erules, encode_UniversalString, [{asis,SizeConstr}, + {asis,Pa},Value]); 'UTF8String' -> call(Erules, encode_UTF8String, [Value]); - 'ANY' -> - call(Erules, encode_open_type, [Value]); 'ASN1_OPEN_TYPE' -> NewValue = case Constraint of [#'Externaltypereference'{type=Tname}] -> @@ -215,18 +204,11 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> io_lib:format( "complete(enc_~s(~s))", [Tname,Value]); - _ -> Value + _ -> + io_lib:format("iolist_to_binary(~s)", + [Value]) end, - call(Erules, encode_open_type, [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}) + call(Erules, encode_open_type, [NewValue]) end. emit_enc_real(Erules, Real) -> @@ -271,16 +253,6 @@ enc_ext_and_val(uper, E, F, Args) -> <<E:1,(apply(asn1ct_eval_uper, F, Args))/bitstring>>. -get_constraint([{Key,V}], Key) -> - V; -get_constraint([], _) -> - no; -get_constraint(C, Key) -> - case lists:keyfind(Key, 1, C) of - false -> no; - {Key,V} -> V - end. - %% Object code generating for encoding and decoding %% ------------------------------------------------ @@ -301,17 +273,16 @@ gen_obj_code(Erules,_Module,Obj) when is_record(Obj,typedef) -> gen_encode_constr_type(Erules,EncConstructed), emit(nl), DecConstructed = - gen_decode_objectfields(ClassName,get_class_fields(Class), - ObjName,Fields,[]), + gen_decode_objectfields(Erules, 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. + emit(nl). -gen_encode_objectfields(Erule,ClassName,[{typefield,Name,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> +gen_encode_objectfields(Erule, ClassName, + [{typefield,Name,OptOrMand}|Rest], + ObjName, ObjectFields, ConstrAcc) -> EmitFuncClause = fun(V) -> emit(["'enc_",ObjName,"'(",{asis,Name}, @@ -329,18 +300,24 @@ gen_encode_objectfields(Erule,ClassName,[{typefield,Name,OptOrMand}|Rest], case Erule of uper -> emit(" Val"); - _ -> - emit(" [{octets,Val}]") + per -> + emit([" if",nl, + " is_list(Val) ->",nl, + " NewVal = list_to_binary(Val),",nl, + " [20,byte_size(NewVal),NewVal];",nl, + " is_binary(Val) ->",nl, + " [20,byte_size(Val),Val]",nl, + " end"]) end, []; {false,{'DEFAULT',DefaultType}} -> EmitFuncClause("Val"), - gen_encode_default_call(ClassName,Name,DefaultType); + gen_encode_default_call(Erule, 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) + gen_encode_field_call(Erule, ObjName, Name, TypeSpec) end, case more_genfields(Rest) of true -> @@ -416,7 +393,7 @@ gen_encode_constr_type(Erules,[TypeDef|Rest]) when is_record(TypeDef,typedef) -> gen_encode_constr_type(_,[]) -> ok. -gen_encode_field_call(_ObjName,_FieldName, +gen_encode_field_call(_Erules, _ObjName, _FieldName, #'Externaltypereference'{module=M,type=T}) -> CurrentMod = get(currmod), if @@ -427,12 +404,11 @@ gen_encode_field_call(_ObjName,_FieldName, emit({" '",M,"':'enc_",T,"'(Val)"}), [] end; -gen_encode_field_call(ObjName,FieldName,Type) -> +gen_encode_field_call(Erules, ObjName, FieldName, Type) -> Def = Type#typedef.typespec, case Type#typedef.name of {primitive,bif} -> - gen_encode_prim(uper,Def,"false", - "Val"), + gen_encode_prim(Erules, Def, "Val"), []; {constructed,bif} -> emit({" 'enc_",ObjName,'_',FieldName, @@ -448,7 +424,7 @@ gen_encode_field_call(ObjName,FieldName,Type) -> [] end. -gen_encode_default_call(ClassName,FieldName,Type) -> +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 @@ -459,7 +435,7 @@ gen_encode_default_call(ClassName,FieldName,Type) -> [#typedef{name=[FieldName,ClassName], typespec=Type}]; {primitive,bif} -> - gen_encode_prim(per,Type,"false","Val"), + gen_encode_prim(Erules, Type, "Val"), []; #'Externaltypereference'{module=CurrentMod,type=Etype} -> emit([" 'enc_",Etype,"'(Val)",nl]), @@ -470,8 +446,9 @@ gen_encode_default_call(ClassName,FieldName,Type) -> end. -gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> +gen_decode_objectfields(Erules, ClassName, + [{typefield,Name,OptOrMand}|Rest], + ObjName, ObjectFields, ConstrAcc) -> EmitFuncClause = fun(Bytes) -> emit(["'dec_",ObjName,"'(",{asis,Name},",",Bytes, @@ -488,12 +465,13 @@ gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], []; {false,{'DEFAULT',DefaultType}} -> EmitFuncClause("Bytes"), - gen_decode_default_call(ClassName,Name,"Bytes",DefaultType); + gen_decode_default_call(Erules, 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) + gen_decode_field_call(Erules, ObjName, Name, "Bytes", TypeSpec) end, case more_genfields(Rest) of true -> @@ -501,9 +479,11 @@ gen_decode_objectfields(ClassName,[{typefield,Name,OptOrMand}|Rest], false -> emit([".",nl]) end, - gen_decode_objectfields(ClassName,Rest,ObjName,ObjectFields,MaybeConstr++ConstrAcc); -gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], - ObjName,ObjectFields,ConstrAcc) -> + gen_decode_objectfields(Erules, ClassName, Rest, ObjName, + ObjectFields, MaybeConstr++ConstrAcc); +gen_decode_objectfields(Erules, ClassName, + [{objectfield,Name,_,_,OptOrMand}|Rest], + ObjName, ObjectFields, ConstrAcc) -> CurrentMod = get(currmod), EmitFuncClause = fun(Attrs) -> @@ -546,30 +526,25 @@ gen_decode_objectfields(ClassName,[{objectfield,Name,_,_,OptOrMand}|Rest], 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) -> + gen_decode_objectfields(Erules, ClassName, Rest, ObjName, + ObjectFields, ConstrAcc); +gen_decode_objectfields(Erules, CN, [_C|Cs], O, OF, CAcc) -> + gen_decode_objectfields(Erules, 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) -> +gen_decode_field_call(_Erules, _ObjName, _FieldName, Bytes, + #'Externaltypereference'{}=Etype) -> + emit(" "), + gen_dec_external(Etype, Bytes), + []; +gen_decode_field_call(Erules, ObjName, FieldName, Bytes, Type) -> Def = Type#typedef.typespec, case Type#typedef.name of {primitive,bif} -> - gen_dec_prim(uper, Def, Bytes), + gen_dec_prim(Erules, Def, Bytes), []; {constructed,bif} -> emit({" 'dec_",ObjName,'_',FieldName, @@ -585,8 +560,7 @@ gen_decode_field_call(ObjName,FieldName,Bytes,Type) -> [] end. -gen_decode_default_call(ClassName,FieldName,Bytes,Type) -> - CurrentMod = get(currmod), +gen_decode_default_call(Erules, ClassName, FieldName, Bytes, Type) -> InnerType = asn1ct_gen:get_inner(Type#type.def), case asn1ct_gen:type(InnerType) of {constructed,bif} -> @@ -595,13 +569,10 @@ gen_decode_default_call(ClassName,FieldName,Bytes,Type) -> [#typedef{name=[FieldName,ClassName], typespec=Type}]; {primitive,bif} -> - gen_dec_prim(per,Type,Bytes), + gen_dec_prim(Erules, 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]), + #'Externaltypereference'{}=Etype -> + asn1ct_gen_per:gen_dec_external(Etype, Bytes), [] end. @@ -657,7 +628,7 @@ 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_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 @@ -665,67 +636,56 @@ 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}), +gen_objset_enc(Erule, ObjSetName, UniqueName, [{ObjName,Val,Fields}|T], + ClName, ClFields, NthObj, Acc)-> + emit(["'getenc_",ObjSetName,"'(",{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); + gen_inlined_enc_funs(Erule, Fields, ClFields, + ObjSetName, 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) -> + gen_objset_enc(Erule, ObjSetName, UniqueName, T, ClName, ClFields, + NewNthObj, InternalFunc ++ Acc); +gen_objset_enc(uper, ObjSetName, _UniqueName, ['EXTENSIONMARK'], + _ClName, _ClFields, _NthObj, Acc) -> emit({"'getenc_",ObjSetName,"'(_, _) ->",nl}), emit({indent(3),"fun(_, Val, _) ->",nl}), - case Erule of - uper -> - emit([indent(6),"Val",nl]); - _ -> - emit([indent(6),"[{octets,Val}]",nl]) - end, - emit({indent(3),"end.",nl,nl}), + emit([indent(6),"Val",nl, + indent(3),"end.",nl,nl]), + Acc; +gen_objset_enc(per, ObjSetName, _UniqueName, ['EXTENSIONMARK'], + _ClName, _ClFields, _NthObj, Acc) -> + emit(["'getenc_",ObjSetName,"'(_, _) ->",nl, + indent(3),"fun(_, Val, _) ->",nl, + indent(6),"BinVal = if",nl, + indent(9),"is_list(Val) -> list_to_binary(Val);",nl, + indent(9),"true -> Val",nl, + indent(6),"end,",nl, + indent(6),"Size = byte_size(BinVal),",nl, + indent(6),"if",nl, + indent(9),"Size < 256 ->",nl, + indent(12),"[20,Size,BinVal];",nl, + indent(9),"true ->",nl, + indent(12),"[21,<<Size:16>>,Val]",nl, + indent(6),"end",nl, + indent(3),"end.",nl,nl]), Acc; -gen_objset_enc(_,_,_,[],_,_,_,Acc) -> +gen_objset_enc(_, ObjSetName, UniqueName, [], _, _, _, Acc) -> + emit_default_getenc(ObjSetName, UniqueName), + emit([".",nl,nl]), Acc. emit_ext_encfun(ModuleName,Name) -> @@ -740,97 +700,70 @@ emit_default_getenc(ObjSetName,UniqueName) -> %% 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 -> - 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, [{typefield,_,_}|_]=T, + ObjSetName, NthObj) -> + emit([indent(3),"fun(Type, Val, _) ->",nl, + indent(6),"case Type of",nl]), + gen_inlined_enc_funs1(Erule, Fields, T, ObjSetName, [], NthObj, []); 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) -> +gen_inlined_enc_funs1(Erule, Fields, [{typefield,Name,_}|Rest], ObjSetName, + Sep0, NthObj, Acc0) -> + emit(Sep0), + Sep = [";",nl], 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}; + {Acc,NAdd} = + case lists:keyfind(Name, 1, Fields) of + {_,#type{}=Type} -> + {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName), + {Ret++Acc0,N}; + {_,#typedef{}=Type} -> + emit([indent(9),{asis,Name}," ->",nl]), + {Ret,N} = emit_inner_of_fun(Erule, Type, InternalDefFunName), + {Ret++Acc0,N}; + {_,#'Externaltypereference'{module=CurrentMod,type=T}} -> + emit([indent(9),{asis,Name}," ->",nl, + indent(12),"'enc_",T,"'(Val)"]), + {Acc0,0}; + {_,#'Externaltypereference'{module=M,type=T}} -> + emit([indent(9),{asis,Name}," ->",nl, + indent(12),"'",M,"'",":'enc_",T,"'(Val)"]), + {Acc0,0}; false when Erule =:= uper -> - emit([";",nl, - indent(9),{asis,Name}," -> ",nl, - "Val",nl]), - {Acc,0}; - false -> - emit([";",nl, - indent(9),{asis,Name}," -> ",nl, - "[{octets,Val}]",nl]), - {Acc,0} + emit([indent(9),{asis,Name}," ->",nl, + indent(12),"Val",nl]), + {Acc0,0}; + false when Erule =:= per -> + emit([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"]), + {Acc0,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"}), + gen_inlined_enc_funs1(Erule, Fields, Rest, ObjSetName, Sep, + NthObj+NAdd, Acc); +gen_inlined_enc_funs1(Erule, Fields, [_|T], ObjSetName, Sep, NthObj, Acc)-> + gen_inlined_enc_funs1(Erule, Fields, T, ObjSetName, Sep, NthObj, Acc); +gen_inlined_enc_funs1(_, _, [], _, _, NthObj, Acc) -> + emit([nl,indent(6),"end",nl, + indent(3),"end"]), {Acc,NthObj}. -emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type}, +emit_inner_of_fun(Erule, #typedef{name={ExtMod,Name},typespec=Type}=TDef, InternalDefFunName) -> case {ExtMod,Name} of {primitive,bif} -> emit(indent(12)), - gen_encode_prim(uper,Type,dotag,"Val"), + gen_encode_prim(Erule, Type, "Val"), {[],0}; {constructed,bif} -> emit([indent(12),"'enc_", @@ -840,18 +773,15 @@ emit_inner_of_fun(TDef=#typedef{name={ExtMod,Name},typespec=Type}, emit({indent(12),"'",ExtMod,"':'enc_",Name,"'(Val)"}), {[],0} end; -emit_inner_of_fun(#typedef{name=Name},_) -> +emit_inner_of_fun(_Erule, #typedef{name=Name}, _) -> emit({indent(12),"'enc_",Name,"'(Val)"}), {[],0}; -emit_inner_of_fun(Type,_) when is_record(Type,type) -> +emit_inner_of_fun(Erule, #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)"}); + gen_encode_prim(Erule, Type, "Val"); #'Externaltypereference'{module=CurrMod,type=T} -> emit({indent(9),T," ->",nl,indent(12),"'enc_",T,"'(Val)"}); #'Externaltypereference'{module=ExtMod,type=T} -> @@ -864,62 +794,42 @@ indent(N) -> lists:duplicate(N,32). % 32 = space -gen_objset_dec(_,{unique,undefined},_,_,_,_) -> +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)-> - +gen_objset_dec(Erule, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], 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); + gen_inlined_dec_funs(Erule, 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) -> + gen_objset_dec(Erule, ObjSName, UniqueName, T, ClName, ClFields, NewNthObj); +gen_objset_dec(_Erule, ObjSetName, _UniqueName, ['EXTENSIONMARK'], + _ClName, _ClFields, _NthObj) -> emit({"'getdec_",ObjSetName,"'(_, _) ->",nl}), emit({indent(3),"fun(Attr1, Bytes, _,_) ->",nl}), emit({indent(6),"{Bytes,Attr1}",nl}), emit({indent(3),"end.",nl,nl}), ok; -gen_objset_dec(_,_,[],_,_,_) -> +gen_objset_dec(_Erule, ObjSetName, UniqueName, [], _, _, _) -> + emit_default_getdec(ObjSetName, UniqueName), + emit([".",nl,nl]), ok. emit_ext_decfun(ModuleName,Name) -> @@ -931,49 +841,46 @@ emit_default_getdec(ObjSetName,UniqueName) -> emit([indent(2), "fun(C,V,_,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},",ErrV}}) end"]). -gen_inlined_dec_funs(Fields, List, ObjSetName, NthObj0) -> +gen_inlined_dec_funs(Erule, Fields, List, ObjSetName, NthObj0) -> emit([indent(3),"fun(Type, Val, _, _) ->",nl, indent(6),"case Type of",nl]), - NthObj = gen_inlined_dec_funs1(Fields, List, ObjSetName, "", NthObj0), + NthObj = gen_inlined_dec_funs1(Erule, Fields, List, + ObjSetName, "", NthObj0), emit([nl,indent(6),"end",nl, indent(3),"end"]), NthObj. -gen_inlined_dec_funs1(Fields, [{typefield,Name,_}|Rest], +gen_inlined_dec_funs1(Erule, Fields, [{typefield,Name,_}|Rest], ObjSetName, Sep0, NthObj) -> - CurrentMod = get(currmod), InternalDefFunName = [NthObj,Name,ObjSetName], emit(Sep0), Sep = [";",nl], N = case lists:keyfind(Name, 1, Fields) of {_,#type{}=Type} -> - emit_inner_of_decfun(Type, InternalDefFunName); + emit_inner_of_decfun(Erule, Type, InternalDefFunName); {_,#typedef{}=Type} -> emit([indent(9),{asis,Name}," ->",nl]), - emit_inner_of_decfun(Type, InternalDefFunName); - {_,#'Externaltypereference'{module=CurrentMod,type=T}} -> + emit_inner_of_decfun(Erule, Type, InternalDefFunName); + {_,#'Externaltypereference'{}=Etype} -> emit([indent(9),{asis,Name}," ->",nl, - indent(12),"'dec_",T,"'(Val,telltype)"]), - 0; - {_,#'Externaltypereference'{module=M,type=T}} -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"'",M,"':'dec_",T,"'(Val,telltype)"]), + indent(12)]), + gen_dec_external(Etype, "Val"), 0; false -> emit([indent(9),{asis,Name}," -> {Val,Type}"]), 0 end, - gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj+N); -gen_inlined_dec_funs1(Fields, [_|Rest], ObjSetName, Sep, NthObj) -> - gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj); -gen_inlined_dec_funs1(_, [], _, _, NthObj) -> NthObj. + gen_inlined_dec_funs1(Erule, Fields, Rest, ObjSetName, Sep, NthObj+N); +gen_inlined_dec_funs1(Erule, Fields, [_|Rest], ObjSetName, Sep, NthObj) -> + gen_inlined_dec_funs1(Erule, Fields, Rest, ObjSetName, Sep, NthObj); +gen_inlined_dec_funs1(_, _, [], _, _, NthObj) -> NthObj. -emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type}, +emit_inner_of_decfun(Erule, #typedef{name={ExtName,Name},typespec=Type}, InternalDefFunName) -> case {ExtName,Name} of {primitive,bif} -> emit(indent(12)), - gen_dec_prim(uper, Type, "Val"), + gen_dec_prim(Erule, Type, "Val"), 0; {constructed,bif} -> emit({indent(12),"'dec_", @@ -983,18 +890,15 @@ emit_inner_of_decfun(#typedef{name={ExtName,Name},typespec=Type}, emit({indent(12),"'",ExtName,"':'dec_",Name,"'(Val, telltype)"}), 0 end; -emit_inner_of_decfun(#typedef{name=Name},_) -> +emit_inner_of_decfun(_Erule, #typedef{name=Name}, _) -> emit({indent(12),"'dec_",Name,"'(Val, telltype)"}), 0; -emit_inner_of_decfun(Type,_) when is_record(Type,type) -> +emit_inner_of_decfun(Erule, #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(uper, Type, "Val"); - TRef when is_record(TRef,typereference) -> - T = TRef#typereference.val, - emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); + gen_dec_prim(Erule, Type, "Val"); #'Externaltypereference'{module=CurrMod,type=T} -> emit({indent(9),T," ->",nl,indent(12),"'dec_",T,"'(Val)"}); #'Externaltypereference'{module=ExtMod,type=T} -> @@ -1017,7 +921,6 @@ gen_internal_funcs(Erules,[TypeDef|Rest]) -> %% DECODING ***************************** %%*************************************** - gen_decode(Erules,Type) when is_record(Type,typedef) -> D = Type, emit({nl,nl}), @@ -1054,7 +957,6 @@ 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), @@ -1067,17 +969,21 @@ gen_decode_user(Erules,D) when is_record(D,typedef) -> 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}); + #'Externaltypereference'{}=Etype -> + gen_dec_external(Etype, "Bytes"), + emit([".",nl,nl]); Other -> exit({error,{asn1,{unknown,Other}}}) end. +gen_dec_external(Ext, BytesVar) -> + CurrMod = get(currmod), + #'Externaltypereference'{module=Mod,type=Type} = Ext, + emit([case CurrMod of + Mod -> []; + _ -> ["'",Mod,"':"] + end,"'dec_",Type,"'(",BytesVar,",telltype)"]). + gen_dec_imm(Erule, #type{def=Name,constraint=C}) -> Aligned = case Erule of uper -> false; @@ -1087,10 +993,8 @@ gen_dec_imm(Erule, #type{def=Name,constraint=C}) -> gen_dec_imm_1('ASN1_OPEN_TYPE', Constraint, Aligned) -> imm_decode_open_type(Constraint, Aligned); -gen_dec_imm_1('ANY', _Constraint, Aligned) -> - imm_decode_open_type([], Aligned); gen_dec_imm_1({'BIT STRING',NNL}, Constr0, Aligned) -> - Constr = get_constraint(Constr0, 'SizeConstraint'), + Constr = asn1ct_imm:effective_constraint(bitstring, Constr0), Imm = asn1ct_imm:per_dec_raw_bitstring(Constr, Aligned), case NNL of [] -> @@ -1143,7 +1047,7 @@ gen_dec_imm_1('UTCTime', Constraint, Aligned) -> gen_dec_imm_1('GeneralizedTime', Constraint, Aligned) -> gen_dec_k_m_string('VisibleString', Constraint, Aligned); gen_dec_imm_1('OCTET STRING', Constraint, Aligned) -> - SzConstr = get_constraint(Constraint, 'SizeConstraint'), + SzConstr = asn1ct_imm:effective_constraint(bitstring, Constraint), Imm = asn1ct_imm:per_dec_octet_string(SzConstr, Aligned), {convert,binary_to_list,Imm}; gen_dec_imm_1('TeletexString', _Constraint, Aligned) -> @@ -1173,14 +1077,7 @@ gen_dec_imm_1('RELATIVE-OID', _Constraint, Aligned) -> gen_dec_imm_1('UTF8String', _Constraint, Aligned) -> asn1ct_imm:per_dec_restricted_string(Aligned); gen_dec_imm_1('REAL', _Constraint, Aligned) -> - asn1ct_imm:per_dec_real(Aligned); -gen_dec_imm_1(#'ObjectClassFieldType'{}=TypeName, _Constraint, Aligned) -> - case asn1ct_gen:get_inner(TypeName) of - {fixedtypevaluefield,_,#type{def=InnerType,constraint=C}} -> - gen_dec_imm_1(InnerType, C, Aligned); - #type{def=T,constraint=C} -> - gen_dec_imm_1(T, C, Aligned) - end. + asn1ct_imm:per_dec_real(Aligned). gen_dec_bit_string(F, Imm) -> D = fun(V, Buf) -> diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index 81d8cdcae6..012d54e7a1 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -19,105 +19,16 @@ %% -module(asn1ct_gen_per_rt2ct). -%% Generate erlang module which handles (PER) encode and decode for -%% all types in an ASN.1 module +%% Handle encoding of primitives for aligned PER. -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([extaddgroup2sequence/1]). +-export([gen_encode_prim/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]). -import(asn1ct_func, [call/3]). -%% 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} -> - 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), - 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) -> +gen_encode_prim(Erules, #type{}=D, Value) -> Constraint = D#type.constraint, case D#type.def of 'INTEGER' -> @@ -131,8 +42,6 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> emit([" %%INTEGER with effective constraint: ", {asis,EffectiveConstr},nl]), emit_enc_integer_NNL(Erules,EffectiveConstr,Value,NamedNumberList); - {'ENUMERATED',_} -> - asn1ct_gen_per:gen_encode_prim(Erules, D, DoTag, Value); 'REAL' -> emit_enc_real(Erules, Value); @@ -191,8 +100,6 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> emit_enc_known_multiplier_string('UniversalString',Constraint,Value); 'UTF8String' -> call(Erules, encode_UTF8String, [Value]); - 'ANY' -> - call(Erules, encode_open_type, [Value]); 'ASN1_OPEN_TYPE' -> NewValue = case Constraint of [#'Externaltypereference'{type=Tname}] -> @@ -204,18 +111,11 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> io_lib:format( "complete(enc_~s(~s))", [Tname,Value]); - _ -> Value + _ -> + io_lib:format("iolist_to_binary(~s)", + [Value]) end, - call(Erules, encode_open_type, [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}) + call(Erules, encode_open_type, [NewValue]) end. emit_enc_real(Erules, Real) -> @@ -230,11 +130,7 @@ emit_enc_real(Erules, Real) -> "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, + SizeC = effective_constraint(bitstring, C), PAlphabC = get_constraint(C,'PermittedAlphabet'), case {StringType,PAlphabC} of {'UniversalString',{_,_}} -> @@ -359,7 +255,7 @@ charbits1(NumOfChars) -> %% copied from run time module emit_enc_octet_string(Erules, Constraint, Value) -> - case get_constraint(Constraint,'SizeConstraint') of + case effective_constraint(bitstring, Constraint) of 0 -> emit({" []"}); 1 -> @@ -408,7 +304,7 @@ emit_enc_octet_string(Erules, Constraint, Value) -> " end"]); C -> call(Erules, encode_octet_string, - [{asis,C},false,Value]) + [{asis,C},Value]) end. emit_enc_integer_case(Value) -> @@ -563,825 +459,3 @@ 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,byte_size(NewVal),NewVal];",nl, - " is_binary(Val) ->",nl, - " [20,byte_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 = byte_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),"{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, List, ObjSetName, NthObj0) -> - emit([indent(3),"fun(Type, Val, _, _) ->",nl, - indent(6),"case Type of",nl]), - NthObj = gen_inlined_dec_funs1(Fields, List, ObjSetName, "", NthObj0), - emit([nl,indent(6),"end",nl, - indent(3),"end"]), - NthObj. - -gen_inlined_dec_funs1(Fields, [{typefield,Name,_}|Rest], - ObjSetName, Sep0, NthObj) -> - CurrentMod = get(currmod), - InternalDefFunName = [NthObj,Name,ObjSetName], - emit(Sep0), - Sep = [";",nl], - N = case lists:keyfind(Name, 1, Fields) of - {_,#type{}=Type} -> - emit_inner_of_decfun(Type, InternalDefFunName); - {_,#typedef{}=Type} -> - emit([indent(9),{asis,Name}," ->",nl]), - emit_inner_of_decfun(Type, InternalDefFunName); - {_,#'Externaltypereference'{module=CurrentMod,type=T}} -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"'dec_",T,"'(Val,telltype)"]), - 0; - {_,#'Externaltypereference'{module=M,type=T}} -> - emit([indent(9),{asis,Name}," ->",nl, - indent(12),"'",M,"':'dec_",T,"'(Val,telltype)"]), - 0; - false -> - emit([indent(9),{asis,Name}," -> {Val,Type}"]), - 0 - end, - gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj+N); -gen_inlined_dec_funs1(Fields, [_|Rest], ObjSetName, Sep, NthObj) -> - gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj); -gen_inlined_dec_funs1(_, [], _, _, NthObj) -> 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(per, 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) -> - asn1ct_gen_per:gen_dec_prim(Erules, Att, BytesVar). - -%% For PER the ExtensionAdditionGroup notation has significance for the encoding and decoding -%% the components within the ExtensionAdditionGroup is treated in a similar way as if they -%% have been specified within a SEQUENCE, therefore we construct a fake sequence type here -%% so that we can generate code for it -extaddgroup2sequence(ExtList) -> - extaddgroup2sequence(ExtList,0,[]). - -extaddgroup2sequence([{'ExtensionAdditionGroup',Number0}|T],ExtNum,Acc) -> - Number = case Number0 of undefined -> 1; _ -> Number0 end, - {ExtGroupComps,['ExtensionAdditionGroupEnd'|T2]} = - lists:splitwith(fun(Elem) -> is_record(Elem,'ComponentType') end,T), - extaddgroup2sequence(T2,ExtNum+1, - [#'ComponentType'{ - name=list_to_atom("ExtAddGroup"++ - integer_to_list(ExtNum+1)), - typespec=#type{def=#'SEQUENCE'{ - extaddgroup=Number, - components=ExtGroupComps}}, - prop='OPTIONAL'}|Acc]); -extaddgroup2sequence([C|T],ExtNum,Acc) -> - extaddgroup2sequence(T,ExtNum,[C|Acc]); -extaddgroup2sequence([],_,Acc) -> - lists:reverse(Acc). diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 4b2c3b1b65..c6803a0f96 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -25,6 +25,7 @@ per_dec_length/3,per_dec_named_integer/3, per_dec_octet_string/2,per_dec_open_type/1,per_dec_real/1, per_dec_restricted_string/1]). +-export([per_dec_constrained/3,per_dec_normally_small_number/1]). -export([optimize_alignment/1,optimize_alignment/2, dec_slim_cg/2,dec_code_gen/2]). -export([effective_constraint/2]). @@ -94,18 +95,16 @@ per_dec_integer(Constraint0, Aligned) -> per_dec_length(SingleValue, _, _Aligned) when is_integer(SingleValue) -> {value,SingleValue}; -per_dec_length({S,S}, _, _Aligned) when is_integer(S) -> - {value,S}; -per_dec_length({{_,_}=Constr,_}, AllowZero, Aligned) -> +per_dec_length({{Fixed,Fixed},[]}, AllowZero, Aligned) -> + bit_case(per_dec_length(Fixed, AllowZero, Aligned), + per_dec_length(no, AllowZero, Aligned)); +per_dec_length({{_,_}=Constr,[]}, AllowZero, Aligned) -> bit_case(per_dec_length(Constr, AllowZero, Aligned), - per_dec_length(undefined, AllowZero, Aligned)); + per_dec_length(no, AllowZero, Aligned)); per_dec_length({Lb,Ub}, _AllowZero, Aligned) when is_integer(Lb), - is_integer(Lb), - Ub =< 65535 -> + is_integer(Lb) -> per_dec_constrained(Lb, Ub, Aligned); -per_dec_length({_,_}, AllowZero, Aligned) -> - decode_unconstrained_length(AllowZero, Aligned); -per_dec_length(undefined, AllowZero, Aligned) -> +per_dec_length(no, AllowZero, Aligned) -> decode_unconstrained_length(AllowZero, Aligned). per_dec_named_integer(Constraint, NamedList0, Aligned) -> @@ -114,17 +113,27 @@ per_dec_named_integer(Constraint, NamedList0, Aligned) -> {map,Int,NamedList}. per_dec_k_m_string(StringType, Constraint, Aligned) -> - SzConstr = get_constraint(Constraint, 'SizeConstraint'), + SzConstr = effective_constraint(bitstring, Constraint), N = string_num_bits(StringType, Constraint, Aligned), - Imm = dec_string(SzConstr, N, Aligned), + %% X.691 (07/2002) 27.5.7 says if the upper bound times the number + %% of bits is greater than or equal to 16, then the bit field should + %% be aligned. + Imm = dec_string(SzConstr, N, Aligned, fun(_, Ub) -> Ub >= 16 end), Chars = char_tab(Constraint, StringType, N), convert_string(N, Chars, Imm). per_dec_octet_string(Constraint, Aligned) -> - dec_string(Constraint, 8, Aligned). + dec_string(Constraint, 8, Aligned, + %% Aligned unless the size is fixed and =< 16. + fun(Sv, Sv) -> Sv > 16; + (_, _) -> true + end). per_dec_raw_bitstring(Constraint, Aligned) -> - dec_string(Constraint, 1, Aligned). + dec_string(Constraint, 1, Aligned, + fun(Sv, Sv) -> Sv > 16; + (_, _) -> true + end). per_dec_open_type(Aligned) -> {get_bits,decode_unconstrained_length(true, Aligned), @@ -148,21 +157,21 @@ per_dec_restricted_string(Aligned) -> %%% Local functions. %%% -dec_string(Sv, U, _Aligned) when is_integer(Sv), U*Sv =< 16 -> - {get_bits,Sv,[U,binary]}; -dec_string(Sv, U, Aligned) when is_integer(Sv), Sv < 16#10000 -> +dec_string(Sv, U, Aligned0, AF) when is_integer(Sv) -> + Bits = U*Sv, + Aligned = Aligned0 andalso AF(Bits, Bits), {get_bits,Sv,[U,binary,{align,Aligned}]}; -dec_string([_|_]=C, U, Aligned) when is_list(C) -> - dec_string({hd(C),lists:max(C)}, U, Aligned); -dec_string({Sv,Sv}, U, Aligned) -> - dec_string(Sv, U, Aligned); -dec_string({{_,_}=C,_}, U, Aligned) -> - bit_case(dec_string(C, U, Aligned), - dec_string(no, U, Aligned)); -dec_string({Lb,Ub}, U, Aligned) when Ub < 16#10000 -> - Len = per_dec_constrained(Lb, Ub, Aligned), +dec_string({{Sv,Sv},[]}, U, Aligned, AF) -> + bit_case(dec_string(Sv, U, Aligned, AF), + dec_string(no, U, Aligned, AF)); +dec_string({{_,_}=C,[]}, U, Aligned, AF) -> + bit_case(dec_string(C, U, Aligned, AF), + dec_string(no, U, Aligned, AF)); +dec_string({Lb,Ub}, U, Aligned0, AF) -> + Len = per_dec_constrained(Lb, Ub, Aligned0), + Aligned = Aligned0 andalso AF(Lb*U, Ub*U), {get_bits,Len,[U,binary,{align,Aligned}]}; -dec_string(_, U, Aligned) -> +dec_string(_, U, Aligned, _AF) -> Al = [{align,Aligned}], DecRest = fun(V, Buf) -> asn1ct_func:call(per_common, @@ -189,7 +198,7 @@ per_dec_enumerated_fix_list([], Tail, _) -> Tail. per_dec_integer_1([{'SingleValue',Value}], _Aligned) -> {value,Value}; per_dec_integer_1([{'ValueRange',{Lb,'MAX'}}], Aligned) when is_integer(Lb) -> - per_dec_unconstrained(Aligned); + per_decode_semi_constrained(Lb, Aligned); per_dec_integer_1([{'ValueRange',{Lb,Ub}}], Aligned) when is_integer(Lb), is_integer(Ub) -> per_dec_constrained(Lb, Ub, Aligned); @@ -700,7 +709,27 @@ effective_constraint(integer, C) -> VR = effective_constr('ValueRange', VRs), greatest_common_range(SV, VR); effective_constraint(bitstring, C) -> - get_constraint(C, 'SizeConstraint'). + case get_constraint(C, 'SizeConstraint') of + {{Lb,Ub},[]}=Range when is_integer(Lb) -> + if + is_integer(Ub), Ub < 16#10000 -> + Range; + true -> + no + end; + {Lb,Ub}=Range when is_integer(Lb) -> + if + is_integer(Ub), Ub < 16#10000 -> + if + Lb =:= Ub -> Lb; + true -> Range + end; + true -> + no + end; + no -> + no + end. effective_constr(_, []) -> []; effective_constr('SingleValue', List) -> diff --git a/lib/asn1/src/asn1ct_name.erl b/lib/asn1/src/asn1ct_name.erl index 3ab6f7b0ed..c0c2ed302c 100644 --- a/lib/asn1/src/asn1ct_name.erl +++ b/lib/asn1/src/asn1ct_name.erl @@ -21,13 +21,8 @@ %%-compile(export_all). -export([start/0, - stop/0, - push/1, - pop/1, curr/1, clear/0, - delete/1, - active/1, prev/1, next/1, all/1, @@ -43,30 +38,19 @@ start() -> end)), ok; _Pid -> - already_started + %% Already started. Clear the variables. + clear() end. -stop() -> - req(stop), - erase(?MODULE). - name_server_loop({Ref, Parent} = Monitor,Vars) -> %% io:format("name -- ~w~n",[Vars]), receive + {_From,clear} -> + name_server_loop(Monitor, []); {From,{current,Variable}} -> From ! {?MODULE,get_curr(Vars,Variable)}, name_server_loop(Monitor,Vars); - {From,{pop,Variable}} -> - From ! {?MODULE,done}, - name_server_loop(Monitor,pop_var(Vars,Variable)); - {From,{push,Variable}} -> - From ! {?MODULE,done}, - name_server_loop(Monitor,push_var(Vars,Variable)); - {From,{delete,Variable}} -> - From ! {?MODULE,done}, - name_server_loop(Monitor,delete_var(Vars,Variable)); - {From,{new,Variable}} -> - From ! {?MODULE,done}, + {_From,{new,Variable}} -> name_server_loop(Monitor,new_var(Vars,Variable)); {From,{prev,Variable}} -> From ! {?MODULE,get_prev(Vars,Variable)}, @@ -74,32 +58,29 @@ name_server_loop({Ref, Parent} = Monitor,Vars) -> {From,{next,Variable}} -> From ! {?MODULE,get_next(Vars,Variable)}, name_server_loop(Monitor,Vars); - {'DOWN', Ref, process, Parent, Reason} -> - exit(Reason); - {From,stop} -> - From ! {?MODULE,stopped} - end. - -active(V) -> - case curr(V) of - nil -> false; - _ -> true + {'DOWN', Ref, process, Parent, Reason} -> + exit(Reason) end. req(Req) -> - get(?MODULE) ! {self(), Req}, + Pid = get(?MODULE), + Ref = monitor(process, Pid), + Pid ! {self(), Req}, receive - {?MODULE, Reply} -> Reply - after 5000 -> - exit(name_server_timeout) + {?MODULE, Reply} -> + Reply; + {'DOWN', Ref, process, Pid, Reason} -> + error({name_server_died,Reason}) end. -pop(V) -> req({pop,V}). -push(V) -> req({push,V}). -clear() -> stop(), start(). +cast(Req) -> + get(?MODULE) ! {self(), Req}, + ok. + +clear() -> cast(clear). curr(V) -> req({current,V}). -new(V) -> req({new,V}). -delete(V) -> req({delete,V}). +new(V) -> cast({new,V}). + prev(V) -> case req({prev,V}) of none -> @@ -108,11 +89,7 @@ prev(V) -> end. next(V) -> - case req({next,V}) of - none -> - exit('cant get next of none'); - Rep -> Rep - end. + req({next,V}). all(V) -> Curr = curr(V), @@ -146,81 +123,36 @@ get_digs([H|T]) -> [] 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) -> +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. +get_curr([{Variable,Digit}|_Tail], Variable) -> + list_to_atom(lists:concat([Variable,Digit])); +get_curr([_|Tail], Variable) -> + get_curr(Tail, Variable). -delete_var(Vars,Variable) -> - case lists:keysearch(Variable,1,Vars) of +new_var(Vars, Variable) -> + case lists:keyfind(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 + [{Variable,1}|Vars]; + {Variable,Digit} -> + NewVars = lists:keydelete(Variable, 1, Vars), + [{Variable,Digit+1}|NewVars] end. -get_prev(Vars,Variable) -> - case lists:keysearch(Variable,1,Vars) of +get_prev(Vars, Variable) -> + case lists:keyfind(Variable, 1, Vars) of false -> none; - {value,{Variable,[Digit|_]}} when Digit =< 1 -> + {Variable,Digit} when Digit =< 1 -> Variable; - {value,{Variable,[Digit|_]}} when Digit > 1 -> - list_to_atom(lists:concat([Variable, - integer_to_list(Digit-1)])); - _ -> - none + {Variable,Digit} when Digit > 1 -> + list_to_atom(lists:concat([Variable,Digit-1])) end. -get_next(Vars,Variable) -> - case lists:keysearch(Variable,1,Vars) of +get_next(Vars, Variable) -> + case lists:keyfind(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 + {Variable,Digit} when Digit >= 0 -> + list_to_atom(lists:concat([Variable,Digit+1])) end. diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 9e1fcce2b1..344fdf44dd 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -23,6 +23,10 @@ -export([parse/1]). -include("asn1_records.hrl"). +%% Only used internally within this module. +-record(typereference, {pos,val}). +-record(constraint,{c,e}). + %% parse all types in module parse(Tokens) -> case catch parse_ModuleDefinition(Tokens) of @@ -458,7 +462,8 @@ parse_BuiltinType([{'INSTANCE',_},{'OF',_}|Rest]) -> {DefinedObjectClass,Rest2} = parse_DefinedObjectClass(Rest), case Rest2 of [{'(',_}|_] -> - {Constraint,Rest3} = parse_Constraint(Rest2), + {Constraint0,Rest3} = parse_Constraint(Rest2), + Constraint = merge_constraints([Constraint0]), {#type{def={'INSTANCE OF',DefinedObjectClass,Constraint}},Rest3}; _ -> {#type{def={'INSTANCE OF',DefinedObjectClass,[]}},Rest2} diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index 764555c4d2..ecdfa3f645 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -51,8 +51,6 @@ from_type(M,Typename,Type) when is_record(Type,type) -> from_type(Emod,Etype); {_,user} -> from_type(M,InnerType); - {notype,_} -> - true; {primitive,bif} -> from_type_prim(M, Type); 'ASN1_OPEN_TYPE' -> @@ -216,8 +214,6 @@ from_type_prim(M, D) -> _ -> [lists:nth(random(length(NN)),NN)] end; - 'ANY' -> - exit({asn1_error,nyi,'ANY'}); 'NULL' -> 'NULL'; 'OBJECT IDENTIFIER' -> diff --git a/lib/asn1/src/asn1rtt_ber.erl b/lib/asn1/src/asn1rtt_ber.erl index 5fbf116747..b5429fe324 100644 --- a/lib/asn1/src/asn1rtt_ber.erl +++ b/lib/asn1/src/asn1rtt_ber.erl @@ -27,7 +27,8 @@ skip_ExtensionAdditions/2]). -export([encode_boolean/2,decode_boolean/2, encode_integer/2,encode_integer/3, - decode_integer/3,decode_integer/4, + decode_integer/2,decode_integer/3, + decode_named_integer/3,decode_named_integer/4, encode_enumerated/2,decode_enumerated/3, encode_bit_string/4, decode_named_bit_string/3, @@ -41,9 +42,7 @@ decode_restricted_string/2,decode_restricted_string/3, encode_universal_string/2,decode_universal_string/3, encode_UTF8_string/2,decode_UTF8_string/2, - encode_BMP_string/2,decode_BMP_string/3, - encode_generalized_time/2,decode_generalized_time/3, - encode_utc_time/2,decode_utc_time/3]). + encode_BMP_string/2,decode_BMP_string/3]). -export([encode_open_type/2,decode_open_type/2, decode_open_type_as_binary/2]). @@ -700,11 +699,20 @@ encode_integer_neg(N, Acc) -> %% (Buffer, Range, NamedNumberList, HasTag, TotalLen) -> {Integer, Remain, RemovedBytes} %%=============================================================================== -decode_integer(Tlv, Range, NamedNumberList, TagIn) -> +decode_named_integer(Tlv, NamedNumberList, TagIn) -> + V = match_tags(Tlv, TagIn), + Int = decode_integer(V), + number2name(Int, NamedNumberList). + +decode_named_integer(Tlv, Range, NamedNumberList, TagIn) -> V = match_tags(Tlv, TagIn), Int = range_check_integer(decode_integer(V), Range), number2name(Int, NamedNumberList). +decode_integer(Tlv, TagIn) -> + V = match_tags(Tlv, TagIn), + decode_integer(V). + decode_integer(Tlv, Range, TagIn) -> V = match_tags(Tlv, TagIn), Int = decode_integer(V), @@ -715,21 +723,10 @@ decode_integer(Bin) -> <<Int:Len/signed-unit:8>> = Bin, Int. +range_check_integer(Int, {Lb,Ub}) when Lb =< Int, Int =< Ub -> + Int; range_check_integer(Int, Range) -> - case Range of - [] -> % No length constraint - Int; - {Lb,Ub} when Int >= Lb, Ub >= Int -> % variable length constraint - Int; - {_,_} -> - exit({error,{asn1,{integer_range,Range,Int}}}); - Int -> % fixed value constraint - Int; - SingleValue when is_integer(SingleValue) -> - exit({error,{asn1,{integer_range,Range,Int}}}); - _ -> % some strange constraint that we don't support yet - Int - end. + exit({error,{asn1,{integer_range,Range,Int}}}). number2name(Int, []) -> Int; @@ -838,8 +835,8 @@ int_to_bitlist(Int) when is_integer(Int), Int >= 0 -> %% 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 -> + case C of + [] -> remove_unused_then_dotag(TagIn, Unused, BinBits); {_Min,Max} -> BBLen = (byte_size(BinBits)*8)-Unused, @@ -885,8 +882,8 @@ remove_unused_then_dotag(TagIn,Unused,BinBits) -> encode_bit_string_named(C, [FirstVal | RestVal], NamedBitList, TagIn) -> ToSetPos = get_all_bitposes([FirstVal | RestVal], NamedBitList, []), Size = - case get_constraint(C,'SizeConstraint') of - no -> + case C of + [] -> lists:max(ToSetPos)+1; {_Min,Max} -> Max; @@ -943,8 +940,8 @@ make_and_set_list(Len, [], XPos) -> %% 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 -> + case C of + [] -> {Len, Unused, OctetList} = encode_bitstring(BitListVal), %%add unused byte to the Len encode_tags(TagIn, [Unused | OctetList], Len+1); @@ -957,7 +954,7 @@ encode_bit_string_bits(C, BitListVal, _NamedBitList, TagIn) when is_list(BitList Constr={{_,_},{_,_}} ->%{{Min1,Max1},{Min2,Max2}} %% constraint with extension mark encode_constr_bit_str_bits(Constr,BitListVal,TagIn); - Size -> + Size when is_integer(Size) -> case length(BitListVal) of BitSize when BitSize == Size -> {Len, Unused, OctetList} = encode_bitstring(BitListVal), @@ -1266,27 +1263,14 @@ decode_restricted_string(Tlv, Range, TagsIn) -> Bin = match_and_collect(Tlv, TagsIn), check_restricted_string(binary_to_list(Bin), byte_size(Bin), Range). -check_restricted_string(Val, StrLen, Range) -> - case Range of - {Lb,Ub} when StrLen >= Lb, Ub >= StrLen -> % variable length constraint - Val; - {{Lb,_Ub},[]} when StrLen >= Lb -> - Val; - {{Lb,_Ub},_Ext=[Min|_]} when StrLen >= Lb; StrLen >= Min -> - Val; - {{Lb1,Ub1},{Lb2,Ub2}} when StrLen >= Lb1, StrLen =< Ub1; - StrLen =< Ub2, StrLen >= Lb2 -> - Val; - StrLen -> % fixed length constraint - Val; - {_,_} -> - 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 - Val - end. - +check_restricted_string(Val, _Len, []) -> + Val; +check_restricted_string(Val, Len, {Lb,Ub}) when Lb =< Len, Len =< Ub -> + Val; +check_restricted_string(Val, Len, Len) -> + Val; +check_restricted_string(Val, _Len, Range) -> + exit({error,{asn1,{length,Range,Val}}}). %%============================================================================ %% encode Universal string @@ -1390,56 +1374,6 @@ mk_BMP_string([0,B|T], 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(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 - [_H|_T]=PartList -> % 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(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 -> % constructed - collect_parts(PartList); - Bin -> - Bin - end, - binary_to_list(NewVal). - - %%============================================================================ %% Length handling %% @@ -1535,14 +1469,6 @@ match_and_collect(Tlv, TagsIn) -> Bin end. -get_constraint(C, Key) -> - case lists:keyfind(Key, 1, C) of - false -> - no; - {_,V} -> - V - end. - collect_parts(TlvList) -> collect_parts(TlvList, []). diff --git a/lib/asn1/src/asn1rtt_per.erl b/lib/asn1/src/asn1rtt_per.erl index aa6cf4da0a..9f4b7500d8 100644 --- a/lib/asn1/src/asn1rtt_per.erl +++ b/lib/asn1/src/asn1rtt_per.erl @@ -19,7 +19,7 @@ -module(asn1rtt_per). -export([setext/1, fixextensions/2, - skipextensions/3, getbit/1, getchoice/3, + skipextensions/3, set_choice/3,encode_integer/2, encode_small_number/1, encode_constrained_number/2, @@ -36,7 +36,7 @@ encode_VideotexString/2, encode_ObjectDescriptor/2, encode_UTF8String/1, - encode_octet_string/3, + encode_octet_string/2, encode_known_multiplier_string/4, octets_to_complete/2]). @@ -88,23 +88,6 @@ skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) - Bytes0 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}). - - -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) -> @@ -112,28 +95,6 @@ align(BitStr) when is_bitstring(BitStr) -> <<_: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}. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% set_choice(Alt,Choices,Altnum) -> ListofBitSettings %% Alt = atom() @@ -185,15 +146,7 @@ set_choice_tag(_Alt,[],_Tag) -> %% | binary %% Contraint = not used in this version %% -encode_open_type(Val) when is_list(Val) -> - Bin = list_to_binary(Val), - case byte_size(Bin) of - Size when Size > 255 -> - [encode_length(Size),21,<<Size:16>>,Bin]; - Size -> - [encode_length(Size),20,Size,Bin] - end; -encode_open_type(Val) when is_binary(Val) -> +encode_open_type(Val) -> case byte_size(Val) of Size when Size > 255 -> [encode_length(Size),21,<<Size:16>>,Val]; % octets implies align @@ -220,7 +173,7 @@ encode_integer([{'ValueRange',{Lb,Ub}=VR,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_integer([{'ValueRange',{Lb,'MAX'}}], Val) when Lb =< Val -> encode_semi_constrained_number(Lb, Val); encode_integer([{'ValueRange',{'MIN',_}}], Val) -> encode_unconstrained_number(Val); @@ -238,15 +191,6 @@ encode_small_number(Val) when Val < 64 -> encode_small_number(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) - end. - %% X.691:10.7 Encoding of a semi-constrained whole number encode_semi_constrained_number(Lb, Val) -> Val2 = Val - Lb, @@ -261,10 +205,6 @@ encode_semi_constrained_number(Lb, Val) -> [encode_length(Len),21,<<Len:16>>|Oct] end. -decode_semi_constrained_number(Bytes) -> - {Len,Bytes2} = decode_length(Bytes), - getoctets(Bytes2, Len). - encode_constrained_number({Lb,_Ub},_Range,{bits,N},Val) -> Val2 = Val-Lb, [10,N,Val2]; @@ -333,47 +273,6 @@ encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val -> 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) -> - % 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 =< (1 bsl (255*8)) -> - OList = binary:bin_to_list(binary:encode_unsigned(Range - 1)), - RangeOctLen = length(OList), - {Len, Bytes} = decode_length(Buffer, {1, RangeOctLen}), - {Octs, RestBytes} = getoctets_as_bin(Bytes, Len), - {binary:decode_unsigned(Octs), RestBytes}; - true -> - exit({not_supported,{integer_range,Range}}) - end, - {Val+Lb,Remain}. - %% For some reason the minimum bits needed in the length field in %% the encoding of constrained whole numbers must always be at least 2? minimum_bits(N) when N < 4 -> 2; @@ -440,22 +339,17 @@ encode_length(Len) -> % unconstrained exit({error,{asn1,{encode_length,{nyi,above_16k}}}}) end. -encode_length(undefined, Len) -> % un-constrained - encode_length(Len); -encode_length({0,'MAX'},Len) -> - encode_length(undefined,Len); -encode_length({Lb,Ub}=Vr, 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(Len); -encode_length({{Lb,Ub}=Vr,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) -> - []. +encode_length({C,[]}, Len) -> + case C of + {Lb,Ub}=Vr when Lb =< Len, Len =< Ub -> + [0|encode_constrained_number(Vr, Len)]; + _ -> + [1|encode_length(Len)] + end; +encode_length(Len, Len) -> + []; +encode_length(Vr, Len) -> + encode_constrained_number(Vr, Len). %% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension %% additions in a sequence or set @@ -476,11 +370,6 @@ decode_length(Buffer) -> % un-constrained 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). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% bitstring NamedBitList %% Val can be of: @@ -758,40 +647,40 @@ make_and_set_list([], _) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% X.691:16 -%% encode_octet_string(Constraint,ExtensionMarker,Val) +%% encode_octet_string(Constraint, Val) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -encode_octet_string(_C, true, _Val) -> - exit({error,{asn1,{'not_supported',extensionmarker}}}); -encode_octet_string({_,_}=SZ, false, Val) -> +encode_octet_string({{Sv,Sv},Ext}=SZ, Val) when is_list(Ext), Sv =< 2 -> Len = length(Val), try - [encode_length(SZ, Len),2|octets_to_complete(Len, Val)] + case encode_length(SZ, Len) of + [0|_]=EncLen -> + [EncLen,45,Sv*8,Sv,Val]; + [_|_]=EncLen -> + [EncLen|octets_to_complete(Len, Val)] + end catch exit:{error,{asn1,{encode_length,_}}} -> encode_fragmented_octet_string(Val) end; -encode_octet_string(SZ, false, Val) when is_list(SZ) -> +encode_octet_string({_,_}=SZ, Val) -> Len = length(Val), try - [encode_length({hd(SZ),lists:max(SZ)},Len),2| - octets_to_complete(Len,Val)] + [encode_length(SZ, Len),2|octets_to_complete(Len, Val)] catch exit:{error,{asn1,{encode_length,_}}} -> encode_fragmented_octet_string(Val) end; -encode_octet_string(Sv, false, Val) when is_integer(Sv) -> +encode_octet_string(Sv, Val) when is_integer(Sv) -> encode_fragmented_octet_string(Val); -encode_octet_string(no, false, Val) -> +encode_octet_string(no, Val) -> Len = length(Val), try [encode_length(Len),2|octets_to_complete(Len, Val)] catch exit:{error,{asn1,{encode_length,_}}} -> encode_fragmented_octet_string(Val) - end; -encode_octet_string(C, _, _) -> - exit({error,{not_implemented,C}}). + end. encode_fragmented_octet_string(Val) -> Bin = iolist_to_binary(Val), @@ -825,12 +714,24 @@ encode_restricted_string(Val) when is_list(Val)-> encode_known_multiplier_string(SizeC, NumBits, CharOutTab, Val) -> Result = chars_encode2(Val, NumBits, CharOutTab), case SizeC of - Ub when is_integer(Ub), Ub*NumBits =< 16 -> + Ub when is_integer(Ub), Ub*NumBits < 16 -> Result; - Ub when is_integer(Ub), Ub =<65535 -> % fixed length + Ub when is_integer(Ub) -> [2,Result]; - {Ub,Lb} -> - [encode_length({Ub,Lb},length(Val)),2,Result]; + {{_,Ub},Ext}=SZ when is_list(Ext) -> + Len = length(Val), + case encode_length(SZ, Len) of + [0|_]=EncLen when Ub*NumBits < 16 -> + [EncLen,45,Len*NumBits,Len,Val]; + [_|_]=EncLen -> + [EncLen,2|Result] + end; + {_,Ub}=Range -> + [encode_length(Range, length(Val))| + if + Ub*NumBits < 16 -> Result; + true -> [2|Result] + end]; no -> [encode_length(length(Val)),2,Result] end. diff --git a/lib/asn1/src/asn1rtt_uper.erl b/lib/asn1/src/asn1rtt_uper.erl index 8efe9a7b0f..a5035c6660 100644 --- a/lib/asn1/src/asn1rtt_uper.erl +++ b/lib/asn1/src/asn1rtt_uper.erl @@ -21,7 +21,7 @@ -export([setext/1, fixoptionals/3, fixextensions/2, - skipextensions/3, getbit/1, getchoice/3 ]). + skipextensions/3]). -export([set_choice/3, encode_integer/2, encode_integer/3]). -export([encode_small_number/1, encode_constrained_number/2, encode_boolean/1, @@ -34,17 +34,17 @@ -export([encode_open_type/1]). - -export([encode_UniversalString/2, - encode_PrintableString/2, + -export([encode_UniversalString/3, + encode_PrintableString/3, encode_GeneralString/2, encode_GraphicString/2, encode_TeletexString/2, encode_VideotexString/2, - encode_VisibleString/2, + encode_VisibleString/3, encode_UTF8String/1, - encode_BMPString/2, - encode_IA5String/2, - encode_NumericString/2, + encode_BMPString/3, + encode_IA5String/3, + encode_NumericString/3, encode_ObjectDescriptor/2 ]). @@ -123,29 +123,6 @@ skipextensions(Bytes0, Nr, ExtensionBitstr) when is_bitstring(ExtensionBitstr) - 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}). - - -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}. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% set_choice(Alt,Choices,Altnum) -> ListofBitSettings %% Alt = atom() @@ -198,9 +175,7 @@ set_choice_tag(_Alt,[],_Tag) -> %% | binary %% Contraint = not used in this version %% -encode_open_type(Val) when is_list(Val) -> - encode_open_type(list_to_binary(Val)); -encode_open_type(Val) when is_binary(Val) -> +encode_open_type(Val) -> [encode_length(byte_size(Val)),Val]. @@ -248,7 +223,7 @@ encode_integer1(C, Val) -> case VR = get_constraint(C, 'ValueRange') of no -> encode_unconstrained_number(Val); - {Lb,'MAX'} -> + {Lb,'MAX'} when Lb =< Val -> encode_semi_constrained_number(Lb, Val); %% positive with range {Lb,Ub} when Val >= Lb, Ub >= Val -> @@ -265,15 +240,6 @@ encode_small_number(Val) when Val < 64 -> 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) - end. - %% X.691:10.7 Encoding of a semi-constrained whole number encode_semi_constrained_number(Lb, Val) -> %% encoding in minimum number of octets preceeded by a length @@ -289,11 +255,6 @@ encode_semi_constrained_number(Lb, Val) -> [encode_length(Size),Bin] end. -decode_semi_constrained_number(Bytes) -> - {Len,Bytes2} = decode_length(Bytes), - {V,Bytes3} = getoctets(Bytes2,Len), - {V,Bytes3}. - encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val -> Range = Ub - Lb + 1, Val2 = Val - Lb, @@ -302,13 +263,6 @@ encode_constrained_number({Lb,Ub}, Val) when Val >= Lb, Ub >= Val -> 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 -> @@ -390,22 +344,18 @@ encode_length(Len) -> % un-constrained error({error,{asn1,{encode_length,{nyi,above_16k}}}}) end. -encode_length(undefined, Len) -> % unconstrained - encode_length(Len); -encode_length({0,'MAX'},Len) -> - encode_length(undefined, Len); -encode_length({Lb,Ub}=Vr, 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(Len); -encode_length({{Lb,Ub}=Vr,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) -> - []. +encode_length({C,[]}, Len) -> + case C of + {Lb,Ub}=Vr when Lb =< Len, Len =< Ub -> + [<<0:1>>|encode_constrained_number(Vr, Len)]; + _ -> + [<<1:1>>|encode_length(Len)] + end; +encode_length(Len, Len) -> + []; +encode_length(Vr, Len) -> + encode_constrained_number(Vr, Len). + %% X.691 10.9.3.4 (only used for length of bitmap that prefixes extension %% additions in a sequence or set @@ -687,10 +637,6 @@ encode_octet_string(Val) -> encode_octet_string(C, Val) -> case C of - 1 -> - list_to_binary(Val); - 2 -> - list_to_binary(Val); {_,_}=VR -> try [encode_length(VR, length(Val)),list_to_binary(Val)] @@ -699,20 +645,7 @@ encode_octet_string(C, Val) -> encode_fragmented_octet_string(Val) end; Sv when is_integer(Sv), Sv =:= length(Val) -> % fixed length - if - Sv =< 65535 -> - list_to_binary(Val); - true -> - encode_fragmented_octet_string(Val) - end; - Sv when is_list(Sv) -> - try - [encode_length({hd(Sv),lists:max(Sv)}, - length(Val)),list_to_binary(Val)] - catch - error:{error,{asn1,{encode_length,_}}} -> - encode_fragmented_octet_string(Val) - end + list_to_binary(Val) end. @@ -742,41 +675,34 @@ efos_1(<<B/bitstring>>) -> encode_restricted_string(Val) when is_list(Val)-> [encode_length(length(Val)),list_to_binary(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 +encode_known_multiplier_string(StringType, C, Pa, Val) -> + Result = chars_encode(Pa, StringType, Val), + case C of + Ub when is_integer(Ub) -> 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]; + {_,_}=Range -> + [encode_length(Range, length(Val)),Result]; no -> [encode_length(length(Val)),Result] end. -encode_NumericString(C,Val) -> - encode_known_multiplier_string('NumericString',C,Val). +encode_NumericString(C, Pa, Val) -> + encode_known_multiplier_string('NumericString', C, Pa, Val). -encode_PrintableString(C,Val) -> - encode_known_multiplier_string('PrintableString',C,Val). +encode_PrintableString(C, Pa, Val) -> + encode_known_multiplier_string('PrintableString', C, Pa, Val). -encode_VisibleString(C,Val) -> % equivalent with ISO646String - encode_known_multiplier_string('VisibleString',C,Val). +encode_VisibleString(C, Pa, Val) -> % equivalent with ISO646String + encode_known_multiplier_string('VisibleString', C, Pa, Val). -encode_IA5String(C,Val) -> - encode_known_multiplier_string('IA5String',C,Val). +encode_IA5String(C, Pa, Val) -> + encode_known_multiplier_string('IA5String', C, Pa, Val). -encode_BMPString(C,Val) -> - encode_known_multiplier_string('BMPString',C,Val). +encode_BMPString(C, Pa, Val) -> + encode_known_multiplier_string('BMPString', C, Pa, Val). -encode_UniversalString(C,Val) -> - encode_known_multiplier_string('UniversalString',C,Val). +encode_UniversalString(C, Pa, Val) -> + encode_known_multiplier_string('UniversalString', C, Pa, Val). %% end of known-multiplier strings for which PER visible constraints are @@ -805,14 +731,15 @@ encode_VideotexString(_C,Val) -> %% 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 +chars_encode(Pa, StringType, Value) -> + case {StringType,Pa} 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)}, + {NumBits,CharOutTab} = {get_NumBits(Pa, StringType), + get_CharOutTab(Pa, StringType)}, chars_encode2(Value,NumBits,CharOutTab) end. @@ -839,8 +766,8 @@ exit_if_false(V,false)-> exit_if_false(_,V) ->V. -get_NumBits(C,StringType) -> - case get_constraint(C,'PermittedAlphabet') of +get_NumBits(Pa, StringType) -> + case Pa of {'SingleValue',Sv} -> charbits(length(Sv)); no -> @@ -860,22 +787,23 @@ get_NumBits(C,StringType) -> end end. -get_CharOutTab(C,StringType) -> - case get_constraint(C,'PermittedAlphabet') of +get_CharOutTab(Pa, StringType) -> + case Pa of {'SingleValue',Sv} -> - get_CharTab2(C,StringType,hd(Sv),lists:max(Sv),Sv); + get_CharTab2(Pa, StringType, hd(Sv), lists:max(Sv), Sv); no -> case StringType of 'IA5String' -> {0,16#7F,notab}; 'VisibleString' -> - get_CharTab2(C,StringType,16#20,16#7F,notab); + get_CharTab2(Pa, StringType, 16#20, 16#7F, notab); 'PrintableString' -> Chars = lists:sort( " '()+,-./0123456789:=?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"), - get_CharTab2(C,StringType,hd(Chars),lists:max(Chars),Chars); + get_CharTab2(Pa, StringType, hd(Chars), + lists:max(Chars), Chars); 'NumericString' -> - get_CharTab2(C,StringType,16#20,$9," 0123456789"); + get_CharTab2(Pa, StringType, 16#20, $9, " 0123456789"); 'UniversalString' -> {0,16#FFFFFFFF,notab}; 'BMPString' -> diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index 6e6ab4639c..15b97df972 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -114,7 +114,8 @@ MODULES= \ asn1_app_test \ asn1_appup_test \ asn1_wrapper \ - asn1_SUITE + asn1_SUITE \ + error_SUITE SUITE= asn1_SUITE.erl diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index 8deabece37..6be493320c 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -139,7 +139,6 @@ groups() -> testSetOfCho, testEnumExt, value_test, - value_bad_enum_test, testSeq2738, % Uses 'Constructed' {group, [], [constructed, @@ -177,6 +176,7 @@ groups() -> testX420]}, testTcapsystem, testNBAPsystem, + testS1AP, test_compile_options, testDoubleEllipses, test_x691, @@ -655,7 +655,6 @@ constraint_equivalence(Config) -> AbsFile = filename:join(CaseDir, Asn1Spec++".abs"), {ok,Terms} = file:consult(AbsFile), Cs = [begin - 'INTEGER' = element(3, Type), %Assertion. Constraints = element(4, Type), Name1 = atom_to_list(Name0), {Name,_} = lists:splitwith(fun(C) -> C =/= $X end, Name1), @@ -741,11 +740,6 @@ value_test(Config, Rule, Opts) -> {ok, _} = asn1ct:test('ObjIdValues', 'ObjIdType', 'ObjIdValues':'mobileDomainId'()). -value_bad_enum_test(Config) -> - {error, _} = asn1ct:compile(?config(data_dir, Config) ++ - "BadEnumValue1", - [{outdir, ?config(case_dir, Config)}]). - constructed(Config) -> test(Config, fun constructed/3, [ber]). constructed(Config, Rule, Opts) -> @@ -860,7 +854,7 @@ testInvokeMod(Config, Rule, Opts) -> {ok, _Result2} = 'PrimStrings':encode('Bs1', [1, 0, 1, 0]). testExport(Config) -> - {error, {asn1, _Reason}} = + {error, _} = asn1ct:compile(filename:join(?config(data_dir, Config), "IllegalExport"), [{outdir, ?config(case_dir, Config)}]). @@ -906,8 +900,8 @@ testOpenTypeImplicitTag(Config, Rule, Opts) -> duplicate_tags(Config) -> DataDir = ?config(data_dir, Config), CaseDir = ?config(case_dir, Config), - {error, {asn1, [{error, {type, _, _, 'SeqOpt1Imp', - {asn1, {duplicates_of_the_tags, _}}}}]}} = + {error, [{error, {type, _, _, 'SeqOpt1Imp', + {asn1, {duplicates_of_the_tags, _}}}}]} = asn1ct:compile(filename:join(DataDir, "SeqOptional2"), [abs, {outdir, CaseDir}]). @@ -1024,6 +1018,16 @@ testNBAPsystem(Config, Rule, Opts) -> testNBAPsystem:compile(Config, [Rule|Opts]), testNBAPsystem:test(Rule, Config). +testS1AP(Config) -> test(Config, fun testS1AP/3). +testS1AP(Config, Rule, Opts) -> + S1AP = ["S1AP-CommonDataTypes", + "S1AP-Constants", + "S1AP-Containers", + "S1AP-IEs", + "S1AP-PDU-Contents", + "S1AP-PDU-Descriptions"], + asn1_test_lib:compile_all(S1AP, Config, [Rule|Opts]). + test_compile_options(Config) -> ok = test_compile_options:wrong_path(Config), ok = test_compile_options:path(Config), @@ -1077,17 +1081,14 @@ ticket_6143(Config) -> ok = test_compile_options:ticket_6143(Config). testExtensionAdditionGroup(Config) -> - %% FIXME problems with automatic tags [ber_bin], [ber_bin, optimize] - test(Config, fun testExtensionAdditionGroup/3, [per, uper]). + test(Config, fun testExtensionAdditionGroup/3). testExtensionAdditionGroup(Config, Rule, Opts) -> asn1_test_lib:compile("Extension-Addition-Group", Config, [Rule|Opts]), asn1_test_lib:compile_erlang("extensionAdditionGroup", Config, [debug_info]), - extensionAdditionGroup:run([Rule|Opts]), - extensionAdditionGroup:run2([Rule|Opts]), - extensionAdditionGroup:run3(), - asn1_test_lib:compile("EUTRA-RRC-Definitions", Config, [Rule, {record_name_prefix, "RRC-"}|Opts]), - extensionAdditionGroup:run3([Rule|Opts]). + asn1_test_lib:compile("EUTRA-RRC-Definitions", Config, + [Rule,{record_name_prefix,"RRC-"}|Opts]), + extensionAdditionGroup:run(Rule). % parse_modules() -> % ["ImportsFrom"]. @@ -1097,11 +1098,8 @@ per_modules() -> ber_modules() -> [X || X <- test_modules(), - X =/= "CommonDataTypes", - X =/= "DS-EquipmentUser-CommonFunctionOrig-TransmissionPath", X =/= "H323-MESSAGES", - X =/= "H235-SECURITY-MESSAGES", - X =/= "MULTIMEDIA-SYSTEM-CONTROL"]. + X =/= "H235-SECURITY-MESSAGES"]. test_modules() -> ["BitStr", diff --git a/lib/asn1/test/asn1_SUITE_data/BadEnumValue1.asn b/lib/asn1/test/asn1_SUITE_data/BadEnumValue1.asn deleted file mode 100644 index dbc224a74b..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/BadEnumValue1.asn +++ /dev/null @@ -1,8 +0,0 @@ -BadEnumValue1 DEFINITIONS AUTOMATIC TAGS ::= - -BEGIN - -E3 ::= ENUMERATED {monday,thuesday(0)} -enumWrongVal E3 ::= sunday - -END diff --git a/lib/asn1/test/asn1_SUITE_data/Certificate.asn b/lib/asn1/test/asn1_SUITE_data/Certificate.asn deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Certificate.asn +++ /dev/null diff --git a/lib/asn1/test/asn1_SUITE_data/ChoExtension.asn1 b/lib/asn1/test/asn1_SUITE_data/ChoExtension.asn1 index 18473bae30..f6fe18be10 100644 --- a/lib/asn1/test/asn1_SUITE_data/ChoExtension.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/ChoExtension.asn1 @@ -41,4 +41,10 @@ ChoExt4 ::= CHOICE str OCTET STRING } +ChoEmptyRoot ::= CHOICE { + ..., + bool BOOLEAN, + int INTEGER (0..7) +} + END diff --git a/lib/asn1/test/asn1_SUITE_data/ConstraintEquivalence.asn1 b/lib/asn1/test/asn1_SUITE_data/ConstraintEquivalence.asn1 index 6a97c1b38e..8b3d151502 100644 --- a/lib/asn1/test/asn1_SUITE_data/ConstraintEquivalence.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/ConstraintEquivalence.asn1 @@ -8,6 +8,9 @@ BEGIN SingleValueX5 ::= INTEGER ((42) INTERSECTION (MIN..MAX)) SingleValueX6 ::= INTEGER ((42) INTERSECTION (40..49)) SingleValueX7 ::= INTEGER (42..42) + SingleValueX8 ::= INTEGER (integer42) + SingleValueX9 ::= INTEGER (integer42..integer42) + SingleValueX10 ::= INTEGER ((integer42) INTERSECTION (40..49)) UnconstrainedX0 ::= INTEGER UnconstrainedX1 ::= INTEGER (MIN..MAX) @@ -24,6 +27,7 @@ BEGIN RangeX04 ::= INTEGER (5|6|7|8|9|10) RangeX05 ::= INTEGER (10|9|8|7|6|5) RangeX06 ::= INTEGER (5|6|7..10) + RangeX07 ::= INTEGER (integer4<..<integer11) RangeX10 ::= INTEGER ((5..6) UNION (7..8) UNION (9|10)) RangeX11 ::= INTEGER ((5|6) UNION (7..8) UNION (9|10)) @@ -39,4 +43,20 @@ BEGIN RangeX23 ::= INTEGER ((0..10) INTERSECTION (5..20) ^ (MIN..MAX)) RangeX24 ::= INTEGER ((5|6|7|8|9|10) INTERSECTION (5..20) ^ (MIN..MAX)) + UnconstrainedStringX00 ::= IA5String + UnconstrainedStringX01 ::= IA5String (SIZE (0..MAX)) + + ConstrainedStringX00 ::= IA5String (SIZE (0..5)) + ConstrainedStringX01 ::= IA5String (SIZE (0|1|2|3|4|5)) + + -- Note: None of the back-ends care about the exact values + -- outside of the root range. + ExtConstrainedStringX00 ::= IA5String (SIZE (1..2, ...)) + ExtConstrainedStringX01 ::= IA5String (SIZE (1|2, ..., 3)) + ExtConstrainedStringX02 ::= IA5String (SIZE (1|2, ..., 3|4|5)) + + integer4 INTEGER ::= 4 + integer11 INTEGER ::= 11 + integer42 INTEGER ::= 42 + END diff --git a/lib/asn1/test/asn1_SUITE_data/Constraints.py b/lib/asn1/test/asn1_SUITE_data/Constraints.py index 87243121f7..e4bc987e4c 100644 --- a/lib/asn1/test/asn1_SUITE_data/Constraints.py +++ b/lib/asn1/test/asn1_SUITE_data/Constraints.py @@ -12,6 +12,12 @@ ContainedSubtype ::= INTEGER (INCLUDES Range10to20) -- Some ranges for additional constrained number testing. LongLong ::= INTEGER (0..18446744073709551615) Range256to65536 ::= INTEGER (256..65536) +SemiConstrained ::= INTEGER (100..MAX) +NegSemiConstrained ::= INTEGER (-128..MAX) +SemiConstrainedExt ::= INTEGER (42..MAX, ...) +NegSemiConstrainedExt ::= INTEGER (-128..MAX, ...) + +-- Other constraints FixedSize ::= OCTET STRING (SIZE(10)) FixedSize2 ::= OCTET STRING (SIZE(10|20)) VariableSize ::= OCTET STRING (SIZE(1..10)) @@ -86,5 +92,6 @@ Document ::= OCTET STRING (ENCODED BY pdf) pdf OBJECT IDENTIFIER ::= {1,2,3,4,5} +ShorterExt ::= IA5String (SIZE (5, ...)) END diff --git a/lib/asn1/test/asn1_SUITE_data/EUTRA-InterNodeDefinitions.asn b/lib/asn1/test/asn1_SUITE_data/EUTRA-InterNodeDefinitions.asn deleted file mode 100644 index 5e6313dc02..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/EUTRA-InterNodeDefinitions.asn +++ /dev/null @@ -1,123 +0,0 @@ --- 3GPP TS 36.331 V8.8.0 (2009-12) --- $Id$ --- -EUTRA-InterNodeDefinitions DEFINITIONS AUTOMATIC TAGS ::= - -BEGIN - - -HandoverCommand ::= SEQUENCE { - criticalExtensions CHOICE { - c1 CHOICE{ - handoverCommand-r8 HandoverCommand-r8-IEs, - spare7 NULL, - spare6 NULL, spare5 NULL, spare4 NULL, - spare3 NULL, spare2 NULL, spare1 NULL - }, - criticalExtensionsFuture SEQUENCE {} - } -} - -HandoverCommand-r8-IEs ::= SEQUENCE { - handoverCommandMessage OCTET STRING (CONTAINING DL-DCCH-Message), - nonCriticalExtension SEQUENCE {} OPTIONAL -} - - -HandoverPreparationInformation ::= SEQUENCE { - criticalExtensions CHOICE { - c1 CHOICE{ - handoverPreparationInformation-r8 HandoverPreparationInformation-r8-IEs, - spare7 NULL, - spare6 NULL, spare5 NULL, spare4 NULL, - spare3 NULL, spare2 NULL, spare1 NULL - }, - criticalExtensionsFuture SEQUENCE {} - } -} - -HandoverPreparationInformation-r8-IEs ::= SEQUENCE { - ue-RadioAccessCapabilityInfo UE-CapabilityRAT-ContainerList, - as-Config AS-Config OPTIONAL, -- Cond HO - rrm-Config RRM-Config OPTIONAL, - as-Context AS-Context OPTIONAL, -- Cond HO - nonCriticalExtension SEQUENCE {} OPTIONAL -} - - -UERadioAccessCapabilityInformation ::= SEQUENCE { - criticalExtensions CHOICE { - c1 CHOICE{ - ueRadioAccessCapabilityInformation-r8 - UERadioAccessCapabilityInformation-r8-IEs, - spare7 NULL, - spare6 NULL, spare5 NULL, spare4 NULL, - spare3 NULL, spare2 NULL, spare1 NULL - }, - criticalExtensionsFuture SEQUENCE {} - } -} - -UERadioAccessCapabilityInformation-r8-IEs ::= SEQUENCE { - ue-RadioAccessCapabilityInfo OCTET STRING (CONTAINING UECapabilityInformation), - nonCriticalExtension SEQUENCE {} OPTIONAL -} - - -AS-Config ::= SEQUENCE { - sourceMeasConfig MeasConfig, - sourceRadioResourceConfig RadioResourceConfigDedicated, - sourceSecurityAlgorithmConfig SecurityAlgorithmConfig, - sourceUE-Identity C-RNTI, - sourceMasterInformationBlock MasterInformationBlock, - sourceSystemInformationBlockType1 SystemInformationBlockType1, - sourceSystemInformationBlockType2 SystemInformationBlockType2, - antennaInfoCommon AntennaInfoCommon, - sourceDl-CarrierFreq ARFCN-ValueEUTRA, - ... -} - - -AS-Context ::= SEQUENCE { - reestablishmentInfo ReestablishmentInfo OPTIONAL -- Cond HO -} - - -ReestablishmentInfo ::= SEQUENCE { - sourcePhysCellId PhysCellId, - targetCellShortMAC-I ShortMAC-I, - additionalReestabInfoList AdditionalReestabInfoList OPTIONAL, - ... -} - -AdditionalReestabInfoList ::= SEQUENCE ( SIZE (1..maxReestabInfo) ) OF AdditionalReestabInfo - -AdditionalReestabInfo ::= SEQUENCE{ - cellIdentity CellIdentity, - key-eNodeB-Star Key-eNodeB-Star, - shortMAC-I ShortMAC-I -} - -Key-eNodeB-Star ::= BIT STRING (SIZE (256)) - - -RRM-Config ::= SEQUENCE { - ue-InactiveTime ENUMERATED { - s1, s2, s3, s5, s7, s10, s15, s20, - s25, s30, s40, s50, min1, min1s20c, min1s40, - min2, min2s30, min3, min3s30, min4, min5, min6, - min7, min8, min9, min10, min12, min14, min17, min20, - min24, min28, min33, min38, min44, min50, hr1, - hr1min30, hr2, hr2min30, hr3, hr3min30, hr4, hr5, hr6, - hr8, hr10, hr13, hr16, hr20, day1, day1hr12, day2, - day2hr12, day3, day4, day5, day7, day10, day14, day19, - day24, day30, dayMoreThan30} OPTIONAL, - ... -} - - -maxReestabInfo INTEGER ::= 32 -- Maximum number of KeNB* and shortMAC-I forwarded - -- at handover for re-establishment preparation - - -END diff --git a/lib/asn1/test/asn1_SUITE_data/EUTRA-UE-Variables.asn b/lib/asn1/test/asn1_SUITE_data/EUTRA-UE-Variables.asn deleted file mode 100644 index 414140a6fb..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/EUTRA-UE-Variables.asn +++ /dev/null @@ -1,49 +0,0 @@ --- 3GPP TS 36.331 V8.8.0 (2009-12) --- $Id$ --- -EUTRA-UE-Variables DEFINITIONS AUTOMATIC TAGS ::= - -BEGIN - - -VarMeasConfig ::= SEQUENCE { - -- Measurement identities - measIdList MeasIdToAddModList OPTIONAL, - -- Measurement objects - measObjectList MeasObjectToAddModList OPTIONAL, - -- Reporting configurations - reportConfigList ReportConfigToAddModList OPTIONAL, - -- Other parameters - quantityConfig QuantityConfig OPTIONAL, - s-Measure RSRP-Range OPTIONAL, - speedStatePars CHOICE { - release NULL, - setup SEQUENCE { - mobilityStateParameters MobilityStateParameters, - timeToTrigger-SF SpeedStateScaleFactors - } - } OPTIONAL -} - - -VarMeasReportList ::= SEQUENCE (SIZE (1..maxMeasId)) OF VarMeasReport - -VarMeasReport ::= SEQUENCE { - -- List of measurement that have been triggered - measId MeasId, - cellsTriggeredList CellsTriggeredList OPTIONAL, - numberOfReportsSent INTEGER -} - -CellsTriggeredList ::= SEQUENCE (SIZE (1..maxCellMeas)) OF PhysCellId - - -VarShortMAC-Input ::= SEQUENCE { - cellIdentity CellIdentity, - physCellId PhysCellId, - c-RNTI C-RNTI -} - - - -END
\ No newline at end of file diff --git a/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1 b/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1 index 9ad1f6299e..3a727e46bb 100644 --- a/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1 @@ -1,28 +1,35 @@ -EnumExt DEFINITIONS AUTOMATIC TAGS ::=
-BEGIN
-
-Ext ::= ENUMERATED {
- blue(0),
- red(1),
- green(2),
- ...
-}
-
-Ext1 ::= ENUMERATED {
- blue(0),
- red(1),
- green(2),
- ...,
- orange(7)
-}
-
-Noext ::= ENUMERATED {
- blue(0),
- red(1),
- green(2)
-}
-
-Globalstate ::= ENUMERATED {def(1),com(2),preop(3),oper(4),noop(5),fail(6)}
-
-END
-
+EnumExt DEFINITIONS AUTOMATIC TAGS ::= +BEGIN + +Ext ::= ENUMERATED { + blue(0), + red(1), + green(2), + ... +} + +Ext1 ::= ENUMERATED { + blue(0), + red(1), + green(2), + ..., + orange(7), + black(8), + magenta(9) +} + +Noext ::= ENUMERATED { + blue(0), + red(1), + green(2) +} + +Globalstate ::= ENUMERATED {def(1),com(2),preop(3),oper(4),noop(5),fail(6)} + +Seq ::= SEQUENCE { + e Ext1, + i INTEGER +} + +END + diff --git a/lib/asn1/test/asn1_SUITE_data/InfObj.asn b/lib/asn1/test/asn1_SUITE_data/InfObj.asn index 0a437e12df..53e5043cb7 100644 --- a/lib/asn1/test/asn1_SUITE_data/InfObj.asn +++ b/lib/asn1/test/asn1_SUITE_data/InfObj.asn @@ -39,21 +39,6 @@ RANAP-PDU ::= CHOICE { CLASS2 ::= RANAP-ELEMENTARY-PROCEDURE -MY-CLASS ::= CLASS { - &integerValue INTEGER UNIQUE, - &booleanValue BOOLEAN, - &stringValue PrintableString - } - -myobject MY-CLASS ::= { - &integerValue 12, - &booleanValue TRUE, - &stringValue "hejsan" - } -MyObjectSet MY-CLASS ::= { - myobject - } - InitiatingMessage ::= SEQUENCE { procedureCode RANAP-ELEMENTARY-PROCEDURE.&procedureCode ({RANAP-ELEMENTARY-PROCEDURES}), criticality RANAP-ELEMENTARY-PROCEDURE.&criticality ({RANAP-ELEMENTARY-PROCEDURES}{@procedureCode}), @@ -148,6 +133,83 @@ id-Iu-Release3 INTEGER ::= 3 id-Iu-Release4 INTEGER ::= 4 id-Iu-Release5 INTEGER ::= 5 +-- +-- MY-CLASS +-- + +Seq ::= SEQUENCE { + int INTEGER, + str OCTET STRING +} + +MY-CLASS ::= CLASS { + &Count DEFAULT INTEGER, + &integerValue INTEGER UNIQUE, + &booleanValue BOOLEAN, + &stringValue PrintableString +} + +myobject MY-CLASS ::= { + &integerValue 12, + &booleanValue TRUE, + &stringValue "hejsan" +} + +myotherobject MY-CLASS ::= { + &Count Seq, + &integerValue 42, + &booleanValue FALSE, + &stringValue "hoppsan" +} + +MyObjectSet MY-CLASS ::= { + myobject | myotherobject | + { + -- Each character will be encoded in 3 bits in UPER, 4 bits in PER. + &Count NumericString (FROM("01234567") ^ SIZE(8)), + &integerValue 43, + &booleanValue TRUE, + &stringValue "tjosan" + } +} + +MyPdu ::= SEQUENCE { + count MY-CLASS.&Count ({MyObjectSet}{@int}), + int MY-CLASS.&integerValue ({MyObjectSet}), + bool MY-CLASS.&booleanValue ({MyObjectSet}{@int}), + str MY-CLASS.&stringValue ({MyObjectSet}{@int}) +} + +Seq2 ::= SEQUENCE { + int MY-CLASS.&integerValue ({MyObjectSet}), + seqof SEQUENCE (1..10) OF MY-CLASS.&booleanValue ({MyObjectSet}{@int}), + setof SET (1..10) OF MY-CLASS.&booleanValue ({MyObjectSet}{@int}) +} + +-- +-- Class with constructed default +-- + +CONSTRUCTED-DEFAULT ::= CLASS { + &id INTEGER UNIQUE, + &Type DEFAULT SEQUENCE { a INTEGER, b BOOLEAN }, + &ok BOOLEAN DEFAULT TRUE +} + +constructed1 CONSTRUCTED-DEFAULT ::= { &id 1 } +constructed2 CONSTRUCTED-DEFAULT ::= { &id 2, &ok false } + +ConstructedDefaultSet CONSTRUCTED-DEFAULT ::= { + constructed1 | + constructed2 | + { &id 3, &Type BOOLEAN } +} + +ConstructedPdu ::= SEQUENCE { + id CONSTRUCTED-DEFAULT.&id ({ConstructedDefaultSet}), + content CONSTRUCTED-DEFAULT.&Type ({ConstructedDefaultSet}{@id}) +} + END diff --git a/lib/asn1/test/asn1_SUITE_data/InfObj2.asn b/lib/asn1/test/asn1_SUITE_data/InfObj2.asn deleted file mode 100644 index faba7371a4..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/InfObj2.asn +++ /dev/null @@ -1,156 +0,0 @@ -InfObj2 DEFINITIONS ::= -BEGIN - - -RANAP-ELEMENTARY-PROCEDURE ::= CLASS { - &InitiatingMessage , - &SuccessfulOutcome OPTIONAL, - &Outcome DEFAULT NULL, - &vartypvalue &Outcome, - &FixTypeValSet PrintableString, - &VarTypeValSet &InitiatingMessage, - &infoObject RANAP-ELEMENTARY-PROCEDURE, - &InfObjectSet CLASS2, - &UnsuccessfulOutcome 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 [0] InitiatingMessage, - substrings [1] SEQUENCE { - type RANAP-ELEMENTARY-PROCEDURE.&procedureCode({RANAP-ELEMENTARY-PROCEDURES}), - strings SEQUENCE OF CHOICE { - initial [0] RANAP-ELEMENTARY-PROCEDURE.&Outcome({ - RANAP-ELEMENTARY-PROCEDURES}{@substrings.type}), - final [1] RANAP-ELEMENTARY-PROCEDURE.&Outcome({RANAP-ELEMENTARY-PROCEDURES}{@substrings.type}) - } - }, --- successfulOutcome SuccessfulOutcome, --- unsuccessfulOutcome UnsuccessfulOutcome, --- outcome Outcome, - ... - } - -CLASS2 ::= RANAP-ELEMENTARY-PROCEDURE - -MY-CLASS ::= CLASS { - &integerValue INTEGER UNIQUE, - &booleanValue BOOLEAN, - &stringValue PrintableString - } - -myobject MY-CLASS ::= { - &integerValue 12, - &booleanValue TRUE, - &stringValue "hejsan" - } -MyObjectSet MY-CLASS ::= { - myobject - } - -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-Release1 - CRITICALITY ignore - } - -relocationPreparation RANAP-ELEMENTARY-PROCEDURE ::= { - INITIATING MESSAGE INTEGER --Iu-ReleaseCommand - SUCCESSFUL OUTCOME Iu-ReleaseComplete - PROCEDURE CODE id-Iu-Release2 - CRITICALITY notify - } - -object3 RANAP-ELEMENTARY-PROCEDURE ::= { - &InitiatingMessage Iu-ReleaseCommand, - &SuccessfulOutcome Iu-ReleaseComplete, - &procedureCode id-Iu-Release3, - &criticality reject - } - -object4 RANAP-ELEMENTARY-PROCEDURE ::= { - &InitiatingMessage INTEGER, - &SuccessfulOutcome PrintableString, - &procedureCode id-Iu-Release4, - &criticality reject - } - -object5 RANAP-ELEMENTARY-PROCEDURE ::= { - &InitiatingMessage INTEGER, - &SuccessfulOutcome PrintableString, - &Outcome ProcedureCode, - &vartypvalue 12, - &infoObject object4, - &InfObjectSet MyObjectSet, - &procedureCode id-Iu-Release5, - &criticality reject - } - - -RANAP-ELEMENTARY-PROCEDURES RANAP-ELEMENTARY-PROCEDURE ::= { - iu-Release | - relocationPreparation , - ... - } - -RANAP-ELEMENTARY-PROCEDURES2 RANAP-ELEMENTARY-PROCEDURE ::= { - iu-Release | - relocationPreparation - } - - -OBJECTSET1 RANAP-ELEMENTARY-PROCEDURE ::= { - {INITIATING MESSAGE Iu-ReleaseCommand SUCCESSFUL OUTCOME Iu-ReleaseComplete PROCEDURE CODE id-Iu-Release1 CRITICALITY ignore} | {INITIATING MESSAGE Iu-ReleaseCommand PROCEDURE CODE id-Iu-Release2} - } - -OBJECTSET2 RANAP-ELEMENTARY-PROCEDURE ::= { - iu-Release | - {INITIATING MESSAGE Iu-ReleaseCommand SUCCESSFUL OUTCOME Iu-ReleaseComplete PROCEDURE CODE id-Iu-Release4 CRITICALITY ignore} | - relocationPreparation | - {INITIATING MESSAGE Iu-ReleaseCommand PROCEDURE CODE id-Iu-Release5} , - ... - } - -OBJECTSET3 RANAP-ELEMENTARY-PROCEDURE ::= { - iu-Release, - ... - } - -OBJECTSET4 RANAP-ELEMENTARY-PROCEDURE ::= { - iu-Release - } - -Iu-ReleaseCommand ::= SEQUENCE { - first INTEGER, - second BOOLEAN - } - -Iu-ReleaseComplete ::= INTEGER (1..510) - -ProcedureCode ::= INTEGER (0..255) -Criticality ::= ENUMERATED { reject, ignore, notify } -id-Iu-Release1 INTEGER ::= 1 -id-Iu-Release2 INTEGER ::= 2 -id-Iu-Release3 INTEGER ::= 3 -id-Iu-Release4 INTEGER ::= 4 -id-Iu-Release5 INTEGER ::= 5 - -END - - diff --git a/lib/asn1/test/asn1_SUITE_data/MAP-insertSubscriberData-def.py b/lib/asn1/test/asn1_SUITE_data/MAP-insertSubscriberData-def.py deleted file mode 100644 index 298319b0ed..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/MAP-insertSubscriberData-def.py +++ /dev/null @@ -1,102 +0,0 @@ -MAP-insertSubscriberData-def - { ccitt (0) identified-organization( 4) etsi( 0) mobileDomain(0) - gsm-Network( 1) modules( 3) map-Protocol( 4) version2(2) } -DEFINITIONS ::= - -BEGIN - -EXPORTS -InsertSubsDataArg, InsertSubsDatRes; -IMPORTS -IMSI, ISDN-AddressString, LMSI FROM MAP-commonDataTypes; - -InsertSubsDataArg ::= SEQUENCE{ - imsi [0] IMPLICIT IMSI OPTIONAL, - msisdn [1] IMPLICIT ISDN-AddressString OPTIONAL, - category [2] IMPLICIT OCTET STRING (SIZE(1)) OPTIONAL, - subscriberStatus [3] IMPLICIT SubscriberStatus OPTIONAL, - bearerServiceList [4] IMPLICIT SEQUENCE OF - OCTET STRING(SIZE(1)) OPTIONAL, - teleServiceList [6] IMPLICIT SEQUENCE OF - OCTET STRING(SIZE(1)) OPTIONAL, - provisionedSS [7] IMPLICIT SEQUENCE OF SS-Information OPTIONAL - } - -SS-Information ::= CHOICE{ - forwardingInfo [0] IMPLICIT ForwardingInfo, - callBarringInfoInfo [1] IMPLICIT CallBarringInfoInfo, - ss-Data [3] IMPLICIT SS-Data } - -SS-Data ::= SEQUENCE { - ss-Code OCTET STRING (SIZE(1)), - ss-Status [4] IMPLICIT OCTET STRING (SIZE(1)) - } - - -ForwardingInfo ::= SEQUENCE { - ss-Code OCTET STRING(SIZE(1)) OPTIONAL, - forwardingFeatureList ForwardingFeatureList - } - -CallBarringInfoInfo ::= SEQUENCE { - ss-Code OCTET STRING(SIZE(1)) OPTIONAL, - callBarringFeatureList CallBarringFeatureList} - -CallBarringFeatureList ::= SEQUENCE OF CallBarringFeature - -CallBarringFeature ::= SEQUENCE{ - basicService BasicServiceCode OPTIONAL, - ss-Status [2] IMPLICIT OCTET STRING(SIZE(1)) OPTIONAL - } - -InsertSubsDatRes ::= - SEQUENCE { - teleServiceList [1] IMPLICIT SEQUENCE OF - OCTET STRING (SIZE(1)) OPTIONAL, - bearerServiceList [2] IMPLICIT SEQUENCE OF - OCTET STRING (SIZE(1)) OPTIONAL, - ss-List [3] IMPLICIT SEQUENCE OF - OCTET STRING (SIZE(1)) OPTIONAL, - odb-GeneralData [4] IMPLICIT BIT STRING { - allOG-CallsBarred (0), - internationalOGCallsBarred (1), - internationalOGCallsNotToHPLMN-CountryBarred (2), - premiumRateInformationOGCallsBarred (3), - premiumRateEntertainementOGCallsBarred (4), - ss-AccessBarred (5) } (SIZE(6)) OPTIONAL, - regionalSubscriptionResponse [5] IMPLICIT ENUMERATED{ - msc-AreaRestricted (0), - tooManyZoneCodes (1), - zoneCodeConflict (2), - regionalSubscNotSupported (3) } OPTIONAL - } - - -ForwardingFeatureList ::= SEQUENCE OF ForwardingFeature - -ForwardingFeature ::= SEQUENCE{ - basicService BasicServiceCode OPTIONAL, - ss-Status [4] IMPLICIT OCTET STRING(SIZE(1)) OPTIONAL, - forwardedToNumber [5] ISDN-AddressString OPTIONAL, - forwardingOptions [6] IMPLICIT OCTET STRING(SIZE(1)) OPTIONAL, - noReplyConditionTime [7] IMPLICIT INTEGER(5..30) OPTIONAL - } - - -BasicServiceCode ::= CHOICE { - bearerService [2] IMPLICIT OCTET STRING(SIZE(1)), - teleService [3] IMPLICIT OCTET STRING(SIZE(1)) - } - - -BasicServiceGroupList ::= SEQUENCE OF - BasicServiceCode - - -SubscriberStatus ::= ENUMERATED { - serviceGranted (0), - operatorDeterminedBarring (1) - } - -END -- of MAP-insertSubscriberData-def - diff --git a/lib/asn1/test/asn1_SUITE_data/Mod.set.asn b/lib/asn1/test/asn1_SUITE_data/Mod.set.asn deleted file mode 100644 index 5dcd8706ae..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Mod.set.asn +++ /dev/null @@ -1,5 +0,0 @@ -Mod1.asn -Mod2.asn -Mod3.asn -Mod4.asn -Mod5.asn diff --git a/lib/asn1/test/asn1_SUITE_data/Mod1.asn b/lib/asn1/test/asn1_SUITE_data/Mod1.asn deleted file mode 100644 index cb29997985..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Mod1.asn +++ /dev/null @@ -1,18 +0,0 @@ -Mod1 DEFINITIONS AUTOMATIC TAGS ::= - -BEGIN - -IMPORTS - Co,Reg - FROM Mod5 - Name - FROM Mod4; - - -L ::= SEQUENCE { - country Co, - region Reg, - name Name -} - -END diff --git a/lib/asn1/test/asn1_SUITE_data/Mod2.asn b/lib/asn1/test/asn1_SUITE_data/Mod2.asn deleted file mode 100644 index cc22c6f13c..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Mod2.asn +++ /dev/null @@ -1,43 +0,0 @@ -Mod2 DEFINITIONS AUTOMATIC TAGS ::= - -BEGIN - -IMPORTS - Stat,Country - FROM Mod3 - L - FROM Mod1 - Time,LocName,ThingName,Name - FROM Mod4; - -T ::= SEQUENCE { - unit ENUMERATED{celsius,fahrenheit,kelvin}, - degree INTEGER, - location L, - time Time, - statistics Stat -} - -OtherName ::= SEQUENCE { - locationName LocName, - thingName ThingName -} - -FirstName ::= CHOICE { - firstname PrintableString, - nickname PrintableString -} - -FamilyName ::= SEQUENCE{ - prefix ENUMERATED{none,von,af}, - secondname PrintableString -} - -Lang ::= SEQUENCE{ - l PrintableString} - -Inhabitant ::= SEQUENCE { - name Name, - country Country} - -END diff --git a/lib/asn1/test/asn1_SUITE_data/Mod3.asn b/lib/asn1/test/asn1_SUITE_data/Mod3.asn deleted file mode 100644 index 8069bedcf9..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Mod3.asn +++ /dev/null @@ -1,33 +0,0 @@ -Mod3 DEFINITIONS AUTOMATIC TAGS ::= - -BEGIN - -IMPORTS - Name - FROM Mod4 - Lang, Inhabitant,FirstName,FamilyName - FROM Mod2 - TS, RFS, WS, HS - FROM Mod5; - -Stat ::= SEQUENCE { - tempstat TS, - rainfallstat RFS, - windstat WS, - humiditystat HS -} - -Country ::= SEQUENCE{ - name Name, - language Lang -} - -RegionName ::= Name -Inhabitants ::= SEQUENCE OF Inhabitant - -PersonName ::= SEQUENCE { - name1 FirstName, - name2 FamilyName -} - -END diff --git a/lib/asn1/test/asn1_SUITE_data/Mod4.asn b/lib/asn1/test/asn1_SUITE_data/Mod4.asn deleted file mode 100644 index 4a1aaff9dc..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Mod4.asn +++ /dev/null @@ -1,33 +0,0 @@ -Mod4 DEFINITIONS AUTOMATIC TAGS ::= - - -BEGIN - -IMPORTS - PersonName - FROM Mod3 - OtherName,FirstName,FamilyName - FROM Mod2; - -Time ::= SEQUENCE { - year OCTET STRING(SIZE(4)), - month OCTET STRING(SIZE(2)), - hour INTEGER, - minute INTEGER -} - -Name ::= CHOICE { - person PersonName, - othername OtherName -} - - - -LocName ::= SEQUENCE { - region ENUMERATED{gotaland,svealand,norrland}, - name PrintableString -} - -ThingName ::= PrintableString - -END diff --git a/lib/asn1/test/asn1_SUITE_data/Mod5.asn b/lib/asn1/test/asn1_SUITE_data/Mod5.asn deleted file mode 100644 index 71b483d0e0..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Mod5.asn +++ /dev/null @@ -1,37 +0,0 @@ -Mod5 DEFINITIONS AUTOMATIC TAGS ::= - -BEGIN - -IMPORTS - Country,RegionName,Inhabitants - FROM Mod3; -TS ::= SEQUENCE { - average INTEGER, - highest INTEGER, - lowest INTEGER -} - -RFS ::= SEQUENCE { - average INTEGER, - highest INTEGER -} - -WS ::= SEQUENCE { - average INTEGER, - highest INTEGER -} - -HS ::= SEQUENCE { - average INTEGER, - highest INTEGER, - lowest INTEGER -} - -Co ::= Country - -Reg ::= SEQUENCE { - name RegionName, - inhabitants Inhabitants -} - -END diff --git a/lib/asn1/test/asn1_SUITE_data/Mvrasn.set.asn b/lib/asn1/test/asn1_SUITE_data/Mvrasn.set.asn deleted file mode 100644 index 8a61da0160..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Mvrasn.set.asn +++ /dev/null @@ -1,7 +0,0 @@ -Mvrasn-11-6.asn -Mvrasn-21-4.asn -Mvrasn-20-6.asn -Mvrasn-19-6.asn -Mvrasn-15-6.asn -Mvrasn-18-6.asn -Mvrasn-14-6.asn diff --git a/lib/asn1/test/asn1_SUITE_data/P-Record.asn1db b/lib/asn1/test/asn1_SUITE_data/P-Record.asn1db Binary files differdeleted file mode 100644 index 13e1162c64..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/P-Record.asn1db +++ /dev/null diff --git a/lib/asn1/test/asn1_SUITE_data/P-Record.erl b/lib/asn1/test/asn1_SUITE_data/P-Record.erl deleted file mode 100644 index 9fc6f50d64..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/P-Record.erl +++ /dev/null @@ -1,244 +0,0 @@ -%% Generated by the Erlang ASN.1 BER-compiler version, utilizing bit-syntax:1.3.1.4 -%% Purpose: encoder and decoder to the types in mod P-Record - --module('P-Record'). --include("P-Record.hrl"). --define('RT_PER',asn1rt_per_bin). --export([encoding_rule/0]). --export([ -'enc_PersonnelRecord'/1, -'enc_ChildInformation'/1, -'enc_Name'/1, -'enc_EmployeeNumber'/1, -'enc_Date'/1 -]). - --export([ -'dec_PersonnelRecord'/2, -'dec_ChildInformation'/2, -'dec_Name'/2, -'dec_EmployeeNumber'/2, -'dec_Date'/2 -]). - --export([ -'v'/0 -]). - - - --export([encode/2,decode/2,encode_disp/2,decode_disp/2]). - -encoding_rule() -> - per_bin. - -encode(Type,Data) -> -case catch ?RT_PER:complete(encode_disp(Type,Data)) of - {'EXIT',{error,Reason}} -> - {error,Reason}; - {'EXIT',Reason} -> - {error,{asn1,Reason}}; - {Bytes,Len} -> - {ok,Bytes}; - X -> - {ok,X} -end. - -decode(Type,Data) -> -case catch decode_disp(Type,Data) of - {'EXIT',{error,Reason}} -> - {error,Reason}; - {'EXIT',Reason} -> - {error,{asn1,Reason}}; - {X,_Rest} -> - {ok,X}; - {X,_Rest,_Len} -> - {ok,X} -end. - -encode_disp('PersonnelRecord',Data) -> 'enc_PersonnelRecord'(Data); -encode_disp('ChildInformation',Data) -> 'enc_ChildInformation'(Data); -encode_disp('Name',Data) -> 'enc_Name'(Data); -encode_disp('EmployeeNumber',Data) -> 'enc_EmployeeNumber'(Data); -encode_disp('Date',Data) -> 'enc_Date'(Data); -encode_disp(Type,Data) -> exit({error,{asn1,{undefined_type,Type}}}). - - -decode_disp('PersonnelRecord',Data) -> 'dec_PersonnelRecord'(Data,mandatory); -decode_disp('ChildInformation',Data) -> 'dec_ChildInformation'(Data,mandatory); -decode_disp('Name',Data) -> 'dec_Name'(Data,mandatory); -decode_disp('EmployeeNumber',Data) -> 'dec_EmployeeNumber'(Data,mandatory); -decode_disp('Date',Data) -> 'dec_Date'(Data,mandatory); -decode_disp(Type,Data) -> exit({error,{asn1,{undefined_type,Type}}}). - - - - - -'enc_PersonnelRecord'(Val) -> -{Val1,Opt} = ?RT_PER:fixoptionals([{children,6}],Val), -[ -?RT_PER:setoptionals(Opt), - -%% attribute number 1 with type Externaltypereference6P-RecordName -'enc_Name'(?RT_PER:cindex(2,Val1,name)), - -%% attribute number 2 with type VisibleString -?RT_PER:encode_VisibleString([],?RT_PER:cindex(3,Val1,title)), - -%% attribute number 3 with type INTEGER -?RT_PER:encode_integer([],?RT_PER:cindex(4,Val1,number)), - -%% attribute number 4 with type VisibleString -?RT_PER:encode_VisibleString([],?RT_PER:cindex(5,Val1,dateOfHire)), - -%% attribute number 5 with type Externaltypereference10P-RecordName -'enc_Name'(?RT_PER:cindex(6,Val1,nameOfSpouse)), -case ?RT_PER:cindex(7,Val1,children) of -asn1_DEFAULT -> []; -_ -> - -%% attribute number 6 with type SEQUENCE OF -'enc_PersonnelRecord_children'(?RT_PER:cindex(7,Val1,children)) -end]. - -'enc_PersonnelRecord_children'({'PersonnelRecord_children',Val}) -> -'enc_PersonnelRecord_children'(Val); - -'enc_PersonnelRecord_children'(Val) -> -[ - - ?RT_PER:encode_length(undefined,length(Val)), - 'enc_PersonnelRecord_children_components'(Val, []) -]. -'enc_PersonnelRecord_children_components'([], Acc) -> lists:reverse(Acc); - -'enc_PersonnelRecord_children_components'([H|T], Acc) -> -'enc_PersonnelRecord_children_components'(T, ['enc_ChildInformation'(H) - - | Acc]). - -'dec_PersonnelRecord_children'(Bytes,Telltype) -> - -{Num,Bytes1} = ?RT_PER:decode_length(Bytes,undefined), -'dec_PersonnelRecord_children_components'(Num, Bytes1, Telltype, []). -'dec_PersonnelRecord_children_components'(0, Bytes, Telltype, Acc) -> - {lists:reverse(Acc), Bytes}; -'dec_PersonnelRecord_children_components'(Num, Bytes, Telltype, Acc) -> - {Term,Remain} = 'P-Record':'dec_ChildInformation'(Bytes,Telltype), - 'dec_PersonnelRecord_children_components'(Num-1, Remain, Telltype, [Term|Acc]). - - -'dec_PersonnelRecord'(Bytes,Telltype) -> -{Opt,Bytes1} = ?RT_PER:getoptionals(Bytes,1), -%% attribute number 1 with type Name -{Term1,Bytes2} = 'dec_Name'(Bytes1,telltype), - -%% attribute number 2 with type VisibleString -{Term2,Bytes3} = ?RT_PER:decode_VisibleString(Bytes2,[]), - -%% attribute number 3 with type INTEGER -{Term3,Bytes4} = ?RT_PER:decode_integer(Bytes3,[]), - -%% attribute number 4 with type VisibleString -{Term4,Bytes5} = ?RT_PER:decode_VisibleString(Bytes4,[]), - -%% attribute number 5 with type Name -{Term5,Bytes6} = 'dec_Name'(Bytes5,telltype), - -%% attribute number 6 with type SEQUENCE OF -{Term6,Bytes7} = case element(1,Opt) of -1 ->'dec_PersonnelRecord_children'(Bytes6, Telltype); -0 ->{[],Bytes6} - -end, -{{'PersonnelRecord',Term1,Term2,Term3,Term4,Term5,Term6},Bytes7}. - -'enc_ChildInformation'(Val) -> -{Val1,Opt} = ?RT_PER:fixoptionals([{name,1},{dateOfBirth,2}],Val), -[ -?RT_PER:setoptionals(Opt), -case ?RT_PER:cindex(2,Val1,name) of -asn1_NOVALUE -> []; -_ -> - -%% attribute number 1 with type Externaltypereference15P-RecordName -'enc_Name'(?RT_PER:cindex(2,Val1,name)) -end, -case ?RT_PER:cindex(3,Val1,dateOfBirth) of -asn1_NOVALUE -> []; -_ -> - -%% attribute number 2 with type VisibleString -?RT_PER:encode_VisibleString([],?RT_PER:cindex(3,Val1,dateOfBirth)) -end]. - - -'dec_ChildInformation'(Bytes,Telltype) -> -{Opt,Bytes1} = ?RT_PER:getoptionals(Bytes,2), -%% attribute number 1 with type Name -{Term1,Bytes2} = case element(1,Opt) of -1 ->'dec_Name'(Bytes1,telltype); -0 ->{asn1_NOVALUE,Bytes1} - -end, - -%% attribute number 2 with type VisibleString -{Term2,Bytes3} = case element(2,Opt) of -1 ->?RT_PER:decode_VisibleString(Bytes2,[]); -0 ->{asn1_NOVALUE,Bytes2} - -end, -{{'ChildInformation',Term1,Term2},Bytes3}. - -'enc_Name'(Val) -> -Val1 = ?RT_PER:list_to_record('Name', Val), -[ - -%% attribute number 1 with type VisibleString -?RT_PER:encode_VisibleString([],?RT_PER:cindex(2,Val1,givenName)), - -%% attribute number 2 with type VisibleString -?RT_PER:encode_VisibleString([],?RT_PER:cindex(3,Val1,initial)), - -%% attribute number 3 with type VisibleString -?RT_PER:encode_VisibleString([],?RT_PER:cindex(4,Val1,familyName))]. - - -'dec_Name'(Bytes,Telltype) -> - -%% attribute number 1 with type VisibleString -{Term1,Bytes1} = ?RT_PER:decode_VisibleString(Bytes,[]), - -%% attribute number 2 with type VisibleString -{Term2,Bytes2} = ?RT_PER:decode_VisibleString(Bytes1,[]), - -%% attribute number 3 with type VisibleString -{Term3,Bytes3} = ?RT_PER:decode_VisibleString(Bytes2,[]), -{{'Name',Term1,Term2,Term3},Bytes3}. - - -'enc_EmployeeNumber'({'EmployeeNumber',Val}) -> -'enc_EmployeeNumber'(Val); - -'enc_EmployeeNumber'(Val) -> -?RT_PER:encode_integer([],Val). - - -'dec_EmployeeNumber'(Bytes,Telltype) -> -?RT_PER:decode_integer(Bytes,[]). - - -'enc_Date'({'Date',Val}) -> -'enc_Date'(Val); - -'enc_Date'(Val) -> -?RT_PER:encode_VisibleString([],Val). - - -'dec_Date'(Bytes,Telltype) -> -?RT_PER:decode_VisibleString(Bytes,[]). - -'v'() -> -{'PersonnelRecord',{'Name',{74,111,104,110},[80],[83,109,105,116,104]},[68,105,114,101,99,116,111,114],51,[49,57,55,49,48,57,49,55],{'Name',{77,97,114,121},[84],[83,109,105,116,104]},[{'ChildInformation',{'Name',[82,97,108,112,104],[84],[83,109,105,116,104]},[49,57,53,55,49,49,49,49]},{'ChildInformation',{'Name',[83,117,115,97,110],[66],[74,111,110,101,115]},[49,57,53,57,48,55,49,55]}]}. - diff --git a/lib/asn1/test/asn1_SUITE_data/P-Record.hrl b/lib/asn1/test/asn1_SUITE_data/P-Record.hrl deleted file mode 100644 index 92aa1a44e2..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/P-Record.hrl +++ /dev/null @@ -1,17 +0,0 @@ -%% Generated by the Erlang ASN.1 compiler version:1.3.1.4 -%% Purpose: Erlang record definitions for each named and unnamed -%% SEQUENCE and SET, and macro definitions for each value -%% definition,in module P-Record - - - --record('PersonnelRecord',{ -name, title, number, dateOfHire, nameOfSpouse, children = asn1_DEFAULT}). - --record('ChildInformation',{ -name = asn1_NOVALUE, dateOfBirth = asn1_NOVALUE}). - --record('Name',{ -givenName, initial, familyName}). - --define('v', {'PersonnelRecord',{'Name',{74,111,104,110},[80],[83,109,105,116,104]},[68,105,114,101,99,116,111,114],51,[49,57,55,49,48,57,49,55],{'Name',{77,97,114,121},[84],[83,109,105,116,104]},[{'ChildInformation',{'Name',[82,97,108,112,104],[84],[83,109,105,116,104]},[49,57,53,55,49,49,49,49]},{'ChildInformation',{'Name',[83,117,115,97,110],[66],[74,111,110,101,115]},[49,57,53,57,48,55,49,55]}]}). diff --git a/lib/asn1/test/asn1_SUITE_data/PDUs.py b/lib/asn1/test/asn1_SUITE_data/PDUs.py deleted file mode 100644 index 907348193f..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/PDUs.py +++ /dev/null @@ -1,325 +0,0 @@ -PDUs DEFINITIONS ::= - --- Search for 'org' to find changes for erlang. - --- SnmpMgmtCom and PDUs only for dbg. - - -BEGIN -EXPORTS SnmpPrivMsg, SnmpAuthMsg, SnmpMgmtCom, PDUs; - --- From RFC 1442 - - -- names of objects - - ObjectName ::= - OBJECT IDENTIFIER - - - -- syntax of objects - - ObjectSyntax ::= - CHOICE { - simple - SimpleSyntax, - - -- note that SEQUENCEs for conceptual tables and - -- rows are not mentioned here... - - applicationWide - ApplicationSyntax - } - - - -- built-in ASN.1 types - - SimpleSyntax ::= - CHOICE { - -- INTEGERs with a more restrictive range - -- may also be used - integerValue - INTEGER, - - stringValue - OCTET STRING, - - objectIDValue - OBJECT IDENTIFIER, - - -- only the enumerated form is allowed - bitValue - BIT STRING - } - - - -- indistinguishable from INTEGER, but never needs more than - -- 32Bits for a two's complement representation - Integer32 ::= - [UNIVERSAL 2] - IMPLICIT INTEGER (-2147483648..2147483647) - - - -- applicationWide types - - ApplicationSyntax ::= - CHOICE { - ipAddressValue - IpAddress, - - counterValue - Counter32, - - gaugeValue - Gauge32, - - timeticksValue - TimeTicks, - - arbitraryValue - Opaque, - - nsapAddressValue - NsapAddress, - - bigCounterValue - Counter64, - - unsignedIntegerValue - UInteger32 - } - - -- in networkByte order - -- (this is a tagged type for historical reasons) - IpAddress ::= - [APPLICATION 0] - IMPLICIT OCTET STRING (SIZE (4)) - - - - - -- this wraps - Counter32 ::= - [APPLICATION 1] - IMPLICIT INTEGER (0..4294967295) - - -- this doesn't wrap - Gauge32 ::= - [APPLICATION 2] - IMPLICIT INTEGER (0..4294967295) - - -- hundredths of seconds since an epoch - TimeTicks ::= - [APPLICATION 3] - IMPLICIT INTEGER (0..4294967295) - - -- for backwardCompatibility only - Opaque ::= - [APPLICATION 4] - IMPLICIT OCTET STRING - - -- for OSI NSAP addresses - -- (this is a tagged type for historical reasons) - NsapAddress ::= - [APPLICATION 5] --- org: IMPLICIT OCTET STRING (SIZE (1 | 4..21)) - IMPLICIT OCTET STRING - - -- for counters that wrap in less than one hour with only 32 bits - Counter64 ::= - [APPLICATION 6] - IMPLICIT INTEGER (0..18446744073709551615) - - -- an unsigned 32Bit quantity - UInteger32 ::= - [APPLICATION 7] - IMPLICIT INTEGER (0..4294967295) - - --- From RFC 1445 - - SnmpPrivMsg ::= [1] IMPLICIT SEQUENCE { - privDst - OBJECT IDENTIFIER, - privData - [1] IMPLICIT OCTET STRING - } - - SnmpAuthMsg ::= [1] IMPLICIT SEQUENCE { - authInfo - ANY, -- defined by authentication protocol - authData - SnmpMgmtCom - } - - SnmpMgmtCom ::= [2] IMPLICIT SEQUENCE { - dstParty - OBJECT IDENTIFIER, - srcParty - OBJECT IDENTIFIER, - context - OBJECT IDENTIFIER, - pdu - PDUs - } - - --- From RFC 1448 - - -- org: no tag at all. we need a tag to test 'PDUs'. - PDUs ::= [PRIVATE 1] - -- remove tag when 'PDUs' only is used in another type. - CHOICE { - getRequest - GetRequestPdu, - - getNextRequest - GetNextRequestPdu, - - getBulkRequest - GetBulkRequestPdu, - - response - ResponsePdu, - - setRequest - SetRequestPdu, - - informRequest - InformRequestPdu, - - snmpV2Trap - SNMPv2TrapPdu - } - - -- PDUs - - GetRequestPdu ::= - [0] - IMPLICIT PDU - - GetNextRequestPdu ::= - [1] - IMPLICIT PDU - - ResponsePdu ::= - [2] - IMPLICIT PDU - - SetRequestPdu ::= - [3] - IMPLICIT PDU - - -- [4] is obsolete - - GetBulkRequestPdu ::= - [5] - IMPLICIT BulkPDU - - InformRequestPdu ::= - [6] - IMPLICIT PDU - - SNMPv2TrapPdu ::= - [7] - IMPLICIT PDU - - - maxBindings - INTEGER ::= 2147483647 - - PDU ::= - SEQUENCE { - requestId - Integer32, - - errorStatus -- sometimes ignored - INTEGER { - noError(0), - tooBig(1), - noSuchName(2), -- for proxy compatibility - badValue(3), -- for proxy compatibility - readOnly(4), -- for proxy compatibility - genErr(5), - noAccess(6), - wrongType(7), - wrongLength(8), - wrongEncoding(9), - wrongValue(10), - noCreation(11), - inconsistentValue(12), - resourceUnavailable(13), - commitFailed(14), - undoFailed(15), - authorizationError(16), - notWritable(17), - inconsistentName(18) - }, - - errorIndex -- sometimes ignored - INTEGER (0..maxBindings), - - variableBindings -- values are sometimes ignored - VarBindList - } - - - BulkPDU ::= -- MUST be identical in - SEQUENCE { -- structure to PDU - requestId - Integer32, - - nonRepeaters - INTEGER (0..maxBindings), - - maxRepetitions - INTEGER (0..maxBindings), - - variableBindings -- values are ignored - VarBindList - } - - - VarBind ::= - SEQUENCE { - name - ObjectName, - - data CHOICE { - value - ObjectSyntax, - - unSpecified -- in retrieval requests - NULL, - - -- exceptions in responses - noSuchObject[0] - IMPLICIT NULL, - - noSuchInstance[1] - IMPLICIT NULL, - - endOfMibView[2] - IMPLICIT NULL - } - } - - - -- variableBinding list - - VarBindList ::= - SEQUENCE OF VarBind - --- org: --- VarBindList ::= --- SEQUENCE (SIZE (0..maxBindings)) OF --- VarBind - -END - - - - - - - - diff --git a/lib/asn1/test/asn1_SUITE_data/Pattern.asn b/lib/asn1/test/asn1_SUITE_data/Pattern.asn deleted file mode 100644 index 730b4ba32a..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Pattern.asn +++ /dev/null @@ -1,8 +0,0 @@ -Pattern DEFINITIONS AUTOMATIC TAGS ::= - -BEGIN - -DateAndTime ::= VisibleString (PATTERN "\d#2/\d#2/\d#4-\d#2:\d#2") --- DD/MM/YYY-HH:MM - -END
\ No newline at end of file diff --git a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 index c3d54dbbb3..cc0e61422a 100644 --- a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 @@ -47,5 +47,15 @@ BEGIN b Bool, i4 INTEGER (0..63) } - + + ASeq ::= SEQUENCE { + e254 BOOLEAN, + i254 INTEGER (0..254), + e255 BOOLEAN, + i255 INTEGER (0..255), + e256 BOOLEAN, + i256 INTEGER (0..256), + e BOOLEAN, + magic INTEGER + } END diff --git a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 index cfaf4cf034..08e7f94ab6 100644 --- a/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/PrimStrings.asn1 @@ -5,7 +5,7 @@ BEGIN Bs1 ::= BIT STRING Bs2 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (7)) Bs3 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (1..7)) - Bs4 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (1..32)) + Bs4 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } Bs5 ::= BIT STRING {su(0), mo(17), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (1..32)) Bs6 ::= BIT STRING {su(0), mo(17), tu(2), we(3), th(4), fr(5), sa(6)} (SIZE (16..32)) Bs7 ::= BIT STRING (SIZE (24)) @@ -55,10 +55,15 @@ BS1024 ::= BIT STRING (SIZE (1024)) OsExpCon ::= [60] EXPLICIT OCTET STRING OsExpPri ::= [PRIVATE 61] EXPLICIT OCTET STRING OsExpApp ::= [APPLICATION 62] EXPLICIT OCTET STRING + OsFrag ::= OCTET STRING (SIZE (0..100000)) FixedOs65536 ::= OCTET STRING (SIZE (65536)) FixedOs65537 ::= OCTET STRING (SIZE (65537)) + OsFragExt ::= OCTET STRING (SIZE (0..100000, ...)) + FixedOs65536Ext ::= OCTET STRING (SIZE (65536, ...)) + FixedOs65537Ext ::= OCTET STRING (SIZE (65537, ...)) + OsFixedStrings ::= SEQUENCE { b1 BOOLEAN, -- Unalign s0 OCTET STRING (SIZE (0)), @@ -72,6 +77,32 @@ BS1024 ::= BIT STRING (SIZE (1024)) i INTEGER (0..1024) } + OsFixedStringsExt ::= SEQUENCE { + b1 BOOLEAN, -- Unalign + s0 OCTET STRING (SIZE (0, ...)), + s1 OCTET STRING (SIZE (1, ...)), + s2 OCTET STRING (SIZE (2, ...)), + s3 OCTET STRING (SIZE (3, ...)), + b2 BOOLEAN, -- Unalign + s255 OCTET STRING (SIZE (255, ...)), + s256 OCTET STRING (SIZE (256, ...)), + s257 OCTET STRING (SIZE (257, ...)), + i INTEGER (0..1024) + } + + OsVarStringsExt ::= SEQUENCE { + b1 BOOLEAN, -- Unalign + s0 OCTET STRING (SIZE (0, ...)), + s1 OCTET STRING (SIZE (0..1, ...)), + s2 OCTET STRING (SIZE (1..2, ...)), + s3 OCTET STRING (SIZE (2..3, ...)), + b2 BOOLEAN, -- Unalign + s255 OCTET STRING (SIZE (254..255, ...)), + s256 OCTET STRING (SIZE (255..256, ...)), + s257 OCTET STRING (SIZE (256..257, ...)), + i INTEGER (0..1024) + } + OsAlignment ::= SEQUENCE { b1 BOOLEAN, s1 Os, @@ -82,6 +113,52 @@ BS1024 ::= BIT STRING (SIZE (1024)) i INTEGER (0..63) } + IA5FixedStrings ::= SEQUENCE { + b1 BOOLEAN, -- Unalign + s0 IA5String (SIZE (0)), + s1 IA5String (SIZE (1)), + s2 IA5String (SIZE (2)), + s3 IA5String (SIZE (3)), + b2 BOOLEAN, -- Unalign + s4 IA5String (SIZE (4)), + b3 BOOLEAN, -- Unalign + s255 IA5String (SIZE (255)), + s256 IA5String (SIZE (256)), + s257 IA5String (SIZE (257)), + i INTEGER (0..1024) + } + + IA5FixedStringsExt ::= SEQUENCE { + b1 BOOLEAN, -- Unalign + s0 IA5String (SIZE (0, ...)), + s1 IA5String (SIZE (1, ...)), + s2 IA5String (SIZE (2, ...)), + s3 IA5String (SIZE (3, ...)), + b2 BOOLEAN, -- Unalign + s4 IA5String (SIZE (4, ...)), + b3 BOOLEAN, -- Unalign + s255 IA5String (SIZE (255, ...)), + s256 IA5String (SIZE (256, ...)), + s257 IA5String (SIZE (257, ...)), + i INTEGER (0..1024) + } + + IA5VarStringsExt ::= SEQUENCE { + b1 BOOLEAN, -- Unalign + s0 IA5String (SIZE (0, ...)), + s1 IA5String (SIZE (0..1, ...)), + s2 IA5String (SIZE (1..2, ...)), + s3 IA5String (SIZE (2..3, ...)), + b2 BOOLEAN, -- Unalign + s4 IA5String (SIZE (3..4, ...)), + b3 BOOLEAN, -- Unalign + s255 IA5String (SIZE (254..255, ...)), + s256 IA5String (SIZE (255..256, ...)), + s257 IA5String (SIZE (256..257, ...)), + i INTEGER (0..1024) + } + + Ns ::= NumericString NsCon ::= [70] NumericString NsExpCon ::= [71] EXPLICIT NumericString diff --git a/lib/asn1/test/asn1_SUITE_data/ROSE.asn1 b/lib/asn1/test/asn1_SUITE_data/ROSE.asn1 deleted file mode 100644 index 2fefae3caf..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/ROSE.asn1 +++ /dev/null @@ -1,449 +0,0 @@ -ROSE DEFINITIONS IMPLICIT TAGS ::= - - -BEGIN - -OPERATION ::= CLASS -{ - &ArgumentType OPTIONAL, - &argumentTypeOptional BOOLEAN OPTIONAL, - &returnResult BOOLEAN DEFAULT TRUE, - &ResultType OPTIONAL, - &resultTypeOptional BOOLEAN OPTIONAL, - &Errors ERROR OPTIONAL, - &Linked OPERATION OPTIONAL, - &synchronous BOOLEAN DEFAULT FALSE, - &idempotent BOOLEAN DEFAULT FALSE, - &alwaysReturns BOOLEAN DEFAULT TRUE, - &InvokePriority Priority OPTIONAL, - &ResultPriority Priority OPTIONAL, - &operationCode Code UNIQUE OPTIONAL - } -WITH SYNTAX - { - [ARGUMENT &ArgumentType [OPTIONAL &argumentTypeOptional]] - [RESULT &ResultType [OPTIONAL &resultTypeOptional]] - [RETURN RESULT &returnResult] - [ERRORS &Errors] - [LINKED &Linked] - [SYNCHRONOUS &synchronous] - [IDEMPOTENT &idempotent] - [ALWAYS RESPONDS &alwaysReturns] - [INVOKE PRIORITY &InvokePriority] - [RESULT-PRIORITY &ResultPriority] - [CODE &operationCode] - } - -ERROR ::= CLASS -{ - &ParameterType OPTIONAL, - ¶meterTypeOptional BOOLEAN OPTIONAL, - &ErrorPriority Priority OPTIONAL, - &errorCode Code UNIQUE OPTIONAL - } -WITH SYNTAX -{ - [PARAMETER &ParameterType [OPTIONAL ¶meterTypeOptional]] - [PRIORITY &ErrorPriority] - [CODE &errorCode] - } - -OPERATION-PACKAGE ::= CLASS -{ - &Both OPERATION OPTIONAL, - &Consumer OPERATION OPTIONAL, - &Supplier OPERATION OPTIONAL, - &id OBJECT IDENTIFIER UNIQUE OPTIONAL - } -WITH SYNTAX -{ - [OPERATIONS &Both] - [CONSUMER INVOKES &Supplier] - [SUPPLIER INVOKES &Consumer] - [ID &id] - } - -CONNECTION-PACKAGE ::= CLASS -{ - &bind OPERATION DEFAULT emptyBind, - &unbind OPERATION DEFAULT emptyUnbind, - &responderCanUnbind BOOLEAN DEFAULT FALSE, - &unbindCanFail BOOLEAN DEFAULT FALSE, - &id OBJECT IDENTIFIER UNIQUE OPTIONAL - } -WITH SYNTAX -{ - [BIND &bind] - [UNBIND &unbind] - [RESPONDER UNBIND &responderCanUnbind] - [FAILURE TO UNBIND &unbindCanFail] - [ID &id] - } - -CONTRACT ::= CLASS -{ - &connection CONNECTION-PACKAGE OPTIONAL, - &OperationsOf OPERATION-PACKAGE OPTIONAL, - &InitiatorConsumerOf OPERATION-PACKAGE OPTIONAL, - &InitiatorSupplierOf OPERATION-PACKAGE OPTIONAL, - &id OBJECT IDENTIFIER UNIQUE OPTIONAL - } -WITH SYNTAX -{ - [CONNECTION &connection] - [OPERATIONS OF &OperationsOf] - [INITIATOR CONSUMER OF &InitiatorConsumerOf] - [RESPONDER CONSUMER OF &InitiatorSupplierOf] - [ID &id] -} - -ROS-OBJECT-CLASS ::= CLASS -{ - &Is ROS-OBJECT-CLASS OPTIONAL, - &Initiates CONTRACT OPTIONAL, - &Responds CONTRACT OPTIONAL, - &InitiatesAndResponds CONTRACT OPTIONAL, - &id OBJECT IDENTIFIER UNIQUE - } -WITH SYNTAX -{ - [IS &Is] - [BOTH &InitiatesAndResponds] - [INITIATES &Initiates] - [RESPONDS &Responds] - ID &id - } - -Code ::= CHOICE -{ - local INTEGER, - global OBJECT IDENTIFIER - } - -Priority ::= INTEGER (0..MAX) - -ROS {InvokeId:InvokeIdSet,OPERATION:Invokable,OPERATION:Returnable} ::= CHOICE - { - invoke [1] Invoke {{InvokeIdSet}, {Invokable}}, - returnResult [2] ReturnResult {{Returnable}}, - returnError [3] ReturnError {{Errors{{Returnable}}}}, - reject [4] Reject - } -(CONSTRAINED BY {-- must conform to the above definition --} - ! RejectProblem : general-unrecognizedPDU) - -Invoke {InvokeId:InvokeIdSet, OPERATION:Operations} ::= SEQUENCE -{ - invokeId InvokeId (InvokeIdSet) - (CONSTRAINED BY {-- must be unambiguous --} - ! RejectProblem : invoke-duplicateInvocation), - linkedId CHOICE { - present [0] IMPLICIT present < InvokeId, - absent [1] IMPLICIT NULL - } - (CONSTRAINED BY {-- must identify an outstanding operation --} - ! RejectProblem : invoke-unrecognizedLinkedId) - (CONSTRAINED BY {-- which has one or more linked operations--} - ! RejectProblem : invoke-linkedResponseUnexpected) - OPTIONAL, - opcode OPERATION.&operationCode - ({Operations} - ! RejectProblem : invoke-unrecognizedOperation), - argument OPERATION.&ArgumentType - ({Operations} {@opcode} - ! RejectProblem : invoke-mistypedArgument) - OPTIONAL - } -(CONSTRAINED BY {-- must conform to the above definition --} - ! RejectProblem : general-mistypedPDU) -( -WITH COMPONENTS -{..., - linkedId ABSENT - } -| WITH COMPONENTS -{..., - linkedId PRESENT, - opcode - (CONSTRAINED BY {-- must be in the &Linked field of the associated operation -- - } - ! RejectProblem : invoke-unexpectedLinkedOperation) - } -) - -ReturnResult {OPERATION:Operations}::= SEQUENCE -{ - invokeId InvokeId - (CONSTRAINED BY {-- must be that for an outstanding operation --} - ! RejectProblem:returnResult-unrecognizedInvocation) - (CONSTRAINED BY {-- which returns a result --} - ! RejectProblem:returnResult-resultResponseUnexpected), - result SEQUENCE - { - opcode OPERATION.&operationCode - ({Operations})(CONSTRAINED BY {-- identified by invokeId --} - ! RejectProblem:returnResult-unrecognizedInvocation), - result OPERATION.&ResultType ({Operations} {@.opcode} - ! RejectProblem:returnResult-mistypedResult) - } - OPTIONAL - } -(CONSTRAINED BY {-- must conform to the above definition -- - } -! RejectProblem:general-mistypedPDU) - -ReturnError {ERROR:Errors} ::= SEQUENCE -{ - invokeId InvokeId - (CONSTRAINED BY {-- must be that for an outstanding operation -- - } - ! RejectProblem : returnError-unrecognizedInvocation) - (CONSTRAINED BY {-- which returns an error -- - } - ! RejectProblem : returnError-errorResponseUnexpected), - errcode ERROR.&errorCode - ({Errors} - ! RejectProblem : returnError-unrecognizedError) - (CONSTRAINED BY {-- must be in the &Errors field of the associated operation -- - } - ! RejectProblem : returnError-unexpectedError), - parameter ERROR.&ParameterType - ({Errors}{@errcode} - ! RejectProblem : returnError-mistypedParameter) OPTIONAL - } -(CONSTRAINED BY {-- must conform to the above definition -- - } -! RejectProblem : general-mistypedPDU) - -Reject ::= SEQUENCE -{ - invokeId InvokeId, - problem CHOICE - { - general [0] GeneralProblem, - invoke [1] InvokeProblem, - returnResult [2] ReturnResultProblem, - returnError [3] ReturnErrorProblem - } - } -(CONSTRAINED BY {-- must conform to the above definition -- - } -! RejectProblem : general-mistypedPDU) - -GeneralProblem ::= INTEGER -{ - unrecognizedPDU (0), - mistypedPDU (1), - badlyStructuredPDU (2) - } - -InvokeProblem ::= INTEGER -{ - duplicateInvocation (0), - unrecognizedOperation (1), - mistypedArgument (2), - resourceLimitation (3), - releaseInProgress (4), - unrecognizedLinkedId (5), - linkedResponseUnexpected (6), - unexpectedLinkedOperation (7) - } - -ReturnResultProblem ::= INTEGER -{ - unrecognizedInvocation (0), - resultResponseUnexpected (1), - mistypedResult (2) - } - -ReturnErrorProblem ::= INTEGER -{ - unrecognizedInvocation (0), - errorResponseUnexpected (1), - unrecognizedError (2), - unexpectedError (3), - mistypedParameter (4) - } - -RejectProblem ::= INTEGER -{ - general-unrecognizedPDU (0), - general-mistypedPDU (1), - general-badlyStructuredPDU (2), - invoke-duplicateInvocation (10), - invoke-unrecognizedOperation (11), - invoke-mistypedArgument (12), - invoke-resourceLimitation (13), - invoke-releaseInProgress (14), - invoke-unrecognizedLinkedId (15), - invoke-linkedResponseUnexpected (16), - invoke-unexpectedLinkedOperation (17), - returnResult-unrecognizedInvocation (20), - returnResult-resultResponseUnexpected (21), - returnResult-mistypedResult (22), - returnError-unrecognizedInvocation (30), - returnError-errorResponseUnexpected (31), - returnError-unrecognizedError (32), - returnError-unexpectedError (33), - returnError-mistypedParameter (34) - } - -InvokeId ::= CHOICE -{ - present INTEGER, - absent NULL - } - -noInvokeId InvokeId ::= absent:NULL - -NoInvokeId InvokeId ::= {noInvokeId} - -Errors {OPERATION:Operations} ERROR ::= {Operations.&Errors} - -Bind {OPERATION:operation} ::= CHOICE -{ - bind-invoke [16] OPERATION.&ArgumentType({operation}), - bind-result [17] OPERATION.&ResultType ({operation}), - bind-error [18] OPERATION.&Errors.&ParameterType ({operation}) - } - -Unbind {OPERATION:operation} ::= CHOICE -{ - unbind-invoke [19] OPERATION.&ArgumentType({operation}), - unbind-result [20] OPERATION.&ResultType ({operation}), - unbind-error [21] OPERATION.&Errors.&ParameterType ({operation}) - } - -emptyBind OPERATION ::= {ERRORS {refuse} SYNCHRONOUS TRUE} - -emptyUnbind OPERATION ::= { SYNCHRONOUS TRUE } - -refuse ERROR ::= {CODE local:-1} - -no-op OPERATION ::= - { - IDEMPOTENT TRUE - ALWAYS RESPONDS FALSE - CODE local:-1 - } - -Forward {OPERATION:OperationSet} OPERATION ::= -{ - OperationSet | - OperationSet.&Linked.&Linked | - OperationSet.&Linked.&Linked.&Linked.&Linked - } - -Reverse {OPERATION:OperationSet} OPERATION ::= -{Forward{{OperationSet.&Linked}}} - -ConsumerPerforms {OPERATION-PACKAGE:package} OPERATION ::= -{ - Forward{{package.&Consumer}} | - Forward{{package.&Both}} | - Reverse{{package.&Supplier}} | - Reverse{{package.&Both}} - } - -SupplierPerforms {OPERATION-PACKAGE:package} OPERATION ::= -{ - Forward{{package.&Supplier}} | - Forward{{package.&Both}} | - Reverse{{package.&Consumer}} | - Reverse{{package.&Both}} - } - -AllOperations {OPERATION-PACKAGE:package} OPERATION ::= -{ - ConsumerPerforms {package} | - SupplierPerforms {package} - } - -recode {OPERATION:operation, Code:code} OPERATION ::= -{ - ARGUMENT operation.&ArgumentType - OPTIONAL operation.&argumentTypeOptional - RESULT operation.&ResultType - OPTIONAL operation.&resultTypeOptional - RETURN RESULT operation.&returnResult - ERRORS {operation.&Errors} - LINKED {operation.&Linked} - SYNCHRONOUS operation.&synchronous - ALWAYS RESPONDS operation.&alwaysReturns - INVOKE PRIORITY {operation.&InvokePriority} - RESULT-PRIORITY {operation.&ResultPriority} - CODE code - } - -switch {OPERATION-PACKAGE:package, OBJECT IDENTIFIER:id} OPERATION-PACKAGE ::= -{ - OPERATIONS {package.&Both} - CONSUMER INVOKES {package.&Consumer} - SUPPLIER INVOKES {package.&Supplier} - ID id - } - -combine {OPERATION-PACKAGE:ConsumerConsumes,OPERATION-PACKAGE:ConsumerSupplies, - OPERATION-PACKAGE:base - } OPERATION-PACKAGE ::= -{ - OPERATIONS {ConsumerConsumes.&Both | ConsumerSupplies.&Both} - CONSUMER INVOKES {ConsumerConsumes.&Consumer | ConsumerSupplies.&Supplier} - SUPPLIER INVOKES {ConsumerConsumes.&Supplier | ConsumerSupplies.&Consumer} - ID base.&id - } - -ROS-SingleAS {InvokeId:InvokeIdSet, OPERATION-PACKAGE:package} ::= ROS -{{InvokeIdSet}, {AllOperations{package}}, {AllOperations{package}}} - -ROS-ConsumerAS {InvokeId:InvokeIdSet, OPERATION-PACKAGE:package} ::= ROS -{{InvokeIdSet}, {ConsumerPerforms{package}}, {SupplierPerforms{package}}} - -ROS-SupplierAS {InvokeId:InvokeIdSet, OPERATION-PACKAGE:package} ::= ROS -{{InvokeIdSet}, {SupplierPerforms{package}}, {ConsumerPerforms{package}}} - -probe OPERATION ::= - { - ARGUMENT SEQUENCE - { - invokeId [0] InvokeId - } - RESULT ENUMERATED{running(0), finished(1), unknown(2), ...} - IDEMPOTENT TRUE - CODE local:-2 - } - -acknowledge OPERATION ::= - { - ARGUMENT InvokeId - RESULT ENUMERATED{acknowledged(0), unknown(1), ...} - IDEMPOTENT TRUE - CODE local:-3 - } - -ProbeAndAcknowledge OPERATION ::= {probe | acknowledge} - -cancel OPERATION ::= - { - ARGUMENT InvokeId - ERRORS {cancelFailed} - IDEMPOTENT TRUE - CODE local:-4 - } - -cancelFailed ERROR ::= - { - PARAMETER SET - { - problem [0] CancelProblem, - operation [1] InvokeId - } - CODE local:-2 - } - -CancelProblem ::= ENUMERATED -{unknownOperation(0), tooLate(1), operationNotCancellable(2), ...} - -cancelled ERROR ::= {CODE local:-3} - -END -- end of useful definitions. diff --git a/lib/asn1/test/asn1_SUITE_data/SeqDefault.asn1 b/lib/asn1/test/asn1_SUITE_data/SeqDefault.asn1 index 99e79da972..5c8583884a 100644 --- a/lib/asn1/test/asn1_SUITE_data/SeqDefault.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/SeqDefault.asn1 @@ -74,4 +74,15 @@ SeqIn ::= SEQUENCE intIn INTEGER DEFAULT 12 } +SeqExp ::= SEQUENCE +{ + bool BOOLEAN, + ..., + int INTEGER +} + +SeqDef4 ::= SEQUENCE { + seq SeqExp DEFAULT { bool TRUE, int 42 } +} + END diff --git a/lib/asn1/test/asn1_SUITE_data/SeqOf.asn1 b/lib/asn1/test/asn1_SUITE_data/SeqOf.asn1 index 330944cf5c..888dbe5dd7 100644 --- a/lib/asn1/test/asn1_SUITE_data/SeqOf.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/SeqOf.asn1 @@ -62,4 +62,13 @@ Empty ::= SEQUENCE { } +SeqExt ::= SEQUENCE +{ + b1 BOOLEAN, + s1 SEQUENCE SIZE (1..3, ...) OF SeqIn, + b2 BOOLEAN, + s2 SEQUENCE SIZE (0..1024, ...) OF SeqIn, + magic INTEGER +} + END diff --git a/lib/asn1/test/asn1_SUITE_data/SetDefault.asn1 b/lib/asn1/test/asn1_SUITE_data/SetDefault.asn1 index cb9e0ead62..0bbe301ae7 100644 --- a/lib/asn1/test/asn1_SUITE_data/SetDefault.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/SetDefault.asn1 @@ -30,4 +30,15 @@ SetIn ::= SET intIn INTEGER DEFAULT 12 } +SetDef4 ::= SET { + set SetExt DEFAULT { intIn 42, boolIn TRUE } +} + +SetExt ::= SET +{ + boolIn BOOLEAN, + ..., + intIn INTEGER +} + END diff --git a/lib/asn1/test/asn1_SUITE_data/TConstr.asn1 b/lib/asn1/test/asn1_SUITE_data/TConstr.asn1 index 63f5dbde77..e2e0a11dc4 100644 --- a/lib/asn1/test/asn1_SUITE_data/TConstr.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/TConstr.asn1 @@ -51,6 +51,12 @@ Seq2 ::= SEQUENCE { } } +Deeper ::= SEQUENCE { + a SEQUENCE {aa INTEGER, + s SEQUENCE { ab MYCLASS.&id ({ObjectSet}), + ac INTEGER }}, + b SEQUENCE {ba INTEGER, bb MYCLASS.&Type ({ObjectSet}{@a.s.ab})} +} -- following from Peter's definitions diff --git a/lib/asn1/test/asn1_SUITE_data/Tst.py b/lib/asn1/test/asn1_SUITE_data/Tst.py deleted file mode 100644 index d80b32dad5..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Tst.py +++ /dev/null @@ -1,153 +0,0 @@ -Tst { 2 6 6 24 7 1 } DEFINITIONS IMPLICIT TAGS ::= - -BEGIN - ---EXPORTS SomeSet , Id0 , Aset,Id1 ,A,B,C, --- Uhh ,Foo ,Cho,Person,Hobbe,Robbe,X,Y; - -IMPORTS Fooo FROM Bobby; - - -Robbe ::= SET { - ttt TT } - -Koo ::= SET { - c CHOICE { - a INTEGER, - b BOOLEAN }, - s SET OF Id0 } - - -Hobbe ::= [APPLICATION 1] SET { - aaa [0] SET OF INTEGER, - bbb [1] UU - } - -UU ::= PP -PP ::= CHOICE { - cc [1] CHOICE { - a [0] INTEGER, - b [1] BOOLEAN, - c [2] BIT STRING }, - ii [0] Id0 - } - - -TT ::= SS -SS ::= SET { - b BOOLEAN DEFAULT TRUE - } - -Aset ::= [PRIVATE 2] SET OF Uhh - - - -SomeSet ::= [PRIVATE 3] IMPLICIT SET { - aaaa [2] SET{ - ggg [0] INTEGER}, - kkkk [1] SET OF Id2, - booby [4] OCTET STRING, - puck [3] INTEGER {red(0),blue(1),yellow(-2)}, - baby [5] IMPLICIT Id1, - bool [6] BOOLEAN } - - -Id0 ::= INTEGER (4 .. 99) - -Id1 ::= Id0 - -Id2 ::= [PRIVATE 4] EXPLICIT Id1 - - -Uhh ::= SET { - a [1] IMPLICIT Id1} - - - -Soon ::= [PRIVATE 5] Moon - -Moon ::= [PRIVATE 6] IMPLICIT Person - - -Person ::= [PRIVATE 7] IMPLICIT SEQUENCE { - szzzs SET OF SET { - aaa [0] INTEGER, - bbb [1] Id0}, - cho Cho, - name OCTET STRING , - location INTEGER, - asss Aset, - oops [2] IMPLICIT SET { - q [0] INTEGER, - p [1] Uhh}, - on INTEGER, - mybits [3] IMPLICIT BIT STRING, - foo Foo, - age INTEGER, - hobbe [5] SEQUENCE { - a [4] CHOICE { - a INTEGER, - b BOOLEAN }, - b [5] Id0}} - - - - - -Foo ::= [PRIVATE 8] IMPLICIT SEQUENCE { - goofy [3] INTEGER OPTIONAL, - somestring [10] IMPLICIT OCTET STRING DEFAULT '77BB'H, - hoohoo [11] IMPLICIT SEQUENCE { - bar [1] Id1 OPTIONAL, - foo INTEGER, - zombie [9] CHOICE { - a [1] IMPLICIT INTEGER, - b [2] IMPLICIT BOOLEAN } - }, - moon [4] IMPLICIT INTEGER } - - - -Cho ::= [PRIVATE 9] EXPLICIT CHOICE { - somestring [2] IMPLICIT OCTET STRING, - goofy [9] INTEGER, - moon [4] IMPLICIT INTEGER } - - -A ::= [APPLICATION 2] SET { - ppp IA5String , - a [0] INTEGER {aaa(6),bbb(77)} DEFAULT 998, - b [1] Id1 OPTIONAL, - c [2] OCTET STRING (SIZE(8)), - dd [3] BIT STRING DEFAULT '11001'B } - -B ::= [APPLICATION 3] SET { - ww [1] SET { - a A OPTIONAL, - goofy [3] INTEGER OPTIONAL, - somestring [10] IMPLICIT OCTET STRING DEFAULT '77BB'H } - } - - -C::= [APPLICATION 4] SEQUENCE OF X - -Y ::= OBJECT IDENTIFIER - -X ::= SET { - a NULL, - b GeneralString, - c UTCTime, - d VideotexString, - g GeneralizedTime, - h GraphicString, - i VisibleString, - j IA5String, - k PrintableString, - l OCTET STRING, - e TeletexString, - m ANY, - n ObjectDescriptor, - o OBJECT IDENTIFIER, - f NumericString } - -END diff --git a/lib/asn1/test/asn1_SUITE_data/Two.py b/lib/asn1/test/asn1_SUITE_data/Two.py deleted file mode 100644 index c8e6f1a55b..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/Two.py +++ /dev/null @@ -1,34 +0,0 @@ -Two { 1 2 3} DEFINITIONS EXPLICIT TAGS ::= - -BEGIN -EXPORTS A, D,Boo,Szz; - - - -D ::= [PRIVATE 1] SEQUENCE { - a INTEGER, - b Boo, - c ANY DEFINED BY a , - d ANY } - - -Boo ::= SEQUENCE OF INTEGER (198..200) - -A ::= [PRIVATE 2] SEQUENCE { - a INTEGER (1..1), - b INTEGER (3..3) } - - -Szz ::= CHOICE { - one INTEGER, - two BOOLEAN } - -C ::= SET { - a [0] INTEGER (0..8), - xx [4] CHOICE { - [7] INTEGER (9..10), - a INTEGER (11 ..13) }, - f Boo, - r [2] INTEGER (20..22)} -END - diff --git a/lib/asn1/test/asn1_SUITE_data/UPERDefault.asn b/lib/asn1/test/asn1_SUITE_data/UPERDefault.asn deleted file mode 100644 index 7b81a0e09f..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/UPERDefault.asn +++ /dev/null @@ -1,18 +0,0 @@ -UPERDefault DEFINITIONS AUTOMATIC TAGS ::= - -BEGIN - --- OTP-7681 -Int ::= INTEGER (0..32767) - -Seq ::= SEQUENCE { - a Int, - b INTEGER (-27..27) DEFAULT 0, -- OTP-7678 - c INTEGER OPTIONAL -} - -seq Seq ::= -{a 12, - b 0} - -END
\ No newline at end of file diff --git a/lib/asn1/test/asn1_SUITE_data/UndefType.py b/lib/asn1/test/asn1_SUITE_data/UndefType.py deleted file mode 100644 index cdbe083803..0000000000 --- a/lib/asn1/test/asn1_SUITE_data/UndefType.py +++ /dev/null @@ -1,14 +0,0 @@ -Person DEFINITIONS IMPLICIT TAGS ::= -BEGIN -EXPORTS Person; -IMPORTS - ImportedFromUndefined FROM UndefinedModule; - -Feltyp ::= UndefinedType -Feltyp2 ::= ImportedFromUndefined -Person ::= [PRIVATE 19] SEQUENCE { - name Undefined, - location INTEGER {home(0),field(1),roving(2)}, - age ImportedFromUndefined OPTIONAL - } -END diff --git a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl index d46560979d..00e4c707dd 100644 --- a/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl +++ b/lib/asn1/test/asn1_SUITE_data/extensionAdditionGroup.erl @@ -1,9 +1,3 @@ -%%%------------------------------------------------------------------- -%%% File : extensionAdditionGroup.erl -%%% Author : Kenneth Lundin -%%% Description : -%%% -%%% Created : 18 May 2010 by kenneth %% %% %CopyrightBegin% %% @@ -25,36 +19,38 @@ %%%------------------------------------------------------------------- -module(extensionAdditionGroup). -include("Extension-Addition-Group.hrl"). - +-export([run/1]). -compile(export_all). run(Erule) -> - Val = #'Ax'{a=253, b = true, c= {e,true}, g="123", h = true}, - io:format("~p:~p~n",[Erule,Val]), - {ok,List}= asn1rt:encode('Extension-Addition-Group','Ax',Val), - Enc = iolist_to_binary(List), - io:format("~p~n",[Enc]), - {ok,Val2} = asn1rt:decode('Extension-Addition-Group','Ax',Enc), - io:format("~p~n",[Val2]), - case Val2 of - Val -> ok; - _ -> exit({expected,Val, got, Val2}) - end. + Val = #'Ax'{a=253,b=true,c={e,true},g="123",h=true}, + Enc = hex_to_binary(encoded_ax(Erule)), + roundtrip('Ax', Val, Enc), -run2(Erule) -> - Val = #'Ax3'{a=253, b = true, s = #'Ax3_s'{sa = 11, sb = true, sextaddgroup = 17}}, - io:format("~p:~p~n",[Erule,Val]), - {ok,List}= asn1rt:encode('Extension-Addition-Group','Ax3',Val), - Enc = iolist_to_binary(List), - io:format("~p~n",[Enc]), - {ok,Val2} = asn1rt:decode('Extension-Addition-Group','Ax3',Enc), - io:format("~p~n",[Val2]), - case Val2 of - Val -> ok; - _ -> exit({expected,Val, got, Val2}) - end. + Val2 = #'Ax3'{a=253,b=true,s=#'Ax3_s'{sa=11,sb=true,sextaddgroup=17}}, + roundtrip('Ax3', Val2), + + run3(), + run3(Erule), + + ok. + +%% From X.691 (07/2002) A.4. +encoded_ax(per) -> "9E000180 010291A4"; +encoded_ax(uper) -> "9E000600 040A4690"; +encoded_ax(ber) -> none. +hex_to_binary(none) -> + none; +hex_to_binary(L) -> + << <<(hex_digit_to_binary(D)):4>> || D <- L, D =/= $\s >>. + +hex_digit_to_binary(D) -> + if + $0 =< D, D =< $9 -> D - $0; + $A =< D, D =< $F -> D - ($A-10) + end. run3(Erule) -> Val = {'RRC-DL-DCCH-Message', @@ -141,15 +137,23 @@ run3() -> 'ac-BarringFactor' = p00, 'ac-BarringTime' = s4, 'ac-BarringForSpecialAC' = <<0:5>>}, - roundtrip(SI), - roundtrip(SI#'SystemInformationBlockType2'{ - 'ssac-BarringForMMTEL-Voice-r9'=Barring}), - roundtrip(SI#'SystemInformationBlockType2'{ + T = 'SystemInformationBlockType2', + roundtrip(T, SI), + roundtrip(T, SI#'SystemInformationBlockType2'{ + 'ssac-BarringForMMTEL-Voice-r9'=Barring}), + roundtrip(T, SI#'SystemInformationBlockType2'{ 'ssac-BarringForMMTEL-Video-r9'=Barring}), - roundtrip(SI#'SystemInformationBlockType2'{ - 'ac-BarringForCSFB-r10'=Barring}). + roundtrip(T, SI#'SystemInformationBlockType2'{ + 'ac-BarringForCSFB-r10'=Barring}). -roundtrip(V) -> +roundtrip(T, V) -> + roundtrip(T, V, none). + +roundtrip(T, V, Expected) -> Mod = 'Extension-Addition-Group', - {ok,E} = Mod:encode('SystemInformationBlockType2', V), - {ok,V} = Mod:decode('SystemInformationBlockType2', iolist_to_binary(E)). + {ok,E} = Mod:encode(T, V), + {ok,V} = Mod:decode(T, E), + case Expected of + none -> ok; + E -> ok + end. diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl index 1e40fd7b9e..b839dfcf2a 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.erl @@ -39,17 +39,18 @@ compile_all(Files, Config, Options) -> compile_file(File, Options) -> try - ok = asn1ct:compile(File, Options), + ok = asn1ct:compile(File, [warnings_as_errors|Options]), case should_load(File, Options) of false -> ok; {module, Module} -> code:purge(Module), - true = code:soft_purge(Module), - {module, Module} = code:load_file(Module) + {module, Module} = code:load_file(Module), + code:purge(Module) end catch Class:Reason -> + ct:print("Failed to compile ~s\n", [File]), erlang:error({compile_failed, {File, Options}, {Class, Reason}}) end. @@ -58,7 +59,7 @@ compile_erlang(Mod, Config, Options) -> CaseDir = ?config(case_dir, Config), M = list_to_atom(Mod), {ok, M} = compile:file(filename:join(DataDir, Mod), - [{i, CaseDir}, {outdir, CaseDir}|Options]). + [report,{i,CaseDir},{outdir,CaseDir}|Options]). should_load(File, Options) -> case lists:member(abs, Options) of diff --git a/lib/asn1/test/error_SUITE.erl b/lib/asn1/test/error_SUITE.erl new file mode 100644 index 0000000000..a94a6d95a0 --- /dev/null +++ b/lib/asn1/test/error_SUITE.erl @@ -0,0 +1,104 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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(error_SUITE). +-export([suite/0,all/0,groups/0, + already_defined/1,enumerated/1]). + +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks, [ts_install_cth]}]. + +all() -> + [{group,p}]. + +groups() -> + [{p,parallel(),[already_defined, + enumerated]}]. + +parallel() -> + case erlang:system_info(schedulers) > 1 of + true -> [parallel]; + false -> [] + end. + +already_defined(Config) -> + M = 'Already', + P = {M, + <<"Already DEFINITIONS ::= BEGIN\n" + " I ::= INTEGER\n" + " i I ::= 42\n" + " I ::= OCTET STRING\n" + " I ::= CLASS { &Type }\n" + " MYCLASS ::= CLASS { &Type }\n" + " i MYCLASS ::= { &Type INTEGER }\n" + " o MYCLASS ::= { &Type INTEGER }\n" + " I MYCLASS ::= { o }\n" + " I{T} ::= SEQUENCE OF T\n" + " I{INTEGER:x} INTEGER ::= { 1 | 2 | x }\n" + " i{T} MYCLASS ::= { &Type T }\n" + "END\n">>}, + {error, + [ + {structured_error,{M,4},asn1ct_check,{already_defined,'I',2}}, + {structured_error,{M,5},asn1ct_check,{already_defined,'I',2}}, + {structured_error,{M,7},asn1ct_check,{already_defined,'i',3}}, + {structured_error,{M,9},asn1ct_check,{already_defined,'I',2}}, + {structured_error,{M,10},asn1ct_check,{already_defined,'I',2}}, + {structured_error,{M,11},asn1ct_check,{already_defined,'I',2}}, + {structured_error,{M,12},asn1ct_check,{already_defined,'i',3}} + ] + } = run(P, Config), + ok. + +enumerated(Config) -> + M = 'Enumerated', + P = {M, + <<"Enumerated DEFINITIONS AUTOMATIC TAGS ::= BEGIN\n" + " Enum ::= ENUMERATED { a, b, c }\n" + " e Enum ::= d\n" + " EnumExt ::= ENUMERATED { x, ..., y }\n" + " ext EnumExt ::= z\n" + " S1 ::= SEQUENCE {\n" + " ge1 Enum DEFAULT a,\n" + " ge2 EnumExt DEFAULT x,\n" + " ge3 EnumExt DEFAULT y,\n" + " e Enum DEFAULT aa\n" + " }\n" + " S2 ::= SEQUENCE {\n" + " e2 EnumExt DEFAULT xyz\n" + " }\n" + "END\n">>}, + {error, + [ + {structured_error,{'Enumerated',3},asn1ct_check,{undefined,d}}, + {structured_error,{'Enumerated',5},asn1ct_check,{undefined,z}}, + {structured_error,{'Enumerated',10},asn1ct_check,{undefined,aa}}, + {structured_error,{'Enumerated',13},asn1ct_check,{undefined,xyz}} + ] + } = run(P, Config), + ok. + + + +run({Mod,Spec}, Config) -> + Base = atom_to_list(Mod) ++ ".asn1", + File = filename:join(?config(priv_dir, Config), Base), + ok = file:write_file(File, Spec), + asn1ct:compile(File). diff --git a/lib/asn1/test/testChoExtension.erl b/lib/asn1/test/testChoExtension.erl index 067d4d2bf7..5c67ff62ce 100644 --- a/lib/asn1/test/testChoExtension.erl +++ b/lib/asn1/test/testChoExtension.erl @@ -42,6 +42,11 @@ extension(_Rules) -> roundtrip('ChoExt3', {int,33}), roundtrip('ChoExt4', {str,"abc"}), + roundtrip('ChoEmptyRoot', {bool,false}), + roundtrip('ChoEmptyRoot', {bool,true}), + roundtrip('ChoEmptyRoot', {int,0}), + roundtrip('ChoEmptyRoot', {int,7}), + ok. diff --git a/lib/asn1/test/testCompactBitString.erl b/lib/asn1/test/testCompactBitString.erl index 96d9f0fdcb..28ab2464e9 100644 --- a/lib/asn1/test/testCompactBitString.erl +++ b/lib/asn1/test/testCompactBitString.erl @@ -150,4 +150,6 @@ roundtrip(Type, Val1, Val2) -> roundtrip_1(Mod, Type, In, Out) -> {ok,Encoded} = Mod:encode(Type, In), {ok,Out} = Mod:decode(Type, Encoded), + %% Test that compact BIT STRINGs can be encoded. + {ok,Encoded} = Mod:encode(Type, Out), ok. diff --git a/lib/asn1/test/testConstraints.erl b/lib/asn1/test/testConstraints.erl index c8d9008641..e825302629 100644 --- a/lib/asn1/test/testConstraints.erl +++ b/lib/asn1/test/testConstraints.erl @@ -122,13 +122,61 @@ int_constraints(Rules) -> range_error(Rules, 'X1', 21), %%========================================================== + %% SemiConstrained + %%========================================================== + + roundtrip('SemiConstrained', 100), + roundtrip('SemiConstrained', 397249742397243), + roundtrip('NegSemiConstrained', -128), + roundtrip('NegSemiConstrained', -1), + roundtrip('NegSemiConstrained', 500), + + roundtrip('SemiConstrainedExt', -65536), + roundtrip('SemiConstrainedExt', 0), + roundtrip('SemiConstrainedExt', 42), + roundtrip('SemiConstrainedExt', 100), + roundtrip('SemiConstrainedExt', 47777789), + roundtrip('NegSemiConstrainedExt', -1023), + roundtrip('NegSemiConstrainedExt', -128), + roundtrip('NegSemiConstrainedExt', -1), + roundtrip('NegSemiConstrainedExt', 500), + + %%========================================================== %% SIZE Constraint (Duboisson p. 268) %% T ::= IA5String (SIZE (1|2, ..., SIZE (1|2|3))) %% T2 ::= IA5String (SIZE (1|2, ..., 3)) %%========================================================== roundtrip('T', "IA"), - roundtrip('T2', "IA"). + roundtrip('T', "IAB"), + roundtrip('T', "IABC"), + roundtrip('T2', "IA"), + roundtrip('T2', "IAB"), + roundtrip('T2', "IABC"), + + %%========================================================== + %% More SIZE Constraints + %%========================================================== + + roundtrip('FixedSize', "0123456789"), + roundtrip('FixedSize2', "0123456789"), + roundtrip('FixedSize2', "0123456789abcdefghij"), + + range_error(Rules, 'FixedSize', "short"), + range_error(Rules, 'FixedSize2', "short"), + + [roundtrip('VariableSize', lists:seq($A, $A+L-1)) || + L <- lists:seq(1, 10)], + + roundtrip_enc('ShorterExt', "a", shorter_ext(Rules, "a")), + roundtrip('ShorterExt', "abcde"), + roundtrip('ShorterExt', "abcdef"), + + ok. + +shorter_ext(per, "a") -> <<16#80,16#01,16#61>>; +shorter_ext(uper, "a") -> <<16#80,16#E1>>; +shorter_ext(ber, _) -> none. refed_NNL_name(_Erule) -> ?line {ok,_} = asn1_wrapper:encode('Constraints','AnotherThing',fred), @@ -143,11 +191,20 @@ roundtrip(Module, Type, Value) -> {ok,Value} = Module:decode(Type, Encoded), ok. +roundtrip_enc(Type, Value, Enc) -> + Module = 'Constraints', + {ok,Encoded} = Module:encode(Type, Value), + {ok,Value} = Module:decode(Type, Encoded), + case Enc of + none -> ok; + Encoded -> ok + end. + range_error(ber, Type, Value) -> %% BER: Values outside the effective range should be rejected %% on decode. {ok,Encoded} = 'Constraints':encode(Type, Value), - {error,{asn1,{integer_range,_,_}}} = 'Constraints':decode(Type, Encoded), + {error,{asn1,_}} = 'Constraints':decode(Type, Encoded), ok; range_error(Per, Type, Value) when Per =:= per; Per =:= uper -> %% (U)PER: Values outside the effective range should be rejected diff --git a/lib/asn1/test/testDeepTConstr.erl b/lib/asn1/test/testDeepTConstr.erl index 3df7bcbaa0..e826cafa0c 100644 --- a/lib/asn1/test/testDeepTConstr.erl +++ b/lib/asn1/test/testDeepTConstr.erl @@ -40,53 +40,40 @@ main(_Erule) -> {any,"DK"}, {final,"NO"}]}}, - ?line {ok,Bytes1} = - asn1_wrapper:encode('TConstrChoice','FilterItem',Val1), - - ?line {error,Reason} = asn1_wrapper:decode('TConstrChoice','FilterItem',Bytes1), - + {ok,Bytes1} = 'TConstrChoice':encode('FilterItem', Val1), + {error,Reason} = asn1_wrapper:decode('TConstrChoice','FilterItem',Bytes1), io:format("Reason: ~p~n~n",[Reason]), - - ?line {ok,Bytes2} = - asn1_wrapper:encode('TConstrChoice','FilterItem',Val2), - - ?line {ok,Res} = asn1_wrapper:decode('TConstrChoice','FilterItem',Bytes2), - - + {ok,Bytes2} = 'TConstrChoice':encode('FilterItem', Val2), + {ok,Res} = 'TConstrChoice':decode('FilterItem', Bytes2), %% test of OTP-4248. - ?line {ok,Bytes3} = - asn1_wrapper:encode('TConstrChoice','Seq',{'Seq',3,Bytes2}), - - ?line {ok,{'Seq',3,Bytes4}} = - asn1_wrapper:decode('TConstrChoice','Seq',Bytes3), - - ?line {ok,Res} = asn1_wrapper:decode('TConstrChoice','FilterItem',Bytes4), + {ok,Bytes3} = 'TConstrChoice':encode('Seq', {'Seq',3,Bytes2}), + {ok,{'Seq',3,Bytes4}} = 'TConstrChoice':decode('Seq', Bytes3), + {ok,Res} = 'TConstrChoice':decode('FilterItem', Bytes4), %% test of TConstr - Seq1Val = {'Seq1',{'Seq1_a',12,{2,4}},{'Seq1_b',13,{'Type-object1',14,true}}}, - ?line {ok,Bytes5} = - asn1_wrapper:encode('TConstr','Seq1',Seq1Val), - - ?line {ok,Seq1Val} = - asn1_wrapper:decode('TConstr','Seq1',Bytes5), + Seq1Val = {'Seq1',{'Seq1_a',12,{2,4}}, + {'Seq1_b',13,{'Type-object1',14,true}}}, + roundtrip('TConstr', 'Seq1', Seq1Val), Seq2Val = {'Seq2',123,{'Seq2_content',{2,6,7}, {first,{'Type-object3_first',false,47}}, false}}, - - ?line {ok,Bytes6} = - asn1_wrapper:encode('TConstr','Seq2',Seq2Val), + roundtrip('TConstr', 'Seq2', Seq2Val), - ?line {ok,Seq2Val} = - asn1_wrapper:decode('TConstr','Seq2',Bytes6), + roundtrip('TConstr', 'Info', {'Info',{'Info_xyz',{1,2}},1234}), + + roundtrip('TConstr', 'Deeper', + {'Deeper', + {'Deeper_a',12, + {'Deeper_a_s',{2,4},42}}, + {'Deeper_b',13,{'Type-object1',14,true}}}), + ok. - InfoVal = {'Info',{'Info_xyz',{1,2}},1234}, - - ?line {ok,Bytes7} = - asn1_wrapper:encode('TConstr','Info',InfoVal), - ?line {ok,InfoVal} = - asn1_wrapper:decode('TConstr','Info',Bytes7). +roundtrip(M, T, V) -> + {ok,E} = M:encode(T, V), + {ok,V} = M:decode(T, E), + ok. diff --git a/lib/asn1/test/testEnumExt.erl b/lib/asn1/test/testEnumExt.erl index 0811f20571..8840ed6d2f 100644 --- a/lib/asn1/test/testEnumExt.erl +++ b/lib/asn1/test/testEnumExt.erl @@ -38,8 +38,7 @@ main(Rule) when Rule =:= per; Rule =:= uper -> %% ENUMERATED no extensionmark B64 = <<64>>, B64 = roundtrip('Noext', red), - ok; - + common(); main(ber) -> io:format("main(ber)~n",[]), %% ENUMERATED with extensionmark (value is in root set) @@ -57,6 +56,15 @@ main(ber) -> roundtrip('Globalstate', preop), roundtrip('Globalstate', com), + common(). + +common() -> + roundtrip('Seq', {'Seq',blue,42}), + roundtrip('Seq', {'Seq',red,42}), + roundtrip('Seq', {'Seq',green,42}), + roundtrip('Seq', {'Seq',orange,47}), + roundtrip('Seq', {'Seq',black,4711}), + roundtrip('Seq', {'Seq',magenta,4712}), ok. roundtrip(Type, Value) -> diff --git a/lib/asn1/test/testInfObj.erl b/lib/asn1/test/testInfObj.erl index 03e70c730a..75f4dae310 100644 --- a/lib/asn1/test/testInfObj.erl +++ b/lib/asn1/test/testInfObj.erl @@ -22,8 +22,6 @@ -export([main/1]). --include_lib("test_server/include/test_server.hrl"). - -record('InitiatingMessage',{procedureCode,criticality,value}). -record('InitiatingMessage2',{procedureCode,criticality,value}). -record('Iu-ReleaseCommand',{first,second}). @@ -34,22 +32,11 @@ main(_Erule) -> value=#'Iu-ReleaseCommand'{ first=13, second=true}}, - ?line {ok,Bytes1} = - asn1_wrapper:encode('RANAPextract1','InitiatingMessage',Val1), - - ?line {ok,{'InitiatingMessage',1,ignore,{'Iu-ReleaseCommand',13,true}}}= - asn1_wrapper:decode('RANAPextract1','InitiatingMessage',Bytes1), - - ?line {ok,Bytes2} = - asn1_wrapper:encode('InfObj','InitiatingMessage',Val1), - - ?line {ok,Val1} = - asn1_wrapper:decode('InfObj','InitiatingMessage',Bytes2), + roundtrip('RANAPextract1', 'InitiatingMessage', Val1), + roundtrip('InfObj', 'InitiatingMessage', Val1), Val2 = Val1#'InitiatingMessage'{procedureCode=2}, - - ?line {error,_R1} = - asn1_wrapper:encode('InfObj','InitiatingMessage',Val2), + {error,_R1} = 'InfObj':encode('InitiatingMessage', Val2), %% Test case for OTP-4275 @@ -59,10 +46,26 @@ main(_Erule) -> first=13, second=true}}, - ?line {ok,Bytes3} = - asn1_wrapper:encode('RANAPextract1','InitiatingMessage2',Val3), + roundtrip('RANAPextract1', 'InitiatingMessage2', Val3), - - ?line {ok,{'InitiatingMessage2',3,reject,{'Iu-ReleaseCommand',13,true}}}= - asn1_wrapper:decode('RANAPextract1','InitiatingMessage2',Bytes3). - + roundtrip('InfObj', 'MyPdu', {'MyPdu',42,12,false,"string"}), + roundtrip('InfObj', 'MyPdu', {'MyPdu',{'Seq',1023,"hello"}, + 42,true,"longer string"}), + roundtrip('InfObj', 'MyPdu', {'MyPdu',"75712346",43,true,"string"}), + + roundtrip('InfObj', 'ConstructedPdu', + {'ConstructedPdu',1,{'CONSTRUCTED-DEFAULT_Type',-2001,true}}), + roundtrip('InfObj', 'ConstructedPdu', + {'ConstructedPdu',2,{'CONSTRUCTED-DEFAULT_Type',999,false}}), + roundtrip('InfObj', 'ConstructedPdu', + {'ConstructedPdu',3,true}), + + roundtrip('InfObj', 'Seq2', + {'Seq2',42,[true,false,false,true], + [false,true,false]}). + + +roundtrip(M, T, V) -> + {ok,Enc} = M:encode(T, V), + {ok,V} = M:decode(T, Enc), + ok. diff --git a/lib/asn1/test/testPrim.erl b/lib/asn1/test/testPrim.erl index 91fb9fffca..990e7adcd9 100644 --- a/lib/asn1/test/testPrim.erl +++ b/lib/asn1/test/testPrim.erl @@ -30,465 +30,57 @@ -include_lib("test_server/include/test_server.hrl"). bool(Rules) -> - - %%========================================================== - %% Bool ::= BOOLEAN - %%========================================================== - - ?line {ok,Bytes1} = asn1_wrapper:encode('Prim','Bool',true), - ?line {ok,true} = asn1_wrapper:decode('Prim','Bool',lists:flatten(Bytes1)), - - ?line {ok,Bytes2} = asn1_wrapper:encode('Prim','Bool',false), - ?line {ok,false} = asn1_wrapper:decode('Prim','Bool',lists:flatten(Bytes2)), - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {error,{asn1,{encode_boolean,517}}} = - (catch asn1_wrapper:encode('Prim','Bool',517)), - ok; - per -> - ok - end, - - - - - - %%========================================================== - %% BoolCon ::= [20] BOOLEAN - %%========================================================== - - - ?line {ok,BytesCon1} = asn1_wrapper:encode('Prim','BoolCon',true), - ?line {ok,true} = asn1_wrapper:decode('Prim','BoolCon',lists:flatten(BytesCon1)), - - ?line {ok,BytesCon2} = asn1_wrapper:encode('Prim','BoolCon',false), - ?line {ok,false} = asn1_wrapper:decode('Prim','BoolCon',lists:flatten(BytesCon2)), - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {error,{asn1,{encode_boolean,517}}} = - (catch asn1_wrapper:encode('Prim','BoolCon',517)), - ok; - per -> - ok - end, - - - - - - %%========================================================== - %% BoolPri ::= [PRIVATE 21] BOOLEAN - %%========================================================== - - ?line {ok,BytesPri1} = asn1_wrapper:encode('Prim','BoolPri',true), - ?line {ok,true} = asn1_wrapper:decode('Prim','BoolPri',lists:flatten(BytesPri1)), - - ?line {ok,BytesPri2} = asn1_wrapper:encode('Prim','BoolPri',false), - ?line {ok,false} = asn1_wrapper:decode('Prim','BoolPri',lists:flatten(BytesPri2)), - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {error,{asn1,{encode_boolean,517}}} = - (catch asn1_wrapper:encode('Prim','BoolPri',517)), - ok; - per -> - ok - end, - - - %%========================================================== - %% BoolApp ::= [APPLICATION 22] BOOLEAN - %%========================================================== - - ?line {ok,BytesApp1} = asn1_wrapper:encode('Prim','BoolApp',true), - ?line {ok,true} = asn1_wrapper:decode('Prim','BoolApp',lists:flatten(BytesApp1)), - - ?line {ok,BytesApp2} = asn1_wrapper:encode('Prim','BoolApp',false), - ?line {ok,false} = asn1_wrapper:decode('Prim','BoolApp',lists:flatten(BytesApp2)), - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {error,{asn1,{encode_boolean,517}}} = - (catch asn1_wrapper:encode('Prim','BoolApp',517)), - ok; - per -> - ok - end, - - - %%========================================================== - %% BoolExpCon ::= [30] EXPLICIT BOOLEAN - %%========================================================== - - ?line {ok,BytesExpCon1} = asn1_wrapper:encode('Prim','BoolExpCon',true), - ?line {ok,true} = asn1_wrapper:decode('Prim','BoolExpCon',lists:flatten(BytesExpCon1)), - - ?line {ok,BytesExpCon2} = asn1_wrapper:encode('Prim','BoolExpCon',false), - ?line {ok,false} = asn1_wrapper:decode('Prim','BoolExpCon',lists:flatten(BytesExpCon2)), - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {error,{asn1,{encode_boolean,517}}} = - (catch asn1_wrapper:encode('Prim','BoolExpCon',517)), - ok; - per -> - ok - end, - - - - %%========================================================== - %% BoolExpPri ::= [PRIVATE 31] EXPLICIT BOOLEAN - %%========================================================== - - ?line {ok,BytesExpPri1} = asn1_wrapper:encode('Prim','BoolExpPri',true), - ?line {ok,true} = asn1_wrapper:decode('Prim','BoolExpPri',lists:flatten(BytesExpPri1)), - - ?line {ok,BytesExpPri2} = asn1_wrapper:encode('Prim','BoolExpPri',false), - ?line {ok,false} = asn1_wrapper:decode('Prim','BoolExpPri',lists:flatten(BytesExpPri2)), - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {error,{asn1,{encode_boolean,517}}} = - (catch asn1_wrapper:encode('Prim','BoolExpPri',517)), - ok; - per -> - ok - end, - - - %%========================================================== - %% BoolExpApp ::= [APPLICATION 32] EXPLICIT BOOLEAN - %%========================================================== - - ?line {ok,BytesExpApp1} = asn1_wrapper:encode('Prim','BoolExpApp',true), - ?line {ok,true} = asn1_wrapper:decode('Prim','BoolExpApp',lists:flatten(BytesExpApp1)), - - ?line {ok,BytesExpApp2} = asn1_wrapper:encode('Prim','BoolExpApp',false), - ?line {ok,false} = asn1_wrapper:decode('Prim','BoolExpApp',lists:flatten(BytesExpApp2)), - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {error,{asn1,{encode_boolean,517}}} = - (catch asn1_wrapper:encode('Prim','BoolExpApp',517)), - ok; - per -> - ok - end, - - ok. + Types = ['Bool','BoolCon','BoolPri','BoolApp', + 'BoolExpCon','BoolExpPri','BoolExpApp'], + [roundtrip(T, V) || T <- Types, V <- [true,false]], + case Rules of + ber -> + [begin + {error,{asn1,{encode_boolean,517}}} = + (catch 'Prim':encode(T, 517)) + end || T <- Types], + ok; + _ -> + ok + end. int(Rules) -> - - - %%========================================================== - %% Int ::= INTEGER - %%========================================================== - - %% test of OTP-2666 encoding should use minimum number of octets x.690 8.3.2 - ?line {ok,Bytes0} = asn1_wrapper:encode('Prim','Int',-128), - ?line L0 = lists:flatten(Bytes0), - ?line {ok,-128} = asn1_wrapper:decode('Prim','Int',lists:flatten(L0)), - case asn1_wrapper:erule(Rules) of + %% OTP-2666: encoding should use minimum number of octets; x.690 8.3.2 + Bytes0 = roundtrip('Int', -128), + case Rules of ber -> - ?line [_,1,128] = L0; - per -> ok + <<_,1,128>> = Bytes0; + _ -> + ok end, - ?line {ok,Bytes1} = asn1_wrapper:encode('Prim','Int',4), - ?line {ok,4} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes1)), - - ?line {ok,Bytes2} = asn1_wrapper:encode('Prim','Int',444), - ?line {ok,444} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes2)), - - ?line {ok,Bytes3} = asn1_wrapper:encode('Prim','Int',123456789), - ?line {ok,123456789} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes3)), - - ?line {ok,Bytes4} = asn1_wrapper:encode('Prim','Int',12345678901234567890), - ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes4)), - - ?line {ok,Bytes5} = asn1_wrapper:encode('Prim','Int',-100), - ?line {ok,-100} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes5)), - - ?line {ok,Bytes6} = asn1_wrapper:encode('Prim','Int',-255), - ?line {ok,-255} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes6)), - - ?line {ok,Bytes7} = asn1_wrapper:encode('Prim','Int',-256), - ?line {ok,-256} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes7)), - - ?line {ok,Bytes8} = asn1_wrapper:encode('Prim','Int',-257), - ?line {ok,-257} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes8)), - - ?line {ok,Bytes9} = asn1_wrapper:encode('Prim','Int',-1234567890), - ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes9)), - - ?line {ok,Bytes10} = asn1_wrapper:encode('Prim','Int',-2147483648), - ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(Bytes10)), - - - - - - %%========================================================== - %% IntCon ::= [40] INTEGER - %%========================================================== - - ?line {ok,BytesCon1} = asn1_wrapper:encode('Prim','IntCon',4), - ?line {ok,4} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon1)), - - ?line {ok,BytesCon2} = asn1_wrapper:encode('Prim','IntCon',444), - ?line {ok,444} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon2)), - - ?line {ok,BytesCon3} = asn1_wrapper:encode('Prim','IntCon',123456789), - ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon3)), - - ?line {ok,BytesCon4} = asn1_wrapper:encode('Prim','IntCon',12345678901234567890), - ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon4)), - - ?line {ok,BytesCon5} = asn1_wrapper:encode('Prim','IntCon',-100), - ?line {ok,-100} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon5)), - - ?line {ok,BytesCon6} = asn1_wrapper:encode('Prim','IntCon',-255), - ?line {ok,-255} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon6)), - - ?line {ok,BytesCon7} = asn1_wrapper:encode('Prim','IntCon',-256), - ?line {ok,-256} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon7)), - - ?line {ok,BytesCon8} = asn1_wrapper:encode('Prim','IntCon',-257), - ?line {ok,-257} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon8)), - - ?line {ok,BytesCon9} = asn1_wrapper:encode('Prim','IntCon',-1234567890), - ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntCon',lists:flatten(BytesCon9)), - - ?line {ok,BytesCon10} = asn1_wrapper:encode('Prim','Int',-2147483648), - ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesCon10)), - - - - %%========================================================== - %% IntPri ::= [PRIVATE 41] INTEGER - %%========================================================== - - ?line {ok,BytesPri1} = asn1_wrapper:encode('Prim','IntPri',4), - ?line {ok,4} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri1)), - - ?line {ok,BytesPri2} = asn1_wrapper:encode('Prim','IntPri',444), - ?line {ok,444} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri2)), - - ?line {ok,BytesPri3} = asn1_wrapper:encode('Prim','IntPri',123456789), - ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri3)), - - ?line {ok,BytesPri4} = asn1_wrapper:encode('Prim','IntPri',12345678901234567890), - ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri4)), - - ?line {ok,BytesPri5} = asn1_wrapper:encode('Prim','IntPri',-100), - ?line {ok,-100} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri5)), - - ?line {ok,BytesPri6} = asn1_wrapper:encode('Prim','IntPri',-255), - ?line {ok,-255} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri6)), - - ?line {ok,BytesPri7} = asn1_wrapper:encode('Prim','IntPri',-256), - ?line {ok,-256} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri7)), - - ?line {ok,BytesPri8} = asn1_wrapper:encode('Prim','IntPri',-257), - ?line {ok,-257} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri8)), - - ?line {ok,BytesPri9} = asn1_wrapper:encode('Prim','IntPri',-1234567890), - ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntPri',lists:flatten(BytesPri9)), - - ?line {ok,BytesPri10} = asn1_wrapper:encode('Prim','Int',-2147483648), - ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesPri10)), - - - - %%========================================================== - %% IntApp ::= [APPLICATION 42] INTEGER - %%========================================================== - - ?line {ok,BytesApp1} = asn1_wrapper:encode('Prim','IntApp',4), - ?line {ok,4} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp1)), - - ?line {ok,BytesApp2} = asn1_wrapper:encode('Prim','IntApp',444), - ?line {ok,444} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp2)), - - ?line {ok,BytesApp3} = asn1_wrapper:encode('Prim','IntApp',123456789), - ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp3)), - - ?line {ok,BytesApp4} = asn1_wrapper:encode('Prim','IntApp',12345678901234567890), - ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp4)), - - ?line {ok,BytesApp5} = asn1_wrapper:encode('Prim','IntApp',-100), - ?line {ok,-100} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp5)), - - ?line {ok,BytesApp6} = asn1_wrapper:encode('Prim','IntApp',-255), - ?line {ok,-255} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp6)), - - ?line {ok,BytesApp7} = asn1_wrapper:encode('Prim','IntApp',-256), - ?line {ok,-256} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp7)), - - ?line {ok,BytesApp8} = asn1_wrapper:encode('Prim','IntApp',-257), - ?line {ok,-257} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp8)), - - ?line {ok,BytesApp9} = asn1_wrapper:encode('Prim','IntApp',-1234567890), - ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntApp',lists:flatten(BytesApp9)), - - ?line {ok,BytesApp10} = asn1_wrapper:encode('Prim','Int',-2147483648), - ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesApp10)), - - - %%========================================================== - %% IntExpCon ::= [50] EXPLICIT INTEGER - %%========================================================== - - ?line {ok,BytesExpCon1} = asn1_wrapper:encode('Prim','IntExpCon',4), - ?line {ok,4} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon1)), - - ?line {ok,BytesExpCon2} = asn1_wrapper:encode('Prim','IntExpCon',444), - ?line {ok,444} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon2)), - - ?line {ok,BytesExpCon3} = asn1_wrapper:encode('Prim','IntExpCon',123456789), - ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon3)), - - ?line {ok,BytesExpCon4} = asn1_wrapper:encode('Prim','IntExpCon',12345678901234567890), - ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon4)), - - ?line {ok,BytesExpCon5} = asn1_wrapper:encode('Prim','IntExpCon',-100), - ?line {ok,-100} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon5)), - - ?line {ok,BytesExpCon6} = asn1_wrapper:encode('Prim','IntExpCon',-255), - ?line {ok,-255} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon6)), - - ?line {ok,BytesExpCon7} = asn1_wrapper:encode('Prim','IntExpCon',-256), - ?line {ok,-256} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon7)), - - ?line {ok,BytesExpCon8} = asn1_wrapper:encode('Prim','IntExpCon',-257), - ?line {ok,-257} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon8)), - - ?line {ok,BytesExpCon9} = asn1_wrapper:encode('Prim','IntExpCon',-1234567890), - ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntExpCon',lists:flatten(BytesExpCon9)), - - ?line {ok,BytesExpCon10} = asn1_wrapper:encode('Prim','Int',-2147483648), - ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesExpCon10)), - - %%========================================================== - %% IntExpPri ::= [PRIVATE 51] EXPLICIT INTEGER - %%========================================================== - - ?line {ok,BytesExpPri1} = asn1_wrapper:encode('Prim','IntExpPri',4), - ?line {ok,4} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri1)), - - ?line {ok,BytesExpPri2} = asn1_wrapper:encode('Prim','IntExpPri',444), - ?line {ok,444} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri2)), - - ?line {ok,BytesExpPri3} = asn1_wrapper:encode('Prim','IntExpPri',123456789), - ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri3)), - - ?line {ok,BytesExpPri4} = asn1_wrapper:encode('Prim','IntExpPri',12345678901234567890), - ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri4)), - - ?line {ok,BytesExpPri5} = asn1_wrapper:encode('Prim','IntExpPri',-100), - ?line {ok,-100} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri5)), - - ?line {ok,BytesExpPri6} = asn1_wrapper:encode('Prim','IntExpPri',-255), - ?line {ok,-255} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri6)), - - ?line {ok,BytesExpPri7} = asn1_wrapper:encode('Prim','IntExpPri',-256), - ?line {ok,-256} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri7)), - - ?line {ok,BytesExpPri8} = asn1_wrapper:encode('Prim','IntExpPri',-257), - ?line {ok,-257} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri8)), - - ?line {ok,BytesExpPri9} = asn1_wrapper:encode('Prim','IntExpPri',-1234567890), - ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntExpPri',lists:flatten(BytesExpPri9)), - - ?line {ok,BytesExpPri10} = asn1_wrapper:encode('Prim','Int',-2147483648), - ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesExpPri10)), - - %%========================================================== - %% IntExpApp ::= [APPLICATION 52] EXPLICIT INTEGER - %%========================================================== - - ?line {ok,BytesExpApp1} = asn1_wrapper:encode('Prim','IntExpApp',4), - ?line {ok,4} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp1)), - - ?line {ok,BytesExpApp2} = asn1_wrapper:encode('Prim','IntExpApp',444), - ?line {ok,444} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp2)), - - ?line {ok,BytesExpApp3} = asn1_wrapper:encode('Prim','IntExpApp',123456789), - ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp3)), - - ?line {ok,BytesExpApp4} = asn1_wrapper:encode('Prim','IntExpApp',12345678901234567890), - ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp4)), - - ?line {ok,BytesExpApp5} = asn1_wrapper:encode('Prim','IntExpApp',-100), - ?line {ok,-100} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp5)), - - ?line {ok,BytesExpApp6} = asn1_wrapper:encode('Prim','IntExpApp',-255), - ?line {ok,-255} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp6)), - - ?line {ok,BytesExpApp7} = asn1_wrapper:encode('Prim','IntExpApp',-256), - ?line {ok,-256} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp7)), - - ?line {ok,BytesExpApp8} = asn1_wrapper:encode('Prim','IntExpApp',-257), - ?line {ok,-257} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp8)), - - ?line {ok,BytesExpApp9} = asn1_wrapper:encode('Prim','IntExpApp',-1234567890), - ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntExpApp',lists:flatten(BytesExpApp9)), - - ?line {ok,BytesExpApp10} = asn1_wrapper:encode('Prim','Int',-2147483648), - ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesExpApp10)), - + Values = [0,2,3,4,127,128,254,255,256,257,444, + 16383,16384,16385,65534,65535,65536,65537, + 123456789,12345678901234567890, + -1,-2,-3,-4,-100,-127,-255,-256,-257, + -1234567890,-2147483648], + [roundtrip(T, V) || + T <- ['Int','IntCon','IntPri','IntApp', + 'IntExpCon','IntExpPri','IntExpApp'], + V <- [1|Values]], %%========================================================== %% IntEnum ::= INTEGER {first(1),last(31)} %%========================================================== - ?line {ok,BytesEnum1} = asn1_wrapper:encode('Prim','IntEnum',4), - ?line {ok,4} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum1)), - - ?line {ok,BytesEnum2} = asn1_wrapper:encode('Prim','IntEnum',444), - ?line {ok,444} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum2)), - - ?line {ok,BytesEnum3} = asn1_wrapper:encode('Prim','IntEnum',123456789), - ?line {ok,123456789} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum3)), - - ?line {ok,BytesEnum4} = asn1_wrapper:encode('Prim','IntEnum',12345678901234567890), - ?line {ok,12345678901234567890} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum4)), + [roundtrip('IntEnum', V) || V <- Values], - ?line {ok,BytesEnum5} = asn1_wrapper:encode('Prim','IntEnum',-100), - ?line {ok,-100} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum5)), - - ?line {ok,BytesEnum6} = asn1_wrapper:encode('Prim','IntEnum',-255), - ?line {ok,-255} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum6)), - - ?line {ok,BytesEnum7} = asn1_wrapper:encode('Prim','IntEnum',-256), - ?line {ok,-256} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum7)), - - ?line {ok,BytesEnum8} = asn1_wrapper:encode('Prim','IntEnum',-257), - ?line {ok,-257} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum8)), - - ?line {ok,BytesEnum9} = asn1_wrapper:encode('Prim','IntEnum',-1234567890), - ?line {ok,-1234567890} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum9)), - - ?line {ok,BytesEnum910} = asn1_wrapper:encode('Prim','Int',-2147483648), - ?line {ok,-2147483648} = asn1_wrapper:decode('Prim','Int',lists:flatten(BytesEnum910)), - - - ?line {ok,BytesEnum10} = asn1_wrapper:encode('Prim','IntEnum',first), - ?line {ok,first} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum10)), - - ?line {ok,BytesEnum11} = asn1_wrapper:encode('Prim','IntEnum',last), - ?line {ok,last} = asn1_wrapper:decode('Prim','IntEnum',lists:flatten(BytesEnum11)), - + roundtrip('IntEnum', first), + roundtrip('IntEnum', last), + roundtrip('ASeq', {'ASeq',true,254,false,255,true,256,true,68789}), + roundtrip('ASeq', {'ASeq',false,250,true,200,true,199,true,77788}), + roundtrip('ASeq', {'ASeq',true,0,false,0,true,0,true,68789}), ok. - enum(Rules) -> %%========================================================== @@ -496,23 +88,9 @@ enum(Rules) -> %% friday(5),saturday(6),sunday(7)} %%========================================================== - ?line {ok,BytesEnum1} = asn1_wrapper:encode('Prim','Enum',monday), - ?line {ok,monday} = asn1_wrapper:decode('Prim','Enum',lists:flatten(BytesEnum1)), - - ?line {ok,BytesEnum2} = asn1_wrapper:encode('Prim','Enum',thursday), - ?line {ok,thursday} = asn1_wrapper:decode('Prim','Enum',lists:flatten(BytesEnum2)), - - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {error,{asn1,{_,4}}} = - case catch asn1_wrapper:encode('Prim','Enum',4) of Enum -> Enum end, - ok; - per -> - ?line {error,{asn1,{_,4}}} = - case catch asn1_wrapper:encode('Prim','Enum',4) of Enum -> Enum end, - ok - end, + roundtrip('Enum', monday), + roundtrip('Enum', thursday), + {error,{asn1,{_,4}}} = (catch 'Prim':encode('Enum', 4)), case Rules of Per when Per =:= per; Per =:= uper -> @@ -524,88 +102,41 @@ enum(Rules) -> ok. - -obj_id(Rules) -> +obj_id(_) -> %%========================================================== %% ObjId ::= OBJECT IDENTIFIER %%========================================================== - ?line {ok,Bytes1} = asn1_wrapper:encode('Prim','ObjId',{0,22,3}), - ?line {ok,{0,22,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes1)), - - ?line {ok,Bytes2} = asn1_wrapper:encode('Prim','ObjId',{1,39,3}), - ?line {ok,{1,39,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes2)), - - ?line {ok,Bytes3} = asn1_wrapper:encode('Prim','ObjId',{2,100,3}), - ?line {ok,{2,100,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes3)), - - ?line {ok,Bytes4} = asn1_wrapper:encode('Prim','ObjId',{2,16303,3}), - ?line {ok,{2,16303,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes4)), - - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {ok,Bytes5} = asn1_wrapper:encode('Prim','ObjId',{2,16304,3}), - ?line {ok,{2,16304,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes5)), - ok; - per -> - ?line {ok,Bytes5} = asn1_wrapper:encode('Prim','ObjId',{2,16304,3}), - ?line {ok,{2,16304,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes5)), -%% ?line test_server:format("~p~n",[Kurt]), -% ?line {ok,{2,16304,3}} = asn1_wrapper:decode('Prim','ObjId',lists:flatten(Bytes5)), - ok - end, - - - + [roundtrip('ObjId', V) || + V <- [{0,22,3},{1,39,3},{2,100,3},{2,16303,3},{2,16304,3}]], ok. rel_oid(_Rules) -> - %%========================================================== %% RelOid ::= RELATIVE-OID %%========================================================== - ?line {ok,Bytes1} = asn1_wrapper:encode('Prim','RelOid',{0,22,3}), - ?line {ok,{0,22,3}} = asn1_wrapper:decode('Prim','RelOid',lists:flatten(Bytes1)), - - ?line {ok,Bytes2} = asn1_wrapper:encode('Prim','RelOid',{1,39,3}), - ?line {ok,{1,39,3}} = asn1_wrapper:decode('Prim','RelOid',lists:flatten(Bytes2)), - - ?line {ok,Bytes3} = asn1_wrapper:encode('Prim','RelOid',{2,100,3}), - ?line {ok,{2,100,3}} = asn1_wrapper:decode('Prim','RelOid',lists:flatten(Bytes3)), - - ?line {ok,Bytes4} = asn1_wrapper:encode('Prim','RelOid',{2,16303,3}), - ?line {ok,{2,16303,3}} = asn1_wrapper:decode('Prim','RelOid',lists:flatten(Bytes4)), - - ?line {ok,Bytes5} = asn1_wrapper:encode('Prim','RelOid',{2,16304,3}), - ?line {ok,{2,16304,3}} = asn1_wrapper:decode('Prim','RelOid',lists:flatten(Bytes5)), - - ?line {ok,Bytes6} = asn1_wrapper:encode('Prim','RelOid',{8,16304,16#ffff}), - ?line {ok,{8,16304,16#ffff}} = asn1_wrapper:decode('Prim','RelOid',lists:flatten(Bytes6)), - - - + [roundtrip('RelOid', V) || + V <- [{0,22,3},{1,39,3},{2,100,3},{2,16303,3}, + {2,16304,3},{8,16304,16#ffff}]], ok. - - - null(_Rules) -> %%========================================================== %% Null ::= NULL %%========================================================== - ?line {ok,Bytes1} = asn1_wrapper:encode('Prim','Null',monday), - ?line {ok,'NULL'} = asn1_wrapper:decode('Prim','Null',lists:flatten(Bytes1)), - - - -ok. - + {ok,Bytes1} = asn1_wrapper:encode('Prim','Null',monday), + {ok,'NULL'} = asn1_wrapper:decode('Prim','Null',lists:flatten(Bytes1)), + ok. +roundtrip(T, V) -> + {ok,E} = 'Prim':encode(T, V), + {ok,V} = 'Prim':decode(T, E), + E. real(_Rules) -> %%========================================================== diff --git a/lib/asn1/test/testPrimStrings.erl b/lib/asn1/test/testPrimStrings.erl index f8b0c5b05a..e2322c92a9 100644 --- a/lib/asn1/test/testPrimStrings.erl +++ b/lib/asn1/test/testPrimStrings.erl @@ -54,7 +54,7 @@ bit_string(Rules) -> bs_roundtrip('Bs1', [1,0,0,0,0,0,0,0,0]), bs_roundtrip('Bs1', [0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]), - case asn1_wrapper:erule(Rules) of + case Rules of ber -> bs_decode('Bs1', <<35,8,3,2,0,73,3,2,4,32>>, [0,1,0,0,1,0,0,1,0,0,1,0]), @@ -62,7 +62,7 @@ bit_string(Rules) -> [1,1,1,0,1,0,1,0,1,0,0,1,1,1,0,0,0]), bs_decode('Bs1', <<35,128,3,2,0,234,3,3,7,156,0,0,0>>, [1,1,1,0,1,0,1,0,1,0,0,1,1,1,0,0,0]); - per -> + _ -> ok end, @@ -71,35 +71,16 @@ bit_string(Rules) -> %% Bs2 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (7)) %%========================================================== - ?line {ok,Bytes21} = asn1_wrapper:encode('PrimStrings','Bs2',[mo,tu,fr]), - ?line {ok,[mo,tu,fr]} = asn1_wrapper:decode('PrimStrings','Bs2',lists:flatten(Bytes21)), - - ?line {ok,Bytes22} = asn1_wrapper:encode('PrimStrings','Bs2',[0,1,1,0,0,1,0]), - ?line {ok,[mo,tu,fr]} = asn1_wrapper:decode('PrimStrings','Bs2',lists:flatten(Bytes22)), - ok, -%% skip this because it is wrong -% ?line case asn1_wrapper:erule(Rules) of -% ber -> -% ?line {ok,[mo,tu,fr,su,mo,th]} = -% asn1_wrapper:decode('PrimStrings','Bs2',[35,8,3,2,0,101,3,2,2,200]), - -% ?line {ok,[mo,tu,fr,su,mo,th]} = -% asn1_wrapper:decode('PrimStrings','Bs2',[35,128,3,2,1,100,3,2,2,200,0,0]), -% ok; - -% per -> -% ok -% end, - - - + roundtrip('Bs2', [mo,tu,fr]), + roundtrip('Bs2', [0,1,1,0,0,1,0], [mo,tu,fr]), + %%========================================================== %% Bs3 ::= BIT STRING {su(0), mo(1), tu(2), we(3), th(4), fr(5), sa(6) } (SIZE (1..7)) %%========================================================== roundtrip('Bs3', [mo,tu,fr]), bs_roundtrip('Bs3', [0,1,1,0,0,1,0], [mo,tu,fr]), - + %%========================================================== %% Bs7 ::= BIT STRING (SIZE (24)) %%========================================================== @@ -114,10 +95,9 @@ bit_string(Rules) -> %%========================================================== bs_roundtrip('BsPri', 45, [1,0,1,1,0,1]), - bs_roundtrip('BsPri', 211, [1,1,0,0,1,0,1,1]), - case asn1_wrapper:erule(Rules) of + case Rules of ber -> bs_decode('BsPri', <<223,61,4,5,75,226,96>>, [0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]), @@ -127,7 +107,7 @@ bit_string(Rules) -> [0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]), bs_decode('BsPri', <<255,61,128,3,2,0,75,3,3,5,226,96,0,0>>, [0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]); - per -> + _ -> ok end, @@ -139,11 +119,11 @@ bit_string(Rules) -> bs_roundtrip('BsExpPri', 45, [1,0,1,1,0,1]), bs_roundtrip('BsExpPri', 211, [1,1,0,0,1,0,1,1]), - case asn1_wrapper:erule(Rules) of + case Rules of ber -> bs_decode('BsExpPri', <<255,61,6,3,4,5,75,226,96>>, [0,1,0,0,1,0,1,1,1,1,1,0,0,0,1,0,0,1,1]); - per -> + _ -> ok end, @@ -151,24 +131,22 @@ bit_string(Rules) -> %% TestS ::= BIT STRING {a(0),b(1)} (SIZE (3..8)), test case for OTP-4353 %%========================================================== - ?line {ok,Bytes53} = asn1_wrapper:encode('PrimStrings','TestS',[a]), - ?line {ok,[a]} = - asn1_wrapper:decode('PrimStrings','TestS',lists:flatten(Bytes53)), + roundtrip('TestS', [a]), %%========================================================== %% PersonalStatus ::= BIT STRING {married(0),employed(1), %% veteran(2), collegeGraduate(3)}, test case for OTP-5710 %%========================================================== - ?line {ok,Bytes54} = asn1_wrapper:encode('BitStr','PersonalStatus',[]), - ?line {ok,[]} = asn1_wrapper:decode('BitStr','PersonalStatus',Bytes54), + {ok,Bytes54} = 'BitStr':encode('PersonalStatus', []), + {ok,[]} = 'BitStr':decode('PersonalStatus', Bytes54), %%========================================================== %% BS5932 ::= BIT STRING (SIZE (5..MAX)) %% test case for OTP-5932 %%========================================================== bs_roundtrip('BSMAX', [1,0,1,0,1]), - case asn1_wrapper:erule(Rules) of + case Rules of ber -> {error,_} = 'PrimStrings':encode('BSMAX', [1,0,1]); _ -> @@ -195,7 +173,91 @@ bit_string(Rules) -> BSList1024 = BSmaker(BSmaker,0,1024,{1,0},[]), bs_roundtrip('BS1024', BSList1024), - bs_roundtrip('TransportLayerAddress', [0,1,1,0]). + bs_roundtrip('TransportLayerAddress', [0,1,1,0]), + + case Rules of + ber -> ok; + _ -> per_bs_strings() + end. + +%% The PER encoding rules requires that a BIT STRING with +%% named positions should never have any trailing zeroes +%% (except to reach the minimum number of bits as given by +%% a SIZE constraint). + +per_bs_strings() -> + bs_roundtrip('Bs3', [0,0,1,0,0,0,0], [tu]), + bs_roundtrip('Bs3', <<2#0010000:7>>, [tu]), + bs_roundtrip('Bs3', {1,<<2#00100000:8>>}, [tu]), + + bs_roundtrip('Bs4', [0,1,1,0,0,1,0], [mo,tu,fr]), + bs_roundtrip('Bs4', <<2#0110010:7>>, [mo,tu,fr]), + bs_roundtrip('Bs4', {1,<<2#01100100:8>>}, [mo,tu,fr]), + + bs_roundtrip('Bs4', [0,1,1,0,0,0,0], [mo,tu]), + bs_roundtrip('Bs4', <<2#011:3,0:32>>, [mo,tu]), + bs_roundtrip('Bs4', {5,<<2#011:3,0:32,0:5>>}, [mo,tu]), + + [per_trailing_zeroes(B) || B <- lists:seq(0, 255)], + ok. + +%% Trailing zeroes should be removed from BIT STRINGs with named +%% bit positions. + +per_trailing_zeroes(Byte) -> + L = lists:reverse(make_bit_list(Byte+16#10000)), + L = make_bit_list(Byte+16#10000, []), + Pos = positions(L, 0), + ExpectedSz = case lists:last(Pos) of + su -> 1; + {bit,LastBitPos} -> LastBitPos+1 + end, + + %% List of zeroes and ones. + named_roundtrip(L, Pos, ExpectedSz), + named_roundtrip(L++[0,0,0,0,0], Pos, ExpectedSz), + + %% Bitstrings. + Bs = << <<B:1>> || B <- L >>, + Sz = bit_size(Bs), + named_roundtrip(Bs, Pos, ExpectedSz), + Bin = <<Bs:Sz/bits,0:16,0:7>>, + named_roundtrip(Bin, Pos, ExpectedSz), + + %% Compact bitstring. + named_roundtrip({7,Bin}, Pos, ExpectedSz), + + %% Integer bitstring (obsolete). + IntBs = intlist_to_integer(L, 0, 0), + named_roundtrip(IntBs, Pos, ExpectedSz), + + ok. + +make_bit_list(0) -> []; +make_bit_list(B) -> [B band 1|make_bit_list(B bsr 1)]. + +make_bit_list(0, Acc) -> Acc; +make_bit_list(B, Acc) -> make_bit_list(B bsr 1, [B band 1|Acc]). + +positions([1|T], 0) -> [su|positions(T, 1)]; +positions([1|T], Pos) -> [{bit,Pos}|positions(T, Pos+1)]; +positions([0|T], Pos) -> positions(T, Pos+1); +positions([], _) -> []. + +intlist_to_integer([B|T], Shift, Acc) -> + intlist_to_integer(T, Shift+1, (B bsl Shift) + Acc); +intlist_to_integer([], _, Acc) -> Acc. + +named_roundtrip(Value, Expected, ExpectedSz) -> + M = 'PrimStrings', + Type = 'Bs4', + {ok,Encoded} = M:encode(Type, Value), + {ok,Encoded} = M:encode(Type, Expected), + {ok,Expected} = M:decode(Type, Encoded), + + %% Verify the size in the first byte. + <<ExpectedSz:8,_/bits>> = Encoded, + ok. octet_string(Rules) -> @@ -203,21 +265,18 @@ octet_string(Rules) -> %% Os ::= OCTET STRING %%========================================================== - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {ok,"Jones"} = - asn1_wrapper:decode('PrimStrings','Os',[4,5,16#4A,16#6F,16#6E,16#65,16#73]), - - ?line {ok,"Jones"} = - asn1_wrapper:decode('PrimStrings','Os',[36,9,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73]), - - ?line {ok,"Jones"} = - asn1_wrapper:decode('PrimStrings','Os',[36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0]), - ok; - - per -> - ok - end, + case Rules of + ber -> + {ok,"Jones"} = + 'PrimStrings':decode('Os', <<4,5,16#4A,16#6F,16#6E,16#65,16#73>>), + {ok,"Jones"} = + 'PrimStrings':decode('Os', <<36,9,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73>>), + {ok,"Jones"} = + 'PrimStrings':decode('Os', <<36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0>>), + ok; + _ -> + ok + end, roundtrip('Os', [47,23,99,255,1]), roundtrip('OsCon', [47,23,99,255,1]), @@ -239,27 +298,32 @@ octet_string(Rules) -> roundtrip('OsExpApp', OsR), - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','OsExpApp',[127,62,7,4,5,16#4A,16#6F,16#6E,16#65,16#73]), - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','OsExpApp',[127,62,11,36,9,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73]), - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','OsExpApp',[127,62,13,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0]), - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','OsExpApp',[127,62,128,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,0,0]), - ?line {ok,"JonesJones"} = asn1_wrapper:decode('PrimStrings','OsExpApp',[127,62,128,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,0,0]), - ok; - - per -> - ok - end, + case Rules of + ber -> + {ok,"Jones"} = 'PrimStrings':decode('OsExpApp', <<127,62,7,4,5,16#4A,16#6F,16#6E,16#65,16#73>>), + {ok,"Jones"} = 'PrimStrings':decode('OsExpApp', <<127,62,11,36,9,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73>>), + {ok,"Jones"} = 'PrimStrings':decode('OsExpApp', <<127,62,13,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0>>), + {ok,"Jones"} = 'PrimStrings':decode('OsExpApp', <<127,62,128,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,0,0>>), + {ok,"JonesJones"} = 'PrimStrings':decode('OsExpApp', <<127,62,128,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,36,128,4,3,16#4A,16#6F,16#6E,4,2,16#65,16#73,0,0,0,0>>), + ok; + + _-> + ok + end, fragmented_octet_string(Rules), S255 = lists:seq(1, 255), - FixedStrings = {'OsFixedStrings',true,"","1","12","345",true, - S255,[$a|S255],[$a,$b|S255],397}, - roundtrip('OsFixedStrings', FixedStrings), + Strings = {type,true,"","1","12","345",true, + S255,[$a|S255],[$a,$b|S255],397}, + p_roundtrip('OsFixedStrings', Strings), + p_roundtrip('OsFixedStringsExt', Strings), + p_roundtrip('OsVarStringsExt', Strings), + ShortenedStrings = shorten_by_two(Strings), + p_roundtrip('OsFixedStringsExt', ShortenedStrings), + p_roundtrip('OsVarStringsExt', ShortenedStrings), ok. - + fragmented_octet_string(Erules) -> K16 = 1 bsl 14, K32 = K16 + K16, @@ -271,10 +335,12 @@ fragmented_octet_string(Erules) -> K48-1,K48,K48+1,K48+(1 bsl 7)-1,K48+(1 bsl 7),K48+(1 bsl 7)+1, K64-1,K64,K64+1,K64+(1 bsl 7)-1,K64+(1 bsl 7),K64+(1 bsl 7)+1, K64+K16-1,K64+K16,K64+K16+1], - Types = ['Os','OsFrag'], + Types = ['Os','OsFrag','OsFragExt'], [fragmented_octet_string(Erules, Types, L) || L <- Lens], fragmented_octet_string(Erules, ['FixedOs65536'], 65536), fragmented_octet_string(Erules, ['FixedOs65537'], 65537), + fragmented_octet_string(Erules, ['FixedOs65536Ext'], 65536), + fragmented_octet_string(Erules, ['FixedOs65537Ext'], 65537), %% Make sure that octet alignment works. roundtrip('OsAlignment', @@ -336,75 +402,58 @@ numeric_string(Rules) -> %%========================================================== roundtrip('Ns', []), + roundtrip('Ns', "01 34"), + case Rules of + ber -> + {ok,"Jones"} = 'PrimStrings':decode('Ns', + <<16#12,5,16#4A,16#6F, + 16#6E,16#65,16#73>>), + {ok,"Jones"} = 'PrimStrings':decode('Ns', + <<16#32,9,18,3,16#4A,16#6F, + 16#6E,18,2,16#65,16#73>>), + {ok,"Jones"} = 'PrimStrings':decode('Ns', + <<16#32,128,18,3,16#4A,16#6F, + 16#6E,18,2,16#65,16#73,0,0>>), + ok; + _ -> + ok + end, - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {ok,BytesNs1} = asn1_wrapper:encode('PrimStrings','Ns',[48,49,32,51,52]), - ?line {ok,[48,49,32,51,52]} = asn1_wrapper:decode('PrimStrings','Ns',lists:flatten(BytesNs1)), - - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','Ns',[16#12,5,16#4A,16#6F,16#6E,16#65,16#73]), - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','Ns',[16#32,9,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73]), - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','Ns',[16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0]), - ok; - - per -> - ?line {ok,BytesNs1} = asn1_wrapper:encode('PrimStrings','Ns',[48,49,32,51,52]), - ?line {ok,"01 34"} = asn1_wrapper:decode('PrimStrings','Ns',lists:flatten(BytesNs1)), - ok - end, - - - - %%========================================================== %% NsCon ::= [70] NumericString %%========================================================== roundtrip('NsCon', []), + roundtrip('NsCon', "01 34"), - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {ok,BytesNs11} = asn1_wrapper:encode('PrimStrings','NsCon',[48,49,32,51,52]), - ?line {ok,[48,49,32,51,52]} = asn1_wrapper:decode('PrimStrings','NsCon',lists:flatten(BytesNs11)), - - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','NsCon',[16#9F,16#46,5,16#4A,16#6F,16#6E,16#65,16#73]), - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','NsCon',[16#BF,16#46,9,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73]), - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','NsCon',[16#BF,16#46,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0]), - ok; - - per -> - ?line {ok,BytesNs11} = asn1_wrapper:encode('PrimStrings','NsCon',[48,49,32,51,52]), - ?line {ok,"01 34"} = asn1_wrapper:decode('PrimStrings','NsCon',lists:flatten(BytesNs11)), - ok - end, - + case Rules of + ber -> + {ok,"Jones"} = 'PrimStrings':decode('NsCon', <<16#9F,16#46,5,16#4A,16#6F,16#6E,16#65,16#73>>), + {ok,"Jones"} = 'PrimStrings':decode('NsCon', <<16#BF,16#46,9,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73>>), + {ok,"Jones"} = 'PrimStrings':decode('NsCon', <<16#BF,16#46,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0>>), + ok; + _ -> + ok + end, - %%========================================================== %% NsExpCon ::= [71] EXPLICIT NumericString %%========================================================== roundtrip('NsExpCon', []), + roundtrip('NsExpCon', "01 34"), - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {ok,BytesNs21} = asn1_wrapper:encode('PrimStrings','NsExpCon',[48,49,32,51,52]), - ?line {ok,[48,49,32,51,52]} = asn1_wrapper:decode('PrimStrings','NsExpCon',lists:flatten(BytesNs21)), - - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','NsExpCon',[16#BF,16#47,16#07,16#12,16#05,16#4A,16#6F,16#6E,16#65,16#73]), - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','NsExpCon',[16#BF,16#47,11,16#32,9,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73]), - ?line {ok,"Jones"} = asn1_wrapper:decode('PrimStrings','NsExpCon',[16#BF,16#47,128,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,0,0]), - ?line {ok,"JonesJones"} = asn1_wrapper:decode('PrimStrings','NsExpCon',[16#BF,16#47,26,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0]), - ?line {ok,"JonesJones"} = asn1_wrapper:decode('PrimStrings','NsExpCon',[16#BF,16#47,128,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,0,0]), - ok; - - per -> - ?line {ok,BytesNs21} = asn1_wrapper:encode('PrimStrings','NsExpCon',[48,49,32,51,52]), - ?line {ok,"01 34"} = asn1_wrapper:decode('PrimStrings','NsExpCon',lists:flatten(BytesNs21)), - ok - end, - - ok. + case Rules of + ber -> + {ok,"Jones"} = 'PrimStrings':decode('NsExpCon', <<16#BF,16#47,16#07,16#12,16#05,16#4A,16#6F,16#6E,16#65,16#73>>), + {ok,"Jones"} = 'PrimStrings':decode('NsExpCon', <<16#BF,16#47,11,16#32,9,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73>>), + {ok,"Jones"} = 'PrimStrings':decode('NsExpCon', <<16#BF,16#47,128,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,0,0>>), + {ok,"JonesJones"} = 'PrimStrings':decode('NsExpCon', <<16#BF,16#47,26,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0>>), + {ok,"JonesJones"} = 'PrimStrings':decode('NsExpCon', <<16#BF,16#47,128,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,16#32,128,18,3,16#4A,16#6F,16#6E,18,2,16#65,16#73,0,0,0,0>>), + ok; + _ -> + ok + end. other_strings(_Rules) -> @@ -438,6 +487,15 @@ other_strings(_Rules) -> roundtrip('IA5Visible', lists:seq($\s, $~)), + S255 = lists:seq(0, 127) ++ lists:seq(1, 127), + Strings = {type,true,"","1","12","345",true,"6789",true, + S255,[$a|S255],[$a,$b|S255],397}, + p_roundtrip('IA5FixedStrings', Strings), + p_roundtrip('IA5FixedStringsExt', Strings), + p_roundtrip('IA5VarStringsExt', Strings), + ShortenedStrings = shorten_by_two(Strings), + p_roundtrip('IA5VarStringsExt', ShortenedStrings), + ok. @@ -491,23 +549,19 @@ universal_string(Rules) -> %%========================================================== roundtrip('Us', [{47,23,99,47},{0,0,55,66}]), - - ?line {ok,Bytes2} = - asn1_wrapper:encode('PrimStrings','Us',[{47,23,99,255},{0,0,0,201}]), - ?line {ok,[{47,23,99,255},201]} = - asn1_wrapper:decode('PrimStrings','Us',lists:flatten(Bytes2)), - + roundtrip('Us', + [{47,23,99,255},{0,0,0,201}], + [{47,23,99,255},201]), roundtrip('Us', "Universal String"), roundtrip('Us', []), roundtrip('Us', [{47,23,99,47}]), - ?line case asn1_wrapper:erule(Rules) of - ber -> - - ?line {ok,[{47,23,99,255},{0,0,2,201}]} = - asn1_wrapper:decode('PrimStrings','Us',lists:flatten([16#3C,12,28,4,47,23,99,255,28,4,0,0,2,201])), - ?line {ok,[{47,23,99,255},{0,0,2,201}]} = - asn1_wrapper:decode('PrimStrings','Us',lists:flatten([16#3C,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0])); + case Rules of + ber -> + {ok,[{47,23,99,255},{0,0,2,201}]} = + 'PrimStrings':decode('Us', <<16#3C,12,28,4,47,23,99,255,28,4,0,0,2,201>>), + {ok,[{47,23,99,255},{0,0,2,201}]} = + 'PrimStrings':decode('Us', <<16#3C,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0>>); _ -> ok end, @@ -522,24 +576,21 @@ universal_string(Rules) -> %%========================================================== roundtrip('UsCon', [{47,23,99,255},{0,0,2,201}]), - - ?line {ok,Bytes12} = - asn1_wrapper:encode('PrimStrings','UsCon',[{47,23,99,255},{0,0,0,201}]), - ?line {ok,[{47,23,99,255},201]} = - asn1_wrapper:decode('PrimStrings','UsCon',lists:flatten(Bytes12)), - + roundtrip('UsCon', + [{47,23,99,255},{0,0,0,201}], + [{47,23,99,255},201]), roundtrip('UsCon', "Universal String"), roundtrip('UsCon', []), - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {ok,[{47,23,99,255},{0,0,2,201}]} = - asn1_wrapper:decode('PrimStrings','UsCon',lists:flatten([16#BF,16#46,12,28,4,47,23,99,255,28,4,0,0,2,201])), - ?line {ok,[{47,23,99,255},{0,0,2,201}]} = - asn1_wrapper:decode('PrimStrings','UsCon',lists:flatten([16#BF,16#46,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0])); - _ -> ok - end, - + case Rules of + ber -> + {ok,[{47,23,99,255},{0,0,2,201}]} = + 'PrimStrings':decode('UsCon', <<16#BF,16#46,12,28,4,47,23,99,255,28,4,0,0,2,201>>), + {ok,[{47,23,99,255},{0,0,2,201}]} = + 'PrimStrings':decode('UsCon', <<16#BF,16#46,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0>>); + _ -> + ok + end, %%========================================================== @@ -547,25 +598,21 @@ universal_string(Rules) -> %%========================================================== roundtrip('UsExpCon', [{47,23,99,255},{0,0,2,201}]), - - ?line {ok,Bytes22} = - asn1_wrapper:encode('PrimStrings','UsExpCon',[{47,23,99,255},{0,0,0,201}]), - ?line {ok,[{47,23,99,255},201]} = - asn1_wrapper:decode('PrimStrings','UsExpCon',lists:flatten(Bytes22)), - + roundtrip('UsExpCon', + [{47,23,99,255},{0,0,0,201}], + [{47,23,99,255},201]), roundtrip('UsExpCon', "Universal String"), roundtrip('UsExpCon', []), - ?line case asn1_wrapper:erule(Rules) of - ber -> - ?line {ok,[{47,23,99,255},{0,0,2,201}]} = - asn1_wrapper:decode('PrimStrings','UsExpCon',lists:flatten([16#BF,16#47,14,60,12,28,4,47,23,99,255,28,4,0,0,2,201])), - ?line {ok,[{47,23,99,255},{0,0,2,201}]} = - asn1_wrapper:decode('PrimStrings','UsExpCon',lists:flatten([16#BF,16#47,16,60,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0])); - _ -> ok - end, - - ok. + case Rules of + ber -> + {ok,[{47,23,99,255},{0,0,2,201}]} = + 'PrimStrings':decode('UsExpCon', <<16#BF,16#47,14,60,12,28,4,47,23,99,255,28,4,0,0,2,201>>), + {ok,[{47,23,99,255},{0,0,2,201}]} = + 'PrimStrings':decode('UsExpCon', <<16#BF,16#47,16,60,16#80,28,4,47,23,99,255,28,4,0,0,2,201,0,0>>); + _ -> + ok + end. bmp_string(_Rules) -> @@ -575,12 +622,9 @@ bmp_string(_Rules) -> %%========================================================== roundtrip('BMP', [{0,0,99,48},{0,0,2,201}]), - - ?line {ok,Bytes2} = - asn1_wrapper:encode('PrimStrings','BMP',[{0,0,0,48},{0,0,2,201}]), - ?line {ok,[48,{0,0,2,201}]} = - asn1_wrapper:decode('PrimStrings','BMP',lists:flatten(Bytes2)), - + roundtrip('BMP', + [{0,0,0,48},{0,0,2,201}], + [48,{0,0,2,201}]), roundtrip('BMP', "BMP String"), roundtrip('BMP', []), @@ -589,9 +633,6 @@ bmp_string(_Rules) -> ok. - - - times(_Rules) -> @@ -620,106 +661,58 @@ utf8_string(_Rules) -> %% UTF ::= UTF8String %%========================================================== - %% test values in all ranges - - ValLbR1 = [16#00], - ValUbR1 = [16#7f], - ValLbR2 = [16#80], - ValUbR2 = [16#7ff], - ValLbR3 = [16#800], - ValUbR3 = [16#ffff], - ValLbR4 = [16#10000], - ValUbR4 = [16#1fffff], - ValLbR5 = [16#200000], - ValUbR5 = [16#3ffffff], - ValLbR6 = [16#4000000], - ValUbR6 = [16#7fffffff], - - ?line {ok,UTF8L1} = asn1rt:utf8_list_to_binary(ValLbR1), - ?line {ok,Bytes1} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L1), - ?line {ok,Bin1} = asn1_wrapper:decode('PrimStrings','UTF',Bytes1), - ?line {ok,ValLbR1} = wrapper_utf8_binary_to_list(Bin1), - - ?line {ok,UTF8L2} = asn1rt:utf8_list_to_binary(ValUbR1), - ?line {ok,Bytes2} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L2), - ?line {ok,Bin2} = asn1_wrapper:decode('PrimStrings','UTF',Bytes2), - ?line {ok,ValUbR1} = wrapper_utf8_binary_to_list(Bin2), - - ?line {ok,UTF8L3} = asn1rt:utf8_list_to_binary(ValLbR2), - ?line {ok,Bytes3} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L3), - ?line {ok,Bin3} = asn1_wrapper:decode('PrimStrings','UTF',Bytes3), - ?line {ok,ValLbR2} = wrapper_utf8_binary_to_list(Bin3), - - ?line {ok,UTF8L4} = asn1rt:utf8_list_to_binary(ValUbR2), - ?line {ok,Bytes4} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L4), - ?line {ok,Bin4} = asn1_wrapper:decode('PrimStrings','UTF',Bytes4), - ?line {ok,ValUbR2} = wrapper_utf8_binary_to_list(Bin4), - - ?line {ok,UTF8L5} = asn1rt:utf8_list_to_binary(ValLbR3), - ?line {ok,Bytes5} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L5), - ?line {ok,Bin5} = asn1_wrapper:decode('PrimStrings','UTF',Bytes5), - ?line {ok,ValLbR3} = wrapper_utf8_binary_to_list(Bin5), - - ?line {ok,UTF8L6} = asn1rt:utf8_list_to_binary(ValUbR3), - ?line {ok,Bytes6} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L6), - ?line {ok,Bin6} = asn1_wrapper:decode('PrimStrings','UTF',Bytes6), - ?line {ok,ValUbR3} = wrapper_utf8_binary_to_list(Bin6), - - ?line {ok,UTF8L7} = asn1rt:utf8_list_to_binary(ValLbR4), - ?line {ok,Bytes7} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L7), - ?line {ok,Bin7} = asn1_wrapper:decode('PrimStrings','UTF',Bytes7), - ?line {ok,ValLbR4} = wrapper_utf8_binary_to_list(Bin7), - - ?line {ok,UTF8L8} = asn1rt:utf8_list_to_binary(ValUbR4), - ?line {ok,Bytes8} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L8), - ?line {ok,Bin8} = asn1_wrapper:decode('PrimStrings','UTF',Bytes8), - ?line {ok,ValUbR4} = wrapper_utf8_binary_to_list(Bin8), - - ?line {ok,UTF8L9} = asn1rt:utf8_list_to_binary(ValLbR5), - ?line {ok,Bytes9} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L9), - ?line {ok,Bin9} = asn1_wrapper:decode('PrimStrings','UTF',Bytes9), - ?line {ok,ValLbR5} = wrapper_utf8_binary_to_list(Bin9), - - ?line {ok,UTF8L10} = asn1rt:utf8_list_to_binary(ValUbR5), - ?line {ok,Bytes10} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L10), - ?line {ok,Bin10} = asn1_wrapper:decode('PrimStrings','UTF',Bytes10), - ?line {ok,ValUbR5} = wrapper_utf8_binary_to_list(Bin10), - - ?line {ok,UTF8L11} = asn1rt:utf8_list_to_binary(ValLbR6), - ?line {ok,Bytes11} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L11), - ?line {ok,Bin11} = asn1_wrapper:decode('PrimStrings','UTF',Bytes11), - ?line {ok,ValLbR6} = wrapper_utf8_binary_to_list(Bin11), - - ?line {ok,UTF8L12} = asn1rt:utf8_list_to_binary(ValUbR6), - ?line {ok,Bytes12} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L12), - ?line {ok,Bin12} = asn1_wrapper:decode('PrimStrings','UTF',Bytes12), - ?line {ok,ValUbR6} = wrapper_utf8_binary_to_list(Bin12), - - LVal = ValLbR1++ValUbR1++ValLbR2++ValUbR2++ValLbR3++ValUbR3++ - ValLbR4++ValUbR4++ValLbR5++ValUbR5++ValLbR6++ValUbR6, - LongVal = LVal++LVal++LVal++LVal++LVal++LVal++LVal++"hello", - - ?line {ok,UTF8L13} = asn1rt:utf8_list_to_binary(LongVal), - ?line {ok,Bytes13} = asn1_wrapper:encode('PrimStrings','UTF',UTF8L13), - ?line {ok,Bin13} = asn1_wrapper:decode('PrimStrings','UTF',Bytes13), - ?line {ok,LongVal} = wrapper_utf8_binary_to_list(Bin13). + AllRanges = [16#00, + 16#7f, + 16#80, + 16#7ff, + 16#800, + 16#ffff, + 16#10000, + 16#1fffff, + 16#200000, + 16#3ffffff, + 16#4000000, + 16#7fffffff], + [begin + {ok,UTF8} = asn1rt:utf8_list_to_binary([Char]), + {ok,[Char]} = asn1rt:utf8_binary_to_list(UTF8), + roundtrip('UTF', UTF8) + end || Char <- AllRanges], + + {ok,UTF8} = asn1rt:utf8_list_to_binary(AllRanges), + {ok,AllRanges} = asn1rt:utf8_binary_to_list(UTF8), + roundtrip('UTF', UTF8), + ok. + + +shorten_by_two(Tuple) -> + L = [case E of + [_,_|T] -> T; + _ -> E + end || E <- tuple_to_list(Tuple)], + list_to_tuple(L). -wrapper_utf8_binary_to_list(L) when is_list(L) -> - asn1rt:utf8_binary_to_list(list_to_binary(L)); -wrapper_utf8_binary_to_list(B) -> - asn1rt:utf8_binary_to_list(B). +p_roundtrip(Type, Value0) -> + Value = setelement(1, Value0, Type), + roundtrip(Type, Value). roundtrip(Type, Value) -> {ok,Encoded} = 'PrimStrings':encode(Type, Value), {ok,Value} = 'PrimStrings':decode(Type, Encoded), ok. +roundtrip(Type, Value, Expected) -> + {ok,Encoded} = 'PrimStrings':encode(Type, Value), + {ok,Expected} = 'PrimStrings':decode(Type, Encoded), + ok. + bs_roundtrip(Type, Value) -> bs_roundtrip(Type, Value, Value). bs_roundtrip(Type, Value, Expected) -> M = 'PrimStrings', {ok,Encoded} = M:encode(Type, Value), + {ok,Encoded} = M:encode(Type, Expected), case M:decode(Type, Encoded) of {ok,Expected} -> ok; diff --git a/lib/asn1/test/testSeqOf.erl b/lib/asn1/test/testSeqOf.erl index 1aa1eab26d..c1af0d7a32 100644 --- a/lib/asn1/test/testSeqOf.erl +++ b/lib/asn1/test/testSeqOf.erl @@ -28,193 +28,110 @@ -record('Seq3',{bool3, seq3 = asn1_DEFAULT, int3}). -record('Seq4',{seq41 = asn1_DEFAULT, seq42 = asn1_DEFAULT, seq43 = asn1_DEFAULT}). -record('SeqIn',{boolIn, intIn}). -%-record('SeqCho',{bool1, int1, seq1 = asn1_DEFAULT}). -%-record('SeqChoInline',{bool1, int1, seq1 = asn1_DEFAULT}). -%-record('SeqChoOfInline_SEQOF',{bool1, int1, seq1 = asn1_DEFAULT}). -record('SeqEmp',{seq1}). -record('Empty',{}). -main(Rules) -> - - ?line {ok,Bytes11} = - asn1_wrapper:encode('SeqOf','Seq1',#'Seq1'{bool1 = true, - int1 = 17}), - ?line {ok,{'Seq1',true,17,[]}} = - asn1_wrapper:decode('SeqOf','Seq1',lists:flatten(Bytes11)), - - - ?line {ok,Bytes12} = - asn1_wrapper:encode('SeqOf','Seq1',#'Seq1'{bool1 = true, - int1 = 17, - seq1 = [#'SeqIn'{boolIn = true, - intIn = 25}]}), - ?line {ok,{'Seq1',true,17,[{'SeqIn',true,25}]}} = - asn1_wrapper:decode('SeqOf','Seq1',lists:flatten(Bytes12)), - - - - ?line {ok,Bytes13} = - asn1_wrapper:encode('SeqOf','Seq1',#'Seq1'{bool1 = true, - int1 = 17, - seq1 = [#'SeqIn'{boolIn = true, - intIn = 25}, - #'SeqIn'{boolIn = false, - intIn = 125}, - #'SeqIn'{boolIn = false, - intIn = 225}]}), - ?line {ok,{'Seq1',true,17,[{'SeqIn',true,25},{'SeqIn',false,125},{'SeqIn',false,225}]}} = - asn1_wrapper:decode('SeqOf','Seq1',lists:flatten(Bytes13)), - - - - - - - ?line {ok,Bytes21} = - asn1_wrapper:encode('SeqOf','Seq2',#'Seq2'{bool2 = true, - int2 = 17}), - - ?line {ok,{'Seq2',[],true,17}} = - asn1_wrapper:decode('SeqOf','Seq2',lists:flatten(Bytes21)), - - - ?line {ok,Bytes22} = - asn1_wrapper:encode('SeqOf','Seq2',#'Seq2'{bool2 = true, - int2 = 17, - seq2 = [#'SeqIn'{boolIn = true, - intIn = 25}]}), - ?line {ok,{'Seq2',[{'SeqIn',true,25}],true,17}} = - asn1_wrapper:decode('SeqOf','Seq2',lists:flatten(Bytes22)), - - - ?line {ok,Bytes23} = - asn1_wrapper:encode('SeqOf','Seq2',#'Seq2'{bool2 = true, - int2 = 17, - seq2 = [#'SeqIn'{boolIn = true, - intIn = 25}, - #'SeqIn'{boolIn = false, - intIn = 125}, - #'SeqIn'{boolIn = false, - intIn = 225}]}), - ?line {ok,{'Seq2',[{'SeqIn',true,25},{'SeqIn',false,125},{'SeqIn',false,225}],true,17}} = - asn1_wrapper:decode('SeqOf','Seq2',lists:flatten(Bytes23)), - - - - - - - ?line {ok,Bytes31} = - asn1_wrapper:encode('SeqOf','Seq3',#'Seq3'{bool3 = true, - int3 = 17}), - ?line {ok,{'Seq3',true,[],17}} = - asn1_wrapper:decode('SeqOf','Seq3',lists:flatten(Bytes31)), - - - ?line {ok,Bytes32} = - asn1_wrapper:encode('SeqOf','Seq3',#'Seq3'{bool3 = true, - int3 = 17, - seq3 = [#'SeqIn'{boolIn = true, - intIn = 25}]}), - ?line {ok,{'Seq3',true,[{'SeqIn',true,25}],17}} = - asn1_wrapper:decode('SeqOf','Seq3',lists:flatten(Bytes32)), - - - ?line {ok,Bytes33} = - asn1_wrapper:encode('SeqOf','Seq3',#'Seq3'{bool3 = true, - int3 = 17, - seq3 = [#'SeqIn'{boolIn = true, - intIn = 25}, - #'SeqIn'{boolIn = false, - intIn = 125}, - #'SeqIn'{boolIn = false, - intIn = 225}]}), - ?line {ok,{'Seq3',true,[{'SeqIn',true,25},{'SeqIn',false,125},{'SeqIn',false,225}],17}} = - asn1_wrapper:decode('SeqOf','Seq3',lists:flatten(Bytes33)), - - +main(_Rules) -> + SeqIn3 = [#'SeqIn'{boolIn=true,intIn=25}, + #'SeqIn'{boolIn=false,intIn=125}, + #'SeqIn'{boolIn=false,intIn=225}], + + roundtrip('Seq1', #'Seq1'{bool1=true,int1=17}, + #'Seq1'{bool1=true,int1=17,seq1=[]}), + + roundtrip('Seq1', #'Seq1'{bool1=true,int1 = 17, + seq1=[#'SeqIn'{boolIn=true, + intIn=25}]}), + roundtrip('Seq1', #'Seq1'{bool1=true, + int1=17, + seq1=SeqIn3}), + + roundtrip('Seq2', #'Seq2'{bool2=true,int2=17}, + #'Seq2'{seq2=[],bool2=true,int2=17}), + roundtrip('Seq2',#'Seq2'{bool2=true,int2=17, + seq2=[#'SeqIn'{boolIn=true, + intIn=25}]}), + roundtrip('Seq2', #'Seq2'{bool2=true, + int2=17, + seq2=SeqIn3}), + + roundtrip('Seq3', #'Seq3'{bool3=true,int3=17}, + #'Seq3'{bool3=true,seq3=[],int3=17}), + roundtrip('Seq3',#'Seq3'{bool3=true, + int3=17, + seq3=[#'SeqIn'{boolIn=true, + intIn=25}]}), + roundtrip('Seq3', #'Seq3'{bool3=true,int3=17,seq3=SeqIn3}), + + roundtrip('Seq4', #'Seq4'{}, #'Seq4'{seq41=[],seq42=[],seq43=[]}), + + roundtrip('Seq4', #'Seq4'{seq41=[#'SeqIn'{boolIn=true,intIn=25}]}, + #'Seq4'{seq41=[#'SeqIn'{boolIn=true,intIn=25}], + seq42=[],seq43=[]}), + + roundtrip('Seq4', #'Seq4'{seq41=SeqIn3}, + #'Seq4'{seq41=SeqIn3,seq42=[],seq43=[]}), + roundtrip('Seq4', #'Seq4'{seq42=[#'SeqIn'{boolIn=true,intIn=25}]}, + #'Seq4'{seq41=[],seq42=[#'SeqIn'{boolIn=true,intIn=25}], + seq43=[]}), + roundtrip('Seq4', #'Seq4'{seq42=SeqIn3}, + #'Seq4'{seq41=[],seq42=SeqIn3,seq43=[]}), + + roundtrip('Seq4', #'Seq4'{seq43=[#'SeqIn'{boolIn=true,intIn=25}]}, + #'Seq4'{seq41=[],seq42=[], + seq43=[#'SeqIn'{boolIn=true,intIn=25}]}), + roundtrip('Seq4', #'Seq4'{seq43=SeqIn3}, + #'Seq4'{seq41=[],seq42=[], + seq43=SeqIn3}), + + roundtrip('SeqEmp', #'SeqEmp'{seq1=[#'Empty'{}]}), + + %% Test constrained, extensible size. + + SeqIn = #'SeqIn'{boolIn=true,intIn=978654321}, + roundtrip('SeqExt', {'SeqExt',true,[],true,[],789}), + roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(1, SeqIn), + true,lists:duplicate(0, SeqIn),777}), + roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(1, SeqIn), + true,lists:duplicate(1, SeqIn),777}), + roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(1, SeqIn), + true,lists:duplicate(127, SeqIn),777}), + roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(2, SeqIn), + true,lists:duplicate(128, SeqIn),1777}), + roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(2, SeqIn), + true,lists:duplicate(255, SeqIn),7773}), + roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(2, SeqIn), + true,lists:duplicate(256, SeqIn),77755}), + roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(2, SeqIn), + true,lists:duplicate(257, SeqIn),8888}), + roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(3, SeqIn), + true,lists:duplicate(1024, SeqIn),999988888}), + roundtrip('SeqExt', {'SeqExt',true,lists:duplicate(15, SeqIn), + true,lists:duplicate(2000, SeqIn),555555}), + + %% Test OTP-4590: correct encoding of the length of SEQUENC OF. + DayNames = ["Monday","Tuesday","Wednesday", + "Thursday","Friday","Saturday","Sunday"], + xroundtrip('DayNames1', 'DayNames3', DayNames), + xroundtrip('DayNames2', 'DayNames4', DayNames), + xroundtrip('DayNames2', 'DayNames4', [hd(DayNames)]), + xroundtrip('DayNames2', 'DayNames4', tl(DayNames)), + ok. +roundtrip(T, V) -> + roundtrip(T, V, V). - - - ?line {ok,Bytes41} = asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{}), - ?line {ok,{'Seq4',[],[],[]}} = asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes41)), - - - ?line {ok,Bytes42} = - asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{seq41 = [#'SeqIn'{boolIn = true, - intIn = 25}]}), - ?line {ok,{'Seq4',[{'SeqIn',true,25}],[],[]}} = - asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes42)), - - - ?line {ok,Bytes43} = - asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{seq41 = [#'SeqIn'{boolIn = true, - intIn = 25}, - #'SeqIn'{boolIn = false, - intIn = 125}, - #'SeqIn'{boolIn = false, - intIn = 225}]}), - ?line {ok,{'Seq4',[{'SeqIn',true,25},{'SeqIn',false,125},{'SeqIn',false,225}],[],[]}} = - asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes43)), - - - ?line {ok,Bytes44} = - asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{seq42 = [#'SeqIn'{boolIn = true, - intIn = 25}]}), - ?line {ok,{'Seq4',[],[{'SeqIn',true,25}],[]}} = - asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes44)), - - - ?line {ok,Bytes45} = - asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{seq42 = [#'SeqIn'{boolIn = true, - intIn = 25}, - #'SeqIn'{boolIn = false, - intIn = 125}, - #'SeqIn'{boolIn = false, - intIn = 225}]}), - ?line {ok,{'Seq4',[],[{'SeqIn',true,25},{'SeqIn',false,125},{'SeqIn',false,225}],[]}} = - asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes45)), - - - ?line {ok,Bytes46} = - asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{seq43 = [#'SeqIn'{boolIn = true, - intIn = 25}]}), - ?line {ok,{'Seq4',[],[],[{'SeqIn',true,25}]}} = - asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes46)), - - - ?line {ok,Bytes47} = - asn1_wrapper:encode('SeqOf','Seq4',#'Seq4'{seq43 = [#'SeqIn'{boolIn = true, - intIn = 25}, - #'SeqIn'{boolIn = false, - intIn = 125}, - #'SeqIn'{boolIn = false, - intIn = 225}]}), - ?line {ok,{'Seq4',[],[],[{'SeqIn',true,25},{'SeqIn',false,125},{'SeqIn',false,225}]}} = - asn1_wrapper:decode('SeqOf','Seq4',lists:flatten(Bytes47)), - - - ?line {ok,Bytes51} = asn1_wrapper:encode('SeqOf','SeqEmp',#'SeqEmp'{seq1 = [#'Empty'{}]}), - ?line {ok,{'SeqEmp',[{'Empty'}]}} = asn1_wrapper:decode('SeqOf','SeqEmp',lists:flatten(Bytes51)), - - %% tests of OTP-4590 - case Rules of - per -> - DayNames = ["Monday","Tuesday","Wednesday","Thursday","Friday","Saturday","Sunday"], - ?line {ok,Bytes60} = asn1_wrapper:encode('XSeqOf','DayNames2',DayNames), - ?line {ok,Bytes60} = asn1_wrapper:encode('XSeqOf','DayNames4',DayNames), - ?line {ok,DayNames} = asn1_wrapper:decode('XSeqOf','DayNames2',Bytes60), - ?line {ok,DayNames} = asn1_wrapper:decode('XSeqOf','DayNames4',Bytes60), - ?line {ok,Bytes61} = asn1_wrapper:encode('XSeqOf','DayNames1',DayNames), - ?line {ok,Bytes61} = asn1_wrapper:encode('XSeqOf','DayNames3',DayNames), - ?line {ok,DayNames} = asn1_wrapper:decode('XSeqOf','DayNames1',Bytes61), - ?line {ok,DayNames} = asn1_wrapper:decode('XSeqOf','DayNames3',Bytes61); - _ -> - ok - end, - +roundtrip(Type, Val, Expected) -> + M = 'SeqOf', + {ok,Enc} = M:encode(Type, Val), + {ok,Expected} = M:decode(Type, Enc), ok. - +xroundtrip(T1, T2, Val) -> + M = 'XSeqOf', + {ok,Enc} = M:encode(T1, Val), + {ok,Enc} = M:encode(T2, Val), + {ok,Val} = M:decode(T1, Enc), + {ok,Val} = M:decode(T2, Enc), + ok. diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl index 9bb9817001..5c80a299f8 100644 --- a/lib/common_test/src/ct_config.erl +++ b/lib/common_test/src/ct_config.erl @@ -46,7 +46,7 @@ decrypt_config_file/2, decrypt_config_file/3, get_crypt_key_from_file/0, get_crypt_key_from_file/1]). --export([get_ref_from_name/1, get_name_from_ref/1, get_key_from_name/1]). +-export([get_key_from_name/1]). -export([check_config_files/1, add_default_callback/1, prepare_config_list/1]). @@ -56,7 +56,7 @@ -define(cryptfile, ".ct_config.crypt"). --record(ct_conf,{key,value,handler,config,ref,name='_UNDEF',default=false}). +-record(ct_conf,{key,value,handler,config,name='_UNDEF',default=false}). start(Mode) -> case whereis(ct_config_server) of @@ -275,7 +275,6 @@ store_config(Config, Callback, File) when is_list(Config) -> value=Val, handler=Callback, config=File, - ref=ct_util:ct_make_ref(), default=false}) || {Key,Val} <- Config]. @@ -296,13 +295,11 @@ rewrite_config(Config, Callback, File) -> #ct_conf{key=Key, value=Value, handler=Callback, - config=File, - ref=ct_util:ct_make_ref()}); + config=File}); RowsToUpdate -> Inserter = fun(Row) -> ets:insert(?attr_table, - Row#ct_conf{value=Value, - ref=ct_util:ct_make_ref()}) + Row#ct_conf{value=Value}) end, lists:foreach(Inserter, RowsToUpdate) end @@ -314,7 +311,7 @@ set_config(Config,Default) -> set_config(Name,Config,Default) -> [ets:insert(?attr_table, - #ct_conf{key=Key,value=Val,ref=ct_util:ct_make_ref(), + #ct_conf{key=Key,value=Val, name=Name,default=Default}) || {Key,Val} <- Config]. @@ -559,26 +556,6 @@ encrypt_config_file(SrcFileName, EncryptFileName) -> encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) end. -get_ref_from_name(Name) -> - case ets:select(?attr_table,[{#ct_conf{name=Name,ref='$1',_='_'}, - [], - ['$1']}]) of - [Ref] -> - {ok,Ref}; - _ -> - {error,{no_such_name,Name}} - end. - -get_name_from_ref(Ref) -> - case ets:select(?attr_table,[{#ct_conf{name='$1',ref=Ref,_='_'}, - [], - ['$1']}]) of - [Name] -> - {ok,Name}; - _ -> - {error,{no_such_ref,Ref}} - end. - get_key_from_name(Name) -> case ets:select(?attr_table,[{#ct_conf{name=Name,key='$1',_='_'}, [], diff --git a/lib/common_test/src/ct_ftp.erl b/lib/common_test/src/ct_ftp.erl index 8790393b36..b91a521bd4 100644 --- a/lib/common_test/src/ct_ftp.erl +++ b/lib/common_test/src/ct_ftp.erl @@ -348,10 +348,10 @@ terminate(FtpPid,State) -> get_handle(Pid) when is_pid(Pid) -> {ok,Pid}; get_handle(Name) -> - case ct_util:get_connections(Name,?MODULE) of - {ok,[{Pid,_}|_]} -> + case ct_util:get_connection(Name,?MODULE) of + {ok,{Pid,_}} -> {ok,Pid}; - {ok,[]} -> + {error,no_registered_connection} -> open(Name); Error -> Error diff --git a/lib/common_test/src/ct_gen_conn.erl b/lib/common_test/src/ct_gen_conn.erl index 2d4b1d1f52..a5b736136f 100644 --- a/lib/common_test/src/ct_gen_conn.erl +++ b/lib/common_test/src/ct_gen_conn.erl @@ -26,7 +26,7 @@ -compile(export_all). --export([start/4, stop/1]). +-export([start/4, stop/1, get_conn_pid/1]). -export([call/2, call/3, return/2, do_within_time/2]). -ifdef(debug). @@ -120,8 +120,16 @@ start(Name,Address,InitData,CallbackMod) -> %%% Handle = handle() %%% %%% @doc Close the connection and stop the process managing it. -stop(Pid) -> - call(Pid,stop,5000). +stop(Handle) -> + call(Handle,stop,5000). + +%%%----------------------------------------------------------------- +%%% @spec get_conn_pid(Handle) -> ok +%%% Handle = handle() +%%% +%%% @doc Return the connection pid associated with Handle +get_conn_pid(Handle) -> + call(Handle,get_conn_pid). %%%----------------------------------------------------------------- %%% @spec log(Heading,Format,Args) -> ok @@ -222,7 +230,8 @@ do_start(Opts) -> receive {connected,Pid} -> erlang:demonitor(MRef, [flush]), - ct_util:register_connection(Opts#gen_opts.name, Opts#gen_opts.address, + ct_util:register_connection(Opts#gen_opts.name, + Opts#gen_opts.address, Opts#gen_opts.callback, Pid), {ok,Pid}; {Error,Pid} -> @@ -315,10 +324,12 @@ loop(Opts) -> {ok, NewPid, NewState} -> link(NewPid), put(conn_pid,NewPid), - loop(Opts#gen_opts{conn_pid=NewPid,cb_state=NewState}); + loop(Opts#gen_opts{conn_pid=NewPid, + cb_state=NewState}); Error -> ct_util:unregister_connection(self()), - log("Reconnect failed. Giving up!","Reason: ~p\n", + log("Reconnect failed. Giving up!", + "Reason: ~p\n", [Error]) end; false -> @@ -338,7 +349,8 @@ loop(Opts) -> Opts#gen_opts.cb_state), return(From,ok), ok; - {{retry,{Error,_Name,CPid,_Msg}}, From} when CPid == Opts#gen_opts.conn_pid -> + {{retry,{Error,_Name,CPid,_Msg}}, From} when + CPid == Opts#gen_opts.conn_pid -> %% only retry if failure is because of a reconnection Return = case Error of {error,_} -> Error; @@ -347,12 +359,16 @@ loop(Opts) -> return(From, Return), loop(Opts); {{retry,{_Error,_Name,_CPid,Msg}}, From} -> - log("Rerunning command","Connection reestablished. Rerunning command...",[]), + log("Rerunning command","Connection reestablished. " + "Rerunning command...",[]), {Return,NewState} = (Opts#gen_opts.callback):handle_msg(Msg,Opts#gen_opts.cb_state), return(From, Return), loop(Opts#gen_opts{cb_state=NewState}); - {Msg,From={Pid,_Ref}} when is_pid(Pid), Opts#gen_opts.old==true -> + {get_conn_pid, From} -> + return(From, Opts#gen_opts.conn_pid), + loop(Opts); + {Msg, From={Pid,_Ref}} when is_pid(Pid), Opts#gen_opts.old==true -> {Return,NewState} = (Opts#gen_opts.callback):handle_msg(Msg,Opts#gen_opts.cb_state), return(From, Return), @@ -372,7 +388,8 @@ loop(Opts) -> return(From,Reply) end; Msg when Opts#gen_opts.forward==true -> - case (Opts#gen_opts.callback):handle_msg(Msg,Opts#gen_opts.cb_state) of + case (Opts#gen_opts.callback):handle_msg(Msg, + Opts#gen_opts.cb_state) of {noreply,NewState} -> loop(Opts#gen_opts{cb_state=NewState}); {stop,NewState} -> diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index 1339e53780..e094ee877a 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -1164,13 +1164,11 @@ call(Client, Msg, Timeout, WaitStop) -> get_handle(Client) when is_pid(Client) -> {ok,Client}; get_handle(Client) -> - case ct_util:get_connections(Client, ?MODULE) of - {ok,[{Pid,_}]} -> + case ct_util:get_connection(Client, ?MODULE) of + {ok,{Pid,_}} -> {ok,Pid}; - {ok,[]} -> + {error,no_registered_connection} -> {error,{no_connection_found,Client}}; - {ok,Conns} -> - {error,{multiple_connections_found,Client,Conns}}; Error -> Error end. @@ -1302,7 +1300,8 @@ handle_data(NewData,#state{connection=Connection,buff=Buff} = State) -> decode(Simple,State#state{buff=Rest}); {fatal_error,_Loc,Reason,_EndTags,_EventState} -> ?error(Connection#connection.name,[{parse_error,Reason}, - {data,Data}]), + {buffer,Buff}, + {new_data,NewData}]), case Reason of {could_not_fetch_data,Msg} -> handle_msg(Msg,State#state{buff = <<>>}); diff --git a/lib/common_test/src/ct_ssh.erl b/lib/common_test/src/ct_ssh.erl index c6ea27b10e..1adc79d358 100644 --- a/lib/common_test/src/ct_ssh.erl +++ b/lib/common_test/src/ct_ssh.erl @@ -1328,10 +1328,10 @@ do_recv_response(SSH, Chn, Data, End, Timeout) -> get_handle(SSH) when is_pid(SSH) -> {ok,SSH}; get_handle(SSH) -> - case ct_util:get_connections(SSH, ?MODULE) of - {ok,[{Pid,_}]} -> + case ct_util:get_connection(SSH, ?MODULE) of + {ok,{Pid,_}} -> {ok,Pid}; - {ok,[]} -> + {error,no_registered_connection} -> connect(SSH); Error -> Error diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index 4755d939e0..4092d33bc0 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -183,7 +183,8 @@ open(KeyOrName,ConnType,TargetMod,Extra) -> end; Bool -> Bool end, - log(heading(open,{KeyOrName,ConnType}),"Opening connection to: ~p",[Addr1]), + log(heading(open,{KeyOrName,ConnType}), + "Opening connection to: ~p",[Addr1]), ct_gen_conn:start(KeyOrName,full_addr(Addr1,ConnType), {TargetMod,KeepAlive,Extra},?MODULE) end. @@ -591,9 +592,9 @@ terminate(TelnPid,State) -> get_handle(Pid) when is_pid(Pid) -> {ok,Pid}; get_handle({Name,Type}) when Type==telnet;Type==ts1;Type==ts2 -> - case ct_util:get_connections(Name,?MODULE) of - {ok,Conns} when Conns /= [] -> - case get_handle(Type,Conns) of + case ct_util:get_connection(Name,?MODULE) of + {ok,Conn} -> + case get_handle(Type,Conn) of {ok,Pid} -> {ok,Pid}; _Error -> @@ -608,19 +609,15 @@ get_handle({Name,Type}) when Type==telnet;Type==ts1;Type==ts2 -> Error end end; - {ok,[]} -> - {error,already_closed}; Error -> Error end; get_handle(Name) -> get_handle({Name,telnet}). -get_handle(Type,[{Pid,{_,_,Type}}|_]) -> +get_handle(Type,{Pid,{_,_,Type}}) -> {ok,Pid}; -get_handle(Type,[_H|T]) -> - get_handle(Type,T); -get_handle(Type,[]) -> +get_handle(Type,_) -> {error,{no_such_connection,Type}}. full_addr({Ip,Port},Type) -> diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index b77845eb5b..68e76c2396 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -25,13 +25,13 @@ %%% -module(ct_util). --export([start/0,start/1,start/2,start/3, - stop/1,update_last_run_index/0]). +-export([start/0, start/1, start/2, start/3, + stop/1, update_last_run_index/0]). --export([register_connection/4,unregister_connection/1, - does_connection_exist/3,get_key_from_name/1]). +-export([register_connection/4, unregister_connection/1, + does_connection_exist/3, get_key_from_name/1]). --export([close_connections/0]). +-export([get_connections/1, close_connections/0]). -export([save_suite_data/3, save_suite_data/2, save_suite_data_async/3, save_suite_data_async/2, @@ -56,11 +56,11 @@ -export([listenv/1]). --export([get_target_name/1, get_connections/2]). +-export([get_target_name/1, get_connection/2]). -export([is_test_dir/1, get_testdir/2]). --export([kill_attached/2, get_attached/1, ct_make_ref/0]). +-export([kill_attached/2, get_attached/1]). -export([warn_duplicates/1]). @@ -417,7 +417,8 @@ loop(Mode,TestData,StartDir) -> ?MAX_IMPORTANCE, "CT Error Notification", "Connection process died: " - "Pid: ~w, Address: ~p, Callback: ~w\n" + "Pid: ~w, Address: ~p, " + "Callback: ~w\n" "Reason: ~p\n\n", [Pid,A,CB,Reason]), catch CB:close(Pid), @@ -426,8 +427,8 @@ loop(Mode,TestData,StartDir) -> loop(Mode,TestData,StartDir); _ -> %% Let process crash in case of error, this shouldn't happen! - io:format("\n\nct_util_server got EXIT from ~w: ~p\n\n", - [Pid,Reason]), + io:format("\n\nct_util_server got EXIT " + "from ~w: ~p\n\n", [Pid,Reason]), file:set_cwd(StartDir), exit(Reason) end @@ -457,10 +458,13 @@ get_key_from_name(Name)-> %%% table, and ct_util will close all registered connections when the %%% test is finished by calling <code>Callback:close/1</code>.</p> register_connection(TargetName,Address,Callback,Handle) -> + %% If TargetName is a registered alias for a config + %% variable, use it as reference for the connection, + %% otherwise use the Handle value. TargetRef = - case ct_config:get_ref_from_name(TargetName) of - {ok,Ref} -> - Ref; + case ct_config:get_key_from_name(TargetName) of + {ok,_Key} -> + TargetName; _ -> %% no config name associated with connection, %% use handle for identification instead @@ -496,10 +500,10 @@ unregister_connection(Handle) -> %%% %%% @doc Check if a connection already exists. does_connection_exist(TargetName,Address,Callback) -> - case ct_config:get_ref_from_name(TargetName) of - {ok,TargetRef} -> + case ct_config:get_key_from_name(TargetName) of + {ok,_Key} -> case ets:select(?conn_table,[{#conn{handle='$1', - targetref=TargetRef, + targetref=TargetName, address=Address, callback=Callback}, [], @@ -514,41 +518,76 @@ does_connection_exist(TargetName,Address,Callback) -> end. %%%----------------------------------------------------------------- -%%% @spec get_connections(TargetName,Callback) -> -%%% {ok,Connections} | {error,Reason} +%%% @spec get_connection(TargetName,Callback) -> +%%% {ok,Connection} | {error,Reason} %%% TargetName = ct:target_name() %%% Callback = atom() -%%% Connections = [Connection] %%% Connection = {Handle,Address} %%% Handle = term() %%% Address = term() %%% -%%% @doc Return all connections for the <code>Callback</code> on the +%%% @doc Return the connection for <code>Callback</code> on the %%% given target (<code>TargetName</code>). -get_connections(TargetName,Callback) -> - case ct_config:get_ref_from_name(TargetName) of - {ok,Ref} -> - {ok,ets:select(?conn_table,[{#conn{handle='$1', - address='$2', - targetref=Ref, - callback=Callback}, - [], - [{{'$1','$2'}}]}])}; +get_connection(TargetName,Callback) -> + %% check that TargetName is a registered alias + case ct_config:get_key_from_name(TargetName) of + {ok,_Key} -> + case ets:select(?conn_table,[{#conn{handle='$1', + address='$2', + targetref=TargetName, + callback=Callback}, + [], + [{{'$1','$2'}}]}]) of + [Result] -> + {ok,Result}; + [] -> + {error,no_registered_connection} + end; Error -> Error end. %%%----------------------------------------------------------------- +%%% @spec get_connections(ConnPid) -> +%%% {ok,Connections} | {error,Reason} +%%% Connections = [Connection] +%%% Connection = {TargetName,Handle,Callback,Address} +%%% TargetName = ct:target_name() | undefined +%%% Handle = term() +%%% Callback = atom() +%%% Address = term() +%%% +%%% @doc Get data for all connections associated with a particular +%%% connection pid (see Callback:init/3). +get_connections(ConnPid) -> + Conns = ets:tab2list(?conn_table), + lists:flatmap(fun(#conn{targetref=TargetName, + handle=Handle, + callback=Callback, + address=Address}) -> + case ct_gen_conn:get_conn_pid(Handle) of + ConnPid when is_atom(TargetName) -> + [{TargetName,Handle, + Callback,Address}]; + ConnPid -> + [{undefined,Handle, + Callback,Address}]; + _ -> + [] + end + end, Conns). + +%%%----------------------------------------------------------------- %%% @hidden %%% @equiv ct:get_target_name/1 -get_target_name(ConnPid) -> - case ets:select(?conn_table,[{#conn{handle=ConnPid,targetref='$1',_='_'}, +get_target_name(Handle) -> + case ets:select(?conn_table,[{#conn{handle=Handle,targetref='$1',_='_'}, [], ['$1']}]) of - [TargetRef] -> - ct_config:get_name_from_ref(TargetRef); - [] -> - {error,{unknown_connection,ConnPid}} + [TargetName] when is_atom(TargetName) -> + {ok,TargetName}; + _ -> + {error,{unknown_connection,Handle}} end. %%%----------------------------------------------------------------- @@ -922,29 +961,6 @@ cast(Msg) -> seconds(T) -> test_server:seconds(T). -ct_make_ref() -> - Pid = case whereis(ct_make_ref) of - undefined -> - spawn_link(fun() -> ct_make_ref_init() end); - P -> - P - end, - Pid ! {self(),ref_req}, - receive - {Pid,Ref} -> Ref - end. - -ct_make_ref_init() -> - register(ct_make_ref,self()), - ct_make_ref_loop(0). - -ct_make_ref_loop(N) -> - receive - {From,ref_req} -> - From ! {self(),N}, - ct_make_ref_loop(N+1) - end. - abs_name("/") -> "/"; abs_name(Dir0) -> diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index 31ab28c41d..9d2edcd653 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -30,6 +30,7 @@ MODULES= \ ct_userconfig_callback \ telnet_server \ ct_smoke_test_SUITE \ + ct_gen_conn_SUITE \ ct_priv_dir_SUITE \ ct_event_handler_SUITE \ ct_config_info_SUITE \ diff --git a/lib/common_test/test/ct_gen_conn_SUITE.erl b/lib/common_test/test/ct_gen_conn_SUITE.erl new file mode 100644 index 0000000000..2a2183854e --- /dev/null +++ b/lib/common_test/test/ct_gen_conn_SUITE.erl @@ -0,0 +1,135 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2012. 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% +%% + +%%%------------------------------------------------------------------- +%%% File: ct_gen_conn_SUITE +%%% +%%% Description: +%%% Test that the generic connection handling in CT works as expected. +%%% +%%% The suite used for the test is located in the data directory. +%%%------------------------------------------------------------------- +-module(ct_gen_conn_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +-define(eh, ct_test_support_eh). + +%%-------------------------------------------------------------------- +%% TEST SERVER CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% Description: Since Common Test starts another Test Server +%% instance, the tests need to be performed on a separate node (or +%% there will be clashes with logging processes etc). +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + ct_test_support:init_per_suite(Config). + +end_per_suite(Config) -> + ct_test_support:end_per_suite(Config). + +init_per_testcase(TestCase, Config) -> + ct_test_support:init_per_testcase(TestCase, Config). + +end_per_testcase(TestCase, Config) -> + ct_test_support:end_per_testcase(TestCase, Config). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [handles_to_multi_conn_pids, handles_to_single_conn_pids, + names_to_multi_conn_pids, names_to_single_conn_pids]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- +handles_to_multi_conn_pids(Config) -> + run_test(handles_to_multi_conn_pids, Config). + +handles_to_single_conn_pids(Config) -> + run_test(handles_to_single_conn_pids, Config). + +names_to_multi_conn_pids(Config) -> + run_test(names_to_multi_conn_pids, Config). + +names_to_single_conn_pids(Config) -> + run_test(names_to_single_conn_pids, Config). + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- +run_test(TestCase, Config) -> + DataDir = ?config(data_dir, Config), + {Opts,ERPid} = setup_env([{dir,DataDir}, + {suite,conn_SUITE}, + {testcase,TestCase}, + {config,filename:join(DataDir,"conn.conf")}], + Config), + ok = ct_test_support:run(Opts, Config), + TestEvents = ct_test_support:get_events(ERPid, Config), + ct_test_support:log_events(TestCase, + reformat_events(TestEvents, ?eh), + ?config(priv_dir, Config), + Opts), + ExpEvents = events_to_check(TestCase), + ok = ct_test_support:verify_events(ExpEvents, TestEvents, Config). + +setup_env(Test, Config) -> + Opts0 = ct_test_support:get_opts(Config), + Level = ?config(trace_level, Config), + EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}} | Test], + ERPid = ct_test_support:start_event_receiver(Config), + {Opts,ERPid}. + +reformat_events(Events, EH) -> + ct_test_support:reformat(Events, EH). + +%%%----------------------------------------------------------------- +%%% TEST EVENTS +%%%----------------------------------------------------------------- +events_to_check(Test) -> + %% 2 tests (ct:run_test + script_start) is default + events_to_check(Test, 2). + +events_to_check(_, 0) -> + []; +events_to_check(Test, N) -> + test_events(Test) ++ events_to_check(Test, N-1). + +test_events(Name) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,1}}, + {?eh,tc_start,{conn_SUITE,init_per_suite}}, + {?eh,tc_done,{conn_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{conn_SUITE,Name}}, + {?eh,tc_done,{conn_SUITE,Name,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{conn_SUITE,end_per_suite}}, + {?eh,tc_done,{conn_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]. diff --git a/lib/common_test/test/ct_gen_conn_SUITE_data/conn.conf b/lib/common_test/test/ct_gen_conn_SUITE_data/conn.conf new file mode 100644 index 0000000000..09f3c11e10 --- /dev/null +++ b/lib/common_test/test/ct_gen_conn_SUITE_data/conn.conf @@ -0,0 +1,8 @@ +{multi_conn_pid, [{addr,"localhost"}, + {port,8383}, + {multiple_conn_pids,true}]}. + +{single_conn_pid, [{addr,"localhost"}, + {port,8383}, + {multiple_conn_pids,false}, + {conn_mgr_name,conn_mgr}]}. diff --git a/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl b/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl new file mode 100644 index 0000000000..6877e0c2d2 --- /dev/null +++ b/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl @@ -0,0 +1,240 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2010. 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% +%% + +%%%------------------------------------------------------------------- +%%% File : conn_SUITE +%%% Description : Check that the generic connection handling in CT +%%% works as expected. +%%%------------------------------------------------------------------- +-module(conn_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +%%-------------------------------------------------------------------- +%% COMMON TEST CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- + +suite() -> + [{timetrap,{seconds,5}}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(_TestCase, _Config) -> + ok. + +all() -> + [handles_to_multi_conn_pids, handles_to_single_conn_pids, + names_to_multi_conn_pids, names_to_single_conn_pids]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +handles_to_multi_conn_pids() -> + [{require,multi_conn_pid}]. + +handles_to_multi_conn_pids(_Config) -> + application:set_env(ct_test, reconnect, true), + + Handle1 = proto:open(multi_conn_pid), + ConnPid1 = ct_gen_conn:get_conn_pid(Handle1), + {true,true} = {is_process_alive(Handle1),is_process_alive(ConnPid1)}, + Handle2 = proto:open(multi_conn_pid), + ConnPid2 = ct_gen_conn:get_conn_pid(Handle2), + {true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid2)}, + Handle3 = proto:open(multi_conn_pid), + ConnPid3 = ct_gen_conn:get_conn_pid(Handle3), + {true,true} = {is_process_alive(Handle3),is_process_alive(ConnPid3)}, + + ok = proto:close(Handle1), + timer:sleep(100), + {false,false} = {is_process_alive(Handle1),is_process_alive(ConnPid1)}, + {true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid2)}, + + ok = proto:kill_conn_proc(Handle2), + timer:sleep(100), + {true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2)}, + ConnPid2x = ct_gen_conn:get_conn_pid(Handle2), + true = is_process_alive(ConnPid2x), + + ok = proto:close(Handle2), + timer:sleep(100), + {false,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2x)}, + + application:set_env(ct_test, reconnect, false), + ok = proto:kill_conn_proc(Handle3), + timer:sleep(100), + {false,false} = {is_process_alive(Handle3),is_process_alive(ConnPid3)}, + + ok. + +handles_to_single_conn_pids() -> + [{require,single_conn_pid}]. + +handles_to_single_conn_pids(_Config) -> + application:set_env(ct_test, reconnect, true), + + Handle1 = proto:open(single_conn_pid), + ConnPid = ct_gen_conn:get_conn_pid(Handle1), + {true,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)}, + Handle2 = proto:open(single_conn_pid), + ConnPid = ct_gen_conn:get_conn_pid(Handle2), + {true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid)}, + Handle3 = proto:open(single_conn_pid), + ConnPid = ct_gen_conn:get_conn_pid(Handle3), + {true,true} = {is_process_alive(Handle3),is_process_alive(ConnPid)}, + + Conns = [{undefined,Handle1,_,_}, + {undefined,Handle2,_,_}, + {undefined,Handle3,_,_}] = lists:sort(ct_util:get_connections(ConnPid)), + ct:pal("CONNS = ~n~p", [Conns]), + + ok = proto:close(Handle1), + timer:sleep(100), + {false,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)}, + + ok = proto:kill_conn_proc(Handle2), + timer:sleep(100), + NewConnPid = ct_gen_conn:get_conn_pid(Handle2), + NewConnPid = ct_gen_conn:get_conn_pid(Handle3), + true = is_process_alive(Handle2), + true = is_process_alive(Handle3), + + ok = proto:close(Handle2), + timer:sleep(100), + {false,true} = {is_process_alive(Handle2),is_process_alive(NewConnPid)}, + + application:set_env(ct_test, reconnect, false), + ok = proto:kill_conn_proc(Handle3), + timer:sleep(100), + {false,false} = {is_process_alive(Handle3),is_process_alive(NewConnPid)}, + + ok. + +names_to_multi_conn_pids() -> + [{require,mconn1,multi_conn_pid}, + {require,mconn2,multi_conn_pid}, + {require,mconn3,multi_conn_pid}]. + +names_to_multi_conn_pids(_Config) -> + application:set_env(ct_test, reconnect, true), + + Handle1 = proto:open(mconn1), + ConnPid1 = ct_gen_conn:get_conn_pid(Handle1), + {true,true} = {is_process_alive(Handle1),is_process_alive(ConnPid1)}, + Handle2 = proto:open(mconn2), + ConnPid2 = ct_gen_conn:get_conn_pid(Handle2), + {true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid2)}, + Handle3 = proto:open(mconn3), + ConnPid3 = ct_gen_conn:get_conn_pid(Handle3), + {true,true} = {is_process_alive(Handle3),is_process_alive(ConnPid3)}, + + Handle1 = proto:open(mconn1), + + ok = proto:close(mconn1), + timer:sleep(100), + {false,false} = {is_process_alive(Handle1),is_process_alive(ConnPid1)}, + + ok = proto:kill_conn_proc(Handle2), + timer:sleep(100), + Handle2 = proto:open(mconn2), % should've been reconnected already + {true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2)}, + ConnPid2x = ct_gen_conn:get_conn_pid(Handle2), + true = is_process_alive(ConnPid2x), + + ok = proto:close(mconn2), + timer:sleep(100), + {false,false} = {is_process_alive(Handle2),is_process_alive(ConnPid2x)}, + Handle2y = proto:open(mconn2), + ConnPid2y = ct_gen_conn:get_conn_pid(Handle2y), + {true,true} = {is_process_alive(Handle2y),is_process_alive(ConnPid2y)}, + ok = proto:close(mconn2), + timer:sleep(100), + {false,false} = {is_process_alive(Handle2y),is_process_alive(ConnPid2y)}, + + application:set_env(ct_test, reconnect, false), + ok = proto:kill_conn_proc(Handle3), + timer:sleep(100), + {false,false} = {is_process_alive(Handle3),is_process_alive(ConnPid3)}, + + ok. + +names_to_single_conn_pids() -> + [{require,sconn1,single_conn_pid}, + {require,sconn2,single_conn_pid}, + {require,sconn3,single_conn_pid}]. + +names_to_single_conn_pids(_Config) -> + application:set_env(ct_test, reconnect, true), + + Handle1 = proto:open(sconn1), + ConnPid = ct_gen_conn:get_conn_pid(Handle1), + {true,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)}, + Handle2 = proto:open(sconn2), + ConnPid = ct_gen_conn:get_conn_pid(Handle2), + {true,true} = {is_process_alive(Handle2),is_process_alive(ConnPid)}, + Handle3 = proto:open(sconn3), + ConnPid = ct_gen_conn:get_conn_pid(Handle3), + {true,true} = {is_process_alive(Handle3),is_process_alive(ConnPid)}, + + Handle1 = proto:open(sconn1), + + Conns = [{sconn1,Handle1,_,_}, + {sconn2,Handle2,_,_}, + {sconn3,Handle3,_,_}] = lists:sort(ct_util:get_connections(ConnPid)), + ct:pal("CONNS on ~p = ~n~p", [ConnPid,Conns]), + + ok = proto:close(sconn1), + timer:sleep(100), + {false,true} = {is_process_alive(Handle1),is_process_alive(ConnPid)}, + + ok = proto:kill_conn_proc(Handle2), + timer:sleep(100), + {true,false} = {is_process_alive(Handle2),is_process_alive(ConnPid)}, + Handle2 = proto:open(sconn2), % should've been reconnected already + NewConnPid = ct_gen_conn:get_conn_pid(Handle2), + true = is_process_alive(NewConnPid), + + Conns1 = [{sconn2,Handle2,_,_}, + {sconn3,Handle3,_,_}] = + lists:sort(ct_util:get_connections(NewConnPid)), + ct:pal("CONNS on ~p = ~n~p", [NewConnPid,Conns1]), + + ok = proto:close(sconn2), + timer:sleep(100), + {false,true} = {is_process_alive(Handle2),is_process_alive(NewConnPid)}, + + application:set_env(ct_test, reconnect, false), + ok = proto:kill_conn_proc(Handle3), + timer:sleep(100), + {false,false} = {is_process_alive(Handle3),is_process_alive(NewConnPid)}, + + ok. + + diff --git a/lib/common_test/test/ct_gen_conn_SUITE_data/proto.erl b/lib/common_test/test/ct_gen_conn_SUITE_data/proto.erl new file mode 100644 index 0000000000..8fcd35e0a4 --- /dev/null +++ b/lib/common_test/test/ct_gen_conn_SUITE_data/proto.erl @@ -0,0 +1,196 @@ +%%% @author Peter Andersson <[email protected]> +%%% @copyright (C) 2013, Peter Andersson +%%% @doc +%%% +%%% @end +%%% Created : 24 May 2013 by Peter Andersson <[email protected]> + +-module(proto). + +-compile(export_all). + +-record(conn_state, {id, pid, ref, data}). + +%% TEST1: N connections (same key) -> N conn pids +%% TEST2: N connections (same key) -> 1 conn pid +%% TEST3: N aliases (same key) -> N conn pids +%% TEST4: N aliases (same key) -> 1 conn pid + +open(KeyOrAlias) -> + case ct:get_config(KeyOrAlias) of + undefined -> + {error,{not_available,KeyOrAlias}}; + ConnData -> + io:format("Opening connection with ~p~n", [ConnData]), + + %% if KeyOrAlias == Key, each call returns unique handle + %% if KeyOrAlias == Alias, successive calls return same handle + {ok,Handle} = ct_gen_conn:start(ConnData, + [], + ?MODULE, + [{name,KeyOrAlias}]), + io:format("Handle for ~p = ~p~n", [KeyOrAlias,Handle]), + Handle + end. + +close(AliasOrHandle) -> + Handle = get_handle(AliasOrHandle), + io:format("Closing connection for ~p (~p)~n", [AliasOrHandle,Handle]), + case ct_gen_conn:stop(Handle) of + E = {error,_} -> + E; + Result -> + Result + end. + +kill_conn_proc(AliasOrHandle) -> + ConnPid = ct_gen_conn:get_conn_pid(get_handle(AliasOrHandle)), + io:format("Killing connection process ~p~n", [ConnPid]), + ConnPid ! fail, + ok. + +send(_) -> + ok. + +%%%----------------------------------------------------------------- +%%% + +init(KeyOrAlias, ConnData, []) -> + Addr = proplists:get_value(addr, ConnData), + Port = proplists:get_value(port, ConnData), + Ref = make_ref(), + Starter = self(), + MultConnPids = proplists:get_value(multiple_conn_pids, ConnData), + ConnPid = + case MultConnPids of + true -> + spawn(fun() -> active_conn(Starter, KeyOrAlias, Ref, + ConnData) end); + _ -> + ConnMgr = proplists:get_value(conn_mgr_name, ConnData), + case whereis(ConnMgr) of + undefined -> + MgrPid = + spawn(fun() -> active_conn(Starter, KeyOrAlias, + Ref, ConnData) end), + receive MgrPid -> + MgrPid + end; + MgrPid when is_pid(MgrPid) -> + MgrPid ! {connect,Ref}, + MgrPid + end + end, + io:format("Connection ~p opened on ~p:~p -> ~p (~p)~n", + [KeyOrAlias,Addr,Port,ConnPid,Ref]), + {ok,ConnPid,#conn_state{id=KeyOrAlias, pid=ConnPid, ref=Ref, data=ConnData}}. + + +terminate(ConnPid, #conn_state{id=Id, pid=ConnPid, ref = Ref, data=Data}) -> + case proplists:get_value(multiple_conn_pids, Data) of + true -> + ConnPid ! close; + _ -> + ConnPid ! {close,Ref} + end, + io:format("Connection ~p on ~p (~p) closing!~n", [Id,ConnPid,Ref]), + ok. + + +reconnect(ConnData, State = #conn_state{id=Id, ref=DeadRef}) -> + io:format("Reconnect for ~p initiated...~n", [DeadRef]), + case application:get_env(ct_test, reconnect) of + {ok,true} -> + ConnMgr = proplists:get_value(conn_mgr_name, ConnData), + NewRef = make_ref(), + Starter = self(), + ConnPid = + case proplists:get_value(multiple_conn_pids, ConnData) of + true -> + spawn(fun() -> + active_conn(Starter, Id, NewRef, + ConnData) + end); + _ -> + case whereis(ConnMgr) of + undefined -> + MgrPid = + spawn(fun() -> + active_conn(Starter, Id, + NewRef, ConnData) + end), + receive MgrPid -> + MgrPid + end; + MgrPid -> + MgrPid ! {reconnect,DeadRef,NewRef}, + MgrPid + end + end, + io:format("Connection ~p reopened on ~p (~p)~n", + [Id,ConnPid,NewRef]), + {ok,ConnPid,State#conn_state{pid=ConnPid, ref=NewRef}}; + _ -> + {error,no_reconnection_allowed} + end. + +%%%----------------------------------------------------------------- +%%% + +active_conn(Starter, Id, Ref, ConnData) -> + ConnMgr = proplists:get_value(conn_mgr_name, ConnData), + case proplists:get_value(multiple_conn_pids, ConnData) of + true -> + ok; + _ -> + register(ConnMgr,self()), + io:format("Connection manager ~p on ~p started for " + "~p and ~p~n", + [ConnMgr,self(),Id,Ref]) + end, + Starter ! self(), + active_conn_loop(ConnData, [Ref]). + +active_conn_loop(ConnData, Conns) -> + receive + {connect,Ref} -> + io:format("Connecting ~p on ~p~n", + [Ref,self()]), + active_conn_loop(ConnData, [Ref | Conns]); + {reconnect,DeadRef,NewRef} -> + Conns1 = [NewRef | lists:delete(DeadRef, Conns)], + io:format("Reconnecting on ~p: ~p -> ~p~n", + [self(),DeadRef,NewRef]), + active_conn_loop(ConnData, Conns1); + close -> + io:format("Conn process ~p shutting down~n", [self()]), + ok; + {close,Ref} -> + io:format("Closing connection ~p on ~p~n", [Ref,self()]), + case proplists:delete(Ref, Conns) of + [] -> + io:format("Last connection on ~p closed, " + "now stopping~n", [self()]), + ok; + Conns1 -> + active_conn_loop(ConnData, Conns1) + end; + fail -> + io:format("Connection process not feeling good...~n", []), + exit(kaboom); + {respond,To} -> + To ! {self(),hello}, + active_conn_loop(ConnData, Conns) + end. + +%%%----------------------------------------------------------------- +%%% + +get_handle(AliasOrHandle) when is_pid(AliasOrHandle) -> + AliasOrHandle; + +get_handle(AliasOrHandle) -> + {ok,{H,_}} = ct_util:get_connection(AliasOrHandle, + ?MODULE), + H. + diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index 1c51226314..b348e854a0 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -70,8 +70,8 @@ rename_instr({bs_put_utf16=I,F,Fl,Src}) -> {bs_put,F,{I,Fl},[Src]}; rename_instr({bs_put_utf32=I,F,Fl,Src}) -> {bs_put,F,{I,Fl},[Src]}; -%% rename_instr({bs_put_string,_,_}=I) -> -%% {bs_put,{f,0},I,[]}; +rename_instr({bs_put_string,_,_}=I) -> + {bs_put,{f,0},I,[]}; rename_instr({bs_add=I,F,[Src1,Src2,U],Dst}) when is_integer(U) -> {bif,I,F,[Src1,Src2,{integer,U}],Dst}; rename_instr({bs_utf8_size=I,F,Src,Dst}) -> diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 554c14f57a..e623bcc6a5 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -734,6 +734,8 @@ live_opt([{loop_rec,_Fail,_Dst}=I|Is], _, D, Acc) -> live_opt(Is, 0, D, [I|Acc]); live_opt([timeout=I|Is], _, D, Acc) -> live_opt(Is, 0, D, [I|Acc]); +live_opt([{wait,_}=I|Is], _, D, Acc) -> + live_opt(Is, 0, D, [I|Acc]); %% Transparent instructions - they neither use nor modify x registers. live_opt([{deallocate,_}=I|Is], Regs, D, Acc) -> @@ -744,8 +746,6 @@ live_opt([{try_end,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{loop_rec_end,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); -live_opt([{wait,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{line,_}=I|Is], Regs, D, Acc) -> diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index e60584d4ab..ec49267ded 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -23,7 +23,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, - export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1]). + export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1, + wait/1]). -include_lib("test_server/include/test_server.hrl"). @@ -44,7 +45,7 @@ all() -> groups() -> [{p,test_lib:parallel(), - [recv,coverage,otp_7980,ref_opt,export]}]. + [recv,coverage,otp_7980,ref_opt,export,wait]}]. init_per_suite(Config) -> @@ -252,4 +253,20 @@ export_1(Reference) -> id({build,self()}), Result. +wait(Config) when is_list(Config) -> + self() ! <<42>>, + <<42>> = wait_1(r, 1, 2), + {1,2,3} = wait_1(1, 2, 3), + ok. + +wait_1(r, _, _) -> + receive + B when byte_size(B) > 0 -> + B + end; +%% beam_utils would wrongly assume that wait/1 could fall through +%% to the next clause. +wait_1(A, B, C) -> + {A,B,C}. + id(I) -> I. diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index bdccfee341..2df407018e 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -249,7 +249,7 @@ <name>hash(Type, Data) -> Digest</name> <fsummary></fsummary> <type> - <v>Type = md4 | message_digest_algorithms()</v> + <v>Type = md4 | hash_algorithms()</v> <v>Data = iodata()</v> <v>Digest = binary()</v> </type> @@ -264,7 +264,7 @@ <name>hash_init(Type) -> Context</name> <fsummary></fsummary> <type> - <v>Type = md4 | message_digest_algorithms()</v> + <v>Type = md4 | hash_algorithms()</v> </type> <desc> <p>Initializes the context for streaming hash operations. <c>Type</c> determines @@ -308,7 +308,7 @@ <name>hmac(Type, Key, Data, MacLength) -> Mac</name> <fsummary></fsummary> <type> - <v>Type = message_digest_algorithms() </v> + <v>Type = hash_algorithms() - except ripemd160</v> <v>Key = iodata()</v> <v>Data = iodata()</v> <v>MacLength = integer()</v> @@ -325,7 +325,7 @@ <name>hmac_init(Type, Key) -> Context</name> <fsummary></fsummary> <type> - <v>Type = message_digest_algorithms()</v> + <v>Type = hash_algorithms() - except ripemd160</v> <v>Key = iodata()</v> <v>Context = binary()</v> </type> @@ -475,7 +475,7 @@ used mode. The size of the <c>Msg</c> must be less than <c>byte_size(N)-11</c> if <c>rsa_pkcs1_padding</c> is used, and <c>byte_size(N)</c> if <c>rsa_no_padding</c> - is used. + is used, where N is public modulus of the RSA key. See also <seealso marker="public_key:public_key#encrypt_private/2">public_key:encrypt_private/[2,3]</seealso> </p> </desc> @@ -513,18 +513,20 @@ <v>ChipherText = binary()</v> </type> <desc> - <p>Encrypts the <c>PlainText</c> (usually a session key) using the <c>PublicKey</c> - and returns the <c>CipherText</c>. The <c>Padding</c> decides what padding mode is used, - <c>rsa_pkcs1_padding</c> is PKCS #1 v1.5 currently the most - used mode and <c>rsa_pkcs1_oaep_padding</c> is EME-OAEP as - defined in PKCS #1 v2.0 with SHA-1, MGF1 and an empty encoding - parameter. This mode is recommended for all new applications. - The size of the <c>Msg</c> must be less - than <c>byte_size(N)-11</c> if - <c>rsa_pkcs1_padding</c> is used, <c>byte_size(N)-41</c> if - <c>rsa_pkcs1_oaep_padding</c> is used and <c>byte_size(N)</c> if <c>rsa_no_padding</c> - is used. - See also <seealso marker="public_key:public_key#encrypt_public/2">public_key:encrypt_public/[2,3]</seealso> + <p>Encrypts the <c>PlainText</c> (usually a session key) using + the <c>PublicKey</c> and returns the <c>CipherText</c>. The + <c>Padding</c> decides what padding mode is used, + <c>rsa_pkcs1_padding</c> is PKCS #1 v1.5 currently the most + used mode and <c>rsa_pkcs1_oaep_padding</c> is EME-OAEP as + defined in PKCS #1 v2.0 with SHA-1, MGF1 and an empty encoding + parameter. This mode is recommended for all new + applications. The size of the <c>Msg</c> must be less than + <c>byte_size(N)-11</c> if <c>rsa_pkcs1_padding</c> is + used, <c>byte_size(N)-41</c> if + <c>rsa_pkcs1_oaep_padding</c> is used and + <c>byte_size(N)</c> if <c>rsa_no_padding</c> is used, where N is public modulus of the RSA key. + See also <seealso + marker="public_key:public_key#encrypt_public/2">public_key:encrypt_public/[2,3]</seealso> </p> </desc> </func> diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index c007ecac86..b3bb5dbd17 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -48,7 +48,7 @@ all() -> {group, des_cfb}, {group, des3_cbc}, {group, des3_cbf}, - %%{group, des_ede3}, + {group, des_ede3}, {group, blowfish_cbc}, {group, blowfish_ecb}, {group, blowfish_cfb64}, @@ -60,7 +60,8 @@ all() -> {group, rc4}, {group, aes_ctr}, mod_pow, - exor + exor, + rand_uniform ]. groups() -> @@ -83,6 +84,7 @@ groups() -> {des_cbc, [], [block]}, {des_cfb, [], [block]}, {des3_cbc,[], [block]}, + {des_ede3,[], [block]}, {des3_cbf,[], [block]}, {rc2_cbc,[], [block]}, {aes_cbc128,[], [block]}, @@ -220,7 +222,13 @@ exor(Config) when is_list(Config) -> Z2 = crypto:exor(B2, B2), R = xor_bytes(B1, B2), R = crypto:exor(B1, B2). - +%%-------------------------------------------------------------------- +rand_uniform() -> + [{doc, "rand_uniform and random_bytes testing"}]. +rand_uniform(Config) when is_list(Config) -> + rand_uniform_aux_test(10), + 10 = byte_size(crypto:rand_bytes(10)), + 10 = byte_size(crypto:strong_rand_bytes(10)). %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- @@ -398,16 +406,19 @@ negative_verify(Type, Hash, Msg, Signature, Public) -> end. do_public_encrypt({Type, Public, Private, Msg, Padding}) -> - PublicEcn = crypto:public_encrypt(Type, Msg, Public, Padding), + PublicEcn = (catch crypto:public_encrypt(Type, Msg, Public, Padding)), case crypto:private_decrypt(Type, PublicEcn, Private, Padding) of Msg -> ok; Other -> ct:fail({{crypto, private_decrypt, [Type, PublicEcn, Private, Padding]}, {expected, Msg}, {got, Other}}) end. + +do_private_encrypt({_Type, _Public, _Private, _Msg, rsa_pkcs1_oaep_padding}) -> + ok; %% Not supported by openssl do_private_encrypt({Type, Public, Private, Msg, Padding}) -> - PrivEcn = crypto:private_encrypt(Type, Msg, Private, Padding), - case crypto:public_decrypt(Type, PrivEcn, Public, Padding) of + PrivEcn = (catch crypto:private_encrypt(Type, Msg, Private, Padding)), + case crypto:public_decrypt(rsa, PrivEcn, Public, Padding) of Msg -> ok; Other -> @@ -451,8 +462,6 @@ mkint(C) when $A =< C, C =< $F -> mkint(C) when $a =< C, C =< $f -> C - $a + 10. -is_supported(cipher) -> - true; is_supported(Group) -> lists:member(Group, lists:append([Algo || {_, Algo} <- crypto:supports()])). @@ -472,6 +481,8 @@ do_block_iolistify({des3_cbc = Type, Key, IV, PlainText}) -> {Type, Key, IV, des_iolistify(PlainText)}; do_block_iolistify({des3_cbf = Type, Key, IV, PlainText}) -> {Type, Key, IV, des_iolistify(PlainText)}; +do_block_iolistify({des_ede3 = Type, Key, IV, PlainText}) -> + {Type, Key, IV, des_iolistify(PlainText)}; do_block_iolistify({Type, Key, PlainText}) -> {Type, iolistify(Key), iolistify(PlainText)}; do_block_iolistify({Type, Key, IV, PlainText}) -> @@ -545,6 +556,25 @@ xor_bytes([], [], Acc) -> lists:reverse(Acc); xor_bytes([N1 | Tl1], [N2 | Tl2], Acc) -> xor_bytes(Tl1, Tl2, [N1 bxor N2 | Acc]). +rand_uniform_aux_test(0) -> + ok; +rand_uniform_aux_test(N) -> + L = N*1000, + H = N*100000+1, + crypto_rand_uniform(L, H), + crypto_rand_uniform(-L, L), + crypto_rand_uniform(-H, -L), + crypto_rand_uniform(-H, L), + rand_uniform_aux_test(N-1). + +crypto_rand_uniform(L,H) -> + R1 = crypto:rand_uniform(L, H), + case (R1 >= L) and (R1 < H) of + true -> + ok; + false -> + ct:fail({"Not in interval", R1, L, H}) + end. %%-------------------------------------------------------------------- %% Test data ------------------------------------------------ @@ -603,17 +633,13 @@ group_config(rsa = Type, Config) -> Msg = rsa_plain(), Public = rsa_public(), Private = rsa_private(), - SignVerify = [{Type, md5, Public, Private, Msg}, - {Type, sha, Public, Private, Msg}, - {Type, sha224, Public, Private,Msg}, - {Type, sha256, Public, Private,Msg} - %% {Type, sha384, Public, Private,Msg}, - %% {Type, sha512, Public, Private, Msg} - ], + PublicS = rsa_public_stronger(), + PrivateS = rsa_private_stronger(), + SignVerify = sign_verify_tests(Type, Msg, Public, Private, PublicS, PrivateS), MsgPubEnc = <<"7896345786348 Asldi">>, - PubPrivEnc = [{rsa, Public, Private, MsgPubEnc, rsa_pkcs1_padding} - %%{rsa, Public, Private, MsgPubEnc, rsa_pkcs1_oaep_padding} - %%{rsa, Public, Private, MsgPubEnc, rsa_no_padding} + PubPrivEnc = [{rsa, Public, Private, MsgPubEnc, rsa_pkcs1_padding}, + rsa_oaep(), + no_padding() ], [{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config]; group_config(dss = Type, Config) -> @@ -649,6 +675,9 @@ group_config(des3_cbc, Config) -> group_config(des3_cbf, Config) -> Block = des3_cbf(), [{block, Block} | Config]; +group_config(des_ede3, Config) -> + Block = des_ede3(), + [{block, Block} | Config]; group_config(rc2_cbc, Config) -> Block = rc2_cbc(), [{block, Block} | Config]; @@ -682,6 +711,20 @@ group_config(aes_ctr, Config) -> group_config(_, Config) -> Config. +sign_verify_tests(Type, Msg, Public, Private, PublicS, PrivateS) -> + sign_verify_tests(Type, [md5, sha, sha224, sha256], Msg, Public, Private) ++ + sign_verify_tests(Type, [sha384, sha512], Msg, PublicS, PrivateS). + +sign_verify_tests(Type, Hashs, Msg, Public, Private) -> + lists:foldl(fun(Hash, Acc) -> + case is_supported(Hash) of + true -> + [{Type, Hash, Public, Private, Msg}|Acc]; + false -> + Acc + end + end, [], Hashs). + rfc_1321_msgs() -> [<<"">>, <<"a">>, @@ -950,6 +993,15 @@ des3_cbc() -> <<"Now is the time for all ">> }]. +des_ede3() -> + [{des_ede3, + [hexstr2bin("8000000000000000"), + hexstr2bin("4000000000000000"), + hexstr2bin("2000000000000000")], + hexstr2bin("7AD16FFB79C45926"), + hexstr2bin("0000000000000000") + }]. + des3_cbf() -> [{des3_cbf, [hexstr2bin("0123456789abcdef"), @@ -1196,6 +1248,12 @@ rsa_public() -> rsa_private() -> rsa_public() ++ [7531712708607620783801185371644749935066152052780368689827275932079815492940396744378735701395659435842364793962992309884847527234216715366607660219930945]. +rsa_public_stronger() -> + [65537, 24629450921918866883077380602720734920775458960049554761386137065662137652635369332143446151320538248280934442179850504891395344346514465469955766163141133564033962851182759993807898821114734943339732032639891483186089941567854227407119560631150779000222837755424893038740314247760600374970909894211201220612920040986106639419467243909950276018045907029941478599124238353052062083560294570722081552510960894164859765695309596889747541376908786225647625736062865138957717982693312699025417086612046330464651009693307624955796202070510577399561730651967517158452930742355327167632521808183383868100102455048819375344881]. + +rsa_private_stronger() -> + rsa_public_stronger() ++ [13565232776562604620467234237694854016819673873109064019820773052201665024482754648718278717031083946624786145611240731564761987114634269887293030432042088547345315212418830656522115993209293567218379960177754901461542373481136856927955012596579314262051109321754382091434920473734937991286600905464814063189230779981494358415076362038786197620360127262110530926733754185204773610295221669711309000953136320804528874719105049753061737780710448207922456570922652651354760939379096788728229638142403068102990416717272880560951246813789730402978652924934794503277969128609831043469924881848849409122972426787999886557185]. + dss_plain() -> rsa_plain(). dss_public() -> @@ -1355,3 +1413,37 @@ ecdh() -> dh() -> {dh, 0087761979513264537414556992123116644042638206717762626089877284926656954974893442000747478454809111207351620687968672207938731607963470779396984752680274820156266685080223616226905101126463253150237669547023934604953898814222890239130021414026118792251620881355456432549881723310342870016961804255746630219, 2}. + +rsa_oaep() -> + %% ftp://ftp.rsa.com/pub/rsalabs/tmp/pkcs1v15crypt-vectors.txt + Public = [hexstr2bin("010001"), + hexstr2bin("a8b3b284af8eb50b387034a860f146c4919f318763cd6c5598c8ae4811a1e0abc4c7e0b082d693a5e7fced675cf4668512772c0cbc64a742c6c630f533c8cc72f62ae833c40bf25842e984bb78bdbf97c0107d55bdb662f5c4e0fab9845cb5148ef7392dd3aaff93ae1e6b667bb3d4247616d4f5ba10d4cfd226de88d39f16fb")], + Private = Public ++ [hexstr2bin("53339cfdb79fc8466a655c7316aca85c55fd8f6dd898fdaf119517ef4f52e8fd8e258df93fee180fa0e4ab29693cd83b152a553d4ac4d1812b8b9fa5af0e7f55fe7304df41570926f3311f15c4d65a732c483116ee3d3d2d0af3549ad9bf7cbfb78ad884f84d5beb04724dc7369b31def37d0cf539e9cfcdd3de653729ead5d1"), + hexstr2bin("d32737e7267ffe1341b2d5c0d150a81b586fb3132bed2f8d5262864a9cb9f30af38be448598d413a172efb802c21acf1c11c520c2f26a471dcad212eac7ca39d"), + hexstr2bin("cc8853d1d54da630fac004f471f281c7b8982d8224a490edbeb33d3e3d5cc93c4765703d1dd791642f1f116a0dd852be2419b2af72bfe9a030e860b0288b5d77"), + hexstr2bin("0e12bf1718e9cef5599ba1c3882fe8046a90874eefce8f2ccc20e4f2741fb0a33a3848aec9c9305fbecbd2d76819967d4671acc6431e4037968db37878e695c1"), + hexstr2bin("95297b0f95a2fa67d00707d609dfd4fc05c89dafc2ef6d6ea55bec771ea333734d9251e79082ecda866efef13c459e1a631386b7e354c899f5f112ca85d71583"), + hexstr2bin("4f456c502493bdc0ed2ab756a3a6ed4d67352a697d4216e93212b127a63d5411ce6fa98d5dbefd73263e3728142743818166ed7dd63687dd2a8ca1d2f4fbd8e1")], + %%Msg = hexstr2bin("6628194e12073db03ba94cda9ef9532397d50dba79b987004afefe34"), + Msg = hexstr2bin("750c4047f547e8e41411856523298ac9bae245efaf1397fbe56f9dd5"), + {rsa, Public, Private, Msg, rsa_pkcs1_oaep_padding}. + +no_padding() -> + Public = [_, Mod] = rsa_public(), + Private = rsa_private(), + MsgLen = erlang:byte_size(int_to_bin(Mod)), + Msg = list_to_binary(lists:duplicate(MsgLen, $X)), + {rsa, Public, Private, Msg, rsa_no_padding}. + +int_to_bin(X) when X < 0 -> int_to_bin_neg(X, []); +int_to_bin(X) -> int_to_bin_pos(X, []). + +int_to_bin_pos(0,Ds=[_|_]) -> + list_to_binary(Ds); +int_to_bin_pos(X,Ds) -> + int_to_bin_pos(X bsr 8, [(X band 255)|Ds]). + +int_to_bin_neg(-1, Ds=[MSB|_]) when MSB >= 16#80 -> + list_to_binary(Ds); +int_to_bin_neg(X,Ds) -> + int_to_bin_neg(X bsr 8, [(X band 255)|Ds]). diff --git a/lib/diameter/doc/src/diameter_app.xml b/lib/diameter/doc/src/diameter_app.xml index d4fb792787..e6c9cc9a90 100644 --- a/lib/diameter/doc/src/diameter_app.xml +++ b/lib/diameter/doc/src/diameter_app.xml @@ -565,7 +565,8 @@ Equivalent to</p> </pre> <p> where <c>Avps</c> sets the Origin-Host, Origin-Realm, the specified -Result-Code and (if the request contained one) Session-Id AVP's.</p> +Result-Code and (if the request contained one) Session-Id AVP's, and +possibly Failed-AVP as described below.</p> <p> Returning a value other than 3xxx or 5xxx will cause the request @@ -573,6 +574,14 @@ process in question to fail, as will returning a 5xxx value if the peer connection in question has been configured with the RFC 3588 common dictionary <c>diameter_gen_base_rfc3588</c>. (Since RFC 3588 only allows 3xxx values in an answer-message.)</p> + +<p> +When returning 5xxx, Failed-AVP will be populated with the AVP of the +first matching Result-Code/AVP pair in the <c>errors</c> field of the +argument &packet;, if found. +If this is not appropriate then an answer-message should be +constructed explicitly and returned in a <c>reply</c> tuple +instead.</p> </item> <tag><c>{relay, Opts}</c></tag> @@ -592,8 +601,7 @@ header of the relayed request.</p> The returned <c>Opts</c> should not specify <c>detach</c>. A subsequent &handle_answer; callback for the relayed request must return its first -argument, the <c>#diameter_packet{}</c> record containing the answer -message. +argument, the &packet; containing the answer message. Note that the <c>extra</c> option can be specified to supply arguments that can distinguish the relay case from others if so desired. Any other return value (for example, from a diff --git a/lib/diameter/doc/src/diameter_transport.xml b/lib/diameter/doc/src/diameter_transport.xml index 8bccf6521e..9161bd1f48 100644 --- a/lib/diameter/doc/src/diameter_transport.xml +++ b/lib/diameter/doc/src/diameter_transport.xml @@ -137,15 +137,14 @@ passed to the former.</p> <p> The start function should use the <c>Host-IP-Address</c> list in -<c>Svc</c> and/or <c>Config</c> to select an appropriate list of local -IP addresses, and should return this list if different from the -<c>Svc</c> addresses. +<c>Svc</c> and/or <c>Config</c> to select and return an appropriate +list of local IP addresses. In the connecting case, the local address list can instead be communicated in a <c>connected</c> message (see &MESSAGES; below) following connection establishment. In either case, the local address list is used to populate <c>Host-IP-Address</c> AVPs in outgoing capabilities exchange -messages.</p> +messages if <c>Host-IP-Address</c> is unspecified.</p> <p> A transport process must implement the message interface documented below. diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl index 03aa557c2e..55aae3a243 100644 --- a/lib/diameter/include/diameter_gen.hrl +++ b/lib/diameter/include/diameter_gen.hrl @@ -25,11 +25,23 @@ -define(THROW(T), throw({?MODULE, T})). -%%% --------------------------------------------------------------------------- -%%% # encode_avps/3 -%%% -%%% Returns: binary() -%%% --------------------------------------------------------------------------- +-type parent_name() :: atom(). %% parent = Message or AVP +-type parent_record() :: tuple(). %% +-type avp_name() :: atom(). +-type avp_record() :: tuple(). +-type avp_values() :: [{avp_name(), term()}]. + +-type non_grouped_avp() :: #diameter_avp{}. +-type grouped_avp() :: nonempty_improper_list(#diameter_avp{}, [avp()]). +-type avp() :: non_grouped_avp() | grouped_avp(). + +%% --------------------------------------------------------------------------- +%% # encode_avps/2 +%% --------------------------------------------------------------------------- + +-spec encode_avps(parent_name(), parent_record() | avp_values()) + -> binary() + | no_return(). encode_avps(Name, Vals) when is_list(Vals) -> @@ -129,42 +141,26 @@ pack_AVP(Name, #diameter_avp{name = AvpName, orelse ?THROW([known_avp_as_AVP, Name, AvpName, Data]), e(AvpName, [Data]). -%%% --------------------------------------------------------------------------- -%%% # decode_avps/2 -%%% -%%% Returns: {Rec, Avps, Failed} -%%% -%%% Rec = decoded message record -%%% Avps = list of Avp -%%% Failed = list of {ResultCode, #diameter_avp{}} -%%% -%%% Avp = #diameter_avp{} if type is not Grouped -%%% | list of Avp where first element has type Grouped -%%% and following elements are its component -%%% AVP's. -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # decode_avps/2 +%% --------------------------------------------------------------------------- + +-spec decode_avps(parent_name(), [#diameter_avp{}]) + -> {parent_record(), [avp()], Failed} + when Failed :: [{5000..5999, #diameter_avp{}}]. decode_avps(Name, Recs) -> - d_rc(Name, lists:foldl(fun(T,A) -> decode(Name, T, A) end, - {[], {newrec(Name), []}}, - Recs)). + {Avps, {Rec, Failed}} + = lists:foldl(fun(T,A) -> decode(Name, T, A) end, + {[], {newrec(Name), []}}, + Recs), + {Rec, Avps, Failed ++ missing(Rec, Name)}. +%% Append 5005 errors so that a 5014 for the same AVP will take +%% precedence in a Result-Code/Failed-AVP setting. newrec(Name) -> '#new-'(name2rec(Name)). -%% No errors so far: keep looking. -d_rc(Name, {Avps, {Rec, [] = Failed}}) -> - try - true = have_required_avps(Rec, Name), - {Rec, Avps, Failed} - catch - throw: {?MODULE, {AvpName, Reason}} -> - diameter_lib:log({decode, error}, - ?MODULE, - ?LINE, - {AvpName, Reason, Rec}), - {Rec, Avps, [{5005, empty_avp(AvpName)}]} - end; %% 3588: %% %% DIAMETER_MISSING_AVP 5005 @@ -175,9 +171,17 @@ d_rc(Name, {Avps, {Rec, [] = Failed}}) -> %% Vendor-Id if applicable. The value field of the missing AVP %% should be of correct minimum length and contain zeroes. -%% Or not. Only need to report the first error so look no further. -d_rc(_, {Avps, {Rec, Failed}}) -> - {Rec, Avps, lists:reverse(Failed)}. +missing(Rec, Name) -> + [{5005, empty_avp(F)} || F <- '#info-'(element(1, Rec), fields), + A <- [avp_arity(Name, F)], + false <- [have_arity(A, '#get-'(F, Rec))]]. + +%% Maximum arities have already been checked in building the record. + +have_arity({Min, _}, L) -> + Min =< length(L); +have_arity(N, V) -> + N /= 1 orelse V /= undefined. %% empty_avp/1 @@ -192,25 +196,6 @@ empty_avp(Name) -> data = empty_value(Name), type = Type}. -%% have_required_avps/2 - -have_required_avps(Rec, Name) -> - lists:foreach(fun(F) -> hra(Name, F, Rec) end, - '#info-'(element(1, Rec), fields)), - true. - -hra(Name, AvpName, Rec) -> - Arity = avp_arity(Name, AvpName), - hra(Arity, '#get-'(AvpName, Rec)) - orelse ?THROW({AvpName, {insufficient_arity, Arity}}). - -%% Maximum arities have already been checked in building the record. - -hra({Min, _}, L) -> - Min =< length(L); -hra(N, V) -> - N /= 1 orelse V /= undefined. - %% 3588, ch 7: %% %% The Result-Code AVP describes the error that the Diameter node @@ -227,23 +212,22 @@ decode(Name, #diameter_avp{code = Code, vendor_id = Vid} = Avp, Acc) -> %% decode/4 -%% Don't know this AVP: see if it can be packed in an 'AVP' field -%% undecoded, unless it's mandatory. Need to give Failed-AVP special -%% treatment since it'll contain any unrecognized mandatory AVP's. -decode(Name, 'AVP', #diameter_avp{is_mandatory = M} = Avp, {Avps, Acc}) -> - {[Avp | Avps], if M, Name /= 'Failed-AVP' -> - unknown(Avp, Acc); - true -> - pack_AVP(Name, Avp, Acc) - end}; -%% Note that the type field is 'undefined' in this case. - -%% Or try to decode. decode(Name, {AvpName, Type}, Avp, Acc) -> - d(Name, Avp#diameter_avp{name = AvpName, type = Type}, Acc). + d(Name, Avp#diameter_avp{name = AvpName, type = Type}, Acc); + +decode(Name, 'AVP', Avp, Acc) -> + decode_AVP(Name, Avp, Acc). %% d/3 +%% Don't try to decode the value of a Failed-AVP component since it +%% probably won't. Note that matching on 'Failed-AVP' assumes that +%% this is the RFC AVP, with code 279. Strictly, this doesn't need to +%% be the case, so we're assuming no one defines another Failed-AVP. +d('Failed-AVP' = Name, Avp, Acc) -> + decode_AVP(Name, Avp, Acc); + +%% Or try to decode. d(Name, Avp, {Avps, Acc}) -> #diameter_avp{name = AvpName, data = Data} @@ -265,17 +249,25 @@ d(Name, Avp, {Avps, Acc}) -> ?LINE, {Reason, Avp, erlang:get_stacktrace()}), {Rec, Failed} = Acc, - {[Avp|Avps], {Rec, [{rc(Reason), Avp} | Failed]}} + {[Avp|Avps], {Rec, [rc(Reason, Avp) | Failed]}} end. +%% decode_AVP/3 +%% +%% Don't know this AVP: see if it can be packed in an 'AVP' field +%% undecoded. Note that the type field is 'undefined' in this case. + +decode_AVP(Name, Avp, {Avps, Acc}) -> + {[Avp | Avps], pack_AVP(Name, Avp, Acc)}. + %% rc/1 %% diameter_types will raise an error of this form to communicate %% DIAMETER_INVALID_AVP_LENGTH (5014). A module specified to a %% @custom_types tag in a spec file can also raise an error of this %% form. -rc({'DIAMETER', RC, _}) -> - RC; +rc({'DIAMETER', 5014 = RC, _}, #diameter_avp{name = AvpName} = Avp) -> + {RC, Avp#diameter_avp{data = empty_value(AvpName)}}; %% 3588: %% @@ -283,20 +275,13 @@ rc({'DIAMETER', RC, _}) -> %% The request contained an AVP with an invalid value in its data %% portion. A Diameter message indicating this error MUST include %% the offending AVPs within a Failed-AVP AVP. -rc(_) -> - 5004. +rc(_, Avp) -> + {5004, Avp}. %% ungroup/2 -%% -%% Returns: {Avp, Dec} -%% -%% Avp = #diameter_avp{} if type is not Grouped -%% | list of Avp where first element has type Grouped -%% and following elements are its component -%% AVP's. -%% = as for decode_avps/2 -%% -%% Dec = #diameter_avp{}, either Avp or its head in the list case. + +-spec ungroup(term(), #diameter_avp{}) + -> {avp(), #diameter_avp{}}. %% The decoded value in the Grouped case is as returned by grouped_avp/3: %% a record and a list of component AVP's. @@ -325,10 +310,18 @@ pack_avp(_, Arity, Avp, Acc) -> %% pack_AVP/3 -pack_AVP(Name, Avp, Acc) -> +%% Give Failed-AVP special treatment since it'll contain any +%% unrecognized mandatory AVP's. +pack_AVP(Name, #diameter_avp{is_mandatory = true} = Avp, Acc) + when Name /= 'Failed-AVP' -> + {Rec, Failed} = Acc, + {Rec, [{5001, Avp} | Failed]}; + +pack_AVP(Name, #diameter_avp{is_mandatory = M} = Avp, Acc) -> case avp_arity(Name, 'AVP') of 0 -> - unknown(Avp, Acc); + {Rec, Failed} = Acc, + {Rec, [{if M -> 5001; true -> 5008 end, Avp} | Failed]}; Arity -> pack(Arity, 'AVP', Avp, Acc) end. @@ -345,9 +338,6 @@ pack_AVP(Name, Avp, Acc) -> %% A message was received with an AVP that MUST NOT be present. The %% Failed-AVP AVP MUST be included and contain a copy of the %% offending AVP. -%% -unknown(#diameter_avp{is_mandatory = B} = Avp, {Rec, Failed}) -> - {Rec, [{if B -> 5001; true -> 5008 end, Avp} | Failed]}. %% pack/4 @@ -386,23 +376,29 @@ value('AVP', Avp) -> value(_, Avp) -> Avp#diameter_avp.value. -%%% --------------------------------------------------------------------------- -%%% # grouped_avp/3 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # grouped_avp/3 +%% --------------------------------------------------------------------------- + +-spec grouped_avp(decode, avp_name(), binary()) + -> {avp_record(), [avp()]}; + (encode, avp_name(), avp_record() | avp_values()) + -> binary() + | no_return(). grouped_avp(decode, Name, Data) -> {Rec, Avps, []} = decode_avps(Name, diameter_codec:collect_avps(Data)), {Rec, Avps}; -%% Note that a failed match here will result in 5004. Note that this is -%% the only AVP type that doesn't just return the decoded value, also -%% returning the list of component #diameter_avp{}'s. +%% A failed match here will result in 5004. Note that this is the only +%% AVP type that doesn't just return the decoded record, also +%% returning the list of component AVP's. grouped_avp(encode, Name, Data) -> encode_avps(Name, Data). -%%% --------------------------------------------------------------------------- -%%% # empty_group/1 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # empty_group/1 +%% --------------------------------------------------------------------------- empty_group(Name) -> list_to_binary(empty_body(Name)). @@ -423,9 +419,9 @@ z(Name) -> Bin = diameter_codec:pack_avp(avp_header(Name), empty_value(Name)), << <<0>> || <<_>> <= Bin >>. -%%% --------------------------------------------------------------------------- -%%% # empty/1 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # empty/1 +%% --------------------------------------------------------------------------- empty(AvpName) -> avp(encode, zero, AvpName). diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl index 9a443fead0..4b821f5139 100644 --- a/lib/diameter/src/base/diameter_capx.erl +++ b/lib/diameter/src/base/diameter_capx.erl @@ -282,9 +282,26 @@ build_CEA(_, LCaps, RCaps, Dict, CEA) -> [] -> Dict:'#set-'({'Result-Code', ?NOSECURITY}, CEA); [_] = IS -> - Dict:'#set-'({'Inband-Security-Id', IS}, CEA) + Dict:'#set-'({'Inband-Security-Id', inband_security(IS)}, CEA) end. +%% Only set Inband-Security-Id if different from the default, since +%% RFC 6733 recommends against the AVP: +%% +%% 6.10. Inband-Security-Id AVP +%% +%% The Inband-Security-Id AVP (AVP Code 299) is of type Unsigned32 and +%% is used in order to advertise support of the security portion of the +%% application. The use of this AVP in CER and CEA messages is NOT +%% RECOMMENDED. Instead, discovery of a Diameter entity's security +%% capabilities can be done either through static configuration or via +%% Diameter Peer Discovery as described in Section 5.2. + +inband_security([?NO_INBAND_SECURITY]) -> + []; +inband_security([_] = IS) -> + IS. + %% common_security/2 common_security(#diameter_caps{inband_security_id = LS}, diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index e446a0209c..6c0e73de36 100644 --- a/lib/diameter/src/base/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -38,6 +38,10 @@ -define(MASK(N,I), ((I) band (1 bsl (N)))). +-type u32() :: 0..16#FFFFFFFF. +-type u24() :: 0..16#FFFFFF. +-type u1() :: 0..1. + %% 0 1 2 3 %% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 %% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ @@ -55,9 +59,13 @@ %% +-+-+-+-+-+-+-+-+-+-+-+-+- %%% --------------------------------------------------------------------------- -%%% # encode/[2-4] +%%% # encode/2 %%% --------------------------------------------------------------------------- +-spec encode(module(), Msg :: term()) + -> #diameter_packet{} + | no_return(). + encode(Mod, #diameter_packet{} = Pkt) -> try e(Mod, Pkt) @@ -217,6 +225,9 @@ rec2msg(Mod, Rec) -> %% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors. +-spec decode(module(), #diameter_packet{} | bitstring()) + -> #diameter_packet{}. + decode(Mod, Pkt) -> decode(Mod:id(), Mod, Pkt). @@ -225,9 +236,9 @@ decode(Mod, Pkt) -> %% question. decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) -> case collect_avps(Pkt) of - {Bs, As} -> + {E, As} -> Pkt#diameter_packet{avps = As, - errors = [Bs]}; + errors = [E]}; As -> Pkt#diameter_packet{avps = As} end; @@ -251,12 +262,12 @@ decode(Id, Mod, Bin) when is_bitstring(Bin) -> decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}). -decode_avps(MsgName, Mod, Pkt, {Bs, Avps}) -> %% invalid avp bits ... +decode_avps(MsgName, Mod, Pkt, {E, Avps}) -> ?LOG(invalid, Pkt#diameter_packet.bin), #diameter_packet{errors = Failed} = P = decode_avps(MsgName, Mod, Pkt, Avps), - P#diameter_packet{errors = [Bs | Failed]}; + P#diameter_packet{errors = [E | Failed]}; decode_avps('', Mod, Pkt, Avps) -> %% unknown message ... ?LOG(unknown, {Mod, Pkt#diameter_packet.header}), @@ -275,6 +286,10 @@ decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not %%% # decode_header/1 %%% --------------------------------------------------------------------------- +-spec decode_header(bitstring()) + -> #diameter_header{} + | false. + decode_header(<<Version:8, MsgLength:24, CmdFlags:1/binary, @@ -324,6 +339,13 @@ decode_header(_) -> %% wraparound counter. The 8-bit counter is incremented each time the %% system is restarted. +-spec sequence_numbers(#diameter_packet{} + | #diameter_header{} + | binary() + | Seq) + -> Seq + when Seq :: {HopByHopId :: u32(), EndToEndId :: u32()}. + sequence_numbers({_,_} = T) -> T; @@ -345,6 +367,9 @@ sequence_numbers(<<_:12/binary, H:32, E:32, _/binary>>) -> %%% # hop_by_hop_id/2 %%% --------------------------------------------------------------------------- +-spec hop_by_hop_id(u32(), binary()) + -> binary(). + hop_by_hop_id(Id, <<H:12/binary, _:32, T/binary>>) -> <<H/binary, Id:32, T/binary>>. @@ -352,6 +377,10 @@ hop_by_hop_id(Id, <<H:12/binary, _:32, T/binary>>) -> %%% # msg_name/2 %%% --------------------------------------------------------------------------- +-spec msg_name(module(), #diameter_header{}) + -> atom() + | {ApplicationId :: u32(), CommandCode :: u24(), Rbit :: u1()}. + msg_name(Dict0, #diameter_header{application_id = ?APP_ID_COMMON, cmd_code = C, is_request = R}) -> @@ -367,6 +396,9 @@ msg_name(_, Hdr) -> %%% # msg_id/1 %%% --------------------------------------------------------------------------- +-spec msg_id(#diameter_packet{} | #diameter_header{}) + -> {ApplicationId :: u32(), CommandCode :: u24(), Rbit :: u1()}. + msg_id(#diameter_packet{msg = [#diameter_header{} = Hdr | _]}) -> msg_id(Hdr); @@ -389,6 +421,12 @@ msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) -> %% order in the binary. Note also that grouped avp's aren't unraveled, %% only those at the top level. +-spec collect_avps(#diameter_packet{} | bitstring()) + -> [Avp] + | {Error, [Avp]} + when Avp :: #diameter_avp{}, + Error :: {5014, #diameter_avp{}}. + collect_avps(#diameter_packet{bin = Bin}) -> <<_:20/binary, Avps/bitstring>> = Bin, collect_avps(Avps); @@ -403,8 +441,8 @@ collect_avps(Bin, N, Acc) -> {Rest, AVP} -> collect_avps(Rest, N+1, [AVP#diameter_avp{index = N} | Acc]) catch - ?FAILURE(_) -> - {Bin, Acc} + ?FAILURE(Error) -> + {Error, Acc} end. %% 0 1 2 3 @@ -422,42 +460,87 @@ collect_avps(Bin, N, Acc) -> %% split_avp/1 split_avp(Bin) -> - 8 =< size(Bin) orelse ?THROW(truncated_header), + {Code, V, M, P, Len, HdrLen} = split_head(Bin), + {Data, B} = split_data(Bin, HdrLen, Len - HdrLen), - <<Code:32, Flags:1/binary, Length:24, Rest/bitstring>> - = Bin, + {B, #diameter_avp{code = Code, + vendor_id = V, + is_mandatory = 1 == M, + need_encryption = 1 == P, + data = Data}}. - DataSize = Length - 8, % size(Code+Flags+Length) = 8 octets - PadSize = (4 - (DataSize rem 4)) rem 4, +%% split_head/1 - DataSize + PadSize =< size(Rest) - orelse ?THROW(truncated_data), +split_head(<<Code:32, 1:1, M:1, P:1, _:5, Len:24, V:32, _/bitstring>>) -> + {Code, V, M, P, Len, 12}; - <<Data:DataSize/binary, _:PadSize/binary, R/bitstring>> - = Rest, - <<Vbit:1, Mbit:1, Pbit:1, _Reserved:5>> - = Flags, +split_head(<<Code:32, 0:1, M:1, P:1, _:5, Len:24, _/bitstring>>) -> + {Code, undefined, M, P, Len, 8}; - 0 == Vbit orelse 4 =< size(Data) - orelse ?THROW(truncated_vendor_id), +split_head(Bin) -> + ?THROW({5014, #diameter_avp{data = Bin}}). + +%% 3588: +%% +%% DIAMETER_INVALID_AVP_LENGTH 5014 +%% The request contained an AVP with an invalid length. A Diameter +%% message indicating this error MUST include the offending AVPs +%% within a Failed-AVP AVP. - {Vid, D} = vid(Vbit, Data), - {R, #diameter_avp{code = Code, - vendor_id = Vid, - is_mandatory = 1 == Mbit, - need_encryption = 1 == Pbit, - data = D}}. +%% 6733: +%% +%% DIAMETER_INVALID_AVP_LENGTH 5014 +%% +%% The request contained an AVP with an invalid length. A Diameter +%% message indicating this error MUST include the offending AVPs +%% within a Failed-AVP AVP. In cases where the erroneous AVP length +%% value exceeds the message length or is less than the minimum AVP +%% ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +%% header length, it is sufficient to include the offending AVP +%% ^^^^^^^^^^^^^ +%% header and a zero filled payload of the minimum required length +%% for the payloads data type. If the AVP is a Grouped AVP, the +%% Grouped AVP header with an empty payload would be sufficient to +%% indicate the offending AVP. In the case where the offending AVP +%% header cannot be fully decoded when the AVP length is less than +%% the minimum AVP header length, it is sufficient to include an +%% offending AVP header that is formulated by padding the incomplete +%% AVP header with zero up to the minimum AVP header length. +%% +%% The underlined clause must be in error since (1) a header less than +%% the minimum value mean we don't know the identity of the AVP and +%% (2) the last sentence covers this case. -%% The RFC is a little misleading when stating that OctetString is -%% padded to a 32-bit boundary while other types align naturally. All -%% other types are already multiples of 32 bits so there's no need to -%% distinguish between types here. Any invalid lengths will result in -%% decode error in diameter_types. +%% split_data/3 -vid(1, <<Vid:32, Data/bitstring>>) -> - {Vid, Data}; -vid(0, Data) -> - {undefined, Data}. +split_data(Bin, HdrLen, Len) + when 0 =< Len -> + split_data(Bin, HdrLen, Len, (4 - (Len rem 4)) rem 4); + +split_data(_, _, _) -> + invalid_avp_length(). + +%% split_data/4 + +split_data(Bin, HdrLen, Len, Pad) -> + <<_:HdrLen/binary, T/bitstring>> = Bin, + case T of + <<Data:Len/binary, _:Pad/binary, Rest/bitstring>> -> + {Data, Rest}; + _ -> + invalid_avp_length() + end. + +%% invalid_avp_length/0 +%% +%% AVP Length doesn't mesh with payload. Induce a decode error by +%% returning a payload that no valid Diameter type can have. This is +%% so that a known AVP will result in 5014 error with a zero'd +%% payload. Here we simply don't know how to construct this payload. +%% (Yes, this solution is an afterthought.) + +invalid_avp_length() -> + {<<0:1>>, <<>>}. %%% --------------------------------------------------------------------------- %%% # pack_avp/1 @@ -472,20 +555,35 @@ vid(0, Data) -> pack_avp(#diameter_avp{data = [#diameter_avp{} | _] = Avps} = A) -> pack_avp(A#diameter_avp{data = encode_avps(Avps)}); -%% ... data as a type/value tuple, possibly with header data, ... +%% ... data as a type/value tuple ... pack_avp(#diameter_avp{data = {Type, Value}} = A) when is_atom(Type) -> pack_avp(A#diameter_avp{data = diameter_types:Type(encode, Value)}); + +%% ... with a header in various forms ... pack_avp(#diameter_avp{data = {{_,_,_} = T, {Type, Value}}}) -> pack_avp(T, iolist_to_binary(diameter_types:Type(encode, Value))); + pack_avp(#diameter_avp{data = {{_,_,_} = T, Bin}}) when is_binary(Bin) -> pack_avp(T, Bin); + pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) -> {Code, _Flags, Vid} = Hdr = Dict:avp_header(Name), {Name, Type} = Dict:avp_name(Code, Vid), pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}}); +pack_avp(#diameter_avp{code = undefined, data = Bin}) + when is_binary(Bin) -> + %% Reset the AVP Length of an AVP Header resulting from a 5014 + %% error. The RFC doesn't explicitly say to do this but the + %% receiver can't correctly extract this and following AVP's + %% without a correct length. On the downside, the header doesn't + %% reveal if the received header has been padded. + Pad = 8*header_length(Bin) - bit_size(Bin), + Len = size(<<H:5/binary, _:24, T/binary>> = <<Bin/bitstring, 0:Pad>>), + <<H/binary, Len:24, T/binary>>; + %% ... or as an iolist. pack_avp(#diameter_avp{code = Code, vendor_id = V, @@ -497,6 +595,11 @@ pack_avp(#diameter_avp{code = Code, {P, 2#00100000}]), pack_avp({Code, Flags, V}, iolist_to_binary(Data)). +header_length(<<_:32, 1:1, _/bitstring>>) -> + 12; +header_length(_) -> + 8. + flag_avp({true, B}, F) -> F bor B; flag_avp({false, _}, F) -> diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index 6be4259510..4e55864168 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -233,20 +233,21 @@ start_transport(Addrs0, T) -> {TPid, Addrs, Tmo, Data} -> erlang:monitor(process, TPid), q_next(TPid, Addrs0, Tmo, Data), - {TPid, addrs(Addrs, Addrs0)}; + {TPid, Addrs}; No -> exit({shutdown, No}) end. -addrs([], Addrs0) -> - Addrs0; -addrs(Addrs, _) -> - Addrs. - -svc(Svc, []) -> - Svc; -svc(Svc, Addrs) -> - readdr(Svc, Addrs). +svc(#diameter_service{capabilities = LCaps0} = Svc, Addrs) -> + #diameter_caps{host_ip_address = Addrs0} + = LCaps0, + case Addrs0 of + [] -> + LCaps = LCaps0#diameter_caps{host_ip_address = Addrs}, + Svc#diameter_service{capabilities = LCaps}; + [_|_] -> + Svc + end. readdr(#diameter_service{capabilities = LCaps0} = Svc, Addrs) -> LCaps = LCaps0#diameter_caps{host_ip_address = Addrs}, @@ -360,7 +361,7 @@ transition({diameter, {TPid, connected, Remote, LAddrs}}, service = Svc} = S) -> transition({diameter, {TPid, connected, Remote}}, - S#state{service = readdr(Svc, LAddrs)}); + S#state{service = svc(Svc, LAddrs)}); %% Connection from peer. transition({diameter, {TPid, connected}}, @@ -702,13 +703,13 @@ build_answer('CER', N -> {cea(CEA, N, Dict0), [fun open/5, Pkt, SupportedApps, Caps, - {accept, hd([_] = IS)}]} + {accept, inband_security(IS)}]} catch ?FAILURE(Reason) -> rejected(Reason, {'CER', Reason, Caps, Pkt}, S) end; -%% The error checks below are similar to those in diameter_service for +%% The error checks below are similar to those in diameter_traffic for %% other messages. Should factor out the commonality. build_answer(Type, @@ -719,6 +720,11 @@ build_answer(Type, RC = rc(H, Es), {answer(Type, RC, Es, S), post(Type, RC, Pkt, S)}. +inband_security([]) -> + ?NO_INBAND_SECURITY; +inband_security([IS]) -> + IS. + cea(CEA, ok, _) -> CEA; cea(CEA, 2001, _) -> @@ -742,7 +748,14 @@ rejected(N, T, S) -> rejected({N, []}, T, S). answer(Type, RC, Es, S) -> - set(answer(Type, RC, S), failed_avp([A || {_,A} <- Es])). + set(answer(Type, RC, S), failed_avp(RC, Es)). + +failed_avp(RC, [{RC, Avp} | _]) -> + [{'Failed-AVP', [{'AVP', [Avp]}]}]; +failed_avp(RC, [_ | Es]) -> + failed_avp(RC, Es); +failed_avp(_, [] = No) -> + No. answer(Type, RC, S) -> answer_message(answer(Type, S), RC). @@ -762,13 +775,6 @@ is_origin({N, _}) -> orelse N == 'Origin-Realm' orelse N == 'Origin-State-Id'. -%% failed_avp/1 - -failed_avp([] = No) -> - No; -failed_avp(Avps) -> - [{'Failed-AVP', [[{'AVP', Avps}]]}]. - %% set/2 set(Ans, []) -> @@ -784,7 +790,7 @@ rc(#diameter_header{is_error = true}, _) -> 3008; %% DIAMETER_INVALID_HDR_BITS rc(_, [Bs|_]) - when is_bitstring(Bs) -> + when is_bitstring(Bs) -> %% from old code 3009; %% DIAMETER_INVALID_HDR_BITS rc(#diameter_header{version = ?DIAMETER_VERSION}, Es) -> diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index 25b902e3f2..0b15e68ec7 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -226,10 +226,10 @@ recv_R(false = No, _, _, _, _) -> %% transport has gone down collect_avps(Pkt) -> case diameter_codec:collect_avps(Pkt) of - {_Bs, As} -> - As; - As -> - As + {_Error, Avps} -> + Avps; + Avps -> + Avps end. %% recv_R/6 @@ -300,7 +300,7 @@ errors(_, #diameter_packet{header = #diameter_header{version = V}, %% AVP's definition. errors(_, #diameter_packet{errors = [Bs | Es]} = Pkt) - when is_bitstring(Bs) -> + when is_bitstring(Bs) -> %% from old code Pkt#diameter_packet{errors = [3009 | Es]}; %% DIAMETER_COMMAND_UNSUPPORTED 3001 @@ -479,10 +479,9 @@ answer_message(RC, #diameter_caps{origin_host = {OH,_}, origin_realm = {OR,_}}, Dict0, - #diameter_packet{avps = Avps} - = Pkt) -> + Pkt) -> ?LOG({error, RC}, Pkt), - {Dict0, answer_message(OH, OR, RC, Dict0, Avps)}. + {Dict0, answer_message(OH, OR, RC, Dict0, Pkt)}. %% resend/7 @@ -595,71 +594,87 @@ reply([Msg], Dict, TPid, Dict0, Fs, ReqPkt) is_tuple(Msg) -> reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt#diameter_packet{errors = []}); -%% No errors or a diameter_header/avp list. reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt) -> - Pkt = encode(Dict, reset(make_answer_packet(Msg, ReqPkt), Dict), Fs), + Pkt = encode(Dict, + reset(make_answer_packet(Msg, ReqPkt), Dict, Dict0), + Fs), incr(send, Pkt, Dict, TPid, Dict0), %% count outgoing result codes send(TPid, Pkt). -%% reset/2 +%% reset/3 %% Header/avps list: send as is. -reset(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) -> +reset(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _, _) -> Pkt; %% No errors to set or errors explicitly ignored. -reset(#diameter_packet{errors = Es} = Pkt, _) +reset(#diameter_packet{errors = Es} = Pkt, _, _) when Es == []; Es == false -> Pkt; %% Otherwise possibly set Result-Code and/or Failed-AVP. -reset(#diameter_packet{msg = Msg, errors = Es} = Pkt, Dict) -> - Pkt#diameter_packet{msg = reset(Msg, Dict, Es)}. - -%% reset/3 - -reset(Msg, Dict, Es) - when is_list(Es) -> - {E3, E5, Fs} = partition(Es), - FailedAVP = failed_avp(Msg, lists:reverse(Fs), Dict), - reset(set(Msg, FailedAVP, Dict), - Dict, - choose(is_answer_message(Msg, Dict), E3, E5)); - -reset(Msg, Dict, N) - when is_integer(N) -> - ResultCode = rc(Msg, {'Result-Code', N}, Dict), - set(Msg, ResultCode, Dict); - -reset(Msg, _, _) -> - Msg. +reset(#diameter_packet{msg = Msg, errors = Es} = Pkt, Dict, Dict0) -> + {RC, Failed} = select_error(Msg, Es, Dict0), + Pkt#diameter_packet{msg = reset(Msg, Dict, RC, Failed)}. -partition(Es) -> - lists:foldl(fun pacc/2, {false, false, []}, Es). - -%% Note that the errors list can contain not only integer() and -%% {integer(), #diameter_avp{}} but also #diameter_avp{}. The latter -%% isn't something that's returned by decode but can be set in a reply -%% for encode. +%% select_error/3 +%% +%% Extract the first appropriate RC or {RC, #diameter_avp{}} +%% pair from an errors list, and accumulate all #diameter_avp{}. +%% +%% RFC 6733: +%% +%% 7.5. Failed-AVP AVP +%% +%% The Failed-AVP AVP (AVP Code 279) is of type Grouped and provides +%% debugging information in cases where a request is rejected or not +%% fully processed due to erroneous information in a specific AVP. The +%% value of the Result-Code AVP will provide information on the reason +%% for the Failed-AVP AVP. A Diameter answer message SHOULD contain an +%% instance of the Failed-AVP AVP that corresponds to the error +%% indicated by the Result-Code AVP. For practical purposes, this +%% Failed-AVP would typically refer to the first AVP processing error +%% that a Diameter node encounters. + +select_error(Msg, Es, Dict0) -> + {RC, Avps} = lists:foldl(fun(T,A) -> select(T, A, Dict0) end, + {is_answer_message(Msg, Dict0), []}, + Es), + {RC, lists:reverse(Avps)}. + +%% Only integer() and {integer(), #diameter_avp{}} are the result of +%% decode. #diameter_avp{} can only be set in a reply for encode. + +select(#diameter_avp{} = A, {RC, As}, _) -> + {RC, [A|As]}; + +select(_, {RC, _} = Acc, _) + when is_integer(RC) -> + Acc; -pacc({RC, #diameter_avp{} = A}, {E3, E5, Acc}) +select({RC, #diameter_avp{} = A}, {IsAns, As} = Acc, Dict0) when is_integer(RC) -> - pacc(RC, {E3, E5, [A|Acc]}); + case is_result(RC, IsAns, Dict0) of + true -> {RC, [A|As]}; + false -> Acc + end; -pacc(#diameter_avp{} = A, {E3, E5, Acc}) -> - {E3, E5, [A|Acc]}; +select(RC, {IsAns, As} = Acc, Dict0) + when is_boolean(IsAns), is_integer(RC) -> + case is_result(RC, IsAns, Dict0) of + true -> {RC, As}; + false -> Acc + end. -pacc(RC, {false, E5, Acc}) - when 3 == RC div 1000 -> - {RC, E5, Acc}; +%% reset/4 -pacc(RC, {E3, false, Acc}) - when 5 == RC div 1000 -> - {E3, RC, Acc}; +reset(Msg, Dict, RC, Avps) -> + FailedAVP = failed_avp(Msg, Avps, Dict), + ResultCode = rc(Msg, RC, Dict), + set(set(Msg, FailedAVP, Dict), ResultCode, Dict). -pacc(_, Acc) -> - Acc. +%% eval_packet/2 eval_packet(Pkt, Fs) -> lists:foreach(fun(F) -> diameter_lib:eval([F,Pkt]) end, Fs). @@ -725,29 +740,34 @@ set(Rec, Avps, Dict) -> %% the arity is 1 or {0,1}. In other cases (which probably shouldn't %% exist in practise) we can't know what's appropriate. -rc([MsgName | _], {'Result-Code' = K, RC} = T, Dict) -> - case Dict:avp_arity(MsgName, 'Result-Code') of - 1 -> [T]; +rc(_, B, _) + when is_boolean(B) -> + []; + +rc([MsgName | _], RC, Dict) -> + K = 'Result-Code', + case Dict:avp_arity(MsgName, K) of + 1 -> [{K, RC}]; {0,1} -> [{K, [RC]}]; _ -> [] end; -rc(Rec, T, Dict) -> - rc([Dict:rec2msg(element(1, Rec))], T, Dict). +rc(Rec, RC, Dict) -> + rc([Dict:rec2msg(element(1, Rec))], RC, Dict). %% failed_avp/3 failed_avp(_, [] = No, _) -> No; -failed_avp(Rec, Failed, Dict) -> - [fa(Rec, [{'AVP', Failed}], Dict)]. +failed_avp(Rec, Avps, Dict) -> + [failed(Rec, [{'AVP', Avps}], Dict)]. %% Reply as name and tuple list ... -fa([MsgName | Values], FailedAvp, Dict) -> - R = Dict:msg2rec(MsgName), +failed([MsgName | Values], FailedAvp, Dict) -> + RecName = Dict:msg2rec(MsgName), try - Dict:'#info-'(R, {index, 'Failed-AVP'}), + Dict:'#info-'(RecName, {index, 'Failed-AVP'}), {'Failed-AVP', [FailedAvp]} catch error: _ -> @@ -758,8 +778,10 @@ fa([MsgName | Values], FailedAvp, Dict) -> end; %% ... or record. -fa(Rec, FailedAvp, Dict) -> +failed(Rec, FailedAvp, Dict) -> try + RecName = element(1, Rec), + Dict:'#info-'(RecName, {index, 'Failed-AVP'}), {'Failed-AVP', [FailedAvp]} catch error: _ -> @@ -838,12 +860,14 @@ fa(Rec, FailedAvp, Dict) -> %% answer_message/5 -answer_message(OH, OR, RC, Dict0, Avps) -> +answer_message(OH, OR, RC, Dict0, #diameter_packet{avps = Avps, + errors = Es}) -> {Code, _, Vid} = Dict0:avp_header('Session-Id'), ['answer-message', {'Origin-Host', OH}, {'Origin-Realm', OR}, - {'Result-Code', RC} - | session_id(Code, Vid, Dict0, Avps)]. + {'Result-Code', RC}] + ++ session_id(Code, Vid, Dict0, Avps) + ++ failed_avp(RC, Es). session_id(Code, Vid, Dict0, Avps) when is_list(Avps) -> @@ -855,6 +879,15 @@ session_id(Code, Vid, Dict0, Avps) [] end. +%% Note that this should only match 5xxx result codes currently but +%% don't bother distinguishing this case. +failed_avp(RC, [{RC, Avp} | _]) -> + [{'Failed-AVP', [{'AVP', [Avp]}]}]; +failed_avp(RC, [_ | Es]) -> + failed_avp(RC, Es); +failed_avp(_, [] = No) -> + No. + %% find_avp/3 find_avp(Code, Vid, Avps) diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl index 41c493ff20..88ccf630e2 100644 --- a/lib/diameter/src/base/diameter_watchdog.erl +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -505,7 +505,9 @@ set_watchdog(#watchdog{tw = TwInit, tref = TRef} = S) -> cancel(TRef), - S#watchdog{tref = erlang:start_timer(tw(TwInit), self(), tw)}. + S#watchdog{tref = erlang:start_timer(tw(TwInit), self(), tw)}; +set_watchdog(stop = No) -> + No. cancel(undefined) -> ok; diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index 80036879ea..e687145263 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -574,12 +574,12 @@ cs_enumerated_avp({AvpName, Values}) -> lists:flatmap(fun(V) -> c_enumerated_avp(AvpName, V) end, Values). c_enumerated_avp(AvpName, {_,I}) -> - [{?clause, [?ATOM(decode), ?Atom(AvpName), ?TERM(<<I:32/integer>>)], + [{?clause, [?ATOM(decode), ?Atom(AvpName), ?TERM(<<I:32>>)], [], [?TERM(I)]}, {?clause, [?ATOM(encode), ?Atom(AvpName), ?INTEGER(I)], [], - [?TERM(<<I:32/integer>>)]}]. + [?TERM(<<I:32>>)]}]. %%% ------------------------------------------------------------------------ %%% msg_header/1 @@ -700,7 +700,7 @@ c_empty_value({Name, _, _, _}) -> c_empty_value({Name, _}) -> {?clause, [?Atom(Name)], [], - [?TERM(<<0:32/integer>>)]}. + [?TERM(<<0:32>>)]}. %%% ------------------------------------------------------------------------ %%% # dict/0 diff --git a/lib/diameter/test/diameter_3xxx_SUITE.erl b/lib/diameter/test/diameter_3xxx_SUITE.erl index 89c78d8b57..071b1a1177 100644 --- a/lib/diameter/test/diameter_3xxx_SUITE.erl +++ b/lib/diameter/test/diameter_3xxx_SUITE.erl @@ -40,9 +40,10 @@ send_unknown_application/1, send_unknown_command/1, send_ok/1, - send_invalid_avp_bits/1, + send_invalid_hdr_bits/1, send_missing_avp/1, send_ignore_missing_avp/1, + send_5xxx_missing_avp/1, send_double_error/1, send_3xxx/1, send_5xxx/1, @@ -136,9 +137,10 @@ tc() -> [send_unknown_application, send_unknown_command, send_ok, - send_invalid_avp_bits, + send_invalid_hdr_bits, send_missing_avp, send_ignore_missing_avp, + send_5xxx_missing_avp, send_double_error, send_3xxx, send_5xxx]. @@ -216,27 +218,26 @@ send_ok([_,_]) -> send_ok(Config) -> send_ok(?group(Config)). -%% send_invalid_avp_bits/1 +%% send_invalid_hdr_bits/1 %% -%% Send a request with an incorrect length on the optional -%% Origin-State-Id that a callback ignores. +%% Send a request with an incorrect E-bit that a callback ignores. %% Callback answers. -send_invalid_avp_bits([callback, _]) -> +send_invalid_hdr_bits([callback, _]) -> #diameter_base_STA{'Result-Code' = 2001, %% SUCCESS 'Failed-AVP' = [], 'AVP' = []} = call(); %% diameter answers. -send_invalid_avp_bits([_,_]) -> - #'diameter_base_answer-message'{'Result-Code' = 3009, %% INVALID_AVP_BITS +send_invalid_hdr_bits([_,_]) -> + #'diameter_base_answer-message'{'Result-Code' = 3008, %% INVALID_HDR_BITS 'Failed-AVP' = [], 'AVP' = []} = call(); -send_invalid_avp_bits(Config) -> - send_invalid_avp_bits(?group(Config)). +send_invalid_hdr_bits(Config) -> + send_invalid_hdr_bits(?group(Config)). %% send_missing_avp/1 %% @@ -280,10 +281,35 @@ send_ignore_missing_avp([_,_]) -> send_ignore_missing_avp(Config) -> send_ignore_missing_avp(?group(Config)). +%% send_5xxx_missing_avp/1 +%% +%% Send a request with a missing AVP that a callback answers +%% with {answer_message, 5005}. + +%% RFC 6733 allows 5xxx in an answer-message. +send_5xxx_missing_avp([_, rfc6733]) -> + #'diameter_base_answer-message'{'Result-Code' = 5005, %% MISSING_AVP + 'Failed-AVP' = [_], + 'AVP' = []} + = call(); + +%% RFC 3588 doesn't: sending answer fails. +send_5xxx_missing_avp([_, rfc3588]) -> + {error, timeout} = call(); + +%% Callback answers, ignores the error +send_5xxx_missing_avp([_,_]) -> + #diameter_base_STA{'Result-Code' = 2001, %% SUCCESS + 'Failed-AVP' = [], + 'AVP' = []} + = call(); + +send_5xxx_missing_avp(Config) -> + send_5xxx_missing_avp(?group(Config)). + %% send_double_error/1 %% -%% Send a request with both an incorrect length on the optional -%% Origin-State-Id and a missing AVP. +%% Send a request with both an invalid E-bit and a missing AVP. %% Callback answers with STA. send_double_error([callback, _]) -> @@ -294,8 +320,8 @@ send_double_error([callback, _]) -> %% diameter answers with answer-message. send_double_error([_,_]) -> - #'diameter_base_answer-message'{'Result-Code' = 3009, %% INVALID_AVP_BITS - 'Failed-AVP' = [_], + #'diameter_base_answer-message'{'Result-Code' = 3008, %% INVALID_HDR_BITS + 'Failed-AVP' = [], 'AVP' = []} = call(); @@ -392,24 +418,21 @@ prepare(Pkt, Caps, T) T == send_5xxx -> sta(Pkt, Caps); -prepare(Pkt0, Caps, send_invalid_avp_bits) -> - Req0 = sta(Pkt0, Caps), - %% Append an Origin-State-Id with an incorrect AVP Length in order - %% to force 3009. - Req = Req0#diameter_base_STR{'Origin-State-Id' = [7]}, - #diameter_packet{bin = Bin} +prepare(Pkt0, Caps, send_invalid_hdr_bits) -> + Req = sta(Pkt0, Caps), + %% Set the E-bit to force 3008. + #diameter_packet{bin = <<H:34, 0:1, T/bitstring>>} = Pkt = diameter_codec:encode(?DICT, Pkt0#diameter_packet{msg = Req}), - Offset = size(Bin) - 12 + 5, - <<H:Offset/binary, Len:24, T/binary>> = Bin, - Pkt#diameter_packet{bin = <<H/binary, (Len + 2):24, T/binary>>}; + Pkt#diameter_packet{bin = <<H:34, 1:1, T/bitstring>>}; prepare(Pkt0, Caps, send_double_error) -> - dehost(prepare(Pkt0, Caps, send_invalid_avp_bits)); + dehost(prepare(Pkt0, Caps, send_invalid_hdr_bits)); prepare(Pkt, Caps, T) when T == send_missing_avp; - T == send_ignore_missing_avp -> + T == send_ignore_missing_avp; + T == send_5xxx_missing_avp -> Req = sta(Pkt, Caps), dehost(diameter_codec:encode(?DICT, Pkt#diameter_packet{msg = Req})). @@ -480,9 +503,7 @@ request(send_3xxx, _Req, _Caps) -> request(send_5xxx, _Req, _Caps) -> {answer_message, 5999}; -request(send_invalid_avp_bits, Req, Caps) -> - #diameter_base_STR{'Origin-State-Id' = []} - = Req, +request(send_invalid_hdr_bits, Req, Caps) -> %% Default errors field but a non-answer-message and only 3xxx %% errors detected means diameter sets neither Result-Code nor %% Failed-AVP. @@ -495,7 +516,10 @@ request(T, Req, Caps) request(send_ignore_missing_avp, Req, Caps) -> {reply, #diameter_packet{msg = answer(Req, Caps), - errors = false}}. %% ignore errors + errors = false}}; %% ignore errors + +request(send_5xxx_missing_avp, _Req, _Caps) -> + {answer_message, 5005}. %% MISSING_AVP answer(Req, Caps) -> #diameter_base_STR{'Session-Id' = SId} diff --git a/lib/diameter/test/diameter_app_SUITE.erl b/lib/diameter/test/diameter_app_SUITE.erl index 209f72adf1..1e262895a6 100644 --- a/lib/diameter/test/diameter_app_SUITE.erl +++ b/lib/diameter/test/diameter_app_SUITE.erl @@ -56,7 +56,7 @@ %% =========================================================================== suite() -> - [{timetrap, {seconds, 10}}]. + [{timetrap, {seconds, 60}}]. all() -> [keys, diff --git a/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl b/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl index bce3d78a37..49f2158b1a 100644 --- a/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl +++ b/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl @@ -71,6 +71,6 @@ dec('AR', #diameter_packet dec('BR', #diameter_packet {msg = #recv_BR{'Origin-Host' = ?HOST, 'Origin-Realm' = ?REALM}, - errors = [{5008, ?NOT_MANDATORY_YYY}, - {5001, ?MANDATORY_XXX}]}) -> + errors = [{5001, ?MANDATORY_XXX}, + {5008, ?NOT_MANDATORY_YYY}]}) -> ok. diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl index 0baac59c1a..24d4c7665e 100644 --- a/lib/diameter/test/diameter_codec_test.erl +++ b/lib/diameter/test/diameter_codec_test.erl @@ -265,7 +265,7 @@ arity(M, Name, AvpName, Rec) -> %% enum/3 enum(M, Name, {_,E}) -> - B = <<E:32/integer>>, + B = <<E:32>>, B = M:avp(encode, E, Name), E = M:avp(decode, B, Name). @@ -322,15 +322,15 @@ values('Unsigned64') -> values('Float32') -> E = (1 bsl 8) - 2, F = (1 bsl 23) - 1, - <<Mx:32/float>> = <<0:1/integer, E:8/integer, F:23/integer>>, - <<Mn:32/float>> = <<1:1/integer, E:8/integer, F:23/integer>>, + <<Mx:32/float>> = <<0:1, E:8, F:23>>, + <<Mn:32/float>> = <<1:1, E:8, F:23>>, {[0.0, infinity, '-infinity', Mx, Mn], [0]}; values('Float64') -> E = (1 bsl 11) - 2, F = (1 bsl 52) - 1, - <<Mx:64/float>> = <<0:1/integer, E:11/integer, F:52/integer>>, - <<Mn:64/float>> = <<1:1/integer, E:11/integer, F:52/integer>>, + <<Mx:64/float>> = <<0:1, E:11, F:52>>, + <<Mn:64/float>> = <<1:1, E:11, F:52>>, {[0.0, infinity, '-infinity', Mx, Mn], [0]}; values('Address') -> diff --git a/lib/diameter/test/diameter_distribution_SUITE.erl b/lib/diameter/test/diameter_distribution_SUITE.erl index 01d3507b27..f069abbe2f 100644 --- a/lib/diameter/test/diameter_distribution_SUITE.erl +++ b/lib/diameter/test/diameter_distribution_SUITE.erl @@ -28,7 +28,7 @@ all/0]). %% testcases --export([enslave/1, +-export([enslave/1, enslave/0, ping/1, start/1, connect/1, @@ -36,7 +36,7 @@ send_remote/1, send_timeout/1, send_failover/1, - stop/1]). + stop/1, stop/0]). %% diameter callbacks -export([peer_up/3, @@ -126,6 +126,9 @@ all() -> %% Start four slave nodes, one to implement a Diameter server, %% two three to implement a client. +enslave() -> + [{timetrap, {seconds, 30*length(?NODES)}}]. + enslave(Config) -> Here = filename:dirname(code:which(?MODULE)), Ebin = filename:join([Here, "..", "ebin"]), @@ -225,6 +228,9 @@ connect(Config) -> %% %% Stop the slave nodes. +stop() -> + [{timetrap, {seconds, 30*length(?NODES)}}]. + stop(_Config) -> [] = [{N,E} || {N,_} <- ?NODES, {error, _, _} = E <- [ct_slave:stop(N)]]. diff --git a/lib/diameter/test/diameter_examples_SUITE.erl b/lib/diameter/test/diameter_examples_SUITE.erl index 585fc9d3b8..1954bc319b 100644 --- a/lib/diameter/test/diameter_examples_SUITE.erl +++ b/lib/diameter/test/diameter_examples_SUITE.erl @@ -29,6 +29,7 @@ %% testcases -export([dict/1, dict/0, code/1, + slave/1, slave/0, enslave/1, start/1, traffic/1, @@ -65,11 +66,12 @@ %% =========================================================================== suite() -> - [{timetrap, {seconds, 45}}]. + [{timetrap, {minutes, 2}}]. all() -> [dict, code, + slave, enslave, start, traffic, @@ -250,6 +252,29 @@ store(Path, Dict) -> %% =========================================================================== +%% slave/1 +%% +%% Return how long slave start/stop is taking since it seems to be +%% ridiculously long on some hosts. + +slave() -> + [{timetrap, {minutes, 10}}]. + +slave(_) -> + T0 = now(), + {ok, Node} = ct_slave:start(?MODULE, ?TIMEOUTS), + T1 = now(), + T2 = rpc:call(Node, erlang, now, []), + {ok, Node} = ct_slave:stop(?MODULE), + now_diff([T0, T1, T2, now()]). + +now_diff([T1,T2|_] = Ts) -> + [timer:now_diff(T2,T1) | now_diff(tl(Ts))]; +now_diff(_) -> + []. + +%% =========================================================================== + %% enslave/1 %% %% Start two nodes: one for the server, one for the client. diff --git a/lib/diameter/test/diameter_gen_tcp_SUITE.erl b/lib/diameter/test/diameter_gen_tcp_SUITE.erl new file mode 100644 index 0000000000..7e232edb44 --- /dev/null +++ b/lib/diameter/test/diameter_gen_tcp_SUITE.erl @@ -0,0 +1,106 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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% +%% + +%% +%% Some gen_sctp-specific tests demonstrating problems that were +%% encountered during diameter development but have nothing +%% specifically to do with diameter. At least one of them can cause +%% diameter_traffic_SUITE testcases to fail. +%% + +-module(diameter_gen_tcp_SUITE). + +-export([suite/0, + all/0]). + +%% testcases +-export([send_long/1]). + +-define(LOOPBACK, {127,0,0,1}). +-define(GEN_OPTS, [binary, {active, true}, {ip, ?LOOPBACK}]). + +%% =========================================================================== + +suite() -> + [{timetrap, {minutes, 2}}]. + +all() -> + [send_long]. + +%% =========================================================================== + +%% send_long/1 +%% +%% Test that a long message is received. + +send_long(_) -> + {Sock, SendF} = connection(), + B = list_to_binary(lists:duplicate(1 bsl 20, $X)), + ok = SendF(B), + B = recv(Sock, size(B), []). + +recv(_, 0, Acc) -> + list_to_binary(lists:reverse(Acc)); +recv(Sock, N, Acc) -> + receive + {tcp, Sock, Bin} -> + recv(Sock, N - size(Bin), [Bin | Acc]); + T -> + {T, Acc} + end. + +%% connection/0 + +connection() -> + {ok, LSock} = gen_tcp:listen(0, ?GEN_OPTS), + {ok, PortNr} = inet:port(LSock), + LPid = self(), + {Pid, MRef} = spawn_monitor(fun() -> connect(PortNr, LPid) end), + {ok, Sock} = gen_tcp:accept(LSock), + receive + {Pid, F} -> + {Sock, F}; + {'DOWN', MRef, process, _, _} = T -> + T + end. + +%% connect/2 + +connect(PortNr, LPid) -> + {ok, Sock} = gen_tcp:connect(?LOOPBACK, PortNr, ?GEN_OPTS), + LPid ! {self(), fun(B) -> send(Sock, B) end}, + down(LPid). + +%% down/1 + +down(Pid) + when is_pid(Pid) -> + down(erlang:monitor(process, Pid)); + +down(MRef) -> + receive {'DOWN', MRef, process, _, Reason} -> Reason end. + +%% send/2 +%% +%% Send from a spawned process just to avoid sending from the +%% receiving process, in case it's significant. + +send(Sock, Bin) -> + {_, MRef} = spawn_monitor(fun() -> exit(gen_tcp:send(Sock, Bin)) end), + down(MRef). diff --git a/lib/diameter/test/diameter_tls_SUITE.erl b/lib/diameter/test/diameter_tls_SUITE.erl index 5a79c63d36..55565692ec 100644 --- a/lib/diameter/test/diameter_tls_SUITE.erl +++ b/lib/diameter/test/diameter_tls_SUITE.erl @@ -181,7 +181,7 @@ start_diameter(_Config) -> ok = diameter:start(). make_certs() -> - [{timetrap, {seconds, 30}}]. + [{timetrap, {minutes, 2}}]. make_certs(Config) -> Dir = proplists:get_value(priv_dir, Config), @@ -302,9 +302,7 @@ set([H|T], Vs) -> disconnect({{LRef, _PortNr}, CRef}) -> ok = diameter:remove_transport(?CLIENT, CRef), - ok = receive #diameter_event{info = {down, LRef, _, _}} -> ok - after 2000 -> false - end. + receive #diameter_event{info = {down, LRef, _, _}} -> ok end. realm(Host) -> tl(lists:dropwhile(fun(C) -> C /= $. end, Host)). @@ -365,13 +363,11 @@ ssl([{ssl_options = T, Opts}]) -> connect(Host, {_LRef, PortNr}, {Caps, Opts}) -> {ok, Ref} = diameter:add_transport(Host, ?CONNECT(PortNr, Caps, Opts)), - ok = receive - #diameter_event{service = Host, - info = {up, Ref, _, _, #diameter_packet{}}} -> - ok - after 2000 -> - false - end, + receive + #diameter_event{service = Host, + info = {up, Ref, _, _, #diameter_packet{}}} -> + ok + end, Ref. copts(S, Opts) diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 781ed234cc..38bdf55af8 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -49,9 +49,12 @@ send_unsupported_app/1, send_error_bit/1, send_unsupported_version/1, - send_invalid_avp_bits/1, + send_long_avp_length/1, + send_short_avp_length/1, + send_zero_avp_length/1, send_invalid_avp_length/1, send_invalid_reject/1, + send_unrecognized_mandatory/1, send_long/1, send_nopeer/1, send_noapp/1, @@ -268,9 +271,12 @@ tc() -> send_unsupported_app, send_error_bit, send_unsupported_version, - send_invalid_avp_bits, + send_long_avp_length, + send_short_avp_length, + send_zero_avp_length, send_invalid_avp_length, send_invalid_reject, + send_unrecognized_mandatory, send_long, send_nopeer, send_noapp, @@ -405,7 +411,7 @@ send_eval(Config) -> send_bad_answer(Config) -> Req = ['ACR', {'Accounting-Record-Type', ?EVENT_RECORD}, {'Accounting-Record-Number', 2}], - {error, timeout} = call(Config, Req). + {timeout, _} = call(Config, Req). %% Send an ACR that the server callback answers explicitly with a %% protocol error. @@ -416,13 +422,14 @@ send_protocol_error(Config) -> ?answer_message(?TOO_BUSY) = call(Config, Req). -%% Send an ASR with an arbitrary AVP and expect success and the same -%% AVP in the reply. +%% Send an ASR with an arbitrary non-mandatory AVP and expect success +%% and the same AVP in the reply. send_arbitrary(Config) -> - Req = ['ASR', {'AVP', [#diameter_avp{name = 'Class', value = "XXX"}]}], + Req = ['ASR', {'AVP', [#diameter_avp{name = 'Product-Name', + value = "XXX"}]}], ['ASA', _SessionId, {'Result-Code', ?SUCCESS} | Avps] = call(Config, Req), - {'AVP', [#diameter_avp{name = 'Class', + {'AVP', [#diameter_avp{name = 'Product-Name', value = "XXX"}]} = lists:last(Avps). @@ -455,7 +462,7 @@ send_unknown_mandatory(Config) -> %% Send an STR that the server ignores. send_noreply(Config) -> Req = ['STR', {'Termination-Cause', ?BAD_ANSWER}], - {error, timeout} = call(Config, Req). + {timeout, _} = call(Config, Req). %% Send an unsupported command and expect 3001. send_unsupported(Config) -> @@ -481,19 +488,33 @@ send_unsupported_version(Config) -> ['STA', _SessionId, {'Result-Code', ?UNSUPPORTED_VERSION} | _] = call(Config, Req). -%% Send a request containing an incorrect AVP length. -send_invalid_avp_bits(Config) -> - Req = ['STR', {'Termination-Cause', ?LOGOUT}], +%% Send a request containing an AVP length > data size. +send_long_avp_length(Config) -> + send_invalid_avp_length(Config). - ?answer_message(?INVALID_AVP_BITS) - = call(Config, Req). +%% Send a request containing an AVP length < data size. +send_short_avp_length(Config) -> + send_invalid_avp_length(Config). + +%% Send a request containing an AVP whose advertised length is < 8. +send_zero_avp_length(Config) -> + send_invalid_avp_length(Config). %% Send a request containing an AVP length that doesn't match the %% AVP's type. send_invalid_avp_length(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], - ['STA', _SessionId, {'Result-Code', ?INVALID_AVP_LENGTH} | _] + ['STA', _SessionId, + {'Result-Code', ?INVALID_AVP_LENGTH}, + _OriginHost, + _OriginRealm, + _UserName, + _Class, + _ErrorMessage, + _ErrorReportingHost, + {'Failed-AVP', [#'diameter_base_Failed-AVP'{'AVP' = [_]}]} + | _] = call(Config, Req). %% Send a request containing 5xxx errors that the server rejects with @@ -504,6 +525,14 @@ send_invalid_reject(Config) -> ?answer_message(?TOO_BUSY) = call(Config, Req). +%% Send an STR containing a known AVP, but one that's not allowed and +%% sets the M-bit. +send_unrecognized_mandatory(Config) -> + Req = ['STR', {'Termination-Cause', ?LOGOUT}], + + ['STA', _SessionId, {'Result-Code', ?AVP_UNSUPPORTED} | _] + = call(Config, Req). + %% Send something long that will be fragmented by TCP. send_long(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, @@ -552,7 +581,7 @@ send_all_2(Config) -> %% Timeout before the server manages an answer. send_timeout(Config) -> Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_ONLY}], - {error, timeout} = call(Config, Req, [{timeout, 1000}]). + {timeout, _} = call(Config, Req, [{timeout, 1000}]). %% Explicitly answer with an answer-message and ensure that we %% received the Session-Id. @@ -560,7 +589,7 @@ send_error(Config) -> Req = ['RAR', {'Re-Auth-Request-Type', ?AUTHORIZE_AUTHENTICATE}], ?answer_message(SId, ?TOO_BUSY) = call(Config, Req), - undefined /= SId. + true = undefined /= SId. %% Send a request with the detached option and receive it as a message %% from handle_answer instead. @@ -568,7 +597,7 @@ send_detach(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}], Ref = make_ref(), ok = call(Config, Req, [{extra, [{self(), Ref}]}, detach]), - Ans = receive {Ref, T} -> T after 2000 -> false end, + Ans = receive {Ref, T} -> T end, ['STA', _SessionId, {'Result-Code', ?SUCCESS} | _] = Ans. @@ -683,7 +712,7 @@ call(Config, Req, Opts) -> diameter:call(?CLIENT, dict(Req, Dict0), msg(Req, ReqEncoding, Dict0), - [{extra, [Name, Group]} | Opts]). + [{extra, [{Name, Group}, now()]} | Opts]). origin({A,C}) -> 2*codec(A) + container(C); @@ -767,14 +796,14 @@ peer_down(_SvcName, _Peer, State) -> %% pick_peer/6-7 -pick_peer(Peers, _, ?CLIENT, _State, Name, Group) +pick_peer(Peers, _, ?CLIENT, _State, {Name, Group}, _) when Name /= send_detach -> find(Group, Peers). -pick_peer(_Peers, _, ?CLIENT, _State, send_nopeer, _, ?EXTRA) -> +pick_peer(_Peers, _, ?CLIENT, _State, {send_nopeer, _}, _, ?EXTRA) -> false; -pick_peer(Peers, _, ?CLIENT, _State, send_detach, Group, {_,_}) -> +pick_peer(Peers, _, ?CLIENT, _State, {send_detach, Group}, _, {_,_}) -> find(Group, Peers). find(#group{server_encoding = A, server_container = C}, Peers) -> @@ -789,13 +818,13 @@ id(Id, {Pid, _Caps}) -> %% prepare_request/5-6 -prepare_request(_Pkt, ?CLIENT, {_Ref, _Caps}, send_discard, _) -> +prepare_request(_Pkt, ?CLIENT, {_Ref, _Caps}, {send_discard, _}, _) -> {discard, unprepared}; -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, Name, Group) -> +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, {Name, Group}, _) -> {send, prepare(Pkt, Caps, Name, Group)}. -prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, send_detach, Group, _) -> +prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, {send_detach, Group}, _, _) -> {eval_packet, {send, prepare(Pkt, Caps, Group)}, [fun log/2, detach]}. log(#diameter_packet{bin = Bin} = P, T) @@ -804,45 +833,63 @@ log(#diameter_packet{bin = Bin} = P, T) %% prepare/4 -prepare(Pkt, Caps, send_invalid_avp_bits, #group{client_dict0 = Dict0} - = Group) -> +prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) + when N == send_long_avp_length; + N == send_short_avp_length; + N == send_zero_avp_length -> Req = prepare(Pkt, Caps, Group), - %% Last AVP in our STR is Termination-Cause of type Unsigned32: - %% set its length improperly. + %% Second last AVP in our STR is Auth-Application-Id of type + %% Unsigned32: set AVP Length to a value other than 12 and place + %% it last in the message (so as not to mess with Termination-Cause). #diameter_packet{header = #diameter_header{length = L}, bin = B} = E = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), - Offset = L - 7, %% to AVP Length - <<H:Offset/binary, 12:24/integer, T:4/binary>> = B, - E#diameter_packet{bin = <<H/binary, 13:24/integer, T/binary>>}; + Offset = L - 24, %% to Auth-Application-Id + <<H:Offset/binary, + Hdr:5/binary, 12:24, Data:4/binary, + T:12/binary>> + = B, + AL = case N of + send_long_avp_length -> 13; + send_short_avp_length -> 11; + send_zero_avp_length -> 0 + end, + E#diameter_packet{bin = <<H/binary, + T/binary, + Hdr/binary, AL:24, Data/binary>>}; prepare(Pkt, Caps, N, #group{client_dict0 = Dict0} = Group) when N == send_invalid_avp_length; N == send_invalid_reject -> Req = prepare(Pkt, Caps, Group), %% Second last AVP in our STR is Auth-Application-Id of type - %% Unsigned32: Send a value of length 8. + %% Unsigned32: send data of length 8. #diameter_packet{header = #diameter_header{length = L}, bin = B0} = E = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), Offset = L - 7 - 12, %% to AVP Length - <<H0:Offset/binary, 12:24/integer, T:16/binary>> = B0, - <<V, L:24/integer, H/binary>> = H0, %% assert - E#diameter_packet{bin = <<V, - (L+4):24/integer, - H/binary, - 16:24/integer, - 0:32/integer, - T/binary>>}; + <<H0:Offset/binary, 12:24, T:16/binary>> = B0, + <<V, L:24, H/binary>> = H0, %% assert + E#diameter_packet{bin = <<V, (L+4):24, H/binary, 16:24, 0:32, T/binary>>}; + +prepare(Pkt, Caps, send_unrecognized_mandatory, #group{client_dict0 = Dict0} + = Group) -> + Req = prepare(Pkt, Caps, Group), + #diameter_packet{bin = <<V, Len:24, T/binary>>} + = E + = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), + {Code, Flags, undefined} = Dict0:avp_header('Proxy-State'), + Avp = <<Code:32, Flags, 8:24>>, + E#diameter_packet{bin = <<V, (Len+8):24, T/binary, Avp/binary>>}; prepare(Pkt, Caps, send_unsupported, #group{client_dict0 = Dict0} = Group) -> Req = prepare(Pkt, Caps, Group), #diameter_packet{bin = <<H:5/binary, _CmdCode:3/binary, T/binary>>} = E = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), - E#diameter_packet{bin = <<H/binary, 42:24/integer, T/binary>>}; + E#diameter_packet{bin = <<H/binary, 42:24, T/binary>>}; prepare(Pkt, Caps, send_unsupported_app, #group{client_dict0 = Dict0} = Group) -> @@ -850,7 +897,7 @@ prepare(Pkt, Caps, send_unsupported_app, #group{client_dict0 = Dict0} #diameter_packet{bin = <<H:8/binary, _ApplId:4/binary, T/binary>>} = E = diameter_codec:encode(Dict0, Pkt#diameter_packet{msg = Req}), - E#diameter_packet{bin = <<H/binary, ?BAD_APP:32/integer, T/binary>>}; + E#diameter_packet{bin = <<H/binary, ?BAD_APP:32, T/binary>>}; prepare(Pkt, Caps, send_error_bit, Group) -> #diameter_packet{header = Hdr} = Pkt, @@ -928,10 +975,10 @@ prepare_retransmit(_Pkt, false, _Peer, _Name, _Group) -> %% handle_answer/6-7 -handle_answer(Pkt, Req, ?CLIENT, Peer, Name, Group) -> +handle_answer(Pkt, Req, ?CLIENT, Peer, {Name, Group}, _) -> answer(Pkt, Req, Peer, Name, Group). -handle_answer(Pkt, Req, ?CLIENT, Peer, send_detach = Name, Group, X) -> +handle_answer(Pkt, Req, ?CLIENT, Peer, {send_detach = Name, Group}, _, X) -> {Pid, Ref} = X, Pid ! {Ref, answer(Pkt, Req, Peer, Name, Group)}. @@ -944,7 +991,9 @@ answer(Pkt, Req, _Peer, Name, #group{client_dict0 = Dict0}) -> [Dict:rec2msg(R) | Vs]. answer(Rec, [_|_], N) - when N == send_invalid_avp_bits; + when N == send_long_avp_length; + N == send_short_avp_length; + N == send_zero_avp_length; N == send_invalid_avp_length; N == send_invalid_reject -> Rec; @@ -959,7 +1008,11 @@ app(Req, _, Dict0) -> %% handle_error/6 -handle_error(Reason, _Req, ?CLIENT, _Peer, _Name, _Group) -> +handle_error(timeout = Reason, _Req, ?CLIENT, _Peer, _, Time) -> + Now = now(), + {Reason, {Time, Now, timer:now_diff(Now, Time)}}; + +handle_error(Reason, _Req, ?CLIENT, _Peer, _, _Time) -> {error, Reason}. %% handle_request/3 @@ -1085,7 +1138,6 @@ request(#diameter_base_STR{'Session-Id' = SId}, {'Origin-Host', OH}, {'Origin-Realm', OR}]}; -%% send_error +%% send_error/send_timeout request(#diameter_base_RAR{}, _Caps) -> - receive after 2000 -> ok end, - {protocol_error, ?TOO_BUSY}. + receive after 2000 -> {protocol_error, ?TOO_BUSY} end. diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index 1a829f8031..4fea62461c 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -38,6 +38,7 @@ MODULES = \ diameter_examples_SUITE \ diameter_failover_SUITE \ diameter_gen_sctp_SUITE \ + diameter_gen_tcp_SUITE \ diameter_length_SUITE \ diameter_reg_SUITE \ diameter_relay_SUITE \ diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index f6b13c2998..55794f57dc 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -33,7 +33,6 @@ %% connect_and_send/2, send/2, cancel/3, - stream/3, stream_next/1, info/1 ]). @@ -65,7 +64,7 @@ options, % #options{} timers = #timers{}, % #timers{} profile_name, % atom() - id of httpc_manager process. - once % send | undefined + once = inactive % inactive | once }). @@ -231,6 +230,8 @@ init([Parent, Request, Options, ProfileName]) -> ProxyOptions = handle_proxy_options(Request#request.scheme, Options), Address = handle_proxy(Request#request.address, ProxyOptions), {ok, State} = + %% #state.once should initially be 'inactive' because we + %% activate the socket at first regardless of the state. case {Address /= Request#request.address, Request#request.scheme} of {true, https} -> connect_and_send_upgrade_request(Address, Request, @@ -425,7 +426,9 @@ handle_cast({cancel, RequestId, From}, handle_cast(stream_next, #state{session = Session} = State) -> activate_once(Session), - {noreply, State#state{once = once}}. + %% Inactivate the #state.once here because we don't want + %% next_body_chunk/1 to activate the socket twice. + {noreply, State#state{once = inactive}}. %%-------------------------------------------------------------------- @@ -478,6 +481,41 @@ handle_info({Proto, _Socket, Data}, NewMFA = {Module, whole_body, [NewBody, NewLength]}, {noreply, NewState#state{mfa = NewMFA, request = NewRequest}}; + {Module, decode_size, + [TotalChunk, HexList, + {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} + when BodySoFar =/= <<>> -> + ?hcrd("data processed - decode_size", []), + %% The response body is chunk-encoded. Steal decoded + %% chunks as much as possible to stream. + {_, Code, _} = StatusLine, + {NewBody, NewRequest} = stream(BodySoFar, Request, Code), + NewState = next_body_chunk(State), + NewMFA = {Module, decode_size, + [TotalChunk, HexList, + {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, + {noreply, NewState#state{mfa = NewMFA, + request = NewRequest}}; + {Module, decode_data, + [ChunkSize, TotalChunk, + {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}]} + when TotalChunk =/= <<>> orelse BodySoFar =/= <<>> -> + ?hcrd("data processed - decode_data", []), + %% The response body is chunk-encoded. Steal decoded + %% chunks as much as possible to stream. + ChunkSizeToSteal = min(ChunkSize, byte_size(TotalChunk)), + <<StolenChunk:ChunkSizeToSteal/binary, NewTotalChunk/binary>> = TotalChunk, + StolenBody = <<BodySoFar/binary, StolenChunk/binary>>, + NewChunkSize = ChunkSize - ChunkSizeToSteal, + {_, Code, _} = StatusLine, + + {NewBody, NewRequest} = stream(StolenBody, Request, Code), + NewState = next_body_chunk(State), + NewMFA = {Module, decode_data, + [NewChunkSize, NewTotalChunk, + {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}, + {noreply, NewState#state{mfa = NewMFA, + request = NewRequest}}; NewMFA -> ?hcrd("data processed - new mfa", []), activate_once(Session), @@ -1027,11 +1065,15 @@ handle_http_msg({Version, StatusCode, ReasonPharse, Headers, Body}, status_line = StatusLine, headers = Headers}) end; -handle_http_msg({ChunkedHeaders, Body}, #state{headers = Headers} = State) -> +handle_http_msg({ChunkedHeaders, Body}, + #state{status_line = {_, Code, _}, headers = Headers} = State) -> ?hcrt("handle_http_msg", [{chunked_headers, ChunkedHeaders}, {headers, Headers}]), NewHeaders = http_chunk:handle_headers(Headers, ChunkedHeaders), - handle_response(State#state{headers = NewHeaders, body = Body}); + {NewBody, NewRequest} = stream(Body, State#state.request, Code), + handle_response(State#state{headers = NewHeaders, + body = NewBody, + request = NewRequest}); handle_http_msg(Body, #state{status_line = {_,Code, _}} = State) -> ?hcrt("handle_http_msg", [{code, Code}]), {NewBody, NewRequest} = stream(Body, State#state.request, Code), @@ -1070,8 +1112,7 @@ handle_http_body(Body, #state{headers = Headers, "chunked" -> ?hcrt("handle_http_body - chunked", []), case http_chunk:decode(Body, State#state.max_body_size, - State#state.max_header_size, - {Code, Request}) of + State#state.max_header_size) of {Module, Function, Args} -> ?hcrt("handle_http_body - new mfa", [{module, Module}, diff --git a/lib/inets/src/http_lib/http_chunk.erl b/lib/inets/src/http_lib/http_chunk.erl index 57647438e9..24c939e80c 100644 --- a/lib/inets/src/http_lib/http_chunk.erl +++ b/lib/inets/src/http_lib/http_chunk.erl @@ -24,7 +24,7 @@ -include("http_internal.hrl"). %% API --export([decode/3, decode/4, encode/1, encode_last/0, handle_headers/2]). +-export([decode/3, encode/1, encode_last/0, handle_headers/2]). %% Callback API - used for example if the chunkedbody is received a %% little at a time on a socket. -export([decode_size/1, ignore_extensions/1, decode_data/1, decode_trailer/1]). @@ -34,20 +34,14 @@ %%% API %%%========================================================================= %%------------------------------------------------------------------------- -%% decode(ChunkedBody, MaxBodySize, MaxHeaderSize, <Stream>) -> +%% decode(ChunkedBody, MaxBodySize, MaxHeaderSize) -> %% {ok, {Headers, Body}} | {Module, Function, Args} %% %% Headers = ["Header:Value"] %% ChunkedBody = binary() %% MaxBodySize = integer() %% MaxHeaderSize = integer() -%% Stream = {Code, Request} - if Request#request.stream =/= none -%% and Code == 200 the side effect of sending each decode chunk to the -%% client/file before the whole body is received will take place. %% -%% Note: decode/4 should only be used from httpc_handler module. -%% Otherwhise use the side effect free decode/3. -%% %% Description: Decodes a body encoded by the chunked transfer %% encoding. If the ChunkedBody is not compleate it returns {Module, %% Function, Args} so that decoding can be continued when more of the @@ -61,12 +55,9 @@ %% the next pass in the loop. %%------------------------------------------------------------------------- decode(ChunkedBody, MaxBodySize, MaxHeaderSize) -> - decode(ChunkedBody, MaxBodySize, MaxHeaderSize, false). - -decode(ChunkedBody, MaxBodySize, MaxHeaderSize, Stream) -> %% Note decode_size will call decode_data. - decode_size([ChunkedBody, <<>>, [], - {MaxBodySize, <<>>, 0, MaxHeaderSize, Stream}]). + decode_size([ChunkedBody, <<>>, [], + {MaxBodySize, <<>>, 0, MaxHeaderSize}]). %%------------------------------------------------------------------------- %% encode(Chunk) -> EncodedChunk @@ -150,7 +141,7 @@ decode_size(<<>>, HexList, Info) -> decode_size(Data = <<?CR, ?LF, ChunkRest/binary>>, HexList, {MaxBodySize, Body, AccLength, - MaxHeaderSize, Stream}) -> + MaxHeaderSize}) -> ChunkSize = http_util:hexlist_to_integer(lists:reverse(HexList)), case ChunkSize of 0 -> % Last chunk, there was no data @@ -164,7 +155,7 @@ decode_size(Data = <<?CR, ?LF, ChunkRest/binary>>, HexList, %% to this function comes in. decode_data(ChunkSize, ChunkRest, {MaxBodySize, Body, ChunkSize + AccLength , - MaxHeaderSize, Stream}) + MaxHeaderSize}) end; decode_size(<<";", Rest/binary>>, HexList, Info) -> %% Note ignore_extensions will call decode_size/1 again when @@ -189,50 +180,42 @@ ignore_extensions(<<_Octet, Rest/binary>>, NextFunction) -> ignore_extensions(Rest, NextFunction). decode_data(ChunkSize, TotalChunk, - Info = {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize, Stream}) + Info = {MaxBodySize, BodySoFar, AccLength, MaxHeaderSize}) when ChunkSize =< size(TotalChunk) -> case TotalChunk of %% Last chunk <<Data:ChunkSize/binary, ?CR, ?LF, "0", ";">> -> %% Note ignore_extensions will call decode_trailer/1 %% once it ignored all extensions. - {NewBody, _} = - stream(<<BodySoFar/binary, Data/binary>>, Stream), {?MODULE, ignore_extensions, [<<>>, {?MODULE, decode_trailer, [<<>>, [],[], MaxHeaderSize, - NewBody, + <<BodySoFar/binary, Data/binary>>, integer_to_list(AccLength)]}]}; <<Data:ChunkSize/binary, ?CR, ?LF, "0", ";", Rest/binary>> -> %% Note ignore_extensions will call decode_trailer/1 %% once it ignored all extensions. - {NewBody, _} = stream(<<BodySoFar/binary, Data/binary>>, Stream), ignore_extensions(Rest, {?MODULE, decode_trailer, [<<>>, [],[], MaxHeaderSize, - NewBody, + <<BodySoFar/binary, Data/binary>>, integer_to_list(AccLength)]}); <<Data:ChunkSize/binary, ?CR, ?LF, "0", ?CR, ?LF>> -> - {NewBody, _} = stream(<<BodySoFar/binary, Data/binary>>, Stream), {?MODULE, decode_trailer, [<<?CR, ?LF>>, [],[], MaxHeaderSize, - NewBody, + <<BodySoFar/binary, Data/binary>>, integer_to_list(AccLength)]}; <<Data:ChunkSize/binary, ?CR, ?LF, "0", ?CR, ?LF, Rest/binary>> -> - {NewBody,_}= stream(<<BodySoFar/binary, Data/binary>>, Stream), decode_trailer(<<?CR, ?LF, Rest/binary>>, [],[], MaxHeaderSize, - NewBody, + <<BodySoFar/binary, Data/binary>>, integer_to_list(AccLength)); %% There are more chunks, so here we go agin... <<Data:ChunkSize/binary, ?CR, ?LF>> -> - {NewBody, NewStream} = - stream(<<BodySoFar/binary, Data/binary>>, Stream), - {?MODULE, decode_size, [<<>>, [], {MaxBodySize, NewBody, AccLength, MaxHeaderSize, NewStream}]}; + NewBody = <<BodySoFar/binary, Data/binary>>, + {?MODULE, decode_size, [<<>>, [], {MaxBodySize, NewBody, AccLength, MaxHeaderSize}]}; <<Data:ChunkSize/binary, ?CR, ?LF, Rest/binary>> when (AccLength < MaxBodySize) or (MaxBodySize == nolimit) -> - {NewBody, NewStream} = - stream(<<BodySoFar/binary, Data/binary>>, Stream), decode_size(Rest, [], - {MaxBodySize, NewBody, - AccLength, MaxHeaderSize, NewStream}); + {MaxBodySize, <<BodySoFar/binary, Data/binary>>, + AccLength, MaxHeaderSize}); <<_:ChunkSize/binary, ?CR, ?LF, _/binary>> -> throw({error, body_too_big}); _ -> @@ -286,9 +269,3 @@ decode_trailer(<<Octet, Rest/binary>>, Header, Headers, MaxHeaderSize, Body, BodyLength) -> decode_trailer(Rest, [Octet | Header], Headers, MaxHeaderSize, Body, BodyLength). - -stream(BodyPart, false) -> - {BodyPart, false}; -stream(BodyPart, {Code, Request}) -> - {NewBody, NewRequest} = httpc_handler:stream(BodyPart, Request, Code), - {NewBody, {Code, NewRequest}}. diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 350192464e..0c35f284f7 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -1693,6 +1693,15 @@ receive_streamed_body(RequestId, Body, Pid) -> ct:print("~p:receive_streamed_body -> requested next stream ~n", [?MODULE]), receive {http, {RequestId, stream, BinBodyPart}} -> + %% Make sure the httpc hasn't sent us the next 'stream' + %% without our request. + receive + {http, {RequestId, stream, _}} = Msg -> + ct:fail({unexpected_flood_of_stream, Msg}) + after + 1000 -> + ok + end, receive_streamed_body(RequestId, <<Body/binary, BinBodyPart/binary>>, Pid); diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 4218cfa646..e4c8f0ffaf 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -2651,6 +2651,8 @@ symlinks(Config) when is_list(Config) -> ?line #file_info{links=1, type=symlink} = Info2, ?line {ok, Name} = ?FILE_MODULE:read_link(Alias), {ok, Name} = ?FILE_MODULE:read_link_all(Alias), + %% If all is good, delete dir again (avoid hanging dir on windows) + rm_rf(?FILE_MODULE,NewDir), ok end, @@ -4304,3 +4306,18 @@ disc_free(Path) -> memsize() -> {Tot,_Used,_} = memsup:get_memory_data(), Tot. + +%%%----------------------------------------------------------------- +%%% Utilities +rm_rf(Mod,Dir) -> + case Mod:read_link_info(Dir) of + {ok, #file_info{type = directory}} -> + {ok, Content} = Mod:list_dir_all(Dir), + [ rm_rf(Mod,filename:join(Dir,C)) || C <- Content ], + Mod:del_dir(Dir), + ok; + {ok, #file_info{}} -> + Mod:delete(Dir); + _ -> + ok + end. diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl index a6728564e4..0c8082026a 100644 --- a/lib/kernel/test/file_name_SUITE.erl +++ b/lib/kernel/test/file_name_SUITE.erl @@ -197,7 +197,10 @@ normal(Config) when is_list(Config) -> put(file_module,prim_file), ok = check_normal(prim_file), put(file_module,file), - ok = check_normal(file) + ok = check_normal(file), + %% If all is good, delete dir again (avoid hanging dir on windows) + rm_rf(file,"normal_dir"), + ok after file:set_cwd(Dir) end. @@ -219,7 +222,10 @@ icky(Config) when is_list(Config) -> put(file_module,prim_file), ok = check_icky(prim_file), put(file_module,file), - ok = check_icky(file) + ok = check_icky(file), + %% If all is good, delete dir again (avoid hanging dir on windows) + rm_rf(file,"icky_dir"), + ok after file:set_cwd(Dir) end @@ -243,7 +249,11 @@ very_icky(Config) when is_list(Config) -> {skipped,"VM needs to be started in Unicode filename mode"}; ok -> put(file_module,file), - ok = check_very_icky(file) + ok = check_very_icky(file), + %% If all is good, delete dir again + %% (avoid hanging dir on windows) + rm_rf(file,"very_icky_dir"), + ok end after file:set_cwd(Dir) diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 6b672004ec..2d5827282f 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -602,7 +602,7 @@ iter_max_socks(Config) when is_list(Config) -> %% Run on a different node in order to limit the effect if this test fails. Dir = filename:dirname(code:which(?MODULE)), {ok,Node} = test_server:start_node(test_iter_max_socks,slave, - [{args,"-pa " ++ Dir}]), + [{args,"+Q 2048 -pa " ++ Dir}]), L = rpc:call(Node,?MODULE,do_iter_max_socks,[N, initalize]), test_server:stop_node(Node), diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl index dac021c6c6..d7d9434b1f 100644 --- a/lib/kernel/test/interactive_shell_SUITE.erl +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -211,7 +211,7 @@ job_control_remote(Config) when is_list(Config) -> {sleep,timeout(short)}, {putline,""}, {getline," -->"}, - {putline,"r "++MyNode}, + {putline,"r '"++MyNode++"'"}, {putline,"c"}, {putline_raw,""}, {getline,"Eshell"}, @@ -265,7 +265,7 @@ job_control_remote_noshell(Config) when is_list(Config) -> {sleep,timeout(short)}, {putline,""}, {getline," -->"}, - {putline,"r "++NSNodeStr}, + {putline,"r '"++NSNodeStr++"'"}, {putline,"c"}, {putline_raw,""}, {getline,"Eshell"}, @@ -721,4 +721,4 @@ get_default_shell() -> end. atom2list(A) -> - lists:flatten(io_lib:format("~w", [A])). + lists:flatten(io_lib:format("~s", [A])). diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index ac75037536..199e597e78 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -2039,6 +2039,8 @@ symlinks(Config, Handle, Suffix) -> ?PRIM_FILE_call(read_link, Handle, [Alias]), {ok, Name} = ?PRIM_FILE_call(read_link_all, Handle, [Alias]), + %% If all is good, delete dir again (avoid hanging dir on windows) + rm_rf(?PRIM_FILE,NewDir), ok end, @@ -2245,3 +2247,18 @@ zip_data([], Bs) -> Bs; zip_data(As, []) -> As. + +%%%----------------------------------------------------------------- +%%% Utilities +rm_rf(Mod,Dir) -> + case Mod:read_link_info(Dir) of + {ok, #file_info{type = directory}} -> + {ok, Content} = Mod:list_dir_all(Dir), + [ rm_rf(Mod,filename:join(Dir,C)) || C <- Content ], + Mod:del_dir(Dir), + ok; + {ok, #file_info{}} -> + Mod:delete(Dir); + _ -> + ok + end. diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index 64a8457d16..e7d71c581e 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2013. 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 @@ -41,6 +41,7 @@ %% Process state %% ------------- %% file: The name of the crashdump currently viewed. +%% dump_vsn: The version number of the crashdump %% procs_summary: Process summary represented by a list of %% #proc records. This is used for efficiency reasons when sorting the %% process summary table instead of reading all processes from the @@ -127,6 +128,8 @@ % timers, funs... % Must be equal to % ?max_sort_process_num! +-define(not_available,"N/A"). + %% All possible tags - use macros in order to avoid misspelling in the code -define(allocated_areas,allocated_areas). @@ -161,7 +164,7 @@ -define(visible_node,visible_node). --record(state,{file,procs_summary,sorted,shared_heap=false, +-record(state,{file,dump_vsn,procs_summary,sorted,shared_heap=false, wordsize=4,num_atoms="unknown",binaries,bg_status}). %%%----------------------------------------------------------------- @@ -499,6 +502,7 @@ handle_call(filename_frame,_From,State=#state{file=File}) -> {reply,Reply,State}; handle_call(initial_info_frame,_From,State=#state{file=File}) -> GenInfo = general_info(File), + [{DumpVsn,_}] = lookup_index(?erl_crash_dump), NumAtoms = GenInfo#general_info.num_atoms, {WS,SH} = parse_vsn_str(GenInfo#general_info.system_vsn,4,false), NumProcs = list_to_integer(GenInfo#general_info.num_procs), @@ -506,7 +510,9 @@ handle_call(initial_info_frame,_From,State=#state{file=File}) -> if NumProcs > ?max_sort_process_num -> too_many; true -> State#state.procs_summary end, - NewState = State#state{shared_heap=SH, + NewState = State#state{dump_vsn=[list_to_integer(L) || + L<-string:tokens(DumpVsn,".")], + shared_heap=SH, wordsize=WS, num_atoms=NumAtoms, procs_summary=ProcsSummary}, @@ -577,7 +583,7 @@ handle_call({sort_procs,SessionId,Input}, _From, State) -> handle_call({proc_details,Input},_From,State=#state{file=File,shared_heap=SH}) -> {ok,Pid} = get_value("pid",httpd:parse_query(Input)), Reply = - case get_proc_details(File,Pid) of + case get_proc_details(File,Pid,State#state.dump_vsn) of {ok,Proc} -> TW = truncated_warning([{?proc,Pid}]), crashdump_viewer_html:proc_details(Pid,Proc,TW,SH); @@ -1298,7 +1304,6 @@ find_truncated_proc({Tag,Pid}) -> is_proc_tag(Tag) when Tag==?proc; Tag==?proc_dictionary; Tag==?proc_messages; - Tag==?proc_dictionary; Tag==?debug_proc_dictionary; Tag==?proc_stack; Tag==?proc_heap -> @@ -1451,7 +1456,8 @@ count() -> %% avoid really big data in the server state. procs_summary(SessionId,TW,_,State=#state{procs_summary=too_many}) -> chunk_page(SessionId,State#state.file,TW,?proc,processes, - {no_sort,State#state.shared_heap},procs_summary_parsefun()), + {no_sort,State#state.shared_heap,State#state.dump_vsn}, + procs_summary_parsefun()), State; procs_summary(SessionId,TW,SortOn,State) -> ProcsSummary = @@ -1465,10 +1471,12 @@ procs_summary(SessionId,TW,SortOn,State) -> PS -> PS end, - {SortedPS,NewSorted} = do_sort_procs(SortOn,ProcsSummary,State#state.sorted), + {SortedPS,NewSorted} = do_sort_procs(SortOn,ProcsSummary,State), HtmlInfo = crashdump_viewer_html:chunk_page(processes,SessionId,TW, - {SortOn,State#state.shared_heap}, + {SortOn, + State#state.shared_heap, + State#state.dump_vsn}, SortedPS), crashdump_viewer_html:chunk(SessionId,done,HtmlInfo), State#state{procs_summary=ProcsSummary,sorted=NewSorted}. @@ -1480,15 +1488,14 @@ procs_summary_parsefun() -> %%----------------------------------------------------------------- %% Page with one process -get_proc_details(File,Pid) -> - [{DumpVsn,_}] = lookup_index(?erl_crash_dump), +get_proc_details(File,Pid,DumpVsn) -> case lookup_index(?proc,Pid) of [{_,Start}] -> Fd = open(File), pos_bof(Fd,Start), Proc0 = case DumpVsn of - "0.0" -> + [0,0] -> %% Old version (translated) #proc{pid=Pid}; _ -> @@ -1597,6 +1604,9 @@ get_procinfo(Fd,Fun,Proc) -> get_procinfo(Fd,Fun,Proc#proc{old_heap_top=val(Fd)}); "Old heap end" -> get_procinfo(Fd,Fun,Proc#proc{old_heap_end=val(Fd)}); + "Memory" -> + %% stored as integer so we can sort on it + get_procinfo(Fd,Fun,Proc#proc{memory=list_to_integer(val(Fd))}); {eof,_} -> Proc; % truncated file Other -> @@ -1865,35 +1875,41 @@ parse(Line0, Dict0) -> Dict. -do_sort_procs("state",Procs,"state") -> +do_sort_procs("state",Procs,#state{sorted="state"}) -> {lists:reverse(lists:keysort(#proc.state,Procs)),"rstate"}; do_sort_procs("state",Procs,_) -> {lists:keysort(#proc.state,Procs),"state"}; -do_sort_procs("pid",Procs,"pid") -> +do_sort_procs("pid",Procs,#state{sorted="pid"}) -> {lists:reverse(Procs),"rpid"}; do_sort_procs("pid",Procs,_) -> {Procs,"pid"}; -do_sort_procs("msg_q_len",Procs,"msg_q_len") -> +do_sort_procs("msg_q_len",Procs,#state{sorted="msg_q_len"}) -> {lists:keysort(#proc.msg_q_len,Procs),"rmsg_q_len"}; do_sort_procs("msg_q_len",Procs,_) -> {lists:reverse(lists:keysort(#proc.msg_q_len,Procs)),"msg_q_len"}; -do_sort_procs("reds",Procs,"reds") -> +do_sort_procs("reds",Procs,#state{sorted="reds"}) -> {lists:keysort(#proc.reds,Procs),"rreds"}; do_sort_procs("reds",Procs,_) -> {lists:reverse(lists:keysort(#proc.reds,Procs)),"reds"}; -do_sort_procs("mem",Procs,"mem") -> - {lists:keysort(#proc.stack_heap,Procs),"rmem"}; -do_sort_procs("mem",Procs,_) -> - {lists:reverse(lists:keysort(#proc.stack_heap,Procs)),"mem"}; -do_sort_procs("init_func",Procs,"init_func") -> +do_sort_procs("mem",Procs,#state{sorted="mem",dump_vsn=DumpVsn}) -> + KeyPos = if DumpVsn>=?r16b01_dump_vsn -> #proc.memory; + true -> #proc.stack_heap + end, + {lists:keysort(KeyPos,Procs),"rmem"}; +do_sort_procs("mem",Procs,#state{dump_vsn=DumpVsn}) -> + KeyPos = if DumpVsn>=?r16b01_dump_vsn -> #proc.memory; + true -> #proc.stack_heap + end, + {lists:reverse(lists:keysort(KeyPos,Procs)),"mem"}; +do_sort_procs("init_func",Procs,#state{sorted="init_func"}) -> {lists:reverse(lists:keysort(#proc.init_func,Procs)),"rinit_func"}; do_sort_procs("init_func",Procs,_) -> {lists:keysort(#proc.init_func,Procs),"init_func"}; -do_sort_procs("name_func",Procs,"name_func") -> +do_sort_procs("name_func",Procs,#state{sorted="name_func"}) -> {lists:reverse(lists:keysort(#proc.name,Procs)),"rname_func"}; do_sort_procs("name_func",Procs,_) -> {lists:keysort(#proc.name,Procs),"name_func"}; -do_sort_procs("name",Procs,Sorted) -> +do_sort_procs("name",Procs,#state{sorted=Sorted}) -> {No,Yes} = lists:foldl(fun(P,{N,Y}) -> case P#proc.name of @@ -2349,7 +2365,7 @@ allocator_info(File) -> end, AllAllocators), close(Fd), - R + [allocator_summary(R) | R] end. get_allocatorinfo(Fd,Start) -> @@ -2374,6 +2390,213 @@ get_all_vals([],Acc) -> get_all_vals([Char|Rest],Acc) -> get_all_vals(Rest,[Char|Acc]). +%% Calculate allocator summary: +%% +%% System totals: +%% blocks size = sum of mbcs, mbcs_pool and sbcs blocks size over +%% all allocator instances of all types +%% carriers size = sum of mbcs, mbcs_pool and sbcs carriers size over +%% all allocator instances of all types +%% +%% I any allocator except sbmbc_alloc has "option e: false" then don't +%% present system totals. +%% +%% For each allocator type: +%% blocks size = sum of sbmbcs, mbcs, mbcs_pool and sbcs blocks +%% size over all allocator instances of this type +%% carriers size = sum of sbmbcs, mbcs, mbcs_pool and sbcs carriers +%% size over all allocator instances of this type +%% mseg carriers size = sum of mbcs and sbcs mseg carriers size over all +%% allocator instances of this type +%% + +-define(sbmbcs_blocks_size,"sbmbcs blocks size"). +-define(mbcs_blocks_size,"mbcs blocks size"). +-define(sbcs_blocks_size,"sbcs blocks size"). +-define(sbmbcs_carriers_size,"sbmbcs carriers size"). +-define(mbcs_carriers_size,"mbcs carriers size"). +-define(sbcs_carriers_size,"sbcs carriers size"). +-define(mbcs_mseg_carriers_size,"mbcs mseg carriers size"). +-define(sbcs_mseg_carriers_size,"sbcs mseg carriers size"). +-define(segments_size,"segments_size"). +-define(mbcs_pool_blocks_size,"mbcs_pool blocks size"). +-define(mbcs_pool_carriers_size,"mbcs_pool carriers size"). + +-define(type_blocks_size,[?sbmbcs_blocks_size, + ?mbcs_blocks_size, + ?mbcs_pool_blocks_size, + ?sbcs_blocks_size]). +-define(type_carriers_size,[?sbmbcs_carriers_size, + ?mbcs_carriers_size, + ?mbcs_pool_carriers_size, + ?sbcs_carriers_size]). +-define(type_mseg_carriers_size,[?mbcs_mseg_carriers_size, + ?sbcs_mseg_carriers_size]). +-define(total_blocks_size,[?mbcs_blocks_size, + ?mbcs_pool_blocks_size, + ?sbcs_blocks_size]). +-define(total_carriers_size,[?mbcs_carriers_size, + ?mbcs_pool_carriers_size, + ?sbcs_carriers_size]). +-define(total_mseg_carriers_size,[?mbcs_mseg_carriers_size, + ?sbcs_mseg_carriers_size]). +-define(interesting_allocator_info, [?sbmbcs_blocks_size, + ?mbcs_blocks_size, + ?mbcs_pool_blocks_size, + ?sbcs_blocks_size, + ?sbmbcs_carriers_size, + ?mbcs_carriers_size, + ?sbcs_carriers_size, + ?mbcs_mseg_carriers_size, + ?mbcs_pool_carriers_size, + ?sbcs_mseg_carriers_size, + ?segments_size]). +-define(mseg_alloc,"mseg_alloc"). +-define(seg_size,"segments_size"). +-define(sbmbc_alloc,"sbmbc_alloc"). +-define(opt_e_false,{"option e","false"}). + +allocator_summary(Allocators) -> + {Sorted,DoTotal} = sort_allocator_types(Allocators,[],true), + {TypeTotals0,Totals} = sum_allocator_data(Sorted,DoTotal), + {TotalMCS,TypeTotals} = + case lists:keytake(?mseg_alloc,1,TypeTotals0) of + {value,{_,[{?seg_size,SegSize}]},Rest} -> + {integer_to_list(SegSize),Rest}; + false -> + {?not_available,TypeTotals0} + end, + {TotalBS,TotalCS} = + case Totals of + false -> + {?not_available,?not_available}; + {TBS,TCS} -> + {integer_to_list(TBS),integer_to_list(TCS)} + end, + {{"Summary",["blocks size","carriers size","mseg carriers size"]}, + [{"total",[TotalBS,TotalCS,TotalMCS]} | + format_allocator_summary(lists:reverse(TypeTotals))]}. + +format_allocator_summary([{Type,Data}|Rest]) -> + [format_allocator_summary(Type,Data) | format_allocator_summary(Rest)]; +format_allocator_summary([]) -> + []. + +format_allocator_summary(Type,Data) -> + BS = get_size_value(blocks_size,Data), + CS = get_size_value(carriers_size,Data), + MCS = get_size_value(mseg_carriers_size,Data), + {Type,[BS,CS,MCS]}. + +get_size_value(Key,Data) -> + case proplists:get_value(Key,Data) of + undefined -> + ?not_available; + Int -> + integer_to_list(Int) + end. + +%% Sort allocator data per type +%% Input = [{Instance,[{Key,Data}]}] +%% Output = [{Type,[{Key,Value}]}] +%% where Key in Output is one of ?interesting_allocator_info +%% and Value is the sum over all allocator instances of each type. +sort_allocator_types([{Name,Data}|Allocators],Acc,DoTotal) -> + Type = + case string:tokens(Name,"[]") of + [T,_Id] -> T; + [Name] -> Name + end, + TypeData = proplists:get_value(Type,Acc,[]), + {NewTypeData,NewDoTotal} = sort_type_data(Type,Data,TypeData,DoTotal), + NewAcc = lists:keystore(Type,1,Acc,{Type,NewTypeData}), + sort_allocator_types(Allocators,NewAcc,NewDoTotal); +sort_allocator_types([],Acc,DoTotal) -> + {Acc,DoTotal}. + +sort_type_data(Type,[?opt_e_false|Data],Acc,_) when Type=/=?sbmbc_alloc-> + sort_type_data(Type,Data,Acc,false); +sort_type_data(Type,[{Key,Val0}|Data],Acc,DoTotal) -> + case lists:member(Key,?interesting_allocator_info) of + true -> + Val = list_to_integer(hd(Val0)), + sort_type_data(Type,Data,update_value(Key,Val,Acc),DoTotal); + false -> + sort_type_data(Type,Data,Acc,DoTotal) + end; +sort_type_data(_Type,[],Acc,DoTotal) -> + {Acc,DoTotal}. + +%% Sum up allocator data in total blocks- and carriers size for all +%% allocators and per type of allocator. +%% Input = Output from sort_allocator_types/3 +%% Output = {[{"mseg_alloc",[{"segments_size",Value}]}, +%% {Type,[{blocks_size,Value}, +%% {carriers_size,Value}, +%% {mseg_carriers_size,Value}]}, +%% ...], +%% {TotalBlocksSize,TotalCarriersSize}} +sum_allocator_data(AllocData,false) -> + sum_allocator_data(AllocData,[],false); +sum_allocator_data(AllocData,true) -> + sum_allocator_data(AllocData,[],{0,0}). + +sum_allocator_data([{_Type,[]}|AllocData],TypeAcc,Total) -> + sum_allocator_data(AllocData,TypeAcc,Total); +sum_allocator_data([{Type,Data}|AllocData],TypeAcc,Total) -> + {TypeSum,NewTotal} = sum_type_data(Data,[],Total), + sum_allocator_data(AllocData,[{Type,TypeSum}|TypeAcc],NewTotal); +sum_allocator_data([],TypeAcc,Total) -> + {TypeAcc,Total}. + +sum_type_data([{Key,Value}|Data],TypeAcc,Total) -> + NewTotal = + case Total of + false -> + false; + {TotalBS,TotalCS} -> + case lists:member(Key,?total_blocks_size) of + true -> + {TotalBS+Value,TotalCS}; + false -> + case lists:member(Key,?total_carriers_size) of + true -> + {TotalBS,TotalCS+Value}; + false -> + {TotalBS,TotalCS} + end + end + end, + NewTypeAcc = + case lists:member(Key,?type_blocks_size) of + true -> + update_value(blocks_size,Value,TypeAcc); + false -> + case lists:member(Key,?type_carriers_size) of + true -> + update_value(carriers_size,Value,TypeAcc); + false -> + case lists:member(Key,?type_mseg_carriers_size) of + true -> + update_value(mseg_carriers_size,Value,TypeAcc); + false -> + %% "segments_size" for "mseg_alloc" + update_value(Key,Value,TypeAcc) + end + end + end, + sum_type_data(Data,NewTypeAcc,NewTotal); +sum_type_data([],TypeAcc,Total) -> + {TypeAcc,Total}. + +update_value(Key,Value,Acc) -> + case lists:keytake(Key,1,Acc) of + false -> + [{Key,Value}|Acc]; + {value,{Key,Old},Acc1} -> + [{Key,Old+Value}|Acc1] + end. + %%----------------------------------------------------------------- %% Page with hash table information hash_tables(File) -> diff --git a/lib/observer/src/crashdump_viewer.hrl b/lib/observer/src/crashdump_viewer.hrl index 466f33b63b..2e0ea5cf96 100644 --- a/lib/observer/src/crashdump_viewer.hrl +++ b/lib/observer/src/crashdump_viewer.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2013. 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 @@ -18,7 +18,7 @@ %% -define(space, " "). -define(unknown, "unknown"). - +-define(r16b01_dump_vsn, [0,2]). % =erl_crash_dump:0.2 -record(menu_item,{index,picture,text,depth,children,state,target}). @@ -83,6 +83,7 @@ old_heap_start=?space, old_heap_top=?space, old_heap_end=?space, + memory, stack_dump=?space}). -record(port, diff --git a/lib/observer/src/crashdump_viewer_html.erl b/lib/observer/src/crashdump_viewer_html.erl index 3151b83bfb..93c1a842b5 100644 --- a/lib/observer/src/crashdump_viewer_html.erl +++ b/lib/observer/src/crashdump_viewer_html.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2013. 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 @@ -333,7 +333,13 @@ proc_details_body(Heading,Proc,TW,SharedHeap) -> td("COLSPAN=1",href_proc_port(Proc#proc.parent))]), tr( [td("NOWRAP=true",b("Reductions")), - td("COLSPAN=3",integer_to_list(Proc#proc.reds))]), + td("COLSPAN=1",integer_to_list(Proc#proc.reds))] ++ + case Proc#proc.memory of + undefined -> []; % before R16B01 + Mem -> + [td("NOWRAP=true",b("Memory (bytes)")), + td("COLSPAN=1",integer_to_list(Mem))] + end), if SharedHeap -> Stack = case Proc#proc.stack_heap of -1 -> "unknown"; @@ -815,12 +821,26 @@ allocator_info_body(Heading,Allocators,TW) -> [heading(Heading,"memory"), warn(TW), p(b("Sizes are in bytes")), - lists:map(fun({SubTitle,Allocator}) -> + lists:map(fun({Head,Allocator}) -> + TableHead = + case Head of + {SubTitle,Columns} -> + tr("BGCOLOR=\"#8899AA\"", + [th("ALIGN=left", + font("SIZE=+1",SubTitle)) | + lists:map( + fun(CH) -> + th("ALIGN=right",CH) + end, + Columns)]); + SubTitle -> + tr("BGCOLOR=\"#8899AA\"", + th("COLSPAN=10 ALIGN=left", + font("SIZE=+1",SubTitle))) + end, [table( "BORDER=4 CELLPADDING=4", - [tr("BGCOLOR=\"#8899AA\"", - th("COLSPAN=10 ALIGN=left", - font("SIZE=+1",SubTitle))) | + [TableHead | lists:map( fun({Key,Values}) -> tr([th("ALIGN=left",Key) | @@ -1243,8 +1263,8 @@ replace_insrt([],[],Acc) -> %%% Create a page with one table by delivering chunk by chunk to %%% inets. crashdump_viewer first calls chunk_page/5 once, then %%% chunk/3 multiple times until all data is delivered. -chunk_page(processes,SessionId,TW,{Sorted,SharedHeap},FirstChunk) -> - Columns = procs_summary_table_head(Sorted,SharedHeap), +chunk_page(processes,SessionId,TW,{Sorted,SharedHeap,DumpVsn},FirstChunk) -> + Columns = procs_summary_table_head(Sorted,SharedHeap,DumpVsn), chunk_page(SessionId, "Process Information", TW, FirstChunk, "processes", Columns, fun procs_summary_table/1); chunk_page(ports,SessionId,TW,_,FirstChunk) -> @@ -1321,35 +1341,45 @@ deliver(SessionId,IoList) -> %%%----------------------------------------------------------------- %%% Page specific stuff for chunk pages -procs_summary_table_head(Sorted,SharedHeap) -> +procs_summary_table_head(Sorted,SharedHeap,DumpVsn) -> MemHeading = - if SharedHeap -> - "Stack"; + if DumpVsn>=?r16b01_dump_vsn -> + "Memory (bytes)"; true -> - "Stack+heap" + if SharedHeap -> + "Stack"; + true -> + "Stack+heap" + end end, - [procs_summary_table_head("pid","Pid",Sorted), - procs_summary_table_head("name_func","Name/Spawned as",Sorted), - procs_summary_table_head("state","State",Sorted), - procs_summary_table_head("reds","Reductions",Sorted), - procs_summary_table_head("mem",MemHeading,Sorted), - procs_summary_table_head("msg_q_len","MsgQ Length",Sorted)]. - -procs_summary_table_head(_,Text,no_sort) -> + [procs_summary_table_head1("pid","Pid",Sorted), + procs_summary_table_head1("name_func","Name/Spawned as",Sorted), + procs_summary_table_head1("state","State",Sorted), + procs_summary_table_head1("reds","Reductions",Sorted), + procs_summary_table_head1("mem",MemHeading,Sorted), + procs_summary_table_head1("msg_q_len","MsgQ Length",Sorted)]. + +procs_summary_table_head1(_,Text,no_sort) -> Text; -procs_summary_table_head(Sorted,Text,Sorted) -> +procs_summary_table_head1(Sorted,Text,Sorted) -> %% Mark the sorted column (bigger and italic) font("SIZE=\"+1\"",em(href("./sort_procs?sort="++Sorted,Text))); -procs_summary_table_head(SortOn,Text,_Sorted) -> +procs_summary_table_head1(SortOn,Text,_Sorted) -> href("./sort_procs?sort="++SortOn,Text). procs_summary_table(Proc) -> #proc{pid=Pid,name=Name,state=State, - reds=Reds,stack_heap=Mem0,msg_q_len=MsgQLen}=Proc, - Mem = case Mem0 of - -1 -> "unknown"; - _ -> integer_to_list(Mem0) - end, + reds=Reds,stack_heap=Stack,memory=Memory,msg_q_len=MsgQLen}=Proc, + Mem = + case Memory of + undefined -> % assuming pre-R16B01 + case Stack of + -1 -> "unknown"; + _ -> integer_to_list(Stack) + end; + _ -> + integer_to_list(Memory) + end, tr( [td(href(["./proc_details?pid=",Pid],Pid)), td(Name), diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl index 4077f8371a..f7712cf3da 100644 --- a/lib/observer/src/observer_lib.erl +++ b/lib/observer/src/observer_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% Copyright Ericsson AB 2011-2013. 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 @@ -122,7 +122,10 @@ fill_info([{Str, Key}|Rest], Data) when is_atom(Key); is_function(Key) -> [{Str, get_value(Key, Data)} | fill_info(Rest, Data)]; fill_info([{Str, {Format, Key}}|Rest], Data) when is_atom(Key); is_function(Key), is_atom(Format) -> - [{Str, {Format, get_value(Key,Data)}} | fill_info(Rest, Data)]; + case get_value(Key, Data) of + undefined -> [{Str, undefined} | fill_info(Rest, Data)]; + Value -> [{Str, {Format, Value}} | fill_info(Rest, Data)] + end; fill_info([{Str,SubStructure}|Rest], Data) when is_list(SubStructure) -> [{Str, fill_info(SubStructure, Data)}|fill_info(Rest,Data)]; fill_info([{Str,Attrib,SubStructure}|Rest], Data) -> diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 45218c177b..f234218017 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -64,6 +64,7 @@ init([Pid, ParentFrame, Parent]) -> MessagePage = init_panel(Notebook, "Messages", Pid, fun init_message_page/2), DictPage = init_panel(Notebook, "Dictionary", Pid, fun init_dict_page/2), StackPage = init_panel(Notebook, "Stack Trace", Pid, fun init_stack_page/2), + StatePage = init_panel(Notebook, "State", Pid, fun init_state_page/2), wxFrame:connect(Frame, close_window), wxMenu:connect(Frame, command_menu_selected), @@ -72,7 +73,7 @@ init([Pid, ParentFrame, Parent]) -> {Frame, #state{parent=Parent, pid=Pid, frame=Frame, - pages=[ProcessPage,MessagePage,DictPage,StackPage] + pages=[ProcessPage,MessagePage,DictPage,StackPage,StatePage] }} catch error:{badrpc, _} -> observer_wx:return_to_localnode(ParentFrame, node(Pid)), @@ -235,6 +236,59 @@ init_stack_page(Parent, Pid) -> Update(), {LCtrl, Update}. + +init_state_page(Parent, Pid) -> + Text = init_text_page(Parent), + Update = fun() -> + %% First, test if sys:get_status/2 have any chance to return an answer + case rpc:call(node(Pid), proc_lib, translate_initial_call, [Pid]) + of + %% Not a gen process + {proc_lib,init_p,5} -> Misc = [{"Information", "Not available"}]; + %% May be a gen process + {M, _F, _A} -> + %% Get the behavio(u)r + I = rpc:call(node(Pid), M, module_info, [attributes]), + case lists:keyfind(behaviour, 1, I) of + false -> case lists:keyfind(behavior, 1, I) of + false -> B = undefined; + {behavior, [B]} -> B + end; + {behaviour, [B]} -> B + end, + %% but not sure that system messages are treated by this process + %% so using a rpc with a small timeout in order not to lag the display + case rpc:call(node(Pid), sys, get_status, [Pid, 200]) + of + {status, _, {module, _}, [_PDict, _SysState, _Parent, _Dbg, + [Header,{data, First},{data, Second}]]} -> + Misc = [{"Behaviour", B}] ++ [Header] ++ First ++ Second; + {status, _, {module, _}, [_PDict, _SysState, _Parent, _Dbg, + [Header,{data, First}, OtherFormat]]} -> + Misc = [{"Behaviour", B}] ++ [Header] ++ First ++ [{"State",OtherFormat}]; + {status, _, {module, _}, [_PDict, _SysState, _Parent, _Dbg, + OtherFormat]} -> + %% Formatted status ? + case lists:keyfind(format_status, 1, rpc:call(node(Pid), M, module_info, [exports])) of + false -> Opt = {"Format", unknown}; + _ -> Opt = {"Format", overriden} + end, + Misc = [{"Behaviour", B}] ++ [Opt, {"State",OtherFormat}]; + {badrpc,{'EXIT',{timeout, _}}} -> + Misc = [{"Information","Timed out"}, + {"Tip","system messages are probably not treated by this process"}] + end; + _ -> Misc=[], throw(process_undefined) + end, + Dict = [io_lib:format("~-20.s ~tp~n", [K, V]) || {K, V} <- Misc], + Last = wxTextCtrl:getLastPosition(Text), + wxTextCtrl:remove(Text, 0, Last), + wxTextCtrl:writeText(Text, Dict) + end, + Update(), + {Text, Update}. + + create_menus(MenuBar) -> Menus = [{"File", [#create_menu{id=?wxID_CLOSE, text="Close"}]}, {"View", [#create_menu{id=?REFRESH, text="Refresh\tCtrl-R"}]}], diff --git a/lib/observer/src/observer_sys_wx.erl b/lib/observer/src/observer_sys_wx.erl index f00a666a35..31800cf12a 100644 --- a/lib/observer/src/observer_sys_wx.erl +++ b/lib/observer/src/observer_sys_wx.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2012. All Rights Reserved. +%% Copyright Ericsson AB 2011-2013. 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 @@ -37,6 +37,7 @@ parent_notebook, panel, sizer, menubar, + alloc, fields, timer}). @@ -47,22 +48,28 @@ start_link(Notebook, Parent) -> init([Notebook, Parent]) -> SysInfo = observer_backend:sys_info(), + AllocInfo = proplists:get_value(alloc_info, SysInfo, []), {Info, Stat} = info_fields(), Panel = wxPanel:new(Notebook), - Sizer = wxBoxSizer:new(?wxHORIZONTAL), + Sizer = wxBoxSizer:new(?wxVERTICAL), + TopSizer = wxBoxSizer:new(?wxHORIZONTAL), {FPanel0, _FSizer0, Fields0} = observer_lib:display_info(Panel, observer_lib:fill_info(Info, SysInfo)), {FPanel1, _FSizer1, Fields1} = observer_lib:display_info(Panel, observer_lib:fill_info(Stat, SysInfo)), - wxSizer:add(Sizer, FPanel0, [{flag, ?wxEXPAND bor ?wxTOP bor ?wxBOTTOM bor ?wxLEFT}, - {proportion, 1}, {border, 5}]), - wxSizer:add(Sizer, FPanel1, [{flag, ?wxEXPAND bor ?wxTOP bor ?wxBOTTOM bor ?wxRIGHT}, - {proportion, 1}, {border, 5}]), + wxSizer:add(TopSizer, FPanel0, [{flag, ?wxEXPAND}, {proportion, 1}]), + wxSizer:add(TopSizer, FPanel1, [{flag, ?wxEXPAND}, {proportion, 1}]), + BorderFlags = ?wxLEFT bor ?wxRIGHT, + MemoryInfo = create_mem_info(Panel, AllocInfo), + wxSizer:add(Sizer, TopSizer, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP}, + {proportion, 0}, {border, 5}]), + wxSizer:add(Sizer, MemoryInfo, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM}, + {proportion, 1}, {border, 5}]), wxPanel:setSizer(Panel, Sizer), Timer = observer_lib:start_timer(10), {Panel, #sys_wx_state{parent=Parent, parent_notebook=Notebook, - panel=Panel, sizer=Sizer, + panel=Panel, sizer=Sizer, alloc=MemoryInfo, timer=Timer, fields=Fields0 ++ Fields1}}. create_sys_menu(Parent) -> @@ -70,13 +77,84 @@ create_sys_menu(Parent) -> #create_menu{id = ?ID_REFRESH_INTERVAL, text = "Refresh interval"}]}, observer_wx:create_menus(Parent, [View]). -update_syspage(#sys_wx_state{node = Node, fields=Fields, sizer=Sizer}) -> +update_syspage(#sys_wx_state{node = Node, fields=Fields, sizer=Sizer, alloc=AllocCtrl}) -> SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []), + AllocInfo = proplists:get_value(alloc_info, SysInfo, []), {Info, Stat} = info_fields(), observer_lib:update_info(Fields, observer_lib:fill_info(Info, SysInfo) ++ observer_lib:fill_info(Stat, SysInfo)), + update_alloc(AllocCtrl, AllocInfo), wxSizer:layout(Sizer). +create_mem_info(Panel, Fields) -> + Style = ?wxLC_REPORT bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES bor ?wxLC_VRULES, + Grid = wxListCtrl:new(Panel, [{style, Style}]), + Li = wxListItem:new(), + AddListEntry = fun({Name, Align, DefSize}, Col) -> + wxListItem:setText(Li, Name), + wxListItem:setAlign(Li, Align), + wxListCtrl:insertColumn(Grid, Col, Li), + wxListCtrl:setColumnWidth(Grid, Col, DefSize), + Col + 1 + end, + ListItems = [{"Allocator Type", ?wxLIST_FORMAT_LEFT, 200}, + {"Block size (kB)", ?wxLIST_FORMAT_RIGHT, 150}, + {"Carrier size (kB)",?wxLIST_FORMAT_RIGHT, 150}], + lists:foldl(AddListEntry, 0, ListItems), + wxListItem:destroy(Li), + update_alloc(Grid, Fields), + Grid. + +update_alloc(Grid, AllocInfo) -> + Fields = alloc_info(AllocInfo, [], 0, 0, true), + wxListCtrl:deleteAllItems(Grid), + Update = fun({Name, BS, CS}, Row) -> + wxListCtrl:insertItem(Grid, Row, ""), + wxListCtrl:setItem(Grid, Row, 0, observer_lib:to_str(Name)), + wxListCtrl:setItem(Grid, Row, 1, observer_lib:to_str(BS div 1024)), + wxListCtrl:setItem(Grid, Row, 2, observer_lib:to_str(CS div 1024)), + Row + 1 + end, + lists:foldl(Update, 0, Fields), + Fields. + +alloc_info([{Type,Instances}|Allocators],TypeAcc,TotalBS,TotalCS,IncludeTotal) -> + {BS,CS,NewTotalBS,NewTotalCS,NewIncludeTotal} = + sum_alloc_instances(Instances,0,0,TotalBS,TotalCS), + alloc_info(Allocators,[{Type,BS,CS}|TypeAcc],NewTotalBS,NewTotalCS, + IncludeTotal andalso NewIncludeTotal); +alloc_info([],TypeAcc,TotalBS,TotalCS,IncludeTotal) -> + Types = [X || X={_,BS,CS} <- TypeAcc, (BS>0 orelse CS>0)], + case IncludeTotal of + true -> + [{total,TotalBS,TotalCS} | lists:reverse(Types)]; + false -> + lists:reverse(Types) + end. + +sum_alloc_instances(false,BS,CS,TotalBS,TotalCS) -> + {BS,CS,TotalBS,TotalCS,false}; +sum_alloc_instances([{_,_,Data}|Instances],BS,CS,TotalBS,TotalCS) -> + {NewBS,NewCS,NewTotalBS,NewTotalCS} = + sum_alloc_one_instance(Data,BS,CS,TotalBS,TotalCS), + sum_alloc_instances(Instances,NewBS,NewCS,NewTotalBS,NewTotalCS); +sum_alloc_instances([],BS,CS,TotalBS,TotalCS) -> + {BS,CS,TotalBS,TotalCS,true}. + +sum_alloc_one_instance([{sbmbcs,[{blocks_size,BS,_,_},{carriers_size,CS,_,_}]}| + Rest],OldBS,OldCS,TotalBS,TotalCS) -> + sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS,TotalCS); +sum_alloc_one_instance([{_,[{blocks_size,BS,_,_},{carriers_size,CS,_,_}]}| + Rest],OldBS,OldCS,TotalBS,TotalCS) -> + sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS+BS,TotalCS+CS); +sum_alloc_one_instance([{_,[{blocks_size,BS},{carriers_size,CS}]}| + Rest],OldBS,OldCS,TotalBS,TotalCS) -> + sum_alloc_one_instance(Rest,OldBS+BS,OldCS+CS,TotalBS+BS,TotalCS+CS); +sum_alloc_one_instance([_|Rest],BS,CS,TotalBS,TotalCS) -> + sum_alloc_one_instance(Rest,BS,CS,TotalBS,TotalCS); +sum_alloc_one_instance([],BS,CS,TotalBS,TotalCS) -> + {BS,CS,TotalBS,TotalCS}. + info_fields() -> Info = [{"System and Architecture", [{"System Version", otp_release}, diff --git a/lib/odbc/configure.in b/lib/odbc/configure.in index fd28830c0c..83f7a47434 100644 --- a/lib/odbc/configure.in +++ b/lib/odbc/configure.in @@ -167,7 +167,8 @@ AC_SUBST(TARGET_FLAGS) AC_CHECK_SIZEOF(void *) AC_MSG_CHECKING([for odbc in standard locations]) for rdir in /usr/local/odbc /usr/local /usr/odbc \ - /usr /opt/local/pgm/odbc /usr/local/pgm/odbc; do + /usr /opt/local/pgm/odbc /usr/local/pgm/odbc \ + "$with_odbc"; do test -f "$erl_xcomp_isysroot$rdir/include/sql.h" || continue is_odbc_std_location=yes libdir="$erl_xcomp_sysroot$rdir/lib" diff --git a/lib/reltool/doc/src/reltool_examples.xml b/lib/reltool/doc/src/reltool_examples.xml index 19a3f37819..de243343ff 100644 --- a/lib/reltool/doc/src/reltool_examples.xml +++ b/lib/reltool/doc/src/reltool_examples.xml @@ -261,7 +261,8 @@ Eshell V5.7.3 (abort with ^G) 8> reltool:get_script(Server, "NAME"). {ok,{script,{"NAME","VSN"}, [{preLoaded,[erl_prim_loader,erlang,init,otp_ring0, - prim_file,prim_inet,prim_zip,zlib]}, + prim_eval,prim_file,prim_inet,prim_zip, + zlib]}, {progress,preloaded}, {path,["$ROOT/lib/kernel-2.13/ebin", "$ROOT/lib/stdlib-1.16/ebin"]}, diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index d1d291d5cb..670e216d97 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -49,6 +49,10 @@ vsn() -> %% observer backend %% sys_info() -> + MemInfo = try erlang:memory() of + Mem -> Mem + catch _:_ -> [] + end, {{_,Input},{_,Output}} = erlang:statistics(io), [{process_count, erlang:system_info(process_count)}, {process_limit, erlang:system_info(process_limit)}, @@ -68,9 +72,16 @@ sys_info() -> {threads, erlang:system_info(threads)}, {thread_pool_size, erlang:system_info(thread_pool_size)}, {wordsize_internal, erlang:system_info({wordsize, internal})}, - {wordsize_external, erlang:system_info({wordsize, external})} | - erlang:memory() - ]. + {wordsize_external, erlang:system_info({wordsize, external})}, + {alloc_info, alloc_info()} + | MemInfo]. + +alloc_info() -> + {_,_,AllocTypes,_} = erlang:system_info(allocator), + try erlang:system_info({allocator_sizes,AllocTypes}) of + Allocators -> Allocators + catch _:_ -> [] + end. get_table(Parent, Table, Module) -> spawn(fun() -> @@ -274,7 +285,7 @@ etop_collect([P|Ps], Acc) -> [{registered_name,Reg},{initial_call,Initial},{memory,Mem}, {reductions,Reds},{current_function,Current},{message_queue_len,Qlen}] -> Name = case Reg of - [] -> Initial; + [] -> initial_call(Initial, P); _ -> Reg end, Info = #etop_proc_info{pid=P,mem=Mem,reds=Reds,name=Name, @@ -283,6 +294,11 @@ etop_collect([P|Ps], Acc) -> end; etop_collect([], Acc) -> Acc. +initial_call({proc_lib, init_p, _}, Pid) -> + proc_lib:translate_initial_call(Pid); +initial_call(Initial, _Pid) -> + Initial. + %% %% ttb backend %% diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 193dbb64bf..b2e95fdbee 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -1461,8 +1461,8 @@ mandatory_modules() -> preloaded() -> %% Sorted - [erl_prim_loader,erlang,erts_internal,init,otp_ring0,prim_file,prim_inet, - prim_zip,zlib]. + [erl_prim_loader,erlang,erts_internal,init,otp_ring0,prim_eval,prim_file, + prim_inet,prim_zip,zlib]. %%______________________________________________________________________ %% Kernel processes; processes that are specially treated by the init diff --git a/lib/snmp/.gitignore b/lib/snmp/.gitignore index b82d23e7bd..650c1d6865 100644 --- a/lib/snmp/.gitignore +++ b/lib/snmp/.gitignore @@ -1,4 +1,9 @@ # Match at any level. *.BKP +*.orig +*.rej + +doc/index.html + diff --git a/lib/snmp/doc/src/files.mk b/lib/snmp/doc/src/files.mk index 61c91c9729..494c550fff 100644 --- a/lib/snmp/doc/src/files.mk +++ b/lib/snmp/doc/src/files.mk @@ -41,6 +41,8 @@ XML_AGENT_REF3_FILES = \ snmpa_error_io.xml \ snmpa_error_logger.xml \ snmpa_local_db.xml \ + snmpa_mib_data.xml \ + snmpa_mib_storage.xml \ snmpa_mpd.xml \ snmpa_network_interface.xml \ snmpa_network_interface_filter.xml \ diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 5222922848..80de9738f1 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -34,6 +34,88 @@ <section> + <title>SNMP Development Toolkit 4.24</title> + <p>Version 4.24 supports code replacement in runtime from/to + version 4.23.1 and 4.23. </p> + + <section> + <title>Improvements and new features</title> +<!-- + <p>-</p> +--> + + <list type="bulleted"> + <item> + <p>[agent,manager] Updated to support the new crypto interface. </p> + <p>Own Id: OTP-11009</p> + </item> + + <item> + <p>[agent] Introduced a documented behaviour for the mib-server + <seealso marker="snmpa_mib_data">mib-data backend</seealso>. + At present only the default module (<c>snmpa_mib_data_tttn</c>) is + provided. </p> + <p>A config option for the (agent) + <seealso marker="snmp_config#agent_mib_server">mib-servers</seealso> + mib-data backend module has been added to the agent config options, + <seealso marker="snmp_config#agent_ms_data_module">data_module</seealso>. </p> + <p>Own Id: OTP-11101</p> + </item> + + <item> + <p>[agent] Introduced a documented behaviour for the + <seealso marker="snmpa_mib_storage">mib storage</seealso>. + At present there are three simple modules + (<c>snmpa_mib_storage_ets</c>, <c>snmpa_mib_storage_dets</c> and + <c>snmpa_mib_storage_mnesia</c>) implement�ng this behaviour, + provided with the app. </p> + <p>A config option for the (agent) + <seealso marker="snmp_config#agent_mib_storage">mib storage</seealso> + has been added to the agent config options. </p> + <p>Own Id: OTP-11107</p> + </item> + + </list> + + </section> + + <section> + <title>Fixed Bugs and Malfunctions</title> + <p>-</p> + +<!-- + <list type="bulleted"> + <item> + <p>[agent,manager] Updated to support the new crypto interface. </p> + <p>Own Id: OTP-11009</p> + </item> + + </list> +--> + + </section> + + <section> + <title>Incompatibilities</title> + <p>-</p> + +<!-- + <list type="bulleted"> + <item> + <p>[manager] The old Addr-and-Port based API functions, previously + long deprecated and marked for deletion in R16B, has now been + removed. </p> + <p>Own Id: OTP-10027</p> + </item> + + </list> +--> + </section> + + </section> <!-- 4.24 --> + + + <section> <title>SNMP Development Toolkit 4.23.1</title> <p>Version 4.23.1 supports code replacement in runtime from/to version 4.23. </p> @@ -1017,135 +1099,6 @@ </section> <!-- 4.20 --> - <section> - <title>SNMP Development Toolkit 4.19</title> - <p>Version 4.19 supports code replacement in runtime from/to - version 4.18.</p> - - <section> - <title>Improvements and new features</title> -<!-- - <p>-</p> ---> - <list type="bulleted"> - <item> - <p>[compiler] Added support for textual convention - <c>AGENT-CAPABILITIES</c> and "full" support for textual - convention MODULE-COMPLIANCE, both defined by the SNMPv2-CONF - mib.</p> - <p>The <c>reference</c> and <c>modules</c> part(s) are - stored in the <c>assocList</c> of the mib-entry (<c>me</c>) - record. - Only handled <em>if</em> the option(s) <c>agent_capabilities</c> - and <c>module_compliance</c> (respectively) are provided to the - compiler. </p> - <p>See <seealso marker="snmpc#compile">compile/2</seealso> - for more info. </p> - <p>For backward compatibillity, the MIBs provided with - this application are <em>not</em> compiled with these - options. </p> - <p>Own Id: OTP-8966</p> - </item> - - <item> - <p>[agent] Added a "complete" set of (snmp) table and variable - print functions, for each mib handled by the SNMP (agent) - application. This will be usefull when debugging a running agent.</p> - <p>See - <seealso marker="snmpa#print_mib_info">print_mib_info/0</seealso>, - <seealso marker="snmpa#print_mib_tables">print_mib_tables/0</seealso> - and - <seealso marker="snmpa#print_mib_variables">print_mib_variables/0</seealso> - for more info. </p> - <p>Own Id: OTP-8977</p> - </item> - - <item> - <p>[compiler] Added a MIB compiler (frontend) escript, - <c>snmpc</c>. </p> - <p>Own Id: OTP-9004</p> - </item> - - </list> - </section> - - <section> - <title>Fixed Bugs and Malfunctions</title> -<!-- - <p>-</p> ---> - <list type="bulleted"> - <item> - <p>[agent] For the table vacmAccessTable, - when performing the is_set_ok and set operation(s), - all values of the vacmAccessSecurityModel column was - incorrectly translated to <c>any</c>. </p> -<!-- -that is when calling: -snmp_view_basec_acm_mib:vacmAccessTable(set, RowIndex, Cols). ---> - <p>Own Id: OTP-8980</p> - </item> - - <item> - <p>[agent] When calling - <seealso marker="snmp_view_based_acm_mib#reconfigure">snmp_view_based_acm_mib:reconfigure/1</seealso> - on a running node, the table <c>vacmAccessTable</c> was not properly - cleaned. - This meant that if some entries in the vacm.conf file was removed - (compared to the <c>current</c> config), - while others where modified and/or added, the removed entrie(s) - would still exist in the <c>vacmAccessTable</c> table. </p> - <p>Own Id: OTP-8981</p> - <p>Aux Id: Seq 11750</p> - </item> - - </list> - </section> - - - <section> - <title>Incompatibilities</title> - <p>-</p> - </section> - - </section> <!-- 4.19 --> - - - <section> - <title>SNMP Development Toolkit 4.18</title> - <p>Version 4.18 supports code replacement in runtime from/to - version 4.17.1 and 4.17.</p> - - <section> - <title>Improvements and new features</title> - <list type="bulleted"> - <item> - <p>Prepared for R14B release.</p> - </item> - </list> - </section> - - <section><title>Fixed Bugs and Malfunctions</title> - <p>-</p> -<!-- - <list type="bulleted"> - <item> - <p>[agent] When the function FilterMod:accept_recv/2 returned false - the SNMP agent stopped collecting messages from UDP.</p> - <p>Own Id: OTP-8761</p> - </item> - </list> ---> - </section> - - <section> - <title>Incompatibilities</title> - <p>-</p> - </section> - </section> <!-- 4.18 --> - - <!-- section> <title>Release notes history</title> <p>For information about older versions see diff --git a/lib/snmp/doc/src/ref_man.xml b/lib/snmp/doc/src/ref_man.xml index 92e8927f6d..628b30b11a 100644 --- a/lib/snmp/doc/src/ref_man.xml +++ b/lib/snmp/doc/src/ref_man.xml @@ -44,6 +44,8 @@ <xi:include href="snmpa_error_io.xml"/> <xi:include href="snmpa_error_logger.xml"/> <xi:include href="snmpa_local_db.xml"/> + <xi:include href="snmpa_mib_data.xml"/> + <xi:include href="snmpa_mib_storage.xml"/> <xi:include href="snmpa_mpd.xml"/> <xi:include href="snmpa_network_interface.xml"/> <xi:include href="snmpa_network_interface_filter.xml"/> diff --git a/lib/snmp/doc/src/snmp_app.xml b/lib/snmp/doc/src/snmp_app.xml index 62dfa515d1..e5a05342c1 100644 --- a/lib/snmp/doc/src/snmp_app.xml +++ b/lib/snmp/doc/src/snmp_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>1997</year><year>2012</year> + <year>1997</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -311,36 +311,125 @@ <p>Default is <c>[]</c>.</p> </item> - <marker id="agent_mib_storage"></marker> - <tag><c><![CDATA[mib_storage() = ets | {ets, Dir} | {ets, Dir, Action} | dets | {dets, Dir} | {dets, Dir, Action} | mnesia | {mnesia, Nodes} | {mnesia, Nodes, Action} <optional>]]></c></tag> - <item> - <p>Specifies how info retrieved from the mibs will be stored.</p> - <p>If <c>mib_storage</c> is <c>{ets, Dir}</c>, the table will also be - stored on file. If <c>Dir</c> is <c>default</c>, then <c>db_dir</c> - will be used.</p> - <p>If <c>mib_storage</c> is <c>dets</c> or if <c>Dir</c> is - <c>default</c>, then <c>db_dir</c> will be used for <c>Dir</c>.</p> - <p>If <c>mib_storage</c> is <c>mnesia</c> then <c>erlang:nodes()</c> - will be used for <c>Nodes</c>.</p> - <p>Default is <c>ets</c>. </p> - <p><c>Dir = default | string()</c>. Dir is the directory where the - files will be stored. If <c>default</c>, then <c>db_dir</c> will be - used.</p> - <p><c>Nodes = visible | connected | [node()]</c>. - <c>Nodes = visible</c> is translated to - <c>erlang:nodes(visible)</c>. - <c>Nodes = connected</c> is translated to - <c>erlang:nodes(connected)</c>. - If <c>Nodes = []</c> then the own node is assumed.</p> - <p><c>Action = clear | keep</c>. Default is <c>keep</c>. - <c>Action</c> is used to specify what shall be done if the - mnesia/dets table already exist.</p> + <marker id="agent_mib_storage"></marker> + <tag><c><![CDATA[mib_storage() = [mib_storage_opt()] <optional>]]></c></tag> + <item> + <p><c>mib_storage_opt() = {module, mib_storage_module()} | {options, mib_storage_options()}</c></p> + <p>This option specifies how basic mib data is stored. + This option is used by two parts of the snmp agent: + The mib-server and the symbolic-store. </p> + <p>Default is <c>[{module, snmpa_mib_storage_ets}]</c>. </p> + </item> + + <marker id="agent_mst_module"></marker> + <tag><c><![CDATA[mib_storage_module() = snmpa_mib_data_ets | snmpa_mib_data_dets | snmpa_mib_data_mnesia | module()]]></c></tag> + <item> + <p>Defines the mib storage module of the SNMP agent as defined by the + <seealso marker="snmpa_mib_storage">snmpa_mib_storage</seealso> + behaviour. </p> + <p>Several entities (<c>mib-server</c> via the its data module and + the <c>symbolic-store</c>) of the snmp agent uses this for storage + of miscelaneous mib related data retrieved while loading a mib. </p> + <p>There are several implementations provided with the agent: + <c>snmpa_mib_storage_ets</c>, <c>snmpa_mib_storage_dets</c> and + <c>snmpa_mib_storage_mnesia</c>. </p> + <p>Default module is <c>snmpa_mib_storage_ets</c>. </p> + </item> + + <marker id="agent_mst_options"></marker> + <tag><c><![CDATA[mib_storage_options() = list() <optional>]]></c></tag> + <item> + <p>This is implementattion depended. That is, it depends on the + module. For each module a specific set of options are valid. + For the module provided with the app, these options are supported: </p> + <list type="bulleted"> + <item> + <p><c>snmpa_mib_storage_ets</c>: <c>{dir, filename()} | {action, keep | clear}, {checksum, boolean()}</c></p> + <list> + <item> + <p><c>dir</c> - If present, points to a directory where a file + to which all data in the ets table is "synced". </p> + <p>Also, when a table is opened this file is read, + if it exists. </p> + <p>By default, this will <em>not</em> be used. </p> + </item> + <item> + <p><c>action</c> - Specifies the behaviour when a non-empty + file is found: Keep its content or clear it out. </p> + <p>Default is <c>keep</c>. </p> + </item> + <item> + <p><c>checksum</c> - Defines if the file is checksummed + or not. </p> + <p>Default is <c>false</c>. </p> + </item> + </list> + </item> + <item> + <p><c>snmpa_mib_storage_dets</c>: <c>{dir, filename()} | {action, keep | clear}, {auto_save, default | pos_integer()} | {repair, force | boolean()}</c></p> + <list> + <item> + <p><c>dir</c> - This <em>mandatory</em> option points to a + directory where to place the file of a dets table. </p> + </item> + <item> + <p><c>action</c> - Specifies the behaviour when a non-empty + file is found: Keep its content or clear it out. </p> + <p>Default is <c>keep</c>. </p> + </item> + <item> + <p><c>auto_save</c> - Defines the dets auto-save frequency. </p> + <p>Default is <c>default</c>. </p> + </item> + <item> + <p><c>repair</c> - Defines the dets repair behaviour. </p> + <p>Default is <c>false</c>. </p> + </item> + </list> + </item> + <item> + <p><c>snmpa_mib_storage_mnesia</c>: <c>{action, keep | clear}, {nodes, [node()]}</c></p> + <list> + <item> + <p><c>action</c> - Specifies the behaviour when a non-empty, + already existing, table: Keep its content or clear it out. </p> + <p>Default is <c>keep</c>. </p> + </item> + <item> + <p><c>nodes</c> - A list of node names (or an atom + describing a list of nodes) defining where to open the table. + Its up to the user to ensure that mnesia is actually running + on the specified nodes. </p> + <p>The following distinct values are recognised: </p> + <list> + <item> + <p><c>[]</c> - Translated into a list of the own node: <c>[node()]</c></p> + </item> + <item> + <p><c>all</c> - <c>erlang:nodes()</c></p> + </item> + <item> + <p><c>visible</c> - <c>erlang:nodes(visible)</c></p> + </item> + <item> + <p><c>connected</c> - <c>erlang:nodes(connected)</c></p> + </item> + <item> + <p><c>db_nodes</c> - <c>mnesia:system_info(db_nodes)</c></p> + </item> + </list> + + <p>Default is the result of the call: <c>erlang:nodes()</c>. </p> + </item> + </list> + </item> + </list> </item> <marker id="agent_mib_server"></marker> <tag><c><![CDATA[mib_server() = [mib_server_opt()] <optional>]]></c></tag> <item> - <p><c>mib_server_opt() = {mibentry_override, mibentry_override()} | {trapentry_override, trapentry_override()} | {verbosity, verbosity()} | {cache, mibs_cache()}</c></p> + <p><c>mib_server_opt() = {mibentry_override, mibentry_override()} | {trapentry_override, trapentry_override()} | {verbosity, verbosity()} | {cache, mibs_cache()} | {data_module, mib_server_data_module()}</c></p> <p>Defines options specific for the SNMP agent mib server. </p> <p>For defaults see the options in <c>mib_server_opt()</c>.</p> </item> @@ -365,7 +454,28 @@ <p>Default is <c>false</c>.</p> </item> - <marker id="agent_ms_cache"></marker> + <marker id="agent_ms_data_module"></marker> +<!-- + <tag><c><![CDATA[mib_server_data_module() = snmpa_mib_data_tttn | snmpa_mib_data_ttln | module() <optional>]]></c></tag> +--> + <tag><c><![CDATA[mib_server_data_module() = snmpa_mib_data_tttn | module() <optional>]]></c></tag> + <item> + <p>Defines the backend data module of the SNMP agent mib-server as + defined by the + <seealso marker="snmpa_mib_data">snmpa_mib_data</seealso> + behaviour. </p> + <p>At present only the default module is provided with the agent, + <c>snmpa_mib_data_tttn</c>. </p> +<!-- + <p>Two modules is provided with the agent + <c>snmpa_mib_data_tttn</c> (this is the old implementation) and + <c>snmpa_mib_data_ttln</c> (for a mib tree with many holes, + this algorithm can be more price efficient). </p> +--> + <p>Default module is <c>snmpa_mib_data_tttn</c>. </p> + </item> + + <marker id="agent_ms_cache"></marker> <tag><c><![CDATA[mibs_cache() = bool() | mibs_cache_opts() <optional>]]></c></tag> <item> <p>Shall the agent utilize the mib server lookup cache or not.</p> @@ -385,30 +495,30 @@ <tag><c><![CDATA[mibs_cache_autogc() = bool() <optional>]]></c></tag> <item> <p>Defines if the mib server shall perform cache gc automatically or - leave it to the user (see - <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p> + leave it to the user (see + <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p> <p>Default is <c>true</c>.</p> </item> <marker id="agent_ms_cache_age"></marker> <tag><c><![CDATA[mibs_cache_age() = integer() > 0 <optional>]]></c></tag> <item> - <p>Defines how old the entries in the cache will be allowed before - they are GC'ed (assuming GC is performed). Each entry in the - cache is "touched" whenever it is accessed. </p> - <p>The age is defined in milliseconds. </p> - <p>Default is <c>10 timutes</c>.</p> + <p>Defines how old the entries in the cache will be allowed + to become before they are GC'ed (assuming GC is performed). + Each entry in the cache is "touched" whenever it is accessed. </p> + <p>The age is defined in milliseconds. </p> + <p>Default is <c>10 timutes</c>.</p> </item> <marker id="agent_ms_cache_gclimit"></marker> <tag><c><![CDATA[mibs_cache_gclimit() = integer() > 0 | infinity <optional>]]></c></tag> <item> <p>When performing a GC, this is the max number of cache entries - that will be deleted from the cache. </p> + that will be deleted from the cache. </p> <p>The reason for having this limit is that if the cache is - large, the GC can potentially take a long time, during which - the agent is locked. </p> - <p>Default is <c>100</c>.</p> + large, the GC can potentially take a long time, during which + the agent is locked. </p> + <p>Default is <c>100</c>.</p> </item> <marker id="agent_error_report_mod"></marker> diff --git a/lib/snmp/doc/src/snmp_config.xml b/lib/snmp/doc/src/snmp_config.xml index eec53162a1..61ee7f00ee 100644 --- a/lib/snmp/doc/src/snmp_config.xml +++ b/lib/snmp/doc/src/snmp_config.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2012</year> + <year>1997</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -308,6 +308,126 @@ <p>Default is <c>[]</c>.</p> </item> + <marker id="agent_mib_storage"></marker> + <tag><c><![CDATA[mib_storage() = [mib_storage_opt()] <optional>]]></c></tag> + <item> + <p><c>mib_storage_opt() = {module, mib_storage_module()} | {options, mib_storage_options()}</c></p> + <p>This option specifies how basic mib data is stored. + This option is used by two parts of the snmp agent: + The mib-server and the symbolic-store. </p> + <p>Default is <c>[{module, snmpa_mib_storage_ets}]</c>. </p> + </item> + + <marker id="agent_mst_module"></marker> + <tag><c><![CDATA[mib_storage_module() = snmpa_mib_data_ets | snmpa_mib_data_dets | snmpa_mib_data_mnesia | module()]]></c></tag> + <item> + <p>Defines the mib storage module of the SNMP agent as defined by the + <seealso marker="snmpa_mib_storage">snmpa_mib_storage</seealso> + behaviour. </p> + <p>Several entities (<c>mib-server</c> via the its data module and + the <c>symbolic-store</c>) of the snmp agent uses this for storage + of miscelaneous mib related data dataretrieved while loading a mib. </p> + <p>There are several implementations provided with the agent: + <c>snmpa_mib_storage_ets</c>, <c>snmpa_mib_storage_dets</c> and + <c>snmpa_mib_storage_mnesia</c>. </p> + <p>Default module is <c>snmpa_mib_storage_ets</c>. </p> + </item> + + <marker id="agent_mst_options"></marker> + <tag><c><![CDATA[mib_storage_options() = list() <optional>]]></c></tag> + <item> + <p>This is implementattion depended. That is, it depends on the + module. For each module a specific set of options are valid. + For the module provided with the app, these options are supported: </p> + <list type="bulleted"> + <item> + <p><c>snmpa_mib_storage_ets</c>: <c>{dir, filename()} | {action, keep | clear}, {checksum, boolean()}</c></p> + <list> + <item> + <p><c>dir</c> - If present, points to a directory where a file + to which all data in the ets table is "synced". </p> + <p>Also, when a table is opened this file is read, + if it exists. </p> + <p>By default, this will <em>not</em> be used. </p> + </item> + <item> + <p><c>action</c> - Specifies the behaviour when a non-empty + file is found: Keep its content or clear it out. </p> + <p>Default is <c>keep</c>. </p> + </item> + <item> + <p><c>checksum</c> - Defines if the file is checksummed + or not. </p> + <p>Default is <c>false</c>. </p> + </item> + </list> + </item> + <item> + <p><c>snmpa_mib_storage_dets</c>: <c>{dir, filename()} | {action, keep | clear}, {auto_save, default | pos_integer()} | {repair, force | boolean()}</c></p> + <list> + <item> + <p><c>dir</c> - This <em>mandatory</em> option points to a + directory where to place the file of a dets table. </p> + </item> + <item> + <p><c>action</c> - Specifies the behaviour when a non-empty + file is found: Keep its content or clear it out. </p> + <p>Default is <c>keep</c>. </p> + </item> + <item> + <p><c>auto_save</c> - Defines the dets auto-save frequency. </p> + <p>Default is <c>default</c>. </p> + </item> + <item> + <p><c>repair</c> - Defines the dets repair behaviour. </p> + <p>Default is <c>false</c>. </p> + </item> + </list> + </item> + <item> + <p><c>snmpa_mib_storage_mnesia</c>: <c>{action, keep | clear}, {nodes, [node()]}</c></p> + <list> + <item> + <p><c>action</c> - Specifies the behaviour when a non-empty, + already existing, table: Keep its content or clear it out. </p> + <p>Default is <c>keep</c>. </p> + </item> + <item> + <p><c>nodes</c> - A list of node names (or an atom + describing a list of nodes) defining where to open the table. + Its up to the user to ensure that mnesia is actually running + on the specified nodes. </p> + <p>The following distinct values are recognised: </p> + <list> + <item> + <p><c>[]</c> - Translated into a list of the own node: <c>[node()]</c></p> + </item> + <item> + <p><c>all</c> - <c>erlang:nodes()</c></p> + </item> + <item> + <p><c>visible</c> - <c>erlang:nodes(visible)</c></p> + </item> + <item> + <p><c>connected</c> - <c>erlang:nodes(connected)</c></p> + </item> + <item> + <p><c>db_nodes</c> - <c>mnesia:system_info(db_nodes)</c></p> + </item> + </list> + + <p>Default is the result of the call: <c>erlang:nodes()</c>. </p> + </item> + </list> + </item> + </list> + </item> + +<!-- + +This is the old format which is "supported", but not documented, +in so far as it will be converted to the new format if found. + <marker id="agent_mib_storage"></marker> <tag><c><![CDATA[mib_storage() = ets | {ets, Dir} | {ets, Dir, Action} | dets | {dets, Dir} | {dets, Dir, Action} | mnesia | {mnesia, Nodes} | {mnesia, Nodes, Action} <optional>]]></c></tag> <item> @@ -333,11 +453,12 @@ <c>Action</c> is used to specify what shall be done if the mnesia/dets table already exist.</p> </item> +--> <marker id="agent_mib_server"></marker> <tag><c><![CDATA[mib_server() = [mib_server_opt()] <optional>]]></c></tag> <item> - <p><c>mib_server_opt() = {mibentry_override, mibentry_override()} | {trapentry_override, trapentry_override()} | {verbosity, verbosity()} | {cache, mibs_cache()}</c></p> + <p><c>mib_server_opt() = {mibentry_override, mibentry_override()} | {trapentry_override, trapentry_override()} | {verbosity, verbosity()} | {cache, mibs_cache()} | {data_module, mib_server_data_module()}</c></p> <p>Defines options specific for the SNMP agent mib server. </p> <p>For defaults see the options in <c>mib_server_opt()</c>.</p> </item> @@ -362,6 +483,27 @@ <p>Default is <c>false</c>.</p> </item> + <marker id="agent_ms_data_module"></marker> +<!-- + <tag><c><![CDATA[mib_server_data_module() = snmpa_mib_data_tttn | snmpa_mib_data_ttln | module() <optional>]]></c></tag> +--> + <tag><c><![CDATA[mib_server_data_module() = snmpa_mib_data_tttn | module() <optional>]]></c></tag> + <item> + <p>Defines the backend data module of the SNMP agent mib-server as + defined by the + <seealso marker="snmpa_mib_data">snmpa_mib_data</seealso> + behaviour. </p> + <p>At present only the default module is provided with the agent, + <c>snmpa_mib_data_tttn</c>. </p> +<!-- + <p>Two modules is provided with the agent + <c>snmpa_mib_data_tttn</c> (this is the old implementation) and + <c>snmpa_mib_data_ttln</c> (for a mib tree with many holes, + this algorithm can be more price efficient). </p> +--> + <p>Default module is <c>snmpa_mib_data_tttn</c>. </p> + </item> + <marker id="agent_ms_cache"></marker> <tag><c><![CDATA[mibs_cache() = bool() | mibs_cache_opts() <optional>]]></c></tag> <item> @@ -382,18 +524,18 @@ <tag><c><![CDATA[mibs_cache_autogc() = bool() <optional>]]></c></tag> <item> <p>Defines if the mib server shall perform cache gc automatically or - leave it to the user (see - <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p> - <p>Default is <c>true</c>.</p> + leave it to the user (see + <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p> + <p>Default is <c>true</c>.</p> </item> <marker id="agent_ms_cache_age"></marker> <tag><c><![CDATA[mibs_cache_age() = integer() > 0 <optional>]]></c></tag> <item> - <p>Defines how old the entries in the cache will be allowed before - they are GC'ed (assuming GC is performed). Each entry in the - cache is "touched" whenever it is accessed. </p> - <p>The age is defined in milliseconds. </p> + <p>Defines how old the entries in the cache will be allowed + to become before they are GC'ed (assuming GC is performed). + Each entry in the cache is "touched" whenever it is accessed. </p> + <p>The age is defined in milliseconds. </p> <p>Default is <c>10 timutes</c>.</p> </item> @@ -401,11 +543,11 @@ <tag><c><![CDATA[mibs_cache_gclimit() = integer() > 0 | infinity <optional>]]></c></tag> <item> <p>When performing a GC, this is the max number of cache entries - that will be deleted from the cache. </p> - <p>The reason for having this limit is that if the cache is - large, the GC can potentially take a long time, during which - the agent is locked. </p> - <p>Default is <c>100</c>.</p> + that will be deleted from the cache. </p> + <p>The reason for having this limit is that if the cache is + large, the GC can potentially take a long time, during which + the agent is locked. </p> + <p>Default is <c>100</c>.</p> </item> <marker id="agent_error_report_mod"></marker> diff --git a/lib/snmp/doc/src/snmpa_mib_data.xml b/lib/snmp/doc/src/snmpa_mib_data.xml new file mode 100644 index 0000000000..ff07a03b98 --- /dev/null +++ b/lib/snmp/doc/src/snmpa_mib_data.xml @@ -0,0 +1,392 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2013</year><year>2013</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>snmpa_mib_data</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + <file>snmpa_mib_data.xml</file> + </header> + + <module>snmpa_mib_data</module> + <modulesummary>Behaviour module for the SNMP agent mib-server + data module.</modulesummary> + <description> + <p>This module defines the behaviour of the SNMP agent mib-server + data module. A <c>snmpa_mib_data</c> compliant module + must export the following functions: </p> + <list type="bulleted"> + <item> + <seealso marker="#new">new/1</seealso> + </item> + <item> + <seealso marker="#close">close/1</seealso> + </item> + <item> + <seealso marker="#sync">sync/1</seealso> + </item> + <item> + <seealso marker="#load_mib">load_mib/4</seealso> + </item> + <item> + <seealso marker="#unload_mib">unload_mib/4</seealso> + </item> + <item> + <seealso marker="#lookup">lookup/2</seealso> + </item> + <item> + <seealso marker="#next">next/3</seealso> + </item> + <item> + <seealso marker="#register_subagent">register_subagent/3</seealso> + </item> + <item> + <seealso marker="#unregister_subagent">unregister_subagent/2</seealso> + </item> + <item> + <seealso marker="#which_mib">which_mib/2</seealso> + </item> + <item> + <seealso marker="#which_mibs">which_mibs/1</seealso> + </item> + <item> + <seealso marker="#whereis_mib">whereis_mib/2</seealso> + </item> + <item> + <seealso marker="#dump">dump/2</seealso> + </item> + <item> + <seealso marker="#info">info/1</seealso> + </item> + <item> + <seealso marker="#backup">backup/2</seealso> + </item> + <item> + <seealso marker="#code_change">code_change/4</seealso> + </item> + </list> + + <p>The semantics of them and their exact signatures are + explained below. </p> + + <p>Note that the data extracted from the imported (loaded) + mibs are stored partly by the mib-server and partly by the + symbolic-store server. See the default mib-server data + module, <c>snmpa_mib_data_tttn</c> for details. </p> + + </description> + + <section> + <title>CALLBACK FUNCTIONS</title> + <p>The following functions must be exported from a + <c>mib-server</c> data callback module: </p> + + <marker id="new"></marker> + </section> + + <funcs> + <func> + <name>Module:new(Storage) -> State</name> + <fsummary>Create new (mib-server) data instance</fsummary> + <type> + <v>Storage = mib_storage()</v> + <v>State = term()</v> + </type> + <desc> + <p>Create a new mib-server data instance. </p> + + <marker id="close"></marker> + </desc> + </func> + + <func> + <name>Module:close(State) -> void()</name> + <fsummary>Close the mib-server data instance</fsummary> + <type> + <v>State = term()</v> + </type> + <desc> + <p>Close the mib-storage.</p> + + <marker id="sync"></marker> + </desc> + </func> + + <func> + <name>Module:sync(State) -> void()</name> + <fsummary>Synchronize to disc</fsummary> + <type> + <v>State = term()</v> + </type> + <desc> + <p>Synchronize (write to disc, if possible) the mib-server data. + This depends on the <c>mib_storage</c> option, and will only have + an effect if the mib-storage option has an actual disc component + (such as dets, or ets with a file). </p> + + <marker id="load_mib"></marker> + </desc> + </func> + + <func> + <name>Module:load_mib(State, Filename, MeOverride, TeOverride) -> {ok, NewState} | {error, Reason}</name> + <fsummary>Load a mib into the mib-server</fsummary> + <type> + <v>State = NewState = term()</v> + <v>Filename = filename()</v> + <v>MeOverride = boolean()</v> + <v>TeOverride = boolean()</v> + <v>Reason = already_loaded | term()</v> + </type> + <desc> + <p>Load the mib specified by the <c>Filename</c> argument + into the mib-server. + The <c>MeOverride</c> and <c>TeOverride</c> arguments + specifies how the mib-server shall handle duplicate mib- and trap- + entries. </p> + + <marker id="unload_mib"></marker> + </desc> + </func> + + <func> + <name>Module:unload_mib(State, Filename) -> {ok, NewState} | {error, Reason}</name> + <fsummary>Unload mib from the mib-server</fsummary> + <type> + <v>State = NewState = term()</v> + <v>Filename = filename()</v> + <v>Reason = not_loaded | term()</v> + </type> + <desc> + <p>Unload the mib specified by the <c>Filename</c> argument + from the mib-server. </p> + + <marker id="lookup"></marker> + </desc> + </func> + + <func> + <name>Module:lookup(State, Oid) -> Reply</name> + <fsummary>Find the mib-entry corresponding to the Oid</fsummary> + <type> + <v>State = term()</v> + <v>Reply = {variable, ME} | {table_column, ME, TEOid} | {subagent, SAPid, SAOid} | {false, Reason}</v> + <v>Oid = TEOid = SAOid = oid()</v> + <v>SAPid = pid()</v> + <v>ME = me()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Find the mib-entry corresponding to the <c>Oid</c>. + If it is a variable, the <c>Oid</c> must be + <Oid for var>.0 + and if it is a table, <c>Oid</c> must be + <table>.<entry>.<col>.<any>.</p> + + <marker id="next"></marker> + </desc> + </func> + + <func> + <name>Module:next(State, Oid, MibView) -> Reply</name> + <fsummary>Finds the lexicographically next oid</fsummary> + <type> + <v>State = term()</v> + <v>Reply = false | endOfTable | {subagent, SAPid, SAOid} | {variable, ME, VarOid} | {table, TableOid, TableRestOid, ME}</v> + <v>Oid = SAOid = VarOid = TableOid = TableRestOid = oid()</v> + <v>SAPid = pid()</v> + <v>ME = me()</v> + </type> + <desc> + <p>Finds the lexicographically next oid. </p> + + <marker id="register_subagent"></marker> + </desc> + </func> + + <func> + <name>Module:register_subagent(State, Oid, Pid) -> Reply</name> + <fsummary>Register the subagent</fsummary> + <type> + <v>State = NewState = term()</v> + <v>Reply = {ok, NewState} | {error, Reason}</v> + <v>Oid = oid()</v> + <v>Pid = pid()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Register the subagent, process, + handling part of the mib-tree. </p> + + <marker id="unregister_subagent"></marker> + </desc> + </func> + + <func> + <name>Module:unregister_subagent(State, PidOrOid) -> Reply</name> + <fsummary>Unregister the subagent</fsummary> + <type> + <v>State = NewState = term()</v> + <v>Reply = {ok, NewState} | {ok, NewState, Pid} | {error, Reason}</v> + <v>PidOrOid = pid() | oid()</v> + <v>Pid = pid()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Unregister the subagent, handling part of the mib-tree, + as specified by the <c>oid()</c> or <c>pid()</c> + (<c>PidOrOid</c>). </p> + <p>When unregister the subagent using an <c>oid()</c>, the <c>pid()</c> + of the process handling the sub-tree is also returned. </p> + + <marker id="dump"></marker> + </desc> + </func> + + <func> + <name>Module:dump(State, Destination) -> Reply</name> + <fsummary>Unregister the subagent</fsummary> + <type> + <v>State = term()</v> + <v>Reply = ok | {error, Reason}</v> + <v>Destination = io | filename()</v> + <v>Pid = pid()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Dump the mib-server data to <c>stdio</c> (Destination = <c>io</c>) or + the specified file. </p> + + <marker id="which_mib"></marker> + </desc> + </func> + + <func> + <name>Module:which_mib(State, Oid) -> Reply</name> + <fsummary>Retrieve the mib file for an oid()</fsummary> + <type> + <v>State = term()</v> + <v>Reply = {ok, MibFile} | {error, Reason}</v> + <v>Oid = oid()</v> + <v>MibFile = string()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Retrieve the mib-file to which an given <c>oid()</c> belongs. </p> + + <marker id="which_mibs"></marker> + </desc> + </func> + + <func> + <name>Module:which_mibs(State) -> Reply</name> + <fsummary>Retrieve all loaded mib files</fsummary> + <type> + <v>State = term()</v> + <v>Reply = [{MibName, Filename}]</v> + <v>MibName = atom()</v> + <v>Filename = string()</v> + </type> + <desc> + <p>Retrieve all loaded mib-files. </p> + + <marker id="whereis_mib"></marker> + </desc> + </func> + + <func> + <name>Module:whereis_mib(State, MibName) -> Reply</name> + <fsummary>Retrieve the mib file for the mib</fsummary> + <type> + <v>State = term()</v> + <v>MibName = atom()</v> + <v>Reply = {ok, Filename} | {error, Reason}</v> + <v>Filename = string()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Retrieve the mib file for the mib. </p> + + <marker id="info"></marker> + </desc> + </func> + + <func> + <name>Module:info(State) -> Reply</name> + <fsummary>Retrieve misc info for the mib data</fsummary> + <type> + <v>State = term()</v> + <v>Reply = {ok, Filename} | {error, Reason}</v> + <v>Filename = string()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Retrieve misc info for the mib data. </p> + <p>This is a utility function used to inspect, for instance, + memory usage, in a simple way. </p> + + <marker id="backup"></marker> + </desc> + </func> + + <func> + <name>Module:backup(State, BackupDir) -> Reply</name> + <fsummary>Perform a backup of the mib-server data</fsummary> + <type> + <v>State = term()</v> + <v>Reply = ok | {error, Reason}</v> + <v>BackupDir = string()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Perform a backup of the mib-server data. </p> + <p>Note that its implementation dependant (and also + dependent on mib-storage is used) if a backup is possible. </p> + + <marker id="code_change"></marker> + </desc> + </func> + + <func> + <name>Module:code_change(Destination, Vsn, Extra, State) -> NewState</name> + <fsummary>Perform a code-change</fsummary> + <type> + <v>Destination = up | down</v> + <v>Vsn = term()</v> + <v>Extra = term()</v> + <v>State = NewState = term()</v> + </type> + <desc> + <p>Perform a code-change (upgrade or downgrade). </p> + <p>See + <seealso marker="gen_server">gen_server</seealso> + for more info regarding the <c>Vsn</c> and <c>Extra</c> arguments. </p> + + </desc> + </func> + + </funcs> + +</erlref> + diff --git a/lib/snmp/doc/src/snmpa_mib_storage.xml b/lib/snmp/doc/src/snmpa_mib_storage.xml new file mode 100644 index 0000000000..a857ce79e8 --- /dev/null +++ b/lib/snmp/doc/src/snmpa_mib_storage.xml @@ -0,0 +1,292 @@ +<?xml version="1.0" encoding="iso-8859-1" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2013</year><year>2013</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>snmpa_mib_storage</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + <file>snmpa_mib_storage.xml</file> + </header> + + <module>snmpa_mib_storage</module> + <modulesummary> + Behaviour module for the SNMP agent mib storage. + </modulesummary> + <description> + <p>This module defines the behaviour of the SNMP agent mib storage. </p> + <p>The mib storage is used by the agent to store internal mib- + related information. The mib storage module is used by several entities, + not just the mib-server. </p> + + <p>A <c>snmpa_mib_storage</c> compliant module + must export the following functions: </p> + <list type="bulleted"> + <item> + <seealso marker="#open">open/5</seealso> + </item> + <item> + <seealso marker="#close">close/1</seealso> + </item> + <item> + <seealso marker="#read">read/2</seealso> + </item> + <item> + <seealso marker="#write">write/2</seealso> + </item> + <item> + <seealso marker="#delete1">delete/1</seealso> + </item> + <item> + <seealso marker="#delete2">delete/2</seealso> + </item> + <item> + <seealso marker="#match_object">match_object/2</seealso> + </item> + <item> + <seealso marker="#match_delete">match_delete/2</seealso> + </item> + <item> + <seealso marker="#tab2list">tab2list/1</seealso> + </item> + <item> + <seealso marker="#info">info/1</seealso> + </item> + <item> + <seealso marker="#sync">sync/1</seealso> + </item> + <item> + <seealso marker="#backup">backup/2</seealso> + </item> + </list> + + <p>The semantics of them and their exact signatures are + explained below. </p> + + </description> + + <section> + <title>CALLBACK FUNCTIONS</title> + <p>The following functions must be exported from a + <c>mib-server</c> data callback module: </p> + + <marker id="open"></marker> + </section> + + <funcs> + <func> + <name>Module:open(Name, RecordName, Fields, Type, Options) -> {ok, TabId} | {error, Reason}</name> + <fsummary>Create new (mib-server) data instance</fsummary> + <type> + <v>Name = atom()</v> + <v>RecordName = atom()</v> + <v>Fields = [atom()]</v> + <v>Type = set | bag()</v> + <v>Options = list()</v> + <v>TabId = term()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Create or open a mib storage table. </p> + <p>Note that the <c>RecordName</c> and <c>Fields</c> arguments + my not be used in all implementations (they are actually only + needed for mnesia-based implementations). </p> + + <p>Note also that the <c>Options</c> argument comes from + the <c>options</c> config option of the mib-storage config option, + and is passed on as is. </p> + + <marker id="close"></marker> + </desc> + </func> + + <func> + <name>Module:close(TabId) -> void()</name> + <fsummary>Close the mib-storage table</fsummary> + <type> + <v>State = term()</v> + </type> + <desc> + <p>Close the mib-storage table.</p> + + <marker id="read"></marker> + </desc> + </func> + + <func> + <name>Module:read(TabId, Key) -> false | {value, Record}</name> + <fsummary>Read a record from the mib-storage table</fsummary> + <type> + <v>TabId = term()</v> + <v>Key = term()</v> + <v>Record = tuple()</v> + </type> + <desc> + <p>Read a record from the mib-storage table. </p> + + <marker id="write"></marker> + </desc> + </func> + + <func> + <name>Module:write(TabId, Record) -> ok | {error, Reason}</name> + <fsummary>Write a record to the mib-storage table</fsummary> + <type> + <v>TabId = term()</v> + <v>Record = tuple()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Write a record to the mib-storage table. </p> + + <marker id="delete1"></marker> + </desc> + </func> + + <func> + <name>Module:delete(TabId) -> void()</name> + <fsummary>Delete an entire mib-storage table</fsummary> + <type> + <v>TabId = term()</v> + </type> + <desc> + <p>Delete an entire mib-storage table. </p> + + <marker id="delete2"></marker> + </desc> + </func> + + <func> + <name>Module:delete(TabId, Key) -> ok | {error, Reason}</name> + <fsummary>Delete a record from the mib-storage table</fsummary> + <type> + <v>TabId = term()</v> + <v>Key = term()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Delete a record from the mib-storage table. </p> + + <marker id="match_object"></marker> + </desc> + </func> + + <func> + <name>Module:match_object(TabId, Pattern) -> {ok, Recs} | {error, Reason}</name> + <fsummary>Search the mib-storage table for record matching pattern</fsummary> + <type> + <v>TabId = term()</v> + <v>Pattern = match_pattern()</v> + <v>Recs = [tuple()]</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Search the mib-storage table for record that match the + specified pattern. </p> + + <marker id="match_delete"></marker> + </desc> + </func> + + <func> + <name>Module:match_delete(TabId, Pattern) -> {ok, Recs} | {error, Reason}</name> + <fsummary>Delete records in the mib-storage table matching pattern</fsummary> + <type> + <v>TabId = term()</v> + <v>Pattern = match_pattern()</v> + <v>Recs = [tuple()]</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Search the mib-storage table for record that match the + specified pattern and then delete them. The records deleted are + also returned. </p> + + <marker id="tab2list"></marker> + </desc> + </func> + + <func> + <name>Module:tab2list(TabId) -> Recs</name> + <fsummary>Return all records of the mib-storage table</fsummary> + <type> + <v>TabId = term()</v> + <v>Recs = [tuple()]</v> + </type> + <desc> + <p>Return all records in the mib-storage table in the form + of a list. </p> + + <marker id="info"></marker> + </desc> + </func> + + <func> + <name>Module:info(TabId) -> {ok, Info} | {error, Reason}</name> + <fsummary>Returns information about the mib-storage table. </fsummary> + <type> + <v>TabId = term()</v> + <v>Info = term()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Retrieve implementation dependent mib-storage table + information. </p> + + <marker id="sync"></marker> + </desc> + </func> + + <func> + <name>Module:sync(TabId) -> void()</name> + <fsummary>Synchronize mib-storage table</fsummary> + <type> + <v>TabId = term()</v> + </type> + <desc> + <p>Synchronize the mib-storage table. </p> + <p>What this means, if anything, is implementation dependent. </p> + + <marker id="backup"></marker> + </desc> + </func> + + <func> + <name>Module:backup(TabId, BackupDir) -> ok | {error, Reason}</name> + <fsummary>Perform a backup of the mib-storage table</fsummary> + <type> + <v>TabId = term()</v> + <v>BackupDir = string()</v> + <v>Reason = term()</v> + </type> + <desc> + <p>Perform a backup of the mib-storage table. </p> + <p>What this means, if anything, is implementation dependent. </p> + + </desc> + </func> + + </funcs> + +</erlref> + diff --git a/lib/snmp/src/agent/depend.mk b/lib/snmp/src/agent/depend.mk index ea9261e266..4b12b66e3b 100644 --- a/lib/snmp/src/agent/depend.mk +++ b/lib/snmp/src/agent/depend.mk @@ -77,10 +77,6 @@ $(EBIN)/snmpa_error_logger.$(EMULATOR): \ snmpa_error_report.erl \ snmpa_error_logger.erl -$(EBIN)/snmpa_general_db.$(EMULATOR): \ - snmpa_general_db.erl \ - ../misc/snmp_verbosity.hrl - $(EBIN)/snmpa_local_db.$(EMULATOR): \ snmpa_local_db.erl \ ../misc/snmp_debug.hrl \ @@ -88,6 +84,18 @@ $(EBIN)/snmpa_local_db.$(EMULATOR): \ ../../include/snmp_types.hrl \ ../../include/STANDARD-MIB.hrl +$(EBIN)/snmpa_mib_storage.$(EMULATOR): \ + snmpa_mib_storage.erl + +$(EBIN)/snmpa_mib_storage_ets.$(EMULATOR): \ + snmpa_mib_storage_ets.erl + +$(EBIN)/snmpa_mib_storage_dets.$(EMULATOR): \ + snmpa_mib_storage_dets.erl + +$(EBIN)/snmpa_mib_storage_mnesia.$(EMULATOR): \ + snmpa_mib_storage_mnesia.erl + $(EBIN)/snmpa_mib.$(EMULATOR): \ snmpa_mib.erl \ ../misc/snmp_debug.hrl \ @@ -96,6 +104,10 @@ $(EBIN)/snmpa_mib.$(EMULATOR): \ $(EBIN)/snmpa_mib_data.$(EMULATOR): \ snmpa_mib_data.erl \ + ../../include/snmp_types.hrl + +$(EBIN)/snmpa_mib_data_tttn.$(EMULATOR): \ + snmpa_mib_data_tttn.erl \ ../misc/snmp_debug.hrl \ ../misc/snmp_verbosity.hrl \ ../../include/snmp_types.hrl diff --git a/lib/snmp/src/agent/modules.mk b/lib/snmp/src/agent/modules.mk index 33ab41b434..34765475b9 100644 --- a/lib/snmp/src/agent/modules.mk +++ b/lib/snmp/src/agent/modules.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2009. All Rights Reserved. +# Copyright Ericsson AB 2004-2013. 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 @@ -21,15 +21,21 @@ BEHAVIOUR_MODULES = \ snmpa_authentication_service \ snmpa_discovery_handler \ snmpa_error_report \ + snmpa_mib_storage \ + snmpa_mib_data \ snmpa_network_interface \ snmpa_network_interface_filter \ snmpa_notification_delivery_info_receiver \ snmpa_notification_filter \ snmpa_set_mechanism +# snmpa is "plain" interface module but also defines some agent specific types +# and therefor must be compiled before the modules that use them, including +# the behaviour modules... +# snmpa_mib_data_ttln MODULES = \ - $(BEHAVIOUR_MODULES) \ snmpa \ + $(BEHAVIOUR_MODULES) \ snmpa_acm \ snmpa_agent \ snmpa_agent_sup \ @@ -39,10 +45,12 @@ MODULES = \ snmpa_error \ snmpa_error_io \ snmpa_error_logger \ - snmpa_general_db \ snmpa_local_db \ + snmpa_mib_storage_ets \ + snmpa_mib_storage_dets \ + snmpa_mib_storage_mnesia \ snmpa_mib \ - snmpa_mib_data \ + snmpa_mib_data_tttn \ snmpa_mib_lib \ snmpa_misc_sup \ snmpa_mpd \ diff --git a/lib/snmp/src/agent/snmp_user_based_sm_mib.erl b/lib/snmp/src/agent/snmp_user_based_sm_mib.erl index e675cf1b83..223d3f7218 100644 --- a/lib/snmp/src/agent/snmp_user_based_sm_mib.erl +++ b/lib/snmp/src/agent/snmp_user_based_sm_mib.erl @@ -1219,16 +1219,10 @@ split(N, [H | T], FirstRev) when N > 0 -> split(N-1, T, [H | FirstRev]). -is_crypto_supported(Algo) -> - %% The 'catch' handles the case when 'crypto' is - %% not present in the system (or not started). - Supported = crypto:supports(), - Hashs = proplists:get_value(hashs, Supported), - Ciphers = proplists:get_value(ciphers, Supported), - case catch lists:member(Algo, Hashs ++ Ciphers) of - true -> true; - _ -> false - end. +-compile({inline, [{is_crypto_supported,1}]}). +is_crypto_supported(Func) -> + snmp_misc:is_crypto_supported(Func). + inconsistentValue(V) -> throw({inconsistentValue, V}). inconsistentName(N) -> throw({inconsistentName, N}). diff --git a/lib/snmp/src/agent/snmpa.erl b/lib/snmp/src/agent/snmpa.erl index b45a47ec6b..14b93439df 100644 --- a/lib/snmp/src/agent/snmpa.erl +++ b/lib/snmp/src/agent/snmpa.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%% Copyright Ericsson AB 2004-2013. 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 @@ -111,13 +111,44 @@ -export([print_mib_info/0, print_mib_tables/0, print_mib_variables/0]). +-export_type([ + me/0, + + %% Agent config types + mib_storage/0, + mib_storage_opt/0, + mib_storage_module/0, + mib_storage_options/0 + ]). + +-deprecated([{old_info_format, 1, next_major_release}]). + + -include("snmpa_atl.hrl"). -include("snmpa_internal.hrl"). +-include_lib("snmp/include/snmp_types.hrl"). % type of me needed. -define(DISCO_EXTRA_INFO, undefined). %%----------------------------------------------------------------- +%% Types +%%----------------------------------------------------------------- + +-type me() :: #me{}. + +%% Agent config types +-type mib_storage() :: [mib_storage_opt()]. +-type mib_storage_opt() :: {module, mib_storage_module()} | + {options, mib_storage_options()}. + +%% Module implementing the snmpa_mib_storage behaviour +-type mib_storage_module() :: atom(). +%% Options specific to the above module +-type mib_storage_options() :: list(). + + +%%----------------------------------------------------------------- %% This utility function is used to convert an old SNMP application %% config (prior to snmp-4.0) to a SNMP agent config (as of %% snmp-4.0). diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index 57846db13b..c267ce5a70 100644 --- a/lib/snmp/src/agent/snmpa_agent.erl +++ b/lib/snmp/src/agent/snmpa_agent.erl @@ -159,12 +159,15 @@ %% it is sent to the worker, and the worker is marked as busy. %% If a request is received when the worker is busy, a new temporary %% worker is spawned. +%% %% Code change %% =========== %% Note that the worker(s) execute the same module as the master %% agent. For code change we have two options - ignore the workers, %% or send them a code change message. +%% %%----------------------------------------------------------------- + -record(state, {type, parent, worker, @@ -219,22 +222,19 @@ %%----------------------------------------------------------------- start_link(Prio, Parent, Ref, Options) -> ?d("start_link -> entry with" - "~n Prio: ~p" - "~n Parent: ~p" - "~n Ref: ~p" - "~n Options: ~p", [Prio, Parent, Ref, Options]), - %% gen_server:start_link(?MODULE, [Prio, Parent, Ref, Options], []). + "~n Prio: ~p" + "~n Parent: ~p" + "~n Ref: ~p" + "~n Options: ~p", [Prio, Parent, Ref, Options]), ?GS_START_LINK3(Prio, Parent, Ref, Options). start_link(Prio, Name, Parent, Ref, Options) -> ?d("start_link -> entry with" - "~n Prio: ~p" - "~n Name: ~p" - "~n Parent: ~p" - "~n Ref: ~p" - "~n Options: ~p", [Prio, Name, Parent, Ref, Options]), -% gen_server:start_link({local, Name}, ?MODULE, -% [Prio, Parent, Ref, Options], []). + "~n Prio: ~p" + "~n Name: ~p" + "~n Parent: ~p" + "~n Ref: ~p" + "~n Options: ~p", [Prio, Name, Parent, Ref, Options]), ?GS_START_LINK4(Prio, Name, Parent, Ref, Options). stop(Agent) -> call(Agent, stop). @@ -335,10 +335,10 @@ increment_counter(Counter, Initial, Max) -> init([Prio, Parent, Ref, Options]) -> ?d("init -> entry with" - "~n Prio: ~p" - "~n Parent: ~p" - "~n Ref: ~p" - "~n Options: ~p", [Prio, Parent, Ref, Options]), + "~n Prio: ~p" + "~n Parent: ~p" + "~n Ref: ~p" + "~n Options: ~p", [Prio, Parent, Ref, Options]), case (catch do_init(Prio, Parent, Ref, Options)) of {ok, State} -> ?vdebug("started",[]), @@ -1457,80 +1457,80 @@ handle_mibs_cache_request(MibServer, Req) -> %% Downgrade %% -code_change({down, _Vsn}, S1, downgrade_to_pre_4_17_3) -> - #state{type = Type, - parent = Parent, - worker = Worker, - worker_state = WorkerState, - set_worker = SetWorker, - multi_threaded = MT, - ref = Ref, - vsns = Vsns, - nfilters = NF, - note_store = NoteStore, - mib_server = MS, - net_if = NetIf, - net_if_mod = NetIfMod, - backup = Backup, - disco = Disco, - mibs_cache_request = MCR} = S1, - S2 = {state, - type = Type, - parent = Parent, - worker = Worker, - worker_state = WorkerState, - set_worker = SetWorker, - multi_threaded = MT, - ref = Ref, - vsns = Vsns, - nfilters = NF, - note_store = NoteStore, - mib_server = MS, - net_if = NetIf, - net_if_mod = NetIfMod, - backup = Backup, - disco = Disco, - mibs_cache_request = MCR}, - {ok, S2}; - -%% Upgrade -%% -code_change(_Vsn, S1, upgrade_from_pre_4_17_3) -> - {state, - type = Type, - parent = Parent, - worker = Worker, - worker_state = WorkerState, - set_worker = SetWorker, - multi_threaded = MT, - ref = Ref, - vsns = Vsns, - nfilters = NF, - note_store = NoteStore, - mib_server = MS, - net_if = NetIf, - net_if_mod = NetIfMod, - backup = Backup, - disco = Disco, - mibs_cache_request = MCR} = S1, - S2 = #state{type = Type, - parent = Parent, - worker = Worker, - worker_state = WorkerState, - set_worker = SetWorker, - multi_threaded = MT, - ref = Ref, - vsns = Vsns, - nfilters = NF, - note_store = NoteStore, - mib_server = MS, - net_if = NetIf, - net_if_mod = NetIfMod, - backup = Backup, - disco = Disco, - mibs_cache_request = MCR, - gb_max_vbs = ?DEFAULT_GB_MAX_VBS}, - {ok, S2}; +%% code_change({down, _Vsn}, S1, downgrade_to_pre_4_17_3) -> +%% #state{type = Type, +%% parent = Parent, +%% worker = Worker, +%% worker_state = WorkerState, +%% set_worker = SetWorker, +%% multi_threaded = MT, +%% ref = Ref, +%% vsns = Vsns, +%% nfilters = NF, +%% note_store = NoteStore, +%% mib_server = MS, +%% net_if = NetIf, +%% net_if_mod = NetIfMod, +%% backup = Backup, +%% disco = Disco, +%% mibs_cache_request = MCR} = S1, +%% S2 = {state, +%% type = Type, +%% parent = Parent, +%% worker = Worker, +%% worker_state = WorkerState, +%% set_worker = SetWorker, +%% multi_threaded = MT, +%% ref = Ref, +%% vsns = Vsns, +%% nfilters = NF, +%% note_store = NoteStore, +%% mib_server = MS, +%% net_if = NetIf, +%% net_if_mod = NetIfMod, +%% backup = Backup, +%% disco = Disco, +%% mibs_cache_request = MCR}, +%% {ok, S2}; + +%% %% Upgrade +%% %% +%% code_change(_Vsn, S1, upgrade_from_pre_4_17_3) -> +%% {state, +%% type = Type, +%% parent = Parent, +%% worker = Worker, +%% worker_state = WorkerState, +%% set_worker = SetWorker, +%% multi_threaded = MT, +%% ref = Ref, +%% vsns = Vsns, +%% nfilters = NF, +%% note_store = NoteStore, +%% mib_server = MS, +%% net_if = NetIf, +%% net_if_mod = NetIfMod, +%% backup = Backup, +%% disco = Disco, +%% mibs_cache_request = MCR} = S1, +%% S2 = #state{type = Type, +%% parent = Parent, +%% worker = Worker, +%% worker_state = WorkerState, +%% set_worker = SetWorker, +%% multi_threaded = MT, +%% ref = Ref, +%% vsns = Vsns, +%% nfilters = NF, +%% note_store = NoteStore, +%% mib_server = MS, +%% net_if = NetIf, +%% net_if_mod = NetIfMod, +%% backup = Backup, +%% disco = Disco, +%% mibs_cache_request = MCR, +%% gb_max_vbs = ?DEFAULT_GB_MAX_VBS}, +%% {ok, S2}; code_change(_Vsn, S, _Extra) -> {ok, S}. @@ -4411,7 +4411,7 @@ get_mibs(Opts) -> get_option(mibs, Opts, []). get_mib_storage(Opts) -> - get_option(mib_storage, Opts, ets). + get_option(mib_storage, Opts). get_set_mechanism(Opts) -> get_option(set_mechanism, Opts, snmpa_set). @@ -4450,6 +4450,9 @@ net_if_verbosity(_Pid,_Verbosity) -> ok. +get_option(Key, Opts) -> + snmp_misc:get_option(Key, Opts). + get_option(Key, Opts, Default) -> snmp_misc:get_option(Key, Opts, Default). diff --git a/lib/snmp/src/agent/snmpa_agent_sup.erl b/lib/snmp/src/agent/snmpa_agent_sup.erl index 9b8c4d12a6..2805e2dc0d 100644 --- a/lib/snmp/src/agent/snmpa_agent_sup.erl +++ b/lib/snmp/src/agent/snmpa_agent_sup.erl @@ -29,10 +29,12 @@ -export([init/1]). -define(SERVER, ?MODULE). +%% Always use plain ets for sub-agents -ifdef(snmp_debug). --define(DEFAULT_OPTS, [{verbosity, trace}]). +-define(DEFAULT_SA_OPTS, [{mib_storage, [{module, snmpa_mib_storage_ets}]}, + {verbosity, trace}]). -else. --define(DEFAULT_OPTS, []). +-define(DEFAULT_SA_OPTS, [{mib_storage, [{module, snmpa_mib_storage_ets}]}]). -endif. @@ -63,8 +65,8 @@ start_subagent(ParentAgent, Subtree, Mibs) -> Ref = make_ref(), ?d("start_subagent -> Ref: ~p", [Ref]), Options = [{priority, Prio}, - {mibs, Mibs}, - {misc_sup, snmpa_misc_sup} | ?DEFAULT_OPTS], + {mibs, Mibs}, + {misc_sup, snmpa_misc_sup} | ?DEFAULT_SA_OPTS], Agent = {{sub_agent, Max}, {snmpa_agent, start_link, [Prio, ParentAgent, Ref, Options]}, diff --git a/lib/snmp/src/agent/snmpa_mib.erl b/lib/snmp/src/agent/snmpa_mib.erl index 575a018c0c..031309b990 100644 --- a/lib/snmp/src/agent/snmpa_mib.erl +++ b/lib/snmp/src/agent/snmpa_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. 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 @@ -18,7 +18,6 @@ %% -module(snmpa_mib). -%% c(snmpa_mib). %%%----------------------------------------------------------------- %%% This module implements a MIB server. @@ -75,12 +74,14 @@ %% Internal Data structures %% %% State -%% data - is the MIB data (defined in snmpa_mib_data) +%% data - is the MIB data (defined in mib_data module) %% meo - mib entry override %% teo - trap (notification) entry override %%----------------------------------------------------------------- --record(state, {data, meo, teo, backup, - cache, cache_tmr, cache_autogc, cache_gclimit, cache_age}). +-record(state, + {data, meo, teo, backup, + cache, cache_tmr, cache_autogc, cache_gclimit, cache_age, + data_mod}). @@ -224,9 +225,9 @@ info(MibServer, Type) -> call(MibServer, {info, Type}). dump(MibServer) -> - call(MibServer, dump). + dump(MibServer, io). -dump(MibServer, File) when is_list(File) -> +dump(MibServer, File) when (File =:= io) orelse is_list(File) -> call(MibServer, {dump, File}). backup(MibServer, BackupDir) when is_list(BackupDir) -> @@ -256,7 +257,7 @@ init([Prio, Mibs, Opts]) -> do_init(Prio, Mibs, Opts) -> process_flag(priority, Prio), process_flag(trap_exit, true), - put(sname,ms), + put(sname, ms), put(verbosity, ?vvalidate(get_verbosity(Opts))), ?vlog("starting",[]), @@ -289,13 +290,19 @@ do_init(Prio, Mibs, Opts) -> MeOverride = get_me_override(Opts), TeOverride = get_te_override(Opts), MibStorage = get_mib_storage(Opts), - Data = snmpa_mib_data:new(MibStorage), - ?vtrace("init -> mib data created",[]), - case (catch mib_operations(load_mib, Mibs, Data, + MibDataMod = get_data_mod(Opts), + ?vtrace("init -> try create mib data with" + "~n MeOverride: ~p" + "~n TeOverride: ~p" + "~n MibStorage: ~p", [MeOverride, TeOverride, MibStorage]), + Data = MibDataMod:new(MibStorage), + ?vdebug("init -> mib data created", []), + case (catch mib_operations(MibDataMod, + load_mib, Mibs, Data, MeOverride, TeOverride, true)) of {ok, Data2} -> ?vdebug("started",[]), - snmpa_mib_data:sync(Data2), + MibDataMod:sync(Data2), ?vdebug("mib data synced",[]), {ok, #state{data = Data2, teo = TeOverride, @@ -304,7 +311,8 @@ do_init(Prio, Mibs, Opts) -> cache_tmr = CacheGcTimer, cache_autogc = CacheAutoGC, cache_gclimit = CacheGcLimit, - cache_age = CacheAge}}; + cache_age = CacheAge, + data_mod = MibDataMod}}; {'aborted at', Mib, _NewData, Reason} -> ?vinfo("failed loading mib ~p: ~p",[Mib,Reason]), {error, {Mib, Reason}} @@ -315,32 +323,34 @@ do_init(Prio, Mibs, Opts) -> %% Returns: {ok, NewMibData} | {'aborted at', Mib, NewData, Reason} %% Args: Operation is load_mib | unload_mib. %%---------------------------------------------------------------------- -mib_operations(Operation, Mibs, Data, MeOverride, TeOverride) -> - mib_operations(Operation, Mibs, Data, MeOverride, TeOverride, false). +mib_operations(Mod, Operation, Mibs, Data, MeOverride, TeOverride) -> + mib_operations(Mod, Operation, Mibs, Data, MeOverride, TeOverride, false). -mib_operations(_Operation, [], Data, _MeOverride, _TeOverride, _Force) -> +mib_operations(_Mod, _Operation, [], Data, _MeOverride, _TeOverride, _Force) -> {ok, Data}; -mib_operations(Operation, [Mib|Mibs], Data0, MeOverride, TeOverride, Force) -> +mib_operations(Mod, Operation, [Mib|Mibs], Data0, MeOverride, TeOverride, Force) -> ?vtrace("mib operations ~p on" - "~n Mibs: ~p" - "~n with " - "~n MeOverride: ~p" - "~n TeOverride: ~p" - "~n Force: ~p", [Operation,Mibs,MeOverride,TeOverride,Force]), - Data = mib_operation(Operation, Mib, Data0, MeOverride, TeOverride, Force), - mib_operations(Operation, Mibs, Data, MeOverride, TeOverride, Force). - -mib_operation(Operation, Mib, Data0, MeOverride, TeOverride, Force) + "~n Mibs: ~p" + "~n with " + "~n MeOverride: ~p" + "~n TeOverride: ~p" + "~n Force: ~p", + [Operation, Mibs, MeOverride, TeOverride, Force]), + Data = mib_operation(Mod, + Operation, Mib, Data0, MeOverride, TeOverride, Force), + mib_operations(Mod, Operation, Mibs, Data, MeOverride, TeOverride, Force). + +mib_operation(Mod, Operation, Mib, Data0, MeOverride, TeOverride, Force) when is_list(Mib) -> ?vtrace("mib operation on mib ~p", [Mib]), - case apply(snmpa_mib_data, Operation, [Data0,Mib,MeOverride,TeOverride]) of - {error, 'already loaded'} when (Operation =:= load_mib) andalso + case apply(Mod, Operation, [Data0, Mib, MeOverride, TeOverride]) of + {error, already_loaded} when (Operation =:= load_mib) andalso (Force =:= true) -> ?vlog("ignore mib ~p -> already loaded", [Mib]), Data0; - {error, 'not loaded'} when (Operation =:= unload_mib) andalso - (Force =:= true) -> + {error, not_loaded} when (Operation =:= unload_mib) andalso + (Force =:= true) -> ?vlog("ignore mib ~p -> not loaded", [Mib]), Data0; {error, Reason} -> @@ -350,7 +360,7 @@ mib_operation(Operation, Mib, Data0, MeOverride, TeOverride, Force) {ok, Data} -> Data end; -mib_operation(_Op, Mib, Data, _MeOverride, _TeOverride, _Force) -> +mib_operation(_Mod, _Op, Mib, Data, _MeOverride, _TeOverride, _Force) -> throw({'aborted at', Mib, Data, bad_mibname}). @@ -395,15 +405,15 @@ handle_call({update_cache_opts, Key, Value}, _From, State) -> {reply, Result, NewState}; handle_call({lookup, Oid}, _From, - #state{data = Data, cache = Cache} = State) -> + #state{data = Data, cache = Cache, data_mod = Mod} = State) -> ?vlog("lookup ~p", [Oid]), Key = {lookup, Oid}, {Reply, NewState} = case maybe_cache_lookup(Cache, Key) of ?NO_CACHE -> - {snmpa_mib_data:lookup(Data, Oid), State}; + {Mod:lookup(Data, Oid), State}; [] -> - Rep = snmpa_mib_data:lookup(Data, Oid), + Rep = Mod:lookup(Data, Oid), ets:insert(Cache, {Key, Rep, timestamp()}), {Rep, maybe_start_cache_gc_timer(State)}; [{Key, Rep, _}] -> @@ -414,22 +424,23 @@ handle_call({lookup, Oid}, _From, ?vdebug("lookup -> Reply: ~p", [Reply]), {reply, Reply, NewState}; -handle_call({which_mib, Oid}, _From, #state{data = Data} = State) -> +handle_call({which_mib, Oid}, _From, + #state{data = Data, data_mod = Mod} = State) -> ?vlog("which_mib ~p",[Oid]), - Reply = snmpa_mib_data:which_mib(Data, Oid), + Reply = Mod:which_mib(Data, Oid), ?vdebug("which_mib: ~p",[Reply]), {reply, Reply, State}; handle_call({next, Oid, MibView}, _From, - #state{data = Data, cache = Cache} = State) -> + #state{data = Data, cache = Cache, data_mod = Mod} = State) -> ?vlog("next ~p [~p]", [Oid, MibView]), Key = {next, Oid, MibView}, {Reply, NewState} = case maybe_cache_lookup(Cache, Key) of ?NO_CACHE -> - {snmpa_mib_data:next(Data, Oid, MibView), State}; + {Mod:next(Data, Oid, MibView), State}; [] -> - Rep = snmpa_mib_data:next(Data, Oid, MibView), + Rep = Mod:next(Data, Oid, MibView), ets:insert(Cache, {Key, Rep, timestamp()}), {Rep, maybe_start_cache_gc_timer(State)}; [{Key, Rep, _}] -> @@ -441,89 +452,99 @@ handle_call({next, Oid, MibView}, _From, {reply, Reply, NewState}; handle_call({load_mibs, Mibs}, _From, - #state{data = Data, - teo = TeOverride, - meo = MeOverride, - cache = Cache} = State) -> + #state{data = Data, + teo = TeOverride, + meo = MeOverride, + cache = Cache, + data_mod = Mod} = State) -> ?vlog("load mibs ~p",[Mibs]), %% Invalidate cache NewCache = maybe_invalidate_cache(Cache), - {NData,Reply} = - case (catch mib_operations(load_mib, Mibs, Data, + {NData, Reply} = + case (catch mib_operations(Mod, load_mib, Mibs, Data, MeOverride, TeOverride)) of {'aborted at', Mib, NewData, Reason} -> ?vlog("aborted at ~p for reason ~p",[Mib,Reason]), - {NewData,{error, {'load aborted at', Mib, Reason}}}; + {NewData, {error, {'load aborted at', Mib, Reason}}}; {ok, NewData} -> - {NewData,ok} + {NewData, ok} end, - snmpa_mib_data:sync(NData), + Mod:sync(NData), {reply, Reply, State#state{data = NData, cache = NewCache}}; handle_call({unload_mibs, Mibs}, _From, - #state{data = Data, - teo = TeOverride, - meo = MeOverride, - cache = Cache} = State) -> + #state{data = Data, + teo = TeOverride, + meo = MeOverride, + cache = Cache, + data_mod = Mod} = State) -> ?vlog("unload mibs ~p",[Mibs]), %% Invalidate cache NewCache = maybe_invalidate_cache(Cache), %% Unload mib(s) - {NData,Reply} = - case (catch mib_operations(unload_mib, Mibs, Data, + {NData, Reply} = + case (catch mib_operations(Mod, unload_mib, Mibs, Data, MeOverride, TeOverride)) of {'aborted at', Mib, NewData, Reason} -> - ?vlog("aborted at ~p for reason ~p",[Mib,Reason]), + ?vlog("aborted at ~p for reason ~p", [Mib,Reason]), {NewData, {error, {'unload aborted at', Mib, Reason}}}; {ok, NewData} -> - {NewData,ok} + {NewData, ok} end, - snmpa_mib_data:sync(NData), + Mod:sync(NData), {reply, Reply, State#state{data = NData, cache = NewCache}}; -handle_call(which_mibs, _From, #state{data = Data} = State) -> +handle_call(which_mibs, _From, #state{data = Data, data_mod = Mod} = State) -> ?vlog("which mibs",[]), - Reply = snmpa_mib_data:which_mibs(Data), + Reply = Mod:which_mibs(Data), {reply, Reply, State}; -handle_call({whereis_mib, Mib}, _From, #state{data = Data} = State) -> +handle_call({whereis_mib, Mib}, _From, + #state{data = Data, + data_mod = Mod} = State) -> ?vlog("whereis mib: ~p",[Mib]), - Reply = snmpa_mib_data:whereis_mib(Data, Mib), + Reply = Mod:whereis_mib(Data, Mib), {reply, Reply, State}; handle_call({register_subagent, Oid, Pid}, _From, - #state{data = Data, cache = Cache} = State) -> + #state{data = Data, + cache = Cache, + data_mod = Mod} = State) -> ?vlog("register subagent ~p, ~p",[Oid,Pid]), %% Invalidate cache NewCache = maybe_invalidate_cache(Cache), - case snmpa_mib_data:register_subagent(Data, Oid, Pid) of + case Mod:register_subagent(Data, Oid, Pid) of {error, Reason} -> ?vlog("registration failed: ~p",[Reason]), {reply, {error, Reason}, State#state{cache = NewCache}}; - NewData -> + {ok, NewData} -> {reply, ok, State#state{data = NewData, cache = NewCache}} end; handle_call({unregister_subagent, OidOrPid}, _From, - #state{data = Data, cache = Cache} = State) -> + #state{data = Data, + cache = Cache, + data_mod = Mod} = State) -> ?vlog("unregister subagent ~p",[OidOrPid]), %% Invalidate cache NewCache = maybe_invalidate_cache(Cache), - case snmpa_mib_data:unregister_subagent(Data, OidOrPid) of + case Mod:unregister_subagent(Data, OidOrPid) of + {ok, NewData} -> + {reply, ok, State#state{data = NewData, cache = NewCache}}; {ok, NewData, DeletedSubagentPid} -> {reply, {ok, DeletedSubagentPid}, State#state{data = NewData, cache = NewCache}}; {error, Reason} -> ?vlog("unregistration failed: ~p",[Reason]), - {reply, {error, Reason}, State#state{cache = NewCache}}; - NewData -> - {reply, ok, State#state{data = NewData, cache = NewCache}} + {reply, {error, Reason}, State#state{cache = NewCache}} end; -handle_call(info, _From, #state{data = Data, cache = Cache} = State) -> +handle_call(info, _From, #state{data = Data, + cache = Cache, + data_mod = Mod} = State) -> ?vlog("info",[]), Reply = - case (catch snmpa_mib_data:info(Data)) of + case (catch Mod:info(Data)) of Info when is_list(Info) -> [{cache, size_cache(Cache)} | Info]; E -> @@ -531,10 +552,12 @@ handle_call(info, _From, #state{data = Data, cache = Cache} = State) -> end, {reply, Reply, State}; -handle_call({info, Type}, _From, #state{data = Data} = State) -> +handle_call({info, Type}, _From, + #state{data = Data, + data_mod = Mod} = State) -> ?vlog("info ~p",[Type]), Reply = - case (catch snmpa_mib_data:info(Data, Type)) of + case (catch Mod:info(Data, Type)) of Info when is_list(Info) -> Info; E -> @@ -542,21 +565,19 @@ handle_call({info, Type}, _From, #state{data = Data} = State) -> end, {reply, Reply, State}; -handle_call(dump, _From, State) -> - ?vlog("dump",[]), - Reply = snmpa_mib_data:dump(State#state.data), - {reply, Reply, State}; - -handle_call({dump, File}, _From, #state{data = Data} = State) -> +handle_call({dump, File}, _From, + #state{data = Data, data_mod = Mod} = State) -> ?vlog("dump on ~s",[File]), - Reply = snmpa_mib_data:dump(Data, File), + Reply = Mod:dump(Data, File), {reply, Reply, State}; %% This check (that there is no backup already in progress) is also %% done in the master agent process, but just in case a user issues %% a backup call to this process directly, we add a similar check here. handle_call({backup, BackupDir}, From, - #state{backup = undefined, data = Data} = State) -> + #state{backup = undefined, + data = Data, + data_mod = Mod} = State) -> ?vlog("backup to ~s", [BackupDir]), Pid = self(), V = get(verbosity), @@ -568,7 +589,7 @@ handle_call({backup, BackupDir}, From, put(sname, ambs), put(verbosity, V), Dir = filename:join([BackupDir]), - Reply = snmpa_mib_data:backup(Data, Dir), + Reply = Mod:backup(Data, Dir), Pid ! {backup_done, Reply}, unlink(Pid) end), @@ -637,8 +658,8 @@ handle_info(Info, State) -> warning_msg("received unknown info: ~n~p", [Info]), {noreply, State}. -terminate(_Reason, #state{data = Data}) -> - catch snmpa_mib_data:close(Data), +terminate(_Reason, #state{data = Data, data_mod = Mod}) -> + catch Mod:close(Data), ok. @@ -655,6 +676,11 @@ terminate(_Reason, #state{data = Data}) -> %% S2 = {state, Data, MEO, TEO, B}, %% {ok, S2}; +code_change({down, Vsn}, #state{data = Data0, data_mod = Mod} = State, Extra) -> + Data = Mod:code_change(down, Vsn, Extra, Data0), + {ok, State#state{data = Data}}; + + %% %% upgrade %% %% %% code_change(_Vsn, S1, upgrade_from_pre_4_12) -> @@ -663,8 +689,9 @@ terminate(_Reason, #state{data = Data}) -> %% S2 = #state{data = Data, meo = MEO, teo = TEO, backup = B, cache = Cache}, %% {ok, S2}; -code_change(_Vsn, State, _Extra) -> - {ok, State}. +code_change(Vsn, #state{data = Data0, data_mod = Mod} = State, Extra) -> + Data = Mod:code_change(up, Vsn, Extra, Data0), + {ok, State#state{data = Data}}. %%----------------------------------------------------------------- @@ -681,7 +708,10 @@ get_te_override(Options) -> get_opt(trapentry_override, Options, false). get_mib_storage(Options) -> - get_opt(mib_storage, Options, ets). + get_opt(mib_storage, Options). + +get_data_mod(Options) -> + get_opt(data_module, Options, snmpa_mib_data_tttn). get_cacheopt_autogc(Cache, CacheOpts) -> IsValid = fun(AutoGC) when ((AutoGC =:= true) orelse @@ -868,6 +898,9 @@ timestamp() -> %% ---------------------------------------------------------------- +get_opt(Key, Options) -> + snmp_misc:get_option(Key, Options). + get_opt(Key, Options, Default) -> snmp_misc:get_option(Key, Options, Default). diff --git a/lib/snmp/src/agent/snmpa_mib_data.erl b/lib/snmp/src/agent/snmpa_mib_data.erl index b80d85d2ee..4d8a12b6c6 100644 --- a/lib/snmp/src/agent/snmpa_mib_data.erl +++ b/lib/snmp/src/agent/snmpa_mib_data.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. 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 @@ -18,1338 +18,92 @@ %% -module(snmpa_mib_data). -%%%----------------------------------------------------------------- -%%% This module implements the MIB internal data structures. -%%% An MIB Data Structure consists of three items; an ets-table, -%%% a tree and a list of registered subagents. -%%% The subagent information is consequently duplicated. It resides -%%% both in the tree and in the list. -%%% The ets-table contains all data associated with each variable, -%%% table, tableentry and tablecolumn in the MIB. -%%% The tree contains information of the Oids in the MIB. -%%% -%%% When a mib is loaded, the tree is built from the plain list -%%% in the binary file. -%%%----------------------------------------------------------------- --include("snmp_types.hrl"). --include("snmp_debug.hrl"). - --define(VMODULE,"MDATA"). --include("snmp_verbosity.hrl"). - --define(MIB_DATA,snmpa_mib_data). --define(MIB_NODE,snmpa_mib_node). --define(MIB_TREE,snmpa_mib_tree). --define(DUMMY_TREE_GENERATION,1). --define(DEFAULT_TREE,{tree,{undefined_node},internal}). -%%-define(DUMMY_TREE_DB,dummy_tree_db). -%%-define(DUMMY_TREE_DB_INIT,{?DUMMY_TREE_DB,?DEFAULT_TREE}). - +-include_lib("snmp/include/snmp_types.hrl"). %%%----------------------------------------------------------------- -%%% Table of contents -%%% ================= -%%% 1. Interface -%%% 2. Implementation of tree access -%%% 3. Tree building functions -%%% 4. Tree merging -%%% 5. Tree deletion routines -%%% 6. Functions for subagent handling -%%% 7. Misc functions +%%% This is the behaviour for the MIB server backend internal +%%% data storage. %%%----------------------------------------------------------------- +%% These types should really be defined elsewhere... +-export_type([ + mib_view/0, + mib_view_elem/0, + mib_view_mask/0, + mib_view_inclusion/0 + ]). -%%---------------------------------------------------------------------- -%% data_db is an database containing loaded mibs as: -%% {MibName = atom(), Symbolic = ?, FullFileName = string()} -%% it is either ets or mnesia -%% tree_db is a database containing _one_ record with the tree! -%% (the reason for this is part to get replication and part out of convenience) -%% ref_tree is the root node, without any subagent. -%% tree is the root node (same as ref_tree but with the subagents added). -%% subagents is a list of {SAPid, Oid} -%%---------------------------------------------------------------------- --record(mib_data, {mib_db, % table of #mib_info - node_db, % table of #node_info - tree_db, % table of #tree - tree, % The actual tree - subagents = []}). - --record(mib_info, {name, symbolic, file_name}). --record(node_info, {oid, mib_name, me}). - - -%% API --export([new/0, new/1, sync/1, close/1, - load_mib/4, unload_mib/4, which_mibs/1, whereis_mib/2, - info/1, info/2, - dump/1, dump/2, - backup/2, - lookup/2, next/3, which_mib/2, - register_subagent/3, unregister_subagent/2]). - -%% Internal exports --export([code_change/2]). - - -%%----------------------------------------------------------------- -%% A tree is represented as a N-tuple, where each element is a -%% node. A node is: -%% 1) {tree, Tree, Info} where Info can be {table, Id}, {table_entry, Id} -%% or perhaps 'internal' -%% 2) undefined_node (memory optimization (instead of {node, undefined})) -%% 3) {node, Info} where Info can be {subagent, Pid}, {variable, Id}, -%% {table_column, Id} -%% Id is {MibName, MibEntry} -%% The over all root is represented as {tree, Tree, internal}. -%% -%% tree() = {tree, nodes(), tree_info()} -%% nodes() = {tree() | node() | undefined_node, ...} -%% node() = {node, node_info()} -%% tree_info() = {table, Id} | {table_entry, Id} | internal -%% node_info() = {subagent, Pid} | {variable, Id} | {table_colum, Id} -%%----------------------------------------------------------------- - -%% This record is what is stored in the database. The 'tree' part -%% is described above... --record(tree,{generation = ?DUMMY_TREE_GENERATION, root = ?DEFAULT_TREE}). - - -%%%====================================================================== -%%% 1. Interface -%%%====================================================================== - -%%----------------------------------------------------------------- -%% Func: new/0, new/1 -%% Returns: A representation of mib data. -%%----------------------------------------------------------------- -new() -> - new(ets). - -%% Where -> A list of nodes where the tables will be created -new(Storage) -> - %% First we must check if there is already something to read - %% If a database already exists, then the tree structure has to be read - ?vtrace("open (mib) database",[]), - MibDb = snmpa_general_db:open(Storage, ?MIB_DATA, - mib_info, - record_info(fields,mib_info), set), - ?vtrace("open (mib) node database",[]), - NodeDb = snmpa_general_db:open(Storage, ?MIB_NODE, - node_info, - record_info(fields,node_info), set), - ?vtrace("open (mib) tree database",[]), - TreeDb = snmpa_general_db:open(Storage, ?MIB_TREE, - tree, - record_info(fields,tree), set), - Tree = - case snmpa_general_db:read(TreeDb, ?DUMMY_TREE_GENERATION) of - false -> - T = #tree{}, - snmpa_general_db:write(TreeDb, T), - T; - {value, T} -> - T - end, - install_mibs(MibDb, NodeDb), - #mib_data{mib_db = MibDb, - node_db = NodeDb, - tree_db = TreeDb, - tree = Tree}. - - -%%---------------------------------------------------------------------- -%% Returns: new mib data | {error, Reason} -%%---------------------------------------------------------------------- -load_mib(MibData,FileName,MeOverride,TeOverride) - when is_record(MibData,mib_data) andalso is_list(FileName) -> - ?vlog("load mib file: ~p",[FileName]), - ActualFileName = filename:rootname(FileName, ".bin") ++ ".bin", - MibName = list_to_atom(filename:basename(FileName, ".bin")), - (catch do_load_mib(MibData, ActualFileName, MibName, - MeOverride, TeOverride)). - -do_load_mib(MibData, ActualFileName, MibName, MeOverride, TeOverride) -> - ?vtrace("do_load_mib -> entry with" - "~n ActualFileName: ~s" - "~n MibName: ~p",[ActualFileName, MibName]), - #mib_data{mib_db = MibDb, - node_db = NodeDb, - %% tree_db = TreeDb, - tree = Tree} = MibData, - verify_not_loaded(MibDb, MibName), - ?vtrace("do_load_mib -> already loaded mibs:" - "~n ~p",[loaded(MibDb)]), - Mib = do_read_mib(ActualFileName), - ?vtrace("do_load_mib -> read mib ~s",[Mib#mib.name]), - NonInternalMes = - lists:filter(fun(ME) -> maybe_drop_me(ME) end, Mib#mib.mes), - OldRoot = Tree#tree.root, - T = build_tree(NonInternalMes, MibName), - ?d("load_mib -> " - "~n OldRoot: ~p" - "~n T: ~p", [OldRoot, T]), - case (catch merge_nodes(T, OldRoot)) of - {error_merge_nodes, Node1, Node2} -> - ?vlog("error merging nodes:" - "~n~p~nand~n~p", [Node1,Node2]), - {error, oid_conflict}; - NewRoot when is_tuple(NewRoot) andalso (element(1,NewRoot) =:= tree) -> - ?d("load_mib -> " - "~n NewRoot: ~p", [NewRoot]), - Symbolic = not lists:member(no_symbolic_info, Mib#mib.misc), - case (catch check_notif_and_mes(TeOverride, MeOverride, Symbolic, - Mib#mib.traps, NonInternalMes)) of - true -> - install_mes(NodeDb, MibName, NonInternalMes), - install_mib(MibDb, Symbolic, Mib, - MibName, ActualFileName, NonInternalMes), - ?vtrace("installed mib ~s", [Mib#mib.name]), - Tree2 = Tree#tree{root = NewRoot}, - %% snmpa_general_db:write(TreeDb, Tree2), %% Store later? - {ok, MibData#mib_data{tree = Tree2}}; - Else -> - Else - end - end. - - -verify_not_loaded(Db, Name) -> - case snmpa_general_db:read(Db, Name) of - {value, #mib_info{name = Name}} -> - throw({error, 'already loaded'}); - false -> - ok - end. - -do_read_mib(ActualFileName) -> - case snmp_misc:read_mib(ActualFileName) of - {error, Reason} -> - ?vlog("Failed reading mib file ~p with reason: ~p", - [ActualFileName,Reason]), - throw({error, Reason}); - {ok, Mib} -> - Mib - end. - -%% The Tree DB is handled in a special way since it can be very large. -sync(#mib_data{mib_db = M, - node_db = N, - tree_db = T, tree = Tree, subagents = []}) -> - snmpa_general_db:sync(M), - snmpa_general_db:sync(N), - snmpa_general_db:write(T, Tree), - snmpa_general_db:sync(T); -sync(#mib_data{mib_db = M, - node_db = N, - tree_db = T, tree = Tree, subagents = SAs}) -> - - snmpa_general_db:sync(M), - snmpa_general_db:sync(N), - - %% Ouch. Since the subagent info is dynamic we do not - %% want to store the tree containing subagent info. So, we - %% have to create a tmp tree without those and store it. - - case delete_subagents(Tree, SAs) of - {ok, TreeWithoutSAs} -> - snmpa_general_db:write(T, TreeWithoutSAs), - snmpa_general_db:sync(T); - Error -> - Error - end. - -delete_subagents(Tree, []) -> - {ok, Tree}; -delete_subagents(Tree0, [{_, Oid}|SAs]) -> - case (catch delete_subagent(Tree0, Oid)) of - {tree, _Tree, _Info} = Tree1 -> - delete_subagents(Tree1, SAs); - _Error -> - {error, {'invalid oid', Oid}} - end. - -%%---------------------------------------------------------------------- -%% (OTP-3601) -%%---------------------------------------------------------------------- -check_notif_and_mes(TeOverride,MeOverride,Symbolic,Traps,MEs) -> - ?vtrace("check notifications and mib entries",[]), - check_notifications(TeOverride,Symbolic,Traps), - check_mes(MeOverride,MEs). - -check_notifications(true, _Symbolic, _Traps) -> - ?vtrace("trapentry override = true => skip check",[]), - true; -check_notifications(_, Symbolic, Traps) -> - check_notifications(Symbolic, Traps). - -check_notifications(true, Traps) -> - check_notifications(Traps); -check_notifications(_, _) -> true. - -check_notifications([]) -> true; -check_notifications([#trap{trapname = Key} = Trap | Traps]) -> - ?vtrace("check notification [trap] with Key: ~p",[Key]), - case snmpa_symbolic_store:get_notification(Key) of - {value, Trap} -> check_notifications(Traps); - {value, _} -> throw({error, {'trap already defined', Key}}); - undefined -> check_notifications(Traps) - end; -check_notifications([#notification{trapname = Key} = Notif | Traps]) -> - ?vtrace("check notification [notification] with Key: ~p",[Key]), - case snmpa_symbolic_store:get_notification(Key) of - {value, Notif} -> - check_notifications(Traps); - {value, _} -> - throw({error, {'notification already defined', Key}}); - undefined -> - check_notifications(Traps) - end; -check_notifications([Crap | Traps]) -> - ?vlog("skipped check of: ~n~p",[Crap]), - check_notifications(Traps). - -check_mes(true,_) -> - ?vtrace("mibentry override = true => skip check",[]), - true; -check_mes(_,MEs) -> - check_mes(MEs). - -check_mes([]) -> true; -check_mes([#me{aliasname = Name, oid = Oid1} | MEs]) -> - ?vtrace("check mib entries with aliasname: ~p",[Name]), - case snmpa_symbolic_store:aliasname_to_oid(Name) of - {value, Oid1} -> - check_mes(MEs); - {value, Oid2} -> - ?vinfo("~n expecting '~p'~n but found '~p'",[Oid1, Oid2]), - throw({error, {'mibentry already defined', Name}}); - false -> - check_mes(MEs) - end; -check_mes([Crap | MEs]) -> - ?vlog("skipped check of: ~n~p",[Crap]), - check_mes(MEs). - - - -%%---------------------------------------------------------------------- -%% Returns: new mib data | {error, Reason} -%%---------------------------------------------------------------------- -unload_mib(MibData, FileName, _, _) when is_list(FileName) -> - MibName = list_to_atom(filename:basename(FileName, ".bin")), - (catch do_unload_mib(MibData, MibName)). - -do_unload_mib(MibData, MibName) -> - ?vtrace("do_unload_mib -> entry with" - "~n MibName: ~p", [MibName]), - #mib_data{mib_db = MibDb, - node_db = NodeDb, - %% tree_db = TreeDb, - tree = Tree} = MibData, - #mib_info{symbolic = Symbolic} = verify_loaded(MibDb, MibName), - NewRoot = delete_mib_from_tree(MibName, Tree#tree.root), - MEs = uninstall_mes(NodeDb, MibName), - uninstall_mib(MibDb, Symbolic, MibName, MEs), - NewMibData = MibData#mib_data{tree = Tree#tree{root = NewRoot}}, - {ok, NewMibData}. - -verify_loaded(Db, Name) -> - case snmpa_general_db:read(Db, Name) of - {value, MibInfo} -> - MibInfo; - false -> - throw({error, 'not loaded'}) - end. - - -close(#mib_data{mib_db = MibDb, node_db = NodeDb, tree_db = TreeDb}) -> - snmpa_general_db:close(MibDb), - snmpa_general_db:close(NodeDb), - snmpa_general_db:close(TreeDb), - ok. - -register_subagent(#mib_data{tree = T} = MibData, Oid, Pid) -> - case insert_subagent(Oid, T#tree.root) of - {error, Reason} -> - {error, Reason}; - NewRootTree -> - SAs = [{Pid, Oid} | MibData#mib_data.subagents], - T2 = T#tree{root = NewRootTree}, - MibData#mib_data{tree = T2, subagents = SAs} - end. - - -%%---------------------------------------------------------------------- -%% Purpose: Get a list of all loaded mibs -%% Returns: [{Name, File}] -%%---------------------------------------------------------------------- - -which_mibs(#mib_data{mib_db = Db}) -> - Mibs = snmpa_general_db:tab2list(Db), - [{Name, File} || #mib_info{name = Name, file_name = File} <- Mibs]. - - -%%---------------------------------------------------------------------- -%% Purpose: Get a list of all loaded mibs -%% Returns: [{Name, File}] -%%---------------------------------------------------------------------- - -whereis_mib(#mib_data{mib_db = Db}, Name) -> - case snmpa_general_db:read(Db, Name) of - {value, #mib_info{file_name = File}} -> - {ok, File}; - false -> - {error, not_found} - end. - - -%%---------------------------------------------------------------------- -%% Purpose: Deletes SA with Pid from all subtrees it handles. -%% Returns: NewMibData. -%%---------------------------------------------------------------------- -unregister_subagent(MibData, Pid) when is_pid(Pid) -> - SAs = MibData#mib_data.subagents, - case lists:keysearch(Pid, 1, SAs) of - false -> MibData; - {value, {Pid, Oid}} -> - % we should never get an error since Oid is found in MibData. - {ok, NewMibData, _DeletedSA} = unregister_subagent(MibData, Oid), - % continue if the same Pid handles other mib subtrees. - unregister_subagent(NewMibData, Pid) - end; - -%%---------------------------------------------------------------------- -%% Purpose: Deletes one unique subagent. -%% Returns: {error, Reason} | {ok, NewMibData, DeletedSubagentPid} -%%---------------------------------------------------------------------- -unregister_subagent(#mib_data{tree = T} = MibData, Oid) when is_list(Oid) -> - case catch delete_subagent(T#tree.root, Oid) of - {tree, Tree, Info} -> - OldSAs = MibData#mib_data.subagents, - {value, {Pid, _Oid}} = lists:keysearch(Oid, 2, OldSAs), - SAs = lists:keydelete(Oid, 2, OldSAs), - T2 = T#tree{root = {tree, Tree, Info}}, - {ok, - MibData#mib_data{tree = T2, subagents = SAs}, - Pid}; - _ -> - {error, {'invalid oid', Oid}} - end. - -%%---------------------------------------------------------------------- -%% Purpose: To inpect memory usage, loaded mibs, registered subagents -%%---------------------------------------------------------------------- -info(MibData) -> - ?vtrace("retrieve info",[]), - #mib_data{mib_db = MibDb, node_db = NodeDb, tree_db = TreeDb, - tree = Tree, subagents = SAs} = MibData, - LoadedMibs = old_format(snmpa_general_db:tab2list(MibDb)), - TreeSize = snmp_misc:mem_size(Tree), - {memory, ProcSize} = erlang:process_info(self(),memory), - MibDbSize = snmpa_general_db:info(MibDb, memory), - NodeDbSize = snmpa_general_db:info(NodeDb, memory), - TreeDbSize = snmpa_general_db:info(TreeDb, memory), - [{loaded_mibs, LoadedMibs}, {subagents, SAs}, {tree_size_bytes, TreeSize}, - {process_memory, ProcSize}, - {db_memory, [{mib,MibDbSize},{node,NodeDbSize},{tree,TreeDbSize}]}]. - -info(#mib_data{mib_db = MibDb}, loaded_mibs) -> - Mibs = snmpa_general_db:tab2list(MibDb), - [filename:rootname(FN, ".bin") || #mib_info{file_name = FN} <- Mibs]; -info(#mib_data{tree = Tree}, tree_size_bytes) -> - snmp_misc:mem_size(Tree); -info(_, process_memory) -> - {memory, ProcSize} = erlang:process_info(self(),memory), - ProcSize; -info(#mib_data{mib_db = MibDb, node_db = NodeDb, tree_db = TreeDb}, - db_memory) -> - MibDbSize = snmpa_general_db:info(MibDb, memory), - NodeDbSize = snmpa_general_db:info(NodeDb, memory), - TreeDbSize = snmpa_general_db:info(TreeDb, memory), - [{mib,MibDbSize},{node,NodeDbSize},{tree,TreeDbSize}]; -info(#mib_data{subagents = SAs}, subagents) -> - SAs. - -old_format(LoadedMibs) -> - ?vtrace("convert mib info to old format",[]), - [{N,S,F} || #mib_info{name=N,symbolic=S,file_name=F} <- LoadedMibs]. - - -%%---------------------------------------------------------------------- -%% A total dump for debugging. -%%---------------------------------------------------------------------- -dump(#mib_data{mib_db = MibDb, node_db = NodeDb, tree = Tree}) -> - (catch io:format("MIB-tables:~n~p~n~n", - [snmpa_general_db:tab2list(MibDb)])), - (catch io:format("MIB-entries:~n~p~n~n", - [snmpa_general_db:tab2list(NodeDb)])), - (catch io:format("Tree:~n~p~n", [Tree])), % good luck reading it! - ok. - -dump(#mib_data{mib_db = MibDb, node_db = NodeDb, tree = Tree}, File) -> - case file:open(File,[write]) of - {ok, Fd} -> - io:format(Fd,"~s~n", - [snmp:date_and_time_to_string(snmp:date_and_time())]), - (catch io:format(Fd,"MIB-tables:~n~p~n~n", - [snmpa_general_db:tab2list(MibDb)])), - (catch io:format(Fd, "MIB-entries:~n~p~n~n", - [snmpa_general_db:tab2list(NodeDb)])), - io:format(Fd,"Tree:~n~p~n", [Tree]), % good luck reading it! - file:close(Fd), - ok; - {error,Reason} -> - ?vinfo("~n Failed opening file '~s' for reason ~p", - [File,Reason]), - {error,Reason} - end. - - -backup(#mib_data{mib_db = M, node_db = N, tree_db = T}, BackupDir) -> - MRes = snmpa_general_db:backup(M, BackupDir), - NRes = snmpa_general_db:backup(N, BackupDir), - TRes = snmpa_general_db:backup(T, BackupDir), - handle_backup_res([{mib_db, MRes}, {node_db, NRes}, {tree_db, TRes}]). - -handle_backup_res(Res) -> - handle_backup_res(Res, []). - -handle_backup_res([], []) -> - ok; -handle_backup_res([], Err) -> - {error, lists:reverse(Err)}; -handle_backup_res([{_, ok}|Res], Err) -> - handle_backup_res(Res, Err); -handle_backup_res([{Tag, {error, Reason}}|Res], Err) -> - handle_backup_res(Res, [{Tag, Reason}|Err]); -handle_backup_res([{Tag, Error}|Res], Err) -> - handle_backup_res(Res, [{Tag, Error}|Err]). - - -%%%====================================================================== -%%% 2. Implementation of tree access -%%% lookup and next. -%%%====================================================================== - - -which_mib(#mib_data{tree = T} = D, Oid) -> - ?vtrace("which_mib -> entry with" - "~n Oid: ~p",[Oid]), - case (catch find_node(D, T#tree.root, Oid, [])) of - {variable, _ME, Mib} -> - ?vtrace("which_mib -> variable:" - "~n Mib: ~p", [Mib]), - {ok, Mib}; - {table, _EntryME, _, Mib} -> - ?vtrace("which_mib -> table:" - "~n Mib: ~p", [Mib]), - {ok, Mib}; - {subagent, SubAgentPid, _SANextOid} -> - ?vtrace("which_mib -> subagent:" - "~n SubAgentPid: ~p", [SubAgentPid]), - {error, {subagent, SubAgentPid}}; - {false, ErrorCode} -> - ?vtrace("which_mib -> false:" - "~n ErrorCode: ~p",[ErrorCode]), - {error, ErrorCode}; - false -> - ?vtrace("which_mib -> false",[]), - {error, noSuchObject}; - {'EXIT', R} -> - ?vtrace("which_mib -> exit:" - "~n R: ~p",[R]), - {error, noSuchObject} - end. - - -%%----------------------------------------------------------------- -%% Func: lookup/2 -%% Purpose: Finds the mib entry corresponding to the Oid. If it is a -%% variable, the Oid must be <Oid for var>.0 and if it is -%% a table, Oid must be <table>.<entry>.<col>.<any> -%% Returns: {variable, MibEntry} | -%% {table_column, MibEntry, TableEntryOid} | -%% {subagent, SubAgentPid, SAOid} | -%% {false, Reason} -%%----------------------------------------------------------------- -lookup(#mib_data{tree = T} = D, Oid) -> - ?vtrace("lookup -> entry with" - "~n Oid: ~p",[Oid]), - case (catch find_node(D, T#tree.root, Oid, [])) of - {variable, ME, _Mib} when is_record(ME, me) -> - ?vtrace("lookup -> variable:" - "~n ME: ~p",[ME]), - {variable, ME}; - {table, EntryME, {ColME, TableEntryOid}, _Mib} -> - ?vtrace("lookup -> table:" - "~n EntryME: ~p" - "~n ColME: ~p" - "~n RevTableEntryOid: ~p", - [EntryME, ColME, TableEntryOid]), - MFA = EntryME#me.mfa, - RetME = ColME#me{mfa = MFA}, - {table_column, RetME, TableEntryOid}; - {subagent, SubAgentPid, SANextOid} -> - ?vtrace("lookup -> subagent:" - "~n SubAgentPid: ~p" - "~n SANextOid: ~p", [SubAgentPid, SANextOid]), - {subagent, SubAgentPid, SANextOid}; - {false, ErrorCode} -> - ?vtrace("lookup -> false:" - "~n ErrorCode: ~p",[ErrorCode]), - {false, ErrorCode}; - false -> - ?vtrace("lookup -> false",[]), - {false, noSuchObject}; - {'EXIT', R} -> - ?vtrace("lookup -> exit:" - "~n R: ~p",[R]), - {false, noSuchObject} - end. - - -find_node(D, {tree, Tree, {table, _}}, RestOfOid, RevOid) -> - ?vtrace("find_node(tree,table) -> entry with" - "~n RestOfOid: ~p" - "~n RevOid: ~p",[RestOfOid, RevOid]), - find_node(D, {tree, Tree, internal}, RestOfOid, RevOid); -find_node(D, {tree, Tree, {table_entry, _}}, RestOfOid, RevOid) -> - ?vtrace("find_node(tree,table_entry) -> entry with" - "~n RestOfOid: ~p" - "~n RevOid: ~p",[RestOfOid, RevOid]), - #mib_data{node_db = Db} = D, - Oid = lists:reverse(RevOid), - case snmpa_general_db:read(Db, Oid) of - {value, #node_info{me = ME, mib_name = Mib}} -> - case find_node(D, {tree, Tree, internal}, RestOfOid, RevOid) of - {false, ErrorCode} -> {false, ErrorCode}; - Val -> {table, ME, Val, Mib} - end; - false -> - ?vinfo("find_node -> could not find table_entry ME with" - "~n RevOid: ~p" - "~n when" - "~n RestOfOid: ~p", - [RevOid, RestOfOid]), - false - end; -find_node(D, {tree, Tree, _Internal}, [Int | RestOfOid], RevOid) -> - ?vtrace("find_node(tree) -> entry with" - "~n Int: ~p" - "~n RestOfOid: ~p" - "~n RevOid: ~p",[Int, RestOfOid, RevOid]), - find_node(D, element(Int+1, Tree), RestOfOid, [Int | RevOid]); -find_node(D, {node, {table_column, _}}, RestOfOid, [ColInt | RevOid]) -> - ?vtrace("find_node(tree,table_column) -> entry with" - "~n RestOfOid: ~p" - "~n ColInt: ~p" - "~n RevOid: ~p",[RestOfOid, ColInt, RevOid]), - #mib_data{node_db = Db} = D, - Oid = lists:reverse([ColInt | RevOid]), - case snmpa_general_db:read(Db, Oid) of - {value, #node_info{me = ME}} -> - {ME, lists:reverse(RevOid)}; - false -> - X = snmpa_general_db:read(Db, lists:reverse([ColInt | RevOid])), - ?vinfo("find_node -> could not find table_column ME with" - "~n RevOid: ~p" - "~n trying [~p|~p]" - "~n X: ~p", - [RevOid, [ColInt | RevOid], X]), - false - end; -find_node(D, {node, {variable, _MibName}}, [0], RevOid) -> - ?vtrace("find_node(tree,variable,[0]) -> entry with" - "~n RevOid: ~p",[RevOid]), - #mib_data{node_db = Db} = D, - Oid = lists:reverse(RevOid), - %% {value, #node_info{me = ME}} = snmpa_general_db:read(Db, Oid), - case snmpa_general_db:read(Db, Oid) of - {value, #node_info{me = ME, mib_name = Mib}} -> - {variable, ME, Mib}; - false -> - ?vinfo("find_node -> could not find variable ME with" - "~n RevOid: ~p", [RevOid]), - false - end; -find_node(_D, {node, {variable, _MibName}}, [], _RevOid) -> - ?vtrace("find_node(tree,variable,[]) -> entry",[]), - {false, noSuchObject}; -find_node(_D, {node, {variable, _MibName}}, _, _RevOid) -> - ?vtrace("find_node(tree,variable) -> entry",[]), - {false, noSuchInstance}; -find_node(D, {node, subagent}, _RestOfOid, SARevOid) -> - ?vtrace("find_node(tree,subagent) -> entry with" - "~n SARevOid: ~p",[SARevOid]), - #mib_data{subagents = SAs} = D, - SAOid = lists:reverse(SARevOid), - case lists:keysearch(SAOid, 2, SAs) of - {value, {SubAgentPid, SAOid}} -> - {subagent, SubAgentPid, SAOid}; - false -> - ?vinfo("find_node -> could not find subagent with" - "~n SAOid: ~p" - "~n SAs: ~p", [SAOid, SAs]), - false - end; -find_node(_D, Node, _RestOfOid, _RevOid) -> - ?vtrace("find_node -> failed:~n~p",[Node]), - {false, noSuchObject}. - - -%%----------------------------------------------------------------- -%% Func: next/3 -%% Purpose: Finds the lexicographically next oid. -%% Returns: endOfMibView | -%% {subagent, SubAgentPid, SAOid} | -%% {variable, MibEntry, VarOid} | -%% {table, TableOid, TableRestOid, MibEntry} -%% If a variable is returnes, it is in the MibView. -%% If a table or subagent is returned, it *may* be in the MibView. -%%----------------------------------------------------------------- -next(#mib_data{tree = T} = D, Oid, MibView) -> - case catch next_node(D, T#tree.root, Oid, [], MibView) of - false -> endOfMibView; - Else -> Else - end. - -%%----------------------------------------------------------------- -%% This function is used as long as we have any Oid left. Take -%% one integer at a time from the Oid, and traverse the tree -%% accordingly. When the Oid is empty, call find_next. -%% Returns: {subagent, SubAgentPid, SAOid} | -%% false | -%% {variable, MibEntry, VarOid} | -%% {table, TableOid, TableRestOid, MibEntry} -%%----------------------------------------------------------------- -next_node(_D, undefined_node, _Oid, _RevOidSoFar, _MibView) -> - ?vtrace("next_node(undefined_node) -> entry", []), - false; - -next_node(_D, {tree, Tree, {table_entry, _Id}}, [Int | _Oid], - _RevOidSoFar, _MibView) - when Int+1 > size(Tree) -> - ?vtrace("next_node(tree,table_entry) -> entry when not found whith" - "~n Int: ~p" - "~n size(Tree): ~p", [Int, size(Tree)]), - false; -next_node(D, {tree, Tree, {table_entry, _MibName}}, - Oid, RevOidSoFar, MibView) -> - ?vtrace("next_node(tree,table_entry) -> entry when" - "~n size(Tree): ~p" - "~n Oid: ~p" - "~n RevOidSoFar: ~p" - "~n MibView: ~p", [size(Tree), Oid, RevOidSoFar, MibView]), - OidSoFar = lists:reverse(RevOidSoFar), - case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of - true -> - ?vdebug("next_node(tree,table_entry) -> not in mib view",[]), - false; - _ -> - #mib_data{node_db = Db} = D, - case snmpa_general_db:read(Db, OidSoFar) of - false -> - ?vinfo("next_node -> could not find table_entry with" - "~n OidSoFar: ~p", [OidSoFar]), - false; - {value, #node_info{me = ME}} -> - ?vtrace("next_node(tree,table_entry) -> found: ~n ~p", - [ME]), - {table, OidSoFar, Oid, ME} - end - end; - -next_node(D, {tree, Tree, _Info}, [Int | RestOfOid], RevOidSoFar, MibView) - when (Int < size(Tree)) andalso (Int >= 0) -> - ?vtrace("next_node(tree) -> entry when" - "~n size(Tree): ~p" - "~n Int: ~p" - "~n RestOfOid: ~p" - "~n RevOidSoFar: ~p" - "~n MibView: ~p", - [size(Tree), Int, RestOfOid, RevOidSoFar, MibView]), - case next_node(D, element(Int+1,Tree), - RestOfOid, [Int|RevOidSoFar], MibView) of - false -> - find_next(D, {tree, Tree, _Info}, Int+1, RevOidSoFar, MibView); - Else -> - Else - end; -%% no solution -next_node(D, {tree, Tree, _Info}, [], RevOidSoFar, MibView) -> - ?vtrace("next_node(tree,[]) -> entry when" - "~n size(Tree): ~p" - "~n RevOidSoFar: ~p" - "~n MibView: ~p", - [size(Tree), RevOidSoFar, MibView]), - find_next(D, {tree, Tree, _Info}, 0, RevOidSoFar, MibView); -next_node(_D, {tree, Tree, _Info}, _RestOfOid, _RevOidSoFar, _MibView) -> - ?vtrace("next_node(tree) -> entry when" - "~n size(Tree): ~p", [size(Tree)]), - false; - -next_node(D, {node, subagent}, Oid, RevOidSoFar, MibView) -> - ?vtrace("next_node(node,subagent) -> entry when" - "~n Oid: ~p" - "~n RevOidSoFar: ~p" - "~n MibView: ~p", - [Oid, RevOidSoFar, MibView]), - OidSoFar = lists:reverse(RevOidSoFar), - case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of - true -> - false; - _ -> - #mib_data{subagents = SAs} = D, - case lists:keysearch(OidSoFar, 2, SAs) of - {value, {SubAgentPid, OidSoFar}} -> - {subagent, SubAgentPid, OidSoFar}; - _ -> - ?vinfo("next_node -> could not find subagent with" - "~n OidSoFar: ~p" - "~n SAs: ~p", [OidSoFar, SAs]), - false - end - end; - -next_node(D, {node, {variable, _MibName}}, [], RevOidSoFar, MibView) -> - ?vtrace("next_node(node,variable,[]) -> entry when" - "~n RevOidSoFar: ~p" - "~n MibView: ~p", - [RevOidSoFar, MibView]), - OidSoFar = lists:reverse([0 | RevOidSoFar]), - case snmpa_acm:validate_mib_view(OidSoFar, MibView) of - true -> - #mib_data{node_db = Db} = D, - case snmpa_general_db:read(Db, lists:reverse(RevOidSoFar)) of - false -> - ?vinfo("next_node -> could not find variable with" - "~n RevOidSoFar: ~p", [RevOidSoFar]), - false; - {value, #node_info{me = ME}} -> - {variable, ME, OidSoFar} - end; - _ -> - false - end; - -next_node(_D, {node, {variable, _MibName}}, _Oid, _RevOidSoFar, _MibView) -> - ?vtrace("next_node(node,variable) -> entry", []), - false. - -%%----------------------------------------------------------------- -%% This function is used to find the first leaf from where we -%% are. -%% Returns: {subagent, SubAgentPid, SAOid} | -%% false | -%% {variable, MibEntry, VarOid} | -%% {table, TableOid, TableRestOid, MibEntry} -%% PRE: This function must always be called with a {internal, Tree} -%% node. -%%----------------------------------------------------------------- -find_next(D, {tree, Tree, internal}, Idx, RevOidSoFar, MibView) - when Idx < size(Tree) -> - case find_next(D, element(Idx+1, Tree), 0, [Idx| RevOidSoFar], MibView) of - false -> - find_next(D, {tree, Tree, internal}, Idx+1, RevOidSoFar, MibView); - Other -> - Other - end; -find_next(_D, {tree, _Tree, internal}, _Idx, _RevOidSoFar, _MibView) -> - false; -find_next(_D, undefined_node, _Idx, _RevOidSoFar, _MibView) -> - false; -find_next(D, {tree, Tree, {table, _MibName}}, Idx, RevOidSoFar, MibView) -> - find_next(D, {tree, Tree, internal}, Idx, RevOidSoFar, MibView); -find_next(D, {tree, _Tree, {table_entry, _MibName}}, _Index, - RevOidSoFar, MibView) -> - OidSoFar = lists:reverse(RevOidSoFar), - case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of - true -> - false; - _ -> - #mib_data{node_db = Db} = D, - case snmpa_general_db:read(Db, OidSoFar) of - false -> - ?vinfo("find_next -> could not find table_entry ME with" - "~n OidSoFar: ~p", [OidSoFar]), - false; - {value, #node_info{me = ME}} -> - {table, OidSoFar, [], ME} - end - end; -find_next(D, {node, {variable, _MibName}}, _Idx, RevOidSoFar, MibView) -> - OidSoFar = lists:reverse([0 | RevOidSoFar]), - case snmpa_acm:validate_mib_view(OidSoFar, MibView) of - true -> - #mib_data{node_db = Db} = D, - case snmpa_general_db:read(Db, lists:reverse(RevOidSoFar)) of - false -> - ?vinfo("find_next -> could not find variable with" - "~n RevOidSoFar: ~p", [RevOidSoFar]), - false; - {value, #node_info{me = ME}} -> - {variable, ME, OidSoFar} - end; - _ -> - false - end; -find_next(D, {node, subagent}, _Idx, RevOidSoFar, MibView) -> - OidSoFar = lists:reverse(RevOidSoFar), - case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of - true -> - false; - _ -> - #mib_data{subagents = SAs} = D, - case lists:keysearch(OidSoFar, 2, SAs) of - {value, {SubAgentPid, OidSoFar}} -> - {subagent, SubAgentPid, OidSoFar}; - false -> - ?vinfo("find_node -> could not find subagent with" - "~n OidSoFar: ~p" - "~n SAs: ~p", [OidSoFar, SAs]), - false - end - end. - -%%%====================================================================== -%%% 3. Tree building functions -%%% Used when loading mibs. -%%%====================================================================== - -build_tree(Mes, MibName) -> - ?d("build_tree -> " - "~n Mes: ~p", [Mes]), - {ListTree, []} = build_subtree([], Mes, MibName), - {tree, convert_tree(ListTree), internal}. - -%%---------------------------------------------------------------------- -%% Purpose: Builds the tree where all oids have prefix equal to LevelPrefix. -%% Returns: {Tree, RestMes} -%% RestMes are Mes that should not be in this subtree. -%% The Tree is a temporary and simplified data structure that is easy to -%% convert to the final tuple tree used by the MIB process. -%% A Node is represented as in the final tree. -%% The tree is not represented as a N-tuple, but as an Index-list. -%% Example: Temporary: [{1, Node1}, {3, Node3}] -%% Final: {Node1, undefined_node, Node3} -%% Pre: Mes are sorted on oid. -%%---------------------------------------------------------------------- -build_subtree(LevelPrefix, [Me | Mes], MibName) -> - ?vtrace("build subtree -> ~n" - " oid: ~p~n" - " LevelPrefix: ~p~n" - " MibName: ~p", [Me#me.oid, LevelPrefix, MibName]), - EType = Me#me.entrytype, - ?vtrace("build subtree -> EType = ~p",[EType]), - case in_subtree(LevelPrefix, Me) of - above -> - ?vtrace("build subtree -> above",[]), - {[], [Me|Mes]}; - {node, Index} -> - ?vtrace("build subtree -> node at ~p",[Index]), - {Tree, RestMes} = build_subtree(LevelPrefix, Mes, MibName), - {[{Index, {node, {EType, MibName}}} | Tree], RestMes}; - {subtree, Index, NewLevelPrefix} -> - ?vtrace("build subtree -> subtree at" - "~n ~w with ~w", - [Index, NewLevelPrefix]), - {BelowTree, RestMes} = - build_subtree(NewLevelPrefix, Mes, MibName), - {CurTree, RestMes2} = - build_subtree(LevelPrefix, RestMes, MibName), - {[{Index, {tree, BelowTree, {EType,MibName}}}| CurTree], RestMes2}; - {internal_subtree, Index, NewLevelPrefix} -> - ?vtrace("build subtree -> internal_subtree at" - "~n ~w with ~w", - [Index,NewLevelPrefix]), - {BelowTree, RestMes} = - build_subtree(NewLevelPrefix, [Me | Mes], MibName), - {CurTree, RestMes2} = - build_subtree(LevelPrefix, RestMes, MibName), - {[{Index, {tree, BelowTree, internal}} | CurTree], RestMes2} - end; - -build_subtree(_LevelPrefix, [], _MibName) -> - ?vtrace("build subtree -> done", []), - {[], []}. - -%%-------------------------------------------------- -%% Purpose: Determine how/if/where Me should be inserted in subtree -%% with LevelPrefix. This function does not build any tree, only -%% determinses what should be done (by build subtree). -%% Returns: -%% above - Indicating that this ME should _not_ be in this subtree. -%% {node, Index} - yes, construct a node with index Index on this level -%% {internal_subtree, Index, NewLevelPrefix} - yes, there should be an -%% internal subtree at this index. -%% {subtree, Index, NewLevelPrefix} - yes, construct a subtree with -%% NewLevelPrefix and insert this on current level in position Index. -%%-------------------------------------------------- -in_subtree(LevelPrefix, Me) -> - case lists:prefix(LevelPrefix, Me#me.oid) of - true when length(Me#me.oid) > length(LevelPrefix) -> - classify_how_in_subtree(LevelPrefix, Me); - _ -> - above - end. - -%%-------------------------------------------------- -%% See comment about in_subtree/2. This function takes care of all cases -%% where the ME really should be in _this_ subtree (not above). -%%-------------------------------------------------- -classify_how_in_subtree(LevelPrefix, Me) - when (length(Me#me.oid) =:= (length(LevelPrefix) + 1)) -> - Oid = Me#me.oid, - case node_or_subtree(Me#me.entrytype) of - subtree -> - {subtree, lists:last(Oid), Oid}; - node -> - {node, lists:last(Oid)} - end; - -classify_how_in_subtree(LevelPrefix, Me) - when (length(Me#me.oid) > (length(LevelPrefix) + 1)) -> - L1 = length(LevelPrefix) + 1, - Oid = Me#me.oid, - {internal_subtree, lists:nth(L1, Oid), lists:sublist(Oid, 1, L1)}. - -%%-------------------------------------------------- -%% Determines how to treat different kinds om MEs in the tree building process. -%% Pre: all internal nodes have been removed. -%%-------------------------------------------------- -node_or_subtree(table) -> subtree; -node_or_subtree(table_entry) -> subtree; -node_or_subtree(variable) -> node; -node_or_subtree(table_column) -> node. - -%%-------------------------------------------------- -%% Purpose: (Recursively) Converts a temporary tree (see above) to a final tree. -%% If input is a ListTree, output is a TupleTree. -%% If input is a Node, output is the same Node. -%% Pre: All Indexes are >= 0. -%%-------------------------------------------------- -convert_tree({Index, {tree, Tree, Info}}) when Index >= 0 -> - L = lists:map(fun convert_tree/1, Tree), - {Index, {tree, dict_list_to_tuple(L), Info}}; -convert_tree({Index, {node, Info}}) when Index >= 0 -> - {Index, {node, Info}}; -convert_tree(Tree) when is_list(Tree) -> - L = lists:map(fun convert_tree/1, Tree), - dict_list_to_tuple(L). - -%%---------------------------------------------------------------------- -%% Purpose: Converts a single level (that is non-recursively) from -%% the temporary indexlist to the N-tuple. -%% Input: A list of {Index, Data}. -%% Output: A tuple where element Index is Data. -%%---------------------------------------------------------------------- -dict_list_to_tuple(L) -> - L2 = lists:keysort(1, L), - list_to_tuple(integrate_indexes(0, L2)). - -%%---------------------------------------------------------------------- -%% Purpose: Helper function for dict_list_to_tuple/1. -%% Converts an indexlist to a N-list. -%% Input: A list of {Index, Data}. -%% Output: A (usually longer, never shorter) list where element Index is Data. -%% Example: [{1,hej}, {3, sven}] will give output -%% [undefined_node, hej, undefined_node, sven]. -%% Initially CurIndex should be 0. -%%---------------------------------------------------------------------- -integrate_indexes(CurIndex, [{CurIndex, Data} | T]) -> - [Data | integrate_indexes(CurIndex + 1, T)]; -integrate_indexes(_Index, []) -> - []; -integrate_indexes(CurIndex, L) -> - [undefined_node | integrate_indexes(CurIndex + 1, L)]. - -%%%====================================================================== -%%% 4. Tree merging -%%% Used by: load mib, insert subagent. -%%%====================================================================== - -%%---------------------------------------------------------------------- -%% Arg: Two root nodes (that is to be merged). -%% Returns: A new root node where the nodes have been merger to one. -%%---------------------------------------------------------------------- -merge_nodes(Same, Same) -> - Same; -merge_nodes(Node, undefined_node) -> - Node; -merge_nodes(undefined_node, Node) -> - Node; -merge_nodes({tree, Tree1, internal}, {tree, Tree2, internal}) -> - {tree, merge_levels(tuple_to_list(Tree1),tuple_to_list(Tree2)), internal}; -merge_nodes(Node1, Node2) -> - throw({error_merge_nodes, Node1, Node2}). - -%%---------------------------------------------------------------------- -%% Arg: Two levels to be merged. -%% Here, a level is represented as a list of nodes. A list is easier -%% to extend than a tuple. -%% Returns: The resulting, merged level tuple. -%%---------------------------------------------------------------------- -merge_levels(Level1, Level2) when length(Level1) =:= length(Level2) -> - MergeNodes = fun(N1, N2) -> merge_nodes(N1, N2) end, - list_to_tuple(snmp_misc:multi_map(MergeNodes, [Level1, Level2])); -merge_levels(Level1, Level2) when length(Level1) > length(Level2) -> - merge_levels(Level1, Level2 ++ - undefined_nodes_list(length(Level1) - length(Level2))); -merge_levels(Level1, Level2) when length(Level1) < length(Level2) -> - merge_levels(Level2, Level1). - -undefined_nodes_list(N) -> lists:duplicate(N, undefined_node). - - -%%%====================================================================== -%%% 5. Tree deletion routines -%%% (for unload mib) -%%%====================================================================== - -%%---------------------------------------------------------------------- -%% Purpose: Actually kicks of the tree reconstruction. -%% Returns: {list of removed MEs, NewTree} -%%---------------------------------------------------------------------- -delete_mib_from_tree(MibName, {tree, Tree, internal}) -> - case delete_tree(Tree, MibName) of - [] -> - {tree, {undefined_node}, internal}; % reduce - LevelList -> - {tree, list_to_tuple(LevelList), internal} - end. - -%%---------------------------------------------------------------------- -%% Purpose: Deletes all nodes associated to MibName from this level and -%% all levels below. -%% If the new level does not contain information (that is, no -%% other mibs use it) anymore the empty list is returned. -%% Returns: {MEs, The new level represented as a list} -%%---------------------------------------------------------------------- -delete_tree(Tree, MibName) when is_tuple(Tree) -> - NewLevel = delete_nodes(tuple_to_list(Tree), MibName, []), - case lists:filter(fun drop_undefined_nodes/1,NewLevel) of - [] -> []; - _A_perhaps_shorted_list -> - NewLevel % some other mib needs this level - end. - -%%---------------------------------------------------------------------- -%% Purpose: Nodes belonging to MibName are removed from the tree. -%% Recursively deletes sub trees to this node. -%% Returns: {MEs, NewNodesList} -%%---------------------------------------------------------------------- -delete_nodes([], _MibName, AccNodes) -> - lists:reverse(AccNodes); - -delete_nodes([{node, {variable, MibName}}|T], MibName, AccNodes) -> - delete_nodes(T, MibName, [undefined_node | AccNodes]); - -delete_nodes([{node, {table_column, MibName}}|T], MibName, AccNodes) -> - delete_nodes(T, MibName, [undefined_node | AccNodes]); - -delete_nodes([{tree, _Tree, {table, MibName}}|T], MibName, AccNodes) -> - delete_nodes(T, MibName, [undefined_node | AccNodes]); - -delete_nodes([{tree, _Tree, {table_entry, MibName}}|T], MibName, AccNodes) -> - delete_nodes(T, MibName, [undefined_node | AccNodes]); - -delete_nodes([{tree, Tree, Info}|T], MibName, AccNodes) -> - case delete_tree(Tree, MibName) of - [] -> % tree completely deleted - delete_nodes(T, MibName, [undefined_node | AccNodes]); - LevelList -> - delete_nodes(T, MibName, - [{tree, list_to_tuple(LevelList), Info} | AccNodes]) - end; - -delete_nodes([NodeToKeep|T], MibName, AccNodes) -> - delete_nodes(T, MibName, [NodeToKeep | AccNodes]). - -drop_undefined_nodes(undefined_node) -> false; -drop_undefined_nodes(_) -> true. - - -%%%====================================================================== -%%% 6. Functions for subagent handling -%%%====================================================================== - -%%---------------------------------------------------------------------- -%% Returns: A new Root|{error, reason} -%%---------------------------------------------------------------------- -insert_subagent(Oid, OldRoot) -> - ListTree = build_tree_for_subagent(Oid), - case catch convert_tree(ListTree) of - {'EXIT', _Reason} -> - {error, 'cannot construct tree from oid'}; - Level when is_tuple(Level) -> - T = {tree, Level, internal}, - case catch merge_nodes(T, OldRoot) of - {error_merge_nodes, _Node1, _Node2} -> - {error, oid_conflict}; - NewRoot when is_tuple(NewRoot) andalso - (element(1, NewRoot) =:= tree) -> - NewRoot - end - end. - -build_tree_for_subagent([Index]) -> - [{Index, {node, subagent}}]; - -build_tree_for_subagent([Index | T]) -> - [{Index, {tree, build_tree_for_subagent(T), internal}}]. +-type mib_view() :: [mib_view_elem()]. +-type mib_view_elem() :: {SubTree :: snmp:oid(), + Mask :: [non_neg_integer()], + Inclusion :: mib_view_inclusion()}. +-type mib_view_mask() :: [non_neg_integer()]. +-type mib_view_inclusion() :: 1 | 2. % 1 = included, 2 = excluded -%%---------------------------------------------------------------------- -%% Returns: A new tree where the subagent at Oid (2nd arg) has been deleted. -%%---------------------------------------------------------------------- -delete_subagent({tree, Tree, Info}, [Index]) -> - {node, subagent} = element(Index+1, Tree), - {tree, setelement(Index+1, Tree, undefined_node), Info}; -delete_subagent({tree, Tree, Info}, [Index | TI]) -> - {tree, setelement(Index+1, Tree, - delete_subagent(element(Index+1, Tree), TI)), Info}. +-type filename() :: file:filename(). -%%%====================================================================== -%%% 7. Misc functions -%%%====================================================================== -%%---------------------------------------------------------------------- -%% Installs the mibs found in the database when starting the agent. -%% Basically calls the instrumentation functions for all non-internal -%% mib-entries -%%---------------------------------------------------------------------- -install_mibs(MibDb, NodeDb) -> - MibNames = loaded(MibDb), - ?vtrace("install_mibs -> found following mibs in database: ~n" - "~p", [MibNames]), - install_mibs2(NodeDb, MibNames). +-callback new(MibStorage :: snmpa:mib_storage()) -> State :: term(). -install_mibs2(_, []) -> - ok; -install_mibs2(NodeDb, [MibName|MibNames]) -> - Pattern = #node_info{oid = '_', mib_name = MibName, me = '_'}, - Nodes = snmpa_general_db:match_object(NodeDb, Pattern), - MEs = [ME || #node_info{me = ME} <- Nodes], - ?vtrace("install_mibs2 -> installing ~p MEs for mib ~p", - [length(MEs),MibName]), - NewF = fun(ME) -> call_instrumentation(ME, new) end, - lists:foreach(NewF, MEs), - install_mibs2(NodeDb, MibNames). - - -%%---------------------------------------------------------------------- -%% Does all side effect stuff during load_mib. -%%---------------------------------------------------------------------- -install_mib(Db, Symbolic, Mib, MibName, FileName, NonInternalMes) -> - ?vdebug("install_mib -> entry with" - "~n Symbolic: ~p" - "~n MibName: ~p" - "~n FileName: ~p", [Symbolic, MibName, FileName]), - Rec = #mib_info{name = MibName, symbolic = Symbolic, file_name = FileName}, - snmpa_general_db:write(Db, Rec), - install_mib2(Symbolic, MibName, Mib), - NewF = fun(ME) -> call_instrumentation(ME, new) end, - lists:foreach(NewF, NonInternalMes). +-callback close(State :: term()) -> ok. -install_mib2(true, MibName, Mib) -> - #mib{table_infos = TabInfos, - variable_infos = VarInfos, - mes = MEs, - asn1_types = ASN1Types, - traps = Traps} = Mib, - snmpa_symbolic_store:add_table_infos(MibName, TabInfos), - snmpa_symbolic_store:add_variable_infos(MibName, VarInfos), - snmpa_symbolic_store:add_aliasnames(MibName, MEs), - snmpa_symbolic_store:add_types(MibName, ASN1Types), - SetF = fun(Trap) -> - snmpa_symbolic_store:set_notification(Trap, MibName) - end, - lists:foreach(SetF, Traps); -install_mib2(_, _, _) -> - ok. +-callback sync(State :: term()) -> ok. -install_mes(_Db, _MibName, []) -> - ok; -install_mes(Db, MibName, [ME|MEs]) -> - Node = #node_info{oid = ME#me.oid, mib_name = MibName, me = ME}, - snmpa_general_db:write(Db, Node), - install_mes(Db, MibName, MEs). +-callback load_mib(State :: term(), FileName :: string(), + MeOverride :: boolean(), + TeOverride :: boolean()) -> + {ok, NewState :: term()} | {error, Reason :: already_loaded | term()}. +-callback unload_mib(State :: term(), FileName :: string(), + MeOverride :: boolean(), + TeOverride :: boolean()) -> + {ok, NewState :: term()} | {error, Reason :: not_loaded | term()}. -%%---------------------------------------------------------------------- -%% Does all side effect stuff during unload_mib. -%%---------------------------------------------------------------------- -uninstall_mib(Db, Symbolic, MibName, MEs) -> - ?vtrace("uninstall_mib -> entry with" - "~n Db: ~p" - "~n Symbolic: ~p" - "~n MibName: ~p", [Db, Symbolic, MibName]), - Res = snmpa_general_db:delete(Db, MibName), - ?vtrace("uninstall_mib -> (mib) db delete result: ~p", [Res]), - uninstall_mib2(Symbolic, MibName), - DelF = fun(ME) -> call_instrumentation(ME, delete) end, - lists:foreach(DelF, MEs). +-callback lookup(State :: term(), Oid :: snmp:oid()) -> + {false, Reason :: term()} | + {variable, MibEntry :: snmpa:me()} | + {table_column, MibEntry :: snmpa:me(), TableEntryOid :: snmp:oid()} | + {subagent, SubAgentPid :: pid(), SAOid :: snmp:oid()}. -uninstall_mib2(true, MibName) -> - snmpa_symbolic_store:delete_table_infos(MibName), - snmpa_symbolic_store:delete_variable_infos(MibName), - snmpa_symbolic_store:delete_aliasnames(MibName), - snmpa_symbolic_store:delete_types(MibName), - snmpa_symbolic_store:delete_notifications(MibName); -uninstall_mib2(_, _) -> - ok. +-callback next(State :: term(), Oid :: snmp:oid(), MibView :: mib_view()) -> + endOfView | false | + {subagent, SubAgentPid :: pid(), SAOid :: snmp:oid()} | + {variable, MibEntry :: snmpa:me(), VarOid :: snmp:oid()} | + {table, TableOid :: snmp:oid(), TableRestOid :: snmp:oid(), MibEntry :: snmpa:me()}. -uninstall_mes(Db, MibName) -> - Pattern = #node_info{oid = '_', mib_name = MibName, me = '_'}, - snmpa_general_db:match_delete(Db, Pattern). +-callback register_subagent(State :: term(), + Oid :: snmp:oid(), + Pid :: pid()) -> + {ok, NewState :: term()} | {error, Reason :: term()}. +-callback unregister_subagent(State :: term(), + PidOrOid :: pid() | snmp:oid()) -> + {ok, NewState :: term()} | % When second arg was a pid() + {ok, NewState :: term(), Pid :: pid()} | % When second arg was a oid() + {error, Reason :: term()}. -%%---------------------------------------------------------------------- -%% Create a list of the names of all the loaded mibs -%%---------------------------------------------------------------------- -loaded(Db) -> - [N || #mib_info{name = N} <- snmpa_general_db:tab2list(Db)]. - +-callback dump(State :: term(), Destination :: io | filename()) -> + ok | {error, Reason :: term()}. -%%---------------------------------------------------------------------- -%% Calls MFA-instrumentation with 'new' or 'delete' operation. -%%---------------------------------------------------------------------- -call_instrumentation(#me{entrytype = variable, mfa={M,F,A}}, Operation) -> - ?vtrace("call instrumentation with" - "~n entrytype: variable" - "~n MFA: {~p,~p,~p}" - "~n Operation: ~p", - [M,F,A,Operation]), - catch apply(M, F, [Operation | A]); -call_instrumentation(#me{entrytype = table_entry, mfa={M,F,A}}, Operation) -> - ?vtrace("call instrumentation with" - "~n entrytype: table_entry" - "~n MFA: {~p,~p,~p}" - "~n Operation: ~p", - [M,F,A,Operation]), - catch apply(M, F, [Operation | A]); -call_instrumentation(_ShitME, _Operation) -> - done. +-callback which_mib(State :: term(), Oid :: snmp:oid()) -> + {ok, Mib :: string()} | {error, Reason :: term()}. +-callback which_mibs(State :: term()) -> + [{MibName :: atom(), Filename :: string()}]. -maybe_drop_me(#me{entrytype = internal}) -> false; -maybe_drop_me(#me{entrytype = group}) -> false; -maybe_drop_me(#me{imported = true}) -> false; -maybe_drop_me(_) -> true. +-callback whereis_mib(State :: term(), MibName :: atom()) -> + {ok, Filename :: string()} | {error, Reason :: term()}. +-callback info(State :: term()) -> list(). -%%---------------------------------------------------------------------- -%% Code change functions -%%---------------------------------------------------------------------- +-callback backup(State :: term(), BackupDir :: string()) -> + ok | {error, Reason :: term()}. -code_change(down, State) -> - ?d("code_change(down) -> entry",[]), - State; +-callback code_change(Direction :: up | down, + Vsn :: term(), + Extra :: term(), + State :: term()) -> + NewState :: term(). -code_change(up, State) -> - ?d("code_change(up)",[]), - State; -code_change(_Vsn, State) -> - State. diff --git a/lib/snmp/src/agent/snmpa_mib_data_ttln.erl b/lib/snmp/src/agent/snmpa_mib_data_ttln.erl new file mode 100644 index 0000000000..d367e8f13f --- /dev/null +++ b/lib/snmp/src/agent/snmpa_mib_data_ttln.erl @@ -0,0 +1,1402 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. 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(snmpa_mib_data_ttln). + +%%%----------------------------------------------------------------- +%%% +%%% THIS FILE IS JUST A PLACE HOLDER - IGNORE +%%% +%%%----------------------------------------------------------------- + + +%%%----------------------------------------------------------------- +%%% +%%% TTLN - TupleTreeListNodes +%%% +%%% This module implements the MIB internal data structures. +%%% An MIB Data Structure consists of three items; an ets-table, +%%% a tree and a list of registered subagents. +%%% The subagent information is consequently duplicated. It resides +%%% both in the tree and in the list. +%%% The ets-table contains all data associated with each variable, +%%% table, tableentry and tablecolumn in the MIB. +%%% The tree contains information of the Oids in the MIB. +%%% +%%% When a mib is loaded, the tree is built from the plain list +%%% in the binary file. +%%% +%%%----------------------------------------------------------------- + +-include("snmp_types.hrl"). +-include("snmp_debug.hrl"). + +-define(VMODULE,"MDATA_TTLN"). +-include("snmp_verbosity.hrl"). + +-behaviour(snmpa_mib_data). + +-define(MIB_DATA, snmpa_mib_data). +-define(MIB_NODE, snmpa_mib_node). +-define(MIB_TREE, snmpa_mib_tree). +-define(DUMMY_TREE_GENERATION, 1). +-define(DEFAULT_TREE, {tree,{undefined_node},internal}). + + +%%%----------------------------------------------------------------- +%%% Table of contents +%%% ================= +%%% 1. Interface +%%% 2. Implementation of tree access +%%% 3. Tree building functions +%%% 4. Tree merging +%%% 5. Tree deletion routines +%%% 6. Functions for subagent handling +%%% 7. Misc functions +%%%----------------------------------------------------------------- + + +%%---------------------------------------------------------------------- +%% data_db is an database containing loaded mibs as: +%% {MibName = atom(), Symbolic = ?, FullFileName = string()} +%% it is either ets or mnesia +%% tree_db is a database containing _one_ record with the tree! +%% (the reason for this is part to get replication and part out of convenience) +%% ref_tree is the root node, without any subagent. +%% tree is the root node (same as ref_tree but with the subagents added). +%% subagents is a list of {SAPid, Oid} +%%---------------------------------------------------------------------- +-record(mib_data, {mib_db, % table of #mib_info + node_db, % table of #node_info + tree_db, % table of #tree + tree, % The actual tree + subagents = []}). + +-record(mib_info, {name, symbolic, file_name}). +-record(node_info, {oid, mib_name, me}). + + +%% API +-export([new/0, new/1, sync/1, close/1, + load_mib/4, unload_mib/4, which_mibs/1, whereis_mib/2, + info/1, info/2, + dump/1, dump/2, + backup/2, + lookup/2, next/3, which_mib/2, + register_subagent/3, unregister_subagent/2]). + +%% Internal exports +-export([code_change/2]). + + +%%----------------------------------------------------------------- +%% A tree is represented as a N-tuple, where each element is a +%% node. A node is: +%% 1) {tree, Tree, Info} where Info can be {table, Id}, {table_entry, Id} +%% or perhaps 'internal' +%% 2) undefined_node (memory optimization (instead of {node, undefined})) +%% 3) {node, Info} where Info can be {subagent, Pid}, {variable, Id}, +%% {table_column, Id} +%% Id is {MibName, MibEntry} +%% The over all root is represented as {tree, Tree, internal}. +%% +%% tree() = {tree, nodes(), tree_info()} +%% nodes() = [tree() | node() | undefined_node] +%% node() = {node, node_info()} +%% tree_info() = {table, Id} | {table_entry, Id} | internal +%% node_info() = {subagent, Pid} | {variable, Id} | {table_colum, Id} +%%----------------------------------------------------------------- + +-type tree_generation() :: non_neg_integer(). +-type tree() :: #tree{}. +-type tree_nodes() :: [tree_node()]. +-type tree_node() :: tree() | + tree_node_elem() | + tree_node_empty(). +-type tree_node_elem() :: {node, tree_node_info()}. +-type tree_node_info() :: {subagent, Pid :: pid()} | + {variable, Id :: non_neg_integer()} | + {table_column, Id :: non_neg_integer()}. +-type tree_node_empty() :: {undefined_node, N :: pos_integer()}. +-type tree_info() :: {table, Id :: non_neg_integer()} | + {table_entry, Id :: non_neg_integer()} | + internal. + + +%% This record is what is stored in the database. The 'tree' part +%% is described above... +-record(mtree, + { + generation = ?DUMMY_TREE_GENERATION :: tree_generation(), + root = ?DEFAULT_TREE :: tree() + }). + +-record(tree, + { + %% The number of nodes is *not* actually the length of the + %% nodes list. Since the undefined-node(s) can be collapsed + %% into {undefined_node, N} we need to keep track of the + %% actual size some other way (so that we dont have the + %% traverse the nodes every time we want to check an index). + num_nodes :: non_neg_integer(), + nodes :: tree_nodes(), + tree_info :: tree_info() + }). + + + + +%%%====================================================================== +%%% 1. Interface +%%%====================================================================== + +%%----------------------------------------------------------------- +%% Func: new/0, new/1 +%% Returns: A representation of mib data. +%%----------------------------------------------------------------- +new() -> + new(ets). + +%% Where -> A list of nodes where the tables will be created +new(Storage) -> + %% First we must check if there is already something to read + %% If a database already exists, then the tree structure has to be read + ?vtrace("open (mib) database",[]), + MibDb = snmpa_general_db:open(Storage, ?MIB_DATA, + mib_info, + record_info(fields, mib_info), set), + ?vtrace("open (mib) node database",[]), + NodeDb = snmpa_general_db:open(Storage, ?MIB_NODE, + node_info, + record_info(fields, node_info), set), + ?vtrace("open (mib) tree database",[]), + TreeDb = snmpa_general_db:open(Storage, ?MIB_TREE, + tree, + record_info(fields, mtree), set), + MTree = + case snmpa_general_db:read(TreeDb, ?DUMMY_TREE_GENERATION) of + false -> + T = #mtree{}, + snmpa_general_db:write(TreeDb, T), + T; + {value, T} -> + T + end, + install_mibs(MibDb, NodeDb), + #mib_data{mib_db = MibDb, + node_db = NodeDb, + tree_db = TreeDb, + mtree = MTree}. + + +%%---------------------------------------------------------------------- +%% Returns: new mib data | {error, Reason} +%%---------------------------------------------------------------------- +load_mib(MibData,FileName,MeOverride,TeOverride) + when is_record(MibData,mib_data) andalso is_list(FileName) -> + ?vlog("load mib file: ~p",[FileName]), + ActualFileName = filename:rootname(FileName, ".bin") ++ ".bin", + MibName = list_to_atom(filename:basename(FileName, ".bin")), + (catch do_load_mib(MibData, ActualFileName, MibName, + MeOverride, TeOverride)). + +do_load_mib(MibData, ActualFileName, MibName, MeOverride, TeOverride) -> + ?vtrace("do_load_mib -> entry with" + "~n ActualFileName: ~s" + "~n MibName: ~p",[ActualFileName, MibName]), + #mib_data{mib_db = MibDb, + node_db = NodeDb, + %% tree_db = TreeDb, + tree = Tree} = MibData, + verify_not_loaded(MibDb, MibName), + ?vtrace("do_load_mib -> already loaded mibs:" + "~n ~p",[loaded(MibDb)]), + Mib = do_read_mib(ActualFileName), + ?vtrace("do_load_mib -> read mib ~s",[Mib#mib.name]), + NonInternalMes = + lists:filter(fun(ME) -> maybe_drop_me(ME) end, Mib#mib.mes), + OldRoot = Tree#tree.root, + T = build_tree(NonInternalMes, MibName), + ?d("load_mib -> " + "~n OldRoot: ~p" + "~n T: ~p", [OldRoot, T]), + case (catch merge_nodes(T, OldRoot)) of + {error_merge_nodes, Node1, Node2} -> + ?vlog("error merging nodes:" + "~n~p~nand~n~p", [Node1,Node2]), + {error, oid_conflict}; + NewRoot when is_tuple(NewRoot) andalso (element(1,NewRoot) =:= tree) -> + ?d("load_mib -> " + "~n NewRoot: ~p", [NewRoot]), + Symbolic = not lists:member(no_symbolic_info, Mib#mib.misc), + case (catch check_notif_and_mes(TeOverride, MeOverride, Symbolic, + Mib#mib.traps, NonInternalMes)) of + true -> + install_mes(NodeDb, MibName, NonInternalMes), + install_mib(MibDb, Symbolic, Mib, + MibName, ActualFileName, NonInternalMes), + ?vtrace("installed mib ~s", [Mib#mib.name]), + Tree2 = Tree#tree{root = NewRoot}, + %% snmpa_general_db:write(TreeDb, Tree2), %% Store later? + {ok, MibData#mib_data{tree = Tree2}}; + Else -> + Else + end + end. + + +verify_not_loaded(Db, Name) -> + case snmpa_general_db:read(Db, Name) of + {value, #mib_info{name = Name}} -> + throw({error, 'already loaded'}); + false -> + ok + end. + +do_read_mib(ActualFileName) -> + case snmp_misc:read_mib(ActualFileName) of + {error, Reason} -> + ?vlog("Failed reading mib file ~p with reason: ~p", + [ActualFileName,Reason]), + throw({error, Reason}); + {ok, Mib} -> + Mib + end. + +%% The Tree DB is handled in a special way since it can be very large. +sync(#mib_data{mib_db = M, + node_db = N, + tree_db = T, tree = Tree, subagents = []}) -> + snmpa_general_db:sync(M), + snmpa_general_db:sync(N), + snmpa_general_db:write(T, Tree), + snmpa_general_db:sync(T); +sync(#mib_data{mib_db = M, + node_db = N, + tree_db = T, tree = Tree, subagents = SAs}) -> + + snmpa_general_db:sync(M), + snmpa_general_db:sync(N), + + %% Ouch. Since the subagent info is dynamic we do not + %% want to store the tree containing subagent info. So, we + %% have to create a tmp tree without those and store it. + + case delete_subagents(Tree, SAs) of + {ok, TreeWithoutSAs} -> + snmpa_general_db:write(T, TreeWithoutSAs), + snmpa_general_db:sync(T); + Error -> + Error + end. + +delete_subagents(Tree, []) -> + {ok, Tree}; +delete_subagents(Tree0, [{_, Oid}|SAs]) -> + case (catch delete_subagent(Tree0, Oid)) of + {tree, _Tree, _Info} = Tree1 -> + delete_subagents(Tree1, SAs); + _Error -> + {error, {'invalid oid', Oid}} + end. + +%%---------------------------------------------------------------------- +%% (OTP-3601) +%%---------------------------------------------------------------------- +check_notif_and_mes(TeOverride,MeOverride,Symbolic,Traps,MEs) -> + ?vtrace("check notifications and mib entries",[]), + check_notifications(TeOverride,Symbolic,Traps), + check_mes(MeOverride,MEs). + +check_notifications(true, _Symbolic, _Traps) -> + ?vtrace("trapentry override = true => skip check",[]), + true; +check_notifications(_, Symbolic, Traps) -> + check_notifications(Symbolic, Traps). + +check_notifications(true, Traps) -> + check_notifications(Traps); +check_notifications(_, _) -> true. + +check_notifications([]) -> true; +check_notifications([#trap{trapname = Key} = Trap | Traps]) -> + ?vtrace("check notification [trap] with Key: ~p",[Key]), + case snmpa_symbolic_store:get_notification(Key) of + {value, Trap} -> check_notifications(Traps); + {value, _} -> throw({error, {'trap already defined', Key}}); + undefined -> check_notifications(Traps) + end; +check_notifications([#notification{trapname = Key} = Notif | Traps]) -> + ?vtrace("check notification [notification] with Key: ~p",[Key]), + case snmpa_symbolic_store:get_notification(Key) of + {value, Notif} -> + check_notifications(Traps); + {value, _} -> + throw({error, {'notification already defined', Key}}); + undefined -> + check_notifications(Traps) + end; +check_notifications([Crap | Traps]) -> + ?vlog("skipped check of: ~n~p",[Crap]), + check_notifications(Traps). + +check_mes(true,_) -> + ?vtrace("mibentry override = true => skip check",[]), + true; +check_mes(_,MEs) -> + check_mes(MEs). + +check_mes([]) -> true; +check_mes([#me{aliasname = Name, oid = Oid1} | MEs]) -> + ?vtrace("check mib entries with aliasname: ~p",[Name]), + case snmpa_symbolic_store:aliasname_to_oid(Name) of + {value, Oid1} -> + check_mes(MEs); + {value, Oid2} -> + ?vinfo("~n expecting '~p'~n but found '~p'",[Oid1, Oid2]), + throw({error, {'mibentry already defined', Name}}); + false -> + check_mes(MEs) + end; +check_mes([Crap | MEs]) -> + ?vlog("skipped check of: ~n~p",[Crap]), + check_mes(MEs). + + + +%%---------------------------------------------------------------------- +%% Returns: new mib data | {error, Reason} +%%---------------------------------------------------------------------- +unload_mib(MibData, FileName, _, _) when is_list(FileName) -> + MibName = list_to_atom(filename:basename(FileName, ".bin")), + (catch do_unload_mib(MibData, MibName)). + +do_unload_mib(MibData, MibName) -> + ?vtrace("do_unload_mib -> entry with" + "~n MibName: ~p", [MibName]), + #mib_data{mib_db = MibDb, + node_db = NodeDb, + %% tree_db = TreeDb, + tree = Tree} = MibData, + #mib_info{symbolic = Symbolic} = verify_loaded(MibDb, MibName), + NewRoot = delete_mib_from_tree(MibName, Tree#tree.root), + MEs = uninstall_mes(NodeDb, MibName), + uninstall_mib(MibDb, Symbolic, MibName, MEs), + NewMibData = MibData#mib_data{tree = Tree#tree{root = NewRoot}}, + {ok, NewMibData}. + +verify_loaded(Db, Name) -> + case snmpa_general_db:read(Db, Name) of + {value, MibInfo} -> + MibInfo; + false -> + throw({error, 'not loaded'}) + end. + + +close(#mib_data{mib_db = MibDb, node_db = NodeDb, tree_db = TreeDb}) -> + snmpa_general_db:close(MibDb), + snmpa_general_db:close(NodeDb), + snmpa_general_db:close(TreeDb), + ok. + +register_subagent(#mib_data{tree = T} = MibData, Oid, Pid) -> + case insert_subagent(Oid, T#tree.root) of + {error, Reason} -> + {error, Reason}; + NewRootTree -> + SAs = [{Pid, Oid} | MibData#mib_data.subagents], + T2 = T#tree{root = NewRootTree}, + MibData#mib_data{tree = T2, subagents = SAs} + end. + + +%%---------------------------------------------------------------------- +%% Purpose: Get a list of all loaded mibs +%% Returns: [{Name, File}] +%%---------------------------------------------------------------------- + +which_mibs(#mib_data{mib_db = Db}) -> + Mibs = snmpa_general_db:tab2list(Db), + [{Name, File} || #mib_info{name = Name, file_name = File} <- Mibs]. + + +%%---------------------------------------------------------------------- +%% Purpose: Get a list of all loaded mibs +%% Returns: [{Name, File}] +%%---------------------------------------------------------------------- + +whereis_mib(#mib_data{mib_db = Db}, Name) -> + case snmpa_general_db:read(Db, Name) of + {value, #mib_info{file_name = File}} -> + {ok, File}; + false -> + {error, not_found} + end. + + +%%---------------------------------------------------------------------- +%% Purpose: Deletes SA with Pid from all subtrees it handles. +%% Returns: NewMibData. +%%---------------------------------------------------------------------- +unregister_subagent(MibData, Pid) when is_pid(Pid) -> + SAs = MibData#mib_data.subagents, + case lists:keysearch(Pid, 1, SAs) of + false -> MibData; + {value, {Pid, Oid}} -> + % we should never get an error since Oid is found in MibData. + {ok, NewMibData, _DeletedSA} = unregister_subagent(MibData, Oid), + % continue if the same Pid handles other mib subtrees. + unregister_subagent(NewMibData, Pid) + end; + +%%---------------------------------------------------------------------- +%% Purpose: Deletes one unique subagent. +%% Returns: {error, Reason} | {ok, NewMibData, DeletedSubagentPid} +%%---------------------------------------------------------------------- +unregister_subagent(#mib_data{tree = T} = MibData, Oid) when is_list(Oid) -> + case catch delete_subagent(T#tree.root, Oid) of + {tree, Tree, Info} -> + OldSAs = MibData#mib_data.subagents, + {value, {Pid, _Oid}} = lists:keysearch(Oid, 2, OldSAs), + SAs = lists:keydelete(Oid, 2, OldSAs), + T2 = T#tree{root = {tree, Tree, Info}}, + {ok, + MibData#mib_data{tree = T2, subagents = SAs}, + Pid}; + _ -> + {error, {'invalid oid', Oid}} + end. + +%%---------------------------------------------------------------------- +%% Purpose: To inpect memory usage, loaded mibs, registered subagents +%%---------------------------------------------------------------------- +info(MibData) -> + ?vtrace("retrieve info",[]), + #mib_data{mib_db = MibDb, node_db = NodeDb, tree_db = TreeDb, + tree = Tree, subagents = SAs} = MibData, + LoadedMibs = old_format(snmpa_general_db:tab2list(MibDb)), + TreeSize = snmp_misc:mem_size(Tree), + {memory, ProcSize} = erlang:process_info(self(),memory), + MibDbSize = snmpa_general_db:info(MibDb, memory), + NodeDbSize = snmpa_general_db:info(NodeDb, memory), + TreeDbSize = snmpa_general_db:info(TreeDb, memory), + [{loaded_mibs, LoadedMibs}, {subagents, SAs}, {tree_size_bytes, TreeSize}, + {process_memory, ProcSize}, + {db_memory, [{mib,MibDbSize},{node,NodeDbSize},{tree,TreeDbSize}]}]. + +info(#mib_data{mib_db = MibDb}, loaded_mibs) -> + Mibs = snmpa_general_db:tab2list(MibDb), + [filename:rootname(FN, ".bin") || #mib_info{file_name = FN} <- Mibs]; +info(#mib_data{tree = Tree}, tree_size_bytes) -> + snmp_misc:mem_size(Tree); +info(_, process_memory) -> + {memory, ProcSize} = erlang:process_info(self(),memory), + ProcSize; +info(#mib_data{mib_db = MibDb, node_db = NodeDb, tree_db = TreeDb}, + db_memory) -> + MibDbSize = snmpa_general_db:info(MibDb, memory), + NodeDbSize = snmpa_general_db:info(NodeDb, memory), + TreeDbSize = snmpa_general_db:info(TreeDb, memory), + [{mib,MibDbSize},{node,NodeDbSize},{tree,TreeDbSize}]; +info(#mib_data{subagents = SAs}, subagents) -> + SAs. + +old_format(LoadedMibs) -> + ?vtrace("convert mib info to old format",[]), + [{N,S,F} || #mib_info{name=N,symbolic=S,file_name=F} <- LoadedMibs]. + + +%%---------------------------------------------------------------------- +%% A total dump for debugging. +%%---------------------------------------------------------------------- +dump(#mib_data{mib_db = MibDb, node_db = NodeDb, tree = Tree}) -> + (catch io:format("MIB-tables:~n~p~n~n", + [snmpa_general_db:tab2list(MibDb)])), + (catch io:format("MIB-entries:~n~p~n~n", + [snmpa_general_db:tab2list(NodeDb)])), + (catch io:format("Tree:~n~p~n", [Tree])), % good luck reading it! + ok. + +dump(#mib_data{mib_db = MibDb, node_db = NodeDb, tree = Tree}, File) -> + case file:open(File,[write]) of + {ok, Fd} -> + io:format(Fd,"~s~n", + [snmp:date_and_time_to_string(snmp:date_and_time())]), + (catch io:format(Fd,"MIB-tables:~n~p~n~n", + [snmpa_general_db:tab2list(MibDb)])), + (catch io:format(Fd, "MIB-entries:~n~p~n~n", + [snmpa_general_db:tab2list(NodeDb)])), + io:format(Fd,"Tree:~n~p~n", [Tree]), % good luck reading it! + file:close(Fd), + ok; + {error,Reason} -> + ?vinfo("~n Failed opening file '~s' for reason ~p", + [File,Reason]), + {error,Reason} + end. + + +backup(#mib_data{mib_db = M, node_db = N, tree_db = T}, BackupDir) -> + MRes = snmpa_general_db:backup(M, BackupDir), + NRes = snmpa_general_db:backup(N, BackupDir), + TRes = snmpa_general_db:backup(T, BackupDir), + handle_backup_res([{mib_db, MRes}, {node_db, NRes}, {tree_db, TRes}]). + +handle_backup_res(Res) -> + handle_backup_res(Res, []). + +handle_backup_res([], []) -> + ok; +handle_backup_res([], Err) -> + {error, lists:reverse(Err)}; +handle_backup_res([{_, ok}|Res], Err) -> + handle_backup_res(Res, Err); +handle_backup_res([{Tag, {error, Reason}}|Res], Err) -> + handle_backup_res(Res, [{Tag, Reason}|Err]); +handle_backup_res([{Tag, Error}|Res], Err) -> + handle_backup_res(Res, [{Tag, Error}|Err]). + + +%%%====================================================================== +%%% 2. Implementation of tree access +%%% lookup and next. +%%%====================================================================== + + +which_mib(#mib_data{tree = T} = D, Oid) -> + ?vtrace("which_mib -> entry with" + "~n Oid: ~p",[Oid]), + case (catch find_node(D, T#tree.root, Oid, [])) of + {variable, _ME, Mib} -> + ?vtrace("which_mib -> variable:" + "~n Mib: ~p", [Mib]), + {ok, Mib}; + {table, _EntryME, _, Mib} -> + ?vtrace("which_mib -> table:" + "~n Mib: ~p", [Mib]), + {ok, Mib}; + {subagent, SubAgentPid, _SANextOid} -> + ?vtrace("which_mib -> subagent:" + "~n SubAgentPid: ~p", [SubAgentPid]), + {error, {subagent, SubAgentPid}}; + {false, ErrorCode} -> + ?vtrace("which_mib -> false:" + "~n ErrorCode: ~p",[ErrorCode]), + {error, ErrorCode}; + false -> + ?vtrace("which_mib -> false",[]), + {error, noSuchObject}; + {'EXIT', R} -> + ?vtrace("which_mib -> exit:" + "~n R: ~p",[R]), + {error, noSuchObject} + end. + + +%%----------------------------------------------------------------- +%% Func: lookup/2 +%% Purpose: Finds the mib entry corresponding to the Oid. If it is a +%% variable, the Oid must be <Oid for var>.0 and if it is +%% a table, Oid must be <table>.<entry>.<col>.<any> +%% Returns: {variable, MibEntry} | +%% {table_column, MibEntry, TableEntryOid} | +%% {subagent, SubAgentPid, SAOid} | +%% {false, Reason} +%%----------------------------------------------------------------- +lookup(#mib_data{tree = T} = D, Oid) -> + ?vtrace("lookup -> entry with" + "~n Oid: ~p",[Oid]), + case (catch find_node(D, T#tree.root, Oid, [])) of + {variable, ME, _Mib} when is_record(ME, me) -> + ?vtrace("lookup -> variable:" + "~n ME: ~p",[ME]), + {variable, ME}; + {table, EntryME, {ColME, TableEntryOid}, _Mib} -> + ?vtrace("lookup -> table:" + "~n EntryME: ~p" + "~n ColME: ~p" + "~n RevTableEntryOid: ~p", + [EntryME, ColME, TableEntryOid]), + MFA = EntryME#me.mfa, + RetME = ColME#me{mfa = MFA}, + {table_column, RetME, TableEntryOid}; + {subagent, SubAgentPid, SANextOid} -> + ?vtrace("lookup -> subagent:" + "~n SubAgentPid: ~p" + "~n SANextOid: ~p", [SubAgentPid, SANextOid]), + {subagent, SubAgentPid, SANextOid}; + {false, ErrorCode} -> + ?vtrace("lookup -> false:" + "~n ErrorCode: ~p",[ErrorCode]), + {false, ErrorCode}; + false -> + ?vtrace("lookup -> false",[]), + {false, noSuchObject}; + {'EXIT', R} -> + ?vtrace("lookup -> exit:" + "~n R: ~p",[R]), + {false, noSuchObject} + end. + + +find_node(D, {tree, Tree, {table, _}}, RestOfOid, RevOid) -> + ?vtrace("find_node(tree,table) -> entry with" + "~n RestOfOid: ~p" + "~n RevOid: ~p",[RestOfOid, RevOid]), + find_node(D, {tree, Tree, internal}, RestOfOid, RevOid); +find_node(D, {tree, Tree, {table_entry, _}}, RestOfOid, RevOid) -> + ?vtrace("find_node(tree,table_entry) -> entry with" + "~n RestOfOid: ~p" + "~n RevOid: ~p",[RestOfOid, RevOid]), + #mib_data{node_db = Db} = D, + Oid = lists:reverse(RevOid), + case snmpa_general_db:read(Db, Oid) of + {value, #node_info{me = ME, mib_name = Mib}} -> + case find_node(D, {tree, Tree, internal}, RestOfOid, RevOid) of + {false, ErrorCode} -> {false, ErrorCode}; + Val -> {table, ME, Val, Mib} + end; + false -> + ?vinfo("find_node -> could not find table_entry ME with" + "~n RevOid: ~p" + "~n when" + "~n RestOfOid: ~p", + [RevOid, RestOfOid]), + false + end; +find_node(D, {tree, Tree, _Internal}, [Int | RestOfOid], RevOid) -> + ?vtrace("find_node(tree) -> entry with" + "~n Int: ~p" + "~n RestOfOid: ~p" + "~n RevOid: ~p",[Int, RestOfOid, RevOid]), + find_node(D, element(Int+1, Tree), RestOfOid, [Int | RevOid]); +find_node(D, {node, {table_column, _}}, RestOfOid, [ColInt | RevOid]) -> + ?vtrace("find_node(tree,table_column) -> entry with" + "~n RestOfOid: ~p" + "~n ColInt: ~p" + "~n RevOid: ~p",[RestOfOid, ColInt, RevOid]), + #mib_data{node_db = Db} = D, + Oid = lists:reverse([ColInt | RevOid]), + case snmpa_general_db:read(Db, Oid) of + {value, #node_info{me = ME}} -> + {ME, lists:reverse(RevOid)}; + false -> + X = snmpa_general_db:read(Db, lists:reverse([ColInt | RevOid])), + ?vinfo("find_node -> could not find table_column ME with" + "~n RevOid: ~p" + "~n trying [~p|~p]" + "~n X: ~p", + [RevOid, [ColInt | RevOid], X]), + false + end; +find_node(D, {node, {variable, _MibName}}, [0], RevOid) -> + ?vtrace("find_node(tree,variable,[0]) -> entry with" + "~n RevOid: ~p",[RevOid]), + #mib_data{node_db = Db} = D, + Oid = lists:reverse(RevOid), + %% {value, #node_info{me = ME}} = snmpa_general_db:read(Db, Oid), + case snmpa_general_db:read(Db, Oid) of + {value, #node_info{me = ME, mib_name = Mib}} -> + {variable, ME, Mib}; + false -> + ?vinfo("find_node -> could not find variable ME with" + "~n RevOid: ~p", [RevOid]), + false + end; +find_node(_D, {node, {variable, _MibName}}, [], _RevOid) -> + ?vtrace("find_node(tree,variable,[]) -> entry",[]), + {false, noSuchObject}; +find_node(_D, {node, {variable, _MibName}}, _, _RevOid) -> + ?vtrace("find_node(tree,variable) -> entry",[]), + {false, noSuchInstance}; +find_node(D, {node, subagent}, _RestOfOid, SARevOid) -> + ?vtrace("find_node(tree,subagent) -> entry with" + "~n SARevOid: ~p",[SARevOid]), + #mib_data{subagents = SAs} = D, + SAOid = lists:reverse(SARevOid), + case lists:keysearch(SAOid, 2, SAs) of + {value, {SubAgentPid, SAOid}} -> + {subagent, SubAgentPid, SAOid}; + false -> + ?vinfo("find_node -> could not find subagent with" + "~n SAOid: ~p" + "~n SAs: ~p", [SAOid, SAs]), + false + end; +find_node(_D, Node, _RestOfOid, _RevOid) -> + ?vtrace("find_node -> failed:~n~p",[Node]), + {false, noSuchObject}. + + +%%----------------------------------------------------------------- +%% Func: next/3 +%% Purpose: Finds the lexicographically next oid. +%% Returns: endOfMibView | +%% {subagent, SubAgentPid, SAOid} | +%% {variable, MibEntry, VarOid} | +%% {table, TableOid, TableRestOid, MibEntry} +%% If a variable is returnes, it is in the MibView. +%% If a table or subagent is returned, it *may* be in the MibView. +%%----------------------------------------------------------------- +next(#mib_data{tree = T} = D, Oid, MibView) -> + case catch next_node(D, T#tree.root, Oid, [], MibView) of + false -> endOfMibView; + Else -> Else + end. + +%%----------------------------------------------------------------- +%% This function is used as long as we have any Oid left. Take +%% one integer at a time from the Oid, and traverse the tree +%% accordingly. When the Oid is empty, call find_next. +%% Returns: {subagent, SubAgentPid, SAOid} | +%% false | +%% {variable, MibEntry, VarOid} | +%% {table, TableOid, TableRestOid, MibEntry} +%%----------------------------------------------------------------- +next_node(_D, undefined_node, _Oid, _RevOidSoFar, _MibView) -> + ?vtrace("next_node(undefined_node) -> entry", []), + false; + +next_node(_D, {tree, Tree, {table_entry, _Id}}, [Int | _Oid], + _RevOidSoFar, _MibView) + when Int+1 > size(Tree) -> + ?vtrace("next_node(tree,table_entry) -> entry when not found whith" + "~n Int: ~p" + "~n size(Tree): ~p", [Int, size(Tree)]), + false; +next_node(D, {tree, Tree, {table_entry, _MibName}}, + Oid, RevOidSoFar, MibView) -> + ?vtrace("next_node(tree,table_entry) -> entry when" + "~n size(Tree): ~p" + "~n Oid: ~p" + "~n RevOidSoFar: ~p" + "~n MibView: ~p", [size(Tree), Oid, RevOidSoFar, MibView]), + OidSoFar = lists:reverse(RevOidSoFar), + case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of + true -> + ?vdebug("next_node(tree,table_entry) -> not in mib view",[]), + false; + _ -> + #mib_data{node_db = Db} = D, + case snmpa_general_db:read(Db, OidSoFar) of + false -> + ?vinfo("next_node -> could not find table_entry with" + "~n OidSoFar: ~p", [OidSoFar]), + false; + {value, #node_info{me = ME}} -> + ?vtrace("next_node(tree,table_entry) -> found: ~n ~p", + [ME]), + {table, OidSoFar, Oid, ME} + end + end; + +next_node(D, {tree, Tree, _Info}, [Int | RestOfOid], RevOidSoFar, MibView) + when (Int < size(Tree)) andalso (Int >= 0) -> + ?vtrace("next_node(tree) -> entry when" + "~n size(Tree): ~p" + "~n Int: ~p" + "~n RestOfOid: ~p" + "~n RevOidSoFar: ~p" + "~n MibView: ~p", + [size(Tree), Int, RestOfOid, RevOidSoFar, MibView]), + case next_node(D, element(Int+1,Tree), + RestOfOid, [Int|RevOidSoFar], MibView) of + false -> + find_next(D, {tree, Tree, _Info}, Int+1, RevOidSoFar, MibView); + Else -> + Else + end; +%% no solution +next_node(D, {tree, Tree, _Info}, [], RevOidSoFar, MibView) -> + ?vtrace("next_node(tree,[]) -> entry when" + "~n size(Tree): ~p" + "~n RevOidSoFar: ~p" + "~n MibView: ~p", + [size(Tree), RevOidSoFar, MibView]), + find_next(D, {tree, Tree, _Info}, 0, RevOidSoFar, MibView); +next_node(_D, {tree, Tree, _Info}, _RestOfOid, _RevOidSoFar, _MibView) -> + ?vtrace("next_node(tree) -> entry when" + "~n size(Tree): ~p", [size(Tree)]), + false; + +next_node(D, {node, subagent}, Oid, RevOidSoFar, MibView) -> + ?vtrace("next_node(node,subagent) -> entry when" + "~n Oid: ~p" + "~n RevOidSoFar: ~p" + "~n MibView: ~p", + [Oid, RevOidSoFar, MibView]), + OidSoFar = lists:reverse(RevOidSoFar), + case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of + true -> + false; + _ -> + #mib_data{subagents = SAs} = D, + case lists:keysearch(OidSoFar, 2, SAs) of + {value, {SubAgentPid, OidSoFar}} -> + {subagent, SubAgentPid, OidSoFar}; + _ -> + ?vinfo("next_node -> could not find subagent with" + "~n OidSoFar: ~p" + "~n SAs: ~p", [OidSoFar, SAs]), + false + end + end; + +next_node(D, {node, {variable, _MibName}}, [], RevOidSoFar, MibView) -> + ?vtrace("next_node(node,variable,[]) -> entry when" + "~n RevOidSoFar: ~p" + "~n MibView: ~p", + [RevOidSoFar, MibView]), + OidSoFar = lists:reverse([0 | RevOidSoFar]), + case snmpa_acm:validate_mib_view(OidSoFar, MibView) of + true -> + #mib_data{node_db = Db} = D, + case snmpa_general_db:read(Db, lists:reverse(RevOidSoFar)) of + false -> + ?vinfo("next_node -> could not find variable with" + "~n RevOidSoFar: ~p", [RevOidSoFar]), + false; + {value, #node_info{me = ME}} -> + {variable, ME, OidSoFar} + end; + _ -> + false + end; + +next_node(_D, {node, {variable, _MibName}}, _Oid, _RevOidSoFar, _MibView) -> + ?vtrace("next_node(node,variable) -> entry", []), + false. + +%%----------------------------------------------------------------- +%% This function is used to find the first leaf from where we +%% are. +%% Returns: {subagent, SubAgentPid, SAOid} | +%% false | +%% {variable, MibEntry, VarOid} | +%% {table, TableOid, TableRestOid, MibEntry} +%% PRE: This function must always be called with a {internal, Tree} +%% node. +%%----------------------------------------------------------------- +find_next(D, {tree, Tree, internal}, Idx, RevOidSoFar, MibView) + when Idx < size(Tree) -> + case find_next(D, element(Idx+1, Tree), 0, [Idx| RevOidSoFar], MibView) of + false -> + find_next(D, {tree, Tree, internal}, Idx+1, RevOidSoFar, MibView); + Other -> + Other + end; +find_next(_D, {tree, _Tree, internal}, _Idx, _RevOidSoFar, _MibView) -> + false; +find_next(_D, undefined_node, _Idx, _RevOidSoFar, _MibView) -> + false; +find_next(D, {tree, Tree, {table, _MibName}}, Idx, RevOidSoFar, MibView) -> + find_next(D, {tree, Tree, internal}, Idx, RevOidSoFar, MibView); +find_next(D, {tree, _Tree, {table_entry, _MibName}}, _Index, + RevOidSoFar, MibView) -> + OidSoFar = lists:reverse(RevOidSoFar), + case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of + true -> + false; + _ -> + #mib_data{node_db = Db} = D, + case snmpa_general_db:read(Db, OidSoFar) of + false -> + ?vinfo("find_next -> could not find table_entry ME with" + "~n OidSoFar: ~p", [OidSoFar]), + false; + {value, #node_info{me = ME}} -> + {table, OidSoFar, [], ME} + end + end; +find_next(D, {node, {variable, _MibName}}, _Idx, RevOidSoFar, MibView) -> + OidSoFar = lists:reverse([0 | RevOidSoFar]), + case snmpa_acm:validate_mib_view(OidSoFar, MibView) of + true -> + #mib_data{node_db = Db} = D, + case snmpa_general_db:read(Db, lists:reverse(RevOidSoFar)) of + false -> + ?vinfo("find_next -> could not find variable with" + "~n RevOidSoFar: ~p", [RevOidSoFar]), + false; + {value, #node_info{me = ME}} -> + {variable, ME, OidSoFar} + end; + _ -> + false + end; +find_next(D, {node, subagent}, _Idx, RevOidSoFar, MibView) -> + OidSoFar = lists:reverse(RevOidSoFar), + case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of + true -> + false; + _ -> + #mib_data{subagents = SAs} = D, + case lists:keysearch(OidSoFar, 2, SAs) of + {value, {SubAgentPid, OidSoFar}} -> + {subagent, SubAgentPid, OidSoFar}; + false -> + ?vinfo("find_node -> could not find subagent with" + "~n OidSoFar: ~p" + "~n SAs: ~p", [OidSoFar, SAs]), + false + end + end. + +%%%====================================================================== +%%% 3. Tree building functions +%%% Used when loading mibs. +%%%====================================================================== + +build_tree(Mes, MibName) -> + ?d("build_tree -> " + "~n Mes: ~p", [Mes]), + {ListTree, []} = build_subtree([], Mes, MibName), + {tree, convert_tree(ListTree), internal}. + +%%---------------------------------------------------------------------- +%% Purpose: Builds the tree where all oids have prefix equal to LevelPrefix. +%% Returns: {Tree, RestMes} +%% RestMes are Mes that should not be in this subtree. +%% The Tree is a temporary and simplified data structure that is easy to +%% convert to the final tuple tree used by the MIB process. +%% A Node is represented as in the final tree. +%% The tree is not represented as a N-tuple, but as an Index-list. +%% Example: Temporary: [{1, Node1}, {3, Node3}] +%% Final: {Node1, undefined_node, Node3} +%% Pre: Mes are sorted on oid. +%%---------------------------------------------------------------------- +build_subtree(LevelPrefix, [Me | Mes], MibName) -> + ?vtrace("build subtree -> ~n" + " oid: ~p~n" + " LevelPrefix: ~p~n" + " MibName: ~p", [Me#me.oid, LevelPrefix, MibName]), + EType = Me#me.entrytype, + ?vtrace("build subtree -> EType = ~p",[EType]), + case in_subtree(LevelPrefix, Me) of + above -> + ?vtrace("build subtree -> above",[]), + {[], [Me|Mes]}; + {node, Index} -> + ?vtrace("build subtree -> node at ~p",[Index]), + {Tree, RestMes} = build_subtree(LevelPrefix, Mes, MibName), + {[{Index, {node, {EType, MibName}}} | Tree], RestMes}; + {subtree, Index, NewLevelPrefix} -> + ?vtrace("build subtree -> subtree at" + "~n ~w with ~w", + [Index, NewLevelPrefix]), + {BelowTree, RestMes} = + build_subtree(NewLevelPrefix, Mes, MibName), + {CurTree, RestMes2} = + build_subtree(LevelPrefix, RestMes, MibName), + {[{Index, {tree, BelowTree, {EType,MibName}}}| CurTree], RestMes2}; + {internal_subtree, Index, NewLevelPrefix} -> + ?vtrace("build subtree -> internal_subtree at" + "~n ~w with ~w", + [Index,NewLevelPrefix]), + {BelowTree, RestMes} = + build_subtree(NewLevelPrefix, [Me | Mes], MibName), + {CurTree, RestMes2} = + build_subtree(LevelPrefix, RestMes, MibName), + {[{Index, {tree, BelowTree, internal}} | CurTree], RestMes2} + end; + +build_subtree(_LevelPrefix, [], _MibName) -> + ?vtrace("build subtree -> done", []), + {[], []}. + +%%-------------------------------------------------- +%% Purpose: Determine how/if/where Me should be inserted in subtree +%% with LevelPrefix. This function does not build any tree, only +%% determinses what should be done (by build subtree). +%% Returns: +%% above - Indicating that this ME should _not_ be in this subtree. +%% {node, Index} - yes, construct a node with index Index on this level +%% {internal_subtree, Index, NewLevelPrefix} - yes, there should be an +%% internal subtree at this index. +%% {subtree, Index, NewLevelPrefix} - yes, construct a subtree with +%% NewLevelPrefix and insert this on current level in position Index. +%%-------------------------------------------------- +in_subtree(LevelPrefix, Me) -> + case lists:prefix(LevelPrefix, Me#me.oid) of + true when length(Me#me.oid) > length(LevelPrefix) -> + classify_how_in_subtree(LevelPrefix, Me); + _ -> + above + end. + +%%-------------------------------------------------- +%% See comment about in_subtree/2. This function takes care of all cases +%% where the ME really should be in _this_ subtree (not above). +%%-------------------------------------------------- +classify_how_in_subtree(LevelPrefix, Me) + when (length(Me#me.oid) =:= (length(LevelPrefix) + 1)) -> + Oid = Me#me.oid, + case node_or_subtree(Me#me.entrytype) of + subtree -> + {subtree, lists:last(Oid), Oid}; + node -> + {node, lists:last(Oid)} + end; + +classify_how_in_subtree(LevelPrefix, Me) + when (length(Me#me.oid) > (length(LevelPrefix) + 1)) -> + L1 = length(LevelPrefix) + 1, + Oid = Me#me.oid, + {internal_subtree, lists:nth(L1, Oid), lists:sublist(Oid, 1, L1)}. + +%%-------------------------------------------------- +%% Determines how to treat different kinds om MEs in the tree building process. +%% Pre: all internal nodes have been removed. +%%-------------------------------------------------- +node_or_subtree(table) -> subtree; +node_or_subtree(table_entry) -> subtree; +node_or_subtree(variable) -> node; +node_or_subtree(table_column) -> node. + +%%-------------------------------------------------- +%% Purpose: (Recursively) Converts a temporary tree (see above) to a final tree. +%% If input is a ListTree, output is a TupleTree. +%% If input is a Node, output is the same Node. +%% Pre: All Indexes are >= 0. +%%-------------------------------------------------- +convert_tree({Index, {tree, Tree, Info}}) when Index >= 0 -> + L = lists:map(fun convert_tree/1, Tree), + {Index, {tree, dict_list_to_tuple(L), Info}}; +convert_tree({Index, {node, Info}}) when Index >= 0 -> + {Index, {node, Info}}; +convert_tree(Tree) when is_list(Tree) -> + L = lists:map(fun convert_tree/1, Tree), + dict_list_to_tuple(L). + +%%---------------------------------------------------------------------- +%% Purpose: Converts a single level (that is non-recursively) from +%% the temporary indexlist to the N-tuple. +%% Input: A list of {Index, Data}. +%% Output: A tuple where element Index is Data. +%%---------------------------------------------------------------------- +dict_list_to_tuple(L) -> + L2 = lists:keysort(1, L), + list_to_tuple(integrate_indexes(0, L2)). + +%%---------------------------------------------------------------------- +%% Purpose: Helper function for dict_list_to_tuple/1. +%% Converts an indexlist to a N-list. +%% Input: A list of {Index, Data}. +%% Output: A (usually longer, never shorter) list where element Index is Data. +%% Example: [{1,hej}, {3, sven}] will give output +%% [undefined_node, hej, undefined_node, sven]. +%% Initially CurIndex should be 0. +%%---------------------------------------------------------------------- +integrate_indexes(CurIndex, [{CurIndex, Data} | T]) -> + [Data | integrate_indexes(CurIndex + 1, T)]; +integrate_indexes(_Index, []) -> + []; +integrate_indexes(CurIndex, L) -> + [undefined_node | integrate_indexes(CurIndex + 1, L)]. + +%%%====================================================================== +%%% 4. Tree merging +%%% Used by: load mib, insert subagent. +%%%====================================================================== + +%%---------------------------------------------------------------------- +%% Arg: Two root nodes (that is to be merged). +%% Returns: A new root node where the nodes have been merger to one. +%%---------------------------------------------------------------------- +merge_nodes(Same, Same) -> + Same; +merge_nodes(Node, undefined_node) -> + Node; +merge_nodes(undefined_node, Node) -> + Node; +merge_nodes({tree, Tree1, internal}, {tree, Tree2, internal}) -> + {tree, merge_levels(tuple_to_list(Tree1),tuple_to_list(Tree2)), internal}; +merge_nodes(Node1, Node2) -> + throw({error_merge_nodes, Node1, Node2}). + +%%---------------------------------------------------------------------- +%% Arg: Two levels to be merged. +%% Here, a level is represented as a list of nodes. A list is easier +%% to extend than a tuple. +%% Returns: The resulting, merged level tuple. +%%---------------------------------------------------------------------- +merge_levels(Level1, Level2) when length(Level1) =:= length(Level2) -> + MergeNodes = fun(N1, N2) -> merge_nodes(N1, N2) end, + list_to_tuple(snmp_misc:multi_map(MergeNodes, [Level1, Level2])); +merge_levels(Level1, Level2) when length(Level1) > length(Level2) -> + merge_levels(Level1, Level2 ++ + undefined_nodes_list(length(Level1) - length(Level2))); +merge_levels(Level1, Level2) when length(Level1) < length(Level2) -> + merge_levels(Level2, Level1). + +undefined_nodes_list(N) -> lists:duplicate(N, undefined_node). + + +%%%====================================================================== +%%% 5. Tree deletion routines +%%% (for unload mib) +%%%====================================================================== + +%%---------------------------------------------------------------------- +%% Purpose: Actually kicks of the tree reconstruction. +%% Returns: {list of removed MEs, NewTree} +%%---------------------------------------------------------------------- +delete_mib_from_tree(MibName, {tree, Tree, internal}) -> + case delete_tree(Tree, MibName) of + [] -> + {tree, {undefined_node}, internal}; % reduce + LevelList -> + {tree, list_to_tuple(LevelList), internal} + end. + +%%---------------------------------------------------------------------- +%% Purpose: Deletes all nodes associated to MibName from this level and +%% all levels below. +%% If the new level does not contain information (that is, no +%% other mibs use it) anymore the empty list is returned. +%% Returns: {MEs, The new level represented as a list} +%%---------------------------------------------------------------------- +delete_tree(Tree, MibName) when is_tuple(Tree) -> + NewLevel = delete_nodes(tuple_to_list(Tree), MibName, []), + case lists:filter(fun drop_undefined_nodes/1,NewLevel) of + [] -> []; + _A_perhaps_shorted_list -> + NewLevel % some other mib needs this level + end. + +%%---------------------------------------------------------------------- +%% Purpose: Nodes belonging to MibName are removed from the tree. +%% Recursively deletes sub trees to this node. +%% Returns: {MEs, NewNodesList} +%%---------------------------------------------------------------------- +delete_nodes([], _MibName, AccNodes) -> + lists:reverse(AccNodes); + +delete_nodes([{node, {variable, MibName}}|T], MibName, AccNodes) -> + delete_nodes(T, MibName, [undefined_node | AccNodes]); + +delete_nodes([{node, {table_column, MibName}}|T], MibName, AccNodes) -> + delete_nodes(T, MibName, [undefined_node | AccNodes]); + +delete_nodes([{tree, _Tree, {table, MibName}}|T], MibName, AccNodes) -> + delete_nodes(T, MibName, [undefined_node | AccNodes]); + +delete_nodes([{tree, _Tree, {table_entry, MibName}}|T], MibName, AccNodes) -> + delete_nodes(T, MibName, [undefined_node | AccNodes]); + +delete_nodes([{tree, Tree, Info}|T], MibName, AccNodes) -> + case delete_tree(Tree, MibName) of + [] -> % tree completely deleted + delete_nodes(T, MibName, [undefined_node | AccNodes]); + LevelList -> + delete_nodes(T, MibName, + [{tree, list_to_tuple(LevelList), Info} | AccNodes]) + end; + +delete_nodes([NodeToKeep|T], MibName, AccNodes) -> + delete_nodes(T, MibName, [NodeToKeep | AccNodes]). + +drop_undefined_nodes(undefined_node) -> false; +drop_undefined_nodes(_) -> true. + + +%%%====================================================================== +%%% 6. Functions for subagent handling +%%%====================================================================== + +%%---------------------------------------------------------------------- +%% Returns: A new Root|{error, reason} +%%---------------------------------------------------------------------- +insert_subagent(Oid, OldRoot) -> + ListTree = build_tree_for_subagent(Oid), + case catch convert_tree(ListTree) of + {'EXIT', _Reason} -> + {error, 'cannot construct tree from oid'}; + Level when is_tuple(Level) -> + T = {tree, Level, internal}, + case catch merge_nodes(T, OldRoot) of + {error_merge_nodes, _Node1, _Node2} -> + {error, oid_conflict}; + NewRoot when is_tuple(NewRoot) andalso + (element(1, NewRoot) =:= tree) -> + NewRoot + end + end. + +build_tree_for_subagent([Index]) -> + [{Index, {node, subagent}}]; + +build_tree_for_subagent([Index | T]) -> + [{Index, {tree, build_tree_for_subagent(T), internal}}]. + +%%---------------------------------------------------------------------- +%% Returns: A new tree where the subagent at Oid (2nd arg) has been deleted. +%%---------------------------------------------------------------------- +delete_subagent({tree, Tree, Info}, [Index]) -> + {node, subagent} = element(Index+1, Tree), + {tree, setelement(Index+1, Tree, undefined_node), Info}; +delete_subagent({tree, Tree, Info}, [Index | TI]) -> + {tree, setelement(Index+1, Tree, + delete_subagent(element(Index+1, Tree), TI)), Info}. + +%%%====================================================================== +%%% 7. Misc functions +%%%====================================================================== + +%%---------------------------------------------------------------------- +%% Installs the mibs found in the database when starting the agent. +%% Basically calls the instrumentation functions for all non-internal +%% mib-entries +%%---------------------------------------------------------------------- +install_mibs(MibDb, NodeDb) -> + MibNames = loaded(MibDb), + ?vtrace("install_mibs -> found following mibs in database: ~n" + "~p", [MibNames]), + install_mibs2(NodeDb, MibNames). + +install_mibs2(_, []) -> + ok; +install_mibs2(NodeDb, [MibName|MibNames]) -> + Pattern = #node_info{oid = '_', mib_name = MibName, me = '_'}, + Nodes = snmpa_general_db:match_object(NodeDb, Pattern), + MEs = [ME || #node_info{me = ME} <- Nodes], + ?vtrace("install_mibs2 -> installing ~p MEs for mib ~p", + [length(MEs),MibName]), + NewF = fun(ME) -> call_instrumentation(ME, new) end, + lists:foreach(NewF, MEs), + install_mibs2(NodeDb, MibNames). + + +%%---------------------------------------------------------------------- +%% Does all side effect stuff during load_mib. +%%---------------------------------------------------------------------- +install_mib(Db, Symbolic, Mib, MibName, FileName, NonInternalMes) -> + ?vdebug("install_mib -> entry with" + "~n Symbolic: ~p" + "~n MibName: ~p" + "~n FileName: ~p", [Symbolic, MibName, FileName]), + Rec = #mib_info{name = MibName, symbolic = Symbolic, file_name = FileName}, + snmpa_general_db:write(Db, Rec), + install_mib2(Symbolic, MibName, Mib), + NewF = fun(ME) -> call_instrumentation(ME, new) end, + lists:foreach(NewF, NonInternalMes). + +install_mib2(true, MibName, Mib) -> + #mib{table_infos = TabInfos, + variable_infos = VarInfos, + mes = MEs, + asn1_types = ASN1Types, + traps = Traps} = Mib, + snmpa_symbolic_store:add_table_infos(MibName, TabInfos), + snmpa_symbolic_store:add_variable_infos(MibName, VarInfos), + snmpa_symbolic_store:add_aliasnames(MibName, MEs), + snmpa_symbolic_store:add_types(MibName, ASN1Types), + SetF = fun(Trap) -> + snmpa_symbolic_store:set_notification(Trap, MibName) + end, + lists:foreach(SetF, Traps); +install_mib2(_, _, _) -> + ok. + +install_mes(_Db, _MibName, []) -> + ok; +install_mes(Db, MibName, [ME|MEs]) -> + Node = #node_info{oid = ME#me.oid, mib_name = MibName, me = ME}, + snmpa_general_db:write(Db, Node), + install_mes(Db, MibName, MEs). + + +%%---------------------------------------------------------------------- +%% Does all side effect stuff during unload_mib. +%%---------------------------------------------------------------------- +uninstall_mib(Db, Symbolic, MibName, MEs) -> + ?vtrace("uninstall_mib -> entry with" + "~n Db: ~p" + "~n Symbolic: ~p" + "~n MibName: ~p", [Db, Symbolic, MibName]), + Res = snmpa_general_db:delete(Db, MibName), + ?vtrace("uninstall_mib -> (mib) db delete result: ~p", [Res]), + uninstall_mib2(Symbolic, MibName), + DelF = fun(ME) -> call_instrumentation(ME, delete) end, + lists:foreach(DelF, MEs). + +uninstall_mib2(true, MibName) -> + snmpa_symbolic_store:delete_table_infos(MibName), + snmpa_symbolic_store:delete_variable_infos(MibName), + snmpa_symbolic_store:delete_aliasnames(MibName), + snmpa_symbolic_store:delete_types(MibName), + snmpa_symbolic_store:delete_notifications(MibName); +uninstall_mib2(_, _) -> + ok. + +uninstall_mes(Db, MibName) -> + Pattern = #node_info{oid = '_', mib_name = MibName, me = '_'}, + snmpa_general_db:match_delete(Db, Pattern). + + +%%---------------------------------------------------------------------- +%% Create a list of the names of all the loaded mibs +%%---------------------------------------------------------------------- +loaded(Db) -> + [N || #mib_info{name = N} <- snmpa_general_db:tab2list(Db)]. + + +%%---------------------------------------------------------------------- +%% Calls MFA-instrumentation with 'new' or 'delete' operation. +%%---------------------------------------------------------------------- +call_instrumentation(#me{entrytype = variable, mfa={M,F,A}}, Operation) -> + ?vtrace("call instrumentation with" + "~n entrytype: variable" + "~n MFA: {~p,~p,~p}" + "~n Operation: ~p", + [M,F,A,Operation]), + catch apply(M, F, [Operation | A]); +call_instrumentation(#me{entrytype = table_entry, mfa={M,F,A}}, Operation) -> + ?vtrace("call instrumentation with" + "~n entrytype: table_entry" + "~n MFA: {~p,~p,~p}" + "~n Operation: ~p", + [M,F,A,Operation]), + catch apply(M, F, [Operation | A]); +call_instrumentation(_ShitME, _Operation) -> + done. + + +maybe_drop_me(#me{entrytype = internal}) -> false; +maybe_drop_me(#me{entrytype = group}) -> false; +maybe_drop_me(#me{imported = true}) -> false; +maybe_drop_me(_) -> true. + + +%%---------------------------------------------------------------------- +%% Code change functions +%%---------------------------------------------------------------------- + +code_change(down, State) -> + ?d("code_change(down) -> entry",[]), + State; + +code_change(up, State) -> + ?d("code_change(up)",[]), + State; + +code_change(_Vsn, State) -> + State. + diff --git a/lib/snmp/src/agent/snmpa_mib_data_tttn.erl b/lib/snmp/src/agent/snmpa_mib_data_tttn.erl new file mode 100644 index 0000000000..90ddf4869f --- /dev/null +++ b/lib/snmp/src/agent/snmpa_mib_data_tttn.erl @@ -0,0 +1,1443 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2013. 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(snmpa_mib_data_tttn). + + +%%%----------------------------------------------------------------- +%%% +%%% TTTN - TupleTreeTupleNodes +%%% +%%% This module implements the MIB (internal) data structures. +%%% The TTTN MIB Data structure consists of three items: +%%% +%%% 1) A mib-storage (as specified when new is called) for +%%% the data associated with each variable, table, +%%% table-entry and table-column in the MIB. +%%% 2) A tree contains information of the Oids in the MIB. +%%% 3) A list of registered subagents. +%%% +%%% The subagent information is consequently duplicated. It resides +%%% both in the tree and in the list. +%%% +%%% When a mib is loaded, the tree is built from the plain list +%%% in the binary file. +%%% +%%%----------------------------------------------------------------- + +-include_lib("snmp/include/snmp_types.hrl"). +-include_lib("snmp/src/misc/snmp_debug.hrl"). + +-define(VMODULE,"MDATA_TTTN"). +-include_lib("snmp/src/misc/snmp_verbosity.hrl"). + +-behaviour(snmpa_mib_data). + +-define(MIB_DATA, snmpa_mib_data). +-define(MIB_NODE, snmpa_mib_node). +-define(MIB_TREE, snmpa_mib_tree). +-define(DUMMY_TREE_GENERATION, 1). +-define(DEFAULT_TREE, {tree,{undefined_node},internal}). + + +%%%----------------------------------------------------------------- +%%% Table of contents +%%% ================= +%%% 1. Interface +%%% 2. Implementation of tree access +%%% 3. Tree building functions +%%% 4. Tree merging +%%% 5. Tree deletion routines +%%% 6. Functions for subagent handling +%%% 7. Misc functions +%%%----------------------------------------------------------------- + +-record(mib_data, + { + %% Mib storage module + module :: snmpa:mib_storage_module(), + + %% A database of loaded mibs + %% #mib_info{} + mib_db, + + %% A database with information about each node in the tree + %% #node_info{} + node_db, + + %% A database containing _one_ record with the tree + %% without the subagent(s). + %% (the reason for this is part to get replication + %% and part out of convenience) + %% #tree{} + tree_db, + + %% The root node (same as the tree part of the tree_db + %% but with the subagents added). + tree, + + %% A list of {SAPid, Oid} + subagents = [] + }). + +-record(mib_info, {name, symbolic, file_name}). +-record(node_info, {oid, mib_name, me}). + + +%% (behaviour) API +-export([new/1, + close/1, + sync/1, + load_mib/4, + unload_mib/4, + lookup/2, + next/3, + register_subagent/3, + unregister_subagent/2, + dump/2, + which_mib/2, which_mibs/1, + whereis_mib/2, + info/1, info/2, + backup/2, + code_change/4]). + + +%%----------------------------------------------------------------- +%% A tree is represented as a N-tuple, where each element is a +%% node. A node is: +%% 1) {tree, Tree, Info} where Info can be {table, Id}, {table_entry, Id} +%% or perhaps 'internal' +%% 2) undefined_node (memory optimization (instead of {node, undefined})) +%% 3) {node, Info} where Info can be {subagent, Pid}, {variable, Id}, +%% {table_column, Id} +%% Id is {MibName, MibEntry} +%% The over all root is represented as {tree, Tree, internal}. +%% +%% tree() = {tree, nodes(), tree_info()} +%% nodes() = {tree() | node() | undefined_node, ...} +%% node() = {node, node_info()} +%% tree_info() = {table, Id} | {table_entry, Id} | internal +%% node_info() = {subagent, Pid} | {variable, Id} | {table_colum, Id} +%%----------------------------------------------------------------- + +%% This record is what is stored in the database. The 'tree' part +%% is described above... +-record(tree, {generation = ?DUMMY_TREE_GENERATION, root = ?DEFAULT_TREE}). + + +%%%====================================================================== +%%% 1. Interface +%%%====================================================================== + +%%----------------------------------------------------------------- +%% Func: new/1 +%% Returns: A representation of mib data. +%%----------------------------------------------------------------- + +%% Where -> A list of nodes where the tables will be created +new(MibStorage) -> + Mod = snmp_misc:get_option(module, MibStorage), + Opts = snmp_misc:get_option(options, MibStorage, []), + + %% First we must check if there is already something to read + %% If a database already exists, then the tree structure has to be read + ?vdebug("open (mib) database",[]), + MibDb = + case Mod:open(?MIB_DATA, mib_info, record_info(fields, mib_info), + set, Opts) of + {ok, T1} -> + T1; + {error, Reason1} -> + throw({error, {open, mib_data, Reason1}}) + end, + + ?vdebug("open (mib) node database",[]), + NodeDb = + case Mod:open(?MIB_NODE, node_info, record_info(fields, node_info), + set, Opts) of + {ok, T2} -> + T2; + {error, Reason2} -> + throw({error, {open, mib_node, Reason2}}) + end, + + ?vdebug("open (mib) tree database",[]), + TreeDb = + case Mod:open(?MIB_TREE, tree, record_info(fields, tree), + set, Opts) of + {ok, T3} -> + T3; + {error, Reason3} -> + throw({error, {open, mib_tree, Reason3}}) + end, + + ?vdebug("write the default (mib) tree",[]), + Tree = + case Mod:read(TreeDb, ?DUMMY_TREE_GENERATION) of + false -> + T = #tree{}, + Mod:write(TreeDb, T), + T; + {value, T} -> + T + end, + ?vdebug("install (existing) mibs",[]), + install_mibs(Mod, MibDb, NodeDb), + ?vdebug("done",[]), + #mib_data{module = Mod, + mib_db = MibDb, + node_db = NodeDb, + tree_db = TreeDb, + tree = Tree}. + + +%%---------------------------------------------------------------------- +%% Returns: new mib data | {error, Reason} +%%---------------------------------------------------------------------- +load_mib(MibData, FileName, MeOverride, TeOverride) + when is_record(MibData,mib_data) andalso is_list(FileName) -> + ?vlog("load mib file: ~p",[FileName]), + ActualFileName = filename:rootname(FileName, ".bin") ++ ".bin", + MibName = list_to_atom(filename:basename(FileName, ".bin")), + (catch do_load_mib(MibData, ActualFileName, MibName, + MeOverride, TeOverride)). + +do_load_mib(MibData, ActualFileName, MibName, MeOverride, TeOverride) -> + ?vtrace("do_load_mib -> entry with" + "~n ActualFileName: ~s" + "~n MibName: ~p",[ActualFileName, MibName]), + #mib_data{module = Mod, + mib_db = MibDb, + node_db = NodeDb, + %% tree_db = TreeDb, + tree = Tree} = MibData, + verify_not_loaded(Mod, MibDb, MibName), + ?vtrace("do_load_mib -> already loaded mibs:" + "~n ~p", [loaded(Mod, MibDb)]), + Mib = do_read_mib(ActualFileName), + ?vtrace("do_load_mib -> read mib ~s",[Mib#mib.name]), + NonInternalMes = + lists:filter(fun(ME) -> maybe_drop_me(ME) end, Mib#mib.mes), + OldRoot = Tree#tree.root, + T = build_tree(NonInternalMes, MibName), + ?d("load_mib -> " + "~n OldRoot: ~p" + "~n T: ~p", [OldRoot, T]), + case (catch merge_nodes(T, OldRoot)) of + {error_merge_nodes, Node1, Node2} -> + ?vlog("error merging nodes:" + "~n~p~nand~n~p", [Node1,Node2]), + {error, oid_conflict}; + NewRoot when is_tuple(NewRoot) andalso (element(1,NewRoot) =:= tree) -> + ?d("load_mib -> " + "~n NewRoot: ~p", [NewRoot]), + Symbolic = not lists:member(no_symbolic_info, Mib#mib.misc), + case (catch check_notif_and_mes(TeOverride, MeOverride, Symbolic, + Mib#mib.traps, NonInternalMes)) of + true -> + install_mes(Mod, NodeDb, MibName, NonInternalMes), + install_mib(Mod, + MibDb, Symbolic, Mib, + MibName, ActualFileName, NonInternalMes), + ?vtrace("installed mib ~s", [Mib#mib.name]), + Tree2 = Tree#tree{root = NewRoot}, + {ok, MibData#mib_data{tree = Tree2}}; + Else -> + Else + end + end. + + +verify_not_loaded(Mod, Tab, Name) -> + case Mod:read(Tab, Name) of + {value, #mib_info{name = Name}} -> + throw({error, already_loaded}); + false -> + ok + end. + +do_read_mib(ActualFileName) -> + case snmp_misc:read_mib(ActualFileName) of + {error, Reason} -> + ?vlog("Failed reading mib file ~p with reason: ~p", + [ActualFileName, Reason]), + throw({error, Reason}); + {ok, Mib} -> + Mib + end. + +%% The Tree DB is handled in a special way since it can be very large. +sync(#mib_data{module = Mod, + mib_db = M, + node_db = N, + tree_db = T, tree = Tree, subagents = []}) -> + Mod:sync(M), + Mod:sync(N), + Mod:write(T, Tree), + Mod:sync(T); +sync(#mib_data{module = Mod, + mib_db = M, + node_db = N, + tree_db = T, tree = Tree, subagents = SAs}) -> + + Mod:sync(M), + Mod:sync(N), + + %% Ouch. Since the subagent info is dynamic we do not + %% want to store the tree containing subagent info. So, we + %% have to create a tmp tree without those and store it. + + case delete_subagents(Tree, SAs) of + {ok, TreeWithoutSAs} -> + Mod:write(T, TreeWithoutSAs), + Mod:sync(T); + Error -> + Error + end. + +delete_subagents(Tree, []) -> + {ok, Tree}; +delete_subagents(Tree0, [{_, Oid}|SAs]) -> + case (catch delete_subagent(Tree0, Oid)) of + {tree, _Tree, _Info} = Tree1 -> + delete_subagents(Tree1, SAs); + _Error -> + {error, {'invalid oid', Oid}} + end. + +%%---------------------------------------------------------------------- +%% (OTP-3601) +%%---------------------------------------------------------------------- +check_notif_and_mes(TeOverride,MeOverride,Symbolic,Traps,MEs) -> + ?vtrace("check notifications and mib entries",[]), + check_notifications(TeOverride,Symbolic,Traps), + check_mes(MeOverride,MEs). + +check_notifications(true, _Symbolic, _Traps) -> + ?vtrace("trapentry override = true => skip check",[]), + true; +check_notifications(_, Symbolic, Traps) -> + check_notifications(Symbolic, Traps). + +check_notifications(true, Traps) -> + check_notifications(Traps); +check_notifications(_, _) -> true. + +check_notifications([]) -> true; +check_notifications([#trap{trapname = Key} = Trap | Traps]) -> + ?vtrace("check notification [trap] with Key: ~p",[Key]), + case snmpa_symbolic_store:get_notification(Key) of + {value, Trap} -> check_notifications(Traps); + {value, _} -> throw({error, {'trap already defined', Key}}); + undefined -> check_notifications(Traps) + end; +check_notifications([#notification{trapname = Key} = Notif | Traps]) -> + ?vtrace("check notification [notification] with Key: ~p",[Key]), + case snmpa_symbolic_store:get_notification(Key) of + {value, Notif} -> + check_notifications(Traps); + {value, _} -> + throw({error, {'notification already defined', Key}}); + undefined -> + check_notifications(Traps) + end; +check_notifications([Crap | Traps]) -> + ?vlog("skipped check of: ~n~p",[Crap]), + check_notifications(Traps). + +check_mes(true,_) -> + ?vtrace("mibentry override = true => skip check",[]), + true; +check_mes(_,MEs) -> + check_mes(MEs). + +check_mes([]) -> true; +check_mes([#me{aliasname = Name, oid = Oid1} | MEs]) -> + ?vtrace("check mib entries with aliasname: ~p",[Name]), + case snmpa_symbolic_store:aliasname_to_oid(Name) of + {value, Oid1} -> + check_mes(MEs); + {value, Oid2} -> + ?vinfo("~n expecting '~p'~n but found '~p'",[Oid1, Oid2]), + throw({error, {'mibentry already defined', Name}}); + false -> + check_mes(MEs) + end; +check_mes([Crap | MEs]) -> + ?vlog("skipped check of: ~n~p",[Crap]), + check_mes(MEs). + + + +%%---------------------------------------------------------------------- +%% Returns: new mib data | {error, Reason} +%%---------------------------------------------------------------------- +unload_mib(MibData, FileName, _, _) when is_list(FileName) -> + MibName = list_to_atom(filename:basename(FileName, ".bin")), + (catch do_unload_mib(MibData, MibName)). + +do_unload_mib(MibData, MibName) -> + ?vtrace("do_unload_mib -> entry with" + "~n MibName: ~p", [MibName]), + #mib_data{module = Mod, + mib_db = MibDb, + node_db = NodeDb, + %% tree_db = TreeDb, + tree = Tree} = MibData, + #mib_info{symbolic = Symbolic} = verify_loaded(Mod, MibDb, MibName), + NewRoot = delete_mib_from_tree(MibName, Tree#tree.root), + MEs = uninstall_mes(Mod, NodeDb, MibName), + uninstall_mib(Mod, MibDb, Symbolic, MibName, MEs), + NewMibData = MibData#mib_data{tree = Tree#tree{root = NewRoot}}, + {ok, NewMibData}. + +verify_loaded(Mod, Tab, Name) -> + case Mod:read(Tab, Name) of + {value, MibInfo} -> + MibInfo; + false -> + throw({error, not_loaded}) + end. + + +close(#mib_data{module = Mod, + mib_db = MibDb, + node_db = NodeDb, + tree_db = TreeDb}) -> + Mod:close(MibDb), + Mod:close(NodeDb), + Mod:close(TreeDb), + ok. + +register_subagent(#mib_data{tree = T} = MibData, Oid, Pid) -> + case insert_subagent(Oid, T#tree.root) of + {error, Reason} -> + {error, Reason}; + NewRootTree -> + SAs = [{Pid, Oid} | MibData#mib_data.subagents], + T2 = T#tree{root = NewRootTree}, + {ok, MibData#mib_data{tree = T2, subagents = SAs}} + end. + + +%%---------------------------------------------------------------------- +%% Purpose: Get a list of all loaded mibs +%% Returns: [{Name, File}] +%%---------------------------------------------------------------------- + +which_mibs(#mib_data{module = Mod, mib_db = Db}) -> + Mibs = Mod:tab2list(Db), + [{Name, File} || #mib_info{name = Name, file_name = File} <- Mibs]. + + +%%---------------------------------------------------------------------- +%% Purpose: Get a list of all loaded mibs +%% Returns: [{Name, File}] +%%---------------------------------------------------------------------- + +whereis_mib(#mib_data{module = Mod, mib_db = Db}, Name) -> + case Mod:read(Db, Name) of + {value, #mib_info{file_name = File}} -> + {ok, File}; + false -> + {error, not_found} + end. + + +%%---------------------------------------------------------------------- +%% Purpose: Deletes SA with Pid from all subtrees it handles. +%% Returns: NewMibData. +%%---------------------------------------------------------------------- +unregister_subagent(#mib_data{subagents = SAs} = MibData, Pid) + when is_pid(Pid) -> + SAs = MibData#mib_data.subagents, + case lists:keysearch(Pid, 1, SAs) of + false -> + {ok, MibData}; + {value, {Pid, Oid}} -> + % we should never get an error since Oid is found in MibData. + {ok, NewMibData, _DeletedSA} = unregister_subagent(MibData, Oid), + % continue if the same Pid handles other mib subtrees. + unregister_subagent(NewMibData, Pid) + end; + +%%---------------------------------------------------------------------- +%% Purpose: Deletes one unique subagent. +%% Returns: {error, Reason} | {ok, NewMibData, DeletedSubagentPid} +%%---------------------------------------------------------------------- +unregister_subagent(#mib_data{tree = T} = MibData, Oid) when is_list(Oid) -> + case (catch delete_subagent(T#tree.root, Oid)) of + {tree, Tree, Info} -> + OldSAs = MibData#mib_data.subagents, + {value, {Pid, _Oid}} = lists:keysearch(Oid, 2, OldSAs), + SAs = lists:keydelete(Oid, 2, OldSAs), + T2 = T#tree{root = {tree, Tree, Info}}, + {ok, + MibData#mib_data{tree = T2, subagents = SAs}, + Pid}; + _ -> + {error, {invalid_oid, Oid}} + end. + +%%---------------------------------------------------------------------- +%% Purpose: To inpect memory usage, loaded mibs, registered subagents +%%---------------------------------------------------------------------- +info(MibData) -> + ?vtrace("retrieve info",[]), + #mib_data{module = Mod, + mib_db = MibDb, + node_db = NodeDb, + tree_db = TreeDb, + tree = Tree, + subagents = SAs} = MibData, + LoadedMibs = old_format(Mod:tab2list(MibDb)), + TreeSize = snmp_misc:mem_size(Tree), + {memory, ProcSize} = erlang:process_info(self(), memory), + MibDbSize = Mod:info(MibDb, memory), + NodeDbSize = Mod:info(NodeDb, memory), + TreeDbSize = Mod:info(TreeDb, memory), + [{loaded_mibs, LoadedMibs}, {subagents, SAs}, {tree_size_bytes, TreeSize}, + {process_memory, ProcSize}, + {db_memory, [{mib,MibDbSize},{node,NodeDbSize},{tree,TreeDbSize}]}]. + +info(#mib_data{module = Mod, mib_db = MibDb}, loaded_mibs) -> + Mibs = Mod:tab2list(MibDb), + [filename:rootname(FN, ".bin") || #mib_info{file_name = FN} <- Mibs]; +info(#mib_data{tree = Tree}, tree_size_bytes) -> + snmp_misc:mem_size(Tree); +info(_, process_memory) -> + {memory, ProcSize} = erlang:process_info(self(),memory), + ProcSize; +info(#mib_data{module = Mod, + mib_db = MibDb, + node_db = NodeDb, + tree_db = TreeDb}, + db_memory) -> + MibDbSize = Mod:info(MibDb, memory), + NodeDbSize = Mod:info(NodeDb, memory), + TreeDbSize = Mod:info(TreeDb, memory), + [{mib, MibDbSize}, {node, NodeDbSize}, {tree, TreeDbSize}]; +info(#mib_data{subagents = SAs}, subagents) -> + SAs. + +old_format(LoadedMibs) -> + ?vtrace("convert mib info to old format",[]), + [{N,S,F} || #mib_info{name=N,symbolic=S,file_name=F} <- LoadedMibs]. + + +%%---------------------------------------------------------------------- +%% A total dump for debugging. +%%---------------------------------------------------------------------- + +dump(#mib_data{module = Mod, + mib_db = MibDb, + node_db = NodeDb, + tree = Tree}, io) -> + (catch io:format("MIB-tables:~n~p~n~n", + [Mod:tab2list(MibDb)])), + (catch io:format("MIB-entries:~n~p~n~n", + [Mod:tab2list(NodeDb)])), + (catch io:format("Tree:~n~p~n", [Tree])), % good luck reading it! + ok; + +dump(#mib_data{module = Mod, + mib_db = MibDb, + node_db = NodeDb, + tree = Tree}, File) -> + case file:open(File, [write]) of + {ok, Fd} -> + io:format(Fd,"~s~n", + [snmp:date_and_time_to_string(snmp:date_and_time())]), + (catch io:format(Fd,"MIB-tables:~n~p~n~n", + [Mod:tab2list(MibDb)])), + (catch io:format(Fd, "MIB-entries:~n~p~n~n", + [Mod:tab2list(NodeDb)])), + io:format(Fd,"Tree:~n~p~n", [Tree]), % good luck reading it! + file:close(Fd), + ok; + {error, Reason} -> + ?vinfo("~n Failed opening file '~s' for reason ~p", + [File, Reason]), + {error, Reason} + end. + + +backup(#mib_data{module = Mod, + mib_db = M, + node_db = N, + tree_db = T}, BackupDir) -> + MRes = Mod:backup(M, BackupDir), + NRes = Mod:backup(N, BackupDir), + TRes = Mod:backup(T, BackupDir), + handle_backup_res([{mib_db, MRes}, {node_db, NRes}, {tree_db, TRes}]). + +handle_backup_res(Res) -> + handle_backup_res(Res, []). + +handle_backup_res([], []) -> + ok; +handle_backup_res([], Err) -> + {error, lists:reverse(Err)}; +handle_backup_res([{_, ok}|Res], Err) -> + handle_backup_res(Res, Err); +handle_backup_res([{Tag, {error, Reason}}|Res], Err) -> + handle_backup_res(Res, [{Tag, Reason}|Err]); +handle_backup_res([{Tag, Error}|Res], Err) -> + handle_backup_res(Res, [{Tag, Error}|Err]). + + +%%%====================================================================== +%%% 2. Implementation of tree access +%%% lookup and next. +%%%====================================================================== + + +which_mib(#mib_data{tree = T} = D, Oid) -> + ?vtrace("which_mib -> entry with" + "~n Oid: ~p",[Oid]), + case (catch find_node(D, T#tree.root, Oid, [])) of + {variable, _ME, Mib} -> + ?vtrace("which_mib -> variable:" + "~n Mib: ~p", [Mib]), + {ok, Mib}; + {table, _EntryME, _, Mib} -> + ?vtrace("which_mib -> table:" + "~n Mib: ~p", [Mib]), + {ok, Mib}; + {subagent, SubAgentPid, _SANextOid} -> + ?vtrace("which_mib -> subagent:" + "~n SubAgentPid: ~p", [SubAgentPid]), + {error, {subagent, SubAgentPid}}; + {false, ErrorCode} -> + ?vtrace("which_mib -> false:" + "~n ErrorCode: ~p",[ErrorCode]), + {error, ErrorCode}; + false -> + ?vtrace("which_mib -> false",[]), + {error, noSuchObject}; + {'EXIT', R} -> + ?vtrace("which_mib -> exit:" + "~n R: ~p",[R]), + {error, noSuchObject} + end. + + +%%----------------------------------------------------------------- +%% Func: lookup/2 +%% Purpose: Finds the mib entry corresponding to the Oid. If it is a +%% variable, the Oid must be <Oid for var>.0 and if it is +%% a table, Oid must be <table>.<entry>.<col>.<any> +%% Returns: {variable, MibEntry} | +%% {table_column, MibEntry, TableEntryOid} | +%% {subagent, SubAgentPid, SAOid} | +%% {false, Reason} +%%----------------------------------------------------------------- +lookup(#mib_data{tree = T} = D, Oid) -> + ?vtrace("lookup -> entry with" + "~n Oid: ~p",[Oid]), + case (catch find_node(D, T#tree.root, Oid, [])) of + {variable, ME, _Mib} when is_record(ME, me) -> + ?vtrace("lookup -> variable:" + "~n ME: ~p",[ME]), + {variable, ME}; + {table, EntryME, {ColME, TableEntryOid}, _Mib} -> + ?vtrace("lookup -> table:" + "~n EntryME: ~p" + "~n ColME: ~p" + "~n RevTableEntryOid: ~p", + [EntryME, ColME, TableEntryOid]), + MFA = EntryME#me.mfa, + RetME = ColME#me{mfa = MFA}, + {table_column, RetME, TableEntryOid}; + {subagent, SubAgentPid, SANextOid} -> + ?vtrace("lookup -> subagent:" + "~n SubAgentPid: ~p" + "~n SANextOid: ~p", [SubAgentPid, SANextOid]), + {subagent, SubAgentPid, SANextOid}; + {false, ErrorCode} -> + ?vtrace("lookup -> false:" + "~n ErrorCode: ~p",[ErrorCode]), + {false, ErrorCode}; + false -> + ?vtrace("lookup -> false",[]), + {false, noSuchObject}; + {'EXIT', R} -> + ?vtrace("lookup -> exit:" + "~n R: ~p",[R]), + {false, noSuchObject} + end. + + +find_node(D, {tree, Tree, {table, _}}, RestOfOid, RevOid) -> + ?vtrace("find_node(tree,table) -> entry with" + "~n RestOfOid: ~p" + "~n RevOid: ~p",[RestOfOid, RevOid]), + find_node(D, {tree, Tree, internal}, RestOfOid, RevOid); +find_node(D, {tree, Tree, {table_entry, _}}, RestOfOid, RevOid) -> + ?vtrace("find_node(tree,table_entry) -> entry with" + "~n RestOfOid: ~p" + "~n RevOid: ~p",[RestOfOid, RevOid]), + #mib_data{module = Mod, node_db = Db} = D, + Oid = lists:reverse(RevOid), + case Mod:read(Db, Oid) of + {value, #node_info{me = ME, mib_name = Mib}} -> + case find_node(D, {tree, Tree, internal}, RestOfOid, RevOid) of + {false, ErrorCode} -> {false, ErrorCode}; + Val -> {table, ME, Val, Mib} + end; + false -> + ?vinfo("find_node -> could not find table_entry ME with" + "~n RevOid: ~p" + "~n when" + "~n RestOfOid: ~p", + [RevOid, RestOfOid]), + false + end; +find_node(D, {tree, Tree, _Internal}, [Int | RestOfOid], RevOid) -> + ?vtrace("find_node(tree) -> entry with" + "~n Int: ~p" + "~n RestOfOid: ~p" + "~n RevOid: ~p",[Int, RestOfOid, RevOid]), + find_node(D, element(Int+1, Tree), RestOfOid, [Int | RevOid]); +find_node(D, {node, {table_column, _}}, RestOfOid, [ColInt | RevOid]) -> + ?vtrace("find_node(tree,table_column) -> entry with" + "~n RestOfOid: ~p" + "~n ColInt: ~p" + "~n RevOid: ~p",[RestOfOid, ColInt, RevOid]), + #mib_data{module = Mod, node_db = Db} = D, + Oid = lists:reverse([ColInt | RevOid]), + case Mod:read(Db, Oid) of + {value, #node_info{me = ME}} -> + {ME, lists:reverse(RevOid)}; + false -> + X = Mod:read(Db, lists:reverse([ColInt | RevOid])), + ?vinfo("find_node -> could not find table_column ME with" + "~n RevOid: ~p" + "~n trying [~p|~p]" + "~n X: ~p", + [RevOid, [ColInt | RevOid], X]), + false + end; +find_node(D, {node, {variable, _MibName}}, [0], RevOid) -> + ?vtrace("find_node(tree,variable,[0]) -> entry with" + "~n RevOid: ~p",[RevOid]), + #mib_data{module = Mod, node_db = Db} = D, + Oid = lists:reverse(RevOid), + case Mod:read(Db, Oid) of + {value, #node_info{me = ME, mib_name = Mib}} -> + {variable, ME, Mib}; + false -> + ?vinfo("find_node -> could not find variable ME with" + "~n RevOid: ~p", [RevOid]), + false + end; +find_node(_D, {node, {variable, _MibName}}, [], _RevOid) -> + ?vtrace("find_node(tree,variable,[]) -> entry",[]), + {false, noSuchObject}; +find_node(_D, {node, {variable, _MibName}}, _, _RevOid) -> + ?vtrace("find_node(tree,variable) -> entry",[]), + {false, noSuchInstance}; +find_node(D, {node, subagent}, _RestOfOid, SARevOid) -> + ?vtrace("find_node(tree,subagent) -> entry with" + "~n SARevOid: ~p",[SARevOid]), + #mib_data{subagents = SAs} = D, + SAOid = lists:reverse(SARevOid), + case lists:keysearch(SAOid, 2, SAs) of + {value, {SubAgentPid, SAOid}} -> + {subagent, SubAgentPid, SAOid}; + false -> + ?vinfo("find_node -> could not find subagent with" + "~n SAOid: ~p" + "~n SAs: ~p", [SAOid, SAs]), + false + end; +find_node(_D, Node, _RestOfOid, _RevOid) -> + ?vtrace("find_node -> failed:~n~p",[Node]), + {false, noSuchObject}. + + +%%----------------------------------------------------------------- +%% Func: next/3 +%% Purpose: Finds the lexicographically next oid. +%% Returns: endOfMibView | +%% {subagent, SubAgentPid, SAOid} | +%% {variable, MibEntry, VarOid} | +%% {table, TableOid, TableRestOid, MibEntry} +%% If a variable is returnes, it is in the MibView. +%% If a table or subagent is returned, it *may* be in the MibView. +%%----------------------------------------------------------------- +next(#mib_data{tree = T} = D, Oid, MibView) -> + case catch next_node(D, T#tree.root, Oid, [], MibView) of + false -> endOfMibView; + Else -> Else + end. + +%%----------------------------------------------------------------- +%% This function is used as long as we have any Oid left. Take +%% one integer at a time from the Oid, and traverse the tree +%% accordingly. When the Oid is empty, call find_next. +%% Returns: {subagent, SubAgentPid, SAOid} | +%% false | +%% {variable, MibEntry, VarOid} | +%% {table, TableOid, TableRestOid, MibEntry} +%%----------------------------------------------------------------- +next_node(_D, undefined_node, _Oid, _RevOidSoFar, _MibView) -> + ?vtrace("next_node(undefined_node) -> entry", []), + false; + +next_node(_D, {tree, Tree, {table_entry, _Id}}, [Int | _Oid], + _RevOidSoFar, _MibView) + when Int+1 > size(Tree) -> + ?vtrace("next_node(tree,table_entry) -> entry when not found whith" + "~n Int: ~p" + "~n size(Tree): ~p", [Int, size(Tree)]), + false; +next_node(D, {tree, Tree, {table_entry, _MibName}}, + Oid, RevOidSoFar, MibView) -> + ?vtrace("next_node(tree,table_entry) -> entry when" + "~n size(Tree): ~p" + "~n Oid: ~p" + "~n RevOidSoFar: ~p" + "~n MibView: ~p", [size(Tree), Oid, RevOidSoFar, MibView]), + OidSoFar = lists:reverse(RevOidSoFar), + case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of + true -> + ?vdebug("next_node(tree,table_entry) -> not in mib view",[]), + false; + _ -> + #mib_data{module = Mod, node_db = Db} = D, + case Mod:read(Db, OidSoFar) of + false -> + ?vinfo("next_node -> could not find table_entry with" + "~n OidSoFar: ~p", [OidSoFar]), + false; + {value, #node_info{me = ME}} -> + ?vtrace("next_node(tree,table_entry) -> found: ~n ~p", + [ME]), + {table, OidSoFar, Oid, ME} + end + end; + +next_node(D, {tree, Tree, _Info}, [Int | RestOfOid], RevOidSoFar, MibView) + when (Int < size(Tree)) andalso (Int >= 0) -> + ?vtrace("next_node(tree) -> entry when" + "~n size(Tree): ~p" + "~n Int: ~p" + "~n RestOfOid: ~p" + "~n RevOidSoFar: ~p" + "~n MibView: ~p", + [size(Tree), Int, RestOfOid, RevOidSoFar, MibView]), + case next_node(D, element(Int+1,Tree), + RestOfOid, [Int|RevOidSoFar], MibView) of + false -> + find_next(D, {tree, Tree, _Info}, Int+1, RevOidSoFar, MibView); + Else -> + Else + end; +%% no solution +next_node(D, {tree, Tree, _Info}, [], RevOidSoFar, MibView) -> + ?vtrace("next_node(tree,[]) -> entry when" + "~n size(Tree): ~p" + "~n RevOidSoFar: ~p" + "~n MibView: ~p", + [size(Tree), RevOidSoFar, MibView]), + find_next(D, {tree, Tree, _Info}, 0, RevOidSoFar, MibView); +next_node(_D, {tree, Tree, _Info}, _RestOfOid, _RevOidSoFar, _MibView) -> + ?vtrace("next_node(tree) -> entry when" + "~n size(Tree): ~p", [size(Tree)]), + false; + +next_node(D, {node, subagent}, Oid, RevOidSoFar, MibView) -> + ?vtrace("next_node(node,subagent) -> entry when" + "~n Oid: ~p" + "~n RevOidSoFar: ~p" + "~n MibView: ~p", + [Oid, RevOidSoFar, MibView]), + OidSoFar = lists:reverse(RevOidSoFar), + case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of + true -> + false; + _ -> + #mib_data{subagents = SAs} = D, + case lists:keysearch(OidSoFar, 2, SAs) of + {value, {SubAgentPid, OidSoFar}} -> + {subagent, SubAgentPid, OidSoFar}; + _ -> + ?vinfo("next_node -> could not find subagent with" + "~n OidSoFar: ~p" + "~n SAs: ~p", [OidSoFar, SAs]), + false + end + end; + +next_node(D, {node, {variable, _MibName}}, [], RevOidSoFar, MibView) -> + ?vtrace("next_node(node,variable,[]) -> entry when" + "~n RevOidSoFar: ~p" + "~n MibView: ~p", + [RevOidSoFar, MibView]), + OidSoFar = lists:reverse([0 | RevOidSoFar]), + case snmpa_acm:validate_mib_view(OidSoFar, MibView) of + true -> + #mib_data{module = Mod, node_db = Db} = D, + case Mod:read(Db, lists:reverse(RevOidSoFar)) of + false -> + ?vinfo("next_node -> could not find variable with" + "~n RevOidSoFar: ~p", [RevOidSoFar]), + false; + {value, #node_info{me = ME}} -> + {variable, ME, OidSoFar} + end; + _ -> + false + end; + +next_node(_D, {node, {variable, _MibName}}, _Oid, _RevOidSoFar, _MibView) -> + ?vtrace("next_node(node,variable) -> entry", []), + false. + + +%%----------------------------------------------------------------- +%% This function is used to find the first leaf from where we +%% are. +%% Returns: {subagent, SubAgentPid, SAOid} | +%% false | +%% {variable, MibEntry, VarOid} | +%% {table, TableOid, TableRestOid, MibEntry} +%% PRE: This function must always be called with a {internal, Tree} +%% node. +%%----------------------------------------------------------------- +find_next(D, {tree, Tree, internal}, Idx, RevOidSoFar, MibView) + when Idx < size(Tree) -> + case find_next(D, element(Idx+1, Tree), 0, [Idx| RevOidSoFar], MibView) of + false -> + find_next(D, {tree, Tree, internal}, Idx+1, RevOidSoFar, MibView); + Other -> + Other + end; +find_next(_D, {tree, _Tree, internal}, _Idx, _RevOidSoFar, _MibView) -> + false; +find_next(_D, undefined_node, _Idx, _RevOidSoFar, _MibView) -> + false; +find_next(D, {tree, Tree, {table, _MibName}}, Idx, RevOidSoFar, MibView) -> + find_next(D, {tree, Tree, internal}, Idx, RevOidSoFar, MibView); +find_next(D, {tree, _Tree, {table_entry, _MibName}}, _Index, + RevOidSoFar, MibView) -> + OidSoFar = lists:reverse(RevOidSoFar), + case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of + true -> + false; + _ -> + #mib_data{module = Mod, node_db = Db} = D, + case Mod:read(Db, OidSoFar) of + false -> + ?vinfo("find_next -> could not find table_entry ME with" + "~n OidSoFar: ~p", [OidSoFar]), + false; + {value, #node_info{me = ME}} -> + {table, OidSoFar, [], ME} + end + end; +find_next(D, {node, {variable, _MibName}}, _Idx, RevOidSoFar, MibView) -> + OidSoFar = lists:reverse([0 | RevOidSoFar]), + case snmpa_acm:validate_mib_view(OidSoFar, MibView) of + true -> + #mib_data{module = Mod, node_db = Db} = D, + case Mod:read(Db, lists:reverse(RevOidSoFar)) of + false -> + ?vinfo("find_next -> could not find variable with" + "~n RevOidSoFar: ~p", [RevOidSoFar]), + false; + {value, #node_info{me = ME}} -> + {variable, ME, OidSoFar} + end; + _ -> + false + end; +find_next(D, {node, subagent}, _Idx, RevOidSoFar, MibView) -> + OidSoFar = lists:reverse(RevOidSoFar), + case snmpa_acm:is_definitely_not_in_mib_view(OidSoFar, MibView) of + true -> + false; + _ -> + #mib_data{subagents = SAs} = D, + case lists:keysearch(OidSoFar, 2, SAs) of + {value, {SubAgentPid, OidSoFar}} -> + {subagent, SubAgentPid, OidSoFar}; + false -> + ?vinfo("find_node -> could not find subagent with" + "~n OidSoFar: ~p" + "~n SAs: ~p", [OidSoFar, SAs]), + false + end + end. + +%%%====================================================================== +%%% 3. Tree building functions +%%% Used when loading mibs. +%%%====================================================================== + +build_tree(Mes, MibName) -> + ?d("build_tree -> " + "~n Mes: ~p", [Mes]), + {ListTree, []} = build_subtree([], Mes, MibName), + {tree, convert_tree(ListTree), internal}. + +%%---------------------------------------------------------------------- +%% Purpose: Builds the tree where all oids have prefix equal to LevelPrefix. +%% Returns: {Tree, RestMes} +%% RestMes are Mes that should not be in this subtree. +%% The Tree is a temporary and simplified data structure that is easy to +%% convert to the final tuple tree used by the MIB process. +%% A Node is represented as in the final tree. +%% The tree is not represented as a N-tuple, but as an Index-list. +%% Example: Temporary: [{1, Node1}, {3, Node3}] +%% Final: {Node1, undefined_node, Node3} +%% Pre: Mes are sorted on oid. +%%---------------------------------------------------------------------- +build_subtree(LevelPrefix, [Me | Mes], MibName) -> + ?vtrace("build subtree -> ~n" + " oid: ~p~n" + " LevelPrefix: ~p~n" + " MibName: ~p", [Me#me.oid, LevelPrefix, MibName]), + EType = Me#me.entrytype, + ?vtrace("build subtree -> EType = ~p",[EType]), + case in_subtree(LevelPrefix, Me) of + above -> + ?vtrace("build subtree -> above",[]), + {[], [Me|Mes]}; + {node, Index} -> + ?vtrace("build subtree -> node at ~p",[Index]), + {Tree, RestMes} = build_subtree(LevelPrefix, Mes, MibName), + {[{Index, {node, {EType, MibName}}} | Tree], RestMes}; + {subtree, Index, NewLevelPrefix} -> + ?vtrace("build subtree -> subtree at" + "~n ~w with ~w", + [Index, NewLevelPrefix]), + {BelowTree, RestMes} = + build_subtree(NewLevelPrefix, Mes, MibName), + {CurTree, RestMes2} = + build_subtree(LevelPrefix, RestMes, MibName), + {[{Index, {tree, BelowTree, {EType,MibName}}}| CurTree], RestMes2}; + {internal_subtree, Index, NewLevelPrefix} -> + ?vtrace("build subtree -> internal_subtree at" + "~n ~w with ~w", + [Index,NewLevelPrefix]), + {BelowTree, RestMes} = + build_subtree(NewLevelPrefix, [Me | Mes], MibName), + {CurTree, RestMes2} = + build_subtree(LevelPrefix, RestMes, MibName), + {[{Index, {tree, BelowTree, internal}} | CurTree], RestMes2} + end; + +build_subtree(_LevelPrefix, [], _MibName) -> + ?vtrace("build subtree -> done", []), + {[], []}. + +%%-------------------------------------------------- +%% Purpose: Determine how/if/where Me should be inserted in subtree +%% with LevelPrefix. This function does not build any tree, only +%% determinses what should be done (by build subtree). +%% Returns: +%% above - Indicating that this ME should _not_ be in this subtree. +%% {node, Index} - yes, construct a node with index Index on this level +%% {internal_subtree, Index, NewLevelPrefix} - yes, there should be an +%% internal subtree at this index. +%% {subtree, Index, NewLevelPrefix} - yes, construct a subtree with +%% NewLevelPrefix and insert this on current level in position Index. +%%-------------------------------------------------- +in_subtree(LevelPrefix, Me) -> + case lists:prefix(LevelPrefix, Me#me.oid) of + true when length(Me#me.oid) > length(LevelPrefix) -> + classify_how_in_subtree(LevelPrefix, Me); + _ -> + above + end. + +%%-------------------------------------------------- +%% See comment about in_subtree/2. This function takes care of all cases +%% where the ME really should be in _this_ subtree (not above). +%%-------------------------------------------------- +classify_how_in_subtree(LevelPrefix, Me) + when (length(Me#me.oid) =:= (length(LevelPrefix) + 1)) -> + Oid = Me#me.oid, + case node_or_subtree(Me#me.entrytype) of + subtree -> + {subtree, lists:last(Oid), Oid}; + node -> + {node, lists:last(Oid)} + end; + +classify_how_in_subtree(LevelPrefix, Me) + when (length(Me#me.oid) > (length(LevelPrefix) + 1)) -> + L1 = length(LevelPrefix) + 1, + Oid = Me#me.oid, + {internal_subtree, lists:nth(L1, Oid), lists:sublist(Oid, 1, L1)}. + +%%-------------------------------------------------- +%% Determines how to treat different kinds om MEs in the tree building process. +%% Pre: all internal nodes have been removed. +%%-------------------------------------------------- +node_or_subtree(table) -> subtree; +node_or_subtree(table_entry) -> subtree; +node_or_subtree(variable) -> node; +node_or_subtree(table_column) -> node. + +%%-------------------------------------------------- +%% Purpose: (Recursively) Converts a temporary tree (see above) to a final tree. +%% If input is a ListTree, output is a TupleTree. +%% If input is a Node, output is the same Node. +%% Pre: All Indexes are >= 0. +%%-------------------------------------------------- +convert_tree({Index, {tree, Tree, Info}}) when Index >= 0 -> + L = lists:map(fun convert_tree/1, Tree), + {Index, {tree, dict_list_to_tuple(L), Info}}; +convert_tree({Index, {node, Info}}) when Index >= 0 -> + {Index, {node, Info}}; +convert_tree(Tree) when is_list(Tree) -> + L = lists:map(fun convert_tree/1, Tree), + dict_list_to_tuple(L). + +%%---------------------------------------------------------------------- +%% Purpose: Converts a single level (that is non-recursively) from +%% the temporary indexlist to the N-tuple. +%% Input: A list of {Index, Data}. +%% Output: A tuple where element Index is Data. +%%---------------------------------------------------------------------- +dict_list_to_tuple(L) -> + L2 = lists:keysort(1, L), + list_to_tuple(integrate_indexes(0, L2)). + +%%---------------------------------------------------------------------- +%% Purpose: Helper function for dict_list_to_tuple/1. +%% Converts an indexlist to a N-list. +%% Input: A list of {Index, Data}. +%% Output: A (usually longer, never shorter) list where element Index is Data. +%% Example: [{1,hej}, {3, sven}] will give output +%% [undefined_node, hej, undefined_node, sven]. +%% Initially CurIndex should be 0. +%%---------------------------------------------------------------------- +integrate_indexes(CurIndex, [{CurIndex, Data} | T]) -> + [Data | integrate_indexes(CurIndex + 1, T)]; +integrate_indexes(_Index, []) -> + []; +integrate_indexes(CurIndex, L) -> + [undefined_node | integrate_indexes(CurIndex + 1, L)]. + +%%%====================================================================== +%%% 4. Tree merging +%%% Used by: load mib, insert subagent. +%%%====================================================================== + +%%---------------------------------------------------------------------- +%% Arg: Two root nodes (that is to be merged). +%% Returns: A new root node where the nodes have been merger to one. +%%---------------------------------------------------------------------- +merge_nodes(Same, Same) -> + Same; +merge_nodes(Node, undefined_node) -> + Node; +merge_nodes(undefined_node, Node) -> + Node; +merge_nodes({tree, Tree1, internal}, {tree, Tree2, internal}) -> + {tree, merge_levels(tuple_to_list(Tree1),tuple_to_list(Tree2)), internal}; +merge_nodes(Node1, Node2) -> + throw({error_merge_nodes, Node1, Node2}). + +%%---------------------------------------------------------------------- +%% Arg: Two levels to be merged. +%% Here, a level is represented as a list of nodes. A list is easier +%% to extend than a tuple. +%% Returns: The resulting, merged level tuple. +%%---------------------------------------------------------------------- +merge_levels(Level1, Level2) when length(Level1) =:= length(Level2) -> + MergeNodes = fun(N1, N2) -> merge_nodes(N1, N2) end, + list_to_tuple(snmp_misc:multi_map(MergeNodes, [Level1, Level2])); +merge_levels(Level1, Level2) when length(Level1) > length(Level2) -> + merge_levels(Level1, Level2 ++ + undefined_nodes_list(length(Level1) - length(Level2))); +merge_levels(Level1, Level2) when length(Level1) < length(Level2) -> + merge_levels(Level2, Level1). + +undefined_nodes_list(N) -> lists:duplicate(N, undefined_node). + + +%%%====================================================================== +%%% 5. Tree deletion routines +%%% (for unload mib) +%%%====================================================================== + +%%---------------------------------------------------------------------- +%% Purpose: Actually kicks of the tree reconstruction. +%% Returns: {list of removed MEs, NewTree} +%%---------------------------------------------------------------------- +delete_mib_from_tree(MibName, {tree, Tree, internal}) -> + case delete_tree(Tree, MibName) of + [] -> + {tree, {undefined_node}, internal}; % reduce + LevelList -> + {tree, list_to_tuple(LevelList), internal} + end. + +%%---------------------------------------------------------------------- +%% Purpose: Deletes all nodes associated to MibName from this level and +%% all levels below. +%% If the new level does not contain information (that is, no +%% other mibs use it) anymore the empty list is returned. +%% Returns: {MEs, The new level represented as a list} +%%---------------------------------------------------------------------- +delete_tree(Tree, MibName) when is_tuple(Tree) -> + NewLevel = delete_nodes(tuple_to_list(Tree), MibName, []), + case lists:filter(fun drop_undefined_nodes/1,NewLevel) of + [] -> []; + _A_perhaps_shorted_list -> + NewLevel % some other mib needs this level + end. + +%%---------------------------------------------------------------------- +%% Purpose: Nodes belonging to MibName are removed from the tree. +%% Recursively deletes sub trees to this node. +%% Returns: {MEs, NewNodesList} +%%---------------------------------------------------------------------- +delete_nodes([], _MibName, AccNodes) -> + lists:reverse(AccNodes); + +delete_nodes([{node, {variable, MibName}}|T], MibName, AccNodes) -> + delete_nodes(T, MibName, [undefined_node | AccNodes]); + +delete_nodes([{node, {table_column, MibName}}|T], MibName, AccNodes) -> + delete_nodes(T, MibName, [undefined_node | AccNodes]); + +delete_nodes([{tree, _Tree, {table, MibName}}|T], MibName, AccNodes) -> + delete_nodes(T, MibName, [undefined_node | AccNodes]); + +delete_nodes([{tree, _Tree, {table_entry, MibName}}|T], MibName, AccNodes) -> + delete_nodes(T, MibName, [undefined_node | AccNodes]); + +delete_nodes([{tree, Tree, Info}|T], MibName, AccNodes) -> + case delete_tree(Tree, MibName) of + [] -> % tree completely deleted + delete_nodes(T, MibName, [undefined_node | AccNodes]); + LevelList -> + delete_nodes(T, MibName, + [{tree, list_to_tuple(LevelList), Info} | AccNodes]) + end; + +delete_nodes([NodeToKeep|T], MibName, AccNodes) -> + delete_nodes(T, MibName, [NodeToKeep | AccNodes]). + +drop_undefined_nodes(undefined_node) -> false; +drop_undefined_nodes(_) -> true. + + +%%%====================================================================== +%%% 6. Functions for subagent handling +%%%====================================================================== + +%%---------------------------------------------------------------------- +%% Returns: A new Root|{error, reason} +%%---------------------------------------------------------------------- +insert_subagent(Oid, OldRoot) -> + ListTree = build_tree_for_subagent(Oid), + case catch convert_tree(ListTree) of + {'EXIT', _Reason} -> + {error, 'cannot construct tree from oid'}; + Level when is_tuple(Level) -> + T = {tree, Level, internal}, + case catch merge_nodes(T, OldRoot) of + {error_merge_nodes, _Node1, _Node2} -> + {error, oid_conflict}; + NewRoot when is_tuple(NewRoot) andalso + (element(1, NewRoot) =:= tree) -> + NewRoot + end + end. + +build_tree_for_subagent([Index]) -> + [{Index, {node, subagent}}]; + +build_tree_for_subagent([Index | T]) -> + [{Index, {tree, build_tree_for_subagent(T), internal}}]. + + +%%---------------------------------------------------------------------- +%% Returns: A new tree where the subagent at Oid (2nd arg) has been deleted. +%%---------------------------------------------------------------------- + +delete_subagent({tree, Tree, Info}, [Index]) -> + {node, subagent} = element(Index+1, Tree), + {tree, setelement(Index+1, Tree, undefined_node), Info}; +delete_subagent({tree, Tree, Info}, [Index | TI]) -> + {tree, setelement(Index+1, Tree, + delete_subagent(element(Index+1, Tree), TI)), Info}. + + +%%%====================================================================== +%%% 7. Misc functions +%%%====================================================================== + +%%---------------------------------------------------------------------- +%% Installs the mibs found in the database when starting the agent. +%% Basically calls the instrumentation functions for all non-internal +%% mib-entries +%%---------------------------------------------------------------------- +install_mibs(Mod, MibDb, NodeDb) -> + MibNames = loaded(Mod, MibDb), + ?vtrace("install_mibs -> found following mibs in database: ~n" + "~p", [MibNames]), + install_mibs2(Mod, NodeDb, MibNames). + +install_mibs2(_, _, []) -> + ok; +install_mibs2(Mod, NodeDb, [MibName|MibNames]) -> + Pattern = #node_info{oid = '_', mib_name = MibName, me = '_'}, + Nodes = Mod:match_object(NodeDb, Pattern), + MEs = [ME || #node_info{me = ME} <- Nodes], + ?vtrace("install_mibs2 -> installing ~p MEs for mib ~p", + [length(MEs), MibName]), + NewF = fun(ME) -> call_instrumentation(ME, new) end, + lists:foreach(NewF, MEs), + install_mibs2(Mod, NodeDb, MibNames). + + +%%---------------------------------------------------------------------- +%% Does all side effect stuff during load_mib. +%%---------------------------------------------------------------------- +install_mib(Mod, Db, Symbolic, Mib, MibName, FileName, NonInternalMes) -> + ?vdebug("install_mib -> entry with" + "~n Symbolic: ~p" + "~n MibName: ~p" + "~n FileName: ~p", [Symbolic, MibName, FileName]), + Rec = #mib_info{name = MibName, symbolic = Symbolic, file_name = FileName}, + Mod:write(Db, Rec), + install_mib2(Symbolic, MibName, Mib), + NewF = fun(ME) -> call_instrumentation(ME, new) end, + lists:foreach(NewF, NonInternalMes). + +install_mib2(true, MibName, Mib) -> + #mib{table_infos = TabInfos, + variable_infos = VarInfos, + mes = MEs, + asn1_types = ASN1Types, + traps = Traps} = Mib, + snmpa_symbolic_store:add_table_infos(MibName, TabInfos), + snmpa_symbolic_store:add_variable_infos(MibName, VarInfos), + snmpa_symbolic_store:add_aliasnames(MibName, MEs), + snmpa_symbolic_store:add_types(MibName, ASN1Types), + SetF = fun(Trap) -> + snmpa_symbolic_store:set_notification(Trap, MibName) + end, + lists:foreach(SetF, Traps); +install_mib2(_, _, _) -> + ok. + +install_mes(Mod, Db, MibName, MEs) -> + Write = fun(#me{oid = Oid} = ME) -> + Node = #node_info{oid = Oid, + mib_name = MibName, + me = ME}, + Mod:write(Db, Node) + end, + install_mes(Write, MEs). + +install_mes(_Write, []) -> + ok; +install_mes(Write, [ME|MEs]) -> + Write(ME), + install_mes(Write, MEs). + + +%%---------------------------------------------------------------------- +%% Does all side effect stuff during unload_mib. +%%---------------------------------------------------------------------- +uninstall_mib(Mod, Db, Symbolic, MibName, MEs) -> + ?vtrace("uninstall_mib -> entry with" + "~n Db: ~p" + "~n Symbolic: ~p" + "~n MibName: ~p", [Db, Symbolic, MibName]), + Res = Mod:delete(Db, MibName), + ?vtrace("uninstall_mib -> (mib) db delete result: ~p", [Res]), + uninstall_mib2(Symbolic, MibName), + DelF = fun(ME) -> call_instrumentation(ME, delete) end, + lists:foreach(DelF, MEs). + +uninstall_mib2(true, MibName) -> + snmpa_symbolic_store:delete_table_infos(MibName), + snmpa_symbolic_store:delete_variable_infos(MibName), + snmpa_symbolic_store:delete_aliasnames(MibName), + snmpa_symbolic_store:delete_types(MibName), + snmpa_symbolic_store:delete_notifications(MibName); +uninstall_mib2(_, _) -> + ok. + +uninstall_mes(Mod, Db, MibName) -> + Pattern = #node_info{oid = '_', mib_name = MibName, me = '_'}, + Mod:match_delete(Db, Pattern). + + +%%---------------------------------------------------------------------- +%% Create a list of the names of all the loaded mibs +%%---------------------------------------------------------------------- +loaded(Mod, Db) -> + [N || #mib_info{name = N} <- Mod:tab2list(Db)]. + + +%%---------------------------------------------------------------------- +%% Calls MFA-instrumentation with 'new' or 'delete' operation. +%%---------------------------------------------------------------------- +call_instrumentation(#me{entrytype = variable, mfa={M,F,A}}, Operation) -> + ?vtrace("call instrumentation with" + "~n entrytype: variable" + "~n MFA: {~p,~p,~p}" + "~n Operation: ~p", + [M,F,A,Operation]), + catch apply(M, F, [Operation | A]); +call_instrumentation(#me{entrytype = table_entry, mfa={M,F,A}}, Operation) -> + ?vtrace("call instrumentation with" + "~n entrytype: table_entry" + "~n MFA: {~p,~p,~p}" + "~n Operation: ~p", + [M,F,A,Operation]), + catch apply(M, F, [Operation | A]); +call_instrumentation(_ShitME, _Operation) -> + done. + + +maybe_drop_me(#me{entrytype = internal}) -> false; +maybe_drop_me(#me{entrytype = group}) -> false; +maybe_drop_me(#me{imported = true}) -> false; +maybe_drop_me(_) -> true. + + +%%---------------------------------------------------------------------- +%% Code change functions +%%---------------------------------------------------------------------- + +code_change(down, _Vsn, _Extra, State) -> + ?d("code_change(down) -> entry when" + "~n Vsn: ~p" + "~n Extra: ~p", [_Vsn, _Extra]), + State; + +code_change(up, _Vsn, _Extra, State) -> + ?d("code_change(up) -> entry when" + "~n Vsn: ~p" + "~n Extra: ~p", [_Vsn, _Extra]), + State. + + diff --git a/lib/snmp/src/agent/snmpa_mib_storage.erl b/lib/snmp/src/agent/snmpa_mib_storage.erl new file mode 100644 index 0000000000..5c3f76d89b --- /dev/null +++ b/lib/snmp/src/agent/snmpa_mib_storage.erl @@ -0,0 +1,181 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. 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(snmpa_mib_storage). + +-export_type([ + mib_storage_fields/0, + mib_storage_table_type/0, + mib_storage_table_id/0 + ]). + + +%%% ---------------------------------------------------------------- +%%% This behaviour module defines the API for the mib-storage. +%%% This is how the agent stores its internal mib-data +%%% (symbolic-store and mib-server). +%%%----------------------------------------------------------------- + +-type mib_storage_fields() :: [atom()]. +-type mib_storage_table_type() :: set | bag. +-type mib_storage_table_id() :: term(). + + +%% --------------------------------------------------------------- +%% open +%% +%% Open or create a mib-storage table. +%% If any extra info needs to be communicated to the implementor +%% (of the behaviour), this is done using the *Options* argument. +%% --------------------------------------------------------------- + +%% Options is callback module dependant + +-callback open(Name :: atom(), + RecName :: atom(), + Fields :: mib_storage_fields(), + Type :: mib_storage_table_type(), + Options :: list()) -> + {ok, TabId :: mib_storage_table_id()} | {error, Reason :: term()}. + + +%% --------------------------------------------------------------- +%% close +%% +%% Close the mib-storage table. What this does is up to the +%% implementor (when using mnesia it may be a no-op but for ets +%% it may actually delete the table). +%% --------------------------------------------------------------- + +-callback close(TabId :: mib_storage_table_id()) -> + term(). + + +%% --------------------------------------------------------------- +%% read/2 +%% +%% Retrieve a record from the mib-storage table. +%% --------------------------------------------------------------- + +-callback read(TabId :: mib_storage_table_id(), + Key :: term()) -> + false | {value, Record :: tuple()}. + + +%% --------------------------------------------------------------- +%% write/2 +%% +%% Write a record to the mib-storage table. +%% --------------------------------------------------------------- + +-callback write(TabId :: mib_storage_table_id(), + Record :: tuple()) -> + ok | {error, Reason :: term()}. + + +%% --------------------------------------------------------------- +%% delete/1 +%% +%% Delete the mib-storage table. +%% --------------------------------------------------------------- + +-callback delete(TabId :: mib_storage_table_id()) -> + snmp:void(). + + +%% --------------------------------------------------------------- +%% delete/2 +%% +%% Delete a record from the mib-storage table. +%% --------------------------------------------------------------- + +-callback delete(TabId :: mib_storage_table_id(), + Key :: term()) -> + ok | {error, Reason :: term()}. + + +%% --------------------------------------------------------------- +%% match_object +%% +%% Search the mib-storage table for records which matches +%% the pattern. +%% --------------------------------------------------------------- + +-callback match_object(TabId :: mib_storage_table_id(), + Pattern :: ets:match_pattern()) -> + {ok, Recs :: [tuple()]} | {error, Reason :: term()}. + + +%% --------------------------------------------------------------- +%% match_delete +%% +%% Search the mib-storage table for records which matches the +%% pattern and deletes them from the database and return the +%5 deleted records. +%% --------------------------------------------------------------- + +-callback match_delete(TabId :: mib_storage_table_id(), + Pattern :: ets:match_pattern()) -> + {ok, Recs :: [tuple()]} | {error, Reason :: term()}. + + +%% --------------------------------------------------------------- +%% tab2list +%% +%% Return all records in the table in the form of a list. +%% --------------------------------------------------------------- + +-callback tab2list(TabId :: mib_storage_table_id()) -> + [tuple()]. + + +%% --------------------------------------------------------------- +%% info/1,2 +%% +%% Retrieve implementation dependent mib-storage table +%% information. +%% --------------------------------------------------------------- + +-callback info(TabId :: mib_storage_table_id()) -> + Info :: term(). + +-callback info(TabId :: mib_storage_table_id(), Item :: atom()) -> + Info :: term(). + + +%% --------------------------------------------------------------- +%% sync +%% +%% Dump mib-storage table to disc (if it has a disk component). +%% --------------------------------------------------------------- + +-callback sync(TabId :: mib_storage_table_id()) -> + snmp:void(). + + +%% --------------------------------------------------------------- +%% backup +%% +%% Make a backup copy of the mib-storage table. +%% --------------------------------------------------------------- + +-callback backup(TabId :: mib_storage_table_id(), + Dir :: file:filename()) -> + ok | {error, Reason :: term()}. + diff --git a/lib/snmp/src/agent/snmpa_mib_storage_dets.erl b/lib/snmp/src/agent/snmpa_mib_storage_dets.erl new file mode 100644 index 0000000000..e84e18e7ea --- /dev/null +++ b/lib/snmp/src/agent/snmpa_mib_storage_dets.erl @@ -0,0 +1,309 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. 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(snmpa_mib_storage_dets). + +-behaviour(snmpa_mib_storage). + + +%%%----------------------------------------------------------------- +%%% This module implements the snmpa_mib_storage behaviour. +%%% It uses dets for storage. +%%%----------------------------------------------------------------- + +-export([ + open/5, + close/1, + read/2, + write/2, + delete/1, + delete/2, + match_object/2, + match_delete/2, + tab2list/1, + info/1, info/2, + sync/1, + backup/2 + ]). + + +-define(VMODULE, "MS-DETS"). +-include("snmp_verbosity.hrl"). + +-record(tab, {id, rec_name}). + + +%% --------------------------------------------------------------- +%% open +%% +%% Open or create a mib-storage (dets) table. +%% +%% Opts - A list of implementation dependent options +%% dets_open_options() = [dets_open_option()] +%% dets_open_option() = {dir, filename()} | +%% {action, keep | clear} | +%% {auto_save, default | pos_integer()} | +%% {repair, force | boolean()} +%% +%% --------------------------------------------------------------- + +open(Name, RecName, _Fields, Type, Opts) -> + Dir = snmp_misc:get_option(dir, Opts), + Action = snmp_misc:get_option(action, Opts, keep), + AutoSave = snmp_misc:get_option(auto_save, Opts, default), + Repair = snmp_misc:get_option(repair, Opts, false), + File = dets_filename(Name, Dir), + OpenOpts = [{file, File}, + {type, Type}, + {keypos, 2}, + {repair, Repair}] ++ + case AutoSave of + default -> + []; + _ -> + [{auto_save, AutoSave}] + end, + case dets:open_file(Name, OpenOpts) of + {ok, ID} when (Action =:= keep) -> + {ok, #tab{id = ID, rec_name = RecName}}; + {ok, ID} when (Action =:= clear) -> + dets:match_delete(ID, '_'), + {ok, #tab{id = ID, rec_name = RecName}}; + {error, Reason} -> + {error, {dets_open, Reason}} + end. + +dets_filename(Name, Dir) -> + Dir1 = dets_filename1(Dir), + Dir2 = string:strip(Dir1, right, $/), + io_lib:format("~s/~p.dat", [Dir2, Name]). + +dets_filename1([]) -> "."; +dets_filename1(Dir) -> Dir. + + +%% --------------------------------------------------------------- +%% close +%% +%% Close the table. +%% --------------------------------------------------------------- + +close(#tab{id = ID}) -> + ?vtrace("close database ~p", [ID]), + dets:close(ID). + + +%% --------------------------------------------------------------- +%% read +%% +%% Retrieve a record from the database table. +%% --------------------------------------------------------------- + +read(#tab{id = ID}, Key) -> + ?vtrace("read from table ~p: ~p", [ID, Key]), + case dets:lookup(ID, Key) of + [Rec|_] -> {value, Rec}; + _ -> false + end. + + +%% --------------------------------------------------------------- +%% write +%% +%% Write a record to the database table. +%% --------------------------------------------------------------- + +write(#tab{id = ID, rec_name = RecName}, Rec) + when (is_tuple(Rec) andalso (element(1, Rec) =:= RecName)) -> + ?vtrace("write to table ~p", [ID]), + dets:insert(ID, Rec). + + +%% --------------------------------------------------------------- +%% delete +%% +%% Delete the database table. +%% --------------------------------------------------------------- + +delete(#tab{id = ID}) -> + ?vtrace("delete database ~p", [ID]), + File = dets:info(ID, filename), + case dets:close(ID) of + ok -> + file:delete(File); + Error -> + Error + end. + + +%% --------------------------------------------------------------- +%% delete +%% +%% Delete a record from the database table. +%% --------------------------------------------------------------- + +delete(#tab{id = ID}, Key) -> + ?vtrace("delete from table ~p: ~p", [ID, Key]), + dets:delete(ID, Key). + + +%% --------------------------------------------------------------- +%% match_object +%% +%% Search the database table for records witch matches the pattern. +%% --------------------------------------------------------------- + +match_object(#tab{id = ID}, Pattern) -> + ?vtrace("match_object in ~p of ~p", [ID, Pattern]), + dets:match_object(ID, Pattern). + + +%% --------------------------------------------------------------- +%% match_delete +%% +%% Search the database table for records witch matches the +%% pattern and deletes them from the database table. +%% --------------------------------------------------------------- + +match_delete(#tab{id = ID}, Pattern) -> + ?vtrace("match_delete in ~p with pattern ~p", [ID, Pattern]), + Recs = dets:match_object(ID, Pattern), + dets:match_delete(ID, Pattern), + Recs. + + +%% --------------------------------------------------------------- +%% tab2list +%% +%% Return all records in the table in the form of a list. +%% --------------------------------------------------------------- + +tab2list(#tab{id = ID} = Tab) -> + ?vtrace("tab2list -> list of ~p", [ID]), + match_object(Tab, '_'). + + +%% --------------------------------------------------------------- +%% info +%% +%% Retrieve implementation dependent mib-storage table +%% information. +%% --------------------------------------------------------------- + +info(#tab{id = ID}) -> + ?vtrace("info -> info of ~p", [ID]), + dets:info(ID). + + +info(TabId, all = _Item) -> + info(TabId); +info(#tab{id = ID}, memory = _Item) -> + ?vtrace("info on ~p (~w)", [ID, _Item]), + dets:info(ID, file_size); +info(#tab{id = ID}, Item) -> + ?vtrace("info on ~p (~w)", [ID, Item]), + dets:info(ID, Item). + + +%% --------------------------------------------------------------- +%% sync +%% +%% Dump mib-storage table to disc (if it has a disk component) +%% --------------------------------------------------------------- + +sync(#tab{id = ID}) -> + ?vtrace("sync -> sync ~p", [ID]), + dets:sync(ID). + + +%% --------------------------------------------------------------- +%% backup +%% +%% Make a backup copy of the mib-storage table. +%% --------------------------------------------------------------- + +backup(#tab{id = ID}, BackupDir) -> + ?vtrace("backup -> backup of ~p to ~p", [ID, BackupDir]), + case dets:info(ID, filename) of + undefined -> + {error, no_file}; + Filename -> + case filename:dirname(Filename) of + BackupDir -> + {error, db_dir}; + _ -> + Type = dets:info(ID, type), + KP = dets:info(ID, keypos), + dets_backup(ID, + filename:basename(Filename), + BackupDir, Type, KP) + end + end. + + +dets_backup(ID, Filename, BackupDir, Type, KP) -> + ?vtrace("dets_backup -> entry with" + "~n ID: ~p" + "~n Filename: ~p" + "~n BackupDir: ~p" + "~n Type: ~p" + "~n KP: ~p", [ID, Filename, BackupDir, Type, KP]), + BackupFile = filename:join(BackupDir, Filename), + ?vtrace("dets_backup -> " + "~n BackupFile: ~p", [BackupFile]), + Backup = list_to_atom(atom_to_list(ID) ++ "_backup"), + Opts = [{file, BackupFile}, {type, Type}, {keypos, KP}], + case dets:open_file(Backup, Opts) of + {ok, B} -> + ?vtrace("dets_backup -> create fun", []), + F = fun(Arg) -> + dets_backup(Arg, start, ID, B) + end, + dets:safe_fixtable(ID, true), + Res = dets:init_table(Backup, F, [{format, bchunk}]), + dets:safe_fixtable(ID, false), + ?vtrace("dets_backup -> Res: ~p", [Res]), + Res; + Error -> + ?vinfo("dets_backup -> open_file failed: " + "~n ~p", [Error]), + Error + end. + +dets_backup(close, _Cont, _ID, B) -> + dets:close(B), + ok; +dets_backup(read, Cont1, ID, B) -> + case dets:bchunk(ID, Cont1) of + {Cont2, Data} -> + F = fun(Arg) -> + dets_backup(Arg, Cont2, ID, B) + end, + {Data, F}; + '$end_of_table' -> + dets:close(B), + end_of_input; + Error -> + Error + end. + + +%%---------------------------------------------------------------------- + +%% user_err(F, A) -> +%% snmpa_error:user_err(F, A). diff --git a/lib/snmp/src/agent/snmpa_mib_storage_ets.erl b/lib/snmp/src/agent/snmpa_mib_storage_ets.erl new file mode 100644 index 0000000000..04faf46864 --- /dev/null +++ b/lib/snmp/src/agent/snmpa_mib_storage_ets.erl @@ -0,0 +1,341 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. 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(snmpa_mib_storage_ets). + +-behaviour(snmpa_mib_storage). + +%%%----------------------------------------------------------------- +%%% This module implements the snmpa_mib_storage behaviour. +%%% It uses ets for storage. +%%%----------------------------------------------------------------- + +-export([ + open/5, + close/1, + read/2, + write/2, + delete/1, + delete/2, + match_object/2, + match_delete/2, + tab2list/1, + info/1, info/2, + sync/1, + backup/2 + ]). + + +-define(VMODULE,"MS-ETS"). +-include("snmp_verbosity.hrl"). + +-record(tab, {id, rec_name, file, checksum = false}). + + +%% --------------------------------------------------------------- +%% open +%% +%% Open or create an ets table. +%% Possibly also read data from a (specified) file (mirror) and +%% populate the table from that (the dir option). +%% +%% Opts - A list of implementation dependent options +%% ets_open_options() = [ets_open_option()] +%% ets_open_option() = {dir, filename()} | +%% {action, keep | clear} | +%% {checksum, boolean()} +%% +%% The RecName and Fields arguments are not used in this +%% implementation. +%% +%% --------------------------------------------------------------- + +%% This function creates the ets table +open(Name, RecName, _Fields, Type, Opts) -> + ?vtrace("open table ~p", [Name]), + case lists:keysearch(dir, 1, Opts) of + {value, {dir, Dir}} -> + Action = snmp_misc:get_option(action, Opts, keep), + Checksum = snmp_misc:get_option(checksum, Opts, false), + ?vtrace("open ~p database ~p - check if file exist", [Type, Name]), + File = filename:join(Dir, atom_to_list(Name) ++ ".db"), + case file:read_file_info(File) of + {ok, _} -> + ?vdebug("open ~p database ~p - file exist - try reading", + [Type, Name]), + case ets:file2tab(File, [{verify, Checksum}]) of + {ok, ID} -> + ?vtrace("open ~p database ~p - " + "data read from file", [Type, Name]), + {ok, #tab{id = ID, + rec_name = RecName, + file = File, + checksum = Checksum}}; + {error, Reason} when (Action =:= keep) -> + ?vinfo("open ~p database ~p - " + "failed reading from file (keep): " + "~n ~p", + [Type, Name, Reason]), + {error, {file2tab, Reason}}; + {error, Reason} -> + ?vlog("open ~p database ~p - " + "failed reading from file (clear): " + "~n ~p", [Type, Name, Reason]), + user_err("Warning: could not read file - " + "create new (empty): " + "~n File: ~p" + "~n Reason: ~p", [File, Reason]), + ID = ets:new(Name, [Type, protected, {keypos, 2}]), + write_ets_file(ID, File, Checksum), + {ok, #tab{id = ID, + rec_name = RecName, + file = File, + checksum = Checksum}} + end; + {error, enoent} -> + %% No such file - create it + ?vdebug("open ~p database ~p - " + "file does *not* exist - create", + [Type, Name]), + ID = ets:new(Name, [Type, protected, {keypos, 2}]), + write_ets_file(ID, File, Checksum), + {ok, #tab{id = ID, + rec_name = RecName, + file = File, + checksum = Checksum}}; + {error, Reason} when (Action =:= keep) -> + ?vinfo("open ~p database ~p - " + "failed reading file info (keep): " + "~n ~p", + [Type, Name, Reason]), + {error, {read_file_info, Reason}}; + {error, Reason} -> + ?vlog("open ~p database ~p - " + "failed reading file info (clear): " + "~n ~p", + [Type, Name, Reason]), + user_err("Warning: could not read file info - " + "create new file: " + "~n File: ~p" + "~n Reason: ~p", [File, Reason]), + ID = ets:new(Name, [Type, protected, {keypos, 2}]), + write_ets_file(ID, File, Checksum), + {ok, #tab{id = ID, + rec_name = RecName, + file = File, + checksum = Checksum}} + end; + false -> + ?vdebug("open ~p database ~p - ok", [Type, Name]), + ID = ets:new(Name, [Type, protected, {keypos, 2}]), + {ok, #tab{id = ID, rec_name = RecName}} + end. + + +%% --------------------------------------------------------------- +%% close +%% +%% Close the mib-storage table. +%% We will delete the table and if there is a file component, +%% will also be written to file. +%% --------------------------------------------------------------- +close(#tab{id = ID, file = undefined}) -> + ?vtrace("close (delete) table ~p", [ID]), + ets:delete(ID); +close(#tab{id = ID, file = File, checksum = Checksum}) -> + ?vtrace("close (delete) table ~p", [ID]), + write_ets_file(ID, File, Checksum), + ets:delete(ID). + + +%% --------------------------------------------------------------- +%% read +%% +%% Retrieve a record from the mib-storage table. +%% --------------------------------------------------------------- + +read(#tab{id = ID}, Key) -> + ?vtrace("read from table ~p: ~p", [ID, Key]), + case ets:lookup(ID, Key) of + [Rec|_] -> {value, Rec}; + _ -> false + end. + + +%% --------------------------------------------------------------- +%% write +%% +%% Write a record to the mib-storage table. +%% --------------------------------------------------------------- + +%% This is a very crude guard test is used instead of: is_record(Rec, RecName) +write(#tab{id = ID, rec_name = RecName}, Rec) + when (is_tuple(Rec) andalso (element(1, Rec) =:= RecName)) -> + ?vtrace("write to table ~p", [ID]), + ets:insert(ID, Rec). + + +%% --------------------------------------------------------------- +%% delete +%% +%% Delete the mib-storage table. +%% --------------------------------------------------------------- +delete(#tab{id = ID, file = undefined}) -> + ?vtrace("delete table ~p", [ID]), + ets:delete(ID); +delete(#tab{id = ID, file = File}) -> + ?vtrace("delete table ~p", [ID]), + file:delete(File), + ets:delete(ID). + + +%% --------------------------------------------------------------- +%% delete +%% +%% Delete a record from the mib-storage table. +%% --------------------------------------------------------------- +delete(#tab{id = ID}, Key) -> + ?vtrace("delete from table ~p: ~p", [ID, Key]), + ets:delete(ID, Key). + + +%% --------------------------------------------------------------- +%% match_object +%% +%% Search the mib-storage table for records witch matches +%% the pattern. +%% --------------------------------------------------------------- + +match_object(#tab{id = ID}, Pattern) -> + ?vtrace("match_object in ~p of ~p", [ID, Pattern]), + ets:match_object(ID, Pattern). + + +%% --------------------------------------------------------------- +%% match_delete +%% +%% Search the mib-storage table for records witch matches +%% the pattern and deletes them from the table. +%% --------------------------------------------------------------- + +match_delete(#tab{id = ID}, Pattern) -> + ?vtrace("match_delete in ~p with pattern ~p", [ID, Pattern]), + Recs = ets:match_object(ID, Pattern), + ets:match_delete(ID, Pattern), + Recs. + + +%% --------------------------------------------------------------- +%% tab2list +%% +%% Return all records in the mib-storage table in the form +%% of a list. +%% --------------------------------------------------------------- + +tab2list(#tab{id = ID}) -> + ?vtrace("tab2list -> list of ~p", [ID]), + ets:tab2list(ID). + + + +%% --------------------------------------------------------------- +%% info/1,2 +%% +%% Retrieve implementation dependent mib-storage table +%% information. +%% --------------------------------------------------------------- +info(#tab{id = ID}) -> + ?vtrace("info on ~p", [ID]), + case ets:info(ID) of + undefined -> + []; + L -> + L + end. + + +info(TabId, all = _Item) -> + info(TabId); +info(#tab{id = ID}, Item) -> + ?vtrace("info on ~p", [ID]), + ets:info(ID, Item). + + +%% --------------------------------------------------------------- +%% sync +%% +%% Dump mib-storage table to disc (if there is a file compionent) +%% --------------------------------------------------------------- + +sync(#tab{file = undefined}) -> + ok; +sync(#tab{id = ID, file = File, checksum = Checksum}) -> + ?vtrace("sync ~p", [ID]), + write_ets_file(ID, File, Checksum). + + +%% --------------------------------------------------------------- +%% backup +%% +%% Make a backup copy of the mib-storage table. Only valid id +%% there is a file component. +%% --------------------------------------------------------------- + +backup(#tab{file = undefined}, _BackupDir) -> + ok; +backup(#tab{id = ID, file = File, checksum = Checksum}, BackupDir) -> + ?vtrace("backup ~p to ~p", [ID, BackupDir]), + Filename = filename:basename(File), + case filename:join(BackupDir, Filename) of + File -> + %% Oups: backup-dir and db-dir the same + {error, db_dir}; + BackupFile -> + write_ets_file(ID, BackupFile, Checksum) + end. + + +%%---------------------------------------------------------------------- + +write_ets_file(ID, File, Checksum) when (Checksum =:= true) -> + do_write_ets_file(ID, File, [{extended_info, [md5sum]}]); +write_ets_file(ID, File, Checksum) when (Checksum =:= false) -> + do_write_ets_file(ID, File, []). + +do_write_ets_file(ID, File, Options) -> + TmpFile = File ++ ".tmp", + case ets:tab2file(ID, TmpFile, Options) of + ok -> + case file:rename(TmpFile, File) of + ok -> + ok; + Else -> + user_err("Warning: could not move file ~p" + " (~p)", [File, Else]) + end; + {error, Reason} -> + user_err("Warning: could not save file ~p (~p)", + [File, Reason]) + end. + + +%%---------------------------------------------------------------------- + +user_err(F, A) -> + snmpa_error:user_err(F, A). diff --git a/lib/snmp/src/agent/snmpa_mib_storage_mnesia.erl b/lib/snmp/src/agent/snmpa_mib_storage_mnesia.erl new file mode 100644 index 0000000000..192b5aa26e --- /dev/null +++ b/lib/snmp/src/agent/snmpa_mib_storage_mnesia.erl @@ -0,0 +1,302 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. 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(snmpa_mib_storage_mnesia). + + +-behaviour(snmpa_mib_storage). + +%%%----------------------------------------------------------------- +%%% This module implements the snmpa_mib_storage behaviour. +%%% It uses mnesia for storage. +%%%----------------------------------------------------------------- + +-export([ + open/5, + close/1, + read/2, + write/2, + delete/1, + delete/2, + match_object/2, + match_delete/2, + tab2list/1, + info/1, info/2, + sync/1, + backup/2 + ]). + + +-define(VMODULE,"MS-MNESIA"). +-include("snmp_verbosity.hrl"). + +-record(tab, {id}). + + +%% --------------------------------------------------------------- +%% open +%% +%% Open or create a mnesia table. +%% +%% Opts - A list of implementation dependent options +%% mnesia_open_options() = [mnesia_open_option()] +%% mnesia_open_option() = {action, keep | clear} | +%% {nodes, [node()]} +%% +%% --------------------------------------------------------------- + +open(Name, RecName, Fields, Type, Opts) -> + ?vtrace("open ~p table ~p for record ~p", + [Type, Name, RecName]), + Action = get_action(Opts), + Nodes = get_nodes(Opts), + case table_exists(Name) of + true when (Action =:= keep) -> + ?vtrace("open table ~p - exist (keep)", [Name]), + {ok, #tab{id = Name}}; + true when (Action =:= clear) -> + ?vtrace("open table ~p - exist (clear)", [Name]), + F = fun() -> mnesia:clear_table(Name) end, + case mnesia:transaction(F) of + {aborted, Reason} -> + {error, {clear, Reason}}; + {atomic, _} -> + {ok, #tab{id = Name}} + end; + false -> + ?vtrace("open table ~p - does not exist", [Name]), + Args = [{record_name, RecName}, + {attributes, Fields}, + {type, Type}, + {disc_copies, Nodes}], + case mnesia:create_table(Name, Args) of + {atomic, ok} -> + ?vtrace("open table ~p - ok", [Name]), + {ok, #tab{id = Name}}; + {aborted, Reason} -> + ?vinfo("open table ~p - aborted" + "~n Reason: ~p", [Name, Reason]), + {error, {create, Reason}} + end + end. + +table_exists(Name) -> + case (catch mnesia:table_info(Name, type)) of + {'EXIT', _Reason} -> + false; + _ -> + true + end. + + +%% --------------------------------------------------------------- +%% close +%% +%% Close the mib-storage table. +%% This does nothing in the mnesia case. +%% --------------------------------------------------------------- + +close(_) -> + ?vtrace("close mib-storage - ignore",[]), + ok. + + +%% --------------------------------------------------------------- +%% read +%% +%% Retrieve a record from the mib-storage table. +%% --------------------------------------------------------------- + +read(#tab{id = ID}, Key) -> + ?vtrace("read (dirty) from database ~p: ~p", [ID, Key]), + case (catch mnesia:dirty_read(ID, Key)) of + [Rec|_] -> {value,Rec}; + _ -> false + end. + + +%% --------------------------------------------------------------- +%% write +%% +%% Write a record to the mib-storage table. +%% --------------------------------------------------------------- + +write(#tab{id = ID}, Rec) -> + ?vtrace("write to database ~p", [ID]), + F = fun() -> mnesia:write(ID, Rec, write) end, + case mnesia:transaction(F) of + {aborted, _Reason} = ABORTED -> + {error, ABORTED}; + {atomic,_} -> + ok + end. + + +%% --------------------------------------------------------------- +%% delete +%% +%% Delete the mib-storage table. +%% --------------------------------------------------------------- + +delete(#tab{id = ID}) -> + ?vtrace("delete database: ~p", [ID]), + mnesia:delete_table(ID). + + +%% --------------------------------------------------------------- +%% delete +%% +%% Delete a record from the mib-storage table. +%% --------------------------------------------------------------- + +delete(#tab{id = ID}, Key) -> + ?vtrace("delete from database ~p: ~p", [ID, Key]), + F = fun() -> mnesia:delete(ID, Key, write) end, + case mnesia:transaction(F) of + {aborted, _Reason} = ABORTED -> + {error, ABORTED}; + {atomic, _} -> + ok + end. + + +%% --------------------------------------------------------------- +%% match_object +%% +%% Search the mib-storage table for records witch matches +%% the pattern. +%% --------------------------------------------------------------- + +match_object(#tab{id = ID}, Pattern) -> + ?vtrace("match_object in ~p of ~p", [ID, Pattern]), + F = fun() -> mnesia:match_object(ID, Pattern, read) end, + case mnesia:transaction(F) of + {aborted, _Reason} = ABORTED -> + {error, ABORTED}; + {atomic, Rs} -> + Rs + end. + + +%% --------------------------------------------------------------- +%% match_delete +%% +%% Search the mib-storage table for records witch matches +%% the pattern and deletes them from the table. +%% --------------------------------------------------------------- + +match_delete(#tab{id = ID}, Pattern) -> + ?vtrace("match_delete in ~p with pattern ~p", [ID, Pattern]), + F = fun() -> + Recs = mnesia:match_object(ID, Pattern, read), + lists:foreach(fun(Rec) -> + mnesia:delete_object(ID, Rec, write) + end, Recs), + Recs + end, + case mnesia:transaction(F) of + {aborted, _Reason} = ABORTED -> + {error, ABORTED}; + {atomic, Rs} -> + Rs + end. + + +%% --------------------------------------------------------------- +%% tab2list +%% +%% Return all records in the mib-storage table in the form of +%% a list. +%% --------------------------------------------------------------- + +tab2list(#tab{id = ID} = Tab) -> + ?vtrace("tab2list -> list of ~p", [ID]), + match_object(Tab, mnesia:table_info(ID, wild_pattern)). + + +%% --------------------------------------------------------------- +%% info +%% +%% Retrieve implementation dependent mib-storage table +%% information. +%% --------------------------------------------------------------- + +info(#tab{id = ID}) -> + case (catch mnesia:table_info(ID, all)) of + Info when is_list(Info) -> + Info; + {'EXIT', {aborted, Reason}} -> + {error, Reason} + end. + + +info(#tab{id = ID}, Item) -> + mnesia:table_info(ID, Item). + + +%% --------------------------------------------------------------- +%% sync +%% +%% Ignore +%% --------------------------------------------------------------- + +sync(_) -> + ok. + + +%% --------------------------------------------------------------- +%% backup +%% +%% Ignore. Mnesia handles its own backups. +%% --------------------------------------------------------------- + +backup(_, _) -> + ok. + + +%%---------------------------------------------------------------------- + +get_action(Opts) -> + snmp_misc:get_option(action, Opts, keep). + +get_nodes(Opts) -> + case snmp_misc:get_option(nodes, Opts, erlang:nodes()) of + [] -> + [node()]; + Nodes when is_list(Nodes) -> + Nodes; + all -> + erlang:nodes(); + visible -> + erlang:nodes(visible); + connected -> + erlang:nodes(connected); + db_nodes -> + try mnesia:system_info(db_nodes) of + DbNodes when is_list(DbNodes) -> + DbNodes; + _ -> + erlang:nodes() + catch + _:_ -> + erlang:nodes() + end + end. + +%% user_err(F, A) -> +%% snmpa_error:user_err(F, A). diff --git a/lib/snmp/src/agent/snmpa_supervisor.erl b/lib/snmp/src/agent/snmpa_supervisor.erl index 886fd074bc..aebcdbaa84 100644 --- a/lib/snmp/src/agent/snmpa_supervisor.erl +++ b/lib/snmp/src/agent/snmpa_supervisor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. 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 @@ -224,26 +224,101 @@ init([AgentType, Opts]) -> ets:insert(snmp_agent_table, {error_report_mod, ErrorReportMod}), %% -- mib storage -- + %% MibStorage has only one mandatory part: module + %% Everything else is module dependent and therefor + %% put in a special option: options MibStorage = - case get_opt(mib_storage, Opts, ets) of + case get_opt(mib_storage, Opts, [{module, snmpa_mib_storage_ets}]) of + + %% --- ETS wrappers --- + + ets -> + [{module, snmpa_mib_storage_ets}]; + {ets, default} -> + [{module, snmpa_mib_storage_ets}, + {options, [{dir, filename:join([DbDir])}, + {action, keep}]}]; + {ets, Dir} when is_list(Dir) -> + [{module, snmpa_mib_storage_ets}, + {options, [{dir, filename:join([Dir])}, + {action, keep}]}]; + {ets, default, Action} when ((Action =:= keep) orelse + (Action =:= clear)) -> + [{module, snmpa_mib_storage_ets}, + {options, [{dir, filename:join([DbDir])}, + {action, Action}]}]; + {ets, Dir, Action} when is_list(Dir) andalso + ((Action =:= keep) orelse + (Action =:= clear)) -> + [{module, snmpa_mib_storage_ets}, + {options, [{dir, filename:join([Dir])}, + {action, Action}]}]; + + %% --- DETS wrappers --- + dets -> - {dets, DbDir}; + [{module, snmpa_mib_storage_dets}, + {options, [{dir, filename:join([DbDir])}, + {action, keep}]}]; {dets, default} -> - {dets, DbDir}; - {dets, default, Act} -> - {dets, DbDir, Act}; - {ets, default} -> - {ets, DbDir}; + [{module, snmpa_mib_storage_dets}, + {options, [{dir, filename:join([DbDir])}, + {action, keep}]}]; + {dets, default, Action} when ((Action =:= keep) orelse + (Action =:= clear)) -> + [{module, snmpa_mib_storage_dets}, + {options, [{dir, filename:join([DbDir])}, + {action, Action}]}]; + {dets, Dir, Action} when is_list(Dir) andalso + ((Action =:= keep) orelse + (Action =:= clear)) -> + [{module, snmpa_mib_storage_dets}, + {options, [{dir, filename:join([Dir])}, + {action, Action}]}]; + + %% --- Mnesia wrappers --- + mnesia -> - {mnesia, erlang:nodes()}; - {mnesia, visible} -> - {mnesia, erlang:nodes(visible)}; - {mnesia, connected} -> - {mnesia, erlang:nodes(connected)}; - Other -> + [{module, snmpa_mib_storage_mnesia}, + {options, [{nodes, erlang:nodes()}, + {action, keep}]}]; + {mnesia, Nodes0} -> + Nodes = + if + Nodes0 =:= visible -> + erlang:nodes(visible); + Nodes0 =:= connected -> + erlang:nodes(connected); + Nodes0 =:= [] -> + [node()]; + true -> + Nodes0 + end, + [{module, snmpa_mib_storage_mnesia}, + {options, [{nodes, Nodes}, + {action, keep}]}]; + {mnesia, Nodes0, Action} when ((Action =:= keep) orelse + (Action =:= clear)) -> + Nodes = + if + Nodes0 =:= visible -> + erlang:nodes(visible); + Nodes0 =:= connected -> + erlang:nodes(connected); + Nodes0 =:= [] -> + [node()]; + true -> + Nodes0 + end, + [{module, snmpa_mib_storage_mnesia}, + {options, [{nodes, Nodes}, + {action, Action}]}]; + + Other when is_list(Other) -> Other end, - ?vdebug("[agent table] store mib storage: ~w",[MibStorage]), + + ?vdebug("[agent table] store mib storage: ~w", [MibStorage]), ets:insert(snmp_agent_table, {mib_storage, MibStorage}), %% -- Agent mib storage -- @@ -388,7 +463,7 @@ init([AgentType, Opts]) -> AgentSpec = worker_spec(snmpa_agent, - [Prio,snmp_master_agent,none,Ref,AgentOpts], + [Prio, snmp_master_agent, none, Ref, AgentOpts], Restart, 15000), AgentSupSpec = sup_spec(snmpa_agent_sup, [AgentSpec], diff --git a/lib/snmp/src/agent/snmpa_symbolic_store.erl b/lib/snmp/src/agent/snmpa_symbolic_store.erl index 6c58ffde41..00178f4bcd 100644 --- a/lib/snmp/src/agent/snmpa_symbolic_store.erl +++ b/lib/snmp/src/agent/snmpa_symbolic_store.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. 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 @@ -78,7 +78,7 @@ gen_server:start_link({local, ?SERVER}, ?MODULE, [Prio, Opts], [])). -endif. --record(state, {db, backup}). +-record(state, {module, db, backup}). -record(symbol, {key, mib_name, info}). @@ -112,6 +112,9 @@ backup(BackupDir) -> get_db() -> call(get_db). +which_module() -> + call(which_module). + %%---------------------------------------------------------------------- %% Returns: {value, Oid} | false @@ -202,49 +205,63 @@ verbosity(Verbosity) -> %%---------------------------------------------------------------------- %% DB access (read) functions: Returns: {value, Oid} | false %%---------------------------------------------------------------------- + aliasname_to_oid(Db, Aliasname) -> - case snmpa_general_db:read(Db, {alias, Aliasname}) of + Mod = which_module(), + aliasname_to_oid(Mod, Db, Aliasname). + +aliasname_to_oid(Mod, Db, Aliasname) -> + case Mod:read(Db, {alias, Aliasname}) of {value,#symbol{info = {Oid, _Enums}}} -> {value, Oid}; false -> false end. -oid_to_aliasname(Db,Oid) -> - case snmpa_general_db:read(Db, {oid, Oid}) of +oid_to_aliasname(Db, Oid) -> + Mod = which_module(), + oid_to_aliasname(Mod, Db, Oid). + +oid_to_aliasname(Mod, Db, Oid) -> + case Mod:read(Db, {oid, Oid}) of {value,#symbol{info = Aliasname}} -> {value, Aliasname}; _ -> false end. -which_notifications(Db) -> +which_notifications(Mod, Db) -> Pattern = #symbol{key = {trap, '_'}, _ = '_'}, - Symbols = snmpa_general_db:match_object(Db, Pattern), + Symbols = Mod:match_object(Db, Pattern), [{Name, Mib, Rec} || #symbol{key = {trap, Name}, mib_name = Mib, info = Rec} <- Symbols]. -which_aliasnames(Db) -> +which_aliasnames(Mod, Db) -> Pattern = #symbol{key = {alias, '_'}, _ = '_'}, - Symbols = snmpa_general_db:match_object(Db, Pattern), + Symbols = Mod:match_object(Db, Pattern), [Alias || #symbol{key = {alias, Alias}} <- Symbols]. -which_tables(Db) -> +which_tables(Mod, Db) -> Pattern = #symbol{key = {table_info, '_'}, _ = '_'}, - Symbols = snmpa_general_db:match_object(Db, Pattern), + Symbols = Mod:match_object(Db, Pattern), [Name || #symbol{key = {table_info, Name}} <- Symbols]. -which_variables(Db) -> +which_variables(Mod, Db) -> Pattern = #symbol{key = {variable_info, '_'}, _ = '_'}, - Symbols = snmpa_general_db:match_object(Db, Pattern), + Symbols = Mod:match_object(Db, Pattern), [Name || #symbol{key = {variable_info, Name}} <- Symbols]. -int_to_enum(Db,TypeOrObjName,Int) -> - case snmpa_general_db:read(Db, {alias, TypeOrObjName}) of + +int_to_enum(Db, TypeOrObjName, Int) -> + Mod = which_module(), + int_to_enum(Mod, Db, TypeOrObjName, Int). + +int_to_enum(Mod, Db, TypeOrObjName, Int) -> + case Mod:read(Db, {alias, TypeOrObjName}) of {value,#symbol{info = {_Oid, Enums}}} -> case lists:keysearch(Int, 2, Enums) of {value, {Enum, _Int}} -> {value, Enum}; false -> false end; false -> % Not an Aliasname -> - case snmpa_general_db:read(Db, {type, TypeOrObjName}) of + case Mod:read(Db, {type, TypeOrObjName}) of {value,#symbol{info = Enums}} -> case lists:keysearch(Int, 2, Enums) of {value, {Enum, _Int}} -> {value, Enum}; @@ -256,14 +273,18 @@ int_to_enum(Db,TypeOrObjName,Int) -> end. enum_to_int(Db, TypeOrObjName, Enum) -> - case snmpa_general_db:read(Db, {alias, TypeOrObjName}) of + Mod = which_module(), + enum_to_int(Mod, Db, TypeOrObjName, Enum). + +enum_to_int(Mod, Db, TypeOrObjName, Enum) -> + case Mod:read(Db, {alias, TypeOrObjName}) of {value,#symbol{info = {_Oid, Enums}}} -> case lists:keysearch(Enum, 1, Enums) of {value, {_Enum, Int}} -> {value, Int}; false -> false end; false -> % Not an Aliasname - case snmpa_general_db:read(Db, {type, TypeOrObjName}) of + case Mod:read(Db, {type, TypeOrObjName}) of {value,#symbol{info = Enums}} -> case lists:keysearch(Enum, 1, Enums) of {value, {_Enum, Int}} -> {value, Int}; @@ -278,8 +299,9 @@ enum_to_int(Db, TypeOrObjName, Enum) -> %%---------------------------------------------------------------------- %% DB access (read) functions: Returns: false|{value, Info} %%---------------------------------------------------------------------- -table_info(Db,TableName) -> - case snmpa_general_db:read(Db, {table_info, TableName}) of + +table_info(Mod, Db, TableName) -> + case Mod:read(Db, {table_info, TableName}) of {value,#symbol{info = Info}} -> {value, Info}; false -> false end. @@ -288,8 +310,8 @@ table_info(Db,TableName) -> %%---------------------------------------------------------------------- %% DB access (read) functions: Returns: false|{value, Info} %%---------------------------------------------------------------------- -variable_info(Db,VariableName) -> - case snmpa_general_db:read(Db, {variable_info, VariableName}) of +variable_info(Mod, Db, VariableName) -> + case Mod:read(Db, {variable_info, VariableName}) of {value,#symbol{info = Info}} -> {value, Info}; false -> false end. @@ -299,7 +321,7 @@ variable_info(Db,VariableName) -> %% Implementation %%---------------------------------------------------------------------- -init([Prio,Opts]) -> +init([Prio, Opts]) -> ?d("init -> entry with" "~n Prio: ~p" "~n Opts: ~p", [Prio,Opts]), @@ -317,102 +339,125 @@ do_init(Prio, Opts) -> put(sname,ss), put(verbosity,get_verbosity(Opts)), ?vlog("starting",[]), - Storage = get_mib_storage(Opts), + MibStorage = get_mib_storage(Opts), + Mod = snmp_misc:get_option(module, MibStorage), + MsOpts = snmp_misc:get_option(options, MibStorage, []), + %% type = bag solves the problem with import and multiple %% object/type definitions. - Db = snmpa_general_db:open(Storage, snmpa_symbolic_store, - symbol, record_info(fields,symbol), bag), - S = #state{db = Db}, - ?vdebug("started",[]), - {ok, S}. + case Mod:open(?MODULE, symbol, record_info(fields, symbol), bag, MsOpts) of + {ok, Db} -> + S = #state{module = Mod, db = Db}, + ?vdebug("started",[]), + {ok, S}; + {error, _} = ERROR -> + ERROR + end. handle_call(get_db, _From, #state{db = DB} = S) -> ?vlog("get db",[]), {reply, DB, S}; -handle_call({table_info, TableName}, _From, #state{db = DB} = S) -> +handle_call(which_module, _From, #state{module = Mod} = S) -> + ?vlog("which module",[]), + {reply, Mod, S}; + +handle_call({table_info, TableName}, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("table info: ~p",[TableName]), - Res = table_info(DB, TableName), + Res = table_info(Mod, DB, TableName), ?vdebug("table info result: ~p",[Res]), {reply, Res, S}; -handle_call({variable_info, VariableName}, _From, #state{db = DB} = S) -> +handle_call({variable_info, VariableName}, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("variable info: ~p",[VariableName]), - Res = variable_info(DB, VariableName), + Res = variable_info(Mod, DB, VariableName), ?vdebug("variable info result: ~p",[Res]), {reply, Res, S}; -handle_call({aliasname_to_oid, Aliasname}, _From, #state{db = DB} = S) -> +handle_call({aliasname_to_oid, Aliasname}, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("aliasname to oid: ~p",[Aliasname]), - Res = aliasname_to_oid(DB,Aliasname), + Res = aliasname_to_oid(Mod, DB, Aliasname), ?vdebug("aliasname to oid result: ~p",[Res]), {reply, Res, S}; -handle_call({oid_to_aliasname, Oid}, _From, #state{db = DB} = S) -> +handle_call({oid_to_aliasname, Oid}, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("oid to aliasname: ~p",[Oid]), - Res = oid_to_aliasname(DB, Oid), + Res = oid_to_aliasname(Mod, DB, Oid), ?vdebug("oid to aliasname result: ~p",[Res]), {reply, Res, S}; -handle_call(which_aliasnames, _From, #state{db = DB} = S) -> +handle_call(which_aliasnames, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("which aliasnames",[]), - Res = which_aliasnames(DB), + Res = which_aliasnames(Mod, DB), ?vdebug("which aliasnames: ~p",[Res]), {reply, Res, S}; -handle_call(which_tables, _From, #state{db = DB} = S) -> +handle_call(which_tables, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("which tables",[]), - Res = which_tables(DB), + Res = which_tables(Mod, DB), ?vdebug("which tables: ~p",[Res]), {reply, Res, S}; -handle_call(which_variables, _From, #state{db = DB} = S) -> +handle_call(which_variables, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("which variables",[]), - Res = which_variables(DB), + Res = which_variables(Mod, DB), ?vdebug("which variables: ~p",[Res]), {reply, Res, S}; -handle_call({enum_to_int, TypeOrObjName, Enum}, _From, #state{db = DB} = S) -> +handle_call({enum_to_int, TypeOrObjName, Enum}, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("enum to int: ~p, ~p",[TypeOrObjName,Enum]), - Res = enum_to_int(DB, TypeOrObjName, Enum), + Res = enum_to_int(Mod, DB, TypeOrObjName, Enum), ?vdebug("enum to int result: ~p",[Res]), {reply, Res, S}; -handle_call({int_to_enum, TypeOrObjName, Int}, _From, #state{db = DB} = S) -> +handle_call({int_to_enum, TypeOrObjName, Int}, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("int to enum: ~p, ~p",[TypeOrObjName,Int]), - Res = int_to_enum(DB, TypeOrObjName, Int), + Res = int_to_enum(Mod, DB, TypeOrObjName, Int), ?vdebug("int to enum result: ~p",[Res]), {reply, Res, S}; -handle_call({set_notification, MibName, Trap}, _From, #state{db = DB} = S) -> +handle_call({set_notification, MibName, Trap}, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("set notification:" "~n ~p~n ~p", [MibName,Trap]), - set_notif(DB, MibName, Trap), + set_notif(Mod, DB, MibName, Trap), {reply, true, S}; -handle_call({delete_notifications, MibName}, _From, #state{db = DB} = S) -> +handle_call({delete_notifications, MibName}, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("delete notification: ~p",[MibName]), - delete_notif(DB, MibName), + delete_notif(Mod, DB, MibName), {reply, true, S}; -handle_call(which_notifications, _From, #state{db = DB} = S) -> +handle_call(which_notifications, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("which notifications", []), - Reply = which_notifications(DB), + Reply = which_notifications(Mod, DB), {reply, Reply, S}; -handle_call({get_notification, Key}, _From, #state{db = DB} = S) -> +handle_call({get_notification, Key}, _From, + #state{module = Mod, db = DB} = S) -> ?vlog("get notification: ~p",[Key]), - Res = get_notif(DB, Key), + Res = get_notif(Mod, DB, Key), ?vdebug("get notification result: ~p",[Res]), {reply, Res, S}; -handle_call(info, _From, #state{db = DB} = S) -> +handle_call(info, _From, #state{module = Mod, db = DB} = S) -> ?vlog("info",[]), - Info = get_info(DB), + Info = get_info(Mod, DB), {reply, Info, S}; -handle_call({backup, BackupDir}, From, #state{db = DB} = S) -> +handle_call({backup, BackupDir}, From, #state{module = Mod, db = DB} = S) -> ?vlog("info to ~p",[BackupDir]), Pid = self(), V = get(verbosity), @@ -424,7 +469,7 @@ handle_call({backup, BackupDir}, From, #state{db = DB} = S) -> put(sname, albs), put(verbosity, V), Dir = filename:join([BackupDir]), - Reply = snmpa_general_db:backup(DB, Dir), + Reply = Mod:backup(DB, Dir), Pid ! {backup_done, Reply}, unlink(Pid) end), @@ -446,7 +491,7 @@ handle_call(Req, _From, S) -> {reply, Reply, S}. -handle_cast({add_types, MibName, Types}, #state{db = DB} = S) -> +handle_cast({add_types, MibName, Types}, #state{module = Mod, db = DB} = S) -> ?vlog("add types for ~p:",[MibName]), F = fun(#asn1_type{assocList = Alist, aliasname = Name}) -> case snmp_misc:assq(enums, Alist) of @@ -455,20 +500,21 @@ handle_cast({add_types, MibName, Types}, #state{db = DB} = S) -> Rec = #symbol{key = {type, Name}, mib_name = MibName, info = Es}, - snmpa_general_db:write(DB, Rec); + Mod:write(DB, Rec); false -> done end end, lists:foreach(F, Types), {noreply, S}; -handle_cast({delete_types, MibName}, #state{db = DB} = S) -> +handle_cast({delete_types, MibName}, #state{module = Mod, db = DB} = S) -> ?vlog("delete types: ~p",[MibName]), Pattern = #symbol{key = {type, '_'}, mib_name = MibName, info = '_'}, - snmpa_general_db:match_delete(DB, Pattern), + Mod:match_delete(DB, Pattern), {noreply, S}; -handle_cast({add_aliasnames, MibName, MEs}, #state{db = DB} = S) -> +handle_cast({add_aliasnames, MibName, MEs}, + #state{module = Mod, db = DB} = S) -> ?vlog("add aliasnames for ~p:",[MibName]), F = fun(#me{aliasname = AN, oid = Oid, asn1_type = AT}) -> Enums = @@ -480,20 +526,21 @@ handle_cast({add_aliasnames, MibName, MEs}, #state{db = DB} = S) -> end; _ -> [] end, - write_alias(AN, DB, Enums, MibName, Oid) + write_alias(Mod, AN, DB, Enums, MibName, Oid) end, lists:foreach(F, MEs), {noreply, S}; -handle_cast({delete_aliasname, MibName}, #state{db = DB} = S) -> +handle_cast({delete_aliasname, MibName}, #state{module = Mod, db = DB} = S) -> ?vlog("delete aliasname: ~p",[MibName]), Pattern1 = #symbol{key = {alias, '_'}, mib_name = MibName, info = '_'}, - snmpa_general_db:match_delete(DB, Pattern1), + Mod:match_delete(DB, Pattern1), Pattern2 = #symbol{key = {oid, '_'}, mib_name = MibName, info = '_'}, - snmpa_general_db:match_delete(DB, Pattern2), + Mod:match_delete(DB, Pattern2), {noreply, S}; -handle_cast({add_table_infos, MibName, TableInfos}, #state{db = DB} = S) -> +handle_cast({add_table_infos, MibName, TableInfos}, + #state{module = Mod, db = DB} = S) -> ?vlog("add table infos for ~p:",[MibName]), F = fun({Name, TableInfo}) -> ?vlog("add table info~n ~p -> ~p", @@ -501,19 +548,20 @@ handle_cast({add_table_infos, MibName, TableInfos}, #state{db = DB} = S) -> Rec = #symbol{key = {table_info, Name}, mib_name = MibName, info = TableInfo}, - snmpa_general_db:write(DB, Rec) + Mod:write(DB, Rec) end, lists:foreach(F, TableInfos), {noreply, S}; -handle_cast({delete_table_infos, MibName}, #state{db = DB} = S) -> +handle_cast({delete_table_infos, MibName}, + #state{module = Mod, db = DB} = S) -> ?vlog("delete table infos: ~p",[MibName]), Pattern = #symbol{key = {table_info, '_'}, mib_name = MibName, info = '_'}, - snmpa_general_db:match_delete(DB, Pattern), + Mod:match_delete(DB, Pattern), {noreply, S}; handle_cast({add_variable_infos, MibName, VariableInfos}, - #state{db = DB} = S) -> + #state{module = Mod, db = DB} = S) -> ?vlog("add variable infos for ~p:",[MibName]), F = fun({Name, VariableInfo}) -> ?vlog("add variable info~n ~p -> ~p", @@ -521,17 +569,18 @@ handle_cast({add_variable_infos, MibName, VariableInfos}, Rec = #symbol{key = {variable_info, Name}, mib_name = MibName, info = VariableInfo}, - snmpa_general_db:write(DB, Rec) + Mod:write(DB, Rec) end, lists:foreach(F, VariableInfos), {noreply, S}; -handle_cast({delete_variable_infos, MibName}, #state{db = DB} = S) -> +handle_cast({delete_variable_infos, MibName}, + #state{module = Mod, db = DB} = S) -> ?vlog("delete variable infos: ~p",[MibName]), Pattern = #symbol{key = {variable_info,'_'}, mib_name = MibName, info = '_'}, - snmpa_general_db:match_delete(DB, Pattern), + Mod:match_delete(DB, Pattern), {noreply, S}; handle_cast({verbosity,Verbosity}, State) -> @@ -565,9 +614,9 @@ handle_info(Info, S) -> {noreply, S}. -terminate(Reason, S) -> - ?vlog("terminate: ~p",[Reason]), - snmpa_general_db:close(S#state.db). +terminate(Reason, #state{module = Mod, db = DB}) -> + ?vlog("terminate: ~p", [Reason]), + Mod:close(DB). %%---------------------------------------------------------- @@ -575,18 +624,18 @@ terminate(Reason, S) -> %%---------------------------------------------------------- % downgrade -code_change({down, _Vsn}, #state{db = DB, backup = B}, downgrade_to_pre_4_7) -> - ?d("code_change(down) -> entry", []), - stop_backup_server(B), - S = {state, DB}, - {ok, S}; - -% upgrade -code_change(_Vsn, S, upgrade_from_pre_4_7) -> - ?d("code_change(up) -> entry", []), - {state, DB} = S, - S1 = #state{db = DB}, - {ok, S1}; +%% code_change({down, _Vsn}, #state{db = DB, backup = B}, downgrade_to_pre_4_7) -> +%% ?d("code_change(down) -> entry", []), +%% stop_backup_server(B), +%% S = {state, DB}, +%% {ok, S}; + +%% % upgrade +%% code_change(_Vsn, S, upgrade_from_pre_4_7) -> +%% ?d("code_change(up) -> entry", []), +%% {state, DB} = S, +%% S1 = #state{db = DB}, +%% {ok, S1}; code_change(_Vsn, S, _Extra) -> ?d("code_change -> entry [do nothing]", []), @@ -609,13 +658,13 @@ stop_backup_server({Pid, _}) when is_pid(Pid) -> %%----------------------------------------------------------------- %% Returns: {value, Value} | undefined %%----------------------------------------------------------------- -get_notif(Db, Key) -> - case snmpa_general_db:read(Db, {trap, Key}) of +get_notif(Mod, Db, Key) -> + case Mod:read(Db, {trap, Key}) of {value,#symbol{info = Value}} -> {value, Value}; false -> undefined end. -set_notif(Db, MibName, Trap) when is_record(Trap, trap) -> +set_notif(Mod, Db, MibName, Trap) when is_record(Trap, trap) -> #trap{trapname = Name} = Trap, Rec = #symbol{key = {trap, Name}, mib_name = MibName, info = Trap}, %% convert old v1 trap to oid @@ -625,40 +674,41 @@ set_notif(Db, MibName, Trap) when is_record(Trap, trap) -> Oid0 -> Oid0 ++ [0, Trap#trap.specificcode] end, - write_alias(Name, Db, MibName, Oid), - snmpa_general_db:write(Db, Rec); -set_notif(Db, MibName, Trap) -> + write_alias(Mod, Name, Db, MibName, Oid), + Mod:write(Db, Rec); +set_notif(Mod, Db, MibName, Trap) -> #notification{trapname = Name, oid = Oid} = Trap, Rec = #symbol{key = {trap, Name}, mib_name = MibName, info = Trap}, - write_alias(Name, Db, MibName, Oid), - snmpa_general_db:write(Db, Rec). + write_alias(Mod, Name, Db, MibName, Oid), + Mod:write(Db, Rec). -delete_notif(Db, MibName) -> +delete_notif(Mod, Db, MibName) -> Pattern = #symbol{key = {trap, '_'}, mib_name = MibName, info = '_'}, - snmpa_general_db:match_delete(Db, Pattern). + Mod:match_delete(Db, Pattern). -write_alias(AN, DB, MibName, Oid) -> - write_alias(AN, DB, [], MibName, Oid). +write_alias(Mod, AN, DB, MibName, Oid) -> + write_alias(Mod, AN, DB, [], MibName, Oid). -write_alias(AN, DB, Enums, MibName, Oid) -> +write_alias(Mod, AN, DB, Enums, MibName, Oid) -> ?vlog("add alias~n ~p -> {~p,~p}",[AN, Oid, Enums]), Rec1 = #symbol{key = {alias, AN}, mib_name = MibName, info = {Oid,Enums}}, - snmpa_general_db:write(DB, Rec1), + Mod:write(DB, Rec1), ?vlog("add oid~n ~p -> ~p",[Oid, AN]), Rec2 = #symbol{key = {oid, Oid}, mib_name = MibName, info = AN}, - snmpa_general_db:write(DB, Rec2). + Mod:write(DB, Rec2). + %% ------------------------------------- -get_info(DB) -> +get_info(Mod, DB) -> ProcSize = proc_mem(self()), - DbSz = tab_size(DB), - [{process_memory, ProcSize}, {db_memory, DbSz}]. + DbMemory = Mod:info(DB, memory), + [{process_memory, ProcSize}, {db_memory, DbMemory}]. proc_mem(P) when is_pid(P) -> case (catch erlang:process_info(P, memory)) of @@ -667,26 +717,15 @@ proc_mem(P) when is_pid(P) -> _ -> undefined end. -%% proc_mem(_) -> -%% undefined. - -tab_size(DB) -> - case (catch snmpa_general_db:info(DB, memory)) of - Sz when is_integer(Sz) -> - Sz; - _ -> - undefined - end. - %% ------------------------------------- get_verbosity(L) -> - snmp_misc:get_option(verbosity,L,?default_verbosity). + snmp_misc:get_option(verbosity, L, ?default_verbosity). get_mib_storage(L) -> - snmp_misc:get_option(mib_storage,L,ets). + snmp_misc:get_option(mib_storage, L). %% ------------------------------------- diff --git a/lib/snmp/src/app/snmp.app.src b/lib/snmp/src/app/snmp.app.src index b11c1ef934..904d17954b 100644 --- a/lib/snmp/src/app/snmp.app.src +++ b/lib/snmp/src/app/snmp.app.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. 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 @@ -48,11 +48,15 @@ snmpa_error_io, snmpa_error_logger, snmpa_error_report, - snmpa_general_db, snmpa_local_db, snmpa_mib, snmpa_mib_data, + snmpa_mib_data_tttn, snmpa_mib_lib, + snmpa_mib_storage, + snmpa_mib_storage_ets, + snmpa_mib_storage_dets, + snmpa_mib_storage_mnesia, snmpa_misc_sup, snmpa_mpd, snmpa_net_if, diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index 4c5f14da90..7ffa4a725d 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -22,19 +22,15 @@ %% ----- U p g r a d e ------------------------------------------------------- [ - {"4.23", - [ - ] - } + {"4.23.1", [{restart_application, snmp}]}, + {"4.23", [{restart_application, snmp}]} ], %% ------D o w n g r a d e --------------------------------------------------- [ - {"4.23", - [ - ] - } + {"4.23.1", [{restart_application, snmp}]}, + {"4.23", [{restart_application, snmp}]} ] }. diff --git a/lib/snmp/src/app/snmp.erl b/lib/snmp/src/app/snmp.erl index cd3e3a0055..1bb562654a 100644 --- a/lib/snmp/src/app/snmp.erl +++ b/lib/snmp/src/app/snmp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2013. 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 @@ -90,6 +90,13 @@ ]). +-export_type([ + oid/0, + + void/0 + ]). + + %% This is for XREF -deprecated([{c, 1, eventually}, {c, 2, eventually}, @@ -143,6 +150,15 @@ -define(APPLICATION, snmp). + +%%----------------------------------------------------------------- +%% Types +%%----------------------------------------------------------------- + +-type oid() :: [non_neg_integer()]. +-type void() :: term(). + + %%----------------------------------------------------------------- %% Application %%----------------------------------------------------------------- diff --git a/lib/snmp/src/app/snmp_app.erl b/lib/snmp/src/app/snmp_app.erl index deb42cc373..0cfbb22a5a 100644 --- a/lib/snmp/src/app/snmp_app.erl +++ b/lib/snmp/src/app/snmp_app.erl @@ -62,17 +62,17 @@ entities([], []) -> ?d("entities -> converted config: ~n~p", [Conf]), [{agent, Conf}] end; -entities([], E) -> +entities([], Acc) -> ?d("entities -> done", []), - lists:reverse(E); -entities([ET|ETs], E) -> + lists:reverse(Acc); +entities([Ent|Ents], Acc) -> ?d("entities -> entry with" - "~n ET: ~p", [ET]), - case application:get_env(snmp, ET) of + "~n Ent: ~p", [Ent]), + case application:get_env(snmp, Ent) of {ok, Conf} -> - entities(ETs, [{ET, Conf}|E]); + entities(Ents, [{Ent, Conf}|Acc]); _ -> - entities(ETs, E) + entities(Ents, Acc) end. start_entities(_Type, []) -> diff --git a/lib/snmp/src/manager/snmpm_config.erl b/lib/snmp/src/manager/snmpm_config.erl index 5bbf9e5542..9d687f1d31 100644 --- a/lib/snmp/src/manager/snmpm_config.erl +++ b/lib/snmp/src/manager/snmpm_config.erl @@ -2028,7 +2028,7 @@ verify_usm_user_auth(usmNoAuthProtocol, AuthKey) -> end; verify_usm_user_auth(usmHMACMD5AuthProtocol, AuthKey) when is_list(AuthKey) andalso (length(AuthKey) =:= 16) -> - case is_crypto_supported(md5_mac_96) of + case is_crypto_supported(md5) of true -> case snmp_conf:all_integer(AuthKey) of true -> @@ -2037,7 +2037,7 @@ verify_usm_user_auth(usmHMACMD5AuthProtocol, AuthKey) error({invalid_auth_key, usmHMACMD5AuthProtocol}) end; false -> - error({unsupported_crypto, md5_mac_96}) + error({unsupported_crypto, md5}) end; verify_usm_user_auth(usmHMACMD5AuthProtocol, AuthKey) when is_list(AuthKey) -> Len = length(AuthKey), @@ -2046,7 +2046,7 @@ verify_usm_user_auth(usmHMACMD5AuthProtocol, _AuthKey) -> error({invalid_auth_key, usmHMACMD5AuthProtocol}); verify_usm_user_auth(usmHMACSHAAuthProtocol, AuthKey) when is_list(AuthKey) andalso (length(AuthKey) =:= 20) -> - case is_crypto_supported(sha_mac_96) of + case is_crypto_supported(sha) of true -> case snmp_conf:all_integer(AuthKey) of true -> @@ -2055,7 +2055,7 @@ verify_usm_user_auth(usmHMACSHAAuthProtocol, AuthKey) error({invalid_auth_key, usmHMACSHAAuthProtocol}) end; false -> - error({unsupported_crypto, sha_mac_96}) + error({unsupported_crypto, sha}) end; verify_usm_user_auth(usmHMACSHAAuthProtocol, AuthKey) when is_list(AuthKey) -> Len = length(AuthKey), @@ -2074,7 +2074,7 @@ verify_usm_user_priv(usmNoPrivProtocol, PrivKey) -> end; verify_usm_user_priv(usmDESPrivProtocol, PrivKey) when (length(PrivKey) =:= 16) -> - case is_crypto_supported(des_cbc_decrypt) of + case is_crypto_supported(des_cbc) of true -> case snmp_conf:all_integer(PrivKey) of true -> @@ -2083,7 +2083,7 @@ verify_usm_user_priv(usmDESPrivProtocol, PrivKey) error({invalid_priv_key, usmDESPrivProtocol}) end; false -> - error({unsupported_crypto, des_cbc_decrypt}) + error({unsupported_crypto, des_cbc}) end; verify_usm_user_priv(usmDESPrivProtocol, PrivKey) when is_list(PrivKey) -> Len = length(PrivKey), @@ -2092,7 +2092,7 @@ verify_usm_user_priv(usmDESPrivProtocol, _PrivKey) -> error({invalid_priv_key, usmDESPrivProtocol}); verify_usm_user_priv(usmAesCfb128Protocol, PrivKey) when (length(PrivKey) =:= 16) -> - case is_crypto_supported(aes_cfb_128_decrypt) of + case is_crypto_supported(aes_cfb128) of true -> case snmp_conf:all_integer(PrivKey) of true -> @@ -2101,7 +2101,7 @@ verify_usm_user_priv(usmAesCfb128Protocol, PrivKey) error({invalid_priv_key, usmAesCfb128Protocol}) end; false -> - error({unsupported_crypto, aes_cfb_128_decrypt}) + error({unsupported_crypto, aes_cfb128}) end; verify_usm_user_priv(usmAesCfb128Protocol, PrivKey) when is_list(PrivKey) -> Len = length(PrivKey), @@ -2111,13 +2111,10 @@ verify_usm_user_priv(usmAesCfb128Protocol, _PrivKey) -> verify_usm_user_priv(PrivP, _PrivKey) -> error({invalid_priv_protocol, PrivP}). + +-compile({inline, [{is_crypto_supported,1}]}). is_crypto_supported(Func) -> - %% The 'catch' handles the case when 'crypto' is - %% not present in the system (or not started). - case (catch lists:member(Func, crypto:info())) of - true -> true; - _ -> false - end. + snmp_misc:is_crypto_supported(Func). read_manager_config_file(Dir) -> @@ -2879,11 +2876,11 @@ do_update_usm_user_info(Key, #usm_user{auth = usmHMACMD5AuthProtocol} = User, auth_key, Val) when length(Val) =:= 16 -> - case is_crypto_supported(md5_mac_96) of + case is_crypto_supported(md5) of true -> do_update_usm_user_info(Key, User#usm_user{auth_key = Val}); false -> - {error, {unsupported_crypto, md5_mac_96}} + {error, {unsupported_crypto, md5}} end; do_update_usm_user_info(_Key, #usm_user{auth = usmHMACMD5AuthProtocol}, @@ -2898,11 +2895,11 @@ do_update_usm_user_info(Key, #usm_user{auth = usmHMACSHAAuthProtocol} = User, auth_key, Val) when length(Val) =:= 20 -> - case is_crypto_supported(sha_mac_96) of + case is_crypto_supported(sha) of true -> do_update_usm_user_info(Key, User#usm_user{auth_key = Val}); false -> - {error, {unsupported_crypto, sha_mac_96}} + {error, {unsupported_crypto, sha}} end; do_update_usm_user_info(_Key, #usm_user{auth = usmHMACSHAAuthProtocol}, @@ -2933,21 +2930,21 @@ do_update_usm_user_info(Key, #usm_user{priv = usmDESPrivProtocol} = User, priv_key, Val) when length(Val) =:= 16 -> - case is_crypto_supported(des_cbc_decrypt) of + case is_crypto_supported(des_cbc) of true -> do_update_usm_user_info(Key, User#usm_user{priv_key = Val}); false -> - {error, {unsupported_crypto, des_cbc_decrypt}} + {error, {unsupported_crypto, des_cbc}} end; do_update_usm_user_info(Key, #usm_user{priv = usmAesCfb128Protocoll} = User, priv_key, Val) when length(Val) =:= 16 -> - case is_crypto_supported(aes_cfb_128_decrypt) of + case is_crypto_supported(aes_cfb128) of true -> do_update_usm_user_info(Key, User#usm_user{priv_key = Val}); false -> - {error, {unsupported_crypto, aes_cfb_128_decrypt}} + {error, {unsupported_crypto, aes_cfb128}} end; do_update_usm_user_info(_Key, #usm_user{auth = usmHMACSHAAuthProtocol}, diff --git a/lib/snmp/src/misc/snmp_config.erl b/lib/snmp/src/misc/snmp_config.erl index 0bed097b62..22fe25941c 100644 --- a/lib/snmp/src/misc/snmp_config.erl +++ b/lib/snmp/src/misc/snmp_config.erl @@ -238,7 +238,7 @@ config_agent_sys() -> MibStorage = case MibStorageType of ets -> - ets; + [{module, snmpa_mib_storage_ets}]; dets -> DetsDir = ask("6b. Mib storage directory (absolute path)?", DbDir, fun verify_dir/1), @@ -248,13 +248,14 @@ config_agent_sys() -> "default", fun verify_mib_storage_action/1), case DetsAction of default -> - {dets, DetsDir}; + [{module, snmpa_mib_storage_dets}, + {options, [{dir, DetsDir}]}]; _ -> - {dets, DetsDir, DetsAction} + [{module, snmpa_mib_storage_dets}, + {options, [{dir, DetsDir}, + {action, DetsAction}]}] end; mnesia -> -% Nodes = ask("Mib storage nodes?", "none", -% fun verify_mib_storage_nodes/1), Nodes = [], MnesiaAction = ask("6b. Mib storage [mnesia] database start " "action " @@ -262,11 +263,18 @@ config_agent_sys() -> "default", fun verify_mib_storage_action/1), case MnesiaAction of default -> - {mnesia, Nodes}; + [{module, snmpa_mib_storage_mnesia}, + {options, [{nodes, Nodes}]}]; _ -> - {mnesia, Nodes, MnesiaAction} + [{module, snmpa_mib_storage_mnesia}, + {options, [{nodes, Nodes}, + {action, MnesiaAction}]}] end end, + + %% Here we should ask about mib-server data module, + %% but as we only have one at the moment... + TargetCacheVerb = ask("7. Target cache verbosity " "(silence/info/log/debug/trace)?", "silence", fun verify_verbosity/1), diff --git a/lib/snmp/src/misc/snmp_misc.erl b/lib/snmp/src/misc/snmp_misc.erl index a061dcd97c..293b22991b 100644 --- a/lib/snmp/src/misc/snmp_misc.erl +++ b/lib/snmp/src/misc/snmp_misc.erl @@ -43,6 +43,7 @@ ip/1, ip/2, is_auth/1, is_BitString/1, + is_crypto_supported/1, is_oid/1, is_priv/1, is_reportable/1, @@ -117,13 +118,27 @@ now(sec) -> (element(3,Now) div 1000000). +is_crypto_supported(Alg) -> + %% The 'try catch' handles the case when 'crypto' is + %% not present in the system (or not started). + try + begin + Supported = crypto:supports(), + Hashs = proplists:get_value(hashs, Supported), + Ciphers = proplists:get_value(ciphers, Supported), + lists:member(Alg, Hashs ++ Ciphers) + end + catch + _:_ -> + false + end. + is_string([]) -> true; is_string([Tkn | Str]) when is_integer(Tkn) andalso (Tkn >= 0) andalso (Tkn =< 255) -> is_string(Str); is_string(_) -> false. - is_oid([E1, E2| Rest]) when (length(Rest) =< 126) andalso (E1 *40 + E2 =< 255) -> is_oid2(Rest); diff --git a/lib/snmp/src/misc/snmp_usm.erl b/lib/snmp/src/misc/snmp_usm.erl index 53c291ca0e..67e3476816 100644 --- a/lib/snmp/src/misc/snmp_usm.erl +++ b/lib/snmp/src/misc/snmp_usm.erl @@ -142,32 +142,33 @@ auth_out(?usmHMACSHAAuthProtocol, AuthKey, Message, UsmSecParams) -> sha_auth_out(AuthKey, Message, UsmSecParams). md5_auth_out(AuthKey, Message, UsmSecParams) -> + %% ?vtrace("md5_auth_out -> entry with" + %% "~n AuthKey: ~w" + %% "~n Message: ~w" + %% "~n UsmSecParams: ~w", [AuthKey, Message, UsmSecParams]), %% 6.3.1.1 Message2 = set_msg_auth_params(Message, UsmSecParams, ?twelwe_zeros), - Packet = snmp_pdus:enc_message_only(Message2), + Packet = snmp_pdus:enc_message_only(Message2), %% 6.3.1.2-4 is done by the crypto function %% 6.3.1.4 MAC = binary_to_list(crypto:hmac(md5, AuthKey, Packet, 12)), - ?vtrace("md5_auth_out -> entry with" - "~n Packet: ~w" - "~n AuthKey: ~w" - "~n MAC: ~w" - , [Packet, AuthKey, MAC]), + %% ?vtrace("md5_auth_out -> crypto (md5) encoded" + %% "~n MAC: ~w", [MAC]), %% 6.3.1.5 set_msg_auth_params(Message, UsmSecParams, MAC). md5_auth_in(AuthKey, AuthParams, Packet) when length(AuthParams) == 12 -> + %% ?vtrace("md5_auth_in -> entry with" + %% "~n AuthKey: ~w" + %% "~n AuthParams: ~w" + %% "~n Packet: ~w", [AuthKey, AuthParams, Packet]), %% 6.3.2.3 Packet2 = patch_packet(binary_to_list(Packet)), %% 6.3.2.5 MAC = binary_to_list(crypto:hmac(md5, AuthKey, Packet2, 12)), %% 6.3.2.6 - ?vtrace("md5_auth_in -> entry with" - "~n Packet2: ~w" - "~n AuthKey: ~w" - "~n AuthParams: ~w" - "~n MAC: ~w" - , [Packet2, AuthKey, AuthParams, MAC]), + %% ?vtrace("md5_auth_in -> crypto (md5) encoded" + %% "~n MAC: ~w", [MAC]), MAC == AuthParams; md5_auth_in(_AuthKey, _AuthParams, _Packet) -> %% 6.3.2.1 diff --git a/lib/snmp/test/snmp_agent_mibs_test.erl b/lib/snmp/test/snmp_agent_mibs_test.erl index 3e48130fac..248fe7d83e 100644 --- a/lib/snmp/test/snmp_agent_mibs_test.erl +++ b/lib/snmp/test/snmp_agent_mibs_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 2003-2013. 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 @@ -19,13 +19,17 @@ %% %%---------------------------------------------------------------------- -%% Purpose: +%% Purpose: Test suite of the agent mib-server. +%% Some of these tests should really be in a mib-storage suite. %%---------------------------------------------------------------------- + -module(snmp_agent_mibs_test). + %%---------------------------------------------------------------------- %% Include files %%---------------------------------------------------------------------- + -include_lib("test_server/include/test_server.hrl"). -include("snmp_test_lib.hrl"). -include_lib("snmp/include/snmp_types.hrl"). @@ -39,13 +43,25 @@ %% External exports %%---------------------------------------------------------------------- -export([ - all/0,groups/0,init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2, - init_per_suite/1, end_per_suite/1, + all/0, + groups/0, + + init_per_suite/1, + end_per_suite/1, + + init_per_group/2, + end_per_group/2, + + init_per_testcase/2, + end_per_testcase/2, start_and_stop/1, - size_check_ets/1, + size_check_ets1/1, + size_check_ets2/1, + size_check_ets2_bad_file1/1, + size_check_ets3/1, + size_check_ets3_bad_file1/1, size_check_dets/1, size_check_mnesia/1, load_unload/1, @@ -55,6 +71,7 @@ ]). + %%---------------------------------------------------------------------- %% Internal exports %%---------------------------------------------------------------------- @@ -71,18 +88,51 @@ %% External functions %%====================================================================== -init_per_testcase(size_check_dets, Config) when is_list(Config) -> - Dir = ?config(priv_dir, Config), - DetsDir = join(Dir, "dets_dir/"), - ?line ok = file:make_dir(DetsDir), - [{dets_dir, DetsDir}|Config]; -init_per_testcase(size_check_mnesia, Config) when is_list(Config) -> - Dir = ?config(priv_dir, Config), - MnesiaDir = join(Dir, "mnesia_dir/"), - ?line ok = file:make_dir(MnesiaDir), - mnesia_start([{dir, MnesiaDir}]), - [{mnesia_dir, MnesiaDir}|Config]; -init_per_testcase(cache_test, Config) when is_list(Config) -> +init_per_suite(Config0) when is_list(Config0) -> + + ?DBG("init_per_suite -> entry with" + "~n Config0: ~p", [Config0]), + + Config1 = snmp_test_lib:init_suite_top_dir(?MODULE, Config0), + + ?DBG("init_per_suite -> done when" + "~n Config1: ~p", [Config1]), + + Config1. + +end_per_suite(Config) when is_list(Config) -> + + ?DBG("end_per_suite -> entry with" + "~n Config: ~p", [Config]), + + Config. + + +init_per_testcase(Case, Config0) when is_list(Config0) -> + Config1 = snmp_test_lib:fix_data_dir(Config0), + CaseTopDir = snmp_test_lib:init_testcase_top_dir(Case, Config1), + DbDir = join(CaseTopDir, "db_dir/"), + ?line ok = file:make_dir(DbDir), + init_per_testcase2(Case, [{db_dir, DbDir}, + {case_top_dir, CaseTopDir} | Config1]). + +init_per_testcase2(size_check_ets2_bad_file1, Config) when is_list(Config) -> + DbDir = ?config(db_dir, Config), + %% Create a ad file + ok = file:write_file(join(DbDir, "snmpa_symbolic_store.db"), + "calvin and hoppes play chess"), + Config; +init_per_testcase2(size_check_ets3_bad_file1, Config) when is_list(Config) -> + DbDir = ?config(db_dir, Config), + %% Create a ad file + ok = file:write_file(join(DbDir, "snmpa_symbolic_store.db"), + "calvin and hoppes play chess"), + Config; +init_per_testcase2(size_check_mnesia, Config) when is_list(Config) -> + DbDir = ?config(db_dir, Config), + mnesia_start([{dir, DbDir}]), + Config; +init_per_testcase2(cache_test, Config) when is_list(Config) -> Min = timer:minutes(5), Timeout = case lists:keysearch(tc_timeout, 1, Config) of @@ -95,18 +145,26 @@ init_per_testcase(cache_test, Config) when is_list(Config) -> end, Dog = test_server:timetrap(Timeout), [{watchdog, Dog} | Config]; -init_per_testcase(_Case, Config) when is_list(Config) -> +init_per_testcase2(_Case, Config) when is_list(Config) -> Config. -end_per_testcase(size_check_dets, Config) when is_list(Config) -> - Dir = ?config(dets_dir, Config), - ?line ok = ?DEL_DIR(Dir), - lists:keydelete(dets_dir, 1, Config); +%% end_per_testcase(EtsCase, Config) +%% when (is_list(Config) andalso +%% ((EtsCase =:= size_check_ets2) orelse +%% (EtsCase =:= size_check_ets3))) -> +%% Dir = ?config(ets_dir, Config), +%% ?line ok = ?DEL_DIR(Dir), +%% lists:keydelete(ets_dir, 1, Config); +%% end_per_testcase(size_check_dets, Config) when is_list(Config) -> +%% Dir = ?config(dets_dir, Config), +%% ?line ok = ?DEL_DIR(Dir), +%% lists:keydelete(dets_dir, 1, Config); end_per_testcase(size_check_mnesia, Config) when is_list(Config) -> mnesia_stop(), - Dir = ?config(mnesia_dir, Config), - ?line ok = ?DEL_DIR(Dir), - lists:keydelete(mnesia_dir, 1, Config); + %% Dir = ?config(db_dir, Config), + %% ?line ok = ?DEL_DIR(Dir), + %% lists:keydelete(mnesia_dir, 1, Config); + Config; end_per_testcase(cache_test, Config) when is_list(Config) -> Dog = ?config(watchdog, Config), test_server:timetrap_cancel(Dog), @@ -120,33 +178,40 @@ end_per_testcase(_Case, Config) when is_list(Config) -> %%====================================================================== all() -> -cases(). + cases(). groups() -> [{size_check, [], - [size_check_ets, size_check_dets, size_check_mnesia]}]. + [ + size_check_ets1, % Plain ets + size_check_ets2, % ets with a file + size_check_ets2_bad_file1, % ets with a bad file + size_check_ets3, % ets with a checksummed file + size_check_ets3_bad_file1, % ets with bad file (checksummed) + size_check_dets, % Plain dets + size_check_mnesia % Plain mnesia + ] + }]. + -init_per_group(_GroupName, Config) -> - Config. +init_per_group(GroupName, Config) -> + snmp_test_lib:init_group_top_dir(GroupName, Config). end_per_group(_GroupName, Config) -> - Config. + %% Do we really need to do this? + %% lists:keydelete(snmp_group_top_dir, 1, Config). + Config. cases() -> -[start_and_stop, load_unload, {group, size_check}, - me_lookup, which_mib, cache_test]. - -init_per_suite(Config) when is_list(Config) -> - %% Data dir points wrong - DataDir0 = ?config(data_dir, Config), - DataDir1 = filename:split(filename:absname(DataDir0)), - [_|DataDir2] = lists:reverse(DataDir1), - DataDir = filename:join(lists:reverse(DataDir2) ++ [?snmp_test_data]), - [{snmp_data_dir, DataDir ++ "/"}|Config]. - -end_per_suite(Config) when is_list(Config) -> - lists:keydelete(snmp_data_dir, 1, Config). + [ + start_and_stop, + load_unload, + {group, size_check}, + me_lookup, + which_mib, + cache_test + ]. %%====================================================================== @@ -175,8 +240,7 @@ load_unload(suite) -> []; load_unload(Config) when is_list(Config) -> Prio = normal, Verbosity = log, - %% MibStorage = ets, - MibDir = ?config(snmp_data_dir, Config), + MibDir = ?config(data_dir, Config), ?DBG("load_unload -> start symbolic store", []), ?line sym_start(Prio, Verbosity), @@ -221,30 +285,74 @@ load_unload(Config) when is_list(Config) -> %% --------------------------------------------------------------------- -size_check_ets(suite) -> +size_check_ets1(suite) -> + []; +size_check_ets1(Config) when is_list(Config) -> + MibStorage = [{module, snmpa_mib_storage_ets}], + do_size_check([{mib_storage, MibStorage}|Config]). + +size_check_ets2(suite) -> + []; +size_check_ets2(Config) when is_list(Config) -> + Dir = ?config(db_dir, Config), + MibStorage = [{module, snmpa_mib_storage_ets}, + {options, [{dir, Dir}]}], + do_size_check([{mib_storage, MibStorage}|Config]). + +size_check_ets2_bad_file1(suite) -> + []; +size_check_ets2_bad_file1(Config) when is_list(Config) -> + Dir = ?config(db_dir, Config), + %% Ensure that the bad file does not cause any problems (action = clear) + MibStorage = [{module, snmpa_mib_storage_ets}, + {options, [{dir, Dir}, + {action, clear}]}], + do_size_check([{mib_storage, MibStorage}|Config]). + +size_check_ets3(suite) -> []; -size_check_ets(Config) when is_list(Config) -> - do_size_check([{mib_storage, ets}|Config]). +size_check_ets3(Config) when is_list(Config) -> + Dir = ?config(db_dir, Config), + MibStorage = [{module, snmpa_mib_storage_ets}, + {options, [{dir, Dir}, + {checksum, true}]}], + do_size_check([{mib_storage, MibStorage}|Config]). + +size_check_ets3_bad_file1(suite) -> + []; +size_check_ets3_bad_file1(Config) when is_list(Config) -> + Dir = ?config(db_dir, Config), + %% Ensure that the bad file does not cause any problems (action = clear) + MibStorage = [{module, snmpa_mib_storage_ets}, + {options, [{dir, Dir}, + {action, clear}, + {checksum, true}]}], + do_size_check([{mib_storage, MibStorage}|Config]). size_check_dets(suite) -> []; size_check_dets(Config) when is_list(Config) -> - Dir = ?config(dets_dir, Config), - do_size_check([{mib_storage, {dets, Dir}}|Config]). + Dir = ?config(db_dir, Config), + MibStorage = [{module, snmpa_mib_storage_dets}, + {options, [{dir, Dir}]}], + do_size_check([{mib_storage, MibStorage}|Config]). size_check_mnesia(suite) -> []; size_check_mnesia(Config) when is_list(Config) -> - do_size_check([{mib_storage, {mnesia, [node()]}}|Config]). + MibStorage = [{module, snmpa_mib_storage_mnesia}, + {options, [{nodes, [node()]}]}], + do_size_check([{mib_storage, MibStorage}|Config]). do_size_check(Config) -> - ?DBG("do_size_check -> start", []), + ?DBG("do_size_check -> start with" + "~n Config: ~p", [Config]), Prio = normal, Verbosity = trace, MibStorage = ?config(mib_storage, Config), ?DBG("do_size_check -> MibStorage: ~p", [MibStorage]), - MibDir = ?config(snmp_data_dir, Config), + MibDir = ?config(data_dir, Config), StdMibDir = filename:join(code:priv_dir(snmp), "mibs") ++ "/", ?DBG("do_size_check -> start symbolic store", []), @@ -294,8 +402,7 @@ me_lookup(suite) -> []; me_lookup(Config) when is_list(Config) -> Prio = normal, Verbosity = trace, - %% MibStorage = ets, - MibDir = ?config(snmp_data_dir, Config), + MibDir = ?config(data_dir, Config), StdMibDir = filename:join(code:priv_dir(snmp), "mibs") ++ "/", Mibs = ["Test2", "TestTrap", "TestTrapv2"], StdMibs = ["OTP-SNMPEA-MIB", @@ -348,8 +455,7 @@ which_mib(suite) -> []; which_mib(Config) when is_list(Config) -> Prio = normal, Verbosity = trace, - %% MibStorage = ets, - MibDir = ?config(snmp_data_dir, Config), + MibDir = ?config(data_dir, Config), StdMibDir = filename:join(code:priv_dir(snmp), "mibs") ++ "/", Mibs = ["Test2", "TestTrap", "TestTrapv2"], StdMibs = ["OTP-SNMPEA-MIB", @@ -406,28 +512,28 @@ cache_test(Config) when is_list(Config) -> ?DBG("cache_test -> start", []), Prio = normal, Verbosity = trace, - MibStorage = ets, - MibDir = ?config(snmp_data_dir, Config), + MibStorage = [{module, snmpa_mib_storage_ets}], + MibDir = ?config(data_dir, Config), StdMibDir = filename:join(code:priv_dir(snmp), "mibs") ++ "/", - Mibs = ["Test2", "TestTrap", "TestTrapv2"], - StdMibs = ["OTP-SNMPEA-MIB", - "SNMP-COMMUNITY-MIB", - "SNMP-FRAMEWORK-MIB", - "SNMP-MPD-MIB", - "SNMP-NOTIFICATION-MIB", - "SNMP-TARGET-MIB", - %% "SNMP-USER-BASED-SM-MIB", - "SNMP-VIEW-BASED-ACM-MIB", - "SNMPv2-MIB", - "SNMPv2-TC", - "SNMPv2-TM"], + Mibs = ["Test2", "TestTrap", "TestTrapv2"], + StdMibs = ["OTP-SNMPEA-MIB", + "SNMP-COMMUNITY-MIB", + "SNMP-FRAMEWORK-MIB", + "SNMP-MPD-MIB", + "SNMP-NOTIFICATION-MIB", + "SNMP-TARGET-MIB", + %% "SNMP-USER-BASED-SM-MIB", + "SNMP-VIEW-BASED-ACM-MIB", + "SNMPv2-MIB", + "SNMPv2-TC", + "SNMPv2-TM"], ?DBG("cache_test -> start symbolic store", []), ?line sym_start(Prio, MibStorage, Verbosity), ?DBG("cache_test -> start mib server", []), - GcLimit = 2, - Age = timer:seconds(10), + GcLimit = 2, + Age = timer:seconds(10), CacheOpts = [{autogc, false}, {age, Age}, {gclimit, GcLimit}], ?line MibsPid = mibs_start(Prio, MibStorage, [], Verbosity, CacheOpts), @@ -537,7 +643,7 @@ mnesia_stop() -> %% - Symbolic Store mini interface sym_start(Prio, Verbosity) -> - sym_start(Prio, ets, Verbosity). + sym_start(Prio, mib_storage(), Verbosity). sym_start(Prio, MibStorage, Verbosity) -> Opts = [{mib_storage, MibStorage}, {verbosity,Verbosity}], @@ -554,7 +660,7 @@ sym_info() -> %% -- MIB server mini interface mibs_start(Prio, Verbosity) when is_atom(Prio) andalso is_atom(Verbosity) -> - mibs_start(Prio, ets, [], Verbosity). + mibs_start(Prio, mib_storage(), [], Verbosity). mibs_start(Prio, MibStorage, Verbosity) when is_atom(Prio) andalso is_atom(Verbosity) -> @@ -671,6 +777,11 @@ which_mib(M1, M2) -> {error, {invalid_mib, M1, M2}}. +%% Default mib-storage +mib_storage() -> + [{module, snmpa_mib_storage_ets}]. + + %% -- display_memory_usage(MibsPid) -> diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index 09e1eb25a9..6fe97ccd25 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2013. 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 @@ -24,7 +24,402 @@ %% * Test fault-tolerance (kill master etc) %% --compile(export_all). +-export([ + all/0, + groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, + init_per_testcase/2, end_per_testcase/2, + + %% all_tcs - misc + app_info/1, + info_test/1, + + %% all_tcs - test_v1 + simple/1, + db_notify_client/1, + v1_processing/1, + big/1, + big2/1, + loop_mib/1, + api/1, + subagent/1, + mnesia/1, + sa_register/1, + v1_trap/1, + sa_error/1, + next_across_sa/1, + undo/1, + sparse_table/1, + cnt_64/1, + opaque/1, + change_target_addr_config/1, + + %% all_tcs - test_v1 - multiple_reqs + mul_get/1, + mul_get_err/1, + mul_next/1, + mul_next_err/1, + mul_set/1, + mul_set_err/1, + + %% all_tcs - test_v1 - reported_bugs + otp_1128/1, + otp_1129/1, + otp_1131/1, + otp_1162/1, + otp_1222/1, + otp_1298/1, + otp_1331/1, + otp_1338/1, + otp_1342/1, + otp_1366/1, + otp_2776/1, + otp_2979/1, + otp_3187/1, + otp_3725/1, + + %% all_tcs - test_v1 - standard_mibs + snmp_standard_mib/1, + snmp_community_mib/1, + snmp_framework_mib/1, + snmp_target_mib/1, + snmp_notification_mib/1, + snmp_view_based_acm_mib/1, + + %% all_tcs - test_v2 + simple_2/1, + v2_processing/1, + big_2/1, + big2_2/1, + loop_mib_2/1, + api_2/1, + subagent_2/1, + mnesia_2/1, + sa_register_2/1, + v2_trap/1, + sa_error_2/1, + next_across_sa_2/1, + undo_2/1, + v2_types/1, + implied/1, + sparse_table_2/1, + cnt_64_2/1, + opaque_2/1, + v2_caps/1, + + %% all_tcs - test_v2 - multiple_reqs_2 + mul_get_2/1, + mul_get_err_2/1, + mul_next_2/1, + mul_next_err_2/1, + mul_set_2/1, + mul_set_err_2/1, + + %% all_tcs - test_v2 - v2_inform + v2_inform_i/1, + + %% all_tcs - test_v2 - reported_bugs_2 + otp_1128_2/1, + otp_1129_2/1, + otp_1131_2/1, + otp_1162_2/1, + otp_1222_2/1, + otp_1298_2/1, + otp_1331_2/1, + otp_1338_2/1, + otp_1342_2/1, + otp_1366_2/1, + otp_2776_2/1, + otp_2979_2/1, + otp_3187_2/1, + + %% all_tcs - test_v2 - standard_mibs_2 + snmpv2_mib_2/1, + snmp_community_mib_2/1, + snmp_framework_mib_2/1, + snmp_target_mib_2/1, + snmp_notification_mib_2/1, + snmp_view_based_acm_mib_2/1, + + %% all_tcs - test_v1_v2 + simple_bi/1, + + %% all_tcs - test_v3 + simple_3/1, + v3_processing/1, + big_3/1, + big2_3/1, + api_3/1, + subagent_3/1, + mnesia_3/1, + loop_mib_3/1, + sa_register_3/1, + v3_trap/1, + sa_error_3/1, + next_across_sa_3/1, + undo_3/1, + v2_types_3/1, + implied_3/1, + sparse_table_3/1, + cnt_64_3/1, + opaque_3/1, + v2_caps_3/1, + + %% all_tcs - test_v3 - multiple_reqs_3 + mul_get_3/1, + mul_get_err_3/1, + mul_next_3/1, + mul_next_err_3/1, + mul_set_3/1, + mul_set_err_3/1, + + %% all_tcs - test_v3 - v3_inform + v3_inform_i/1, + + %% all_tcs - test_v3 - reported_bugs_3 + otp_1128_3/1, + otp_1129_3/1, + otp_1131_3/1, + otp_1162_3/1, + otp_1222_3/1, + otp_1298_3/1, + otp_1331_3/1, + otp_1338_3/1, + otp_1342_3/1, + otp_1366_3/1, + otp_2776_3/1, + otp_2979_3/1, + otp_3187_3/1, + otp_3542/1, + + %% all_tcs - test_v3 - standard_mibs_3 + snmpv2_mib_3/1, + snmp_framework_mib_3/1, + snmp_mpd_mib_3/1, + snmp_target_mib_3/1, + snmp_notification_mib_3/1, + snmp_view_based_acm_mib_3/1, + snmp_user_based_sm_mib_3/1, + + %% all_tcs - test_v3 - v3_security + v3_crypto_basic/1, + v3_md5_auth/1, + v3_sha_auth/1, + v3_des_priv/1, + + %% all_tcs - test_multi_threaded + multi_threaded/1, + mt_trap/1, + + %% all_tcs - mib_storage - mib_storage_ets + mse_simple/1, + mse_v1_processing/1, + mse_big/1, + mse_big2/1, + mse_loop_mib/1, + mse_api/1, + mse_sa_register/1, + mse_v1_trap/1, + mse_sa_error/1, + mse_next_across_sa/1, + mse_undo/1, + mse_standard_mib/1, + mse_community_mib/1, + mse_framework_mib/1, + mse_target_mib/1, + mse_notification_mib/1, + mse_view_based_acm_mib/1, + mse_sparse_table/1, + mse_me_of/1, + mse_mib_of/1, + + %% all_tcs - mib_storage - mib_storage_dets + msd_simple/1, + msd_v1_processing/1, + msd_big/1, + msd_big2/1, + msd_loop_mib/1, + msd_api/1, + msd_sa_register/1, + msd_v1_trap/1, + msd_sa_error/1, + msd_next_across_sa/1, + msd_undo/1, + msd_standard_mib/1, + msd_community_mib/1, + msd_framework_mib/1, + msd_target_mib/1, + msd_notification_mib/1, + msd_view_based_acm_mib/1, + msd_sparse_table/1, + msd_me_of/1, + msd_mib_of/1, + + %% all_tcs - mib_storage - mib_storage_mnesia + msm_simple/1, + msm_v1_processing/1, + msm_big/1, + msm_big2/1, + msm_loop_mib/1, + msm_api/1, + msm_sa_register/1, + msm_v1_trap/1, + msm_sa_error/1, + msm_next_across_sa/1, + msm_undo/1, + msm_standard_mib/1, + msm_community_mib/1, + msm_framework_mib/1, + msm_target_mib/1, + msm_notification_mib/1, + msm_view_based_acm_mib/1, + msm_sparse_table/1, + msm_me_of/1, + msm_mib_of/1, + + %% all_tcs - mib_storage - mse_size_check + mse_size_check/1, + + %% all_tcs - mib_storage - msd_size_check + msd_size_check/1, + + %% all_tcs - mib_storage - msm_size_check + msm_size_check/1, + + %% all_tcs - mib_storage - varm_mib_storage_dets + msd_varm_mib_start/1, + + %% all_tcs - mib_storage - varm_mib_storage_mnesia + msm_varm_mib_start/1, + + %% all_tcs - tickets1 - otp4394 + otp_4394/1, + + %% all_tcs - tickets1 - otp7157 + otp_7157/1, + + %% tickets2 + otp8395/1, + otp9884/1 + + ]). + +%% Internal exports +-export([dummy_manager_init/2, + v3_sync/1, + v3_inform_sync/1, + v2_caps_i/1, + v1_proc/0, + v2_proc/0, + big_test/0, + big_test_2/0, + simple_standard_test/0, + db_notify_client_test/0, + notify/2, + multi_threaded_test/0, + mt_trap_test/1, + types_v2_test/0, + implied_test/1, + sparse_table_test/0, + cnt_64_test/1, + opaque_test/0, + api_test/1, + unreg_test/0, + load_test/0, + load_test_sa/0, + api_test2/0, + api_test3/0, + do_mul_get/0, + do_mul_get_err/0, + do_mul_next/0, + do_mul_next_err/0, + do_mul_set/0, + do_mul_set_err/0, + sa_mib/0, + ma_trap1/1, + ma_trap2/1, + ma_v2_2_v1_trap/1, + ma_v2_2_v1_trap2/1, + sa_trap1/1, + sa_trap2/1, + sa_trap3/1, + ma_v2_trap1/1, + ma_v2_trap2/1, + ma_v2_inform1/1, + ma_v2_inform2/1, + ma_v2_inform3/1, + delivery_targets/3, + delivery_info/4, + ma_v1_2_v2_trap/1, + ma_v1_2_v2_trap2/1, + sa_v1_2_v2_trap1/1, + sa_v1_2_v2_trap2/1, + sa_v1_2_v2_trap3/1, + sa_errs_bad_value/0, + sa_errs_gen_err/0, + sa_too_big/0, + next_across_sa_test/0, + undo_test/0, + bad_return/0, + standard_mib_a/0, + std_mib_read/0, + std_mib_write/0, + std_mib_init/0, + std_mib_finish/0, + standard_mib_test_finish/0, + std_mib_asn_err/0, + snmpv2_mib_test_finish/0, + std_mib_a/0, + std_mib_b/1, + std_mib_c/1, + snmpv2_mib_a/0, + snmp_community_mib_test/0, + snmp_framework_mib_test/0, + snmp_mpd_mib_a/0, + snmp_mpd_mib_b/0, + snmp_mpd_mib_c/1, + snmp_target_mib_test/0, + snmp_notification_mib_test/0, + do_set/1, + add_row/1, + del_row/1, + use_no_rights/0, + use_rights/0, + usm_add_user1/0, + usm_use_user/0, + usm_key_change1/2, + usm_key_change2/4, + usm_key_change3/4, + usm_read/0, + usm_del_user/0, + usm_bad/0, + loop_mib_1/0, + loop_mib_2/0, + otp_1129_i/1, + otp_1162_test/0, + otp_1131_test/0, + otp_1222_test/0, + otp_1298_test/0, + otp_1331_test/0, + otp_1338_test/0, + otp_1342_test/0, + otp_1366_test/0, + otp_1128_test/0, + otp_2776_test/0, + otp_2979_test/0, + otp_3542_test/0, + otp_3725_test/1, + otp_4394_test/0, + otp_7157_test/1, + otp9884_backup/4, + agent_log_validation/0, + mnesia_init/1, + mnesia_start/0, + mnesia_stop/0, + start_stdalone_agent/1, + do_info/1 + ]). -define(application, snmp). @@ -86,6 +481,26 @@ end). +-define(expect1(What), + snmp_agent_test_lib:expect(?MODULE, ?LINE, + What)). +-define(expect2(What, ExpVBs), + snmp_agent_test_lib:expect(?MODULE, ?LINE, + What, ExpVBs)). +-define(expect3(Err, Idx, ExpVBs), + snmp_agent_test_lib:expect(?MODULE, ?LINE, + Err, Idx, ExpVBs)). +-define(expect4(Err, Idx, ExpVBs, To), + snmp_agent_test_lib:expect(?MODULE, ?LINE, + Err, Idx, ExpVBs, To)). +-define(expect5(Type, Ent, Gen, Spec, ExpVBs), + snmp_agent_test_lib:expect(?MODULE, ?LINE, + Type, Ent, Gen, Spec, ExpVBs)). +-define(expect6(Type, Ent, Gen, Spec, ExpVBs, To), + snmp_agent_test_lib:expect(?MODULE, ?LINE, + Type, Ent, Gen, Spec, ExpVBs, To)). + + all() -> %% Reqs = [mnesia, distribution, {local_slave_nodes, 2}, {time, 360}], Conf1 = [{group, all_tcs}], @@ -94,19 +509,8 @@ all() -> groups() -> [ - {all_tcs, [], cases()}, - {mib_storage, [], - [ - {group, mib_storage_ets}, - {group, mib_storage_dets}, - {group, mib_storage_mnesia}, - {group, mib_storage_size_check_ets}, - {group, mib_storage_size_check_dets}, - {group, mib_storage_size_check_mnesia}, - {group, mib_storage_varm_dets}, - {group, mib_storage_varm_mnesia} - ] - }, + {all_tcs, [], cases()}, + {mib_storage, [], mib_storage_cases()}, {mib_storage_ets, [], mib_storage_ets_cases()}, {mib_storage_dets, [], mib_storage_dets_cases()}, {mib_storage_mnesia, [], mib_storage_mnesia_cases()}, @@ -123,109 +527,20 @@ groups() -> {test_multi_threaded, [], mt_cases()}, {multiple_reqs, [], mul_cases()}, {multiple_reqs_2, [], mul_cases_2()}, - {v2_inform, [], - [ - v2_inform_i - ] - }, - {v3_security, [], - [ - v3_crypto_basic, - v3_md5_auth, - v3_sha_auth, - v3_des_priv - ] - }, - {standard_mibs, [], - [ - snmp_standard_mib, - snmp_community_mib, - snmp_framework_mib, - snmp_target_mib, - snmp_notification_mib, - snmp_view_based_acm_mib - ] - }, - {standard_mibs_2, [], - [ - snmpv2_mib_2, - snmp_community_mib_2, - snmp_framework_mib_2, - snmp_target_mib_2, - snmp_notification_mib_2, - snmp_view_based_acm_mib_2 - ] - }, - {standard_mibs_3, [], - [ - snmpv2_mib_3, - snmp_framework_mib_3, - snmp_mpd_mib_3, - snmp_target_mib_3, - snmp_notification_mib_3, - snmp_view_based_acm_mib_3, - snmp_user_based_sm_mib_3 - ] - }, - {reported_bugs, [], - [ - otp_1128, - otp_1129, - otp_1131, - otp_1162, - otp_1222, - otp_1298, - otp_1331, - otp_1338, - otp_1342, - otp_2776, - otp_2979, - otp_3187, - otp_3725 - ] - }, - {reported_bugs_2, [], - [ - otp_1128_2, - otp_1129_2, - otp_1131_2, - otp_1162_2, - otp_1222_2, - otp_1298_2, - otp_1331_2, - otp_1338_2, - otp_1342_2, - otp_2776_2, - otp_2979_2, - otp_3187_2 - ] - }, - {reported_bugs_3, [], - [ - otp_1128_3, - otp_1129_3, - otp_1131_3, - otp_1162_3, - otp_1222_3, - otp_1298_3, - otp_1331_3, - otp_1338_3, - otp_1342_3, - otp_2776_3, - otp_2979_3, - otp_3187_3, - otp_3542 - ] - }, - {tickets1, [], - [ - {group, otp_4394}, - {group, otp_7157} - ] - }, - {tickets2, [], [otp8395, otp9884]}, - {otp_4394, [], [otp_4394_test]}, - {otp_7157, [], [otp_7157_test]} + {multiple_reqs_3, [], mul_cases_3()}, + {v2_inform, [], v2_inform_cases()}, + {v3_inform, [], v3_inform_cases()}, + {v3_security, [], v3_security_cases()}, + {standard_mibs, [], standard_mibs_cases()}, + {standard_mibs_2, [], standard_mibs2_cases()}, + {standard_mibs_3, [], standard_mibs3_cases()}, + {reported_bugs, [], reported_bugs_cases()}, + {reported_bugs_2, [], reported_bugs2_cases()}, + {reported_bugs_3, [], reported_bugs3_cases()}, + {tickets1, [], tickets1_cases()}, + {tickets2, [], tickets2_cases()}, + {otp4394, [], [otp_4394]}, + {otp7157, [], [otp_7157]} ]. @@ -258,15 +573,19 @@ end_per_suite(Config) when is_list(Config) -> init_per_group(all_tcs = GroupName, Config) -> init_all(snmp_test_lib:init_group_top_dir(GroupName, Config)); -init_per_group(otp_7157 = GroupName, Config) -> - init_otp_7157(snmp_test_lib:init_group_top_dir(GroupName, Config)); -init_per_group(otp_4394 = GroupName, Config) -> - init_otp_4394(snmp_test_lib:init_group_top_dir(GroupName, Config)); +init_per_group(otp7157 = GroupName, Config) -> + otp_7157_init(snmp_test_lib:init_group_top_dir(GroupName, Config)); +init_per_group(otp4394 = GroupName, Config) -> + otp_4394_init(snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(v2_inform = GroupName, Config) -> init_v2_inform(snmp_test_lib:init_group_top_dir(GroupName, Config)); +init_per_group(v3_inform = GroupName, Config) -> + init_v3_inform(snmp_test_lib:init_group_top_dir(GroupName, Config)); +init_per_group(multiple_reqs = GroupName, Config) -> + init_mul(snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(multiple_reqs_2 = GroupName, Config) -> init_mul(snmp_test_lib:init_group_top_dir(GroupName, Config)); -init_per_group(multiple_reqs = GroupName, Config) -> +init_per_group(multiple_reqs_3 = GroupName, Config) -> init_mul(snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(test_multi_threaded = GroupName, Config) -> init_mt(snmp_test_lib:init_group_top_dir(GroupName, Config)); @@ -284,8 +603,10 @@ init_per_group(mib_storage_varm_mnesia = GroupName, Config) -> init_varm_mib_storage_mnesia(snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(mib_storage_varm_dets = GroupName, Config) -> - init_varm_mib_storage_dets(snmp_test_lib:init_group_top_dir(GroupName, - Config)); + ?DBG("init_per_group(mib_storage_varm_dets) -> entry with" + "~n Config: ~p", [Config]), + init_varm_mib_storage_dets( + snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(mib_storage_size_check_mnesia = GroupName, Config) -> init_size_check_msm(snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(mib_storage_size_check_dets = GroupName, Config) -> @@ -304,16 +625,20 @@ init_per_group(GroupName, Config) -> end_per_group(all_tcs, Config) -> finish_all(Config); -end_per_group(otp_7157, Config) -> - finish_otp_7157(Config); -end_per_group(otp_4394, Config) -> - finish_otp_4394(Config); +end_per_group(otp7157, Config) -> + otp_7157_finish(Config); +end_per_group(otp4394, Config) -> + otp_4394_finish(Config); end_per_group(v2_inform, Config) -> - finish_v2_inform(Config); -end_per_group(multiple_reqs_2, Config) -> - finish_mul(Config); + finish_v2_inform(Config); +end_per_group(v3_inform, Config) -> + finish_v3_inform(Config); end_per_group(multiple_reqs, Config) -> finish_mul(Config); +end_per_group(multiple_reqs_2, Config) -> + finish_mul(Config); +end_per_group(multiple_reqs_3, Config) -> + finish_mul(Config); end_per_group(test_multi_threaded, Config) -> finish_mt(Config); end_per_group(test_v3, Config) -> @@ -353,9 +678,6 @@ init_per_testcase(Case, Config) when is_list(Config) -> ?DBG("init_per_testcase -> entry with" "~n Config: ~p", [Config]), - p("Agent Info: " - "~n ~p", [snmpa:info()]), - init_per_testcase1(Case, Config). init_per_testcase1(otp8395 = Case, Config) when is_list(Config) -> @@ -368,7 +690,7 @@ init_per_testcase1(otp9884 = Case, Config) when is_list(Config) -> "~n Case: ~p" "~n Config: ~p", [Case, Config]), otp9884({init, init_per_testcase2(Case, Config)}); -init_per_testcase1(otp_7157_test = _Case, Config) when is_list(Config) -> +init_per_testcase1(otp_7157 = _Case, Config) when is_list(Config) -> ?DBG("init_per_testcase1 -> entry with" "~n Case: ~p" "~n Config: ~p", [_Case, Config]), @@ -400,9 +722,6 @@ end_per_testcase(Case, Config) when is_list(Config) -> ?DBG("end_per_testcase -> entry with" "~n Config: ~p", [Config]), - p("Agent Info: " - "~n ~p", [snmpa:info()]), - display_log(Config), end_per_testcase1(Case, Config). @@ -454,20 +773,20 @@ init_per_testcase2(Case, Config) -> {sub_agent_top_dir, SubAgentTopDir}, {manager_top_dir, ManagerTopDir} | Config]. -end_per_testcase2(_Case, Config) -> - Config. +%% end_per_testcase2(_Case, Config) -> +%% Config. cases() -> [ - {group, misc}, - {group, test_v1}, - {group, test_v2}, - {group, test_v1_v2}, - {group, test_v3}, - {group, test_multi_threaded}, - {group, mib_storage}, - {group, tickets1} + {group, misc}, + {group, test_v1}, + {group, test_v2}, + {group, test_v1_v2}, + {group, test_v3}, + {group, test_multi_threaded}, + {group, mib_storage}, + {group, tickets1} ]. @@ -553,7 +872,7 @@ delete_tables() -> mnesia:delete_table(kompissTable2), mnesia:delete_table(snmp_variables). -%% Creation is done in runtime! +%% Tables are created in runtime! delete_mib_storage_mnesia_tables() -> mnesia:delete_table(snmpa_mib_data), mnesia:delete_table(snmpa_mib_tree), @@ -576,40 +895,89 @@ delete_mib_storage_mnesia_tables() -> %% versions as well, <base>_N. %%----------------------------------------------------------------- - - - - - - - - +mib_storage_cases() -> + [ + {group, mib_storage_ets}, + {group, mib_storage_dets}, + {group, mib_storage_mnesia}, + {group, mib_storage_size_check_ets}, + {group, mib_storage_size_check_dets}, + {group, mib_storage_size_check_mnesia}, + {group, mib_storage_varm_dets}, + {group, mib_storage_varm_mnesia} + ]. + mib_storage_ets_cases() -> -[mse_simple, mse_v1_processing, mse_big, mse_big2, - mse_loop_mib, mse_api, mse_sa_register, mse_v1_trap, - mse_sa_error, mse_next_across_sa, mse_undo, - mse_standard_mib, mse_community_mib, mse_framework_mib, - mse_target_mib, mse_notification_mib, - mse_view_based_acm_mib, mse_sparse_table, mse_me_of, - mse_mib_of]. + [ + mse_simple, + mse_v1_processing, + mse_big, + mse_big2, + mse_loop_mib, + mse_api, + mse_sa_register, + mse_v1_trap, + mse_sa_error, + mse_next_across_sa, + mse_undo, + mse_standard_mib, + mse_community_mib, + mse_framework_mib, + mse_target_mib, + mse_notification_mib, + mse_view_based_acm_mib, + mse_sparse_table, + mse_me_of, + mse_mib_of + ]. mib_storage_dets_cases() -> -[msd_simple, msd_v1_processing, msd_big, msd_big2, - msd_loop_mib, msd_api, msd_sa_register, msd_v1_trap, - msd_sa_error, msd_next_across_sa, msd_undo, - msd_standard_mib, msd_community_mib, msd_framework_mib, - msd_target_mib, msd_notification_mib, - msd_view_based_acm_mib, msd_sparse_table, msd_me_of, - msd_mib_of]. + [ + msd_simple, + msd_v1_processing, + msd_big, + msd_big2, + msd_loop_mib, + msd_api, + msd_sa_register, + msd_v1_trap, + msd_sa_error, + msd_next_across_sa, + msd_undo, + msd_standard_mib, + msd_community_mib, + msd_framework_mib, + msd_target_mib, + msd_notification_mib, + msd_view_based_acm_mib, + msd_sparse_table, + msd_me_of, + msd_mib_of + ]. mib_storage_mnesia_cases() -> -[msm_simple, msm_v1_processing, msm_big, msm_big2, - msm_loop_mib, msm_api, msm_sa_register, msm_v1_trap, - msm_sa_error, msm_next_across_sa, msm_undo, - msm_standard_mib, msm_community_mib, msm_framework_mib, - msm_target_mib, msm_notification_mib, - msm_view_based_acm_mib, msm_sparse_table, msm_me_of, - msm_mib_of]. + [ + msm_simple, + msm_v1_processing, + msm_big, + msm_big2, + msm_loop_mib, + msm_api, + msm_sa_register, + msm_v1_trap, + msm_sa_error, + msm_next_across_sa, + msm_undo, + msm_standard_mib, + msm_community_mib, + msm_framework_mib, + msm_target_mib, + msm_notification_mib, + msm_view_based_acm_mib, + msm_sparse_table, + msm_me_of, + msm_mib_of + ]. mse_size_check_cases() -> [mse_size_check]. @@ -628,22 +996,27 @@ varm_mib_storage_mnesia_cases() -> init_mib_storage_ets(Config) when is_list(Config) -> ?LOG("init_mib_storage_ets -> entry", []), - MibStorage = {snmp_mib_storage,ets}, + MibStorage = {mib_storage, [{module, snmpa_mib_storage_ets}]}, init_ms(Config, [MibStorage]). init_mib_storage_dets(Config) when is_list(Config) -> - ?LOG("init_mib_storage_ets -> entry", []), + ?LOG("init_mib_storage_dets -> entry", []), ?line AgentDbDir = ?GCONF(agent_db_dir, Config), - MibStorage = {snmp_mib_storage, {dets, AgentDbDir}}, + MibStorage = {mib_storage, [{module, snmpa_mib_storage_dets}, + {options, [{dir, AgentDbDir}]}]}, init_ms(Config, [MibStorage]). init_mib_storage_mnesia(Config) when is_list(Config) -> - ?LOG("init_mib_storage_ets -> entry", []), - MibStorage = {snmp_mib_storage, {mnesia,[]}}, + ?LOG("init_mib_storage_mnesia -> entry", []), + ?line AgentNode = ?GCONF(snmp_master, Config), + MibStorage = {mib_storage, [{module, snmpa_mib_storage_mnesia}, + {options, [{nodes, [AgentNode]}]}]}, init_ms(Config, [MibStorage]). init_ms(Config, Opts) when is_list(Config) -> - ?LOG("init_mib_storage_ets -> entry", []), + ?LOG("init_ms -> entry with" + "~n Config: ~p" + "~n Opts: ~p", [Config, Opts]), ?line SaNode = ?GCONF(snmp_sa, Config), ?line create_tables(SaNode), ?line AgentConfDir = ?GCONF(agent_conf_dir, Config), @@ -651,23 +1024,26 @@ init_ms(Config, Opts) when is_list(Config) -> ?line Ip = ?GCONF(ip, Config), ?line config([v1], MgrDir, AgentConfDir, tuple_to_list(Ip), tuple_to_list(Ip)), - MasterAgentVerbosity = {snmp_master_agent_verbosity, trace}, - MibsVerbosity = {snmp_mibserver_verbosity, trace}, - SymStoreVerbosity = {snmp_symbolic_store_verbosity, trace}, + MasterAgentVerbosity = {agent_verbosity, trace}, + MibsVerbosity = {mib_server, [{verbosity, trace}]}, + SymStoreVerbosity = {symbolic_store, [{verbosity, trace}]}, Opts1 = [MasterAgentVerbosity, MibsVerbosity, SymStoreVerbosity | Opts], [{vsn, v1} | start_v1_agent(Config, Opts1)]. init_size_check_mse(Config) when is_list(Config) -> - MibStorage = {snmp_mib_storage, ets}, + MibStorage = {mib_storage, [{module, snmpa_mib_storage_ets}]}, init_size_check_ms(Config, [MibStorage]). init_size_check_msd(Config) when is_list(Config) -> AgentDbDir = ?GCONF(agent_db_dir, Config), - MibStorage = {snmp_mib_storage, {dets, AgentDbDir}}, + MibStorage = {mib_storage, [{module, snmpa_mib_storage_dets}, + {options, [{dir, AgentDbDir}]}]}, init_size_check_ms(Config, [MibStorage]). init_size_check_msm(Config) when is_list(Config) -> - MibStorage = {snmp_mib_storage, {mnesia,[]}}, + ?line AgentNode = ?GCONF(snmp_master, Config), + MibStorage = {mib_storage, [{module, snmpa_mib_storage_mnesia}, + {options, [{nodes, [AgentNode]}]}]}, init_size_check_ms(Config, [MibStorage]). init_size_check_ms(Config, Opts) when is_list(Config) -> @@ -702,12 +1078,16 @@ init_varm_mib_storage_dets(Config) when is_list(Config) -> ?line Ip = ?GCONF(ip, Config), ?line config([v1], MgrDir, AgentConfDir, tuple_to_list(Ip), tuple_to_list(Ip)), - MibStorage = {snmp_mib_storage, {dets, AgentDbDir}}, - MasterAgentVerbosity = {snmp_master_agent_verbosity, trace}, - MibsVerbosity = {snmp_mibserver_verbosity, trace}, - SymStoreVerbosity = {snmp_symbolic_store_verbosity, trace}, - Opts = [MibStorage,MasterAgentVerbosity,MibsVerbosity,SymStoreVerbosity], - [{vsn, v1}, {agent_opts,Opts} | Config]. + MibStorage = {mib_storage, [{module, snmpa_mib_storage_dets}, + {options, [{dir, AgentDbDir}]}]}, + MasterAgentVerbosity = {agent_verbosity, trace}, + MibsVerbosity = {mib_server, [{verbosity, trace}]}, + SymStoreVerbosity = {symbolic_store, [{verbosity, trace}]}, + Opts = [MibStorage, + MasterAgentVerbosity, + MibsVerbosity, + SymStoreVerbosity], + [{vsn, v1}, {agent_opts, Opts} | Config]. init_varm_mib_storage_mnesia(Config) when is_list(Config) -> ?LOG("init_varm_mib_storage_mnesia -> entry", []), @@ -718,12 +1098,17 @@ init_varm_mib_storage_mnesia(Config) when is_list(Config) -> ?line Ip = ?GCONF(ip, Config), ?line config([v1], MgrDir, AgentConfDir, tuple_to_list(Ip), tuple_to_list(Ip)), - MibStorage = {snmp_mib_storage,{mnesia,[]}}, - MasterAgentVerbosity = {snmp_master_agent_verbosity, trace}, - MibsVerbosity = {snmp_mibserver_verbosity, trace}, - SymStoreVerbosity = {snmp_symbolic_store_verbosity, trace}, - Opts = [MibStorage,MasterAgentVerbosity,MibsVerbosity,SymStoreVerbosity], - [{vsn, v1}, {agent_opts,Opts} | Config]. + ?line AgentNode = ?GCONF(snmp_master, Config), + MibStorage = {mib_storage, [{module, snmpa_mib_storage_mnesia}, + {options, [{nodes, [AgentNode]}]}]}, + MasterAgentVerbosity = {agent_verbosity, trace}, + MibsVerbosity = {mib_server, [{verbosity, trace}]}, + SymStoreVerbosity = {symbolic_store, [{verbosity, trace}]}, + Opts = [MibStorage, + MasterAgentVerbosity, + MibsVerbosity, + SymStoreVerbosity], + [{vsn, v1}, {agent_opts, Opts} | Config]. finish_mib_storage_ets(Config) when is_list(Config) -> ?LOG("finish_mib_storage_ets -> entry", []), @@ -956,10 +1341,10 @@ varm_mib_start(Config) when is_list(Config) -> %% Perform the test(s) ?DBG("varm_mib_start -> perform the tests", []), - try_test(snmp_community_mib), - try_test(snmp_framework_mib), - try_test(snmp_target_mib), - try_test(snmp_notification_mib), + try_test(snmp_community_mib_test), + try_test(snmp_framework_mib_test), + try_test(snmp_target_mib_test), + try_test(snmp_notification_mib_test), %% Stop the agent (without deleting the stored files) ?DBG("varm_mib_start -> stop the agent", []), @@ -1119,7 +1504,10 @@ finish_misc(Config) -> finish_v1(Config). misc_cases() -> -[app_info, info_test]. + [ + app_info, + info_test + ]. app_info(suite) -> []; app_info(Config) when is_list(Config) -> @@ -1270,10 +1658,10 @@ v3_cases() -> subagent_3, mnesia_3, loop_mib_3, - multiple_reqs_3, + {group, multiple_reqs_3}, sa_register_3, v3_trap, - v3_inform, + {group, v3_inform}, sa_error_3, next_across_sa_3, undo_3, @@ -1626,7 +2014,7 @@ change_target_addr_config(Config) when is_list(Config) -> dummy_manager_start(MA) -> ?DBG("dummy_manager_start -> entry",[]), - Pid = spawn(get(mgr_node), ?MODULE,dummy_manager_init,[self(),MA]), + Pid = spawn(get(mgr_node), ?MODULE, dummy_manager_init, [self(), MA]), ?DBG("dummy_manager_start -> Pid: ~p",[Pid]), await_dummy_manager_started(Pid). @@ -1818,23 +2206,41 @@ mnesia_2(X) -> ?P(mnesia_2), mnesia(X). mnesia_3(X) -> ?P(mnesia_3), mnesia(X). - mul_cases() -> -[mul_get, mul_get_err, mul_next, mul_next_err, - mul_set_err]. - + [ + mul_get, + mul_get_err, + mul_next, + mul_next_err, + mul_set, + mul_set_err + ]. + -multiple_reqs_3(_X) -> - {req, [], {conf, init_mul, mul_cases_3(), finish_mul}}. +%% multiple_reqs_3(_X) -> +%% {req, [], {conf, init_mul, mul_cases_3(), finish_mul}}. mul_cases_2() -> -[mul_get_2, mul_get_err_2, mul_next_2, mul_next_err_2, - mul_set_err_2]. - + [ + mul_get_2, + mul_get_err_2, + mul_next_2, + mul_next_err_2, + mul_set_2, + mul_set_err_2 + ]. + mul_cases_3() -> - [mul_get_3, mul_get_err_3, mul_next_3, mul_next_err_3, mul_set_err_3]. + [ + mul_get_3, + mul_get_err_3, + mul_next_3, + mul_next_err_3, + mul_set_3, + mul_set_err_3 + ]. init_mul(Config) when is_list(Config) -> @@ -2056,27 +2462,32 @@ v3_trap(Config) when is_list(Config) -> trap2(Config). -v3_inform(_X) -> - %% v2_inform(X). - {req, [], {conf, init_v3_inform, [v3_inform_i], finish_v3_inform}}. +v3_inform_cases() -> + [ + v3_inform_i + ]. + +init_v3_inform(X) -> + init_v2_inform(X). + +finish_v3_inform(X) -> + finish_v2_inform(X). + init_v2_inform(Config) when is_list(Config) -> _Dir = ?config(agent_conf_dir, Config), %% snmp_internal_mib:configure(Dir), Config. -init_v3_inform(X) -> - init_v2_inform(X). - finish_v2_inform(Config) when is_list(Config) -> _Dir = ?config(agent_conf_dir, Config), %% snmp_internal_mib:configure(Dir), Config. -finish_v3_inform(X) -> - finish_v2_inform(X). - - +v2_inform_cases() -> + [ + v2_inform_i + ]. v2_inform_i(suite) -> []; v2_inform_i(Config) when is_list(Config) -> @@ -2176,7 +2587,7 @@ next_across_sa(Config) when is_list(Config) -> try_test(load_test_sa), ?P1("Testing next across subagent (endOfMibView from SA)..."), - try_test(next_across_sa), + try_test(next_across_sa_test), ?P1("Unloading mib (Klas1)"), snmpa:unload_mibs(SA, [MibDir ++ "Klas1"]), @@ -2186,7 +2597,7 @@ next_across_sa(Config) when is_list(Config) -> ?P1("Starting another subagent (2) "), ?line {ok, SA2} = start_subagent(SaNode, ?klas1, "Klas1"), ?P1("Testing next across subagent (wrong prefix from SA)..."), - try_test(next_across_sa), + try_test(next_across_sa_test), ?P1("stop subagent (1)..."), stop_subagent(SA), @@ -2315,6 +2726,15 @@ v3_processing(Config) when is_list(Config) -> %% report, which makes it in sync. The notification-generating %% application times out, and send again. This time it'll work. +v3_security_cases() -> + [ + v3_crypto_basic, + v3_md5_auth, + v3_sha_auth, + v3_des_priv + ]. + + v3_crypto_basic(suite) -> []; v3_crypto_basic(_Config) -> ?P(v3_crypto_basic), @@ -2453,9 +2873,9 @@ v3_des_priv(Config) when is_list(Config) -> v3_sync(Funcs) -> ?DBG("v3_sync -> entry with Funcs: ~p",[Funcs]), g([[sysDescr, 0]]), - expect(432, report, [{?usmStatsNotInTimeWindows_instance, any}]), + ?expect2(report, [{?usmStatsNotInTimeWindows_instance, any}]), g([[sysDescr, 0]]), - expect(433, [{[sysDescr,0], any}]), + ?expect1([{[sysDescr,0], any}]), lists:foreach(fun({Func, Args}) -> apply(?MODULE, Func, Args) end, Funcs). v3_inform_sync(MA) -> @@ -2466,9 +2886,9 @@ v3_inform_sync(MA) -> ?DBG("v3_sync -> wait some time: ",[]), ?SLEEP(20000), % more than 1500*10 in target_addr.conf ?DBG("v3_sync -> await response",[]), - ?line expect(1, {inform, true}, - [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?system ++ [0,1]}]). + ?line ?expect2({inform, true}, + [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?system ++ [0,1]}]). v2_caps(suite) -> []; @@ -2484,11 +2904,11 @@ v2_caps_3(X) -> ?P(v2_caps_3), v2_caps(X). v2_caps_i(Node) -> ?line Idx = rpc:call(Node, snmp, add_agent_caps, [[1,2,3,4,5], "test cap"]), g([[sysORID, Idx], [sysORDescr, Idx]]), - ?line expect(1, [{[sysORID, Idx], [1,2,3,4,5]}, - {[sysORDescr, Idx], "test cap"}]), + ?line ?expect1([{[sysORID, Idx], [1,2,3,4,5]}, + {[sysORDescr, Idx], "test cap"}]), ?line rpc:call(Node, snmp, del_agent_caps, [Idx]), g([[sysORID, Idx]]), - ?line expect(2, [{[sysORID, Idx], noSuchInstance}]). + ?line ?expect1([{[sysORID, Idx], noSuchInstance}]). %% Req. Test2 @@ -2504,86 +2924,86 @@ v1_proc() -> v1_get_p() -> %% 4.1.2:1 g([[test2]]), - ?line expect(10, noSuchName, 1, [{[test2], 'NULL'}]), + ?line ?expect3(noSuchName, 1, [{[test2], 'NULL'}]), g([[tDescr]]), - ?line expect(11, noSuchName, 1, [{[tDescr], 'NULL'}]), + ?line ?expect3(noSuchName, 1, [{[tDescr], 'NULL'}]), g([[tDescr2,0]]), - ?line expect(12, noSuchName, 1, [{[tDescr2,0], 'NULL'}]), + ?line ?expect3(noSuchName, 1, [{[tDescr2,0], 'NULL'}]), g([[tDescr3,0]]), - ?line expect(131, noSuchName, 1, [{[tDescr3,0], 'NULL'}]), + ?line ?expect3(noSuchName, 1, [{[tDescr3,0], 'NULL'}]), g([[tDescr4,0]]), - ?line expect(132, noSuchName, 1, [{[tDescr4,0], 'NULL'}]), + ?line ?expect3(noSuchName, 1, [{[tDescr4,0], 'NULL'}]), g([[sysDescr, 0], [tDescr,0]]), % Outside mibview - ?line expect(14, noSuchName, 2, [{[sysDescr, 0], 'NULL'}, - {[tDescr,0], 'NULL'}]), + ?line ?expect3(noSuchName, 2, [{[sysDescr, 0], 'NULL'}, + {[tDescr,0], 'NULL'}]), g([[sysDescr,3]]), - ?line expect(15, noSuchName, 1, [{[sysDescr, 3], 'NULL'}]), + ?line ?expect3(noSuchName, 1, [{[sysDescr, 3], 'NULL'}]), %% 4.1.2:2 g([[tTable]]), - ?line expect(20, noSuchName, 1, [{[tTable], 'NULL'}]), + ?line ?expect3(noSuchName, 1, [{[tTable], 'NULL'}]), g([[tEntry]]), - ?line expect(21, noSuchName, 1, [{[tEntry], 'NULL'}]), + ?line ?expect3(noSuchName, 1, [{[tEntry], 'NULL'}]), %% 4.1.2:3 g([[tTooBig, 0]]), - ?line expect(30, tooBig, 0, [{[tTooBig, 0], 'NULL'}]), + ?line ?expect3(tooBig, 0, [{[tTooBig, 0], 'NULL'}]), %% 4.1.2:4 g([[tGenErr1, 0]]), - ?line expect(40, genErr, 1, [{[tGenErr1, 0], 'NULL'}]), + ?line ?expect3(genErr, 1, [{[tGenErr1, 0], 'NULL'}]), g([[tGenErr2, 0]]), - ?line expect(41, genErr, 1, [{[tGenErr2, 0], 'NULL'}]), + ?line ?expect3(genErr, 1, [{[tGenErr2, 0], 'NULL'}]), g([[sysDescr, 0], [tGenErr3, 0]]), - ?line expect(42, genErr, 2, [{[sysDescr, 0], 'NULL'}, - {[tGenErr3, 0], 'NULL'}]). + ?line ?expect3(genErr, 2, [{[sysDescr, 0], 'NULL'}, + {[tGenErr3, 0], 'NULL'}]). v1_get_next_p() -> %% 4.1.3:1 gn([[1,3,7,1]]), - ?line expect(10, noSuchName, 1, [{[1,3,7,1], 'NULL'}]), + ?line ?expect3(noSuchName, 1, [{[1,3,7,1], 'NULL'}]), gn([[tDescr2]]), - ?line expect(11, tooBig, 0, any), + ?line ?expect3(tooBig, 0, any), %% 4.1.3:2 gn([[tTooBig]]), io:format("We currently don't handle tooBig correct!!!\n"), -% ?line expect(20, tooBig, 0, [{[tTooBig], 'NULL'}]), - ?line expect(20, tooBig, 0, any), +% ?line ?expect3(tooBig, 0, [{[tTooBig], 'NULL'}]), + ?line ?expect3(tooBig, 0, any), %% 4.1.3:3 gn([[tGenErr1]]), % ?line expect(40, genErr, 1, [{[tGenErr1], 'NULL'}]), - ?line expect(40, genErr, 1, any), + ?line ?expect3(genErr, 1, any), gn([[tGenErr2]]), -% ?line expect(41, genErr, 1, [{[tGenErr2], 'NULL'}]), - ?line expect(41, genErr, 1, any), +% ?line ?expect3(genErr, 1, [{[tGenErr2], 'NULL'}]), + ?line ?expect3(genErr, 1, any), gn([[sysDescr], [tGenErr3]]), -% ?line expect(42, genErr, 2, [{[sysDescr], 'NULL'}, +% ?line ?expect3(genErr, 2, [{[sysDescr], 'NULL'}, % {[tGenErr3], 'NULL'}]). - ?line expect(42, genErr, 2, any). + ?line ?expect3(genErr, 2, any). v1_set_p() -> %% 4.1.5:1 s([{[1,3,7,0], i, 4}]), - ?line expect(10, noSuchName, 1, [{[1,3,7,0], 4}]), + ?line ?expect3(noSuchName, 1, [{[1,3,7,0], 4}]), s([{[tDescr,0], s, "outside mibview"}]), - ?line expect(11, noSuchName, 1, [{[tDescr,0], "outside mibview"}]), + ?line ?expect3(noSuchName, 1, [{[tDescr,0], "outside mibview"}]), s([{[tDescr3,0], s, "read-only"}]), - ?line expect(12, noSuchName, 1, [{[tDescr3,0], "read-only"}]), + ?line ?expect3(noSuchName, 1, [{[tDescr3,0], "read-only"}]), s([{[tDescr3], s, "noSuchObject"}]), - ?line expect(13, noSuchName, 1, [{[tDescr3], "noSuchObject"}]), + ?line ?expect3(noSuchName, 1, [{[tDescr3], "noSuchObject"}]), s([{[tDescr3,1], s, "noSuchInstance"}]), - ?line expect(14, noSuchName, 1, [{[tDescr3,1], "noSuchInstance"}]), + ?line ?expect3(noSuchName, 1, [{[tDescr3,1], "noSuchInstance"}]), s([{[tDescr2,0], s, "inconsistentName"}]), - ?line expect(15, noSuchName, 1, [{[tDescr2,0], "inconsistentName"}]), + ?line ?expect3(noSuchName, 1, [{[tDescr2,0], "inconsistentName"}]), %% 4.1.5:2 s([{[tDescr2, 0], i, 4}]), - ?line expect(20, badValue, 1, [{[tDescr2, 0], 4}]), + ?line ?expect3(badValue, 1, [{[tDescr2, 0], 4}]), s([{[tDescr2, 0], s, "badValue"}]), - ?line expect(21, badValue, 1, [{[tDescr2, 0], "badValue"}]), + ?line ?expect3(badValue, 1, [{[tDescr2, 0], "badValue"}]), %% 4.1.5:3 %% The standard is quite incorrect here. The resp pdu was too big. In @@ -2593,14 +3013,14 @@ v1_set_p() -> %% of the std-like original value. s([{[tTooBig, 0], s, ?tooBigStr}]), %% according to std: -% ?line expect(30, tooBig, 0, [{[tTooBig, 0], ?tooBigStr}]), - ?line expect(30, tooBig, 0, [{[tTooBig, 0], 'NULL'}]), +% ?line ?expect3(tooBig, 0, [{[tTooBig, 0], ?tooBigStr}]), + ?line ?expect3(tooBig, 0, [{[tTooBig, 0], 'NULL'}]), %% 4.1.5:4 s([{[tDescr2, 0], s, "is_set_ok_fail"}]), - ?line expect(40, genErr, 1, [{[tDescr2, 0], "is_set_ok_fail"}]), + ?line ?expect3(genErr, 1, [{[tDescr2, 0], "is_set_ok_fail"}]), s([{[tDescr2, 0], s, "commit_fail"}]), - ?line expect(41, genErr, 1, [{[tDescr2, 0], "commit_fail"}]). + ?line ?expect3(genErr, 1, [{[tDescr2, 0], "commit_fail"}]). %% Req. Test2 v2_proc() -> @@ -2616,183 +3036,183 @@ v2_get_p() -> %% 4.2.1:2 ?DBG("v2_get_p -> entry",[]), g([[test2]]), - ?line expect(10, [{[test2], noSuchObject}]), + ?line ?expect1([{[test2], noSuchObject}]), g([[tDescr]]), - ?line expect(11, [{[tDescr], noSuchObject}]), + ?line ?expect1([{[tDescr], noSuchObject}]), g([[tDescr4,0]]), - ?line expect(12, [{[tDescr4,0], noSuchObject}]), + ?line ?expect1([{[tDescr4,0], noSuchObject}]), g([[sysDescr, 0], [tDescr,0]]), % Outside mibview - ?line expect(13, [{[sysDescr,0], "Erlang SNMP agent"}, - {[tDescr,0], noSuchObject}]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}, + {[tDescr,0], noSuchObject}]), g([[tTable]]), - ?line expect(14, [{[tTable], noSuchObject}]), + ?line ?expect1([{[tTable], noSuchObject}]), g([[tEntry]]), - ?line expect(15, [{[tEntry], noSuchObject}]), + ?line ?expect1([{[tEntry], noSuchObject}]), %% 4.2.1:3 g([[tDescr2,0]]), %% instrum ret noSuchName!!! - ?line expect(20, [{[tDescr2,0], noSuchInstance}]), + ?line ?expect1([{[tDescr2,0], noSuchInstance}]), g([[tDescr3,0]]), - ?line expect(21, [{[tDescr3,0], noSuchInstance}]), + ?line ?expect1([{[tDescr3,0], noSuchInstance}]), g([[sysDescr,3]]), - ?line expect(22, [{[sysDescr, 3], noSuchInstance}]), + ?line ?expect1([{[sysDescr, 3], noSuchInstance}]), g([[tIndex,1]]), - ?line expect(23, [{[tIndex, 1], noSuchInstance}]), + ?line ?expect1([{[tIndex, 1], noSuchInstance}]), %% 4.2.1 - any other error: genErr g([[tGenErr1, 0]]), - ?line expect(30, genErr, 1, [{[tGenErr1, 0], 'NULL'}]), + ?line ?expect3(genErr, 1, [{[tGenErr1, 0], 'NULL'}]), g([[tGenErr2, 0]]), - ?line expect(31, genErr, 1, [{[tGenErr2, 0], 'NULL'}]), + ?line ?expect3(genErr, 1, [{[tGenErr2, 0], 'NULL'}]), g([[sysDescr, 0], [tGenErr3, 0]]), - ?line expect(32, genErr, 2, [{[sysDescr, 0], 'NULL'}, - {[tGenErr3, 0], 'NULL'}]), + ?line ?expect3(genErr, 2, [{[sysDescr, 0], 'NULL'}, + {[tGenErr3, 0], 'NULL'}]), %% 4.2.1 - tooBig g([[tTooBig, 0]]), - ?line expect(40, tooBig, 0, []). + ?line ?expect3(tooBig, 0, []). v2_get_next_p() -> %% 4.2.2:2 ?DBG("v2_get_next_p -> entry",[]), gn([[1,3,7,1]]), - ?line expect(10, [{[1,3,7,1], endOfMibView}]), + ?line ?expect1([{[1,3,7,1], endOfMibView}]), gn([[sysDescr], [1,3,7,1]]), - ?line expect(11, [{[sysDescr, 0], "Erlang SNMP agent"}, - {[1,3,7,1], endOfMibView}]), + ?line ?expect1([{[sysDescr, 0], "Erlang SNMP agent"}, + {[1,3,7,1], endOfMibView}]), gn([[tCnt2, 1]]), - ?line expect(12, [{[tCnt2,2], 100}]), + ?line ?expect1([{[tCnt2,2], 100}]), gn([[tCnt2, 2]]), - ?line expect(12, [{[tCnt2,2], endOfMibView}]), + ?line ?expect1([{[tCnt2,2], endOfMibView}]), %% 4.2.2 - any other error: genErr gn([[tGenErr1]]), - ?line expect(20, genErr, 1, [{[tGenErr1], 'NULL'}]), + ?line ?expect3(genErr, 1, [{[tGenErr1], 'NULL'}]), gn([[tGenErr2]]), - ?line expect(21, genErr, 1, [{[tGenErr2], 'NULL'}]), + ?line ?expect3(genErr, 1, [{[tGenErr2], 'NULL'}]), gn([[sysDescr], [tGenErr3]]), - ?line expect(22, genErr, 2, [{[sysDescr], 'NULL'}, - {[tGenErr3], 'NULL'}]), + ?line ?expect3(genErr, 2, [{[sysDescr], 'NULL'}, + {[tGenErr3], 'NULL'}]), %% 4.2.2 - tooBig gn([[tTooBig]]), - ?line expect(20, tooBig, 0, []). + ?line ?expect3(tooBig, 0, []). v2_get_bulk_p() -> %% 4.2.3 ?DBG("v2_get_bulk_p -> entry",[]), gb(1, 1, []), - ?line expect(10, []), + ?line ?expect1([]), gb(-1, 1, []), - ?line expect(11, []), + ?line ?expect1([]), gb(-1, -1, []), - ?line expect(12, []), + ?line ?expect1([]), gb(-1, -1, []), - ?line expect(13, []), + ?line ?expect1([]), gb(2, 0, [[sysDescr], [1,3,7,1]]), - ?line expect(14, [{[sysDescr, 0], "Erlang SNMP agent"}, - {[1,3,7,1], endOfMibView}]), + ?line ?expect1([{[sysDescr, 0], "Erlang SNMP agent"}, + {[1,3,7,1], endOfMibView}]), gb(1, 2, [[sysDescr], [1,3,7,1]]), - ?line expect(15, [{[sysDescr, 0], "Erlang SNMP agent"}, - {[1,3,7,1], endOfMibView}]), + ?line ?expect1([{[sysDescr, 0], "Erlang SNMP agent"}, + {[1,3,7,1], endOfMibView}]), gb(0, 2, [[sysDescr], [1,3,7,1]]), - ?line expect(16, [{[sysDescr, 0], "Erlang SNMP agent"}, - {[1,3,7,1], endOfMibView}, - {[sysObjectID, 0], [1,2,3]}, - {[1,3,7,1], endOfMibView}]), + ?line ?expect1([{[sysDescr, 0], "Erlang SNMP agent"}, + {[1,3,7,1], endOfMibView}, + {[sysObjectID, 0], [1,2,3]}, + {[1,3,7,1], endOfMibView}]), gb(2, 2, [[sysDescr], [1,3,7,1], [sysDescr], [1,3,7,1]]), - ?line expect(17, [{[sysDescr, 0], "Erlang SNMP agent"}, - {[1,3,7,1], endOfMibView}, - {[sysDescr, 0], "Erlang SNMP agent"}, - {[1,3,7,1], endOfMibView}, - {[sysObjectID, 0], [1,2,3]}, - {[1,3,7,1], endOfMibView}]), + ?line ?expect1([{[sysDescr, 0], "Erlang SNMP agent"}, + {[1,3,7,1], endOfMibView}, + {[sysDescr, 0], "Erlang SNMP agent"}, + {[1,3,7,1], endOfMibView}, + {[sysObjectID, 0], [1,2,3]}, + {[1,3,7,1], endOfMibView}]), gb(1, 2, [[sysDescr], [sysDescr], [tTooBig]]), - ?line expect(18, [{[sysDescr, 0], "Erlang SNMP agent"}, - {[sysDescr, 0], "Erlang SNMP agent"}]), + ?line ?expect1([{[sysDescr, 0], "Erlang SNMP agent"}, + {[sysDescr, 0], "Erlang SNMP agent"}]), gb(1,12, [[tDescr2], [sysDescr]]), % next one after tDescr2 is tTooBig. - ?line expect(19, []), + ?line ?expect1([]), gb(2,2, [[sysDescr], [sysObjectID], [tGenErr1], [sysDescr]]), - ?line expect(20, genErr, 3, [{[sysDescr], 'NULL'}, - {[sysObjectID], 'NULL'}, - {[tGenErr1], 'NULL'}, - {[sysDescr], 'NULL'}]), + ?line ?expect3(genErr, 3, [{[sysDescr], 'NULL'}, + {[sysObjectID], 'NULL'}, + {[tGenErr1], 'NULL'}, + {[sysDescr], 'NULL'}]), gb(0, 2, [[tCnt2, 1]]), - ?line expect(21, [{[tCnt2,2], 100}, - {[tCnt2,2], endOfMibView}]). + ?line ?expect1([{[tCnt2,2], 100}, + {[tCnt2,2], endOfMibView}]). v2_set_p() -> %% 4.2.5:1 ?DBG("v2_set_p -> entry",[]), s([{[1,3,7,0], i, 4}]), - ?line expect(10, noAccess, 1, [{[1,3,7,0], 4}]), + ?line ?expect3(noAccess, 1, [{[1,3,7,0], 4}]), s([{[tDescr,0], s, "outside mibview"}]), - ?line expect(11, noAccess, 1, [{[tDescr,0], "outside mibview"}]), + ?line ?expect3(noAccess, 1, [{[tDescr,0], "outside mibview"}]), %% 4.2.5:2 s([{[1,3,6,1,0], s, "noSuchObject"}]), - ?line expect(20, notWritable, 1, [{[1,3,6,1,0], "noSuchObject"}]), + ?line ?expect3(notWritable, 1, [{[1,3,6,1,0], "noSuchObject"}]), %% 4.2.5:3 s([{[tDescr2, 0], i, 4}]), - ?line expect(30, wrongType, 1, [{[tDescr2, 0], 4}]), + ?line ?expect3(wrongType, 1, [{[tDescr2, 0], 4}]), s([{[tDescr2, 0], s, "badValue"}]), - ?line expect(31, badValue, 1, [{[tDescr2, 0], "badValue"}]), + ?line ?expect3(badValue, 1, [{[tDescr2, 0], "badValue"}]), %% 4.2.5:4 s([{[tStr, 0], s, ""}]), - ?line expect(40, wrongLength, 1, [{[tStr, 0], ""}]), + ?line ?expect3(wrongLength, 1, [{[tStr, 0], ""}]), s([{[tStr, 0], s, "12345"}]), - ?line expect(40, wrongLength, 1, [{[tStr, 0], "12345"}]), + ?line ?expect3(wrongLength, 1, [{[tStr, 0], "12345"}]), %% 4.2.5:5 - N/A %% 4.2.5:6 s([{[tInt1, 0], i, 0}]), - ?line expect(60, wrongValue, 1, [{[tInt1, 0], 0}]), + ?line ?expect3(wrongValue, 1, [{[tInt1, 0], 0}]), s([{[tInt1, 0], i, 5}]), - ?line expect(61, wrongValue, 1, [{[tInt1, 0], 5}]), + ?line ?expect3(wrongValue, 1, [{[tInt1, 0], 5}]), s([{[tInt2, 0], i, 0}]), - ?line expect(62, wrongValue, 1, [{[tInt2, 0], 0}]), + ?line ?expect3(wrongValue, 1, [{[tInt2, 0], 0}]), s([{[tInt2, 0], i, 5}]), - ?line expect(63, wrongValue, 1, [{[tInt2, 0], 5}]), + ?line ?expect3(wrongValue, 1, [{[tInt2, 0], 5}]), s([{[tInt3, 0], i, 5}]), - ?line expect(64, wrongValue, 1, [{[tInt3, 0], 5}]), + ?line ?expect3(wrongValue, 1, [{[tInt3, 0], 5}]), %% 4.2.5:7 s([{[tDescrX, 1, 1], s, "noCreation"}]), - ?line expect(70, noCreation, 1, [{[tDescrX, 1, 1], "noCreation"}]), + ?line ?expect3(noCreation, 1, [{[tDescrX, 1, 1], "noCreation"}]), %% 4.2.5:8 s([{[tDescrX, 1, 2], s, "inconsistentName"}]), - ?line expect(80, inconsistentName, 1, - [{[tDescrX, 1, 2], "inconsistentName"}]), + ?line ?expect3(inconsistentName, 1, + [{[tDescrX, 1, 2], "inconsistentName"}]), %% 4.2.5:9 s([{[tCnt, 1, 2], i, 5}]), - ?line expect(90, notWritable, 1, [{[tCnt, 1, 2], 5}]), + ?line ?expect3(notWritable, 1, [{[tCnt, 1, 2], 5}]), s([{[tDescr3,0], s, "read-only"}]), - ?line expect(90, notWritable, 1, [{[tDescr3,0], "read-only"}]), + ?line ?expect3(notWritable, 1, [{[tDescr3,0], "read-only"}]), %% 4.2.5:10 s([{[tDescr2,0], s, "inconsistentValue"}]), - ?line expect(100, inconsistentValue, 1, - [{[tDescr2,0], "inconsistentValue"}]), + ?line ?expect3(inconsistentValue, 1, + [{[tDescr2,0], "inconsistentValue"}]), %% 4.2.5:11 s([{[tDescr2,0], s, "resourceUnavailable"}]), - ?line expect(110, resourceUnavailable, 1, - [{[tDescr2,0],"resourceUnavailable"}]), + ?line ?expect3(resourceUnavailable, 1, + [{[tDescr2,0],"resourceUnavailable"}]), %% 4.2.5:12 s([{[tDescr2, 0], s, "is_set_ok_fail"}]), - ?line expect(120, genErr, 1, [{[tDescr2, 0], "is_set_ok_fail"}]). + ?line ?expect3(genErr, 1, [{[tDescr2, 0], "is_set_ok_fail"}]). %% commitFailed and undoFailed is tested by the 'undo' case. @@ -2807,101 +3227,101 @@ table_test() -> Key1c4 = [intCommunityAccess,get(mip),is("public")], EndKey = [intCommunityEntry,[9],get(mip),is("public")], gn([[intCommunityEntry]]), - ?line expect(7, [{Key1c3, 2}]), + ?line ?expect1([{Key1c3, 2}]), gn([[intCommunityTable]]), - ?line expect(71, [{Key1c3, 2}]), + ?line ?expect1([{Key1c3, 2}]), gn([[community]]), - ?line expect(72, [{Key1c3, 2}]), + ?line ?expect1([{Key1c3, 2}]), gn([[otpSnmpeaMIB]]), - ?line expect(73, [{Key1c3, 2}]), + ?line ?expect1([{Key1c3, 2}]), gn([[ericsson]]), - ?line expect(74, [{Key1c3, 2}]), + ?line ?expect1([{Key1c3, 2}]), gn([Key1c3]), - ?line expect(8, [{Key2c3, 2}]), + ?line ?expect1([{Key2c3, 2}]), gn([Key2c3]), - ?line expect(9, [{Key1c4, 2}]), + ?line ?expect1([{Key1c4, 2}]), gn([EndKey]), AgentIp = [intAgentIpAddress,0], - ?line expect(10, [{AgentIp, any}]), + ?line ?expect1([{AgentIp, any}]), g([Key1c3]), - ?line expect(11, [{Key1c3, 2}]), + ?line ?expect1([{Key1c3, 2}]), g([EndKey]), - ?line ?v1_2(expect(12, noSuchName, 1, any), - expect(12, [{EndKey, noSuchObject}])), + ?line ?v1_2(?expect3(noSuchName, 1, any), + ?expect1([{EndKey, noSuchObject}])), io:format("Testing row creation/deletion on communityTable...~n"), NewKeyc3 = [intCommunityViewIndex,get(mip),is("test")], NewKeyc4 = [intCommunityAccess,get(mip),is("test")], NewKeyc5 = [intCommunityStatus,get(mip),is("test")], s([{NewKeyc5, ?createAndGo}]), - ?line expect(14, ?v1_2(badValue, inconsistentValue), 1,any), + ?line ?expect3(?v1_2(badValue, inconsistentValue), 1, any), s([{NewKeyc5, ?createAndGo}, {NewKeyc3, 2}, {NewKeyc4, 2}]), - ?line expect(15, [{NewKeyc5, ?createAndGo},{NewKeyc3, 2}, {NewKeyc4, 2}]), + ?line ?expect1([{NewKeyc5, ?createAndGo},{NewKeyc3, 2}, {NewKeyc4, 2}]), g([NewKeyc4]), - ?line expect(16, [{NewKeyc4, 2}]), + ?line ?expect1([{NewKeyc4, 2}]), s([{NewKeyc5, ?destroy}]), - ?line expect(17, [{NewKeyc5, ?destroy}]), + ?line ?expect1([{NewKeyc5, ?destroy}]), s([{NewKeyc4, 2}]), - ?line expect(18, ?v1_2(noSuchName, inconsistentName), 1,[{NewKeyc4, 2}]), + ?line ?expect3(?v1_2(noSuchName, inconsistentName), 1, [{NewKeyc4, 2}]), s([{NewKeyc5, ?createAndWait}]), - ?line expect(19, [{NewKeyc5, ?createAndWait}]), + ?line ?expect1([{NewKeyc5, ?createAndWait}]), g([NewKeyc5]), - ?line expect(20, [{NewKeyc5, ?notReady}]), + ?line ?expect1([{NewKeyc5, ?notReady}]), s([{NewKeyc4, 2}]), - ?line expect(21, [{NewKeyc4, 2}]), + ?line ?expect1([{NewKeyc4, 2}]), g([NewKeyc5]), - ?line expect(22, [{NewKeyc5, ?notReady}]), + ?line ?expect1([{NewKeyc5, ?notReady}]), s([{NewKeyc3, 2}]), - ?line expect(23, [{NewKeyc3, 2}]), + ?line ?expect1([{NewKeyc3, 2}]), g([NewKeyc5]), - ?line expect(24, [{NewKeyc5, ?notInService}]), + ?line ?expect1([{NewKeyc5, ?notInService}]), s([{NewKeyc5, ?active}]), - ?line expect(25, [{NewKeyc5, ?active}]), + ?line ?expect1([{NewKeyc5, ?active}]), s([{NewKeyc5, ?destroy}]), - ?line expect(26, [{NewKeyc5, ?destroy}]), + ?line ?expect1([{NewKeyc5, ?destroy}]), s([{NewKeyc3, 3}]), - ?line expect(27, ?v1_2(noSuchName, inconsistentName), 1,[{NewKeyc3, 3}]), - otp_1128(). + ?line ?expect3(?v1_2(noSuchName, inconsistentName), 1, [{NewKeyc3, 3}]), + otp_1128_test(). %% Req. system group simple_standard_test() -> ?DBG("simple_standard_test -> entry",[]), gn([[1,1]]), - ?line expect(1, [{[sysDescr,0], "Erlang SNMP agent"}]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]), gn([[1,3]]), - ?line expect(11, [{[sysDescr,0], "Erlang SNMP agent"}]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]), gn([[1,3,6]]), - ?line expect(12, [{[sysDescr,0], "Erlang SNMP agent"}]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]), gn([[1,3,6,1]]), - ?line expect(13, [{[sysDescr,0], "Erlang SNMP agent"}]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]), gn([[1,3,6,1,2]]), - ?line expect(14, [{[sysDescr,0], "Erlang SNMP agent"}]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]), gn([[1,3,6,1,2,1]]), - ?line expect(15, [{[sysDescr,0], "Erlang SNMP agent"}]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]), gn([[1,3,6,1,2,1,1]]), - ?line expect(16, [{[sysDescr,0], "Erlang SNMP agent"}]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]), gn([[sysDescr]]), - ?line expect(17, [{[sysDescr,0], "Erlang SNMP agent"}]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]), g([[sysDescr,0]]), - ?line expect(2, [{[sysDescr,0], "Erlang SNMP agent"}]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}]), g([[sysDescr]]), - ?line ?v1_2(expect(3, noSuchName, 1, any), - expect(3, [{[sysDescr], noSuchObject}])), + ?line ?v1_2(?expect3(noSuchName, 1, any), + ?expect1([{[sysDescr], noSuchObject}])), g([[1,6,7,0]]), - ?line ?v1_2(expect(41, noSuchName, 1, any), - expect(3, [{[1,6,7,0], noSuchObject}])), + ?line ?v1_2(?expect3(noSuchName, 1, any), + ?expect1([{[1,6,7,0], noSuchObject}])), gn([[1,13]]), - ?line ?v1_2(expect(4, noSuchName,1, any), - expect(4, [{[1,13], endOfMibView}])), + ?line ?v1_2(?expect3(noSuchName,1, any), + ?expect1([{[1,13], endOfMibView}])), s([{[sysLocation, 0], "new_value"}]), - ?line expect(5, [{[sysLocation, 0], "new_value"}]), + ?line ?expect1([{[sysLocation, 0], "new_value"}]), g([[sysLocation, 0]]), - ?line expect(6, [{[sysLocation, 0], "new_value"}]), + ?line ?expect1([{[sysLocation, 0], "new_value"}]), io:format("Testing noSuchName and badValue...~n"), s([{[sysServices,0], 3}]), - ?line expect(61, ?v1_2(noSuchName, notWritable), 1, any), + ?line ?expect3(?v1_2(noSuchName, notWritable), 1, any), s([{[sysLocation, 0], i, 3}]), - ?line expect(62, ?v1_2(badValue, wrongType), 1, any), + ?line ?expect3(?v1_2(badValue, wrongType), 1, any), ?DBG("simple_standard_test -> done",[]), ok. @@ -2918,7 +3338,7 @@ db_notify_client(Config) when is_list(Config) -> snmpa_local_db:verbosity(trace), Self = self(), ?DBG("db_notify_client -> register self (~p) notify client", [Self]), - snmpa_local_db:register_notify_client(self(),?MODULE), + snmpa_local_db:register_notify_client(Self, ?MODULE), %% This call (to the manager) will issue to set operations, so %% we expect to receive to notify(insert) calls. @@ -2943,7 +3363,7 @@ db_notify_client(Config) when is_list(Config) -> end, ?DBG("db_notify_client -> unregister self (~p) notify client", [Self]), - snmpa_local_db:unregister_notify_client(self()), + snmpa_local_db:unregister_notify_client(Self), ?DBG("db_notify_client -> minimize verbosity", []), snmpa_local_db:verbosity(silence), @@ -2955,12 +3375,13 @@ db_notify_client(Config) when is_list(Config) -> db_notify_client_test() -> ?DBG("set first new sysLocation",[]), s([{[sysLocation, 0], "new_value"}]), - ?line expect(5, [{[sysLocation, 0], "new_value"}]), + ?line ?expect1([{[sysLocation, 0], "new_value"}]), ?DBG("set second new sysLocation",[]), s([{[sysLocation, 0], "new_value"}]), - ?line expect(5, [{[sysLocation, 0], "new_value"}]). + ?line ?expect1([{[sysLocation, 0], "new_value"}]). +%% Callback function notify(Pid, What) -> ?DBG("notify(~p,~p) -> called",[Pid,What]), Pid ! {db_notify_test_reply, What}. @@ -2976,24 +3397,23 @@ big_test() -> ?DBG("big_test -> testing simple next/get/set @ subagent...",[]), gn([[klas1]]), - ?line expect(1, [{[fname,0], ""}]), + ?line ?expect1([{[fname,0], ""}]), g([[fname,0]]), - ?line expect(2, [{[fname,0], ""}]), + ?line ?expect1([{[fname,0], ""}]), s([{[fname,0], s, "test set"}]), - ?line expect(3, [{[fname,0], "test set"}]), + ?line ?expect1([{[fname,0], "test set"}]), g([[fname,0]]), - ?line expect(4, [{[fname,0], "test set"}]), + ?line ?expect1([{[fname,0], "test set"}]), ?DBG("big_test -> " "testing next from last instance in master to subagent...",[]), gn([[?v1_2(sysServices, sysORLastChange),0]]), - ?line expect(5, [{[fname,0], "test set"}]), - gn([[1,1], - [?v1_2(sysServices, sysORLastChange),0]]), - ?line expect(51, [{[sysDescr,0], "Erlang SNMP agent"}, - {[fname,0], "test set"}]), + ?line ?expect1([{[fname,0], "test set"}]), + gn([[1,1], [?v1_2(sysServices, sysORLastChange),0]]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}, + {[fname,0], "test set"}]), s([{[fname,0], s, ""}]), - ?line expect(52, [{[fname,0], ""}]), + ?line ?expect1([{[fname,0], ""}]), table_test(), @@ -3001,43 +3421,43 @@ big_test() -> _FTab = [friendsEntry], s([{[friendsEntry, [2, 3]], s, "kompis3"}, {[friendsEntry, [3, 3]], i, ?createAndGo}]), - ?line expect(6, [{[friendsEntry, [2, 3]], "kompis3"}, - {[friendsEntry, [3, 3]], ?createAndGo}]), + ?line ?expect1([{[friendsEntry, [2, 3]], "kompis3"}, + {[friendsEntry, [3, 3]], ?createAndGo}]), g([[friendsEntry, [2, 3]], [friendsEntry, [3, 3]]]), - ?line expect(7, [{[friendsEntry, [2, 3]], "kompis3"}, - {[friendsEntry, [3, 3]], ?active}]), + ?line ?expect1([{[friendsEntry, [2, 3]], "kompis3"}, + {[friendsEntry, [3, 3]], ?active}]), s([{[friendsEntry, [3, 3]], i, ?destroy}]), - ?line expect(8, [{[friendsEntry, [3, 3]], ?destroy}]), + ?line ?expect1([{[friendsEntry, [3, 3]], ?destroy}]), - otp_1131(), + otp_1131_test(), ?DBG("big_test -> adding two rows in subagent table with special INDEX", []), s([{[kompissEntry, [1, 3]], s, "kompis3"}, {[kompissEntry, [2, 3]], i, ?createAndGo}]), - ?line expect(9, [{[kompissEntry, [1, 3]], "kompis3"}, - {[kompissEntry, [2, 3]], ?createAndGo}]), + ?line ?expect1([{[kompissEntry, [1, 3]], "kompis3"}, + {[kompissEntry, [2, 3]], ?createAndGo}]), g([[kompissEntry, [1, 3]], [kompissEntry, [2, 3]]]), - ?line expect(10, [{[kompissEntry, [1, 3]], "kompis3"}, - {[kompissEntry, [2, 3]], ?active}]), + ?line ?expect1([{[kompissEntry, [1, 3]], "kompis3"}, + {[kompissEntry, [2, 3]], ?active}]), gn([[kompissEntry, [1]], [kompissEntry, [2]]]), - ?line expect(11, [{[kompissEntry, [1, 3]], "kompis3"}, - {[kompissEntry, [2, 3]], ?active}]), + ?line ?expect1([{[kompissEntry, [1, 3]], "kompis3"}, + {[kompissEntry, [2, 3]], ?active}]), s([{[kompissEntry, [1, 2]], s, "kompis3"}, {[kompissEntry, [2, 2]], i, ?createAndGo}]), - ?line expect(12, [{[kompissEntry, [1, 2]], "kompis3"}, - {[kompissEntry, [2, 2]], ?createAndGo}]), + ?line ?expect1([{[kompissEntry, [1, 2]], "kompis3"}, + {[kompissEntry, [2, 2]], ?createAndGo}]), gn([[kompissEntry, [1, 1]], [kompissEntry, [2, 1]]]), - ?line expect(13, [{[kompissEntry, [1, 2]], "kompis3"}, - {[kompissEntry, [2, 2]], ?active}]), + ?line ?expect1([{[kompissEntry, [1, 2]], "kompis3"}, + {[kompissEntry, [2, 2]], ?active}]), s([{[kompissEntry, [2, 3]], i, ?destroy}]), - ?line expect(14, [{[kompissEntry, [2, 3]], ?destroy}]), + ?line ?expect1([{[kompissEntry, [2, 3]], ?destroy}]), s([{[kompissEntry, [2, 2]], i, ?destroy}]), - ?line expect(15, [{[kompissEntry, [2, 2]], ?destroy}]), + ?line ?expect1([{[kompissEntry, [2, 2]], ?destroy}]), ?DBG("big_test -> done",[]), ok. @@ -3048,23 +3468,22 @@ big_test_2() -> ?P1("Testing simple next/get/set @ subagent (2)..."), gn([[klas2]]), - ?line expect(1, [{[fname2,0], ""}]), + ?line ?expect1([{[fname2,0], ""}]), g([[fname2,0]]), - ?line expect(2, [{[fname2,0], ""}]), + ?line ?expect1([{[fname2,0], ""}]), s([{[fname2,0], s, "test set"}]), - ?line expect(3, [{[fname2,0], "test set"}]), + ?line ?expect1([{[fname2,0], "test set"}]), g([[fname2,0]]), - ?line expect(4, [{[fname2,0], "test set"}]), + ?line ?expect1([{[fname2,0], "test set"}]), - otp_1298(), + otp_1298_test(), ?P1("Testing next from last object in master to subagent (2)..."), gn([[?v1_2(sysServices, sysORLastChange),0]]), - ?line expect(5, [{[fname2,0], "test set"}]), - gn([[1,1], - [?v1_2(sysServices, sysORLastChange),0]]), - ?line expect(51, [{[sysDescr,0], "Erlang SNMP agent"}, - {[fname2,0], "test set"}]), + ?line ?expect1([{[fname2,0], "test set"}]), + gn([[1,1], [?v1_2(sysServices, sysORLastChange),0]]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}, + {[fname2,0], "test set"}]), table_test(), @@ -3072,40 +3491,40 @@ big_test_2() -> _FTab = [friendsEntry2], s([{[friendsEntry2, [2, 3]], s, "kompis3"}, {[friendsEntry2, [3, 3]], i, ?createAndGo}]), - ?line expect(6, [{[friendsEntry2, [2, 3]], "kompis3"}, - {[friendsEntry2, [3, 3]], ?createAndGo}]), + ?line ?expect1([{[friendsEntry2, [2, 3]], "kompis3"}, + {[friendsEntry2, [3, 3]], ?createAndGo}]), g([[friendsEntry2, [2, 3]], [friendsEntry2, [3, 3]]]), - ?line expect(7, [{[friendsEntry2, [2, 3]], "kompis3"}, - {[friendsEntry2, [3, 3]], ?active}]), + ?line ?expect1([{[friendsEntry2, [2, 3]], "kompis3"}, + {[friendsEntry2, [3, 3]], ?active}]), s([{[friendsEntry2, [3, 3]], i, ?destroy}]), - ?line expect(8, [{[friendsEntry2, [3, 3]], ?destroy}]), + ?line ?expect1([{[friendsEntry2, [3, 3]], ?destroy}]), ?P1("Adding two rows in subagent table with special INDEX (2)"), s([{[kompissEntry2, [1, 3]], s, "kompis3"}, {[kompissEntry2, [2, 3]], i, ?createAndGo}]), - ?line expect(9, [{[kompissEntry2, [1, 3]], "kompis3"}, - {[kompissEntry2, [2, 3]], ?createAndGo}]), + ?line ?expect1([{[kompissEntry2, [1, 3]], "kompis3"}, + {[kompissEntry2, [2, 3]], ?createAndGo}]), g([[kompissEntry2, [1, 3]], [kompissEntry2, [2, 3]]]), - ?line expect(10, [{[kompissEntry2, [1, 3]], "kompis3"}, - {[kompissEntry2, [2, 3]], ?active}]), + ?line ?expect1([{[kompissEntry2, [1, 3]], "kompis3"}, + {[kompissEntry2, [2, 3]], ?active}]), gn([[kompissEntry2, [1]], [kompissEntry2, [2]]]), - ?line expect(11, [{[kompissEntry2, [1, 3]], "kompis3"}, - {[kompissEntry2, [2, 3]], ?active}]), + ?line ?expect1([{[kompissEntry2, [1, 3]], "kompis3"}, + {[kompissEntry2, [2, 3]], ?active}]), s([{[kompissEntry2, [1, 2]], s, "kompis3"}, {[kompissEntry2, [2, 2]], i, ?createAndGo}]), - ?line expect(12, [{[kompissEntry2, [1, 2]], "kompis3"}, - {[kompissEntry2, [2, 2]], ?createAndGo}]), + ?line ?expect1([{[kompissEntry2, [1, 2]], "kompis3"}, + {[kompissEntry2, [2, 2]], ?createAndGo}]), gn([[kompissEntry2, [1, 1]], [kompissEntry2, [2, 1]]]), - ?line expect(13, [{[kompissEntry2, [1, 2]], "kompis3"}, - {[kompissEntry2, [2, 2]], ?active}]), + ?line ?expect1([{[kompissEntry2, [1, 2]], "kompis3"}, + {[kompissEntry2, [2, 2]], ?active}]), s([{[kompissEntry2, [2, 3]], i, ?destroy}]), - ?line expect(14, [{[kompissEntry2, [2, 3]], ?destroy}]), + ?line ?expect1([{[kompissEntry2, [2, 3]], ?destroy}]), s([{[kompissEntry2, [2, 2]], i, ?destroy}]), - ?line expect(15, [{[kompissEntry2, [2, 2]], ?destroy}]), + ?line ?expect1([{[kompissEntry2, [2, 2]], ?destroy}]), ok. %% Req. Test1 @@ -3114,26 +3533,26 @@ multi_threaded_test() -> g([[multiStr,0]]), Pid = get_multi_pid(), g([[sysUpTime,0]]), - ?line expect(1, [{[sysUpTime,0], any}]), + ?line ?expect1([{[sysUpTime,0], any}]), s([{[sysLocation, 0], s, "pelle"}]), - ?line expect(2, [{[sysLocation, 0], "pelle"}]), + ?line ?expect1([{[sysLocation, 0], "pelle"}]), Pid ! continue, - ?line expect(3, [{[multiStr,0], "ok"}]), + ?line ?expect1([{[multiStr,0], "ok"}]), s([{[multiStr, 0], s, "block"}]), Pid2 = get_multi_pid(), g([[sysUpTime,0]]), - ?line expect(4, [{[sysUpTime,0], any}]), + ?line ?expect1([{[sysUpTime,0], any}]), g([[multiStr,0]]), Pid3 = get_multi_pid(), g([[sysUpTime,0]]), - ?line expect(5, [{[sysUpTime,0], any}]), + ?line ?expect1([{[sysUpTime,0], any}]), s([{[sysLocation, 0], s, "kalle"}]), Pid3 ! continue, - ?line expect(6, [{[multiStr,0], "ok"}]), + ?line ?expect1([{[multiStr,0], "ok"}]), Pid2 ! continue, - ?line expect(7, [{[multiStr,0], "block"}]), - ?line expect(8, [{[sysLocation,0], "kalle"}]). + ?line ?expect1([{[multiStr,0], "block"}]), + ?line ?expect1([{[sysLocation,0], "kalle"}]). %% Req. Test1, TestTrapv2 mt_trap_test(MA) -> @@ -3141,9 +3560,8 @@ mt_trap_test(MA) -> ?DBG("mt_trap_test(01) -> issue testTrapv22 (standard trap)", []), snmpa:send_trap(MA, testTrapv22, "standard trap"), ?DBG("mt_trap_test(02) -> await v2trap", []), - ?line expect(mt_trap_test_1, v2trap, - [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?system ++ [0,1]}]), + ?line ?expect2(v2trap, [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?system ++ [0,1]}]), ?DBG("mt_trap_test(03) -> issue mtTrap (standard trap)", []), snmpa:send_trap(MA, mtTrap, "standard trap"), @@ -3152,21 +3570,21 @@ mt_trap_test(MA) -> g([[sysUpTime,0]]), ?DBG("mt_trap_test(06) -> await sysUpTime", []), - ?line expect(mt_trap_test_2, [{[sysUpTime,0], any}]), + ?line ?expect1([{[sysUpTime,0], any}]), ?DBG("mt_trap_test(07) -> issue testTrapv22 (standard trap)", []), snmpa:send_trap(MA, testTrapv22, "standard trap"), ?DBG("mt_trap_test(08) -> await v2trap", []), - ?line expect(mt_trap_test_3, v2trap, - [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?system ++ [0,1]}]), + ?line ?expect2(v2trap, + [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?system ++ [0,1]}]), ?DBG("mt_trap_test(09) -> send continue to multi-pid", []), Pid ! continue, ?DBG("mt_trap_test(10) -> await v2trap", []), - ?line expect(mt_trap_test_4, v2trap, [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?testTrap ++ [2]}, - {[multiStr,0], "ok"}]), + ?line ?expect2(v2trap, [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?testTrap ++ [2]}, + {[multiStr,0], "ok"}]), ?DBG("mt_trap_test(11) -> done", []), ok. @@ -3187,26 +3605,26 @@ types_v2_test() -> ?P1("Testing v2 types..."), s([{[bits1,0], 2#10}]), - ?line expect(1, [{[bits1,0], ?str(2#10)}]), + ?line ?expect1([{[bits1,0], ?str(2#10)}]), g([[bits1,0]]), - ?line expect(2, [{[bits1,0], ?str(2#101)}]), + ?line ?expect1([{[bits1,0], ?str(2#101)}]), s([{[bits2,0], 2#11000000110}]), - ?line expect(3, [{[bits2,0], ?str(2#11000000110)}]), + ?line ?expect1([{[bits2,0], ?str(2#11000000110)}]), g([[bits2,0]]), - ?line expect(4, [{[bits2,0], ?str(2#11000000110)}]), + ?line ?expect1([{[bits2,0], ?str(2#11000000110)}]), g([[bits3,0]]), - ?line expect(50, genErr, 1, any), + ?line ?expect3(genErr, 1, any), g([[bits4,0]]), - ?line expect(51, genErr, 1, any), + ?line ?expect3(genErr, 1, any), s([{[bits1,0], s, [2#10]}]), - ?line expect(6, ?v1_2(badValue, wrongValue), 1, any), + ?line ?expect3(?v1_2(badValue, wrongValue), 1, any), s([{[bits2,0], 2#11001001101010011}]), - ?line expect(7, ?v1_2(badValue, wrongValue), 1, any). + ?line ?expect3(?v1_2(badValue, wrongValue), 1, any). %% Req. Test1 @@ -3214,64 +3632,63 @@ implied_test(MA) -> ?LOG("implied_test -> start",[]), ?P1("Testing IMPLIED..."), - snmpa:verbosity(MA,trace), - snmpa:verbosity(MA,trace), + snmpa:verbosity(MA, trace), %% Create two rows, check that they are get-nexted in correct order. Idx1 = "apa", Idx2 = "qq", ?DBG("implied_test -> (send) create row 1 '~s' in table 1",[Idx1]), s([{[testStatus, Idx1], i, ?createAndGo}, {[testDescr, Idx1],s,"row 1"}]), - ?line expect(1, [{[testStatus, Idx1], ?createAndGo}, - {[testDescr, Idx1], "row 1"}]), + ?line ?expect1([{[testStatus, Idx1], ?createAndGo}, + {[testDescr, Idx1], "row 1"}]), ?DBG("implied_test -> (send) create row 2 '~s' in table 1",[Idx2]), s([{[testStatus, Idx2], i, ?createAndGo}, {[testDescr, Idx2],s,"row 2"}]), - ?line expect(2, [{[testStatus, Idx2], ?createAndGo}, - {[testDescr, Idx2], "row 2"}]), + ?line ?expect1([{[testStatus, Idx2], ?createAndGo}, + {[testDescr, Idx2], "row 2"}]), ?DBG("implied_test -> get-next(testDescr)",[]), gn([[testDescr]]), - ?line expect(3, [{[testDescr,Idx1], "row 1"}]), + ?line ?expect1([{[testDescr,Idx1], "row 1"}]), ?DBG("implied_test -> get-next(testDescr) of row 1",[]), gn([[testDescr,Idx1]]), - ?line expect(4, [{[testDescr,Idx2], "row 2"}]), + ?line ?expect1([{[testDescr,Idx2], "row 2"}]), % Delete the rows ?DBG("implied_test -> (send) delete row 1 '~s' from table 1",[Idx1]), s([{[testStatus, Idx1], i, ?destroy}]), - ?line expect(5, [{[testStatus, Idx1], ?destroy}]), + ?line ?expect1([{[testStatus, Idx1], ?destroy}]), ?DBG("implied_test -> (send) delete row 2 '~s' from table 1",[Idx2]), s([{[testStatus, Idx2], i, ?destroy}]), - ?line expect(6, [{[testStatus, Idx2], ?destroy}]), + ?line ?expect1([{[testStatus, Idx2], ?destroy}]), %% Try the same in other table Idx3 = [1, "apa"], Idx4 = [1, "qq"], ?DBG("implied_test -> (send) create row 1 '~s' in table 2",[Idx3]), s([{[testStatus2, Idx3], i, ?createAndGo}, {[testDescr2,Idx3],s,"row 1"}]), - ?line expect(1, [{[testStatus2, Idx3], ?createAndGo}, - {[testDescr2, Idx3], "row 1"}]), + ?line ?expect1([{[testStatus2, Idx3], ?createAndGo}, + {[testDescr2, Idx3], "row 1"}]), ?DBG("implied_test -> (send) create row 2 '~s' in table 2",[Idx4]), s([{[testStatus2, Idx4], i, ?createAndGo}, {[testDescr2,Idx4],s,"row 2"}]), - ?line expect(2, [{[testStatus2, Idx4], ?createAndGo}, - {[testDescr2, Idx4], "row 2"}]), + ?line ?expect1([{[testStatus2, Idx4], ?createAndGo}, + {[testDescr2, Idx4], "row 2"}]), ?DBG("implied_test -> get-next(testDescr2)",[]), gn([[testDescr2]]), - ?line expect(3, [{[testDescr2,Idx3], "row 1"}]), + ?line ?expect1([{[testDescr2,Idx3], "row 1"}]), ?DBG("implied_test -> get-next(testDescr2) of row 1",[]), gn([[testDescr2,Idx3]]), - ?line expect(4, [{[testDescr2,Idx4], "row 2"}]), + ?line ?expect1([{[testDescr2,Idx4], "row 2"}]), % Delete the rows ?DBG("implied_test -> (send) delete row 1 '~s' from table 2",[Idx3]), s([{[testStatus2, Idx3], i, ?destroy}]), - ?line expect(5, [{[testStatus2, Idx3], ?destroy}]), + ?line ?expect1([{[testStatus2, Idx3], ?destroy}]), ?DBG("implied_test -> (send) delete row 2 '~s' from table 2",[Idx4]), s([{[testStatus2, Idx4], i, ?destroy}]), - ?line expect(6, [{[testStatus2, Idx4], ?destroy}]), + ?line ?expect1([{[testStatus2, Idx4], ?destroy}]), - snmpa:verbosity(MA,log), + snmpa:verbosity(MA, log), - ?LOG("implied_test -> done",[]). + ?LOG("implied_test -> done", []). @@ -3284,25 +3701,25 @@ sparse_table_test() -> Idx2 = 2, s([{[sparseStatus, Idx1], i, ?createAndGo}, {[sparseDescr, Idx1], s, "row 1"}]), - ?line expect(1, [{[sparseStatus, Idx1], ?createAndGo}, - {[sparseDescr, Idx1], "row 1"}]), + ?line ?expect1([{[sparseStatus, Idx1], ?createAndGo}, + {[sparseDescr, Idx1], "row 1"}]), s([{[sparseStatus, Idx2], i, ?createAndGo}, {[sparseDescr, Idx2], s, "row 2"}]), - ?line expect(2, [{[sparseStatus, Idx2], ?createAndGo}, - {[sparseDescr, Idx2], "row 2"}]), + ?line ?expect1([{[sparseStatus, Idx2], ?createAndGo}, + {[sparseDescr, Idx2], "row 2"}]), ?v1_2(gn([[sparseIndex], [sparseDescr,Idx1], [sparseDescr,Idx2], [sparseStatus,Idx1], [sparseStatus,Idx2]]), gb(0,5,[[sparseIndex]])), - ?line expect(3, [{[sparseDescr,Idx1], "row 1"}, - {[sparseDescr,Idx2], "row 2"}, - {[sparseStatus,Idx1], ?active}, - {[sparseStatus,Idx2], ?active}, - {[sparseStr,0], "slut"}]), - % Delete the rows + ?line ?expect1([{[sparseDescr,Idx1], "row 1"}, + {[sparseDescr,Idx2], "row 2"}, + {[sparseStatus,Idx1], ?active}, + {[sparseStatus,Idx2], ?active}, + {[sparseStr,0], "slut"}]), + %% Delete the rows s([{[sparseStatus, Idx1], i, ?destroy}]), - ?line expect(4, [{[sparseStatus, Idx1], ?destroy}]), + ?line ?expect1([{[sparseStatus, Idx1], ?destroy}]), s([{[sparseStatus, Idx2], i, ?destroy}]), - ?line expect(5, [{[sparseStatus, Idx2], ?destroy}]). + ?line ?expect1([{[sparseStatus, Idx2], ?destroy}]). %% Req. Test1 @@ -3316,13 +3733,13 @@ cnt_64_test(MA) -> ?DBG("get cnt64",[]), g([[cnt64,0]]), ?DBG("await response",[]), - ?line ?v1_2(expect(1, noSuchName, 1, any), - expect(1, [{[cnt64,0],18446744073709551615}])), + ?line ?v1_2(?expect3(noSuchName, 1, any), + ?expect1([{[cnt64,0],18446744073709551615}])), ?DBG("get-next cnt64",[]), gn([[cnt64]]), ?DBG("await response",[]), - ?line ?v1_2(expect(2, [{[cnt64Str,0], "after cnt64"}]), - expect(2, [{[cnt64,0],18446744073709551615}])), + ?line ?v1_2(?expect1([{[cnt64Str,0], "after cnt64"}]), + ?expect1([{[cnt64,0],18446744073709551615}])), ?DBG("send cntTrap",[]), snmpa:send_trap(MA,cntTrap,"standard trap",[ {sysContact, "pelle"}, @@ -3330,13 +3747,13 @@ cnt_64_test(MA) -> {sysLocation, "here"} ]), ?DBG("await response",[]), - ?line ?v1_2(expect(3, trap, [test], 6, 1, [{[sysContact,0], "pelle"}, - {[sysLocation,0], "here"}]), - expect(3, v2trap, [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?testTrap ++ [1]}, - {[sysContact,0], "pelle"}, - {[cnt64,0], 10}, - {[sysLocation,0], "here"}])), + ?line ?v1_2(?expect5(trap, [test], 6, 1, [{[sysContact,0], "pelle"}, + {[sysLocation,0], "here"}]), + ?expect2(v2trap, [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?testTrap ++ [1]}, + {[sysContact,0], "pelle"}, + {[cnt64,0], 10}, + {[sysLocation,0], "here"}])), %% Create two rows, check that they are get-nexted in correct order. Idx1 = 1, @@ -3344,27 +3761,27 @@ cnt_64_test(MA) -> ?DBG("create row (cntStatus): ~p",[Idx1]), s([{[cntStatus, Idx1], i, ?createAndGo}]), ?DBG("await response",[]), - ?line expect(1, [{[cntStatus, Idx1], ?createAndGo}]), + ?line ?expect1([{[cntStatus, Idx1], ?createAndGo}]), ?DBG("create row (cntStatus): ~p",[Idx2]), s([{[cntStatus, Idx2], i, ?createAndGo}]), ?DBG("await response",[]), - ?line expect(2, [{[cntStatus, Idx2], ?createAndGo}]), + ?line ?expect1([{[cntStatus, Idx2], ?createAndGo}]), ?DBG("get-next (cntIndex)",[]), gn([[cntIndex]]), ?DBG("await response",[]), - ?line ?v1_2(expect(3, [{[cntStatus,Idx1], ?active}]), - expect(3, [{[cntCnt,Idx1], 0}])), + ?line ?v1_2(?expect1([{[cntStatus,Idx1], ?active}]), + ?expect1([{[cntCnt,Idx1], 0}])), % Delete the rows ?DBG("delete row (cntStatus): ~p",[Idx1]), s([{[cntStatus, Idx1], i, ?destroy}]), ?DBG("await response",[]), - ?line expect(4, [{[cntStatus, Idx1], ?destroy}]), + ?line ?expect1([{[cntStatus, Idx1], ?destroy}]), ?DBG("delete row (cntStatus): ~p",[Idx2]), s([{[cntStatus, Idx2], i, ?destroy}]), ?DBG("await response",[]), - ?line expect(5, [{[cntStatus, Idx2], ?destroy}]), - catch snmpa:verbosity(MA,log), + ?line ?expect1([{[cntStatus, Idx2], ?destroy}]), + catch snmpa:verbosity(MA, log), ?DBG("done",[]), ok. @@ -3372,7 +3789,7 @@ cnt_64_test(MA) -> opaque_test() -> ?P1("Testing Opaque datatype..."), g([[opaqueObj,0]]), - ?line expect(1, [{[opaqueObj,0], "opaque-data"}]). + ?line ?expect1([{[opaqueObj,0], "opaque-data"}]). %% Req. OLD-SNMPEA-MIB api_test(MaNode) -> @@ -3413,70 +3830,69 @@ api_test(MaNode) -> %% Req. Klas3 api_test2() -> g([[fname3,0]]), - ?line expect(1, [{[fname3,0], "ok"}]), + ?line ?expect1([{[fname3,0], "ok"}]), g([[fname4,0]]), - ?line expect(2, [{[fname4,0], 1}]). + ?line ?expect1([{[fname4,0], 1}]). api_test3() -> g([[fname3,0]]), - ?line expect(1, [{[fname3,0], "ok"}]). + ?line ?expect1([{[fname3,0], "ok"}]). unreg_test() -> gn([[?v1_2(sysServices, sysORLastChange),0]]), - ?line expect(1, [{[snmpInPkts, 0], any}]). + ?line ?expect1([{[snmpInPkts, 0], any}]). load_test() -> gn([[?v1_2(sysServices, sysORLastChange),0]]), - ?line expect(1, [{[fname,0], ""}]). + ?line ?expect1([{[fname,0], ""}]). %% Req. Klas1 load_test_sa() -> gn([[?v1_2(sysServices,sysORLastChange), 0]]), - ?line expect(1, [{[fname,0], any}]). + ?line ?expect1([{[fname,0], any}]). %% Req. system group, Klas1, OLD-SNMPEA-MIB do_mul_get() -> Key1c3 = [intCommunityEntry,[3],get(mip),is("public")], Key1c4 = [intCommunityEntry,[4],get(mip),is("public")], s([{[fname,0], s, "test set"}]), - ?line expect(3, [{[fname,0], "test set"}]), - g([[sysDescr,0], Key1c4, [fname,0],Key1c3, - [sysName,0]]), - ?line expect(1, [{[sysDescr,0], "Erlang SNMP agent"}, - {Key1c4, 2}, - {[fname,0], "test set"}, - {Key1c3, 2}, - {[sysName,0], "test"}]), + ?line ?expect1([{[fname,0], "test set"}]), + g([[sysDescr,0], Key1c4, [fname,0],Key1c3,[sysName,0]]), + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}, + {Key1c4, 2}, + {[fname,0], "test set"}, + {Key1c3, 2}, + {[sysName,0], "test"}]), g([[1,3,7,1], Key1c4, [sysDescr,0], [1,3,7,2], Key1c3, [sysDescr,0]]), - ?line ?v1_2(expect(2, noSuchName, [1,4], any), - expect(2, [{[1,3,7,1], noSuchObject}, - {Key1c4, 2}, - {[sysDescr,0], "Erlang SNMP agent"}, - {[1,3,7,2], noSuchObject}, - {Key1c3, 2}, - {[sysDescr,0], "Erlang SNMP agent"}])). + ?line ?v1_2(?expect3(noSuchName, [1,4], any), + ?expect1([{[1,3,7,1], noSuchObject}, + {Key1c4, 2}, + {[sysDescr,0], "Erlang SNMP agent"}, + {[1,3,7,2], noSuchObject}, + {Key1c3, 2}, + {[sysDescr,0], "Erlang SNMP agent"}])). %% Req. v1, system group, Klas1, OLD-SNMPEA-MIB, *ej* Klas3. do_mul_get_err() -> Key1c3 = [intCommunityEntry,[3],get(mip),is("public")], Key1c4 = [intCommunityEntry,[4],get(mip),is("public")], s([{[fname,0], s, "test set"}]), - ?line expect(3, [{[fname,0], "test set"}]), + ?line ?expect1([{[fname,0], "test set"}]), g([[sysDescr,0],Key1c4,[fname,0], Key1c3, [sysName,2]]), - ?line ?v1_2(expect(1, noSuchName, 5, any), - expect(1, [{[sysDescr,0], "Erlang SNMP agent"}, - {Key1c4, 2}, - {[fname,0], "test set"}, - {Key1c3, 2}, - {[sysName,2], noSuchInstance}])), + ?line ?v1_2(?expect3(noSuchName, 5, any), + ?expect1([{[sysDescr,0], "Erlang SNMP agent"}, + {Key1c4, 2}, + {[fname,0], "test set"}, + {Key1c3, 2}, + {[sysName,2], noSuchInstance}])), g([[sysDescr,0],Key1c4,[fname3,0], Key1c3, [sysName,1]]), - ?line ?v1_2(expect(1, noSuchName, [3,5], any), - expect(1, [{[sysDescr,0], "Erlang SNMP agent"}, - {Key1c4, 2}, - {[fname3,0], noSuchObject}, - {Key1c3, 2}, - {[sysName,1], noSuchInstance}])). + ?line ?v1_2(?expect3(noSuchName, [3,5], any), + ?expect1([{[sysDescr,0], "Erlang SNMP agent"}, + {Key1c4, 2}, + {[fname3,0], noSuchObject}, + {Key1c3, 2}, + {[sysName,1], noSuchInstance}])). %% Req. system group, Klas1, OLD-SNMPEA-MIB @@ -3486,11 +3902,11 @@ do_mul_next() -> Key1c3 = [intCommunityEntry,[3],get(mip),is("public")], Key1c4 = [intCommunityEntry,[4],get(mip),is("public")], s([{[fname,0], s, "test set"}]), - ?line expect(3, [{[fname,0], "test set"}]), + ?line ?expect1([{[fname,0], "test set"}]), gn([[sysDescr], Key1c4s, [fname],Key1c3s,[sysName]]), - ?line expect(1, [{[sysDescr,0], "Erlang SNMP agent"}, - {Key1c4, 2}, {[fname,0], "test set"}, - {Key1c3, 2}, {[sysName,0], "test"}]). + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}, + {Key1c4, 2}, {[fname,0], "test set"}, + {Key1c3, 2}, {[sysName,0], "test"}]). %% Req. system group, Klas1, OLD-SNMPEA-MIB do_mul_next_err() -> @@ -3499,17 +3915,17 @@ do_mul_next_err() -> Key1c3 = [intCommunityEntry,[3],get(mip),is("public")], Key1c4 = [intCommunityEntry,[4],get(mip),is("public")], s([{[fname,0], s, "test set"}]), - ?line expect(3, [{[fname,0], "test set"}]), + ?line ?expect1([{[fname,0], "test set"}]), gn([[sysDescr], Key1c4s, [1,3,6,999], [fname],[1,3,90], Key1c3s,[sysName]]), - ?line ?v1_2(expect(1, noSuchName, [3,5], any), - expect(1, [{[sysDescr,0], "Erlang SNMP agent"}, - {Key1c4, 2}, - {[1,3,6,999], endOfMibView}, - {[fname,0], "test set"}, - {[1,3,90], endOfMibView}, - {Key1c3, 2}, - {[sysName,0], "test"}])). - + ?line ?v1_2(?expect3(noSuchName, [3,5], any), + ?expect1([{[sysDescr,0], "Erlang SNMP agent"}, + {Key1c4, 2}, + {[1,3,6,999], endOfMibView}, + {[fname,0], "test set"}, + {[1,3,90], endOfMibView}, + {Key1c3, 2}, + {[sysName,0], "test"}])). + %% Req. system group, Klas1, OLD-SNMPEA-MIB do_mul_set() -> @@ -3523,24 +3939,24 @@ do_mul_set() -> {NewKeyc5, ?createAndGo}, {NewKeyc4, 2}, {[friendsEntry, [3, 3]], ?createAndGo}]), - ?line expect(1, [{[friendsEntry, [2, 3]], "kompis3"}, - {NewKeyc3, 2}, - {[sysLocation,0], "new_value"}, - {NewKeyc5, ?createAndGo}, - {NewKeyc4, 2}, - {[friendsEntry, [3, 3]], ?createAndGo}]), + ?line ?expect1([{[friendsEntry, [2, 3]], "kompis3"}, + {NewKeyc3, 2}, + {[sysLocation,0], "new_value"}, + {NewKeyc5, ?createAndGo}, + {NewKeyc4, 2}, + {[friendsEntry, [3, 3]], ?createAndGo}]), g([[friendsEntry, [2, 3]], - [sysLocation,0], - [friendsEntry, [3, 3]]]), - ?line expect(2, [{[friendsEntry, [2, 3]], "kompis3"}, - {[sysLocation,0], "new_value"}, - {[friendsEntry, [3, 3]], ?active}]), + [sysLocation,0], + [friendsEntry, [3, 3]]]), + ?line ?expect1([{[friendsEntry, [2, 3]], "kompis3"}, + {[sysLocation,0], "new_value"}, + {[friendsEntry, [3, 3]], ?active}]), g([NewKeyc4]), - ?line expect(3, [{NewKeyc4, 2}]), + ?line ?expect1([{NewKeyc4, 2}]), s([{[friendsEntry, [3, 3]], ?destroy}, {NewKeyc5, ?destroy}]), - ?line expect(4, [{[friendsEntry, [3, 3]], ?destroy}, - {NewKeyc5, ?destroy}]). + ?line ?expect1([{[friendsEntry, [3, 3]], ?destroy}, + {NewKeyc5, ?destroy}]). %% Req. system group, Klas1, OLD-SNMPEA-MIB do_mul_set_err() -> @@ -3554,53 +3970,48 @@ do_mul_set_err() -> {NewKeyc5, ?createAndGo}, {NewKeyc4, 2}, {[friendsEntry, [3, 3]], ?createAndGo}]), - ?line expect(1, ?v1_2(noSuchName, notWritable), 3, any), + ?line ?expect3(?v1_2(noSuchName, notWritable), 3, any), g([[friendsEntry, [2, 3]]]), - ?line ?v1_2(expect(2, noSuchName, 1, any), - expect(2, [{[friendsEntry, [2,3]], noSuchInstance}])), + ?line ?v1_2(?expect3(noSuchName, 1, any), + ?expect1([{[friendsEntry, [2,3]], noSuchInstance}])), g([NewKeyc4]), - ?line ?v1_2(expect(3, noSuchName, 1, any), - expect(3, [{NewKeyc4, noSuchInstance}])). + ?line ?v1_2(?expect3(noSuchName, 1, any), + ?expect1([{NewKeyc4, noSuchInstance}])). %% Req. SA-MIB sa_mib() -> g([[sa, [2,0]]]), - ?line expect(sa_mib_1, [{[sa, [2,0]], 3}]), + ?line ?expect1([{[sa, [2,0]], 3}]), s([{[sa, [1,0]], s, "sa_test"}]), - ?line expect(sa_mib_2, [{[sa, [1,0]], "sa_test"}]), + ?line ?expect1([{[sa, [1,0]], "sa_test"}]), ok. ma_trap1(MA) -> ok = snmpa:send_trap(MA, testTrap2, "standard trap"), - ?line expect(ma_trap1_1, - trap, [system], 6, 1, [{[system, [4,0]], - "{mbj,eklas}@erlang.ericsson.se"}]), + ?line ?expect5(trap, [system], 6, 1, [{[system, [4,0]], + "{mbj,eklas}@erlang.ericsson.se"}]), ok = snmpa:send_trap(MA, testTrap1, "standard trap"), - ?line expect(ma_trap1_2, - trap, [1,2,3] , 1, 0, [{[system, [4,0]], - "{mbj,eklas}@erlang.ericsson.se"}]), + ?line ?expect5(trap, [1,2,3] , 1, 0, [{[system, [4,0]], + "{mbj,eklas}@erlang.ericsson.se"}]), ok. ma_trap2(MA) -> snmpa:send_trap(MA,testTrap2,"standard trap",[{sysContact,"pelle"}]), - ?line expect(ma_trap2_3, - trap, [system], 6, 1, [{[system, [4,0]], "pelle"}]), + ?line ?expect5(trap, [system], 6, 1, [{[system, [4,0]], "pelle"}]), ok. ma_v2_2_v1_trap(MA) -> snmpa:send_trap(MA,testTrapv22,"standard trap",[{sysContact,"pelle"}]), - ?line expect(ma_v2_2_v1_trap_3, - trap, [system], 6, 1, [{[system, [4,0]], "pelle"}]), + ?line ?expect5(trap, [system], 6, 1, [{[system, [4,0]], "pelle"}]), ok. ma_v2_2_v1_trap2(MA) -> snmpa:send_trap(MA,linkUp,"standard trap",[{ifIndex, [1], 1}, {ifAdminStatus, [1], 1}, {ifOperStatus, [1], 2}]), - ?line expect(ma_v2_2_v1_trap2_3, - trap, [1,2,3], 3, 0, [{[ifIndex, 1], 1}, - {[ifAdminStatus, 1], 1}, - {[ifOperStatus, 1], 2}]), + ?line ?expect5(trap, [1,2,3], 3, 0, [{[ifIndex, 1], 1}, + {[ifAdminStatus, 1], 1}, + {[ifOperStatus, 1], 2}]), ok. sa_trap1(SA) -> @@ -3618,47 +4029,44 @@ sa_trap1(SA) -> %% io:format("sa_trap1 -> SA trap send: " %% "~n TSRes: ~p" %% "~n", [TSRes]), - ?line expect(sa_trap1_4, - trap, [ericsson], 6, 1, [{[system, [4,0]], - "{mbj,eklas}@erlang.ericsson.se"}, - {[sa, [1,0]], "sa_test"}]), + ?line ?expect5(trap, [ericsson], 6, 1, [{[system, [4,0]], + "{mbj,eklas}@erlang.ericsson.se"}, + {[sa, [1,0]], "sa_test"}]), snmpa:verbosity(SA, {subagents, silence}), ok. sa_trap2(SA) -> snmpa:send_trap(SA, saTrap, "standard trap",[{sysContact,"pelle"}]), - ?line expect(sa_trap2_5, - trap, [ericsson], 6, 1, [{[system, [4,0]], "pelle"}, - {[sa, [1,0]], "sa_test"}]), + ?line ?expect5(trap, [ericsson], 6, 1, [{[system, [4,0]], "pelle"}, + {[sa, [1,0]], "sa_test"}]), ok. sa_trap3(SA) -> snmpa:send_trap(SA, saTrap2, "standard trap", [{intViewSubtree, [4], [1,2,3,4]}]), - ?line expect(sa_trap3_6, - trap, [ericsson], 6, 2, [{[system, [4,0]], - "{mbj,eklas}@erlang.ericsson.se"}, - {[sa, [1,0]], "sa_test"}, - {[intViewSubtree,4],[1,2,3,4]}]), + ?line ?expect5(trap, [ericsson], 6, 2, [{[system, [4,0]], + "{mbj,eklas}@erlang.ericsson.se"}, + {[sa, [1,0]], "sa_test"}, + {[intViewSubtree,4],[1,2,3,4]}]), ok. ma_v2_trap1(MA) -> ?DBG("ma_v2_traps -> entry with MA = ~p => " "send standard trap: testTrapv22",[MA]), snmpa:send_trap(MA, testTrapv22, "standard trap"), - ?line expect(1, v2trap, [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?system ++ [0,1]}]), + ?line ?expect2(v2trap, [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?system ++ [0,1]}]), ?DBG("ma_v2_traps -> send standard trap: testTrapv21",[]), snmpa:send_trap(MA, testTrapv21, "standard trap"), - ?line expect(2, v2trap, [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?snmp ++ [1]}]), + ?line ?expect2(v2trap, [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?snmp ++ [1]}]), ok. ma_v2_trap2(MA) -> snmpa:send_trap(MA,testTrapv22,"standard trap",[{sysContact,"pelle"}]), - ?line expect(3, v2trap, [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?system ++ [0,1]}, - {[system, [4,0]], "pelle"}]). + ?line ?expect2(v2trap, [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?system ++ [0,1]}, + {[system, [4,0]], "pelle"}]). %% Note: This test case takes a while... actually a couple of minutes. ma_v2_inform1(MA) -> @@ -3667,11 +4075,10 @@ ma_v2_inform1(MA) -> "~n send notification: testTrapv22", [MA]), CmdExpectInform = - fun(No, Response) -> - expect(No, - {inform, Response}, - [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?system ++ [0,1]}]) + fun(_No, Response) -> + ?expect2({inform, Response}, + [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?system ++ [0,1]}]) end, CmdExp = @@ -3817,11 +4224,10 @@ ma_v2_inform2(MA) -> "~n send notification: testTrapv22", [MA]), CmdExpectInform = - fun(No, Response) -> - expect(No, - {inform, Response}, - [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?system ++ [0,1]}]) + fun(_No, Response) -> + ?expect2({inform, Response}, + [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?system ++ [0,1]}]) end, CmdExp = @@ -3909,17 +4315,17 @@ ma_v2_inform3(MA) -> CmdExpectInform = fun(No, Response) -> - expect(No, - {inform, Response}, - [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?system ++ [0,1]}]) + ?DBG("CmdExpectInform -> ~p: ~n~p", [No, Response]), + ?expect2({inform, Response}, + [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?system ++ [0,1]}]) end, CmdExp = fun(ok) -> ok; ({ok, Val}) -> - ?DBG("ma_v2_inform3 -> [cmd2] Val: ~p", [Val]), + ?DBG("CmdExp -> Val: ~p", [Val]), ok; ({error, Id, Extra}) -> {error, {unexpected, Id, Extra}}; @@ -3983,15 +4389,16 @@ ma_v2_inform3(MA) -> Commands = [ - {15, "Send notification [tag31]", Cmd15}, - {16, "Expect notification message [tag31]", Cmd16}, - {17, "Expect targets message [tag31]", Cmd17}, - {18, "Expect notification (no) response message [tag31]", Cmd18} + {15, "Send notification [" ++ atom_to_list(Tag15) ++ "]", Cmd15}, + {16, "Expect notification message [" ++ atom_to_list(Tag15) ++ "]", Cmd16}, + {17, "Expect targets message [" ++ atom_to_list(Tag15) ++ "]", Cmd17}, + {18, "Expect notification (no) response message [" ++ atom_to_list(Tag15) ++ "]", Cmd18} ], command_handler(Commands). - + +%% snmpa_notification_delivery_info_receiver callback function delivery_targets(Tag, Addresses, Extra) -> io:format("~w:delivery_targets -> entry with" "~n Tag: ~p" @@ -4008,6 +4415,7 @@ delivery_targets(Tag, Addresses, Extra) -> end, ok. +%% snmpa_notification_delivery_info_receiver callback function delivery_info(Tag, Address, DeliveryResult, Extra) -> io:format("~w:delivery_info -> entry with" "~n Tag: ~p" @@ -4045,40 +4453,40 @@ command_handler([{No, Desc, Cmd}|Rest]) -> ma_v1_2_v2_trap(MA) -> snmpa:send_trap(MA,linkDown,"standard trap",[{ifIndex, [1], 1}]), - ?line expect(2, v2trap, [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?snmpTraps ++ [3]}, - {[ifIndex, 1], 1}, - {[snmpTrapEnterprise, 0], [1,2,3]}]). + ?line ?expect2(v2trap, [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?snmpTraps ++ [3]}, + {[ifIndex, 1], 1}, + {[snmpTrapEnterprise, 0], [1,2,3]}]). ma_v1_2_v2_trap2(MA) -> snmpa:send_trap(MA,testTrap2,"standard trap",[{sysContact,"pelle"}]), - ?line expect(3, v2trap, [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?system ++ [0,1]}, - {[system, [4,0]], "pelle"}, - {[snmpTrapEnterprise, 0], ?system}]). + ?line ?expect2(v2trap, [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?system ++ [0,1]}, + {[system, [4,0]], "pelle"}, + {[snmpTrapEnterprise, 0], ?system}]). sa_v1_2_v2_trap1(SA) -> snmpa:verbosity(SA, {subagents, trace}), snmpa:send_trap(SA, saTrap, "standard trap"), - ?line expect(trap1_4, v2trap, [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?ericsson ++ [0, 1]}, - {[system, [4,0]], - "{mbj,eklas}@erlang.ericsson.se"}, - {[sa, [1,0]], "sa_test"}, - {[snmpTrapEnterprise, 0], ?ericsson}]), + ?line ?expect2(v2trap, [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?ericsson ++ [0, 1]}, + {[system, [4,0]], + "{mbj,eklas}@erlang.ericsson.se"}, + {[sa, [1,0]], "sa_test"}, + {[snmpTrapEnterprise, 0], ?ericsson}]), snmpa:verbosity(SA, {subagents, silence}), ok. sa_v1_2_v2_trap2(SA) -> snmpa:verbosity(SA, {subagents, trace}), snmpa:send_trap(SA, saTrap, "standard trap",[{sysContact,"pelle"}]), - ?line expect(trap2_4, v2trap, [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?ericsson ++ [0, 1]}, - {[system, [4,0]], "pelle"}, - {[sa, [1,0]], "sa_test"}, - {[snmpTrapEnterprise, 0], ?ericsson}]), + ?line ?expect2(v2trap, [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?ericsson ++ [0, 1]}, + {[system, [4,0]], "pelle"}, + {[sa, [1,0]], "sa_test"}, + {[snmpTrapEnterprise, 0], ?ericsson}]), snmpa:verbosity(SA, {subagents, silence}), ok. @@ -4087,13 +4495,13 @@ sa_v1_2_v2_trap3(SA) -> snmpa:verbosity(SA, {subagents, trace}), snmpa:send_trap(SA, saTrap2, "standard trap", [{intViewSubtree, [4], [1,2,3,4]}]), - ?line expect(trap3_4, v2trap, [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], ?ericsson ++ [0, 2]}, - {[system, [4,0]], - "{mbj,eklas}@erlang.ericsson.se"}, - {[sa, [1,0]], "sa_test"}, - {[intViewSubtree,4],[1,2,3,4]}, - {[snmpTrapEnterprise, 0], ?ericsson}]), + ?line ?expect2(v2trap, [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], ?ericsson ++ [0, 2]}, + {[system, [4,0]], + "{mbj,eklas}@erlang.ericsson.se"}, + {[sa, [1,0]], "sa_test"}, + {[intViewSubtree,4],[1,2,3,4]}, + {[snmpTrapEnterprise, 0], ?ericsson}]), snmpa:verbosity(SA, {subagents, silence}), ok. @@ -4107,15 +4515,15 @@ sa_errs_bad_value() -> {[sa, [2,0]], 5}, % badValue (i is_set_ok) {NewKeyc5, ?createAndGo}, {NewKeyc4, 2}]), - ?line expect(1, badValue, 2, any), + ?line ?expect3(badValue, 2, any), s([{NewKeyc3, 2}, {[sa, [2,0]], 6}, % wrongValue (i is_set_ok) {NewKeyc5, ?createAndGo}, {NewKeyc4, 2}]), - ?line expect(1, ?v1_2(badValue, wrongValue), 2, any), + ?line ?expect3(?v1_2(badValue, wrongValue), 2, any), g([NewKeyc4]), - ?line ?v1_2(expect(2, noSuchName, 1, any), - expect(2, [{NewKeyc4, noSuchInstance}])). + ?line ?v1_2(?expect3(noSuchName, 1, any), + ?expect1([{NewKeyc4, noSuchInstance}])). %% Req. SA-MIB, OLD-SNMPEA-MIB sa_errs_gen_err() -> @@ -4124,23 +4532,23 @@ sa_errs_gen_err() -> NewKeyc5 = [intCommunityEntry,[5],get(mip),is("test")], s([{NewKeyc3, 2},{NewKeyc4, 2}, {NewKeyc5, ?createAndGo}, {[sa, [3,0]], 5}]), - ?line expect(1, genErr, 4, any), + ?line ?expect3(genErr, 4, any), % The row might have been added; we don't know. % (as a matter of fact we do - it is added, because the agent % first sets its own vars, and then th SAs. Lets destroy it. s([{NewKeyc5, ?destroy}]), - ?line expect(2, [{NewKeyc5, ?destroy}]). + ?line ?expect1([{NewKeyc5, ?destroy}]). %% Req. SA-MIB, OLD-SNMPEA-MIB sa_too_big() -> g([[sa, [4,0]]]), - ?line expect(1, tooBig). + ?line ?expect1(tooBig). %% Req. Klas1, system group, snmp group (v1/v2) -next_across_sa() -> +next_across_sa_test() -> gn([[sysDescr],[klas1,5]]), - ?line expect(1, [{[sysDescr,0], "Erlang SNMP agent"}, - {[snmpInPkts, 0], any}]). + ?line ?expect1([{[sysDescr,0], "Erlang SNMP agent"}, + {[snmpInPkts, 0], any}]). %% snmp_test_mgr:s([{[fStatus3, 1], 4}, {[fname3,0], "ok"}]). -> noError %% snmp_test_mgr:s([{[fStatus3, 1], 4}, {[fname3,0], "hoj"}]). -> {badValue, 2} @@ -4151,40 +4559,40 @@ next_across_sa() -> %% Req. Klas3, Klas4 undo_test() -> s([{[fStatus3, 1], 4}, {[fname3,0], "ok"}]), - ?line expect(1, [{[fStatus3, 1], 4}, {[fname3,0], "ok"}]), + ?line ?expect1([{[fStatus3, 1], 4}, {[fname3,0], "ok"}]), s([{[fStatus3, 1], 4}, {[fname3,0], "hoj"}]), - ?line expect(2, ?v1_2(badValue, inconsistentValue), 2, any), + ?line ?expect3(?v1_2(badValue, inconsistentValue), 2, any), s([{[fStatus3, 3], 4}, {[fname3,0], "hoj"}]), - ?line expect(3, ?v1_2(genErr, undoFailed), 1, any), + ?line ?expect3(?v1_2(genErr, undoFailed), 1, any), s([{[fStatus3, 4], 4}, {[fname3,0], "ok"}]), - ?line expect(4, ?v1_2(genErr, commitFailed), 1, any), + ?line ?expect3(?v1_2(genErr, commitFailed), 1, any), % unfortunatly we don't know if we'll get undoFailed or commitFailed. % it depends on which order the agent traverses the varbind list. % s([{[fStatus3, 4], 4}, {[fname3,0], "ufail"}]), % ?line expect(5, ?v1_2(genErr, undoFailed), 1, any), s([{[fStatus3, 1], 4}, {[fname3,0], "xfail"}]), - ?line expect(6, genErr, 2, any). + ?line ?expect3(genErr, 2, any). %% Req. Klas3, Klas4 bad_return() -> g([[fStatus4,4], [fName4,4]]), - ?line expect(4, genErr, 2, any), + ?line ?expect3(genErr, 2, any), g([[fStatus4,5], [fName4,5]]), - ?line expect(5, genErr, 1, any), + ?line ?expect3(genErr, 1, any), g([[fStatus4,6], [fName4,6]]), - ?line expect(6, genErr, 2, any), + ?line ?expect3(genErr, 2, any), gn([[fStatus4,7], [fName4,7]]), - ?line expect(7, genErr, 2, any), + ?line ?expect3(genErr, 2, any), gn([[fStatus4,8], [fName4,8]]), - ?line expect(8, genErr, 1, any), + ?line ?expect3(genErr, 1, any), gn([[fStatus4,9], [fName4,9]]), - ?line expect(9, genErr, 2, any). + ?line ?expect3(genErr, 2, any). %%%----------------------------------------------------------------- @@ -4195,7 +4603,16 @@ bad_return() -> %%% already tested by the normal tests. %%%----------------------------------------------------------------- - +standard_mibs_cases() -> + [ + snmp_standard_mib, + snmp_community_mib, + snmp_framework_mib, + snmp_target_mib, + snmp_notification_mib, + snmp_view_based_acm_mib + ]. + %%----------------------------------------------------------------- %% For this test, the agent is configured for v1. @@ -4247,27 +4664,27 @@ std_mib_init() -> %% disable authentication failure traps. (otherwise w'd get many of %% them - this is also a test to see that it works). s([{[snmpEnableAuthenTraps,0], 2}]), - ?line expect(std_mib_init_1, [{[snmpEnableAuthenTraps, 0], 2}]). + ?line ?expect1([{[snmpEnableAuthenTraps, 0], 2}]). %% Req. SNMP-STANDARD-MIB | SNMPv2-MIB std_mib_finish() -> %% enable again s([{[snmpEnableAuthenTraps,0], 1}]), - ?line expect(std_mib_finish_1, [{[snmpEnableAuthenTraps, 0], 1}]). + ?line ?expect1([{[snmpEnableAuthenTraps, 0], 1}]). %% Req. SNMP-STANDARD-MIB standard_mib_test_finish() -> %% force a authenticationFailure (should result in a trap) std_mib_write(), %% check that we got a trap - ?line expect(standard_mib_test_finish_2, trap, [1,2,3], 4, 0, []). + ?line ?expect5(trap, [1,2,3], 4, 0, []). %% Req. SNMP-STANDARD-MIB | SNMPv2-MIB std_mib_read() -> ?DBG("std_mib_read -> entry", []), g([[sysUpTime,0]]), % try a bad <something>; msg dropped, no reply ?DBG("std_mib_read -> await timeout (i.e. no reply)", []), - ?line expect(std_mib_read_1, timeout). % make sure we don't get a trap! + ?line ?expect1(timeout). % make sure we don't get a trap! %% Req. SNMP-STANDARD-MIB | SNMPv2-MIB @@ -4279,6 +4696,18 @@ std_mib_write() -> std_mib_asn_err() -> snmp_test_mgr:send_bytes([48,99,67,12,0,0,0,0,0,0,5]). + +standard_mibs2_cases() -> + [ + snmpv2_mib_2, + snmp_community_mib_2, + snmp_framework_mib_2, + snmp_target_mib_2, + snmp_notification_mib_2, + snmp_view_based_acm_mib_2 + ]. + + %%----------------------------------------------------------------- %% For this test, the agent is configured for v2 and v3. %% o Test the counters and control objects in SNMPv2-MIB @@ -4327,6 +4756,19 @@ snmpv2_mib_2(Config) when is_list(Config) -> ?LOG("snmpv2_mib_2 -> done",[]). + +standard_mibs3_cases() -> + [ + snmpv2_mib_3, + snmp_framework_mib_3, + snmp_mpd_mib_3, + snmp_target_mib_3, + snmp_notification_mib_3, + snmp_view_based_acm_mib_3, + snmp_user_based_sm_mib_3 + ]. + + %% Req. SNMPv2-MIB snmpv2_mib_3(suite) -> []; snmpv2_mib_3(Config) when is_list(Config) -> @@ -4358,13 +4800,13 @@ snmpv2_mib_test_finish() -> %% check that we got a trap ?DBG("ma_v2_inform -> await trap",[]), - ?line expect(2, v2trap, [{[sysUpTime,0], any}, - {[snmpTrapOID,0], ?authenticationFailure}]), + ?line ?expect2(v2trap, [{[sysUpTime,0], any}, + {[snmpTrapOID,0], ?authenticationFailure}]), %% and the the inform ?DBG("ma_v2_inform -> await inform",[]), - ?line expect(2, {inform,true}, [{[sysUpTime,0], any}, - {[snmpTrapOID,0],?authenticationFailure}]). + ?line ?expect2({inform,true}, [{[sysUpTime,0], any}, + {[snmpTrapOID,0],?authenticationFailure}]). %% Req. SNMP-STANDARD-MIB | SNMPv2-MIB std_mib_a() -> @@ -4402,12 +4844,12 @@ std_mib_c({InBadCommunityNames, InBadCommunityUses, InASNErrs}) -> snmpv2_mib_a() -> ?line [SetSerial] = get_req(2, [[snmpSetSerialNo,0]]), s([{[snmpSetSerialNo,0], SetSerial}, {[sysLocation, 0], "val2"}]), - ?line expect(snmpv2_mib_a_3, [{[snmpSetSerialNo,0], SetSerial}, - {[sysLocation, 0], "val2"}]), + ?line ?expect1([{[snmpSetSerialNo,0], SetSerial}, + {[sysLocation, 0], "val2"}]), s([{[sysLocation, 0], "val3"}, {[snmpSetSerialNo,0], SetSerial}]), - ?line expect(snmpv2_mib_a_4, inconsistentValue, 2, - [{[sysLocation, 0], "val3"}, - {[snmpSetSerialNo,0], SetSerial}]), + ?line ?expect3(inconsistentValue, 2, + [{[sysLocation, 0], "val3"}, + {[snmpSetSerialNo,0], SetSerial}]), ?line ["val2"] = get_req(5, [[sysLocation,0]]). @@ -4421,13 +4863,13 @@ snmp_community_mib(Config) when is_list(Config) -> ?P(snmp_community_mib), init_case(Config), ?line load_master_std("SNMP-COMMUNITY-MIB"), - try_test(snmp_community_mib), + try_test(snmp_community_mib_test), ?line unload_master("SNMP-COMMUNITY-MIB"). snmp_community_mib_2(X) -> ?P(snmp_community_mib_2), snmp_community_mib(X). %% Req. SNMP-COMMUNITY-MIB -snmp_community_mib() -> +snmp_community_mib_test() -> ?INF("NOT YET IMPLEMENTED", []), nyi. @@ -4439,7 +4881,7 @@ snmp_framework_mib(Config) when is_list(Config) -> ?P(snmp_framework_mib), init_case(Config), ?line load_master_std("SNMP-FRAMEWORK-MIB"), - try_test(snmp_framework_mib), + try_test(snmp_framework_mib_test), ?line unload_master("SNMP-FRAMEWORK-MIB"). snmp_framework_mib_2(X) -> ?P(snmp_framework_mib_2), snmp_framework_mib(X). @@ -4448,11 +4890,11 @@ snmp_framework_mib_3(suite) -> []; snmp_framework_mib_3(Config) when is_list(Config) -> ?P(snmp_framework_mib_3), init_case(Config), - try_test(snmp_framework_mib). + try_test(snmp_framework_mib_test). %% Req. SNMP-FRAMEWORK-MIB -snmp_framework_mib() -> +snmp_framework_mib_test() -> ?line ["agentEngine"] = get_req(1, [[snmpEngineID,0]]), ?line [EngineTime] = get_req(2, [[snmpEngineTime,0]]), ?SLEEP(5000), @@ -4538,7 +4980,7 @@ snmp_mpd_mib_a() -> -define(snmpUnknownPDUHandlers_instance, [1,3,6,1,6,3,11,2,1,3,0]). snmp_mpd_mib_b() -> g([[sysUpTime,0]]), - ?line expect(1, report, [{?snmpUnknownPDUHandlers_instance, any}]). + ?line ?expect2(report, [{?snmpUnknownPDUHandlers_instance, any}]). snmp_mpd_mib_c(UnknownPDUHs) -> @@ -4551,14 +4993,14 @@ snmp_target_mib(Config) when is_list(Config) -> ?P(snmp_target_mib), init_case(Config), ?line load_master_std("SNMP-TARGET-MIB"), - try_test(snmp_target_mib), + try_test(snmp_target_mib_test), ?line unload_master("SNMP-TARGET-MIB"). snmp_target_mib_2(X) -> ?P(snmp_target_mib_2), snmp_target_mib(X). snmp_target_mib_3(X) -> ?P(snmp_target_mib_3), snmp_target_mib(X). -snmp_target_mib() -> +snmp_target_mib_test() -> ?INF("NOT YET IMPLEMENTED", []), nyi. @@ -4567,7 +5009,7 @@ snmp_notification_mib(Config) when is_list(Config) -> ?P(snmp_notification_mib), init_case(Config), ?line load_master_std("SNMP-NOTIFICATION-MIB"), - try_test(snmp_notification_mib), + try_test(snmp_notification_mib_test), ?line unload_master("SNMP-NOTIFICATION-MIB"). snmp_notification_mib_2(X) -> ?P(snmp_notification_mib_2), @@ -4576,7 +5018,7 @@ snmp_notification_mib_2(X) -> ?P(snmp_notification_mib_2), snmp_notification_mib_3(X) -> ?P(snmp_notification_mib_3), snmp_notification_mib(X). -snmp_notification_mib() -> +snmp_notification_mib_test() -> ?INF("NOT YET IMPLEMENTED", []), nyi. @@ -4728,50 +5170,51 @@ snmp_view_based_acm_mib() -> do_set(Row) -> s(Row), - expect(do_set_1, Row). + ?expect1(Row). add_row(RowStatus) -> s([{RowStatus, ?createAndGo}]), - expect(add_row_1, [{RowStatus, ?createAndGo}]). + ?expect1([{RowStatus, ?createAndGo}]). del_row(RowStatus) -> s([{RowStatus, ?destroy}]), - expect(del_row_1, [{RowStatus, ?destroy}]). + ?expect1([{RowStatus, ?destroy}]). use_no_rights() -> g([[xDescr,0]]), - ?v1_2_3(expect(use_no_rights_11, noSuchName, 1, any), - expect(use_no_rights_12, [{[xDescr,0], noSuchObject}]), - expect(use_no_rights_13, authorizationError, 1, any)), + ?v1_2_3(?expect3(noSuchName, 1, any), + ?expect1([{[xDescr,0], noSuchObject}]), + ?expect3(authorizationError, 1, any)), g([[xDescr2,0]]), - ?v1_2_3(expect(use_no_rights_21, noSuchName, 1, any), - expect(use_no_rights_22, [{[xDescr2,0], noSuchObject}]), - expect(use_no_rights_23, authorizationError, 1, any)), + ?v1_2_3(?expect3(noSuchName, 1, any), + ?expect1([{[xDescr2,0], noSuchObject}]), + ?expect3(authorizationError, 1, any)), gn([[xDescr]]), - ?v1_2_3(expect(use_no_rights_31, noSuchName, 1, any), - expect(use_no_rights_32, [{[xDescr], endOfMibView}]), - expect(use_no_rights_33, authorizationError, 1, any)), + ?v1_2_3(?expect3(noSuchName, 1, any), + ?expect1([{[xDescr], endOfMibView}]), + ?expect3(authorizationError, 1, any)), s([{[xDescr,0], "tryit"}]), - ?v1_2_3(expect(use_no_rights_41, noSuchName, 1, any), - expect(use_no_rights_42, noAccess, 1, any), - expect(use_no_rights_43, authorizationError, 1, any)). + ?v1_2_3(?expect3(noSuchName, 1, any), + ?expect3(noAccess, 1, any), + ?expect3(authorizationError, 1, any)). use_rights() -> g([[xDescr,0]]), - expect(use_rights_1, [{[xDescr,0], any}]), + ?expect1([{[xDescr,0], any}]), g([[xDescr2,0]]), - expect(use_rights_2, [{[xDescr2,0], any}]), + ?expect1([{[xDescr2,0], any}]), s([{[xDescr,0], "tryit"}]), - expect(use_rights_3, noError, 0, any), + ?expect3(noError, 0, any), g([[xDescr,0]]), - expect(use_rights_4, [{[xDescr,0], "tryit"}]). + ?expect1([{[xDescr,0], "tryit"}]). mk_ln(X) -> [length(X) | X]. + %%----------------------------------------------------------------- %% o add/delete users and try them %% o test all secLevels @@ -4851,15 +5294,15 @@ snmp_user_based_sm_mib_3(Config) when is_list(Config) -> %% Try some read requests ?line try_test(v3_sync, [[{usm_read, []}]], - [{sec_level, authPriv}, {user, "privDES"}]), + [{sec_level, authPriv}, {user, "privDES"}]), %% Delete the new user ?line try_test(v3_sync, [[{usm_del_user, []}]], - [{sec_level, authPriv}, {user, "privDES"}]), + [{sec_level, authPriv}, {user, "privDES"}]), %% Try some bad requests ?line try_test(v3_sync, [[{usm_bad, []}]], - [{sec_level, authPriv}, {user, "privDES"}]), + [{sec_level, authPriv}, {user, "privDES"}]), ?line unload_master("SNMP-USER-BASED-SM-MIB"). @@ -4871,7 +5314,7 @@ usm_add_user1() -> Vbs1 = [{[usmUserCloneFrom, NewRowIndex], RowPointer}, {[usmUserStatus, NewRowIndex], ?createAndGo}], ?line s(Vbs1), - ?line expect(1, Vbs1), + ?line ?expect1(Vbs1), ok. usm_use_user() -> @@ -4890,7 +5333,7 @@ usm_key_change1(ShaKey, DesKey) -> Vbs1 = [{[usmUserAuthKeyChange, NewRowIndex], ShaKeyChange}, {[usmUserPrivKeyChange, NewRowIndex], DesKeyChange}], s(Vbs1), - ?line expect(1, Vbs1). + ?line ?expect1(Vbs1). %% Change own private keys usm_key_change2(OldShaKey, OldDesKey, ShaKey, DesKey) -> @@ -4904,7 +5347,7 @@ usm_key_change2(OldShaKey, OldDesKey, ShaKey, DesKey) -> Vbs1 = [{[usmUserOwnAuthKeyChange, NewRowIndex], ShaKeyChange}, {[usmUserOwnPrivKeyChange, NewRowIndex], DesKeyChange}], s(Vbs1), - ?line expect(1, Vbs1). + ?line ?expect1(Vbs1). %% Change other's public keys usm_key_change3(OldShaKey, OldDesKey, ShaKey, DesKey) -> @@ -4917,16 +5360,16 @@ usm_key_change3(OldShaKey, OldDesKey, ShaKey, DesKey) -> DesKey), Vbs1 = [{[usmUserOwnAuthKeyChange, NewRowIndex], ShaKeyChange}], s(Vbs1), - ?line expect(1, noAccess, 1, any), + ?line ?expect3(noAccess, 1, any), Vbs2 = [{[usmUserOwnPrivKeyChange, NewRowIndex], DesKeyChange}], s(Vbs2), - ?line expect(2, noAccess, 1, any), + ?line ?expect3(noAccess, 1, any), Vbs3 = [{[usmUserAuthKeyChange, NewRowIndex], ShaKeyChange}, {[usmUserPrivKeyChange, NewRowIndex], DesKeyChange}], s(Vbs3), - ?line expect(1, Vbs3). + ?line ?expect1(Vbs3). usm_read() -> NewRowIndex = [11,"agentEngine", 7, "newUser"], @@ -4936,13 +5379,12 @@ usm_read() -> [usmUserOwnAuthKeyChange, NewRowIndex], [usmUserPrivKeyChange, NewRowIndex], [usmUserOwnPrivKeyChange, NewRowIndex]]), - ?line expect(1, - [{[usmUserSecurityName, NewRowIndex], "newUser"}, - {[usmUserCloneFrom, NewRowIndex], [0,0]}, - {[usmUserAuthKeyChange, NewRowIndex], ""}, - {[usmUserOwnAuthKeyChange, NewRowIndex], ""}, - {[usmUserPrivKeyChange, NewRowIndex], ""}, - {[usmUserOwnPrivKeyChange, NewRowIndex], ""}]), + ?line ?expect1([{[usmUserSecurityName, NewRowIndex], "newUser"}, + {[usmUserCloneFrom, NewRowIndex], [0,0]}, + {[usmUserAuthKeyChange, NewRowIndex], ""}, + {[usmUserOwnAuthKeyChange, NewRowIndex], ""}, + {[usmUserPrivKeyChange, NewRowIndex], ""}, + {[usmUserOwnPrivKeyChange, NewRowIndex], ""}]), ok. @@ -4951,7 +5393,7 @@ usm_del_user() -> NewRowIndex = [11,"agentEngine", 7, "newUser"], Vbs1 = [{[usmUserStatus, NewRowIndex], ?destroy}], ?line s(Vbs1), - ?line expect(1, Vbs1), + ?line ?expect1(Vbs1), ok. -define(usmUserCloneFrom, [1,3,6,1,6,3,15,1,2,2,1,4]). @@ -4972,32 +5414,31 @@ usm_bad() -> Vbs1 = [{[usmUserCloneFrom, NewRowIndex], RowPointer1}, {[usmUserStatus, NewRowIndex], ?createAndGo}], ?line s(Vbs1), - ?line expect(1, inconsistentName, 1, any), + ?line ?expect3(inconsistentName, 1, any), RowPointer2 = ?usmUserCloneFrom ++ [11|"agentEngine"] ++ [7|"privDES"], Vbs2 = [{[usmUserCloneFrom, NewRowIndex], RowPointer2}, {[usmUserStatus, NewRowIndex], ?createAndGo}], ?line s(Vbs2), - ?line expect(2, wrongValue, 1, any), + ?line ?expect3(wrongValue, 1, any), RowPointer3 = ?usmUserSecurityName ++ [11|"agentEngine"] ++ [7|"privDES"], Vbs3 = [{[usmUserCloneFrom, NewRowIndex], RowPointer3}, {[usmUserStatus, NewRowIndex], ?createAndGo}], ?line s(Vbs3), - ?line expect(3, Vbs3), + ?line ?expect1(Vbs3), ?line s([{[usmUserAuthProtocol, NewRowIndex], ?usmNoAuthProtocol}]), - ?line expect(4, inconsistentValue, 1, any), + ?line ?expect3(inconsistentValue, 1, any), ?line s([{[usmUserAuthProtocol, NewRowIndex], ?usmHMACMD5AuthProtocol}]), - ?line expect(5, inconsistentValue, 1, any), + ?line ?expect3(inconsistentValue, 1, any), ?line s([{[usmUserAuthProtocol, NewRowIndex], ?usmDESPrivProtocol}]), - ?line expect(6, wrongValue, 1, any), + ?line ?expect3(wrongValue, 1, any), ?line s([{[usmUserPrivProtocol, NewRowIndex], ?usmHMACSHAAuthProtocol}]), - ?line expect(7, wrongValue, 1, any), + ?line ?expect3(wrongValue, 1, any), Vbs4 = [{[usmUserStatus, NewRowIndex], ?destroy}], ?line s(Vbs4), - ?line expect(1, Vbs4), - + ?line ?expect1(Vbs4), ok. @@ -5239,7 +5680,60 @@ loop_it_2(Oid, N) -> %%% Testing of reported bugs and other tickets. %%%----------------------------------------------------------------- +reported_bugs_cases() -> + [ + otp_1128, + otp_1129, + otp_1131, + otp_1162, + otp_1222, + otp_1298, + otp_1331, + otp_1338, + otp_1342, + otp_1366, + otp_2776, + otp_2979, + otp_3187, + otp_3725 + ]. + +reported_bugs2_cases() -> + [ + otp_1128_2, + otp_1129_2, + otp_1131_2, + otp_1162_2, + otp_1222_2, + otp_1298_2, + otp_1331_2, + otp_1338_2, + otp_1342_2, + otp_1366_2, + otp_2776_2, + otp_2979_2, + otp_3187_2 + ]. +reported_bugs3_cases() -> + [ + otp_1128_3, + otp_1129_3, + otp_1131_3, + otp_1162_3, + otp_1222_3, + otp_1298_3, + otp_1331_3, + otp_1338_3, + otp_1342_3, + otp_1366_3, + otp_2776_3, + otp_2979_3, + otp_3187_3, + otp_3542 + ]. + + %%----------------------------------------------------------------- %% Ticket: OTP-1128 %% Slogan: Bug in handling of createAndWait set-requests. @@ -5251,14 +5745,14 @@ otp_1128(Config) when is_list(Config) -> ?line load_master("OLD-SNMPEA-MIB"), ?line init_old(), - try_test(otp_1128), + try_test(otp_1128_test), ?line unload_master("OLD-SNMPEA-MIB"). otp_1128_2(X) -> ?P(otp_1128_2), otp_1128(X). otp_1128_3(X) -> ?P(otp_1128_3), otp_1128(X). -otp_1128() -> +otp_1128_test() -> io:format("Testing bug reported in ticket OTP-1128...~n"), NewKeyc3 = [intCommunityViewIndex,get(mip),is("test")], @@ -5266,15 +5760,16 @@ otp_1128() -> NewKeyc5 = [intCommunityStatus,get(mip),is("test")], s([{NewKeyc5, ?createAndWait}, {NewKeyc4, 2}]), - ?line expect(28, [{NewKeyc5, ?createAndWait}, {NewKeyc4, 2}]), + ?line ?expect1([{NewKeyc5, ?createAndWait}, {NewKeyc4, 2}]), g([NewKeyc5]), - ?line expect(29, [{NewKeyc5, ?notReady}]), + ?line ?expect1([{NewKeyc5, ?notReady}]), s([{NewKeyc5, ?active}, {NewKeyc3, 2}]), - ?line expect(30, [{NewKeyc5, ?active}, {NewKeyc3, 2}]), + ?line ?expect1([{NewKeyc5, ?active}, {NewKeyc3, 2}]), g([NewKeyc5]), - ?line expect(31, [{NewKeyc5, ?active}]), + ?line ?expect1([{NewKeyc5, ?active}]), s([{NewKeyc5, ?destroy}]), - ?line expect(32, [{NewKeyc5, ?destroy}]). + ?line ?expect1([{NewKeyc5, ?destroy}]). + %%----------------------------------------------------------------- %% Ticket: OTP-1129, OTP-1169 @@ -5297,6 +5792,7 @@ otp_1129_i(MaNode) -> false = rpc:call(MaNode, snmp, int_to_enum, [iso, 1]), false = rpc:call(MaNode, snmp, int_to_enum, [isox, 1]). + %%----------------------------------------------------------------- %% Ticket: OTP-1131 %% Slogan: Agent crashes / erlang node halts if RowIndex in a @@ -5309,7 +5805,7 @@ otp_1131(Config) when is_list(Config) -> init_case(Config), ?line load_master("Klas1"), - try_test(otp_1131), + try_test(otp_1131_test), ?line unload_master("Klas1"). otp_1131_2(X) -> ?P(otp_1131_2), otp_1131(X). @@ -5352,11 +5848,11 @@ otp_1131_3(X) -> ?P(otp_1131_3), otp_1131(X). -otp_1131() -> +otp_1131_test() -> io:format("Testing bug reported in ticket OTP-1131...~n"), s([{[friendsEntry, [2, 3, 1]], s, "kompis3"}, {[friendsEntry, [3, 3, 1]], i, ?createAndGo}]), - ?line expect(1, ?v1_2(noSuchName, noCreation), 2, any). + ?line ?expect3(?v1_2(noSuchName, noCreation), 2, any). %%----------------------------------------------------------------- @@ -5368,16 +5864,16 @@ otp_1162(Config) when is_list(Config) -> ?P(otp_1162), {SaNode, _MgrNode, _MibDir} = init_case(Config), ?line {ok, SA} = start_subagent(SaNode, ?sa, "SA-MIB"), - try_test(otp_1162), + try_test(otp_1162_test), stop_subagent(SA). otp_1162_2(X) -> ?P(otp_1162_2), otp_1162(X). otp_1162_3(X) -> ?P(otp_1162_3), otp_1162(X). -otp_1162() -> +otp_1162_test() -> s([{[sa, [2,0]], 6}]), % wrongValue (i is_set_ok) - ?line expect(1, ?v1_2(badValue, wrongValue), 1, any). + ?line ?expect3(?v1_2(badValue, wrongValue), 1, any). %%----------------------------------------------------------------- @@ -5390,7 +5886,7 @@ otp_1222(Config) when is_list(Config) -> init_case(Config), ?line load_master("Klas3"), ?line load_master("Klas4"), - try_test(otp_1222), + try_test(otp_1222_test), ?line unload_master("Klas3"), ?line unload_master("Klas4"). @@ -5398,12 +5894,13 @@ otp_1222_2(X) -> ?P(otp_1222_2), otp_1222(X). otp_1222_3(X) -> ?P(otp_1222_3), otp_1222(X). -otp_1222() -> +otp_1222_test() -> io:format("Testing bug reported in ticket OTP-1222...~n"), s([{[fStatus4,1], 4}, {[fName4,1], 1}]), - ?line expect(1, genErr, 0, any), + ?line ?expect3(genErr, 0, any), s([{[fStatus4,2], 4}, {[fName4,2], 1}]), - ?line expect(2, genErr, 0, any). + ?line ?expect3(genErr, 0, any). + %%----------------------------------------------------------------- %% Ticket: OTP-1298 @@ -5415,17 +5912,17 @@ otp_1298(Config) when is_list(Config) -> init_case(Config), ?line load_master("Klas2"), - try_test(otp_1298), + try_test(otp_1298_test), ?line unload_master("Klas2"). otp_1298_2(X) -> ?P(otp_1298_2), otp_1298(X). otp_1298_3(X) -> ?P(otp_1298_3), otp_1298(X). -otp_1298() -> +otp_1298_test() -> io:format("Testing bug reported in ticket OTP-1298...~n"), s([{[fint,0], -1}]), - ?line expect(1298, [{[fint,0], -1}]). + ?line ?expect1([{[fint,0], -1}]). %%----------------------------------------------------------------- @@ -5438,17 +5935,17 @@ otp_1331(Config) when is_list(Config) -> init_case(Config), ?line load_master("OLD-SNMPEA-MIB"), ?line init_old(), - try_test(otp_1331), + try_test(otp_1331_test), ?line unload_master("OLD-SNMPEA-MIB"). otp_1331_2(X) -> ?P(otp_1331_2), otp_1331(X). otp_1331_3(X) -> ?P(otp_1331_3), otp_1331(X). -otp_1331() -> +otp_1331_test() -> NewKeyc5 = [intCommunityStatus,[127,32,0,0],is("test")], s([{NewKeyc5, ?destroy}]), - ?line expect(1, [{NewKeyc5, ?destroy}]). + ?line ?expect1([{NewKeyc5, ?destroy}]). %%----------------------------------------------------------------- @@ -5461,18 +5958,19 @@ otp_1338(Config) when is_list(Config) -> init_case(Config), ?line load_master("Klas2"), - try_test(otp_1338), + try_test(otp_1338_test), ?line unload_master("Klas2"). otp_1338_2(X) -> ?P(otp_1338_2), otp_1338(X). otp_1338_3(X) -> ?P(otp_1338_3), otp_1338(X). -otp_1338() -> +otp_1338_test() -> s([{[kStatus2, 7], i, ?createAndGo}]), - ?line expect(1, [{[kStatus2, 7], ?createAndGo}]), + ?line ?expect1([{[kStatus2, 7], ?createAndGo}]), g([[kName2, 7]]), - ?line expect(2, [{[kName2, 7], "JJJ"}]). + ?line ?expect1([{[kName2, 7], "JJJ"}]). + %%----------------------------------------------------------------- %% Ticket: OTP-1342 @@ -5484,18 +5982,18 @@ otp_1342(Config) when is_list(Config) -> ?P(otp_1342), init_case(Config), ?line load_master("Klas4"), - try_test(otp_1342), + try_test(otp_1342_test), ?line unload_master("Klas4"). otp_1342_2(X) -> ?P(otp_1342_2), otp_1342(X). otp_1342_3(X) -> ?P(otp_1342_3), otp_1342(X). -otp_1342() -> +otp_1342_test() -> s([{[fIndex5, 1], i, 1}, {[fName5, 1], i, 3}, {[fStatus5, 1], i, ?createAndGo}]), - ?line expect(1, ?v1_2(noSuchName, noCreation), 3, any). + ?line ?expect3(?v1_2(noSuchName, noCreation), 3, any). %%----------------------------------------------------------------- @@ -5510,17 +6008,18 @@ otp_1366(Config) when is_list(Config) -> init_case(Config), ?line load_master("OLD-SNMPEA-MIB"), ?line init_old(), - try_test(otp_1366), + try_test(otp_1366_test), ?line unload_master("OLD-SNMPEA-MIB"). otp_1366_2(X) -> ?P(otp_1366_2), otp_1366(X). otp_1366_3(X) -> ?P(otp_1366_3), otp_1366(X). -otp_1366() -> +otp_1366_test() -> ?INF("NOT YET IMPLEMENTED", []), 'NYI'. + %%----------------------------------------------------------------- %% Ticket: OTP-2776 %% Slogan: snmp:validate_date_and_time() fails when time is 00:00 @@ -5529,13 +6028,13 @@ otp_2776(suite) -> []; otp_2776(Config) when is_list(Config) -> ?P(otp_2776), init_case(Config), - try_test(otp_2776). + try_test(otp_2776_test). otp_2776_2(X) -> ?P(otp_2776_2), otp_2776(X). otp_2776_3(X) -> ?P(otp_2776_3), otp_2776(X). -otp_2776() -> +otp_2776_test() -> io:format("Testing bug reported in ticket OTP-2776...~n"), Dt01_valid = [19,98,9,1,1,0,23,0,43,0,0], @@ -5598,17 +6097,18 @@ otp_2979(Config) when is_list(Config) -> init_case(Config), ?line load_master("Test1"), ?line init_old(), - try_test(otp_2979), + try_test(otp_2979_test), ?line unload_master("Test1"). otp_2979_2(X) -> ?P(otp_2979_2), otp_2979(X). otp_2979_3(X) -> ?P(otp_2979_3), otp_2979(X). -otp_2979() -> +otp_2979_test() -> gn([[sparseDescr], [sparseStatus]]), - ?line expect(1, [{[sparseStr,0], "slut"}, - {[sparseStr,0], "slut"}]). + ?line ?expect1([{[sparseStr,0], "slut"}, + {[sparseStr,0], "slut"}]). + %%----------------------------------------------------------------- %% Ticket: OTP-3187 @@ -5620,14 +6120,14 @@ otp_3187(Config) when is_list(Config) -> ?P(otp_3187), init_case(Config), ?line load_master_std("SNMP-VIEW-BASED-ACM-MIB"), - otp_3187(), + otp_3187_test(), ?line unload_master("SNMP-VIEW-BASED-ACM-MIB"). otp_3187_2(X) -> ?P(otp_3187_2), otp_3187(X). otp_3187_3(X) -> ?P(otp_3187_3), otp_3187(X). -otp_3187() -> +otp_3187_test() -> ?line Elements = snmp_view_based_acm_mib:vacmAccessTable(get_next,[],[4,5,6]), lists:foreach(fun(E) -> @@ -5645,9 +6145,9 @@ otp_3542(suite) -> []; otp_3542(Config) when is_list(Config) -> ?P(otp_3542), init_case(Config), - try_test(otp_3542). + try_test(otp_3542_test). -otp_3542() -> +otp_3542_test() -> io:format("SNMP v3 discovery...~n"), ?line Res = snmp_test_mgr:d(), io:format("SNMP v3 discovery result: ~p~n",[Res]). @@ -5716,10 +6216,15 @@ otp_3725_test(MaNode) -> %% Slogan: Target mib tag list check invalid %%----------------------------------------------------------------- +tickets1_cases() -> + [ + {group, otp4394}, + {group, otp7157} + ]. + - -init_otp_4394(Config) when is_list(Config) -> - ?DBG("init_otp_4394 -> entry with" +otp_4394_init(Config) when is_list(Config) -> + ?DBG("otp_4394_init -> entry with" "~n Config: ~p", [Config]), ?line AgentConfDir = ?config(agent_conf_dir, Config), ?line MgrDir = ?config(mgr_dir, Config), @@ -5772,35 +6277,35 @@ otp_4394_config(AgentConfDir, MgrDir, Ip0) -> -finish_otp_4394(Config) when is_list(Config) -> +otp_4394_finish(Config) when is_list(Config) -> ?DBG("finish_otp_4394 -> entry", []), C1 = stop_agent(Config), delete_files(C1), erase(mgr_node), lists:keydelete(vsn, 1, C1). -otp_4394_test(suite) -> []; -otp_4394_test(Config) -> - ?P(otp_4394_test), - ?DBG("otp_4394_test -> entry", []), +otp_4394(suite) -> []; +otp_4394(Config) -> + ?P(otp_4394), + ?DBG("otp_4394 -> entry", []), init_case(Config), - try_test(otp_4394_test1), - ?DBG("otp_4394_test -> done", []), + try_test(otp_4394_test), + ?DBG("otp_4394 -> done", []), ok. -otp_4394_test1() -> - ?DBG("otp_4394_test1 -> entry", []), +otp_4394_test() -> + ?DBG("otp_4394_test -> entry", []), gn([[1,1]]), Res = case snmp_test_mgr:expect(1, [{[sysDescr,0], "Erlang SNMP agent"}]) of %% {error, 1, {"?",[]}, {"~w",[timeout]}} {error, 1, _, {_, [timeout]}} -> - ?DBG("otp_4394_test1 -> expected result: timeout", []), + ?DBG("otp_4394_test -> expected result: timeout", []), ok; Else -> Else end, - ?DBG("otp_4394_test1 -> done with: ~p", [Res]), + ?DBG("otp_4394_test -> done with: ~p", [Res]), Res. @@ -5811,7 +6316,7 @@ otp_4394_test1() -> -init_otp_7157(Config) when is_list(Config) -> +otp_7157_init(Config) when is_list(Config) -> %% <CONDITIONAL-SKIP> Skippable = [win32], Condition = fun() -> ?OS_BASED_SKIP(Skippable) end, @@ -5831,30 +6336,30 @@ init_otp_7157(Config) when is_list(Config) -> [{vsn, v2} | start_v2_agent(Config, Opts)]. -finish_otp_7157(Config) when is_list(Config) -> +otp_7157_finish(Config) when is_list(Config) -> ?DBG("finish_otp_7157 -> entry", []), C1 = stop_agent(Config), delete_files(C1), erase(mgr_node), lists:keydelete(vsn, 1, C1). -otp_7157_test(suite) -> []; -otp_7157_test(Config) -> - ?P(otp_7157_test), - ?DBG("otp_7157_test -> entry", []), +otp_7157(suite) -> []; +otp_7157(Config) -> + ?P(otp_7157), + ?DBG("otp_7157 -> entry", []), init_case(Config), MA = whereis(snmp_master_agent), ?line load_master("Test1"), - try_test(otp_7157_test1, [MA]), + try_test(otp_7157_test, [MA]), ?line unload_master("Test1"), - ?DBG("otp_7157_test -> done", []), + ?DBG("otp_7157 -> done", []), ok. %% ts:run(snmp, snmp_agent_test, [batch]). -otp_7157_test1(MA) -> - ?LOG("start otp_7157_test1 test (~p)",[MA]), +otp_7157_test(MA) -> + ?LOG("start otp_7157_test test (~p)",[MA]), snmpa:verbosity(MA, trace), - ?LOG("start otp_7157_test1 test",[]), + ?LOG("start otp_7157_test test",[]), ?P1("Testing that varbinds in traps/notifications are not reordered"), ?DBG("send cntTrap",[]), @@ -5862,11 +6367,11 @@ otp_7157_test1(MA) -> ?DBG("await response",[]), %% We don't really care about the values, just the vb order. - ?line ok = expect(1, v2trap, [{[sysUpTime, 0], any}, - {[snmpTrapOID, 0], any}, - {[sysContact, 0], any}, - {[cnt64, 0], any}, - {[sysLocation, 0], any}]), + ?line ok = ?expect2(v2trap, [{[sysUpTime, 0], any}, + {[snmpTrapOID, 0], any}, + {[sysContact, 0], any}, + {[cnt64, 0], any}, + {[sysLocation, 0], any}]), ?DBG("done", []), ok. @@ -5878,6 +6383,13 @@ otp_7157_test1(MA) -> %% These cases are started in the new way %%----------------------------------------------------------------- +tickets2_cases() -> + [ + otp8395, + otp9884 + ]. + + otp8395({init, Config}) when is_list(Config) -> ?DBG("otp8395(init) -> entry with" "~n Config: ~p", [Config]), @@ -6336,13 +6848,13 @@ process_options(Defaults, _Opts) -> %% {value, {Key, Value}} when is_list-> -snmp_app_env_init(Node, Entity, Conf) -> - rpc:call(Node, snmp_app_env_init, [Entity, Conf]). +%% snmp_app_env_init(Node, Entity, Conf) -> +%% rpc:call(Node, snmp_app_env_init, [Entity, Conf]). -snmp_app_env_init(Entity, Conf) -> - application:unload(snmp), - application:load(snmp), - application:set_env(snmp, Entity, Conf). +%% snmp_app_env_init(Entity, Conf) -> +%% application:unload(snmp), +%% application:load(snmp), +%% application:set_env(snmp, Entity, Conf). start_stdalone_agent(Node, Config) -> rpc:call(Node, ?MODULE, start_stdalone_agent, [Config]). @@ -6403,10 +6915,10 @@ info_test(Config) when is_list(Config) -> ?line load_master("OLD-SNMPEA-MIB"), ?line init_old(), - try_test(info_test1, [node()]), + try_test(do_info, [node()]), ?line unload_master("OLD-SNMPEA-MIB"). -info_test1(MaNode) -> +do_info(MaNode) -> ?line Info = rpc:call(MaNode, snmpa, info, []), ?DBG("info_test1 -> Info: ~n~p", [Info]), Keys = [vsns, @@ -6482,7 +6994,7 @@ verify_old_info([Key|Keys], Info) -> ?FAIL({missing_old_info, Key}) end. -%% string used in index +%% Index String - string used in index is(S) -> [length(S) | S]. try_test(Func) -> @@ -6500,16 +7012,11 @@ try_test(Func, A, Opts) -> %% Test manager wrapperfunctions: g(Oids) -> snmp_test_mgr:g(Oids). -gn() -> snmp_test_mgr:gn(). +%%gn() -> snmp_test_mgr:gn(). gn(OidsOrN) -> snmp_test_mgr:gn(OidsOrN). gb(NR, MR, Oids) -> snmp_test_mgr:gb(NR, MR, Oids). s(VAV) -> snmp_test_mgr:s(VAV). -expect(A, B) -> snmp_agent_test_lib:expect(A, B). -expect(A, B, C) -> snmp_agent_test_lib:expect(A, B, C). -expect(A, B, C, D) -> snmp_agent_test_lib:expect(A, B, C, D). -expect(A, B, C, D, E, F) -> snmp_agent_test_lib:expect(A, B, C, D, E, F). - get_req(Id, Vars) -> snmp_agent_test_lib:get_req(Id, Vars). @@ -6545,8 +7052,8 @@ rewrite_usm_mgr(Dir, ShaKey, DesKey) -> reset_usm_mgr(Dir) -> snmp_agent_test_lib:reset_usm_mgr(Dir). -update_community(Vsns, DIr) -> - snmp_agent_test_lib:update_community(Vsns, DIr). +%% update_community(Vsns, Dir) -> +%% snmp_agent_test_lib:update_community(Vsns, Dir). update_vacm(Vsn, Dir) -> snmp_agent_test_lib:update_vacm(Vsn, Dir). @@ -6579,8 +7086,8 @@ reset_target_params_conf(Dir) -> write_notify_conf(Dir) -> snmp_agent_test_lib:write_notify_conf(Dir). -write_view_conf(Dir) -> - snmp_agent_test_lib:write_view_conf(Dir). +%% write_view_conf(Dir) -> +%% snmp_agent_test_lib:write_view_conf(Dir). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -6742,8 +7249,8 @@ lists_key1search(Key, List) when is_atom(Key) -> end. -regs() -> - lists:sort(registered()). +%% regs() -> +%% lists:sort(registered()). %% ------ diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl index 757aebfa9b..11c05fc1db 100644 --- a/lib/snmp/test/snmp_agent_test_lib.erl +++ b/lib/snmp/test/snmp_agent_test_lib.erl @@ -28,7 +28,7 @@ start_mt_agent/1, start_mt_agent/2, stop_agent/1, - start_sup/0, stop_sup/2, + %% start_sup/0, stop_sup/2, start_subagent/3, stop_subagent/1, start_sub_sup/1, start_sub_sup/2, @@ -58,7 +58,7 @@ init_all/1, finish_all/1, init_case/1, try_test/2, try_test/3, try_test/4, - expect/2, expect/3, expect/4, expect/6, + expect/3, expect/4, expect/5, expect/7, regs/0, rpc/3 @@ -418,10 +418,10 @@ start_bilingual_agent(Config, Opts) start_agent(Config, [v1,v2], Opts). start_mt_agent(Config) when is_list(Config) -> - start_agent(Config, [v2], [{snmp_multi_threaded, true}]). + start_agent(Config, [v2], [{multi_threaded, true}]). start_mt_agent(Config, Opts) when is_list(Config) andalso is_list(Opts) -> - start_agent(Config, [v2], [{snmp_multi_threaded, true}|Opts]). + start_agent(Config, [v2], [{multi_threaded, true}|Opts]). start_agent(Config, Vsns) -> start_agent(Config, Vsns, []). @@ -437,79 +437,231 @@ start_agent(Config, Vsns, Opts) -> ?line AgentDbDir = ?config(agent_db_dir, Config), ?line SaNode = ?config(snmp_sa, Config), - app_env_init(vsn_init(Vsns) ++ - [{audit_trail_log, read_write_log}, - {audit_trail_log_dir, AgentLogDir}, - {audit_trail_log_size, {10240, 10}}, - {force_config_reload, false}, - {snmp_agent_type, master}, - {snmp_config_dir, AgentConfDir}, - {snmp_db_dir, AgentDbDir}, - {snmp_local_db_auto_repair, true}, - {snmp_local_db_verbosity, log}, - {snmp_master_agent_verbosity, trace}, - {snmp_supervisor_verbosity, trace}, - {snmp_mibserver_verbosity, log}, - {snmp_symbolic_store_verbosity, log}, - {snmp_note_store_verbosity, log}, - {snmp_net_if_verbosity, trace}], - Opts), - + Env = app_agent_env_init( + [{versions, Vsns}, + {agent_type, master}, + {agent_verbosity, trace}, + {db_dir, AgentDbDir}, + {audit_trail_log, [{type, read_write}, + {dir, AgentLogDir}, + {size, {10240, 10}}]}, + {config, [{dir, AgentConfDir}, + {force_load, false}, + {verbosity, trace}]}, + {local_db, [{repair, true}, + {verbosity, log}]}, + {mib_server, [{verbosity, log}]}, + {symbolic_store, [{verbosity, log}]}, + {note_store, [{verbosity, log}]}, + {net_if, [{verbosity, trace}]}], + Opts), + process_flag(trap_exit,true), {ok, AppSup} = snmp_app_sup:start_link(), unlink(AppSup), - ?DBG("start_agent -> snmp app supervisor: ~p",[AppSup]), + ?DBG("start_agent -> snmp app supervisor: ~p", [AppSup]), - ?DBG("start_agent -> start master agent (old style)",[]), - ?line Sup = start_sup(), + ?DBG("start_agent -> start master agent",[]), + ?line Sup = start_sup(Env), - ?DBG("start_agent -> unlink from supervisor",[]), + ?DBG("start_agent -> unlink from supervisor", []), ?line unlink(Sup), ?line SaDir = ?config(sa_dir, Config), - ?DBG("start_agent -> (rpc) start sub on ~p",[SaNode]), + ?DBG("start_agent -> (rpc) start sub on ~p", [SaNode]), ?line {ok, Sub} = start_sub_sup(SaNode, SaDir), ?DBG("start_agent -> done",[]), ?line [{snmp_sup, {Sup, self()}}, {snmp_sub, Sub} | Config]. -vsn_init(Vsn) -> - vsn_init([v1,v2,v3], Vsn, []). +app_agent_env_init(Env0, Opts) -> + ?DBG("app_agent_env_init -> unload snmp",[]), + ?line application:unload(snmp), + + ?DBG("app_agent_env_init -> load snmp",[]), + ?line application:load(snmp), -vsn_init([], _Vsn, Acc) -> - Acc; -vsn_init([V|Vsns], Vsn, Acc) -> - case lists:member(V, Vsn) of - true -> - vsn_init(Vsns, Vsn, [{V, true}|Acc]); - false -> - vsn_init(Vsns, Vsn, [{V, false}|Acc]) + ?DBG("app_agent_env_init -> " + "merge or maybe replace (snmp agent) app env",[]), + Env = add_or_maybe_merge_agent_env(Opts, Env0), + ?DBG("app_agent_env_init -> merged env: " + "~n ~p", [Env]), + + %% We put it into the app environment just as + %% a precaution, since when starting normally, + %% this is where the environment is extracted from. + app_agent_set_env(Env), + Env. + +app_agent_set_env(Value) -> + application_controller:set_env(snmp, agent, Value). + +add_or_maybe_merge_agent_env([], Env) -> + ?DBG("merging agent env -> merged", []), + lists:keysort(1, Env); +add_or_maybe_merge_agent_env([{Key, Value1}|Opts], Env) -> + ?DBG("merging agent env -> add, replace or merge ~p", [Key]), + case lists:keysearch(Key, 1, Env) of + {value, {Key, Value1}} -> + %% Identical, move on + ?DBG("merging agent env -> " + "no need to merge ~p - identical - keep: " + "~n ~p", [Key, Value1]), + add_or_maybe_merge_agent_env(Opts, Env); + {value, {Key, Value2}} -> + %% Another value, merge or replace + NewValue = merge_or_replace_agent_env(Key, Value1, Value2), + Env2 = lists:keyreplace(Key, 1, Env, {Key, NewValue}), + add_or_maybe_merge_agent_env(Opts, Env2); + false -> + ?DBG("merging agent env -> no old ~p to merge with - add: " + "~n ~p", [Key, Value1]), + add_or_maybe_merge_agent_env(Opts, [{Key, Value1}|Env]) end. -app_env_init(Env0, Opts) -> - ?DBG("app_env_init -> unload snmp",[]), - ?line application:unload(snmp), - ?DBG("app_env_init -> load snmp",[]), - ?line application:load(snmp), - ?DBG("app_env_init -> initiate (snmp) application env",[]), - F1 = fun({Key, Val} = New, Acc0) -> - ?DBG("app_env_init -> " - "updating setting ~p to ~p", [Key, Val]), - case lists:keyreplace(Key, 1, Acc0, New) of - Acc0 -> - [New|Acc0]; - Acc -> - Acc - end - end, - Env = lists:foldr(F1, Env0, Opts), - ?DBG("app_env_init -> Env: ~p",[Env]), - F2 = fun({Key,Val}) -> - ?DBG("app_env_init -> setting ~p to ~p",[Key, Val]), - application_controller:set_env(snmp, Key, Val) - end, - lists:foreach(F2, Env). +merge_or_replace_agent_env(versions, NewVersions, _OldVersions) -> + ?DBG("merging agent env -> versions replaced: ~p -> ~p", + [NewVersions, _OldVersions]), + NewVersions; +merge_or_replace_agent_env(agent_type, NewType, _OldType) -> + ?DBG("merging agent env -> agent type replaced: ~p -> ~p", + [NewType, _OldType]), + NewType; +merge_or_replace_agent_env(agent_verbosity, NewVerbosity, _OldVerbosity) -> + ?DBG("merging agent env -> agent verbosity replaced: ~p -> ~p", + [NewVerbosity, _OldVerbosity]), + NewVerbosity; +merge_or_replace_agent_env(db_dir, NewDbDir, _OldDbDir) -> + ?DBG("merging agent env -> db-dir replaced: ~p -> ~p", + [NewDbDir, _OldDbDir]), + NewDbDir; +merge_or_replace_agent_env(audit_trail_log, NewATL, OldATL) -> + merge_or_replace_agent_env_atl(NewATL, OldATL); +merge_or_replace_agent_env(config, NewConfig, OldConfig) -> + merge_or_replace_agent_env_config(NewConfig, OldConfig); +merge_or_replace_agent_env(local_db, NewLdb, OldLdb) -> + merge_or_replace_agent_env_ldb(NewLdb, OldLdb); +merge_or_replace_agent_env(mib_storage, NewMst, OldMst) -> + merge_or_replace_agent_env_mib_storage(NewMst, OldMst); +merge_or_replace_agent_env(mib_server, NewMibs, OldMibs) -> + merge_or_replace_agent_env_mib_server(NewMibs, OldMibs); +merge_or_replace_agent_env(symbolic_store, NewSymStore, OldSymStore) -> + merge_or_replace_agent_env_symbolic_store(NewSymStore, OldSymStore); +merge_or_replace_agent_env(note_store, NewNoteStore, OldNoteStore) -> + merge_or_replace_agent_env_note_store(NewNoteStore, OldNoteStore); +merge_or_replace_agent_env(net_if, NewNetIf, OldNetIf) -> + merge_or_replace_agent_env_net_if(NewNetIf, OldNetIf); +merge_or_replace_agent_env(Key, NewValue, OldValue) -> + ?FAIL({not_implemented_merge_or_replace, + Key, NewValue, OldValue}). + +merge_or_replace_agent_env_atl(New, Old) -> + ATL = merge_agent_options(New, Old), + ?DBG("merging agent env -> audit-trail-log merged: " + "~n ~p | ~p -> ~p", [New, Old, ATL]), + ATL. + +merge_or_replace_agent_env_config(New, Old) -> + Config = merge_agent_options(New, Old), + case lists:keymember(dir, 1, Config) of + true -> + ?DBG("merging agent env -> config merged: " + "~n ~p | ~p -> ~p", [New, Old, Config]), + Config; + false -> + ?FAIL({missing_mandatory_option, {config, dir}}) + end. + +merge_or_replace_agent_env_ldb(New, Old) -> + LDB = merge_agent_options(New, Old), + ?DBG("merging agent env -> local-db merged: " + "~n ~p | ~p -> ~p", [New, Old, LDB]), + LDB. + +merge_or_replace_agent_env_mib_storage(NewMibStorage, OldMibStorage) -> + %% Shall we merge or replace? + %% module is mandatory. We will only merge if NewModule is + %% equal to OldModule. + NewModule = + case lists:keysearch(module, 1, NewMibStorage) of + {value, {module, M}} -> + M; + false -> + ?FAIL({missing_mandatory_option, {mib_storage, module}}) + end, + case lists:keysearch(module, 1, OldMibStorage) of + {value, {module, NewModule}} -> + %% Same module => merge + %% Non-ex new options => remove + %% Ex new options and non-ex old options => replace + %% Otherwise merge + case lists:keysearch(options, 1, NewMibStorage) of + false -> + ?DBG("merging agent env -> " + "no mib-storage ~p merge needed - " + "no new options (= remove old options)", [NewModule]), + NewMibStorage; + {value, {options, NewOptions}} -> + case lists:keysearch(options, 1, OldMibStorage) of + false -> + ?DBG("merging agent env -> " + "no mib-storage ~p merge needed - " + "no old options", [NewModule]), + NewMibStorage; + {value, {options, OldOptions}} -> + MergedOptions = + merge_agent_options(NewOptions, OldOptions), + ?DBG("merging agent env -> mib-storage ~p merged: " + "~n Options: ~p | ~p -> ~p", + [NewModule, + NewOptions, OldOptions, MergedOptions]), + [{module, NewModule}, + {options, MergedOptions}] + end + end; + _ -> + %% Diff module => replace + ?DBG("merging agent env -> " + "no mib-storage ~p merge needed - " + "new module", [NewModule]), + NewMibStorage + end. + +merge_or_replace_agent_env_mib_server(New, Old) -> + MibServer = merge_agent_options(New, Old), + ?DBG("merging agent env -> mib-server merged: " + "~n ~p | ~p -> ~p", [New, Old, MibServer]), + MibServer. + +merge_or_replace_agent_env_symbolic_store(New, Old) -> + SymbolicStore = merge_agent_options(New, Old), + ?DBG("merging agent env -> symbolic-store merged: " + "~n ~p | ~p -> ~p", [New, Old, SymbolicStore]), + SymbolicStore. + +merge_or_replace_agent_env_note_store(New, Old) -> + NoteStore = merge_agent_options(New, Old), + ?DBG("merging agent env -> note-store merged: " + "~n ~p | ~p -> ~p", [New, Old, NoteStore]), + NoteStore. + +merge_or_replace_agent_env_net_if(New, Old) -> + NetIf = merge_agent_options(New, Old), + ?DBG("merging agent env -> net-if merged: " + "~n ~p | ~p -> ~p", [New, Old, NetIf]), + NetIf. + +merge_agent_options([], Options) -> + lists:keysort(1, Options); +merge_agent_options([{Key, _Value} = Opt|Opts], Options) -> + case lists:keysearch(Key, 1, Options) of + {value, _} -> + NewOptions = lists:keyreplace(Key, 1, Options, Opt), + merge_agent_options(Opts, NewOptions); + false -> + merge_agent_options(Opts, [Opt|Options]) + end. stop_agent(Config) when is_list(Config) -> @@ -544,8 +696,8 @@ stop_agent(Config) when is_list(Config) -> lists:keydelete(snmp_sub, 1, C1). -start_sup() -> - case (catch snmpa_app:start(normal)) of +start_sup(Env) -> + case (catch snmp_app_sup:start_agent(normal, Env)) of {ok, S} -> ?DBG("start_agent -> started, Sup: ~p",[S]), S; @@ -553,7 +705,7 @@ start_sup() -> Else -> ?DBG("start_agent -> unknown result: ~n~p",[Else]), %% Get info about the apps we depend on - ?FAIL({start_failed,Else, ?IS_MNESIA_RUNNING()}) + ?FAIL({start_failed, Else, ?IS_MNESIA_RUNNING()}) end. stop_sup(Pid, _) when (node(Pid) =:= node()) -> @@ -594,7 +746,7 @@ start_sub_sup(Node, Dir) -> start_sub_sup(Dir) -> ?DBG("start_sub -> entry",[]), - Opts = [{db_dir, Dir}, + Opts = [{db_dir, Dir}, {supervisor, [{verbosity, trace}]}], {ok, P} = snmpa_supervisor:start_sub_sup(Opts), unlink(P), @@ -690,31 +842,33 @@ agent_info(Sup) -> %% --- +%% The first two arguments are simple to be able to find where in the +%% (test) code this call is made. -expect(Id, A) -> - Fun = fun() -> do_expect(A) end, - expect2(Id, Fun). +expect(Mod, Line, What) -> + Fun = fun() -> do_expect(What) end, + expect2(Mod, Line, Fun). -expect(Id, A, B) -> - Fun = fun() -> do_expect(A, B) end, - expect2(Id, Fun). +expect(Mod, Line, What, ExpVBs) -> + Fun = fun() -> do_expect(What, ExpVBs) end, + expect2(Mod, Line, Fun). -expect(Id, A, B, C) -> - Fun = fun() -> do_expect(A, B, C) end, - expect2(Id, Fun). +expect(Mod, Line, Error, Index, ExpVBS) -> + Fun = fun() -> do_expect(Error, Index, ExpVBS) end, + expect2(Mod, Line, Fun). -expect(Id, A, B, C, D, E) -> - Fun = fun() -> do_expect(A, B, C, D, E) end, - expect2(Id, Fun). +expect(Mod, Line, Type, Enterp, Generic, Specific, ExpVBs) -> + Fun = fun() -> do_expect(Type, Enterp, Generic, Specific, ExpVBs) end, + expect2(Mod, Line, Fun). -expect2(Id, F) -> - io:format("EXPECT for ~w~n", [Id]), +expect2(Mod, Line, F) -> + io:format("EXPECT for ~w:~w~n", [Mod, Line]), case F() of {error, Reason} -> - io:format("EXPECT failed for ~w: ~n~p~n", [Id, Reason]), - throw({error, {expect, Id, Reason}}); + io:format("EXPECT failed at ~w:~w => ~n~p~n", [Mod, Line, Reason]), + throw({error, {expect, Mod, Line, Reason}}); Else -> - io:format("EXPECT result for ~w: ~n~p~n", [Id, Else]), + io:format("EXPECT result for ~w:~w => ~n~p~n", [Mod, Line, Else]), Else end. @@ -766,7 +920,8 @@ do_expect({timeout, To}) -> end; do_expect({Err, To}) - when is_atom(Err) andalso (is_integer(To) orelse (To =:= infinity)) -> + when (is_atom(Err) andalso + ((is_integer(To) andalso To > 0) orelse (To =:= infinity))) -> io:format("EXPECT error ~w within ~w~n", [Err, To]), do_expect({{error, Err}, To}); diff --git a/lib/snmp/test/snmp_test_lib.erl b/lib/snmp/test/snmp_test_lib.erl index f0abae73e8..505332b586 100644 --- a/lib/snmp/test/snmp_test_lib.erl +++ b/lib/snmp/test/snmp_test_lib.erl @@ -435,7 +435,7 @@ crypto_start() -> end. crypto_support() -> - crypto_support([md5_mac_96, sha_mac_96], []). + crypto_support([md5, sha], []). crypto_support([], []) -> yes; @@ -450,12 +450,7 @@ crypto_support([Func|Funcs], Acc) -> end. is_crypto_supported(Func) -> - %% The 'catch' handles the case when 'crypto' is - %% not present in the system (or not started). - case (catch lists:member(Func, crypto:info())) of - true -> true; - _ -> false - end. + snmp_misc:is_crypto_supported(Func). %% ---------------------------------------------------------------- diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index fb7aa52402..0e48e7ea56 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 4.23.1 +SNMP_VSN = 4.24 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 3b8145089e..cf9f7d5001 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -42,31 +42,37 @@ BEHAVIOUR_MODULES= \ MODULES= \ ssl \ + tls \ + dtls \ ssl_alert \ ssl_app \ ssl_dist_sup\ ssl_sup \ inet_tls_dist \ ssl_certificate\ - ssl_certificate_db\ + ssl_pkix_db\ ssl_cipher \ ssl_srp_primes \ - ssl_connection \ + tls_connection \ + dtls_connection \ ssl_connection_sup \ - ssl_handshake \ + tls_handshake \ + dtls_handshake\ ssl_manager \ ssl_session \ ssl_session_cache \ ssl_socket \ - ssl_record \ + tls_record \ + dtls_record \ ssl_ssl2 \ ssl_ssl3 \ ssl_tls1 \ ssl_tls_dist_proxy INTERNAL_HRL_FILES = \ - ssl_alert.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_internal.hrl \ - ssl_record.hrl ssl_srp.hrl + ssl_alert.hrl ssl_cipher.hrl ssl_handshake.hrl tls_handshake.hrl \ + dtls_handshake.hrl ssl_internal.hrl \ + ssl_record.hrl tls_record.hrl dtls_record.hrl ssl_srp.hrl ERL_FILES= \ $(MODULES:%=%.erl) \ @@ -134,13 +140,14 @@ release_docs_spec: # Dependencies # ---------------------------------------------------- $(EBIN)/inet_tls_dist.$(EMULATOR): ../../kernel/include/net_address.hrl ../../kernel/include/dist.hrl ../../kernel/include/dist_util.hrl -$(EBIN)/ssl.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ../../public_key/include/public_key.hrl +$(EBIN)/tls.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ../../public_key/include/public_key.hrl $(EBIN)/ssl_alert.$(EMULATOR): ssl_alert.hrl ssl_record.hrl $(EBIN)/ssl_certificate.$(EMULATOR): ssl_internal.hrl ssl_alert.hrl ssl_handshake.hrl ../../public_key/include/public_key.hrl $(EBIN)/ssl_certificate_db.$(EMULATOR): ssl_internal.hrl ../../public_key/include/public_key.hrl ../../kernel/include/file.hrl $(EBIN)/ssl_cipher.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl -$(EBIN)/ssl_connection.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl -$(EBIN)/ssl_handshake.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl +$(EBIN)/tls_connection.$(EMULATOR): ssl_internal.hrl tls_record.hrl ssl_cipher.hrl tls_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl +$(EBIN)/dtls_connection.$(EMULATOR): ssl_internal.hrl dtls_record.hrl ssl_cipher.hrl dtls_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl +$(EBIN)/tls_handshake.$(EMULATOR): ssl_internal.hrl tls_record.hrl ssl_cipher.hrl tls_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl $(EBIN)/ssl_manager.$(EMULATOR): ssl_internal.hrl ssl_handshake.hrl ../../kernel/include/file.hrl $(EBIN)/ssl_record.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl $(EBIN)/ssl_session.$(EMULATOR): ssl_internal.hrl ssl_handshake.hrl diff --git a/lib/ssl/src/ssl_debug.hrl b/lib/ssl/src/dtls.erl index e88cef441f..013286c9bd 100644 --- a/lib/ssl/src/ssl_debug.hrl +++ b/lib/ssl/src/dtls.erl @@ -1,39 +1,25 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2013. 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% %% %% +%%% Purpose : API for DTLS. --ifndef(ssl_debug). --define(ssl_debug, true). - --ifdef(SSL_DEBUG). --define(DBG_HEX(V), ssl_debug:hex_data(??V, V, ?MODULE, ?LINE)). --define(DBG_TERM(T), ssl_debug:term_data(??T, T, ?MODULE, ?LINE)). --else. --define(DBG_HEX(V), ok). --define(DBG_TERM(T), ok). --endif. - --endif. % -ifdef(ssl_debug). - - - - +-module(dtls). diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl new file mode 100644 index 0000000000..ac2ee0d09f --- /dev/null +++ b/lib/ssl/src/dtls_connection.erl @@ -0,0 +1,19 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. 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(dtls_connection). diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl new file mode 100644 index 0000000000..b25daa59d9 --- /dev/null +++ b/lib/ssl/src/dtls_handshake.erl @@ -0,0 +1,18 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. 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(dtls_handshake). diff --git a/lib/ssl/src/dtls_handshake.hrl b/lib/ssl/src/dtls_handshake.hrl new file mode 100644 index 0000000000..db7b8596ae --- /dev/null +++ b/lib/ssl/src/dtls_handshake.hrl @@ -0,0 +1,50 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. 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% +%% + +%% +%%---------------------------------------------------------------------- +%% Purpose: Record and constant defenitions for the DTLS-handshake protocol +%% that differs from TLS see RFC 6347 +%%---------------------------------------------------------------------- +-ifndef(dtls_handshake). +-define(dtls_handshake, true). + +-include("ssl_handshake.hrl"). %% Common TLS and DTLS records and Constantes + +-record(client_hello, { + client_version, + random, + session_id, % opaque SessionID<0..32> + cookie, % opaque<2..2^16-1> + cipher_suites, % cipher_suites<2..2^16-1> + compression_methods, % compression_methods<1..2^8-1>, + %% Extensions + renegotiation_info, + hash_signs, % supported combinations of hashes/signature algos + next_protocol_negotiation = undefined % [binary()] + }). + +-record(hello_verify_request { + protocol_version, + cookie + }). + +-define(HELLO_VERIFY_REQUEST, 3). + +-endif. % -ifdef(dtls_handshake). diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl new file mode 100644 index 0000000000..2469a7d26c --- /dev/null +++ b/lib/ssl/src/dtls_record.erl @@ -0,0 +1,18 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. 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(dtls_record). diff --git a/lib/ssl/src/dtls_record.hrl b/lib/ssl/src/dtls_record.hrl new file mode 100644 index 0000000000..e935d84bdf --- /dev/null +++ b/lib/ssl/src/dtls_record.hrl @@ -0,0 +1,44 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. 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% +%% + +%% +%%---------------------------------------------------------------------- +%% Purpose: Record and constant defenitions for the DTLS-record protocol +%% see RFC 6347 +%%---------------------------------------------------------------------- + +-ifndef(dtls_record). +-define(dtls_record, true). + +-include("ssl_record.hrl"). %% Common TLS and DTLS records and Constantes + +%% Used to handle tls_plain_text, tls_compressed and tls_cipher_text + +-record(ssl_tls, { + type, + version, + record_seq, % used in plain_text + epoch, % used in plain_text + message_seq, + fragment_offset, + fragment_length, + fragment + }). + +-endif. % -ifdef(dtls_record). diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 5c34de905e..582a60635f 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -1,7 +1,20 @@ {application, ssl, [{description, "Erlang/OTP SSL application"}, {vsn, "%VSN%"}, - {modules, [ssl, + {modules, [ + %% TLS/SSL + tls, + tls_connection, + tls_handshake, + tls_record, + %% DTLS + dtls_record, + dtls_handshake, + dtls_connection, + dtls, + %% Backwards compatibility + ssl, + %% Both TLS/SSL and DTLS ssl_app, ssl_sup, inet_tls_dist, @@ -14,14 +27,14 @@ ssl_session_cache_api, ssl_session_cache, ssl_socket, - ssl_record, + %%ssl_record, ssl_manager, - ssl_handshake, + %%ssl_handshake, ssl_connection_sup, - ssl_connection, + %%ssl_connection, ssl_cipher, ssl_srp_primes, - ssl_certificate_db, + ssl_pkix_db, ssl_certificate, ssl_alert ]}, @@ -31,5 +44,3 @@ {mod, {ssl_app, []}}]}. - - diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index fb64a6652f..75c17b14db 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -19,7 +19,7 @@ %% -%%% Purpose : Main API module for SSL. +%%% Purpose : Backwards compatibility -module(ssl). @@ -46,13 +46,6 @@ tls_atom_version/0, %% From ssl_internal.hrl prf_random/0, sslsocket/0]). --record(config, {ssl, %% SSL parameters - inet_user, %% User set inet options - emulated, %% #socket_option{} emulated - inet_ssl, %% inet options for internal ssl socket - cb %% Callback info - }). - -type sslsocket() :: #sslsocket{}. -type connect_option() :: socket_connect_option() | ssl_option() | transport_option(). -type socket_connect_option() :: gen_tcp:connect_option(). @@ -92,241 +85,65 @@ %% is temporary. see application(3) %%-------------------------------------------------------------------- start() -> - application:start(crypto), - application:start(public_key), - application:start(ssl). - + tls:start(). start(Type) -> - application:start(crypto, Type), - application:start(public_key, Type), - application:start(ssl, Type). + tls:start(Type). -%%-------------------------------------------------------------------- --spec stop() -> ok. -%% -%% Description: Stops the ssl application. -%%-------------------------------------------------------------------- stop() -> - application:stop(ssl). + tls:stop(). -%%-------------------------------------------------------------------- --spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | - {error, reason()}. --spec connect(host() | port(), [connect_option()] | inet:port_number(), - timeout() | list()) -> - {ok, #sslsocket{}} | {error, reason()}. --spec connect(host() | port(), inet:port_number(), list(), timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. +connect(Socket, SslOptions) -> + tls:connect(Socket, SslOptions). -%% -%% Description: Connect to an ssl server. -%%-------------------------------------------------------------------- -connect(Socket, SslOptions) when is_port(Socket) -> - connect(Socket, SslOptions, infinity). - -connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> - {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0, - {gen_tcp, tcp, tcp_closed, tcp_error}), - EmulatedOptions = emulated_options(), - {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), - try handle_options(SslOptions0 ++ SocketValues, client) of - {ok, #config{cb = CbInfo, ssl = SslOptions, emulated = EmOpts}} -> - - ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()), - case ssl_socket:peername(Transport, Socket) of - {ok, {Address, Port}} -> - ssl_connection:connect(Address, Port, Socket, - {SslOptions, EmOpts}, - self(), CbInfo, Timeout); - {error, Error} -> - {error, Error} - end - catch - _:{error, Reason} -> - {error, Reason} - end; - -connect(Host, Port, Options) -> - connect(Host, Port, Options, infinity). +connect(Socket, SslOptions0, TimeoutOrOpts) -> + tls:connect(Socket, SslOptions0, TimeoutOrOpts). connect(Host, Port, Options, Timeout) -> - try handle_options(Options, client) of - {ok, Config} -> - do_connect(Host,Port,Config,Timeout) - catch - throw:Error -> - Error - end. + tls:connect(Host, Port, Options, Timeout). -%%-------------------------------------------------------------------- --spec listen(inet:port_number(), [listen_option()]) ->{ok, #sslsocket{}} | {error, reason()}. - -%% -%% Description: Creates an ssl listen socket. -%%-------------------------------------------------------------------- -listen(_Port, []) -> - {error, nooptions}; -listen(Port, Options0) -> - try - {ok, Config} = handle_options(Options0, server), - #config{cb = {Transport, _, _, _}, inet_user = Options} = Config, - case Transport:listen(Port, Options) of - {ok, ListenSocket} -> - {ok, #sslsocket{pid = {ListenSocket, Config}}}; - Err = {error, _} -> - Err - end - catch - Error = {error, _} -> - Error - end. -%%-------------------------------------------------------------------- --spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} | - {error, reason()}. --spec transport_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | - {error, reason()}. -%% -%% Description: Performs transport accept on an ssl listen socket -%%-------------------------------------------------------------------- -transport_accept(ListenSocket) -> - transport_accept(ListenSocket, infinity). +listen(Port, Options) -> + tls:listen(Port, Options). -transport_accept(#sslsocket{pid = {ListenSocket, #config{cb = CbInfo, ssl = SslOpts}}}, Timeout) -> - - %% The setopt could have been invoked on the listen socket - %% and options should be inherited. - EmOptions = emulated_options(), - {Transport,_,_, _} = CbInfo, - {ok, SocketValues} = ssl_socket:getopts(Transport, ListenSocket, EmOptions), - ok = ssl_socket:setopts(Transport, ListenSocket, internal_inet_values()), - case Transport:accept(ListenSocket, Timeout) of - {ok, Socket} -> - ok = ssl_socket:setopts(Transport, ListenSocket, SocketValues), - {ok, Port} = ssl_socket:port(Transport, Socket), - ConnArgs = [server, "localhost", Port, Socket, - {SslOpts, socket_options(SocketValues)}, self(), CbInfo], - case ssl_connection_sup:start_child(ConnArgs) of - {ok, Pid} -> - ssl_connection:socket_control(Socket, Pid, Transport); - {error, Reason} -> - {error, Reason} - end; - {error, Reason} -> - {error, Reason} - end. +transport_accept(ListenSocket) -> + tls:transport_accept(ListenSocket). -%%-------------------------------------------------------------------- --spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}. --spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option() - | transport_option()]) -> - ok | {ok, #sslsocket{}} | {error, reason()}. --spec ssl_accept(port(), [ssl_option()| transport_option()], timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. -%% -%% Description: Performs accept on an ssl listen socket. e.i. performs -%% ssl handshake. -%%-------------------------------------------------------------------- +transport_accept(ListenSocket, Timeout) -> + tls:transport_accept(ListenSocket, Timeout). + ssl_accept(ListenSocket) -> - ssl_accept(ListenSocket, infinity). + tls:ssl_accept(ListenSocket, infinity). ssl_accept(#sslsocket{} = Socket, Timeout) -> - ssl_connection:handshake(Socket, Timeout); + tls:ssl_accept(Socket, Timeout); ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> - ssl_accept(ListenSocket, SslOptions, infinity). + tls:ssl_accept(ListenSocket, SslOptions, infinity). ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> - {Transport,_,_,_} = - proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}), - EmulatedOptions = emulated_options(), - {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), - try handle_options(SslOptions ++ SocketValues, server) of - {ok, #config{cb = CbInfo, ssl = SslOpts, emulated = EmOpts}} -> - ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()), - {ok, Port} = ssl_socket:port(Transport, Socket), - ssl_connection:ssl_accept(Port, Socket, - {SslOpts, EmOpts}, - self(), CbInfo, Timeout) - catch - Error = {error, _Reason} -> Error - end. + tls:ssl_accept(Socket, SslOptions, Timeout). -%%-------------------------------------------------------------------- --spec close(#sslsocket{}) -> term(). -%% -%% Description: Close an ssl connection -%%-------------------------------------------------------------------- -close(#sslsocket{pid = Pid}) when is_pid(Pid) -> - ssl_connection:close(Pid); -close(#sslsocket{pid = {ListenSocket, #config{cb={Transport,_, _, _}}}}) -> - Transport:close(ListenSocket). +close(Socket) -> + tls:close(Socket). -%%-------------------------------------------------------------------- --spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}. -%% -%% Description: Sends data over the ssl connection -%%-------------------------------------------------------------------- -send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) -> - ssl_connection:send(Pid, Data); -send(#sslsocket{pid = {ListenSocket, #config{cb={Transport, _, _, _}}}}, Data) -> - Transport:send(ListenSocket, Data). %% {error,enotconn} +send(Socket, Data) -> + tls:send(Socket, Data). -%%-------------------------------------------------------------------- --spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}. --spec recv(#sslsocket{}, integer(), timeout()) -> {ok, binary()| list()} | {error, reason()}. -%% -%% Description: Receives data when active = false -%%-------------------------------------------------------------------- recv(Socket, Length) -> - recv(Socket, Length, infinity). -recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid) -> - ssl_connection:recv(Pid, Length, Timeout); -recv(#sslsocket{pid = {Listen, - #config{cb={Transport, _, _, _}}}}, _,_) when is_port(Listen)-> - Transport:recv(Listen, 0). %% {error,enotconn} - -%%-------------------------------------------------------------------- --spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}. -%% -%% Description: Changes process that receives the messages when active = true -%% or once. -%%-------------------------------------------------------------------- -controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid), is_pid(NewOwner) -> - ssl_connection:new_user(Pid, NewOwner); -controlling_process(#sslsocket{pid = {Listen, - #config{cb={Transport, _, _, _}}}}, - NewOwner) when is_port(Listen), - is_pid(NewOwner) -> - Transport:controlling_process(Listen, NewOwner). + tls:recv(Socket, Length, infinity). +recv(Socket, Length, Timeout) -> + tls:recv(Socket, Length, Timeout). -%%-------------------------------------------------------------------- --spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} | - {error, reason()}. -%% -%% Description: Returns ssl protocol and cipher used for the connection -%%-------------------------------------------------------------------- -connection_info(#sslsocket{pid = Pid}) when is_pid(Pid) -> - ssl_connection:info(Pid); -connection_info(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> - {error, enotconn}. +controlling_process(Socket, NewOwner) -> + tls:controlling_process(Socket, NewOwner). + +connection_info(Socket) -> + tls:connection_info(Socket). -%%-------------------------------------------------------------------- --spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. -%% -%% Description: same as inet:peername/1. -%%-------------------------------------------------------------------- -peername(#sslsocket{pid = Pid, fd = {Transport, Socket}}) when is_pid(Pid)-> - ssl_socket:peername(Transport, Socket); -peername(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}) -> - ssl_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn} +peername(Socket) -> + tls:peername(Socket). -%%-------------------------------------------------------------------- --spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. -%% -%% Description: Returns the peercert. -%%-------------------------------------------------------------------- peercert(#sslsocket{pid = Pid}) when is_pid(Pid) -> - case ssl_connection:peer_certificate(Pid) of + case tls_connection:peer_certificate(Pid) of {ok, undefined} -> {error, no_peercert}; Result -> @@ -335,701 +152,71 @@ peercert(#sslsocket{pid = Pid}) when is_pid(Pid) -> peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> {error, enotconn}. -%%-------------------------------------------------------------------- --spec suite_definition(cipher_suite()) -> erl_cipher_suite(). -%% -%% Description: Return erlang cipher suite definition. -%%-------------------------------------------------------------------- suite_definition(S) -> {KeyExchange, Cipher, Hash, _} = ssl_cipher:suite_definition(S), {KeyExchange, Cipher, Hash}. -%%-------------------------------------------------------------------- --spec negotiated_next_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}. -%% -%% Description: Returns the next protocol that has been negotiated. If no -%% protocol has been negotiated will return {error, next_protocol_not_negotiated} -%%-------------------------------------------------------------------- negotiated_next_protocol(#sslsocket{pid = Pid}) -> - ssl_connection:negotiated_next_protocol(Pid). + tls_connection:negotiated_next_protocol(Pid). +%%%-------------------------------------------------------------------- -spec cipher_suites() -> [erl_cipher_suite()]. -spec cipher_suites(erlang | openssl | all ) -> [erl_cipher_suite()] | [string()]. %% Description: Returns all supported cipher suites. %%-------------------------------------------------------------------- + cipher_suites() -> cipher_suites(erlang). cipher_suites(erlang) -> - Version = ssl_record:highest_protocol_version([]), - [suite_definition(S) || S <- cipher_suites(Version, [])]; + Version = tls_record:highest_protocol_version([]), + [suite_definition(S) || S <- ssl_cipher:suites(Version)]; cipher_suites(openssl) -> - Version = ssl_record:highest_protocol_version([]), - [ssl_cipher:openssl_suite_name(S) || S <- cipher_suites(Version, [])]; + Version = tls_record:highest_protocol_version([]), + [ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)]; cipher_suites(all) -> - Version = ssl_record:highest_protocol_version([]), + Version = tls_record:highest_protocol_version([]), Supported = ssl_cipher:suites(Version) ++ ssl_cipher:anonymous_suites() ++ ssl_cipher:psk_suites(Version) ++ ssl_cipher:srp_suites(), [suite_definition(S) || S <- Supported]. -%%-------------------------------------------------------------------- --spec getopts(#sslsocket{}, [gen_tcp:option_name()]) -> - {ok, [gen_tcp:option()]} | {error, reason()}. -%% -%% Description: Gets options -%%-------------------------------------------------------------------- -getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> - ssl_connection:get_opts(Pid, OptionTags); -getopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, - OptionTags) when is_list(OptionTags) -> - try ssl_socket:getopts(Transport, ListenSocket, OptionTags) of - {ok, _} = Result -> - Result; - {error, InetError} -> - {error, {options, {socket_options, OptionTags, InetError}}} - catch - _:_ -> - {error, {options, {socket_options, OptionTags}}} - end; -getopts(#sslsocket{}, OptionTags) -> - {error, {options, {socket_options, OptionTags}}}. - -%%-------------------------------------------------------------------- --spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. -%% -%% Description: Sets options -%%-------------------------------------------------------------------- -setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> - try proplists:expand([{binary, [{mode, binary}]}, - {list, [{mode, list}]}], Options0) of - Options -> - ssl_connection:set_opts(Pid, Options) - catch - _:_ -> - {error, {options, {not_a_proplist, Options0}}} - end; -setopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, Options) when is_list(Options) -> - try ssl_socket:setopts(Transport, ListenSocket, Options) of - ok -> - ok; - {error, InetError} -> - {error, {options, {socket_options, Options, InetError}}} - catch - _:Error -> - {error, {options, {socket_options, Options, Error}}} - end; -setopts(#sslsocket{}, Options) -> - {error, {options,{not_a_proplist, Options}}}. +getopts(Socket, OptionTags) -> + tls:getopts(Socket, OptionTags). -%%--------------------------------------------------------------- --spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}. -%% -%% Description: Same as gen_tcp:shutdown/2 -%%-------------------------------------------------------------------- -shutdown(#sslsocket{pid = {Listen, #config{cb={Transport,_, _, _}}}}, - How) when is_port(Listen) -> - Transport:shutdown(Listen, How); -shutdown(#sslsocket{pid = Pid}, How) -> - ssl_connection:shutdown(Pid, How). +setopts(Socket, Options) -> + tls:setopts(Socket, Options). -%%-------------------------------------------------------------------- --spec sockname(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. -%% -%% Description: Same as inet:sockname/1 -%%-------------------------------------------------------------------- -sockname(#sslsocket{pid = {Listen, #config{cb={Transport,_, _, _}}}}) when is_port(Listen) -> - ssl_socket:sockname(Transport, Listen); +shutdown(Socket, How) -> + tls:shutdown(Socket, How). -sockname(#sslsocket{pid = Pid, fd = {Transport, Socket}}) when is_pid(Pid) -> - ssl_socket:sockname(Transport, Socket). +sockname(Socket) -> + tls:sockname(Socket). -%%--------------------------------------------------------------- --spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}. -%% -%% Description: Returns list of session info currently [{session_id, session_id(), -%% {cipher_suite, cipher_suite()}] -%%-------------------------------------------------------------------- session_info(#sslsocket{pid = Pid}) when is_pid(Pid) -> - ssl_connection:session_info(Pid); + tls_connection:session_info(Pid); session_info(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> {error, enotconn}. -%%--------------------------------------------------------------- --spec versions() -> [{ssl_app, string()} | {supported, [tls_atom_version()]} | - {available, [tls_atom_version()]}]. -%% -%% Description: Returns a list of relevant versions. -%%-------------------------------------------------------------------- versions() -> - Vsns = ssl_record:supported_protocol_versions(), - SupportedVsns = [ssl_record:protocol_version(Vsn) || Vsn <- Vsns], - AvailableVsns = ?ALL_SUPPORTED_VERSIONS, - [{ssl_app, ?VSN}, {supported, SupportedVsns}, {available, AvailableVsns}]. + tls:versions(). +renegotiate(Socket) -> + tls:renegotiate(Socket). -%%--------------------------------------------------------------- --spec renegotiate(#sslsocket{}) -> ok | {error, reason()}. -%% -%% Description: Initiates a renegotiation. -%%-------------------------------------------------------------------- -renegotiate(#sslsocket{pid = Pid}) when is_pid(Pid) -> - ssl_connection:renegotiation(Pid); -renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> - {error, enotconn}. +prf(Socket, Secret, Label, Seed, WantedLength) -> + tls:prf(Socket, Secret, Label, Seed, WantedLength). -%%-------------------------------------------------------------------- --spec prf(#sslsocket{}, binary() | 'master_secret', binary(), - binary() | prf_random(), non_neg_integer()) -> - {ok, binary()} | {error, reason()}. -%% -%% Description: use a ssl sessions TLS PRF to generate key material -%%-------------------------------------------------------------------- -prf(#sslsocket{pid = Pid}, - Secret, Label, Seed, WantedLength) when is_pid(Pid) -> - ssl_connection:prf(Pid, Secret, Label, Seed, WantedLength); -prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) -> - {error, enotconn}. - -%%-------------------------------------------------------------------- --spec clear_pem_cache() -> ok. -%% -%% Description: Clear the PEM cache -%%-------------------------------------------------------------------- clear_pem_cache() -> - ssl_manager:clear_pem_cache(). + tls:clear_pem_cache(). -%%--------------------------------------------------------------- --spec format_error({error, term()}) -> list(). -%% -%% Description: Creates error string. -%%-------------------------------------------------------------------- -format_error({error, Reason}) -> - format_error(Reason); format_error(Reason) when is_list(Reason) -> - Reason; -format_error(closed) -> - "TLS connection is closed"; -format_error({tls_alert, Description}) -> - "TLS Alert: " ++ Description; -format_error({options,{FileType, File, Reason}}) when FileType == cacertfile; - FileType == certfile; - FileType == keyfile; - FileType == dhfile -> - Error = file_error_format(Reason), - file_desc(FileType) ++ File ++ ": " ++ Error; -format_error({options, {socket_options, Option, Error}}) -> - lists:flatten(io_lib:format("Invalid transport socket option ~p: ~s", [Option, format_error(Error)])); -format_error({options, {socket_options, Option}}) -> - lists:flatten(io_lib:format("Invalid socket option: ~p", [Option])); -format_error({options, Options}) -> - lists:flatten(io_lib:format("Invalid TLS option: ~p", [Options])); - -format_error(Error) -> - case inet:format_error(Error) of - "unknown POSIX" ++ _ -> - unexpected_format(Error); - Other -> - Other - end. + tls:format_error(Reason). -%%-------------------------------------------------------------------- --spec random_bytes(integer()) -> binary(). - -%% -%% Description: Generates cryptographically secure random sequence if possible -%% fallbacks on pseudo random function -%%-------------------------------------------------------------------- random_bytes(N) -> - try crypto:strong_rand_bytes(N) of - RandBytes -> - RandBytes - catch - error:low_entropy -> - crypto:rand_bytes(N) - end. - -%%%-------------------------------------------------------------- -%%% Internal functions -%%%-------------------------------------------------------------------- -do_connect(Address, Port, - #config{cb=CbInfo, inet_user=UserOpts, ssl=SslOpts, - emulated=EmOpts,inet_ssl=SocketOpts}, - Timeout) -> - {Transport, _, _, _} = CbInfo, - try Transport:connect(Address, Port, SocketOpts, Timeout) of - {ok, Socket} -> - ssl_connection:connect(Address, Port, Socket, {SslOpts,EmOpts}, - self(), CbInfo, Timeout); - {error, Reason} -> - {error, Reason} - catch - exit:{function_clause, _} -> - {error, {options, {cb_info, CbInfo}}}; - exit:badarg -> - {error, {options, {socket_options, UserOpts}}}; - exit:{badarg, _} -> - {error, {options, {socket_options, UserOpts}}} - end. - -handle_options(Opts0, _Role) -> - Opts = proplists:expand([{binary, [{mode, binary}]}, - {list, [{mode, list}]}], Opts0), - ReuseSessionFun = fun(_, _, _, _) -> true end, - - DefaultVerifyNoneFun = - {fun(_,{bad_cert, _}, UserState) -> - {valid, UserState}; - (_,{extension, _}, UserState) -> - {unknown, UserState}; - (_, valid, UserState) -> - {valid, UserState}; - (_, valid_peer, UserState) -> - {valid, UserState} - end, []}, - - VerifyNoneFun = handle_option(verify_fun, Opts, DefaultVerifyNoneFun), - - UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false), - UserVerifyFun = handle_option(verify_fun, Opts, undefined), - CaCerts = handle_option(cacerts, Opts, undefined), - - {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = - %% Handle 0, 1, 2 for backwards compatibility - case proplists:get_value(verify, Opts, verify_none) of - 0 -> - {verify_none, false, - ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; - 1 -> - {verify_peer, false, - ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; - 2 -> - {verify_peer, true, - ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; - verify_none -> - {verify_none, false, - ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; - verify_peer -> - {verify_peer, UserFailIfNoPeerCert, - ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; - Value -> - throw({error, {options, {verify, Value}}}) - end, - - CertFile = handle_option(certfile, Opts, <<>>), - - Versions = case handle_option(versions, Opts, []) of - [] -> - ssl_record:supported_protocol_versions(); - Vsns -> - [ssl_record:protocol_version(Vsn) || Vsn <- Vsns] - end, - - SSLOptions = #ssl_options{ - versions = Versions, - verify = validate_option(verify, Verify), - verify_fun = VerifyFun, - fail_if_no_peer_cert = FailIfNoPeerCert, - verify_client_once = handle_option(verify_client_once, Opts, false), - depth = handle_option(depth, Opts, 1), - cert = handle_option(cert, Opts, undefined), - certfile = CertFile, - key = handle_option(key, Opts, undefined), - keyfile = handle_option(keyfile, Opts, CertFile), - password = handle_option(password, Opts, ""), - cacerts = CaCerts, - cacertfile = handle_option(cacertfile, Opts, CaCertDefault), - dh = handle_option(dh, Opts, undefined), - dhfile = handle_option(dhfile, Opts, undefined), - user_lookup_fun = handle_option(user_lookup_fun, Opts, undefined), - psk_identity = handle_option(psk_identity, Opts, undefined), - srp_identity = handle_option(srp_identity, Opts, undefined), - ciphers = handle_option(ciphers, Opts, []), - %% Server side option - reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), - reuse_sessions = handle_option(reuse_sessions, Opts, true), - secure_renegotiate = handle_option(secure_renegotiate, Opts, false), - renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), - hibernate_after = handle_option(hibernate_after, Opts, undefined), - erl_dist = handle_option(erl_dist, Opts, false), - next_protocols_advertised = - handle_option(next_protocols_advertised, Opts, undefined), - next_protocol_selector = - make_next_protocol_selector( - handle_option(client_preferred_next_protocols, Opts, undefined)) - }, - - CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), - SslOptions = [versions, verify, verify_fun, - fail_if_no_peer_cert, verify_client_once, - depth, cert, certfile, key, keyfile, - password, cacerts, cacertfile, dh, dhfile, - user_lookup_fun, psk_identity, srp_identity, ciphers, - reuse_session, reuse_sessions, ssl_imp, - cb_info, renegotiate_at, secure_renegotiate, hibernate_after, - erl_dist, next_protocols_advertised, - client_preferred_next_protocols], - - SockOpts = lists:foldl(fun(Key, PropList) -> - proplists:delete(Key, PropList) - end, Opts, SslOptions), - - {SSLsock, Emulated} = emulated_options(SockOpts), - {ok, #config{ssl=SSLOptions, emulated=Emulated, inet_ssl=SSLsock, - inet_user=SockOpts, cb=CbInfo}}. - -handle_option(OptionName, Opts, Default) -> - validate_option(OptionName, - proplists:get_value(OptionName, Opts, Default)). - - -validate_option(versions, Versions) -> - validate_versions(Versions, Versions); -validate_option(verify, Value) - when Value == verify_none; Value == verify_peer -> - Value; -validate_option(verify_fun, undefined) -> - undefined; -%% Backwards compatibility -validate_option(verify_fun, Fun) when is_function(Fun) -> - {fun(_,{bad_cert, _} = Reason, OldFun) -> - case OldFun([Reason]) of - true -> - {valid, OldFun}; - false -> - {fail, Reason} - end; - (_,{extension, _}, UserState) -> - {unknown, UserState}; - (_, valid, UserState) -> - {valid, UserState}; - (_, valid_peer, UserState) -> - {valid, UserState} - end, Fun}; -validate_option(verify_fun, {Fun, _} = Value) when is_function(Fun) -> - Value; -validate_option(fail_if_no_peer_cert, Value) - when Value == true; Value == false -> - Value; -validate_option(verify_client_once, Value) - when Value == true; Value == false -> - Value; -validate_option(depth, Value) when is_integer(Value), - Value >= 0, Value =< 255-> - Value; -validate_option(cert, Value) when Value == undefined; - is_binary(Value) -> - Value; -validate_option(certfile, undefined = Value) -> - Value; -validate_option(certfile, Value) when is_binary(Value) -> - Value; -validate_option(certfile, Value) when is_list(Value) -> - list_to_binary(Value); - -validate_option(key, undefined) -> - undefined; -validate_option(key, {KeyType, Value}) when is_binary(Value), - KeyType == rsa; %% Backwards compatibility - KeyType == dsa; %% Backwards compatibility - KeyType == 'RSAPrivateKey'; - KeyType == 'DSAPrivateKey'; - KeyType == 'ECPrivateKey'; - KeyType == 'PrivateKeyInfo' -> - {KeyType, Value}; - -validate_option(keyfile, undefined) -> - <<>>; -validate_option(keyfile, Value) when is_binary(Value) -> - Value; -validate_option(keyfile, Value) when is_list(Value), Value =/= "" -> - list_to_binary(Value); -validate_option(password, Value) when is_list(Value) -> - Value; - -validate_option(cacerts, Value) when Value == undefined; - is_list(Value) -> - Value; -%% certfile must be present in some cases otherwhise it can be set -%% to the empty string. -validate_option(cacertfile, undefined) -> - <<>>; -validate_option(cacertfile, Value) when is_binary(Value) -> - Value; -validate_option(cacertfile, Value) when is_list(Value), Value =/= ""-> - list_to_binary(Value); -validate_option(dh, Value) when Value == undefined; - is_binary(Value) -> - Value; -validate_option(dhfile, undefined = Value) -> - Value; -validate_option(dhfile, Value) when is_binary(Value) -> - Value; -validate_option(dhfile, Value) when is_list(Value), Value =/= "" -> - list_to_binary(Value); -validate_option(psk_identity, undefined) -> - undefined; -validate_option(psk_identity, Identity) - when is_list(Identity), Identity =/= "", length(Identity) =< 65535 -> - list_to_binary(Identity); -validate_option(user_lookup_fun, undefined) -> - undefined; -validate_option(user_lookup_fun, {Fun, _} = Value) when is_function(Fun, 3) -> - Value; -validate_option(srp_identity, undefined) -> - undefined; -validate_option(srp_identity, {Username, Password}) - when is_list(Username), is_list(Password), Username =/= "", length(Username) =< 255 -> - {list_to_binary(Username), list_to_binary(Password)}; -validate_option(ciphers, Value) when is_list(Value) -> - Version = ssl_record:highest_protocol_version([]), - try cipher_suites(Version, Value) - catch - exit:_ -> - throw({error, {options, {ciphers, Value}}}); - error:_-> - throw({error, {options, {ciphers, Value}}}) - end; -validate_option(reuse_session, Value) when is_function(Value) -> - Value; -validate_option(reuse_sessions, Value) when Value == true; - Value == false -> - Value; - -validate_option(secure_renegotiate, Value) when Value == true; - Value == false -> - Value; -validate_option(renegotiate_at, Value) when is_integer(Value) -> - erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT); - -validate_option(hibernate_after, undefined) -> - undefined; -validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> - Value; -validate_option(erl_dist,Value) when Value == true; - Value == false -> - Value; -validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols} = Value) - when is_list(PreferredProtocols) -> - case ssl_record:highest_protocol_version([]) of - {3,0} -> - throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); - _ -> - validate_binary_list(client_preferred_next_protocols, PreferredProtocols), - validate_npn_ordering(Precedence), - {Precedence, PreferredProtocols, ?NO_PROTOCOL} - end; -validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols, Default} = Value) - when is_list(PreferredProtocols), is_binary(Default), - byte_size(Default) > 0, byte_size(Default) < 256 -> - case ssl_record:highest_protocol_version([]) of - {3,0} -> - throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); - _ -> - validate_binary_list(client_preferred_next_protocols, PreferredProtocols), - validate_npn_ordering(Precedence), - Value - end; - -validate_option(client_preferred_next_protocols, undefined) -> - undefined; -validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) -> - case ssl_record:highest_protocol_version([]) of - {3,0} -> - throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); - _ -> - validate_binary_list(next_protocols_advertised, Value), - Value - end; - -validate_option(next_protocols_advertised, undefined) -> - undefined; -validate_option(Opt, Value) -> - throw({error, {options, {Opt, Value}}}). - -validate_npn_ordering(client) -> - ok; -validate_npn_ordering(server) -> - ok; -validate_npn_ordering(Value) -> - throw({error, {options, {client_preferred_next_protocols, {invalid_precedence, Value}}}}). - -validate_binary_list(Opt, List) -> - lists:foreach( - fun(Bin) when is_binary(Bin), - byte_size(Bin) > 0, - byte_size(Bin) < 256 -> - ok; - (Bin) -> - throw({error, {options, {Opt, {invalid_protocol, Bin}}}}) - end, List). - -validate_versions([], Versions) -> - Versions; -validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2'; - Version == 'tlsv1.1'; - Version == tlsv1; - Version == sslv3 -> - validate_versions(Rest, Versions); -validate_versions([Ver| _], Versions) -> - throw({error, {options, {Ver, {versions, Versions}}}}). - -validate_inet_option(mode, Value) - when Value =/= list, Value =/= binary -> - throw({error, {options, {mode,Value}}}); -validate_inet_option(packet, Value) - when not (is_atom(Value) orelse is_integer(Value)) -> - throw({error, {options, {packet,Value}}}); -validate_inet_option(packet_size, Value) - when not is_integer(Value) -> - throw({error, {options, {packet_size,Value}}}); -validate_inet_option(header, Value) - when not is_integer(Value) -> - throw({error, {options, {header,Value}}}); -validate_inet_option(active, Value) - when Value =/= true, Value =/= false, Value =/= once -> - throw({error, {options, {active,Value}}}); -validate_inet_option(_, _) -> - ok. - -%% The option cacerts overrides cacertsfile -ca_cert_default(_,_, [_|_]) -> - undefined; -ca_cert_default(verify_none, _, _) -> - undefined; -ca_cert_default(verify_peer, {Fun,_}, _) when is_function(Fun) -> - undefined; -%% Server that wants to verify_peer and has no verify_fun must have -%% some trusted certs. -ca_cert_default(verify_peer, undefined, _) -> - "". - -emulated_options() -> - [mode, packet, active, header, packet_size]. - -internal_inet_values() -> - [{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}]. - -socket_options(InetValues) -> - #socket_options{ - mode = proplists:get_value(mode, InetValues, lists), - header = proplists:get_value(header, InetValues, 0), - active = proplists:get_value(active, InetValues, active), - packet = proplists:get_value(packet, InetValues, 0), - packet_size = proplists:get_value(packet_size, InetValues) - }. - -emulated_options(Opts) -> - emulated_options(Opts, internal_inet_values(), #socket_options{}). - -emulated_options([{mode,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(mode,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{mode=Opt}); -emulated_options([{header,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(header,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{header=Opt}); -emulated_options([{active,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(active,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{active=Opt}); -emulated_options([{packet,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(packet,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{packet=Opt}); -emulated_options([{packet_size,Opt}|Opts], Inet, Emulated) -> - validate_inet_option(packet_size,Opt), - emulated_options(Opts, Inet, Emulated#socket_options{packet_size=Opt}); -emulated_options([Opt|Opts], Inet, Emulated) -> - emulated_options(Opts, [Opt|Inet], Emulated); -emulated_options([], Inet,Emulated) -> - {Inet, Emulated}. - -cipher_suites(Version, []) -> - ssl_cipher:filter_suites(ssl_cipher:suites(Version)); -cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility - Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0], - ssl_cipher:filter_suites(cipher_suites(Version, Ciphers)); -cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> - Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], - ssl_cipher:filter_suites(cipher_suites(Version, Ciphers)); -cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> - Supported0 = ssl_cipher:suites(Version) - ++ ssl_cipher:anonymous_suites() - ++ ssl_cipher:psk_suites(Version) - ++ ssl_cipher:srp_suites(), - Supported1 = ssl_cipher:filter_suites(Supported0), - case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported1)] of - [] -> - Supported1; - Ciphers -> - Ciphers - end; -cipher_suites(Version, [Head | _] = Ciphers0) when is_list(Head) -> - %% Format: ["RC4-SHA","RC4-MD5"] - Ciphers = [ssl_cipher:openssl_suite(C) || C <- Ciphers0], - cipher_suites(Version, Ciphers); -cipher_suites(Version, Ciphers0) -> - %% Format: "RC4-SHA:RC4-MD5" - Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")], - cipher_suites(Version, Ciphers). - -unexpected_format(Error) -> - lists:flatten(io_lib:format("Unexpected error: ~p", [Error])). - -file_error_format({error, Error})-> - case file:format_error(Error) of - "unknown POSIX error" -> - "decoding error"; - Str -> - Str - end; -file_error_format(_) -> - "decoding error". - -file_desc(cacertfile) -> - "Invalid CA certificate file "; -file_desc(certfile) -> - "Invalid certificate file "; -file_desc(keyfile) -> - "Invalid key file "; -file_desc(dhfile) -> - "Invalid DH params file ". - -detect(_Pred, []) -> - undefined; -detect(Pred, [H|T]) -> - case Pred(H) of - true -> - H; - _ -> - detect(Pred, T) - end. - -make_next_protocol_selector(undefined) -> - undefined; -make_next_protocol_selector({client, AllProtocols, DefaultProtocol}) -> - fun(AdvertisedProtocols) -> - case detect(fun(PreferredProtocol) -> - lists:member(PreferredProtocol, AdvertisedProtocols) - end, AllProtocols) of - undefined -> - DefaultProtocol; - PreferredProtocol -> - PreferredProtocol - end - end; + tls:random_bytes(N). -make_next_protocol_selector({server, AllProtocols, DefaultProtocol}) -> - fun(AdvertisedProtocols) -> - case detect(fun(PreferredProtocol) -> - lists:member(PreferredProtocol, AllProtocols) - end, - AdvertisedProtocols) of - undefined -> - DefaultProtocol; - PreferredProtocol -> - PreferredProtocol - end - end. diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 9e1c3a09bf..b186a1015a 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -240,7 +240,7 @@ find_issuer(OtpCert, CertDbHandle) -> Acc end, - try ssl_certificate_db:foldl(IsIssuerFun, issuer_not_found, CertDbHandle) of + try ssl_pkix_db:foldl(IsIssuerFun, issuer_not_found, CertDbHandle) of issuer_not_found -> {error, issuer_not_found} catch diff --git a/lib/ssl/src/ssl_connection_sup.erl b/lib/ssl/src/ssl_connection_sup.erl index 78cfda5e63..fb1c6e11a6 100644 --- a/lib/ssl/src/ssl_connection_sup.erl +++ b/lib/ssl/src/ssl_connection_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2013. 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 @@ -56,10 +56,10 @@ init(_O) -> MaxT = 3600, Name = undefined, % As simple_one_for_one is used. - StartFunc = {ssl_connection, start_link, []}, + StartFunc = {tls_connection, start_link, []}, Restart = temporary, % E.g. should not be restarted Shutdown = 4000, - Modules = [ssl_connection], + Modules = [tls_connection], Type = worker, ChildSpec = {Name, StartFunc, Restart, Shutdown, Type, Modules}, diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index b2387a0ee7..eb1a1dbf62 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -20,7 +20,7 @@ %% %%---------------------------------------------------------------------- %% Purpose: Record and constant defenitions for the SSL-handshake protocol -%% see RFC 4346 +%% see RFC 5246. Also includes supported hello extensions. %%---------------------------------------------------------------------- -ifndef(ssl_handshake). @@ -91,21 +91,10 @@ % -define(NULL, 0). %% Already defined by ssl_internal.hrl %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% Hello messages - RFC 4346 section 7.4.2 +%%% Hello messages - RFC 5246 section 7.4.1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --record(client_hello, { - client_version, - random, - session_id, % opaque SessionID<0..32> - cipher_suites, % cipher_suites<2..2^16-1> - compression_methods, % compression_methods<1..2^8-1>, - renegotiation_info, - srp, % srp username to send - hash_signs, % supported combinations of hashes/signature algos - ec_point_formats, % supported ec point formats - elliptic_curves, % supported elliptic curver - next_protocol_negotiation = undefined % [binary()] - }). + +%% client_hello defined in tls_handshake.hrl and dtls_handshake.hrl -record(server_hello, { server_version, @@ -121,7 +110,7 @@ }). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% Server authentication and key exchange messages - RFC 4346 section 7.4.3 +%%% Server authentication and key exchange messages - RFC 5246 section 7.4.3 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% opaque ASN.1Cert<2^24-1>; @@ -193,7 +182,7 @@ -record(server_hello_done, {}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% Certificate request - RFC 4346 section 7.4.4 +%%% Certificate request - RFC 5246 section 7.4.4 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% enum { diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index caea528a08..1b06e351cf 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -104,7 +104,8 @@ connection_init(Trustedcerts, Role) -> %%-------------------------------------------------------------------- cache_pem_file(File, DbHandle) -> MD5 = crypto:hash(md5, File), - case ssl_certificate_db:lookup_cached_pem(DbHandle, MD5) of + MD5 = crypto:md5(File), + case ssl_pkix_db:lookup_cached_pem(DbHandle, MD5) of [{Content,_}] -> {ok, Content}; [Content] -> @@ -132,7 +133,7 @@ clear_pem_cache() -> %% serialnumber(), issuer()}. %% -------------------------------------------------------------------- lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer) -> - ssl_certificate_db:lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer). + ssl_pkix_db:lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer). %%-------------------------------------------------------------------- -spec new_session_id(integer()) -> session_id(). @@ -194,7 +195,7 @@ init([Name, Opts]) -> CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache), SessionLifeTime = proplists:get_value(session_lifetime, Opts, ?'24H_in_sec'), - CertDb = ssl_certificate_db:create(), + CertDb = ssl_pkix_db:create(), SessionCache = CacheCb:init(proplists:get_value(session_cb_init_args, Opts, [])), Timer = erlang:send_after(SessionLifeTime * 1000 + 5000, self(), validate_sessions), @@ -227,7 +228,7 @@ handle_call({{connection_init, Trustedcerts, _Role}, Pid}, _From, session_cache = Cache} = State) -> Result = try - {ok, Ref} = ssl_certificate_db:add_trusted_certs(Pid, Trustedcerts, Db), + {ok, Ref} = ssl_pkix_db:add_trusted_certs(Pid, Trustedcerts, Db), {ok, Ref, CertDb, FileRefDb, PemChace, Cache} catch _:Reason -> @@ -244,7 +245,7 @@ handle_call({{new_session_id,Port}, _}, handle_call({{cache_pem, File}, _Pid}, _, #state{certificate_db = Db} = State) -> - try ssl_certificate_db:cache_pem_file(File, Db) of + try ssl_pkix_db:cache_pem_file(File, Db) of Result -> {reply, Result, State} catch @@ -252,7 +253,7 @@ handle_call({{cache_pem, File}, _Pid}, _, {reply, {error, Reason}, State} end; handle_call({unconditionally_clear_pem_cache, _},_, #state{certificate_db = [_,_,PemChace]} = State) -> - ssl_certificate_db:clear(PemChace), + ssl_pkix_db:clear(PemChace), {reply, ok, State}. %%-------------------------------------------------------------------- @@ -315,11 +316,11 @@ handle_info({delayed_clean_session, Key}, #state{session_cache = Cache, {noreply, State}; handle_info(clear_pem_cache, #state{certificate_db = [_,_,PemChace]} = State) -> - case ssl_certificate_db:db_size(PemChace) of + case ssl_pkix_db:db_size(PemChace) of N when N < ?NOT_TO_BIG -> ok; _ -> - ssl_certificate_db:clear(PemChace) + ssl_pkix_db:clear(PemChace) end, erlang:send_after(?CLEAR_PEM_CACHE, self(), clear_pem_cache), {noreply, State}; @@ -328,7 +329,7 @@ handle_info(clear_pem_cache, #state{certificate_db = [_,_,PemChace]} = State) -> handle_info({clean_cert_db, Ref, File}, #state{certificate_db = [CertDb,RefDb, PemCache]} = State) -> - case ssl_certificate_db:lookup(Ref, RefDb) of + case ssl_pkix_db:lookup(Ref, RefDb) of undefined -> %% Alredy cleaned ok; _ -> @@ -357,7 +358,7 @@ terminate(_Reason, #state{certificate_db = Db, session_cache_cb = CacheCb, session_validation_timer = Timer}) -> erlang:cancel_timer(Timer), - ssl_certificate_db:remove(Db), + ssl_pkix_db:remove(Db), CacheCb:terminate(SessionCache), ok. @@ -466,17 +467,17 @@ new_id(Port, Tries, Cache, CacheCb) -> end. clean_cert_db(Ref, CertDb, RefDb, PemCache, File) -> - case ssl_certificate_db:ref_count(Ref, RefDb, 0) of + case ssl_pkix_db:ref_count(Ref, RefDb, 0) of 0 -> MD5 = crypto:hash(md5, File), - case ssl_certificate_db:lookup_cached_pem(PemCache, MD5) of + case ssl_pkix_db:lookup_cached_pem(PemCache, MD5) of [{Content, Ref}] -> - ssl_certificate_db:insert(MD5, Content, PemCache); + ssl_pkix_db:insert(MD5, Content, PemCache); _ -> ok end, - ssl_certificate_db:remove(Ref, RefDb), - ssl_certificate_db:remove_trusted_certs(Ref, CertDb); + ssl_pkix_db:remove(Ref, RefDb), + ssl_pkix_db:remove_trusted_certs(Ref, CertDb); _ -> ok end. diff --git a/lib/ssl/src/ssl_certificate_db.erl b/lib/ssl/src/ssl_pkix_db.erl index cdff73336e..9de50c8f26 100644 --- a/lib/ssl/src/ssl_certificate_db.erl +++ b/lib/ssl/src/ssl_pkix_db.erl @@ -21,7 +21,7 @@ %% Purpose: Storage for trusted certificates %%---------------------------------------------------------------------- --module(ssl_certificate_db). +-module(ssl_pkix_db). -include("ssl_internal.hrl"). -include_lib("public_key/include/public_key.hrl"). diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index f73da92a52..2fd17f9c35 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2012. All Rights Reserved. +%% Copyright Ericsson AB 2007-2013. 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 @@ -143,34 +143,6 @@ -define(LOWEST_MAJOR_SUPPORTED_VERSION, 3). --record(ssl_tls, { %% From inet driver - port, - type, - version, - fragment - }). - -%% -record(tls_plain_text, { -%% type, -%% version, % #protocol_version{} -%% length, % unit 16 -%% fragment % opaque -%% }). - -%% -record(tls_compressed, { -%% type, -%% version, -%% length, % unit 16 -%% fragment % opaque -%% }). - -%% -record(tls_cipher_text, { -%% type, -%% version, -%% length, -%% cipher, -%% fragment -%% }). -record(generic_stream_cipher, { content, % opaque content[TLSCompressed.length]; diff --git a/lib/ssl/src/tls.erl b/lib/ssl/src/tls.erl new file mode 100644 index 0000000000..fcecf8196f --- /dev/null +++ b/lib/ssl/src/tls.erl @@ -0,0 +1,1037 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2013. 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% +%% + +%% + +%%% Purpose : Main API module for SSL. + +-module(tls). + +-export([start/0, start/1, stop/0, transport_accept/1, + transport_accept/2, ssl_accept/1, ssl_accept/2, ssl_accept/3, + cipher_suites/0, cipher_suites/1, suite_definition/1, + close/1, shutdown/2, + connect/3, connect/2, connect/4, connection_info/1, + controlling_process/2, listen/2, peername/1, peercert/1, + recv/2, recv/3, send/2, getopts/2, setopts/2, sockname/1, + versions/0, session_info/1, format_error/1, + renegotiate/1, prf/5, clear_pem_cache/0, random_bytes/1, negotiated_next_protocol/1]). + +-include("ssl_internal.hrl"). +-include("ssl_record.hrl"). +-include("ssl_cipher.hrl"). +-include("ssl_handshake.hrl"). +-include("ssl_srp.hrl"). + +-include_lib("public_key/include/public_key.hrl"). + +%% Visible in API +-export_type([connect_option/0, listen_option/0, ssl_option/0, transport_option/0, + erl_cipher_suite/0, %% From ssl_cipher.hrl + tls_atom_version/0, %% From ssl_internal.hrl + prf_random/0, sslsocket/0]). + +-record(config, {ssl, %% SSL parameters + inet_user, %% User set inet options + emulated, %% #socket_option{} emulated + inet_ssl, %% inet options for internal ssl socket + cb %% Callback info + }). + +-type sslsocket() :: #sslsocket{}. +-type connect_option() :: socket_connect_option() | ssl_option() | transport_option(). +-type socket_connect_option() :: gen_tcp:connect_option(). +-type listen_option() :: socket_listen_option() | ssl_option() | transport_option(). +-type socket_listen_option() :: gen_tcp:listen_option(). + +-type ssl_option() :: {verify, verify_type()} | + {verify_fun, {fun(), InitialUserState::term()}} | + {fail_if_no_peer_cert, boolean()} | {depth, integer()} | + {cert, Der::binary()} | {certfile, path()} | {key, Der::binary()} | + {keyfile, path()} | {password, string()} | {cacerts, [Der::binary()]} | + {cacertfile, path()} | {dh, Der::binary()} | {dhfile, path()} | + {user_lookup_fun, {fun(), InitialUserState::term()}} | + {psk_identity, string()} | + {srp_identity, {string(), string()}} | + {ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | + {reuse_session, fun()} | {hibernate_after, integer()|undefined} | + {next_protocols_advertised, list(binary())} | + {client_preferred_next_protocols, binary(), client | server, list(binary())}. + +-type verify_type() :: verify_none | verify_peer. +-type path() :: string(). +-type ciphers() :: [erl_cipher_suite()] | + string(). % (according to old API) +-type ssl_imp() :: new | old. + +-type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), + ClosedTag::atom(), ErrTag::atom()}}. +-type prf_random() :: client_random | server_random. + +%%-------------------------------------------------------------------- +-spec start() -> ok | {error, reason()}. +-spec start(permanent | transient | temporary) -> ok | {error, reason()}. +%% +%% Description: Utility function that starts the ssl, +%% crypto and public_key applications. Default type +%% is temporary. see application(3) +%%-------------------------------------------------------------------- +start() -> + application:start(crypto), + application:start(public_key), + application:start(ssl). + +start(Type) -> + application:start(crypto, Type), + application:start(public_key, Type), + application:start(ssl, Type). + +%%-------------------------------------------------------------------- +-spec stop() -> ok. +%% +%% Description: Stops the ssl application. +%%-------------------------------------------------------------------- +stop() -> + application:stop(ssl). + +%%-------------------------------------------------------------------- +-spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} | + {error, reason()}. +-spec connect(host() | port(), [connect_option()] | inet:port_number(), + timeout() | list()) -> + {ok, #sslsocket{}} | {error, reason()}. +-spec connect(host() | port(), inet:port_number(), list(), timeout()) -> + {ok, #sslsocket{}} | {error, reason()}. + +%% +%% Description: Connect to an ssl server. +%%-------------------------------------------------------------------- +connect(Socket, SslOptions) when is_port(Socket) -> + connect(Socket, SslOptions, infinity). + +connect(Socket, SslOptions0, Timeout) when is_port(Socket) -> + {Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0, + {gen_tcp, tcp, tcp_closed, tcp_error}), + EmulatedOptions = emulated_options(), + {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), + try handle_options(SslOptions0 ++ SocketValues, client) of + {ok, #config{cb = CbInfo, ssl = SslOptions, emulated = EmOpts}} -> + + ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()), + case ssl_socket:peername(Transport, Socket) of + {ok, {Address, Port}} -> + tls_connection:connect(Address, Port, Socket, + {SslOptions, EmOpts}, + self(), CbInfo, Timeout); + {error, Error} -> + {error, Error} + end + catch + _:{error, Reason} -> + {error, Reason} + end; + +connect(Host, Port, Options) -> + connect(Host, Port, Options, infinity). + +connect(Host, Port, Options, Timeout) -> + try handle_options(Options, client) of + {ok, Config} -> + do_connect(Host,Port,Config,Timeout) + catch + throw:Error -> + Error + end. + +%%-------------------------------------------------------------------- +-spec listen(inet:port_number(), [listen_option()]) ->{ok, #sslsocket{}} | {error, reason()}. + +%% +%% Description: Creates an ssl listen socket. +%%-------------------------------------------------------------------- +listen(_Port, []) -> + {error, nooptions}; +listen(Port, Options0) -> + try + {ok, Config} = handle_options(Options0, server), + #config{cb = {Transport, _, _, _}, inet_user = Options} = Config, + case Transport:listen(Port, Options) of + {ok, ListenSocket} -> + {ok, #sslsocket{pid = {ListenSocket, Config}}}; + Err = {error, _} -> + Err + end + catch + Error = {error, _} -> + Error + end. +%%-------------------------------------------------------------------- +-spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} | + {error, reason()}. +-spec transport_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | + {error, reason()}. +%% +%% Description: Performs transport accept on an ssl listen socket +%%-------------------------------------------------------------------- +transport_accept(ListenSocket) -> + transport_accept(ListenSocket, infinity). + +transport_accept(#sslsocket{pid = {ListenSocket, #config{cb = CbInfo, ssl = SslOpts}}}, Timeout) -> + + %% The setopt could have been invoked on the listen socket + %% and options should be inherited. + EmOptions = emulated_options(), + {Transport,_,_, _} = CbInfo, + {ok, SocketValues} = ssl_socket:getopts(Transport, ListenSocket, EmOptions), + ok = ssl_socket:setopts(Transport, ListenSocket, internal_inet_values()), + case Transport:accept(ListenSocket, Timeout) of + {ok, Socket} -> + ok = ssl_socket:setopts(Transport, ListenSocket, SocketValues), + {ok, Port} = ssl_socket:port(Transport, Socket), + ConnArgs = [server, "localhost", Port, Socket, + {SslOpts, socket_options(SocketValues)}, self(), CbInfo], + case ssl_connection_sup:start_child(ConnArgs) of + {ok, Pid} -> + tls_connection:socket_control(Socket, Pid, Transport); + {error, Reason} -> + {error, Reason} + end; + {error, Reason} -> + {error, Reason} + end. + +%%-------------------------------------------------------------------- +-spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}. +-spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option() + | transport_option()]) -> + ok | {ok, #sslsocket{}} | {error, reason()}. +-spec ssl_accept(port(), [ssl_option()| transport_option()], timeout()) -> + {ok, #sslsocket{}} | {error, reason()}. +%% +%% Description: Performs accept on an ssl listen socket. e.i. performs +%% ssl handshake. +%%-------------------------------------------------------------------- +ssl_accept(ListenSocket) -> + ssl_accept(ListenSocket, infinity). + +ssl_accept(#sslsocket{} = Socket, Timeout) -> + tls_connection:handshake(Socket, Timeout); + +ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> + ssl_accept(ListenSocket, SslOptions, infinity). + +ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> + {Transport,_,_,_} = + proplists:get_value(cb_info, SslOptions, {gen_tcp, tcp, tcp_closed, tcp_error}), + EmulatedOptions = emulated_options(), + {ok, SocketValues} = ssl_socket:getopts(Transport, Socket, EmulatedOptions), + try handle_options(SslOptions ++ SocketValues, server) of + {ok, #config{cb = CbInfo, ssl = SslOpts, emulated = EmOpts}} -> + ok = ssl_socket:setopts(Transport, Socket, internal_inet_values()), + {ok, Port} = ssl_socket:port(Transport, Socket), + tls_connection:ssl_accept(Port, Socket, + {SslOpts, EmOpts}, + self(), CbInfo, Timeout) + catch + Error = {error, _Reason} -> Error + end. + +%%-------------------------------------------------------------------- +-spec close(#sslsocket{}) -> term(). +%% +%% Description: Close an ssl connection +%%-------------------------------------------------------------------- +close(#sslsocket{pid = Pid}) when is_pid(Pid) -> + tls_connection:close(Pid); +close(#sslsocket{pid = {ListenSocket, #config{cb={Transport,_, _, _}}}}) -> + Transport:close(ListenSocket). + +%%-------------------------------------------------------------------- +-spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}. +%% +%% Description: Sends data over the ssl connection +%%-------------------------------------------------------------------- +send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) -> + tls_connection:send(Pid, Data); +send(#sslsocket{pid = {ListenSocket, #config{cb={Transport, _, _, _}}}}, Data) -> + Transport:send(ListenSocket, Data). %% {error,enotconn} + +%%-------------------------------------------------------------------- +-spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}. +-spec recv(#sslsocket{}, integer(), timeout()) -> {ok, binary()| list()} | {error, reason()}. +%% +%% Description: Receives data when active = false +%%-------------------------------------------------------------------- +recv(Socket, Length) -> + recv(Socket, Length, infinity). +recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid) -> + tls_connection:recv(Pid, Length, Timeout); +recv(#sslsocket{pid = {Listen, + #config{cb={Transport, _, _, _}}}}, _,_) when is_port(Listen)-> + Transport:recv(Listen, 0). %% {error,enotconn} + +%%-------------------------------------------------------------------- +-spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}. +%% +%% Description: Changes process that receives the messages when active = true +%% or once. +%%-------------------------------------------------------------------- +controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid), is_pid(NewOwner) -> + tls_connection:new_user(Pid, NewOwner); +controlling_process(#sslsocket{pid = {Listen, + #config{cb={Transport, _, _, _}}}}, + NewOwner) when is_port(Listen), + is_pid(NewOwner) -> + Transport:controlling_process(Listen, NewOwner). + +%%-------------------------------------------------------------------- +-spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} | + {error, reason()}. +%% +%% Description: Returns ssl protocol and cipher used for the connection +%%-------------------------------------------------------------------- +connection_info(#sslsocket{pid = Pid}) when is_pid(Pid) -> + tls_connection:info(Pid); +connection_info(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> + {error, enotconn}. + +%%-------------------------------------------------------------------- +-spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. +%% +%% Description: same as inet:peername/1. +%%-------------------------------------------------------------------- +peername(#sslsocket{pid = Pid, fd = {Transport, Socket}}) when is_pid(Pid)-> + ssl_socket:peername(Transport, Socket); +peername(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}) -> + ssl_socket:peername(Transport, ListenSocket). %% Will return {error, enotconn} + +%%-------------------------------------------------------------------- +-spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. +%% +%% Description: Returns the peercert. +%%-------------------------------------------------------------------- +peercert(#sslsocket{pid = Pid}) when is_pid(Pid) -> + case tls_connection:peer_certificate(Pid) of + {ok, undefined} -> + {error, no_peercert}; + Result -> + Result + end; +peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> + {error, enotconn}. + +%%-------------------------------------------------------------------- +-spec suite_definition(cipher_suite()) -> erl_cipher_suite(). +%% +%% Description: Return erlang cipher suite definition. +%%-------------------------------------------------------------------- +suite_definition(S) -> + {KeyExchange, Cipher, Hash, _} = ssl_cipher:suite_definition(S), + {KeyExchange, Cipher, Hash}. + +%%-------------------------------------------------------------------- +-spec negotiated_next_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}. +%% +%% Description: Returns the next protocol that has been negotiated. If no +%% protocol has been negotiated will return {error, next_protocol_not_negotiated} +%%-------------------------------------------------------------------- +negotiated_next_protocol(#sslsocket{pid = Pid}) -> + tls_connection:negotiated_next_protocol(Pid). + +-spec cipher_suites() -> [erl_cipher_suite()]. +-spec cipher_suites(erlang | openssl | all) -> [erl_cipher_suite()] | [string()]. + +%% Description: Returns all supported cipher suites. +%%-------------------------------------------------------------------- +cipher_suites() -> + cipher_suites(erlang). + +cipher_suites(erlang) -> + Version = tls_record:highest_protocol_version([]), + [suite_definition(S) || S <- ssl_cipher:suites(Version)]; + +cipher_suites(openssl) -> + Version = tls_record:highest_protocol_version([]), + [ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)]; +cipher_suites(all) -> + Version = tls_record:highest_protocol_version([]), + Supported = ssl_cipher:suites(Version) + ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:psk_suites(Version) + ++ ssl_cipher:srp_suites(), + [suite_definition(S) || S <- Supported]. + +%%-------------------------------------------------------------------- +-spec getopts(#sslsocket{}, [gen_tcp:option_name()]) -> + {ok, [gen_tcp:option()]} | {error, reason()}. +%% +%% Description: Gets options +%%-------------------------------------------------------------------- +getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> + tls_connection:get_opts(Pid, OptionTags); +getopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, + OptionTags) when is_list(OptionTags) -> + try ssl_socket:getopts(Transport, ListenSocket, OptionTags) of + {ok, _} = Result -> + Result; + {error, InetError} -> + {error, {options, {socket_options, OptionTags, InetError}}} + catch + _:_ -> + {error, {options, {socket_options, OptionTags}}} + end; +getopts(#sslsocket{}, OptionTags) -> + {error, {options, {socket_options, OptionTags}}}. + +%%-------------------------------------------------------------------- +-spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. +%% +%% Description: Sets options +%%-------------------------------------------------------------------- +setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) -> + try proplists:expand([{binary, [{mode, binary}]}, + {list, [{mode, list}]}], Options0) of + Options -> + tls_connection:set_opts(Pid, Options) + catch + _:_ -> + {error, {options, {not_a_proplist, Options0}}} + end; + +setopts(#sslsocket{pid = {ListenSocket, #config{cb = {Transport,_,_,_}}}}, Options) when is_list(Options) -> + try ssl_socket:setopts(Transport, ListenSocket, Options) of + ok -> + ok; + {error, InetError} -> + {error, {options, {socket_options, Options, InetError}}} + catch + _:Error -> + {error, {options, {socket_options, Options, Error}}} + end; +setopts(#sslsocket{}, Options) -> + {error, {options,{not_a_proplist, Options}}}. + +%%--------------------------------------------------------------- +-spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}. +%% +%% Description: Same as gen_tcp:shutdown/2 +%%-------------------------------------------------------------------- +shutdown(#sslsocket{pid = {Listen, #config{cb={Transport,_, _, _}}}}, + How) when is_port(Listen) -> + Transport:shutdown(Listen, How); +shutdown(#sslsocket{pid = Pid}, How) -> + tls_connection:shutdown(Pid, How). + +%%-------------------------------------------------------------------- +-spec sockname(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. +%% +%% Description: Same as inet:sockname/1 +%%-------------------------------------------------------------------- +sockname(#sslsocket{pid = {Listen, #config{cb={Transport,_, _, _}}}}) when is_port(Listen) -> + ssl_socket:sockname(Transport, Listen); + +sockname(#sslsocket{pid = Pid, fd = {Transport, Socket}}) when is_pid(Pid) -> + ssl_socket:sockname(Transport, Socket). + +%%--------------------------------------------------------------- +-spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}. +%% +%% Description: Returns list of session info currently [{session_id, session_id(), +%% {cipher_suite, cipher_suite()}] +%%-------------------------------------------------------------------- +session_info(#sslsocket{pid = Pid}) when is_pid(Pid) -> + tls_connection:session_info(Pid); +session_info(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> + {error, enotconn}. + +%%--------------------------------------------------------------- +-spec versions() -> [{ssl_app, string()} | {supported, [tls_atom_version()]} | + {available, [tls_atom_version()]}]. +%% +%% Description: Returns a list of relevant versions. +%%-------------------------------------------------------------------- +versions() -> + Vsns = tls_record:supported_protocol_versions(), + SupportedVsns = [tls_record:protocol_version(Vsn) || Vsn <- Vsns], + AvailableVsns = ?ALL_SUPPORTED_VERSIONS, + [{ssl_app, ?VSN}, {supported, SupportedVsns}, {available, AvailableVsns}]. + + +%%--------------------------------------------------------------- +-spec renegotiate(#sslsocket{}) -> ok | {error, reason()}. +%% +%% Description: Initiates a renegotiation. +%%-------------------------------------------------------------------- +renegotiate(#sslsocket{pid = Pid}) when is_pid(Pid) -> + tls_connection:renegotiation(Pid); +renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> + {error, enotconn}. + +%%-------------------------------------------------------------------- +-spec prf(#sslsocket{}, binary() | 'master_secret', binary(), + binary() | prf_random(), non_neg_integer()) -> + {ok, binary()} | {error, reason()}. +%% +%% Description: use a ssl sessions TLS PRF to generate key material +%%-------------------------------------------------------------------- +prf(#sslsocket{pid = Pid}, + Secret, Label, Seed, WantedLength) when is_pid(Pid) -> + tls_connection:prf(Pid, Secret, Label, Seed, WantedLength); +prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) -> + {error, enotconn}. + +%%-------------------------------------------------------------------- +-spec clear_pem_cache() -> ok. +%% +%% Description: Clear the PEM cache +%%-------------------------------------------------------------------- +clear_pem_cache() -> + ssl_manager:clear_pem_cache(). + +%%--------------------------------------------------------------- +-spec format_error({error, term()}) -> list(). +%% +%% Description: Creates error string. +%%-------------------------------------------------------------------- +format_error({error, Reason}) -> + format_error(Reason); +format_error(Reason) when is_list(Reason) -> + Reason; +format_error(closed) -> + "TLS connection is closed"; +format_error({tls_alert, Description}) -> + "TLS Alert: " ++ Description; +format_error({options,{FileType, File, Reason}}) when FileType == cacertfile; + FileType == certfile; + FileType == keyfile; + FileType == dhfile -> + Error = file_error_format(Reason), + file_desc(FileType) ++ File ++ ": " ++ Error; +format_error({options, {socket_options, Option, Error}}) -> + lists:flatten(io_lib:format("Invalid transport socket option ~p: ~s", [Option, format_error(Error)])); +format_error({options, {socket_options, Option}}) -> + lists:flatten(io_lib:format("Invalid socket option: ~p", [Option])); +format_error({options, Options}) -> + lists:flatten(io_lib:format("Invalid TLS option: ~p", [Options])); + +format_error(Error) -> + case inet:format_error(Error) of + "unknown POSIX" ++ _ -> + unexpected_format(Error); + Other -> + Other + end. + +%%-------------------------------------------------------------------- +-spec random_bytes(integer()) -> binary(). + +%% +%% Description: Generates cryptographically secure random sequence if possible +%% fallbacks on pseudo random function +%%-------------------------------------------------------------------- +random_bytes(N) -> + try crypto:strong_rand_bytes(N) of + RandBytes -> + RandBytes + catch + error:low_entropy -> + crypto:rand_bytes(N) + end. + +%%%-------------------------------------------------------------- +%%% Internal functions +%%%-------------------------------------------------------------------- +do_connect(Address, Port, + #config{cb=CbInfo, inet_user=UserOpts, ssl=SslOpts, + emulated=EmOpts,inet_ssl=SocketOpts}, + Timeout) -> + {Transport, _, _, _} = CbInfo, + try Transport:connect(Address, Port, SocketOpts, Timeout) of + {ok, Socket} -> + tls_connection:connect(Address, Port, Socket, {SslOpts,EmOpts}, + self(), CbInfo, Timeout); + {error, Reason} -> + {error, Reason} + catch + exit:{function_clause, _} -> + {error, {options, {cb_info, CbInfo}}}; + exit:badarg -> + {error, {options, {socket_options, UserOpts}}}; + exit:{badarg, _} -> + {error, {options, {socket_options, UserOpts}}} + end. + +handle_options(Opts0, _Role) -> + Opts = proplists:expand([{binary, [{mode, binary}]}, + {list, [{mode, list}]}], Opts0), + ReuseSessionFun = fun(_, _, _, _) -> true end, + + DefaultVerifyNoneFun = + {fun(_,{bad_cert, _}, UserState) -> + {valid, UserState}; + (_,{extension, _}, UserState) -> + {unknown, UserState}; + (_, valid, UserState) -> + {valid, UserState}; + (_, valid_peer, UserState) -> + {valid, UserState} + end, []}, + + VerifyNoneFun = handle_option(verify_fun, Opts, DefaultVerifyNoneFun), + + UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false), + UserVerifyFun = handle_option(verify_fun, Opts, undefined), + CaCerts = handle_option(cacerts, Opts, undefined), + + {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = + %% Handle 0, 1, 2 for backwards compatibility + case proplists:get_value(verify, Opts, verify_none) of + 0 -> + {verify_none, false, + ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; + 1 -> + {verify_peer, false, + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; + 2 -> + {verify_peer, true, + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; + verify_none -> + {verify_none, false, + ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; + verify_peer -> + {verify_peer, UserFailIfNoPeerCert, + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; + Value -> + throw({error, {options, {verify, Value}}}) + end, + + CertFile = handle_option(certfile, Opts, <<>>), + + Versions = case handle_option(versions, Opts, []) of + [] -> + tls_record:supported_protocol_versions(); + Vsns -> + [tls_record:protocol_version(Vsn) || Vsn <- Vsns] + end, + + SSLOptions = #ssl_options{ + versions = Versions, + verify = validate_option(verify, Verify), + verify_fun = VerifyFun, + fail_if_no_peer_cert = FailIfNoPeerCert, + verify_client_once = handle_option(verify_client_once, Opts, false), + depth = handle_option(depth, Opts, 1), + cert = handle_option(cert, Opts, undefined), + certfile = CertFile, + key = handle_option(key, Opts, undefined), + keyfile = handle_option(keyfile, Opts, CertFile), + password = handle_option(password, Opts, ""), + cacerts = CaCerts, + cacertfile = handle_option(cacertfile, Opts, CaCertDefault), + dh = handle_option(dh, Opts, undefined), + dhfile = handle_option(dhfile, Opts, undefined), + user_lookup_fun = handle_option(user_lookup_fun, Opts, undefined), + psk_identity = handle_option(psk_identity, Opts, undefined), + srp_identity = handle_option(srp_identity, Opts, undefined), + ciphers = handle_option(ciphers, Opts, []), + %% Server side option + reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), + reuse_sessions = handle_option(reuse_sessions, Opts, true), + secure_renegotiate = handle_option(secure_renegotiate, Opts, false), + renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), + hibernate_after = handle_option(hibernate_after, Opts, undefined), + erl_dist = handle_option(erl_dist, Opts, false), + next_protocols_advertised = + handle_option(next_protocols_advertised, Opts, undefined), + next_protocol_selector = + make_next_protocol_selector( + handle_option(client_preferred_next_protocols, Opts, undefined)) + }, + + CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), + SslOptions = [versions, verify, verify_fun, + fail_if_no_peer_cert, verify_client_once, + depth, cert, certfile, key, keyfile, + password, cacerts, cacertfile, dh, dhfile, + user_lookup_fun, psk_identity, srp_identity, ciphers, + reuse_session, reuse_sessions, ssl_imp, + cb_info, renegotiate_at, secure_renegotiate, hibernate_after, + erl_dist, next_protocols_advertised, + client_preferred_next_protocols], + + SockOpts = lists:foldl(fun(Key, PropList) -> + proplists:delete(Key, PropList) + end, Opts, SslOptions), + + {SSLsock, Emulated} = emulated_options(SockOpts), + {ok, #config{ssl=SSLOptions, emulated=Emulated, inet_ssl=SSLsock, + inet_user=SockOpts, cb=CbInfo}}. + +handle_option(OptionName, Opts, Default) -> + validate_option(OptionName, + proplists:get_value(OptionName, Opts, Default)). + + +validate_option(versions, Versions) -> + validate_versions(Versions, Versions); +validate_option(verify, Value) + when Value == verify_none; Value == verify_peer -> + Value; +validate_option(verify_fun, undefined) -> + undefined; +%% Backwards compatibility +validate_option(verify_fun, Fun) when is_function(Fun) -> + {fun(_,{bad_cert, _} = Reason, OldFun) -> + case OldFun([Reason]) of + true -> + {valid, OldFun}; + false -> + {fail, Reason} + end; + (_,{extension, _}, UserState) -> + {unknown, UserState}; + (_, valid, UserState) -> + {valid, UserState}; + (_, valid_peer, UserState) -> + {valid, UserState} + end, Fun}; +validate_option(verify_fun, {Fun, _} = Value) when is_function(Fun) -> + Value; +validate_option(fail_if_no_peer_cert, Value) + when Value == true; Value == false -> + Value; +validate_option(verify_client_once, Value) + when Value == true; Value == false -> + Value; +validate_option(depth, Value) when is_integer(Value), + Value >= 0, Value =< 255-> + Value; +validate_option(cert, Value) when Value == undefined; + is_binary(Value) -> + Value; +validate_option(certfile, undefined = Value) -> + Value; +validate_option(certfile, Value) when is_binary(Value) -> + Value; +validate_option(certfile, Value) when is_list(Value) -> + list_to_binary(Value); + +validate_option(key, undefined) -> + undefined; +validate_option(key, {KeyType, Value}) when is_binary(Value), + KeyType == rsa; %% Backwards compatibility + KeyType == dsa; %% Backwards compatibility + KeyType == 'RSAPrivateKey'; + KeyType == 'DSAPrivateKey'; + KeyType == 'PrivateKeyInfo' -> + {KeyType, Value}; + +validate_option(keyfile, undefined) -> + <<>>; +validate_option(keyfile, Value) when is_binary(Value) -> + Value; +validate_option(keyfile, Value) when is_list(Value), Value =/= "" -> + list_to_binary(Value); +validate_option(password, Value) when is_list(Value) -> + Value; + +validate_option(cacerts, Value) when Value == undefined; + is_list(Value) -> + Value; +%% certfile must be present in some cases otherwhise it can be set +%% to the empty string. +validate_option(cacertfile, undefined) -> + <<>>; +validate_option(cacertfile, Value) when is_binary(Value) -> + Value; +validate_option(cacertfile, Value) when is_list(Value), Value =/= ""-> + list_to_binary(Value); +validate_option(dh, Value) when Value == undefined; + is_binary(Value) -> + Value; +validate_option(dhfile, undefined = Value) -> + Value; +validate_option(dhfile, Value) when is_binary(Value) -> + Value; +validate_option(dhfile, Value) when is_list(Value), Value =/= "" -> + list_to_binary(Value); +validate_option(psk_identity, undefined) -> + undefined; +validate_option(psk_identity, Identity) + when is_list(Identity), Identity =/= "", length(Identity) =< 65535 -> + list_to_binary(Identity); +validate_option(user_lookup_fun, undefined) -> + undefined; +validate_option(user_lookup_fun, {Fun, _} = Value) when is_function(Fun, 3) -> + Value; +validate_option(srp_identity, undefined) -> + undefined; +validate_option(srp_identity, {Username, Password}) + when is_list(Username), is_list(Password), Username =/= "", length(Username) =< 255 -> + {list_to_binary(Username), list_to_binary(Password)}; + +validate_option(ciphers, Value) when is_list(Value) -> + Version = tls_record:highest_protocol_version([]), + try cipher_suites(Version, Value) + catch + exit:_ -> + throw({error, {options, {ciphers, Value}}}); + error:_-> + throw({error, {options, {ciphers, Value}}}) + end; +validate_option(reuse_session, Value) when is_function(Value) -> + Value; +validate_option(reuse_sessions, Value) when Value == true; + Value == false -> + Value; + +validate_option(secure_renegotiate, Value) when Value == true; + Value == false -> + Value; +validate_option(renegotiate_at, Value) when is_integer(Value) -> + erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT); + +validate_option(hibernate_after, undefined) -> + undefined; +validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> + Value; +validate_option(erl_dist,Value) when Value == true; + Value == false -> + Value; +validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols} = Value) + when is_list(PreferredProtocols) -> + case tls_record:highest_protocol_version([]) of + {3,0} -> + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); + _ -> + validate_binary_list(client_preferred_next_protocols, PreferredProtocols), + validate_npn_ordering(Precedence), + {Precedence, PreferredProtocols, ?NO_PROTOCOL} + end; +validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols, Default} = Value) + when is_list(PreferredProtocols), is_binary(Default), + byte_size(Default) > 0, byte_size(Default) < 256 -> + case tls_record:highest_protocol_version([]) of + {3,0} -> + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); + _ -> + validate_binary_list(client_preferred_next_protocols, PreferredProtocols), + validate_npn_ordering(Precedence), + Value + end; + +validate_option(client_preferred_next_protocols, undefined) -> + undefined; +validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) -> + case tls_record:highest_protocol_version([]) of + {3,0} -> + throw({error, {options, {not_supported_in_sslv3, {Opt, Value}}}}); + _ -> + validate_binary_list(next_protocols_advertised, Value), + Value + end; + +validate_option(next_protocols_advertised, undefined) -> + undefined; +validate_option(Opt, Value) -> + throw({error, {options, {Opt, Value}}}). + +validate_npn_ordering(client) -> + ok; +validate_npn_ordering(server) -> + ok; +validate_npn_ordering(Value) -> + throw({error, {options, {client_preferred_next_protocols, {invalid_precedence, Value}}}}). + +validate_binary_list(Opt, List) -> + lists:foreach( + fun(Bin) when is_binary(Bin), + byte_size(Bin) > 0, + byte_size(Bin) < 256 -> + ok; + (Bin) -> + throw({error, {options, {Opt, {invalid_protocol, Bin}}}}) + end, List). + +validate_versions([], Versions) -> + Versions; +validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2'; + Version == 'tlsv1.1'; + Version == tlsv1; + Version == sslv3 -> + validate_versions(Rest, Versions); +validate_versions([Ver| _], Versions) -> + throw({error, {options, {Ver, {versions, Versions}}}}). + +validate_inet_option(mode, Value) + when Value =/= list, Value =/= binary -> + throw({error, {options, {mode,Value}}}); +validate_inet_option(packet, Value) + when not (is_atom(Value) orelse is_integer(Value)) -> + throw({error, {options, {packet,Value}}}); +validate_inet_option(packet_size, Value) + when not is_integer(Value) -> + throw({error, {options, {packet_size,Value}}}); +validate_inet_option(header, Value) + when not is_integer(Value) -> + throw({error, {options, {header,Value}}}); +validate_inet_option(active, Value) + when Value =/= true, Value =/= false, Value =/= once -> + throw({error, {options, {active,Value}}}); +validate_inet_option(_, _) -> + ok. + +%% The option cacerts overrides cacertsfile +ca_cert_default(_,_, [_|_]) -> + undefined; +ca_cert_default(verify_none, _, _) -> + undefined; +ca_cert_default(verify_peer, {Fun,_}, _) when is_function(Fun) -> + undefined; +%% Server that wants to verify_peer and has no verify_fun must have +%% some trusted certs. +ca_cert_default(verify_peer, undefined, _) -> + "". + +emulated_options() -> + [mode, packet, active, header, packet_size]. + +internal_inet_values() -> + [{packet_size,0},{packet, 0},{header, 0},{active, false},{mode,binary}]. + +socket_options(InetValues) -> + #socket_options{ + mode = proplists:get_value(mode, InetValues, lists), + header = proplists:get_value(header, InetValues, 0), + active = proplists:get_value(active, InetValues, active), + packet = proplists:get_value(packet, InetValues, 0), + packet_size = proplists:get_value(packet_size, InetValues) + }. + +emulated_options(Opts) -> + emulated_options(Opts, internal_inet_values(), #socket_options{}). + +emulated_options([{mode,Opt}|Opts], Inet, Emulated) -> + validate_inet_option(mode,Opt), + emulated_options(Opts, Inet, Emulated#socket_options{mode=Opt}); +emulated_options([{header,Opt}|Opts], Inet, Emulated) -> + validate_inet_option(header,Opt), + emulated_options(Opts, Inet, Emulated#socket_options{header=Opt}); +emulated_options([{active,Opt}|Opts], Inet, Emulated) -> + validate_inet_option(active,Opt), + emulated_options(Opts, Inet, Emulated#socket_options{active=Opt}); +emulated_options([{packet,Opt}|Opts], Inet, Emulated) -> + validate_inet_option(packet,Opt), + emulated_options(Opts, Inet, Emulated#socket_options{packet=Opt}); +emulated_options([{packet_size,Opt}|Opts], Inet, Emulated) -> + validate_inet_option(packet_size,Opt), + emulated_options(Opts, Inet, Emulated#socket_options{packet_size=Opt}); +emulated_options([Opt|Opts], Inet, Emulated) -> + emulated_options(Opts, [Opt|Inet], Emulated); +emulated_options([], Inet,Emulated) -> + {Inet, Emulated}. + +cipher_suites(Version, []) -> + ssl_cipher:suites(Version); +cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility + Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0], + cipher_suites(Version, Ciphers); +cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> + Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], + cipher_suites(Version, Ciphers); + +cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> + Supported0 = ssl_cipher:suites(Version) + ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:psk_suites(Version) + ++ ssl_cipher:srp_suites(), + Supported = ssl_cipher:filter_suites(Supported0), + case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported)] of + [] -> + Supported; + Ciphers -> + Ciphers + end; +cipher_suites(Version, [Head | _] = Ciphers0) when is_list(Head) -> + %% Format: ["RC4-SHA","RC4-MD5"] + Ciphers = [ssl_cipher:openssl_suite(C) || C <- Ciphers0], + cipher_suites(Version, Ciphers); +cipher_suites(Version, Ciphers0) -> + %% Format: "RC4-SHA:RC4-MD5" + Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")], + cipher_suites(Version, Ciphers). + +unexpected_format(Error) -> + lists:flatten(io_lib:format("Unexpected error: ~p", [Error])). + +file_error_format({error, Error})-> + case file:format_error(Error) of + "unknown POSIX error" -> + "decoding error"; + Str -> + Str + end; +file_error_format(_) -> + "decoding error". + +file_desc(cacertfile) -> + "Invalid CA certificate file "; +file_desc(certfile) -> + "Invalid certificate file "; +file_desc(keyfile) -> + "Invalid key file "; +file_desc(dhfile) -> + "Invalid DH params file ". + +detect(_Pred, []) -> + undefined; +detect(Pred, [H|T]) -> + case Pred(H) of + true -> + H; + _ -> + detect(Pred, T) + end. + +make_next_protocol_selector(undefined) -> + undefined; +make_next_protocol_selector({client, AllProtocols, DefaultProtocol}) -> + fun(AdvertisedProtocols) -> + case detect(fun(PreferredProtocol) -> + lists:member(PreferredProtocol, AdvertisedProtocols) + end, AllProtocols) of + undefined -> + DefaultProtocol; + PreferredProtocol -> + PreferredProtocol + end + end; + +make_next_protocol_selector({server, AllProtocols, DefaultProtocol}) -> + fun(AdvertisedProtocols) -> + case detect(fun(PreferredProtocol) -> + lists:member(PreferredProtocol, AllProtocols) + end, + AdvertisedProtocols) of + undefined -> + DefaultProtocol; + PreferredProtocol -> + PreferredProtocol + end + end. diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/tls_connection.erl index de9260fd8c..6a0461e805 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -25,13 +25,13 @@ %% sent according to the SSL-record protocol. %%---------------------------------------------------------------------- --module(ssl_connection). +-module(tls_connection). -behaviour(gen_fsm). --include("ssl_handshake.hrl"). +-include("tls_handshake.hrl"). -include("ssl_alert.hrl"). --include("ssl_record.hrl"). +-include("tls_record.hrl"). -include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). -include("ssl_srp.hrl"). @@ -70,7 +70,7 @@ tls_handshake_history, % tls_handshake_history() tls_cipher_texts, % list() received but not deciphered yet cert_db, % - session, % #session{} from ssl_handshake.hrl + session, % #session{} from tls_handshake.hrl session_cache, % session_cache_cb, % negotiated_version, % tls_version() @@ -302,7 +302,7 @@ start_link(Role, Host, Port, Socket, Options, User, CbInfo) -> init([Role, Host, Port, Socket, {SSLOpts0, _} = Options, User, CbInfo]) -> State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo), - Handshake = ssl_handshake:init_handshake_history(), + Handshake = tls_handshake:init_handshake_history(), TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), try ssl_init(SSLOpts0, Role) of {ok, Ref, CertDbHandle, FileRefHandle, CacheHandle, OwnCert, Key, DHParams} -> @@ -342,11 +342,11 @@ hello(start, #state{host = Host, port = Port, role = client, transport_cb = Transport, socket = Socket, connection_states = ConnectionStates0, renegotiation = {Renegotiation, _}} = State0) -> - Hello = ssl_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, + Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, Cert), Version = Hello#client_hello.client_version, - Handshake0 = ssl_handshake:init_handshake_history(), + Handshake0 = tls_handshake:init_handshake_history(), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Hello, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -374,7 +374,7 @@ hello(#server_hello{cipher_suite = CipherSuite, negotiated_version = ReqVersion, renegotiation = {Renegotiation, _}, ssl_options = SslOptions} = State0) -> - case ssl_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of + case tls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of #alert{} = Alert -> handle_own_alert(Alert, ReqVersion, hello, State0); {Version, NewId, ConnectionStates, NextProtocol} -> @@ -414,7 +414,7 @@ hello(Hello = #client_hello{client_version = ClientVersion}, session_cache = Cache, session_cache_cb = CacheCb, ssl_options = SslOpts}) -> - case ssl_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, + case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) of {Version, {Type, Session}, ConnectionStates, ProtocolsToAdvertise, EcPointFormats, EllipticCurves} -> @@ -448,11 +448,11 @@ abbreviated(#finished{verify_data = Data} = Finished, session = #session{master_secret = MasterSecret}, connection_states = ConnectionStates0} = State) -> - case ssl_handshake:verify_connection(Version, Finished, client, + case tls_handshake:verify_connection(Version, Finished, client, get_current_connection_state_prf(ConnectionStates0, write), MasterSecret, Handshake) of verified -> - ConnectionStates = ssl_record:set_client_verify_data(current_both, Data, ConnectionStates0), + ConnectionStates = tls_record:set_client_verify_data(current_both, Data, ConnectionStates0), next_state_connection(abbreviated, ack_connection(State#state{connection_states = ConnectionStates})); #alert{} = Alert -> @@ -464,11 +464,11 @@ abbreviated(#finished{verify_data = Data} = Finished, session = #session{master_secret = MasterSecret}, negotiated_version = Version, connection_states = ConnectionStates0} = State) -> - case ssl_handshake:verify_connection(Version, Finished, server, + case tls_handshake:verify_connection(Version, Finished, server, get_pending_connection_state_prf(ConnectionStates0, write), MasterSecret, Handshake0) of verified -> - ConnectionStates1 = ssl_record:set_server_verify_data(current_read, Data, ConnectionStates0), + ConnectionStates1 = tls_record:set_server_verify_data(current_read, Data, ConnectionStates0), {ConnectionStates, Handshake} = finalize_handshake(State#state{connection_states = ConnectionStates1}, abbreviated), next_state_connection(abbreviated, @@ -523,7 +523,7 @@ certify(#certificate{} = Cert, cert_db = CertDbHandle, cert_db_ref = CertDbRef, ssl_options = Opts} = State) -> - case ssl_handshake:certify(Cert, CertDbHandle, CertDbRef, Opts#ssl_options.depth, + case tls_handshake:certify(Cert, CertDbHandle, CertDbRef, Opts#ssl_options.depth, Opts#ssl_options.verify, Opts#ssl_options.verify_fun, Role) of {PeerCert, PublicKeyInfo} -> @@ -603,7 +603,7 @@ certify(#server_hello_done{}, negotiated_version = Version, premaster_secret = undefined, role = client} = State0) -> - case ssl_handshake:master_secret(Version, Session, + case tls_handshake:master_secret(Version, Session, ConnectionStates0, client) of {MasterSecret, ConnectionStates} -> State = State0#state{connection_states = ConnectionStates}, @@ -619,7 +619,7 @@ certify(#server_hello_done{}, negotiated_version = Version, premaster_secret = PremasterSecret, role = client} = State0) -> - case ssl_handshake:master_secret(Version, PremasterSecret, + case tls_handshake:master_secret(Version, PremasterSecret, ConnectionStates0, client) of {MasterSecret, ConnectionStates} -> Session = Session0#session{master_secret = MasterSecret}, @@ -640,7 +640,7 @@ certify(#client_key_exchange{} = Msg, certify(#client_key_exchange{exchange_keys = Keys}, State = #state{key_algorithm = KeyAlg, negotiated_version = Version}) -> try - certify_client_key_exchange(ssl_handshake:decode_client_key(Keys, KeyAlg, Version), State) + certify_client_key_exchange(tls_handshake:decode_client_key(Keys, KeyAlg, Version), State) catch #alert{} = Alert -> handle_own_alert(Alert, Version, certify, State) @@ -658,8 +658,8 @@ certify_client_key_exchange(#encrypted_premaster_secret{premaster_secret= EncPMS connection_states = ConnectionStates0, session = Session0, private_key = Key} = State0) -> - PremasterSecret = ssl_handshake:decrypt_premaster_secret(EncPMS, Key), - case ssl_handshake:master_secret(Version, PremasterSecret, + PremasterSecret = tls_handshake:decrypt_premaster_secret(EncPMS, Key), + case tls_handshake:master_secret(Version, PremasterSecret, ConnectionStates0, server) of {MasterSecret, ConnectionStates} -> Session = Session0#session{master_secret = MasterSecret}, @@ -726,7 +726,7 @@ certify_client_key_exchange(#client_rsa_psk_identity{ #encrypted_premaster_secret{premaster_secret= EncPMS}}, #state{negotiated_version = Version, private_key = Key} = State0) -> - PremasterSecret = ssl_handshake:decrypt_premaster_secret(EncPMS, Key), + PremasterSecret = tls_handshake:decrypt_premaster_secret(EncPMS, Key), case server_rsa_psk_master_secret(PskIdentity, PremasterSecret, State0) of #state{} = State1 -> {Record, State} = next_record(State1), @@ -769,7 +769,7 @@ cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashS {_, _} -> CertHashSign; _ -> ConnectionHashSign end, - case ssl_handshake:certificate_verify(Signature, PublicKeyInfo, + case tls_handshake:certificate_verify(Signature, PublicKeyInfo, Version, HashSign, MasterSecret, Handshake) of valid -> {Record, State} = next_record(State0), @@ -792,7 +792,7 @@ cipher(#finished{verify_data = Data} = Finished, = Session0, connection_states = ConnectionStates0, tls_handshake_history = Handshake0} = State) -> - case ssl_handshake:verify_connection(Version, Finished, + case tls_handshake:verify_connection(Version, Finished, opposite_role(Role), get_current_connection_state_prf(ConnectionStates0, read), MasterSecret, Handshake0) of @@ -830,7 +830,7 @@ connection(#hello_request{}, #state{host = Host, port = Port, connection_states = ConnectionStates0, renegotiation = {Renegotiation, _}, tls_handshake_history = Handshake0} = State0) -> - Hello = ssl_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, + Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, Cache, CacheCb, Renegotiation, Cert), {BinMsg, ConnectionStates, Handshake} = @@ -1025,7 +1025,7 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, #state{connection_states = ConnectionStates, negotiated_version = Version} = State) -> ConnectionState = - ssl_record:current_connection_state(ConnectionStates, read), + tls_record:current_connection_state(ConnectionStates, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{master_secret = MasterSecret, client_random = ClientRandom, @@ -1040,7 +1040,7 @@ handle_sync_event({prf, Secret, Label, Seed, WantedLength}, _, StateName, (client_random, Acc) -> [ClientRandom|Acc]; (server_random, Acc) -> [ServerRandom|Acc] end, [], Seed)), - ssl_handshake:prf(Version, SecretToUse, Label, SeedToUse, WantedLength) + tls_handshake:prf(Version, SecretToUse, Label, SeedToUse, WantedLength) catch exit:_ -> {error, badarg}; error:Reason -> {error, Reason} @@ -1051,7 +1051,7 @@ handle_sync_event(info, _, StateName, #state{negotiated_version = Version, session = #session{cipher_suite = Suite}} = State) -> - AtomVersion = ssl_record:protocol_version(Version), + AtomVersion = tls_record:protocol_version(Version), {reply, {ok, {AtomVersion, ssl:suite_definition(Suite)}}, StateName, State, get_timeout(State)}; @@ -1397,7 +1397,7 @@ certify_client(#state{client_certificate_requested = true, role = client, session = #session{own_certificate = OwnCert}, socket = Socket, tls_handshake_history = Handshake0} = State) -> - Certificate = ssl_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, client), + Certificate = tls_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, client), {BinCert, ConnectionStates, Handshake} = encode_handshake(Certificate, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinCert), @@ -1418,7 +1418,7 @@ verify_client_cert(#state{client_certificate_requested = true, role = client, tls_handshake_history = Handshake0} = State) -> %%TODO: for TLS 1.2 we can choose a different/stronger HashSign combination for this. - case ssl_handshake:client_certificate_verify(OwnCert, MasterSecret, + case tls_handshake:client_certificate_verify(OwnCert, MasterSecret, Version, HashSign, PrivateKey, Handshake0) of #certificate_verify{} = Verified -> {BinVerified, ConnectionStates, Handshake} = @@ -1444,7 +1444,7 @@ do_server_hello(Type, NextProtocolsToSend, = State0) when is_atom(Type) -> ServerHello = - ssl_handshake:server_hello(SessId, Version, + tls_handshake:server_hello(SessId, Version, ConnectionStates0, Renegotiation, NextProtocolsToSend, EcPointFormats, EllipticCurves), State = server_hello(ServerHello, @@ -1480,7 +1480,7 @@ resumed_server_hello(#state{session = Session, connection_states = ConnectionStates0, negotiated_version = Version} = State0) -> - case ssl_handshake:master_secret(Version, Session, + case tls_handshake:master_secret(Version, Session, ConnectionStates0, server) of {_, ConnectionStates1} -> State1 = State0#state{connection_states = ConnectionStates1, @@ -1509,7 +1509,7 @@ handle_resumed_session(SessId, #state{connection_states = ConnectionStates0, session_cache = Cache, session_cache_cb = CacheCb} = State0) -> Session = CacheCb:lookup(Cache, {{Host, Port}, SessId}), - case ssl_handshake:master_secret(Version, Session, + case tls_handshake:master_secret(Version, Session, ConnectionStates0, client) of {_, ConnectionStates} -> {Record, State} = @@ -1569,7 +1569,7 @@ server_hello_done(#state{transport_cb = Transport, connection_states = ConnectionStates0, tls_handshake_history = Handshake0} = State) -> - HelloDone = ssl_handshake:server_hello_done(), + HelloDone = tls_handshake:server_hello_done(), {BinHelloDone, ConnectionStates, Handshake} = encode_handshake(HelloDone, Version, ConnectionStates0, Handshake0), @@ -1589,7 +1589,7 @@ certify_server(#state{transport_cb = Transport, cert_db = CertDbHandle, cert_db_ref = CertDbRef, session = #session{own_certificate = OwnCert}} = State) -> - case ssl_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, server) of + case tls_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, server) of CertMsg = #certificate{} -> {BinCertMsg, ConnectionStates, Handshake} = encode_handshake(CertMsg, Version, ConnectionStates0, Handshake0), @@ -1618,11 +1618,11 @@ key_exchange(#state{role = server, key_algorithm = Algo, Algo == dh_anon -> DHKeys = public_key:generate_key(Params), ConnectionState = - ssl_record:pending_connection_state(ConnectionStates0, read), + tls_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = ssl_handshake:key_exchange(server, Version, {dh, DHKeys, Params, + Msg = tls_handshake:key_exchange(server, Version, {dh, DHKeys, Params, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1650,11 +1650,11 @@ key_exchange(#state{role = server, key_algorithm = Algo, ECDHKeys = public_key:generate_key(select_curve(State)), ConnectionState = - ssl_record:pending_connection_state(ConnectionStates0, read), + tls_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = ssl_handshake:key_exchange(server, Version, {ecdh, ECDHKeys, + Msg = tls_handshake:key_exchange(server, Version, {ecdh, ECDHKeys, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1679,14 +1679,14 @@ key_exchange(#state{role = server, key_algorithm = psk, transport_cb = Transport } = State) -> ConnectionState = - ssl_record:pending_connection_state(ConnectionStates0, read), + tls_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = ssl_handshake:key_exchange(server, Version, {psk, PskIdentityHint, - HashSignAlgo, ClientRandom, - ServerRandom, - PrivateKey}), + Msg = tls_handshake:key_exchange(server, Version, {psk, PskIdentityHint, + HashSignAlgo, ClientRandom, + ServerRandom, + PrivateKey}), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1706,11 +1706,11 @@ key_exchange(#state{role = server, key_algorithm = dhe_psk, } = State) -> DHKeys = public_key:generate_key(Params), ConnectionState = - ssl_record:pending_connection_state(ConnectionStates0, read), + tls_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = ssl_handshake:key_exchange(server, Version, {dhe_psk, PskIdentityHint, DHKeys, Params, + Msg = tls_handshake:key_exchange(server, Version, {dhe_psk, PskIdentityHint, DHKeys, Params, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1735,11 +1735,11 @@ key_exchange(#state{role = server, key_algorithm = rsa_psk, transport_cb = Transport } = State) -> ConnectionState = - ssl_record:pending_connection_state(ConnectionStates0, read), + tls_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = ssl_handshake:key_exchange(server, Version, {psk, PskIdentityHint, + Msg = tls_handshake:key_exchange(server, Version, {psk, PskIdentityHint, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1771,11 +1771,11 @@ key_exchange(#state{role = server, key_algorithm = Algo, Keys0 end, ConnectionState = - ssl_record:pending_connection_state(ConnectionStates0, read), + tls_record:pending_connection_state(ConnectionStates0, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Msg = ssl_handshake:key_exchange(server, Version, {srp, Keys, SrpParams, + Msg = tls_handshake:key_exchange(server, Version, {srp, Keys, SrpParams, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1811,7 +1811,7 @@ key_exchange(#state{role = client, when Algorithm == dhe_dss; Algorithm == dhe_rsa; Algorithm == dh_anon -> - Msg = ssl_handshake:key_exchange(client, Version, {dh, DhPubKey}), + Msg = tls_handshake:key_exchange(client, Version, {dh, DhPubKey}), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1828,7 +1828,7 @@ key_exchange(#state{role = client, when Algorithm == ecdhe_ecdsa; Algorithm == ecdhe_rsa; Algorithm == ecdh_ecdsa; Algorithm == ecdh_rsa; Algorithm == ecdh_anon -> - Msg = ssl_handshake:key_exchange(client, Version, {ecdh, Keys}), + Msg = tls_handshake:key_exchange(client, Version, {ecdh, Keys}), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1842,7 +1842,7 @@ key_exchange(#state{role = client, negotiated_version = Version, socket = Socket, transport_cb = Transport, tls_handshake_history = Handshake0} = State) -> - Msg = ssl_handshake:key_exchange(client, Version, {psk, SslOpts#ssl_options.psk_identity}), + Msg = tls_handshake:key_exchange(client, Version, {psk, SslOpts#ssl_options.psk_identity}), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1857,7 +1857,7 @@ key_exchange(#state{role = client, diffie_hellman_keys = {DhPubKey, _}, socket = Socket, transport_cb = Transport, tls_handshake_history = Handshake0} = State) -> - Msg = ssl_handshake:key_exchange(client, Version, {dhe_psk, SslOpts#ssl_options.psk_identity, DhPubKey}), + Msg = tls_handshake:key_exchange(client, Version, {dhe_psk, SslOpts#ssl_options.psk_identity, DhPubKey}), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1890,7 +1890,7 @@ key_exchange(#state{role = client, when Algorithm == srp_dss; Algorithm == srp_rsa; Algorithm == srp_anon -> - Msg = ssl_handshake:key_exchange(client, Version, {srp, ClientPubKey}), + Msg = tls_handshake:key_exchange(client, Version, {srp, ClientPubKey}), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1907,7 +1907,7 @@ rsa_key_exchange(Version, PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) Algorithm == ?sha384WithRSAEncryption; Algorithm == ?sha512WithRSAEncryption -> - ssl_handshake:key_exchange(client, Version, + tls_handshake:key_exchange(client, Version, {premaster_secret, PremasterSecret, PublicKeyInfo}); rsa_key_exchange(_, _, _) -> @@ -1923,7 +1923,7 @@ rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret, PublicKeyInfo = {Alg Algorithm == ?sha384WithRSAEncryption; Algorithm == ?sha512WithRSAEncryption -> - ssl_handshake:key_exchange(client, Version, + tls_handshake:key_exchange(client, Version, {psk_premaster_secret, PskIdentity, PremasterSecret, PublicKeyInfo}); rsa_psk_key_exchange(_, _, _, _) -> @@ -1937,7 +1937,7 @@ request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer}, negotiated_version = Version, socket = Socket, transport_cb = Transport} = State) -> - Msg = ssl_handshake:certificate_request(ConnectionStates0, CertDbHandle, CertDbRef), + Msg = tls_handshake:certificate_request(ConnectionStates0, CertDbHandle, CertDbRef), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1952,7 +1952,7 @@ finalize_handshake(State, StateName) -> ConnectionStates0 = cipher_protocol(State), ConnectionStates = - ssl_record:activate_pending_connection_state(ConnectionStates0, + tls_record:activate_pending_connection_state(ConnectionStates0, write), State1 = State#state{connection_states = ConnectionStates}, @@ -1970,7 +1970,7 @@ next_protocol(#state{transport_cb = Transport, socket = Socket, next_protocol = NextProtocol, connection_states = ConnectionStates0, tls_handshake_history = Handshake0} = State) -> - NextProtocolMessage = ssl_handshake:next_protocol(NextProtocol), + NextProtocolMessage = tls_handshake:next_protocol(NextProtocol), {BinMsg, ConnectionStates, Handshake} = encode_handshake(NextProtocolMessage, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), State#state{connection_states = ConnectionStates, @@ -1992,7 +1992,7 @@ finished(#state{role = Role, socket = Socket, negotiated_version = Version, connection_states = ConnectionStates0, tls_handshake_history = Handshake0}, StateName) -> MasterSecret = Session#session.master_secret, - Finished = ssl_handshake:finished(Version, Role, + Finished = tls_handshake:finished(Version, Role, get_current_connection_state_prf(ConnectionStates0, write), MasterSecret, Handshake0), ConnectionStates1 = save_verify_data(Role, Finished, ConnectionStates0, StateName), @@ -2002,18 +2002,18 @@ finished(#state{role = Role, socket = Socket, negotiated_version = Version, {ConnectionStates, Handshake}. save_verify_data(client, #finished{verify_data = Data}, ConnectionStates, certify) -> - ssl_record:set_client_verify_data(current_write, Data, ConnectionStates); + tls_record:set_client_verify_data(current_write, Data, ConnectionStates); save_verify_data(server, #finished{verify_data = Data}, ConnectionStates, cipher) -> - ssl_record:set_server_verify_data(current_both, Data, ConnectionStates); + tls_record:set_server_verify_data(current_both, Data, ConnectionStates); save_verify_data(client, #finished{verify_data = Data}, ConnectionStates, abbreviated) -> - ssl_record:set_client_verify_data(current_both, Data, ConnectionStates); + tls_record:set_client_verify_data(current_both, Data, ConnectionStates); save_verify_data(server, #finished{verify_data = Data}, ConnectionStates, abbreviated) -> - ssl_record:set_server_verify_data(current_write, Data, ConnectionStates). + tls_record:set_server_verify_data(current_write, Data, ConnectionStates). handle_server_key(#server_key_exchange{exchange_keys = Keys}, #state{key_algorithm = KeyAlg, negotiated_version = Version} = State) -> - Params = ssl_handshake:decode_server_key(Keys, KeyAlg, Version), + Params = tls_handshake:decode_server_key(Keys, KeyAlg, Version), HashSign = connection_hashsign(Params#server_key_params.hashsign, State), case HashSign of {_, SignAlgo} when SignAlgo == anon; SignAlgo == ecdh_anon -> @@ -2030,15 +2030,15 @@ verify_server_key(#server_key_params{params = Params, public_key_info = PubKeyInfo, connection_states = ConnectionStates} = State) -> ConnectionState = - ssl_record:pending_connection_state(ConnectionStates, read), + tls_record:pending_connection_state(ConnectionStates, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{client_random = ClientRandom, server_random = ServerRandom} = SecParams, - Hash = ssl_handshake:server_key_exchange_hash(HashAlgo, + Hash = tls_handshake:server_key_exchange_hash(HashAlgo, <<ClientRandom/binary, ServerRandom/binary, EncParams/binary>>), - case ssl_handshake:verify_signature(Version, Hash, HashSign, Signature, PubKeyInfo) of + case tls_handshake:verify_signature(Version, Hash, HashSign, Signature, PubKeyInfo) of true -> server_master_secret(Params, State); false -> @@ -2074,7 +2074,7 @@ master_from_premaster_secret(PremasterSecret, #state{session = Session, negotiated_version = Version, role = Role, connection_states = ConnectionStates0} = State) -> - case ssl_handshake:master_secret(Version, PremasterSecret, + case tls_handshake:master_secret(Version, PremasterSecret, ConnectionStates0, Role) of {MasterSecret, ConnectionStates} -> State#state{ @@ -2227,12 +2227,12 @@ client_srp_master_secret(Generator, Prime, Salt, ServerPub, ClientKeys, end. cipher_role(client, Data, Session, #state{connection_states = ConnectionStates0} = State) -> - ConnectionStates = ssl_record:set_server_verify_data(current_both, Data, ConnectionStates0), + ConnectionStates = tls_record:set_server_verify_data(current_both, Data, ConnectionStates0), next_state_connection(cipher, ack_connection(State#state{session = Session, connection_states = ConnectionStates})); cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0} = State) -> - ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data, ConnectionStates0), + ConnectionStates1 = tls_record:set_client_verify_data(current_read, Data, ConnectionStates0), {ConnectionStates, Handshake} = finalize_handshake(State#state{connection_states = ConnectionStates1, session = Session}, cipher), @@ -2242,16 +2242,16 @@ cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0 tls_handshake_history = Handshake})). encode_alert(#alert{} = Alert, Version, ConnectionStates) -> - ssl_record:encode_alert_record(Alert, Version, ConnectionStates). + tls_record:encode_alert_record(Alert, Version, ConnectionStates). encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) -> - ssl_record:encode_change_cipher_spec(Version, ConnectionStates). + tls_record:encode_change_cipher_spec(Version, ConnectionStates). encode_handshake(HandshakeRec, Version, ConnectionStates0, Handshake0) -> - Frag = ssl_handshake:encode_handshake(HandshakeRec, Version), - Handshake1 = ssl_handshake:update_handshake_history(Handshake0, Frag), + Frag = tls_handshake:encode_handshake(HandshakeRec, Version), + Handshake1 = tls_handshake:update_handshake_history(Handshake0, Frag), {E, ConnectionStates1} = - ssl_record:encode_handshake(Frag, Version, ConnectionStates0), + tls_record:encode_handshake(Frag, Version, ConnectionStates0), {E, ConnectionStates1, Handshake1}. encode_packet(Data, #socket_options{packet=Packet}) -> @@ -2346,7 +2346,7 @@ write_application_data(Data0, From, #state{socket = Socket, renegotiate(State#state{send_queue = queue:in_r({From, Data}, SendQueue), renegotiation = {true, internal}}); false -> - {Msgs, ConnectionStates} = ssl_record:encode_data(Data, Version, ConnectionStates0), + {Msgs, ConnectionStates} = tls_record:encode_data(Data, Version, ConnectionStates0), Result = Transport:send(Socket, Msgs), {reply, Result, connection, State#state{connection_states = ConnectionStates}, get_timeout(State)} @@ -2514,7 +2514,7 @@ next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, fun({#hello_request{} = Packet, _}, {next_state, connection = SName, State}) -> %% This message should not be included in handshake %% message hashes. Starts new handshake (renegotiation) - Hs0 = ssl_handshake:init_handshake_history(), + Hs0 = tls_handshake:init_handshake_history(), ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs0, renegotiation = {true, peer}}); ({#hello_request{} = Packet, _}, {next_state, SName, State}) -> @@ -2523,17 +2523,17 @@ next_state(Current, Next, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, ?MODULE:SName(Packet, State); ({#client_hello{} = Packet, Raw}, {next_state, connection = SName, State}) -> Version = Packet#client_hello.client_version, - Hs0 = ssl_handshake:init_handshake_history(), - Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), + Hs0 = tls_handshake:init_handshake_history(), + Hs1 = tls_handshake:update_handshake_history(Hs0, Raw), ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs1, renegotiation = {true, peer}}); ({Packet, Raw}, {next_state, SName, State = #state{tls_handshake_history=Hs0}}) -> - Hs1 = ssl_handshake:update_handshake_history(Hs0, Raw), + Hs1 = tls_handshake:update_handshake_history(Hs0, Raw), ?MODULE:SName(Packet, State#state{tls_handshake_history=Hs1}); (_, StopState) -> StopState end, try - {Packets, Buf} = ssl_handshake:get_tls_handshake(Version,Data,Buf0), + {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0), State = State0#state{tls_packets = Packets, tls_handshake_buffer = Buf}, handle_tls_handshake(Handle, Next, State) catch throw:#alert{} = Alert -> @@ -2551,7 +2551,7 @@ next_state(Current, Next, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = <<1>>} _ChangeCipher, #state{connection_states = ConnectionStates0} = State0) -> ConnectionStates1 = - ssl_record:activate_pending_connection_state(ConnectionStates0, read), + tls_record:activate_pending_connection_state(ConnectionStates0, read), {Record, State} = next_record(State0#state{connection_states = ConnectionStates1}), next_state(Current, Next, Record, State); next_state(Current, Next, #ssl_tls{type = _Unknown}, State0) -> @@ -2561,7 +2561,7 @@ next_state(Current, Next, #ssl_tls{type = _Unknown}, State0) -> next_tls_record(Data, #state{tls_record_buffer = Buf0, tls_cipher_texts = CT0} = State0) -> - case ssl_record:get_tls_records(Data, Buf0) of + case tls_record:get_tls_records(Data, Buf0) of {Records, Buf1} -> CT1 = CT0 ++ Records, next_record(State0#state{tls_record_buffer = Buf1, @@ -2576,7 +2576,7 @@ next_record(#state{tls_packets = [], tls_cipher_texts = [], socket = Socket, {no_record, State}; next_record(#state{tls_packets = [], tls_cipher_texts = [CT | Rest], connection_states = ConnStates0} = State) -> - case ssl_record:decode_cipher_text(CT, ConnStates0) of + case tls_record:decode_cipher_text(CT, ConnStates0) of {Plain, ConnStates} -> {Plain, State#state{tls_cipher_texts = Rest, connection_states = ConnStates}}; #alert{} = Alert -> @@ -2603,7 +2603,7 @@ next_state_connection(StateName, #state{send_queue = Queue0, case queue:out(Queue0) of {{value, {From, Data}}, Queue} -> {Msgs, ConnectionStates} = - ssl_record:encode_data(Data, Version, ConnectionStates0), + tls_record:encode_data(Data, Version, ConnectionStates0), Result = Transport:send(Socket, Msgs), gen_fsm:reply(From, Result), next_state_connection(StateName, @@ -2622,13 +2622,13 @@ next_state_is_connection(_, State = #socket_options{active = false}}) when RecvFrom =/= undefined -> passive_receive(State#state{premaster_secret = undefined, public_key_info = undefined, - tls_handshake_history = ssl_handshake:init_handshake_history()}, connection); + tls_handshake_history = tls_handshake:init_handshake_history()}, connection); next_state_is_connection(StateName, State0) -> {Record, State} = next_record_if_active(State0), next_state(StateName, connection, Record, State#state{premaster_secret = undefined, public_key_info = undefined, - tls_handshake_history = ssl_handshake:init_handshake_history()}). + tls_handshake_history = tls_handshake:init_handshake_history()}). register_session(client, Host, Port, #session{is_resumable = new} = Session0) -> Session = Session0#session{is_resumable = true}, @@ -2648,7 +2648,7 @@ invalidate_session(server, _, Port, Session) -> initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, {CbModule, DataTag, CloseTag, ErrorTag}) -> - ConnectionStates = ssl_record:init_connection_states(Role), + ConnectionStates = tls_record:init_connection_states(Role), SessionCacheCb = case application:get_env(ssl, session_cb) of {ok, Cb} when is_atom(Cb) -> @@ -2905,18 +2905,18 @@ ack_connection(State) -> renegotiate(#state{role = client} = State) -> %% Handle same way as if server requested %% the renegotiation - Hs0 = ssl_handshake:init_handshake_history(), + Hs0 = tls_handshake:init_handshake_history(), connection(#hello_request{}, State#state{tls_handshake_history = Hs0}); renegotiate(#state{role = server, socket = Socket, transport_cb = Transport, negotiated_version = Version, connection_states = ConnectionStates0} = State0) -> - HelloRequest = ssl_handshake:hello_request(), - Frag = ssl_handshake:encode_handshake(HelloRequest, Version), - Hs0 = ssl_handshake:init_handshake_history(), + HelloRequest = tls_handshake:hello_request(), + Frag = tls_handshake:encode_handshake(HelloRequest, Version), + Hs0 = tls_handshake:init_handshake_history(), {BinMsg, ConnectionStates} = - ssl_record:encode_handshake(Frag, Version, ConnectionStates0), + tls_record:encode_handshake(Frag, Version, ConnectionStates0), Transport:send(Socket, BinMsg), {Record, State} = next_record(State0#state{connection_states = ConnectionStates, @@ -2976,14 +2976,14 @@ handle_trusted_certs_db(#state{cert_db_ref = Ref, ssl_options = #ssl_options{cacertfile = undefined}}) -> %% Certs provided as DER directly can not be shared %% with other connections and it is safe to delete them when the connection ends. - ssl_certificate_db:remove_trusted_certs(Ref, CertDb); + ssl_pkix_db:remove_trusted_certs(Ref, CertDb); handle_trusted_certs_db(#state{file_ref_db = undefined}) -> %% Something went wrong early (typically cacertfile does not exist) so there is nothing to handle ok; handle_trusted_certs_db(#state{cert_db_ref = Ref, file_ref_db = RefDb, ssl_options = #ssl_options{cacertfile = File}}) -> - case ssl_certificate_db:ref_count(Ref, RefDb, -1) of + case ssl_pkix_db:ref_count(Ref, RefDb, -1) of 0 -> ssl_manager:clean_cert_db(Ref, File); _ -> @@ -2991,10 +2991,10 @@ handle_trusted_certs_db(#state{cert_db_ref = Ref, end. get_current_connection_state_prf(CStates, Direction) -> - CS = ssl_record:current_connection_state(CStates, Direction), + CS = tls_record:current_connection_state(CStates, Direction), CS#connection_state.security_parameters#security_parameters.prf_algorithm. get_pending_connection_state_prf(CStates, Direction) -> - CS = ssl_record:pending_connection_state(CStates, Direction), + CS = tls_record:pending_connection_state(CStates, Direction), CS#connection_state.security_parameters#security_parameters.prf_algorithm. connection_hashsign(HashSign = {_, _}, _State) -> diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/tls_handshake.erl index 24ea86311f..fea75736f7 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -21,10 +21,10 @@ %% Purpose: Help funtions for handling the SSL-handshake protocol %%---------------------------------------------------------------------- --module(ssl_handshake). +-module(tls_handshake). --include("ssl_handshake.hrl"). --include("ssl_record.hrl"). +-include("tls_handshake.hrl"). +-include("tls_record.hrl"). -include("ssl_cipher.hrl"). -include("ssl_alert.hrl"). -include("ssl_internal.hrl"). @@ -64,8 +64,8 @@ client_hello(Host, Port, ConnectionStates, ciphers = UserSuites } = SslOpts, Cache, CacheCb, Renegotiation, OwnCert) -> - Version = ssl_record:highest_protocol_version(Versions), - Pending = ssl_record:pending_connection_state(ConnectionStates, read), + Version = tls_record:highest_protocol_version(Versions), + Pending = tls_record:pending_connection_state(ConnectionStates, read), SecParams = Pending#connection_state.security_parameters, Ciphers = available_suites(UserSuites, Version), SRP = srp_user(SslOpts), @@ -76,7 +76,7 @@ client_hello(Host, Port, ConnectionStates, #client_hello{session_id = Id, client_version = Version, cipher_suites = cipher_suites(Ciphers, Renegotiation), - compression_methods = ssl_record:compressions(), + compression_methods = tls_record:compressions(), random = SecParams#security_parameters.client_random, renegotiation_info = @@ -109,7 +109,7 @@ encode_protocols_advertised_on_server(Protocols) -> %%-------------------------------------------------------------------- server_hello(SessionId, Version, ConnectionStates, Renegotiation, ProtocolsAdvertisedOnServer, EcPointFormats, EllipticCurves) -> - Pending = ssl_record:pending_connection_state(ConnectionStates, read), + Pending = tls_record:pending_connection_state(ConnectionStates, read), SecParams = Pending#connection_state.security_parameters, #server_hello{server_version = Version, cipher_suite = SecParams#security_parameters.cipher_suite, @@ -153,7 +153,7 @@ hello(#server_hello{cipher_suite = CipherSuite, server_version = Version, versions = SupportedVersions}, ConnectionStates0, Renegotiation) -> %%TODO: select hash and signature algorigthm - case ssl_record:is_acceptable_version(Version, SupportedVersions) of + case tls_record:is_acceptable_version(Version, SupportedVersions) of true -> case handle_renegotiation_info(client, Info, ConnectionStates0, Renegotiation, SecureRenegotation, []) of @@ -179,7 +179,7 @@ hello(#client_hello{client_version = ClientVersion} = Hello, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) -> %% TODO: select hash and signature algorithm Version = select_version(ClientVersion, Versions), - case ssl_record:is_acceptable_version(Version, Versions) of + case tls_record:is_acceptable_version(Version, Versions) of true -> %% TODO: need to take supported Curves into Account when selecting the CipherSuite.... %% if whe have an ECDSA cert with an unsupported curve, we need to drop ECDSA ciphers @@ -357,7 +357,7 @@ verify_signature(_Version, Hash, {HashAlgo, ecdsa}, Signature, {?'id-ecPublicKey certificate_request(ConnectionStates, CertDbHandle, CertDbRef) -> #connection_state{security_parameters = #security_parameters{cipher_suite = CipherSuite}} = - ssl_record:pending_connection_state(ConnectionStates, read), + tls_record:pending_connection_state(ConnectionStates, read), Types = certificate_types(CipherSuite), HashSigns = default_hash_signs(), Authorities = certificate_authorities(CertDbHandle, CertDbRef), @@ -499,7 +499,7 @@ enc_server_key_exchange(Version, Params, {HashAlgo, SignAlgo}, master_secret(Version, #session{master_secret = Mastersecret}, ConnectionStates, Role) -> ConnectionState = - ssl_record:pending_connection_state(ConnectionStates, read), + tls_record:pending_connection_state(ConnectionStates, read), SecParams = ConnectionState#connection_state.security_parameters, try master_secret(Version, Mastersecret, SecParams, ConnectionStates, Role) @@ -513,7 +513,7 @@ master_secret(Version, #session{master_secret = Mastersecret}, master_secret(Version, PremasterSecret, ConnectionStates, Role) -> ConnectionState = - ssl_record:pending_connection_state(ConnectionStates, read), + tls_record:pending_connection_state(ConnectionStates, read), SecParams = ConnectionState#connection_state.security_parameters, #security_parameters{prf_algorithm = PrfAlgo, client_random = ClientRandom, @@ -760,7 +760,7 @@ srp_user(_) -> renegotiation_info(client, _, false) -> #renegotiation_info{renegotiated_connection = undefined}; renegotiation_info(server, ConnectionStates, false) -> - CS = ssl_record:current_connection_state(ConnectionStates, read), + CS = tls_record:current_connection_state(ConnectionStates, read), case CS#connection_state.secure_renegotiation of true -> #renegotiation_info{renegotiated_connection = ?byte(0)}; @@ -768,7 +768,7 @@ renegotiation_info(server, ConnectionStates, false) -> #renegotiation_info{renegotiated_connection = undefined} end; renegotiation_info(client, ConnectionStates, true) -> - CS = ssl_record:current_connection_state(ConnectionStates, read), + CS = tls_record:current_connection_state(ConnectionStates, read), case CS#connection_state.secure_renegotiation of true -> Data = CS#connection_state.client_verify_data, @@ -778,7 +778,7 @@ renegotiation_info(client, ConnectionStates, true) -> end; renegotiation_info(server, ConnectionStates, true) -> - CS = ssl_record:current_connection_state(ConnectionStates, read), + CS = tls_record:current_connection_state(ConnectionStates, read), case CS#connection_state.secure_renegotiation of true -> CData = CS#connection_state.client_verify_data, @@ -873,22 +873,22 @@ handle_ecc_curves_extension(Version, _) -> handle_renegotiation_info(_, #renegotiation_info{renegotiated_connection = ?byte(0)}, ConnectionStates, false, _, _) -> - {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)}; + {ok, tls_record:set_renegotiation_flag(true, ConnectionStates)}; handle_renegotiation_info(server, undefined, ConnectionStates, _, _, CipherSuites) -> case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of true -> - {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)}; + {ok, tls_record:set_renegotiation_flag(true, ConnectionStates)}; false -> - {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)} + {ok, tls_record:set_renegotiation_flag(false, ConnectionStates)} end; handle_renegotiation_info(_, undefined, ConnectionStates, false, _, _) -> - {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)}; + {ok, tls_record:set_renegotiation_flag(false, ConnectionStates)}; handle_renegotiation_info(client, #renegotiation_info{renegotiated_connection = ClientServerVerify}, ConnectionStates, true, _, _) -> - CS = ssl_record:current_connection_state(ConnectionStates, read), + CS = tls_record:current_connection_state(ConnectionStates, read), CData = CS#connection_state.client_verify_data, SData = CS#connection_state.server_verify_data, case <<CData/binary, SData/binary>> == ClientServerVerify of @@ -904,7 +904,7 @@ handle_renegotiation_info(server, #renegotiation_info{renegotiated_connection = true -> ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); false -> - CS = ssl_record:current_connection_state(ConnectionStates, read), + CS = tls_record:current_connection_state(ConnectionStates, read), Data = CS#connection_state.client_verify_data, case Data == ClientVerify of true -> @@ -926,7 +926,7 @@ handle_renegotiation_info(server, undefined, ConnectionStates, true, SecureReneg end. handle_renegotiation_info(ConnectionStates, SecureRenegotation) -> - CS = ssl_record:current_connection_state(ConnectionStates, read), + CS = tls_record:current_connection_state(ConnectionStates, read), case {SecureRenegotation, CS#connection_state.secure_renegotiation} of {_, true} -> ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); @@ -943,9 +943,9 @@ handle_renegotiation_info(ConnectionStates, SecureRenegotation) -> hello_pending_connection_states(Role, Version, CipherSuite, Random, Compression, ConnectionStates) -> ReadState = - ssl_record:pending_connection_state(ConnectionStates, read), + tls_record:pending_connection_state(ConnectionStates, read), WriteState = - ssl_record:pending_connection_state(ConnectionStates, write), + tls_record:pending_connection_state(ConnectionStates, write), NewReadSecParams = hello_security_parameters(Role, Version, ReadState, CipherSuite, @@ -955,7 +955,7 @@ hello_pending_connection_states(Role, Version, CipherSuite, Random, Compression, hello_security_parameters(Role, Version, WriteState, CipherSuite, Random, Compression), - ssl_record:update_security_params(NewReadSecParams, + tls_record:update_security_params(NewReadSecParams, NewWriteSecParams, ConnectionStates). @@ -978,8 +978,8 @@ hello_security_parameters(server, Version, ConnectionState, CipherSuite, Random, }. select_version(ClientVersion, Versions) -> - ServerVersion = ssl_record:highest_protocol_version(Versions), - ssl_record:lowest_protocol_version(ClientVersion, ServerVersion). + ServerVersion = tls_record:highest_protocol_version(Versions), + tls_record:lowest_protocol_version(ClientVersion, ServerVersion). select_cipher_suite([], _) -> no_suite; @@ -1011,15 +1011,15 @@ master_secret(Version, MasterSecret, #security_parameters{ setup_keys(Version, PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, KML, EKML, IVS), - ConnStates1 = ssl_record:set_master_secret(MasterSecret, ConnectionStates), + ConnStates1 = tls_record:set_master_secret(MasterSecret, ConnectionStates), ConnStates2 = - ssl_record:set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret, + tls_record:set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret, Role, ConnStates1), ClientCipherState = #cipher_state{iv = ClientIV, key = ClientWriteKey}, ServerCipherState = #cipher_state{iv = ServerIV, key = ServerWriteKey}, {MasterSecret, - ssl_record:set_pending_cipher_state(ConnStates2, ClientCipherState, + tls_record:set_pending_cipher_state(ConnStates2, ClientCipherState, ServerCipherState, Role)}. @@ -1685,7 +1685,7 @@ certificate_authorities_from_db(CertDbHandle, CertDbRef) -> (_, Acc) -> Acc end, - ssl_certificate_db:foldl(ConnectionCerts, [], CertDbHandle). + ssl_pkix_db:foldl(ConnectionCerts, [], CertDbHandle). digitally_signed({3, Minor}, Hash, HashAlgo, Key) when Minor >= 3 -> diff --git a/lib/ssl/src/tls_handshake.hrl b/lib/ssl/src/tls_handshake.hrl new file mode 100644 index 0000000000..abf1b5abb6 --- /dev/null +++ b/lib/ssl/src/tls_handshake.hrl @@ -0,0 +1,45 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. 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% +%% + +%% +%%---------------------------------------------------------------------- +%% Purpose: Record and constant defenitions for the TLS-handshake protocol +%% see RFC 5246. +%%---------------------------------------------------------------------- +-ifndef(tls_handshake). +-define(tls_handshake, true). + +-include("ssl_handshake.hrl"). %% Common TLS and DTLS records and Constantes + +-record(client_hello, { + client_version, + random, + session_id, % opaque SessionID<0..32> + cipher_suites, % cipher_suites<2..2^16-1> + compression_methods, % compression_methods<1..2^8-1>, + %% Extensions + renegotiation_info, + hash_signs, % supported combinations of hashes/signature algos + next_protocol_negotiation = undefined, % [binary()] + srp, + ec_point_formats, + elliptic_curves + }). + +-endif. % -ifdef(tls_handshake). diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/tls_record.erl index 2a3356d60f..1409a04763 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -23,12 +23,12 @@ %% %%---------------------------------------------------------------------- --module(ssl_record). +-module(tls_record). --include("ssl_record.hrl"). +-include("tls_record.hrl"). -include("ssl_internal.hrl"). -include("ssl_alert.hrl"). --include("ssl_handshake.hrl"). +-include("tls_handshake.hrl"). -include("ssl_cipher.hrl"). %% Connection state handling diff --git a/lib/ssl/src/tls_record.hrl b/lib/ssl/src/tls_record.hrl new file mode 100644 index 0000000000..c9350fa137 --- /dev/null +++ b/lib/ssl/src/tls_record.hrl @@ -0,0 +1,39 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013-2013. 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% +%% + +%% +%%---------------------------------------------------------------------- +%% Purpose: Record and constant defenitions for the TLS-record protocol +%% see RFC 5246 +%%---------------------------------------------------------------------- + +-ifndef(tls_record). +-define(tls_record, true). + +-include("ssl_record.hrl"). %% Common TLS and DTLS records and Constantes + +%% Used to handle tls_plain_text, tls_compressed and tls_cipher_text + +-record(ssl_tls, { + type, + version, + fragment + }). + +-endif. % -ifdef(tls_record). diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 847907cde8..39aa22ffb4 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2012. All Rights Reserved. +# Copyright Ericsson AB 1999-2013. 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 @@ -58,8 +58,10 @@ HRL_FILES = HRL_FILES_SRC = \ ssl_internal.hrl\ ssl_alert.hrl \ + tls_handshake.hrl \ ssl_handshake.hrl \ ssl_cipher.hrl \ + tls_record.hrl \ ssl_record.hrl HRL_FILES_INC = diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index c4a6cf1407..fed590f0ef 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -30,8 +30,8 @@ -include("ssl_internal.hrl"). -include("ssl_alert.hrl"). -include("ssl_internal.hrl"). --include("ssl_record.hrl"). --include("ssl_handshake.hrl"). +-include("tls_record.hrl"). +-include("tls_handshake.hrl"). -define('24H_in_sec', 86400). -define(TIMEOUT, 60000). @@ -266,7 +266,7 @@ init_per_testcase(empty_protocol_versions, Config) -> %% ssl_test_lib:make_mix_cert(Config0); init_per_testcase(_TestCase, Config0) -> - ct:log("TLS/SSL version ~p~n ", [ssl_record:supported_protocol_versions()]), + ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), Config = lists:keydelete(watchdog, 1, Config0), Dog = ct:timetrap(?TIMEOUT), [{watchdog, Dog} | Config]. @@ -333,7 +333,7 @@ connection_info(Config) when is_list(Config) -> [self(), Client, Server]), Version = - ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + tls_record:protocol_version(tls_record:highest_protocol_version([])), ServerMsg = ClientMsg = {ok, {Version, {rsa,rc4_128,sha}}}, @@ -1547,7 +1547,7 @@ ciphers_rsa_signed_certs() -> ciphers_rsa_signed_certs(Config) when is_list(Config) -> Version = - ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:rsa_suites(crypto), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), @@ -1558,7 +1558,7 @@ ciphers_rsa_signed_certs_openssl_names() -> ciphers_rsa_signed_certs_openssl_names(Config) when is_list(Config) -> Version = - ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:openssl_rsa_suites(crypto), ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]), run_suites(Ciphers, Version, Config, rsa). @@ -1569,7 +1569,7 @@ ciphers_dsa_signed_certs() -> ciphers_dsa_signed_certs(Config) when is_list(Config) -> Version = - ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:dsa_suites(), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), @@ -1580,7 +1580,7 @@ ciphers_dsa_signed_certs_openssl_names() -> ciphers_dsa_signed_certs_openssl_names(Config) when is_list(Config) -> Version = - ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:openssl_dsa_suites(), ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]), @@ -1589,56 +1589,56 @@ ciphers_dsa_signed_certs_openssl_names(Config) when is_list(Config) -> anonymous_cipher_suites()-> [{doc,"Test the anonymous ciphersuites"}]. anonymous_cipher_suites(Config) when is_list(Config) -> - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:anonymous_suites(), run_suites(Ciphers, Version, Config, anonymous). %%------------------------------------------------------------------- psk_cipher_suites() -> [{doc, "Test the PSK ciphersuites WITHOUT server supplied identity hint"}]. psk_cipher_suites(Config) when is_list(Config) -> - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:psk_suites(), run_suites(Ciphers, Version, Config, psk). %%------------------------------------------------------------------- psk_with_hint_cipher_suites()-> [{doc, "Test the PSK ciphersuites WITH server supplied identity hint"}]. psk_with_hint_cipher_suites(Config) when is_list(Config) -> - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:psk_suites(), run_suites(Ciphers, Version, Config, psk_with_hint). %%------------------------------------------------------------------- psk_anon_cipher_suites() -> [{doc, "Test the anonymous PSK ciphersuites WITHOUT server supplied identity hint"}]. psk_anon_cipher_suites(Config) when is_list(Config) -> - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:psk_anon_suites(), run_suites(Ciphers, Version, Config, psk_anon). %%------------------------------------------------------------------- psk_anon_with_hint_cipher_suites()-> [{doc, "Test the anonymous PSK ciphersuites WITH server supplied identity hint"}]. psk_anon_with_hint_cipher_suites(Config) when is_list(Config) -> - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:psk_anon_suites(), run_suites(Ciphers, Version, Config, psk_anon_with_hint). %%------------------------------------------------------------------- srp_cipher_suites()-> [{doc, "Test the SRP ciphersuites"}]. srp_cipher_suites(Config) when is_list(Config) -> - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:srp_suites(), run_suites(Ciphers, Version, Config, srp). %%------------------------------------------------------------------- srp_anon_cipher_suites()-> [{doc, "Test the anonymous SRP ciphersuites"}]. srp_anon_cipher_suites(Config) when is_list(Config) -> - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:srp_anon_suites(), run_suites(Ciphers, Version, Config, srp_anon). %%------------------------------------------------------------------- srp_dsa_cipher_suites()-> [{doc, "Test the SRP DSA ciphersuites"}]. srp_dsa_cipher_suites(Config) when is_list(Config) -> - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:srp_dss_suites(), run_suites(Ciphers, Version, Config, srp_dsa). %%-------------------------------------------------------------------- @@ -1671,7 +1671,7 @@ ciphers_ecdsa_signed_certs() -> ciphers_ecdsa_signed_certs(Config) when is_list(Config) -> Version = - ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:ecdsa_suites(), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), @@ -1682,7 +1682,7 @@ ciphers_ecdsa_signed_certs_openssl_names() -> ciphers_ecdsa_signed_certs_openssl_names(Config) when is_list(Config) -> Version = - ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:openssl_ecdsa_suites(), ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]), run_suites(Ciphers, Version, Config, ecdsa). @@ -1692,7 +1692,7 @@ ciphers_ecdh_rsa_signed_certs() -> ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) -> Version = - ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:ecdh_rsa_suites(), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), @@ -1703,7 +1703,7 @@ ciphers_ecdh_rsa_signed_certs_openssl_names() -> ciphers_ecdh_rsa_signed_certs_openssl_names(Config) when is_list(Config) -> Version = - ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:openssl_ecdh_rsa_suites(), ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]), run_suites(Ciphers, Version, Config, ecdh_rsa). @@ -2084,7 +2084,7 @@ client_no_wrap_sequence_number(Config) when is_list(Config) -> {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - Version = ssl_record:highest_protocol_version(ssl_record:supported_protocol_versions()), + Version = tls_record:highest_protocol_version(tls_record:supported_protocol_versions()), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 2703d2d79c..4e095dc184 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -29,8 +29,8 @@ -include("ssl_internal.hrl"). -include("ssl_alert.hrl"). -include("ssl_internal.hrl"). --include("ssl_record.hrl"). --include("ssl_handshake.hrl"). +-include("tls_record.hrl"). +-include("tls_handshake.hrl"). -define(LONG_TIMEOUT, 600000). diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl index 9869812e6e..45e91786d4 100644 --- a/lib/ssl/test/ssl_cipher_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_SUITE.erl @@ -25,7 +25,7 @@ -include_lib("common_test/include/ct.hrl"). -include("ssl_internal.hrl"). --include("ssl_record.hrl"). +-include("tls_record.hrl"). -include("ssl_cipher.hrl"). -include("ssl_alert.hrl"). diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index aff0e0fbbc..a40f07fd07 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -25,7 +25,7 @@ -include_lib("common_test/include/ct.hrl"). -include("ssl_internal.hrl"). --include("ssl_handshake.hrl"). +-include("tls_handshake.hrl"). %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- @@ -55,20 +55,20 @@ decode_hello_handshake(_Config) -> 16#70, 16#64, 16#79, 16#2f, 16#32>>, Version = {3, 0}, - {Records, _Buffer} = ssl_handshake:get_tls_handshake(Version, HelloPacket, <<>>), + {Records, _Buffer} = tls_handshake:get_tls_handshake(Version, HelloPacket, <<>>), {Hello, _Data} = hd(Records), #renegotiation_info{renegotiated_connection = <<0>>} = Hello#server_hello.renegotiation_info. decode_single_hello_extension_correctly(_Config) -> Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>, - Extensions = ssl_handshake:dec_hello_extensions(Renegotiation, []), + Extensions = tls_handshake:dec_hello_extensions(Renegotiation, []), [{renegotiation_info,#renegotiation_info{renegotiated_connection = <<0>>}}] = Extensions. decode_unknown_hello_extension_correctly(_Config) -> FourByteUnknown = <<16#CA,16#FE, ?UINT16(4), 3, 0, 1, 2>>, Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>, - Extensions = ssl_handshake:dec_hello_extensions(<<FourByteUnknown/binary, Renegotiation/binary>>, []), + Extensions = tls_handshake:dec_hello_extensions(<<FourByteUnknown/binary, Renegotiation/binary>>, []), [{renegotiation_info,#renegotiation_info{renegotiated_connection = <<0>>}}] = Extensions. diff --git a/lib/ssl/test/ssl_npn_hello_SUITE.erl b/lib/ssl/test/ssl_npn_hello_SUITE.erl index 43fa72ea28..ef5a02abef 100644 --- a/lib/ssl/test/ssl_npn_hello_SUITE.erl +++ b/lib/ssl/test/ssl_npn_hello_SUITE.erl @@ -23,10 +23,10 @@ %% Note: This directive should only be used in test suites. -compile(export_all). --include("ssl_handshake.hrl"). --include("ssl_record.hrl"). -include("ssl_cipher.hrl"). -include("ssl_internal.hrl"). +-include("tls_handshake.hrl"). +-include("tls_record.hrl"). -include_lib("common_test/include/ct.hrl"). %%-------------------------------------------------------------------- @@ -49,54 +49,52 @@ all() -> encode_and_decode_client_hello_test(_Config) -> HandShakeData = create_client_handshake(undefined), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), {[{DecodedHandshakeMessage, _Raw}], _} = - ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), + tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), NextProtocolNegotiation = DecodedHandshakeMessage#client_hello.next_protocol_negotiation, NextProtocolNegotiation = undefined. %%-------------------------------------------------------------------- encode_and_decode_npn_client_hello_test(_Config) -> HandShakeData = create_client_handshake(#next_protocol_negotiation{extension_data = <<>>}), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), {[{DecodedHandshakeMessage, _Raw}], _} = - ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), + tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), NextProtocolNegotiation = DecodedHandshakeMessage#client_hello.next_protocol_negotiation, NextProtocolNegotiation = #next_protocol_negotiation{extension_data = <<>>}. %%-------------------------------------------------------------------- encode_and_decode_server_hello_test(_Config) -> HandShakeData = create_server_handshake(undefined), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), {[{DecodedHandshakeMessage, _Raw}], _} = - ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), + tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), NextProtocolNegotiation = DecodedHandshakeMessage#server_hello.next_protocol_negotiation, NextProtocolNegotiation = undefined. %%-------------------------------------------------------------------- encode_and_decode_npn_server_hello_test(_Config) -> HandShakeData = create_server_handshake(#next_protocol_negotiation{extension_data = <<6, "spdy/2">>}), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), {[{DecodedHandshakeMessage, _Raw}], _} = - ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), + tls_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), NextProtocolNegotiation = DecodedHandshakeMessage#server_hello.next_protocol_negotiation, ct:log("~p ~n", [NextProtocolNegotiation]), NextProtocolNegotiation = #next_protocol_negotiation{extension_data = <<6, "spdy/2">>}. %%-------------------------------------------------------------------- create_server_hello_with_no_advertised_protocols_test(_Config) -> - Hello = ssl_handshake:server_hello(<<>>, {3, 0}, create_connection_states(), false, - undefined, undefined, undefined), + Hello = tls_handshake:server_hello(<<>>, {3, 0}, create_connection_states(), false, undefined, undefined, undefined), undefined = Hello#server_hello.next_protocol_negotiation. %%-------------------------------------------------------------------- create_server_hello_with_advertised_protocols_test(_Config) -> - Hello = ssl_handshake:server_hello(<<>>, {3, 0}, create_connection_states(), - false, [<<"spdy/1">>, <<"http/1.0">>, <<"http/1.1">>], - undefined, undefined), + Hello = tls_handshake:server_hello(<<>>, {3, 0}, create_connection_states(), + false, [<<"spdy/1">>, <<"http/1.0">>, <<"http/1.1">>], undefined, undefined), #next_protocol_negotiation{extension_data = <<6, "spdy/1", 8, "http/1.0", 8, "http/1.1">>} = Hello#server_hello.next_protocol_negotiation. %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- create_client_handshake(Npn) -> - ssl_handshake:encode_handshake(#client_hello{ + tls_handshake:encode_handshake(#client_hello{ client_version = {1, 2}, random = <<1:256>>, session_id = <<>>, @@ -107,7 +105,7 @@ create_client_handshake(Npn) -> }, vsn). create_server_handshake(Npn) -> - ssl_handshake:encode_handshake(#server_hello{ + tls_handshake:encode_handshake(#server_hello{ server_version = {1, 2}, random = <<1:256>>, session_id = <<>>, diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 7f91865a86..0564b37f1c 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -269,7 +269,7 @@ erlang_client_openssl_server(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(node()), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile, @@ -310,7 +310,7 @@ erlang_server_openssl_client(Config) when is_list(Config) -> {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -host localhost", @@ -344,7 +344,7 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) -> CaCertFile = proplists:get_value(cacertfile, ServerOpts), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -cert " ++ CertFile ++ " -CAfile " ++ CaCertFile @@ -392,7 +392,7 @@ erlang_server_openssl_client_dsa_cert(Config) when is_list(Config) -> {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -host localhost " ++ " -cert " ++ CertFile ++ " -CAfile " ++ CaCertFile ++ " -key " ++ KeyFile ++ " -msg", @@ -428,7 +428,7 @@ erlang_server_openssl_client_reuse_session(Config) when is_list(Config) -> {reconnect_times, 5}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -host localhost -reconnect", @@ -463,7 +463,7 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(node()), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ " -msg", @@ -513,7 +513,7 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(node()), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ " -msg", @@ -559,7 +559,7 @@ erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) -> trigger_renegotiate, [[Data, N+2]]}}, {options, [{renegotiate_at, N}, {reuse_sessions, false} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -host localhost -msg", @@ -594,7 +594,7 @@ erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(node()), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ " -msg", @@ -636,7 +636,7 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) -> CertFile = proplists:get_value(certfile, ServerOpts), CaCertFile = proplists:get_value(cacertfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -cert " ++ CertFile ++ " -CAfile " ++ CaCertFile ++ " -key " ++ KeyFile ++ " -Verify 2", @@ -687,7 +687,7 @@ erlang_server_openssl_client_client_cert(Config) when is_list(Config) -> CaCertFile = proplists:get_value(cacertfile, ClientOpts), CertFile = proplists:get_value(certfile, ClientOpts), KeyFile = proplists:get_value(keyfile, ClientOpts), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_client -cert " ++ CertFile ++ " -CAfile " ++ CaCertFile ++ " -key " ++ KeyFile ++ " -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -host localhost", @@ -712,7 +712,7 @@ erlang_server_erlang_client_client_cert(Config) when is_list(Config) -> process_flag(trap_exit, true), ServerOpts = ?config(server_verification_opts, Config), ClientOpts = ?config(client_verification_opts, Config), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Data = "From erlang to erlang", @@ -748,7 +748,7 @@ ciphers_rsa_signed_certs() -> [{doc,"Test cipher suites that uses rsa certs"}]. ciphers_rsa_signed_certs(Config) when is_list(Config) -> Version = - ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:rsa_suites(openssl), run_suites(Ciphers, Version, Config, rsa). @@ -758,7 +758,7 @@ ciphers_dsa_signed_certs() -> [{doc,"Test cipher suites that uses dsa certs"}]. ciphers_dsa_signed_certs(Config) when is_list(Config) -> Version = - ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:dsa_suites(), run_suites(Ciphers, Version, Config, dsa). @@ -776,7 +776,7 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(node()), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "", @@ -1095,7 +1095,7 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens Port = ssl_test_lib:inet_port(node()), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_server " ++ OpensslServerOpts ++ " -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ @@ -1135,7 +1135,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac Port = ssl_test_lib:inet_port(node()), CertFile = proplists:get_value(certfile, ServerOpts), KeyFile = proplists:get_value(keyfile, ServerOpts), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_server -msg -nextprotoneg http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile, @@ -1174,7 +1174,7 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac {mfa, {?MODULE, erlang_ssl_receive_and_assert_npn, [<<"spdy/2">>, Data]}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_client -nextprotoneg http/1.0,spdy/2 -msg -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -host localhost", @@ -1203,7 +1203,7 @@ start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenS {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, {options, ServerOpts}]), Port = ssl_test_lib:inet_port(Server), - Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_client " ++ OpenSSLClientOpts ++ " -msg -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -host localhost", diff --git a/lib/stdlib/doc/src/c.xml b/lib/stdlib/doc/src/c.xml index ddae388a1b..9cd4581a89 100644 --- a/lib/stdlib/doc/src/c.xml +++ b/lib/stdlib/doc/src/c.xml @@ -140,9 +140,9 @@ compile:file(<anno>File</anno>, <anno>Options</anno> ++ [report_errors, report_w </func> <func> <name name="ls" arity="1"/> - <fsummary>List files in a directory</fsummary> + <fsummary>List files in a directory or a single file</fsummary> <desc> - <p>Lists files in directory <c><anno>Dir</anno></c>.</p> + <p>Lists files in directory <c><anno>Dir</anno></c> or, if Dir is a file, only list it.</p> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/erl_eval.xml b/lib/stdlib/doc/src/erl_eval.xml index d0622594d9..24940f8396 100644 --- a/lib/stdlib/doc/src/erl_eval.xml +++ b/lib/stdlib/doc/src/erl_eval.xml @@ -288,10 +288,7 @@ Func(FuncSpec, Arguments) </code> <section> <title>Bugs</title> - <p>The evaluator is not complete. <c>receive</c> cannot be - handled properly. - </p> - <p>Any undocumented functions in <c>erl_eval</c> should not be used.</p> + <p>Undocumented functions in <c>erl_eval</c> should not be used.</p> </section> </erlref> diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index 2e9ebece0e..121f9febed 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -300,7 +300,7 @@ clear_crypto_key_fun() -> call_crypto_server(clear_crypto_key_fun). -spec make_crypto_key(mode(), string()) -> - {binary(), binary(), binary(), binary()}. + {mode(), [binary()], binary(), integer()}. make_crypto_key(des3_cbc=Type, String) -> <<K1:8/binary,K2:8/binary>> = First = erlang:md5(String), diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index 91d317489c..6e96e3d564 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -713,8 +713,10 @@ ls(Dir) -> case file:list_dir(Dir) of {ok, Entries} -> ls_print(sort(Entries)); - {error,_E} -> - format("Invalid directory\n") + {error, enotdir} -> + ls_print([Dir]); + {error, Error} -> + format("~s\n", [file:format_error(Error)]) end. ls_print([]) -> ok; diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 0b57af1b6d..73b8da335a 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -245,10 +245,10 @@ expr({'case',_,E,Cs}, Bs0, Lf, Ef, RBs) -> expr({'try',_,B,Cases,Catches,AB}, Bs, Lf, Ef, RBs) -> try_clauses(B, Cases, Catches, AB, Bs, Lf, Ef, RBs); expr({'receive',_,Cs}, Bs, Lf, Ef, RBs) -> - receive_clauses(Cs, Bs, Lf, Ef, [], RBs); + receive_clauses(Cs, Bs, Lf, Ef, RBs); expr({'receive',_, Cs, E, TB}, Bs0, Lf, Ef, RBs) -> {value,T,Bs} = expr(E, Bs0, Lf, Ef, none), - receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, [], RBs); + receive_clauses(T, Cs, {TB,Bs}, Bs0, Lf, Ef, RBs); expr({'fun',_Line,{function,Mod0,Name0,Arity0}}, Bs0, Lf, Ef, RBs) -> {[Mod,Name,Arity],Bs} = expr_list([Mod0,Name0,Arity0], Bs0, Lf, Ef), F = erlang:make_fun(Mod, Name, Arity), @@ -807,66 +807,24 @@ case_clauses(Val, Cs, Bs, Lf, Ef, RBs) -> end. %% -%% receive_clauses(Clauses, Bindings, LocalFuncHnd,ExtFuncHnd, Messages, RBs) +%% receive_clauses(Clauses, Bindings, LocalFuncHnd,ExtFuncHnd, RBs) %% -receive_clauses(Cs, Bs, Lf, Ef, Ms, RBs) -> - receive - Val -> - case match_clause(Cs, [Val], Bs, Lf, Ef) of - {B, Bs1} -> - merge_queue(Ms), - exprs(B, Bs1, Lf, Ef, RBs); - nomatch -> - receive_clauses(Cs, Bs, Lf, Ef, [Val|Ms], RBs) - end - end. +receive_clauses(Cs, Bs, Lf, Ef, RBs) -> + receive_clauses(infinity, Cs, unused, Bs, Lf, Ef, RBs). %% %% receive_clauses(TimeOut, Clauses, TimeoutBody, Bindings, %% ExternalFuncHandler, LocalFuncHandler, RBs) %% -receive_clauses(T, Cs, TB, Bs, Lf, Ef, Ms, RBs) -> - {_,_} = statistics(runtime), - receive - Val -> - case match_clause(Cs, [Val], Bs, Lf, Ef) of - {B, Bs1} -> - merge_queue(Ms), - exprs(B, Bs1, Lf, Ef, RBs); - nomatch -> - {_,T1} = statistics(runtime), - if - T =:= infinity -> - receive_clauses(T, Cs, TB,Bs,Lf,Ef,[Val|Ms],RBs); - T-T1 =< 0 -> - receive_clauses(0, Cs, TB,Bs,Lf,Ef,[Val|Ms],RBs); - true -> - receive_clauses(T-T1, Cs,TB,Bs,Lf,Ef,[Val|Ms],RBs) - end - end - after T -> - merge_queue(Ms), +receive_clauses(T, Cs, TB, Bs, Lf, Ef, RBs) -> + F = fun (M) -> match_clause(Cs, [M], Bs, Lf, Ef) end, + case prim_eval:'receive'(F, T) of + {B, Bs1} -> + exprs(B, Bs1, Lf, Ef, RBs); + timeout -> {B, Bs1} = TB, exprs(B, Bs1, Lf, Ef, RBs) end. -merge_queue([]) -> - true; -merge_queue(Ms) -> - send_all(recv_all(Ms), self()). - -recv_all(Xs) -> - receive - X -> recv_all([X|Xs]) - after 0 -> - reverse(Xs) - end. - -send_all([X|Xs], Self) -> - Self ! X, - send_all(Xs, Self); -send_all([], _) -> true. - - %% match_clause -> {Body, Bindings} or nomatch -spec(match_clause(Clauses, ValueList, Bindings, LocalFunctionHandler) -> diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index c0596e5ba6..657cb5d34c 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -214,7 +214,9 @@ lattribute({attribute,_Line,type,Type}, Opts, _State) -> lattribute({attribute,_Line,opaque,Type}, Opts, _State) -> [typeattr(opaque, Type, Opts),leaf(".\n")]; lattribute({attribute,_Line,spec,Arg}, _Opts, _State) -> - [specattr(Arg),leaf(".\n")]; + [specattr(spec, Arg),leaf(".\n")]; +lattribute({attribute,_Line,callback,Arg}, _Opts, _State) -> + [specattr(callback, Arg),leaf(".\n")]; lattribute({attribute,_Line,Name,Arg}, Opts, State) -> [lattribute(Name, Arg, Opts, State),leaf(".\n")]. @@ -311,14 +313,14 @@ union_elem(T) -> tuple_type(Ts, F) -> {seq,${,$},[$,],ltypes(Ts, F)}. -specattr({FuncSpec,TypeSpecs}) -> +specattr(SpecKind, {FuncSpec,TypeSpecs}) -> Func = case FuncSpec of {F,_A} -> format("~w", [F]); {M,F,_A} -> format("~w:~w", [M, F]) end, - {first,leaf("-spec "), + {first,leaf(lists:concat(["-", SpecKind, " "])), {list,[{first,leaf(Func),spec_clauses(TypeSpecs)}]}}. spec_clauses(TypeSpecs) -> diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 42a42b7fd7..cebc9c91bd 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -250,10 +250,12 @@ obsolete_1(snmp, N, A) -> false -> no; true -> - {deprecated,"Deprecated; use snmpa:"++atom_to_list(N)++"/"++ + {deprecated, "Deprecated (will be removed in R17B); use snmpa:"++atom_to_list(N)++"/"++ integer_to_list(A)++" instead"} end; +obsolete_1(snmpa, old_info_format, 1) -> + {deprecated, "Deprecated; (will be removed in R17B); use \"new\" format instead"}; obsolete_1(snmpm, agent_info, 3) -> {removed, {snmpm, agent_info, 2}, "R16B"}; obsolete_1(snmpm, update_agent_info, 5) -> diff --git a/lib/stdlib/test/c_SUITE.erl b/lib/stdlib/test/c_SUITE.erl index 25281365be..8c55b616b9 100644 --- a/lib/stdlib/test/c_SUITE.erl +++ b/lib/stdlib/test/c_SUITE.erl @@ -20,7 +20,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). -export([c_1/1, c_2/1, c_3/1, c_4/1, nc_1/1, nc_2/1, nc_3/1, nc_4/1, - memory/1]). + ls/1, memory/1]). -include_lib("test_server/include/test_server.hrl"). @@ -29,7 +29,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [c_1, c_2, c_3, c_4, nc_1, nc_2, nc_3, nc_4, memory]. + [c_1, c_2, c_3, c_4, nc_1, nc_2, nc_3, nc_4, ls, memory]. groups() -> []. @@ -147,6 +147,13 @@ nc_4(Config) when is_list(Config) -> ?line Result = nc(R,[{outdir,W}]), ?line {ok, m} = Result. +ls(Config) when is_list(Config) -> + Directory = ?config(data_dir, Config), + ok = c:ls(Directory), + File = filename:join(Directory, "m.erl"), + ok = c:ls(File), + ok = c:ls("no_such_file"). + memory(doc) -> ["Checks that c:memory/[0,1] returns consistent results."]; memory(suite) -> diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index ff3470349e..2b7cec87df 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -43,7 +43,7 @@ receive_after/1, bits/1, head_tail/1, cond1/1, block/1, case1/1, ops/1, messages/1, old_mnemosyne_syntax/1, - import_export/1, misc_attrs/1, + import_export/1, misc_attrs/1, dialyzer_attrs/1, hook/1, neg_indent/1, @@ -77,7 +77,7 @@ groups() -> [func, call, recs, try_catch, if_then, receive_after, bits, head_tail, cond1, block, case1, ops, messages, old_mnemosyne_syntax]}, - {attributes, [], [misc_attrs, import_export]}, + {attributes, [], [misc_attrs, import_export, dialyzer_attrs]}, {tickets, [], [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, otp_8473, otp_8522, otp_8567, otp_8664, otp_9147, @@ -597,6 +597,15 @@ misc_attrs(Config) when is_list(Config) -> ok. +dialyzer_attrs(suite) -> + []; +dialyzer_attrs(Config) when is_list(Config) -> + ok = pp_forms(<<"-type foo() :: #bar{}. ">>), + ok = pp_forms(<<"-opaque foo() :: {bar, fun((X, [42,...]) -> X)}. ">>), + ok = pp_forms(<<"-spec foo(bar(), qux()) -> [T | baz(T)]. ">>), + ok = pp_forms(<<"-callback foo(<<_:32,_:_*4>>, T) -> T. ">>), + ok. + hook(suite) -> []; hook(Config) when is_list(Config) -> diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index bd69019892..2b29566942 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -5626,17 +5626,25 @@ etsmem() -> MemInfo -> CS = lists:foldl( fun ({instance, _, L}, Acc) -> - {value,{_,SBMBCS}} = lists:keysearch(sbmbcs, 1, L), - {value,{_,MBCS}} = lists:keysearch(mbcs, 1, L), - {value,{_,SBCS}} = lists:keysearch(sbcs, 1, L), - [SBMBCS,MBCS,SBCS | Acc] + {value,{mbcs,MBCS}} = lists:keysearch(mbcs, 1, L), + {value,{sbcs,SBCS}} = lists:keysearch(sbcs, 1, L), + NewAcc = [MBCS, SBCS | Acc], + case lists:keysearch(mbcs_pool, 1, L) of + {value,{mbcs_pool, MBCS_POOL}} -> + [MBCS_POOL|NewAcc]; + _ -> NewAcc + end end, [], MemInfo), lists:foldl( fun(L, {Bl0,BlSz0}) -> - {value,{_,Bl,_,_}} = lists:keysearch(blocks, 1, L), - {value,{_,BlSz,_,_}} = lists:keysearch(blocks_size, 1, L), + {value,BlTup} = lists:keysearch(blocks, 1, L), + blocks = element(1, BlTup), + Bl = element(2, BlTup), + {value,BlSzTup} = lists:keysearch(blocks_size, 1, L), + blocks_size = element(1, BlSzTup), + BlSz = element(2, BlSzTup), {Bl0+Bl,BlSz0+BlSz} end, {0,0}, CS) end}, diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 8b0be51be3..c350f758ce 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -716,6 +716,16 @@ end_conf_timeout(_, _) -> call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> Starter = self(), Data = {Mod,Func,TCPid,TCExitReason,Loc}, + case erlang:function_exported(Mod,end_per_testcase,2) of + false -> + spawn_link(fun() -> + Starter ! {self(),{call_end_conf,Data,ok}} + end); + true -> + do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) + end. + +do_call_end_conf(Starter,Mod,Func,Data,Conf,TVal) -> EndConfProc = fun() -> process_flag(trap_exit,true), % to catch timetraps @@ -753,7 +763,8 @@ call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> end, spawn_link(EndConfProc). -spawn_fw_call(Mod,{init_per_testcase,Func},CurrConf,Pid,{timetrap_timeout,TVal}=Why, +spawn_fw_call(Mod,{init_per_testcase,Func},CurrConf,Pid, + {timetrap_timeout,TVal}=Why, Loc,SendTo) -> FwCall = fun() -> diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl index 9b6e10e7e2..a75cae3c9d 100644 --- a/lib/test_server/src/ts_install_cth.erl +++ b/lib/test_server/src/ts_install_cth.erl @@ -103,7 +103,9 @@ pre_init_per_suite(_Suite,Config,State) -> end, {add_node_name(Config, State), State} - catch Error:Reason -> + catch error:{badmatch,{error,enoent}} -> + {add_node_name(Config, State), State}; + Error:Reason -> Stack = erlang:get_stacktrace(), ct:pal("~p failed! ~p:{~p,~p}",[?MODULE,Error,Reason,Stack]), {{fail,{?MODULE,{Error,Reason, Stack}}},State} diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index ddd22707dd..f3bc95e3e5 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -883,6 +883,7 @@ resulting regexp is surrounded by \\_< and \\_>." "fun_to_list" "function_exported" "garbage_collect_message_area" + "gather_gc_info_result" "gather_sched_wall_time_result" "get_cookie" "get_module_info" |