diff options
388 files changed, 29882 insertions, 19816 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/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex e87e6a8555..ba17952caf 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam Binary files differindex 3972fe7b91..bb981bbf89 100644 --- a/bootstrap/lib/kernel/ebin/os.beam +++ b/bootstrap/lib/kernel/ebin/os.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex 37ed5b2bf8..611f271cb9 100644 --- a/bootstrap/lib/stdlib/ebin/beam_lib.beam +++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex 0e3672e3b0..879370ef87 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.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_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex ac593149b8..ee07e7636c 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.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/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex c853cf37bd..c19ca1763a 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/erts/configure.in b/erts/configure.in index 2ee907b6e4..b056ba44e2 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -429,7 +429,7 @@ case $host_os in win32) # The ethread library requires _WIN32_WINNT of at least 0x0403. # -D_WIN32_WINNT=* from CPPFLAGS is saved in ETHR_DEFS. - CPPFLAGS="$CPPFLAGS -D_WIN32_WINNT=0x0500 -DWINVER=0x0500" + CPPFLAGS="$CPPFLAGS -D_WIN32_WINNT=0x0501 -DWINVER=0x0501" ;; darwin*) CPPFLAGS="$CPPFLAGS -D_XOPEN_SOURCE" @@ -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;; @@ -1342,6 +1343,17 @@ if test "x$TERMCAP_LIB" != "x"; then AC_DEFINE(HAVE_TERMCAP, 1, [Define if termcap functions exists]) fi +if test "X$host" != "Xwin32"; then + AC_MSG_CHECKING(for wcwidth) + AC_TRY_LINK([#include <wchar.h>], [wcwidth(0);], + have_wcwidth=yes, have_wcwidth=no) + if test $have_wcwidth = yes; then + AC_MSG_RESULT([yes]) + AC_DEFINE(HAVE_WCWIDTH, [1], + [Define to 1 if you have a `wcwidth' function.]) + fi +fi + dnl ------------- dnl zlib dnl ------------- @@ -3576,10 +3588,7 @@ DED_EXT=so case $host_os in win32) DED_EXT=dll;; darwin*) - DED_CFLAGS="$DED_CFLAGS -fno-common" - if test "X$STATIC_CFLAGS" = "X"; then - STATIC_CFLAGS="-mdynamic-no-pic" - fi;; + DED_CFLAGS="$DED_CFLAGS -fno-common";; *) ;; esac diff --git a/erts/doc/src/crash_dump.xml b/erts/doc/src/crash_dump.xml index b3c4671c3d..73212e6143 100644 --- a/erts/doc/src/crash_dump.xml +++ b/erts/doc/src/crash_dump.xml @@ -290,6 +290,10 @@ <em>Stack+heap</em>, <em>OldHeap</em>, <em>Heap unused</em> and <em>OldHeap unused</em> do not exist. Instead this field presents the size of the process' stack.</item> + <tag><em>Memory</em></tag> + <item>The total memory used by this process. This includes call stack, + heap and internal structures. Same as <seealso marker="erlang#process_info-2">erlang:process_info(Pid,memory)</seealso>. + </item> <tag><em>Program counter</em></tag> <item>The current instruction pointer. This is only interesting for runtime system developers. The function into which the program 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 4f2f647742..58e83540e1 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -48,6 +48,7 @@ CREATE_DIRS= LDFLAGS=@LDFLAGS@ ARFLAGS=rc +OMIT_OMIT_FP=no ifeq ($(TYPE),debug) PURIFY = @@ -113,6 +114,13 @@ TYPEMARKER = .lcnt TYPE_FLAGS = @CFLAGS@ -DERTS_ENABLE_LOCK_COUNT else +ifeq ($(TYPE),frmptr) +PURIFY = +OMIT_OMIT_FP=yes +TYPEMARKER = .frmptr +TYPE_FLAGS = @CFLAGS@ -DERTS_FRMPTR +else + # If type isn't one of the above, it *is* opt type... override TYPE=opt PURIFY = @@ -126,6 +134,7 @@ endif endif endif endif +endif # # NOTE: When adding a new type update ERL_BUILD_TYPE_MARKER in sys/unix/sys.c @@ -219,8 +228,6 @@ LIB_PREFIX=lib LIB_SUFFIX=.a endif -OMIT_OMIT_FP=no - ifeq (@EMU_LOCK_CHECKING@,yes) NO_INLINE_FUNCTIONS=true endif @@ -238,7 +245,7 @@ ifeq ($(NO_INLINE_FUNCTIONS),true) GEN_OPT_FLGS = $(OPT_LEVEL) -fno-inline-functions else ifeq ($(OMIT_OMIT_FP),yes) -GEN_OPT_FLGS = $(OPT_LEVEL) +GEN_OPT_FLGS = $(OPT_LEVEL) -fno-omit-frame-pointer else GEN_OPT_FLGS = $(OPT_LEVEL) -fomit-frame-pointer endif @@ -552,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 \ @@ -572,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 \ @@ -1014,7 +1023,8 @@ endif $(TARGET)/gen_git_version.mk: # We touch beam/erl_bif.info.c if we regenerated the git version to force a # rebuild. - if $(gen_verbose)utils/gen_git_version $@; then touch beam/erl_bif_info.c; fi + $(gen_verbose) + $(V_at)if utils/gen_git_version $@; then touch beam/erl_bif_info.c; fi .PHONY: depend ifdef VOID_EMULATOR diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 80208d35e1..3ee9eb0f88 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -249,6 +249,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 @@ -324,6 +325,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/beam_load.c b/erts/emulator/beam/beam_load.c index bd4e5a52d0..4193eb4f3f 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -2964,19 +2964,19 @@ gen_put_integer(LoaderState* stp, GenOpArg Fail, GenOpArg Size, NEW_GENOP(stp, op); NATIVE_ENDIAN(Flags); - if (Size.type == TAG_i && Size.val < 0) { - error: /* Negative size must fail */ - op->op = genop_badarg_1; - op->arity = 1; - op->a[0] = Fail; - } else if (Size.type == TAG_i) { + if (Size.type == TAG_i) { op->op = genop_i_new_bs_put_integer_imm_4; op->arity = 4; op->a[0] = Fail; op->a[1].type = TAG_u; if (!safe_mul(Size.val, Unit.val, &op->a[1].val)) { - goto error; + error: + op->op = genop_badarg_1; + op->arity = 1; + op->a[0] = Fail; + op->next = NULL; + return op; } op->a[1].val = Size.val * Unit.val; op->a[2].type = Flags.type; diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 8bc994c8c3..dc8e9101de 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -154,8 +154,10 @@ bif erts_internal:port_command/3 bif erts_internal:port_control/3 bif erts_internal:port_close/1 bif erts_internal:port_connect/2 -bif erts_internal:port_set_data/2 -bif erts_internal:port_get_data/1 + +# inet_db support +bif erlang:port_set_data/2 +bif erlang:port_get_data/1 # Tracing & debugging. bif erlang:trace_pattern/2 diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 9260c0c4b8..6f9b171224 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -2528,17 +2528,18 @@ const byte d_base_exp_lookup[] = { 31, 19, 15, 13, 11, 11, 10, 9, 9, 8, 8, 8, 8, * end * How much can the characters which fit in 31 bit represent */ -const Uint d_base_base_lookup[] = { 2147483648, 1162261467, 1073741824, - 1220703125, 362797056, 1977326743, 1073741824, 387420489, 1000000000, - 214358881, 429981696, 815730721, 1475789056, 170859375, 268435456, - 410338673, 612220032, 893871739, 1280000000, 1801088541, 113379904, - 148035889, 191102976, 244140625, 308915776, 387420489, 481890304, - 594823321, 729000000, 887503681, 1073741824, 1291467969, 1544804416, - 1838265625, 60466176, 69343957, 79235168, 90224199, 102400000, - 115856201, 130691232, 147008443, 164916224, 184528125, 205962976, - 229345007, 254803968, 282475249, 312500000, 345025251, 380204032, - 418195493, 459165024, 503284375, 550731776, 601692057, 656356768, - 714924299, 777600000, 844596301, 916132832, 992436543, 1073741824 }; +const Uint d_base_base_lookup[] = { 2147483648u, 1162261467u, 1073741824u, + 1220703125u, 362797056u, 1977326743u, 1073741824u, 387420489u, + 1000000000u, 214358881u, 429981696u, 815730721u, 1475789056u, + 170859375u, 268435456u, 410338673u, 612220032u, 893871739u, 1280000000u, + 1801088541u, 113379904u, 148035889u, 191102976u, 244140625u, 308915776u, + 387420489u, 481890304u, 594823321u, 729000000u, 887503681u, 1073741824u, + 1291467969u, 1544804416u, 1838265625u, 60466176u, 69343957u, 79235168u, + 90224199u, 102400000u, 115856201u, 130691232u, 147008443u, 164916224u, + 184528125u, 205962976u, 229345007u, 254803968u, 282475249u, 312500000u, + 345025251u, 380204032u, 418195493u, 459165024u, 503284375u, 550731776u, + 601692057u, 656356768u, 714924299u, 777600000u, 844596301u, 916132832u, + 992436543u, 1073741824u }; Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, Uint size, const int base) { diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 9aa1e5f30d..f8cfd60a6f 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -331,6 +331,7 @@ print_process_info(int to, void *to_arg, Process *p) erts_print(to, to_arg, "Heap unused: %bpu\n", (p->hend - p->htop)); erts_print(to, to_arg, "OldHeap unused: %bpu\n", (OLD_HEAP(p) == NULL) ? 0 : (OLD_HEND(p) - OLD_HTOP(p)) ); + erts_print(to, to_arg, "Memory: %beu\n", erts_process_memory(p)); if (garbing) { print_garb_info(to, to_arg, p); @@ -753,7 +754,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) return; /* Can't create the crash dump, skip it */ time(&now); - erts_fdprintf(fd, "=erl_crash_dump:0.1\n%s", ctime(&now)); + erts_fdprintf(fd, "=erl_crash_dump:0.2\n%s", ctime(&now)); if (file != NULL) erts_fdprintf(fd, "The error occurred in file %s, line %d\n", file, line); diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 0781665f05..44f4eb9d43 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -455,7 +455,7 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) Eterm nd_reason = (reason == am_no_network ? am_no_network : am_net_kernel_terminated); - erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx); for (tdep = erts_hidden_dist_entries; tdep; tdep = tdep->next) no_dist_port++; @@ -464,7 +464,7 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) /* KILL all port controllers */ if (no_dist_port == 0) - erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); else { Eterm def_buf[128]; int i = 0; @@ -483,7 +483,7 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason) ASSERT(is_internal_port(tdep->cid)); dist_port[i++] = tdep->cid; } - erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); for (i = 0; i < no_dist_port; i++) { Port *prt = erts_port_lookup(dist_port[i], @@ -2560,9 +2560,9 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2) erts_smp_proc_unlock(net_kernel, ERTS_PROC_LOCK_MAIN); #ifdef DEBUG - erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx); ASSERT(!erts_visible_dist_entries && !erts_hidden_dist_entries); - erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); #endif erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); @@ -2912,7 +2912,7 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1) length = 0; - erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx); ASSERT(erts_no_of_not_connected_dist_entries >= 0); ASSERT(erts_no_of_hidden_dist_entries >= 0); @@ -2929,7 +2929,7 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1) result = NIL; if (length == 0) { - erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); goto done; } @@ -2958,7 +2958,7 @@ BIF_RETTYPE nodes_1(BIF_ALIST_1) hp += 2; } ASSERT(endp == hp); - erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); done: UnUseTmpHeap(2,BIF_P); diff --git a/erts/emulator/beam/erl_afit_alloc.c b/erts/emulator/beam/erl_afit_alloc.c index 5850f80843..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; @@ -259,10 +259,10 @@ info_options(Allctr_t *allctr, * to erts_afalc_test() * \* */ -unsigned long -erts_afalc_test(unsigned long op, unsigned long a1, unsigned long a2) +UWord +erts_afalc_test(UWord op, UWord a1, UWord a2) { switch (op) { - default: ASSERT(0); return ~((unsigned long) 0); + default: ASSERT(0); return ~((UWord) 0); } } diff --git a/erts/emulator/beam/erl_afit_alloc.h b/erts/emulator/beam/erl_afit_alloc.h index cf7b99c463..b90ac8f7c5 100644 --- a/erts/emulator/beam/erl_afit_alloc.h +++ b/erts/emulator/beam/erl_afit_alloc.h @@ -56,7 +56,7 @@ struct AFAllctr_t_ { AFFreeBlock_t * free_list; }; -unsigned long erts_afalc_test(unsigned long, unsigned long, unsigned long); +UWord erts_afalc_test(UWord, UWord, UWord); #endif /* #if defined(GET_ERL_AF_ALLOC_IMPL) && !defined(ERL_AF_ALLOC_IMPL__) */ diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index d748f86d75..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; @@ -495,6 +522,71 @@ refuse_af_strategy(struct au_init *init) static void hdbg_init(void); #endif +static void adjust_fix_alloc_sizes(UWord extra_block_size) +{ + + if (extra_block_size && erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].enabled) { + int j; + +#ifdef ERTS_SMP + if (erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].thr_spec) { + int i; + ErtsAllocatorThrSpec_t* tspec; + + tspec = &erts_allctr_thr_spec[ERTS_ALC_A_FIXED_SIZE]; + ASSERT(tspec->enabled); + + for (i=0; i < tspec->size; i++) { + Allctr_t* allctr = tspec->allctr[i]; + for (j=0; j < ERTS_ALC_NO_FIXED_SIZES; ++j) { + allctr->fix[j].type_size += extra_block_size; + } + } + } + else +#endif + { + Allctr_t* allctr = erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].extra; + for (j=0; j < ERTS_ALC_NO_FIXED_SIZES; ++j) { + allctr->fix[j].type_size += 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) { @@ -515,9 +607,9 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) = sizeof(Process); #if !HALFWORD_HEAP fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MONITOR_SH)] - = ERTS_MONITOR_SH_SIZE; + = ERTS_MONITOR_SH_SIZE * sizeof(Uint); fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NLINK_SH)] - = ERTS_LINK_SH_SIZE; + = ERTS_LINK_SH_SIZE * sizeof(Uint); #endif fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_EV_D_STATE)] = sizeof(ErtsDrvEventDataState); @@ -533,15 +625,15 @@ 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; + erts_tsd_key_create(&erts_allctr_prelock_tsd_key); + 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); @@ -557,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; @@ -570,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; @@ -582,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); @@ -607,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); @@ -651,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; @@ -668,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); @@ -701,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); @@ -768,7 +845,7 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) #ifdef DEBUG extra_block_size += install_debug_functions(); #endif - + adjust_fix_alloc_sizes(extra_block_size); } void @@ -1104,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) { @@ -1117,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) @@ -1132,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)) { @@ -1163,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)) { @@ -1237,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); @@ -1264,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; @@ -1278,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, @@ -1305,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)) { @@ -1349,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)) { @@ -1414,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; @@ -1444,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; @@ -1508,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; @@ -2054,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 @@ -2102,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; @@ -2142,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) @@ -2152,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(); @@ -2278,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 @@ -2315,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++; @@ -2395,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; @@ -2549,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) { @@ -2811,6 +2908,7 @@ reply_alloc_info(void *vair) int i; Eterm (*info_func)(Allctr_t *, int, + int, int *, void *, Uint **, @@ -2939,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); } @@ -2975,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( @@ -3031,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}; @@ -3043,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)) @@ -3107,6 +3208,55 @@ erts_request_alloc_info(struct process *c_p, return 1; } +/* + * The allocator wrapper prelocking stuff below is about the locking order. + * It only affects wrappers (erl_mtrace.c and erl_instrument.c) that keep locks + * during alloc/realloc/free. + * + * Some query functions in erl_alloc_util.c lock the allocator mutex and then + * use erts_printf that in turn may call the sys allocator through the wrappers. + * To avoid breaking locking order these query functions first "pre-locks" all + * allocator wrappers. + */ +ErtsAllocatorWrapper_t *erts_allctr_wrappers; +int erts_allctr_wrapper_prelocked = 0; +erts_tsd_key_t erts_allctr_prelock_tsd_key; + +void erts_allctr_wrapper_prelock_init(ErtsAllocatorWrapper_t* wrapper) +{ + ASSERT(wrapper->lock && wrapper->unlock); + wrapper->next = erts_allctr_wrappers; + erts_allctr_wrappers = wrapper; +} + +void erts_allctr_wrapper_pre_lock(void) +{ + if (erts_allctr_wrappers) { + ErtsAllocatorWrapper_t* wrapper = erts_allctr_wrappers; + for ( ; wrapper; wrapper = wrapper->next) { + wrapper->lock(); + } + ASSERT(!erts_allctr_wrapper_prelocked); + erts_allctr_wrapper_prelocked = 1; + erts_tsd_set(erts_allctr_prelock_tsd_key, (void*)1); + } +} + +void erts_allctr_wrapper_pre_unlock(void) +{ + if (erts_allctr_wrappers) { + ErtsAllocatorWrapper_t* wrapper = erts_allctr_wrappers; + + erts_allctr_wrapper_prelocked = 0; + erts_tsd_set(erts_allctr_prelock_tsd_key, (void*)0); + for ( ; wrapper; wrapper = wrapper->next) { + wrapper->unlock(); + } + } +} + + + /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ * Deprecated functions * * * @@ -3136,10 +3286,7 @@ void *safe_realloc(void *ptr, Uint sz) \* */ #define ERTS_ALC_TEST_ABORT erl_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error\n") -UWord erts_alc_test(UWord op, - UWord a1, - UWord a2, - UWord a3) +UWord erts_alc_test(UWord op, UWord a1, UWord a2, UWord a3) { switch (op >> 8) { case 0x0: return erts_alcu_test(op, a1, a2); @@ -3191,14 +3338,13 @@ UWord erts_alc_test(UWord op, 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++; @@ -3318,6 +3464,11 @@ UWord erts_alc_test(UWord op, 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 ba5ec9c367..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; @@ -135,6 +127,18 @@ typedef struct { extern ErtsAllocatorThrSpec_t erts_allctr_thr_spec[ERTS_ALC_A_MAX+1]; +typedef struct ErtsAllocatorWrapper_t_ { + void (*lock)(void); + void (*unlock)(void); + struct ErtsAllocatorWrapper_t_* next; +}ErtsAllocatorWrapper_t; +ErtsAllocatorWrapper_t *erts_allctr_wrappers; +extern int erts_allctr_wrapper_prelocked; +extern erts_tsd_key_t erts_allctr_prelock_tsd_key; +void erts_allctr_wrapper_prelock_init(ErtsAllocatorWrapper_t* wrapper); +void erts_allctr_wrapper_pre_lock(void); +void erts_allctr_wrapper_pre_unlock(void); + void erts_alloc_register_scheduler(void *vesdp); #ifdef ERTS_SMP void erts_alloc_scheduler_handle_delayed_dealloc(void *vesdp, @@ -188,6 +192,7 @@ void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size); void erts_free(ErtsAlcType_t type, void *ptr); void *erts_alloc_fnf(ErtsAlcType_t type, Uint size); void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size); +int erts_is_allctr_wrapper_prelocked(void); #endif /* #if !ERTS_ALC_DO_INLINE */ @@ -258,6 +263,13 @@ void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size) size); } +ERTS_ALC_INLINE +int erts_is_allctr_wrapper_prelocked(void) +{ + return erts_allctr_wrapper_prelocked /* locked */ + && !!erts_tsd_get(erts_allctr_prelock_tsd_key); /* by me */ +} + #endif /* #if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) */ #define ERTS_ALC_GET_THR_IX() ((int) erts_get_scheduler_id()) diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 5e3615ccc2..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 @@ -272,6 +266,7 @@ type CODE_IX_LOCK_Q SHORT_LIVED SYSTEM code_ix_lock_q type PROC_INTERVAL LONG_LIVED SYSTEM process_interval type BUSY_CALLER_TAB SHORT_LIVED SYSTEM busy_caller_table type BUSY_CALLER SHORT_LIVED SYSTEM busy_caller +type PORT_DATA_HEAP STANDARD SYSTEM port_data_heap +if threads_no_smp # Need thread safe allocs, but std_alloc and fix_alloc are not; @@ -350,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 @@ -365,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" @@ -382,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 ac7f420708..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 { \ - CarriersStats_t *cstats__ = (((FLGS) & ERTS_ALCU_FLG_SBMBC) \ - ? &(AP)->sbmbcs \ - : &(AP)->mbcs); \ + 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__ = &(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... */ @@ -588,17 +690,21 @@ do { \ #ifdef DEBUG #ifdef USE_THREADS +# ifdef ERTS_SMP +# define IS_ACTUALLY_BLOCKING (erts_thr_progress_is_blocking()) +# else +# define IS_ACTUALLY_BLOCKING 0 +# endif #define ERTS_ALCU_DBG_CHK_THR_ACCESS(A) \ do { \ - if (!(A)->thread_safe) { \ - if (!(A)->debug.saved_tid) { \ + if (!(A)->thread_safe && !IS_ACTUALLY_BLOCKING) { \ + if (!(A)->debug.saved_tid) { \ (A)->debug.tid = erts_thr_self(); \ (A)->debug.saved_tid = 1; \ } \ else { \ ERTS_SMP_LC_ASSERT( \ - ethr_equal_tids((A)->debug.tid, erts_thr_self()) \ - || erts_thr_progress_is_blocking()); \ + ethr_equal_tids((A)->debug.tid, erts_thr_self())); \ } \ } \ } while (0) @@ -609,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 ... */ @@ -777,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) \ @@ -802,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 @@ -817,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 + + return res; +} + +static ERTS_INLINE void * +fix_nocpool_alloc(Allctr_t *allctr, ErtsAlcType_t type, Uint size) +{ + ErtsAlcFixList_t *fix; + void *res; - blk = UMEM2BLK(ptr); + 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++; + + 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); + } + for (o = 0; o < ERTS_ALC_FIX_MAX_SHRINK_OPS || flush; o++) { + void *ptr; - fix[ix].allocated--; + 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[ix].list_size != 0) { - if (fix[ix].limit < fix[ix].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) @@ -876,11 +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); +} -#define ERTS_ALCU_DD_FIX_TYPE_OFFS \ - ((sizeof(ErtsAllctrDDBlock_t)-1)/sizeof(UWord) + 1) +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) @@ -896,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. @@ -904,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; + } } - return crr->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 used_allctr; } static void @@ -1014,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; @@ -1115,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, @@ -1146,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) { @@ -1175,52 +1749,29 @@ handle_delayed_dealloc(Allctr_t *allctr, res = 1; - INC_CC(allctr->calls.this_free); - - if (fix) { - ErtsAlcType_t type; - - type = (ErtsAlcType_t) ((UWord *) ptr)[ERTS_ALCU_DD_FIX_TYPE_OFFS]; - 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)) { @@ -1230,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; @@ -1242,15 +1799,61 @@ enqueue_dealloc_other_instance(ErtsAlcType_t type, int cinit) { if (allctr->fix) - ((UWord *) ptr)[ERTS_ALCU_DD_FIX_TYPE_OFFS] = (UWord) type; + ((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, @@ -1268,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 @@ -1353,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; @@ -1386,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)); @@ -1427,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)); @@ -1447,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)) @@ -1458,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); @@ -1495,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); @@ -1511,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); @@ -1544,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; @@ -1570,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); @@ -1588,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)); @@ -1642,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; } @@ -1665,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); @@ -1674,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); } @@ -1684,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)); @@ -1712,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; } @@ -1721,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); @@ -1750,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); @@ -1761,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)); @@ -1822,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; @@ -1841,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 @@ -1856,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 { @@ -1880,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; @@ -1889,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); } } @@ -1914,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; } @@ -1925,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 @@ -1968,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; @@ -2071,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) @@ -2198,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); } @@ -2346,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); @@ -2366,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); } @@ -2376,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)); @@ -2394,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); } @@ -2451,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; @@ -2488,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 @@ -2508,12 +3708,6 @@ static erts_mtx_t init_atoms_mtx; static void init_atoms(Allctr_t *allctr) { - -#ifdef USE_THREADS - if (allctr && allctr->thread_safe) - erts_mtx_unlock(&allctr->mutex); -#endif - erts_mtx_lock(&init_atoms_mtx); if (!atoms_initialized) { @@ -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++) { @@ -2604,18 +3796,13 @@ init_atoms(Allctr_t *allctr) fix_type_atoms[ix] = am_atom_put(name, len); } } - - if (allctr) { + if (allctr && !allctr->atoms_initialized) { make_name_atoms(allctr); (*allctr->init_atoms)(); -#ifdef USE_THREADS - if (allctr->thread_safe) - erts_mtx_lock(&allctr->mutex); -#endif allctr->atoms_initialized = 1; } @@ -2642,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; @@ -2680,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, @@ -2689,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; } @@ -2732,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; @@ -2748,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, @@ -2772,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, @@ -2782,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; @@ -2813,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), @@ -2940,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; @@ -2959,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); @@ -2988,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; @@ -3045,6 +4304,7 @@ info_options(Allctr_t *allctr, Uint *szp) { Eterm res = THE_NON_VALUE; + int acul; if (!allctr) { if (print_to_p) @@ -3056,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) @@ -3084,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 @@ -3107,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, @@ -3116,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)); @@ -3243,17 +4504,21 @@ erts_alcu_info_options(Allctr_t *allctr, { Eterm res; + if (hpp || szp) + ensure_atoms_initialized(allctr); #ifdef USE_THREADS - if (allctr->thread_safe) + if (allctr->thread_safe) { + erts_allctr_wrapper_pre_lock(); erts_mtx_lock(&allctr->mutex); + } #endif - if (hpp || szp) - ensure_atoms_initialized(allctr); res = info_options(allctr, print_to_p, print_to_arg, hpp, szp); #ifdef USE_THREADS - if (allctr->thread_safe) + if (allctr->thread_safe) { erts_mtx_unlock(&allctr->mutex); + erts_allctr_wrapper_pre_unlock(); + } #endif return res; } @@ -3262,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; @@ -3280,67 +4549,81 @@ erts_alcu_sz_info(Allctr_t *allctr, return am_false; } + if (hpp || szp) + ensure_atoms_initialized(allctr); + #ifdef USE_THREADS - if (allctr->thread_safe) + if (allctr->thread_safe) { + erts_allctr_wrapper_pre_lock(); erts_mtx_lock(&allctr->mutex); + } #endif ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr); - if (hpp || szp) - ensure_atoms_initialized(allctr); - /* Update sbc values not continously updated */ allctr->sbcs.blocks.curr.no = 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); } #ifdef USE_THREADS - if (allctr->thread_safe) + if (allctr->thread_safe) { erts_mtx_unlock(&allctr->mutex); + erts_allctr_wrapper_pre_unlock(); + } #endif return res; } + 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; @@ -3352,22 +4635,23 @@ erts_alcu_info(Allctr_t *allctr, return am_false; } + if (hpp || szp) + ensure_atoms_initialized(allctr); + #ifdef USE_THREADS - if (allctr->thread_safe) + if (allctr->thread_safe) { + erts_allctr_wrapper_pre_lock(); erts_mtx_lock(&allctr->mutex); + } #endif ERTS_ALCU_DBG_CHK_THR_ACCESS(allctr); - if (hpp || szp) - ensure_atoms_initialized(allctr); - /* Update sbc values not continously updated */ allctr->sbcs.blocks.curr.no = 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); @@ -3381,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); @@ -3395,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, @@ -3407,15 +4698,16 @@ 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); } #ifdef USE_THREADS - if (allctr->thread_safe) + if (allctr->thread_safe) { erts_mtx_unlock(&allctr->mutex); + erts_allctr_wrapper_pre_unlock(); + } #endif return res; @@ -3433,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); + } } } } @@ -3466,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); @@ -3484,56 +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; - ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); - 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; - } - if (size < 2*sizeof(UWord)) - size += sizeof(UWord); - 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; } @@ -3602,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); @@ -3621,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); @@ -3635,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 @@ -3695,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); } @@ -3717,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); @@ -3727,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, @@ -3738,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); } } } @@ -3759,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; @@ -3784,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; @@ -3795,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; @@ -3859,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 @@ -3887,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; @@ -3901,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; } @@ -3922,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; @@ -3937,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; @@ -3961,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); @@ -3988,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); @@ -4031,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); } @@ -4048,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, @@ -4089,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); } @@ -4198,13 +5458,23 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) #if ERTS_SMP if (init->tpref) { Uint sz = ABLK_HDR_SZ; - sz += ERTS_ALCU_DD_FIX_TYPE_OFFS*sizeof(UWord); - if (init->fix) - sz += sizeof(UWord); + sz += (init->fix ? + sizeof(ErtsAllctrFixDDBlock_t) : sizeof(ErtsAllctrDDBlock_t)); sz = UNIT_CEILING(sz); 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; @@ -4224,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; @@ -4256,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*/ @@ -4284,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) { @@ -4292,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; @@ -4300,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 @@ -4307,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); @@ -4318,13 +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; + } } } @@ -4349,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) @@ -4367,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); @@ -4394,43 +5662,70 @@ erts_alcu_init(AlcUInit_t *init) * to erts_alcu_test() * \* */ -unsigned long -erts_alcu_test(unsigned long op, unsigned long a1, unsigned long a2) +UWord +erts_alcu_test(UWord op, UWord a1, UWord a2) { switch (op) { - case 0x000: return (unsigned long) BLK_SZ((Block_t *) a1); - case 0x001: return (unsigned long) BLK_UMEM_SZ((Block_t *) a1); - case 0x002: return (unsigned long) IS_PREV_BLK_FREE((Block_t *) a1); - case 0x003: return (unsigned long) IS_FREE_BLK((Block_t *) a1); - case 0x004: return (unsigned long) IS_LAST_BLK((Block_t *) a1); - case 0x005: return (unsigned long) UMEM2BLK((void *) a1); - case 0x006: return (unsigned long) BLK2UMEM((Block_t *) a1); - case 0x007: return (unsigned long) IS_SB_CARRIER((Carrier_t *) a1); - case 0x008: return (unsigned long) IS_SBC_BLK((Block_t *) a1); - case 0x009: return (unsigned long) IS_MB_CARRIER((Carrier_t *) a1); - case 0x00a: return (unsigned long) IS_MSEG_CARRIER((Carrier_t *) a1); - case 0x00b: return (unsigned long) CARRIER_SZ((Carrier_t *) a1); - case 0x00c: return (unsigned long) SBC2BLK((Allctr_t *) a1, + case 0x000: return (UWord) BLK_SZ((Block_t *) a1); + case 0x001: return (UWord) BLK_UMEM_SZ((Block_t *) a1); + case 0x002: return (UWord) IS_PREV_BLK_FREE((Block_t *) a1); + case 0x003: return (UWord) IS_FREE_BLK((Block_t *) a1); + case 0x004: return (UWord) IS_LAST_BLK((Block_t *) a1); + case 0x005: return (UWord) UMEM2BLK((void *) a1); + case 0x006: return (UWord) BLK2UMEM((Block_t *) a1); + case 0x007: return (UWord) IS_SB_CARRIER((Carrier_t *) a1); + case 0x008: return (UWord) IS_SBC_BLK((Block_t *) a1); + case 0x009: return (UWord) IS_MB_CARRIER((Carrier_t *) a1); + case 0x00a: return (UWord) IS_MSEG_CARRIER((Carrier_t *) a1); + case 0x00b: return (UWord) CARRIER_SZ((Carrier_t *) a1); + case 0x00c: return (UWord) SBC2BLK((Allctr_t *) a1, (Carrier_t *) a2); - case 0x00d: return (unsigned long) BLK_TO_SBC((Block_t *) a2); - case 0x00e: return (unsigned long) MBC_TO_FIRST_BLK((Allctr_t *) a1, + case 0x00d: return (UWord) BLK_TO_SBC((Block_t *) a2); + case 0x00e: return (UWord) MBC_TO_FIRST_BLK((Allctr_t *) a1, (Carrier_t *) a2); - case 0x00f: return (unsigned long) FIRST_BLK_TO_MBC((Allctr_t *) a1, + case 0x00f: return (UWord) FIRST_BLK_TO_MBC((Allctr_t *) a1, (Block_t *) a2); - case 0x010: return (unsigned long) ((Allctr_t *) a1)->mbc_list.first; - case 0x011: return (unsigned long) ((Allctr_t *) a1)->mbc_list.last; - case 0x012: return (unsigned long) ((Allctr_t *) a1)->sbc_list.first; - case 0x013: return (unsigned long) ((Allctr_t *) a1)->sbc_list.last; - case 0x014: return (unsigned long) ((Carrier_t *) a1)->next; - case 0x015: return (unsigned long) ((Carrier_t *) a1)->prev; - case 0x016: return (unsigned long) ABLK_HDR_SZ; - case 0x017: return (unsigned long) ((Allctr_t *) a1)->min_block_size; - case 0x018: return (unsigned long) NXT_BLK((Block_t *) a1); - case 0x019: return (unsigned long) PREV_BLK((Block_t *) a1); - case 0x01a: return (unsigned long) IS_MBC_FIRST_BLK((Allctr_t*)a1, (Block_t *) a2); - case 0x01b: return (unsigned long) sizeof(Unit_t); - default: ASSERT(0); return ~((unsigned long) 0); + case 0x010: return (UWord) ((Allctr_t *) a1)->mbc_list.first; + case 0x011: return (UWord) ((Allctr_t *) a1)->mbc_list.last; + case 0x012: return (UWord) ((Allctr_t *) a1)->sbc_list.first; + case 0x013: return (UWord) ((Allctr_t *) a1)->sbc_list.last; + case 0x014: return (UWord) ((Carrier_t *) a1)->next; + case 0x015: return (UWord) ((Carrier_t *) a1)->prev; + case 0x016: return (UWord) ABLK_HDR_SZ; + case 0x017: return (UWord) ((Allctr_t *) a1)->min_block_size; + case 0x018: return (UWord) NXT_BLK((Block_t *) a1); + 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; } /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ @@ -4438,6 +5733,20 @@ erts_alcu_test(unsigned long op, unsigned long a1, unsigned long 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; @@ -4445,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" @@ -4584,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 e0754e7f69..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 { @@ -501,7 +580,9 @@ void erts_alcu_stop(Allctr_t *); void erts_alcu_verify_unused(Allctr_t *); void erts_alcu_verify_unused_ts(Allctr_t *allctr); -unsigned long erts_alcu_test(unsigned long, unsigned long, unsigned long); +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*); diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c index 6ce209085c..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; @@ -780,19 +974,24 @@ info_options(Allctr_t *allctr, * to erts_aoffalc_test() * \* */ -unsigned long -erts_aoffalc_test(unsigned long op, unsigned long a1, unsigned long a2) +UWord +erts_aoffalc_test(UWord op, UWord a1, UWord a2) { switch (op) { - case 0x500: return (unsigned long) 0; /* IS_AOBF */ - case 0x501: return (unsigned long) ((AOFFAllctr_t *) a1)->mbc_root; - case 0x502: return (unsigned long) ((AOFF_RBTree_t *) a1)->parent; - case 0x503: return (unsigned long) ((AOFF_RBTree_t *) a1)->left; - case 0x504: return (unsigned long) ((AOFF_RBTree_t *) a1)->right; - case 0x506: return (unsigned long) IS_BLACK((AOFF_RBTree_t *) a1); - case 0x508: return (unsigned long) 1; /* IS_AOFF */ - case 0x509: return (unsigned long) ((AOFF_RBTree_t *) a1)->max_sz; - default: ASSERT(0); return ~((unsigned long) 0); + 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) 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(unsigned long op, unsigned long a1, unsigned long 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 6fa626f723..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,10 +52,10 @@ 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; }; -unsigned long erts_aoffalc_test(unsigned long, unsigned long, unsigned long); +UWord erts_aoffalc_test(UWord, UWord, UWord); #endif /* #if defined(GET_ERL_AOFF_ALLOC_IMPL) && !defined(ERL_AOFF_ALLOC_IMPL__) */ diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c index 5625622e3f..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; } @@ -972,20 +962,20 @@ info_options(Allctr_t *allctr, * to erts_bfalc_test() * \* */ -unsigned long -erts_bfalc_test(unsigned long op, unsigned long a1, unsigned long a2) +UWord +erts_bfalc_test(UWord op, UWord a1, UWord a2) { switch (op) { - case 0x200: return (unsigned long) ((BFAllctr_t *) a1)->address_order; - case 0x201: return (unsigned long) ((BFAllctr_t *) a1)->mbc_root; - case 0x202: return (unsigned long) ((RBTree_t *) a1)->parent; - case 0x203: return (unsigned long) ((RBTree_t *) a1)->left; - case 0x204: return (unsigned long) ((RBTree_t *) a1)->right; - case 0x205: return (unsigned long) ((RBTreeList_t *) a1)->next; - case 0x206: return (unsigned long) IS_BLACK((RBTree_t *) a1); - case 0x207: return (unsigned long) IS_TREE_NODE((RBTree_t *) a1); - case 0x208: return (unsigned long) 0; /* IS_AOFF */ - default: ASSERT(0); return ~((unsigned long) 0); + case 0x200: return (UWord) ((BFAllctr_t *) a1)->address_order; + case 0x201: return (UWord) ((BFAllctr_t *) a1)->mbc_root; + case 0x202: return (UWord) ((RBTree_t *) a1)->parent; + case 0x203: return (UWord) ((RBTree_t *) a1)->left; + case 0x204: return (UWord) ((RBTree_t *) a1)->right; + 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) 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 0c29662852..be8b2b871d 100644 --- a/erts/emulator/beam/erl_bestfit_alloc.h +++ b/erts/emulator/beam/erl_bestfit_alloc.h @@ -55,11 +55,10 @@ struct BFAllctr_t_ { Allctr_t allctr; /* Has to be first! */ RBTree_t * mbc_root; - RBTree_t * sbmbc_root; int address_order; }; -unsigned long erts_bfalc_test(unsigned long, unsigned long, unsigned long); +UWord erts_bfalc_test(UWord, UWord, UWord); #endif /* #if defined(GET_ERL_BF_ALLOC_IMPL) && !defined(ERL_BF_ALLOC_IMPL__) */ diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 379d3eecc6..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) @@ -114,6 +115,9 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE #ifdef VALGRIND " [valgrind-compiled]" #endif +#ifdef ERTS_FRMPTR + " [frame-pointer]" +#endif #ifdef USE_DTRACE " [dtrace]" #endif @@ -486,27 +490,6 @@ collect_one_suspend_monitor(ErtsSuspendMonitor *smon, void *vsmicp) } } - -static void one_link_size(ErtsLink *lnk, void *vpu) -{ - Uint *pu = vpu; - *pu += ERTS_LINK_SIZE*sizeof(Uint); - if(!IS_CONST(lnk->pid)) - *pu += NC_HEAP_SIZE(lnk->pid)*sizeof(Uint); - if (lnk->type != LINK_NODE && ERTS_LINK_ROOT(lnk) != NULL) { - erts_doforall_links(ERTS_LINK_ROOT(lnk),&one_link_size,vpu); - } -} -static void one_mon_size(ErtsMonitor *mon, void *vpu) -{ - Uint *pu = vpu; - *pu += ERTS_MONITOR_SIZE*sizeof(Uint); - if(!IS_CONST(mon->pid)) - *pu += NC_HEAP_SIZE(mon->pid)*sizeof(Uint); - if(!IS_CONST(mon->ref)) - *pu += NC_HEAP_SIZE(mon->ref)*sizeof(Uint); -} - /* * process_info/[1,2] */ @@ -1420,41 +1403,8 @@ process_info_aux(Process *BIF_P, } case am_memory: { /* Memory consumed in bytes */ - ErlMessage *mp; - Uint size = 0; Uint hsz = 3; - struct saved_calls *scb; - size += sizeof(Process); - - ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); - - erts_doforall_links(ERTS_P_LINKS(rp), &one_link_size, &size); - erts_doforall_monitors(ERTS_P_MONITORS(rp), &one_mon_size, &size); - size += (rp->heap_sz + rp->mbuf_sz) * sizeof(Eterm); - if (rp->old_hend && rp->old_heap) - size += (rp->old_hend - rp->old_heap) * sizeof(Eterm); - - size += rp->msg.len * sizeof(ErlMessage); - - for (mp = rp->msg.first; mp; mp = mp->next) - if (mp->data.attached) - size += erts_msg_attached_data_size(mp)*sizeof(Eterm); - - if (rp->arg_reg != rp->def_arg_reg) { - size += rp->arity * sizeof(rp->arg_reg[0]); - } - - if (rp->psd) - size += sizeof(ErtsPSD); - - scb = ERTS_PROC_GET_SAVED_CALLS_BUF(rp); - if (scb) { - size += (sizeof(struct saved_calls) - + (scb->len-1) * sizeof(scb->ct[0])); - } - - size += erts_dicts_mem_size(rp); - + Uint size = erts_process_memory(rp); (void) erts_bld_uint(NULL, &hsz, size); hp = HAlloc(BIF_P, hsz); res = erts_bld_uint(&hp, NULL, size); @@ -1721,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; @@ -1786,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; @@ -2096,6 +2055,9 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) #elif defined(ERTS_ENABLE_LOCK_COUNT) ERTS_DECL_AM(lcnt); BIF_RET(AM_lcnt); +#elif defined(ERTS_FRMPTR) + ERTS_DECL_AM(frmptr); + BIF_RET(AM_frmptr); #else BIF_RET(am_opt); #endif @@ -2861,12 +2823,10 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt, Eterm ite included though). */ Uint size = 0; - ErlHeapFragment* bp; - erts_doforall_links(ERTS_P_LINKS(prt), &one_link_size, &size); + erts_doforall_links(ERTS_P_LINKS(prt), &erts_one_link_size, &size); - for (bp = prt->bp; bp; bp = bp->next) - size += sizeof(ErlHeapFragment) + (bp->alloc_size - 1)*sizeof(Eterm); + size += erts_port_data_size(prt); if (prt->linebuf) size += sizeof(LineBuf) + prt->linebuf->ovsiz; @@ -3153,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; @@ -4132,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_bif_port.c b/erts/emulator/beam/erl_bif_port.c index 44fa41c7b6..109c54fd7f 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -423,57 +423,164 @@ BIF_RETTYPE erts_internal_port_info_2(BIF_ALIST_2) } } +/* + * The erlang:port_set_data()/erlang:port_get_data() operations should + * be viewed as operations on a table (inet_db) with data values + * associated with port identifier keys. That is, these operations are + * *not* signals to/from ports. + */ + +#if (TAG_PRIMARY_IMMED1 & 0x3) == 0 +# error "erlang:port_set_data()/erlang:port_get_data() needs to be rewritten!" +#endif + +typedef struct { + ErtsThrPrgrLaterOp later_op; + Uint hsize; + Eterm data; + ErlOffHeap off_heap; + Eterm heap[1]; +} ErtsPortDataHeap; -BIF_RETTYPE erts_internal_port_set_data_2(BIF_ALIST_2) +static void +free_port_data_heap(void *vpdhp) { - Eterm ref; + erts_cleanup_offheap(&((ErtsPortDataHeap *) vpdhp)->off_heap); + erts_free(ERTS_ALC_T_PORT_DATA_HEAP, vpdhp); +} + +static ERTS_INLINE void +cleanup_old_port_data(erts_aint_t data) +{ + if ((data & 0x3) != 0) { + ASSERT(is_immed((Eterm) data)); + } + else { +#ifdef ERTS_SMP + ErtsPortDataHeap *pdhp = (ErtsPortDataHeap *) data; + size_t size; + ERTS_SMP_DATA_DEPENDENCY_READ_MEMORY_BARRIER; + size = sizeof(ErtsPortDataHeap) + pdhp->hsize*(sizeof(Eterm) - 1); + erts_schedule_thr_prgr_later_cleanup_op(free_port_data_heap, + (void *) pdhp, + &pdhp->later_op, + size); +#else + free_port_data_heap((void *) data); +#endif + } +} + +void +erts_init_port_data(Port *prt) +{ + erts_smp_atomic_init_nob(&prt->data, (erts_aint_t) am_undefined); +} + +void +erts_cleanup_port_data(Port *prt) +{ + ASSERT(erts_atomic32_read_nob(&prt->state) & ERTS_PORT_SFLGS_INVALID_LOOKUP); + cleanup_old_port_data(erts_smp_atomic_read_nob(&prt->data)); + erts_smp_atomic_set_nob(&prt->data, (erts_aint_t) THE_NON_VALUE); +} + +Uint +erts_port_data_size(Port *prt) +{ + erts_aint_t data = erts_smp_atomic_read_ddrb(&prt->data); + + if ((data & 0x3) != 0) { + ASSERT(is_immed((Eterm) (UWord) data)); + return (Uint) 0; + } + else { + ErtsPortDataHeap *pdhp = (ErtsPortDataHeap *) data; + return (Uint) sizeof(ErtsPortDataHeap) + pdhp->hsize*(sizeof(Eterm)-1); + } +} + +ErlOffHeap * +erts_port_data_offheap(Port *prt) +{ + erts_aint_t data = erts_smp_atomic_read_ddrb(&prt->data); + + if ((data & 0x3) != 0) { + ASSERT(is_immed((Eterm) (UWord) data)); + return NULL; + } + else { + ErtsPortDataHeap *pdhp = (ErtsPortDataHeap *) data; + return &pdhp->off_heap; + } +} + +BIF_RETTYPE port_set_data_2(BIF_ALIST_2) +{ + /* + * This is not a signal. See comment above. + */ + erts_aint_t data; Port* prt; prt = lookup_port(BIF_P, BIF_ARG_1); if (!prt) - BIF_RET(am_badarg); + BIF_ERROR(BIF_P, BADARG); - switch (erts_port_set_data(BIF_P, prt, BIF_ARG_2, &ref)) { - case ERTS_PORT_OP_CALLER_EXIT: - case ERTS_PORT_OP_BADARG: - case ERTS_PORT_OP_DROPPED: - BIF_RET(am_badarg); - case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(ref)); - BIF_RET(ref); - case ERTS_PORT_OP_DONE: - BIF_RET(am_true); - default: - ERTS_INTERNAL_ERROR("Unexpected erts_port_set_data() result"); - BIF_RET(am_internal_error); + if (is_immed(BIF_ARG_2)) { + data = (erts_aint_t) BIF_ARG_2; + ASSERT((data & 0x3) != 0); } + else { + ErtsPortDataHeap *pdhp; + Uint hsize; + Eterm *hp; + + hsize = size_object(BIF_ARG_2); + pdhp = erts_alloc(ERTS_ALC_T_PORT_DATA_HEAP, + sizeof(ErtsPortDataHeap) + hsize*(sizeof(Eterm)-1)); + hp = &pdhp->heap[0]; + pdhp->off_heap.first = NULL; + pdhp->off_heap.overhead = 0; + pdhp->data = copy_struct(BIF_ARG_2, hsize, &hp, &pdhp->off_heap); + data = (erts_aint_t) pdhp; + ASSERT((data & 0x3) == 0); + } + + data = erts_smp_atomic_xchg_wb(&prt->data, data); + + cleanup_old_port_data(data); + + BIF_RET(am_true); } -BIF_RETTYPE erts_internal_port_get_data_1(BIF_ALIST_1) +BIF_RETTYPE port_get_data_1(BIF_ALIST_1) { - Eterm retval; + /* + * This is not a signal. See comment above. + */ + Eterm res; + erts_aint_t data; Port* prt; prt = lookup_port(BIF_P, BIF_ARG_1); if (!prt) - BIF_RET(am_badarg); + BIF_ERROR(BIF_P, BADARG); - switch (erts_port_get_data(BIF_P, prt, &retval)) { - case ERTS_PORT_OP_CALLER_EXIT: - case ERTS_PORT_OP_BADARG: - case ERTS_PORT_OP_DROPPED: - BIF_RET(am_badarg); - case ERTS_PORT_OP_SCHEDULED: - ASSERT(is_internal_ref(retval)); - BIF_RET(retval); - case ERTS_PORT_OP_DONE: - ASSERT(is_not_internal_ref(retval)); - BIF_RET(retval); - default: - ERTS_INTERNAL_ERROR("Unexpected erts_port_get_data() result"); - BIF_RET(am_internal_error); + data = erts_smp_atomic_read_ddrb(&prt->data); + + if ((data & 0x3) != 0) { + res = (Eterm) (UWord) data; + ASSERT(is_immed(res)); + } + else { + ErtsPortDataHeap *pdhp = (ErtsPortDataHeap *) data; + Eterm *hp = HAlloc(BIF_P, pdhp->hsize); + res = copy_struct(pdhp->data, pdhp->hsize, &hp, &MSO(BIF_P)); } + + BIF_RET(res); } /* diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 14a40dcd7e..06fbbea123 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -1224,9 +1224,7 @@ trace_info_func(Process* p, Eterm func_spec, Eterm key) match_spec_meta = NIL; } if (r & FUNC_TRACE_COUNT_TRACE) { - c = count < 0 ? - erts_make_integer(-count-1, p) : - erts_make_integer(count, p); + c = erts_make_integer(count, p); } if (r & FUNC_TRACE_TIME_TRACE) { ct = call_time; 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 c2088929e9..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; @@ -589,16 +590,16 @@ info_options(Allctr_t *allctr, * to erts_gfalc_test() * \* */ -unsigned long -erts_gfalc_test(unsigned long op, unsigned long a1, unsigned long a2) +UWord +erts_gfalc_test(UWord op, UWord a1, UWord a2) { switch (op) { - case 0x100: return (unsigned long) BKT_IX((GFAllctr_t *) a1, (Uint) a2); - case 0x101: return (unsigned long) BKT_MIN_SZ((GFAllctr_t *) a1, (int) a2); - case 0x102: return (unsigned long) NO_OF_BKTS; - case 0x103: return (unsigned long) + case 0x100: return (UWord) BKT_IX((GFAllctr_t *) a1, (Uint) a2); + case 0x101: return (UWord) BKT_MIN_SZ((GFAllctr_t *) a1, (int) a2); + case 0x102: return (UWord) NO_OF_BKTS; + case 0x103: return (UWord) find_bucket(&((GFAllctr_t *) a1)->bucket_mask, (int) a2); - default: ASSERT(0); return ~((unsigned long) 0); + default: ASSERT(0); return ~((UWord) 0); } } diff --git a/erts/emulator/beam/erl_goodfit_alloc.h b/erts/emulator/beam/erl_goodfit_alloc.h index a554a6f466..11bef77e7f 100644 --- a/erts/emulator/beam/erl_goodfit_alloc.h +++ b/erts/emulator/beam/erl_goodfit_alloc.h @@ -82,7 +82,7 @@ struct GFAllctr_t_ { }; -unsigned long erts_gfalc_test(unsigned long, unsigned long, unsigned long); +UWord erts_gfalc_test(UWord, UWord, UWord); #endif /* #if defined(GET_ERL_GF_ALLOC_IMPL) && !defined(ERL_GF_ALLOC_IMPL__) */ 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 b5b245288b..df7c443387 100644 --- a/erts/emulator/beam/erl_instrument.c +++ b/erts/emulator/beam/erl_instrument.c @@ -271,6 +271,18 @@ stat_upd_realloc(ErtsAlcType_t n, Uint size, Uint old_size) * stat instrumentation callback functions */ +static void stat_pre_lock(void) +{ + erts_mtx_lock(&instr_mutex); +} + +static void stat_pre_unlock(void) +{ + erts_mtx_unlock(&instr_mutex); +} + +static ErtsAllocatorWrapper_t instr_wrapper; + static void * stat_alloc(ErtsAlcType_t n, void *extra, Uint size) { @@ -278,7 +290,9 @@ stat_alloc(ErtsAlcType_t n, void *extra, Uint size) Uint ssize; void *res; - erts_mtx_lock(&instr_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_lock(&instr_mutex); + } ssize = size + STAT_BLOCK_HEADER_SIZE; res = (*real_af->alloc)(n, real_af->extra, ssize); @@ -293,7 +307,9 @@ stat_alloc(ErtsAlcType_t n, void *extra, Uint size) res = (void *) ((StatBlock_t *) res)->mem; } - erts_mtx_unlock(&instr_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_unlock(&instr_mutex); + } return res; } @@ -307,7 +323,9 @@ stat_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size) void *sptr; void *res; - erts_mtx_lock(&instr_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_lock(&instr_mutex); + } if (ptr) { sptr = (void *) (((char *) ptr) - STAT_BLOCK_HEADER_SIZE); @@ -329,7 +347,9 @@ stat_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size) res = (void *) ((StatBlock_t *) res)->mem; } - erts_mtx_unlock(&instr_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_unlock(&instr_mutex); + } return res; } @@ -340,7 +360,9 @@ stat_free(ErtsAlcType_t n, void *extra, void *ptr) ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; void *sptr; - erts_mtx_lock(&instr_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_lock(&instr_mutex); + } if (ptr) { sptr = (void *) (((char *) ptr) - STAT_BLOCK_HEADER_SIZE); @@ -352,7 +374,9 @@ stat_free(ErtsAlcType_t n, void *extra, void *ptr) (*real_af->free)(n, real_af->extra, sptr); - erts_mtx_unlock(&instr_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_unlock(&instr_mutex); + } } @@ -360,6 +384,18 @@ stat_free(ErtsAlcType_t n, void *extra, void *ptr) * map stat instrumentation callback functions */ +static void map_stat_pre_lock(void) +{ + erts_mtx_lock(&instr_x_mutex); + erts_mtx_lock(&instr_mutex); +} + +static void map_stat_pre_unlock(void) +{ + erts_mtx_unlock(&instr_mutex); + erts_mtx_unlock(&instr_x_mutex); +} + static void * map_stat_alloc(ErtsAlcType_t n, void *extra, Uint size) { @@ -367,7 +403,9 @@ map_stat_alloc(ErtsAlcType_t n, void *extra, Uint size) Uint msize; void *res; - erts_mtx_lock(&instr_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_lock(&instr_mutex); + } msize = size + MAP_STAT_BLOCK_HEADER_SIZE; res = (*real_af->alloc)(n, real_af->extra, msize); @@ -388,7 +426,9 @@ map_stat_alloc(ErtsAlcType_t n, void *extra, Uint size) res = (void *) mb->mem; } - erts_mtx_unlock(&instr_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_unlock(&instr_mutex); + } return res; } @@ -402,8 +442,10 @@ map_stat_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size) void *mptr; void *res; - erts_mtx_lock(&instr_x_mutex); - erts_mtx_lock(&instr_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_lock(&instr_x_mutex); + erts_mtx_lock(&instr_mutex); + } if (ptr) { mptr = (void *) (((char *) ptr) - MAP_STAT_BLOCK_HEADER_SIZE); @@ -449,9 +491,10 @@ map_stat_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size) res = (void *) mb->mem; } - - erts_mtx_unlock(&instr_mutex); - erts_mtx_unlock(&instr_x_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_unlock(&instr_mutex); + erts_mtx_unlock(&instr_x_mutex); + } return res; } @@ -462,8 +505,10 @@ map_stat_free(ErtsAlcType_t n, void *extra, void *ptr) ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; void *mptr; - erts_mtx_lock(&instr_x_mutex); - erts_mtx_lock(&instr_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_lock(&instr_x_mutex); + erts_mtx_lock(&instr_mutex); + } if (ptr) { MapStatBlock_t *mb; @@ -486,8 +531,10 @@ map_stat_free(ErtsAlcType_t n, void *extra, void *ptr) (*real_af->free)(n, real_af->extra, mptr); - erts_mtx_unlock(&instr_mutex); - erts_mtx_unlock(&instr_x_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_unlock(&instr_mutex); + erts_mtx_unlock(&instr_x_mutex); + } } @@ -496,8 +543,10 @@ static void dump_memory_map_to_stream(FILE *fp) ErtsAlcType_t n; MapStatBlock_t *bp; int lock = !ERTS_IS_CRASH_DUMPING; - if (lock) + if (lock) { + ASSERT(!erts_is_allctr_wrapper_prelocked()); erts_mtx_lock(&instr_mutex); + } /* Write header */ @@ -1155,6 +1204,7 @@ erts_instr_get_type_info(Process *proc) Uint erts_instr_init(int stat, int map_stat) { + Uint extra_sz; int i; am_tot = NULL; @@ -1186,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 @@ -1201,27 +1249,28 @@ 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; erts_allctrs[i].extra = (void *) &real_allctrs[i]; } - return MAP_STAT_BLOCK_HEADER_SIZE; + instr_wrapper.lock = map_stat_pre_lock; + instr_wrapper.unlock = map_stat_pre_unlock; + extra_sz = MAP_STAT_BLOCK_HEADER_SIZE; } 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; erts_allctrs[i].extra = (void *) &real_allctrs[i]; } - return STAT_BLOCK_HEADER_SIZE; + instr_wrapper.lock = stat_pre_lock; + instr_wrapper.unlock = stat_pre_unlock; + extra_sz = STAT_BLOCK_HEADER_SIZE; } - + erts_allctr_wrapper_prelock_init(&instr_wrapper); + return extra_sz; } diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 69bb4be717..2ac5e24d3a 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -143,21 +143,20 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "ptimer_pre_alloc_lock", "address", }, { "btm_pre_alloc_lock", NULL, }, { "dist_entry_out_queue", "address" }, + { "port_sched_lock", "port_id" }, + { "port_table", NULL }, #endif { "mtrace_op", NULL }, { "instr_x", NULL }, { "instr", NULL }, { "alcu_allocator", "index" }, - { "sbmbc_alloc", "index" }, { "mseg", NULL }, #if HALFWORD_HEAP { "pmmap", NULL }, #endif #ifdef ERTS_SMP - { "port_sched_lock", "port_id" }, { "port_task_pre_alloc_lock", "address" }, { "proclist_pre_alloc_lock", "address" }, - { "port_table", NULL }, { "xports_list_pre_alloc_lock", "address" }, { "inet_buffer_stack_lock", NULL }, { "gc_info", NULL }, @@ -181,6 +180,11 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "efile_drv dtrace mutex", NULL }, #endif { "mtrace_buf", NULL }, +#ifdef __WIN32__ +#ifdef ERTS_SMP + { "sys_gethrtime", NULL }, +#endif +#endif { "erts_alloc_hard_debug", NULL } }; diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c index 70e592cc5f..244a2b26db 100644 --- a/erts/emulator/beam/erl_monitors.c +++ b/erts/emulator/beam/erl_monitors.c @@ -1024,3 +1024,23 @@ Eterm erts_debug_dump_links_1(BIF_ALIST_1) } } } + +void erts_one_link_size(ErtsLink *lnk, void *vpu) +{ + Uint *pu = vpu; + *pu += ERTS_LINK_SIZE*sizeof(Uint); + if(!IS_CONST(lnk->pid)) + *pu += NC_HEAP_SIZE(lnk->pid)*sizeof(Uint); + if (lnk->type != LINK_NODE && ERTS_LINK_ROOT(lnk) != NULL) { + erts_doforall_links(ERTS_LINK_ROOT(lnk),&erts_one_link_size,vpu); + } +} +void erts_one_mon_size(ErtsMonitor *mon, void *vpu) +{ + Uint *pu = vpu; + *pu += ERTS_MONITOR_SIZE*sizeof(Uint); + if(!IS_CONST(mon->pid)) + *pu += NC_HEAP_SIZE(mon->pid)*sizeof(Uint); + if(!IS_CONST(mon->ref)) + *pu += NC_HEAP_SIZE(mon->ref)*sizeof(Uint); +} diff --git a/erts/emulator/beam/erl_monitors.h b/erts/emulator/beam/erl_monitors.h index 6a360a2336..fb11dbbd22 100644 --- a/erts/emulator/beam/erl_monitors.h +++ b/erts/emulator/beam/erl_monitors.h @@ -170,6 +170,8 @@ ErtsSuspendMonitor *erts_lookup_suspend_monitor(ErtsSuspendMonitor *root, Eterm pid); void erts_delete_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid); void erts_init_monitors(void); +void erts_one_link_size(ErtsLink *lnk, void *vpu); +void erts_one_mon_size(ErtsMonitor *mon, void *vpu); #define erts_doforall_monitors erts_sweep_monitors #define erts_doforall_links erts_sweep_links diff --git a/erts/emulator/beam/erl_mtrace.c b/erts/emulator/beam/erl_mtrace.c index e538ba30c2..c8bb126687 100644 --- a/erts/emulator/beam/erl_mtrace.c +++ b/erts/emulator/beam/erl_mtrace.c @@ -222,6 +222,8 @@ static byte *tracep; static byte *endp; static SysTimeval last_tv; +static ErtsAllocatorWrapper_t mtrace_wrapper; + #if ERTS_MTRACE_SEGMENT_ID >= ERTS_ALC_A_MIN || ERTS_MTRACE_SEGMENT_ID < 0 #error ERTS_MTRACE_SEGMENT_ID >= ERTS_ALC_A_MIN || ERTS_MTRACE_SEGMENT_ID < 0 #endif @@ -555,6 +557,8 @@ write_trace_header(char *nodename, char *pid, char *hostname) return 1; } +static void mtrace_pre_lock(void); +static void mtrace_pre_unlock(void); static void *mtrace_alloc(ErtsAlcType_t, void *, Uint); static void *mtrace_realloc(ErtsAlcType_t, void *, void *, Uint); static void mtrace_free(ErtsAlcType_t, void *, void *); @@ -635,12 +639,16 @@ erts_mtrace_install_wrapper_functions(void) erts_allctrs[i].free = mtrace_free; erts_allctrs[i].extra = (void *) &real_allctrs[i]; } + mtrace_wrapper.lock = mtrace_pre_lock; + mtrace_wrapper.unlock = mtrace_pre_unlock; + erts_allctr_wrapper_prelock_init(&mtrace_wrapper); } } void erts_mtrace_stop(void) { + ASSERT(!erts_is_allctr_wrapper_prelocked()); erts_mtx_lock(&mtrace_op_mutex); erts_mtx_lock(&mtrace_buf_mutex); if (erts_mtrace_enabled) { @@ -677,6 +685,7 @@ erts_mtrace_stop(void) void erts_mtrace_exit(Uint32 exit_value) { + ASSERT(!erts_is_allctr_wrapper_prelocked()); erts_mtx_lock(&mtrace_op_mutex); erts_mtx_lock(&mtrace_buf_mutex); if (erts_mtrace_enabled) { @@ -935,18 +944,33 @@ write_free_entry(byte tag, erts_mtx_unlock(&mtrace_buf_mutex); } +static void mtrace_pre_lock(void) +{ + erts_mtx_lock(&mtrace_op_mutex); +} + +static void mtrace_pre_unlock(void) +{ + erts_mtx_unlock(&mtrace_op_mutex); +} + + static void * mtrace_alloc(ErtsAlcType_t n, void *extra, Uint size) { ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; void *res; - erts_mtx_lock(&mtrace_op_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_lock(&mtrace_op_mutex); + } res = (*real_af->alloc)(n, real_af->extra, size); write_alloc_entry(ERTS_MT_ALLOC_BDY_TAG, res, n, 0, size); - erts_mtx_unlock(&mtrace_op_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_unlock(&mtrace_op_mutex); + } return res; } @@ -957,12 +981,16 @@ mtrace_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size) ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; void *res; - erts_mtx_lock(&mtrace_op_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_lock(&mtrace_op_mutex); + } res = (*real_af->realloc)(n, real_af->extra, ptr, size); write_realloc_entry(ERTS_MT_REALLOC_BDY_TAG, res, n, 0, ptr, size); - erts_mtx_unlock(&mtrace_op_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_unlock(&mtrace_op_mutex); + } return res; @@ -973,10 +1001,14 @@ mtrace_free(ErtsAlcType_t n, void *extra, void *ptr) { ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; - erts_mtx_lock(&mtrace_op_mutex); + if (!erts_is_allctr_wrapper_prelocked()) { + erts_mtx_lock(&mtrace_op_mutex); + } (*real_af->free)(n, real_af->extra, ptr); - write_free_entry(ERTS_MT_FREE_BDY_TAG, n, 0, ptr); + if (!erts_is_allctr_wrapper_prelocked()) { + write_free_entry(ERTS_MT_FREE_BDY_TAG, n, 0, ptr); + } erts_mtx_unlock(&mtrace_op_mutex); } diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index ebfba065d1..e688e55c88 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -1371,6 +1371,7 @@ setup_reference_table(void) /* Insert all ports */ max = erts_ptab_max(&erts_port); for (i = 0; i < max; i++) { + ErlOffHeap *ohp; erts_aint32_t state; Port *prt; @@ -1389,8 +1390,9 @@ setup_reference_table(void) if (ERTS_P_MONITORS(prt)) insert_monitors(ERTS_P_MONITORS(prt), prt->common.id); /* Insert port data */ - for(hfp = prt->bp; hfp; hfp = hfp->next) - insert_offheap(&(hfp->off_heap), HEAP_REF, prt->common.id); + ohp = erts_port_data_offheap(prt); + if (ohp) + insert_offheap(ohp, HEAP_REF, prt->common.id); /* Insert controller */ if (prt->dist_entry) insert_dist_entry(prt->dist_entry, diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h index 377aa72ed5..ad3f104a68 100644 --- a/erts/emulator/beam/erl_port.h +++ b/erts/emulator/beam/erl_port.h @@ -167,8 +167,7 @@ struct _erl_drv_port { #endif erts_atomic_t connected; /* A connected process */ Eterm caller; /* Current caller. */ - Eterm data; /* Data associated with port. */ - ErlHeapFragment* bp; /* Heap fragment holding data (NULL if imm data). */ + erts_smp_atomic_t data; /* Data associated with port. */ Uint bytes_in; /* Number of bytes read */ Uint bytes_out; /* Number of bytes written */ @@ -189,6 +188,12 @@ struct _erl_drv_port { int reds; /* Only used while executing driver callbacks */ }; + +void erts_init_port_data(Port *); +void erts_cleanup_port_data(Port *); +Uint erts_port_data_size(Port *); +ErlOffHeap *erts_port_data_offheap(Port *); + #define ERTS_PORT_GET_CONNECTED(PRT) \ ((Eterm) erts_atomic_read_nob(&(PRT)->connected)) #define ERTS_PORT_SET_CONNECTED(PRT, PID) \ @@ -326,8 +331,6 @@ extern erts_smp_atomic_t erts_bytes_in; /* no bytes sent into the system */ #define ERTS_PORT_REDS_CONTROL (CONTEXT_REDS/100) #define ERTS_PORT_REDS_CALL (CONTEXT_REDS/50) #define ERTS_PORT_REDS_INFO (CONTEXT_REDS/100) -#define ERTS_PORT_REDS_SET_DATA (CONTEXT_REDS/100) -#define ERTS_PORT_REDS_GET_DATA (CONTEXT_REDS/100) #define ERTS_PORT_REDS_TERMINATE (CONTEXT_REDS/50) void print_port_info(Port *, int, void *); @@ -794,8 +797,6 @@ struct binary; #define ERTS_P2P_SIG_TYPE_INFO 7 #define ERTS_P2P_SIG_TYPE_LINK 8 #define ERTS_P2P_SIG_TYPE_UNLINK 9 -#define ERTS_P2P_SIG_TYPE_SET_DATA 10 -#define ERTS_P2P_SIG_TYPE_GET_DATA 11 #define ERTS_P2P_SIG_TYPE_BITS 4 #define ERTS_P2P_SIG_TYPE_MASK \ @@ -810,6 +811,7 @@ struct binary; #define ERTS_P2P_SIG_DATA_FLG_BAD_OUTPUT ERTS_P2P_SIG_DATA_FLG(4) #define ERTS_P2P_SIG_DATA_FLG_BROKEN_LINK ERTS_P2P_SIG_DATA_FLG(5) #define ERTS_P2P_SIG_DATA_FLG_SCHED ERTS_P2P_SIG_DATA_FLG(6) +#define ERTS_P2P_SIG_DATA_FLG_ASYNC ERTS_P2P_SIG_DATA_FLG(7) struct ErtsProc2PortSigData_ { int flags; @@ -856,10 +858,6 @@ struct ErtsProc2PortSigData_ { struct { Eterm from; } unlink; - struct { - ErlHeapFragment *bp; - Eterm data; - } set_data; } u; } ; @@ -919,6 +917,7 @@ erts_schedule_proc2port_signal(Process *, Eterm *, ErtsProc2PortSigData *, int, + ErtsPortTaskHandle *, ErtsProc2PortSigCallback); int erts_deliver_port_exit(Port *, Eterm, Eterm, int); @@ -932,6 +931,7 @@ int erts_deliver_port_exit(Port *, Eterm, Eterm, int); #define ERTS_PORT_SIG_FLG_BROKEN_LINK ERTS_P2P_SIG_DATA_FLG_BROKEN_LINK #define ERTS_PORT_SIG_FLG_BAD_OUTPUT ERTS_P2P_SIG_DATA_FLG_BAD_OUTPUT #define ERTS_PORT_SIG_FLG_FORCE_SCHED ERTS_P2P_SIG_DATA_FLG_SCHED +#define ERTS_PORT_SIG_FLG_ASYNC ERTS_P2P_SIG_DATA_FLG_ASYNC /* ERTS_PORT_SIG_FLG_FORCE_IMM_CALL only when crash dumping... */ #define ERTS_PORT_SIG_FLG_FORCE_IMM_CALL ERTS_P2P_SIG_DATA_FLG_BAD_OUTPUT @@ -953,7 +953,5 @@ ErtsPortOpResult erts_port_unlink(Process *, Port *, Eterm, Eterm *); ErtsPortOpResult erts_port_control(Process *, Port *, unsigned int, Eterm, Eterm *); ErtsPortOpResult erts_port_call(Process *, Port *, unsigned int, Eterm, Eterm *); ErtsPortOpResult erts_port_info(Process *, Port *, Eterm, Eterm *); -ErtsPortOpResult erts_port_set_data(Process *, Port *, Eterm, Eterm *); -ErtsPortOpResult erts_port_get_data(Process *, Port *, Eterm *); #endif diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 9ba7704106..7d53ce7152 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -552,6 +552,19 @@ set_handle(ErtsPortTask *ptp, ErtsPortTaskHandle *pthp) } } +static ERTS_INLINE void +set_tmp_handle(ErtsPortTask *ptp, ErtsPortTaskHandle *pthp) +{ + ptp->u.alive.handle = NULL; + if (pthp) { + /* + * IMPORTANT! Task either need to be aborted, or task handle + * need to be detached before thread progress has been made. + */ + erts_smp_atomic_set_relb(pthp, (erts_aint_t) ptp); + } +} + /* * Busy port queue management @@ -1182,6 +1195,13 @@ erl_drv_consume_timeslice(ErlDrvPort dprt, int percent) return 1; } +void +erts_port_task_tmp_handle_detach(ErtsPortTaskHandle *pthp) +{ + ERTS_SMP_LC_ASSERT(erts_thr_progress_lc_is_delaying()); + reset_port_task_handle(pthp); +} + /* * Abort a scheduled task. */ @@ -1206,7 +1226,7 @@ erts_port_task_abort(ErtsPortTaskHandle *pthp) ERTS_SMP_READ_MEMORY_BARRIER; old_state = erts_smp_atomic32_read_nob(&ptp->state); if (old_state == ERTS_PT_STATE_SCHEDULED) { - ASSERT(saved_pthp == pthp); + ASSERT(!saved_pthp || saved_pthp == pthp); } #endif @@ -1227,9 +1247,6 @@ erts_port_task_abort(ErtsPortTaskHandle *pthp) &erts_port_task_outstanding_io_tasks) > 0); erts_smp_atomic_dec_relb(&erts_port_task_outstanding_io_tasks); break; - case ERTS_PORT_TASK_PROC_SIG: - ERTS_INTERNAL_ERROR("Aborted process to port signal"); - break; default: break; } @@ -1404,7 +1421,6 @@ erts_port_task_schedule(Eterm id, } case ERTS_PORT_TASK_PROC_SIG: { va_list argp; - ASSERT(!pthp); va_start(argp, type); sigdp = va_arg(argp, ErtsProc2PortSigData *); ptp = p2p_sig_data_to_task(sigdp); @@ -1412,7 +1428,7 @@ erts_port_task_schedule(Eterm id, ptp->u.alive.flags |= va_arg(argp, int); va_end(argp); if (!(ptp->u.alive.flags & ERTS_PT_FLG_NOSUSPEND)) - set_handle(ptp, pthp); + set_tmp_handle(ptp, pthp); else { ns_pthlp = erts_alloc(ERTS_ALC_T_PT_HNDL_LIST, sizeof(ErtsPortTaskHandleList)); @@ -1925,18 +1941,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_port_task.h b/erts/emulator/beam/erl_port_task.h index ae6cd69ae2..d35a15c27b 100644 --- a/erts/emulator/beam/erl_port_task.h +++ b/erts/emulator/beam/erl_port_task.h @@ -243,7 +243,9 @@ int erts_port_task_execute(ErtsRunQueue *, Port **); void erts_port_task_init(void); #endif +void erts_port_task_tmp_handle_detach(ErtsPortTaskHandle *); int erts_port_task_abort(ErtsPortTaskHandle *); + void erts_port_task_abort_nosuspend_tasks(Port *); int erts_port_task_schedule(Eterm, diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 9618a5555b..3d161f2aa0 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -486,7 +486,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 @@ -506,7 +506,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; @@ -1327,6 +1328,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) { @@ -4671,6 +4683,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 797f9e687b..3c1edfad7a 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,8 @@ struct ErtsSchedulerData_ { Uint64 reductions; ErtsSchedWallTime sched_wall_time; + ErtsGCInfo gc_info; + ErtsPortTaskHandle nosuspend_port_task_handle; #ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC erts_alloc_verify_func_t verify_unused_temp_alloc; @@ -1126,6 +1133,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 +1341,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 +1361,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 *); @@ -1422,6 +1431,8 @@ Eterm erts_debug_reader_groups_map(Process *c_p, int groups); Uint erts_debug_nbalance(void); int erts_debug_wait_deallocations(Process *c_p); +Uint erts_process_memory(Process *c_p); + #ifdef ERTS_SMP # define ERTS_GET_SCHEDULER_DATA_FROM_PROC(PROC) ((PROC)->scheduler_data) # define ERTS_PROC_GET_SCHDATA(PROC) ((PROC)->scheduler_data) diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index a93229c473..6cd0d23b97 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -76,6 +76,43 @@ erts_deep_process_dump(int to, void *to_arg) dump_binaries(to, to_arg, all_binaries); } +Uint erts_process_memory(Process *p) { + ErlMessage *mp; + Uint size = 0; + struct saved_calls *scb; + size += sizeof(Process); + + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p); + + erts_doforall_links(ERTS_P_LINKS(p), &erts_one_link_size, &size); + erts_doforall_monitors(ERTS_P_MONITORS(p), &erts_one_mon_size, &size); + size += (p->heap_sz + p->mbuf_sz) * sizeof(Eterm); + if (p->old_hend && p->old_heap) + size += (p->old_hend - p->old_heap) * sizeof(Eterm); + + size += p->msg.len * sizeof(ErlMessage); + + for (mp = p->msg.first; mp; mp = mp->next) + if (mp->data.attached) + size += erts_msg_attached_data_size(mp)*sizeof(Eterm); + + if (p->arg_reg != p->def_arg_reg) { + size += p->arity * sizeof(p->arg_reg[0]); + } + + if (p->psd) + size += sizeof(ErtsPSD); + + scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p); + if (scb) { + size += (sizeof(struct saved_calls) + + (scb->len-1) * sizeof(scb->ct[0])); + } + + size += erts_dicts_mem_size(p); + return size; +} + static void dump_process_info(int to, void *to_arg, Process *p) { 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/external.c b/erts/emulator/beam/external.c index 5ce0d97c74..8420cfae24 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -3147,17 +3147,6 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) return result; } -static int is_valid_utf8_atom(byte* bytes, Uint nbytes) -{ - byte* err_pos; - Uint num_chars; - - /*SVERK Do we really need to validate correct utf8? */ - return nbytes <= MAX_ATOM_SZ_LIMIT - && erts_analyze_utf8(bytes, nbytes, &err_pos, &num_chars, NULL) == ERTS_UTF8_OK - && num_chars <= MAX_ATOM_CHARACTERS; -} - static Sint decoded_size(byte *ep, byte* endp, int internal_tags) { @@ -3235,7 +3224,7 @@ decoded_size(byte *ep, byte* endp, int internal_tags) CHKSIZE(2); n = get_int16(ep); ep += 2; - if (!is_valid_utf8_atom(ep, n)) { + if (n > MAX_ATOM_SZ_LIMIT) { return -1; } SKIP(n+atom_extra_skip); @@ -3254,7 +3243,7 @@ decoded_size(byte *ep, byte* endp, int internal_tags) CHKSIZE(1); n = get_int8(ep); ep++; - if (!is_valid_utf8_atom(ep, n)) { + if (n > MAX_ATOM_SZ_LIMIT) { return -1; } SKIP(n+atom_extra_skip); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 12826cf428..12eb3bfb7c 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 7cadd4aaad..01e130bd64 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -364,9 +364,8 @@ static Port *create_port(char *name, ERTS_P_LINKS(prt) = NULL; ERTS_P_MONITORS(prt) = NULL; prt->linebuf = NULL; - prt->bp = NULL; prt->suspended = NULL; - prt->data = am_undefined; + erts_init_port_data(prt); prt->port_data_lock = NULL; prt->control_flags = 0; prt->bytes_in = 0; @@ -1442,6 +1441,7 @@ erts_schedule_proc2port_signal(Process *c_p, Eterm *refp, ErtsProc2PortSigData *sigdp, int task_flags, + ErtsPortTaskHandle *pthp, ErtsProc2PortSigCallback callback) { int sched_res; @@ -1491,7 +1491,7 @@ erts_schedule_proc2port_signal(Process *c_p, /* Schedule port close call for later execution... */ sched_res = erts_port_task_schedule(prt->common.id, - NULL, + pthp, ERTS_PORT_TASK_PROC_SIG, sigdp, callback, @@ -1629,6 +1629,7 @@ bad_port_signal(Process *c_p, refp, sigdp, 0, + NULL, port_badsig); } @@ -1838,8 +1839,11 @@ erts_port_output(Process *c_p, ErlIOVec *evp = NULL; char *buf = NULL; int force_immediate_call = (flags & ERTS_PORT_SIG_FLG_FORCE_IMM_CALL); + int async_nosuspend; + ErtsPortTaskHandle *ns_pthp; ASSERT((flags & ~(ERTS_PORT_SIG_FLG_BANG_OP + | ERTS_PORT_SIG_FLG_ASYNC | ERTS_PORT_SIG_FLG_NOSUSPEND | ERTS_PORT_SIG_FLG_FORCE | ERTS_PORT_SIG_FLG_FORCE_IMM_CALL)) == 0); @@ -1861,6 +1865,12 @@ erts_port_output(Process *c_p, ? ERTS_PORT_OP_DROPPED : ERTS_PORT_OP_BUSY); + async_nosuspend = ((flags & (ERTS_PORT_SIG_FLG_ASYNC + | ERTS_PORT_SIG_FLG_NOSUSPEND + | ERTS_PORT_SIG_FLG_FORCE)) + == (ERTS_PORT_SIG_FLG_ASYNC + | ERTS_PORT_SIG_FLG_NOSUSPEND)); + try_call = (force_immediate_call /* crash dumping */ || !(sched_flags & (invalid_flags | ERTS_PTS_FLGS_FORCE_SCHEDULE_OP))); @@ -1995,6 +2005,15 @@ erts_port_output(Process *c_p, return ERTS_PORT_OP_DONE; case ERTS_TRY_IMM_DRV_CALL_INVALID_SCHED_FLAGS: sched_flags = try_call_state.sched_flags; + if (async_nosuspend + && (sched_flags & (busy_flgs|ERTS_PTS_FLG_EXIT))) { + driver_free_binary(cbin); + if (evp != &ev) + erts_free(ERTS_ALC_T_TMP, evp); + return ((sched_flags & ERTS_PTS_FLG_EXIT) + ? ERTS_PORT_OP_DROPPED + : ERTS_PORT_OP_BUSY); + } case ERTS_TRY_IMM_DRV_CALL_BUSY_LOCK: /* Schedule outputv() call instead... */ break; @@ -2142,6 +2161,13 @@ erts_port_output(Process *c_p, return ERTS_PORT_OP_DONE; case ERTS_TRY_IMM_DRV_CALL_INVALID_SCHED_FLAGS: sched_flags = try_call_state.sched_flags; + if (async_nosuspend + && (sched_flags & (busy_flgs|ERTS_PTS_FLG_EXIT))) { + erts_free(ERTS_ALC_T_TMP, buf); + return ((sched_flags & ERTS_PTS_FLG_EXIT) + ? ERTS_PORT_OP_DROPPED + : ERTS_PORT_OP_BUSY); + } case ERTS_TRY_IMM_DRV_CALL_BUSY_LOCK: /* Schedule outputv() call instead... */ break; @@ -2163,20 +2189,33 @@ erts_port_output(Process *c_p, task_flags = ERTS_PT_FLG_WAIT_BUSY; sigdp->flags |= flags; + ns_pthp = NULL; if (flags & (ERTS_P2P_SIG_DATA_FLG_FORCE|ERTS_P2P_SIG_DATA_FLG_NOSUSPEND)) { task_flags = 0; if (flags & ERTS_P2P_SIG_DATA_FLG_FORCE) sigdp->flags &= ~ERTS_P2P_SIG_DATA_FLG_NOSUSPEND; + else if (async_nosuspend) { + ErtsSchedulerData *esdp = (c_p + ? ERTS_PROC_GET_SCHDATA(c_p) + : erts_get_scheduler_data()); + ASSERT(esdp); + ns_pthp = &esdp->nosuspend_port_task_handle; + sigdp->flags &= ~ERTS_P2P_SIG_DATA_FLG_NOSUSPEND; + } else if (flags & ERTS_P2P_SIG_DATA_FLG_NOSUSPEND) task_flags = ERTS_PT_FLG_NOSUSPEND; } + ASSERT(ns_pthp || !async_nosuspend); + ASSERT(async_nosuspend || !ns_pthp); + res = erts_schedule_proc2port_signal(c_p, prt, c_p ? c_p->common.id : ERTS_INVALID_PID, refp, sigdp, task_flags, + ns_pthp, port_sig_callback); if (res != ERTS_PORT_OP_SCHEDULED) { @@ -2187,9 +2226,23 @@ erts_port_output(Process *c_p, return res; } - if (!(sched_flags & ERTS_PTS_FLG_EXIT) && (sched_flags & busy_flgs)) - return ERTS_PORT_OP_BUSY_SCHEDULED; - + if (!(flags & ERTS_PORT_SIG_FLG_FORCE)) { + sched_flags = erts_smp_atomic32_read_acqb(&prt->sched.flags); + if (!(sched_flags & ERTS_PTS_FLG_BUSY_PORT)) { + if (async_nosuspend) + erts_port_task_tmp_handle_detach(ns_pthp); + } + else { + if (!async_nosuspend) + return ERTS_PORT_OP_BUSY_SCHEDULED; + else { + if (erts_port_task_abort(ns_pthp) == 0) + return ERTS_PORT_OP_BUSY; + else + erts_port_task_tmp_handle_detach(ns_pthp); + } + } + } return res; bad_value: @@ -2285,6 +2338,7 @@ erts_port_exit(Process *c_p, ErlHeapFragment *bp = NULL; ASSERT((flags & ~(ERTS_PORT_SIG_FLG_BANG_OP + | ERTS_PORT_SIG_FLG_ASYNC | ERTS_PORT_SIG_FLG_BROKEN_LINK | ERTS_PORT_SIG_FLG_FORCE_SCHED)) == 0); @@ -2345,6 +2399,7 @@ erts_port_exit(Process *c_p, refp, sigdp, 0, + NULL, port_sig_exit); if (res == ERTS_PORT_OP_DROPPED) { @@ -2460,7 +2515,8 @@ erts_port_connect(Process *c_p, !refp, am_connect); - ASSERT((flags & ~ERTS_PORT_SIG_FLG_BANG_OP) == 0); + ASSERT((flags & ~(ERTS_PORT_SIG_FLG_BANG_OP + | ERTS_PORT_SIG_FLG_ASYNC)) == 0); if (is_not_internal_pid(connect)) connect_id = NIL; /* Fail in op (for signal order) */ @@ -2499,6 +2555,7 @@ erts_port_connect(Process *c_p, refp, sigdp, 0, + NULL, port_sig_connect); } @@ -2555,6 +2612,7 @@ erts_port_unlink(Process *c_p, Port *prt, Eterm from, Eterm *refp) refp, sigdp, 0, + NULL, port_sig_unlink); } @@ -2644,11 +2702,13 @@ erts_port_link(Process *c_p, Port *prt, Eterm to, Eterm *refp) refp, sigdp, 0, + NULL, port_sig_link); } 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; @@ -2691,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); @@ -3371,11 +3432,8 @@ terminate_port(Port *prt) erts_free(ERTS_ALC_T_LINEBUF, (void *) prt->linebuf); prt->linebuf = NULL; } - if (prt->bp != NULL) { - free_message_buffer(prt->bp); - prt->bp = NULL; - prt->data = am_undefined; - } + + erts_cleanup_port_data(prt); if (prt->psd) erts_free(ERTS_ALC_T_PRTSD, prt->psd); @@ -3625,6 +3683,10 @@ erts_port_command(Process *c_p, ASSERT(port); flags |= ERTS_PORT_SIG_FLG_BANG_OP; + if (!erts_port_synchronous_ops) { + flags |= ERTS_PORT_SIG_FLG_ASYNC; + refp = NULL; + } if (is_tuple_arity(command, 2)) { Eterm cntd; @@ -3632,21 +3694,14 @@ erts_port_command(Process *c_p, cntd = tp[1]; if (is_internal_pid(cntd)) { if (tp[2] == am_close) { - if (!erts_port_synchronous_ops) - refp = NULL; flags &= ~ERTS_PORT_SIG_FLG_NOSUSPEND; return erts_port_exit(c_p, flags, port, cntd, am_normal, refp); } else if (is_tuple_arity(tp[2], 2)) { tp = tuple_val(tp[2]); if (tp[1] == am_command) { - if (!(flags & ERTS_PORT_SIG_FLG_NOSUSPEND) - && !erts_port_synchronous_ops) - refp = NULL; return erts_port_output(c_p, flags, port, cntd, tp[2], refp); } else if (tp[1] == am_connect) { - if (!erts_port_synchronous_ops) - refp = NULL; flags &= ~ERTS_PORT_SIG_FLG_NOSUSPEND; return erts_port_connect(c_p, flags, port, cntd, tp[2], refp); } @@ -3655,8 +3710,6 @@ erts_port_command(Process *c_p, } /* badsig */ - if (!erts_port_synchronous_ops) - refp = NULL; flags &= ~ERTS_PORT_SIG_FLG_NOSUSPEND; return bad_port_signal(c_p, flags, port, c_p->common.id, refp, am_command); } @@ -4053,6 +4106,7 @@ erts_port_control(Process* c_p, retvalp, sigdp, 0, + NULL, port_sig_control); if (res != ERTS_PORT_OP_SCHEDULED) { cleanup_scheduled_control(binp, bufp); @@ -4147,7 +4201,7 @@ port_sig_call(Port *prt, ErlOffHeap *ohp; Process *rp; ErtsProcLocks rp_locks = 0; - Uint hsz; + Sint hsz; rp = erts_proc_lookup_raw(sigdp->caller); if (!rp) @@ -4264,7 +4318,7 @@ erts_port_call(Process* c_p, switch (try_call_res) { case ERTS_TRY_IMM_DRV_CALL_OK: { Eterm *hp, *hp_end; - Uint hsz; + Sint hsz; unsigned ret_flags = 0U; Eterm term; @@ -4333,6 +4387,7 @@ erts_port_call(Process* c_p, retvalp, sigdp, 0, + NULL, port_sig_call); if (res != ERTS_PORT_OP_SCHEDULED) { cleanup_scheduled_call(bufp); @@ -4499,228 +4554,10 @@ erts_port_info(Process* c_p, retvalp, sigdp, 0, + NULL, port_sig_info); } -static int -port_sig_set_data(Port *prt, - erts_aint32_t state, - int op, - ErtsProc2PortSigData *sigdp) -{ - ASSERT(sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY); - - if (op == ERTS_PROC2PORT_SIG_EXEC) { - if (prt->bp) - free_message_buffer(prt->bp); - prt->bp = sigdp->u.set_data.bp; - prt->data = sigdp->u.set_data.data; - port_sched_op_reply(sigdp->caller, sigdp->ref, am_true); - } - else { - if (sigdp->u.set_data.bp) - free_message_buffer(sigdp->u.set_data.bp); - port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg); - } - return ERTS_PORT_REDS_SET_DATA; -} - -ErtsPortOpResult -erts_port_set_data(Process* c_p, - Port *prt, - Eterm data, - Eterm *refp) -{ - ErtsPortOpResult res; - Eterm set_data; - ErlHeapFragment *bp; - ErtsProc2PortSigData *sigdp; - ErtsTryImmDrvCallResult try_call_res; - ErtsTryImmDrvCallState try_call_state - = ERTS_INIT_TRY_IMM_DRV_CALL_STATE( - c_p, - prt, - ERTS_PORT_SFLGS_INVALID_LOOKUP, - 0, - !refp, - am_set_data); - - if (is_immed(data)) { - set_data = data; - bp = NULL; - } - else { - Eterm *hp; - Uint sz = size_object(data); - bp = new_message_buffer(sz); - hp = bp->mem; - set_data = copy_struct(data, sz, &hp, &bp->off_heap); - } - - try_call_res = try_imm_drv_call(&try_call_state); - switch (try_call_res) { - case ERTS_TRY_IMM_DRV_CALL_OK: - if (prt->bp) - free_message_buffer(prt->bp); - prt->bp = bp; - prt->data = set_data; - finalize_imm_drv_call(&try_call_state); - BUMP_REDS(c_p, ERTS_PORT_REDS_SET_DATA); - return ERTS_PORT_OP_DONE; - case ERTS_TRY_IMM_DRV_CALL_INVALID_PORT: - return ERTS_PORT_OP_DROPPED; - case ERTS_TRY_IMM_DRV_CALL_INVALID_SCHED_FLAGS: - case ERTS_TRY_IMM_DRV_CALL_BUSY_LOCK: - /* Schedule call instead... */ - break; - } - - sigdp = erts_port_task_alloc_p2p_sig_data(); - sigdp->flags = ERTS_P2P_SIG_TYPE_SET_DATA; - sigdp->u.set_data.data = set_data; - sigdp->u.set_data.bp = bp; - - res = erts_schedule_proc2port_signal(c_p, - prt, - c_p->common.id, - refp, - sigdp, - 0, - port_sig_set_data); - if (res != ERTS_PORT_OP_SCHEDULED && bp) - free_message_buffer(bp); - return res; -} - -static int -port_sig_get_data(Port *prt, - erts_aint32_t state, - int op, - ErtsProc2PortSigData *sigdp) -{ - ASSERT(sigdp->flags & ERTS_P2P_SIG_DATA_FLG_REPLY); - if (op != ERTS_PROC2PORT_SIG_EXEC) - port_sched_op_reply(sigdp->caller, sigdp->ref, am_badarg); - else { - Process *rp; - ErtsProcLocks rp_locks = 0; - - rp = erts_proc_lookup_raw(sigdp->caller); - if (rp) { - Uint hsz; - Eterm *hp, *hp_start; - Eterm data, msg; - ErlHeapFragment *bp; - ErlOffHeap *ohp; - - hsz = ERTS_QUEUE_PORT_SCHED_OP_REPLY_SIZE; - hsz += 3; - if (prt->bp) - hsz += prt->bp->used_size; - - hp_start = hp = erts_alloc_message_heap(hsz, - &bp, - &ohp, - rp, - &rp_locks); - - if (is_immed(prt->data)) - data = prt->data; - else - data = copy_struct(prt->data, - prt->bp->used_size, - &hp, - &bp->off_heap); - - - - msg = TUPLE2(hp, am_ok, data); - hp += 3; - - queue_port_sched_op_reply(rp, - &rp_locks, - hp_start, - hp, - hsz, - bp, - sigdp->ref, - msg); - if (rp_locks) - erts_smp_proc_unlock(rp, rp_locks); - } - } - return ERTS_PORT_REDS_GET_DATA; -} - -ErtsPortOpResult -erts_port_get_data(Process* c_p, - Port *prt, - Eterm *retvalp) -{ - ErtsProc2PortSigData *sigdp; - ErtsTryImmDrvCallResult try_call_res; - ErtsTryImmDrvCallState try_call_state - = ERTS_INIT_TRY_IMM_DRV_CALL_STATE( - c_p, - prt, - ERTS_PORT_SFLGS_INVALID_LOOKUP, - 0, - 0, - am_get_data); - - try_call_res = try_imm_drv_call(&try_call_state); - switch (try_call_res) { - case ERTS_TRY_IMM_DRV_CALL_OK: { - Eterm *hp; - Eterm data; - ErlHeapFragment *bp; - Uint sz; - if (is_immed(prt->data)) { - bp = NULL; - data = prt->data; - } - else { - bp = new_message_buffer(prt->bp->used_size); - data = copy_struct(prt->data, - prt->bp->used_size, - &hp, - &bp->off_heap); - } - finalize_imm_drv_call(&try_call_state); - if (is_immed(data)) - sz = 0; - else - sz = bp->used_size; - - hp = HAlloc(c_p, sz + 3); - if (is_not_immed(data)) { - data = copy_struct(data, bp->used_size, &hp, &MSO(c_p)); - free_message_buffer(bp); - } - *retvalp = TUPLE2(hp, am_ok, data); - BUMP_REDS(c_p, ERTS_PORT_REDS_GET_DATA); - return ERTS_PORT_OP_DONE; - } - case ERTS_TRY_IMM_DRV_CALL_INVALID_PORT: - return ERTS_PORT_OP_DROPPED; - case ERTS_TRY_IMM_DRV_CALL_INVALID_SCHED_FLAGS: - case ERTS_TRY_IMM_DRV_CALL_BUSY_LOCK: - /* Schedule call instead... */ - break; - } - - sigdp = erts_port_task_alloc_p2p_sig_data(); - sigdp->flags = ERTS_P2P_SIG_TYPE_GET_DATA; - - return erts_schedule_proc2port_signal(c_p, - prt, - c_p->common.id, - retvalp, - sigdp, - 0, - port_sig_get_data); -} - typedef struct { int to; void *arg; @@ -4977,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; @@ -4992,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"; @@ -5035,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; @@ -5052,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 { @@ -5941,10 +5794,6 @@ int driver_outputv(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen, return driver_output2(ix, hbuf, hlen, NULL, 0); size = vec->size - skip; /* Size of remaining bytes in vector */ - ASSERT(hlen >= 0); /* debug only */ - if (hlen < 0) - hlen = 0; - prt = erts_drvport2port_state(ix, &state); if (prt == ERTS_INVALID_ERL_DRV_PORT) return -1; 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/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 2451f41a82..301ce2d0e2 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -678,8 +678,8 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n) #define INET_LOPT_UDP_READ_PACKETS 33 /* Number of packets to read */ #define INET_OPT_RAW 34 /* Raw socket options */ #define INET_LOPT_TCP_SEND_TIMEOUT_CLOSE 35 /* auto-close on send timeout or not */ -#define INET_LOPT_TCP_MSGQ_HIWTRMRK 36 /* set local high watermark */ -#define INET_LOPT_TCP_MSGQ_LOWTRMRK 37 /* set local low watermark */ +#define INET_LOPT_MSGQ_HIWTRMRK 36 /* set local msgq high watermark */ +#define INET_LOPT_MSGQ_LOWTRMRK 37 /* set local msgq low watermark */ /* SCTP options: a separate range, from 100: */ #define SCTP_OPT_RTOINFO 100 #define SCTP_OPT_ASSOCINFO 101 @@ -5476,27 +5476,25 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len) } continue; - case INET_LOPT_TCP_MSGQ_HIWTRMRK: - if (desc->stype == SOCK_STREAM) { - ErlDrvSizeT high; - if (ival < ERL_DRV_BUSY_MSGQ_LIM_MIN - || ERL_DRV_BUSY_MSGQ_LIM_MAX < ival) - return -1; - high = (ErlDrvSizeT) ival; - erl_drv_busy_msgq_limits(desc->port, NULL, &high); - } + case INET_LOPT_MSGQ_HIWTRMRK: { + ErlDrvSizeT high; + if (ival < ERL_DRV_BUSY_MSGQ_LIM_MIN + || ERL_DRV_BUSY_MSGQ_LIM_MAX < ival) + return -1; + high = (ErlDrvSizeT) ival; + erl_drv_busy_msgq_limits(desc->port, NULL, &high); continue; + } - case INET_LOPT_TCP_MSGQ_LOWTRMRK: - if (desc->stype == SOCK_STREAM) { - ErlDrvSizeT low; - if (ival < ERL_DRV_BUSY_MSGQ_LIM_MIN - || ERL_DRV_BUSY_MSGQ_LIM_MAX < ival) - return -1; - low = (ErlDrvSizeT) ival; - erl_drv_busy_msgq_limits(desc->port, &low, NULL); - } + case INET_LOPT_MSGQ_LOWTRMRK: { + ErlDrvSizeT low; + if (ival < ERL_DRV_BUSY_MSGQ_LIM_MIN + || ERL_DRV_BUSY_MSGQ_LIM_MAX < ival) + return -1; + low = (ErlDrvSizeT) ival; + erl_drv_busy_msgq_limits(desc->port, &low, NULL); continue; + } case INET_LOPT_TCP_SEND_TIMEOUT: if (desc->stype == SOCK_STREAM) { @@ -6398,31 +6396,23 @@ static ErlDrvSSizeT inet_fill_opts(inet_descriptor* desc, } continue; - case INET_LOPT_TCP_MSGQ_HIWTRMRK: - if (desc->stype == SOCK_STREAM) { - ErlDrvSizeT high = ERL_DRV_BUSY_MSGQ_READ_ONLY; - *ptr++ = opt; - erl_drv_busy_msgq_limits(desc->port, NULL, &high); - ival = high > INT_MAX ? INT_MAX : (int) high; - put_int32(ival, ptr); - } - else { - TRUNCATE_TO(0,ptr); - } + case INET_LOPT_MSGQ_HIWTRMRK: { + ErlDrvSizeT high = ERL_DRV_BUSY_MSGQ_READ_ONLY; + *ptr++ = opt; + erl_drv_busy_msgq_limits(desc->port, NULL, &high); + ival = high > INT_MAX ? INT_MAX : (int) high; + put_int32(ival, ptr); continue; + } - case INET_LOPT_TCP_MSGQ_LOWTRMRK: - if (desc->stype == SOCK_STREAM) { - ErlDrvSizeT low = ERL_DRV_BUSY_MSGQ_READ_ONLY; - *ptr++ = opt; - erl_drv_busy_msgq_limits(desc->port, &low, NULL); - ival = low > INT_MAX ? INT_MAX : (int) low; - put_int32(ival, ptr); - } - else { - TRUNCATE_TO(0,ptr); - } + case INET_LOPT_MSGQ_LOWTRMRK: { + ErlDrvSizeT low = ERL_DRV_BUSY_MSGQ_READ_ONLY; + *ptr++ = opt; + erl_drv_busy_msgq_limits(desc->port, &low, NULL); + ival = low > INT_MAX ? INT_MAX : (int) low; + put_int32(ival, ptr); continue; + } case INET_LOPT_TCP_SEND_TIMEOUT: if (desc->stype == SOCK_STREAM) { @@ -7471,6 +7461,20 @@ static void inet_stop(inet_descriptor* desc) FREE(desc); } +static void set_default_msgq_limits(ErlDrvPort port) +{ + ErlDrvSizeT q_high = INET_HIGH_MSGQ_WATERMARK; + ErlDrvSizeT q_low = INET_LOW_MSGQ_WATERMARK; + if (q_low < ERL_DRV_BUSY_MSGQ_LIM_MIN) + q_low = ERL_DRV_BUSY_MSGQ_LIM_MIN; + else if (q_low > ERL_DRV_BUSY_MSGQ_LIM_MAX) + q_low = ERL_DRV_BUSY_MSGQ_LIM_MAX; + if (q_high < ERL_DRV_BUSY_MSGQ_LIM_MIN) + q_high = ERL_DRV_BUSY_MSGQ_LIM_MIN; + else if (q_high > ERL_DRV_BUSY_MSGQ_LIM_MAX) + q_high = ERL_DRV_BUSY_MSGQ_LIM_MAX; + erl_drv_busy_msgq_limits(port, &q_low, &q_high); +} /* Allocate descriptor */ static ErlDrvData inet_start(ErlDrvPort port, int size, int protocol) @@ -8091,9 +8095,8 @@ static int tcp_inet_init(void) /* initialize the TCP descriptor */ -static ErlDrvData tcp_inet_start(ErlDrvPort port, char* args) +static ErlDrvData prep_tcp_inet_start(ErlDrvPort port, char* args) { - ErlDrvSizeT q_low, q_high; tcp_descriptor* desc; DEBUGF(("tcp_inet_start(%ld) {\r\n", (long)port)); @@ -8103,17 +8106,6 @@ static ErlDrvData tcp_inet_start(ErlDrvPort port, char* args) return ERL_DRV_ERROR_ERRNO; desc->high = INET_HIGH_WATERMARK; desc->low = INET_LOW_WATERMARK; - q_high = INET_HIGH_MSGQ_WATERMARK; - q_low = INET_LOW_MSGQ_WATERMARK; - if (q_low < ERL_DRV_BUSY_MSGQ_LIM_MIN) - q_low = ERL_DRV_BUSY_MSGQ_LIM_MIN; - else if (q_low > ERL_DRV_BUSY_MSGQ_LIM_MAX) - q_low = ERL_DRV_BUSY_MSGQ_LIM_MAX; - if (q_high < ERL_DRV_BUSY_MSGQ_LIM_MIN) - q_high = ERL_DRV_BUSY_MSGQ_LIM_MIN; - else if (q_high > ERL_DRV_BUSY_MSGQ_LIM_MAX) - q_high = ERL_DRV_BUSY_MSGQ_LIM_MAX; - erl_drv_busy_msgq_limits(port, &q_low, &q_high); desc->send_timeout = INET_INFINITY; desc->send_timeout_close = 0; desc->busy_on_send = 0; @@ -8130,6 +8122,12 @@ static ErlDrvData tcp_inet_start(ErlDrvPort port, char* args) return (ErlDrvData) desc; } +static ErlDrvData tcp_inet_start(ErlDrvPort port, char* args) +{ + ErlDrvData data = prep_tcp_inet_start(port, args); + set_default_msgq_limits(port); + return data; +} /* Copy a descriptor, by creating a new port with same settings * as the descriptor desc. * return NULL on error (SYSTEM_LIMIT no ports avail) @@ -8141,7 +8139,7 @@ static tcp_descriptor* tcp_inet_copy(tcp_descriptor* desc,SOCKET s, ErlDrvPort port = desc->inet.port; tcp_descriptor* copy_desc; - copy_desc = (tcp_descriptor*) tcp_inet_start(port, NULL); + copy_desc = (tcp_descriptor*) prep_tcp_inet_start(port, NULL); /* Setup event if needed */ if ((copy_desc->inet.s = s) != INVALID_SOCKET) { @@ -9864,12 +9862,15 @@ static int should_use_so_bsdcompat(void) * as the descriptor desc. * return NULL on error (ENFILE no ports avail) */ +static ErlDrvData packet_inet_start(ErlDrvPort port, char* args, int protocol); + static udp_descriptor* sctp_inet_copy(udp_descriptor* desc, SOCKET s, int* err) { + ErlDrvSizeT q_low, q_high; ErlDrvPort port = desc->inet.port; udp_descriptor* copy_desc; - copy_desc = (udp_descriptor*) sctp_inet_start(port, NULL); + copy_desc = (udp_descriptor*) packet_inet_start(port, NULL, IPPROTO_SCTP); /* Setup event if needed */ if ((copy_desc->inet.s = s) != INVALID_SOCKET) { @@ -9900,9 +9901,17 @@ static udp_descriptor* sctp_inet_copy(udp_descriptor* desc, SOCKET s, int* err) FREE(copy_desc); return NULL; } + + /* Read busy msgq limits of parent */ + q_low = q_high = ERL_DRV_BUSY_MSGQ_READ_ONLY; + erl_drv_busy_msgq_limits(desc->inet.port, &q_low, &q_high); + /* Write same busy msgq limits to child */ + erl_drv_busy_msgq_limits(port, &q_low, &q_high); + copy_desc->inet.port = port; copy_desc->inet.dport = driver_mk_port(port); *err = 0; + return copy_desc; } #endif @@ -9935,13 +9944,17 @@ static ErlDrvData packet_inet_start(ErlDrvPort port, char* args, int protocol) static ErlDrvData udp_inet_start(ErlDrvPort port, char *args) { - return packet_inet_start(port, args, IPPROTO_UDP); + ErlDrvData data = packet_inet_start(port, args, IPPROTO_UDP); + set_default_msgq_limits(port); + return data; } #ifdef HAVE_SCTP static ErlDrvData sctp_inet_start(ErlDrvPort port, char *args) { - return packet_inet_start(port, args, IPPROTO_SCTP); + ErlDrvData data = packet_inet_start(port, args, IPPROTO_SCTP); + set_default_msgq_limits(port); + return data; } #endif diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index bedb5ef784..1e436830e7 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -42,6 +42,9 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*); #include <locale.h> #include <unistd.h> #include <termios.h> +#ifdef HAVE_WCWIDTH +#include <wchar.h> +#endif #ifdef HAVE_FCNTL_H #include <fcntl.h> #endif @@ -95,6 +98,9 @@ static int lpos; /* The current "cursor position" in the line buf */ #define CONTROL_TAG 0x10000000U /* Control character, value in first position */ #define ESCAPED_TAG 0x01000000U /* Escaped character, value in first position */ +#ifdef HAVE_WCWIDTH +#define WIDE_TAG 0x02000000U /* Wide character, value in first position */ +#endif #define TAG_MASK 0xFF000000U #define MAXSIZE (1 << 16) @@ -597,12 +603,20 @@ static int check_buf_size(byte *s, int n) } if (utf8_mode) { /* That is, terminal is UTF8 compliant */ if (ch >= 128 || isprint(ch)) { - DEBUGLOG(("Printable(UTF-8:%d):%d",(pos - opos),ch)); - size++; /* Buffer contains wide characters... */ +#ifdef HAVE_WCWIDTH + int width; +#endif + DEBUGLOG(("Printable(UTF-8:%d):%d",pos,ch)); + size++; +#ifdef HAVE_WCWIDTH + if ((width = wcwidth(ch)) > 1) { + size += width - 1; + } +#endif } else if (ch == '\t') { size += 8; } else { - DEBUGLOG(("Magic(UTF-8:%d):%d",(pos - opos),ch)); + DEBUGLOG(("Magic(UTF-8:%d):%d",pos,ch)); size += 2; } } else { @@ -868,12 +882,22 @@ static int step_over_chars(int n) end = lbuf + llen; c = lbuf + lpos; for ( ; n > 0 && c < end; --n) { +#ifdef HAVE_WCWIDTH + while (*c & WIDE_TAG) { + c++; + } +#endif c++; while (c < end && (*c & TAG_MASK) && ((*c & ~TAG_MASK) == 0)) c++; } for ( ; n < 0 && c > beg; n++) { --c; +#ifdef HAVE_WCWIDTH + while (c > beg + 1 && (c[-1] & WIDE_TAG)) { + --c; + } +#endif while (c > beg && (*c & TAG_MASK) && ((*c & ~TAG_MASK) == 0)) --c; } @@ -899,6 +923,15 @@ static int insert_buf(byte *s, int n) ++pos; } if ((utf8_mode && (ch >= 128 || isprint(ch))) || (ch <= 255 && isprint(ch))) { +#ifdef HAVE_WCWIDTH + int width; + if ((width = wcwidth(ch)) > 1) { + while (--width) { + DEBUGLOG(("insert_buf: Wide(UTF-8):%d,%d",width,ch)); + lbuf[lpos++] = (WIDE_TAG | ((Uint32) ch)); + } + } +#endif DEBUGLOG(("insert_buf: Printable(UTF-8):%d",ch)); lbuf[lpos++] = (Uint32) ch; } else if (ch >= 128) { /* not utf8 mode */ @@ -1006,6 +1039,10 @@ static int write_buf(Uint32 *s, int n) if (octbuff != octtmp) { driver_free(octbuff); } +#ifdef HAVE_WCWIDTH + } else if (*s & WIDE_TAG) { + --n; s++; +#endif } else { DEBUGLOG(("Very unexpected character %d",(int) *s)); ++n; diff --git a/erts/emulator/drivers/win32/ttsl_drv.c b/erts/emulator/drivers/win32/ttsl_drv.c index 1a74d21e99..8b5e3eeefd 100644 --- a/erts/emulator/drivers/win32/ttsl_drv.c +++ b/erts/emulator/drivers/win32/ttsl_drv.c @@ -414,12 +414,12 @@ static int check_buf_size(byte *s, int n) } if (utf8_mode) { /* That is, terminal is UTF8 compliant */ if (ch >= 128 || isprint(ch)) { - DEBUGLOG(("Printable(UTF-8:%d):%d",(pos - opos),ch)); + DEBUGLOG(("Printable(UTF-8:%d):%d",pos,ch)); size++; /* Buffer contains wide characters... */ } else if (ch == '\t') { size += 8; } else { - DEBUGLOG(("Magic(UTF-8:%d):%d",(pos - opos),ch)); + DEBUGLOG(("Magic(UTF-8:%d):%d",pos,ch)); size += 2; } } else { diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c index 64c0e0da3e..19fc448742 100644 --- a/erts/emulator/hipe/hipe_x86_signal.c +++ b/erts/emulator/hipe/hipe_x86_signal.c @@ -183,6 +183,7 @@ static void do_init(void) #include <dlfcn.h> static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); #define init_done() (__next_sigaction != 0) +extern int _sigaction(int, const struct sigaction*, struct sigaction*); #define __SIGACTION _sigaction static void do_init(void) { 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/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index b6e2c9382b..2748edba02 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -1749,45 +1749,42 @@ erts_mseg_late_init(void) #endif /* #if HAVE_ERTS_MSEG */ -unsigned long -erts_mseg_test(unsigned long op, - unsigned long a1, - unsigned long a2, - unsigned long a3) +UWord +erts_mseg_test(UWord op, UWord a1, UWord a2, UWord a3) { switch (op) { #if HAVE_ERTS_MSEG case 0x400: /* Have erts_mseg */ - return (unsigned long) 1; + return (UWord) 1; case 0x401: - return (unsigned long) erts_mseg_alloc(ERTS_ALC_A_INVALID, (Uint *) a1, (Uint) 0); + return (UWord) erts_mseg_alloc(ERTS_ALC_A_INVALID, (Uint *) a1, (Uint) 0); case 0x402: erts_mseg_dealloc(ERTS_ALC_A_INVALID, (void *) a1, (Uint) a2, (Uint) 0); - return (unsigned long) 0; + return (UWord) 0; case 0x403: - return (unsigned long) erts_mseg_realloc(ERTS_ALC_A_INVALID, + return (UWord) erts_mseg_realloc(ERTS_ALC_A_INVALID, (void *) a1, (Uint) a2, (Uint *) a3, (Uint) 0); case 0x404: erts_mseg_clear_cache(); - return (unsigned long) 0; + return (UWord) 0; case 0x405: - return (unsigned long) erts_mseg_no(&erts_mseg_default_opt); + return (UWord) erts_mseg_no(&erts_mseg_default_opt); case 0x406: { ErtsMsegAllctr_t *ma = ERTS_MSEG_ALLCTR_IX(0); - unsigned long res; + UWord res; ERTS_MSEG_LOCK(ma); - res = (unsigned long) tot_cache_size(ma); + res = (UWord) tot_cache_size(ma); ERTS_MSEG_UNLOCK(ma); return res; } #else /* #if HAVE_ERTS_MSEG */ case 0x400: /* Have erts_mseg */ - return (unsigned long) 0; + return (UWord) 0; #endif /* #if HAVE_ERTS_MSEG */ - default: ASSERT(0); return ~((unsigned long) 0); + default: ASSERT(0); return ~((UWord) 0); } } diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h index 3cab9e18da..a4f250ceab 100644 --- a/erts/emulator/sys/common/erl_mseg.h +++ b/erts/emulator/sys/common/erl_mseg.h @@ -109,9 +109,6 @@ Eterm erts_mseg_info(int, int *, void*, int, Uint **, Uint *); #endif /* #if HAVE_ERTS_MSEG */ -unsigned long erts_mseg_test(unsigned long, - unsigned long, - unsigned long, - unsigned long); +UWord erts_mseg_test(UWord, UWord, UWord, UWord); #endif /* #ifndef ERL_MSEG_H_ */ diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index 787f8d6728..689be98969 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -832,6 +832,8 @@ sys_chars_to_double(char* buf, double* fp) return 0; } +#ifdef USE_MATHERR + int matherr(struct exception *exc) { @@ -842,3 +844,5 @@ matherr(struct exception *exc) #endif return 1; } + +#endif diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index e0422de026..922967c698 100755 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -399,11 +399,12 @@ int* pBuild; /* Pointer to build number. */ * Definitions for driver flags. */ -#define DF_OVR_READY 1 /* Overlapped result is ready. */ -#define DF_EXIT_THREAD 2 /* The thread should exit. */ -#define DF_XLAT_CR 4 /* The thread should translate CRs. */ -#define DF_DROP_IF_INVH 8 /* Drop packages instead of crash if +#define DF_OVR_READY 1 /* Overlapped result is ready. */ +#define DF_EXIT_THREAD 2 /* The thread should exit. */ +#define DF_XLAT_CR 4 /* The thread should translate CRs. */ +#define DF_DROP_IF_INVH 8 /* Drop packages instead of crash if invalid handle (stderr) */ +#define DF_THREAD_FLUSHED 16 /* The thread should exit. */ #define OV_BUFFER_PTR(dp) ((LPVOID) ((dp)->ov.Internal)) #define OV_NUM_TO_READ(dp) ((dp)->ov.InternalHigh) @@ -2141,8 +2142,9 @@ threaded_writer(LPVOID param) for (;;) { handle = WaitForMultipleObjects(2, handles, FALSE, INFINITE); - if (aio->flags & DF_EXIT_THREAD) + if (aio->flags & DF_EXIT_THREAD) { break; + } buf = OV_BUFFER_PTR(aio); numToWrite = OV_NUM_TO_READ(aio); @@ -2150,6 +2152,7 @@ threaded_writer(LPVOID param) if (handle == (WAIT_OBJECT_0 + 1) && numToWrite == 0) { SetEvent(aio->flushReplyEvent); + aio->flags |= DF_THREAD_FLUSHED; continue; } @@ -2197,6 +2200,7 @@ threaded_writer(LPVOID param) if (aio->flags & DF_EXIT_THREAD) break; } + aio->flags |= DF_THREAD_FLUSHED; CloseHandle(aio->fd); aio->fd = INVALID_HANDLE_VALUE; unrefer_driver_data(aio->dp); @@ -2340,9 +2344,11 @@ static void fd_stop(ErlDrvData data) (void) driver_select(dp->port_num, (ErlDrvEvent)dp->out.ov.hEvent, ERL_DRV_WRITE, 0); - ASSERT(dp->out.flushEvent); - SetEvent(dp->out.flushEvent); - WaitForSingleObject(dp->out.flushReplyEvent, INFINITE); + do { + ASSERT(dp->out.flushEvent); + SetEvent(dp->out.flushEvent); + } while (WaitForSingleObject(dp->out.flushReplyEvent, 10) == WAIT_TIMEOUT + || !(dp->out.flags & DF_THREAD_FLUSHED)); } } @@ -2433,12 +2439,12 @@ threaded_exiter(LPVOID param) */ i = 0; if (dp->out.thread != (HANDLE) -1) { - dp->out.flags = DF_EXIT_THREAD; + dp->out.flags |= DF_EXIT_THREAD; SetEvent(dp->out.ioAllowed); handles[i++] = dp->out.thread; } if (dp->in.thread != (HANDLE) -1) { - dp->in.flags = DF_EXIT_THREAD; + dp->in.flags |= DF_EXIT_THREAD; SetEvent(dp->in.ioAllowed); handles[i++] = dp->in.thread; } diff --git a/erts/emulator/sys/win32/sys_float.c b/erts/emulator/sys/win32/sys_float.c index fb1ffc3089..0e19746cf5 100644 --- a/erts/emulator/sys/win32/sys_float.c +++ b/erts/emulator/sys/win32/sys_float.c @@ -52,7 +52,7 @@ void erts_thread_disable_fpe(void) int sys_chars_to_double(char *buf, double *fp) { - char *s = buf, *t, *dp; + unsigned char *s = buf, *t, *dp; /* Robert says that something like this is what he really wanted: * (The [.,] radix test is NOT what Robert wanted - it was added later) @@ -120,7 +120,7 @@ sys_chars_to_double(char *buf, double *fp) int sys_double_to_chars_ext(double fp, char *buffer, size_t buffer_size, size_t decimals) { - char *s = buffer; + unsigned char *s = buffer; if (erts_snprintf(buffer, buffer_size, "%.*e", decimals, fp) >= buffer_size) return -1; @@ -133,6 +133,8 @@ sys_double_to_chars_ext(double fp, char *buffer, size_t buffer_size, size_t deci return s-buffer; /* i.e strlen(buffer) */ } +#ifdef USE_MATHERR + int matherr(struct _exception *exc) { @@ -141,6 +143,8 @@ matherr(struct _exception *exc) return 1; } +#endif + static void fpe_exception(int sig) { diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c index 2f2dfc8197..f7f0161b58 100644 --- a/erts/emulator/sys/win32/sys_time.c +++ b/erts/emulator/sys/win32/sys_time.c @@ -63,6 +63,8 @@ static SysHrTime wrap = 0; static DWORD last_tick_count = 0; +static erts_smp_mtx_t wrap_lock; +static ULONGLONG (WINAPI *pGetTickCount64)(void) = NULL; /* Getting timezone information is a heavy operation, so we want to do this only once */ @@ -77,11 +79,23 @@ static int days_in_month[2][13] = { int sys_init_time(void) { + char kernel_dll_name[] = "kernel32"; + HMODULE module; + + module = GetModuleHandle(kernel_dll_name); + pGetTickCount64 = (module != NULL) ? + (ULONGLONG (WINAPI *)(void)) + GetProcAddress(module,"GetTickCount64") : + NULL; + if(GetTimeZoneInformation(&static_tzi) && static_tzi.StandardDate.wMonth != 0 && static_tzi.DaylightDate.wMonth != 0) { have_static_tzi = 1; } + + erts_smp_mtx_init(&wrap_lock, "sys_gethrtime"); + return 1; } @@ -363,15 +377,39 @@ sys_gettimeofday(SysTimeval *tv) EPOCH_JULIAN_DIFF); } +extern int erts_initialized; SysHrTime sys_gethrtime(void) { - DWORD ticks = (SysHrTime) (GetTickCount() & 0x7FFFFFFF); - if (ticks < (SysHrTime) last_tick_count) { - wrap += LL_LITERAL(1) << 31; + if (pGetTickCount64 != NULL) { + return ((SysHrTime) pGetTickCount64()) * LL_LITERAL(1000000); + } else { + DWORD ticks; + SysHrTime res; + erts_smp_mtx_lock(&wrap_lock); + ticks = (SysHrTime) (GetTickCount() & 0x7FFFFFFF); + if (ticks < (SysHrTime) last_tick_count) { + /* Detect a race that should no longer be here... */ + if ((((SysHrTime) last_tick_count) - ((SysHrTime) ticks)) > 1000) { + wrap += LL_LITERAL(1) << 31; + } else { + /* + * XXX Debug: Violates locking order, remove all this, + * after testing! + */ + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "Did not wrap when last_tick %d " + "and tick %d", + last_tick_count, ticks); + erts_send_error_to_logger_nogl(dsbufp); + ticks = last_tick_count; + } + } + last_tick_count = ticks; + res = ((((LONGLONG) ticks) + wrap) * LL_LITERAL(1000000)); + erts_smp_mtx_unlock(&wrap_lock); + return res; } - last_tick_count = ticks; - return ((((LONGLONG) ticks) + wrap) * LL_LITERAL(1000000)); } clock_t 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/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl index 2c63296b83..4b4af0babe 100644 --- a/erts/emulator/test/busy_port_SUITE.erl +++ b/erts/emulator/test/busy_port_SUITE.erl @@ -170,6 +170,7 @@ send_3(Config) when is_list(Config) -> ?line {Owner,Slave} = get_slave(), ?line ok = erlang:send(Slave, {Owner,{command,"set busy"}}, [nosuspend]), + receive after 100 -> ok end, % ensure command reached port ?line nosuspend = erlang:send(Slave, {Owner,{command,"busy"}}, [nosuspend]), ?line unlock_slave(), @@ -563,6 +564,7 @@ scheduling_delay_busy_nosuspend(Config) -> {2,{call,[{var,1},open_port]}}, {0,{cast,[{var,1},{command,1,100}]}}, {0,{cast,[{var,1},{busy,2}]}}, + {0,{timer,sleep,[200]}}, % ensure reached port {10,{call,[{var,1},{command,3,[nosuspend]}]}}, {0,{timer,sleep,[200]}}, {0,{erlang,port_command,[{var,2},<<$N>>,[force]]}}, 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/driver_SUITE_data/thr_alloc_drv.c b/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c index 95a6ae9bdf..500725a7cd 100644 --- a/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c +++ b/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c @@ -58,7 +58,7 @@ void * test_thread(void *vsize) { int i; - int size = (int) (long) vsize; + int size = (int) (ErlDrvSInt) vsize; void *mem; mem = driver_alloc(size); if (mem) @@ -88,7 +88,7 @@ ErlDrvSSizeT control(ErlDrvData drv_data, unsigned int command, char *buf, res = erl_drv_thread_create("test_thread", &tid, test_thread, - (void *) (long) size, + (void *) (ErlDrvSInt) size, NULL); if (res == 0) { res = erl_drv_thread_join(tid, NULL); 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/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index c8f286f629..0c4a9f7e5c 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -40,7 +40,7 @@ typedef struct int ref_cnt; CallInfo* call_history; NifModPrivData* nif_mod; - union { ErlNifResourceType* t; long l; } rt_arr[2]; + union { ErlNifResourceType* t; void* vp; } rt_arr[2]; } PrivData; /* @@ -93,6 +93,23 @@ struct binary_resource { unsigned size; }; +static int get_pointer(ErlNifEnv* env, ERL_NIF_TERM term, void** pp) +{ + ErlNifUInt64 i64; + int r = enif_get_uint64(env, term, &i64); + if (r) { + *pp = (void*)i64; + } + return r; +} + +static ERL_NIF_TERM make_pointer(ErlNifEnv* env, void* p) +{ + ErlNifUInt64 i64 = (ErlNifUInt64) p; + return enif_make_uint64(env, i64); +} + + static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) { PrivData* data = enif_alloc(sizeof(PrivData)); @@ -224,15 +241,15 @@ static ERL_NIF_TERM call_history(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar static ERL_NIF_TERM hold_nif_mod_priv_data(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { PrivData* data = (PrivData*) enif_priv_data(env); - unsigned long ptr_as_ulong; + void* ptr; - if (!enif_get_ulong(env,argv[0],&ptr_as_ulong)) { + if (!get_pointer(env,argv[0],&ptr)) { return enif_make_badarg(env); } if (data->nif_mod != NULL) { NifModPrivData_release(data->nif_mod); } - data->nif_mod = (NifModPrivData*) ptr_as_ulong; + data->nif_mod = (NifModPrivData*) ptr; return enif_make_int(env,++(data->nif_mod->ref_cnt)); } @@ -696,7 +713,7 @@ static ERL_NIF_TERM last_resource_dtor_call(ErlNifEnv* env, int argc, const ERL_ memcpy(enif_make_new_binary(env, resource_dtor_last_sz, &bin), resource_dtor_last_data, resource_dtor_last_sz); ret = enif_make_tuple3(env, - enif_make_long(env, (long)resource_dtor_last), + make_pointer(env, resource_dtor_last), bin, enif_make_int(env, resource_dtor_cnt)); } @@ -717,40 +734,40 @@ static ERL_NIF_TERM get_resource_type(ErlNifEnv* env, int argc, const ERL_NIF_TE if (!enif_get_int(env, argv[0], &ix) || ix >= 2) { return enif_make_badarg(env); } - return enif_make_long(env, data->rt_arr[ix].l); + return make_pointer(env, data->rt_arr[ix].vp); } static ERL_NIF_TERM alloc_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ErlNifBinary data_bin; - union { ErlNifResourceType* t; long l; } type; - union { void* p; long l;} data; - if (!enif_get_long(env, argv[0], &type.l) + union { ErlNifResourceType* t; void* vp; } type; + void* data; + if (!get_pointer(env, argv[0], &type.vp) || !enif_inspect_binary(env, argv[1], &data_bin) - || (data.p = enif_alloc_resource(type.t, data_bin.size))==NULL) { + || (data = enif_alloc_resource(type.t, data_bin.size))==NULL) { return enif_make_badarg(env); } - memcpy(data.p, data_bin.data, data_bin.size); - return enif_make_long(env, data.l); + memcpy(data, data_bin.data, data_bin.size); + return make_pointer(env, data); } static ERL_NIF_TERM make_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - union { void* p; long l; } data; - if (!enif_get_long(env, argv[0], &data.l)) { + void* data; + if (!get_pointer(env, argv[0], &data)) { return enif_make_badarg(env); } - return enif_make_resource(env, data.p); + return enif_make_resource(env, data); } static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ErlNifBinary data_bin; - union { ErlNifResourceType* t; long l; } type; + union { ErlNifResourceType* t; void* vp; } type; void* data; ERL_NIF_TERM ret; - if (!enif_get_long(env, argv[0], &type.l) + if (!get_pointer(env, argv[0], &type.vp) || !enif_inspect_binary(env, argv[1], &data_bin) || (data = enif_alloc_resource(type.t, data_bin.size))==NULL) { @@ -765,7 +782,7 @@ static ERL_NIF_TERM make_new_resource(ErlNifEnv* env, int argc, const ERL_NIF_TE static ERL_NIF_TERM make_new_resource_binary(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ErlNifBinary data_bin; - union { struct binary_resource* p; void* vp; long l; } br; + union { struct binary_resource* p; void* vp; } br; void* buf; ERL_NIF_TERM ret; if (!enif_inspect_binary(env, argv[0], &data_bin) @@ -781,7 +798,7 @@ static ERL_NIF_TERM make_new_resource_binary(ErlNifEnv* env, int argc, const ERL memcpy(br.p->data, data_bin.data, data_bin.size); ret = enif_make_resource_binary(env, br.vp, br.p->data, br.p->size); enif_release_resource(br.p); - return enif_make_tuple2(env, enif_make_long(env,br.l), ret); + return enif_make_tuple2(env, make_pointer(env,br.vp), ret); } static void binary_resource_dtor(ErlNifEnv* env, void* obj) @@ -796,33 +813,33 @@ static void binary_resource_dtor(ErlNifEnv* env, void* obj) static ERL_NIF_TERM get_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ErlNifBinary data_bin; - union { ErlNifResourceType* t; long l; } type; - union { void* p; long l; } data; + union { ErlNifResourceType* t; void* vp; } type; + void* data; type.t = NULL; if (enif_is_identical(argv[0], atom_binary_resource_type)) { type.t = binary_resource_type; } else { - enif_get_long(env, argv[0], &type.l); + get_pointer(env, argv[0], &type.vp); } if (type.t == NULL - || !enif_get_resource(env, argv[1], type.t, &data.p)) { + || !enif_get_resource(env, argv[1], type.t, &data)) { return enif_make_badarg(env); } - enif_alloc_binary(enif_sizeof_resource(data.p), &data_bin); - memcpy(data_bin.data, data.p, data_bin.size); - return enif_make_tuple2(env, enif_make_long(env,data.l), + enif_alloc_binary(enif_sizeof_resource(data), &data_bin); + memcpy(data_bin.data, data, data_bin.size); + return enif_make_tuple2(env, make_pointer(env,data), enif_make_binary(env, &data_bin)); } static ERL_NIF_TERM release_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - union { void* p; long l; } data; - if (!enif_get_long(env, argv[0], &data.l)) { + void* data; + if (!get_pointer(env, argv[0], &data)) { return enif_make_badarg(env); } - enif_release_resource(data.p); + enif_release_resource(data); return enif_make_atom(env,"ok"); } 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 cc7d77fd9a..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 @@ -171,8 +173,17 @@ while [ $# -gt 0 ]; do cargs="$cargs -debug" TYPE=.debug ;; + "-frmptr") + shift + cargs="$cargs -frmptr" + TYPE=.frmptr + ;; "-gdb") shift + GDB=egdb + ;; + "-rgdb") + shift GDB=gdb ;; "-break") @@ -183,6 +194,12 @@ while [ $# -gt 0 ]; do ;; "-core") shift + GDB=egdb + core="$1" + shift + ;; + "-rcore") + shift GDB=gdb core="$1" shift @@ -280,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/lib_src/Makefile.in b/erts/lib_src/Makefile.in index 0fc3ac6efc..4f0a5e5202 100644 --- a/erts/lib_src/Makefile.in +++ b/erts/lib_src/Makefile.in @@ -86,6 +86,12 @@ CFLAGS += -DERTS_ENABLE_LOCK_COUNT OMIT_FP=true PRE_LD= else +ifeq ($(TYPE),frmptr) +TYPE_SUFFIX = .frmptr +CFLAGS += -DERTS_FRMPTR +OMIT_OMIT_FP=yes +PRE_LD= +else override TYPE=opt OMIT_FP=true TYPE_SUFFIX= @@ -98,6 +104,7 @@ endif endif endif endif +endif OPSYS=@OPSYS@ sol2CFLAGS= @@ -110,6 +117,7 @@ ultrasparcCFLAGS=-Wa,-xarch=v8plusa ARCHCFLAGS=$($(ARCH)CFLAGS) ifeq ($(OMIT_OMIT_FP),yes) +CFLAGS += -fno-omit-frame-pointer OMIT_FP=false endif diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 29fb8aaebf..947fbe7c24 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam Binary files differindex c907ead38a..1b47509a53 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.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/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 7b9da42e4f..a0a4314128 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.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 647da77881..a93194d0bc 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]). @@ -2087,7 +2088,7 @@ tuple_to_list(_Tuple) -> ({allocator_sizes, Alloc}) -> [_] when %% More or less anything Alloc :: atom(); (build_type) -> opt | debug | purify | quantify | purecov | - gcov | valgrind | gprof | lcnt; + gcov | valgrind | gprof | lcnt | frmptr; (c_compiler_used) -> {atom(), term()}; (check_io) -> [_]; (compat_rel) -> integer(); @@ -2706,26 +2707,14 @@ port_info(Port, Item) -> Port :: port() | atom(), Data :: term(). -port_set_data(Port, Data) -> - case case erts_internal:port_set_data(Port, Data) of - Ref when erlang:is_reference(Ref) -> receive {Ref, Res} -> Res end; - Res -> Res - end of - badarg -> erlang:error(badarg, [Port, Data]); - Result -> Result - end. +port_set_data(_Port, _Data) -> + erlang:nif_error(undefined). -spec erlang:port_get_data(Port) -> term() when Port :: port() | atom(). -port_get_data(Port) -> - case case erts_internal:port_get_data(Port) of - Ref when erlang:is_reference(Ref) -> receive {Ref, Res} -> Res end; - Res -> Res - end of - {ok, Data} -> Data; - Error -> erlang:error(Error, [Port]) - end. +port_get_data(_Port) -> + erlang:nif_error(undefined). %% %% If the emulator wants to perform a distributed command and @@ -3126,8 +3115,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)). @@ -3294,12 +3283,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); @@ -3318,6 +3311,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) -> @@ -3369,13 +3365,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, @@ -3393,7 +3397,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) -> @@ -3549,3 +3553,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/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index f1c83f4518..507bc3afb9 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -31,8 +31,7 @@ -export([await_port_send_result/3]). -export([port_command/3, port_connect/2, port_close/1, - port_control/3, port_call/3, port_set_data/2, port_get_data/1, - port_info/1, port_info/2]). + port_control/3, port_call/3, port_info/1, port_info/2]). %% %% Await result of send to port @@ -86,19 +85,6 @@ port_control(_Port, _Operation, _Data) -> port_call(_Port, _Operation, _Data) -> erlang:nif_error(undefined). --spec erts_internal:port_get_data(P1) -> Result when - P1 :: port() | atom(), - Result :: {ok, term()} | reference() | badarg. -port_get_data(_P1) -> - erlang:nif_error(undefined). - --spec erts_internal:port_set_data(P1, P2) -> Result when - P1 :: port() | atom(), - P2 :: term(), - Result :: true | reference() | badarg. -port_set_data(_P1, _P2) -> - erlang:nif_error(undefined). - -type port_info_1_result_item() :: {registered_name, RegName :: atom()} | {id, Index :: non_neg_integer()} | 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/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl index 21d23159f0..36a650cb5c 100644 --- a/erts/preloaded/src/prim_inet.erl +++ b/erts/preloaded/src/prim_inet.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2012. All Rights Reserved. +%% Copyright Ericsson AB 2000-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 @@ -151,30 +151,35 @@ shutdown_pend_loop(S, N0) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% close(S) when is_port(S) -> - unlink(S), %% avoid getting {'EXIT', S, Reason} case subscribe(S, [subs_empty_out_q]) of {ok, [{subs_empty_out_q,N}]} when N > 0 -> close_pend_loop(S, N); %% wait for pending output to be sent _ -> - catch erlang:port_close(S), - ok + close_port(S) end. close_pend_loop(S, N) -> receive {empty_out_q,S} -> - catch erlang:port_close(S), ok + close_port(S) after ?INET_CLOSE_TIMEOUT -> case getstat(S, [send_pend]) of {ok, [{send_pend,N1}]} -> - if N1 =:= N -> catch erlang:port_close(S), ok; - true -> close_pend_loop(S, N1) + if + N1 =:= N -> + close_port(S); + true -> + close_pend_loop(S, N1) end; _ -> - catch erlang:port_close(S), ok + close_port(S) end end. - + +close_port(S) -> + catch erlang:port_close(S), + receive {'EXIT',S,_} -> ok after 0 -> ok end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% BIND(insock(), IP, Port) -> {ok, integer()} | {error, Reason} @@ -1072,8 +1077,8 @@ enc_opt(deliver) -> ?INET_LOPT_DELIVER; enc_opt(exit_on_close) -> ?INET_LOPT_EXITONCLOSE; enc_opt(high_watermark) -> ?INET_LOPT_TCP_HIWTRMRK; enc_opt(low_watermark) -> ?INET_LOPT_TCP_LOWTRMRK; -enc_opt(high_msgq_watermark) -> ?INET_LOPT_TCP_MSGQ_HIWTRMRK; -enc_opt(low_msgq_watermark) -> ?INET_LOPT_TCP_MSGQ_LOWTRMRK; +enc_opt(high_msgq_watermark) -> ?INET_LOPT_MSGQ_HIWTRMRK; +enc_opt(low_msgq_watermark) -> ?INET_LOPT_MSGQ_LOWTRMRK; enc_opt(send_timeout) -> ?INET_LOPT_TCP_SEND_TIMEOUT; enc_opt(send_timeout_close) -> ?INET_LOPT_TCP_SEND_TIMEOUT_CLOSE; enc_opt(delay_send) -> ?INET_LOPT_TCP_DELAY_SEND; @@ -1128,8 +1133,8 @@ dec_opt(?INET_LOPT_DELIVER) -> deliver; dec_opt(?INET_LOPT_EXITONCLOSE) -> exit_on_close; dec_opt(?INET_LOPT_TCP_HIWTRMRK) -> high_watermark; dec_opt(?INET_LOPT_TCP_LOWTRMRK) -> low_watermark; -dec_opt(?INET_LOPT_TCP_MSGQ_HIWTRMRK) -> high_msgq_watermark; -dec_opt(?INET_LOPT_TCP_MSGQ_LOWTRMRK) -> low_msgq_watermark; +dec_opt(?INET_LOPT_MSGQ_HIWTRMRK) -> high_msgq_watermark; +dec_opt(?INET_LOPT_MSGQ_LOWTRMRK) -> low_msgq_watermark; dec_opt(?INET_LOPT_TCP_SEND_TIMEOUT) -> send_timeout; dec_opt(?INET_LOPT_TCP_SEND_TIMEOUT_CLOSE) -> send_timeout_close; dec_opt(?INET_LOPT_TCP_DELAY_SEND) -> delay_send; 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/Makefile b/lib/asn1/src/Makefile index 9607799401..33cd3cc4c3 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -134,10 +134,10 @@ $(EBIN)/asn1ct.$(EMULATOR):asn1ct.erl $(V_ERLC) -b$(EMULATOR) -o$(EBIN) $(ERL_COMPILE_FLAGS) -Dvsn=\"$(VSN)\" $< $(EBIN)/asn1ct_func.$(EMULATOR): asn1ct_func.erl - $(ERLC) -o$(EBIN) $(ERL_COMPILE_FLAGS) -I../rt_templates $< + $(V_ERLC) -o$(EBIN) $(ERL_COMPILE_FLAGS) -I../rt_templates $< asn1ct_eval_%.erl: asn1ct_eval_%.funcs - erl -pa $(EBIN) -noshell -noinput \ + $(gen_verbose)erl -pa $(EBIN) -noshell -noinput \ -run prepare_templates gen_asn1ct_eval $< >$@ $(APP_TARGET): $(APP_SRC) ../vsn.mk @@ -182,14 +182,14 @@ RT_TEMPLATES_ERL = $(RT_TEMPLATES:%=%.erl) RT_TEMPLATES_TARGET = $(RT_TEMPLATES:%=%.$(EMULATOR)) asn1ct_rtt.erl: prepare_templates.$(EMULATOR) $(RT_TEMPLATES_TARGET) - erl -noshell -noinput -run prepare_templates gen_asn1ct_rtt \ + $(gen_verbose)erl -noshell -noinput -run prepare_templates gen_asn1ct_rtt \ $(RT_TEMPLATES_TARGET) >asn1ct_rtt.erl prepare_templates.$(EMULATOR): prepare_templates.erl - erlc prepare_templates.erl + $(V_ERLC) prepare_templates.erl asn1rtt_%.$(EMULATOR): asn1rtt_%.erl - erlc +debug_info $< + $(V_ERLC) +debug_info $< $(EVAL_CT_MODULES:%=%.erl): prepare_templates.$(EMULATOR) \ $(EBIN)/asn1ct_rtt.$(EMULATOR) 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 c35cbd3c08..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',_='_'}, [], @@ -599,7 +576,7 @@ encrypt_config_file(SrcFileName, EncryptFileName, {file,KeyFile}) -> encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) -> crypto:start(), - {K1,K2,K3,IVec} = make_crypto_key(Key), + {Key,IVec} = make_crypto_key(Key), case file:read_file(SrcFileName) of {ok,Bin0} -> Bin1 = term_to_binary({SrcFileName,Bin0}), @@ -607,7 +584,7 @@ encrypt_config_file(SrcFileName, EncryptFileName, {key,Key}) -> 0 -> Bin1; N -> list_to_binary([Bin1,random_bytes(8-N)]) end, - EncBin = crypto:des3_cbc_encrypt(K1, K2, K3, IVec, Bin2), + EncBin = crypto:block_encrypt(des3_cbc, Key, IVec, Bin2), case file:write_file(EncryptFileName, EncBin) of ok -> io:format("~ts --(encrypt)--> ~ts~n", @@ -638,10 +615,10 @@ decrypt_config_file(EncryptFileName, TargetFileName, {file,KeyFile}) -> decrypt_config_file(EncryptFileName, TargetFileName, {key,Key}) -> crypto:start(), - {K1,K2,K3,IVec} = make_crypto_key(Key), + {Key,IVec} = make_crypto_key(Key), case file:read_file(EncryptFileName) of {ok,Bin} -> - DecBin = crypto:des3_cbc_decrypt(K1, K2, K3, IVec, Bin), + DecBin = crypto:block_decrypt(des3_cbc, Key, IVec, Bin), case catch binary_to_term(DecBin) of {'EXIT',_} -> {error,bad_file}; @@ -713,7 +690,7 @@ get_crypt_key_from_file() -> make_crypto_key(String) -> <<K1:8/binary,K2:8/binary>> = First = erlang:md5(String), <<K3:8/binary,IVec:8/binary>> = erlang:md5([First|lists:reverse(String)]), - {K1,K2,K3,IVec}. + {[K1,K2,K3],IVec}. random_bytes(N) -> {A,B,C} = now(), 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 bd74991859..4092d33bc0 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -29,9 +29,7 @@ %%% Command timeout = 10 sec (time to wait for a command to return) %%% Max no of reconnection attempts = 3 %%% Reconnection interval = 5 sek (time to wait in between reconnection attempts) -%%% Keep alive = true (will send NOP to the server every 10 sec if connection is idle) -%%% Wait for linebreak = true (Will expect answer from server to end with linebreak when -%%% using ct_telnet:expect)</pre> +%%% Keep alive = true (will send NOP to the server every 10 sec if connection is idle)</pre> %%% <p>These parameters can be altered by the user with the following %%% configuration term:</p> %%% <pre> @@ -39,8 +37,7 @@ %%% {command_timeout,Millisec}, %%% {reconnection_attempts,N}, %%% {reconnection_interval,Millisec}, -%%% {keep_alive,Bool}, -%% {wait_for_linebreak, Bool}]}.</pre> +%%% {keep_alive,Bool}]}.</pre> %%% <p><code>Millisec = integer(), N = integer()</code></p> %%% <p>Enter the <code>telnet_settings</code> term in a configuration %%% file included in the test and ct_telnet will retrieve the information @@ -186,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. @@ -312,7 +310,7 @@ expect(Connection,Patterns) -> %%% Tag = term() %%% Opts = [Opt] %%% Opt = {timeout,Timeout} | repeat | {repeat,N} | sequence | -%%% {halt,HaltPatterns} | ignore_prompt +%%% {halt,HaltPatterns} | ignore_prompt | no_prompt_check %%% Timeout = integer() %%% N = integer() %%% HaltPatterns = Patterns @@ -339,14 +337,28 @@ expect(Connection,Patterns) -> %%% will also include the matched <code>Tag</code>. Else, only %%% <code>RxMatch</code> is returned.</p> %%% -%%% <p>The function will always return when a prompt is found, unless -%%% the <code>ignore_prompt</code> options is used.</p> -%%% %%% <p>The <code>timeout</code> option indicates that the function %%% shall return if the telnet client is idle (i.e. if no data is %%% received) for more than <code>Timeout</code> milliseconds. Default %%% timeout is 10 seconds.</p> %%% +%%% <p>The function will always return when a prompt is found, unless +%%% any of the <code>ignore_prompt</code> or +%%% <code>no_prompt_check</code> options are used, in which case it +%%% will return when a match is found or after a timeout.</p> +%%% +%%% <p>If the <code>ignore_prompt</code> option is used, +%%% <code>ct_telnet</code> will ignore any prompt found. This option +%%% is useful if data sent by the server could include a pattern that +%%% would match the prompt regexp (as returned by +%%% <code>TargedMod:get_prompt_regexp/0</code>), but which should not +%%% cause the function to return.</p> +%%% +%%% <p>If the <code>no_prompt_check</code> option is used, +%%% <code>ct_telnet</code> will not search for a prompt at all. This +%%% is useful if, for instance, the <code>Pattern</code> itself +%%% matches the prompt.</p> +%%% %%% <p>The <code>repeat</code> option indicates that the pattern(s) %%% shall be matched multiple times. If <code>N</code> is given, the %%% pattern(s) will be matched <code>N</code> times, and the function @@ -580,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 -> @@ -597,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) -> @@ -732,7 +740,7 @@ teln_get_all_data(Pid,Prx,Data,Acc,LastLine) -> seq=false, repeat=false, found_prompt=false, - wait_for_linebreak=true}). + prompt_check=true}). %% @hidden %% @doc Externally the silent_teln_expect function shall only be used @@ -758,25 +766,27 @@ silent_teln_expect(Pid,Data,Pattern,Prx,Opts) -> %% condition is fullfilled. %% 3b) Repeat (sequence): 2) is repeated either N times or until a %% halt condition is fullfilled. -teln_expect(Pid,Data,Pattern0,Prx,Opts) -> - HaltPatterns = case get_ignore_prompt(Opts) of - true -> - get_haltpatterns(Opts); - false -> - [prompt | get_haltpatterns(Opts)] - end, - WaitForLineBreak = get_line_break_opt(Opts), +teln_expect(Pid,Data,Pattern0,Prx,Opts) -> + HaltPatterns = + case get_ignore_prompt(Opts) of + true -> + get_haltpatterns(Opts); + false -> + [prompt | get_haltpatterns(Opts)] + end, + + PromptCheck = get_prompt_check(Opts), Seq = get_seq(Opts), Pattern = convert_pattern(Pattern0,Seq), - + Timeout = get_timeout(Opts), - + EO = #eo{teln_pid=Pid, prx=Prx, timeout=Timeout, seq=Seq, haltpatterns=HaltPatterns, - wait_for_linebreak=WaitForLineBreak}, + prompt_check=PromptCheck}, case get_repeat(Opts) of false -> @@ -817,11 +827,6 @@ get_timeout(Opts) -> {value,{timeout,T}} -> T; false -> ?DEFAULT_TIMEOUT end. -get_line_break_opt(Opts) -> - case lists:keysearch(wait_for_linebreak,1,Opts) of - {value,{wait_for_linebreak,false}} -> false; - _ -> true - end. get_repeat(Opts) -> case lists:keysearch(repeat,1,Opts) of {value,{repeat,N}} when is_integer(N) -> @@ -845,7 +850,9 @@ get_haltpatterns(Opts) -> end. get_ignore_prompt(Opts) -> lists:member(ignore_prompt,Opts). - +get_prompt_check(Opts) -> + not lists:member(no_prompt_check,Opts). + %% Repeat either single or sequence. All match results are accumulated %% and returned when a halt condition is fulllfilled. repeat_expect(Rest,_Pattern,Acc,#eo{repeat=0}) -> @@ -906,6 +913,9 @@ get_data1(Pid) -> %% lines and each line is matched against each pattern. %% one_expect: split data chunk at prompts +one_expect(Data,Pattern,EO) when EO#eo.prompt_check==false -> +% io:format("Raw Data ~p Pattern ~p EO ~p ",[Data,Pattern,EO]), + one_expect1(Data,Pattern,[],EO#eo{found_prompt=false}); one_expect(Data,Pattern,EO) -> case match_prompt(Data,EO#eo.prx) of {prompt,UptoPrompt,PromptType,Rest} -> @@ -964,6 +974,8 @@ seq_expect(Data,[],Acc,_EO) -> {match,lists:reverse(Acc),Data}; seq_expect([],Patterns,Acc,_EO) -> {continue,Patterns,lists:reverse(Acc),[]}; +seq_expect(Data,Patterns,Acc,EO) when EO#eo.prompt_check==false -> + seq_expect1(Data,Patterns,Acc,[],EO#eo{found_prompt=false}); seq_expect(Data,Patterns,Acc,EO) -> case match_prompt(Data,EO#eo.prx) of {prompt,UptoPrompt,PromptType,Rest} -> @@ -1018,9 +1030,8 @@ seq_expect1(Data,[],Acc,Rest,_EO) -> %% Split prompt-chunk at lines match_lines(Data,Patterns,EO) -> FoundPrompt = EO#eo.found_prompt, - NeedLineBreak = EO#eo.wait_for_linebreak, case one_line(Data,[]) of - {noline,Rest} when FoundPrompt=/=false, NeedLineBreak =:= true -> + {noline,Rest} when FoundPrompt=/=false -> %% This is the line including the prompt case match_line(Rest,Patterns,FoundPrompt,EO) of nomatch -> @@ -1028,14 +1039,14 @@ match_lines(Data,Patterns,EO) -> {Tag,Match} -> {Tag,Match,[]} end; - {noline,Rest} when NeedLineBreak =:= false -> - case match_line(Rest,Patterns,FoundPrompt,EO) of + {noline,Rest} when EO#eo.prompt_check==false -> + case match_line(Rest,Patterns,false,EO) of nomatch -> - {nomatch,prompt}; + {nomatch,Rest}; {Tag,Match} -> {Tag,Match,[]} end; - {noline, Rest} -> + {noline,Rest} -> {nomatch,Rest}; {Line,Rest} -> case match_line(Line,Patterns,false,EO) of diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl index 7329498ed6..2cbcba9c77 100644 --- a/lib/common_test/src/ct_telnet_client.erl +++ b/lib/common_test/src/ct_telnet_client.erl @@ -143,7 +143,9 @@ loop(State, Sock, Acc) -> State end; _ -> - Pid ! {data,lists:reverse(lists:append(Acc))}, + Data = lists:reverse(lists:append(Acc)), + dbg("get_data ~p\n",[Data]), + Pid ! {data,Data}, State end, loop(NewState, Sock, []); @@ -161,7 +163,9 @@ loop(State, Sock, Acc) -> NewAcc = case erlang:is_process_alive(Pid) of true -> - Pid ! {data,lists:reverse(lists:append(Acc))}, + Data = lists:reverse(lists:append(Acc)), + dbg("get_data_delayed ~p\n",[Data]), + Pid ! {data,Data}, []; false -> Acc diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index 6a8b37bf3b..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,15 +417,18 @@ 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), + %% in case CB:close failed to do this: + unregister_connection(Pid), 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 @@ -455,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 @@ -494,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}, [], @@ -512,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. %%%----------------------------------------------------------------- @@ -920,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/src/unix_telnet.erl b/lib/common_test/src/unix_telnet.erl index 71df2ab44e..88199b07d0 100644 --- a/lib/common_test/src/unix_telnet.erl +++ b/lib/common_test/src/unix_telnet.erl @@ -94,16 +94,11 @@ connect(Ip,Port,Timeout,KeepAlive,Extra) -> {Username,Password} -> connect1(Ip,Port,Timeout,KeepAlive,Username,Password); Name -> - case not_require_user_and_pass(Name) of - true -> - connect_without_username_and_pass(Ip,Port,Timeout,KeepAlive); - _ -> - case get_username_and_password(Name) of - {ok,{Username,Password}} -> - connect1(Ip,Port,Timeout,KeepAlive,Username,Password); - Error -> - Error - end + case get_username_and_password(Name) of + {ok,{Username,Password}} -> + connect1(Ip,Port,Timeout,KeepAlive,Username,Password); + Error -> + Error end end. @@ -149,27 +144,6 @@ connect1(Ip,Port,Timeout,KeepAlive,Username,Password) -> end_log(), Result. -connect_without_username_and_pass(Ip,Port,Timeout,KeepAlive) -> - start_log("unix_telnet:connect"), - Result = - case ct_telnet_client:open(Ip,Port,Timeout,KeepAlive) of - {ok,Pid} -> - {ok, Pid}; - Error -> - cont_log("Could not open telnet connection\n~p\n",[Error]), - Error - end, - end_log(), - Result. - -not_require_user_and_pass(Name) -> - case ct:get_config({Name, not_require_user_and_pass}) of - undefined -> - false; - _ -> - true - end. - get_username_and_password(Name) -> case ct:get_config({Name,username}) of undefined -> diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index 94569fa87f..9d2edcd653 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -28,7 +28,9 @@ MODULES= \ ct_test_support \ ct_test_support_eh \ 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/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl index 54526e8e83..0535eb924b 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl @@ -1,7 +1,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% 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 @@ -1035,10 +1035,12 @@ make_dsa_files(Config, Type) -> file:write_file(DSAPrivateFile, PemBin), ok. + %%-------------------------------------------------------------------- -%% Creates a dsa key (OBS: for testing only) +%% @doc Creates a dsa key (OBS: for testing only) %% the sizes are in bytes -%% gen_dsa(::integer()) -> {::atom(), ::binary(), ::opaque()} +%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} +%% @end %%-------------------------------------------------------------------- gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) -> Key = gen_dsa2(LSize, NSize), @@ -1048,7 +1050,6 @@ encode_key(Key = #'DSAPrivateKey'{}) -> Der = public_key:der_encode('DSAPrivateKey', Key), {'DSAPrivateKey', Der, not_encrypted}. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% DSA key generation (OBS: for testing only) %% See http://en.wikipedia.org/wiki/Digital_Signature_Algorithm @@ -1058,67 +1059,70 @@ gen_dsa2(LSize, NSize) -> Q = prime(NSize), %% Choose N-bit prime Q X0 = prime(LSize), P0 = prime((LSize div 2) +1), - + %% Choose L-bit prime modulus P such that p-1 is a multiple of q. case dsa_search(X0 div (2*Q*P0), P0, Q, 1000) of - error -> + error -> gen_dsa2(LSize, NSize); - P -> - G = crypto:mod_exp(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. + P -> + G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used. - + X = prime(20), %% Choose x by some random method, where 0 < x < q. - Y = crypto:mod_exp(G, X, P), %% Calculate y = g^x mod p. - - #'DSAPrivateKey'{version=0, p=P, q=Q, g=G, y=Y, x=X} + Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p. + + #'DSAPrivateKey'{version=0, p = P, q = Q, + g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X} end. - + %% See fips_186-3.pdf dsa_search(T, P0, Q, Iter) when Iter > 0 -> P = 2*T*Q*P0 + 1, - case is_prime(crypto:mpint(P), 50) of + case is_prime(P, 50) of true -> P; false -> dsa_search(T+1, P0, Q, Iter-1) end; -dsa_search(_,_,_,_) -> +dsa_search(_,_,_,_) -> error. %%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% prime(ByteSize) -> Rand = odd_rand(ByteSize), - crypto:erlint(prime_odd(Rand, 0)). + prime_odd(Rand, 0). prime_odd(Rand, N) -> case is_prime(Rand, 50) of - true -> + true -> Rand; - false -> - NotPrime = crypto:erlint(Rand), - prime_odd(crypto:mpint(NotPrime+2), N+1) + false -> + prime_odd(Rand+2, N+1) end. %% see http://en.wikipedia.org/wiki/Fermat_primality_test is_prime(_, 0) -> true; -is_prime(Candidate, Test) -> - CoPrime = odd_rand(<<0,0,0,4, 10000:32>>, Candidate), - case crypto:mod_exp(CoPrime, Candidate, Candidate) of - CoPrime -> is_prime(Candidate, Test-1); - _ -> false - end. +is_prime(Candidate, Test) -> + CoPrime = odd_rand(10000, Candidate), + Result = crypto:mod_pow(CoPrime, Candidate, Candidate) , + is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test). + +is_prime(CoPrime, CoPrime, Candidate, Test) -> + is_prime(Candidate, Test-1); +is_prime(_,_,_,_) -> + false. odd_rand(Size) -> Min = 1 bsl (Size*8-1), Max = (1 bsl (Size*8))-1, - odd_rand(crypto:mpint(Min), crypto:mpint(Max)). + odd_rand(Min, Max). odd_rand(Min,Max) -> - Rand = <<Sz:32, _/binary>> = crypto:rand_uniform(Min,Max), - BitSkip = (Sz+4)*8-1, - case Rand of - Odd = <<_:BitSkip, 1:1>> -> Odd; - Even = <<_:BitSkip, 0:1>> -> - crypto:mpint(crypto:erlint(Even)+1) + Rand = crypto:rand_uniform(Min,Max), + case Rand rem 2 of + 0 -> + Rand + 1; + _ -> + Rand end. copyfile(SrcDir, DstDir, Fn) -> diff --git a/lib/common_test/test/ct_telnet_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE.erl index b4f24baa0c..e2ee207754 100644 --- a/lib/common_test/test/ct_telnet_SUITE.erl +++ b/lib/common_test/test/ct_telnet_SUITE.erl @@ -33,6 +33,10 @@ -define(eh, ct_test_support_eh). +-define(erl_telnet_server_port,1234). +-define(erl_telnet_server_user,"telnuser"). +-define(erl_telnet_server_pwd,"telnpwd"). + %%-------------------------------------------------------------------- %% TEST SERVER CALLBACK FUNCTIONS %%-------------------------------------------------------------------- @@ -48,17 +52,28 @@ init_per_suite(Config) -> end_per_suite(Config) -> ct_test_support:end_per_suite(Config). +init_per_testcase(TestCase, Config) when TestCase=/=unix_telnet-> + TS = telnet_server:start([{port,?erl_telnet_server_port}, + {users,[{?erl_telnet_server_user, + ?erl_telnet_server_pwd}]}]), + ct_test_support:init_per_testcase(TestCase, [{telnet_server,TS}|Config]); init_per_testcase(TestCase, Config) -> ct_test_support:init_per_testcase(TestCase, Config). end_per_testcase(TestCase, Config) -> + case ?config(telnet_server,Config) of + undefined -> ok; + TS -> telnet_server:stop(TS) + end, ct_test_support:end_per_testcase(TestCase, Config). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [ - default + unix_telnet, + own_server, + timetrap ]. %%-------------------------------------------------------------------- @@ -67,19 +82,33 @@ all() -> %%%----------------------------------------------------------------- %%% -default(Config) when is_list(Config) -> - DataDir = ?config(data_dir, Config), - Suite = filename:join(DataDir, "ct_telnet_basic_SUITE"), - Cfg = {unix, ct:get_config(unix)}, - ok = file:write_file(filename:join(DataDir, "telnet.cfg"), io_lib:write(Cfg) ++ "."), - CfgFile = filename:join(DataDir, "telnet.cfg"), - {Opts,ERPid} = setup([{suite,Suite},{label,default}, {config, CfgFile}], Config), - ok = execute(default, Opts, ERPid, Config). +unix_telnet(Config) when is_list(Config) -> + all_tests_in_suite(unix_telnet,"ct_telnet_basic_SUITE","telnet.cfg",Config). + +own_server(Config) -> + all_tests_in_suite(own_server,"ct_telnet_own_server_SUITE", + "telnet2.cfg",Config). + +timetrap(Config) -> + all_tests_in_suite(timetrap,"ct_telnet_timetrap_SUITE", + "telnet3.cfg",Config). %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- +all_tests_in_suite(TestCase, SuiteName, CfgFileName, Config) -> + DataDir = ?config(data_dir, Config), + Suite = filename:join(DataDir, SuiteName), + CfgFile = filename:join(DataDir, CfgFileName), + Cfg = telnet_config(TestCase), + ok = file:write_file(CfgFile, io_lib:write(Cfg) ++ "."), + {Opts,ERPid} = setup([{suite,Suite}, + {label,TestCase}, + {config,CfgFile}], + Config), + ok = execute(TestCase, Opts, ERPid, Config). + setup(Test, Config) -> Opts0 = ct_test_support:get_opts(Config), Level = ?config(trace_level, Config), @@ -103,19 +132,40 @@ execute(Name, Opts, ERPid, Config) -> reformat(Events, EH) -> ct_test_support:reformat(Events, EH). + +telnet_config(unix_telnet) -> + {unix, ct:get_config(unix)}; +telnet_config(_) -> + {unix,[{telnet,"localhost"}, + {port, ?erl_telnet_server_port}, + {username,?erl_telnet_server_user}, + {password,?erl_telnet_server_pwd}, + {keep_alive,true}]}. + %%%----------------------------------------------------------------- %%% TEST EVENTS %%%----------------------------------------------------------------- -events_to_check(default,Config) -> +events_to_check(unix_telnet,Config) -> + all_cases(ct_telnet_basic_SUITE,Config); +events_to_check(own_server,Config) -> + all_cases(ct_telnet_own_server_SUITE,Config); +events_to_check(timetrap,_Config) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,tc_done,{ct_telnet_timetrap_SUITE,expect_timetrap, + {failed,{timetrap_timeout,7000}}}}, + {?eh,tc_done,{ct_telnet_timetrap_SUITE,expect_success,ok}}, + {?eh,stop_logging,[]}]. + +all_cases(Suite,Config) -> {module,_} = code:load_abs(filename:join(?config(data_dir,Config), - ct_telnet_basic_SUITE)), - TCs = ct_telnet_basic_SUITE:all(), - code:purge(ct_telnet_basic_SUITE), - code:delete(ct_telnet_basic_SUITE), + Suite)), + TCs = Suite:all(), + code:purge(Suite), + code:delete(Suite), OneTest = [{?eh,start_logging,{'DEF','RUNDIR'}}] ++ - [{?eh,tc_done,{ct_telnet_basic_SUITE,TC,ok}} || TC <- TCs] ++ + [{?eh,tc_done,{Suite,TC,ok}} || TC <- TCs] ++ [{?eh,stop_logging,[]}], %% 2 tests (ct:run_test + script_start) is default diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl new file mode 100644 index 0000000000..3f7c0d68bf --- /dev/null +++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl @@ -0,0 +1,184 @@ +-module(ct_telnet_own_server_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +%%-------------------------------------------------------------------- +%% TEST SERVER CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + + +suite() -> [{require,erl_telnet_server,{unix,[telnet]}}]. + +all() -> + [expect, + expect_repeat, + expect_sequence, + expect_error_prompt, + expect_error_timeout, + no_prompt_check, + no_prompt_check_repeat, + no_prompt_check_sequence, + no_prompt_check_timeout, + ignore_prompt, + ignore_prompt_repeat, + ignore_prompt_sequence, + ignore_prompt_timeout]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +%% Simple expect +expect(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo ayt"), + {ok,["ayt"]} = ct_telnet:expect(Handle, ["ayt"]), + ok = ct_telnet:close(Handle), + ok. + +%% Expect with repeat option +expect_repeat(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo_ml xy xy"), + {ok,[["xy"],["xy"]],done} = ct_telnet:expect(Handle, ["xy"],[{repeat,2}]), + ok = ct_telnet:close(Handle), + ok. + +%% Expect with sequence option +expect_sequence(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo_ml ab cd ef"), + {ok,[["ab"],["cd"],["ef"]]} = ct_telnet:expect(Handle, + [["ab"],["cd"],["ef"]], + [sequence]), + ok = ct_telnet:close(Handle), + ok. + +%% Check that expect returns when a prompt is found, even if pattern +%% is not matched. +expect_error_prompt(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo xxx> yyy"), + {error,{prompt,"> "}} = ct_telnet:expect(Handle, ["yyy"]), + ok = ct_telnet:close(Handle), + ok. + +%% Check that expect returns after idle timeout, and even if the +%% expected pattern is received - as long as not newline or prompt is +%% received it will not match. +expect_error_timeout(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo_no_prompt xxx"), + {error,timeout} = ct_telnet:expect(Handle, ["xxx"], [{timeout,1000}]), + ok = ct_telnet:close(Handle), + ok. + +%% expect with ignore_prompt option should not return even if a prompt +%% is found. The pattern after the prompt (here "> ") can be matched. +ignore_prompt(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo xxx> yyy"), + {ok,["yyy"]} = ct_telnet:expect(Handle, ["yyy"], [ignore_prompt]), + ok = ct_telnet:close(Handle), + ok. + +%% expect with ignore_prompt and repeat options. +ignore_prompt_repeat(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo_ml yyy> yyy>"), + {ok,[["yyy"],["yyy"]],done} = ct_telnet:expect(Handle, ["yyy"], + [{repeat,2}, + ignore_prompt]), + ok = ct_telnet:close(Handle), + ok. + +%% expect with ignore_prompt and sequence options. +ignore_prompt_sequence(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo_ml xxx> yyy> zzz> "), + {ok,[["xxx"],["yyy"],["zzz"]]} = ct_telnet:expect(Handle, + [["xxx"],["yyy"],["zzz"]], + [sequence, + ignore_prompt]), + ok = ct_telnet:close(Handle), + ok. + +%% Check that expect returns after idle timeout when ignore_prompt +%% option is used. +%% As for expect without the ignore_prompt option, it a newline or a +%% prompt is required in order for the pattern to match. +ignore_prompt_timeout(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo xxx"), + {error,timeout} = ct_telnet:expect(Handle, ["yyy"], [ignore_prompt, + {timeout,1000}]), + ok = ct_telnet:send(Handle, "echo xxx"), % sends prompt and newline + {ok,["xxx"]} = ct_telnet:expect(Handle, ["xxx"], [ignore_prompt, + {timeout,1000}]), + ok = ct_telnet:send(Handle, "echo_no_prompt xxx\n"), % no prompt, but newline + {ok,["xxx"]} = ct_telnet:expect(Handle, ["xxx"], [ignore_prompt, + {timeout,1000}]), + ok = ct_telnet:send(Handle, "echo_no_prompt xxx"), % no prompt, no newline + {error,timeout} = ct_telnet:expect(Handle, ["xxx"], [ignore_prompt, + {timeout,1000}]), + ok = ct_telnet:close(Handle), + ok. + +%% no_prompt_check option shall match pattern both when prompt is sent +%% and when it is not. +no_prompt_check(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo xxx"), + {ok,["xxx"]} = ct_telnet:expect(Handle, ["xxx"], [no_prompt_check]), + ok = ct_telnet:send(Handle, "echo_no_prompt yyy"), + {ok,["yyy"]} = ct_telnet:expect(Handle, ["yyy"], [no_prompt_check]), + ok = ct_telnet:close(Handle), + ok. + +%% no_prompt_check and repeat options +no_prompt_check_repeat(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo_ml xxx xxx"), + {ok,[["xxx"],["xxx"]],done} = ct_telnet:expect(Handle,["xxx"], + [{repeat,2}, + no_prompt_check]), + ok = ct_telnet:send(Handle, "echo_ml_no_prompt yyy yyy"), + {ok,[["yyy"],["yyy"]],done} = ct_telnet:expect(Handle,["yyy"], + [{repeat,2}, + no_prompt_check]), + ok = ct_telnet:close(Handle), + ok. + +%% no_prompt_check and sequence options +no_prompt_check_sequence(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo_ml_no_prompt ab cd ef"), + {ok,[["ab"],["cd"],["ef"]]} = ct_telnet:expect(Handle, + [["ab"],["cd"],["ef"]], + [sequence, + no_prompt_check]), + ok = ct_telnet:close(Handle), + ok. + +%% Check that expect returns after idle timeout when no_prompt_check +%% option is used. +no_prompt_check_timeout(_) -> + {ok, Handle} = ct_telnet:open(erl_telnet_server), + ok = ct_telnet:send(Handle, "echo xxx"), + {error,timeout} = ct_telnet:expect(Handle, ["yyy"], [no_prompt_check, + {timeout,1000}]), + ok = ct_telnet:close(Handle), + ok. diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_timetrap_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_timetrap_SUITE.erl new file mode 100644 index 0000000000..f274fb9112 --- /dev/null +++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_timetrap_SUITE.erl @@ -0,0 +1,76 @@ +-module(ct_telnet_timetrap_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +-define(name,erl_telnet_server). + +%%-------------------------------------------------------------------- +%% TEST SERVER CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +suite() -> [{require,?name,{unix,[telnet]}}, + {timetrap,{seconds,7}}]. + +all() -> + [expect_timetrap, + expect_success]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(_,Config) -> + ct:log("init_per_testcase: opening telnet connection...",[]), + {ok,_} = ct_telnet:open(?name), + ct:log("...done",[]), + Config. + +end_per_testcase(_,_Config) -> + ct:log("end_per_testcase: closing telnet connection...",[]), + _ = ct_telnet:close(?name), + ct:log("...done",[]), + ok. + + +%% OTP-10648 +%% This test case should fail with timetrap timeout. +%% +%% The long timetrap timeout and timeout option in the expect call +%% also causes the telnet client to hang so long that the attempt at +%% closing it (in end_per_testcase) will time out (close timeout is 5 +%% sec) without a timetrap timeout occuring in end_per_testcase. +%% +%% The point is to see that the connection is thoroughly removed and +%% unregistered anyway so that the next test case can successfully +%% open a connection with the same name. +%% +%% Note!!! that if end_per_testcase reaches a timetrap timeout before +%% the connection is closed, then the connection will survive until +%% the hanging expect times out, after which it will be closed in a +%% seemingly normal way due to the close message which was sent by the +%% close attempt. This could happen any time during the subsequent +%% test cases and cause confusion... There is however not much to do +%% about this, except writing test cases with timetrap timeout longer +%% than the close timeout (as this test case does) +expect_timetrap(_) -> + {error,timeout} = ct_telnet:expect(?name, ["ayt"], [{timeout,20000}]), + ok. + +%% This should succeed +expect_success(_) -> + ok = ct_telnet:send(?name, "echo ayt"), + {ok,["ayt"]} = ct_telnet:expect(?name, ["ayt"]), + ok. diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl new file mode 100644 index 0000000000..31884aa182 --- /dev/null +++ b/lib/common_test/test/telnet_server.erl @@ -0,0 +1,228 @@ +-module(telnet_server). +-compile(export_all). + +%% telnet control characters +-define(SE, 240). +-define(NOP, 241). +-define(DM, 242). +-define(BRK, 243). +-define(IP, 244). +-define(AO, 245). +-define(AYT, 246). +-define(EC, 247). +-define(EL, 248). +-define(GA, 249). +-define(SB, 250). +-define(WILL, 251). +-define(WONT, 252). +-define(DO, 253). +-define(DONT, 254). +-define(IAC, 255). + +%% telnet options +-define(BINARY, 0). +-define(ECHO, 1). +-define(SUPPRESS_GO_AHEAD, 3). +-define(TERMINAL_TYPE, 24). + +-record(state, + {listen, + client, + users, + authorized=false, + suppress_go_ahead=false, + buffer=[]}). + +-type options() :: [{port,pos_integer()} | {users,users()}]. +-type users() :: [{user(),password()}]. +-type user() :: string(). +-type password() :: string(). + +-spec start(Opts::options()) -> Pid::pid(). +start(Opts) when is_list(Opts) -> + spawn_link(fun() -> init(Opts) end). + +-spec stop(Pid::pid()) -> ok. +stop(Pid) -> + Ref = erlang:monitor(process,Pid), + Pid ! stop, + receive {'DOWN',Ref,_,_,_} -> ok end. + +init(Opts) -> + Port = proplists:get_value(port,Opts), + Users = proplists:get_value(users,Opts,[]), + {ok, LSock} = gen_tcp:listen(Port, [list, {packet, 0}, + {active, true}]), + State = #state{listen=LSock,users=Users}, + accept(State), + ok = gen_tcp:close(LSock). + +accept(#state{listen=LSock}=State) -> + Server = self(), + Acceptor = spawn_link(fun() -> do_accept(LSock,Server) end), + receive + {Acceptor,Sock} when is_port(Sock) -> + case init_client(State#state{client=Sock}) of + stopped -> + io:format("telnet_server stopped\n"), + ok; + R -> + io:format("connection to client closed with reason ~p~n",[R]), + accept(State) + end; + {Acceptor,closed} -> + io:format("listen socket closed unexpectedly, " + "terminating telnet_server\n"), + ok; + stop -> + io:format("telnet_server stopped\n"), + ok + end. + +do_accept(LSock,Server) -> + case gen_tcp:accept(LSock) of + {ok, Sock} -> + ok = gen_tcp:controlling_process(Sock,Server), + Server ! {self(),Sock}; + {error,closed} -> + %% This will happen when stop/1 is called, since listen + %% socket is closed. Then the server is probably already + %% dead by now, but to be 100% sure not to hang, we send a + %% message to say what happened. + Server ! {self(),closed} + end. + +init_client(#state{client=Sock}=State) -> + dbg("Server sending: ~p~n",["login: "]), + R = case gen_tcp:send(Sock,"login: ") of + ok -> + loop(State); + Error -> + Error + end, + _ = gen_tcp:close(Sock), + R. + +loop(State) -> + receive + {tcp,_,Data} -> + try handle_data(Data,State) of + {ok,State1} -> + loop(State1) + catch + throw:Error -> + Error + end; + {tcp_closed, _} -> + closed; + {tcp_error,_,Error} -> + {error,tcp,Error}; + stop -> + stopped + end. + +handle_data([?IAC|Cmd],State) -> + dbg("Server got cmd: ~p~n",[Cmd]), + handle_cmd(Cmd,State); +handle_data(Data,State) -> + dbg("Server got data: ~p~n",[Data]), + case get_line(Data,[]) of + {Line,Rest} -> + WholeLine = lists:flatten(lists:reverse(State#state.buffer,Line)), + {ok,State1} = do_handle_data(WholeLine,State), + case Rest of + [] -> {ok,State1}; + _ -> handle_data(Rest,State1) + end; + false -> + {ok,State#state{buffer=[Data|State#state.buffer]}} + end. + +%% Add function clause below to handle new telnet commands (sent with +%% ?IAC from client - this is not possible to do from ct_telnet API, +%% but ct_telnet sends DONT SUPPRESS_GO_AHEAD) +handle_cmd([?DO,?SUPPRESS_GO_AHEAD|T],State) -> + send([?IAC,?WILL,?SUPPRESS_GO_AHEAD],State), + handle_cmd(T,State#state{suppress_go_ahead=true}); +handle_cmd([?DONT,?SUPPRESS_GO_AHEAD|T],State) -> + send([?IAC,?WONT,?SUPPRESS_GO_AHEAD],State), + handle_cmd(T,State#state{suppress_go_ahead=false}); +handle_cmd([?IAC|T],State) -> + %% Multiple commands in one packet + handle_cmd(T,State); +handle_cmd([_H|T],State) -> + %% Not responding to this command + handle_cmd(T,State); +handle_cmd([],State) -> + {ok,State}. + +%% Add function clause below to handle new text command (text entered +%% from the telnet prompt) +do_handle_data(Data,#state{authorized=false}=State) -> + check_user(Data,State); +do_handle_data(Data,#state{authorized={user,_}}=State) -> + check_pwd(Data,State); +do_handle_data("echo "++ Data,State) -> + send(Data++"\r\n> ",State), + {ok,State}; +do_handle_data("echo_no_prompt "++ Data,State) -> + send(Data,State), + {ok,State}; +do_handle_data("echo_ml "++ Data,State) -> + Lines = string:tokens(Data," "), + ReturnData = string:join(Lines,"\n"), + send(ReturnData++"\r\n> ",State), + {ok,State}; +do_handle_data("echo_ml_no_prompt "++ Data,State) -> + Lines = string:tokens(Data," "), + ReturnData = string:join(Lines,"\n"), + send(ReturnData,State), + {ok,State}; +do_handle_data([],State) -> + send("> ",State), + {ok,State}; +do_handle_data(_Data,State) -> + send("error: unknown command\r\n> ",State), + {ok,State}. + +check_user(User,State) -> + case lists:keyfind(User,1,State#state.users) of + {User,Pwd} -> + dbg("user ok\n"), + send("Password: ",State), + {ok,State#state{authorized={user,Pwd}}}; + false -> + throw({error,unknown_user}) + end. + +check_pwd(Pwd,#state{authorized={user,Pwd}}=State) -> + dbg("password ok\n"), + send("Welcome to the ultimate telnet server!\r\n> ",State), + {ok,State#state{authorized=true}}; +check_pwd(_,_State) -> + throw({error,authentication}). + +send(Data,State) -> + dbg("Server sending: ~p~n",[Data]), + case gen_tcp:send(State#state.client,Data) of + ok -> + ok; + {error,Error} -> + throw({error,send,Error}) + end. + +get_line([$\r,$\n|Rest],Acc) -> + {lists:reverse(Acc),Rest}; +get_line([$\r,0|Rest],Acc) -> + {lists:reverse(Acc),Rest}; +get_line([$\n|Rest],Acc) -> + {lists:reverse(Acc),Rest}; +get_line([H|T],Acc) -> + get_line(T,[H|Acc]); +get_line([],_) -> + false. + +dbg(_F) -> + io:format(_F). +dbg(_F,_A) -> + io:format(_F,_A). 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/src/compile.erl b/lib/compiler/src/compile.erl index 745f1d5cf9..2ca403de54 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1197,9 +1197,9 @@ abstract_code(#compile{code=Code,options=Opts,ofile=OFile}) -> encrypt_abs_code(Abstr, Key0) -> try - {Mode,RealKey} = generate_key(Key0), + RealKey = generate_key(Key0), case start_crypto() of - ok -> {ok,encrypt(Mode, RealKey, Abstr)}; + ok -> {ok,encrypt(RealKey, Abstr)}; {error,_}=E -> E end catch @@ -1216,19 +1216,19 @@ start_crypto() -> {error,[{none,?MODULE,no_crypto}]} end. -generate_key({Mode,String}) when is_atom(Mode), is_list(String) -> - {Mode,beam_lib:make_crypto_key(Mode, String)}; +generate_key({Type,String}) when is_atom(Type), is_list(String) -> + beam_lib:make_crypto_key(Type, String); generate_key(String) when is_list(String) -> generate_key({des3_cbc,String}). -encrypt(des3_cbc=Mode, {K1,K2,K3, IVec}, Bin0) -> - Bin1 = case byte_size(Bin0) rem 8 of +encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> + Bin1 = case byte_size(Bin0) rem BlockSize of 0 -> Bin0; - N -> list_to_binary([Bin0,random_bytes(8-N)]) + N -> list_to_binary([Bin0,random_bytes(BlockSize-N)]) end, - Bin = crypto:des3_cbc_encrypt(K1, K2, K3, IVec, Bin1), - ModeString = atom_to_list(Mode), - list_to_binary([0,length(ModeString),ModeString,Bin]). + Bin = crypto:block_encrypt(Type, Key, IVec, Bin1), + TypeString = atom_to_list(Type), + list_to_binary([0,length(TypeString),TypeString,Bin]). random_bytes(N) -> {A,B,C} = now(), diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 229e5a98a1..c635d13c89 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -492,6 +492,16 @@ encrypted_abstr_1(Simple, Target) -> ?line {error,beam_lib,{key_missing_or_invalid,"simple.beam",abstract_code}} = beam_lib:chunks("simple.beam", [abstract_code]), ?line ok = file:set_cwd(OldCwd), + + %% Test key compatibility by reading a BEAM file produced before + %% the update to the new crypto functions. + install_crypto_key("an old key"), + KeyCompat = filename:join(filename:dirname(Simple), + "key_compatibility"), + {ok,{key_compatibility,[Chunk]}} = beam_lib:chunks(KeyCompat, + [abstract_code]), + {abstract_code,{raw_abstract_v1,_}} = Chunk, + ok. diff --git a/lib/compiler/test/compile_SUITE_data/key_compatibility.beam b/lib/compiler/test/compile_SUITE_data/key_compatibility.beam Binary files differnew file mode 100644 index 0000000000..28329d2423 --- /dev/null +++ b/lib/compiler/test/compile_SUITE_data/key_compatibility.beam diff --git a/lib/compiler/test/compile_SUITE_data/key_compatibility.erl b/lib/compiler/test/compile_SUITE_data/key_compatibility.erl new file mode 100644 index 0000000000..e2931f1b12 --- /dev/null +++ b/lib/compiler/test/compile_SUITE_data/key_compatibility.erl @@ -0,0 +1,8 @@ +-module(key_compatibility). +-export([main/0]). + +%% Compile like this: +%% erlc +'{debug_info_key,"an old key"}' key_compatibility.erl + +main() -> + ok. 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/c_src/crypto.c b/lib/crypto/c_src/crypto.c index fac77308f6..98ebb21f29 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -74,6 +74,19 @@ # define HAVE_DES_ede3_cfb_encrypt #endif +#if OPENSSL_VERSION_NUMBER >= 0x009080ffL \ + && !defined(OPENSSL_NO_EC) \ + && !defined(OPENSSL_NO_ECDH) \ + && !defined(OPENSSL_NO_ECDSA) +# define HAVE_EC +#endif + +#if defined(HAVE_EC) +#include <openssl/ec.h> +#include <openssl/ecdh.h> +#include <openssl/ecdsa.h> +#endif + #ifdef VALGRIND # include <valgrind/memcheck.h> @@ -192,7 +205,7 @@ static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -209,13 +222,19 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM srp_client_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM srp_server_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM bf_cfb64_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM bf_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM bf_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM blowfish_ofb64_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM ec_key_to_term_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM term_to_ec_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); /* helpers */ @@ -247,6 +266,11 @@ static void hmac_sha512(unsigned char *key, int klen, unsigned char *dbuf, int dlen, unsigned char *hmacbuf); #endif +#ifdef HAVE_EC +static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg); +static int term2point(ErlNifEnv* env, ERL_NIF_TERM term, + EC_GROUP *group, EC_POINT **pptr); +#endif static int library_refc = 0; /* number of users of this dynamic library */ @@ -311,7 +335,7 @@ static ErlNifFunc nif_funcs[] = { {"strong_rand_mpint_nif", 3, strong_rand_mpint_nif}, {"rand_uniform_nif", 2, rand_uniform_nif}, {"mod_exp_nif", 4, mod_exp_nif}, - {"dss_verify", 4, dss_verify}, + {"dss_verify_nif", 4, dss_verify_nif}, {"rsa_verify_nif", 4, rsa_verify_nif}, {"aes_cbc_crypt", 4, aes_cbc_crypt}, {"exor", 2, exor}, @@ -325,16 +349,120 @@ static ErlNifFunc nif_funcs[] = { {"rsa_private_crypt", 4, rsa_private_crypt}, {"dh_generate_parameters_nif", 2, dh_generate_parameters_nif}, {"dh_check", 1, dh_check}, - {"dh_generate_key_nif", 2, dh_generate_key_nif}, + {"dh_generate_key_nif", 3, dh_generate_key_nif}, {"dh_compute_key_nif", 3, dh_compute_key_nif}, {"srp_value_B_nif", 5, srp_value_B_nif}, - {"srp_client_secret_nif", 7, srp_client_secret_nif}, - {"srp_server_secret_nif", 5, srp_server_secret_nif}, + {"srp_user_secret_nif", 7, srp_user_secret_nif}, + {"srp_host_secret_nif", 5, srp_host_secret_nif}, {"bf_cfb64_crypt", 4, bf_cfb64_crypt}, {"bf_cbc_crypt", 4, bf_cbc_crypt}, {"bf_ecb_crypt", 3, bf_ecb_crypt}, - {"blowfish_ofb64_encrypt", 3, blowfish_ofb64_encrypt} + {"blowfish_ofb64_encrypt", 3, blowfish_ofb64_encrypt}, + + {"ec_key_to_term_nif", 1, ec_key_to_term_nif}, + {"term_to_ec_key_nif", 3, term_to_ec_key_nif}, + {"ec_key_generate", 1, ec_key_generate}, + {"ecdsa_sign_nif", 3, ecdsa_sign_nif}, + {"ecdsa_verify_nif", 4, ecdsa_verify_nif}, + {"ecdh_compute_key_nif", 2, ecdh_compute_key_nif} +}; + +#if defined(HAVE_EC) +struct nid_map { + char *name; + int nid; + ERL_NIF_TERM atom; +}; + +static struct nid_map ec_curves[] = { + /* prime field curves */ + /* secg curves */ + { "secp112r1", NID_secp112r1 }, + { "secp112r2", NID_secp112r2 }, + { "secp128r1", NID_secp128r1 }, + { "secp128r2", NID_secp128r2 }, + { "secp160k1", NID_secp160k1 }, + { "secp160r1", NID_secp160r1 }, + { "secp160r2", NID_secp160r2 }, + /* SECG secp192r1 is the same as X9.62 prime192v1 */ + { "secp192r1", NID_X9_62_prime192v1 }, + { "secp192k1", NID_secp192k1 }, + { "secp224k1", NID_secp224k1 }, + { "secp224r1", NID_secp224r1 }, + { "secp256k1", NID_secp256k1 }, + /* SECG secp256r1 is the same as X9.62 prime256v1 */ + { "secp256r1", NID_X9_62_prime256v1 }, + { "secp384r1", NID_secp384r1 }, + { "secp521r1", NID_secp521r1 }, + /* X9.62 curves */ + { "prime192v1", NID_X9_62_prime192v1 }, + { "prime192v2", NID_X9_62_prime192v2 }, + { "prime192v3", NID_X9_62_prime192v3 }, + { "prime239v1", NID_X9_62_prime239v1 }, + { "prime239v2", NID_X9_62_prime239v2 }, + { "prime239v3", NID_X9_62_prime239v3 }, + { "prime256v1", NID_X9_62_prime256v1 }, + /* characteristic two field curves */ + /* NIST/SECG curves */ + { "sect113r1", NID_sect113r1 }, + { "sect113r2", NID_sect113r2 }, + { "sect131r1", NID_sect131r1 }, + { "sect131r2", NID_sect131r2 }, + { "sect163k1", NID_sect163k1 }, + { "sect163r1", NID_sect163r1 }, + { "sect163r2", NID_sect163r2 }, + { "sect193r1", NID_sect193r1 }, + { "sect193r2", NID_sect193r2 }, + { "sect233k1", NID_sect233k1 }, + { "sect233r1", NID_sect233r1 }, + { "sect239k1", NID_sect239k1 }, + { "sect283k1", NID_sect283k1 }, + { "sect283r1", NID_sect283r1 }, + { "sect409k1", NID_sect409k1 }, + { "sect409r1", NID_sect409r1 }, + { "sect571k1", NID_sect571k1 }, + { "sect571r1", NID_sect571r1 }, + /* X9.62 curves */ + { "c2pnb163v1", NID_X9_62_c2pnb163v1 }, + { "c2pnb163v2", NID_X9_62_c2pnb163v2 }, + { "c2pnb163v3", NID_X9_62_c2pnb163v3 }, + { "c2pnb176v1", NID_X9_62_c2pnb176v1 }, + { "c2tnb191v1", NID_X9_62_c2tnb191v1 }, + { "c2tnb191v2", NID_X9_62_c2tnb191v2 }, + { "c2tnb191v3", NID_X9_62_c2tnb191v3 }, + { "c2pnb208w1", NID_X9_62_c2pnb208w1 }, + { "c2tnb239v1", NID_X9_62_c2tnb239v1 }, + { "c2tnb239v2", NID_X9_62_c2tnb239v2 }, + { "c2tnb239v3", NID_X9_62_c2tnb239v3 }, + { "c2pnb272w1", NID_X9_62_c2pnb272w1 }, + { "c2pnb304w1", NID_X9_62_c2pnb304w1 }, + { "c2tnb359v1", NID_X9_62_c2tnb359v1 }, + { "c2pnb368w1", NID_X9_62_c2pnb368w1 }, + { "c2tnb431r1", NID_X9_62_c2tnb431r1 }, + /* the WAP/WTLS curves + * [unlike SECG, spec has its own OIDs for curves from X9.62] */ + { "wtls1", NID_wap_wsg_idm_ecid_wtls1 }, + { "wtls3", NID_wap_wsg_idm_ecid_wtls3 }, + { "wtls4", NID_wap_wsg_idm_ecid_wtls4 }, + { "wtls5", NID_wap_wsg_idm_ecid_wtls5 }, + { "wtls6", NID_wap_wsg_idm_ecid_wtls6 }, + { "wtls7", NID_wap_wsg_idm_ecid_wtls7 }, + { "wtls8", NID_wap_wsg_idm_ecid_wtls8 }, + { "wtls9", NID_wap_wsg_idm_ecid_wtls9 }, + { "wtls10", NID_wap_wsg_idm_ecid_wtls10 }, + { "wtls11", NID_wap_wsg_idm_ecid_wtls11 }, + { "wtls12", NID_wap_wsg_idm_ecid_wtls12 }, + /* IPSec curves */ + { "ipsec3", NID_ipsec3 }, + { "ipsec4", NID_ipsec4 } +}; + +#define EC_CURVES_CNT (sizeof(ec_curves)/sizeof(struct nid_map)) + +struct nif_ec_key { + EC_KEY *key; }; +#endif ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload) @@ -368,6 +496,7 @@ static ERL_NIF_TERM atom_sha256; static ERL_NIF_TERM atom_sha384; static ERL_NIF_TERM atom_sha512; static ERL_NIF_TERM atom_md5; +static ERL_NIF_TERM atom_md4; static ERL_NIF_TERM atom_ripemd160; static ERL_NIF_TERM atom_error; static ERL_NIF_TERM atom_rsa_pkcs1_padding; @@ -386,6 +515,19 @@ static ERL_NIF_TERM atom_none; static ERL_NIF_TERM atom_notsup; static ERL_NIF_TERM atom_digest; +static ERL_NIF_TERM atom_ec; + +#if defined(HAVE_EC) +static ERL_NIF_TERM atom_prime_field; +static ERL_NIF_TERM atom_characteristic_two_field; +static ERL_NIF_TERM atom_tpbasis; +static ERL_NIF_TERM atom_ppbasis; +static ERL_NIF_TERM atom_onbasis; + +static ErlNifResourceType* res_type_ec_key; +static void ec_key_dtor(ErlNifEnv* env, void* obj); +#endif + /* #define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n") #define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1) @@ -415,6 +557,7 @@ static void error_handler(void* null, const char* errstr) static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) { + int i; ErlNifSysInfo sys_info; get_crypto_callbacks_t* funcp; struct crypto_callbacks* ccb; @@ -448,6 +591,7 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_sha256 = enif_make_atom(env,"sha256"); atom_sha384 = enif_make_atom(env,"sha384"); atom_sha512 = enif_make_atom(env,"sha512"); + atom_md4 = enif_make_atom(env,"md4"); atom_md5 = enif_make_atom(env,"md5"); atom_ripemd160 = enif_make_atom(env,"ripemd160"); atom_error = enif_make_atom(env,"error"); @@ -466,6 +610,23 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_notsup = enif_make_atom(env,"notsup"); atom_digest = enif_make_atom(env,"digest"); +#if defined(HAVE_EC) + atom_ec = enif_make_atom(env,"ec"); + atom_prime_field = enif_make_atom(env,"prime_field"); + atom_characteristic_two_field = enif_make_atom(env,"characteristic_two_field"); + atom_tpbasis = enif_make_atom(env,"tpbasis"); + atom_ppbasis = enif_make_atom(env,"ppbasis"); + atom_onbasis = enif_make_atom(env,"onbasis"); + + for (i = 0; i < EC_CURVES_CNT; i++) + ec_curves[i].atom = enif_make_atom(env,ec_curves[i].name); + + res_type_ec_key = enif_open_resource_type(env,NULL,"crypto.EC_KEY", + ec_key_dtor, + ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, + NULL); +#endif + init_digest_types(env); init_algorithms_types(); @@ -549,12 +710,12 @@ static void unload(ErlNifEnv* env, void* priv_data) } static int algos_cnt; -static ERL_NIF_TERM algos[7]; /* increase when extending the list */ +static ERL_NIF_TERM algos[9]; /* increase when extending the list */ static void init_algorithms_types(void) { algos_cnt = 0; - + algos[algos_cnt++] = atom_md4; algos[algos_cnt++] = atom_md5; algos[algos_cnt++] = atom_sha; algos[algos_cnt++] = atom_ripemd160; @@ -570,6 +731,9 @@ static void init_algorithms_types(void) #ifdef HAVE_SHA512 algos[algos_cnt++] = atom_sha512; #endif +#if defined(HAVE_EC) + algos[algos_cnt++] = atom_ec; +#endif } static ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -1631,13 +1795,7 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg return ret; } -static int inspect_mpint(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifBinary* bin) -{ - return enif_inspect_binary(env, term, bin) && - bin->size >= 4 && get_int32(bin->data) == bin->size-4; -} - -static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (DigestType|none, Data|{digest,Digest}, Signature,Key=[P, Q, G, Y]) */ ErlNifBinary data_bin, sign_bin; BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL, *dsa_y = NULL; @@ -1660,10 +1818,10 @@ static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv digest = data_bin.data; } else { - if (!inspect_mpint(env, argv[1], &data_bin)) { + if (!enif_inspect_binary(env, argv[1], &data_bin)) { return enif_make_badarg(env); } - SHA1(data_bin.data+4, data_bin.size-4, hmacbuf); + SHA1(data_bin.data, data_bin.size, hmacbuf); digest = hmacbuf; } } @@ -1675,15 +1833,15 @@ static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv return enif_make_badarg(env); } - if (!inspect_mpint(env, argv[2], &sign_bin) + if (!enif_inspect_binary(env, argv[2], &sign_bin) || !enif_get_list_cell(env, argv[3], &head, &tail) - || !get_bn_from_mpint(env, head, &dsa_p) + || !get_bn_from_bin(env, head, &dsa_p) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &dsa_q) + || !get_bn_from_bin(env, head, &dsa_q) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &dsa_g) + || !get_bn_from_bin(env, head, &dsa_g) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &dsa_y) + || !get_bn_from_bin(env, head, &dsa_y) || !enif_is_empty_list(env,tail)) { if (dsa_p) BN_free(dsa_p); @@ -1700,7 +1858,7 @@ static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv dsa->priv_key = NULL; dsa->pub_key = dsa_y; i = DSA_verify(0, digest, SHA_DIGEST_LENGTH, - sign_bin.data+4, sign_bin.size-4, dsa); + sign_bin.data, sign_bin.size, dsa); DSA_free(dsa); return(i > 0) ? atom_true : atom_false; } @@ -1826,11 +1984,11 @@ static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM rsa = RSA_new(); - if (!inspect_mpint(env, argv[2], &sign_bin) + if (!enif_inspect_binary(env, argv[2], &sign_bin) || !enif_get_list_cell(env, argv[3], &head, &tail) - || !get_bn_from_mpint(env, head, &rsa->e) + || !get_bn_from_bin(env, head, &rsa->e) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &rsa->n) + || !get_bn_from_bin(env, head, &rsa->n) || !enif_is_empty_list(env, tail)) { ret = enif_make_badarg(env); @@ -1846,9 +2004,9 @@ static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM } digest = data_bin.data; } - else if (inspect_mpint(env, argv[1], &data_bin)) { + else if (enif_inspect_binary(env, argv[1], &data_bin)) { digest = hmacbuf; - digp->funcp(data_bin.data+4, data_bin.size-4, digest); + digp->funcp(data_bin.data, data_bin.size, digest); } else { ret = enif_make_badarg(env); @@ -1856,7 +2014,7 @@ static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM } i = RSA_verify(digp->NID_type, digest, digp->len, - sign_bin.data+4, sign_bin.size-4, rsa); + sign_bin.data, sign_bin.size, rsa); ret = (i==1 ? atom_true : atom_false); @@ -2001,22 +2159,22 @@ static int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa) ERL_NIF_TERM head, tail; if (!enif_get_list_cell(env, key, &head, &tail) - || !get_bn_from_mpint(env, head, &rsa->e) + || !get_bn_from_bin(env, head, &rsa->e) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &rsa->n) + || !get_bn_from_bin(env, head, &rsa->n) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &rsa->d) + || !get_bn_from_bin(env, head, &rsa->d) || (!enif_is_empty_list(env, tail) && (!enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &rsa->p) + || !get_bn_from_bin(env, head, &rsa->p) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &rsa->q) + || !get_bn_from_bin(env, head, &rsa->q) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &rsa->dmp1) + || !get_bn_from_bin(env, head, &rsa->dmp1) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &rsa->dmq1) + || !get_bn_from_bin(env, head, &rsa->dmq1) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &rsa->iqmp) + || !get_bn_from_bin(env, head, &rsa->iqmp) || !enif_is_empty_list(env, tail)))) { return 0; } @@ -2053,11 +2211,11 @@ static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar digest = data_bin.data; } else { - if (!inspect_mpint(env,argv[1],&data_bin)) { + if (!enif_inspect_binary(env,argv[1],&data_bin)) { return enif_make_badarg(env); } digest = hmacbuf; - digp->funcp(data_bin.data+4, data_bin.size-4, digest); + digp->funcp(data_bin.data, data_bin.size, digest); } rsa = RSA_new(); @@ -2112,10 +2270,10 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar digest = data_bin.data; } else { - if (!inspect_mpint(env,argv[1],&data_bin)) { + if (!enif_inspect_binary(env,argv[1],&data_bin)) { return enif_make_badarg(env); } - SHA1(data_bin.data+4, data_bin.size-4, hmacbuf); + SHA1(data_bin.data, data_bin.size, hmacbuf); digest = hmacbuf; } } @@ -2133,13 +2291,13 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar dsa->pub_key = NULL; if (!enif_get_list_cell(env, argv[2], &head, &tail) - || !get_bn_from_mpint(env, head, &dsa->p) + || !get_bn_from_bin(env, head, &dsa->p) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &dsa->q) + || !get_bn_from_bin(env, head, &dsa->q) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &dsa->g) + || !get_bn_from_bin(env, head, &dsa->g) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &dsa->priv_key) + || !get_bn_from_bin(env, head, &dsa->priv_key) || !enif_is_empty_list(env,tail)) { DSA_free(dsa); return enif_make_badarg(env); @@ -2187,9 +2345,9 @@ static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TER if (!enif_inspect_binary(env, argv[0], &data_bin) || !enif_get_list_cell(env, argv[1], &head, &tail) - || !get_bn_from_mpint(env, head, &rsa->e) + || !get_bn_from_bin(env, head, &rsa->e) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &rsa->n) + || !get_bn_from_bin(env, head, &rsa->n) || !enif_is_empty_list(env,tail) || !rsa_pad(argv[2], &padding)) { @@ -2286,14 +2444,12 @@ static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const E } p_len = BN_num_bytes(dh_params->p); g_len = BN_num_bytes(dh_params->g); - p_ptr = enif_make_new_binary(env, p_len+4, &ret_p); - g_ptr = enif_make_new_binary(env, g_len+4, &ret_g); - put_int32(p_ptr, p_len); - put_int32(g_ptr, g_len); - BN_bn2bin(dh_params->p, p_ptr+4); - BN_bn2bin(dh_params->g, g_ptr+4); - ERL_VALGRIND_MAKE_MEM_DEFINED(p_ptr+4, p_len); - ERL_VALGRIND_MAKE_MEM_DEFINED(g_ptr+4, g_len); + p_ptr = enif_make_new_binary(env, p_len, &ret_p); + g_ptr = enif_make_new_binary(env, g_len, &ret_g); + BN_bn2bin(dh_params->p, p_ptr); + BN_bn2bin(dh_params->g, g_ptr); + ERL_VALGRIND_MAKE_MEM_DEFINED(p_ptr, p_len); + ERL_VALGRIND_MAKE_MEM_DEFINED(g_ptr, g_len); DH_free(dh_params); return enif_make_list2(env, ret_p, ret_g); } @@ -2305,9 +2461,9 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] ERL_NIF_TERM ret, head, tail; if (!enif_get_list_cell(env, argv[0], &head, &tail) - || !get_bn_from_mpint(env, head, &dh_params->p) + || !get_bn_from_bin(env, head, &dh_params->p) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &dh_params->g) + || !get_bn_from_bin(env, head, &dh_params->g) || !enif_is_empty_list(env,tail)) { DH_free(dh_params); @@ -2329,19 +2485,21 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] } static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (PrivKey, DHParams=[P,G]) */ +{/* (PrivKey, DHParams=[P,G], Mpint) */ DH* dh_params = DH_new(); int pub_len, prv_len; unsigned char *pub_ptr, *prv_ptr; ERL_NIF_TERM ret, ret_pub, ret_prv, head, tail; + int mpint; /* 0 or 4 */ - if (!(get_bn_from_mpint(env, argv[0], &dh_params->priv_key) + if (!(get_bn_from_bin(env, argv[0], &dh_params->priv_key) || argv[0] == atom_undefined) || !enif_get_list_cell(env, argv[1], &head, &tail) - || !get_bn_from_mpint(env, head, &dh_params->p) + || !get_bn_from_bin(env, head, &dh_params->p) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &dh_params->g) - || !enif_is_empty_list(env, tail)) { + || !get_bn_from_bin(env, head, &dh_params->g) + || !enif_is_empty_list(env, tail) + || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4)) { DH_free(dh_params); return enif_make_badarg(env); } @@ -2349,14 +2507,16 @@ static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_ if (DH_generate_key(dh_params)) { pub_len = BN_num_bytes(dh_params->pub_key); prv_len = BN_num_bytes(dh_params->priv_key); - pub_ptr = enif_make_new_binary(env, pub_len+4, &ret_pub); - prv_ptr = enif_make_new_binary(env, prv_len+4, &ret_prv); - put_int32(pub_ptr, pub_len); - put_int32(prv_ptr, prv_len); - BN_bn2bin(dh_params->pub_key, pub_ptr+4); - BN_bn2bin(dh_params->priv_key, prv_ptr+4); - ERL_VALGRIND_MAKE_MEM_DEFINED(pub_ptr+4, pub_len); - ERL_VALGRIND_MAKE_MEM_DEFINED(prv_ptr+4, prv_len); + pub_ptr = enif_make_new_binary(env, pub_len+mpint, &ret_pub); + prv_ptr = enif_make_new_binary(env, prv_len+mpint, &ret_prv); + if (mpint) { + put_int32(pub_ptr, pub_len); pub_ptr += 4; + put_int32(prv_ptr, prv_len); prv_ptr += 4; + } + BN_bn2bin(dh_params->pub_key, pub_ptr); + BN_bn2bin(dh_params->priv_key, prv_ptr); + ERL_VALGRIND_MAKE_MEM_DEFINED(pub_ptr, pub_len); + ERL_VALGRIND_MAKE_MEM_DEFINED(prv_ptr, prv_len); ret = enif_make_tuple2(env, ret_pub, ret_prv); } else { @@ -2374,12 +2534,12 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T ErlNifBinary ret_bin; ERL_NIF_TERM ret, head, tail; - if (!get_bn_from_mpint(env, argv[0], &pubkey) - || !get_bn_from_mpint(env, argv[1], &dh_params->priv_key) + if (!get_bn_from_bin(env, argv[0], &pubkey) + || !get_bn_from_bin(env, argv[1], &dh_params->priv_key) || !enif_get_list_cell(env, argv[2], &head, &tail) - || !get_bn_from_mpint(env, head, &dh_params->p) + || !get_bn_from_bin(env, head, &dh_params->p) || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_mpint(env, head, &dh_params->g) + || !get_bn_from_bin(env, head, &dh_params->g) || !enif_is_empty_list(env, tail)) { ret = enif_make_badarg(env); @@ -2457,7 +2617,7 @@ static ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM return ret; } -static ERL_NIF_TERM srp_client_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (a, u, B, Multiplier, Prime, Exponent, Generator) */ /* <premaster secret> = (B - (k * g^x)) ^ (a + (u * x)) % N @@ -2537,7 +2697,7 @@ static ERL_NIF_TERM srp_client_secret_nif(ErlNifEnv* env, int argc, const ERL_NI return ret; } -static ERL_NIF_TERM srp_server_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Verifier, b, u, A, Prime) */ /* <premaster secret> = (A * v^u) ^ b % N @@ -2686,7 +2846,554 @@ static ERL_NIF_TERM blowfish_ofb64_encrypt(ErlNifEnv* env, int argc, const ERL_N return ret; } +#if defined(HAVE_EC) +static int term2curve_id(ERL_NIF_TERM nid) +{ + int i; + + for (i = 0; i < EC_CURVES_CNT; i++) + if (ec_curves[i].atom == nid) + return ec_curves[i].nid; + + return 0; +} +static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg) +{ + EC_KEY *key = NULL; + int nid = 0; + int c_arity = -1; + const ERL_NIF_TERM* curve; + ErlNifBinary seed; + BIGNUM *p = NULL; + BIGNUM *a = NULL; + BIGNUM *b = NULL; + BIGNUM *bn_order = NULL; + BIGNUM *cofactor = NULL; + EC_GROUP *group = NULL; + EC_POINT *point = NULL; + + if (enif_is_atom(env, curve_arg)) { + nid = term2curve_id(curve_arg); + if (nid == 0) + return NULL; + key = EC_KEY_new_by_curve_name(nid); + } + else if (enif_is_tuple(env, curve_arg) + && enif_get_tuple(env,curve_arg,&c_arity,&curve) + && c_arity == 5 + && get_bn_from_bin(env, curve[3], &bn_order) + && (curve[4] != atom_none && get_bn_from_bin(env, curve[4], &cofactor))) { + //* {Field, Prime, Point, Order, CoFactor} = Curve */ + + int f_arity = -1; + const ERL_NIF_TERM* field; + int p_arity = -1; + const ERL_NIF_TERM* prime; + + long field_bits; + + /* {A, B, Seed} = Prime */ + if (!enif_get_tuple(env,curve[1],&p_arity,&prime) + || !get_bn_from_bin(env, prime[0], &a) + || !get_bn_from_bin(env, prime[1], &b)) + goto out_err; + + if (!enif_get_tuple(env,curve[0],&f_arity,&field)) + goto out_err; + + if (f_arity == 2 && field[0] == atom_prime_field) { + /* {prime_field, Prime} */ + + if (!get_bn_from_bin(env, field[1], &p)) + goto out_err; + + if (BN_is_negative(p) || BN_is_zero(p)) + goto out_err; + + field_bits = BN_num_bits(p); + if (field_bits > OPENSSL_ECC_MAX_FIELD_BITS) + goto out_err; + + /* create the EC_GROUP structure */ + group = EC_GROUP_new_curve_GFp(p, a, b, NULL); + + } else if (f_arity == 3 && field[0] == atom_characteristic_two_field) { + /* {characteristic_two_field, M, Basis} */ + + int b_arity = -1; + const ERL_NIF_TERM* basis; + unsigned int k1, k2, k3; + + if ((p = BN_new()) == NULL) + goto out_err; + + if (!enif_get_long(env, field[1], &field_bits) + || field_bits > OPENSSL_ECC_MAX_FIELD_BITS) + goto out_err; + + if (enif_get_tuple(env,field[2],&b_arity,&basis)) { + if (b_arity == 2 + && basis[0] == atom_tpbasis + && enif_get_uint(env, basis[1], &k1)) { + /* {tpbasis, k} = Basis */ + + if (!(field_bits > k1 && k1 > 0)) + goto out_err; + + /* create the polynomial */ + if (!BN_set_bit(p, (int)field_bits) + || !BN_set_bit(p, (int)k1) + || !BN_set_bit(p, 0)) + goto out_err; + + } else if (b_arity == 4 + && basis[0] == atom_ppbasis + && enif_get_uint(env, basis[1], &k1) + && enif_get_uint(env, basis[2], &k2) + && enif_get_uint(env, basis[3], &k3)) { + /* {ppbasis, k1, k2, k3} = Basis */ + + if (!(field_bits > k3 && k3 > k2 && k2 > k1 && k1 > 0)) + goto out_err; + + /* create the polynomial */ + if (!BN_set_bit(p, (int)field_bits) + || !BN_set_bit(p, (int)k1) + || !BN_set_bit(p, (int)k2) + || !BN_set_bit(p, (int)k3) + || !BN_set_bit(p, 0)) + goto out_err; + + } else + goto out_err; + } else if (field[2] == atom_onbasis) { + /* onbasis = Basis */ + /* no parameters */ + goto out_err; + + } else + goto out_err; + + group = EC_GROUP_new_curve_GF2m(p, a, b, NULL); + } else + goto out_err; + + if (enif_inspect_binary(env, prime[2], &seed)) { + EC_GROUP_set_seed(group, seed.data, seed.size); + } + + if (!term2point(env, curve[2], group, &point)) + goto out_err; + + if (BN_is_negative(bn_order) + || BN_is_zero(bn_order) + || BN_num_bits(bn_order) > (int)field_bits + 1) + goto out_err; + + if (!EC_GROUP_set_generator(group, point, bn_order, cofactor)) + goto out_err; + + EC_GROUP_set_asn1_flag(group, 0x0); + + key = EC_KEY_new(); + if (!key) + goto out_err; + EC_KEY_set_group(key, group); + } + else { + goto out_err; + } + + + goto out; + +out_err: + if (key) EC_KEY_free(key); + key = NULL; + +out: + /* some OpenSSL structures are mem-dup'ed into the key, + so we have to free our copies here */ + if (p) BN_free(p); + if (a) BN_free(a); + if (b) BN_free(b); + if (bn_order) BN_free(bn_order); + if (cofactor) BN_free(cofactor); + if (group) EC_GROUP_free(group); + + return key; +} + + +static ERL_NIF_TERM bn2term(ErlNifEnv* env, const BIGNUM *bn) +{ + unsigned dlen; + unsigned char* ptr; + ERL_NIF_TERM ret; + + if (!bn) + return atom_undefined; + + dlen = BN_num_bytes(bn); + ptr = enif_make_new_binary(env, dlen, &ret); + BN_bn2bin(bn, ptr); + + return ret; +} + +static ERL_NIF_TERM point2term(ErlNifEnv* env, + const EC_GROUP *group, + const EC_POINT *point, + point_conversion_form_t form) +{ + unsigned dlen; + ErlNifBinary bin; + + dlen = EC_POINT_point2oct(group, point, form, NULL, 0, NULL); + if (dlen == 0) + return atom_undefined; + + if (!enif_alloc_binary(dlen, &bin)) + return enif_make_badarg(env); + + if (!EC_POINT_point2oct(group, point, form, bin.data, bin.size, NULL)) { + enif_release_binary(&bin); + return enif_make_badarg(env); + } + + return enif_make_binary(env, &bin); +} +#endif + +static ERL_NIF_TERM ec_key_to_term_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ +#if defined(HAVE_EC) + struct nif_ec_key *obj; + const EC_GROUP *group; + const EC_POINT *public_key; + const BIGNUM *priv_key = NULL; + ERL_NIF_TERM pub_key = atom_undefined; + + if (!enif_get_resource(env, argv[0], res_type_ec_key, (void **)&obj)) + return enif_make_badarg(env); + + group = EC_KEY_get0_group(obj->key); + public_key = EC_KEY_get0_public_key(obj->key); + priv_key = EC_KEY_get0_private_key(obj->key); + + if (group) { + if (public_key) + pub_key = point2term(env, group, public_key, EC_KEY_get_conv_form(obj->key)); + } + + return enif_make_tuple2(env, pub_key, bn2term(env, priv_key)); +#else + return atom_notsup; +#endif +} + +#if defined(HAVE_EC) +static int term2point(ErlNifEnv* env, ERL_NIF_TERM term, + EC_GROUP *group, EC_POINT **pptr) +{ + int ret = 0; + ErlNifBinary bin; + EC_POINT *point; + + if (!enif_inspect_binary(env,term,&bin)) { + return 0; + } + + if ((*pptr = point = EC_POINT_new(group)) == NULL) { + return 0; + } + + /* set the point conversion form */ + EC_GROUP_set_point_conversion_form(group, (point_conversion_form_t)(bin.data[0] & ~0x01)); + + /* extract the ec point */ + if (!EC_POINT_oct2point(group, point, bin.data, bin.size, NULL)) { + EC_POINT_free(point); + *pptr = NULL; + } else + ret = 1; + + return ret; +} +#endif + +static ERL_NIF_TERM term_to_ec_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ +#if defined(HAVE_EC) + ERL_NIF_TERM ret; + EC_KEY *key = NULL; + BIGNUM *priv_key = NULL; + EC_POINT *pub_key = NULL; + struct nif_ec_key *obj; + EC_GROUP *group = NULL; + + if (!(argv[1] == atom_undefined || get_bn_from_bin(env, argv[1], &priv_key)) + || !(argv[2] == atom_undefined || enif_is_binary(env, argv[2]))) { + goto out_err; + } + + key = ec_key_new(env, argv[0]); + + if (!key) { + goto out_err; + } + + if (!group) + group = EC_GROUP_dup(EC_KEY_get0_group(key)); + + if (term2point(env, argv[2], group, &pub_key)) { + if (!EC_KEY_set_public_key(key, pub_key)) { + goto out_err; + } + } + if (argv[1] != atom_undefined + && !BN_is_zero(priv_key)) { + if (!EC_KEY_set_private_key(key, priv_key)) + goto out_err; + + /* calculate public key (if necessary) */ + if (EC_KEY_get0_public_key(key) == NULL) + { + /* the public key was not included in the SEC1 private + * key => calculate the public key */ + pub_key = EC_POINT_new(group); + if (pub_key == NULL + || !EC_POINT_copy(pub_key, EC_GROUP_get0_generator(group)) + || !EC_POINT_mul(group, pub_key, priv_key, NULL, NULL, NULL) + || !EC_KEY_set_public_key(key, pub_key)) + goto out_err; + } + } + + obj = enif_alloc_resource(res_type_ec_key, sizeof(struct nif_ec_key)); + if (!obj) + goto out_err; + + obj->key = key; + ret = enif_make_resource(env, obj); + enif_release_resource(obj); + + goto out; + +out_err: + if (key) EC_KEY_free(key); + ret = enif_make_badarg(env); + +out: + /* some OpenSSL structures are mem-dup'ed into the key, + so we have to free our copies here */ + if (priv_key) BN_clear_free(priv_key); + if (pub_key) EC_POINT_free(pub_key); + if (group) EC_GROUP_free(group); + return ret; +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ +#if defined(HAVE_EC) + EC_KEY *key = ec_key_new(env, argv[0]); + + if (key && EC_KEY_generate_key(key)) { + ERL_NIF_TERM term; + struct nif_ec_key *obj = enif_alloc_resource(res_type_ec_key, sizeof(struct nif_ec_key)); + if (!obj) + return atom_error; + obj->key = key; + term = enif_make_resource(env, obj); + enif_release_resource(obj); + return term; + } + else + return enif_make_badarg(env); +#else + return atom_notsup; +#endif +} + +#if defined(HAVE_EC) +static void ec_key_dtor(ErlNifEnv* env, void* obj) +{ + struct nif_ec_key *key = (struct nif_ec_key*) obj; + EC_KEY_free(key->key); +} +#endif + +static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type, Data|{digest,Digest}, Key) */ +#if defined(HAVE_EC) + ErlNifBinary data_bin, ret_bin; + unsigned char hmacbuf[SHA_DIGEST_LENGTH]; + unsigned int dsa_s_len; + struct nif_ec_key *obj; + int i; + const ERL_NIF_TERM* tpl_terms; + int tpl_arity; + struct digest_type_t *digp; + unsigned char* digest; + + digp = get_digest_type(argv[0]); + if (!digp) { + return enif_make_badarg(env); + } + if (!digp->len) { + return atom_notsup; + } + + if (!enif_get_resource(env, argv[2], res_type_ec_key, (void **)&obj)) + return enif_make_badarg(env); + + if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { + if (tpl_arity != 2 || tpl_terms[0] != atom_digest + || !enif_inspect_binary(env, tpl_terms[1], &data_bin) + || data_bin.size != digp->len) { + + return enif_make_badarg(env); + } + digest = data_bin.data; + } + else { + if (!enif_inspect_binary(env,argv[1],&data_bin)) { + return enif_make_badarg(env); + } + digest = hmacbuf; + digp->funcp(data_bin.data, data_bin.size, digest); + } + + enif_alloc_binary(ECDSA_size(obj->key), &ret_bin); + + i = ECDSA_sign(digp->NID_type, digest, digp->len, + ret_bin.data, &dsa_s_len, obj->key); + if (i) { + if (dsa_s_len != ret_bin.size) { + enif_realloc_binary(&ret_bin, dsa_s_len); + } + return enif_make_binary(env, &ret_bin); + } + else { + enif_release_binary(&ret_bin); + return atom_error; + } +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type, Data|{digest,Digest}, Signature, Key) */ +#if defined(HAVE_EC) + ErlNifBinary data_bin, sign_bin; + unsigned char hmacbuf[SHA512_LEN]; + int i; + struct nif_ec_key *obj; + const ERL_NIF_TERM type = argv[0]; + const ERL_NIF_TERM* tpl_terms; + int tpl_arity; + struct digest_type_t* digp = NULL; + unsigned char* digest = NULL; + + digp = get_digest_type(type); + if (!digp) { + return enif_make_badarg(env); + } + if (!digp->len) { + return atom_notsup; + } + + if (!enif_inspect_binary(env, argv[2], &sign_bin) + || !enif_get_resource(env, argv[3], res_type_ec_key, (void **)&obj)) + return enif_make_badarg(env); + + if (enif_get_tuple(env, argv[1], &tpl_arity, &tpl_terms)) { + if (tpl_arity != 2 || tpl_terms[0] != atom_digest + || !enif_inspect_binary(env, tpl_terms[1], &data_bin) + || data_bin.size != digp->len) { + + return enif_make_badarg(env); + } + digest = data_bin.data; + } + else if (enif_inspect_binary(env, argv[1], &data_bin)) { + digest = hmacbuf; + digp->funcp(data_bin.data, data_bin.size, digest); + } + else { + return enif_make_badarg(env); + } + + i = ECDSA_verify(digp->NID_type, digest, digp->len, + sign_bin.data, sign_bin.size, obj->key); + + return (i==1 ? atom_true : atom_false); +#else + return atom_notsup; +#endif +} + +/* + (_OthersPublicKey, _MyPrivateKey) + (_OthersPublicKey, _MyEC_Point) +*/ +static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ +#if defined(HAVE_EC) + ERL_NIF_TERM ret; + unsigned char *p; + struct nif_ec_key *other_key; + int field_size = 0; + int i; + + EC_GROUP *group; + const BIGNUM *priv_key; + EC_POINT *my_ecpoint; + EC_KEY *other_ecdh = NULL; + + if (!enif_get_resource(env, argv[1], res_type_ec_key, (void **)&other_key)) + return enif_make_badarg(env); + + group = EC_GROUP_dup(EC_KEY_get0_group(other_key->key)); + priv_key = EC_KEY_get0_private_key(other_key->key); + + if (!term2point(env, argv[0], group, &my_ecpoint)) { + goto out_err; + } + + if ((other_ecdh = EC_KEY_new()) == NULL + || !EC_KEY_set_group(other_ecdh, group) + || !EC_KEY_set_private_key(other_ecdh, priv_key)) + goto out_err; + + field_size = EC_GROUP_get_degree(group); + if (field_size <= 0) + goto out_err; + + p = enif_make_new_binary(env, (field_size+7)/8, &ret); + i = ECDH_compute_key(p, (field_size+7)/8, my_ecpoint, other_ecdh, NULL); + + if (i < 0) + goto out_err; +out: + if (group) EC_GROUP_free(group); + if (my_ecpoint) EC_POINT_free(my_ecpoint); + if (other_ecdh) EC_KEY_free(other_ecdh); + + return ret; + +out_err: + ret = enif_make_badarg(env); + goto out; +#else + return atom_notsup; +#endif +} /* HMAC */ diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 7eca4557d9..2df407018e 100755..100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -22,263 +22,234 @@ </legalnotice> <title>crypto</title> - <prepared>Peter Högfeldt</prepared> - <docno></docno> - <date>2000-06-20</date> - <rev>B</rev> </header> <module>crypto</module> <modulesummary>Crypto Functions</modulesummary> <description> <p>This module provides a set of cryptographic functions. </p> - <p>References:</p> <list type="bulleted"> <item> - <p>md4: The MD4 Message Digest Algorithm (RFC 1320)</p> - </item> - <item> - <p>md5: The MD5 Message Digest Algorithm (RFC 1321)</p> - </item> - <item> - <p>sha: Secure Hash Standard (FIPS 180-2)</p> - </item> - <item> - <p>hmac: Keyed-Hashing for Message Authentication (RFC 2104)</p> - </item> - <item> - <p>des: Data Encryption Standard (FIPS 46-3)</p> + <p>Hash functions - + <url href="http://csrc.nist.gov/publications/fips/fips180-4/fips-180-4.pdf"> Secure Hash Standard</url>, + <url href="http://www.ietf.org/rfc/rfc1321.txt"> The MD5 Message Digest Algorithm (RFC 1321)</url> and + <url href="http://www.ietf.org/rfc/rfc1320.txt">The MD4 Message Digest Algorithm (RFC 1320)</url> + </p> </item> <item> - <p>aes: Advanced Encryption Standard (AES) (FIPS 197) </p> + <p>Hmac functions - <url href="http://www.ietf.org/rfc/rfc2104.txt"> Keyed-Hashing for Message Authentication (RFC 2104) </url></p> </item> <item> - <p>ecb, cbc, cfb, ofb, ctr: Recommendation for Block Cipher Modes - of Operation (NIST SP 800-38A).</p> + <p>Block ciphers - <url href="http://csrc.nist.gov/groups/ST/toolkit/block_ciphers.html"> </url> DES and AES in + Block Cipher Modes - <url href="http://csrc.nist.gov/groups/ST/toolkit/BCM/index.html"> ECB, CBC, CFB, OFB and CTR </url></p> </item> <item> - <p>rsa: Recommendation for Block Cipher Modes of Operation - (NIST 800-38A)</p> + <p><url href="http://www.ietf.org/rfc/rfc1321.txt"> RSA encryption RFC 1321 </url> </p> </item> <item> - <p>dss: Digital Signature Standard (FIPS 186-2)</p> + <p>Digital signatures <url href="http://csrc.nist.gov/publications/drafts/fips186-3/fips_186-3.pdf">Digital Signature Standard (DSS)</url> and<url href="http://csrc.nist.gov/groups/STM/cavp/documents/dss2/ecdsa2vs.pdf"> Elliptic Curve Digital + Signature Algorithm (ECDSA) </url> </p> </item> <item> - <p>srp: Secure Remote Password Protocol (RFC 2945)</p> + <p><url href="http://www.ietf.org/rfc/rfc2945.txt"> Secure Remote Password Protocol (SRP - RFC 2945) </url></p> </item> - - </list> - <p>The above publications can be found at <url href="http://csrc.nist.gov/publications">NIST publications</url>, at <url href="http://www.ietf.org">IETF</url>. - </p> - <p><em>Types</em></p> - <pre> -byte() = 0 ... 255 -ioelem() = byte() | binary() | iolist() -iolist() = [ioelem()] -Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> - </pre> - <p></p> </description> + + <section> + <title>DATA TYPES </title> + + <p><code>key_value() = integer() | binary() </code></p> + <p>Always <c>binary()</c> when used as return value</p> + + <p><code>rsa_public() = [key_value()] = [E, N] </code></p> + <p> Where E is the public exponent and N is public modulus. </p> + + <p><code>rsa_private() = [key_value()] = [E, N, D] | [E, N, D, P1, P2, E1, E2, C] </code></p> + <p>Where E is the public exponent, N is public modulus and D is + the private exponent.The longer key format contains redundant + information that will make the calculation faster. P1,P2 are first + and second prime factors. E1,E2 are first and second exponents. C + is the CRT coefficient. Terminology is taken from <url href="http://www.ietf.org/rfc/rfc3477.txt"> RFC 3447</url>.</p> + + <p><code>dss_public() = [key_value()] = [P, Q, G, Y] </code></p> + <p>Where P, Q and G are the dss parameters and Y is the public key.</p> + + <p><code>dss_private() = [key_value()] = [P, Q, G, X] </code></p> + <p>Where P, Q and G are the dss parameters and X is the private key.</p> + + <p><code>srp_public() = key_value() </code></p> + <p>Where is <c>A</c> or <c>B</c> from <url href="http://srp.stanford.edu/design.html">SRP design</url></p> + + <p><code>srp_private() = key_value() </code></p> + <p>Where is <c>a</c> or <c>b</c> from <url href="http://srp.stanford.edu/design.html">SRP design</url></p> + + <p>Where Verifier is <c>v</c>, Generator is <c>g</c> and Prime is<c> N</c>, DerivedKey is <c>X</c>, and Scrambler is + <c>u</c> (optional will be generated if not provided) from <url href="http://srp.stanford.edu/design.html">SRP design</url> + Version = '3' | '6' | '6a' + </p> + + <p><code>dh_public() = key_value() </code></p> + + <p><code>dh_private() = key_value() </code></p> + + <p><code>dh_params() = [key_value()] = [P, G] </code></p> + + <p><code>ecdh_public() = key_value() </code></p> + + <p><code>ecdh_private() = key_value() </code></p> + + <p><code>ecdh_params() = ec_named_curve() | + {ec_field(), Prime :: key_value(), Point :: key_value(), Order :: integer(), CoFactor :: none | integer()} </code></p> + + <p><code>ec_field() = {prime_field, Prime :: integer()} | + {characteristic_two_field, M :: integer(), Basis :: ec_basis()}</code></p> + + <p><code>ec_basis() = {tpbasis, K :: non_neg_integer()} | + {ppbasis, K1 :: non_neg_integer(), K2 :: non_neg_integer(), K3 :: non_neg_integer()} | + onbasis</code></p> + + <p><code>ec_named_curve() -> + sect571r1| sect571k1| sect409r1| sect409k1| secp521r1| secp384r1| secp224r1| secp224k1| + secp192k1| secp160r2| secp128r2| secp128r1| sect233r1| sect233k1| sect193r2| sect193r1| + sect131r2| sect131r1| sect283r1| sect283k1| sect163r2| secp256k1| secp160k1| secp160r1| + secp112r2| secp112r1| sect113r2| sect113r1| sect239k1| sect163r1| sect163k1| secp256r1| + secp192r1 </code></p> + + <p><code>stream_cipher() = rc4 | aes_ctr </code></p> + + <p><code>block_cipher() = aes_cbc128 | aes_cfb128 | blowfish_cbc | + blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf + | des_ede3 | rc2_cbc </code></p> + + <p><code>stream_key() = aes_key() | rc4_key() </code></p> + + <p><code>block_key() = aes_key() | blowfish_key() | des_key()| des3_key() </code></p> + + <p><code>aes_key() = iodata() </code> Key length is 128, 192 or 256 bits</p> + + <p><code>rc4_key() = iodata() </code> Variable key length from 8 bits up to 2048 bits (usually between 40 and 256)</p> + + <p><code>blowfish_key() = iodata() </code> Variable key length from 32 bits up to 448 bits</p> + + <p><code>des_key() = iodata() </code> Key length is 64 bits (in CBC mode only 8 bits are used)</p> + + <p><code>des3_key() = [binary(), binary(), binary()] </code> Each key part is 64 bits (in CBC mode only 8 bits are used)</p> + + <p><code>digest_type() = md5 | sha | sha224 | sha256 | sha384 | sha512</code></p> + + <p><code> hash_algorithms() = md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512 </code> md4 is also supported for hash_init/1 and hash/2. + Note that both md4 and md5 are recommended only for compatibility with existing applications. + </p> + <p><code> cipher_algorithms() = des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | + blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb128| aes_cbc256 | rc2_cbc | aes_ctr| rc4 </code> </p> + <p><code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh </code> </p> + + </section> + <funcs> - <func> - <name>start() -> ok</name> - <fsummary>Start the crypto server.</fsummary> - <desc> - <p>Starts the crypto server.</p> - </desc> - </func> - <func> - <name>stop() -> ok</name> - <fsummary>Stop the crypto server.</fsummary> - <desc> - <p>Stops the crypto server.</p> - </desc> - </func> - <func> - <name>info() -> [atom()]</name> - <fsummary>Provide a list of available crypto functions.</fsummary> - <desc> - <p>Provides the available crypto functions in terms of a list - of atoms.</p> - </desc> - </func> - <func> - <name>algorithms() -> [atom()]</name> - <fsummary>Provide a list of available crypto algorithms.</fsummary> - <desc> - <p>Provides the available crypto algorithms in terms of a list - of atoms.</p> - </desc> - </func> - <func> - <name>info_lib() -> [{Name,VerNum,VerStr}]</name> - <fsummary>Provides information about the libraries used by crypto.</fsummary> - <type> - <v>Name = binary()</v> - <v>VerNum = integer()</v> - <v>VerStr = binary()</v> - </type> - <desc> - <p>Provides the name and version of the libraries used by crypto.</p> - <p><c>Name</c> is the name of the library. <c>VerNum</c> is - the numeric version according to the library's own versioning - scheme. <c>VerStr</c> contains a text variant of the version.</p> - <pre> -> <input>info_lib().</input> -[{<<"OpenSSL">>,9469983,<<"OpenSSL 0.9.8a 11 Oct 2005">>}] - </pre> - <note><p> - From OTP R16 the <em>numeric version</em> represents the version of the OpenSSL - <em>header files</em> (<c>openssl/opensslv.h</c>) used when crypto was compiled. - The text variant represents the OpenSSL library used at runtime. - In earlier OTP versions both numeric and text was taken from the library. - </p></note> - </desc> - </func> - <func> - <name>md4(Data) -> Digest</name> - <fsummary>Compute an <c>MD4</c>message digest from <c>Data</c></fsummary> + <func> + <name>block_encrypt(Type, Key, Ivec, PlainText) -> CipherText</name> + <fsummary>Encrypt <c>PlainText</c>according to <c>Type</c> block cipher</fsummary> <type> - <v>Data = iolist() | binary()</v> - <v>Digest = binary()</v> + <v>Type = block_cipher() </v> + <v>Key = block_key() </v> + <v>PlainText = iodata() </v> + <v>IVec = CipherText = binary()</v> </type> <desc> - <p>Computes an <c>MD4</c> message digest from <c>Data</c>, where - the length of the digest is 128 bits (16 bytes).</p> - </desc> - </func> - <func> - <name>md4_init() -> Context</name> - <fsummary>Creates an MD4 context</fsummary> - <type> - <v>Context = binary()</v> - </type> - <desc> - <p>Creates an MD4 context, to be used in subsequent calls to - <c>md4_update/2</c>.</p> - </desc> - </func> - <func> - <name>md4_update(Context, Data) -> NewContext</name> - <fsummary>Update an MD4 <c>Context</c>with <c>Data</c>, and return a <c>NewContext</c></fsummary> - <type> - <v>Data = iolist() | binary()</v> - <v>Context = NewContext = binary()</v> - </type> - <desc> - <p>Updates an MD4 <c>Context</c> with <c>Data</c>, and returns - a <c>NewContext</c>.</p> - </desc> - </func> - <func> - <name>md4_final(Context) -> Digest</name> - <fsummary>Finish the update of an MD4 <c>Context</c>and return the computed <c>MD4</c>message digest</fsummary> - <type> - <v>Context = Digest = binary()</v> - </type> - <desc> - <p>Finishes the update of an MD4 <c>Context</c> and returns - the computed <c>MD4</c> message digest.</p> - </desc> - </func> - <func> - <name>md5(Data) -> Digest</name> - <fsummary>Compute an <c>MD5</c>message digest from <c>Data</c></fsummary> - <type> - <v>Data = iolist() | binary()</v> - <v>Digest = binary()</v> - </type> - <desc> - <p>Computes an <c>MD5</c> message digest from <c>Data</c>, where - the length of the digest is 128 bits (16 bytes).</p> - </desc> - </func> - <func> - <name>md5_init() -> Context</name> - <fsummary>Creates an MD5 context</fsummary> - <type> - <v>Context = binary()</v> - </type> - <desc> - <p>Creates an MD5 context, to be used in subsequent calls to - <c>md5_update/2</c>.</p> - </desc> - </func> - <func> - <name>md5_update(Context, Data) -> NewContext</name> - <fsummary>Update an MD5 <c>Context</c>with <c>Data</c>, and return a <c>NewContext</c></fsummary> - <type> - <v>Data = iolist() | binary()</v> - <v>Context = NewContext = binary()</v> - </type> - <desc> - <p>Updates an MD5 <c>Context</c> with <c>Data</c>, and returns - a <c>NewContext</c>.</p> + <p>Encrypt <c>PlainText</c>according to <c>Type</c> block cipher. + <c>IVec</c> is an arbitrary initializing vector. + </p> </desc> </func> + <func> - <name>md5_final(Context) -> Digest</name> - <fsummary>Finish the update of an MD5 <c>Context</c>and return the computed <c>MD5</c>message digest</fsummary> + <name>block_decrypt(Type, Key, Ivec, CipherText) -> PlainText</name> + <fsummary>Decrypt <c>CipherText</c>according to <c>Type</c> block cipher</fsummary> <type> - <v>Context = Digest = binary()</v> + <v>Type = block_cipher() </v> + <v>Key = block_key() </v> + <v>PlainText = iodata() </v> + <v>IVec = CipherText = binary()</v> </type> <desc> - <p>Finishes the update of an MD5 <c>Context</c> and returns - the computed <c>MD5</c> message digest.</p> + <p>Decrypt <c>CipherText</c>according to <c>Type</c> block cipher. + <c>IVec</c> is an arbitrary initializing vector. + </p> </desc> </func> - <func> - <name>sha(Data) -> Digest</name> - <fsummary>Compute an <c>SHA</c>message digest from <c>Data</c></fsummary> + + <func> + <name>bytes_to_integer(Bin) -> Integer </name> + <fsummary>Convert binary representation, of an integer, to an Erlang integer.</fsummary> <type> - <v>Data = iolist() | binary()</v> - <v>Digest = binary()</v> + <v>Bin = binary() - as returned by crypto functions</v> + + <v>Integer = integer() </v> </type> <desc> - <p>Computes an <c>SHA</c> message digest from <c>Data</c>, where - the length of the digest is 160 bits (20 bytes).</p> + <p>Convert binary representation, of an integer, to an Erlang integer. + </p> </desc> </func> + <func> - <name>sha_init() -> Context</name> - <fsummary>Create an SHA context</fsummary> + <name>compute_key(Type, OthersPublicKey, MyKey, Params) -> SharedSecret</name> + <fsummary>Computes the shared secret</fsummary> <type> - <v>Context = binary()</v> + <v> Type = dh | ecdh | srp </v> + <v>OthersPublicKey = dh_public() | ecdh_public() | srp_public() </v> + <v>MyKey = dh_private() | ecdh_private() | {srp_public(),srp_private()}</v> + <v>Params = dh_params() | ecdh_params() | SrpUserParams | SrpHostParams</v> + <v>SrpUserParams = {user, [DerivedKey::binary(), Prime::binary(), Generator::binary(), Version::atom() | [Scrambler:binary()]]} </v> + <v>SrpHostParams = {host, [Verifier::binary(), Prime::binary(), Version::atom() | [Scrambler::binary]]} </v> + <v>SharedSecret = binary()</v> </type> <desc> - <p>Creates an SHA context, to be used in subsequent calls to - <c>sha_update/2</c>.</p> + <p>Computes the shared secret from the private key and the other party's public key. + See also <seealso marker="public_key:public_key#compute_key/2">public_key:compute_key/2</seealso> + </p> </desc> </func> + <func> - <name>sha_update(Context, Data) -> NewContext</name> - <fsummary>Update an SHA context</fsummary> + <name>exor(Data1, Data2) -> Result</name> + <fsummary>XOR data</fsummary> <type> - <v>Data = iolist() | binary()</v> - <v>Context = NewContext = binary()</v> + <v>Data1, Data2 = iodata()</v> + <v>Result = binary()</v> </type> <desc> - <p>Updates an SHA <c>Context</c> with <c>Data</c>, and returns - a <c>NewContext</c>.</p> + <p>Performs bit-wise XOR (exclusive or) on the data supplied.</p> </desc> </func> - <func> - <name>sha_final(Context) -> Digest</name> - <fsummary>Finish the update of an SHA context</fsummary> - <type> - <v>Context = Digest = binary()</v> - </type> - <desc> - <p>Finishes the update of an SHA <c>Context</c> and returns - the computed <c>SHA</c> message digest.</p> + + <func> + <name>generate_key(Type, Params) -> {PublicKey, PrivKeyOut} </name> + <name>generate_key(Type, Params, PrivKeyIn) -> {PublicKey, PrivKeyOut} </name> + <fsummary>Generates a public keys of type <c>Type</c></fsummary> + <type> + <v> Type = dh | ecdh | srp </v> + <v>Params = dh_params() | ecdh_params() | SrpUserParams | SrpHostParams </v> + <v>SrpUserParams = {user, [Generator::binary(), Prime::binary(), Version::atom()]}</v> + <v>SrpHostParams = {host, [Verifier::binary(), Generator::binary(), Prime::binary(), Version::atom()]}</v> + <v>PublicKey = dh_public() | ecdh_public() | srp_public() </v> + <v>PrivKeyIn = undefined | dh_private() | srp_private() </v> + <v>PrivKeyOut = dh_private() | ecdh_private() | srp_private() </v> + </type> + <desc> + <p>Generates public keys of type <c>Type</c>. + See also <seealso marker="public_key:public_key#generate_key/1">public_key:generate_key/1</seealso> + </p> </desc> </func> - <func> + + <func> <name>hash(Type, Data) -> Digest</name> <fsummary></fsummary> <type> - <v>Type = md4 | md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512</v> + <v>Type = md4 | hash_algorithms()</v> <v>Data = iodata()</v> <v>Digest = binary()</v> </type> @@ -288,11 +259,12 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> is not supported by the underlying OpenSSL implementation.</p> </desc> </func> + <func> <name>hash_init(Type) -> Context</name> <fsummary></fsummary> <type> - <v>Type = md4 | md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512</v> + <v>Type = md4 | hash_algorithms()</v> </type> <desc> <p>Initializes the context for streaming hash operations. <c>Type</c> determines @@ -302,6 +274,7 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> is not supported by the underlying OpenSSL implementation.</p> </desc> </func> + <func> <name>hash_update(Context, Data) -> NewContext</name> <fsummary></fsummary> @@ -329,38 +302,13 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> function used to generate it.</p> </desc> </func> - <func> - <name>md5_mac(Key, Data) -> Mac</name> - <fsummary>Compute an <c>MD5 MAC</c>message authentification code</fsummary> - <type> - <v>Key = Data = iolist() | binary()</v> - <v>Mac = binary()</v> - </type> - <desc> - <p>Computes an <c>MD5 MAC</c> message authentification code - from <c>Key</c> and <c>Data</c>, where the the length of the - Mac is 128 bits (16 bytes).</p> - </desc> - </func> - <func> - <name>md5_mac_96(Key, Data) -> Mac</name> - <fsummary>Compute an <c>MD5 MAC</c>message authentification code</fsummary> - <type> - <v>Key = Data = iolist() | binary()</v> - <v>Mac = binary()</v> - </type> - <desc> - <p>Computes an <c>MD5 MAC</c> message authentification code - from <c>Key</c> and <c>Data</c>, where the length of the Mac - is 96 bits (12 bytes).</p> - </desc> - </func> + <func> <name>hmac(Type, Key, Data) -> Mac</name> <name>hmac(Type, Key, Data, MacLength) -> Mac</name> <fsummary></fsummary> <type> - <v>Type = md5 | sha | sha224 | sha256 | sha384 | sha512</v> + <v>Type = hash_algorithms() - except ripemd160</v> <v>Key = iodata()</v> <v>Data = iodata()</v> <v>MacLength = integer()</v> @@ -372,12 +320,13 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> will limit the size of the resultant <c>Mac</c>. </desc> </func> + <func> <name>hmac_init(Type, Key) -> Context</name> <fsummary></fsummary> <type> - <v>Type = md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512</v> - <v>Key = iolist() | binary()</v> + <v>Type = hash_algorithms() - except ripemd160</v> + <v>Key = iodata()</v> <v>Context = binary()</v> </type> <desc> @@ -386,20 +335,26 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> key. The key can be any length.</p> </desc> </func> + <func> <name>hmac_update(Context, Data) -> NewContext</name> <fsummary></fsummary> <type> <v>Context = NewContext = binary()</v> - <v>Data = iolist() | binary()</v> + <v>Data = iodata()</v> </type> <desc> <p>Updates the HMAC represented by <c>Context</c> using the given <c>Data</c>. <c>Context</c> must have been generated using an HMAC init function (such as <seealso marker="#hmac_init/2">hmac_init</seealso>). <c>Data</c> can be any length. <c>NewContext</c> - must be passed into the next call to <c>hmac_update</c>.</p> + must be passed into the next call to <c>hmac_update</c> + or to one of the functions <seealso marker="#hmac_final/1">hmac_final</seealso> and + <seealso marker="#hmac_final_n/1">hmac_final_n</seealso> + </p> + </desc> </func> + <func> <name>hmac_final(Context) -> Mac</name> <fsummary></fsummary> @@ -411,6 +366,7 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> determined by the type of hash function used to generate it.</p> </desc> </func> + <func> <name>hmac_final_n(Context, HashLen) -> Mac</name> <fsummary></fsummary> @@ -423,705 +379,92 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> zero. <c>Mac</c> will be a binary with at most <c>HashLen</c> bytes. Note that if HashLen is greater than the actual number of bytes returned from the underlying hash, the returned hash will have fewer than <c>HashLen</c> bytes.</p> </desc> </func> - <func> - <name>sha_mac(Key, Data) -> Mac</name> - <name>sha_mac(Key, Data, MacLength) -> Mac</name> - <fsummary>Compute an <c>MD5 MAC</c>message authentification code</fsummary> - <type> - <v>Key = Data = iolist() | binary()</v> - <v>Mac = binary()</v> - <v>MacLenength = integer() =< 20 </v> - </type> - <desc> - <p>Computes an <c>SHA MAC</c> message authentification code - from <c>Key</c> and <c>Data</c>, where the default length of the Mac - is 160 bits (20 bytes).</p> - </desc> - </func> - <func> - <name>sha_mac_96(Key, Data) -> Mac</name> - <fsummary>Compute an <c>SHA MAC</c>message authentification code</fsummary> - <type> - <v>Key = Data = iolist() | binary()</v> - <v>Mac = binary()</v> - </type> - <desc> - <p>Computes an <c>SHA MAC</c> message authentification code - from <c>Key</c> and <c>Data</c>, where the length of the Mac - is 96 bits (12 bytes).</p> - </desc> - </func> - <func> - <name>des_cbc_encrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>according to DES in CBC mode</fsummary> - <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> - </type> - <desc> - <p>Encrypts <c>Text</c> according to DES in CBC - mode. <c>Text</c> must be a multiple of 64 bits (8 - bytes). <c>Key</c> is the DES key, and <c>IVec</c> is an - arbitrary initializing vector. The lengths of <c>Key</c> and - <c>IVec</c> must be 64 bits (8 bytes).</p> - </desc> - </func> - <func> - <name>des_cbc_decrypt(Key, IVec, Cipher) -> Text</name> - <fsummary>Decrypt <c>Cipher</c>according to DES in CBC mode</fsummary> - <type> - <v>Key = Cipher = iolist() | binary()</v> - <v>IVec = Text = binary()</v> - </type> - <desc> - <p>Decrypts <c>Cipher</c> according to DES in CBC mode. - <c>Key</c> is the DES key, and <c>IVec</c> is an arbitrary - initializing vector. <c>Key</c> and <c>IVec</c> must have - the same values as those used when encrypting. <c>Cipher</c> - must be a multiple of 64 bits (8 bytes). The lengths of - <c>Key</c> and <c>IVec</c> must be 64 bits (8 bytes).</p> - </desc> - </func> - <func> - <name>des_cbc_ivec(Data) -> IVec</name> - <fsummary>Get <c>IVec</c> to be used in next iteration of - <c>des_cbc_[ecrypt|decrypt]</c></fsummary> - <type> - <v>Data = iolist() | binary()</v> - <v>IVec = binary()</v> - </type> - <desc> - <p>Returns the <c>IVec</c> to be used in a next iteration of - <c>des_cbc_[encrypt|decrypt]</c>. <c>Data</c> is the encrypted - data from the previous iteration step.</p> - </desc> - </func> - <func> - <name>des_cfb_encrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>according to DES in CFB mode</fsummary> - <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> - </type> - <desc> - <p>Encrypts <c>Text</c> according to DES in 8-bit CFB - mode. <c>Key</c> is the DES key, and <c>IVec</c> is an - arbitrary initializing vector. The lengths of <c>Key</c> and - <c>IVec</c> must be 64 bits (8 bytes).</p> - </desc> - </func> - <func> - <name>des_cfb_decrypt(Key, IVec, Cipher) -> Text</name> - <fsummary>Decrypt <c>Cipher</c>according to DES in CFB mode</fsummary> - <type> - <v>Key = Cipher = iolist() | binary()</v> - <v>IVec = Text = binary()</v> - </type> - <desc> - <p>Decrypts <c>Cipher</c> according to DES in 8-bit CFB mode. - <c>Key</c> is the DES key, and <c>IVec</c> is an arbitrary - initializing vector. <c>Key</c> and <c>IVec</c> must have - the same values as those used when encrypting. The lengths of - <c>Key</c> and <c>IVec</c> must be 64 bits (8 bytes).</p> - </desc> - </func> - <func> - <name>des_cfb_ivec(IVec, Data) -> NextIVec</name> - <fsummary>Get <c>IVec</c> to be used in next iteration of - <c>des_cfb_[ecrypt|decrypt]</c></fsummary> - <type> - <v>IVec = iolist() | binary()</v> - <v>Data = iolist() | binary()</v> - <v>NextIVec = binary()</v> - </type> - <desc> - <p>Returns the <c>IVec</c> to be used in a next iteration of - <c>des_cfb_[encrypt|decrypt]</c>. <c>IVec</c> is the vector - used in the previous iteration step. <c>Data</c> is the encrypted - data from the previous iteration step.</p> - </desc> - </func> - <func> - <name>des3_cbc_encrypt(Key1, Key2, Key3, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>according to DES3 in CBC mode</fsummary> - <type> - <v>Key1 =Key2 = Key3 Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> - </type> - <desc> - <p>Encrypts <c>Text</c> according to DES3 in CBC - mode. <c>Text</c> must be a multiple of 64 bits (8 - bytes). <c>Key1</c>, <c>Key2</c>, <c>Key3</c>, are the DES - keys, and <c>IVec</c> is an arbitrary initializing - vector. The lengths of each of <c>Key1</c>, <c>Key2</c>, - <c>Key3</c> and <c>IVec</c> must be 64 bits (8 bytes).</p> - </desc> - </func> - <func> - <name>des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher) -> Text</name> - <fsummary>Decrypt <c>Cipher</c>according to DES3 in CBC mode</fsummary> - <type> - <v>Key1 = Key2 = Key3 = Cipher = iolist() | binary()</v> - <v>IVec = Text = binary()</v> - </type> - <desc> - <p>Decrypts <c>Cipher</c> according to DES3 in CBC mode. - <c>Key1</c>, <c>Key2</c>, <c>Key3</c> are the DES key, and - <c>IVec</c> is an arbitrary initializing vector. - <c>Key1</c>, <c>Key2</c>, <c>Key3</c> and <c>IVec</c> must - and <c>IVec</c> must have the same values as those used when - encrypting. <c>Cipher</c> must be a multiple of 64 bits (8 - bytes). The lengths of <c>Key1</c>, <c>Key2</c>, - <c>Key3</c>, and <c>IVec</c> must be 64 bits (8 bytes).</p> - </desc> - </func> - <func> - <name>des3_cfb_encrypt(Key1, Key2, Key3, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>according to DES3 in CFB mode</fsummary> - <type> - <v>Key1 =Key2 = Key3 Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> - </type> - <desc> - <p>Encrypts <c>Text</c> according to DES3 in 8-bit CFB - mode. <c>Key1</c>, <c>Key2</c>, <c>Key3</c>, are the DES - keys, and <c>IVec</c> is an arbitrary initializing - vector. The lengths of each of <c>Key1</c>, <c>Key2</c>, - <c>Key3</c> and <c>IVec</c> must be 64 bits (8 bytes).</p> - <p>May throw exception <c>notsup</c> for old OpenSSL - versions (0.9.7) that does not support this encryption mode.</p> - </desc> - </func> - <func> - <name>des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher) -> Text</name> - <fsummary>Decrypt <c>Cipher</c>according to DES3 in CFB mode</fsummary> - <type> - <v>Key1 = Key2 = Key3 = Cipher = iolist() | binary()</v> - <v>IVec = Text = binary()</v> - </type> - <desc> - <p>Decrypts <c>Cipher</c> according to DES3 in 8-bit CFB mode. - <c>Key1</c>, <c>Key2</c>, <c>Key3</c> are the DES key, and - <c>IVec</c> is an arbitrary initializing vector. - <c>Key1</c>, <c>Key2</c>, <c>Key3</c> and <c>IVec</c> must - and <c>IVec</c> must have the same values as those used when - encrypting. The lengths of <c>Key1</c>, <c>Key2</c>, - <c>Key3</c>, and <c>IVec</c> must be 64 bits (8 bytes).</p> - <p>May throw exception <c>notsup</c> for old OpenSSL - versions (0.9.7) that does not support this encryption mode.</p> - </desc> - </func> - - <func> - <name>des_ecb_encrypt(Key, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>according to DES in ECB mode</fsummary> - <type> - <v>Key = Text = iolist() | binary()</v> - <v>Cipher = binary()</v> - </type> - <desc> - <p>Encrypts <c>Text</c> according to DES in ECB mode. - <c>Key</c> is the DES key. The lengths of <c>Key</c> and - <c>Text</c> must be 64 bits (8 bytes).</p> - </desc> - </func> - <func> - <name>des_ecb_decrypt(Key, Cipher) -> Text</name> - <fsummary>Decrypt <c>Cipher</c>according to DES in ECB mode</fsummary> - <type> - <v>Key = Cipher = iolist() | binary()</v> - <v>Text = binary()</v> - </type> - <desc> - <p>Decrypts <c>Cipher</c> according to DES in ECB mode. - <c>Key</c> is the DES key. The lengths of <c>Key</c> and - <c>Cipher</c> must be 64 bits (8 bytes).</p> - </desc> - </func> <func> - <name>blowfish_ecb_encrypt(Key, Text) -> Cipher</name> - <fsummary>Encrypt the first 64 bits of <c>Text</c> using Blowfish in ECB mode</fsummary> - <type> - <v>Key = Text = iolist() | binary()</v> - <v>Cipher = binary()</v> - </type> - <desc> - <p>Encrypts the first 64 bits of <c>Text</c> using Blowfish in ECB mode. <c>Key</c> is the Blowfish key. The length of <c>Text</c> must be at least 64 bits (8 bytes).</p> - </desc> - </func> - <func> - <name>blowfish_ecb_decrypt(Key, Text) -> Cipher</name> - <fsummary>Decrypt the first 64 bits of <c>Text</c> using Blowfish in ECB mode</fsummary> - <type> - <v>Key = Text = iolist() | binary()</v> - <v>Cipher = binary()</v> - </type> - <desc> - <p>Decrypts the first 64 bits of <c>Text</c> using Blowfish in ECB mode. <c>Key</c> is the Blowfish key. The length of <c>Text</c> must be at least 64 bits (8 bytes).</p> - </desc> - </func> - - <func> - <name>blowfish_cbc_encrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c> using Blowfish in CBC mode</fsummary> - <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> - </type> - <desc> - <p>Encrypts <c>Text</c> using Blowfish in CBC mode. <c>Key</c> is the Blowfish key, and <c>IVec</c> is an - arbitrary initializing vector. The length of <c>IVec</c> - must be 64 bits (8 bytes). The length of <c>Text</c> must be a multiple of 64 bits (8 bytes).</p> - </desc> - </func> - <func> - <name>blowfish_cbc_decrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Decrypt <c>Text</c> using Blowfish in CBC mode</fsummary> - <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> - </type> - <desc> - <p>Decrypts <c>Text</c> using Blowfish in CBC mode. <c>Key</c> is the Blowfish key, and <c>IVec</c> is an - arbitrary initializing vector. The length of <c>IVec</c> - must be 64 bits (8 bytes). The length of <c>Text</c> must be a multiple 64 bits (8 bytes).</p> - </desc> - </func> - - <func> - <name>blowfish_cfb64_encrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>using Blowfish in CFB mode with 64 - bit feedback</fsummary> - <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> - </type> - <desc> - <p>Encrypts <c>Text</c> using Blowfish in CFB mode with 64 bit - feedback. <c>Key</c> is the Blowfish key, and <c>IVec</c> is an - arbitrary initializing vector. The length of <c>IVec</c> - must be 64 bits (8 bytes).</p> - </desc> - </func> - <func> - <name>blowfish_cfb64_decrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Decrypt <c>Text</c>using Blowfish in CFB mode with 64 - bit feedback</fsummary> - <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> - </type> - <desc> - <p>Decrypts <c>Text</c> using Blowfish in CFB mode with 64 bit - feedback. <c>Key</c> is the Blowfish key, and <c>IVec</c> is an - arbitrary initializing vector. The length of <c>IVec</c> - must be 64 bits (8 bytes).</p> - </desc> - </func> - - <func> - <name>blowfish_ofb64_encrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>using Blowfish in OFB mode with 64 - bit feedback</fsummary> + <name>info_lib() -> [{Name,VerNum,VerStr}]</name> + <fsummary>Provides information about the libraries used by crypto.</fsummary> <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> + <v>Name = binary()</v> + <v>VerNum = integer()</v> + <v>VerStr = binary()</v> </type> <desc> - <p>Encrypts <c>Text</c> using Blowfish in OFB mode with 64 bit - feedback. <c>Key</c> is the Blowfish key, and <c>IVec</c> is an - arbitrary initializing vector. The length of <c>IVec</c> - must be 64 bits (8 bytes).</p> + <p>Provides the name and version of the libraries used by crypto.</p> + <p><c>Name</c> is the name of the library. <c>VerNum</c> is + the numeric version according to the library's own versioning + scheme. <c>VerStr</c> contains a text variant of the version.</p> + <pre> +> <input>info_lib().</input> +[{<<"OpenSSL">>,9469983,<<"OpenSSL 0.9.8a 11 Oct 2005">>}] + </pre> + <note><p> + From OTP R16 the <em>numeric version</em> represents the version of the OpenSSL + <em>header files</em> (<c>openssl/opensslv.h</c>) used when crypto was compiled. + The text variant represents the OpenSSL library used at runtime. + In earlier OTP versions both numeric and text was taken from the library. + </p></note> </desc> </func> <func> - <name>aes_cfb_128_encrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>according to AES in Cipher Feedback mode</fsummary> - <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> - </type> - <desc> - <p>Encrypts <c>Text</c> according to AES in Cipher Feedback - mode (CFB). <c>Key</c> is the - AES key, and <c>IVec</c> is an arbitrary initializing vector. - The lengths of <c>Key</c> and <c>IVec</c> must be 128 bits - (16 bytes).</p> - </desc> - </func> - <func> - <name>aes_cfb_128_decrypt(Key, IVec, Cipher) -> Text</name> - <fsummary>Decrypt <c>Cipher</c>according to AES in Cipher Feedback mode</fsummary> - <type> - <v>Key = Cipher = iolist() | binary()</v> - <v>IVec = Text = binary()</v> - </type> - <desc> - <p>Decrypts <c>Cipher</c> according to AES in Cipher Feedback Mode (CFB). - <c>Key</c> is the AES key, and <c>IVec</c> is an arbitrary - initializing vector. <c>Key</c> and <c>IVec</c> must have - the same values as those used when encrypting. The lengths of - <c>Key</c> and <c>IVec</c> must be 128 bits (16 bytes).</p> - </desc> - </func> - <func> - <name>aes_cbc_128_encrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>according to AES in Cipher Block Chaining mode</fsummary> - <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> - </type> - <desc> - <p>Encrypts <c>Text</c> according to AES in Cipher Block Chaining - mode (CBC). <c>Text</c> - must be a multiple of 128 bits (16 bytes). <c>Key</c> is the - AES key, and <c>IVec</c> is an arbitrary initializing vector. - The lengths of <c>Key</c> and <c>IVec</c> must be 128 bits - (16 bytes).</p> - </desc> - </func> - <func> - <name>aes_cbc_128_decrypt(Key, IVec, Cipher) -> Text</name> - <fsummary>Decrypt <c>Cipher</c>according to AES in Cipher Block Chaining mode</fsummary> - <type> - <v>Key = Cipher = iolist() | binary()</v> - <v>IVec = Text = binary()</v> - </type> - <desc> - <p>Decrypts <c>Cipher</c> according to AES in Cipher Block - Chaining mode (CBC). - <c>Key</c> is the AES key, and <c>IVec</c> is an arbitrary - initializing vector. <c>Key</c> and <c>IVec</c> must have - the same values as those used when encrypting. <c>Cipher</c> - must be a multiple of 128 bits (16 bytes). The lengths of - <c>Key</c> and <c>IVec</c> must be 128 bits (16 bytes).</p> - </desc> - </func> - <func> - <name>aes_cbc_ivec(Data) -> IVec</name> - <fsummary>Get <c>IVec</c> to be used in next iteration of - <c>aes_cbc_*_[ecrypt|decrypt]</c></fsummary> - <type> - <v>Data = iolist() | binary()</v> - <v>IVec = binary()</v> - </type> - <desc> - <p>Returns the <c>IVec</c> to be used in a next iteration of - <c>aes_cbc_*_[encrypt|decrypt]</c>. <c>Data</c> is the encrypted - data from the previous iteration step.</p> - </desc> - </func> - <func> - <name>aes_ctr_encrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>according to AES in Counter mode</fsummary> - <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> - </type> - <desc> - <p>Encrypts <c>Text</c> according to AES in Counter mode (CTR). <c>Text</c> - can be any number of bytes. <c>Key</c> is the AES key and must be either - 128, 192 or 256 bits long. <c>IVec</c> is an arbitrary initializing vector of 128 bits - (16 bytes).</p> - </desc> - </func> - <func> - <name>aes_ctr_decrypt(Key, IVec, Cipher) -> Text</name> - <fsummary>Decrypt <c>Cipher</c>according to AES in Counter mode</fsummary> - <type> - <v>Key = Cipher = iolist() | binary()</v> - <v>IVec = Text = binary()</v> - </type> - <desc> - <p>Decrypts <c>Cipher</c> according to AES in Counter mode (CTR). <c>Cipher</c> - can be any number of bytes. <c>Key</c> is the AES key and must be either - 128, 192 or 256 bits long. <c>IVec</c> is an arbitrary initializing vector of 128 bits - (16 bytes).</p> - </desc> - </func> - <func> - <name>aes_ctr_stream_init(Key, IVec) -> State</name> - <fsummary></fsummary> - <type> - <v>State = { K, I, E, C }</v> - <v>Key = K = iolist()</v> - <v>IVec = I = E = binary()</v> - <v>C = integer()</v> - </type> - <desc> - <p>Initializes the state for use in streaming AES encryption using Counter mode (CTR). - <c>Key</c> is the AES key and must be either 128, 192, or 256 bts long. <c>IVec</c> is - an arbitrary initializing vector of 128 bits (16 bytes). This state is for use with - <seealso marker="#aes_ctr_stream_encrypt/2">aes_ctr_stream_encrypt</seealso> and - <seealso marker="#aes_ctr_stream_decrypt/2">aes_ctr_stream_decrypt</seealso>.</p> - </desc> - </func> - <func> - <name>aes_ctr_stream_encrypt(State, Text) -> { NewState, Cipher}</name> - <fsummary></fsummary> - <type> - <v>Text = iolist() | binary()</v> - <v>Cipher = binary()</v> - </type> - <desc> - <p>Encrypts <c>Text</c> according to AES in Counter mode (CTR). This function can be - used to encrypt a stream of text using a series of calls instead of requiring all - text to be in memory. <c>Text</c> can be any number of bytes. State is initialized using - <seealso marker="#aes_ctr_stream_init/2">aes_ctr_stream_init</seealso>. <c>NewState</c> is the new streaming - encryption state that must be passed to the next call to <c>aes_ctr_stream_encrypt</c>. - <c>Cipher</c> is the encrypted cipher text.</p> - </desc> - </func> - <func> - <name>aes_ctr_stream_decrypt(State, Cipher) -> { NewState, Text }</name> - <fsummary></fsummary> - <type> - <v>Cipher = iolist() | binary()</v> - <v>Text = binary()</v> - </type> - <desc> - <p>Decrypts <c>Cipher</c> according to AES in Counter mode (CTR). This function can be - used to decrypt a stream of ciphertext using a series of calls instead of requiring all - ciphertext to be in memory. <c>Cipher</c> can be any number of bytes. State is initialized using - <seealso marker="#aes_ctr_stream_init/2">aes_ctr_stream_init</seealso>. <c>NewState</c> is the new streaming - encryption state that must be passed to the next call to <c>aes_ctr_stream_encrypt</c>. - <c>Text</c> is the decrypted data.</p> - </desc> - </func> - <func> - <name>erlint(Mpint) -> N</name> - <name>mpint(N) -> Mpint</name> - <fsummary>Convert between binary multi-precision integer and erlang big integer</fsummary> - <type> - <v>Mpint = binary()</v> - <v>N = integer()</v> - </type> - <desc> - <p>Convert a binary multi-precision integer <c>Mpint</c> to and from - an erlang big integer. A multi-precision integer is a binary - with the following form: - <c><![CDATA[<<ByteLen:32/integer, Bytes:ByteLen/binary>>]]></c> where both - <c>ByteLen</c> and <c>Bytes</c> are big-endian. Mpints are used in - some of the functions in <c>crypto</c> and are not translated - in the API for performance reasons.</p> - </desc> - </func> - <func> - <name>rand_bytes(N) -> binary()</name> - <fsummary>Generate a binary of random bytes</fsummary> - <type> - <v>N = integer()</v> - </type> - <desc> - <p>Generates N bytes randomly uniform 0..255, and returns the - result in a binary. Uses the <c>crypto</c> library pseudo-random - number generator.</p> - </desc> - </func> - <func> - <name>strong_rand_bytes(N) -> binary()</name> - <fsummary>Generate a binary of random bytes</fsummary> - <type> - <v>N = integer()</v> - </type> - <desc> - <p>Generates N bytes randomly uniform 0..255, and returns the - result in a binary. Uses a cryptographically secure prng seeded and - periodically mixed with operating system provided entropy. By default - this is the <c>RAND_bytes</c> method from OpenSSL.</p> - <p>May throw exception <c>low_entropy</c> in case the random generator - failed due to lack of secure "randomness".</p> - </desc> - </func> - <func> - <name>rand_uniform(Lo, Hi) -> N</name> - <fsummary>Generate a random number</fsummary> - <type> - <v>Lo, Hi, N = Mpint | integer()</v> - <v>Mpint = binary()</v> - </type> - <desc> - <p>Generate a random number <c><![CDATA[N, Lo =< N < Hi.]]></c> Uses the - <c>crypto</c> library pseudo-random number generator. The - arguments (and result) can be either erlang integers or binary - multi-precision integers. <c>Hi</c> must be larger than <c>Lo</c>.</p> - </desc> - </func> - <func> - <name>strong_rand_mpint(N, Top, Bottom) -> Mpint</name> - <fsummary>Generate an N bit random number</fsummary> - <type> - <v>N = non_neg_integer()</v> - <v>Top = -1 | 0 | 1</v> - <v>Bottom = 0 | 1</v> - <v>Mpint = binary()</v> - </type> - <desc> - <p>Generate an N bit random number using OpenSSL's - cryptographically strong pseudo random number generator - <c>BN_rand</c>.</p> - <p>The parameter <c>Top</c> places constraints on the most - significant bits of the generated number. If <c>Top</c> is 1, then the - two most significant bits will be set to 1, if <c>Top</c> is 0, the - most significant bit will be 1, and if <c>Top</c> is -1 then no - constraints are applied and thus the generated number may be less than - N bits long.</p> - <p>If <c>Bottom</c> is 1, then the generated number is - constrained to be odd.</p> - <p>May throw exception <c>low_entropy</c> in case the random generator - failed due to lack of secure "randomness".</p> - </desc> - </func> - <func> - <name>mod_exp(N, P, M) -> Result</name> - <fsummary>Perform N ^ P mod M</fsummary> - <type> - <v>N, P, M, Result = Mpint</v> - <v>Mpint = binary()</v> - </type> - <desc> - <p>This function performs the exponentiation <c>N ^ P mod M</c>, - using the <c>crypto</c> library.</p> - </desc> - </func> - <func> - <name>mod_exp_prime(N, P, M) -> Result</name> + <name>mod_pow(N, P, M) -> Result</name> <fsummary>Computes the function: N^P mod M</fsummary> <type> - <v>N, P, M = binary()</v> + <v>N, P, M = binary() | integer()</v> <v>Result = binary() | error</v> </type> <desc> <p>Computes the function <c>N^P mod M</c>.</p> </desc> </func> - <func> - <name>rsa_sign(DataOrDigest, Key) -> Signature</name> - <name>rsa_sign(DigestType, DataOrDigest, Key) -> Signature</name> - <fsummary>Sign the data using rsa with the given key.</fsummary> - <type> - <v>DataOrDigest = Data | {digest,Digest}</v> - <v>Data = Mpint</v> - <v>Digest = binary()</v> - <v>Key = [E, N, D] | [E, N, D, P1, P2, E1, E2, C]</v> - <v>E, N, D = Mpint</v> - <d>Where <c>E</c> is the public exponent, <c>N</c> is public modulus and - <c>D</c> is the private exponent.</d> - <v>P1, P2, E1, E2, C = Mpint</v> - <d>The longer key format contains redundant information that will make - the calculation faster. <c>P1,P2</c> are first and second prime factors. - <c>E1,E2</c> are first and second exponents. <c>C</c> is the CRT coefficient. - Terminology is taken from RFC 3447.</d> - <v>DigestType = md5 | sha | sha224 | sha256 | sha384 | sha512</v> - <d>The default <c>DigestType</c> is sha.</d> - <v>Mpint = binary()</v> - <v>Signature = binary()</v> - </type> - <desc> - <p>Creates a RSA signature with the private key <c>Key</c> - of a digest. The digest is either calculated as a - <c>DigestType</c> digest of <c>Data</c> or a precalculated - binary <c>Digest</c>.</p> - </desc> - </func> <func> - <name>rsa_verify(DataOrDigest, Signature, Key) -> Verified</name> - <name>rsa_verify(DigestType, DataOrDigest, Signature, Key) -> Verified </name> - <fsummary>Verify the digest and signature using rsa with given public key.</fsummary> - <type> - <v>Verified = boolean()</v> - <v>DataOrDigest = Data | {digest|Digest}</v> - <v>Data, Signature = Mpint</v> - <v>Digest = binary()</v> - <v>Key = [E, N]</v> - <v>E, N = Mpint</v> - <d>Where <c>E</c> is the public exponent and <c>N</c> is public modulus.</d> - <v>DigestType = md5 | sha | sha224 | sha256 | sha384 | sha512</v> - <d>The default <c>DigestType</c> is sha.</d> - <v>Mpint = binary()</v> - </type> - <desc> - <p>Verifies that a digest matches the RSA signature using the - signer's public key <c>Key</c>. - The digest is either calculated as a <c>DigestType</c> - digest of <c>Data</c> or a precalculated binary <c>Digest</c>.</p> - <p>May throw exception <c>notsup</c> in case the chosen <c>DigestType</c> - is not supported by the underlying OpenSSL implementation.</p> - </desc> - </func> - - <func> - <name>rsa_public_encrypt(PlainText, PublicKey, Padding) -> ChipherText</name> - <fsummary>Encrypts Msg using the public Key.</fsummary> - <type> - <v>PlainText = binary()</v> - <v>PublicKey = [E, N]</v> - <v>E, N = Mpint</v> - <d>Where <c>E</c> is the public exponent and <c>N</c> is public modulus.</d> - <v>Padding = rsa_pkcs1_padding | rsa_pkcs1_oaep_padding | rsa_no_padding</v> - <v>ChipherText = binary()</v> - </type> - <desc> - <p>Encrypts the <c>PlainText</c> (usually a session key) using the <c>PublicKey</c> - and returns the cipher. 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 byte_size(N) is the size part of an <c>Mpint-1</c>. - </p> - </desc> + <name>next_iv(Type, Data) -> NextIVec</name> + <name>next_iv(Type, Data, IVec) -> NextIVec</name> + <fsummary></fsummary> + <type> + <v>Type = des_cbc | des3_cbc | aes_cbc | des_cfb</v> + <v>Data = iodata()</v> + <v>IVec = NextIVec = binary()</v> + </type> + <desc> + <p>Returns the initialization vector to be used in the next + iteration of encrypt/decrypt of type <c>Type</c>. <c>Data</c> is the + encrypted data from the previous iteration step. The <c>IVec</c> + argument is only needed for <c>des_cfb</c> as the vector used + in the previous iteration step.</p> + </desc> </func> <func> - <name>rsa_private_decrypt(ChipherText, PrivateKey, Padding) -> PlainText</name> + <name>private_decrypt(Type, ChipherText, PrivateKey, Padding) -> PlainText</name> <fsummary>Decrypts ChipherText using the private Key.</fsummary> <type> + <v>Type = rsa</v> <v>ChipherText = binary()</v> - <v>PrivateKey = [E, N, D] | [E, N, D, P1, P2, E1, E2, C]</v> - <v>E, N, D = Mpint</v> - <d>Where <c>E</c> is the public exponent, <c>N</c> is public modulus and - <c>D</c> is the private exponent.</d> - <v>P1, P2, E1, E2, C = Mpint</v> - <d>The longer key format contains redundant information that will make - the calculation faster. <c>P1,P2</c> are first and second prime factors. - <c>E1,E2</c> are first and second exponents. <c>C</c> is the CRT coefficient. - Terminology is taken from RFC 3447.</d> + <v>PrivateKey = rsa_private()</v> <v>Padding = rsa_pkcs1_padding | rsa_pkcs1_oaep_padding | rsa_no_padding</v> <v>PlainText = binary()</v> </type> <desc> - <p>Decrypts the <c>ChipherText</c> (usually a session key encrypted with - <seealso marker="#rsa_public_encrypt/3">rsa_public_encrypt/3</seealso>) + <p>Decrypts the <c>ChipherText</c> (usually a session key encrypted with + <seealso marker="#public_encrypt/3">public_encrypt/3</seealso>) using the <c>PrivateKey</c> and returns the message. The <c>Padding</c> is the padding mode that was - used to encrypt the data, - see <seealso marker="#rsa_public_encrypt/3">rsa_public_encrypt/3</seealso>. + used to encrypt the data, + see <seealso marker="#public_encrypt/3">public_encrypt/3</seealso>. + See also <seealso marker="public_key:public_key#decrypt_private/2">public_key:decrypt_private/[2,3]</seealso> </p> </desc> </func> + <func> - <name>rsa_private_encrypt(PlainText, PrivateKey, Padding) -> ChipherText</name> + <name>private_encrypt(Type, PlainText, PrivateKey, Padding) -> ChipherText</name> <fsummary>Encrypts Msg using the private Key.</fsummary> <type> + <v>Type = rsa</v> <v>PlainText = binary()</v> - <v>PrivateKey = [E, N, D] | [E, N, D, P1, P2, E1, E2, C]</v> - <v>E, N, D = Mpint</v> - <d>Where <c>E</c> is the public exponent, <c>N</c> is public modulus and - <c>D</c> is the private exponent.</d> - <v>P1, P2, E1, E2, C = Mpint</v> - <d>The longer key format contains redundant information that will make - the calculation faster. <c>P1,P2</c> are first and second prime factors. - <c>E1,E2</c> are first and second exponents. <c>C</c> is the CRT coefficient. - Terminology is taken from RFC 3447.</d> + <v>PrivateKey = rsa_private()</v> <v>Padding = rsa_pkcs1_padding | rsa_no_padding</v> <v>ChipherText = binary()</v> </type> @@ -1131,316 +474,311 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> <c>rsa_pkcs1_padding</c> is PKCS #1 v1.5 currently the most 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. Where byte_size(N) is the size part of an <c>Mpint-1</c>. + <c>rsa_pkcs1_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_private/2">public_key:encrypt_private/[2,3]</seealso> </p> </desc> </func> - <func> - <name>rsa_public_decrypt(ChipherText, PublicKey, Padding) -> PlainText</name> + <name>public_decrypt(Type, ChipherText, PublicKey, Padding) -> PlainText</name> <fsummary>Decrypts ChipherText using the public Key.</fsummary> <type> + <v>Type = rsa</v> <v>ChipherText = binary()</v> - <v>PublicKey = [E, N]</v> - <v>E, N = Mpint</v> - <d>Where <c>E</c> is the public exponent and <c>N</c> is public modulus</d> + <v>PublicKey = rsa_public() </v> <v>Padding = rsa_pkcs1_padding | rsa_no_padding</v> <v>PlainText = binary()</v> </type> <desc> - <p>Decrypts the <c>ChipherText</c> (encrypted with - <seealso marker="#rsa_private_encrypt/3">rsa_private_encrypt/3</seealso>) + <p>Decrypts the <c>ChipherText</c> (encrypted with + <seealso marker="#private_encrypt/3">private_encrypt/3</seealso>) using the <c>PrivateKey</c> and returns the message. The <c>Padding</c> is the padding mode that was - used to encrypt the data, - see <seealso marker="#rsa_private_encrypt/3">rsa_private_encrypt/3</seealso>. + used to encrypt the data, + see <seealso marker="#private_encrypt/3">private_encrypt/3</seealso>. + See also <seealso marker="public_key:public_key#decrypt_public/2">public_key:decrypt_public/[2,3]</seealso> </p> </desc> </func> - + <func> - <name>dss_sign(DataOrDigest, Key) -> Signature</name> - <name>dss_sign(DigestType, DataOrDigest, Key) -> Signature</name> - <fsummary>Sign the data using dsa with given private key.</fsummary> + <name>public_encrypt(Type, PlainText, PublicKey, Padding) -> ChipherText</name> + <fsummary>Encrypts Msg using the public Key.</fsummary> <type> - <v>DigestType = sha</v> - <v>DataOrDigest = Mpint | {digest,Digest}</v> - <v>Key = [P, Q, G, X]</v> - <v>P, Q, G, X = Mpint</v> - <d> Where <c>P</c>, <c>Q</c> and <c>G</c> are the dss - parameters and <c>X</c> is the private key.</d> - <v>Digest = binary() with length 20 bytes</v> - <v>Signature = binary()</v> + <v>Type = rsa</v> + <v>PlainText = binary()</v> + <v>PublicKey = rsa_public()</v> + <v>Padding = rsa_pkcs1_padding | rsa_pkcs1_oaep_padding | rsa_no_padding</v> + <v>ChipherText = binary()</v> </type> <desc> - <p>Creates a DSS signature with the private key <c>Key</c> of - a digest. The digest is either calculated as a SHA1 - digest of <c>Data</c> or a precalculated binary <c>Digest</c>.</p> - <p>A deprecated feature is having <c>DigestType = 'none'</c> - in which case <c>DataOrDigest</c> is a precalculated SHA1 - digest.</p> + <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> <func> - <name>dss_verify(DataOrDigest, Signature, Key) -> Verified</name> - <name>dss_verify(DigestType, DataOrDigest, Signature, Key) -> Verified</name> - <fsummary>Verify the data and signature using dsa with given public key.</fsummary> + <name>rand_bytes(N) -> binary()</name> + <fsummary>Generate a binary of random bytes</fsummary> <type> - <v>Verified = boolean()</v> - <v>DigestType = sha</v> - <v>DataOrDigest = Mpint | {digest,Digest}</v> - <v>Data = Mpint | ShaDigest</v> - <v>Signature = Mpint</v> - <v>Key = [P, Q, G, Y]</v> - <v>P, Q, G, Y = Mpint</v> - <d> Where <c>P</c>, <c>Q</c> and <c>G</c> are the dss - parameters and <c>Y</c> is the public key.</d> - <v>Digest = binary() with length 20 bytes</v> + <v>N = integer()</v> </type> <desc> - <p>Verifies that a digest matches the DSS signature using the - public key <c>Key</c>. The digest is either calculated as a SHA1 - digest of <c>Data</c> or is a precalculated binary <c>Digest</c>.</p> - <p>A deprecated feature is having <c>DigestType = 'none'</c> - in which case <c>DataOrDigest</c> is a precalculated SHA1 - digest binary.</p> + <p>Generates N bytes randomly uniform 0..255, and returns the + result in a binary. Uses the <c>crypto</c> library pseudo-random + number generator.</p> </desc> </func> - <func> - <name>rc2_cbc_encrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>according to RC2 in CBC mode</fsummary> + <func> + <name>rand_uniform(Lo, Hi) -> N</name> + <fsummary>Generate a random number</fsummary> <type> - <v>Key = Text = iolist() | binary()</v> - <v>Ivec = Cipher = binary()</v> + <v>Lo, Hi, N = integer()</v> </type> <desc> - <p>Encrypts <c>Text</c> according to RC2 in CBC mode.</p> + <p>Generate a random number <c><![CDATA[N, Lo =< N < Hi.]]></c> Uses the + <c>crypto</c> library pseudo-random number generator. + <c>Hi</c> must be larger than <c>Lo</c>.</p> </desc> </func> <func> - <name>rc2_cbc_decrypt(Key, IVec, Cipher) -> Text</name> - <fsummary>Decrypts <c>Cipher</c>according to RC2 in CBC mode</fsummary> + <name>sign(Algorithm, DigestType, Msg, Key) -> binary()</name> + <fsummary> Create digital signature.</fsummary> <type> - <v>Key = Text = iolist() | binary()</v> - <v>Ivec = Cipher = binary()</v> + <v>Algorithm = rsa | dss | ecdsa </v> + <v>Msg = binary() | {digest,binary()}</v> + <d>The msg is either the binary "plain text" data to be + signed or it is the hashed value of "plain text" i.e. the + digest.</d> + <v>DigestType = digest_type()</v> + <v>Key = rsa_private() | dss_private() | [ecdh_private(),ecdh_params()]</v> </type> <desc> - <p>Decrypts <c>Cipher</c> according to RC2 in CBC mode.</p> + <p>Creates a digital signature.</p> + <p>Algorithm <c>dss</c> can only be used together with digest type + <c>sha</c>.</p> + See also <seealso marker="public_key:public_key#sign/3">public_key:sign/3</seealso> + </desc> + </func> + + <func> + <name>start() -> ok</name> + <fsummary> Equivalent to application:start(crypto). </fsummary> + <desc> + <p> Equivalent to application:start(crypto).</p> </desc> </func> - <func> - <name>rc4_encrypt(Key, Data) -> Result</name> - <fsummary>Encrypt data using RC4</fsummary> + <name>stop() -> ok</name> + <fsummary> Equivalent to application:stop(crypto).</fsummary> + <desc> + <p> Equivalent to application:stop(crypto).</p> + </desc> + </func> + + <func> + <name>strong_rand_bytes(N) -> binary()</name> + <fsummary>Generate a binary of random bytes</fsummary> <type> - <v>Key, Data = iolist() | binary()</v> - <v>Result = binary()</v> + <v>N = integer()</v> </type> <desc> - <p>Encrypts the data with RC4 symmetric stream encryption. - Since it is symmetric, the same function is used for - decryption.</p> + <p>Generates N bytes randomly uniform 0..255, and returns the + result in a binary. Uses a cryptographically secure prng seeded and + periodically mixed with operating system provided entropy. By default + this is the <c>RAND_bytes</c> method from OpenSSL.</p> + <p>May throw exception <c>low_entropy</c> in case the random generator + failed due to lack of secure "randomness".</p> </desc> </func> - <func> - <name>dh_generate_key(DHParams) -> {PublicKey,PrivateKey} </name> - <name>dh_generate_key(PrivateKey, DHParams) -> {PublicKey,PrivateKey} </name> - <fsummary>Generates a Diffie-Hellman public key</fsummary> + <name>stream_init(Type, Key) -> State</name> + <fsummary></fsummary> <type> - <v>DHParameters = [P, G]</v> - <v>P, G = Mpint</v> - <d> Where <c>P</c> is the shared prime number and <c>G</c> is the shared generator.</d> - <v>PublicKey, PrivateKey = Mpint()</v> + <v>Type = rc4 </v> + <v>State = opaque() </v> + <v>Key = iodata()</v> </type> <desc> - <p>Generates a Diffie-Hellman <c>PublicKey</c> and <c>PrivateKey</c> (if not given). - </p> + <p>Initializes the state for use in RC4 stream encryption + <seealso marker="#stream_encrypt/2">stream_encrypt</seealso> and + <seealso marker="#stream_decrypt/2">stream_decrypt</seealso></p> </desc> </func> - <func> - <name>dh_compute_key(OthersPublicKey, MyPrivateKey, DHParams) -> SharedSecret</name> - <fsummary>Computes the shared secret</fsummary> + <func> + <name>stream_init(Type, Key, IVec) -> State</name> + <fsummary></fsummary> <type> - <v>DHParameters = [P, G]</v> - <v>P, G = Mpint</v> - <d> Where <c>P</c> is the shared prime number and <c>G</c> is the shared generator.</d> - <v>OthersPublicKey, MyPrivateKey = Mpint()</v> - <v>SharedSecret = binary()</v> + <v>Type = aes_ctr </v> + <v>State = opaque() </v> + <v>Key = iodata()</v> + <v>IVec = binary()</v> </type> <desc> - <p>Computes the shared secret from the private key and the other party's public key. - </p> + <p>Initializes the state for use in streaming AES encryption using Counter mode (CTR). + <c>Key</c> is the AES key and must be either 128, 192, or 256 bts long. <c>IVec</c> is + an arbitrary initializing vector of 128 bits (16 bytes). This state is for use with + <seealso marker="#stream_encrypt/2">stream_encrypt</seealso> and + <seealso marker="#stream_decrypt/2">stream_decrypt</seealso>.</p> </desc> </func> - + <func> - <name>srp_generate_key(Generator, Prime, Version) -> {PublicKey, PrivateKey} </name> - <name>srp_generate_key(Generator, Prime, Version, Private) -> {PublicKey, PrivateKey} </name> - <name>srp_generate_key(Verifier, Generator, Prime, Version) -> {PublicKey, PrivateKey} </name> - <name>srp_generate_key(Verifier, Generator, Prime, Version, Private) -> {PublicKey, PrivateKey} </name> - <fsummary>Generates SRP public keys</fsummary> + <name>stream_encrypt(State, PlainText) -> { NewState, CipherText}</name> + <fsummary></fsummary> <type> - <v>Verifier = binary()</v> - <d>Parameter v from <url href="http://srp.stanford.edu/design.html">SRP design</url> - </d> - <v>Generator = binary() </v> - <d>Parameter g from <url href="http://srp.stanford.edu/design.html">SRP design</url> - </d> - <v>Prime = binary() </v> - <d>Parameter N from <url href="http://srp.stanford.edu/design.html">SRP design</url> - </d> - <v>Version = '3' | '6' | '6a' </v> - <d>SRP version, TLS SRP cipher suites uses '6a'.</d> - <v>PublicKey = binary()</v> - <d> Parameter A or B from <url href="http://srp.stanford.edu/design.html">SRP design</url></d> - <v>Private = PrivateKey = binary() - generated if not supplied</v> - <d>Parameter a or b from <url href="http://srp.stanford.edu/design.html">SRP design</url></d> + <v>Text = iodata()</v> + <v>CipherText = binary()</v> </type> <desc> - <p>Generates SRP public keys for the client side (first argument is Generator) - or for the server side (first argument is Verifier).</p> + <p>Encrypts <c>PlainText</c> according to the stream cipher <c>Type</c> specified in stream_init/3. + <c>Text</c> can be any number of bytes. The initial <c>State</c> is created using + <seealso marker="#stream_init/2">stream_init</seealso>. + <c>NewState</c> must be passed into the next call to <c>stream_encrypt</c>.</p> </desc> </func> <func> - <name>srp_compute_key(DerivedKey, Prime, Generator, - ClientPublic, ClientPrivate, ServerPublic, Version) -> SessionKey</name> - <name>srp_compute_key(DerivedKey, Prime, Generator, - ClientPublic, ClientPrivate, ServerPublic, Version, Scrambler) -> SessionKey</name> - <name>srp_compute_key(Verifier, Prime, - ClientPublic, ServerPublic, ServerPrivate, Version, Scrambler)-> SessionKey</name> - <name>srp_compute_key(Verifier, Prime, - ClientPublic, ServerPublic, ServerPrivate, Version) -> SessionKey</name> - - <fsummary>Computes SRP session key</fsummary> + <name>stream_decrypt(State, CipherText) -> { NewState, PlainText }</name> + <fsummary></fsummary> <type> - <v>DerivedKey = binary()</v> - <d>Parameter x from <url href="http://srp.stanford.edu/design.html">SRP design</url> - </d> - <v>Verifier = binary()</v> - <d>Parameter v from <url href="http://srp.stanford.edu/design.html">SRP design</url> - </d> - <v>Prime = binary() </v> - <d>Parameter N from <url href="http://srp.stanford.edu/design.html">SRP design</url> - </d> - <v>Generator = binary() </v> - <d>Parameter g from <url href="http://srp.stanford.edu/design.html">SRP design</url> - </d> - <v>ClientPublic = binary() </v> - <d>Parameter A from <url href="http://srp.stanford.edu/design.html">SRP design</url> - </d> - <v>ClientPrivate = binary() </v> - <d>Parameter a from <url href="http://srp.stanford.edu/design.html">SRP design</url> - </d> - <v>ServerPublic = binary() </v> - <d>Parameter B from <url href="http://srp.stanford.edu/design.html">SRP design</url> - </d> - <v>ServerPrivate = binary() </v> - <d>Parameter b from <url href="http://srp.stanford.edu/design.html">SRP design</url> - </d> - <v>Version = '3' | '6' | '6a' </v> - <d>SRP version, TLS SRP cipher suites uses '6a'.</d> - <v>SessionKey = binary()</v> - <d>Result K from <url href="http://srp.stanford.edu/design.html">SRP design</url> - </d> + <v>CipherText = iodata()</v> + <v>PlainText = binary()</v> </type> <desc> - <p> - Computes the SRP session key (shared secret) for the client side (first argument is DerivedKey) - or for the server side (first argument is Verifier). Also used - as premaster secret by TLS-SRP cipher suites. - </p> + <p>Decrypts <c>CipherText</c> according to the stream cipher <c>Type</c> specified in stream_init/3. + <c>PlainText</c> can be any number of bytes. The initial <c>State</c> is created using + <seealso marker="#stream_init/2">stream_init</seealso>. + <c>NewState</c> must be passed into the next call to <c>stream_encrypt</c>.</p> </desc> </func> - - <func> - <name>exor(Data1, Data2) -> Result</name> - <fsummary>XOR data</fsummary> + + <func> + <name>supports() -> AlgorithmList </name> + <fsummary>Provide a list of available crypto algorithms.</fsummary> <type> - <v>Data1, Data2 = iolist() | binary()</v> - <v>Result = binary()</v> + <v> AlgorithmList = [{hashs, [hash_algorithms()]}, + {ciphers, [cipher_algorithms()]}, + {public_keys, [public_key_algorithms()]} + </v> </type> <desc> - <p>Performs bit-wise XOR (exclusive or) on the data supplied.</p> + <p> Can be used to determine which crypto algorithms that are supported + by the underlying OpenSSL library</p> </desc> </func> - </funcs> - <section> - <title>DES in CBC mode</title> - <p>The Data Encryption Standard (DES) defines an algorithm for - encrypting and decrypting an 8 byte quantity using an 8 byte key - (actually only 56 bits of the key is used). - </p> - <p>When it comes to encrypting and decrypting blocks that are - multiples of 8 bytes various modes are defined (NIST SP - 800-38A). One of those modes is the Cipher Block Chaining (CBC) - mode, where the encryption of an 8 byte segment depend not only - of the contents of the segment itself, but also on the result of - encrypting the previous segment: the encryption of the previous - segment becomes the initializing vector of the encryption of the - current segment. - </p> - <p>Thus the encryption of every segment depends on the encryption - key (which is secret) and the encryption of the previous - segment, except the first segment which has to be provided with - an initial initializing vector. That vector could be chosen at - random, or be a counter of some kind. It does not have to be - secret. - </p> - <p>The following example is drawn from the old FIPS 81 standard - (replaced by NIST SP 800-38A), where both the plain text and the - resulting cipher text is settled. The following code fragment - returns `true'. - </p> - <pre><![CDATA[ - - Key = <<16#01,16#23,16#45,16#67,16#89,16#ab,16#cd,16#ef>>, - IVec = <<16#12,16#34,16#56,16#78,16#90,16#ab,16#cd,16#ef>>, - P = "Now is the time for all ", - C = crypto:des_cbc_encrypt(Key, IVec, P), - % Which is the same as - P1 = "Now is t", P2 = "he time ", P3 = "for all ", - C1 = crypto:des_cbc_encrypt(Key, IVec, P1), - C2 = crypto:des_cbc_encrypt(Key, C1, P2), - C3 = crypto:des_cbc_encrypt(Key, C2, P3), - - C = <<C1/binary, C2/binary, C3/binary>>, - C = <<16#e5,16#c7,16#cd,16#de,16#87,16#2b,16#f2,16#7c, - 16#43,16#e9,16#34,16#00,16#8c,16#38,16#9c,16#0f, - 16#68,16#37,16#88,16#49,16#9a,16#7c,16#05,16#f6>>, - <<"Now is the time for all ">> == - crypto:des_cbc_decrypt(Key, IVec, C). - ]]></pre> - <p>The following is true for the DES CBC mode. For all - decompositions <c>P1 ++ P2 = P</c> of a plain text message - <c>P</c> (where the length of all quantities are multiples of 8 - bytes), the encryption <c>C</c> of <c>P</c> is equal to <c>C1 ++ - C2</c>, where <c>C1</c> is obtained by encrypting <c>P1</c> with - <c>Key</c> and the initializing vector <c>IVec</c>, and where - <c>C2</c> is obtained by encrypting <c>P2</c> with <c>Key</c> - and the initializing vector <c>last8(C1)</c>, - where <c>last(Binary)</c> denotes the last 8 bytes of the - binary <c>Binary</c>. - </p> - <p>Similarly, for all decompositions <c>C1 ++ C2 = C</c> of a - cipher text message <c>C</c> (where the length of all quantities - are multiples of 8 bytes), the decryption <c>P</c> of <c>C</c> - is equal to <c>P1 ++ P2</c>, where <c>P1</c> is obtained by - decrypting <c>C1</c> with <c>Key</c> and the initializing vector - <c>IVec</c>, and where <c>P2</c> is obtained by decrypting - <c>C2</c> with <c>Key</c> and the initializing vector - <c>last8(C1)</c>, where <c>last8(Binary)</c> is as above. - </p> - <p>For DES3 (which uses three 64 bit keys) the situation is the - same. - </p> - </section> + + <func> + <name>verify(Algorithm, DigestType, Msg, Signature, Key) -> boolean()</name> + <fsummary>Verifies a digital signature.</fsummary> + <type> + <v> Algorithm = rsa | dss | ecdsa </v> + <v>Msg = binary() | {digest,binary()}</v> + <d>The msg is either the binary "plain text" data + or it is the hashed value of "plain text" i.e. the digest.</d> + <v>DigestType = digest_type()</v> + <v>Signature = binary()</v> + <v>Key = rsa_public() | dss_public() | [ecdh_public(),ecdh_params()]</v> + </type> + <desc> + <p>Verifies a digital signature</p> + <p>Algorithm <c>dss</c> can only be used together with digest type + <c>sha</c>.</p> + + See also <seealso marker="public_key:public_key#sign/3">public_key:verify/3</seealso> + </desc> + </func> + + </funcs> + + <!-- Maybe put this in the users guide --> + <!-- <section> --> + <!-- <title>DES in CBC mode</title> --> + <!-- <p>The Data Encryption Standard (DES) defines an algorithm for --> + <!-- encrypting and decrypting an 8 byte quantity using an 8 byte key --> + <!-- (actually only 56 bits of the key is used). --> + <!-- </p> --> + <!-- <p>When it comes to encrypting and decrypting blocks that are --> + <!-- multiples of 8 bytes various modes are defined (NIST SP --> + <!-- 800-38A). One of those modes is the Cipher Block Chaining (CBC) --> + <!-- mode, where the encryption of an 8 byte segment depend not only --> + <!-- of the contents of the segment itself, but also on the result of --> + <!-- encrypting the previous segment: the encryption of the previous --> + <!-- segment becomes the initializing vector of the encryption of the --> + <!-- current segment. --> + <!-- </p> --> + <!-- <p>Thus the encryption of every segment depends on the encryption --> + <!-- key (which is secret) and the encryption of the previous --> + <!-- segment, except the first segment which has to be provided with --> + <!-- an initial initializing vector. That vector could be chosen at --> + <!-- random, or be a counter of some kind. It does not have to be --> + <!-- secret. --> + <!-- </p> --> + <!-- <p>The following example is drawn from the old FIPS 81 standard --> + <!-- (replaced by NIST SP 800-38A), where both the plain text and the --> + <!-- resulting cipher text is settled. The following code fragment --> + <!-- returns `true'. --> + <!-- </p> --> + <!-- <pre><![CDATA[ --> + + <!-- Key = <<16#01,16#23,16#45,16#67,16#89,16#ab,16#cd,16#ef>>, --> + <!-- IVec = <<16#12,16#34,16#56,16#78,16#90,16#ab,16#cd,16#ef>>, --> + <!-- P = "Now is the time for all ", --> + <!-- C = crypto:des_cbc_encrypt(Key, IVec, P), --> + <!-- % Which is the same as --> + <!-- P1 = "Now is t", P2 = "he time ", P3 = "for all ", --> + <!-- C1 = crypto:des_cbc_encrypt(Key, IVec, P1), --> + <!-- C2 = crypto:des_cbc_encrypt(Key, C1, P2), --> + <!-- C3 = crypto:des_cbc_encrypt(Key, C2, P3), --> + + <!-- C = <<C1/binary, C2/binary, C3/binary>>, --> + <!-- C = <<16#e5,16#c7,16#cd,16#de,16#87,16#2b,16#f2,16#7c, --> + <!-- 16#43,16#e9,16#34,16#00,16#8c,16#38,16#9c,16#0f, --> + <!-- 16#68,16#37,16#88,16#49,16#9a,16#7c,16#05,16#f6>>, --> + <!-- <<"Now is the time for all ">> == --> + <!-- crypto:des_cbc_decrypt(Key, IVec, C). --> + <!-- ]]></pre> --> + <!-- <p>The following is true for the DES CBC mode. For all --> + <!-- decompositions <c>P1 ++ P2 = P</c> of a plain text message --> + <!-- <c>P</c> (where the length of all quantities are multiples of 8 --> + <!-- bytes), the encryption <c>C</c> of <c>P</c> is equal to <c>C1 ++ --> + <!-- C2</c>, where <c>C1</c> is obtained by encrypting <c>P1</c> with --> + <!-- <c>Key</c> and the initializing vector <c>IVec</c>, and where --> + <!-- <c>C2</c> is obtained by encrypting <c>P2</c> with <c>Key</c> --> + <!-- and the initializing vector <c>last8(C1)</c>, --> + <!-- where <c>last(Binary)</c> denotes the last 8 bytes of the --> + <!-- binary <c>Binary</c>. --> + <!-- </p> --> + <!-- <p>Similarly, for all decompositions <c>C1 ++ C2 = C</c> of a --> + <!-- cipher text message <c>C</c> (where the length of all quantities --> + <!-- are multiples of 8 bytes), the decryption <c>P</c> of <c>C</c> --> + <!-- is equal to <c>P1 ++ P2</c>, where <c>P1</c> is obtained by --> + <!-- decrypting <c>C1</c> with <c>Key</c> and the initializing vector --> + <!-- <c>IVec</c>, and where <c>P2</c> is obtained by decrypting --> + <!-- <c>C2</c> with <c>Key</c> and the initializing vector --> + <!-- <c>last8(C1)</c>, where <c>last8(Binary)</c> is as above. --> + <!-- </p> --> + <!-- <p>For DES3 (which uses three 64 bit keys) the situation is the --> + <!-- same. --> + <!-- </p> --> + <!-- </section> --> </erlref> diff --git a/lib/crypto/doc/src/crypto_app.xml b/lib/crypto/doc/src/crypto_app.xml index 8371db1ff2..6d26076c04 100644 --- a/lib/crypto/doc/src/crypto_app.xml +++ b/lib/crypto/doc/src/crypto_app.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="iso-8859-1" ?> <!DOCTYPE appref SYSTEM "appref.dtd"> <appref> @@ -24,81 +24,28 @@ </legalnotice> <title>crypto</title> - <prepared>Peter Högfeldt</prepared> - <responsible>Peter Högfeldt</responsible> - <docno></docno> - <approved>Peter Högfeldt</approved> - <checked>Peter Högfeldt</checked> - <date>2003-06-01</date> - <rev>B</rev> <file>crypto_app.sgml</file> </header> <app>crypto</app> <appsummary>The Crypto Application</appsummary> <description> - <p>The purpose of the Crypto application is to provide message - digest and DES encryption for SMNPv3. It provides computation of - message digests MD5 and SHA, and CBC-DES encryption and - decryption.</p> - <p></p> + <p>The purpose of the Crypto application is to provide an Erlang API + to cryptographic functions, see <seealso marker="crypto">crypto(3)</seealso>. + Note that the API is on a fairly low level and there are some + corresponding API functions available in <seealso marker="public_key:public_key">public_key(3)</seealso>, + on a higher abstraction level, that uses the crypto application in its implementation. + </p> </description> <section> - <title>Configuration</title> - <p>The following environment configuration parameters are defined - for the Crypto application. Refer to application(3) for more - information about configuration parameters. - </p> - <taglist> - <tag><c><![CDATA[debug = true | false <optional>]]></c></tag> - <item> - <p>Causes debug information to be written to standard - error or standard output. Default is <c>false</c>. - </p> - </item> - </taglist> - </section> + <title>DEPENDENCIES</title> - <section> - <title>OpenSSL libraries</title> - <p>The current implementation of the Erlang Crypto application is - based on the <em>OpenSSL</em> package version 0.9.8 or higher. - There are source and binary releases on the web. - </p> + <p>The current crypto implementation uses nifs to interface OpenSSLs crypto library + and requires <em>OpenSSL</em> package version 0.9.8 or higher.</p> <p>Source releases of OpenSSL can be downloaded from the <url href="http://www.openssl.org">OpenSSL</url> project home page, - or mirror sites listed there. - </p> - <p>The same URL also contains links to some compiled binaries and - libraries of OpenSSL (see the <c>Related/Binaries</c> menu) of - which the <url href="http://www.shininglightpro.com/search.php?searchname=Win32+OpenSSL">Shining Light Productions Win32 and OpenSSL</url> pages are of - interest for the Win32 user. - </p> - <p>For some Unix flavours there are binary packages available - on the net. - </p> - <p>If you cannot find a suitable binary OpenSSL package, you - have to fetch an OpenSSL source release and compile it. - </p> - <p>You then have to compile and install the library - <c>libcrypto.so</c> (Unix), or the library <c>libeay32.dll</c> - (Win32). - </p> - <p>For Unix The <c>crypto_drv</c> dynamic driver is delivered linked - to OpenSSL libraries in <c>/usr/local/lib</c>, but the default - dynamic linking will also accept libraries in <c>/lib</c> and - <c>/usr/lib</c>. - </p> - <p>If that is not applicable to the particular Unix operating - system used, the example <c>Makefile</c> in the Crypto - <c>priv/obj</c> directory, should be used as a basis for - relinking the final version of the port program. - </p> - <p>For <c>Win32</c> it is only required that the library can be - found from the <c>PATH</c> environment variable, or that they - reside in the appropriate <c>SYSTEM32</c> directory; hence no - particular relinking is need. Hence no example <c>Makefile</c> - for Win32 is provided.</p> - </section> + or mirror sites listed there. + </p> + </section> <section> <title>SEE ALSO</title> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 1d0a9943c3..e042545094 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -21,104 +21,219 @@ -module(crypto). --export([start/0, stop/0, info/0, info_lib/0, algorithms/0, version/0]). +-export([start/0, stop/0, info_lib/0, supports/0, version/0, bytes_to_integer/1]). -export([hash/2, hash_init/1, hash_update/2, hash_final/1]). +-export([sign/4, verify/5]). +-export([generate_key/2, generate_key/3, compute_key/4]). +-export([hmac/3, hmac/4, hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]). +-export([exor/2, strong_rand_bytes/1, mod_pow/3]). +-export([rand_bytes/1, rand_bytes/3, rand_uniform/2]). +-export([block_encrypt/3, block_decrypt/3, block_encrypt/4, block_decrypt/4]). +-export([next_iv/2, next_iv/3]). +-export([stream_init/2, stream_init/3, stream_encrypt/2, stream_decrypt/2]). +-export([public_encrypt/4, private_decrypt/4]). +-export([private_encrypt/4, public_decrypt/4]). +-export([dh_generate_parameters/2, dh_check/1]). %% Testing see + + +%% DEPRECATED +%% Replaced by hash_* -export([md4/1, md4_init/0, md4_update/2, md4_final/1]). -export([md5/1, md5_init/0, md5_update/2, md5_final/1]). -export([sha/1, sha_init/0, sha_update/2, sha_final/1]). --export([sha224/1, sha224_init/0, sha224_update/2, sha224_final/1]). --export([sha256/1, sha256_init/0, sha256_update/2, sha256_final/1]). --export([sha384/1, sha384_init/0, sha384_update/2, sha384_final/1]). --export([sha512/1, sha512_init/0, sha512_update/2, sha512_final/1]). +-deprecated({md4, 1, next_major_release}). +-deprecated({md5, 1, next_major_release}). +-deprecated({sha, 1, next_major_release}). +-deprecated({md4_init, 0, next_major_release}). +-deprecated({md5_init, 0, next_major_release}). +-deprecated({sha_init, 0, next_major_release}). +-deprecated({md4_update, 2, next_major_release}). +-deprecated({md5_update, 2, next_major_release}). +-deprecated({sha_update, 2, next_major_release}). +-deprecated({md4_final, 1, next_major_release}). +-deprecated({md5_final, 1, next_major_release}). +-deprecated({sha_final, 1, next_major_release}). + +%% Replaced by hmac_* -export([md5_mac/2, md5_mac_96/2, sha_mac/2, sha_mac/3, sha_mac_96/2]). --export([sha224_mac/2, sha224_mac/3]). --export([sha256_mac/2, sha256_mac/3]). --export([sha384_mac/2, sha384_mac/3]). --export([sha512_mac/2, sha512_mac/3]). --export([hmac/3, hmac/4, hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]). +-deprecated({md5_mac, 2, next_major_release}). +-deprecated({md5_mac_96, 2, next_major_release}). +-deprecated({sha_mac, 2, next_major_release}). +-deprecated({sha_mac, 3, next_major_release}). +-deprecated({sha_mac_96, 2, next_major_release}). + +%% Replaced by sign/verify +-export([dss_verify/3, dss_verify/4, rsa_verify/3, rsa_verify/4]). +-export([dss_sign/2, dss_sign/3, rsa_sign/2, rsa_sign/3]). +-deprecated({dss_verify, 3, next_major_release}). +-deprecated({dss_verify, 4, next_major_release}). +-deprecated({rsa_verify, 3, next_major_release}). +-deprecated({rsa_verify, 4, next_major_release}). +-deprecated({dss_sign, 2, next_major_release}). +-deprecated({dss_sign, 3, next_major_release}). +-deprecated({rsa_sign, 2, next_major_release}). +-deprecated({rsa_sign, 3, next_major_release}). + +%% Replaced by generate_key +-export([dh_generate_key/1, dh_generate_key/2, dh_compute_key/3]). +-deprecated({dh_generate_key, 1, next_major_release}). +-deprecated({dh_generate_key, 2, next_major_release}). +-deprecated({dh_compute_key, 3, next_major_release}). + +%% Replaced by mod_exp_prim and no longer needed +-export([mod_exp/3, mpint/1, erlint/1, strong_rand_mpint/3]). +-deprecated({mod_exp, 3, next_major_release}). +-deprecated({mpint, 1, next_major_release}). +-deprecated({erlint, 1, next_major_release}). +-deprecated({strong_rand_mpint, 3, next_major_release}). + +%% Replaced by block_* -export([des_cbc_encrypt/3, des_cbc_decrypt/3, des_cbc_ivec/1]). +-export([des3_cbc_encrypt/5, des3_cbc_decrypt/5]). -export([des_ecb_encrypt/2, des_ecb_decrypt/2]). +-export([des_ede3_cbc_encrypt/5, des_ede3_cbc_decrypt/5]). -export([des_cfb_encrypt/3, des_cfb_decrypt/3, des_cfb_ivec/2]). --export([des3_cbc_encrypt/5, des3_cbc_decrypt/5]). -export([des3_cfb_encrypt/5, des3_cfb_decrypt/5]). +-deprecated({des_cbc_encrypt, 3, next_major_release}). +-deprecated({des_cbc_decrypt, 3, next_major_release}). +-deprecated({des_cbc_ivec, 1, next_major_release}). +-deprecated({des3_cbc_encrypt, 5, next_major_release}). +-deprecated({des3_cbc_decrypt, 5, next_major_release}). +-deprecated({des_ecb_encrypt, 2, next_major_release}). +-deprecated({des_ecb_decrypt, 2, next_major_release}). +-deprecated({des_ede3_cbc_encrypt, 5, next_major_release}). +-deprecated({des_ede3_cbc_decrypt, 5, next_major_release}). +-deprecated({des_cfb_encrypt, 3, next_major_release}). +-deprecated({des_cfb_decrypt, 3, next_major_release}). +-deprecated({des_cfb_ivec, 2, next_major_release}). +-deprecated({des3_cfb_encrypt, 5, next_major_release}). +-deprecated({des3_cfb_decrypt, 5, next_major_release}). -export([blowfish_ecb_encrypt/2, blowfish_ecb_decrypt/2]). -export([blowfish_cbc_encrypt/3, blowfish_cbc_decrypt/3]). -export([blowfish_cfb64_encrypt/3, blowfish_cfb64_decrypt/3]). -export([blowfish_ofb64_encrypt/3]). --export([des_ede3_cbc_encrypt/5, des_ede3_cbc_decrypt/5]). +-deprecated({blowfish_ecb_encrypt, 2, next_major_release}). +-deprecated({blowfish_ecb_decrypt, 2, next_major_release}). +-deprecated({blowfish_cbc_encrypt, 3, next_major_release}). +-deprecated({blowfish_cbc_decrypt, 3, next_major_release}). +-deprecated({blowfish_cfb64_encrypt, 3, next_major_release}). +-deprecated({blowfish_cfb64_decrypt, 3, next_major_release}). +-deprecated({blowfish_ofb64_encrypt, 3, next_major_release}). -export([aes_cfb_128_encrypt/3, aes_cfb_128_decrypt/3]). --export([exor/2]). --export([rc4_encrypt/2, rc4_set_key/1, rc4_encrypt_with_state/2]). --export([rc2_cbc_encrypt/3, rc2_cbc_decrypt/3, rc2_40_cbc_encrypt/3, rc2_40_cbc_decrypt/3]). --export([dss_verify/3, dss_verify/4, rsa_verify/3, rsa_verify/4]). --export([dss_sign/2, dss_sign/3, rsa_sign/2, rsa_sign/3]). --export([rsa_public_encrypt/3, rsa_private_decrypt/3]). --export([rsa_private_encrypt/3, rsa_public_decrypt/3]). --export([dh_generate_key/1, dh_generate_key/2, dh_compute_key/3]). --export([rand_bytes/1, rand_bytes/3, rand_uniform/2]). --export([strong_rand_bytes/1, strong_rand_mpint/3]). --export([mod_exp/3, mod_exp_prime/3, mpint/1, erlint/1]). --export([srp_generate_key/4, srp_generate_key/3, - srp_generate_key/5, srp_compute_key/6, srp_compute_key/7, srp_compute_key/8]). - -%% -export([idea_cbc_encrypt/3, idea_cbc_decrypt/3]). -export([aes_cbc_128_encrypt/3, aes_cbc_128_decrypt/3]). -export([aes_cbc_256_encrypt/3, aes_cbc_256_decrypt/3]). -export([aes_cbc_ivec/1]). --export([aes_ctr_encrypt/3, aes_ctr_decrypt/3]). +-deprecated({aes_cfb_128_encrypt, 3, next_major_release}). +-deprecated({aes_cfb_128_decrypt, 3, next_major_release}). +-deprecated({aes_cbc_128_encrypt, 3, next_major_release}). +-deprecated({aes_cbc_128_decrypt, 3, next_major_release}). +-deprecated({aes_cbc_256_encrypt, 3, next_major_release}). +-deprecated({aes_cbc_256_decrypt, 3, next_major_release}). +-deprecated({aes_cbc_ivec, 1, next_major_release}). +-export([rc2_cbc_encrypt/3, rc2_cbc_decrypt/3]). +-export([rc2_40_cbc_encrypt/3, rc2_40_cbc_decrypt/3]). +-deprecated({rc2_cbc_encrypt, 3, next_major_release}). +-deprecated({rc2_cbc_decrypt, 3, next_major_release}). +%% allready replaced by above! +-deprecated({rc2_40_cbc_encrypt, 3, next_major_release}). +-deprecated({rc2_40_cbc_decrypt, 3, next_major_release}). + +%% Replaced by stream_* -export([aes_ctr_stream_init/2, aes_ctr_stream_encrypt/2, aes_ctr_stream_decrypt/2]). - --export([dh_generate_parameters/2, dh_check/1]). %% Testing see below - - --define(FUNC_LIST, [md4, md4_init, md4_update, md4_final, +-export([rc4_set_key/1, rc4_encrypt_with_state/2]). +-deprecated({aes_ctr_stream_init, 2, next_major_release}). +-deprecated({aes_ctr_stream_encrypt, 2, next_major_release}). +-deprecated({aes_ctr_stream_decrypt, 2, next_major_release}). +-deprecated({rc4_set_key, 1, next_major_release}). +-deprecated({rc4_encrypt_with_state, 2, next_major_release}). + +%% Not needed special case of stream_* +-export([aes_ctr_encrypt/3, aes_ctr_decrypt/3, rc4_encrypt/2]). +-deprecated({aes_ctr_encrypt, 3, next_major_release}). +-deprecated({aes_ctr_decrypt, 3, next_major_release}). +-deprecated({rc4_encrypt, 2, next_major_release}). + +%% Replace by public/private_encrypt/decrypt +-export([rsa_public_encrypt/3, rsa_private_decrypt/3]). +-export([rsa_private_encrypt/3, rsa_public_decrypt/3]). +-deprecated({rsa_public_encrypt, 3, next_major_release}). +-deprecated({rsa_private_decrypt, 3, next_major_release}). +-deprecated({rsa_public_decrypt, 3, next_major_release}). +-deprecated({rsa_private_encrypt, 3, next_major_release}). + +%% Replaced by crypto:module_info() +-export([info/0]). +-deprecated({info, 0, next_major_release}). + +-define(FUNC_LIST, [hash, hash_init, hash_update, hash_final, + hmac, hmac_init, hmac_update, hmac_final, hmac_final_n, + %% deprecated + md4, md4_init, md4_update, md4_final, md5, md5_init, md5_update, md5_final, sha, sha_init, sha_update, sha_final, - sha224, sha224_init, sha224_update, sha224_final, - sha256, sha256_init, sha256_update, sha256_final, - sha384, sha384_init, sha384_update, sha384_final, - sha512, sha512_init, sha512_update, sha512_final, md5_mac, md5_mac_96, sha_mac, sha_mac_96, - sha224_mac, sha256_mac, sha384_mac, sha512_mac, + %% + block_encrypt, block_decrypt, + %% deprecated des_cbc_encrypt, des_cbc_decrypt, des_cfb_encrypt, des_cfb_decrypt, des_ecb_encrypt, des_ecb_decrypt, des3_cbc_encrypt, des3_cbc_decrypt, des3_cfb_encrypt, des3_cfb_decrypt, aes_cfb_128_encrypt, aes_cfb_128_decrypt, + rc2_cbc_encrypt, rc2_cbc_decrypt, + rc2_40_cbc_encrypt, rc2_40_cbc_decrypt, + aes_cbc_128_encrypt, aes_cbc_128_decrypt, + aes_cbc_256_encrypt, aes_cbc_256_decrypt, + blowfish_cbc_encrypt, blowfish_cbc_decrypt, + blowfish_cfb64_encrypt, blowfish_cfb64_decrypt, + blowfish_ecb_encrypt, blowfish_ecb_decrypt, blowfish_ofb64_encrypt, + %% rand_bytes, strong_rand_bytes, - strong_rand_mpint, rand_uniform, - mod_exp, mod_exp_prime, + mod_pow, + exor, + %% deprecated + mod_exp,strong_rand_mpint,erlint, mpint, + %% + sign, verify, generate_key, compute_key, + %% deprecated dss_verify,dss_sign, rsa_verify,rsa_sign, rsa_public_encrypt,rsa_private_decrypt, rsa_private_encrypt,rsa_public_decrypt, dh_generate_key, dh_compute_key, - aes_cbc_128_encrypt, aes_cbc_128_decrypt, - exor, + %% + stream_init, stream_encrypt, stream_decrypt, + %% deprecated rc4_encrypt, rc4_set_key, rc4_encrypt_with_state, - rc2_40_cbc_encrypt, rc2_40_cbc_decrypt, - %% idea_cbc_encrypt, idea_cbc_decrypt, - aes_cbc_256_encrypt, aes_cbc_256_decrypt, aes_ctr_encrypt, aes_ctr_decrypt, aes_ctr_stream_init, aes_ctr_stream_encrypt, aes_ctr_stream_decrypt, - aes_cbc_ivec, blowfish_cbc_encrypt, blowfish_cbc_decrypt, - blowfish_cfb64_encrypt, blowfish_cfb64_decrypt, - blowfish_ecb_encrypt, blowfish_ecb_decrypt, blowfish_ofb64_encrypt, - des_cbc_ivec, des_cfb_ivec, erlint, mpint, - hash, hash_init, hash_update, hash_final, - hmac, hmac_init, hmac_update, hmac_final, hmac_final_n, info, - rc2_cbc_encrypt, rc2_cbc_decrypt, - srp_generate_key, srp_compute_key, - info_lib, algorithms]). - + %% + next_iv, + %% deprecated + aes_cbc_ivec, + des_cbc_ivec, des_cfb_ivec, + info, + %% + info_lib, supports]). + +-type mpint() :: binary(). -type rsa_digest_type() :: 'md5' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'. -type dss_digest_type() :: 'none' | 'sha'. +%%-type ecdsa_digest_type() :: 'md5' | 'sha' | 'sha256' | 'sha384' | 'sha512'. -type data_or_digest() :: binary() | {digest, binary()}. -type crypto_integer() :: binary() | integer(). +%%-type ec_named_curve() :: atom(). +%%-type ec_point() :: crypto_integer(). +%%-type ec_basis() :: {tpbasis, K :: non_neg_integer()} | {ppbasis, K1 :: non_neg_integer(), K2 :: non_neg_integer(), K3 :: non_neg_integer()} | onbasis. +%%-type ec_field() :: {prime_field, Prime :: integer()} | {characteristic_two_field, M :: integer(), Basis :: ec_basis()}. +%%-type ec_prime() :: {A :: crypto_integer(), B :: crypto_integer(), Seed :: binary() | none}. +%%-type ec_curve_spec() :: {Field :: ec_field(), Prime :: ec_prime(), Point :: crypto_integer(), Order :: integer(), CoFactor :: none | integer()}. +%%-type ec_curve() :: ec_named_curve() | ec_curve_spec(). +%%-type ec_key() :: {Curve :: ec_curve(), PrivKey :: binary() | undefined, PubKey :: ec_point() | undefined}. -define(nif_stub,nif_stub_error(?LINE)). @@ -190,6 +305,22 @@ info_lib() -> ?nif_stub. algorithms() -> ?nif_stub. +supports()-> + Algs = algorithms(), + PubKeyAlgs = + case lists:member(ec, Algs) of + true -> + {public_keys, [rsa, dss, ecdsa, dh, srp, ecdh]}; + false -> + {public_keys, [rsa, dss, dh, srp]} + end, + [{hashs, Algs -- [ec]}, + {ciphers, [des_cbc, des_cfb, des3_cbc, des3_cbf, des_ede3, blowfish_cbc, + blowfish_cfb64, blowfish_ofb64, blowfish_ecb, aes_cbc128, aes_cfb128, aes_cbc256, rc2_cbc, aes_ctr, rc4 + ]}, + PubKeyAlgs + ]. + %% Crypto app version history: %% (no version): Driver implementation %% 2.0 : NIF implementation, requires OTP R14 @@ -459,7 +590,7 @@ hmac(sha384, Key, Data) -> sha384_mac(Key, Data); hmac(sha512, Key, Data) -> sha512_mac(Key, Data). hmac(md5, Key, Data, Size) -> md5_mac_n(Key, Data, Size); -hmac(sha, Key, Data, Size) -> sha_mac(Key, Data, Size); +hmac(sha, Key, Data, Size) -> sha_mac_n(Key, Data, Size); hmac(sha224, Key, Data, Size) -> sha224_mac(Key, Data, Size); hmac(sha256, Key, Data, Size) -> sha256_mac(Key, Data, Size); hmac(sha384, Key, Data, Size) -> sha384_mac(Key, Data, Size); @@ -565,6 +696,114 @@ sha512_mac(Key, Data, MacSz) -> sha512_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub. + +%% Ecrypt/decrypt %%% + +-spec block_encrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | + blowfish_cfb64 | aes_cbc128 | aes_cfb128 | aes_cbc256 | rc2_cbc, + Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(). + +block_encrypt(des_cbc, Key, Ivec, Data) -> + des_cbc_encrypt(Key, Ivec, Data); +block_encrypt(des_cfb, Key, Ivec, Data) -> + des_cfb_encrypt(Key, Ivec, Data); +block_encrypt(des3_cbc, [Key1, Key2, Key3], Ivec, Data) -> + des3_cbc_encrypt(Key1, Key2, Key3, Ivec, Data); +block_encrypt(des3_cbf, [Key1, Key2, Key3], Ivec, Data) -> + des3_cfb_encrypt(Key1, Key2, Key3, Ivec, Data); +block_encrypt(des_ede3, [Key1, Key2, Key3], Ivec, Data) -> + des_ede3_cbc_encrypt(Key1, Key2, Key3, Ivec, Data); +block_encrypt(blowfish_cbc, Key, Ivec, Data) -> + blowfish_cbc_encrypt(Key, Ivec, Data); +block_encrypt(blowfish_cfb64, Key, Ivec, Data) -> + blowfish_cfb64_encrypt(Key, Ivec, Data); +block_encrypt(blowfish_ofb64, Key, Ivec, Data) -> + blowfish_ofb64_encrypt(Key, Ivec, Data); +block_encrypt(aes_cbc128, Key, Ivec, Data) -> + aes_cbc_128_encrypt(Key, Ivec, Data); +block_encrypt(aes_cbc256, Key, Ivec, Data) -> + aes_cbc_256_encrypt(Key, Ivec, Data); +block_encrypt(aes_cfb128, Key, Ivec, Data) -> + aes_cfb_128_encrypt(Key, Ivec, Data); +block_encrypt(rc2_cbc, Key, Ivec, Data) -> + rc2_cbc_encrypt(Key, Ivec, Data). + +-spec block_decrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | + blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cbc256 | aes_cfb128 | rc2_cbc, + Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(). + +block_decrypt(des_cbc, Key, Ivec, Data) -> + des_cbc_decrypt(Key, Ivec, Data); +block_decrypt(des_cfb, Key, Ivec, Data) -> + des_cfb_decrypt(Key, Ivec, Data); +block_decrypt(des3_cbc, [Key1, Key2, Key3], Ivec, Data) -> + des3_cbc_decrypt(Key1, Key2, Key3, Ivec, Data); +block_decrypt(des3_cbf, [Key1, Key2, Key3], Ivec, Data) -> + des3_cfb_decrypt(Key1, Key2, Key3, Ivec, Data); +block_decrypt(des_ede3, [Key1, Key2, Key3], Ivec, Data) -> + des_ede3_cbc_decrypt(Key1, Key2, Key3, Ivec, Data); +block_decrypt(blowfish_cbc, Key, Ivec, Data) -> + blowfish_cbc_decrypt(Key, Ivec, Data); +block_decrypt(blowfish_cfb64, Key, Ivec, Data) -> + blowfish_cfb64_decrypt(Key, Ivec, Data); +block_decrypt(blowfish_ofb64, Key, Ivec, Data) -> + blowfish_ofb64_decrypt(Key, Ivec, Data); +block_decrypt(aes_cbc128, Key, Ivec, Data) -> + aes_cbc_128_decrypt(Key, Ivec, Data); +block_decrypt(aes_cbc256, Key, Ivec, Data) -> + aes_cbc_256_decrypt(Key, Ivec, Data); +block_decrypt(aes_cfb128, Key, Ivec, Data) -> + aes_cfb_128_decrypt(Key, Ivec, Data); +block_decrypt(rc2_cbc, Key, Ivec, Data) -> + rc2_cbc_decrypt(Key, Ivec, Data). + +-spec block_encrypt(des_ecb | blowfish_ecb, Key::iodata(), Data::iodata()) -> binary(). + +block_encrypt(des_ecb, Key, Data) -> + des_ecb_encrypt(Key, Data); +block_encrypt(blowfish_ecb, Key, Data) -> + blowfish_ecb_encrypt(Key, Data). + +-spec block_decrypt(des_ecb | blowfish_ecb, Key::iodata(), Data::iodata()) -> binary(). + +block_decrypt(des_ecb, Key, Data) -> + des_ecb_decrypt(Key, Data); +block_decrypt(blowfish_ecb, Key, Data) -> + blowfish_ecb_decrypt(Key, Data). + +-spec next_iv(des_cbc | des3_cbc | aes_cbc, Data::iodata()) -> binary(). + +next_iv(des_cbc, Data) -> + des_cbc_ivec(Data); +next_iv(des3_cbc, Data) -> + des_cbc_ivec(Data); +next_iv(aes_cbc, Data) -> + aes_cbc_ivec(Data). + +-spec next_iv(des_cfb, Data::iodata(), Ivec::binary()) -> binary(). + +next_iv(des_cfb, Data, Ivec) -> + des_cfb_ivec(Ivec, Data); +next_iv(Type, Data, _Ivec) -> + next_iv(Type, Data). + +stream_init(aes_ctr, Key, Ivec) -> + {aes_ctr, aes_ctr_stream_init(Key, Ivec)}. +stream_init(rc4, Key) -> + {rc4, rc4_set_key(Key)}. +stream_encrypt({aes_ctr, State0}, Data) -> + {State, Cipher} = aes_ctr_stream_encrypt(State0, Data), + {{aes_ctr, State}, Cipher}; +stream_encrypt({rc4, State0}, Data) -> + {State, Cipher} = rc4_encrypt_with_state(State0, Data), + {{rc4, State}, Cipher}. +stream_decrypt({aes_ctr, State0}, Data) -> + {State, Text} = aes_ctr_stream_decrypt(State0, Data), + {{aes_ctr, State}, Text}; +stream_decrypt({rc4, State0}, Data) -> + {State, Text} = rc4_encrypt_with_state (State0, Data), + {{rc4, State}, Text}. + %% %% CRYPTO FUNCTIONS %% @@ -713,8 +952,12 @@ blowfish_cfb64_decrypt(Key, IVec, Data) -> bf_cfb64_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. +blowfish_ofb64_decrypt(Key, Ivec, Data) -> + blowfish_ofb64_encrypt(Key, Ivec, Data). + blowfish_ofb64_encrypt(_Key, _IVec, _Data) -> ?nif_stub. + %% %% AES in cipher feedback mode (CFB) %% @@ -798,9 +1041,9 @@ mod_exp(Base, Exponent, Modulo) mod_exp(Base, Exponent, Modulo) -> mod_exp_nif(mpint_to_bin(Base),mpint_to_bin(Exponent),mpint_to_bin(Modulo), 4). --spec mod_exp_prime(binary(), binary(), binary()) -> binary() | error. -mod_exp_prime(Base, Exponent, Prime) -> - case mod_exp_nif(Base, Exponent, Prime, 0) of +-spec mod_pow(binary()|integer(), binary()|integer(), binary()|integer()) -> binary() | error. +mod_pow(Base, Exponent, Prime) -> + case mod_exp_nif(ensure_int_as_bin(Base), ensure_int_as_bin(Exponent), ensure_int_as_bin(Prime), 0) of <<0>> -> error; R -> R end. @@ -819,19 +1062,40 @@ mod_exp_nif(_Base,_Exp,_Mod,_bin_hdr) -> ?nif_stub. %% Key = [P,Q,G,Y] P,Q,G=DSSParams Y=PublicKey dss_verify(Data,Signature,Key) -> - dss_verify(sha, Data, Signature, Key). -dss_verify(_Type,_Data,_Signature,_Key) -> ?nif_stub. + dss_verify(sha, Data, Signature, Key). + +dss_verify(Type,Data,Signature,Key) when is_binary(Data), Type=/=none -> + verify(dss,Type,mpint_to_bin(Data),mpint_to_bin(Signature),map_mpint_to_bin(Key)); +dss_verify(Type,Digest,Signature,Key) -> + verify(dss,Type,Digest,mpint_to_bin(Signature),map_mpint_to_bin(Key)). % Key = [E,N] E=PublicExponent N=PublicModulus rsa_verify(Data,Signature,Key) -> - rsa_verify_nif(sha, Data,Signature,Key). -rsa_verify(Type, DataOrDigest, Signature, Key) -> - case rsa_verify_nif(Type, DataOrDigest, Signature, Key) of + rsa_verify(sha, Data,Signature,Key). +rsa_verify(Type, Data, Signature, Key) when is_binary(Data) -> + verify(rsa, Type, mpint_to_bin(Data), mpint_to_bin(Signature), map_mpint_to_bin(Key)); +rsa_verify(Type, Digest, Signature, Key) -> + verify(rsa, Type, Digest, mpint_to_bin(Signature), map_mpint_to_bin(Key)). + + +verify(dss, Type, Data, Signature, Key) -> + dss_verify_nif(Type, Data, Signature, map_ensure_int_as_bin(Key)); + +verify(rsa, Type, DataOrDigest, Signature, Key) -> + case rsa_verify_nif(Type, DataOrDigest, Signature, map_ensure_int_as_bin(Key)) of notsup -> erlang:error(notsup); Bool -> Bool + end; +verify(ecdsa, Type, DataOrDigest, Signature, [Key, Curve]) -> + case ecdsa_verify_nif(Type, DataOrDigest, Signature, term_to_ec_key(Curve, undefined, Key)) of + notsup -> erlang:error(notsup); + Bool -> Bool end. + +dss_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub. rsa_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub. +ecdsa_verify_nif(_Type, _DataOrDigest, _Signature, _Key) -> ?nif_stub. %% @@ -845,24 +1109,103 @@ rsa_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub. dss_sign(DataOrDigest,Key) -> dss_sign(sha,DataOrDigest,Key). -dss_sign(Type, DataOrDigest, Key) -> - case dss_sign_nif(Type,DataOrDigest,Key) of - error -> erlang:error(badkey, [DataOrDigest, Key]); - Sign -> Sign - end. +dss_sign(Type, Data, Key) when is_binary(Data), Type=/=none -> + sign(dss, Type, mpint_to_bin(Data), map_mpint_to_bin(Key)); +dss_sign(Type, Digest, Key) -> + sign(dss, Type, Digest, map_mpint_to_bin(Key)). -dss_sign_nif(_Type,_Data,_Key) -> ?nif_stub. %% Key = [E,N,D] E=PublicExponent N=PublicModulus D=PrivateExponent rsa_sign(DataOrDigest,Key) -> rsa_sign(sha, DataOrDigest, Key). -rsa_sign(Type, DataOrDigest, Key) -> - case rsa_sign_nif(Type,DataOrDigest,Key) of + +rsa_sign(Type, Data, Key) when is_binary(Data) -> + sign(rsa, Type, mpint_to_bin(Data), map_mpint_to_bin(Key)); +rsa_sign(Type, Digest, Key) -> + sign(rsa, Type, Digest, map_mpint_to_bin(Key)). + +map_mpint_to_bin(List) -> + lists:map(fun(E) -> mpint_to_bin(E) end, List ). + +map_ensure_int_as_bin([H|_]=List) when is_integer(H) -> + lists:map(fun(E) -> int_to_bin(E) end, List); +map_ensure_int_as_bin(List) -> + List. + +ensure_int_as_bin(Int) when is_integer(Int) -> + int_to_bin(Int); +ensure_int_as_bin(Bin) -> + Bin. + +map_to_norm_bin([H|_]=List) when is_integer(H) -> + lists:map(fun(E) -> int_to_bin(E) end, List); +map_to_norm_bin(List) -> + lists:map(fun(E) -> mpint_to_bin(E) end, List). + + +sign(rsa, Type, DataOrDigest, Key) -> + case rsa_sign_nif(Type, DataOrDigest, map_ensure_int_as_bin(Key)) of + error -> erlang:error(badkey, [Type,DataOrDigest,Key]); + Sign -> Sign + end; +sign(dss, Type, DataOrDigest, Key) -> + case dss_sign_nif(Type, DataOrDigest, map_ensure_int_as_bin(Key)) of + error -> erlang:error(badkey, [DataOrDigest, Key]); + Sign -> Sign + end; +sign(ecdsa, Type, DataOrDigest, [Key, Curve]) -> + case ecdsa_sign_nif(Type, DataOrDigest, term_to_ec_key(Curve, Key, undefined)) of error -> erlang:error(badkey, [Type,DataOrDigest,Key]); Sign -> Sign end. rsa_sign_nif(_Type,_Data,_Key) -> ?nif_stub. +dss_sign_nif(_Type,_Data,_Key) -> ?nif_stub. +ecdsa_sign_nif(_Type, _DataOrDigest, _Key) -> ?nif_stub. + + + + +-spec public_encrypt(rsa, binary(), [binary()], rsa_padding()) -> + binary(). +-spec public_decrypt(rsa, binary(), [integer() | binary()], rsa_padding()) -> + binary(). +-spec private_encrypt(rsa, binary(), [integer() | binary()], rsa_padding()) -> + binary(). +-spec private_decrypt(rsa, binary(), [integer() | binary()], rsa_padding()) -> + binary(). + +public_encrypt(rsa, BinMesg, Key, Padding) -> + case rsa_public_crypt(BinMesg, map_ensure_int_as_bin(Key), Padding, true) of + error -> + erlang:error(encrypt_failed, [BinMesg,Key, Padding]); + Sign -> Sign + end. + +%% Binary, Key = [E,N,D] +private_decrypt(rsa, BinMesg, Key, Padding) -> + case rsa_private_crypt(BinMesg, map_ensure_int_as_bin(Key), Padding, false) of + error -> + erlang:error(decrypt_failed, [BinMesg,Key, Padding]); + Sign -> Sign + end. + + +%% Binary, Key = [E,N,D] +private_encrypt(rsa, BinMesg, Key, Padding) -> + case rsa_private_crypt(BinMesg, map_ensure_int_as_bin(Key), Padding, true) of + error -> + erlang:error(encrypt_failed, [BinMesg,Key, Padding]); + Sign -> Sign + end. + +%% Binary, Key = [E,N] +public_decrypt(rsa, BinMesg, Key, Padding) -> + case rsa_public_crypt(BinMesg, map_ensure_int_as_bin(Key), Padding, false) of + error -> + erlang:error(decrypt_failed, [BinMesg,Key, Padding]); + Sign -> Sign + end. %% @@ -872,16 +1215,16 @@ rsa_sign_nif(_Type,_Data,_Key) -> ?nif_stub. -spec rsa_public_encrypt(binary(), [binary()], rsa_padding()) -> binary(). --spec rsa_public_decrypt(binary(), [binary()], rsa_padding()) -> +-spec rsa_public_decrypt(binary(), [integer() | mpint()], rsa_padding()) -> binary(). --spec rsa_private_encrypt(binary(), [binary()], rsa_padding()) -> +-spec rsa_private_encrypt(binary(), [integer() | mpint()], rsa_padding()) -> binary(). --spec rsa_private_decrypt(binary(), [binary()], rsa_padding()) -> +-spec rsa_private_decrypt(binary(), [integer() | mpint()], rsa_padding()) -> binary(). %% Binary, Key = [E,N] rsa_public_encrypt(BinMesg, Key, Padding) -> - case rsa_public_crypt(BinMesg, Key, Padding, true) of + case rsa_public_crypt(BinMesg, map_to_norm_bin(Key), Padding, true) of error -> erlang:error(encrypt_failed, [BinMesg,Key, Padding]); Sign -> Sign @@ -891,7 +1234,7 @@ rsa_public_crypt(_BinMsg, _Key, _Padding, _IsEncrypt) -> ?nif_stub. %% Binary, Key = [E,N,D] rsa_private_decrypt(BinMesg, Key, Padding) -> - case rsa_private_crypt(BinMesg, Key, Padding, false) of + case rsa_private_crypt(BinMesg, map_to_norm_bin(Key), Padding, false) of error -> erlang:error(decrypt_failed, [BinMesg,Key, Padding]); Sign -> Sign @@ -902,7 +1245,7 @@ rsa_private_crypt(_BinMsg, _Key, _Padding, _IsEncrypt) -> ?nif_stub. %% Binary, Key = [E,N,D] rsa_private_encrypt(BinMesg, Key, Padding) -> - case rsa_private_crypt(BinMesg, Key, Padding, true) of + case rsa_private_crypt(BinMesg, map_to_norm_bin(Key), Padding, true) of error -> erlang:error(encrypt_failed, [BinMesg,Key, Padding]); Sign -> Sign @@ -910,7 +1253,7 @@ rsa_private_encrypt(BinMesg, Key, Padding) -> %% Binary, Key = [E,N] rsa_public_decrypt(BinMesg, Key, Padding) -> - case rsa_public_crypt(BinMesg, Key, Padding, false) of + case rsa_public_crypt(BinMesg, map_to_norm_bin(Key), Padding, false) of error -> erlang:error(decrypt_failed, [BinMesg,Key, Padding]); Sign -> Sign @@ -1052,120 +1395,135 @@ dh_check([_Prime,_Gen]) -> ?nif_stub. {binary(),binary()}. dh_generate_key(DHParameters) -> - dh_generate_key(undefined, DHParameters). + dh_generate_key_nif(undefined, map_mpint_to_bin(DHParameters), 4). dh_generate_key(PrivateKey, DHParameters) -> - case dh_generate_key_nif(PrivateKey, DHParameters) of - error -> erlang:error(generation_failed, [PrivateKey,DHParameters]); - Res -> Res - end. + dh_generate_key_nif(mpint_to_bin(PrivateKey), map_mpint_to_bin(DHParameters), 4). -dh_generate_key_nif(_PrivateKey, _DHParameters) -> ?nif_stub. +dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint) -> ?nif_stub. %% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] -%% MyPrivKey, OthersPublicKey = mpint() +%% MyPrivKey, OthersPublicKey = mpint() -spec dh_compute_key(binary(), binary(), [binary()]) -> binary(). dh_compute_key(OthersPublicKey, MyPrivateKey, DHParameters) -> - case dh_compute_key_nif(OthersPublicKey,MyPrivateKey,DHParameters) of - error -> erlang:error(computation_failed, [OthersPublicKey,MyPrivateKey,DHParameters]); - Ret -> Ret - end. + compute_key(dh, mpint_to_bin(OthersPublicKey), mpint_to_bin(MyPrivateKey), + map_mpint_to_bin(DHParameters)). + dh_compute_key_nif(_OthersPublicKey, _MyPrivateKey, _DHParameters) -> ?nif_stub. +generate_key(Type, Params) -> + generate_key(Type, Params, undefined). + +generate_key(dh, DHParameters, PrivateKey) -> + dh_generate_key_nif(ensure_int_as_bin(PrivateKey), + map_ensure_int_as_bin(DHParameters), 0); + +generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, PrivArg) + when is_binary(Verifier), is_binary(Generator), is_binary(Prime), is_atom(Version) -> + Private = case PrivArg of + undefined -> random_bytes(32); + _ -> ensure_int_as_bin(PrivArg) + end, + host_srp_gen_key(Private, Verifier, Generator, Prime, Version); -%%% SRP --spec srp_generate_key(binary(), binary(), atom() | binary(), atom() | binary() ) -> {Public::binary(), Private::binary()}. -srp_generate_key(Verifier, Generator, Prime, Version) when is_binary(Verifier), - is_binary(Generator), - is_binary(Prime), - is_atom(Version) -> - Private = random_bytes(32), - server_srp_gen_key(Private, Verifier, Generator, Prime, Version); - -srp_generate_key(Generator, Prime, Version, Private) when is_binary(Generator), - is_binary(Prime), - is_atom(Version), - is_binary(Private) -> - client_srp_gen_key(Private, Generator, Prime). - --spec srp_generate_key(binary(), binary(), binary(), atom(), binary()) -> {Public::binary(), Private::binary()}. -srp_generate_key(Verifier, Generator, Prime, Version, Private) when is_binary(Verifier), - is_binary(Generator), - is_binary(Prime), - is_atom(Version), - is_binary(Private) - -> - server_srp_gen_key(Private, Verifier, Generator, Prime, Version). - --spec srp_generate_key(binary(), binary(), atom()) -> {Public::binary(), Private::binary()}. -srp_generate_key(Generator, Prime, Version) when is_binary(Generator), - is_binary(Prime), - is_atom(Version) -> - Private = random_bytes(32), - client_srp_gen_key(Private, Generator, Prime). - --spec srp_compute_key(binary(), binary(), binary(), binary(), binary(), atom()| binary(), atom() | binary() ) -> binary(). -srp_compute_key(DerivedKey, Prime, Generator, ClientPublic, ClientPrivate, ServerPublic, Version) when - is_binary(Prime), +generate_key(srp, {user, [Generator, Prime, Version]}, PrivateArg) + when is_binary(Generator), is_binary(Prime), is_atom(Version) -> + Private = case PrivateArg of + undefined -> random_bytes(32); + _ -> PrivateArg + end, + user_srp_gen_key(Private, Generator, Prime); + +generate_key(ecdh, Curve, undefined) -> + ec_key_to_term_nif(ec_key_generate(Curve)). + + +ec_key_generate(_Key) -> ?nif_stub. + + +compute_key(dh, OthersPublicKey, MyPrivateKey, DHParameters) -> + case dh_compute_key_nif(ensure_int_as_bin(OthersPublicKey), + ensure_int_as_bin(MyPrivateKey), + map_ensure_int_as_bin(DHParameters)) of + error -> erlang:error(computation_failed, + [OthersPublicKey,MyPrivateKey,DHParameters]); + Ret -> Ret + end; + +compute_key(srp, HostPublic, {UserPublic, UserPrivate}, + {user, [DerivedKey, Prime, Generator, Version | ScramblerArg]}) when + is_binary(Prime), is_binary(Generator), - is_binary(ClientPublic), - is_binary(ClientPrivate), - is_binary(ServerPublic), is_atom(Version) -> + HostPubBin = ensure_int_as_bin(HostPublic), Multiplier = srp_multiplier(Version, Generator, Prime), - Scrambler = srp_scrambler(Version, ClientPublic, ServerPublic, Prime), - srp_client_secret_nif(ClientPrivate, Scrambler, ServerPublic, Multiplier, - Generator, DerivedKey, Prime); - -srp_compute_key(Verifier, Prime, ClientPublic, ServerPublic, ServerPrivate, Version, Scrambler) when - is_binary(Verifier), - is_binary(Prime), - is_binary(ClientPublic), - is_binary(ServerPublic), - is_binary(ServerPrivate), - is_atom(Version), - is_binary(Scrambler) -> - srp_server_secret_nif(Verifier, ServerPrivate, Scrambler, ClientPublic, Prime). - --spec srp_compute_key(binary(), binary(), binary(), binary(), binary(), binary(), atom(), binary()) -> binary(). -srp_compute_key(DerivedKey, Prime, Generator, ClientPublic, ClientPrivate, - ServerPublic, Version, Scrambler) when is_binary(DerivedKey), - is_binary(Prime), - is_binary(Generator), - is_binary(ClientPublic), - is_binary(ClientPrivate), - is_binary(ServerPublic), - is_atom(Version), - is_binary(Scrambler) -> - Multiplier = srp_multiplier(Version, Generator, Prime), - srp_client_secret_nif(ClientPrivate, Scrambler, ServerPublic, Multiplier, - Generator, DerivedKey, Prime). - --spec srp_compute_key(binary(), binary(), binary(), binary(), binary(), atom()) -> binary(). -srp_compute_key(Verifier, Prime, ClientPublic, ServerPublic, ServerPrivate, Version) when + Scrambler = case ScramblerArg of + [] -> srp_scrambler(Version, ensure_int_as_bin(UserPublic), + HostPubBin, Prime); + [S] -> S + end, + srp_user_secret_nif(ensure_int_as_bin(UserPrivate), Scrambler, HostPubBin, + Multiplier, Generator, DerivedKey, Prime); + +compute_key(srp, UserPublic, {HostPublic, HostPrivate}, + {host,[Verifier, Prime, Version | ScramblerArg]}) when is_binary(Verifier), - is_binary(Prime), - is_binary(ClientPublic), - is_binary(ServerPublic), - is_binary(ServerPrivate), + is_binary(Prime), is_atom(Version) -> - Scrambler = srp_scrambler(Version, ClientPublic, ServerPublic, Prime), - srp_server_secret_nif(Verifier, ServerPrivate, Scrambler, ClientPublic, Prime). + UserPubBin = ensure_int_as_bin(UserPublic), + Scrambler = case ScramblerArg of + [] -> srp_scrambler(Version, UserPubBin, ensure_int_as_bin(HostPublic), Prime); + [S] -> S + end, + srp_host_secret_nif(Verifier, ensure_int_as_bin(HostPrivate), Scrambler, + UserPubBin, Prime); + +compute_key(ecdh, Others, My, Curve) -> + ecdh_compute_key_nif(ensure_int_as_bin(Others), + term_to_ec_key(Curve,My,undefined)). + +ecdh_compute_key_nif(_Others, _My) -> ?nif_stub. + %% +%% EC +%% +ec_key_to_term_nif(_Key) -> ?nif_stub. + +term_to_nif_prime({prime_field, Prime}) -> + {prime_field, int_to_bin(Prime)}; +term_to_nif_prime(PrimeField) -> + PrimeField. +term_to_nif_curve({A, B, Seed}) -> + {ensure_int_as_bin(A), ensure_int_as_bin(B), Seed}. +term_to_nif_curve_parameters({PrimeField, Curve, BasePoint, Order, CoFactor}) -> + {term_to_nif_prime(PrimeField), term_to_nif_curve(Curve), ensure_int_as_bin(BasePoint), int_to_bin(Order), int_to_bin(CoFactor)}; +term_to_nif_curve_parameters(Curve) when is_atom(Curve) -> + %% named curve + Curve. + +term_to_ec_key(Curve, PrivKey, PubKey) -> + term_to_ec_key_nif(term_to_nif_curve_parameters(Curve), + ensure_int_as_bin(PrivKey), + ensure_int_as_bin(PubKey)). + +term_to_ec_key_nif(_Curve, _PrivKey, _PubKey) -> ?nif_stub. + + + %% LOCAL FUNCTIONS %% -client_srp_gen_key(Private, Generator, Prime) -> - case mod_exp_prime(Generator, Private, Prime) of +user_srp_gen_key(Private, Generator, Prime) -> + case mod_pow(Generator, Private, Prime) of error -> error; Public -> {Public, Private} end. -server_srp_gen_key(Private, Verifier, Generator, Prime, Version) -> +host_srp_gen_key(Private, Verifier, Generator, Prime, Version) -> Multiplier = srp_multiplier(Version, Generator, Prime), case srp_value_B_nif(Multiplier, Verifier, Generator, Private, Prime) of error -> @@ -1185,17 +1543,17 @@ srp_multiplier('6', _, _) -> srp_multiplier('3', _, _) -> <<1/integer>>. -srp_scrambler(Version, ClientPublic, ServerPublic, Prime) when Version == '6'; Version == '6a'-> +srp_scrambler(Version, UserPublic, HostPublic, Prime) when Version == '6'; Version == '6a'-> %% SHA1(PAD(A) | PAD(B)) from http://srp.stanford.edu/design.html PadLength = erlang:byte_size(Prime), C0 = sha_init(), - C1 = sha_update(C0, srp_pad_to(PadLength, ClientPublic)), - C2 = sha_update(C1, srp_pad_to(PadLength, ServerPublic)), + C1 = sha_update(C0, srp_pad_to(PadLength, UserPublic)), + C2 = sha_update(C1, srp_pad_to(PadLength, HostPublic)), sha_final(C2); -srp_scrambler('3', _, ServerPublic, _Prime) -> +srp_scrambler('3', _, HostPublic, _Prime) -> %% The parameter u is a 32-bit unsigned integer which takes its value %% from the first 32 bits of the SHA1 hash of B, MSB first. - <<U:32/bits, _/binary>> = sha(ServerPublic), + <<U:32/bits, _/binary>> = sha(HostPublic), U. srp_pad_length(Width, Length) -> @@ -1207,9 +1565,9 @@ srp_pad_to(Width, Binary) -> N -> << 0:(N*8), Binary/binary>> end. -srp_server_secret_nif(_Verifier, _B, _U, _A, _Prime) -> ?nif_stub. +srp_host_secret_nif(_Verifier, _B, _U, _A, _Prime) -> ?nif_stub. -srp_client_secret_nif(_A, _U, _B, _Multiplier, _Generator, _Exponent, _Prime) -> ?nif_stub. +srp_user_secret_nif(_A, _U, _B, _Multiplier, _Generator, _Exponent, _Prime) -> ?nif_stub. srp_value_B_nif(_Multiplier, _Verifier, _Generator, _Exponent, _Prime) -> ?nif_stub. @@ -1252,11 +1610,15 @@ int_to_bin_neg(-1, Ds=[MSB|_]) when MSB >= 16#80 -> int_to_bin_neg(X,Ds) -> int_to_bin_neg(X bsr 8, [(X band 255)|Ds]). +bytes_to_integer(Bin) -> + bin_to_int(Bin). -bin_to_int(Bin) -> +bin_to_int(Bin) when is_binary(Bin) -> Bits = bit_size(Bin), <<Integer:Bits/integer>> = Bin, - Integer. + Integer; +bin_to_int(undefined) -> + undefined. %% int from integer in a binary with 32bit length erlint(<<MPIntSize:32/integer,MPIntValue/binary>>) -> diff --git a/lib/crypto/test/Makefile b/lib/crypto/test/Makefile index ec8136b455..07e5c1b754 100644 --- a/lib/crypto/test/Makefile +++ b/lib/crypto/test/Makefile @@ -7,7 +7,8 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES = \ blowfish_SUITE \ - crypto_SUITE + crypto_SUITE \ + old_crypto_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 08ecad3233..b3bb5dbd17 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -18,105 +18,106 @@ %% -module(crypto_SUITE). --include_lib("test_server/include/test_server.hrl"). - --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, - info/1, - link_test/1, - md5/1, - md5_update/1, - md4/1, - md4_update/1, - sha/1, - sha_update/1, - hmac_update_sha/1, - hmac_update_sha_n/1, - hmac_update_sha256/1, - hmac_update_sha512/1, - hmac_update_md5/1, - hmac_update_md5_io/1, - hmac_update_md5_n/1, - hmac_rfc2202/1, - hmac_rfc4231_sha224/1, - hmac_rfc4231_sha256/1, - hmac_rfc4231_sha384/1, - hmac_rfc4231_sha512/1, - ripemd160/1, - ripemd160_update/1, - sha256/1, - sha256_update/1, - sha512/1, - sha512_update/1, - md5_mac/1, - md5_mac_io/1, - des_cbc/1, - des_cbc_iter/1, - des_cfb/1, - des_cfb_iter/1, - des_ecb/1, - des3_cbc/1, - des3_cfb/1, - rc2_cbc/1, - aes_cfb/1, - aes_cbc/1, - aes_cbc_iter/1, - aes_ctr/1, - aes_ctr_stream/1, - mod_exp_test/1, - rand_uniform_test/1, - strong_rand_test/1, - rsa_verify_test/1, - dsa_verify_test/1, - rsa_sign_test/1, - rsa_sign_hash_test/1, - dsa_sign_test/1, - dsa_sign_hash_test/1, - rsa_encrypt_decrypt/1, - dh/1, - srp3/1, srp6/1, srp6a/1, - exor_test/1, - rc4_test/1, - rc4_stream_test/1, - blowfish_cfb64/1, - smp/1]). - --export([hexstr2bin/1]). +-include_lib("common_test/include/ct.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [link_test, {group, info}]. - -groups() -> - [{info, [sequence],[info, {group, rest}]}, - {rest, [], - [md5, md5_update, md4, md4_update, md5_mac, - md5_mac_io, ripemd160, ripemd160_update, sha, sha_update, - sha256, sha256_update, sha512, sha512_update, - hmac_update_sha, hmac_update_sha_n, hmac_update_sha256, hmac_update_sha512, - hmac_update_md5_n, hmac_update_md5_io, hmac_update_md5, - hmac_rfc2202, hmac_rfc4231_sha224, hmac_rfc4231_sha256, - hmac_rfc4231_sha384, hmac_rfc4231_sha512, - des_cbc, aes_cfb, aes_cbc, - des_cfb, des_cfb_iter, des3_cbc, des3_cfb, rc2_cbc, - aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_ecb, - rand_uniform_test, strong_rand_test, - rsa_verify_test, dsa_verify_test, rsa_sign_test, - rsa_sign_hash_test, dsa_sign_test, dsa_sign_hash_test, - rsa_encrypt_decrypt, dh, srp3, srp6, srp6a, exor_test, - rc4_test, rc4_stream_test, mod_exp_test, blowfish_cfb64, - smp]}]. - + [app, + {group, md4}, + {group, md5}, + {group, ripemd160}, + {group, sha}, + {group, sha224}, + {group, sha256}, + {group, sha384}, + {group, sha512}, + {group, rsa}, + {group, dss}, + {group, ecdsa}, + {group, dh}, + {group, ecdh}, + {group, srp}, + {group, des_cbc}, + {group, des_cfb}, + {group, des3_cbc}, + {group, des3_cbf}, + {group, des_ede3}, + {group, blowfish_cbc}, + {group, blowfish_ecb}, + {group, blowfish_cfb64}, + {group, blowfish_ofb64}, + {group, aes_cbc128}, + {group, aes_cfb128}, + {group, aes_cbc256}, + {group, rc2_cbc}, + {group, rc4}, + {group, aes_ctr}, + mod_pow, + exor, + rand_uniform + ]. + +groups() -> + [{md4, [], [hash]}, + {md5, [], [hash, hmac]}, + {ripemd160, [], [hash]}, + {sha, [], [hash, hmac]}, + {sha224, [], [hash, hmac]}, + {sha256, [], [hash, hmac]}, + {sha384, [], [hash, hmac]}, + {sha512, [], [hash, hmac]}, + {rsa, [], [sign_verify, + public_encrypt + ]}, + {dss, [], [sign_verify]}, + {ecdsa, [], [sign_verify]}, + {dh, [], [generate_compute]}, + {ecdh, [], [compute]}, + {srp, [], [generate_compute]}, + {des_cbc, [], [block]}, + {des_cfb, [], [block]}, + {des3_cbc,[], [block]}, + {des_ede3,[], [block]}, + {des3_cbf,[], [block]}, + {rc2_cbc,[], [block]}, + {aes_cbc128,[], [block]}, + {aes_cfb128,[], [block]}, + {aes_cbc256,[], [block]}, + {blowfish_cbc, [], [block]}, + {blowfish_ecb, [], [block]}, + {blowfish_cfb64, [], [block]}, + {blowfish_ofb64,[], [block]}, + {rc4, [], [stream]}, + {aes_ctr, [], [stream]} + ]. + +%%------------------------------------------------------------------- init_per_suite(Config) -> - Config. + try crypto:start() of + ok -> + Config + catch _:_ -> + {skip, "Crypto did not start"} + end. end_per_suite(_Config) -> - ok. + application:stop(crypto). -init_per_group(_GroupName, Config) -> - Config. +%%------------------------------------------------------------------- +init_per_group(GroupName, Config) -> + case is_supported(GroupName) of + true -> + group_config(GroupName, Config); + false -> + {skip, "Group not supported"} + end. end_per_group(_GroupName, Config) -> Config. @@ -124,1733 +125,1154 @@ end_per_group(_GroupName, Config) -> init_per_testcase(info, Config) -> Config; init_per_testcase(_Name,Config) -> - io:format("init_per_testcase\n"), - ?line crypto:start(), Config. end_per_testcase(info, Config) -> Config; end_per_testcase(_Name,Config) -> - io:format("end_per_testcase\n"), - ?line crypto:stop(), Config. -%% -%% -link_test(doc) -> - ["Test that the library is statically linked to libcrypto.a."]; -link_test(suite) -> - []; -link_test(Config) when is_list(Config) -> - ?line case os:type() of - {unix,darwin} -> {skipped,"Darwin cannot link statically"}; - {unix,_} -> link_test_1(); - _ -> {skip,"Only runs on Unix"} - end. - -link_test_1() -> - ?line CryptoPriv = code:priv_dir(crypto), - ?line Wc = filename:join([CryptoPriv,"lib","crypto.*"]), - ?line case filelib:wildcard(Wc) of - [] -> {skip,"Didn't find the crypto driver"}; - [Drv] -> link_test_2(Drv) - end. - -link_test_2(Drv) -> - case ldd_program() of - none -> - {skip,"No ldd-like program found"}; - Ldd -> - Cmd = Ldd ++ " " ++ Drv, - Libs = os:cmd(Cmd), - io:format("~p\n", [Libs]), - case string:str(Libs, "libcrypto") of - 0 -> - case ?t:is_commercial() of - true -> - ?t:fail({libcrypto,statically_linked}); - false -> - {comment,"Statically linked (OK for open-source platform)"} - end; - _ -> - ok - end - end. +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- +app() -> + [{doc, "Test that the crypto app file is ok"}]. +app(Config) when is_list(Config) -> + ok = ?t:app_test(crypto). +%%-------------------------------------------------------------------- +hash() -> + [{doc, "Test all different hash functions"}]. +hash(Config) when is_list(Config) -> + {Type, Msgs, Digests} = proplists:get_value(hash, Config), + [LongMsg | _] = lists:reverse(Msgs), + Inc = iolistify(LongMsg), + [IncrDigest | _] = lists:reverse(Digests), + hash(Type, Msgs, Digests), + hash(Type, lists:map(fun iolistify/1, Msgs), Digests), + hash_increment(Type, Inc, IncrDigest). +%%-------------------------------------------------------------------- +hmac() -> + [{doc, "Test all different hmac functions"}]. +hmac(Config) when is_list(Config) -> + {Type, Keys, Data, Expected} = proplists:get_value(hmac, Config), + hmac(Type, Keys, Data, Expected), + hmac(Type, lists:map(fun iolistify/1, Keys), lists:map(fun iolistify/1, Data), Expected), + hmac_increment(Type). +%%-------------------------------------------------------------------- +block() -> + [{doc, "Test block ciphers"}]. +block(Config) when is_list(Config) -> + Blocks = proplists:get_value(block, Config), + lists:foreach(fun block_cipher/1, Blocks), + lists:foreach(fun block_cipher/1, block_iolistify(Blocks)), + lists:foreach(fun block_cipher_increment/1, block_iolistify(Blocks)). + +%%-------------------------------------------------------------------- +stream() -> + [{doc, "Test stream ciphers"}]. +stream(Config) when is_list(Config) -> + Streams = proplists:get_value(stream, Config), + lists:foreach(fun stream_cipher/1, Streams), + lists:foreach(fun stream_cipher/1, stream_iolistify(Streams)), + lists:foreach(fun stream_cipher_incment/1, stream_iolistify(Streams)). + +%%-------------------------------------------------------------------- +sign_verify() -> + [{doc, "Sign/verify digital signatures"}]. +sign_verify(Config) when is_list(Config) -> + SignVerify = proplists:get_value(sign_verify, Config), + lists:foreach(fun do_sign_verify/1, SignVerify). + +%%-------------------------------------------------------------------- +public_encrypt() -> + [{doc, "Test public_encrypt/decrypt and private_encrypt/decrypt functions. "}]. +public_encrypt(Config) when is_list(Config) -> + Params = proplists:get_value(pub_priv_encrypt, Config), + lists:foreach(fun do_public_encrypt/1, Params), + lists:foreach(fun do_private_encrypt/1, Params). + +%%-------------------------------------------------------------------- +generate_compute() -> + [{doc, " Test crypto:genarate_key and crypto:compute_key"}]. +generate_compute(Config) when is_list(Config) -> + GenCom = proplists:get_value(generate_compute, Config), + lists:foreach(fun do_generate_compute/1, GenCom). +%%-------------------------------------------------------------------- +compute() -> + [{doc, " Test crypto:compute_key"}]. +compute(Config) when is_list(Config) -> + Gen = proplists:get_value(compute, Config), + lists:foreach(fun do_compute/1, Gen). +%%-------------------------------------------------------------------- +mod_pow() -> + [{doc, "mod_pow testing (A ^ M % P with bignums)"}]. +mod_pow(Config) when is_list(Config) -> + mod_pow_aux_test(2, 5, 10, 8). +%%-------------------------------------------------------------------- +exor() -> + [{doc, "Test the exor function"}]. +exor(Config) when is_list(Config) -> + B = <<1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>, + Z1 = zero_bin(B), + Z1 = crypto:exor(B, B), + B1 = crypto:rand_bytes(100), + B2 = crypto:rand_bytes(100), + Z2 = zero_bin(B1), + Z2 = crypto:exor(B1, B1), + 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 ------------------------------------------------ +%%-------------------------------------------------------------------- -ldd_program() -> - case os:find_executable("ldd") of - false -> - case os:type() of - {unix,darwin} -> - case os:find_executable("otool") of - false -> none; - Otool -> Otool ++ " -L" - end - end; - Ldd when is_list(Ldd) -> Ldd +hash(_, [], []) -> + ok; +hash(Type, [Msg | RestMsg], [Digest| RestDigest]) -> + case crypto:hash(Type, Msg) of + Digest -> + hash(Type, RestMsg, RestDigest); + Other -> + ct:fail({{crypto, hash, [Type, Msg]}, {expected, Digest}, {got, Other}}) end. -%% -%% -info(doc) -> - ["Call the info function."]; -info(suite) -> - []; -info(Config) when is_list(Config) -> - case {code:lib_dir(crypto),?t:is_commercial()} of - {{error,bad_name},false} -> - {skip,"Missing crypto application"}; - {_,_} -> - ?line crypto:start(), - ?line Info = crypto:info(), - ?line Exports = lists:usort([F || {F,_} <- crypto:module_info(exports)]), - ?line [] = Info -- Exports, - ?line NotInInfo = Exports -- Info, - io:format("NotInInfo = ~p\n", [NotInInfo]), - BlackList = lists:sort([des_ede3_cbc_decrypt, des_ede3_cbc_encrypt, - dh_check, dh_generate_parameters, - module_info, start, stop, version]), - ?line BlackList = NotInInfo, - - ?line InfoLib = crypto:info_lib(), - ?line [_|_] = InfoLib, - F = fun([{Name,VerN,VerS}|T],Me) -> - ?line true = is_binary(Name), - ?line true = is_integer(VerN), - ?line true = is_binary(VerS), - Me(T,Me); - ([],_) -> - ok - end, - ?line F(InfoLib,F), - ?line crypto:stop() +hash_increment(Type, Increments, Digest) -> + State = crypto:hash_init(Type), + case hash_increment(State, Increments) of + Digest -> + ok; + Other -> + ct:fail({{crypto, "hash_init/update/final", [Type, Increments]}, {expected, Digest}, {got, Other}}) end. -%% -%% -md5(doc) -> - ["Generate MD5 message digests and check the result. Examples are " - "from RFC-1321."]; -md5(suite) -> - []; -md5(Config) when is_list(Config) -> - ?line m(crypto:md5(""), - hexstr2bin("d41d8cd98f00b204e9800998ecf8427e")), - ?line m(crypto:md5("a"), - hexstr2bin("0cc175b9c0f1b6a831c399e269772661")), - ?line m(crypto:md5("abc"), - hexstr2bin("900150983cd24fb0d6963f7d28e17f72")), - ?line m(crypto:md5("message digest"), - hexstr2bin("f96b697d7cb7938d525a2f31aaf161d0")), - ?line m(crypto:md5("abcdefghijklmnopqrstuvwxyz"), - hexstr2bin("c3fcd3d76192e4007dfb496cca67e13b")), - ?line m(crypto:md5("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" - "0123456789"), - hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")), - ?line m(crypto:md5("12345678901234567890123456789012345678901234567890" - "123456789012345678901234567890"), - hexstr2bin("57edf4a22be3c955ac49da2e2107b67a")). +hash_increment(State, []) -> + crypto:hash_final(State); +hash_increment(State0, [Increment | Rest]) -> + State = crypto:hash_update(State0, Increment), + hash_increment(State, Rest). -%% -%% -md5_update(doc) -> - ["Generate MD5 message using md5_init, md5_update, and md5_final, and" - "check the result. Examples are from RFC-1321."]; -md5_update(suite) -> - []; -md5_update(Config) when is_list(Config) -> - ?line Ctx = crypto:md5_init(), - ?line Ctx1 = crypto:md5_update(Ctx, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), - ?line Ctx2 = crypto:md5_update(Ctx1, "abcdefghijklmnopqrstuvwxyz" - "0123456789"), - ?line m(crypto:md5_final(Ctx2), - hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")). - -%% -%% -md4(doc) -> - ["Generate MD4 message digests and check the result. Examples are " - "from RFC-1321."]; -md4(suite) -> - []; -md4(Config) when is_list(Config) -> - ?line m(crypto:md4(""), - hexstr2bin("31d6cfe0d16ae931b73c59d7e0c089c0")), - ?line m(crypto:md4("a"), - hexstr2bin("bde52cb31de33e46245e05fbdbd6fb24")), - ?line m(crypto:md4("abc"), - hexstr2bin("a448017aaf21d8525fc10ae87aa6729d")), - ?line m(crypto:md4("message digest"), - hexstr2bin("d9130a8164549fe818874806e1c7014b")), - ?line m(crypto:md4("abcdefghijklmnopqrstuvwxyz"), - hexstr2bin("d79e1c308aa5bbcdeea8ed63df412da9")), - ?line m(crypto:md4("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" - "0123456789"), - hexstr2bin("043f8582f241db351ce627e153e7f0e4")), - ?line m(crypto:md4("12345678901234567890123456789012345678901234567890" - "123456789012345678901234567890"), - hexstr2bin("e33b4ddc9c38f2199c3e7b164fcc0536")). - -%% -%% -md4_update(doc) -> - ["Generate MD5 message using md5_init, md5_update, and md5_final, and" - "check the result. Examples are from RFC-1321."]; -md4_update(suite) -> - []; -md4_update(Config) when is_list(Config) -> - ?line Ctx = crypto:md4_init(), - ?line Ctx1 = crypto:md4_update(Ctx, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), - ?line Ctx2 = crypto:md4_update(Ctx1, "abcdefghijklmnopqrstuvwxyz" - "0123456789"), - ?line m(crypto:md4_final(Ctx2), - hexstr2bin("043f8582f241db351ce627e153e7f0e4")). - -%% -%% -sha(doc) -> - ["Generate SHA message digests and check the result. Examples are " - "from FIPS-180-1."]; -sha(suite) -> - []; -sha(Config) when is_list(Config) -> - ?line m(crypto:sha("abc"), - hexstr2bin("A9993E364706816ABA3E25717850C26C9CD0D89D")), - ?line m(crypto:sha("abcdbcdecdefdefgefghfghighijhijkijkljklmklm" - "nlmnomnopnopq"), - hexstr2bin("84983E441C3BD26EBAAE4AA1F95129E5E54670F1")). - - -%% -hmac_update_sha_n(doc) -> - ["Request a larger-than-allowed SHA1 HMAC using hmac_init, hmac_update, and hmac_final_n. " - "Expected values for examples are generated using crypto:sha_mac." ]; -hmac_update_sha_n(suite) -> - []; -hmac_update_sha_n(Config) when is_list(Config) -> - ?line Key = hexstr2bin("00010203101112132021222330313233" - "04050607141516172425262734353637" - "08090a0b18191a1b28292a2b38393a3b" - "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"), - ?line Data = "Sampl", - ?line Data2 = "e #1", - ?line Ctx = crypto:hmac_init(sha, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), - ?line Mac = crypto:hmac_final_n(Ctx3, 1024), - ?line Exp = crypto:sha_mac(Key, lists:flatten([Data, Data2])), - ?line m(Exp, Mac), - ?line m(size(Exp), size(Mac)). - - -hmac_update_sha(doc) -> - ["Generate an SHA1 HMAC using hmac_init, hmac_update, and hmac_final. " - "Expected values for examples are generated using crypto:sha_mac." ]; -hmac_update_sha(suite) -> - []; -hmac_update_sha(Config) when is_list(Config) -> - ?line Key = hexstr2bin("00010203101112132021222330313233" - "04050607141516172425262734353637" - "08090a0b18191a1b28292a2b38393a3b" - "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"), - ?line Data = "Sampl", - ?line Data2 = "e #1", - ?line Ctx = crypto:hmac_init(sha, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), - ?line Mac = crypto:hmac_final(Ctx3), - ?line Exp = crypto:sha_mac(Key, lists:flatten([Data, Data2])), - ?line m(Exp, Mac). - -hmac_update_sha256(doc) -> - ["Generate an SHA256 HMAC using hmac_init, hmac_update, and hmac_final. " - "Expected values for examples are generated using crypto:sha256_mac." ]; -hmac_update_sha256(suite) -> - []; -hmac_update_sha256(Config) when is_list(Config) -> - if_supported(sha256, fun() -> hmac_update_sha256_do() end). - -hmac_update_sha256_do() -> - ?line Key = hexstr2bin("00010203101112132021222330313233" - "04050607141516172425262734353637" - "08090a0b18191a1b28292a2b38393a3b" - "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"), - ?line Data = "Sampl", - ?line Data2 = "e #1", - ?line Ctx = crypto:hmac_init(sha256, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), - ?line Mac = crypto:hmac_final(Ctx3), - ?line Exp = crypto:sha256_mac(Key, lists:flatten([Data, Data2])), - ?line m(Exp, Mac). - -hmac_update_sha512(doc) -> - ["Generate an SHA512 HMAC using hmac_init, hmac_update, and hmac_final. " - "Expected values for examples are generated using crypto:sha512_mac." ]; -hmac_update_sha512(suite) -> - []; -hmac_update_sha512(Config) when is_list(Config) -> - if_supported(sha512, fun() -> hmac_update_sha512_do() end). - -hmac_update_sha512_do() -> - ?line Key = hexstr2bin("00010203101112132021222330313233" - "04050607141516172425262734353637" - "08090a0b18191a1b28292a2b38393a3b" - "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"), - ?line Data = "Sampl", - ?line Data2 = "e #1", - ?line Ctx = crypto:hmac_init(sha512, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), - ?line Mac = crypto:hmac_final(Ctx3), - ?line Exp = crypto:sha512_mac(Key, lists:flatten([Data, Data2])), - ?line m(Exp, Mac). - -hmac_update_md5(doc) -> - ["Generate an MD5 HMAC using hmac_init, hmac_update, and hmac_final. " - "Expected values for examples are generated using crypto:md5_mac." ]; -hmac_update_md5(suite) -> - []; -hmac_update_md5(Config) when is_list(Config) -> - % ?line Key2 = ["A fine speach", "by a fine man!"], - Key2 = "A fine speach by a fine man!", - ?line Long1 = "Four score and seven years ago our fathers brought forth on this continent a new nation, conceived in liberty, and dedicated to the proposition that all men are created equal.", - ?line Long2 = "Now we are engaged in a great civil war, testing whether that nation, or any nation, so conceived and so dedicated, can long endure. We are met on a great battle-field of that war. We have come to dedicate a portion of that field, as a final resting place for those who here gave their lives that that nation might live. It is altogether fitting and proper that we should do this.", - ?line Long3 = "But, in a larger sense, we can not dedicate, we can not consecrate, we can not hallow this ground. The brave men, living and dead, who struggled here, have consecrated it, far above our poor power to add or detract. The world will little note, nor long remember what we say here, but it can never forget what they did here. It is for us the living, rather, to be dedicated here to the unfinished work which they who fought here have thus far so nobly advanced. It is rather for us to be here dedicated to the great task remaining before us-that from these honored dead we take increased devotion to that cause for which they gave the last full measure of devotion that we here highly resolve that these dead shall not have died in vain-that this nation, under God, shall have a new birth of freedom-and that government of the people, by the people, for the people, shall not perish from the earth.", - ?line CtxA = crypto:hmac_init(md5, Key2), - ?line CtxB = crypto:hmac_update(CtxA, Long1), - ?line CtxC = crypto:hmac_update(CtxB, Long2), - ?line CtxD = crypto:hmac_update(CtxC, Long3), - ?line Mac2 = crypto:hmac_final(CtxD), - ?line Exp2 = crypto:md5_mac(Key2, lists:flatten([Long1, Long2, Long3])), - ?line m(Exp2, Mac2). - -hmac_rfc2202(doc) -> - ["Generate an HMAC using hmac, md5_mac, and sha_mac." - "Test vectors are taken from RFC-2202."]; -hmac_rfc2202(suite) -> - []; -hmac_rfc2202(Config) when is_list(Config) -> - hmac_rfc2202_md5(), - hmac_rfc2202_sha(). - -hmac_rfc2202_md5() -> - %% Test case 1 - Case1Key = binary:copy(<<16#0b>>, 16), - Case1Data = <<"Hi There">>, - Case1Exp = hexstr2bin("9294727a3638bb1c13f48ef8158bfc9d"), - - ?line Case1Mac_1 = crypto:md5_mac(Case1Key, Case1Data), - ?line Case1Mac_2 = crypto:hmac(md5, Case1Key, Case1Data), - ?line m(Case1Exp, Case1Mac_1), - ?line m(Case1Exp, Case1Mac_2), - - %% Test case 2 - Case2Key = <<"Jefe">>, - Case2Data = <<"what do ya want for nothing?">>, - Case2Exp = hexstr2bin("750c783e6ab0b503eaa86e310a5db738"), - - ?line Case2Mac_1 = crypto:md5_mac(Case2Key, Case2Data), - ?line Case2Mac_2 = crypto:hmac(md5, Case2Key, Case2Data), - ?line m(Case2Exp, Case2Mac_1), - ?line m(Case2Exp, Case2Mac_2), - - %% Test case 3 - Case3Key = binary:copy(<<16#aa>>, 16), - Case3Data = binary:copy(<<16#dd>>, 50), - Case3Exp = hexstr2bin("56be34521d144c88dbb8c733f0e8b3f6"), - - ?line Case3Mac_1 = crypto:md5_mac(Case3Key, Case3Data), - ?line Case3Mac_2 = crypto:hmac(md5, Case3Key, Case3Data), - ?line m(Case3Exp, Case3Mac_1), - ?line m(Case3Exp, Case3Mac_2), - - %% Test case 4 - Case4Key = list_to_binary(lists:seq(1, 16#19)), - Case4Data = binary:copy(<<16#cd>>, 50), - Case4Exp = hexstr2bin("697eaf0aca3a3aea3a75164746ffaa79"), - - ?line Case4Mac_1 = crypto:md5_mac(Case4Key, Case4Data), - ?line Case4Mac_2 = crypto:hmac(md5, Case4Key, Case4Data), - ?line m(Case4Exp, Case4Mac_1), - ?line m(Case4Exp, Case4Mac_2), - - %% Test case 5 - Case5Key = binary:copy(<<16#0c>>, 16), - Case5Data = "Test With Truncation", - Case5Exp = hexstr2bin("56461ef2342edc00f9bab995690efd4c"), - Case5Exp96 = hexstr2bin("56461ef2342edc00f9bab995"), - - ?line Case5Mac_1 = crypto:md5_mac(Case5Key, Case5Data), - ?line Case5Mac_2 = crypto:hmac(md5, Case5Key, Case5Data), - ?line Case5Mac96_1 = crypto:md5_mac_96(Case5Key, Case5Data), - ?line Case5Mac96_2 = crypto:hmac(md5, Case5Key, Case5Data, 12), - ?line m(Case5Exp, Case5Mac_1), - ?line m(Case5Exp, Case5Mac_2), - ?line m(Case5Exp96, Case5Mac96_1), - ?line m(Case5Exp96, Case5Mac96_2), - - %% Test case 6 - Case6Key = binary:copy(<<16#aa>>, 80), - Case6Data = <<"Test Using Larger Than Block-Size Key - Hash Key First">>, - Case6Exp = hexstr2bin("6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"), - - ?line Case6Mac_1 = crypto:md5_mac(Case6Key, Case6Data), - ?line Case6Mac_2 = crypto:hmac(md5, Case6Key, Case6Data), - ?line m(Case6Exp, Case6Mac_1), - ?line m(Case6Exp, Case6Mac_2), - - %% Test case 7 - Case7Key = binary:copy(<<16#aa>>, 80), - Case7Data = <<"Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data">>, - Case7Exp = hexstr2bin("6f630fad67cda0ee1fb1f562db3aa53e"), - - ?line Case7Mac_1 = crypto:md5_mac(Case7Key, Case7Data), - ?line Case7Mac_2 = crypto:hmac(md5, Case7Key, Case7Data), - ?line m(Case7Exp, Case7Mac_1), - ?line m(Case7Exp, Case7Mac_2). - -hmac_rfc2202_sha() -> - %% Test case 1 - Case1Key = binary:copy(<<16#0b>>, 20), - Case1Data = <<"Hi There">>, - Case1Exp = hexstr2bin("b617318655057264e28bc0b6fb378c8ef146be00"), - - ?line Case1Mac_1 = crypto:sha_mac(Case1Key, Case1Data), - ?line Case1Mac_2 = crypto:hmac(sha, Case1Key, Case1Data), - ?line m(Case1Exp, Case1Mac_1), - ?line m(Case1Exp, Case1Mac_2), - - %% Test case 2 - Case2Key = <<"Jefe">>, - Case2Data = <<"what do ya want for nothing?">>, - Case2Exp = hexstr2bin("effcdf6ae5eb2fa2d27416d5f184df9c259a7c79"), - - ?line Case2Mac_1 = crypto:sha_mac(Case2Key, Case2Data), - ?line Case2Mac_2 = crypto:hmac(sha, Case2Key, Case2Data), - ?line m(Case2Exp, Case2Mac_1), - ?line m(Case2Exp, Case2Mac_2), - - %% Test case 3 - Case3Key = binary:copy(<<16#aa>>, 20), - Case3Data = binary:copy(<<16#dd>>, 50), - Case3Exp = hexstr2bin("125d7342b9ac11cd91a39af48aa17b4f63f175d3"), - - ?line Case3Mac_1 = crypto:sha_mac(Case3Key, Case3Data), - ?line Case3Mac_2 = crypto:hmac(sha, Case3Key, Case3Data), - ?line m(Case3Exp, Case3Mac_1), - ?line m(Case3Exp, Case3Mac_2), - - %% Test case 4 - Case4Key = list_to_binary(lists:seq(1, 16#19)), - Case4Data = binary:copy(<<16#cd>>, 50), - Case4Exp = hexstr2bin("4c9007f4026250c6bc8414f9bf50c86c2d7235da"), - - ?line Case4Mac_1 = crypto:sha_mac(Case4Key, Case4Data), - ?line Case4Mac_2 = crypto:hmac(sha, Case4Key, Case4Data), - ?line m(Case4Exp, Case4Mac_1), - ?line m(Case4Exp, Case4Mac_2), - - %% Test case 5 - Case5Key = binary:copy(<<16#0c>>, 20), - Case5Data = "Test With Truncation", - Case5Exp = hexstr2bin("4c1a03424b55e07fe7f27be1d58bb9324a9a5a04"), - Case5Exp96 = hexstr2bin("4c1a03424b55e07fe7f27be1"), - - ?line Case5Mac_1 = crypto:sha_mac(Case5Key, Case5Data), - ?line Case5Mac_2 = crypto:hmac(sha, Case5Key, Case5Data), - ?line Case5Mac96_1 = crypto:sha_mac_96(Case5Key, Case5Data), - ?line Case5Mac96_2 = crypto:hmac(sha, Case5Key, Case5Data, 12), - ?line m(Case5Exp, Case5Mac_1), - ?line m(Case5Exp, Case5Mac_2), - ?line m(Case5Exp96, Case5Mac96_1), - ?line m(Case5Exp96, Case5Mac96_2), - - %% Test case 6 - Case6Key = binary:copy(<<16#aa>>, 80), - Case6Data = <<"Test Using Larger Than Block-Size Key - Hash Key First">>, - Case6Exp = hexstr2bin("aa4ae5e15272d00e95705637ce8a3b55ed402112"), - - ?line Case6Mac_1 = crypto:sha_mac(Case6Key, Case6Data), - ?line Case6Mac_2 = crypto:hmac(sha, Case6Key, Case6Data), - ?line m(Case6Exp, Case6Mac_1), - ?line m(Case6Exp, Case6Mac_2), - - %% Test case 7 - Case7Key = binary:copy(<<16#aa>>, 80), - Case7Data = <<"Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data">>, - Case7Exp = hexstr2bin("e8e99d0f45237d786d6bbaa7965c7808bbff1a91"), - - ?line Case7Mac_1 = crypto:sha_mac(Case7Key, Case7Data), - ?line Case7Mac_2 = crypto:hmac(sha, Case7Key, Case7Data), - ?line m(Case7Exp, Case7Mac_1), - ?line m(Case7Exp, Case7Mac_2). - -hmac_rfc4231_sha224(doc) -> - ["Generate an HMAC using crypto:sha224_mac, hmac, and hmac_init, hmac_update, and hmac_final. " - "Testvectors are take from RFC4231." ]; -hmac_rfc4231_sha224(suite) -> - []; -hmac_rfc4231_sha224(Config) when is_list(Config) -> - if_supported(sha224, fun() -> hmac_rfc4231_sha224_do() end). - -hmac_rfc4231_sha256(doc) -> - ["Generate an HMAC using crypto:sha256_mac, hmac, and hmac_init, hmac_update, and hmac_final. " - "Testvectors are take from RFC4231." ]; -hmac_rfc4231_sha256(suite) -> - []; -hmac_rfc4231_sha256(Config) when is_list(Config) -> - if_supported(sha256, fun() -> hmac_rfc4231_sha256_do() end). - -hmac_rfc4231_sha384(doc) -> - ["Generate an HMAC using crypto:sha384_mac, hmac, and hmac_init, hmac_update, and hmac_final. " - "Testvectors are take from RFC4231." ]; -hmac_rfc4231_sha384(suite) -> - []; -hmac_rfc4231_sha384(Config) when is_list(Config) -> - if_supported(sha384, fun() -> hmac_rfc4231_sha384_do() end). - -hmac_rfc4231_sha512(doc) -> - ["Generate an HMAC using crypto:sha512_mac, hmac, and hmac_init, hmac_update, and hmac_final. " - "Testvectors are take from RFC4231." ]; -hmac_rfc4231_sha512(suite) -> - []; -hmac_rfc4231_sha512(Config) when is_list(Config) -> - if_supported(sha512, fun() -> hmac_rfc4231_sha512_do() end). - -hmac_rfc4231_case(Hash, HashFun, case1, Exp) -> - %% Test 1 - Key = binary:copy(<<16#0b>>, 20), - Data = <<"Hi There">>, - hmac_rfc4231_case(Hash, HashFun, Key, Data, Exp); - -hmac_rfc4231_case(Hash, HashFun, case2, Exp) -> - %% Test 2 - Key = <<"Jefe">>, - Data = <<"what do ya want for nothing?">>, - hmac_rfc4231_case(Hash, HashFun, Key, Data, Exp); - -hmac_rfc4231_case(Hash, HashFun, case3, Exp) -> - %% Test 3 - Key = binary:copy(<<16#aa>>, 20), - Data = binary:copy(<<16#dd>>, 50), - hmac_rfc4231_case(Hash, HashFun, Key, Data, Exp); - -hmac_rfc4231_case(Hash, HashFun, case4, Exp) -> - %% Test 4 - Key = list_to_binary(lists:seq(1, 16#19)), - Data = binary:copy(<<16#cd>>, 50), - hmac_rfc4231_case(Hash, HashFun, Key, Data, Exp); - -hmac_rfc4231_case(Hash, HashFun, case5, Exp) -> - %% Test 5 - Key = binary:copy(<<16#0c>>, 20), - Data = <<"Test With Truncation">>, - hmac_rfc4231_case(Hash, HashFun, Key, Data, 16, Exp); - -hmac_rfc4231_case(Hash, HashFun, case6, Exp) -> - %% Test 6 - Key = binary:copy(<<16#aa>>, 131), - Data = <<"Test Using Larger Than Block-Size Key - Hash Key First">>, - hmac_rfc4231_case(Hash, HashFun, Key, Data, Exp); - -hmac_rfc4231_case(Hash, HashFun, case7, Exp) -> - %% Test Case 7 - Key = binary:copy(<<16#aa>>, 131), - Data = <<"This is a test using a larger than block-size key and a larger t", - "han block-size data. The key needs to be hashed before being use", - "d by the HMAC algorithm.">>, - hmac_rfc4231_case(Hash, HashFun, Key, Data, Exp). - -hmac_rfc4231_case(Hash, HashFun, Key, Data, Exp) -> - ?line Ctx = crypto:hmac_init(Hash, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Mac1 = crypto:hmac_final(Ctx2), - ?line Mac2 = crypto:HashFun(Key, Data), - ?line Mac3 = crypto:hmac(Hash, Key, Data), - ?line m(Exp, Mac1), - ?line m(Exp, Mac2), - ?line m(Exp, Mac3). - -hmac_rfc4231_case(Hash, HashFun, Key, Data, Trunc, Exp) -> - ?line Ctx = crypto:hmac_init(Hash, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Mac1 = crypto:hmac_final_n(Ctx2, Trunc), - ?line Mac2 = crypto:HashFun(Key, Data, Trunc), - ?line Mac3 = crypto:hmac(Hash, Key, Data, Trunc), - ?line m(Exp, Mac1), - ?line m(Exp, Mac2), - ?line m(Exp, Mac3). - -hmac_rfc4231_sha224_do() -> - Case1 = hexstr2bin("896fb1128abbdf196832107cd49df33f" - "47b4b1169912ba4f53684b22"), - Case2 = hexstr2bin("a30e01098bc6dbbf45690f3a7e9e6d0f" - "8bbea2a39e6148008fd05e44"), - Case3 = hexstr2bin("7fb3cb3588c6c1f6ffa9694d7d6ad264" - "9365b0c1f65d69d1ec8333ea"), - Case4 = hexstr2bin("6c11506874013cac6a2abc1bb382627c" - "ec6a90d86efc012de7afec5a"), - Case5 = hexstr2bin("0e2aea68a90c8d37c988bcdb9fca6fa8"), - Case6 = hexstr2bin("95e9a0db962095adaebe9b2d6f0dbce2" - "d499f112f2d2b7273fa6870e"), - Case7 = hexstr2bin("3a854166ac5d9f023f54d517d0b39dbd" - "946770db9c2b95c9f6f565d1"), - hmac_rfc4231_cases_do(sha224, sha224_mac, [Case1, Case2, Case3, Case4, Case5, Case6, Case7]). - -hmac_rfc4231_sha256_do() -> - Case1 = hexstr2bin("b0344c61d8db38535ca8afceaf0bf12b" - "881dc200c9833da726e9376c2e32cff7"), - Case2 = hexstr2bin("5bdcc146bf60754e6a042426089575c7" - "5a003f089d2739839dec58b964ec3843"), - Case3 = hexstr2bin("773ea91e36800e46854db8ebd09181a7" - "2959098b3ef8c122d9635514ced565fe"), - Case4 = hexstr2bin("82558a389a443c0ea4cc819899f2083a" - "85f0faa3e578f8077a2e3ff46729665b"), - Case5 = hexstr2bin("a3b6167473100ee06e0c796c2955552b"), - Case6 = hexstr2bin("60e431591ee0b67f0d8a26aacbf5b77f" - "8e0bc6213728c5140546040f0ee37f54"), - Case7 = hexstr2bin("9b09ffa71b942fcb27635fbcd5b0e944" - "bfdc63644f0713938a7f51535c3a35e2"), - hmac_rfc4231_cases_do(sha256, sha256_mac, [Case1, Case2, Case3, Case4, Case5, Case6, Case7]). - -hmac_rfc4231_sha384_do() -> - Case1 = hexstr2bin("afd03944d84895626b0825f4ab46907f" - "15f9dadbe4101ec682aa034c7cebc59c" - "faea9ea9076ede7f4af152e8b2fa9cb6"), - Case2 = hexstr2bin("af45d2e376484031617f78d2b58a6b1b" - "9c7ef464f5a01b47e42ec3736322445e" - "8e2240ca5e69e2c78b3239ecfab21649"), - Case3 = hexstr2bin("88062608d3e6ad8a0aa2ace014c8a86f" - "0aa635d947ac9febe83ef4e55966144b" - "2a5ab39dc13814b94e3ab6e101a34f27"), - Case4 = hexstr2bin("3e8a69b7783c25851933ab6290af6ca7" - "7a9981480850009cc5577c6e1f573b4e" - "6801dd23c4a7d679ccf8a386c674cffb"), - Case5 = hexstr2bin("3abf34c3503b2a23a46efc619baef897"), - Case6 = hexstr2bin("4ece084485813e9088d2c63a041bc5b4" - "4f9ef1012a2b588f3cd11f05033ac4c6" - "0c2ef6ab4030fe8296248df163f44952"), - Case7 = hexstr2bin("6617178e941f020d351e2f254e8fd32c" - "602420feb0b8fb9adccebb82461e99c5" - "a678cc31e799176d3860e6110c46523e"), - hmac_rfc4231_cases_do(sha384, sha384_mac, [Case1, Case2, Case3, Case4, Case5, Case6, Case7]). - -hmac_rfc4231_sha512_do() -> - Case1 = hexstr2bin("87aa7cdea5ef619d4ff0b4241a1d6cb0" - "2379f4e2ce4ec2787ad0b30545e17cde" - "daa833b7d6b8a702038b274eaea3f4e4" - "be9d914eeb61f1702e696c203a126854"), - Case2 = hexstr2bin("164b7a7bfcf819e2e395fbe73b56e0a3" - "87bd64222e831fd610270cd7ea250554" - "9758bf75c05a994a6d034f65f8f0e6fd" - "caeab1a34d4a6b4b636e070a38bce737"), - Case3 = hexstr2bin("fa73b0089d56a284efb0f0756c890be9" - "b1b5dbdd8ee81a3655f83e33b2279d39" - "bf3e848279a722c806b485a47e67c807" - "b946a337bee8942674278859e13292fb"), - Case4 = hexstr2bin("b0ba465637458c6990e5a8c5f61d4af7" - "e576d97ff94b872de76f8050361ee3db" - "a91ca5c11aa25eb4d679275cc5788063" - "a5f19741120c4f2de2adebeb10a298dd"), - Case5 = hexstr2bin("415fad6271580a531d4179bc891d87a6"), - Case6 = hexstr2bin("80b24263c7c1a3ebb71493c1dd7be8b4" - "9b46d1f41b4aeec1121b013783f8f352" - "6b56d037e05f2598bd0fd2215d6a1e52" - "95e64f73f63f0aec8b915a985d786598"), - Case7 = hexstr2bin("e37b6a775dc87dbaa4dfa9f96e5e3ffd" - "debd71f8867289865df5a32d20cdc944" - "b6022cac3c4982b10d5eeb55c3e4de15" - "134676fb6de0446065c97440fa8c6a58"), - hmac_rfc4231_cases_do(sha512, sha512_mac, [Case1, Case2, Case3, Case4, Case5, Case6, Case7]). - -hmac_rfc4231_cases_do(Hash, HashFun, CasesData) -> - hmac_rfc4231_cases_do(Hash, HashFun, [case1, case2, case3, case4, case5, case6, case7], CasesData). - -hmac_rfc4231_cases_do(_Hash, _HashFun, _, []) -> +hmac(_, [],[],[]) -> ok; -hmac_rfc4231_cases_do(Hash, HashFun, [C|Cases], [D|CasesData]) -> - hmac_rfc4231_case(Hash, HashFun, C, D), - hmac_rfc4231_cases_do(Hash, HashFun, Cases, CasesData). - -hmac_update_md5_io(doc) -> - ["Generate an MD5 HMAC using hmac_init, hmac_update, and hmac_final. " - "Expected values for examples are generated using crypto:md5_mac." ]; -hmac_update_md5_io(suite) -> - []; -hmac_update_md5_io(Config) when is_list(Config) -> - ?line Key = ["A fine speach", "by a fine man!"], - ?line Data = "Sampl", - ?line Data2 = "e #1", - ?line Ctx = crypto:hmac_init(md5, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), - ?line Mac = crypto:hmac_final(Ctx3), - ?line Exp = crypto:md5_mac(Key, lists:flatten([Data, Data2])), - ?line m(Exp, Mac). - - -hmac_update_md5_n(doc) -> - ["Generate a shortened MD5 HMAC using hmac_init, hmac_update, and hmac_final. " - "Expected values for examples are generated using crypto:md5_mac." ]; -hmac_update_md5_n(suite) -> - []; -hmac_update_md5_n(Config) when is_list(Config) -> - ?line Key = ["A fine speach", "by a fine man!"], - ?line Data = "Sampl", - ?line Data2 = "e #1", - ?line Ctx = crypto:hmac_init(md5, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), - ?line Mac = crypto:hmac_final_n(Ctx3, 12), - ?line Exp = crypto:md5_mac_96(Key, lists:flatten([Data, Data2])), - ?line m(Exp, Mac). -%% -%% -ripemd160(doc) -> - ["Generate RIPEMD160 message digests and check the result."]; -ripemd160(suite) -> - []; -ripemd160(Config) when is_list(Config) -> - ?line m(crypto:hash(ripemd160,"abc"), - hexstr2bin("8EB208F7E05D987A9B044A8E98C6B087F15A0BFC")), - ?line m(crypto:hash(ripemd160,"abcdbcdecdefdefgefghfghighijhijkijkljklmklm" - "nlmnomnopnopq"), - hexstr2bin("12A053384A9C0C88E405A06C27DCF49ADA62EB2B")). - - -%% -%% -ripemd160_update(doc) -> - ["Generate RIPEMD160 message digests by using ripemd160_init," - "ripemd160_update, and ripemd160_final and check the result."]; -ripemd160_update(suite) -> - []; -ripemd160_update(Config) when is_list(Config) -> - ?line Ctx = crypto:hash_init(ripemd160), - ?line Ctx1 = crypto:hash_update(Ctx, "abcdbcdecdefdefgefghfghighi"), - ?line Ctx2 = crypto:hash_update(Ctx1, "jhijkijkljklmklmnlmnomnopnopq"), - ?line m(crypto:hash_final(Ctx2), - hexstr2bin("12A053384A9C0C88E405A06C27DCF49ADA62EB2B")). - -%% -%% -sha_update(doc) -> - ["Generate SHA message digests by using sha_init, sha_update, and" - "sha_final, and check the result. Examples are from FIPS-180-1."]; -sha_update(suite) -> - []; -sha_update(Config) when is_list(Config) -> - ?line Ctx = crypto:sha_init(), - ?line Ctx1 = crypto:sha_update(Ctx, "abcdbcdecdefdefgefghfghighi"), - ?line Ctx2 = crypto:sha_update(Ctx1, "jhijkijkljklmklmnlmnomnopnopq"), - ?line m(crypto:sha_final(Ctx2), - hexstr2bin("84983E441C3BD26EBAAE4AA1F95129E5E54670F1")). - -%% -%% -sha256(doc) -> - ["Generate SHA-256 message digests and check the result. Examples are " - "from rfc-4634."]; -sha256(suite) -> - []; -sha256(Config) when is_list(Config) -> - if_supported(sha256, fun() -> sha256_do() end). - -sha256_do() -> - ?line m(crypto:sha256("abc"), - hexstr2bin("BA7816BF8F01CFEA4141" - "40DE5DAE2223B00361A396177A9CB410FF61F20015AD")), - ?line m(crypto:sha256("abcdbcdecdefdefgefghfghighijhijkijkljklmklm" - "nlmnomnopnopq"), - hexstr2bin("248D6A61D20638B8" - "E5C026930C3E6039A33CE45964FF2167F6ECEDD419DB06C1")). - -%% -%% -sha256_update(doc) -> - ["Generate SHA256 message digests by using sha256_init, sha256_update, and" - "sha256_final, and check the result. Examples are from rfc-4634."]; -sha256_update(suite) -> - []; -sha256_update(Config) when is_list(Config) -> - if_supported(sha256, fun() -> sha256_update_do() end). - -sha256_update_do() -> - ?line Ctx = crypto:sha256_init(), - ?line Ctx1 = crypto:sha256_update(Ctx, "abcdbcdecdefdefgefghfghighi"), - ?line Ctx2 = crypto:sha256_update(Ctx1, "jhijkijkljklmklmnlmnomnopnopq"), - ?line m(crypto:sha256_final(Ctx2), - hexstr2bin("248D6A61D20638B8" - "E5C026930C3E6039A33CE45964FF2167F6ECEDD419DB06C1")). - - -%% -%% -sha512(doc) -> - ["Generate SHA-512 message digests and check the result. Examples are " - "from rfc-4634."]; -sha512(suite) -> - []; -sha512(Config) when is_list(Config) -> - if_supported(sha512, fun() -> sha512_do() end). - -sha512_do() -> - ?line m(crypto:sha512("abc"), - hexstr2bin("DDAF35A193617ABACC417349AE20413112E6FA4E89A97EA2" - "0A9EEEE64B55D39A2192992A274FC1A836BA3C23A3FEEBBD" - "454D4423643CE80E2A9AC94FA54CA49F")), - ?line m(crypto:sha512("abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn" - "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"), - hexstr2bin("8E959B75DAE313DA8CF4F72814FC143F8F7779C6EB9F7FA1" - "7299AEADB6889018501D289E4900F7E4331B99DEC4B5433A" - "C7D329EEB6DD26545E96E55B874BE909")). - -%% -%% -sha512_update(doc) -> - ["Generate SHA512 message digests by using sha512_init, sha512_update, and" - "sha512_final, and check the result. Examples are from rfc=4634."]; -sha512_update(suite) -> - []; -sha512_update(Config) when is_list(Config) -> - if_supported(sha512, fun() -> sha512_update_do() end). - -sha512_update_do() -> - ?line Ctx = crypto:sha512_init(), - ?line Ctx1 = crypto:sha512_update(Ctx, "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn"), - ?line Ctx2 = crypto:sha512_update(Ctx1, "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"), - ?line m(crypto:sha512_final(Ctx2), - hexstr2bin("8E959B75DAE313DA8CF4F72814FC143F8F7779C6EB9F7FA1" - "7299AEADB6889018501D289E4900F7E4331B99DEC4B5433A" - "C7D329EEB6DD26545E96E55B874BE909")). - -%% -%% -md5_mac(doc) -> - ["Generate some HMACs, using MD5, and check the result. Examples are " - "from RFC-2104."]; -md5_mac(suite) -> - []; -md5_mac(Config) when is_list(Config) -> - ?line m(crypto:md5_mac(hexstr2bin("0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"), - "Hi There"), - hexstr2bin("9294727a3638bb1c13f48ef8158bfc9d")), - ?line m(crypto:md5_mac(list_to_binary("Jefe"), - "what do ya want for nothing?"), - hexstr2bin("750c783e6ab0b503eaa86e310a5db738")), - ?line m(crypto:md5_mac(hexstr2bin("AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"), - hexstr2bin("DDDDDDDDDDDDDDDDDDDD" - "DDDDDDDDDDDDDDDDDDDD" - "DDDDDDDDDDDDDDDDDDDD" - "DDDDDDDDDDDDDDDDDDDD" - "DDDDDDDDDDDDDDDDDDDD")), - hexstr2bin("56be34521d144c88dbb8c733f0e8b3f6")). - -%% -%% -md5_mac_io(doc) -> - ["Generate some HMACs, using MD5, with Key an IO-list, and check the " - "result. Examples are from RFC-2104."]; -md5_mac_io(suite) -> - []; -md5_mac_io(Config) when is_list(Config) -> - ?line Key1 = hexstr2bin("0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"), - ?line {B11, B12} = split_binary(Key1, 4), - ?line Key11 = [B11,binary_to_list(B12)], - ?line m(crypto:md5_mac(Key11, "Hi There"), - hexstr2bin("9294727a3638bb1c13f48ef8158bfc9d")). - -%% -%% -des_cbc(doc) -> - "Encrypt and decrypt according to CBC DES. and check the result. " - "Example are from FIPS-81."; -des_cbc(suite) -> - []; -des_cbc(Config) when is_list(Config) -> - ?line Key = hexstr2bin("0123456789abcdef"), - ?line IVec = hexstr2bin("1234567890abcdef"), - ?line Plain = "Now is the time for all ", - ?line Cipher = crypto:des_cbc_encrypt(Key, IVec, Plain), - ?line m(Cipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" - "0f683788499a7c05f6")), - ?line m(list_to_binary(Plain), - crypto:des_cbc_decrypt(Key, IVec, Cipher)), - ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], - ?line Cipher2 = crypto:des_cbc_encrypt(Key, IVec, Plain2), - ?line m(Cipher2, hexstr2bin("b9916b8ee4c3da64b4f44e3cbefb9" - "9484521388fa59ae67d58d2e77e86062733")), - ?line m(list_to_binary(Plain2), - crypto:des_cbc_decrypt(Key, IVec, Cipher2)). - -%% -%% -des_cbc_iter(doc) -> - "Encrypt and decrypt according to CBC DES in two steps, and " - "check the result. Example are from FIPS-81."; -des_cbc_iter(suite) -> - []; -des_cbc_iter(Config) when is_list(Config) -> - ?line Key = hexstr2bin("0123456789abcdef"), - ?line IVec = hexstr2bin("1234567890abcdef"), - ?line Plain1 = "Now is the time ", - ?line Plain2 = "for all ", - ?line Cipher1 = crypto:des_cbc_encrypt(Key, IVec, Plain1), - ?line IVec2 = crypto:des_cbc_ivec(Cipher1), - ?line Cipher2 = crypto:des_cbc_encrypt(Key, IVec2, Plain2), - ?line Cipher = list_to_binary([Cipher1, Cipher2]), - ?line m(Cipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" - "0f683788499a7c05f6")). - -%% -%% -des_cfb(doc) -> - "Encrypt and decrypt according to CFB DES. and check the result. " - "Example is from FIPS-81."; -des_cfb(suite) -> - []; -des_cfb(Config) when is_list(Config) -> - ?line Key = hexstr2bin("0123456789abcdef"), - ?line IVec = hexstr2bin("1234567890abcdef"), - ?line Plain = "Now is the", - ?line Cipher = crypto:des_cfb_encrypt(Key, IVec, Plain), - ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")), - ?line m(list_to_binary(Plain), - crypto:des_cfb_decrypt(Key, IVec, Cipher)). +hmac(sha = Type, [Key | Keys], [ <<"Test With Truncation">> = Data| Rest], [Expected | Expects]) -> + case crypto:hmac(Type, Key, Data, 20) of + Expected -> + ok; + Other -> + ct:fail({{crypto, hmac, [Type, Key, Data]}, {expected, Expected}, {got, Other}}) + end, + hmac(Type, Keys, Rest, Expects); + +hmac(Type, [Key | Keys], [ <<"Test With Truncation">> = Data| Rest], [Expected | Expects]) -> + case crypto:hmac(Type, Key, Data, 16) of + Expected -> + ok; + Other -> + ct:fail({{crypto, hmac, [Type, Key, Data]}, {expected, Expected}, {got, Other}}) + end, + hmac(Type, Keys, Rest, Expects); + +hmac(Type, [Key | Keys], [Data| Rest], [Expected | Expects]) -> + case crypto:hmac(Type, Key, Data) of + Expected -> + ok; + Other -> + ct:fail({{crypto, hmac, [Type, Key, Data]}, {expected, Expected}, {got, Other}}) + end, + hmac(Type, Keys, Rest, Expects). + +hmac_increment(Type) -> + Key = hmac_key(Type), + Increments = hmac_inc(Type), + Expected = crypto:hmac(Type, Key, lists:flatten(Increments)), + State = crypto:hmac_init(Type, Key), + case hmac_increment(State, Increments) of + Expected -> + ok; + Other -> + ct:fail({{crypto, "hmac_init/update/final", [Type, Increments]}, {expected, Expected}, {got, Other}}) + end. -%% -%% -des_cfb_iter(doc) -> - "Encrypt and decrypt according to CFB DES in two steps, and " - "check the result. Example is from FIPS-81."; -des_cfb_iter(suite) -> - []; -des_cfb_iter(Config) when is_list(Config) -> - ?line Key = hexstr2bin("0123456789abcdef"), - ?line IVec = hexstr2bin("1234567890abcdef"), - ?line Plain1 = "Now i", - ?line Plain2 = "s the", - ?line Cipher1 = crypto:des_cfb_encrypt(Key, IVec, Plain1), - ?line IVec2 = crypto:des_cfb_ivec(IVec, Cipher1), - ?line Cipher2 = crypto:des_cfb_encrypt(Key, IVec2, Plain2), - ?line Cipher = list_to_binary([Cipher1, Cipher2]), - ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")). +hmac_increment(State, []) -> + crypto:hmac_final(State); +hmac_increment(State0, [Increment | Rest]) -> + State = crypto:hmac_update(State0, Increment), + hmac_increment(State, Rest). + +block_cipher({Type, Key, PlainText}) -> + Plain = iolist_to_binary(PlainText), + CipherText = crypto:block_encrypt(Type, Key, PlainText), + case crypto:block_decrypt(Type, Key, CipherText) of + Plain -> + ok; + Other -> + ct:fail({{crypto, block_decrypt, [Type, Key, CipherText]}, {expected, Plain}, {got, Other}}) + end; + +block_cipher({Type, Key, IV, PlainText}) -> + Plain = iolist_to_binary(PlainText), + CipherText = crypto:block_encrypt(Type, Key, IV, PlainText), + case crypto:block_decrypt(Type, Key, IV, CipherText) of + Plain -> + ok; + Other -> + ct:fail({{crypto, block_decrypt, [Type, Key, IV, CipherText]}, {expected, Plain}, {got, Other}}) + end. -%% -%% -des_ecb(doc) -> - "Encrypt and decrypt according to ECB DES and check the result. " - "Example are from FIPS-81."; -des_ecb(suite) -> - []; -des_ecb(Config) when is_list(Config) -> - ?line Key = hexstr2bin("0123456789abcdef"), - ?line Cipher1 = crypto:des_ecb_encrypt(Key, "Now is t"), - ?line m(Cipher1, hexstr2bin("3fa40e8a984d4815")), - ?line Cipher2 = crypto:des_ecb_encrypt(Key, "he time "), - ?line m(Cipher2, hexstr2bin("6a271787ab8883f9")), - ?line Cipher3 = crypto:des_ecb_encrypt(Key, "for all "), - ?line m(Cipher3, hexstr2bin("893d51ec4b563b53")), - ?line Cipher4 = crypto:des_ecb_decrypt(Key, hexstr2bin("3fa40e8a984d4815")), - ?line m(Cipher4, <<"Now is t">>), - ?line Cipher5 = crypto:des_ecb_decrypt(Key, hexstr2bin("6a271787ab8883f9")), - ?line m(Cipher5, <<"he time ">>), - ?line Cipher6 = crypto:des_ecb_decrypt(Key, hexstr2bin("893d51ec4b563b53")), - ?line m(Cipher6, <<"for all ">>). -%% -%% -rc2_cbc(doc) -> - "Encrypt and decrypt according to RC2 CBC and check the result. " - "Example stripped out from public_key application test"; -rc2_cbc(Config) when is_list(Config) -> - - Key = <<146,210,160,124,215,227,153,239,227,17,222,140,3,93,27,191>>, - IV = <<72,91,135,182,25,42,35,210>>, - - Cipher = <<36,245,206,158,168,230,58,69,148,137,32,192,250,41,237,181,181,251, 192,2,175,135,177,171,57,30,111,117,159,149,15,28,88,158,28,81,28,115, 85,219,241,82,117,222,91,85,73,117,164,25,182,52,191,64,123,57,26,19, 211,27,253,31,194,219,231,104,247,240,172,130,119,21,225,154,101,247, 32,216,42,216,133,169,78,22,97,27,227,26,196,224,172,168,17,9,148,55, 203,91,252,40,61,226,236,221,215,160,78,63,13,181,68,57,196,241,185, 207, 116,129,152,237,60,139,247,153,27,146,161,246,222,98,185,222,152, 187,135, 236,86,34,7,110,91,230,173,34,160,242,202,222,121,127,181,140, 101,203,195, 190,88,250,86,147,127,87,72,126,171,16,71,47,110,248,88, 14,29,143,161,152, 129,236,148,22,152,186,208,119,70,8,174,193,203,100, 193,203,200,117,102,242, 134,142,96,125,135,200,217,190,76,117,50,70, 209,186,101,241,200,91,40,193,54, 90,195,38,47,59,197,38,234,86,223,16, 51,253,204,129,20,171,66,21,241,26,135,216, 196,114,110,91,15,53,40, 164,201,136,113,95,247,51,181,208,241,68,168,98,151,36, 155,72,24,57, 42,191,14,125,204,10,167,214,233,138,115,125,234,121,134,227,26,247, 77,200,117,110,117,111,168,156,206,67,159,149,189,173,150,193,91,199, 216,153,22, 189,137,185,89,160,13,131,132,58,109,28,110,246,252,251,14, 232,91,38,52,29,101,188,69,123,50,0,130,178,93,73,239,118,7,77,35,59, 253,10,159,45,86,142,37,78,232,48>>, - Text = <<48,130,1,85,2,1,0,48,13,6,9,42,134,72,134,247,13,1,1,1,5,0,4,130,1,63,48,130, 1,59,2,1,0,2,65,0,222,187,252,44,9,214,27,173,162,169,70,47,36,34,78,84,204, 107,60,192,117,95,21,206,49,142,245,126,121,223,23,2,107,106,133,204,161,36, 40,2,114,69,4,93,242,5,42,50,154,47,154,211,209,123,120,161,5,114,173,155,34, 191,52,59,2,3,1,0,1,2,64,45,144,169,106,220,236,71,39,67,82,123,192,35,21,61, 143,13,110,150,180,12,142,210,40,39,109,70,125,132,51,6,66,159,134,112,85, 155,243,118,221,65,133,127,99,151,194,252,141,149,224,229,62,214,45,228,32, 184,85,67,14,228,161,184,161,2,33,0,255,202,240,131,130,57,49,224,115,255,83, 79,6,165,212,21,179,212,20,188,97,74,69,68,163,223,247,237,39,24,23,235,2,33, 0,222,234,48,36,33,23,219,45,59,136,55,245,143,29,165,48,255,131,207,146,131, 104,13,163,54,131,236,78,88,54,16,241,2,33,0,230,2,99,129,173,176,166,131, 241,106,143,76,9,107,70,41,121,185,228,39,124,200,159,62,216,169,5,180,111, 169,255,159,2,33,0,151,193,70,212,209,210,179,219,175,83,165,4,255,81,103,76, 92,39,24,0,222,132,208,3,244,241,10,198,171,54,227,129,2,32,43,250,20,31,16, 189,168,116,225,1,125,132,94,130,118,124,28,56,232,39,69,218,244,33,240,200, 205,9,215,101,35,135,7,7,7,7,7,7,7>>, - - Text = crypto:rc2_cbc_decrypt(Key, IV, Cipher), - Cipher = crypto:rc2_cbc_encrypt(Key, IV, Text). +block_cipher_increment({Type, Key, IV, PlainTexts}) when Type == des_cbc; + Type == des3_cbc; + Type == aes_cbc; + Type == des_cbf + -> + block_cipher_increment(Type, Key, IV, IV, PlainTexts, iolist_to_binary(PlainTexts), []); +block_cipher_increment({_Type, _, _, _}) -> + ok; +block_cipher_increment({_,_,_}) -> + ok. +block_cipher_increment(Type, Key, IV0, _IV, [], Plain, Acc) -> + CipherText = iolist_to_binary(lists:reverse(Acc)), + case crypto:block_decrypt(Type, Key, IV0, CipherText) of + Plain -> + ok; + Other -> + ct:fail({{crypto, block_decrypt, [Type, Key, IV0, CipherText]}, {expected, Plain}, {got, Other}}) + end; +block_cipher_increment(Type, Key, IV0, IV, [PlainText | PlainTexts], Plain, Acc) -> + CipherText = crypto:block_encrypt(Type, Key, IV, PlainText), + NextIV = crypto:next_iv(Type, CipherText), + block_cipher_increment(Type, Key, IV0, NextIV, PlainTexts, Plain, [CipherText | Acc]). + +stream_cipher({Type, Key, PlainText}) -> + Plain = iolist_to_binary(PlainText), + State = crypto:stream_init(Type, Key), + {_, CipherText} = crypto:stream_encrypt(State, PlainText), + case crypto:stream_decrypt(State, CipherText) of + {_, Plain} -> + ok; + Other -> + ct:fail({{crypto, stream_decrypt, [State, CipherText]}, {expected, PlainText}, {got, Other}}) + end; +stream_cipher({Type, Key, IV, PlainText}) -> + Plain = iolist_to_binary(PlainText), + State = crypto:stream_init(Type, Key, IV), + {_, CipherText} = crypto:stream_encrypt(State, PlainText), + case crypto:stream_decrypt(State, CipherText) of + {_, Plain} -> + ok; + Other -> + ct:fail({{crypto, stream_decrypt, [State, CipherText]}, {expected, PlainText}, {got, Other}}) + end. -%% -%% -des3_cbc(doc) -> - "Encrypt and decrypt according to CBC 3DES, and check the result."; -des3_cbc(suite) -> - []; -des3_cbc(Config) when is_list(Config) -> - ?line Key1 = hexstr2bin("0123456789abcdef"), - ?line Key2 = hexstr2bin("fedcba9876543210"), - ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), - ?line IVec = hexstr2bin("1234567890abcdef"), - ?line Plain = "Now is the time for all ", - ?line Cipher = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain), - ?line m(Cipher, hexstr2bin("8a2667ee5577267cd9b1af2c5a0480" - "0bac1ae66970fb2b89")), - ?line m(list_to_binary(Plain), - crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher)), - ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], - ?line Cipher2 = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain2), - ?line m(Cipher2, hexstr2bin("eb33ec6ede2c8e90f6877e77b95d5" - "4c83cee22907f7f0041ca1b7abe202bfafe")), - ?line m(list_to_binary(Plain2), - crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher2)), - - ?line Key = hexstr2bin("0123456789abcdef"), - ?line DESCipher = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain), - ?line m(DESCipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" - "0f683788499a7c05f6")), - ?line m(list_to_binary(Plain), - crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher)), - ?line DESCipher2 = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain2), - ?line m(DESCipher2, hexstr2bin("b9916b8ee4c3da64b4f44e3cbefb9" - "9484521388fa59ae67d58d2e77e86062733")), - ?line m(list_to_binary(Plain2), - crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher2)). +stream_cipher_incment({Type, Key, PlainTexts}) -> + State = crypto:stream_init(Type, Key), + stream_cipher_incment(State, State, PlainTexts, [], iolist_to_binary(PlainTexts)); +stream_cipher_incment({Type, Key, IV, PlainTexts}) -> + State = crypto:stream_init(Type, Key, IV), + stream_cipher_incment(State, State, PlainTexts, [], iolist_to_binary(PlainTexts)). + +stream_cipher_incment(_State, OrigState, [], Acc, Plain) -> + CipherText = iolist_to_binary(lists:reverse(Acc)), + case crypto:stream_decrypt(OrigState, CipherText) of + {_, Plain} -> + ok; + Other -> + ct:fail({{crypto, stream_decrypt, [OrigState, CipherText]}, {expected, Plain}, {got, Other}}) + end; +stream_cipher_incment(State0, OrigState, [PlainText | PlainTexts], Acc, Plain) -> + {State, CipherText} = crypto:stream_encrypt(State0, PlainText), + stream_cipher_incment(State, OrigState, PlainTexts, [CipherText | Acc], Plain). + +do_sign_verify({Type, Hash, Public, Private, Msg}) -> + Signature = crypto:sign(Type, Hash, Msg, Private), + case crypto:verify(Type, Hash, Msg, Signature, Public) of + true -> + negative_verify(Type, Hash, Msg, <<10,20>>, Public); + false -> + ct:fail({{crypto, verify, [Type, Hash, Msg, Signature, Public]}}) + end. -%% -%% -des3_cfb(doc) -> - "Encrypt and decrypt according to CFB 3DES, and check the result."; -des3_cfb(suite) -> - []; -des3_cfb(Config) when is_list(Config) -> - case openssl_version() of - V when V < 16#90705F -> {skipped,"OpenSSL version too old"}; - _ -> des3_cfb_do() +negative_verify(Type, Hash, Msg, Signature, Public) -> + case crypto:verify(Type, Hash, Msg, Signature, Public) of + true -> + ct:fail({{crypto, verify, [Type, Hash, Msg, Signature, Public]}, should_fail}); + false -> + ok end. -des3_cfb_do() -> - ?line Key1 = hexstr2bin("0123456789abcdef"), - ?line Key2 = hexstr2bin("fedcba9876543210"), - ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), - ?line IVec = hexstr2bin("1234567890abcdef"), - ?line Plain = "Now is the time for all ", - ?line Cipher = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain), - ?line m(Cipher, hexstr2bin("fc0ba7a20646ba53cc8bff263f0937" - "1deab42a00666db02c")), - ?line m(list_to_binary(Plain), - crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher)), - ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], - ?line Cipher2 = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain2), - ?line m(Cipher2, hexstr2bin("8582c59ac01897422632c0accb66c" - "e413f5efab838fce7e41e2ba67705bad5bc")), - ?line m(list_to_binary(Plain2), - crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher2)). +do_public_encrypt({Type, Public, Private, Msg, 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 = (catch crypto:private_encrypt(Type, Msg, Private, Padding)), + case crypto:public_decrypt(rsa, PrivEcn, Public, Padding) of + Msg -> + ok; + Other -> + ct:fail({{crypto, public_decrypt, [Type, PrivEcn, Public, Padding]}, {expected, Msg}, {got, Other}}) + end. + +do_generate_compute({srp = Type, UserPrivate, UserGenParams, UserComParams, + HostPublic, HostPrivate, HostGenParams, HostComParam, SessionKey}) -> + {UserPublic, UserPrivate} = crypto:generate_key(Type, UserGenParams, UserPrivate), + {HostPublic, HostPrivate} = crypto:generate_key(Type, HostGenParams, HostPrivate), + SessionKey = crypto:compute_key(Type, HostPublic, {UserPublic, UserPrivate}, + UserComParams), + SessionKey = crypto:compute_key(Type, UserPublic, {HostPublic, HostPrivate}, + HostComParam); +do_generate_compute({dh, P, G}) -> + {UserPub, UserPriv} = crypto:generate_key(dh, [P, G]), + {HostPub, HostPriv} = crypto:generate_key(dh, [P, G]), + SharedSecret = crypto:compute_key(dh, HostPub, UserPriv, [P, G]), + SharedSecret = crypto:compute_key(dh, UserPub, HostPriv, [P, G]). + +do_compute({ecdh = Type, Pub, Priv, Curve, SharedSecret}) -> + Secret = crypto:bytes_to_integer(crypto:compute_key(Type, Pub, Priv, Curve)), + case Secret of + SharedSecret -> + ok; + Other -> + ct:fail({{crypto, compute_key, [Type, Pub, Priv, Curve]}, {expected, SharedSecret}, {got, Other}}) + end. -%% -%% -aes_cfb(doc) -> - "Encrypt and decrypt according to AES CFB 128 bit and check " - "the result. Example are from NIST SP 800-38A."; - -aes_cfb(suite) -> - []; -aes_cfb(Config) when is_list(Config) -> - -%% Sample data from NIST Spec.Publ. 800-38A -%% F.3.13 CFB128-AES128.Encrypt -%% Key 2b7e151628aed2a6abf7158809cf4f3c -%% IV 000102030405060708090a0b0c0d0e0f -%% Segment #1 -%% Input Block 000102030405060708090a0b0c0d0e0f -%% Output Block 50fe67cc996d32b6da0937e99bafec60 -%% Plaintext 6bc1bee22e409f96e93d7e117393172a -%% Ciphertext 3b3fd92eb72dad20333449f8e83cfb4a -%% Segment #2 -%% Input Block 3b3fd92eb72dad20333449f8e83cfb4a -%% Output Block 668bcf60beb005a35354a201dab36bda -%% Plaintext ae2d8a571e03ac9c9eb76fac45af8e51 -%% Ciphertext c8a64537a0b3a93fcde3cdad9f1ce58b -%% Segment #3 -%% Input Block c8a64537a0b3a93fcde3cdad9f1ce58b -%% Output Block 16bd032100975551547b4de89daea630 -%% Plaintext 30c81c46a35ce411e5fbc1191a0a52ef -%% Ciphertext 26751f67a3cbb140b1808cf187a4f4df -%% Segment #4 -%% Input Block 26751f67a3cbb140b1808cf187a4f4df -%% Output Block 36d42170a312871947ef8714799bc5f6 -%% Plaintext f69f2445df4f9b17ad2b417be66c3710 -%% Ciphertext c04b05357c5d1c0eeac4c66f9ff7f2e6 - - ?line Key = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), - ?line IVec = hexstr2bin("000102030405060708090a0b0c0d0e0f"), - ?line Plain = hexstr2bin("6bc1bee22e409f96e93d7e117393172a"), - ?line Cipher = hexstr2bin("3b3fd92eb72dad20333449f8e83cfb4a"), - - %% Try all prefixes of plain and cipher. - aes_cfb_do(byte_size(Plain), Plain, Cipher, Key, IVec). - -aes_cfb_do(N, Plain, Cipher, Key, IVec) when N >= 0 -> - <<P:N/binary, _/binary>> = Plain, - <<C:N/binary, _/binary>> = Cipher, - ?line C = crypto:aes_cfb_128_encrypt(Key, IVec, P), - ?line P = crypto:aes_cfb_128_decrypt(Key, IVec, C), - aes_cfb_do(N-1, Plain, Cipher, Key, IVec); -aes_cfb_do(_, _, _, _, _) -> ok. +hexstr2bin(S) -> + list_to_binary(hexstr2list(S)). +hexstr2list([X,Y|T]) -> + [mkint(X)*16 + mkint(Y) | hexstr2list(T)]; +hexstr2list([]) -> + []. +mkint(C) when $0 =< C, C =< $9 -> + C - $0; +mkint(C) when $A =< C, C =< $F -> + C - $A + 10; +mkint(C) when $a =< C, C =< $f -> + C - $a + 10. -%% -%% -aes_cbc(doc) -> - "Encrypt and decrypt according to AES CBC 128 bit. and check the result. " - "Example are from NIST SP 800-38A."; - -aes_cbc(suite) -> - []; -aes_cbc(Config) when is_list(Config) -> - -%% Sample data from NIST Spec.Publ. 800-38A -%% F.2.1 CBC-AES128.Encrypt -%% Key 2b7e151628aed2a6abf7158809cf4f3c -%% IV 000102030405060708090a0b0c0d0e0f -%% Block #1 -%% Plaintext 6bc1bee22e409f96e93d7e117393172a -%% Input Block 6bc0bce12a459991e134741a7f9e1925 -%% Output Block 7649abac8119b246cee98e9b12e9197d -%% Ciphertext 7649abac8119b246cee98e9b12e9197d -%% Block #2 -%% Plaintext ae2d8a571e03ac9c9eb76fac45af8e51 -%% Input Block d86421fb9f1a1eda505ee1375746972c -%% Output Block 5086cb9b507219ee95db113a917678b2 -%% Ciphertext 5086cb9b507219ee95db113a917678b2 -%% Block #3 -%% Plaintext 30c81c46a35ce411e5fbc1191a0a52ef -%% Input Block 604ed7ddf32efdff7020d0238b7c2a5d -%% Output Block 73bed6b8e3c1743b7116e69e22229516 -%% Ciphertext 73bed6b8e3c1743b7116e69e22229516 -%% Block #4 -%% Plaintext f69f2445df4f9b17ad2b417be66c3710 -%% Input Block 8521f2fd3c8eef2cdc3da7e5c44ea206 -%% Output Block 3ff1caa1681fac09120eca307586e1a7 -%% Ciphertext 3ff1caa1681fac09120eca307586e1a7 -%% -%% F.2.2 CBC-AES128.Decrypt -%% Key 2b7e151628aed2a6abf7158809cf4f3c -%% IV 000102030405060708090a0b0c0d0e0f - %% Block #1 -%% Ciphertext 7649abac8119b246cee98e9b12e9197d -%% Input Block 7649abac8119b246cee98e9b12e9197d -%% Output Block 6bc0bce12a459991e134741a7f9e1925 -%% Plaintext 6bc1bee22e409f96e93d7e117393172a -%% Block #2 -%% Ciphertext 5086cb9b507219ee95db113a917678b2 -%% Input Block 5086cb9b507219ee95db113a917678b2 -%% Output Block d86421fb9f1a1eda505ee1375746972c -%% Plaintext ae2d8a571e03ac9c9eb76fac45af8e51 -%% Block #3 -%% Ciphertext 73bed6b8e3c1743b7116e69e22229516 -%% Input Block 73bed6b8e3c1743b7116e69e22229516 -%% Output Block 604ed7ddf32efdff7020d0238b7c2a5d -%% Plaintext 30c81c46a35ce411e5fbc1191a0a52ef -%% Block #4 -%% Ciphertext 3ff1caa1681fac09120eca307586e1a7 -%% Input Block 3ff1caa1681fac09120eca307586e1a7 -%% Output Block 8521f2fd3c8eef2cdc3da7e5c44ea206 -%% Plaintext f69f2445df4f9b17ad2b417be66c3710 - - ?line Key = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), - ?line IVec = hexstr2bin("000102030405060708090a0b0c0d0e0f"), - ?line Plain = hexstr2bin("6bc1bee22e409f96e93d7e117393172a"), - ?line Cipher = crypto:aes_cbc_128_encrypt(Key, IVec, Plain), - ?line m(Cipher, hexstr2bin("7649abac8119b246cee98e9b12e9197d")), - ?line m(Plain, - crypto:aes_cbc_128_decrypt(Key, IVec, Cipher)). - -aes_cbc_iter(doc) -> - "Encrypt and decrypt according to CBC AES in steps"; -aes_cbc_iter(suite) -> []; -aes_cbc_iter(Config) when is_list(Config) -> - Key = list_to_binary(lists:seq(255,256-16*17,-17)), - IVec = list_to_binary(lists:seq(1,16*7,7)), - Plain = <<"One, two, three o'clock, four o'clock, rock" - "Five, six, seven o'clock, eight o'clock, rock" - "Nine, ten, eleven o'clock, twelve o'clock, rock" - "We're gonna rock around the clock tonight">>, - ?line 0 = size(Plain) rem 16, - - ?line Cipher = crypto:aes_cbc_128_encrypt(Key, IVec, Plain), - ?line Plain = crypto:aes_cbc_128_decrypt(Key, IVec, Cipher), - - ?line Cipher = aes_cbc_encrypt_iter(Key,IVec,Plain,<<>>), - ?line Plain = aes_cbc_decrypt_iter(Key,IVec,Cipher,<<>>), - ok. +is_supported(Group) -> + lists:member(Group, lists:append([Algo || {_, Algo} <- crypto:supports()])). + +block_iolistify(Blocks) -> + lists:map(fun do_block_iolistify/1, Blocks). +stream_iolistify(Streams) -> + lists:map(fun do_stream_iolistify/1, Streams). + +do_stream_iolistify({Type, Key, PlainText}) -> + {Type, iolistify(Key), iolistify(PlainText)}; +do_stream_iolistify({Type, Key, IV, PlainText}) -> + {Type, iolistify(Key), IV, iolistify(PlainText)}. + +do_block_iolistify({des_cbc = Type, Key, IV, PlainText}) -> + {Type, Key, IV, des_iolistify(PlainText)}; +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}) -> + {Type, iolistify(Key), IV, iolistify(PlainText)}. + +iolistify(<<"Test With Truncation">>)-> + %% Do not iolistify as it spoils this special case + <<"Test With Truncation">>; +iolistify(Msg)-> + Length = erlang:byte_size(Msg), + Split = Length div 2, + List0 = binary_to_list(Msg), + case lists:split(Split, List0) of + {[Element | List1], List2} -> + [[Element], List1, List2]; + {List1, List2}-> + [List1, List2] + end. + +des_iolistify(Msg) -> + des_iolist(erlang:byte_size(Msg) div 8, Msg, []). + +des_iolist(1, Msg, Acc) -> + lists:reverse([Msg | Acc]); +des_iolist(Split, Msg, Acc) -> + <<Part:8/binary, Rest/binary>> = Msg, + des_iolist(Split-1, Rest, [Part | Acc]). + +%%-------------------------------------------------------------------- +mod_pow_aux_test(_, _, _, 0) -> + ok; +mod_pow_aux_test(B, E, M, N) -> + Result = crypto:bytes_to_integer(crypto:mod_pow(B, E, M)), + Result = ipow(B, E, M), + mod_pow_aux_test(B, E*E+1, M*M+1, N-1). -aes_cbc_encrypt_iter(_,_,<<>>, Acc) -> - Acc; -aes_cbc_encrypt_iter(Key,IVec,Data, Acc) -> - Bytes = 16 * (1 + size(Data) div (16*3)), - <<Chunk:Bytes/binary, Rest/binary>> = Data, - %%io:format("encrypt iter Chunk=~p Rest=~p\n",[Chunk,Rest]), - ?line Cipher = crypto:aes_cbc_128_encrypt(Key, IVec, Chunk), - ?line IVec2 = crypto:aes_cbc_ivec(Cipher), - aes_cbc_encrypt_iter(Key,IVec2,Rest, <<Acc/binary, Cipher/binary>>). - -aes_cbc_decrypt_iter(_,_,<<>>, Acc) -> - Acc; -aes_cbc_decrypt_iter(Key,IVec,Data, Acc) -> - Bytes = 16 * (1 + size(Data) div (16*5)), - <<Chunk:Bytes/binary, Rest/binary>> = Data, - %%io:format("decrypt iter Chunk=~p Rest=~p\n",[Chunk,Rest]), - ?line Plain = crypto:aes_cbc_128_decrypt(Key, IVec, Chunk), - ?line IVec2 = crypto:aes_cbc_ivec(Chunk), - aes_cbc_decrypt_iter(Key,IVec2,Rest, <<Acc/binary, Plain/binary>>). - - -aes_ctr(doc) -> "CTR"; -aes_ctr(Config) when is_list(Config) -> - %% Sample data from NIST Spec.Publ. 800-38A - %% F.5.1 CTR-AES128.Encrypt - Key128 = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), - Samples128 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block - "6bc1bee22e409f96e93d7e117393172a", % Plaintext - "874d6191b620e3261bef6864990db6ce"},% Ciphertext - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", - "ae2d8a571e03ac9c9eb76fac45af8e51", - "9806f66b7970fdff8617187bb9fffdff"}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", - "30c81c46a35ce411e5fbc1191a0a52ef", - "5ae4df3edbd5d35e5b4f09020db03eab"}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", - "f69f2445df4f9b17ad2b417be66c3710", - "1e031dda2fbe03d1792170a0f3009cee"}], - lists:foreach(fun(S) -> aes_ctr_do(Key128,S) end, Samples128), - - %% F.5.3 CTR-AES192.Encrypt - Key192 = hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), - Samples192 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block - "6bc1bee22e409f96e93d7e117393172a", % Plaintext - "1abc932417521ca24f2b0459fe7e6e0b"},% Ciphertext - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", - "ae2d8a571e03ac9c9eb76fac45af8e51", - "090339ec0aa6faefd5ccc2c6f4ce8e94"}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", - "30c81c46a35ce411e5fbc1191a0a52ef", - "1e36b26bd1ebc670d1bd1d665620abf7"}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", - "f69f2445df4f9b17ad2b417be66c3710", - "4f78a7f6d29809585a97daec58c6b050"}], - lists:foreach(fun(S) -> aes_ctr_do(Key192,S) end, Samples192), - - %% F.5.5 CTR-AES256.Encrypt - Key256 = hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), - Samples256 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block - "6bc1bee22e409f96e93d7e117393172a", % Plaintext - "601ec313775789a5b7a7f504bbf3d228"},% Ciphertext - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", - "ae2d8a571e03ac9c9eb76fac45af8e51", - "f443e3ca4d62b59aca84e990cacaf5c5"}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", - "30c81c46a35ce411e5fbc1191a0a52ef", - "2b0930daa23de94ce87017ba2d84988d"}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", - "f69f2445df4f9b17ad2b417be66c3710", - "dfc9c58db67aada613c2dd08457941a6"}], - lists:foreach(fun(S) -> aes_ctr_do(Key256,S) end, Samples256). - - -aes_ctr_do(Key,{IVec, Plain, Cipher}) -> - ?line I = hexstr2bin(IVec), - ?line P = hexstr2bin(Plain), - ?line C = crypto:aes_ctr_encrypt(Key, I, P), - ?line m(C, hexstr2bin(Cipher)), - ?line m(P, crypto:aes_ctr_decrypt(Key, I, C)). - -aes_ctr_stream(doc) -> "CTR Streaming"; -aes_ctr_stream(Config) when is_list(Config) -> - %% Sample data from NIST Spec.Publ. 800-38A - %% F.5.1 CTR-AES128.Encrypt - Key128 = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), - Samples128 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block - ["6bc1bee22e409f", "96e93d7e117393172a"], % Plaintext - ["874d6191b620e3261bef6864990db6ce"]}, % Ciphertext - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", - ["ae2d8a57", "1e03ac9c", "9eb76fac", "45af8e51"], - ["9806f66b7970fdff","8617187bb9fffdff"]}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", - ["30c81c46a35c", "e411e5fbc119", "1a0a52ef"], - ["5ae4df3e","dbd5d3","5e5b4f0902","0db03eab"]}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", - ["f69f2445df4f9b17ad2b417be66c3710"], - ["1e031dda2fbe","03d1792170a0","f3009cee"]}], - lists:foreach(fun(S) -> aes_ctr_stream_do(Key128,S) end, Samples128), - - %% F.5.3 CTR-AES192.Encrypt - Key192 = hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), - Samples192 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block - ["6bc1bee22e409f96e93d7e117393172a"], % Plaintext - ["1abc9324","17521c","a24f2b04","59fe7e6e0b"]}, % Ciphertext - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", - ["ae2d8a57", "1e03ac9c9eb76fac", "45af8e51"], - ["090339ec0aa6faefd5ccc2c6f4ce8e94"]}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", - ["30c81c46a35ce411", "e5fbc1191a0a52ef"], - ["1e36b26bd1","ebc670d1bd1d","665620abf7"]}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", - ["f69f2445", "df4f9b17ad", "2b417be6", "6c3710"], - ["4f78a7f6d2980958","5a97daec58c6b050"]}], - lists:foreach(fun(S) -> aes_ctr_stream_do(Key192,S) end, Samples192), - - %% F.5.5 CTR-AES256.Encrypt - Key256 = hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), - Samples256 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block - ["6bc1bee22e409f96", "e93d7e117393172a"], % Plaintext - ["601ec313775789", "a5b7a7f504bbf3d228"]}, % Ciphertext - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", - ["ae2d8a571e03ac9c9eb76fac45af8e51"], - ["f443e3ca","4d62b59aca84","e990cacaf5c5"]}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", - ["30c81c46","a35ce411","e5fbc119","1a0a52ef"], - ["2b0930daa23de94ce87017ba2d84988d"]}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", - ["f69f2445df4f","9b17ad2b41","7be66c3710"], - ["dfc9c5","8db67aada6","13c2dd08","457941a6"]}], - lists:foreach(fun(S) -> aes_ctr_stream_do(Key256,S) end, Samples256). - - -aes_ctr_stream_do(Key,{IVec, PlainList, CipherList}) -> - ?line I = hexstr2bin(IVec), - ?line S = crypto:aes_ctr_stream_init(Key, I), - ?line C = aes_ctr_stream_do_iter( - S, PlainList, [], - fun(S2,P) -> crypto:aes_ctr_stream_encrypt(S2, P) end), - ?line m(C, hexstr2bin(lists:flatten(CipherList))), - ?line P = aes_ctr_stream_do_iter( - S, CipherList, [], - fun(S2,C2) -> crypto:aes_ctr_stream_decrypt(S2, C2) end), - ?line m(P, hexstr2bin(lists:flatten(PlainList))). - -aes_ctr_stream_do_iter(_State, [], Acc, _CipherFun) -> - iolist_to_binary(lists:reverse(Acc)); -aes_ctr_stream_do_iter(State, [Plain|Rest], Acc, CipherFun) -> - ?line P = hexstr2bin(Plain), - ?line {S2, C} = CipherFun(State, P), - aes_ctr_stream_do_iter(S2, Rest, [C | Acc], CipherFun). +%% mod_exp in erlang (copied from jungerl's ssh_math.erl) +ipow(A, B, M) when M > 0, B >= 0 -> + if A == 1 -> + 1; + true -> + ipow(A, B, M, 1) + end. -%% -%% -mod_exp_test(doc) -> - "mod_exp testing (A ^ M % P with bignums)"; -mod_exp_test(suite) -> - []; -mod_exp_test(Config) when is_list(Config) -> - mod_exp_aux_test(2, 5, 10, 8). - -mod_exp_aux_test(_, _, _, 0) -> - ok; -mod_exp_aux_test(B, E, M, N) -> - ?line R1 = crypto:mod_exp(B, E, M), - ?line R2 = ipow(B, E, M), - ?line m(R1, R2), - ?line mod_exp_aux_test(B, E*E+1, M*M+1, N-1). +ipow(A, 1, M, Prod) -> + (A*Prod) rem M; +ipow(_A, 0, _M, Prod) -> + Prod; +ipow(A, B, M, Prod) -> + B1 = B bsr 1, + A1 = (A*A) rem M, + if B - B1 == B1 -> + ipow(A1, B1, M, Prod); + true -> + ipow(A1, B1, M, (A*Prod) rem M) + end. -%% -%% -rand_uniform_test(doc) -> - "rand_uniform and random_bytes testing"; -rand_uniform_test(suite) -> - []; -rand_uniform_test(Config) when is_list(Config) -> - rand_uniform_aux_test(10), - ?line 10 = size(crypto:rand_bytes(10)). +zero_bin(N) when is_integer(N) -> + N8 = N * 8, + <<0:N8/integer>>; +zero_bin(B) when is_binary(B) -> + zero_bin(size(B)). +xor_bytes(Bin1, Bin2) when is_binary(Bin1), is_binary(Bin2) -> + L1 = binary_to_list(Bin1), + L2 = binary_to_list(Bin2), + list_to_binary(xor_bytes(L1, L2)); +xor_bytes(L1, L2) -> + xor_bytes(L1, L2, []). +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) -> - ?line L = N*1000, - ?line H = N*100000+1, - ?line crypto_rand_uniform(L, H), - ?line crypto_rand_uniform(-L, L), - ?line crypto_rand_uniform(-H, -L), - ?line crypto_rand_uniform(-H, L), - ?line rand_uniform_aux_test(N-1). + 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) -> - ?line R1 = crypto:rand_uniform(L, H), - ?line t(R1 >= L), - ?line t(R1 < H). - - -%% -%% -strong_rand_test(doc) -> - "strong_rand_mpint and strong_random_bytes testing"; -strong_rand_test(suite) -> - []; -strong_rand_test(Config) when is_list(Config) -> - strong_rand_aux_test(180), - ?line 10 = byte_size(crypto:strong_rand_bytes(10)). - -strong_rand_aux_test(0) -> - ?line t(crypto:strong_rand_mpint(0,0,0) =:= <<0,0,0,0>>), - ok; -strong_rand_aux_test(1) -> - ?line t(crypto:erlint(crypto:strong_rand_mpint(1,0,1)) =:= 1), - ?line strong_rand_aux_test(0); -strong_rand_aux_test(N) -> - ?line t(sru_length(crypto:strong_rand_mpint(N,-1,0)) =< N), - ?line t(sru_length(crypto:strong_rand_mpint(N,0,0)) =:= N), - ?line t(crypto:erlint(crypto:strong_rand_mpint(N,0,1)) band 1 =:= 1), - ?line t(crypto:erlint(crypto:strong_rand_mpint(N,1,0)) bsr (N - 2) =:= 2#11), - ?line strong_rand_aux_test(N-1). - -sru_length(Mpint) -> - I = crypto:erlint(Mpint), - length(erlang:integer_to_list(I, 2)). - -%% -%% -%% -%% -rsa_verify_test(doc) -> - "rsa_verify testing (A ^ M % P with bignums)"; -rsa_verify_test(suite) -> - []; -rsa_verify_test(Config) when is_list(Config) -> - ?line H = <<178,28,54,104,36,80,144,66,140,201,135,17,36,97,114,124, - 194,164,172,147>>, - ?line SigBlob = <<153,44,121,71,132,1,192,159,78,33,29,62,153,64,191,70, - 208,239,166,208,220,167,49,111,128,67,91,253,24,63,194,241, - 97,157,135,226,121,162,150,156,60,49,236,90,151,67,239,23, - 92,103,89,254,17,165,78,181,64,128,13,210,86,111,209,76, - 115,34,107,227,151,47,80,185,143,85,202,55,245,163,226,26, - 139,104,196,6,96,82,108,197,13,0,12,70,153,109,107,180, - 130,246,156,182,56,96,31,220,227,218,136,211,252,43,8,14, - 145,155,191,206,72,194,80,52,54,206,53,27,6,188,195,29>>, - ?line BadSigBlob = <<153,44,121,71,132,1,192,159,78,33,29,62,153,64,191,70, - 208,239,166,208,220,167,49,111,128,67,91,253,24,63,194,241, - 97,157,135,226,121,162,150,156,60,49,236,90,151,67,239,23, - 92,103,89,254,17,165,78,181,64,128,13,210,86,111,209,76, - 115,107,34,227,151,47,80,185,143,85,202,55,245,163,226,26, - 139,104,196,6,96,82,108,197,13,0,12,70,153,109,107,180, - 130,246,156,182,56,96,31,220,227,218,136,211,252,43,8,14, - 145,155,191,206,72,194,80,52,54,206,53,27,6,188,195,29>>, - ?line E = <<35>>, - ?line N = <<0,199,209,142,191,86,92,148,103,37,250,217,175,169,109,10, - 130,139,34,237,174,90,97,118,7,185,57,137,252,236,177,193, - 228,16,62,29,153,144,64,207,152,240,152,206,136,89,64,6, - 3,187,89,57,241,219,88,215,75,70,120,20,145,229,37,1, - 67,138,204,17,39,231,249,239,116,142,169,99,149,41,65,123, - 26,225,133,0,41,85,77,181,35,100,162,223,92,220,207,50, - 63,168,193,171,174,199,23,214,201,63,157,76,125,6,54,73, - 76,89,40,33,147,208,189,76,98,24,61,8,10,110,165,119,165>>, - ?line Nbad = <<0,199,209,142,191,86,92,148,103,37,250,217,175,169,109,10, - 130,139,34,237,174,90,97,118,7,185,57,137,252,236,177,193, - 228,16,62,29,153,144,64,207,152,240,152,206,136,89,64,6, - 3,187,89,57,241,219,88,215,75,70,120,20,145,229,37,1, - 67,138,204,17,39,231,249,239,116,142,169,99,149,41,65,123, - 26,225,133,0,41,85,77,181,35,100,162,223,92,220,207,50, - 63,168,193,171,174,199,23,214,201,63,157,76,125,6,54,73, - 76,89,40,33,147,189,208,76,98,24,61,8,10,110,165,119,165>>, - ?line Ebad = <<77>>, - ?line m(crypto:rsa_verify(sized_binary(H), sized_binary(SigBlob), - [sized_binary(E), sized_binary(N)]), true), - ?line m(crypto:rsa_verify(sized_binary(H), sized_binary(SigBlob), - [sized_binary(Ebad), sized_binary(N)]), false), - ?line m(crypto:rsa_verify(sized_binary(H), sized_binary(SigBlob), - [sized_binary(E), sized_binary(Nbad)]), false), - ?line m(crypto:rsa_verify(sized_binary(H), sized_binary(BadSigBlob), - [sized_binary(E), sized_binary(N)]), false). + 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. -%% -%% -dsa_verify_test(doc) -> - "dsa_verify testing (A ^ M % P with bignums)"; -dsa_verify_test(suite) -> - []; -dsa_verify_test(Config) when is_list(Config) -> - ?line Msg = <<48,130,2,245,160,3,2,1,2,2,1,1,48,9,6,7,42,134,72,206,56,4,3,48, - 58,49,11,48,9,6,3,85,4,6,19,2,85,83,49,26,48,24,6,3,85,4,10,19,17, - 84,101,115,116,32,67,101,114,116,105,102,105,99,97,116,101,115,49, - 15,48,13,6,3,85,4,3,19,6,68,83,65,32,67,65,48,30,23,13,48,49,48, - 52,49,57,49,52,53,55,50,48,90,23,13,49,49,48,52,49,57,49,52,53,55, - 50,48,90,48,93,49,11,48,9,6,3,85,4,6,19,2,85,83,49,26,48,24,6,3, - 85,4,10,19,17,84,101,115,116,32,67,101,114,116,105,102,105,99,97, - 116,101,115,49,50,48,48,6,3,85,4,3,19,41,86,97,108,105,100,32,68, - 83,65,32,83,105,103,110,97,116,117,114,101,115,32,69,69,32,67,101, - 114,116,105,102,105,99,97,116,101,32,84,101,115,116,52,48,130,1, - 182,48,130,1,43,6,7,42,134,72,206,56,4,1,48,130,1,30,2,129,129,0, - 228,139,175,64,140,21,215,61,124,238,3,150,18,104,193,32,5,232,23, - 202,158,116,101,75,154,84,151,42,120,51,218,165,197,114,234,52, - 179,148,104,66,213,27,253,119,240,168,66,158,100,147,144,182,194, - 2,49,70,19,122,3,105,204,152,45,86,157,94,35,95,40,191,173,127,15, - 208,105,149,98,92,26,7,42,94,140,115,73,126,253,18,34,142,85,229, - 86,233,174,114,41,150,135,8,39,215,119,67,240,134,184,9,10,27,20, - 165,230,3,230,69,121,77,233,250,83,95,193,9,189,126,197,195,2,21, - 0,128,63,228,252,243,76,229,62,203,15,23,10,42,84,108,208,103,108, - 13,59,2,129,128,102,212,22,138,32,173,254,209,50,159,165,127,167, - 179,208,234,119,63,235,108,162,228,41,216,216,188,33,221,154,247, - 204,229,180,119,77,223,236,218,162,140,156,117,18,90,31,254,102, - 211,17,194,239,132,67,236,169,136,110,76,186,76,63,53,150,199,103, - 252,153,189,15,153,41,19,145,78,216,2,174,254,107,175,80,86,170, - 47,30,181,42,200,238,34,71,37,120,107,33,221,20,63,206,240,16,129, - 247,150,29,156,65,187,94,68,146,93,46,198,30,184,205,105,200,143, - 63,59,62,208,79,162,206,217,3,129,132,0,2,129,128,15,83,40,172,56, - 47,61,243,17,97,65,195,61,167,214,122,247,246,1,50,211,33,113,16, - 20,213,195,62,77,235,25,162,140,175,158,8,61,65,10,255,204,162,71, - 130,122,86,161,163,253,236,178,139,183,57,181,202,160,25,133,130, - 155,150,104,168,187,107,186,144,164,225,173,101,182,68,49,210,30, - 34,47,83,65,79,250,156,248,47,232,44,67,36,22,126,43,216,100,247, - 100,250,240,121,72,29,185,2,109,144,54,204,235,54,15,242,57,171, - 125,39,236,247,71,111,221,51,196,126,77,238,36,87,163,107,48,105, - 48,29,6,3,85,29,14,4,22,4,20,179,51,215,81,162,4,13,68,251,157,64, - 241,18,98,113,176,83,246,105,13,48,31,6,3,85,29,35,4,24,48,22,128, - 20,116,21,213,36,28,189,94,101,136,31,225,139,9,126,127,234,25,72, - 78,97,48,23,6,3,85,29,32,4,16,48,14,48,12,6,10,96,134,72,1,101,3, - 2,1,48,1,48,14,6,3,85,29,15,1,1,255,4,4,3,2,6,192>>, - - ?line SigBlob = <<48,45,2,21,0,140,167,200,210,153,212,64,155,249,33,146,104,243, - 39,38,9,115,162,89,24,2,20,76,254,31,128,187,48,128,215,216, - 112,198,78,118,160,217,157,180,246,64,234>>, - ?line P_p = 157224271412839155721795253728878055347359513988016145491388196653004661857517720927482198111104095793441029858267073789634147217022008635826863307553453131345099940951090826856271796188522037524757740796268675508118348391218066949174594918958269259937813776150149068811425194955973128428675945283593831134219, - ?line Q_p = 1181895316321540581845959276009400765315408342791, - ?line G_p = 143872196713149000950547166575757355261637863805587906227228163275557375159769599033632918292482002186641475268486598023281100659643528846513898847919251032731261718358900479488287933293278745715922865499005559197328388506945134386346185262919258658109015074718441639029135304654725637911172671711310801418648, - - ?line Key = 12603618348903387232593303690286336220738319446775939686476278478034365380027994899970214309288018488811754534229198764622077544117034174589418477472887827980332636062691833965078594576024299807057520016043084384987871640003684704483975314128362610573625803532737054022545217931847268776098203204571431581966, - - ValidKey = [crypto:mpint(P_p), - crypto:mpint(Q_p), - crypto:mpint(G_p), - crypto:mpint(Key) - ], - - ?line m(my_dss_verify(sized_binary(Msg), sized_binary(SigBlob), - ValidKey), true), - - BadMsg = one_bit_wrong(Msg), - ?line m(my_dss_verify(sized_binary(BadMsg), sized_binary(SigBlob), - ValidKey), false), - BadSig = one_bit_wrong(SigBlob), - ?line m(my_dss_verify(sized_binary(Msg), sized_binary(BadSig), - ValidKey), false), - SizeErr = size(SigBlob) - 13, - - BadArg = (catch my_dss_verify(sized_binary(Msg), <<SizeErr:32, SigBlob/binary>>, - ValidKey)), - ?line m(element(1,element(2,BadArg)), badarg), - - InValidKey = [crypto:mpint(P_p), - crypto:mpint(Q_p), - crypto:mpint(G_p), - crypto:mpint(Key+17) +%%-------------------------------------------------------------------- +%% Test data ------------------------------------------------ +%%-------------------------------------------------------------------- +group_config(md4 = Type, Config) -> + Msgs = rfc_1321_msgs(), + Digests = rfc_1321_md4_digests(), + [{hash, {Type, Msgs, Digests}} | Config]; +group_config(md5 = Type, Config) -> + Msgs = rfc_1321_msgs(), + Digests = rfc_1321_md5_digests(), + Keys = rfc_2202_md5_keys(), + Data = rfc_2202_msgs(), + Hmac = rfc_2202_hmac_md5(), + [{hash, {Type, Msgs, Digests}}, {hmac, {Type, Keys, Data, Hmac}} | Config]; +group_config(ripemd160 = Type, Config) -> + Msgs = ripemd160_msgs(), + Digests = ripemd160_digests(), + [{hash, {Type, Msgs, Digests}} | Config]; +group_config(sha = Type, Config) -> + Msgs = [rfc_4634_test1(), rfc_4634_test2_1()], + Digests = rfc_4634_sha_digests(), + Keys = rfc_2202_sha_keys(), + Data = rfc_2202_msgs(), + Hmac = rfc_2202_hmac_sha(), + [{hash, {Type, Msgs, Digests}}, {hmac, {Type, Keys, Data, Hmac}} | Config]; +group_config(sha224 = Type, Config) -> + Msgs = [rfc_4634_test1(), rfc_4634_test2_1()], + Digests = rfc_4634_sha224_digests(), + Keys = rfc_4231_keys(), + Data = rfc_4231_msgs(), + Hmac = rfc4231_hmac_sha224(), + [{hash, {Type, Msgs, Digests}}, {hmac, {Type, Keys, Data, Hmac}} | Config]; +group_config(sha256 = Type, Config) -> + Msgs = [rfc_4634_test1(), rfc_4634_test2_1()], + Digests = rfc_4634_sha256_digests(), + Keys = rfc_4231_keys(), + Data = rfc_4231_msgs(), + Hmac = rfc4231_hmac_sha256(), + [{hash, {Type, Msgs, Digests}}, {hmac, {Type, Keys, Data, Hmac}} | Config]; +group_config(sha384 = Type, Config) -> + Msgs = [rfc_4634_test1(), rfc_4634_test2()], + Digests = rfc_4634_sha384_digests(), + Keys = rfc_4231_keys(), + Data = rfc_4231_msgs(), + Hmac = rfc4231_hmac_sha384(), + [{hash, {Type, Msgs, Digests}}, {hmac, {Type, Keys, Data, Hmac}} | Config]; +group_config(sha512 = Type, Config) -> + Msgs = [rfc_4634_test1(), rfc_4634_test2()], + Digests = rfc_4634_sha512_digests(), + Keys = rfc_4231_keys(), + Data = rfc_4231_msgs(), + Hmac = rfc4231_hmac_sha512(), + [{hash, {Type, Msgs, Digests}}, {hmac, {Type, Keys, Data, Hmac}} | Config]; +group_config(rsa = Type, Config) -> + Msg = rsa_plain(), + Public = rsa_public(), + Private = rsa_private(), + 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_oaep(), + no_padding() ], - - ?line m(my_dss_verify(sized_binary(Msg), sized_binary(SigBlob), - InValidKey), false). - - -one_bit_wrong(List) when is_list(List) -> - lists:map(fun(Bin) -> one_bit_wrong(Bin) end, List); -one_bit_wrong(Bin) -> - Half = size(Bin) div 2, - <<First:Half/binary, Byte:8, Last/binary>> = Bin, - <<First/binary, (Byte+1):8, Last/binary>>. - - -%% -%% Sign tests - -rsa_sign_test(doc) -> - "rsa_sign testing"; -rsa_sign_test(suite) -> - []; -rsa_sign_test(Config) when is_list(Config) -> - PubEx = 65537, - PrivEx = 7531712708607620783801185371644749935066152052780368689827275932079815492940396744378735701395659435842364793962992309884847527234216715366607660219930945, - Mod = 7919488123861148172698919999061127847747888703039837999377650217570191053151807772962118671509138346758471459464133273114654252861270845708312601272799123, - Msg = <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" - "09812312908312378623487263487623412039812 huagasd">>, - - PrivKey = [crypto:mpint(PubEx), crypto:mpint(Mod), crypto:mpint(PrivEx)], - PubKey = [crypto:mpint(PubEx), crypto:mpint(Mod)], - ?line Sig1 = crypto:rsa_sign(sized_binary(Msg), PrivKey), - ?line m(crypto:rsa_verify(sized_binary(Msg), sized_binary(Sig1),PubKey), true), - - ?line Sig2 = crypto:rsa_sign(md5, sized_binary(Msg), PrivKey), - ?line m(crypto:rsa_verify(md5, sized_binary(Msg), sized_binary(Sig2),PubKey), true), - - ?line m(Sig1 =:= Sig2, false), - ?line m(crypto:rsa_verify(md5, sized_binary(Msg), sized_binary(Sig1),PubKey), false), - ?line m(crypto:rsa_verify(sha, sized_binary(Msg), sized_binary(Sig1),PubKey), true), - - ok. - -rsa_sign_hash_test(doc) -> - "rsa_sign_hash testing"; -rsa_sign_hash_test(suite) -> - []; -rsa_sign_hash_test(Config) when is_list(Config) -> - PubEx = 65537, - PrivEx = 7531712708607620783801185371644749935066152052780368689827275932079815492940396744378735701395659435842364793962992309884847527234216715366607660219930945, - Mod = 7919488123861148172698919999061127847747888703039837999377650217570191053151807772962118671509138346758471459464133273114654252861270845708312601272799123, - Msg = <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" - "09812312908312378623487263487623412039812 huagasd">>, - - PrivKey = [crypto:mpint(PubEx), crypto:mpint(Mod), crypto:mpint(PrivEx)], - PubKey = [crypto:mpint(PubEx), crypto:mpint(Mod)], - MD5 = crypto:md5(sized_binary(Msg)), - SHA = crypto:sha(sized_binary(Msg)), - ?line Sig1 = crypto:rsa_sign(sha, {digest,SHA}, PrivKey), - ?line m(crypto:rsa_verify(sha, {digest,SHA}, sized_binary(Sig1),PubKey), true), - - ?line Sig2 = crypto:rsa_sign(md5, {digest,MD5}, PrivKey), - ?line m(crypto:rsa_verify(md5, {digest,MD5}, sized_binary(Sig2),PubKey), true), - - ?line m(Sig1 =:= Sig2, false), - ?line m(crypto:rsa_verify(md5, {digest,MD5}, sized_binary(Sig1),PubKey), false), - ?line m(crypto:rsa_verify(sha, {digest,SHA}, sized_binary(Sig2),PubKey), false), - - ok. - -dsa_sign_test(doc) -> - "dsa_sign testing"; -dsa_sign_test(suite) -> - []; -dsa_sign_test(Config) when is_list(Config) -> - Msg = <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" - "09812312908312378623487263487623412039812 huagasd">>, - - PubKey = _Y = 25854665488880835237281628794585130313500176551981812527054397586638455298000483144002221850980183404910190346416063318160497344811383498859129095184158800144312512447497510551471331451396405348497845813002058423110442376886564659959543650802132345311573634832461635601376738282831340827591903548964194832978, - PrivKey = _X = 441502407453038284293378221372000880210588566361, - ParamP = 109799869232806890760655301608454668257695818999841877165019612946154359052535682480084145133201304812979481136659521529774182959764860329095546511521488413513097576425638476458000255392402120367876345280670101492199681798674053929238558140260669578407351853803102625390950534052428162468100618240968893110797, - ParamQ = 1349199015905534965792122312016505075413456283393, - ParamG = 18320614775012672475365915366944922415598782131828709277168615511695849821411624805195787607930033958243224786899641459701930253094446221381818858674389863050420226114787005820357372837321561754462061849169568607689530279303056075793886577588606958623645901271866346406773590024901668622321064384483571751669, - - Params = [crypto:mpint(ParamP), crypto:mpint(ParamQ), crypto:mpint(ParamG)], - ?line Sig1 = my_dss_sign(sized_binary(Msg), Params ++ [crypto:mpint(PrivKey)]), - - ?line m(my_dss_verify(sized_binary(Msg), Sig1, - Params ++ [crypto:mpint(PubKey)]), true), - - ?line m(my_dss_verify(sized_binary(one_bit_wrong(Msg)), Sig1, - Params ++ [crypto:mpint(PubKey)]), false), - - ?line m(my_dss_verify(sized_binary(Msg), one_bit_wrong(Sig1), - Params ++ [crypto:mpint(PubKey)]), false), - - %%?line Bad = crypto:dss_sign(sized_binary(Msg), [Params, crypto:mpint(PubKey)]), - - ok. - -dsa_sign_hash_test(doc) -> - "dsa_sign_hash testing"; -dsa_sign_hash_test(suite) -> - []; -dsa_sign_hash_test(Config) when is_list(Config) -> - Msg = <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" - "09812312908312378623487263487623412039812 huagasd">>, - SHA = crypto:sha(sized_binary(Msg)), - - PubKey = _Y = 25854665488880835237281628794585130313500176551981812527054397586638455298000483144002221850980183404910190346416063318160497344811383498859129095184158800144312512447497510551471331451396405348497845813002058423110442376886564659959543650802132345311573634832461635601376738282831340827591903548964194832978, - PrivKey = _X = 441502407453038284293378221372000880210588566361, - ParamP = 109799869232806890760655301608454668257695818999841877165019612946154359052535682480084145133201304812979481136659521529774182959764860329095546511521488413513097576425638476458000255392402120367876345280670101492199681798674053929238558140260669578407351853803102625390950534052428162468100618240968893110797, - ParamQ = 1349199015905534965792122312016505075413456283393, - ParamG = 18320614775012672475365915366944922415598782131828709277168615511695849821411624805195787607930033958243224786899641459701930253094446221381818858674389863050420226114787005820357372837321561754462061849169568607689530279303056075793886577588606958623645901271866346406773590024901668622321064384483571751669, - - Params = [crypto:mpint(ParamP), crypto:mpint(ParamQ), crypto:mpint(ParamG)], - ?line Sig1 = crypto:dss_sign(sha, {digest,SHA}, Params ++ [crypto:mpint(PrivKey)]), - - ?line m(crypto:dss_verify(none, SHA, sized_binary(Sig1), - Params ++ [crypto:mpint(PubKey)]), true), - - ?line m(crypto:dss_verify(sized_binary(one_bit_wrong(Msg)), sized_binary(Sig1), - Params ++ [crypto:mpint(PubKey)]), false), - - ?line m(crypto:dss_verify(sized_binary(Msg), sized_binary(one_bit_wrong(Sig1)), - Params ++ [crypto:mpint(PubKey)]), false), - - %%?line Bad = crypto:dss_sign(sized_binary(Msg), [Params, crypto:mpint(PubKey)]), - - ok. - - -rsa_encrypt_decrypt(doc) -> - ["Test rsa_public_encrypt and rsa_private_decrypt functions."]; -rsa_encrypt_decrypt(suite) -> []; -rsa_encrypt_decrypt(Config) when is_list(Config) -> - PubEx = 65537, - PrivEx = 7531712708607620783801185371644749935066152052780368689827275932079815492940396744378735701395659435842364793962992309884847527234216715366607660219930945, - Mod = 7919488123861148172698919999061127847747888703039837999377650217570191053151807772962118671509138346758471459464133273114654252861270845708312601272799123, - - PrivKey = [crypto:mpint(PubEx), crypto:mpint(Mod), crypto:mpint(PrivEx)], - PubKey = [crypto:mpint(PubEx), crypto:mpint(Mod)], - - Msg = <<"7896345786348 Asldi">>, + [{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config]; +group_config(dss = Type, Config) -> + Msg = dss_plain(), + Public = dss_params() ++ [dss_public()], + Private = dss_params() ++ [dss_private()], + SignVerify = [{Type, sha, Public, Private, Msg}], + [{sign_verify, SignVerify} | Config]; + +group_config(ecdsa = Type, Config) -> + {Private, Public} = ec_key_named(), + Msg = ec_msg(), + SignVerify = [{Type, sha, Public, Private, Msg}], + [{sign_verify, SignVerify} | Config]; +group_config(srp, Config) -> + GenerateCompute = [srp3(), srp6(), srp6a()], + [{generate_compute, GenerateCompute} | Config]; +group_config(ecdh, Config) -> + Compute = [ecdh()], + [{compute, Compute} | Config]; +group_config(dh, Config) -> + GenerateCompute = [dh()], + [{generate_compute, GenerateCompute} | Config]; +group_config(des_cbc, Config) -> + Block = des_cbc(), + [{block, Block} | Config]; +group_config(des_cfb, Config) -> + Block = des_cfb(), + [{block, Block} | Config]; +group_config(des3_cbc, Config) -> + Block = des3_cbc(), + [{block, Block} | 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]; +group_config(aes_cbc128, Config) -> + Block = aes_cbc128(), + [{block, Block} | Config]; +group_config(aes_cbc256, Config) -> + Block = aes_cbc256(), + [{block, Block} | Config]; +group_config(aes_cfb128, Config) -> + Block = aes_cfb128(), + [{block, Block} | Config]; +group_config(blowfish_cbc, Config) -> + Block = blowfish_cbc(), + [{block, Block} | Config]; +group_config(blowfish_ecb, Config) -> + Block = blowfish_ecb(), + [{block, Block} | Config]; +group_config(blowfish_cfb64, Config) -> + Block = blowfish_cfb64(), + [{block, Block} | Config]; +group_config(blowfish_ofb64, Config) -> + Block = blowfish_ofb64(), + [{block, Block} | Config]; +group_config(rc4, Config) -> + Stream = rc4(), + [{stream, Stream} | Config]; +group_config(aes_ctr, Config) -> + Stream = aes_ctr(), + [{stream, Stream} | Config]; +group_config(_, Config) -> + Config. - ?line PKCS1 = crypto:rsa_public_encrypt(Msg, PubKey, rsa_pkcs1_padding), - ?line PKCS1Dec = crypto:rsa_private_decrypt(PKCS1, PrivKey, rsa_pkcs1_padding), - io:format("PKCS1Dec ~p~n",[PKCS1Dec]), - ?line Msg = PKCS1Dec, - - ?line OAEP = crypto:rsa_public_encrypt(Msg, PubKey, rsa_pkcs1_oaep_padding), - ?line Msg = crypto:rsa_private_decrypt(OAEP, PrivKey, rsa_pkcs1_oaep_padding), - - <<Msg2Len:32,_/binary>> = crypto:mpint(Mod), - Msg2 = list_to_binary(lists:duplicate(Msg2Len-1, $X)), - ?line NoPad = crypto:rsa_public_encrypt(Msg2, PubKey, rsa_no_padding), - ?line NoPadDec = crypto:rsa_private_decrypt(NoPad, PrivKey, rsa_no_padding), - ?line NoPadDec = Msg2, - - ShouldBeError = (catch crypto:rsa_public_encrypt(Msg, PubKey, rsa_no_padding)), - ?line {'EXIT', {encrypt_failed,_}} = ShouldBeError, - -%% ?line SSL = crypto:rsa_public_encrypt(Msg, PubKey, rsa_sslv23_padding), -%% ?line Msg = crypto:rsa_private_decrypt(SSL, PrivKey, rsa_sslv23_padding), - - ?line PKCS1_2 = crypto:rsa_private_encrypt(Msg, PrivKey, rsa_pkcs1_padding), - ?line PKCS1_2Dec = crypto:rsa_public_decrypt(PKCS1_2, PubKey, rsa_pkcs1_padding), - io:format("PKCS2Dec ~p~n",[PKCS1_2Dec]), - ?line Msg = PKCS1_2Dec, - - ?line PKCS1_3 = crypto:rsa_private_encrypt(Msg2, PrivKey, rsa_no_padding), - ?line PKCS1_3Dec = crypto:rsa_public_decrypt(PKCS1_3, PubKey, rsa_no_padding), - io:format("PKCS2Dec ~p~n",[PKCS1_3Dec]), - ?line Msg2 = PKCS1_3Dec, +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">>, + <<"abc">>, + <<"message digest">>, + <<"abcdefghijklmnopqrstuvwxyz">>, + <<"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789">>, + <<"12345678901234567890123456789012345678901234567890123456789012345678901234567890">> + ]. + +rfc_1321_md4_digests() -> + [hexstr2bin("31d6cfe0d16ae931b73c59d7e0c089c0"), + hexstr2bin("bde52cb31de33e46245e05fbdbd6fb24"), + hexstr2bin("a448017aaf21d8525fc10ae87aa6729d"), + hexstr2bin("d9130a8164549fe818874806e1c7014b"), + hexstr2bin("d79e1c308aa5bbcdeea8ed63df412da9"), + hexstr2bin("043f8582f241db351ce627e153e7f0e4"), + hexstr2bin("e33b4ddc9c38f2199c3e7b164fcc0536")]. + +rfc_1321_md5_digests() -> + [hexstr2bin("d41d8cd98f00b204e9800998ecf8427e"), + hexstr2bin("0cc175b9c0f1b6a831c399e269772661"), + hexstr2bin("900150983cd24fb0d6963f7d28e17f72"), + hexstr2bin("f96b697d7cb7938d525a2f31aaf161d0"), + hexstr2bin("c3fcd3d76192e4007dfb496cca67e13b"), + hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f"), + hexstr2bin("57edf4a22be3c955ac49da2e2107b67a")]. + +rfc_4634_test1() -> + <<"abc">>. +rfc_4634_test2_1() -> + <<"abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq">>. +rfc_4634_test2_2a() -> + <<"abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn">>. +rfc_4634_test2_2b() -> + <<"hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu">>. +rfc_4634_test2() -> + A2 =rfc_4634_test2_2a(), + B2 = rfc_4634_test2_2b(), + <<A2/binary, B2/binary>>. + +rfc_4634_sha_digests()-> + [hexstr2bin("A9993E364706816ABA3E25717850C26C9CD0D89D"), + hexstr2bin("84983E441C3BD26EBAAE4AA1F95129E5E54670F1")]. +rfc_4634_sha224_digests() -> + [hexstr2bin("23097D223405D8228642A477BDA255B32AADBCE4BDA0B3F7E36C9DA7"), + hexstr2bin("75388B16512776CC5DBA5DA1FD890150B0C6455CB4F58B1952522525")]. +rfc_4634_sha256_digests() -> + [ + hexstr2bin("BA7816BF8F01CFEA4141" + "40DE5DAE2223B00361A396177A9CB410FF61F20015AD"), + hexstr2bin("248D6A61D20638B8" + "E5C026930C3E6039A33CE45964FF2167F6ECEDD419DB06C1") + ]. +rfc_4634_sha384_digests() -> + [hexstr2bin("CB00753F45A35E8BB5A03D699AC65007272C32AB0EDED1631A8B605A43FF5BED8086072BA1E7CC2358BAECA134C825A7"), + hexstr2bin("09330C33F71147E83D192FC782CD1B4753111B173B3B05D22FA08086E3B0F712FCC7C71A557E2DB966C3E9FA91746039") + ]. +rfc_4634_sha512_digests() -> + [hexstr2bin("DDAF35A193617ABACC417349AE20413112E6FA4E89A97EA2" + "0A9EEEE64B55D39A2192992A274FC1A836BA3C23A3FEEBBD" + "454D4423643CE80E2A9AC94FA54CA49F"), + hexstr2bin("8E959B75DAE313DA8CF4F72814FC143F8F7779C6EB9F7FA17299AEADB6889018501D289E4900F7E4331B99DEC4B5433AC7D329EEB6DD26545E96E55B874BE909")]. + +ripemd160_msgs() -> + [<<"">>, + <<"a">>, + <<"abc">>, + <<"message digest">>, + <<"abcdefghijklmnopqrstuvwxyz">>, + <<"abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq">>, + <<"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789">> + ]. + +ripemd160_digests() -> + [hexstr2bin("9c1185a5c5e9fc54612808977ee8f548b2258d31"), + hexstr2bin("0bdc9d2d256b3ee9daae347be6f4dc835a467ffe"), + hexstr2bin("8eb208f7e05d987a9b044a8e98c6b087f15a0bfc"), + hexstr2bin("5d0689ef49d2fae572b881b123a85ffa21595f36"), + hexstr2bin("f71c27109c692c1b56bbdceb5b9d2865b3708dbc"), + hexstr2bin("12a053384a9c0c88e405a06c27dcf49ada62eb2b"), + hexstr2bin("b0e20b6e3116640286ed3a87a5713079b21f5189") + ]. + +ripemd160_incr_msgs() -> + [<<"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefg">>,<<"hijklmnopqrstuvwxyz0123456789">>]. +ripemd160_incr_digest() -> + hexstr2bin("b0e20b6e3116640286ed3a87a5713079b21f5189"). + +rfc_2202_md5_keys() -> + [binary:copy(<<16#0b>>, 16), + <<"Jefe">>, + binary:copy(<<16#aa>>, 16), + list_to_binary(lists:seq(1, 16#19)), + binary:copy(<<16#0c>>, 16), + binary:copy(<<16#aa>>, 80), + binary:copy(<<16#aa>>, 80)]. + +rfc_2202_sha_keys() -> + [binary:copy(<<16#0b>>, 20), + <<"Jefe">>, + binary:copy(<<16#aa>>, 20), + list_to_binary(lists:seq(1, 16#19)), + binary:copy(<<16#0c>>, 20), + binary:copy(<<16#aa>>, 80), + binary:copy(<<16#aa>>, 80)]. + +rfc_2202_msgs()-> + [<<"Hi There">>, + <<"what do ya want for nothing?">>, + binary:copy(<<16#dd>>, 50), + binary:copy(<<16#cd>>, 50), + <<"Test With Truncation">>, + <<"Test Using Larger Than Block-Size Key - Hash Key First">>, + <<"Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data">> + ]. + +hmac_key(md5) -> + [<<"A fine speach">>, <<"by a fine man!">>]; +hmac_key(_) -> + hexstr2bin("00010203101112132021222330313233" + "04050607141516172425262734353637" + "08090a0b18191a1b28292a2b38393a3b" + "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"). +hmac_inc(_) -> + [<<"Sampl">>, <<"e #1">>]. + +rfc_2202_hmac_md5() -> + [ + hexstr2bin("9294727a3638bb1c13f48ef8158bfc9d"), + hexstr2bin("750c783e6ab0b503eaa86e310a5db738"), + hexstr2bin("56be34521d144c88dbb8c733f0e8b3f6"), + hexstr2bin("697eaf0aca3a3aea3a75164746ffaa79"), + hexstr2bin("56461ef2342edc00f9bab995690efd4c"), + hexstr2bin("6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"), + hexstr2bin("6f630fad67cda0ee1fb1f562db3aa53e") + ]. + +rfc_2202_hmac_sha() -> + [ + hexstr2bin("b617318655057264e28bc0b6fb378c8ef146be00"), + hexstr2bin("effcdf6ae5eb2fa2d27416d5f184df9c259a7c79"), + hexstr2bin("125d7342b9ac11cd91a39af48aa17b4f63f175d3"), + hexstr2bin("4c9007f4026250c6bc8414f9bf50c86c2d7235da"), + hexstr2bin("4c1a03424b55e07fe7f27be1d58bb9324a9a5a04"), + hexstr2bin("aa4ae5e15272d00e95705637ce8a3b55ed402112"), + hexstr2bin("e8e99d0f45237d786d6bbaa7965c7808bbff1a91") + ]. + + +rfc_4231_keys() -> + [binary:copy(<<16#0b>>, 20), + <<"Jefe">>, + binary:copy(<<16#aa>>, 20), + list_to_binary(lists:seq(1, 16#19)), + binary:copy(<<16#0c>>, 20), + binary:copy(<<16#aa>>, 131), + binary:copy(<<16#aa>>, 131) + ]. - ?line {'EXIT', {encrypt_failed,_}} = - (catch crypto:rsa_private_encrypt(Msg, PrivKey, rsa_no_padding)), +rfc_4231_msgs() -> + [<<"Hi There">>, + <<"what do ya want for nothing?">>, + binary:copy(<<16#dd>>, 50), + binary:copy(<<16#cd>>, 50), + <<"Test With Truncation">>, + <<"Test Using Larger Than Block-Size Key - Hash Key First">>, + <<"This is a test using a larger than block-size key and a larger t", + "han block-size data. The key needs to be hashed before being use", + "d by the HMAC algorithm.">> + ]. - ok. - - -dh(doc) -> - ["Test dh (Diffie-Hellman) functions."]; -dh(suite) -> []; -dh(Config) when is_list(Config) -> - Self = self(), - GenP = fun() -> - %% Gen Param may take arbitrary long time to finish - %% That's not a bug in erlang crypto application. - ?line DHPs = crypto:dh_generate_parameters(512,2), - ?line ok = crypto:dh_check(DHPs), - Self ! {param, DHPs} - end, - Pid = spawn(GenP), - receive - {param, DHPs} -> - timer:sleep(100), - io:format("DHP ~p~n", [DHPs]), - ?line {Pub1,Priv1} = crypto:dh_generate_key(DHPs), - io:format("Key1:~n~p~n~p~n~n", [Pub1,Priv1]), - ?line {Pub2,Priv2} = crypto:dh_generate_key(DHPs), - io:format("Key2:~n~p~n~p~n~n", [Pub2,Priv2]), - ?line A = crypto:dh_compute_key(Pub1, Priv2, DHPs), - timer:sleep(100), %% Get another thread see if that triggers problem - ?line B = crypto:dh_compute_key(Pub2, Priv1, DHPs), - io:format("A ~p~n",[A]), - io:format("B ~p~n",[B]), - ?line A = B - after 50000 -> - io:format("Killing Param generation which took to long ~p~n",[Pid]), - exit(Pid, kill) - end. - -srp3(doc) -> - ["SRP-3 test vectors generated by http://srp.stanford.edu/demo/demo.html"]; -srp3(suite) -> []; -srp3(Config) when is_list(Config) -> +rfc4231_hmac_sha224() -> + [hexstr2bin("896fb1128abbdf196832107cd49df33f" + "47b4b1169912ba4f53684b22"), + hexstr2bin("a30e01098bc6dbbf45690f3a7e9e6d0f" + "8bbea2a39e6148008fd05e44"), + hexstr2bin("7fb3cb3588c6c1f6ffa9694d7d6ad264" + "9365b0c1f65d69d1ec8333ea"), + hexstr2bin("6c11506874013cac6a2abc1bb382627c" + "ec6a90d86efc012de7afec5a"), + hexstr2bin("0e2aea68a90c8d37c988bcdb9fca6fa8"), + hexstr2bin("95e9a0db962095adaebe9b2d6f0dbce2" + "d499f112f2d2b7273fa6870e"), + hexstr2bin("3a854166ac5d9f023f54d517d0b39dbd" + "946770db9c2b95c9f6f565d1")]. +rfc4231_hmac_sha256() -> + [hexstr2bin("b0344c61d8db38535ca8afceaf0bf12b" + "881dc200c9833da726e9376c2e32cff7"), + hexstr2bin("5bdcc146bf60754e6a042426089575c7" + "5a003f089d2739839dec58b964ec3843"), + hexstr2bin("773ea91e36800e46854db8ebd09181a7" + "2959098b3ef8c122d9635514ced565fe"), + hexstr2bin("82558a389a443c0ea4cc819899f2083a" + "85f0faa3e578f8077a2e3ff46729665b"), + hexstr2bin("a3b6167473100ee06e0c796c2955552b"), + hexstr2bin("60e431591ee0b67f0d8a26aacbf5b77f" + "8e0bc6213728c5140546040f0ee37f54"), + hexstr2bin("9b09ffa71b942fcb27635fbcd5b0e944" + "bfdc63644f0713938a7f51535c3a35e2")]. + +rfc4231_hmac_sha384() -> + [hexstr2bin("afd03944d84895626b0825f4ab46907f" + "15f9dadbe4101ec682aa034c7cebc59c" + "faea9ea9076ede7f4af152e8b2fa9cb6"), + hexstr2bin("af45d2e376484031617f78d2b58a6b1b" + "9c7ef464f5a01b47e42ec3736322445e" + "8e2240ca5e69e2c78b3239ecfab21649"), + hexstr2bin("88062608d3e6ad8a0aa2ace014c8a86f" + "0aa635d947ac9febe83ef4e55966144b" + "2a5ab39dc13814b94e3ab6e101a34f27"), + hexstr2bin("3e8a69b7783c25851933ab6290af6ca7" + "7a9981480850009cc5577c6e1f573b4e" + "6801dd23c4a7d679ccf8a386c674cffb"), + hexstr2bin("3abf34c3503b2a23a46efc619baef897"), + hexstr2bin("4ece084485813e9088d2c63a041bc5b4" + "4f9ef1012a2b588f3cd11f05033ac4c6" + "0c2ef6ab4030fe8296248df163f44952"), + hexstr2bin("6617178e941f020d351e2f254e8fd32c" + "602420feb0b8fb9adccebb82461e99c5" + "a678cc31e799176d3860e6110c46523e")]. +rfc4231_hmac_sha512() -> + [hexstr2bin("87aa7cdea5ef619d4ff0b4241a1d6cb0" + "2379f4e2ce4ec2787ad0b30545e17cde" + "daa833b7d6b8a702038b274eaea3f4e4" + "be9d914eeb61f1702e696c203a126854"), + hexstr2bin("164b7a7bfcf819e2e395fbe73b56e0a3" + "87bd64222e831fd610270cd7ea250554" + "9758bf75c05a994a6d034f65f8f0e6fd" + "caeab1a34d4a6b4b636e070a38bce737"), + hexstr2bin("fa73b0089d56a284efb0f0756c890be9" + "b1b5dbdd8ee81a3655f83e33b2279d39" + "bf3e848279a722c806b485a47e67c807" + "b946a337bee8942674278859e13292fb"), + hexstr2bin("b0ba465637458c6990e5a8c5f61d4af7" + "e576d97ff94b872de76f8050361ee3db" + "a91ca5c11aa25eb4d679275cc5788063" + "a5f19741120c4f2de2adebeb10a298dd"), + hexstr2bin("415fad6271580a531d4179bc891d87a6"), + hexstr2bin("80b24263c7c1a3ebb71493c1dd7be8b4" + "9b46d1f41b4aeec1121b013783f8f352" + "6b56d037e05f2598bd0fd2215d6a1e52" + "95e64f73f63f0aec8b915a985d786598"), + hexstr2bin("e37b6a775dc87dbaa4dfa9f96e5e3ffd" + "debd71f8867289865df5a32d20cdc944" + "b6022cac3c4982b10d5eeb55c3e4de15" + "134676fb6de0446065c97440fa8c6a58")]. +des_cbc() -> + [{des_cbc, + hexstr2bin("0123456789abcdef"), + hexstr2bin("1234567890abcdef"), + <<"Now is the time for all ">> }]. + +des_cfb() -> + [{des_cfb, + hexstr2bin("0123456789abcdef"), + hexstr2bin("1234567890abcdef"), + <<"Now is the">>}]. + +des3_cbc() -> + [{des3_cbc, + [hexstr2bin("0123456789abcdef"), + hexstr2bin("fedcba9876543210"), + hexstr2bin("0f2d4b6987a5c3e1")], + hexstr2bin("1234567890abcdef"), + <<"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"), + hexstr2bin("fedcba9876543210"), + hexstr2bin("0f2d4b6987a5c3e1")], + hexstr2bin("1234567890abcdef"), + <<"Now is the time for all ">> + }]. + +rc2_cbc() -> + [{rc2_cbc, + <<146,210,160,124,215,227,153,239,227,17,222,140,3,93,27,191>>, + <<72,91,135,182,25,42,35,210>>, + <<36,245,206,158,168,230,58,69,148,137,32,192,250,41,237,181,181,251, 192,2,175,135,177,171,57,30,111,117,159,149,15,28,88,158,28,81,28,115, 85,219,241,82,117,222,91,85,73,117,164,25,182,52,191,64,123,57,26,19, 211,27,253,31,194,219,231,104,247,240,172,130,119,21,225,154,101,247, 32,216,42,216,133,169,78,22,97,27,227,26,196,224,172,168,17,9,148,55, 203,91,252,40,61,226,236,221,215,160,78,63,13,181,68,57,196,241,185, 207, 116,129,152,237,60,139,247,153,27,146,161,246,222,98,185,222,152, 187,135, 236,86,34,7,110,91,230,173,34,160,242,202,222,121,127,181,140, 101,203,195, 190,88,250,86,147,127,87,72,126,171,16,71,47,110,248,88, 14,29,143,161,152, 129,236,148,22,152,186,208,119,70,8,174,193,203,100, 193,203,200,117,102,242, 134,142,96,125,135,200,217,190,76,117,50,70, 209,186,101,241,200,91,40,193,54, 90,195,38,47,59,197,38,234,86,223,16, 51,253,204,129,20,171,66,21,241,26,135,216, 196,114,110,91,15,53,40, 164,201,136,113,95,247,51,181,208,241,68,168,98,151,36, 155,72,24,57, 42,191,14,125,204,10,167,214,233,138,115,125,234,121,134,227,26,247, 77,200,117,110,117,111,168,156,206,67,159,149,189,173,150,193,91,199, 216,153,22, 189,137,185,89,160,13,131,132,58,109,28,110,246,252,251,14, 232,91,38,52,29,101,188,69,123,50,0,130,178,93,73,239,118,7,77,35,59, 253,10,159,45,86,142,37,78,232,48>> + }]. +aes_cbc128() -> + [{aes_cbc128, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("000102030405060708090a0b0c0d0e0f"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_cbc128, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("7649ABAC8119B246CEE98E9B12E9197D"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_cbc128, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("5086CB9B507219EE95DB113A917678B2"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_cbc128, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("73BED6B8E3C1743B7116E69E22229516"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")} + ]. + +aes_cbc256() -> + [{aes_cbc256, + hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("000102030405060708090A0B0C0D0E0F"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_cbc256, + hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("F58C4C04D6E5F1BA779EABFB5F7BFBD6"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_cbc256, + hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("9CFC4E967EDB808D679F777BC6702C7D"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_cbc256, + hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("39F23369A9D9BACFA530E26304231461"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")} + ]. + +aes_cfb128() -> + [{aes_cfb128, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("000102030405060708090a0b0c0d0e0f"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_cfb128, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("3B3FD92EB72DAD20333449F8E83CFB4A"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_cfb128, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("C8A64537A0B3A93FCDE3CDAD9F1CE58B"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_cfb128, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("26751F67A3CBB140B1808CF187A4F4DF"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")} + ]. + +blowfish_cbc() -> + [{blowfish_cbc, + hexstr2bin("0123456789ABCDEFF0E1D2C3B4A59687"), + hexstr2bin("FEDCBA9876543210"), + hexstr2bin("37363534333231204E6F77206973207468652074696D6520666F722000000000") + }]. + +blowfish_ecb() -> + [ + {blowfish_ecb, + hexstr2bin("0000000000000000"), + hexstr2bin("0000000000000000")}, + {blowfish_ecb, + hexstr2bin("FFFFFFFFFFFFFFFF"), + hexstr2bin("FFFFFFFFFFFFFFFF")}, + {blowfish_ecb, + hexstr2bin("3000000000000000"), + hexstr2bin("1000000000000001")}, + {blowfish_ecb, + hexstr2bin("1111111111111111"), + hexstr2bin("1111111111111111")}, + {blowfish_ecb, + hexstr2bin("0123456789ABCDEF"), + hexstr2bin("1111111111111111")}, + {blowfish_ecb, + hexstr2bin("0000000000000000"), + hexstr2bin("0000000000000000")}, + {blowfish_ecb, + hexstr2bin("FEDCBA9876543210"), + hexstr2bin("0123456789ABCDEF")}, + {blowfish_ecb, + hexstr2bin("7CA110454A1A6E57"), + hexstr2bin("01A1D6D039776742")}, + {blowfish_ecb, + hexstr2bin("0131D9619DC1376E"), + hexstr2bin("5CD54CA83DEF57DA")}, + {blowfish_ecb, + hexstr2bin("07A1133E4A0B2686"), + hexstr2bin("0248D43806F67172")}, + {blowfish_ecb, + hexstr2bin("3849674C2602319E"), + hexstr2bin("51454B582DDF440A")}, + {blowfish_ecb, + hexstr2bin("04B915BA43FEB5B6"), + hexstr2bin("42FD443059577FA2")}, + {blowfish_ecb, + hexstr2bin("0113B970FD34F2CE"), + hexstr2bin("059B5E0851CF143A")}, + {blowfish_ecb, + hexstr2bin("0170F175468FB5E6"), + hexstr2bin("0756D8E0774761D2")}, + {blowfish_ecb, + hexstr2bin("43297FAD38E373FE"), + hexstr2bin("762514B829BF486A")}, + {blowfish_ecb, + hexstr2bin("07A7137045DA2A16"), + hexstr2bin("3BDD119049372802")}, + {blowfish_ecb, + hexstr2bin("04689104C2FD3B2F"), + hexstr2bin("26955F6835AF609A")}, + {blowfish_ecb, + hexstr2bin("37D06BB516CB7546"), + hexstr2bin("164D5E404F275232")}, + {blowfish_ecb, + hexstr2bin("1F08260D1AC2465E"), + hexstr2bin("6B056E18759F5CCA")}, + {blowfish_ecb, + hexstr2bin("584023641ABA6176"), + hexstr2bin("004BD6EF09176062")}, + {blowfish_ecb, + hexstr2bin("025816164629B007"), + hexstr2bin("480D39006EE762F2")}, + {blowfish_ecb, + hexstr2bin("49793EBC79B3258F"), + hexstr2bin("437540C8698F3CFA")}, + {blowfish_ecb, + hexstr2bin("018310DC409B26D6"), + hexstr2bin("1D9D5C5018F728C2")}, + {blowfish_ecb, + hexstr2bin("1C587F1C13924FEF"), + hexstr2bin("305532286D6F295A")}, + {blowfish_ecb, + hexstr2bin("0101010101010101"), + hexstr2bin("0123456789ABCDEF")}, + {blowfish_ecb, + hexstr2bin("1F1F1F1F0E0E0E0E"), + hexstr2bin("0123456789ABCDEF")}, + {blowfish_ecb, + hexstr2bin("E0FEE0FEF1FEF1FE"), + hexstr2bin("0123456789ABCDEF")}, + {blowfish_ecb, + hexstr2bin("0000000000000000"), + hexstr2bin("FFFFFFFFFFFFFFFF")}, + {blowfish_ecb, + hexstr2bin("FFFFFFFFFFFFFFFF"), + hexstr2bin("0000000000000000")}, + {blowfish_ecb, + hexstr2bin("0123456789ABCDEF"), + hexstr2bin("0000000000000000")}, + {blowfish_ecb, + hexstr2bin("FEDCBA9876543210"), + hexstr2bin("FFFFFFFFFFFFFFFF")} + ]. + +blowfish_cfb64() -> + [{blowfish_cfb64, + hexstr2bin("0123456789ABCDEFF0E1D2C3B4A59687"), + hexstr2bin("FEDCBA9876543210"), + hexstr2bin("37363534333231204E6F77206973207468652074696D6520666F722000") + }]. +blowfish_ofb64() -> + [{blowfish_ofb64, + hexstr2bin("0123456789ABCDEFF0E1D2C3B4A59687"), + hexstr2bin("FEDCBA9876543210"), + hexstr2bin("37363534333231204E6F77206973207468652074696D6520666F722000") + }]. + +rc4() -> + [{rc4, <<"apaapa">>, <<"Yo baby yo">>}, + {rc4, <<"apaapa">>, list_to_binary(lists:seq(0, 255))} + ]. + +aes_ctr() -> + [ %% F.5.3 CTR-AES192.Encrypt + {aes_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff00"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff01"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef") }, + {aes_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff02"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")}, + + %% F.5.3 CTR-AES192.Encrypt + {aes_ctr, hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_ctr, hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff00"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_ctr, hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff01"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_ctr, hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff02"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")}, + + %% F.5.5 CTR-AES256.Encrypt + {aes_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff00"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff01"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff02"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")} + ]. + +rsa_plain() -> + <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" + "09812312908312378623487263487623412039812 huagasd">>. +rsa_public() -> + [65537, 7919488123861148172698919999061127847747888703039837999377650217570191053151807772962118671509138346758471459464133273114654252861270845708312601272799123]. +rsa_private() -> + rsa_public() ++ [7531712708607620783801185371644749935066152052780368689827275932079815492940396744378735701395659435842364793962992309884847527234216715366607660219930945]. + +rsa_public_stronger() -> + [65537, 24629450921918866883077380602720734920775458960049554761386137065662137652635369332143446151320538248280934442179850504891395344346514465469955766163141133564033962851182759993807898821114734943339732032639891483186089941567854227407119560631150779000222837755424893038740314247760600374970909894211201220612920040986106639419467243909950276018045907029941478599124238353052062083560294570722081552510960894164859765695309596889747541376908786225647625736062865138957717982693312699025417086612046330464651009693307624955796202070510577399561730651967517158452930742355327167632521808183383868100102455048819375344881]. + +rsa_private_stronger() -> + rsa_public_stronger() ++ [13565232776562604620467234237694854016819673873109064019820773052201665024482754648718278717031083946624786145611240731564761987114634269887293030432042088547345315212418830656522115993209293567218379960177754901461542373481136856927955012596579314262051109321754382091434920473734937991286600905464814063189230779981494358415076362038786197620360127262110530926733754185204773610295221669711309000953136320804528874719105049753061737780710448207922456570922652651354760939379096788728229638142403068102990416717272880560951246813789730402978652924934794503277969128609831043469924881848849409122972426787999886557185]. + +dss_plain() -> + rsa_plain(). +dss_public() -> + 25854665488880835237281628794585130313500176551981812527054397586638455298000483144002221850980183404910190346416063318160497344811383498859129095184158800144312512447497510551471331451396405348497845813002058423110442376886564659959543650802132345311573634832461635601376738282831340827591903548964194832978. +dss_private() -> + 441502407453038284293378221372000880210588566361. +dss_params() -> + [109799869232806890760655301608454668257695818999841877165019612946154359052535682480084145133201304812979481136659521529774182959764860329095546511521488413513097576425638476458000255392402120367876345280670101492199681798674053929238558140260669578407351853803102625390950534052428162468100618240968893110797, + 1349199015905534965792122312016505075413456283393, + 18320614775012672475365915366944922415598782131828709277168615511695849821411624805195787607930033958243224786899641459701930253094446221381818858674389863050420226114787005820357372837321561754462061849169568607689530279303056075793886577588606958623645901271866346406773590024901668622321064384483571751669]. + +ec_key_named() -> + {D2_pub, D2_priv} = crypto:generate_key(ecdh, sect113r2), + {[D2_priv, sect113r2], [D2_pub, sect113r2]}. + +ec_msg() -> + <<99,234,6,64,190,237,201,99,80,248,58,40,70,45,149,218,5,246,242,63>>. + +srp3() -> Username = <<"alice">>, Password = <<"password123">>, Salt = hexstr2bin("2857827A19266A1F2BC6"), @@ -1889,21 +1311,12 @@ srp3(Config) when is_list(Config) -> "46ABF4FF39498DAFDD2C82924F7D7BD76CDFCE688C77D93F18A65409" "9176A9192615DC0277AE7C12F1F6A7F6563FCA11675D809AF578BDE5" "2B51E05D440B63099A017A0B45044801"), - UserPassHash = crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])]), - Verifier = crypto:mod_exp_prime(Generator, UserPassHash, Prime), - ClientPublic = crypto:mod_exp_prime(Generator, ClientPrivate, Prime), - - {ClientPublic, ClientPrivate} = crypto:srp_generate_key(Generator, Prime, Version, ClientPrivate), - {ServerPublic, ServerPrivate} = crypto:srp_generate_key(Verifier, Generator, Prime, Version, ServerPrivate), - SessionKey = crypto:srp_compute_key(UserPassHash, Prime, Generator, ClientPublic, - ClientPrivate, ServerPublic, Version, Scrambler), - SessionKey = crypto:srp_compute_key(Verifier, Prime, ClientPublic, - ServerPublic, ServerPrivate, Version, Scrambler). - -srp6(doc) -> - ["SRP-6 test vectors generated by http://srp.stanford.edu/demo/demo.html"]; -srp6(suite) -> []; -srp6(Config) when is_list(Config) -> + UserPassHash = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, Password])]), + Verifier = crypto:mod_pow(Generator, UserPassHash, Prime), + ClientPublic = crypto:mod_pow(Generator, ClientPrivate, Prime), + srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPrivate, UserPassHash, Scrambler, SessionKey). + +srp6() -> Username = <<"alice">>, Password = <<"password123">>, Salt = hexstr2bin("2857827A19266A1F2BC6"), @@ -1940,21 +1353,12 @@ srp6(Config) when is_list(Config) -> "7216F9CD8A4AC39F0429857D8D1023066614BDFCBCB89F59A0FEB81C" "72E992AAD89095A84B6A5FADA152369AB1E350A03693BEF044DF3EDF" "0C34741F4696C30E9F675D09F58ACBEB"), - UserPassHash = crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])]), - Verifier = crypto:mod_exp_prime(Generator, UserPassHash, Prime), - ClientPublic = crypto:mod_exp_prime(Generator, ClientPrivate, Prime), - - {ClientPublic, ClientPrivate} = crypto:srp_generate_key(Generator, Prime, Version, ClientPrivate), - {ServerPublic, ServerPrivate} = crypto:srp_generate_key(Verifier, Generator, Prime, Version, ServerPrivate), - SessionKey = crypto:srp_compute_key(UserPassHash, Prime, Generator, ClientPublic, - ClientPrivate, ServerPublic, Version, Scrambler), - SessionKey = crypto:srp_compute_key(Verifier, Prime, ClientPublic, - ServerPublic, ServerPrivate, Version, Scrambler). - -srp6a(doc) -> - ["SRP-6a test vectors from RFC5054."]; -srp6a(suite) -> []; -srp6a(Config) when is_list(Config) -> + UserPassHash = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, Password])]), + Verifier = crypto:mod_pow(Generator, UserPassHash, Prime), + ClientPublic = crypto:mod_pow(Generator, ClientPrivate, Prime), + srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPrivate, UserPassHash, Scrambler, SessionKey). + +srp6a() -> Username = <<"alice">>, Password = <<"password123">>, Salt = hexstr2bin("BEB25379D1A8581EB5A727673A2441EE"), @@ -1976,275 +1380,70 @@ srp6a(Config) when is_list(Config) -> ServerPrivate = hexstr2bin("E487CB59D31AC550471E81F00F6928E01DDA08E974A004F49E61F5D1" "05284D20"), ClientPublic = hexstr2bin("61D5E490F6F1B79547B0704C436F523DD0E560F0C64115BB72557EC4" - "4352E8903211C04692272D8B2D1A5358A2CF1B6E0BFCF99F921530EC" - "8E39356179EAE45E42BA92AEACED825171E1E8B9AF6D9C03E1327F44" - "BE087EF06530E69F66615261EEF54073CA11CF5858F0EDFDFE15EFEA" - "B349EF5D76988A3672FAC47B0769447B"), + "4352E8903211C04692272D8B2D1A5358A2CF1B6E0BFCF99F921530EC" + "8E39356179EAE45E42BA92AEACED825171E1E8B9AF6D9C03E1327F44" + "BE087EF06530E69F66615261EEF54073CA11CF5858F0EDFDFE15EFEA" + "B349EF5D76988A3672FAC47B0769447B"), ServerPublic = hexstr2bin("BD0C61512C692C0CB6D041FA01BB152D4916A1E77AF46AE105393011" - "BAF38964DC46A0670DD125B95A981652236F99D9B681CBF87837EC99" - "6C6DA04453728610D0C6DDB58B318885D7D82C7F8DEB75CE7BD4FBAA" - "37089E6F9C6059F388838E7A00030B331EB76840910440B1B27AAEAE" - "EB4012B7D7665238A8E3FB004B117B58"), - + "BAF38964DC46A0670DD125B95A981652236F99D9B681CBF87837EC99" + "6C6DA04453728610D0C6DDB58B318885D7D82C7F8DEB75CE7BD4FBAA" + "37089E6F9C6059F388838E7A00030B331EB76840910440B1B27AAEAE" + "EB4012B7D7665238A8E3FB004B117B58"), + SessionKey = hexstr2bin("B0DC82BABCF30674AE450C0287745E7990A3381F63B387AAF271A10D" "233861E359B48220F7C4693C9AE12B0A6F67809F0876E2D013800D6C" "41BB59B6D5979B5C00A172B4A2A5903A0BDCAF8A709585EB2AFAFA8F" "3499B200210DCC1F10EB33943CD67FC88A2F39A4BE5BEC4EC0A3212D" "C346D7E474B29EDE8A469FFECA686E5A"), - UserPassHash = crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])]), - Verifier = crypto:mod_exp_prime(Generator, UserPassHash, Prime), - - {ClientPublic, ClientPrivate} = crypto:srp_generate_key(Generator, Prime, Version, ClientPrivate), - {ServerPublic, ServerPrivate} = crypto:srp_generate_key(Verifier, Generator, Prime, Version, ServerPrivate), - - SessionKey = crypto:srp_compute_key(UserPassHash, Prime, Generator, ClientPublic, - ClientPrivate, ServerPublic, Version, Scrambler), - SessionKey = crypto:srp_compute_key(Verifier, Prime, ClientPublic, - ServerPublic, ServerPrivate, Version, Scrambler). - -%% -%% -exor_test(doc) -> - ["Test the exor function."]; -exor_test(suite) -> - []; -exor_test(Config) when is_list(Config) -> - B = <<1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>, - Z1 = zero_bin(B), - Z1 = crypto:exor(B, B), - B1 = crypto:rand_bytes(100), - B2 = crypto:rand_bytes(100), - Z2 = zero_bin(B1), - Z2 = crypto:exor(B1, B1), - Z2 = crypto:exor(B2, B2), - R = xor_bytes(B1, B2), - R = crypto:exor(B1, B2), - ok. - -%% -%% -rc4_test(doc) -> - ["Test rc4 encryption ."]; -rc4_test(suite) -> - []; -rc4_test(Config) when is_list(Config) -> - CT1 = <<"Yo baby yo">>, - R1 = <<118,122,68,110,157,166,141,212,139,39>>, - K = "apaapa", - R1 = crypto:rc4_encrypt(K, CT1), - CT1 = crypto:rc4_encrypt(K, R1), - CT2 = lists:seq(0, 255), - R2 = crypto:rc4_encrypt(K, CT2), - CT2 = binary_to_list(crypto:rc4_encrypt(K, R2)), - ok. - -rc4_stream_test(doc) -> - ["Test rc4 stream encryption ."]; -rc4_stream_test(suite) -> - []; -rc4_stream_test(Config) when is_list(Config) -> - CT1 = <<"Yo ">>, - CT2 = <<"baby yo">>, - K = "apaapa", - State0 = crypto:rc4_set_key(K), - {State1, R1} = crypto:rc4_encrypt_with_state(State0, CT1), - {_State2, R2} = crypto:rc4_encrypt_with_state(State1, CT2), - R = list_to_binary([R1, R2]), - <<118,122,68,110,157,166,141,212,139,39>> = R, - ok. - -blowfish_cfb64(doc) -> ["Test Blowfish encrypt/decrypt."]; -blowfish_cfb64(suite) -> []; -blowfish_cfb64(Config) when is_list(Config) -> - Key = <<1,35,69,103,137,171,205,239,240,225,210,195,180,165,150,135>>, - - IVec = <<254,220,186,152,118,84,50,16>>, - Plain = <<"7654321 Now is the time for ">>, - Enc = <<231,50,20,162,130,33,57,202,242,110,207,109,46,185,231,110,61,163,222,4,209,81,114,0,81,157,87,166>>, - - Enc = crypto:blowfish_cfb64_encrypt(Key, IVec, Plain), - Plain = crypto:blowfish_cfb64_decrypt(Key, IVec, Enc), - - Key2 = <<"A2B4C">>, - IVec2 = <<"12345678">>, - Plain2 = <<"badger at my table....!">>, - Enc2 = <<173,76,128,155,70,81,79,228,4,162,188,92,119,53,144,89,93,236,28,164,176,16,138>>, - - Enc2 = crypto:blowfish_cfb64_encrypt(Key2, IVec2, Plain2), - Plain2 = crypto:blowfish_cfb64_decrypt(Key2, IVec2, Enc2). - - -smp(doc) -> "Check concurrent access to crypto driver"; -smp(suite) -> []; -smp(Config) -> - case erlang:system_info(smp_support) of - true -> - NumOfProcs = erlang:system_info(schedulers), - io:format("smp starting ~p workers\n",[NumOfProcs]), - Seeds = [random:uniform(9999) || _ <- lists:seq(1,NumOfProcs)], - Parent = self(), - Pids = [spawn_link(fun()-> worker(Seed,Config,Parent) end) - || Seed <- Seeds], - wait_pids(Pids); - - false -> - {skipped,"No smp support"} - end. - -worker(Seed, Config, Parent) -> - io:format("smp worker ~p, seed=~p~n",[self(),Seed]), - random:seed(Seed,Seed,Seed), - worker_loop(100, Config), - %%io:format("worker ~p done\n",[self()]), - Parent ! self(). - -worker_loop(0, _) -> - ok; -worker_loop(N, Config) -> - Funcs = { md5, md5_update, md5_mac, md5_mac_io, sha, sha_update, des_cbc, - aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test, strong_rand_test, - rsa_verify_test, exor_test, rc4_test, rc4_stream_test, mod_exp_test, - hmac_update_md5, hmac_update_sha, hmac_update_sha256, hmac_update_sha512, - hmac_rfc2202, hmac_rfc4231_sha224, hmac_rfc4231_sha256, hmac_rfc4231_sha384, - hmac_rfc4231_sha512, aes_ctr_stream }, - - F = element(random:uniform(size(Funcs)),Funcs), - %%io:format("worker ~p calling ~p\n",[self(),F]), - ?MODULE:F(Config), - worker_loop(N-1,Config). - -wait_pids([]) -> - ok; -wait_pids(Pids) -> - receive - Pid -> - ?line true = lists:member(Pid,Pids), - Others = lists:delete(Pid,Pids), - io:format("wait_pid got ~p, still waiting for ~p\n",[Pid,Others]), - wait_pids(Others) - end. - -%% -%% Help functions -%% - -% match -m(X, X) -> - ?line true. -t(true) -> - true. - -% hexstr2bin -hexstr2bin(S) -> - list_to_binary(hexstr2list(S)). - -hexstr2list([X,Y|T]) -> - [mkint(X)*16 + mkint(Y) | hexstr2list(T)]; -hexstr2list([]) -> - []. - -mkint(C) when $0 =< C, C =< $9 -> - C - $0; -mkint(C) when $A =< C, C =< $F -> - C - $A + 10; -mkint(C) when $a =< C, C =< $f -> - C - $a + 10. - -%% mod_exp in erlang (copied from jungerl's ssh_math.erl) -ipow(A, B, M) when M > 0, B >= 0 -> - if A == 1 -> - 1; - true -> - ipow(A, B, M, 1) - end. - -ipow(A, 1, M, Prod) -> - (A*Prod) rem M; -ipow(_A, 0, _M, Prod) -> - Prod; -ipow(A, B, M, Prod) -> - B1 = B bsr 1, - A1 = (A*A) rem M, - if B - B1 == B1 -> - ipow(A1, B1, M, Prod); - true -> - ipow(A1, B1, M, (A*Prod) rem M) - end. - -%% -%% Invert an element X mod P -%% Calculated as {1, {A,B}} = egcd(X,P), -%% 1 == P*A + X*B == X*B (mod P) i.e B is the inverse element -%% -%% X > 0, P > 0, X < P (P should be prime) -%% -%% invert(X,P) when X > 0, P > 0, X < P -> -%% I = inv(X,P,1,0), -%% if -%% I < 0 -> P + I; -%% true -> I -%% end. - -%% inv(0,_,_,Q) -> Q; -%% inv(X,P,R1,Q1) -> -%% D = P div X, -%% inv(P rem X, X, Q1 - D*R1, R1). - -sized_binary(Binary) when is_binary(Binary) -> - <<(size(Binary)):32/integer, Binary/binary>>; -sized_binary(List) -> - sized_binary(list_to_binary(List)). - -xor_bytes(Bin1, Bin2) when is_binary(Bin1), is_binary(Bin2) -> - L1 = binary_to_list(Bin1), - L2 = binary_to_list(Bin2), - list_to_binary(xor_bytes(L1, L2)); -xor_bytes(L1, L2) -> - xor_bytes(L1, L2, []). - -xor_bytes([], [], Acc) -> - lists:reverse(Acc); -xor_bytes([N1 | Tl1], [N2 | Tl2], Acc) -> - xor_bytes(Tl1, Tl2, [N1 bxor N2 | Acc]). - -zero_bin(N) when is_integer(N) -> - N8 = N * 8, - <<0:N8/integer>>; -zero_bin(B) when is_binary(B) -> - zero_bin(size(B)). - -my_dss_verify(Data,[Sign|Tail],Key) -> - Res = my_dss_verify(Data,sized_binary(Sign),Key), - case Tail of - [] -> Res; - _ -> ?line Res = my_dss_verify(Data,Tail,Key) - end; -my_dss_verify(Data,Sign,Key) -> - ?line Res = crypto:dss_verify(Data, Sign, Key), - ?line Res = crypto:dss_verify(sha, Data, Sign, Key), - ?line <<_:32,Raw/binary>> = Data, - ?line Res = crypto:dss_verify(none, crypto:sha(Raw), Sign, Key), - Res. - -my_dss_sign(Data,Key) -> - ?line S1 = crypto:dss_sign(Data, Key), - ?line S2 = crypto:dss_sign(sha, Data, Key), - ?line <<_:32,Raw/binary>> = Data, - ?line S3 = crypto:dss_sign(none, crypto:sha(Raw), Key), - [S1,S2,S3]. - -openssl_version() -> - case crypto:info_lib() of - [{<<"OpenSSL">>,LibVer,_}] when is_integer(LibVer) -> - LibVer; - _ -> - undefined - end. - -if_supported(Algorithm, Fun) -> - case proplists:get_bool(Algorithm, crypto:algorithms()) of - true -> - Fun(); - _ -> - {skipped, io:format("~s not spupported", [Algorithm])} - end. + UserPassHash = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, Password])]), + Verifier = crypto:mod_pow(Generator, UserPassHash, Prime), + ClientPublic = crypto:mod_pow(Generator, ClientPrivate, Prime), + srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPrivate, UserPassHash, Scrambler, SessionKey). + +srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPrivate, UserPassHash, Scrambler, SessionKey)-> + {srp, ClientPrivate, + {user, [Generator, Prime, Version]}, {user, [UserPassHash, Prime, Generator, Version, Scrambler]}, + ServerPublic, ServerPrivate, {host, [Verifier, Generator, Prime, Version]}, + {host, [Verifier, Prime, Version, Scrambler]}, + SessionKey}. +ecdh() -> + {ecdh, 10053111454769593468622878414300213417816614162107065345116848162553478019161427871683337786549966, + 1373339791687564785573162818422814591820885704654, + secp160r1, 990333295438215762119481641129490894973766052278}. + +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/crypto/test/old_crypto_SUITE.erl b/lib/crypto/test/old_crypto_SUITE.erl new file mode 100644 index 0000000000..040edbf092 --- /dev/null +++ b/lib/crypto/test/old_crypto_SUITE.erl @@ -0,0 +1,2342 @@ +%% +%% %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% +%% +-module(old_crypto_SUITE). + +-include_lib("test_server/include/test_server.hrl"). + +-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, + info/1, + link_test/1, + md5/1, + md5_update/1, + md4/1, + md4_update/1, + sha/1, + sha_update/1, + hmac_update_sha/1, + hmac_update_sha_n/1, + hmac_update_sha256/1, + hmac_update_sha512/1, + hmac_update_md5/1, + hmac_update_md5_io/1, + hmac_update_md5_n/1, + hmac_rfc2202/1, + hmac_rfc4231_sha224/1, + hmac_rfc4231_sha256/1, + hmac_rfc4231_sha384/1, + hmac_rfc4231_sha512/1, + ripemd160/1, + ripemd160_update/1, + sha256/1, + sha256_update/1, + sha512/1, + sha512_update/1, + md5_mac/1, + md5_mac_io/1, + des_cbc/1, + des_cbc_iter/1, + des_cfb/1, + des_cfb_iter/1, + des_ecb/1, + des3_cbc/1, + des3_cfb/1, + rc2_cbc/1, + aes_cfb/1, + aes_cbc/1, + aes_cbc_iter/1, + aes_ctr/1, + aes_ctr_stream/1, + mod_exp_test/1, + rand_uniform_test/1, + strong_rand_test/1, + rsa_verify_test/1, + dsa_verify_test/1, + rsa_sign_test/1, + rsa_sign_hash_test/1, + dsa_sign_test/1, + dsa_sign_hash_test/1, + rsa_encrypt_decrypt/1, + dh/1, + srp3/1, srp6/1, srp6a/1, + ec/1, + exor_test/1, + rc4_test/1, + rc4_stream_test/1, + blowfish_cfb64/1, + smp/1]). + +-export([hexstr2bin/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [link_test, {group, info}]. + +groups() -> + [{info, [sequence],[info, {group, rest}]}, + {rest, [], + [md5, md5_update, md4, md4_update, md5_mac, + md5_mac_io, ripemd160, ripemd160_update, sha, sha_update, + sha256, sha256_update, sha512, sha512_update, + hmac_update_sha, hmac_update_sha_n, hmac_update_sha256, hmac_update_sha512, + hmac_update_md5_n, hmac_update_md5_io, hmac_update_md5, + hmac_rfc2202, hmac_rfc4231_sha224, hmac_rfc4231_sha256, + hmac_rfc4231_sha384, hmac_rfc4231_sha512, + des_cbc, aes_cfb, aes_cbc, + des_cfb, des_cfb_iter, des3_cbc, des3_cfb, rc2_cbc, + aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_ecb, + rand_uniform_test, strong_rand_test, + rsa_verify_test, dsa_verify_test, rsa_sign_test, + rsa_sign_hash_test, dsa_sign_test, dsa_sign_hash_test, + rsa_encrypt_decrypt, dh, srp3, srp6, srp6a, ec, exor_test, + rc4_test, rc4_stream_test, mod_exp_test, blowfish_cfb64, + smp]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(info, Config) -> + Config; +init_per_testcase(_Name,Config) -> + io:format("init_per_testcase\n"), + ?line crypto:start(), + Config. + +end_per_testcase(info, Config) -> + Config; +end_per_testcase(_Name,Config) -> + io:format("end_per_testcase\n"), + ?line crypto:stop(), + Config. + +%% +%% +link_test(doc) -> + ["Test that the library is statically linked to libcrypto.a."]; +link_test(suite) -> + []; +link_test(Config) when is_list(Config) -> + ?line case os:type() of + {unix,darwin} -> {skipped,"Darwin cannot link statically"}; + {unix,_} -> link_test_1(); + _ -> {skip,"Only runs on Unix"} + end. + +link_test_1() -> + ?line CryptoPriv = code:priv_dir(crypto), + ?line Wc = filename:join([CryptoPriv,"lib","crypto.*"]), + ?line case filelib:wildcard(Wc) of + [] -> {skip,"Didn't find the crypto driver"}; + [Drv] -> link_test_2(Drv) + end. + +link_test_2(Drv) -> + case ldd_program() of + none -> + {skip,"No ldd-like program found"}; + Ldd -> + Cmd = Ldd ++ " " ++ Drv, + Libs = os:cmd(Cmd), + io:format("~p\n", [Libs]), + case string:str(Libs, "libcrypto") of + 0 -> + case ?t:is_commercial() of + true -> + ?t:fail({libcrypto,statically_linked}); + false -> + {comment,"Statically linked (OK for open-source platform)"} + end; + _ -> + ok + end + end. + +ldd_program() -> + case os:find_executable("ldd") of + false -> + case os:type() of + {unix,darwin} -> + case os:find_executable("otool") of + false -> none; + Otool -> Otool ++ " -L" + end + end; + Ldd when is_list(Ldd) -> Ldd + end. + + + +info(doc) -> + ["Call the info function."]; +info(suite) -> + []; +info(Config) when is_list(Config) -> + case {code:lib_dir(crypto),?t:is_commercial()} of + {{error,bad_name},false} -> + {skip,"Missing crypto application"}; + {_,_} -> + ?line crypto:start(), + ?line Info = crypto:info(), + ?line Exports = lists:usort([F || {F,_} <- crypto:module_info(exports)]), + ?line [] = Info -- Exports, + ?line NotInInfo = Exports -- Info, + io:format("NotInInfo = ~p\n", [NotInInfo]), + %% BlackList = lists:sort([des_ede3_cbc_decrypt, des_ede3_cbc_encrypt, + %% dh_check, dh_generate_parameters, + %% module_info, start, stop, version]), + %% ?line BlackList = NotInInfo, + + ?line InfoLib = crypto:info_lib(), + ?line [_|_] = InfoLib, + F = fun([{Name,VerN,VerS}|T],Me) -> + ?line true = is_binary(Name), + ?line true = is_integer(VerN), + ?line true = is_binary(VerS), + Me(T,Me); + ([],_) -> + ok + end, + ?line F(InfoLib,F), + ?line crypto:stop() + end. + +%% +%% +md5(doc) -> + ["Generate MD5 message digests and check the result. Examples are " + "from RFC-1321."]; +md5(suite) -> + []; +md5(Config) when is_list(Config) -> + ?line m(crypto:md5(""), + hexstr2bin("d41d8cd98f00b204e9800998ecf8427e")), + ?line m(crypto:md5("a"), + hexstr2bin("0cc175b9c0f1b6a831c399e269772661")), + ?line m(crypto:md5("abc"), + hexstr2bin("900150983cd24fb0d6963f7d28e17f72")), + ?line m(crypto:md5("message digest"), + hexstr2bin("f96b697d7cb7938d525a2f31aaf161d0")), + ?line m(crypto:md5("abcdefghijklmnopqrstuvwxyz"), + hexstr2bin("c3fcd3d76192e4007dfb496cca67e13b")), + ?line m(crypto:md5("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" + "0123456789"), + hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")), + ?line m(crypto:md5("12345678901234567890123456789012345678901234567890" + "123456789012345678901234567890"), + hexstr2bin("57edf4a22be3c955ac49da2e2107b67a")). + +%% +%% +md5_update(doc) -> + ["Generate MD5 message using md5_init, md5_update, and md5_final, and" + "check the result. Examples are from RFC-1321."]; +md5_update(suite) -> + []; +md5_update(Config) when is_list(Config) -> + ?line Ctx = crypto:md5_init(), + ?line Ctx1 = crypto:md5_update(Ctx, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), + ?line Ctx2 = crypto:md5_update(Ctx1, "abcdefghijklmnopqrstuvwxyz" + "0123456789"), + ?line m(crypto:md5_final(Ctx2), + hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")). + +%% +%% +md4(doc) -> + ["Generate MD4 message digests and check the result. Examples are " + "from RFC-1321."]; +md4(suite) -> + []; +md4(Config) when is_list(Config) -> + ?line m(crypto:md4(""), + hexstr2bin("31d6cfe0d16ae931b73c59d7e0c089c0")), + ?line m(crypto:md4("a"), + hexstr2bin("bde52cb31de33e46245e05fbdbd6fb24")), + ?line m(crypto:md4("abc"), + hexstr2bin("a448017aaf21d8525fc10ae87aa6729d")), + ?line m(crypto:md4("message digest"), + hexstr2bin("d9130a8164549fe818874806e1c7014b")), + ?line m(crypto:md4("abcdefghijklmnopqrstuvwxyz"), + hexstr2bin("d79e1c308aa5bbcdeea8ed63df412da9")), + ?line m(crypto:md4("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" + "0123456789"), + hexstr2bin("043f8582f241db351ce627e153e7f0e4")), + ?line m(crypto:md4("12345678901234567890123456789012345678901234567890" + "123456789012345678901234567890"), + hexstr2bin("e33b4ddc9c38f2199c3e7b164fcc0536")). + +%% +%% +md4_update(doc) -> + ["Generate MD5 message using md5_init, md5_update, and md5_final, and" + "check the result. Examples are from RFC-1321."]; +md4_update(suite) -> + []; +md4_update(Config) when is_list(Config) -> + ?line Ctx = crypto:md4_init(), + ?line Ctx1 = crypto:md4_update(Ctx, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), + ?line Ctx2 = crypto:md4_update(Ctx1, "abcdefghijklmnopqrstuvwxyz" + "0123456789"), + ?line m(crypto:md4_final(Ctx2), + hexstr2bin("043f8582f241db351ce627e153e7f0e4")). + +%% +%% +sha(doc) -> + ["Generate SHA message digests and check the result. Examples are " + "from FIPS-180-1."]; +sha(suite) -> + []; +sha(Config) when is_list(Config) -> + ?line m(crypto:sha("abc"), + hexstr2bin("A9993E364706816ABA3E25717850C26C9CD0D89D")), + ?line m(crypto:sha("abcdbcdecdefdefgefghfghighijhijkijkljklmklm" + "nlmnomnopnopq"), + hexstr2bin("84983E441C3BD26EBAAE4AA1F95129E5E54670F1")). + + +%% +hmac_update_sha_n(doc) -> + ["Request a larger-than-allowed SHA1 HMAC using hmac_init, hmac_update, and hmac_final_n. " + "Expected values for examples are generated using crypto:sha_mac." ]; +hmac_update_sha_n(suite) -> + []; +hmac_update_sha_n(Config) when is_list(Config) -> + ?line Key = hexstr2bin("00010203101112132021222330313233" + "04050607141516172425262734353637" + "08090a0b18191a1b28292a2b38393a3b" + "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"), + ?line Data = "Sampl", + ?line Data2 = "e #1", + ?line Ctx = crypto:hmac_init(sha, Key), + ?line Ctx2 = crypto:hmac_update(Ctx, Data), + ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), + ?line Mac = crypto:hmac_final_n(Ctx3, 1024), + ?line Exp = crypto:sha_mac(Key, lists:flatten([Data, Data2])), + ?line m(Exp, Mac), + ?line m(size(Exp), size(Mac)). + + +hmac_update_sha(doc) -> + ["Generate an SHA1 HMAC using hmac_init, hmac_update, and hmac_final. " + "Expected values for examples are generated using crypto:sha_mac." ]; +hmac_update_sha(suite) -> + []; +hmac_update_sha(Config) when is_list(Config) -> + ?line Key = hexstr2bin("00010203101112132021222330313233" + "04050607141516172425262734353637" + "08090a0b18191a1b28292a2b38393a3b" + "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"), + ?line Data = "Sampl", + ?line Data2 = "e #1", + ?line Ctx = crypto:hmac_init(sha, Key), + ?line Ctx2 = crypto:hmac_update(Ctx, Data), + ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), + ?line Mac = crypto:hmac_final(Ctx3), + ?line Exp = crypto:hmac(sha, Key, lists:flatten([Data, Data2])), + ?line m(Exp, Mac). + +hmac_update_sha256(doc) -> + ["Generate an SHA256 HMAC using hmac_init, hmac_update, and hmac_final. " + "Expected values for examples are generated using crypto:sha256_mac." ]; +hmac_update_sha256(suite) -> + []; +hmac_update_sha256(Config) when is_list(Config) -> + if_supported(sha256, fun() -> hmac_update_sha256_do() end). + +hmac_update_sha256_do() -> + ?line Key = hexstr2bin("00010203101112132021222330313233" + "04050607141516172425262734353637" + "08090a0b18191a1b28292a2b38393a3b" + "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"), + ?line Data = "Sampl", + ?line Data2 = "e #1", + ?line Ctx = crypto:hmac_init(sha256, Key), + ?line Ctx2 = crypto:hmac_update(Ctx, Data), + ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), + ?line Mac = crypto:hmac_final(Ctx3), + ?line Exp = crypto:hmac(sha256, Key, lists:flatten([Data, Data2])), + ?line m(Exp, Mac). + +hmac_update_sha512(doc) -> + ["Generate an SHA512 HMAC using hmac_init, hmac_update, and hmac_final. " + "Expected values for examples are generated using crypto:sha512_mac." ]; +hmac_update_sha512(suite) -> + []; +hmac_update_sha512(Config) when is_list(Config) -> + if_supported(sha512, fun() -> hmac_update_sha512_do() end). + +hmac_update_sha512_do() -> + ?line Key = hexstr2bin("00010203101112132021222330313233" + "04050607141516172425262734353637" + "08090a0b18191a1b28292a2b38393a3b" + "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"), + ?line Data = "Sampl", + ?line Data2 = "e #1", + ?line Ctx = crypto:hmac_init(sha512, Key), + ?line Ctx2 = crypto:hmac_update(Ctx, Data), + ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), + ?line Mac = crypto:hmac_final(Ctx3), + ?line Exp = crypto:hmac(sha512, Key, lists:flatten([Data, Data2])), + ?line m(Exp, Mac). + +hmac_update_md5(doc) -> + ["Generate an MD5 HMAC using hmac_init, hmac_update, and hmac_final. " + "Expected values for examples are generated using crypto:md5_mac." ]; +hmac_update_md5(suite) -> + []; +hmac_update_md5(Config) when is_list(Config) -> + % ?line Key2 = ["A fine speach", "by a fine man!"], + Key2 = "A fine speach by a fine man!", + ?line Long1 = "Four score and seven years ago our fathers brought forth on this continent a new nation, conceived in liberty, and dedicated to the proposition that all men are created equal.", + ?line Long2 = "Now we are engaged in a great civil war, testing whether that nation, or any nation, so conceived and so dedicated, can long endure. We are met on a great battle-field of that war. We have come to dedicate a portion of that field, as a final resting place for those who here gave their lives that that nation might live. It is altogether fitting and proper that we should do this.", + ?line Long3 = "But, in a larger sense, we can not dedicate, we can not consecrate, we can not hallow this ground. The brave men, living and dead, who struggled here, have consecrated it, far above our poor power to add or detract. The world will little note, nor long remember what we say here, but it can never forget what they did here. It is for us the living, rather, to be dedicated here to the unfinished work which they who fought here have thus far so nobly advanced. It is rather for us to be here dedicated to the great task remaining before us-that from these honored dead we take increased devotion to that cause for which they gave the last full measure of devotion that we here highly resolve that these dead shall not have died in vain-that this nation, under God, shall have a new birth of freedom-and that government of the people, by the people, for the people, shall not perish from the earth.", + ?line CtxA = crypto:hmac_init(md5, Key2), + ?line CtxB = crypto:hmac_update(CtxA, Long1), + ?line CtxC = crypto:hmac_update(CtxB, Long2), + ?line CtxD = crypto:hmac_update(CtxC, Long3), + ?line Mac2 = crypto:hmac_final(CtxD), + ?line Exp2 = crypto:md5_mac(Key2, lists:flatten([Long1, Long2, Long3])), + ?line m(Exp2, Mac2). + +hmac_rfc2202(doc) -> + ["Generate an HMAC using hmac, md5_mac, and sha_mac." + "Test vectors are taken from RFC-2202."]; +hmac_rfc2202(suite) -> + []; +hmac_rfc2202(Config) when is_list(Config) -> + hmac_rfc2202_md5(), + hmac_rfc2202_sha(). + +hmac_rfc2202_md5() -> + %% Test case 1 + Case1Key = binary:copy(<<16#0b>>, 16), + Case1Data = <<"Hi There">>, + Case1Exp = hexstr2bin("9294727a3638bb1c13f48ef8158bfc9d"), + + ?line Case1Mac_1 = crypto:md5_mac(Case1Key, Case1Data), + ?line Case1Mac_2 = crypto:hmac(md5, Case1Key, Case1Data), + ?line m(Case1Exp, Case1Mac_1), + ?line m(Case1Exp, Case1Mac_2), + + %% Test case 2 + Case2Key = <<"Jefe">>, + Case2Data = <<"what do ya want for nothing?">>, + Case2Exp = hexstr2bin("750c783e6ab0b503eaa86e310a5db738"), + + ?line Case2Mac_1 = crypto:md5_mac(Case2Key, Case2Data), + ?line Case2Mac_2 = crypto:hmac(md5, Case2Key, Case2Data), + ?line m(Case2Exp, Case2Mac_1), + ?line m(Case2Exp, Case2Mac_2), + + %% Test case 3 + Case3Key = binary:copy(<<16#aa>>, 16), + Case3Data = binary:copy(<<16#dd>>, 50), + Case3Exp = hexstr2bin("56be34521d144c88dbb8c733f0e8b3f6"), + + ?line Case3Mac_1 = crypto:md5_mac(Case3Key, Case3Data), + ?line Case3Mac_2 = crypto:hmac(md5, Case3Key, Case3Data), + ?line m(Case3Exp, Case3Mac_1), + ?line m(Case3Exp, Case3Mac_2), + + %% Test case 4 + Case4Key = list_to_binary(lists:seq(1, 16#19)), + Case4Data = binary:copy(<<16#cd>>, 50), + Case4Exp = hexstr2bin("697eaf0aca3a3aea3a75164746ffaa79"), + + ?line Case4Mac_1 = crypto:md5_mac(Case4Key, Case4Data), + ?line Case4Mac_2 = crypto:hmac(md5, Case4Key, Case4Data), + ?line m(Case4Exp, Case4Mac_1), + ?line m(Case4Exp, Case4Mac_2), + + %% Test case 5 + Case5Key = binary:copy(<<16#0c>>, 16), + Case5Data = "Test With Truncation", + Case5Exp = hexstr2bin("56461ef2342edc00f9bab995690efd4c"), + Case5Exp96 = hexstr2bin("56461ef2342edc00f9bab995"), + + ?line Case5Mac_1 = crypto:md5_mac(Case5Key, Case5Data), + ?line Case5Mac_2 = crypto:hmac(md5, Case5Key, Case5Data), + ?line Case5Mac96_1 = crypto:md5_mac_96(Case5Key, Case5Data), + ?line Case5Mac96_2 = crypto:hmac(md5, Case5Key, Case5Data, 12), + ?line m(Case5Exp, Case5Mac_1), + ?line m(Case5Exp, Case5Mac_2), + ?line m(Case5Exp96, Case5Mac96_1), + ?line m(Case5Exp96, Case5Mac96_2), + + %% Test case 6 + Case6Key = binary:copy(<<16#aa>>, 80), + Case6Data = <<"Test Using Larger Than Block-Size Key - Hash Key First">>, + Case6Exp = hexstr2bin("6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"), + + ?line Case6Mac_1 = crypto:md5_mac(Case6Key, Case6Data), + ?line Case6Mac_2 = crypto:hmac(md5, Case6Key, Case6Data), + ?line m(Case6Exp, Case6Mac_1), + ?line m(Case6Exp, Case6Mac_2), + + %% Test case 7 + Case7Key = binary:copy(<<16#aa>>, 80), + Case7Data = <<"Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data">>, + Case7Exp = hexstr2bin("6f630fad67cda0ee1fb1f562db3aa53e"), + + ?line Case7Mac_1 = crypto:md5_mac(Case7Key, Case7Data), + ?line Case7Mac_2 = crypto:hmac(md5, Case7Key, Case7Data), + ?line m(Case7Exp, Case7Mac_1), + ?line m(Case7Exp, Case7Mac_2). + +hmac_rfc2202_sha() -> + %% Test case 1 + Case1Key = binary:copy(<<16#0b>>, 20), + Case1Data = <<"Hi There">>, + Case1Exp = hexstr2bin("b617318655057264e28bc0b6fb378c8ef146be00"), + + ?line Case1Mac_1 = crypto:sha_mac(Case1Key, Case1Data), + ?line Case1Mac_2 = crypto:hmac(sha, Case1Key, Case1Data), + ?line m(Case1Exp, Case1Mac_1), + ?line m(Case1Exp, Case1Mac_2), + + %% Test case 2 + Case2Key = <<"Jefe">>, + Case2Data = <<"what do ya want for nothing?">>, + Case2Exp = hexstr2bin("effcdf6ae5eb2fa2d27416d5f184df9c259a7c79"), + + ?line Case2Mac_1 = crypto:sha_mac(Case2Key, Case2Data), + ?line Case2Mac_2 = crypto:hmac(sha, Case2Key, Case2Data), + ?line m(Case2Exp, Case2Mac_1), + ?line m(Case2Exp, Case2Mac_2), + + %% Test case 3 + Case3Key = binary:copy(<<16#aa>>, 20), + Case3Data = binary:copy(<<16#dd>>, 50), + Case3Exp = hexstr2bin("125d7342b9ac11cd91a39af48aa17b4f63f175d3"), + + ?line Case3Mac_1 = crypto:sha_mac(Case3Key, Case3Data), + ?line Case3Mac_2 = crypto:hmac(sha, Case3Key, Case3Data), + ?line m(Case3Exp, Case3Mac_1), + ?line m(Case3Exp, Case3Mac_2), + + %% Test case 4 + Case4Key = list_to_binary(lists:seq(1, 16#19)), + Case4Data = binary:copy(<<16#cd>>, 50), + Case4Exp = hexstr2bin("4c9007f4026250c6bc8414f9bf50c86c2d7235da"), + + ?line Case4Mac_1 = crypto:sha_mac(Case4Key, Case4Data), + ?line Case4Mac_2 = crypto:hmac(sha, Case4Key, Case4Data), + ?line m(Case4Exp, Case4Mac_1), + ?line m(Case4Exp, Case4Mac_2), + + %% Test case 5 + Case5Key = binary:copy(<<16#0c>>, 20), + Case5Data = "Test With Truncation", + Case5Exp = hexstr2bin("4c1a03424b55e07fe7f27be1d58bb9324a9a5a04"), + Case5Exp96 = hexstr2bin("4c1a03424b55e07fe7f27be1"), + + ?line Case5Mac_1 = crypto:sha_mac(Case5Key, Case5Data), + ?line Case5Mac_2 = crypto:hmac(sha, Case5Key, Case5Data), + ?line Case5Mac96_1 = crypto:sha_mac_96(Case5Key, Case5Data), + ?line Case5Mac96_2 = crypto:hmac(sha, Case5Key, Case5Data, 12), + ?line m(Case5Exp, Case5Mac_1), + ?line m(Case5Exp, Case5Mac_2), + ?line m(Case5Exp96, Case5Mac96_1), + ?line m(Case5Exp96, Case5Mac96_2), + + %% Test case 6 + Case6Key = binary:copy(<<16#aa>>, 80), + Case6Data = <<"Test Using Larger Than Block-Size Key - Hash Key First">>, + Case6Exp = hexstr2bin("aa4ae5e15272d00e95705637ce8a3b55ed402112"), + + ?line Case6Mac_1 = crypto:sha_mac(Case6Key, Case6Data), + ?line Case6Mac_2 = crypto:hmac(sha, Case6Key, Case6Data), + ?line m(Case6Exp, Case6Mac_1), + ?line m(Case6Exp, Case6Mac_2), + + %% Test case 7 + Case7Key = binary:copy(<<16#aa>>, 80), + Case7Data = <<"Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data">>, + Case7Exp = hexstr2bin("e8e99d0f45237d786d6bbaa7965c7808bbff1a91"), + + ?line Case7Mac_1 = crypto:sha_mac(Case7Key, Case7Data), + ?line Case7Mac_2 = crypto:hmac(sha, Case7Key, Case7Data), + ?line m(Case7Exp, Case7Mac_1), + ?line m(Case7Exp, Case7Mac_2). + +hmac_rfc4231_sha224(doc) -> + ["Generate an HMAC using crypto:sha224_mac, hmac, and hmac_init, hmac_update, and hmac_final. " + "Testvectors are take from RFC4231." ]; +hmac_rfc4231_sha224(suite) -> + []; +hmac_rfc4231_sha224(Config) when is_list(Config) -> + if_supported(sha224, fun() -> hmac_rfc4231_sha224_do() end). + +hmac_rfc4231_sha256(doc) -> + ["Generate an HMAC using crypto:sha256_mac, hmac, and hmac_init, hmac_update, and hmac_final. " + "Testvectors are take from RFC4231." ]; +hmac_rfc4231_sha256(suite) -> + []; +hmac_rfc4231_sha256(Config) when is_list(Config) -> + if_supported(sha256, fun() -> hmac_rfc4231_sha256_do() end). + +hmac_rfc4231_sha384(doc) -> + ["Generate an HMAC using crypto:sha384_mac, hmac, and hmac_init, hmac_update, and hmac_final. " + "Testvectors are take from RFC4231." ]; +hmac_rfc4231_sha384(suite) -> + []; +hmac_rfc4231_sha384(Config) when is_list(Config) -> + if_supported(sha384, fun() -> hmac_rfc4231_sha384_do() end). + +hmac_rfc4231_sha512(doc) -> + ["Generate an HMAC using crypto:sha512_mac, hmac, and hmac_init, hmac_update, and hmac_final. " + "Testvectors are take from RFC4231." ]; +hmac_rfc4231_sha512(suite) -> + []; +hmac_rfc4231_sha512(Config) when is_list(Config) -> + if_supported(sha512, fun() -> hmac_rfc4231_sha512_do() end). + +hmac_rfc4231_case(Hash, case1, Exp) -> + %% Test 1 + Key = binary:copy(<<16#0b>>, 20), + Data = <<"Hi There">>, + hmac_rfc4231_case(Hash, Key, Data, Exp); + +hmac_rfc4231_case(Hash, case2, Exp) -> + %% Test 2 + Key = <<"Jefe">>, + Data = <<"what do ya want for nothing?">>, + hmac_rfc4231_case(Hash, Key, Data, Exp); + +hmac_rfc4231_case(Hash, case3, Exp) -> + %% Test 3 + Key = binary:copy(<<16#aa>>, 20), + Data = binary:copy(<<16#dd>>, 50), + hmac_rfc4231_case(Hash, Key, Data, Exp); + +hmac_rfc4231_case(Hash, case4, Exp) -> + %% Test 4 + Key = list_to_binary(lists:seq(1, 16#19)), + Data = binary:copy(<<16#cd>>, 50), + hmac_rfc4231_case(Hash, Key, Data, Exp); + +hmac_rfc4231_case(Hash, case5, Exp) -> + %% Test 5 + Key = binary:copy(<<16#0c>>, 20), + Data = <<"Test With Truncation">>, + hmac_rfc4231_case(Hash, Key, Data, 16, Exp); + +hmac_rfc4231_case(Hash, case6, Exp) -> + %% Test 6 + Key = binary:copy(<<16#aa>>, 131), + Data = <<"Test Using Larger Than Block-Size Key - Hash Key First">>, + hmac_rfc4231_case(Hash, Key, Data, Exp); + +hmac_rfc4231_case(Hash, case7, Exp) -> + %% Test Case 7 + Key = binary:copy(<<16#aa>>, 131), + Data = <<"This is a test using a larger than block-size key and a larger t", + "han block-size data. The key needs to be hashed before being use", + "d by the HMAC algorithm.">>, + hmac_rfc4231_case(Hash, Key, Data, Exp). + +hmac_rfc4231_case(Hash, Key, Data, Exp) -> + ?line Ctx = crypto:hmac_init(Hash, Key), + ?line Ctx2 = crypto:hmac_update(Ctx, Data), + ?line Mac1 = crypto:hmac_final(Ctx2), + ?line Mac3 = crypto:hmac(Hash, Key, Data), + ?line m(Exp, Mac1), + ?line m(Exp, Mac3). + +hmac_rfc4231_case(Hash, Key, Data, Trunc, Exp) -> + ?line Ctx = crypto:hmac_init(Hash, Key), + ?line Ctx2 = crypto:hmac_update(Ctx, Data), + ?line Mac1 = crypto:hmac_final_n(Ctx2, Trunc), + ?line Mac3 = crypto:hmac(Hash, Key, Data, Trunc), + ?line m(Exp, Mac1), + ?line m(Exp, Mac3). + +hmac_rfc4231_sha224_do() -> + Case1 = hexstr2bin("896fb1128abbdf196832107cd49df33f" + "47b4b1169912ba4f53684b22"), + Case2 = hexstr2bin("a30e01098bc6dbbf45690f3a7e9e6d0f" + "8bbea2a39e6148008fd05e44"), + Case3 = hexstr2bin("7fb3cb3588c6c1f6ffa9694d7d6ad264" + "9365b0c1f65d69d1ec8333ea"), + Case4 = hexstr2bin("6c11506874013cac6a2abc1bb382627c" + "ec6a90d86efc012de7afec5a"), + Case5 = hexstr2bin("0e2aea68a90c8d37c988bcdb9fca6fa8"), + Case6 = hexstr2bin("95e9a0db962095adaebe9b2d6f0dbce2" + "d499f112f2d2b7273fa6870e"), + Case7 = hexstr2bin("3a854166ac5d9f023f54d517d0b39dbd" + "946770db9c2b95c9f6f565d1"), + hmac_rfc4231_cases_do(sha224, [Case1, Case2, Case3, Case4, Case5, Case6, Case7]). + +hmac_rfc4231_sha256_do() -> + Case1 = hexstr2bin("b0344c61d8db38535ca8afceaf0bf12b" + "881dc200c9833da726e9376c2e32cff7"), + Case2 = hexstr2bin("5bdcc146bf60754e6a042426089575c7" + "5a003f089d2739839dec58b964ec3843"), + Case3 = hexstr2bin("773ea91e36800e46854db8ebd09181a7" + "2959098b3ef8c122d9635514ced565fe"), + Case4 = hexstr2bin("82558a389a443c0ea4cc819899f2083a" + "85f0faa3e578f8077a2e3ff46729665b"), + Case5 = hexstr2bin("a3b6167473100ee06e0c796c2955552b"), + Case6 = hexstr2bin("60e431591ee0b67f0d8a26aacbf5b77f" + "8e0bc6213728c5140546040f0ee37f54"), + Case7 = hexstr2bin("9b09ffa71b942fcb27635fbcd5b0e944" + "bfdc63644f0713938a7f51535c3a35e2"), + hmac_rfc4231_cases_do(sha256, [Case1, Case2, Case3, Case4, Case5, Case6, Case7]). + +hmac_rfc4231_sha384_do() -> + Case1 = hexstr2bin("afd03944d84895626b0825f4ab46907f" + "15f9dadbe4101ec682aa034c7cebc59c" + "faea9ea9076ede7f4af152e8b2fa9cb6"), + Case2 = hexstr2bin("af45d2e376484031617f78d2b58a6b1b" + "9c7ef464f5a01b47e42ec3736322445e" + "8e2240ca5e69e2c78b3239ecfab21649"), + Case3 = hexstr2bin("88062608d3e6ad8a0aa2ace014c8a86f" + "0aa635d947ac9febe83ef4e55966144b" + "2a5ab39dc13814b94e3ab6e101a34f27"), + Case4 = hexstr2bin("3e8a69b7783c25851933ab6290af6ca7" + "7a9981480850009cc5577c6e1f573b4e" + "6801dd23c4a7d679ccf8a386c674cffb"), + Case5 = hexstr2bin("3abf34c3503b2a23a46efc619baef897"), + Case6 = hexstr2bin("4ece084485813e9088d2c63a041bc5b4" + "4f9ef1012a2b588f3cd11f05033ac4c6" + "0c2ef6ab4030fe8296248df163f44952"), + Case7 = hexstr2bin("6617178e941f020d351e2f254e8fd32c" + "602420feb0b8fb9adccebb82461e99c5" + "a678cc31e799176d3860e6110c46523e"), + hmac_rfc4231_cases_do(sha384, [Case1, Case2, Case3, Case4, Case5, Case6, Case7]). + +hmac_rfc4231_sha512_do() -> + Case1 = hexstr2bin("87aa7cdea5ef619d4ff0b4241a1d6cb0" + "2379f4e2ce4ec2787ad0b30545e17cde" + "daa833b7d6b8a702038b274eaea3f4e4" + "be9d914eeb61f1702e696c203a126854"), + Case2 = hexstr2bin("164b7a7bfcf819e2e395fbe73b56e0a3" + "87bd64222e831fd610270cd7ea250554" + "9758bf75c05a994a6d034f65f8f0e6fd" + "caeab1a34d4a6b4b636e070a38bce737"), + Case3 = hexstr2bin("fa73b0089d56a284efb0f0756c890be9" + "b1b5dbdd8ee81a3655f83e33b2279d39" + "bf3e848279a722c806b485a47e67c807" + "b946a337bee8942674278859e13292fb"), + Case4 = hexstr2bin("b0ba465637458c6990e5a8c5f61d4af7" + "e576d97ff94b872de76f8050361ee3db" + "a91ca5c11aa25eb4d679275cc5788063" + "a5f19741120c4f2de2adebeb10a298dd"), + Case5 = hexstr2bin("415fad6271580a531d4179bc891d87a6"), + Case6 = hexstr2bin("80b24263c7c1a3ebb71493c1dd7be8b4" + "9b46d1f41b4aeec1121b013783f8f352" + "6b56d037e05f2598bd0fd2215d6a1e52" + "95e64f73f63f0aec8b915a985d786598"), + Case7 = hexstr2bin("e37b6a775dc87dbaa4dfa9f96e5e3ffd" + "debd71f8867289865df5a32d20cdc944" + "b6022cac3c4982b10d5eeb55c3e4de15" + "134676fb6de0446065c97440fa8c6a58"), + hmac_rfc4231_cases_do(sha512, [Case1, Case2, Case3, Case4, Case5, Case6, Case7]). + +hmac_rfc4231_cases_do(Hash, CasesData) -> + hmac_rfc4231_cases_do(Hash, [case1, case2, case3, case4, case5, case6, case7], CasesData). + +hmac_rfc4231_cases_do(_Hash, _, []) -> + ok; +hmac_rfc4231_cases_do(Hash, [C|Cases], [D|CasesData]) -> + hmac_rfc4231_case(Hash, C, D), + hmac_rfc4231_cases_do(Hash, Cases, CasesData). + +hmac_update_md5_io(doc) -> + ["Generate an MD5 HMAC using hmac_init, hmac_update, and hmac_final. " + "Expected values for examples are generated using crypto:md5_mac." ]; +hmac_update_md5_io(suite) -> + []; +hmac_update_md5_io(Config) when is_list(Config) -> + ?line Key = ["A fine speach", "by a fine man!"], + ?line Data = "Sampl", + ?line Data2 = "e #1", + ?line Ctx = crypto:hmac_init(md5, Key), + ?line Ctx2 = crypto:hmac_update(Ctx, Data), + ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), + ?line Mac = crypto:hmac_final(Ctx3), + ?line Exp = crypto:md5_mac(Key, lists:flatten([Data, Data2])), + ?line m(Exp, Mac). + + +hmac_update_md5_n(doc) -> + ["Generate a shortened MD5 HMAC using hmac_init, hmac_update, and hmac_final. " + "Expected values for examples are generated using crypto:md5_mac." ]; +hmac_update_md5_n(suite) -> + []; +hmac_update_md5_n(Config) when is_list(Config) -> + ?line Key = ["A fine speach", "by a fine man!"], + ?line Data = "Sampl", + ?line Data2 = "e #1", + ?line Ctx = crypto:hmac_init(md5, Key), + ?line Ctx2 = crypto:hmac_update(Ctx, Data), + ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), + ?line Mac = crypto:hmac_final_n(Ctx3, 12), + ?line Exp = crypto:md5_mac_96(Key, lists:flatten([Data, Data2])), + ?line m(Exp, Mac). +%% +%% +ripemd160(doc) -> + ["Generate RIPEMD160 message digests and check the result."]; +ripemd160(suite) -> + []; +ripemd160(Config) when is_list(Config) -> + ?line m(crypto:hash(ripemd160,"abc"), + hexstr2bin("8EB208F7E05D987A9B044A8E98C6B087F15A0BFC")), + ?line m(crypto:hash(ripemd160,"abcdbcdecdefdefgefghfghighijhijkijkljklmklm" + "nlmnomnopnopq"), + hexstr2bin("12A053384A9C0C88E405A06C27DCF49ADA62EB2B")). + + +%% +%% +ripemd160_update(doc) -> + ["Generate RIPEMD160 message digests by using ripemd160_init," + "ripemd160_update, and ripemd160_final and check the result."]; +ripemd160_update(suite) -> + []; +ripemd160_update(Config) when is_list(Config) -> + ?line Ctx = crypto:hash_init(ripemd160), + ?line Ctx1 = crypto:hash_update(Ctx, "abcdbcdecdefdefgefghfghighi"), + ?line Ctx2 = crypto:hash_update(Ctx1, "jhijkijkljklmklmnlmnomnopnopq"), + ?line m(crypto:hash_final(Ctx2), + hexstr2bin("12A053384A9C0C88E405A06C27DCF49ADA62EB2B")). + +%% +%% +sha_update(doc) -> + ["Generate SHA message digests by using sha_init, sha_update, and" + "sha_final, and check the result. Examples are from FIPS-180-1."]; +sha_update(suite) -> + []; +sha_update(Config) when is_list(Config) -> + ?line Ctx = crypto:sha_init(), + ?line Ctx1 = crypto:sha_update(Ctx, "abcdbcdecdefdefgefghfghighi"), + ?line Ctx2 = crypto:sha_update(Ctx1, "jhijkijkljklmklmnlmnomnopnopq"), + ?line m(crypto:sha_final(Ctx2), + hexstr2bin("84983E441C3BD26EBAAE4AA1F95129E5E54670F1")). + +%% +%% +sha256(doc) -> + ["Generate SHA-256 message digests and check the result. Examples are " + "from rfc-4634."]; +sha256(suite) -> + []; +sha256(Config) when is_list(Config) -> + if_supported(sha256, fun() -> sha256_do() end). + +sha256_do() -> + ?line m(crypto:hash(sha256, "abc"), + hexstr2bin("BA7816BF8F01CFEA4141" + "40DE5DAE2223B00361A396177A9CB410FF61F20015AD")), + ?line m(crypto:hash(sha256, "abcdbcdecdefdefgefghfghighijhijkijkljklmklm" + "nlmnomnopnopq"), + hexstr2bin("248D6A61D20638B8" + "E5C026930C3E6039A33CE45964FF2167F6ECEDD419DB06C1")). + +%% +%% +sha256_update(doc) -> + ["Generate SHA256 message digests by using sha256_init, sha256_update, and" + "sha256_final, and check the result. Examples are from rfc-4634."]; +sha256_update(suite) -> + []; +sha256_update(Config) when is_list(Config) -> + if_supported(sha256, fun() -> sha256_update_do() end). + +sha256_update_do() -> + ?line Ctx = crypto:hash_init(sha256), + ?line Ctx1 = crypto:hash_update(Ctx, "abcdbcdecdefdefgefghfghighi"), + ?line Ctx2 = crypto:hash_update(Ctx1, "jhijkijkljklmklmnlmnomnopnopq"), + ?line m(crypto:hash_final(Ctx2), + hexstr2bin("248D6A61D20638B8" + "E5C026930C3E6039A33CE45964FF2167F6ECEDD419DB06C1")). + + +%% +%% +sha512(doc) -> + ["Generate SHA-512 message digests and check the result. Examples are " + "from rfc-4634."]; +sha512(suite) -> + []; +sha512(Config) when is_list(Config) -> + if_supported(sha512, fun() -> sha512_do() end). + +sha512_do() -> + ?line m(crypto:hash(sha512, "abc"), + hexstr2bin("DDAF35A193617ABACC417349AE20413112E6FA4E89A97EA2" + "0A9EEEE64B55D39A2192992A274FC1A836BA3C23A3FEEBBD" + "454D4423643CE80E2A9AC94FA54CA49F")), + ?line m(crypto:hash(sha512, "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn" + "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"), + hexstr2bin("8E959B75DAE313DA8CF4F72814FC143F8F7779C6EB9F7FA1" + "7299AEADB6889018501D289E4900F7E4331B99DEC4B5433A" + "C7D329EEB6DD26545E96E55B874BE909")). + +%% +%% +sha512_update(doc) -> + ["Generate SHA512 message digests by using sha512_init, sha512_update, and" + "sha512_final, and check the result. Examples are from rfc=4634."]; +sha512_update(suite) -> + []; +sha512_update(Config) when is_list(Config) -> + if_supported(sha512, fun() -> sha512_update_do() end). + +sha512_update_do() -> + ?line Ctx = crypto:hash_init(sha512), + ?line Ctx1 = crypto:hash_update(Ctx, "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn"), + ?line Ctx2 = crypto:hash_update(Ctx1, "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"), + ?line m(crypto:hash_final(Ctx2), + hexstr2bin("8E959B75DAE313DA8CF4F72814FC143F8F7779C6EB9F7FA1" + "7299AEADB6889018501D289E4900F7E4331B99DEC4B5433A" + "C7D329EEB6DD26545E96E55B874BE909")). + +%% +%% +md5_mac(doc) -> + ["Generate some HMACs, using MD5, and check the result. Examples are " + "from RFC-2104."]; +md5_mac(suite) -> + []; +md5_mac(Config) when is_list(Config) -> + ?line m(crypto:md5_mac(hexstr2bin("0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"), + "Hi There"), + hexstr2bin("9294727a3638bb1c13f48ef8158bfc9d")), + ?line m(crypto:md5_mac(list_to_binary("Jefe"), + "what do ya want for nothing?"), + hexstr2bin("750c783e6ab0b503eaa86e310a5db738")), + ?line m(crypto:md5_mac(hexstr2bin("AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"), + hexstr2bin("DDDDDDDDDDDDDDDDDDDD" + "DDDDDDDDDDDDDDDDDDDD" + "DDDDDDDDDDDDDDDDDDDD" + "DDDDDDDDDDDDDDDDDDDD" + "DDDDDDDDDDDDDDDDDDDD")), + hexstr2bin("56be34521d144c88dbb8c733f0e8b3f6")). + +%% +%% +md5_mac_io(doc) -> + ["Generate some HMACs, using MD5, with Key an IO-list, and check the " + "result. Examples are from RFC-2104."]; +md5_mac_io(suite) -> + []; +md5_mac_io(Config) when is_list(Config) -> + ?line Key1 = hexstr2bin("0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"), + ?line {B11, B12} = split_binary(Key1, 4), + ?line Key11 = [B11,binary_to_list(B12)], + ?line m(crypto:md5_mac(Key11, "Hi There"), + hexstr2bin("9294727a3638bb1c13f48ef8158bfc9d")). + +%% +%% +des_cbc(doc) -> + "Encrypt and decrypt according to CBC DES. and check the result. " + "Example are from FIPS-81."; +des_cbc(suite) -> + []; +des_cbc(Config) when is_list(Config) -> + ?line Key = hexstr2bin("0123456789abcdef"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the time for all ", + ?line Cipher = crypto:des_cbc_encrypt(Key, IVec, Plain), + ?line m(Cipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" + "0f683788499a7c05f6")), + ?line m(list_to_binary(Plain), + crypto:des_cbc_decrypt(Key, IVec, Cipher)), + ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], + ?line Cipher2 = crypto:des_cbc_encrypt(Key, IVec, Plain2), + ?line m(Cipher2, hexstr2bin("b9916b8ee4c3da64b4f44e3cbefb9" + "9484521388fa59ae67d58d2e77e86062733")), + ?line m(list_to_binary(Plain2), + crypto:des_cbc_decrypt(Key, IVec, Cipher2)). + +%% +%% +des_cbc_iter(doc) -> + "Encrypt and decrypt according to CBC DES in two steps, and " + "check the result. Example are from FIPS-81."; +des_cbc_iter(suite) -> + []; +des_cbc_iter(Config) when is_list(Config) -> + ?line Key = hexstr2bin("0123456789abcdef"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain1 = "Now is the time ", + ?line Plain2 = "for all ", + ?line Cipher1 = crypto:des_cbc_encrypt(Key, IVec, Plain1), + ?line IVec2 = crypto:des_cbc_ivec(Cipher1), + ?line Cipher2 = crypto:des_cbc_encrypt(Key, IVec2, Plain2), + ?line Cipher = list_to_binary([Cipher1, Cipher2]), + ?line m(Cipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" + "0f683788499a7c05f6")). + +%% +%% +des_cfb(doc) -> + "Encrypt and decrypt according to CFB DES. and check the result. " + "Example is from FIPS-81."; +des_cfb(suite) -> + []; +des_cfb(Config) when is_list(Config) -> + ?line Key = hexstr2bin("0123456789abcdef"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the", + ?line Cipher = crypto:des_cfb_encrypt(Key, IVec, Plain), + ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")), + ?line m(list_to_binary(Plain), + crypto:des_cfb_decrypt(Key, IVec, Cipher)). + +%% +%% +des_cfb_iter(doc) -> + "Encrypt and decrypt according to CFB DES in two steps, and " + "check the result. Example is from FIPS-81."; +des_cfb_iter(suite) -> + []; +des_cfb_iter(Config) when is_list(Config) -> + ?line Key = hexstr2bin("0123456789abcdef"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain1 = "Now i", + ?line Plain2 = "s the", + ?line Cipher1 = crypto:des_cfb_encrypt(Key, IVec, Plain1), + ?line IVec2 = crypto:des_cfb_ivec(IVec, Cipher1), + ?line Cipher2 = crypto:des_cfb_encrypt(Key, IVec2, Plain2), + ?line Cipher = list_to_binary([Cipher1, Cipher2]), + ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")). + +%% +%% +des_ecb(doc) -> + "Encrypt and decrypt according to ECB DES and check the result. " + "Example are from FIPS-81."; +des_ecb(suite) -> + []; +des_ecb(Config) when is_list(Config) -> + ?line Key = hexstr2bin("0123456789abcdef"), + ?line Cipher1 = crypto:des_ecb_encrypt(Key, "Now is t"), + ?line m(Cipher1, hexstr2bin("3fa40e8a984d4815")), + ?line Cipher2 = crypto:des_ecb_encrypt(Key, "he time "), + ?line m(Cipher2, hexstr2bin("6a271787ab8883f9")), + ?line Cipher3 = crypto:des_ecb_encrypt(Key, "for all "), + ?line m(Cipher3, hexstr2bin("893d51ec4b563b53")), + ?line Cipher4 = crypto:des_ecb_decrypt(Key, hexstr2bin("3fa40e8a984d4815")), + ?line m(Cipher4, <<"Now is t">>), + ?line Cipher5 = crypto:des_ecb_decrypt(Key, hexstr2bin("6a271787ab8883f9")), + ?line m(Cipher5, <<"he time ">>), + ?line Cipher6 = crypto:des_ecb_decrypt(Key, hexstr2bin("893d51ec4b563b53")), + ?line m(Cipher6, <<"for all ">>). +%% +%% +rc2_cbc(doc) -> + "Encrypt and decrypt according to RC2 CBC and check the result. " + "Example stripped out from public_key application test"; +rc2_cbc(Config) when is_list(Config) -> + + Key = <<146,210,160,124,215,227,153,239,227,17,222,140,3,93,27,191>>, + IV = <<72,91,135,182,25,42,35,210>>, + + Cipher = <<36,245,206,158,168,230,58,69,148,137,32,192,250,41,237,181,181,251, 192,2,175,135,177,171,57,30,111,117,159,149,15,28,88,158,28,81,28,115, 85,219,241,82,117,222,91,85,73,117,164,25,182,52,191,64,123,57,26,19, 211,27,253,31,194,219,231,104,247,240,172,130,119,21,225,154,101,247, 32,216,42,216,133,169,78,22,97,27,227,26,196,224,172,168,17,9,148,55, 203,91,252,40,61,226,236,221,215,160,78,63,13,181,68,57,196,241,185, 207, 116,129,152,237,60,139,247,153,27,146,161,246,222,98,185,222,152, 187,135, 236,86,34,7,110,91,230,173,34,160,242,202,222,121,127,181,140, 101,203,195, 190,88,250,86,147,127,87,72,126,171,16,71,47,110,248,88, 14,29,143,161,152, 129,236,148,22,152,186,208,119,70,8,174,193,203,100, 193,203,200,117,102,242, 134,142,96,125,135,200,217,190,76,117,50,70, 209,186,101,241,200,91,40,193,54, 90,195,38,47,59,197,38,234,86,223,16, 51,253,204,129,20,171,66,21,241,26,135,216, 196,114,110,91,15,53,40, 164,201,136,113,95,247,51,181,208,241,68,168,98,151,36, 155,72,24,57, 42,191,14,125,204,10,167,214,233,138,115,125,234,121,134,227,26,247, 77,200,117,110,117,111,168,156,206,67,159,149,189,173,150,193,91,199, 216,153,22, 189,137,185,89,160,13,131,132,58,109,28,110,246,252,251,14, 232,91,38,52,29,101,188,69,123,50,0,130,178,93,73,239,118,7,77,35,59, 253,10,159,45,86,142,37,78,232,48>>, + Text = <<48,130,1,85,2,1,0,48,13,6,9,42,134,72,134,247,13,1,1,1,5,0,4,130,1,63,48,130, 1,59,2,1,0,2,65,0,222,187,252,44,9,214,27,173,162,169,70,47,36,34,78,84,204, 107,60,192,117,95,21,206,49,142,245,126,121,223,23,2,107,106,133,204,161,36, 40,2,114,69,4,93,242,5,42,50,154,47,154,211,209,123,120,161,5,114,173,155,34, 191,52,59,2,3,1,0,1,2,64,45,144,169,106,220,236,71,39,67,82,123,192,35,21,61, 143,13,110,150,180,12,142,210,40,39,109,70,125,132,51,6,66,159,134,112,85, 155,243,118,221,65,133,127,99,151,194,252,141,149,224,229,62,214,45,228,32, 184,85,67,14,228,161,184,161,2,33,0,255,202,240,131,130,57,49,224,115,255,83, 79,6,165,212,21,179,212,20,188,97,74,69,68,163,223,247,237,39,24,23,235,2,33, 0,222,234,48,36,33,23,219,45,59,136,55,245,143,29,165,48,255,131,207,146,131, 104,13,163,54,131,236,78,88,54,16,241,2,33,0,230,2,99,129,173,176,166,131, 241,106,143,76,9,107,70,41,121,185,228,39,124,200,159,62,216,169,5,180,111, 169,255,159,2,33,0,151,193,70,212,209,210,179,219,175,83,165,4,255,81,103,76, 92,39,24,0,222,132,208,3,244,241,10,198,171,54,227,129,2,32,43,250,20,31,16, 189,168,116,225,1,125,132,94,130,118,124,28,56,232,39,69,218,244,33,240,200, 205,9,215,101,35,135,7,7,7,7,7,7,7>>, + + Text = crypto:rc2_cbc_decrypt(Key, IV, Cipher), + Cipher = crypto:rc2_cbc_encrypt(Key, IV, Text). + +%% +%% +des3_cbc(doc) -> + "Encrypt and decrypt according to CBC 3DES, and check the result."; +des3_cbc(suite) -> + []; +des3_cbc(Config) when is_list(Config) -> + ?line Key1 = hexstr2bin("0123456789abcdef"), + ?line Key2 = hexstr2bin("fedcba9876543210"), + ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the time for all ", + ?line Cipher = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain), + ?line m(Cipher, hexstr2bin("8a2667ee5577267cd9b1af2c5a0480" + "0bac1ae66970fb2b89")), + ?line m(list_to_binary(Plain), + crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher)), + ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], + ?line Cipher2 = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain2), + ?line m(Cipher2, hexstr2bin("eb33ec6ede2c8e90f6877e77b95d5" + "4c83cee22907f7f0041ca1b7abe202bfafe")), + ?line m(list_to_binary(Plain2), + crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher2)), + + ?line Key = hexstr2bin("0123456789abcdef"), + ?line DESCipher = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain), + ?line m(DESCipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" + "0f683788499a7c05f6")), + ?line m(list_to_binary(Plain), + crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher)), + ?line DESCipher2 = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain2), + ?line m(DESCipher2, hexstr2bin("b9916b8ee4c3da64b4f44e3cbefb9" + "9484521388fa59ae67d58d2e77e86062733")), + ?line m(list_to_binary(Plain2), + crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher2)). + +%% +%% +des3_cfb(doc) -> + "Encrypt and decrypt according to CFB 3DES, and check the result."; +des3_cfb(suite) -> + []; +des3_cfb(Config) when is_list(Config) -> + case openssl_version() of + V when V < 16#90705F -> {skipped,"OpenSSL version too old"}; + _ -> des3_cfb_do() + end. + +des3_cfb_do() -> + ?line Key1 = hexstr2bin("0123456789abcdef"), + ?line Key2 = hexstr2bin("fedcba9876543210"), + ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), + ?line IVec = hexstr2bin("1234567890abcdef"), + ?line Plain = "Now is the time for all ", + ?line Cipher = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain), + ?line m(Cipher, hexstr2bin("fc0ba7a20646ba53cc8bff263f0937" + "1deab42a00666db02c")), + ?line m(list_to_binary(Plain), + crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher)), + ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], + ?line Cipher2 = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain2), + ?line m(Cipher2, hexstr2bin("8582c59ac01897422632c0accb66c" + "e413f5efab838fce7e41e2ba67705bad5bc")), + ?line m(list_to_binary(Plain2), + crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher2)). + +%% +%% +aes_cfb(doc) -> + "Encrypt and decrypt according to AES CFB 128 bit and check " + "the result. Example are from NIST SP 800-38A."; + +aes_cfb(suite) -> + []; +aes_cfb(Config) when is_list(Config) -> + +%% Sample data from NIST Spec.Publ. 800-38A +%% F.3.13 CFB128-AES128.Encrypt +%% Key 2b7e151628aed2a6abf7158809cf4f3c +%% IV 000102030405060708090a0b0c0d0e0f +%% Segment #1 +%% Input Block 000102030405060708090a0b0c0d0e0f +%% Output Block 50fe67cc996d32b6da0937e99bafec60 +%% Plaintext 6bc1bee22e409f96e93d7e117393172a +%% Ciphertext 3b3fd92eb72dad20333449f8e83cfb4a +%% Segment #2 +%% Input Block 3b3fd92eb72dad20333449f8e83cfb4a +%% Output Block 668bcf60beb005a35354a201dab36bda +%% Plaintext ae2d8a571e03ac9c9eb76fac45af8e51 +%% Ciphertext c8a64537a0b3a93fcde3cdad9f1ce58b +%% Segment #3 +%% Input Block c8a64537a0b3a93fcde3cdad9f1ce58b +%% Output Block 16bd032100975551547b4de89daea630 +%% Plaintext 30c81c46a35ce411e5fbc1191a0a52ef +%% Ciphertext 26751f67a3cbb140b1808cf187a4f4df +%% Segment #4 +%% Input Block 26751f67a3cbb140b1808cf187a4f4df +%% Output Block 36d42170a312871947ef8714799bc5f6 +%% Plaintext f69f2445df4f9b17ad2b417be66c3710 +%% Ciphertext c04b05357c5d1c0eeac4c66f9ff7f2e6 + + ?line Key = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + ?line IVec = hexstr2bin("000102030405060708090a0b0c0d0e0f"), + ?line Plain = hexstr2bin("6bc1bee22e409f96e93d7e117393172a"), + ?line Cipher = hexstr2bin("3b3fd92eb72dad20333449f8e83cfb4a"), + + %% Try all prefixes of plain and cipher. + aes_cfb_do(byte_size(Plain), Plain, Cipher, Key, IVec). + +aes_cfb_do(N, Plain, Cipher, Key, IVec) when N >= 0 -> + <<P:N/binary, _/binary>> = Plain, + <<C:N/binary, _/binary>> = Cipher, + ?line C = crypto:aes_cfb_128_encrypt(Key, IVec, P), + ?line P = crypto:aes_cfb_128_decrypt(Key, IVec, C), + aes_cfb_do(N-1, Plain, Cipher, Key, IVec); +aes_cfb_do(_, _, _, _, _) -> ok. + + +%% +%% +aes_cbc(doc) -> + "Encrypt and decrypt according to AES CBC 128 bit. and check the result. " + "Example are from NIST SP 800-38A."; + +aes_cbc(suite) -> + []; +aes_cbc(Config) when is_list(Config) -> + +%% Sample data from NIST Spec.Publ. 800-38A +%% F.2.1 CBC-AES128.Encrypt +%% Key 2b7e151628aed2a6abf7158809cf4f3c +%% IV 000102030405060708090a0b0c0d0e0f +%% Block #1 +%% Plaintext 6bc1bee22e409f96e93d7e117393172a +%% Input Block 6bc0bce12a459991e134741a7f9e1925 +%% Output Block 7649abac8119b246cee98e9b12e9197d +%% Ciphertext 7649abac8119b246cee98e9b12e9197d +%% Block #2 +%% Plaintext ae2d8a571e03ac9c9eb76fac45af8e51 +%% Input Block d86421fb9f1a1eda505ee1375746972c +%% Output Block 5086cb9b507219ee95db113a917678b2 +%% Ciphertext 5086cb9b507219ee95db113a917678b2 +%% Block #3 +%% Plaintext 30c81c46a35ce411e5fbc1191a0a52ef +%% Input Block 604ed7ddf32efdff7020d0238b7c2a5d +%% Output Block 73bed6b8e3c1743b7116e69e22229516 +%% Ciphertext 73bed6b8e3c1743b7116e69e22229516 +%% Block #4 +%% Plaintext f69f2445df4f9b17ad2b417be66c3710 +%% Input Block 8521f2fd3c8eef2cdc3da7e5c44ea206 +%% Output Block 3ff1caa1681fac09120eca307586e1a7 +%% Ciphertext 3ff1caa1681fac09120eca307586e1a7 +%% +%% F.2.2 CBC-AES128.Decrypt +%% Key 2b7e151628aed2a6abf7158809cf4f3c +%% IV 000102030405060708090a0b0c0d0e0f + %% Block #1 +%% Ciphertext 7649abac8119b246cee98e9b12e9197d +%% Input Block 7649abac8119b246cee98e9b12e9197d +%% Output Block 6bc0bce12a459991e134741a7f9e1925 +%% Plaintext 6bc1bee22e409f96e93d7e117393172a +%% Block #2 +%% Ciphertext 5086cb9b507219ee95db113a917678b2 +%% Input Block 5086cb9b507219ee95db113a917678b2 +%% Output Block d86421fb9f1a1eda505ee1375746972c +%% Plaintext ae2d8a571e03ac9c9eb76fac45af8e51 +%% Block #3 +%% Ciphertext 73bed6b8e3c1743b7116e69e22229516 +%% Input Block 73bed6b8e3c1743b7116e69e22229516 +%% Output Block 604ed7ddf32efdff7020d0238b7c2a5d +%% Plaintext 30c81c46a35ce411e5fbc1191a0a52ef +%% Block #4 +%% Ciphertext 3ff1caa1681fac09120eca307586e1a7 +%% Input Block 3ff1caa1681fac09120eca307586e1a7 +%% Output Block 8521f2fd3c8eef2cdc3da7e5c44ea206 +%% Plaintext f69f2445df4f9b17ad2b417be66c3710 + + ?line Key = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + ?line IVec = hexstr2bin("000102030405060708090a0b0c0d0e0f"), + ?line Plain = hexstr2bin("6bc1bee22e409f96e93d7e117393172a"), + ?line Cipher = crypto:aes_cbc_128_encrypt(Key, IVec, Plain), + ?line m(Cipher, hexstr2bin("7649abac8119b246cee98e9b12e9197d")), + ?line m(Plain, + crypto:aes_cbc_128_decrypt(Key, IVec, Cipher)). + +aes_cbc_iter(doc) -> + "Encrypt and decrypt according to CBC AES in steps"; +aes_cbc_iter(suite) -> []; +aes_cbc_iter(Config) when is_list(Config) -> + Key = list_to_binary(lists:seq(255,256-16*17,-17)), + IVec = list_to_binary(lists:seq(1,16*7,7)), + Plain = <<"One, two, three o'clock, four o'clock, rock" + "Five, six, seven o'clock, eight o'clock, rock" + "Nine, ten, eleven o'clock, twelve o'clock, rock" + "We're gonna rock around the clock tonight">>, + ?line 0 = size(Plain) rem 16, + + ?line Cipher = crypto:aes_cbc_128_encrypt(Key, IVec, Plain), + ?line Plain = crypto:aes_cbc_128_decrypt(Key, IVec, Cipher), + + ?line Cipher = aes_cbc_encrypt_iter(Key,IVec,Plain,<<>>), + ?line Plain = aes_cbc_decrypt_iter(Key,IVec,Cipher,<<>>), + ok. + +aes_cbc_encrypt_iter(_,_,<<>>, Acc) -> + Acc; +aes_cbc_encrypt_iter(Key,IVec,Data, Acc) -> + Bytes = 16 * (1 + size(Data) div (16*3)), + <<Chunk:Bytes/binary, Rest/binary>> = Data, + %%io:format("encrypt iter Chunk=~p Rest=~p\n",[Chunk,Rest]), + ?line Cipher = crypto:aes_cbc_128_encrypt(Key, IVec, Chunk), + ?line IVec2 = crypto:aes_cbc_ivec(Cipher), + aes_cbc_encrypt_iter(Key,IVec2,Rest, <<Acc/binary, Cipher/binary>>). + +aes_cbc_decrypt_iter(_,_,<<>>, Acc) -> + Acc; +aes_cbc_decrypt_iter(Key,IVec,Data, Acc) -> + Bytes = 16 * (1 + size(Data) div (16*5)), + <<Chunk:Bytes/binary, Rest/binary>> = Data, + %%io:format("decrypt iter Chunk=~p Rest=~p\n",[Chunk,Rest]), + ?line Plain = crypto:aes_cbc_128_decrypt(Key, IVec, Chunk), + ?line IVec2 = crypto:aes_cbc_ivec(Chunk), + aes_cbc_decrypt_iter(Key,IVec2,Rest, <<Acc/binary, Plain/binary>>). + + +aes_ctr(doc) -> "CTR"; +aes_ctr(Config) when is_list(Config) -> + %% Sample data from NIST Spec.Publ. 800-38A + %% F.5.1 CTR-AES128.Encrypt + Key128 = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + Samples128 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block + "6bc1bee22e409f96e93d7e117393172a", % Plaintext + "874d6191b620e3261bef6864990db6ce"},% Ciphertext + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", + "ae2d8a571e03ac9c9eb76fac45af8e51", + "9806f66b7970fdff8617187bb9fffdff"}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", + "30c81c46a35ce411e5fbc1191a0a52ef", + "5ae4df3edbd5d35e5b4f09020db03eab"}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", + "f69f2445df4f9b17ad2b417be66c3710", + "1e031dda2fbe03d1792170a0f3009cee"}], + lists:foreach(fun(S) -> aes_ctr_do(Key128,S) end, Samples128), + + %% F.5.3 CTR-AES192.Encrypt + Key192 = hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + Samples192 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block + "6bc1bee22e409f96e93d7e117393172a", % Plaintext + "1abc932417521ca24f2b0459fe7e6e0b"},% Ciphertext + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", + "ae2d8a571e03ac9c9eb76fac45af8e51", + "090339ec0aa6faefd5ccc2c6f4ce8e94"}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", + "30c81c46a35ce411e5fbc1191a0a52ef", + "1e36b26bd1ebc670d1bd1d665620abf7"}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", + "f69f2445df4f9b17ad2b417be66c3710", + "4f78a7f6d29809585a97daec58c6b050"}], + lists:foreach(fun(S) -> aes_ctr_do(Key192,S) end, Samples192), + + %% F.5.5 CTR-AES256.Encrypt + Key256 = hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + Samples256 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block + "6bc1bee22e409f96e93d7e117393172a", % Plaintext + "601ec313775789a5b7a7f504bbf3d228"},% Ciphertext + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", + "ae2d8a571e03ac9c9eb76fac45af8e51", + "f443e3ca4d62b59aca84e990cacaf5c5"}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", + "30c81c46a35ce411e5fbc1191a0a52ef", + "2b0930daa23de94ce87017ba2d84988d"}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", + "f69f2445df4f9b17ad2b417be66c3710", + "dfc9c58db67aada613c2dd08457941a6"}], + lists:foreach(fun(S) -> aes_ctr_do(Key256,S) end, Samples256). + + +aes_ctr_do(Key,{IVec, Plain, Cipher}) -> + ?line I = hexstr2bin(IVec), + ?line P = hexstr2bin(Plain), + ?line C = crypto:aes_ctr_encrypt(Key, I, P), + ?line m(C, hexstr2bin(Cipher)), + ?line m(P, crypto:aes_ctr_decrypt(Key, I, C)). + +aes_ctr_stream(doc) -> "CTR Streaming"; +aes_ctr_stream(Config) when is_list(Config) -> + %% Sample data from NIST Spec.Publ. 800-38A + %% F.5.1 CTR-AES128.Encrypt + Key128 = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + Samples128 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block + ["6bc1bee22e409f", "96e93d7e117393172a"], % Plaintext + ["874d6191b620e3261bef6864990db6ce"]}, % Ciphertext + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", + ["ae2d8a57", "1e03ac9c", "9eb76fac", "45af8e51"], + ["9806f66b7970fdff","8617187bb9fffdff"]}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", + ["30c81c46a35c", "e411e5fbc119", "1a0a52ef"], + ["5ae4df3e","dbd5d3","5e5b4f0902","0db03eab"]}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", + ["f69f2445df4f9b17ad2b417be66c3710"], + ["1e031dda2fbe","03d1792170a0","f3009cee"]}], + lists:foreach(fun(S) -> aes_ctr_stream_do(Key128,S) end, Samples128), + + %% F.5.3 CTR-AES192.Encrypt + Key192 = hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + Samples192 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block + ["6bc1bee22e409f96e93d7e117393172a"], % Plaintext + ["1abc9324","17521c","a24f2b04","59fe7e6e0b"]}, % Ciphertext + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", + ["ae2d8a57", "1e03ac9c9eb76fac", "45af8e51"], + ["090339ec0aa6faefd5ccc2c6f4ce8e94"]}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", + ["30c81c46a35ce411", "e5fbc1191a0a52ef"], + ["1e36b26bd1","ebc670d1bd1d","665620abf7"]}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", + ["f69f2445", "df4f9b17ad", "2b417be6", "6c3710"], + ["4f78a7f6d2980958","5a97daec58c6b050"]}], + lists:foreach(fun(S) -> aes_ctr_stream_do(Key192,S) end, Samples192), + + %% F.5.5 CTR-AES256.Encrypt + Key256 = hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + Samples256 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block + ["6bc1bee22e409f96", "e93d7e117393172a"], % Plaintext + ["601ec313775789", "a5b7a7f504bbf3d228"]}, % Ciphertext + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", + ["ae2d8a571e03ac9c9eb76fac45af8e51"], + ["f443e3ca","4d62b59aca84","e990cacaf5c5"]}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", + ["30c81c46","a35ce411","e5fbc119","1a0a52ef"], + ["2b0930daa23de94ce87017ba2d84988d"]}, + {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", + ["f69f2445df4f","9b17ad2b41","7be66c3710"], + ["dfc9c5","8db67aada6","13c2dd08","457941a6"]}], + lists:foreach(fun(S) -> aes_ctr_stream_do(Key256,S) end, Samples256). + + +aes_ctr_stream_do(Key,{IVec, PlainList, CipherList}) -> + ?line I = hexstr2bin(IVec), + ?line S = crypto:aes_ctr_stream_init(Key, I), + ?line C = aes_ctr_stream_do_iter( + S, PlainList, [], + fun(S2,P) -> crypto:aes_ctr_stream_encrypt(S2, P) end), + ?line m(C, hexstr2bin(lists:flatten(CipherList))), + ?line P = aes_ctr_stream_do_iter( + S, CipherList, [], + fun(S2,C2) -> crypto:aes_ctr_stream_decrypt(S2, C2) end), + ?line m(P, hexstr2bin(lists:flatten(PlainList))). + +aes_ctr_stream_do_iter(_State, [], Acc, _CipherFun) -> + iolist_to_binary(lists:reverse(Acc)); +aes_ctr_stream_do_iter(State, [Plain|Rest], Acc, CipherFun) -> + ?line P = hexstr2bin(Plain), + ?line {S2, C} = CipherFun(State, P), + aes_ctr_stream_do_iter(S2, Rest, [C | Acc], CipherFun). + +%% +%% +mod_exp_test(doc) -> + "mod_exp testing (A ^ M % P with bignums)"; +mod_exp_test(suite) -> + []; +mod_exp_test(Config) when is_list(Config) -> + mod_exp_aux_test(2, 5, 10, 8). + +mod_exp_aux_test(_, _, _, 0) -> + ok; +mod_exp_aux_test(B, E, M, N) -> + ?line R1 = crypto:mod_exp(B, E, M), + ?line R2 = ipow(B, E, M), + ?line m(R1, R2), + ?line mod_exp_aux_test(B, E*E+1, M*M+1, N-1). + +%% +%% +rand_uniform_test(doc) -> + "rand_uniform and random_bytes testing"; +rand_uniform_test(suite) -> + []; +rand_uniform_test(Config) when is_list(Config) -> + rand_uniform_aux_test(10), + ?line 10 = size(crypto:rand_bytes(10)). + +rand_uniform_aux_test(0) -> + ok; +rand_uniform_aux_test(N) -> + ?line L = N*1000, + ?line H = N*100000+1, + ?line crypto_rand_uniform(L, H), + ?line crypto_rand_uniform(-L, L), + ?line crypto_rand_uniform(-H, -L), + ?line crypto_rand_uniform(-H, L), + ?line rand_uniform_aux_test(N-1). + +crypto_rand_uniform(L,H) -> + ?line R1 = crypto:rand_uniform(L, H), + ?line t(R1 >= L), + ?line t(R1 < H). + + +%% +%% +strong_rand_test(doc) -> + "strong_rand_mpint and strong_random_bytes testing"; +strong_rand_test(suite) -> + []; +strong_rand_test(Config) when is_list(Config) -> + strong_rand_aux_test(180), + ?line 10 = byte_size(crypto:strong_rand_bytes(10)). + +strong_rand_aux_test(0) -> + ?line t(crypto:strong_rand_mpint(0,0,0) =:= <<0,0,0,0>>), + ok; +strong_rand_aux_test(1) -> + ?line t(crypto:erlint(crypto:strong_rand_mpint(1,0,1)) =:= 1), + ?line strong_rand_aux_test(0); +strong_rand_aux_test(N) -> + ?line t(sru_length(crypto:strong_rand_mpint(N,-1,0)) =< N), + ?line t(sru_length(crypto:strong_rand_mpint(N,0,0)) =:= N), + ?line t(crypto:erlint(crypto:strong_rand_mpint(N,0,1)) band 1 =:= 1), + ?line t(crypto:erlint(crypto:strong_rand_mpint(N,1,0)) bsr (N - 2) =:= 2#11), + ?line strong_rand_aux_test(N-1). + +sru_length(Mpint) -> + I = crypto:erlint(Mpint), + length(erlang:integer_to_list(I, 2)). + +%% +%% +%% +%% +rsa_verify_test(doc) -> + "rsa_verify testing (A ^ M % P with bignums)"; +rsa_verify_test(suite) -> + []; +rsa_verify_test(Config) when is_list(Config) -> + ?line H = <<178,28,54,104,36,80,144,66,140,201,135,17,36,97,114,124, + 194,164,172,147>>, + ?line SigBlob = <<153,44,121,71,132,1,192,159,78,33,29,62,153,64,191,70, + 208,239,166,208,220,167,49,111,128,67,91,253,24,63,194,241, + 97,157,135,226,121,162,150,156,60,49,236,90,151,67,239,23, + 92,103,89,254,17,165,78,181,64,128,13,210,86,111,209,76, + 115,34,107,227,151,47,80,185,143,85,202,55,245,163,226,26, + 139,104,196,6,96,82,108,197,13,0,12,70,153,109,107,180, + 130,246,156,182,56,96,31,220,227,218,136,211,252,43,8,14, + 145,155,191,206,72,194,80,52,54,206,53,27,6,188,195,29>>, + ?line BadSigBlob = <<153,44,121,71,132,1,192,159,78,33,29,62,153,64,191,70, + 208,239,166,208,220,167,49,111,128,67,91,253,24,63,194,241, + 97,157,135,226,121,162,150,156,60,49,236,90,151,67,239,23, + 92,103,89,254,17,165,78,181,64,128,13,210,86,111,209,76, + 115,107,34,227,151,47,80,185,143,85,202,55,245,163,226,26, + 139,104,196,6,96,82,108,197,13,0,12,70,153,109,107,180, + 130,246,156,182,56,96,31,220,227,218,136,211,252,43,8,14, + 145,155,191,206,72,194,80,52,54,206,53,27,6,188,195,29>>, + ?line E = <<35>>, + ?line N = <<0,199,209,142,191,86,92,148,103,37,250,217,175,169,109,10, + 130,139,34,237,174,90,97,118,7,185,57,137,252,236,177,193, + 228,16,62,29,153,144,64,207,152,240,152,206,136,89,64,6, + 3,187,89,57,241,219,88,215,75,70,120,20,145,229,37,1, + 67,138,204,17,39,231,249,239,116,142,169,99,149,41,65,123, + 26,225,133,0,41,85,77,181,35,100,162,223,92,220,207,50, + 63,168,193,171,174,199,23,214,201,63,157,76,125,6,54,73, + 76,89,40,33,147,208,189,76,98,24,61,8,10,110,165,119,165>>, + ?line Nbad = <<0,199,209,142,191,86,92,148,103,37,250,217,175,169,109,10, + 130,139,34,237,174,90,97,118,7,185,57,137,252,236,177,193, + 228,16,62,29,153,144,64,207,152,240,152,206,136,89,64,6, + 3,187,89,57,241,219,88,215,75,70,120,20,145,229,37,1, + 67,138,204,17,39,231,249,239,116,142,169,99,149,41,65,123, + 26,225,133,0,41,85,77,181,35,100,162,223,92,220,207,50, + 63,168,193,171,174,199,23,214,201,63,157,76,125,6,54,73, + 76,89,40,33,147,189,208,76,98,24,61,8,10,110,165,119,165>>, + ?line Ebad = <<77>>, + ?line m(crypto:rsa_verify(sized_binary(H), sized_binary(SigBlob), + [sized_binary(E), sized_binary(N)]), true), + ?line m(crypto:rsa_verify(sized_binary(H), sized_binary(SigBlob), + [sized_binary(Ebad), sized_binary(N)]), false), + ?line m(crypto:rsa_verify(sized_binary(H), sized_binary(SigBlob), + [sized_binary(E), sized_binary(Nbad)]), false), + ?line m(crypto:rsa_verify(sized_binary(H), sized_binary(BadSigBlob), + [sized_binary(E), sized_binary(N)]), false). + +%% +%% +dsa_verify_test(doc) -> + "dsa_verify testing (A ^ M % P with bignums)"; +dsa_verify_test(suite) -> + []; +dsa_verify_test(Config) when is_list(Config) -> + ?line Msg = <<48,130,2,245,160,3,2,1,2,2,1,1,48,9,6,7,42,134,72,206,56,4,3,48, + 58,49,11,48,9,6,3,85,4,6,19,2,85,83,49,26,48,24,6,3,85,4,10,19,17, + 84,101,115,116,32,67,101,114,116,105,102,105,99,97,116,101,115,49, + 15,48,13,6,3,85,4,3,19,6,68,83,65,32,67,65,48,30,23,13,48,49,48, + 52,49,57,49,52,53,55,50,48,90,23,13,49,49,48,52,49,57,49,52,53,55, + 50,48,90,48,93,49,11,48,9,6,3,85,4,6,19,2,85,83,49,26,48,24,6,3, + 85,4,10,19,17,84,101,115,116,32,67,101,114,116,105,102,105,99,97, + 116,101,115,49,50,48,48,6,3,85,4,3,19,41,86,97,108,105,100,32,68, + 83,65,32,83,105,103,110,97,116,117,114,101,115,32,69,69,32,67,101, + 114,116,105,102,105,99,97,116,101,32,84,101,115,116,52,48,130,1, + 182,48,130,1,43,6,7,42,134,72,206,56,4,1,48,130,1,30,2,129,129,0, + 228,139,175,64,140,21,215,61,124,238,3,150,18,104,193,32,5,232,23, + 202,158,116,101,75,154,84,151,42,120,51,218,165,197,114,234,52, + 179,148,104,66,213,27,253,119,240,168,66,158,100,147,144,182,194, + 2,49,70,19,122,3,105,204,152,45,86,157,94,35,95,40,191,173,127,15, + 208,105,149,98,92,26,7,42,94,140,115,73,126,253,18,34,142,85,229, + 86,233,174,114,41,150,135,8,39,215,119,67,240,134,184,9,10,27,20, + 165,230,3,230,69,121,77,233,250,83,95,193,9,189,126,197,195,2,21, + 0,128,63,228,252,243,76,229,62,203,15,23,10,42,84,108,208,103,108, + 13,59,2,129,128,102,212,22,138,32,173,254,209,50,159,165,127,167, + 179,208,234,119,63,235,108,162,228,41,216,216,188,33,221,154,247, + 204,229,180,119,77,223,236,218,162,140,156,117,18,90,31,254,102, + 211,17,194,239,132,67,236,169,136,110,76,186,76,63,53,150,199,103, + 252,153,189,15,153,41,19,145,78,216,2,174,254,107,175,80,86,170, + 47,30,181,42,200,238,34,71,37,120,107,33,221,20,63,206,240,16,129, + 247,150,29,156,65,187,94,68,146,93,46,198,30,184,205,105,200,143, + 63,59,62,208,79,162,206,217,3,129,132,0,2,129,128,15,83,40,172,56, + 47,61,243,17,97,65,195,61,167,214,122,247,246,1,50,211,33,113,16, + 20,213,195,62,77,235,25,162,140,175,158,8,61,65,10,255,204,162,71, + 130,122,86,161,163,253,236,178,139,183,57,181,202,160,25,133,130, + 155,150,104,168,187,107,186,144,164,225,173,101,182,68,49,210,30, + 34,47,83,65,79,250,156,248,47,232,44,67,36,22,126,43,216,100,247, + 100,250,240,121,72,29,185,2,109,144,54,204,235,54,15,242,57,171, + 125,39,236,247,71,111,221,51,196,126,77,238,36,87,163,107,48,105, + 48,29,6,3,85,29,14,4,22,4,20,179,51,215,81,162,4,13,68,251,157,64, + 241,18,98,113,176,83,246,105,13,48,31,6,3,85,29,35,4,24,48,22,128, + 20,116,21,213,36,28,189,94,101,136,31,225,139,9,126,127,234,25,72, + 78,97,48,23,6,3,85,29,32,4,16,48,14,48,12,6,10,96,134,72,1,101,3, + 2,1,48,1,48,14,6,3,85,29,15,1,1,255,4,4,3,2,6,192>>, + + ?line SigBlob = <<48,45,2,21,0,140,167,200,210,153,212,64,155,249,33,146,104,243, + 39,38,9,115,162,89,24,2,20,76,254,31,128,187,48,128,215,216, + 112,198,78,118,160,217,157,180,246,64,234>>, + ?line P_p = 157224271412839155721795253728878055347359513988016145491388196653004661857517720927482198111104095793441029858267073789634147217022008635826863307553453131345099940951090826856271796188522037524757740796268675508118348391218066949174594918958269259937813776150149068811425194955973128428675945283593831134219, + ?line Q_p = 1181895316321540581845959276009400765315408342791, + ?line G_p = 143872196713149000950547166575757355261637863805587906227228163275557375159769599033632918292482002186641475268486598023281100659643528846513898847919251032731261718358900479488287933293278745715922865499005559197328388506945134386346185262919258658109015074718441639029135304654725637911172671711310801418648, + + ?line Key = 12603618348903387232593303690286336220738319446775939686476278478034365380027994899970214309288018488811754534229198764622077544117034174589418477472887827980332636062691833965078594576024299807057520016043084384987871640003684704483975314128362610573625803532737054022545217931847268776098203204571431581966, + + ValidKey = [crypto:mpint(P_p), + crypto:mpint(Q_p), + crypto:mpint(G_p), + crypto:mpint(Key) + ], + + ?line m(my_dss_verify(sized_binary(Msg), sized_binary(SigBlob), + ValidKey), true), + + BadMsg = one_bit_wrong(Msg), + ?line m(my_dss_verify(sized_binary(BadMsg), sized_binary(SigBlob), + ValidKey), false), + BadSig = one_bit_wrong(SigBlob), + ?line m(my_dss_verify(sized_binary(Msg), sized_binary(BadSig), + ValidKey), false), + SizeErr = size(SigBlob) - 13, + + BadArg = (catch my_dss_verify(sized_binary(Msg), <<SizeErr:32, SigBlob/binary>>, + ValidKey)), + badarg = case element(1,element(2,BadArg)) of + badarg -> badarg; + function_clause -> badarg; + X -> X + end, + InValidKey = [crypto:mpint(P_p), + crypto:mpint(Q_p), + crypto:mpint(G_p), + crypto:mpint(Key+17) + ], + + ?line m(my_dss_verify(sized_binary(Msg), sized_binary(SigBlob), + InValidKey), false). + + +one_bit_wrong(List) when is_list(List) -> + lists:map(fun(Bin) -> one_bit_wrong(Bin) end, List); +one_bit_wrong(Bin) -> + Half = size(Bin) div 2, + <<First:Half/binary, Byte:8, Last/binary>> = Bin, + <<First/binary, (Byte+1):8, Last/binary>>. + + +%% +%% Sign tests + +rsa_sign_test(doc) -> + "rsa_sign testing"; +rsa_sign_test(suite) -> + []; +rsa_sign_test(Config) when is_list(Config) -> + PubEx = 65537, + PrivEx = 7531712708607620783801185371644749935066152052780368689827275932079815492940396744378735701395659435842364793962992309884847527234216715366607660219930945, + Mod = 7919488123861148172698919999061127847747888703039837999377650217570191053151807772962118671509138346758471459464133273114654252861270845708312601272799123, + Msg = <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" + "09812312908312378623487263487623412039812 huagasd">>, + + PrivKey = [PubEx, Mod, PrivEx], + PubKey = [PubEx, Mod], + PubKeyMpint = map_int_to_mpint(PubKey), + Sig1 = crypto:rsa_sign(sized_binary(Msg), map_int_to_mpint(PrivKey)), + Sig1 = crypto:sign(rsa, sha, Msg, PrivKey), + true = crypto:rsa_verify(sized_binary(Msg), sized_binary(Sig1), PubKeyMpint), + true = crypto:verify(rsa, sha, Msg, Sig1, PubKey), + + Sig2 = crypto:rsa_sign(md5, sized_binary(Msg), map_int_to_mpint(PrivKey)), + Sig2 = crypto:sign(rsa, md5, Msg, PrivKey), + true = crypto:rsa_verify(md5, sized_binary(Msg), sized_binary(Sig2), PubKeyMpint), + true = crypto:verify(rsa, md5, Msg, Sig2, PubKey), + + false = (Sig1 =:= Sig2), + false = crypto:rsa_verify(md5, sized_binary(Msg), sized_binary(Sig1), PubKeyMpint), + false = crypto:verify(rsa, md5, Msg, Sig1, PubKey), + true = crypto:rsa_verify(sha, sized_binary(Msg), sized_binary(Sig1), PubKeyMpint), + true = crypto:verify(rsa, sha, Msg, Sig1, PubKey), + + ok. +map_int_to_mpint(List) -> + lists:map(fun(E) -> crypto:mpint(E) end, List). + +rsa_sign_hash_test(doc) -> + "rsa_sign_hash testing"; +rsa_sign_hash_test(suite) -> + []; +rsa_sign_hash_test(Config) when is_list(Config) -> + PubEx = 65537, + PrivEx = 7531712708607620783801185371644749935066152052780368689827275932079815492940396744378735701395659435842364793962992309884847527234216715366607660219930945, + Mod = 7919488123861148172698919999061127847747888703039837999377650217570191053151807772962118671509138346758471459464133273114654252861270845708312601272799123, + Msg = <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" + "09812312908312378623487263487623412039812 huagasd">>, + + PrivKey = [crypto:mpint(PubEx), crypto:mpint(Mod), crypto:mpint(PrivEx)], + PubKey = [crypto:mpint(PubEx), crypto:mpint(Mod)], + MD5 = crypto:md5(sized_binary(Msg)), + SHA = crypto:sha(sized_binary(Msg)), + ?line Sig1 = crypto:rsa_sign(sha, {digest,SHA}, PrivKey), + ?line m(crypto:rsa_verify(sha, {digest,SHA}, sized_binary(Sig1),PubKey), true), + + ?line Sig2 = crypto:rsa_sign(md5, {digest,MD5}, PrivKey), + ?line m(crypto:rsa_verify(md5, {digest,MD5}, sized_binary(Sig2),PubKey), true), + + ?line m(Sig1 =:= Sig2, false), + ?line m(crypto:rsa_verify(md5, {digest,MD5}, sized_binary(Sig1),PubKey), false), + ?line m(crypto:rsa_verify(sha, {digest,SHA}, sized_binary(Sig2),PubKey), false), + + ok. + +dsa_sign_test(doc) -> + "dsa_sign testing"; +dsa_sign_test(suite) -> + []; +dsa_sign_test(Config) when is_list(Config) -> + Msg = <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" + "09812312908312378623487263487623412039812 huagasd">>, + + PubKey = _Y = 25854665488880835237281628794585130313500176551981812527054397586638455298000483144002221850980183404910190346416063318160497344811383498859129095184158800144312512447497510551471331451396405348497845813002058423110442376886564659959543650802132345311573634832461635601376738282831340827591903548964194832978, + PrivKey = _X = 441502407453038284293378221372000880210588566361, + ParamP = 109799869232806890760655301608454668257695818999841877165019612946154359052535682480084145133201304812979481136659521529774182959764860329095546511521488413513097576425638476458000255392402120367876345280670101492199681798674053929238558140260669578407351853803102625390950534052428162468100618240968893110797, + ParamQ = 1349199015905534965792122312016505075413456283393, + ParamG = 18320614775012672475365915366944922415598782131828709277168615511695849821411624805195787607930033958243224786899641459701930253094446221381818858674389863050420226114787005820357372837321561754462061849169568607689530279303056075793886577588606958623645901271866346406773590024901668622321064384483571751669, + + Params = [crypto:mpint(ParamP), crypto:mpint(ParamQ), crypto:mpint(ParamG)], + ?line Sig1 = my_dss_sign(sized_binary(Msg), Params ++ [crypto:mpint(PrivKey)]), + + ?line m(my_dss_verify(sized_binary(Msg), Sig1, + Params ++ [crypto:mpint(PubKey)]), true), + + ?line m(my_dss_verify(sized_binary(one_bit_wrong(Msg)), Sig1, + Params ++ [crypto:mpint(PubKey)]), false), + + ?line m(my_dss_verify(sized_binary(Msg), one_bit_wrong(Sig1), + Params ++ [crypto:mpint(PubKey)]), false), + + %%?line Bad = crypto:dss_sign(sized_binary(Msg), [Params, crypto:mpint(PubKey)]), + + ok. + +dsa_sign_hash_test(doc) -> + "dsa_sign_hash testing"; +dsa_sign_hash_test(suite) -> + []; +dsa_sign_hash_test(Config) when is_list(Config) -> + Msg = <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" + "09812312908312378623487263487623412039812 huagasd">>, + SHA = crypto:sha(sized_binary(Msg)), + + PubKey = _Y = 25854665488880835237281628794585130313500176551981812527054397586638455298000483144002221850980183404910190346416063318160497344811383498859129095184158800144312512447497510551471331451396405348497845813002058423110442376886564659959543650802132345311573634832461635601376738282831340827591903548964194832978, + PrivKey = _X = 441502407453038284293378221372000880210588566361, + ParamP = 109799869232806890760655301608454668257695818999841877165019612946154359052535682480084145133201304812979481136659521529774182959764860329095546511521488413513097576425638476458000255392402120367876345280670101492199681798674053929238558140260669578407351853803102625390950534052428162468100618240968893110797, + ParamQ = 1349199015905534965792122312016505075413456283393, + ParamG = 18320614775012672475365915366944922415598782131828709277168615511695849821411624805195787607930033958243224786899641459701930253094446221381818858674389863050420226114787005820357372837321561754462061849169568607689530279303056075793886577588606958623645901271866346406773590024901668622321064384483571751669, + + Params = [crypto:mpint(ParamP), crypto:mpint(ParamQ), crypto:mpint(ParamG)], + ?line Sig1 = crypto:dss_sign(sha, {digest,SHA}, Params ++ [crypto:mpint(PrivKey)]), + + ?line m(crypto:dss_verify(none, SHA, sized_binary(Sig1), + Params ++ [crypto:mpint(PubKey)]), true), + + ?line m(crypto:dss_verify(sized_binary(one_bit_wrong(Msg)), sized_binary(Sig1), + Params ++ [crypto:mpint(PubKey)]), false), + + ?line m(crypto:dss_verify(sized_binary(Msg), sized_binary(one_bit_wrong(Sig1)), + Params ++ [crypto:mpint(PubKey)]), false), + + %%?line Bad = crypto:dss_sign(sized_binary(Msg), [Params, crypto:mpint(PubKey)]), + + ok. + + +rsa_encrypt_decrypt(doc) -> + ["Test rsa_public_encrypt and rsa_private_decrypt functions."]; +rsa_encrypt_decrypt(suite) -> []; +rsa_encrypt_decrypt(Config) when is_list(Config) -> + PubEx = 65537, + PrivEx = 7531712708607620783801185371644749935066152052780368689827275932079815492940396744378735701395659435842364793962992309884847527234216715366607660219930945, + Mod = 7919488123861148172698919999061127847747888703039837999377650217570191053151807772962118671509138346758471459464133273114654252861270845708312601272799123, + + PrivKey = [PubEx, Mod, PrivEx], + PubKey = [PubEx, Mod], + + Msg = <<"7896345786348 Asldi">>, + + ?line PKCS1 = rsa_public_encrypt(Msg, PubKey, rsa_pkcs1_padding), + ?line PKCS1Dec = rsa_private_decrypt(PKCS1, PrivKey, rsa_pkcs1_padding), + io:format("PKCS1Dec ~p~n",[PKCS1Dec]), + ?line Msg = PKCS1Dec, + + ?line OAEP = rsa_public_encrypt(Msg, PubKey, rsa_pkcs1_oaep_padding), + ?line Msg = rsa_private_decrypt(OAEP, PrivKey, rsa_pkcs1_oaep_padding), + + <<Msg2Len:32,_/binary>> = crypto:mpint(Mod), + Msg2 = list_to_binary(lists:duplicate(Msg2Len-1, $X)), + ?line NoPad = rsa_public_encrypt(Msg2, PubKey, rsa_no_padding), + ?line NoPadDec = rsa_private_decrypt(NoPad, PrivKey, rsa_no_padding), + ?line NoPadDec = Msg2, + + ShouldBeError = (catch rsa_public_encrypt(Msg, PubKey, rsa_no_padding)), + ?line {'EXIT', {encrypt_failed,_}} = ShouldBeError, + +%% ?line SSL = rsa_public_encrypt(Msg, PubKey, rsa_sslv23_padding), +%% ?line Msg = rsa_private_decrypt(SSL, PrivKey, rsa_sslv23_padding), + + ?line PKCS1_2 = rsa_private_encrypt(Msg, PrivKey, rsa_pkcs1_padding), + ?line PKCS1_2Dec = rsa_public_decrypt(PKCS1_2, PubKey, rsa_pkcs1_padding), + io:format("PKCS2Dec ~p~n",[PKCS1_2Dec]), + ?line Msg = PKCS1_2Dec, + + ?line PKCS1_3 = rsa_private_encrypt(Msg2, PrivKey, rsa_no_padding), + ?line PKCS1_3Dec = rsa_public_decrypt(PKCS1_3, PubKey, rsa_no_padding), + io:format("PKCS2Dec ~p~n",[PKCS1_3Dec]), + ?line Msg2 = PKCS1_3Dec, + + ?line {'EXIT', {encrypt_failed,_}} = + (catch rsa_private_encrypt(Msg, PrivKey, rsa_no_padding)), + + ok. + +rsa_public_encrypt(Msg, Key, Pad) -> + C1 = crypto:rsa_public_encrypt(Msg, Key, Pad), + C2 = crypto:rsa_public_encrypt(Msg, lists:map(fun(E) -> crypto:mpint(E) end, Key), Pad), + {C1,C2}. + +rsa_public_decrypt(Msg, Key, Pad) -> + R = crypto:rsa_public_decrypt(Msg, Key, Pad), + R = crypto:rsa_public_decrypt(Msg, lists:map(fun(E) -> crypto:mpint(E) end, Key), Pad). + +rsa_private_encrypt(Msg, Key, Pad) -> + R = crypto:rsa_private_encrypt(Msg, Key, Pad), + R = crypto:rsa_private_encrypt(Msg, lists:map(fun(E) -> crypto:mpint(E) end, Key), Pad). + +rsa_private_decrypt({C1,C2}, Key, Pad) -> + R = crypto:rsa_private_decrypt(C1, Key, Pad), + R = crypto:rsa_private_decrypt(C2, Key, Pad), + R = crypto:rsa_private_decrypt(C1, lists:map(fun(E) -> crypto:mpint(E) end, Key), Pad), + R = crypto:rsa_private_decrypt(C2, lists:map(fun(E) -> crypto:mpint(E) end, Key), Pad). + + +dh(doc) -> + ["Test dh (Diffie-Hellman) functions."]; +dh(suite) -> []; +dh(Config) when is_list(Config) -> + Self = self(), + GenP = fun() -> + %% Gen Param may take arbitrary long time to finish + %% That's not a bug in erlang crypto application. + ?line DHPs = crypto:dh_generate_parameters(512,2), + ?line ok = crypto:dh_check(DHPs), + Self ! {param, DHPs} + end, + Pid = spawn(GenP), + receive + {param, DHPs} -> + timer:sleep(100), + io:format("DHP ~p~n", [DHPs]), + DHPs_mpint = lists:map(fun(E) -> sized_binary(E) end, DHPs), + ?line {Pub1,Priv1} = crypto:generate_key(dh, DHPs), + io:format("Key1:~n~p~n~p~n~n", [Pub1,Priv1]), + ?line {Pub2,Priv2} = crypto:dh_generate_key(DHPs_mpint), + io:format("Key2:~n~p~n~p~n~n", [Pub2,Priv2]), + ?line A = crypto:compute_key(dh, Pub1, unsized_binary(Priv2), DHPs), + ?line A = crypto:dh_compute_key(sized_binary(Pub1), Priv2, DHPs_mpint), + timer:sleep(100), %% Get another thread see if that triggers problem + ?line B = crypto:compute_key(dh, unsized_binary(Pub2), Priv1, DHPs), + ?line B = crypto:dh_compute_key(Pub2, sized_binary(Priv1), DHPs_mpint), + io:format("A ~p~n",[A]), + io:format("B ~p~n",[B]), + ?line A = B + after 50000 -> + io:format("Killing Param generation which took to long ~p~n",[Pid]), + exit(Pid, kill) + end. + + +ec(doc) -> + ["Test ec (Ecliptic Curve) functions."]; +ec(suite) -> []; +ec(Config) when is_list(Config) -> + if_supported(ecdh, fun() -> ec_do() end). + +ec_do() -> + %% test for a name curve + {D2_pub, D2_priv} = crypto:generate_key(ecdh, sect113r2), + PrivECDH = [D2_priv, sect113r2], + PubECDH = [D2_pub, sect113r2], + %%TODO: find a published test case for a EC key + + %% test for a full specified curve and public key, + %% taken from csca-germany_013_self_signed_cer.pem + PubKey = <<16#04, 16#4a, 16#94, 16#49, 16#81, 16#77, 16#9d, 16#df, + 16#1d, 16#a5, 16#e7, 16#c5, 16#27, 16#e2, 16#7d, 16#24, + 16#71, 16#a9, 16#28, 16#eb, 16#4d, 16#7b, 16#67, 16#75, + 16#ae, 16#09, 16#0a, 16#51, 16#45, 16#19, 16#9b, 16#d4, + 16#7e, 16#a0, 16#81, 16#e5, 16#5e, 16#d4, 16#a4, 16#3f, + 16#60, 16#7c, 16#6a, 16#50, 16#ee, 16#36, 16#41, 16#8a, + 16#87, 16#ff, 16#cd, 16#a6, 16#10, 16#39, 16#ca, 16#95, + 16#76, 16#7d, 16#ae, 16#ca, 16#c3, 16#44, 16#3f, 16#e3, 16#2c>>, + <<P:264/integer>> = <<16#00, 16#a9, 16#fb, 16#57, 16#db, 16#a1, 16#ee, 16#a9, + 16#bc, 16#3e, 16#66, 16#0a, 16#90, 16#9d, 16#83, 16#8d, + 16#72, 16#6e, 16#3b, 16#f6, 16#23, 16#d5, 16#26, 16#20, + 16#28, 16#20, 16#13, 16#48, 16#1d, 16#1f, 16#6e, 16#53, 16#77>>, + <<A:256/integer>> = <<16#7d, 16#5a, 16#09, 16#75, 16#fc, 16#2c, 16#30, 16#57, + 16#ee, 16#f6, 16#75, 16#30, 16#41, 16#7a, 16#ff, 16#e7, + 16#fb, 16#80, 16#55, 16#c1, 16#26, 16#dc, 16#5c, 16#6c, + 16#e9, 16#4a, 16#4b, 16#44, 16#f3, 16#30, 16#b5, 16#d9>>, + <<B:256/integer>> = <<16#26, 16#dc, 16#5c, 16#6c, 16#e9, 16#4a, 16#4b, 16#44, + 16#f3, 16#30, 16#b5, 16#d9, 16#bb, 16#d7, 16#7c, 16#bf, + 16#95, 16#84, 16#16, 16#29, 16#5c, 16#f7, 16#e1, 16#ce, + 16#6b, 16#cc, 16#dc, 16#18, 16#ff, 16#8c, 16#07, 16#b6>>, + BasePoint = <<16#04, 16#8b, 16#d2, 16#ae, 16#b9, 16#cb, 16#7e, 16#57, + 16#cb, 16#2c, 16#4b, 16#48, 16#2f, 16#fc, 16#81, 16#b7, + 16#af, 16#b9, 16#de, 16#27, 16#e1, 16#e3, 16#bd, 16#23, + 16#c2, 16#3a, 16#44, 16#53, 16#bd, 16#9a, 16#ce, 16#32, + 16#62, 16#54, 16#7e, 16#f8, 16#35, 16#c3, 16#da, 16#c4, + 16#fd, 16#97, 16#f8, 16#46, 16#1a, 16#14, 16#61, 16#1d, + 16#c9, 16#c2, 16#77, 16#45, 16#13, 16#2d, 16#ed, 16#8e, + 16#54, 16#5c, 16#1d, 16#54, 16#c7, 16#2f, 16#04, 16#69, 16#97>>, + <<Order:264/integer>> = <<16#00, 16#a9, 16#fb, 16#57, 16#db, 16#a1, 16#ee, 16#a9, + 16#bc, 16#3e, 16#66, 16#0a, 16#90, 16#9d, 16#83, 16#8d, + 16#71, 16#8c, 16#39, 16#7a, 16#a3, 16#b5, 16#61, 16#a6, + 16#f7, 16#90, 16#1e, 16#0e, 16#82, 16#97, 16#48, 16#56, 16#a7>>, + CoFactor = 1, + Curve = {{prime_field,P},{A,B,none},BasePoint, Order,CoFactor}, + + Msg = <<99,234,6,64,190,237,201,99,80,248,58,40,70,45,149,218,5,246,242,63>>, + Sign = crypto:sign(ecdsa, sha, Msg, PrivECDH), + ?line true = crypto:verify(ecdsa, sha, Msg, Sign, PubECDH), + ?line false = crypto:verify(ecdsa, sha, Msg, <<10,20>>, PubECDH), + + ok. + +srp3(doc) -> + ["SRP-3 test vectors generated by http://srp.stanford.edu/demo/demo.html"]; +srp3(suite) -> []; +srp3(Config) when is_list(Config) -> + Username = <<"alice">>, + Password = <<"password123">>, + Salt = hexstr2bin("2857827A19266A1F2BC6"), + Prime = hexstr2bin("EEAF0AB9ADB38DD69C33F80AFA8FC5E86072618775FF3C0B9EA2314C" + "9C256576D674DF7496EA81D3383B4813D692C6E0E0D5D8E250B98BE4" + "8E495C1D6089DAD15DC7D7B46154D6B6CE8EF4AD69B15D4982559B29" + "7BCF1885C529F566660E57EC68EDBC3C05726CC02FD4CBF4976EAA9A" + "FD5138FE8376435B9FC61D2FC0EB06E3"), + Generator = <<2>>, + Version = '3', + Scrambler = hexstr2bin("02E2476A"), + + %% X = hexstr2bin("96E54AB0CD4C5123EDCFA4A1502918AAD3C9E2A8"), + Verifier = hexstr2bin("96EB5F13621D911AA1CA405DE9C64217D4108EEEECAFFE500034FE0E" + "C031E42C8714667C161BCE0E7996F7DDE1B63824C130D2D7286C08C0" + "49758420735961347112AE102A3F23B3F687F8FEE0DF2BFAF933C608" + "D6FE5B5EEE3116FE54016E065BF8E8C9FDBBC08719231AC215149140" + "519E8FDD9AA4F410C28A58AF42974D2D"), + ClientPrivate = hexstr2bin("6411DE75538BED8170677D577D0608F39112BC95B503C447EB6AC945" + "49C75C7B"), + ServerPrivate = hexstr2bin("85E44A6F694DBE676145DB245A045CD37C99F05C562C7840A31F270D" + "9AADCF8B"), + ClientPublic = hexstr2bin("B22B1FFA2244B8CB94F3A9080F419CAEAB0DBA93EA1965B5E84587EE" + "55C79E7A118865DC59B9D0353362C2A8261E7C1B0D221A0E233C2AD1" + "640DACBB8664CBC9733EAC392DA7800142860380C3FC573C3C064329" + "CF54063FD114C7210E9CB3A611EA8002B1844B698F930D95D143899B" + "948A090E0C25938E5F84067D1883DC63"), + ServerPublic = hexstr2bin("93A8C4D8B7F7395ADCFD4ABA37B015124513D3F37B3E85EB23064BE5" + "F53C0AE32FFB9D8C0AA0DCFFA74D632DD67DEBB5C35AAE9812286CC8" + "C43CC176ECBC6D3F447594D9554E995B2509127BF88FADDDA4982D03" + "8EC3001320712D3B1269308CE70F319B2295FA57674F03A2D993CFB1" + "F84C35B7D0C012FA73CD4C8F7D5A71C7"), + + SessionKey = hexstr2bin("C29A986C4D521BBC66428ED11D994CD7431574A6184B83CDCC345092" + "791E75748A1D38CAC4BD14760F0D2694B711236419240FF2F172454C" + "46ABF4FF39498DAFDD2C82924F7D7BD76CDFCE688C77D93F18A65409" + "9176A9192615DC0277AE7C12F1F6A7F6563FCA11675D809AF578BDE5" + "2B51E05D440B63099A017A0B45044801"), + UserPassHash = crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])]), + Verifier = crypto:mod_pow(Generator, UserPassHash, Prime), + ClientPublic = crypto:mod_pow(Generator, ClientPrivate, Prime), + + {ClientPublic, ClientPrivate} = crypto:generate_key(srp, {user, [Generator, Prime, Version]}, ClientPrivate), + {ServerPublic, ServerPrivate} = crypto:generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, ServerPrivate), + SessionKey = crypto:compute_key(srp, ServerPublic, {ClientPublic, ClientPrivate}, + {user, [UserPassHash, Prime, Generator, Version, Scrambler]}), + SessionKey = crypto:compute_key(srp, ClientPublic, {ServerPublic, ServerPrivate}, + {host, [Verifier, Prime, Version, Scrambler]}). + +srp6(doc) -> + ["SRP-6 test vectors generated by http://srp.stanford.edu/demo/demo.html"]; +srp6(suite) -> []; +srp6(Config) when is_list(Config) -> + Username = <<"alice">>, + Password = <<"password123">>, + Salt = hexstr2bin("2857827A19266A1F2BC6"), + Prime = hexstr2bin("EEAF0AB9ADB38DD69C33F80AFA8FC5E86072618775FF3C0B9EA2314C" + "9C256576D674DF7496EA81D3383B4813D692C6E0E0D5D8E250B98BE4" + "8E495C1D6089DAD15DC7D7B46154D6B6CE8EF4AD69B15D4982559B29" + "7BCF1885C529F566660E57EC68EDBC3C05726CC02FD4CBF4976EAA9A" + "FD5138FE8376435B9FC61D2FC0EB06E3"), + Generator = <<2>>, + Version = '6', + Scrambler = hexstr2bin("0A2534C0BF52A0DA9001EEC62CF2A546AB0908A7"), + Verifier = hexstr2bin("96EB5F13621D911AA1CA405DE9C64217D4108EEEECAFFE500034FE0E" + "C031E42C8714667C161BCE0E7996F7DDE1B63824C130D2D7286C08C0" + "49758420735961347112AE102A3F23B3F687F8FEE0DF2BFAF933C608" + "D6FE5B5EEE3116FE54016E065BF8E8C9FDBBC08719231AC215149140" + "519E8FDD9AA4F410C28A58AF42974D2D"), + ClientPrivate = hexstr2bin("6411DE75538BED8170677D577D0608F39112BC95B503C447EB6AC945" + "49C75C7B"), + ServerPrivate = hexstr2bin("85E44A6F694DBE676145DB245A045CD37C99F05C562C7840A31F270D" + "9AADCF8B"), + ClientPublic = hexstr2bin("B22B1FFA2244B8CB94F3A9080F419CAEAB0DBA93EA1965B5E84587EE" + "55C79E7A118865DC59B9D0353362C2A8261E7C1B0D221A0E233C2AD1" + "640DACBB8664CBC9733EAC392DA7800142860380C3FC573C3C064329" + "CF54063FD114C7210E9CB3A611EA8002B1844B698F930D95D143899B" + "948A090E0C25938E5F84067D1883DC63"), + ServerPublic = hexstr2bin("D2D07845CE7ECDB9845DD36B10ACD3598CC29049DE9F467F84CE16B6" + "D97A6DC567AF8B0F9FEDF74962400AD5C357951E64E67B641246F264" + "C8DE6D9A72E554D6C8D3194548780A0C438A0FCC509CA88A14AA1DEB" + "C0F09E4B37A965D1545DB4AD361346F3189B0EA569C06D326C4E4797" + "9E381C748293B7C0591BE0BE419E053E"), + + SessionKey = hexstr2bin("19D22C19612874EBF1F2581F8EFCFDC44C6FDA3B87B0A73823D7E962" + "554295D4E48D3A336523ADBDDD0EC8FB0F02687109E97E01C17C93CC" + "7216F9CD8A4AC39F0429857D8D1023066614BDFCBCB89F59A0FEB81C" + "72E992AAD89095A84B6A5FADA152369AB1E350A03693BEF044DF3EDF" + "0C34741F4696C30E9F675D09F58ACBEB"), + UserPassHash = crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])]), + Verifier = crypto:mod_pow(Generator, UserPassHash, Prime), + ClientPublic = crypto:mod_pow(Generator, ClientPrivate, Prime), + + {ClientPublic, ClientPrivate} = crypto:generate_key(srp, {user, [Generator, Prime, Version]}, ClientPrivate), + {ServerPublic, ServerPrivate} = crypto:generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, ServerPrivate), + SessionKey = crypto:compute_key(srp, ServerPublic, {ClientPublic, ClientPrivate}, + {user, [UserPassHash, Prime, Generator, Version, Scrambler]}), + SessionKey = crypto:compute_key(srp, ClientPublic, {ServerPublic, ServerPrivate}, + {host, [Verifier, Prime, Version, Scrambler]}). + +srp6a(doc) -> + ["SRP-6a test vectors from RFC5054."]; +srp6a(suite) -> []; +srp6a(Config) when is_list(Config) -> + Username = <<"alice">>, + Password = <<"password123">>, + Salt = hexstr2bin("BEB25379D1A8581EB5A727673A2441EE"), + Prime = hexstr2bin("EEAF0AB9ADB38DD69C33F80AFA8FC5E86072618775FF3C0B9EA2314C" + "9C256576D674DF7496EA81D3383B4813D692C6E0E0D5D8E250B98BE4" + "8E495C1D6089DAD15DC7D7B46154D6B6CE8EF4AD69B15D4982559B29" + "7BCF1885C529F566660E57EC68EDBC3C05726CC02FD4CBF4976EAA9A" + "FD5138FE8376435B9FC61D2FC0EB06E3"), + Generator = <<2>>, + Version = '6a', + Scrambler = hexstr2bin("CE38B9593487DA98554ED47D70A7AE5F462EF019"), + Verifier = hexstr2bin("7E273DE8696FFC4F4E337D05B4B375BEB0DDE1569E8FA00A9886D812" + "9BADA1F1822223CA1A605B530E379BA4729FDC59F105B4787E5186F5" + "C671085A1447B52A48CF1970B4FB6F8400BBF4CEBFBB168152E08AB5" + "EA53D15C1AFF87B2B9DA6E04E058AD51CC72BFC9033B564E26480D78" + "E955A5E29E7AB245DB2BE315E2099AFB"), + ClientPrivate = hexstr2bin("60975527035CF2AD1989806F0407210BC81EDC04E2762A56AFD529DD" + "DA2D4393"), + ServerPrivate = hexstr2bin("E487CB59D31AC550471E81F00F6928E01DDA08E974A004F49E61F5D1" + "05284D20"), + ClientPublic = hexstr2bin("61D5E490F6F1B79547B0704C436F523DD0E560F0C64115BB72557EC4" + "4352E8903211C04692272D8B2D1A5358A2CF1B6E0BFCF99F921530EC" + "8E39356179EAE45E42BA92AEACED825171E1E8B9AF6D9C03E1327F44" + "BE087EF06530E69F66615261EEF54073CA11CF5858F0EDFDFE15EFEA" + "B349EF5D76988A3672FAC47B0769447B"), + ServerPublic = hexstr2bin("BD0C61512C692C0CB6D041FA01BB152D4916A1E77AF46AE105393011" + "BAF38964DC46A0670DD125B95A981652236F99D9B681CBF87837EC99" + "6C6DA04453728610D0C6DDB58B318885D7D82C7F8DEB75CE7BD4FBAA" + "37089E6F9C6059F388838E7A00030B331EB76840910440B1B27AAEAE" + "EB4012B7D7665238A8E3FB004B117B58"), + + SessionKey = hexstr2bin("B0DC82BABCF30674AE450C0287745E7990A3381F63B387AAF271A10D" + "233861E359B48220F7C4693C9AE12B0A6F67809F0876E2D013800D6C" + "41BB59B6D5979B5C00A172B4A2A5903A0BDCAF8A709585EB2AFAFA8F" + "3499B200210DCC1F10EB33943CD67FC88A2F39A4BE5BEC4EC0A3212D" + "C346D7E474B29EDE8A469FFECA686E5A"), + UserPassHash = crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])]), + Verifier = crypto:mod_pow(Generator, UserPassHash, Prime), + + {ClientPublic, ClientPrivate} = crypto:generate_key(srp, {user, [Generator, Prime, Version]}, ClientPrivate), + {ServerPublic, ServerPrivate} = crypto:generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, ServerPrivate), + + SessionKey = crypto:compute_key(srp, ServerPublic, {ClientPublic, ClientPrivate}, + {user, [UserPassHash, Prime, Generator, Version, Scrambler]}), + SessionKey = crypto:compute_key(srp, ClientPublic, {ServerPublic, ServerPrivate}, + {host, [Verifier, Prime, Version, Scrambler]}). + +%% +%% +exor_test(doc) -> + ["Test the exor function."]; +exor_test(suite) -> + []; +exor_test(Config) when is_list(Config) -> + B = <<1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>, + Z1 = zero_bin(B), + Z1 = crypto:exor(B, B), + B1 = crypto:rand_bytes(100), + B2 = crypto:rand_bytes(100), + Z2 = zero_bin(B1), + Z2 = crypto:exor(B1, B1), + Z2 = crypto:exor(B2, B2), + R = xor_bytes(B1, B2), + R = crypto:exor(B1, B2), + ok. + +%% +%% +rc4_test(doc) -> + ["Test rc4 encryption ."]; +rc4_test(suite) -> + []; +rc4_test(Config) when is_list(Config) -> + CT1 = <<"Yo baby yo">>, + R1 = <<118,122,68,110,157,166,141,212,139,39>>, + K = "apaapa", + R1 = crypto:rc4_encrypt(K, CT1), + CT1 = crypto:rc4_encrypt(K, R1), + CT2 = lists:seq(0, 255), + R2 = crypto:rc4_encrypt(K, CT2), + CT2 = binary_to_list(crypto:rc4_encrypt(K, R2)), + ok. + +rc4_stream_test(doc) -> + ["Test rc4 stream encryption ."]; +rc4_stream_test(suite) -> + []; +rc4_stream_test(Config) when is_list(Config) -> + CT1 = <<"Yo ">>, + CT2 = <<"baby yo">>, + K = "apaapa", + State0 = crypto:rc4_set_key(K), + {State1, R1} = crypto:rc4_encrypt_with_state(State0, CT1), + {_State2, R2} = crypto:rc4_encrypt_with_state(State1, CT2), + R = list_to_binary([R1, R2]), + <<118,122,68,110,157,166,141,212,139,39>> = R, + ok. + +blowfish_cfb64(doc) -> ["Test Blowfish encrypt/decrypt."]; +blowfish_cfb64(suite) -> []; +blowfish_cfb64(Config) when is_list(Config) -> + Key = <<1,35,69,103,137,171,205,239,240,225,210,195,180,165,150,135>>, + + IVec = <<254,220,186,152,118,84,50,16>>, + Plain = <<"7654321 Now is the time for ">>, + Enc = <<231,50,20,162,130,33,57,202,242,110,207,109,46,185,231,110,61,163,222,4,209,81,114,0,81,157,87,166>>, + + Enc = crypto:blowfish_cfb64_encrypt(Key, IVec, Plain), + Plain = crypto:blowfish_cfb64_decrypt(Key, IVec, Enc), + + Key2 = <<"A2B4C">>, + IVec2 = <<"12345678">>, + Plain2 = <<"badger at my table....!">>, + Enc2 = <<173,76,128,155,70,81,79,228,4,162,188,92,119,53,144,89,93,236,28,164,176,16,138>>, + + Enc2 = crypto:blowfish_cfb64_encrypt(Key2, IVec2, Plain2), + Plain2 = crypto:blowfish_cfb64_decrypt(Key2, IVec2, Enc2). + + +smp(doc) -> "Check concurrent access to crypto driver"; +smp(suite) -> []; +smp(Config) -> + case erlang:system_info(smp_support) of + true -> + NumOfProcs = erlang:system_info(schedulers), + io:format("smp starting ~p workers\n",[NumOfProcs]), + Seeds = [random:uniform(9999) || _ <- lists:seq(1,NumOfProcs)], + Parent = self(), + Pids = [spawn_link(fun()-> worker(Seed,Config,Parent) end) + || Seed <- Seeds], + wait_pids(Pids); + + false -> + {skipped,"No smp support"} + end. + +worker(Seed, Config, Parent) -> + io:format("smp worker ~p, seed=~p~n",[self(),Seed]), + random:seed(Seed,Seed,Seed), + worker_loop(100, Config), + %%io:format("worker ~p done\n",[self()]), + Parent ! self(). + +worker_loop(0, _) -> + ok; +worker_loop(N, Config) -> + Funcs = { md5, md5_update, md5_mac, md5_mac_io, sha, sha_update, des_cbc, + aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test, strong_rand_test, + rsa_verify_test, exor_test, rc4_test, rc4_stream_test, mod_exp_test, + hmac_update_md5, hmac_update_sha, hmac_update_sha256, hmac_update_sha512, + hmac_rfc2202, hmac_rfc4231_sha224, hmac_rfc4231_sha256, hmac_rfc4231_sha384, + hmac_rfc4231_sha512, aes_ctr_stream }, + + F = element(random:uniform(size(Funcs)),Funcs), + %%io:format("worker ~p calling ~p\n",[self(),F]), + ?MODULE:F(Config), + worker_loop(N-1,Config). + +wait_pids([]) -> + ok; +wait_pids(Pids) -> + receive + Pid -> + ?line true = lists:member(Pid,Pids), + Others = lists:delete(Pid,Pids), + io:format("wait_pid got ~p, still waiting for ~p\n",[Pid,Others]), + wait_pids(Others) + end. + +%% +%% Help functions +%% + +% match +m(X, X) -> + ?line true. +t(true) -> + true. + +% hexstr2bin +hexstr2bin(S) -> + list_to_binary(hexstr2list(S)). + +hexstr2list([X,Y|T]) -> + [mkint(X)*16 + mkint(Y) | hexstr2list(T)]; +hexstr2list([]) -> + []. + +mkint(C) when $0 =< C, C =< $9 -> + C - $0; +mkint(C) when $A =< C, C =< $F -> + C - $A + 10; +mkint(C) when $a =< C, C =< $f -> + C - $a + 10. + +%% mod_exp in erlang (copied from jungerl's ssh_math.erl) +ipow(A, B, M) when M > 0, B >= 0 -> + if A == 1 -> + 1; + true -> + ipow(A, B, M, 1) + end. + +ipow(A, 1, M, Prod) -> + (A*Prod) rem M; +ipow(_A, 0, _M, Prod) -> + Prod; +ipow(A, B, M, Prod) -> + B1 = B bsr 1, + A1 = (A*A) rem M, + if B - B1 == B1 -> + ipow(A1, B1, M, Prod); + true -> + ipow(A1, B1, M, (A*Prod) rem M) + end. + +%% +%% Invert an element X mod P +%% Calculated as {1, {A,B}} = egcd(X,P), +%% 1 == P*A + X*B == X*B (mod P) i.e B is the inverse element +%% +%% X > 0, P > 0, X < P (P should be prime) +%% +%% invert(X,P) when X > 0, P > 0, X < P -> +%% I = inv(X,P,1,0), +%% if +%% I < 0 -> P + I; +%% true -> I +%% end. + +%% inv(0,_,_,Q) -> Q; +%% inv(X,P,R1,Q1) -> +%% D = P div X, +%% inv(P rem X, X, Q1 - D*R1, R1). + +sized_binary(Binary) when is_binary(Binary) -> + <<(size(Binary)):32/integer, Binary/binary>>; +sized_binary(List) -> + sized_binary(list_to_binary(List)). + +unsized_binary(<<Sz:32/integer, Binary:Sz/binary>>) -> + Binary. + +xor_bytes(Bin1, Bin2) when is_binary(Bin1), is_binary(Bin2) -> + L1 = binary_to_list(Bin1), + L2 = binary_to_list(Bin2), + list_to_binary(xor_bytes(L1, L2)); +xor_bytes(L1, L2) -> + xor_bytes(L1, L2, []). + +xor_bytes([], [], Acc) -> + lists:reverse(Acc); +xor_bytes([N1 | Tl1], [N2 | Tl2], Acc) -> + xor_bytes(Tl1, Tl2, [N1 bxor N2 | Acc]). + +zero_bin(N) when is_integer(N) -> + N8 = N * 8, + <<0:N8/integer>>; +zero_bin(B) when is_binary(B) -> + zero_bin(size(B)). + +my_dss_verify(Data,[Sign|Tail],Key) -> + Res = my_dss_verify(Data,sized_binary(Sign),Key), + case Tail of + [] -> Res; + _ -> ?line Res = my_dss_verify(Data,Tail,Key) + end; +my_dss_verify(Data,Sign,Key) -> + ?line Res = crypto:dss_verify(Data, Sign, Key), + ?line Res = crypto:dss_verify(sha, Data, Sign, Key), + ?line <<_:32,Raw/binary>> = Data, + ?line Res = crypto:dss_verify(none, crypto:sha(Raw), Sign, Key), + Res. + +my_dss_sign(Data,Key) -> + ?line S1 = crypto:dss_sign(Data, Key), + ?line S2 = crypto:dss_sign(sha, Data, Key), + ?line <<_:32,Raw/binary>> = Data, + ?line S3 = crypto:dss_sign(none, crypto:sha(Raw), Key), + [S1,S2,S3]. + +openssl_version() -> + case crypto:info_lib() of + [{<<"OpenSSL">>,LibVer,_}] when is_integer(LibVer) -> + LibVer; + _ -> + undefined + end. + +if_supported(Algorithm, Fun) -> + case lists:member(Algorithm, lists:append([Algo || {_, Algo} <- crypto:supports()])) of + true -> + Fun(); + _ -> + {skipped, io:format("~s not spupported", [Algorithm])} + end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/tuple_set_crash.erl b/lib/dialyzer/test/small_SUITE_data/src/tuple_set_crash.erl index 5503f39412..e6256e5a53 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/tuple_set_crash.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/tuple_set_crash.erl @@ -69,8 +69,8 @@ test(TargetId, [Date | DateTail], Key, IVT, IVF) -> {ok, message_from_server(), binary(), binary()}. culprit(Message, Key, IVecToServer, IVecFromServer) -> {Packet, NewIVecToServer} = message_to_packet(Message, Key, IVecToServer), - Message = crypto:aes_cbc_128_decrypt(Key, IVecFromServer, Packet), - NewIVecFromServer = crypto:aes_cbc_ivec(Packet), + Message = crypto:block_decrypt(aes_cbc128, Key, IVecFromServer, Packet), + NewIVecFromServer = crypto:next_iv(aes_cbc, Packet), ParsedMessage = parse_message(Message), {ok, ParsedMessage, NewIVecToServer, NewIVecFromServer}. @@ -185,9 +185,9 @@ parse_audio_output_info(<<Output:?DWORD, BitMap:?BITMAP1, Rest/binary>>) -> -spec message_to_packet(binary(), binary(), binary()) -> {binary(), binary()}. message_to_packet(Message, Key, IVec) -> PaddedMessage = pad_pkcs5(Message), - Packet = crypto:aes_cbc_128_encrypt(Key, IVec, PaddedMessage), + Packet = crypto:block_encrypt(aes_cbc128, Key, IVec, PaddedMessage), TotalSize = byte_size(Packet), - NewIVec = crypto:aes_cbc_ivec(Packet), + NewIVec = crypto:next_iv(aes_cbc, Packet), {<<TotalSize:?WORD, Packet/binary>>, NewIVec}. -spec pad_pkcs5(binary()) -> binary(). 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/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 3ab86bb340..8f1f231b82 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -830,7 +830,8 @@ int ei_accept_tmo(ei_cnode* ec, int lfd, ErlConnect *conp, unsigned ms) error: EI_TRACE_ERR0("ei_accept","<- ACCEPT failed"); - closesocket(fd); + if (fd>=0) + closesocket(fd); return ERL_ERROR; } /* ei_accept */ diff --git a/lib/ic/java_src/com/ericsson/otp/ic/Environment.java b/lib/ic/java_src/com/ericsson/otp/ic/Environment.java index fff854a5f8..4b321fbce7 100644 --- a/lib/ic/java_src/com/ericsson/otp/ic/Environment.java +++ b/lib/ic/java_src/com/ericsson/otp/ic/Environment.java @@ -135,8 +135,8 @@ public class Environment { if (connection == null) connection = self.connect(peer); - clientP = new com.ericsson.otp.erlang.OtpErlangPid(self); /* This is not perfect */ - send_ref = new com.ericsson.otp.erlang.OtpErlangRef(self); + clientP = self.createPid(); /* This is not perfect */ + send_ref = self.createRef(); } diff --git a/lib/ic/src/icparse.yrl b/lib/ic/src/icparse.yrl index d0dd6cde4c..b0286d57f4 100644 --- a/lib/ic/src/icparse.yrl +++ b/lib/ic/src/icparse.yrl @@ -230,6 +230,9 @@ Terminals Rootsymbol '<specification>'. +Expect 9. + + %%------------------------------------------------------------ %% Clauses %% 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/erl_make_certs.erl b/lib/inets/test/erl_make_certs.erl index 5b92e551a5..22dc951ac1 100644 --- a/lib/inets/test/erl_make_certs.erl +++ b/lib/inets/test/erl_make_certs.erl @@ -45,7 +45,7 @@ %% {dnQualifer, DnQ} %% issuer = {Issuer, IssuerKey} true (i.e. a ca cert is created) %% (obs IssuerKey migth be {Key, Password} -%% key = KeyFile|KeyBin|rsa|dsa Subject PublicKey rsa or dsa generates key +%% key = KeyFile|KeyBin|rsa|dsa|ec Subject PublicKey rsa, dsa or ec generates key %% %% %% (OBS: The generated keys are for testing only) @@ -91,6 +91,16 @@ gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) -> {Key, encode_key(Key)}. %%-------------------------------------------------------------------- +%% @doc Creates a ec key (OBS: for testing only) +%% the sizes are in bytes +%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} +%% @end +%%-------------------------------------------------------------------- +gen_ec(Curve) when is_atom(Curve) -> + Key = gen_ec2(Curve), + {Key, encode_key(Key)}. + +%%-------------------------------------------------------------------- %% @doc Verifies cert signatures %% @spec (::binary(), ::tuple()) -> ::boolean() %% @end @@ -102,7 +112,10 @@ verify_signature(DerEncodedCert, DerKey, _KeyParams) -> public_key:pkix_verify(DerEncodedCert, #'RSAPublicKey'{modulus=Mod, publicExponent=Exp}); #'DSAPrivateKey'{p=P, q=Q, g=G, y=Y} -> - public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}}) + public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}}); + #'ECPrivateKey'{version = _Version, privateKey = _PrivKey, + parameters = Params, publicKey = {0, PubKey}} -> + public_key:pkix_verify(DerEncodedCert, {#'ECPoint'{point = PubKey}, Params}) end. %%%%%%%%%%%%%%%%%%%%%%%%% Implementation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -112,6 +125,7 @@ get_key(Opts) -> undefined -> make_key(rsa, Opts); rsa -> make_key(rsa, Opts); dsa -> make_key(dsa, Opts); + ec -> make_key(ec, Opts); Key -> Password = proplists:get_value(password, Opts, no_passwd), decode_key(Key, Password) @@ -129,6 +143,8 @@ decode_key(#'RSAPrivateKey'{} = Key,_) -> Key; decode_key(#'DSAPrivateKey'{} = Key,_) -> Key; +decode_key(#'ECPrivateKey'{} = Key,_) -> + Key; decode_key(PemEntry = {_,_,_}, Pw) -> public_key:pem_entry_decode(PemEntry, Pw); decode_key(PemBin, Pw) -> @@ -140,7 +156,10 @@ encode_key(Key = #'RSAPrivateKey'{}) -> {'RSAPrivateKey', Der, not_encrypted}; encode_key(Key = #'DSAPrivateKey'{}) -> {ok, Der} = 'OTP-PUB-KEY':encode('DSAPrivateKey', Key), - {'DSAPrivateKey', Der, not_encrypted}. + {'DSAPrivateKey', Der, not_encrypted}; +encode_key(Key = #'ECPrivateKey'{}) -> + {ok, Der} = 'OTP-PUB-KEY':encode('ECPrivateKey', Key), + {'ECPrivateKey', Der, not_encrypted}. make_tbs(SubjectKey, Opts) -> Version = list_to_atom("v"++integer_to_list(proplists:get_value(version, Opts, 3))), @@ -277,7 +296,14 @@ publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) -> publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) -> Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa', parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}}, - #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}. + #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}; +publickey(#'ECPrivateKey'{version = _Version, + privateKey = _PrivKey, + parameters = Params, + publicKey = {0, PubKey}}) -> + Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-ecPublicKey', parameters=Params}, + #'OTPSubjectPublicKeyInfo'{algorithm = Algo, + subjectPublicKey = #'ECPoint'{point = PubKey}}. validity(Opts) -> DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1), @@ -298,13 +324,24 @@ sign_algorithm(#'RSAPrivateKey'{}, Opts) -> end, {Type, 'NULL'}; sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) -> - {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}. + {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}; +sign_algorithm(#'ECPrivateKey'{}, Opts) -> + Type = case proplists:get_value(digest, Opts, sha1) of + sha1 -> ?'ecdsa-with-SHA1'; + sha512 -> ?'ecdsa-with-SHA512'; + sha384 -> ?'ecdsa-with-SHA384'; + sha256 -> ?'ecdsa-with-SHA256' + end, + {Type, 'NULL'}. make_key(rsa, _Opts) -> %% (OBS: for testing only) gen_rsa2(64); make_key(dsa, _Opts) -> - gen_dsa2(128, 20). %% Bytes i.e. {1024, 160} + gen_dsa2(128, 20); %% Bytes i.e. {1024, 160} +make_key(ec, _Opts) -> + %% (OBS: for testing only) + gen_ec2(secp256k1). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% RSA key generation (OBS: for testing only) @@ -349,24 +386,37 @@ gen_dsa2(LSize, NSize) -> X0 = prime(LSize), P0 = prime((LSize div 2) +1), - %% Choose L-bit prime modulus P such that p–1 is a multiple of q. + %% Choose L-bit prime modulus P such that p-1 is a multiple of q. case dsa_search(X0 div (2*Q*P0), P0, Q, 1000) of error -> gen_dsa2(LSize, NSize); P -> - G = crypto:mod_exp(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. - %% such that This may be done by setting g = h^(p–1)/q mod p, commonly h=2 is used. + G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. + %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used. X = prime(20), %% Choose x by some random method, where 0 < x < q. - Y = crypto:mod_exp(G, X, P), %% Calculate y = g^x mod p. + Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p. - #'DSAPrivateKey'{version=0, p=P, q=Q, g=G, y=Y, x=X} + #'DSAPrivateKey'{version=0, p = P, q = Q, + g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X} end. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% EC key generation (OBS: for testing only) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gen_ec2(CurveId) -> + {PubKey, PrivKey} = crypto:generate_key(ecdh, CurveId), + + #'ECPrivateKey'{version = 1, + privateKey = binary_to_list(PrivKey), + parameters = {namedCurve, pubkey_cert_records:namedCurves(CurveId)}, + publicKey = {0, PubKey}}. + %% See fips_186-3.pdf dsa_search(T, P0, Q, Iter) when Iter > 0 -> P = 2*T*Q*P0 + 1, - case is_prime(crypto:mpint(P), 50) of + case is_prime(P, 50) of true -> P; false -> dsa_search(T+1, P0, Q, Iter-1) end; @@ -377,38 +427,40 @@ dsa_search(_,_,_,_) -> %%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% prime(ByteSize) -> Rand = odd_rand(ByteSize), - crypto:erlint(prime_odd(Rand, 0)). + prime_odd(Rand, 0). prime_odd(Rand, N) -> case is_prime(Rand, 50) of true -> Rand; false -> - NotPrime = crypto:erlint(Rand), - prime_odd(crypto:mpint(NotPrime+2), N+1) + prime_odd(Rand+2, N+1) end. %% see http://en.wikipedia.org/wiki/Fermat_primality_test is_prime(_, 0) -> true; is_prime(Candidate, Test) -> - CoPrime = odd_rand(<<0,0,0,4, 10000:32>>, Candidate), - case crypto:mod_exp(CoPrime, Candidate, Candidate) of - CoPrime -> is_prime(Candidate, Test-1); - _ -> false - end. + CoPrime = odd_rand(10000, Candidate), + Result = crypto:mod_pow(CoPrime, Candidate, Candidate) , + is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test). + +is_prime(CoPrime, CoPrime, Candidate, Test) -> + is_prime(Candidate, Test-1); +is_prime(_,_,_,_) -> + false. odd_rand(Size) -> Min = 1 bsl (Size*8-1), Max = (1 bsl (Size*8))-1, - odd_rand(crypto:mpint(Min), crypto:mpint(Max)). + odd_rand(Min, Max). odd_rand(Min,Max) -> - Rand = <<Sz:32, _/binary>> = crypto:rand_uniform(Min,Max), - BitSkip = (Sz+4)*8-1, - case Rand of - Odd = <<_:BitSkip, 1:1>> -> Odd; - Even = <<_:BitSkip, 0:1>> -> - crypto:mpint(crypto:erlint(Even)+1) + Rand = crypto:rand_uniform(Min,Max), + case Rand rem 2 of + 0 -> + Rand + 1; + _ -> + Rand end. extended_gcd(A, B) -> @@ -427,3 +479,4 @@ pem_to_der(File) -> der_to_pem(File, Entries) -> PemBin = public_key:pem_encode(Entries), file:write_file(File, PemBin). + 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/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 541500a300..7cd98914d1 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -559,7 +559,7 @@ fe80::204:acff:fe17:bf38 <c>[Byte1,Byte2|Binary]</c>.</p> </item> - <tag><c>{high_msgq_watermark, Size}</c> (TCP/IP sockets)</tag> + <tag><c>{high_msgq_watermark, Size}</c></tag> <item> <p>The socket message queue will be set into a busy state when the amount of data queued on the message @@ -674,7 +674,7 @@ fe80::204:acff:fe17:bf38 the flushing time-out in seconds.</p> </item> - <tag><c>{low_msgq_watermark, Size}</c> (TCP/IP sockets)</tag> + <tag><c>{low_msgq_watermark, Size}</c></tag> <item> <p>If the socket message queue is in a busy state, the socket message queue will be set in a not busy state when diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index 74ad192802..acc116df84 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.erl @@ -39,7 +39,9 @@ {active, true | false | once} | {buffer, non_neg_integer()} | {dontroute, boolean()} | + {high_msgq_watermark, pos_integer()} | {linger, {boolean(), non_neg_integer()}} | + {low_msgq_watermark, pos_integer()} | {mode, list | binary} | list | binary | {priority, non_neg_integer()} | {recbuf, non_neg_integer()} | @@ -68,7 +70,9 @@ active | buffer | dontroute | + high_msgq_watermark | linger | + low_msgq_watermark | mode | priority | recbuf | diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index c5a1173575..fb5737f82e 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -34,6 +34,8 @@ {dontroute, boolean()} | {drop_membership, {inet:ip_address(), inet:ip_address()}} | {header, non_neg_integer()} | + {high_msgq_watermark, pos_integer()} | + {low_msgq_watermark, pos_integer()} | {mode, list | binary} | list | binary | {multicast_if, inet:ip_address()} | {multicast_loop, boolean()} | @@ -56,6 +58,8 @@ deliver | dontroute | header | + high_msgq_watermark | + low_msgq_watermark | mode | multicast_if | multicast_loop | diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index 9670271b2e..aada1252ad 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -712,7 +712,8 @@ udp_options() -> [tos, priority, reuseaddr, sndbuf, recbuf, header, active, buffer, mode, deliver, ipv6_v6only, broadcast, dontroute, multicast_if, multicast_ttl, multicast_loop, - add_membership, drop_membership, read_packets,raw]. + add_membership, drop_membership, read_packets,raw, + high_msgq_watermark, low_msgq_watermark]. udp_options(Opts, Family) -> @@ -766,7 +767,7 @@ udp_add(Name, Val, R, Opts, As) -> sctp_options() -> [ % The following are generic inet options supported for SCTP sockets: mode, active, buffer, tos, priority, dontroute, reuseaddr, linger, sndbuf, - recbuf, ipv6_v6only, + recbuf, ipv6_v6only, high_msgq_watermark, low_msgq_watermark, % Other options are SCTP-specific (though they may be similar to their % TCP and UDP counter-parts): diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl index 000119bc74..a01c733d81 100644 --- a/lib/kernel/src/inet_int.hrl +++ b/lib/kernel/src/inet_int.hrl @@ -141,8 +141,8 @@ -define(INET_LOPT_READ_PACKETS, 33). -define(INET_OPT_RAW, 34). -define(INET_LOPT_TCP_SEND_TIMEOUT_CLOSE, 35). --define(INET_LOPT_TCP_MSGQ_HIWTRMRK, 36). --define(INET_LOPT_TCP_MSGQ_LOWTRMRK, 37). +-define(INET_LOPT_MSGQ_HIWTRMRK, 36). +-define(INET_LOPT_MSGQ_LOWTRMRK, 37). % Specific SCTP options: separate range: -define(SCTP_OPT_RTOINFO, 100). -define(SCTP_OPT_ASSOCINFO, 101). diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index 742c000cc1..ded03361ee 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -126,7 +126,7 @@ verify_executable(Name0, [Ext|Rest], OrigExtensions) -> end; verify_executable(Name, [], OrigExtensions) when OrigExtensions =/= [""] -> %% Windows %% Will only happen on windows, hence case insensitivity - case can_be_full_name(string:to_lower(Name),OrigExtensions) of + case can_be_full_name(string:to_lower(Name),OrigExtensions) of true -> verify_executable(Name,[""],[""]); _ -> @@ -150,7 +150,7 @@ split_path(Path) -> {win32, _} -> {ok,Curr} = file:get_cwd(), split_path(Path, $;, [], [Curr]); - _ -> + _ -> split_path(Path, $:, [], []) end. @@ -187,11 +187,14 @@ cmd(Cmd) -> {unix, _} -> unix_cmd(Cmd); {win32, Wtype} -> - Command = case {os:getenv("COMSPEC"),Wtype} of + Command0 = case {os:getenv("COMSPEC"),Wtype} of {false,windows} -> lists:concat(["command.com /c", Cmd]); {false,_} -> lists:concat(["cmd /c", Cmd]); {Cspec,_} -> lists:concat([Cspec," /c",Cmd]) end, + %% open_port/2 awaits string() in Command, but io_lib:chars() can be + %% deep lists according to io_lib module description. + Command = lists:flatten(Command0), Port = open_port({spawn, Command}, [stream, in, eof, hide]), get_data(Port, []) end. @@ -213,7 +216,7 @@ unix_cmd(Cmd) -> end. %% The -s flag implies that only the positional parameters are set, -%% and the commands are read from standard input. We set the +%% and the commands are read from standard input. We set the %% $1 parameter for easy identification of the resident shell. %% -define(SHELL, "/bin/sh -s unix:cmd 2>&1"). @@ -226,7 +229,7 @@ unix_cmd(Cmd) -> -spec start_port() -> port(). start_port() -> Ref = make_ref(), - Request = {Ref,self()}, + Request = {Ref,self()}, {Pid, Mon} = case whereis(?PORT_CREATOR_NAME) of undefined -> spawn_monitor(fun() -> @@ -273,7 +276,7 @@ start_port_srv_handle({Ref,Client}) -> Port catch error:Reason -> - {Reason,erlang:get_stacktrace()} + {Reason,erlang:get_stacktrace()} end, Client ! {Ref,Reply}. @@ -355,16 +358,16 @@ get_data(Port, Sofar) -> {Port, {data, Bytes}} -> get_data(Port, [Sofar|Bytes]); {Port, eof} -> - Port ! {self(), close}, + Port ! {self(), close}, receive {Port, closed} -> true - end, + end, receive - {'EXIT', Port, _} -> + {'EXIT', Port, _} -> ok after 1 -> % force context switch ok - end, + end, lists:flatten(Sofar) end. 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/inet_sockopt_SUITE.erl b/lib/kernel/test/inet_sockopt_SUITE.erl index 75496ce745..185751fead 100644 --- a/lib/kernel/test/inet_sockopt_SUITE.erl +++ b/lib/kernel/test/inet_sockopt_SUITE.erl @@ -772,8 +772,10 @@ all_listen_options() -> {mode,list,binary,true,true}, {deliver,term,port,true,true}, {exit_on_close, true, false, true, true}, - %{high_watermark,4096,8192,true,true}, - %{low_watermark,2048,4096,true,true}, + {high_watermark,4096,8192,true,true}, + {low_watermark,2048,4096,true,true}, + {high_msgq_watermark,4096,8192,true,true}, + {low_msgq_watermark,2048,4096,true,true}, {send_timeout,infinity,1000,true,true}, {send_timeout_close,false,true,true,true}, {delay_send,false,true,true,true}, @@ -797,6 +799,8 @@ all_connect_options() -> {exit_on_close, true, false, true, true}, {high_watermark,4096,8192,false,true}, {low_watermark,2048,4096,false,true}, + {high_msgq_watermark,4096,8192,true,true}, + {low_msgq_watermark,2048,4096,true,true}, {send_timeout,infinity,1000,true,true}, {send_timeout_close,false,true,true,true}, {delay_send,false,true,true,true}, 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/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index 382fd6f6a9..73ed704ae3 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -18,20 +18,21 @@ %% -module(os_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). -export([space_in_cwd/1, quoting/1, space_in_name/1, bad_command/1, - find_executable/1, unix_comment_in_command/1, evil/1]). + find_executable/1, unix_comment_in_command/1, deep_list_command/1, evil/1]). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [space_in_cwd, quoting, space_in_name, bad_command, - find_executable, unix_comment_in_command, evil]. + find_executable, unix_comment_in_command, deep_list_command, + evil]. -groups() -> +groups() -> []. init_per_suite(Config) -> @@ -117,9 +118,9 @@ space_in_name(Config) when is_list(Config) -> ?line ok = file:change_mode(Echo, 8#777), % Make it executable on Unix. %% Run the echo program. - %% Quoting on windows depends on if the full path of the executable + %% Quoting on windows depends on if the full path of the executable %% contains special characters. Paths when running common_tests always - %% include @, why Windows would always fail if we do not double the + %% include @, why Windows would always fail if we do not double the %% quotes (this is the behaviour of cmd.exe, not Erlang's idea). Quote = case os:type() of {win32,_} -> @@ -135,7 +136,7 @@ space_in_name(Config) when is_list(Config) -> ?t:sleep(5), ?line [] = receive_all(), ok. - + bad_command(doc) -> "Check that a bad command doesn't crasch the server or the emulator (it used to)."; bad_command(suite) -> []; @@ -153,17 +154,17 @@ find_executable(suite) -> []; find_executable(doc) -> []; find_executable(Config) when is_list(Config) -> case os:type() of - {win32, _} -> + {win32, _} -> ?line DataDir = filename:join(?config(data_dir, Config), "win32"), ?line ok = file:set_cwd(filename:join([DataDir, "current"])), ?line Bin = filename:join(DataDir, "bin"), ?line Abin = filename:join(DataDir, "abin"), ?line UsrBin = filename:join([DataDir, "usr", "bin"]), ?line {ok, Current} = file:get_cwd(), - + ?line Path = lists:concat([Bin, ";", Abin, ";", UsrBin]), ?line io:format("Path = ~s", [Path]), - + %% Search for programs in Bin (second element in PATH). ?line find_exe(Abin, "my_ar", ".exe", Path), ?line find_exe(Abin, "my_ascii", ".com", Path), @@ -175,18 +176,18 @@ find_executable(Config) when is_list(Config) -> ?line find_exe(Abin, "my_ar.EXE", "", Path), ?line find_exe(Abin, "my_ascii.COM", "", Path), ?line find_exe(Abin, "MY_ADB.BAT", "", Path), - + %% Search for programs in Abin (second element in PATH). ?line find_exe(Abin, "my_ar", ".exe", Path), ?line find_exe(Abin, "my_ascii", ".com", Path), ?line find_exe(Abin, "my_adb", ".bat", Path), - + %% Search for programs in the current working directory. ?line find_exe(Current, "my_program", ".exe", Path), ?line find_exe(Current, "my_command", ".com", Path), ?line find_exe(Current, "my_batch", ".bat", Path), ok; - {unix, _} -> + {unix, _} -> DataDir = ?config(data_dir, Config), %% Smoke test. @@ -237,6 +238,21 @@ unix_comment_in_command(Config) when is_list(Config) -> ?line test_server:timetrap_cancel(Dog), ok. +deep_list_command(doc) -> + "Check that a deep list in command works equally on unix and on windows."; +deep_list_command(suite) -> []; +deep_list_command(Config) when is_list(Config) -> + %% As a 'io_lib' module description says: "There is no guarantee that the + %% character lists returned from some of the functions are flat, they can + %% be deep lists." + %% That's why os:cmd/1 can have arguments that are deep lists. + %% It is not a problem for unix, but for windows it is (in R15B02 for ex.). + Echo = os:cmd([$e, $c, "ho"]), + true = erlang:is_list(Echo), + %% FYI: [$e, $c, "ho"] =:= io_lib:format("ec~s", ["ho"]) + ok. + + -define(EVIL_PROCS, 100). -define(EVIL_LOOPS, 100). -define(PORT_CREATOR, os_cmd_port_creator). @@ -303,4 +319,3 @@ receive_all() -> X -> [X|receive_all()] after 0 -> [] end. - 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/megaco/.gitignore b/lib/megaco/.gitignore index 1c5979cd62..3e64dc20f5 100644 --- a/lib/megaco/.gitignore +++ b/lib/megaco/.gitignore @@ -1,3 +1,38 @@ +# Files generated by configure. +/configure +/config.log +/config.status + +# Files generated when building/running tests +/test/*.log +/test/*.beam + +# Generated documentation. (ie. not doc/src) +/doc/[^s]* + +# Library links +/priv/lib/*.so + +# Generated text src +/src/text/megaco_text_mini_parser.erl +/src/text/megaco_text_parser_*.erl + +# Generated binary src and stuff... +# /src/binary/megaco_per_media_gateway_control_*.erl +# /src/binary/megaco_per_media_gateway_control_*.asn1db +/src/binary/megaco_*_media_gateway_control_*.hrl +/src/binary/megaco_*_media_gateway_control_*.erl +/src/binary/megaco_*_media_gateway_control_*.asn1db + +# Generated binary src and stuff... +/src/flex/megaco_flex_scanner_drv.c +/src/flex/megaco_flex_scanner_drv.flex +/src/flex/megaco_flex_scanner_drv_mt.c +/src/flex/megaco_flex_scanner_drv_mt.flex + +# Generated examples stuff... examples/meas/Makefile examples/meas/meas.sh.skel examples/meas/mstone1.sh.skel + + diff --git a/lib/megaco/doc/src/Makefile b/lib/megaco/doc/src/Makefile index f35413a4fd..ea2284e89b 100644 --- a/lib/megaco/doc/src/Makefile +++ b/lib/megaco/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2000-2012. All Rights Reserved. +# Copyright Ericsson AB 2000-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 @@ -123,9 +123,6 @@ imgs: $(IMG_FILES:%=$(HTMLDIR)/%) man: $(MAN3_FILES) $(INDEX_TARGET): $(INDEX_SRC) $(APP_FILE) - sed -e 's/%VSN%/$(VSN)/' $< > $@ - -$(INDEX_TARGET): $(INDEX_SRC) $(APP_FILE) sed -e 's/%VSN%/$(VSN)/' \ -e 's/%ERLANG_SITE%/www\.erlang\.se\//' \ -e 's/%UP_ONE_LEVEL%/..\/..\/..\/doc\/index.html/' \ diff --git a/lib/megaco/doc/src/notes.xml b/lib/megaco/doc/src/notes.xml index bb30ce4c2a..91905b76f7 100644 --- a/lib/megaco/doc/src/notes.xml +++ b/lib/megaco/doc/src/notes.xml @@ -36,24 +36,138 @@ section is the version number of Megaco.</p> + <section><title>Megaco 3.17</title> + + <p>Version 3.17 supports code replacement in runtime from/to + version 3.16.0.3 and and 3.16.0.2. </p> + + <section> + <title>Improvements and new features</title> + + <p>-</p> + +<!-- + <list type="bulleted"> + <item> + <p>Allow whitespaces in installation path. </p> + <p>It is now possible to give configure and make an + installation/release path with whitespaces in it. </p> + <p>Own Id: OTP-10107</p> + </item> + + </list> +--> + + </section> + + <section> + <title>Fixed bugs and malfunctions</title> + + <!-- + <p>-</p> + --> + + <list type="bulleted"> + <item> + <p>Buffer overrun error while flex scanner processing + property parm groups. </p> + <p>This error occured only for large messages if a + buffer realloc was needed while processing the + property parm groups. </p> + <p>Own Id: OTP-10998</p> + <p>Aux Id: Seq 12263</p> + </item> + + </list> + + </section> + + <section> + <title>Incompatibilities</title> + <p>-</p> + +<!-- + <list type="bulleted"> + <item> + <p>A number of binary encoding alternatives has been removed. + The binary encoding option <c>driver</c> has been removed + since this (the use of the asn1 linked in driver) is + now default and there is now way to <em>not</em> use it. + See <seealso marker="megaco_encode#binary_config">configuration of binary encoding</seealso> for more info. </p> + </item> + + </list> +--> + + </section> + + </section> <!-- 3.17 --> + + <section><title>Megaco 3.16.0.3</title> - <section><title>Improvements and New Features</title> - <list> + <p>Version 3.16.0.2 supports code replacement in runtime from/to + version 3.16.0.1, 3.16, 3.15.1.1, 3.15.1 and 3.15.</p> + + <section> + <title>Improvements and new features</title> + +<!-- + <p>-</p> +--> + + <list type="bulleted"> <item> - <p>Where necessary a comment stating encoding has been - added to Erlang files. The comment is meant to be removed - in Erlang/OTP R17B when UTF-8 becomes the default - encoding. </p> - <p> - Own Id: OTP-10630</p> + <p>Where necessary, a comment stating encoding has been + added to Erlang files. The comment is meant to be removed + in Erlang/OTP R17B when UTF-8 becomes the default encoding. </p> + <p>Own Id: OTP-10630</p> </item> + + </list> + + </section> + + <section> + <title>Fixed bugs and malfunctions</title> + + <p>-</p> + + <!-- + <list type="bulleted"> + <item> + <p>Fixing miscellaneous things detected by dialyzer. </p> + <p>Own Id: OTP-9075</p> + </item> + </list> + --> + </section> -</section> + <section> + <title>Incompatibilities</title> +<!-- + <p>-</p> +--> + + <list type="bulleted"> + <item> + <p>A number of binary encoding alternatives has been removed. + The binary encoding option <c>driver</c> has been removed + since this (the use of the asn1 linked in driver) is + now default and there is now way to <em>not</em> use it. + See <seealso marker="megaco_encode#binary_config">configuration of binary encoding</seealso> for more info. </p> + </item> + + </list> -<section><title>Megaco 3.16.0.2</title> + </section> + + </section> <!-- 3.16.0.3 --> + + + <section><title>Megaco 3.16.0.2</title> <p>Version 3.16.0.2 supports code replacement in runtime from/to version 3.16.0.1, 3.16, 3.15.1.1, 3.15.1 and 3.15.</p> @@ -657,653 +771,6 @@ </section> <!-- 3.13 --> - <section> - <title>Megaco 3.12</title> - -<!-- - <p>Version 3.12 supports code replacement in runtime from/to - version 3.11.3.</p> ---> - - <section> - <title>Improvements and new features</title> -<!-- - <p>-</p> ---> - - <list type="bulleted"> - <item> - <p>Improve handling of async transaction reply. </p> - <p>For asynchronous requests, issued using - <seealso marker="megaco#cast">megaco:cast/3</seealso>, - the reply will be delivered using the - <seealso marker="megaco_user#trans_reply">handle_trans_reply/4,5</seealso> - callback function. </p> - <p>If a receiver of a request, issued using - <seealso marker="megaco#cast">megaco:cast/3</seealso>, - does not reply in time, megaco re-sends the request. - If the receiver of the request sends the reply at the same - time as megaco re-sends, it may also send a reply to the - resent request (thinking the first reply got lost). These - two replies may arrive more or less at the same time, - causing confusion. </p> - <p>In order to improve this situation, a number of - improvements have been done: </p> - <list type="bulleted"> - <item> - <p>When the first reply arrives, a timer, request-keep-alive, - is started. This timer is used to decide when to stop - accepting replies as legitimate. </p> - <p>The timeout time for the timer is specified by the - config option <em>request_keep_alive_timout</em>, - which can be set per - <seealso marker="megaco#ui_request_keep_alive_timeout">user</seealso> - or per - <seealso marker="megaco#ci_request_keep_alive_timeout">connection</seealso>. </p> - </item> - <item> - <p>We also keep track of how many replies has been received - (we do this as long as the request-keep-alive timer is - running). </p> - </item> - <item> - <p>Each reply that arrives while the request-keep-alive timer - is running (including the first) will be delivered using the - <seealso marker="megaco_user#trans_reply">handle_trans_reply/4,5</seealso> - callback function, but with the UserReply augmented to - include a serial number indicating which reply number this - is. - The <em>first</em> reply to arrive, - will be numbered <em>one (1)</em>. </p> - </item> - <item> - <p>Replies arriving after the timer has expired will be delivered - in the same way as before, using the - <seealso marker="megaco_user#unexpected_trans">handle_unexpected_trans/3,4</seealso> - callback function. </p> - </item> - <item> - <p>Note that if the timer was <em>not</em> configured, - megaco will act exactly as before! </p> - </item> - </list> - <p>Own Id: OTP-8183</p> - <p>Aux Id: Seq 11393</p> - </item> - - </list> - - </section> - - <section> - <title>Fixed bugs and malfunctions</title> -<!-- - <p>-</p> ---> - - <list type="bulleted"> - <item> - <p>If the megaco app received a transaction reply, for a request - issued using the - <seealso marker="megaco#call">call/3</seealso> function, from - the wrong remote entity (wrong MId)), megaco would still deliver - the reply (<seealso marker="megaco#call">call/3</seealso> - returnes) as if from the correct remote entity (right MId). </p> - <p>This has been changed so that the function now returns with - an error reason. </p> - <p>See <seealso marker="megaco#call">call/3</seealso> for more - info. </p> - <p>*** POTENTIAL INCOMPATIBILITY ***</p> - <p>Own Id: OTP-8212</p> - <p>Aux Id: Seq 11305</p> - </item> - - </list> - - </section> - - </section> <!-- 3.12 --> - - - <section> - <title>Megaco 3.11.3</title> - -<!-- - <p>Version 3.11.3 supports code replacement in runtime from/to - version 3.11.2, 3.11.1 and 3.11.</p> ---> - - <section> - <title>Improvements and new features</title> -<!-- - <p>-</p> ---> - - <list type="bulleted"> - <item> - <p>Replacing obsolete guard tests.</p> - <p>Own Id: OTP-8164</p> - <!-- <p>Aux Id: Seq 11332</p> --> - </item> - - <item> - <p>Added the config option - <seealso marker="megaco#ui_call_proxy_gc_timeout">call_proxy_gc_timeout</seealso> - to be able to control the way unexpected replies (when requests issued - via calls to <seealso marker="megaco#call">call/3</seealso>) - are handled. </p> - <p>See - <seealso marker="megaco#user_info">user_info/2</seealso>, - <seealso marker="megaco#conn_info">conn_info/2</seealso> and - <seealso marker="megaco#call">call/3</seealso> for more info. </p> - <p>Own Id: OTP-8167</p> - <p>Aux Id: Seq 11393</p> - </item> - - <item> - <p>Make flex scanner c89 compiler compliant.</p> - <p>Akira Kitada</p> - <p>Own Id: OTP-8191</p> - <!-- <p>Aux Id: Seq 11332</p> --> - </item> - - </list> - - </section> - - <section> - <title>Fixed bugs and malfunctions</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>Replacing obsolete guard tests.</p> - <p>Own Id: OTP-8164</p> - <p>Aux Id: Seq 11332</p> - </item> - - </list> ---> - - </section> - - <section> - <title>Incompatibilities</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>For those implementing their own codec's, the new megaco_encoder - behaviour will require three more functions. See above for more - info. </p> - <p>Own Id: OTP-7168</p> - <p>Aux Id: Seq 10867</p> - </item> - - </list> ---> - - </section> - </section> <!-- 3.11.3 --> - - - <section> - <title>Megaco 3.11.2</title> - - <p>Version 3.11.2 supports code replacement in runtime from/to - version 3.11.1 and 3.11.</p> - - <section> - <title>Improvements and new features</title> -<!-- - <p>-</p> ---> - - <list type="bulleted"> - <item> - <p>Megaco was unnecessarily strict when parsing the SDP - attribute <c>maxptime</c> (leading or trailing spaces - cased the value parse to fail). </p> - <p>This has been improved so that leading and trailing - spaces are stripped before parsing the value. - The same has been done for the attribute <c>ptime</c>.</p> - <p>Own Id: OTP-8123</p> - <p>Aux Id: Seq 11364</p> - </item> - - </list> - - </section> - - <section> - <title>Fixed bugs and malfunctions</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>[text] The <em>unquoted</em> string BOTH was interpreted as the - <c>'BothToken'</c> token. This was a version 3 (prev3a, prev3b, - prev3c and v3) only. </p> - <p>Own Id: OTP-8114</p> - <p>Aux Id: Seq 11353</p> - </item> - - <item> - <p>The reply proxy could crash if the timeout time calculation - results in a negative number. This will result in a function - clause with resulting error report.</p> - <p>Own Id: OTP-8081</p> - <p>Aux Id: Seq 11332</p> - </item> - - </list> ---> - - </section> - - <section> - <title>Incompatibilities</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>For those implementing their own codec's, the new megaco_encoder - behaviour will require three more functions. See above for more - info. </p> - <p>Own Id: OTP-7168</p> - <p>Aux Id: Seq 10867</p> - </item> - - </list> ---> - - </section> - </section> <!-- 3.11.2 --> - - - <section> - <title>Megaco 3.11.1</title> - - <p>Version 3.11.1 supports code replacement in runtime from/to - version 3.11.</p> - - <section> - <title>Improvements and new features</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>In order to better utilize multi-core procs, the - <c>flex</c> (text) scanner has been improved. </p> - <p>The <c>flex</c> (text) scanner has been made reentrant, - <em>if</em> the flex utility supports this. Note that the version - of <c>flex</c> supplied with some OS/distros (Solaris 10, - FreeBSD and OpenBSD to mention a few) may not support this, in which - case the flex scanner will be non-reentrant, just as before. </p> - <p>Own Id: OTP-7302</p> - </item> - - </list> ---> - - </section> - - <section> - <title>Fixed bugs and malfunctions</title> -<!-- - <p>-</p> ---> - - <list type="bulleted"> - <item> - <p>[text] The <em>unquoted</em> string BOTH was interpreted as the - <c>'BothToken'</c> token. This was a version 3 (prev3a, prev3b, - prev3c and v3) only. </p> - <p>Own Id: OTP-8114</p> - <p>Aux Id: Seq 11353</p> - </item> - - <item> - <p>The reply proxy could crash if the timeout time calculation - results in a negative number. This will result in a function - clause with resulting error report.</p> - <p>Own Id: OTP-8081</p> - <p>Aux Id: Seq 11332</p> - </item> - - </list> - - </section> - - <section> - <title>Incompatibilities</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>For those implementing their own codec's, the new megaco_encoder - behaviour will require three more functions. See above for more - info. </p> - <p>Own Id: OTP-7168</p> - <p>Aux Id: Seq 10867</p> - </item> - - </list> ---> - - </section> - </section> <!-- 3.11.1 --> - - - <section> - <title>Megaco 3.11</title> - -<!-- - <p>Version 3.11 supports code replacement in runtime from/to - version 3.10.1 and 3.10.0.1.</p> ---> - - <section> - <title>Improvements and new features</title> -<!-- - <p>-</p> ---> - - <list type="bulleted"> - <item> - <p>In order to better utilize multi-core procs, the - <c>flex</c> (text) scanner has been improved. </p> - <p>The <c>flex</c> (text) scanner has been made reentrant, - <em>if</em> the flex utility supports this. Note that the version - of <c>flex</c> supplied with some OS/distros (Solaris 10, - FreeBSD and OpenBSD to mention a few) may not support this, in which - case the flex scanner will be non-reentrant, just as before. </p> - <p>Own Id: OTP-7302</p> - </item> - - </list> - </section> - - <section> - <title>Fixed bugs and malfunctions</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>The (plain) text scanner could incorrectly identify - character strings (any 17 char long string with the - char t in the middle) as a TimeStampToken.</p> - <p>Own Id: OTP-7249</p> - <p>Aux Id: Seq 10917</p> - </item> - - </list> ---> - - </section> - - <section> - <title>Incompatibilities</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>For those implementing their own codec's, the new megaco_encoder - behaviour will require three more functions. See above for more - info. </p> - <p>Own Id: OTP-7168</p> - <p>Aux Id: Seq 10867</p> - </item> - - </list> ---> - - </section> - </section> <!-- 3.11 --> - - - <section> - <title>Megaco 3.10.1</title> - - <p>Version 3.10.1 supports code replacement in runtime from/to - version 3.10.0.1, 3.10 and 3.9.4.</p> - - <section> - <title>Improvements and new features</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>Updated file headers.</p> - <p>Own Id: OTP-7851</p> - <p>Aux Id: Seq 11140</p> - </item> - - </list> ---> - </section> - - <section> - <title>Fixed bugs and malfunctions</title> -<!-- - <p>-</p> ---> - - <list type="bulleted"> - <item> - <p>Unexpected - <seealso marker="megaco_user#unexpected_trans">handle_unexpected_reply</seealso> - callbacks. </p> - <p>The <seealso marker="megaco_user">megaco_user</seealso> callback - function - <seealso marker="megaco_user#unexpected_trans">handle_unexpected_reply</seealso> - could during high load be called with unexpected values for the Trans - argument, such as an <c>TransactionReply</c> where - <c>transactionResult</c> had the value <c>{error, timeout}</c>. - This was a result of a race condition and has now been fixed. </p> - <p>Own Id: OTP-7926</p> - <p>Aux Id: Seq 11255</p> - </item> - - <item> - <p>[text] PropertyParm values cannot be quoted. </p> - <p>It was not possible to encode a PropertyParm value as a quoted string - (unless it *had* to (has at least one RestChar)). The megaco text codec's - now also accepts quoted strings as PropertyParm values. </p> - <p>Own Id: OTP-7936</p> - <p>Aux Id: Seq 11258</p> - </item> - - </list> - - </section> - - <section> - <title>Incompatibilities</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>If the transport module calls the - <seealso marker="megaco#process_received_message">process_received_message/5</seealso> - or - <seealso marker="megaco#receive_message">receive_message/5</seealso> - function(s) for the initial message, then the - <seealso marker="megaco_user#connect">handle_connect/3</seealso> - function will now be called and not the - <seealso marker="megaco_user#connect">handle_connect/2</seealso> - function. </p> - <p>Own Id: OTP-7713</p> - <p>Aux Id: Seq 11140</p> - </item> - - </list> ---> - - </section> - </section> <!-- 3.10.1 --> - - - <section> - <title>Megaco 3.10.0.1</title> - - <p>Version 3.10.0.1 supports code replacement in runtime from/to - version 3.10 and 3.9.4 except - when using any of the drivers (flex for text or asn1 for binary).</p> - - <section> - <title>Improvements and new features</title> -<!-- - <p>-</p> ---> - - <list type="bulleted"> - <item> - <p>Updated file headers.</p> - <p>Own Id: OTP-7851</p> - <!-- <p>Aux Id: Seq 11140</p> --> - </item> - - </list> - </section> - - <section> - <title>Fixed bugs and malfunctions</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>Memory leak in the flex scanner. There was a memory - leak in the flex scanner function handling - Property Parameters. </p> - <p>Own Id: OTP-7700</p> - <p>Aux Id: Seq 11126</p> - </item> - - </list> ---> - - </section> - - <section> - <title>Incompatibilities</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>If the transport module calls the - <seealso marker="megaco#process_received_message">process_received_message/5</seealso> - or - <seealso marker="megaco#receive_message">receive_message/5</seealso> - function(s) for the initial message, then the - <seealso marker="megaco_user#connect">handle_connect/3</seealso> - function will now be called and not the - <seealso marker="megaco_user#connect">handle_connect/2</seealso> - function. </p> - <p>Own Id: OTP-7713</p> - <p>Aux Id: Seq 11140</p> - </item> - - </list> ---> - - </section> - </section> <!-- 3.10.0.1 --> - - - <section> - <title>Megaco 3.10</title> - - <p>Version 3.10 supports code replacement in runtime from/to - version 3.9.4, 3.9.3, 3.9.2, 3.9.1.1, 3.9.1, 3.9, 3.8.2, 3.8.1 and 3.8 except - when using any of the drivers (flex for text or asn1 for binary).</p> - - <section> - <title>Improvements and new features</title> -<!-- - <p>-</p> ---> - - <list type="bulleted"> - <item> - <p>Added new API function - <seealso marker="megaco#connect">megaco:connect/5</seealso> and - the corresponding new <c>megaco_user</c> callback function - <seealso marker="megaco_user#connect">handle_connect/3</seealso>. - The purpose of this is to be able to pass information to the - <seealso marker="megaco_user#connect">handle_connect/3</seealso> - function by calling the - <seealso marker="megaco#connect">megaco:connect/5</seealso> - function. </p> - <p>Own Id: OTP-7713</p> - <p>Aux Id: Seq 11140</p> - </item> - - <item> - <p>Update file headers with new copyright notice. </p> - <p>Own Id: OTP-7743</p> - </item> - - </list> - </section> - - <section> - <title>Fixed bugs and malfunctions</title> - <p>-</p> - -<!-- - <list type="bulleted"> - <item> - <p>Memory leak in the flex scanner. There was a memory - leak in the flex scanner function handling - Property Parameters. </p> - <p>Own Id: OTP-7700</p> - <p>Aux Id: Seq 11126</p> - </item> - - </list> ---> - - </section> - - <section> - <title>Incompatibilities</title> -<!-- - <p>-</p> ---> - - <list type="bulleted"> - <item> - <p>If the transport module calls the - <seealso marker="megaco#process_received_message">process_received_message/5</seealso> - or - <seealso marker="megaco#receive_message">receive_message/5</seealso> - function(s) for the initial message, then the - <seealso marker="megaco_user#connect">handle_connect/3</seealso> - function will now be called and not the - <seealso marker="megaco_user#connect">handle_connect/2</seealso> - function. </p> - <p>Own Id: OTP-7713</p> - <p>Aux Id: Seq 11140</p> - </item> - - </list> - - </section> - </section> <!-- 3.10 --> - <!-- section> <title>Release notes history</title> <p>For information about older versions see diff --git a/lib/megaco/src/app/megaco.appup.src b/lib/megaco/src/app/megaco.appup.src index a7b38eb107..b3659366a4 100644 --- a/lib/megaco/src/app/megaco.appup.src +++ b/lib/megaco/src/app/megaco.appup.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%% Copyright Ericsson AB 2001-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,186 +18,170 @@ %% %CopyrightEnd% %% -%% -%% 3.4.3 -%% | -%% v -%% 3.4.4 -%% / \ -%% | | -%% v v -%% 3.5 3.4.5 -%% | | -%% v v -%% 3.5.1 <- 3.4.6 -%% | -%% v -%% 3.5.2 -%% | -%% v -%% 3.5.3 -%% | -%% v -%% 3.6 -%% | -%% v -%% 3.6.0.1 -%% | -%% v -%% 3.6.1 -%% | -%% v -%% 3.6.2 -%% / \ -%% | | -%% v | -%% 3.7 3.6.3 -%% | | -%% v v -%% 3.7.1 <- 3.6.4 -%% | | -%% v v -%% 3.7.2 <- 3.6.5 -%% | | -%% v v -%% 3.7.3 <- 3.6.6 -%% | | -%% v v -%% 3.7.4 <- 3.6.7 -%% | | -%% v v -%% 3.7.5 <- 3.6.9 -%% | -%% v -%% 3.8 -%% | -%% v -%% 3.8.1 -%% | -%% v -%% 3.8.2 -%% | -%% v -%% 3.9 -%% | -%% v -%% 3.9.1 -%% | -%% v -%% 3.9.1.1 -%% | -%% v -%% 3.9.2 -%% | -%% v -%% 3.9.3 -%% | -%% v -%% 3.9.4 -%% | -%% v -%% 3.10 -%% | -%% v -%% 3.10.0.1 -%% | -%% v -%% 3.10.1 -%% | -%% v -%% 3.11 -%% | -%% v -%% 3.11.1 -%% | -%% v -%% 3.11.2 -%% | -%% v -%% 3.11.3 -%% | -%% v -%% 3.12 -%% | -%% v -%% 3.13 -%% | -%% v -%% 3.14 -%% | -%% v -%% 3.14.1 -%% | -%% v -%% 3.14.1.1 -%% | -%% v -%% 3.15 -%% | -%% v -%% 3.15.1 -%% | -%% v -%% 3.15.1.1 -%% | -%% v -%% 3.16 -%% | -%% v -%% 3.16.0.1 -%% | -%% v -%% 3.16.0.2 +%% +%% 3.4.3 +%% | +%% v +%% 3.4.4 +%% / \ +%% | | +%% v v +%% 3.5 3.4.5 +%% | | +%% v v +%% 3.5.1 <- 3.4.6 +%% | +%% v +%% 3.5.2 +%% | +%% v +%% 3.5.3 +%% | +%% v +%% 3.6 +%% | +%% v +%% 3.6.0.1 +%% | +%% v +%% 3.6.1 +%% | +%% v +%% 3.6.2 +%% / \ +%% | | +%% v v +%% 3.7 3.6.3 +%% | | +%% v v +%% 3.7.1 <- 3.6.4 +%% | | +%% v v +%% 3.7.2 <- 3.6.5 +%% | | +%% v v +%% 3.7.3 <- 3.6.6 +%% | | +%% v v +%% 3.7.4 <- 3.6.7 +%% | | +%% v v +%% 3.7.5 <- 3.6.9 +%% | +%% v +%% 3.8 +%% | +%% v +%% 3.8.1 +%% | +%% v +%% 3.8.2 +%% | +%% v +%% 3.9 +%% | +%% v +%% 3.9.1 +%% | +%% v +%% 3.9.1.1 +%% | +%% v +%% 3.9.2 +%% | +%% v +%% 3.9.3 +%% | +%% v +%% 3.9.4 +%% | +%% v +%% 3.10 +%% | +%% v +%% 3.10.0.1 +%% | +%% v +%% 3.10.1 +%% | +%% v +%% 3.11 +%% | +%% v +%% 3.11.1 +%% | +%% v +%% 3.11.2 +%% | +%% v +%% 3.11.3 +%% / \ +%% | \ +%% v \ +%% 3.12 \ +%% | \ +%% v \ +%% 3.13 \ +%% | \ +%% v \ +%% 3.14 \ +%% | \ +%% v \ +%% 3.14.1 \ +%% | \ +%% v \ +%% 3.14.1.1 \ +%% / \ \ +%% / \ \ +%% | \ \ +%% v \ \ +%% 3.15 \ \ +%% | \ \ +%% v \ \ +%% 3.15.1 \ \ +%% | \ \ +%% v \ \ +%% 3.15.1.1 \ \ +%% / \ \ | +%% / \ \ | +%% / \ \ | +%% | \ \ | +%% v \ \ | +%% 3.16 \ \ | +%% | \ \ | +%% v \ \ | +%% 3.16.0.1 \ | | +%% | \ | | +%% v \ | | +%% 3.16.0.2 \ | | +%% | \ \ | | +%% | \ \ | | +%% | \ \ | | +%% v \ | | | +%% 3.16.0.3 \ | | | +%% | \ | | | +%% | | | | | +%% | | | | | +%% | | | | | +%% v v v v v +%% 3.17 <- 3.16.1 <- 3.15.2 <- 3.14.2 <- 3.11.4 %% %% + {"%VSN%", [ - {"3.16.0.1", - [ - ] - }, - {"3.16", - [ - ] - }, - {"3.15.1.1", - [ - {restart_application, megaco} - ] - }, - {"3.15.1", - [ - {restart_application, megaco} - ] - }, - {"3.15", + {"3.16.0.3", [ - {restart_application, megaco} + {update, megaco_flex_scanner_handler, {advanced, upgrade_from_pre_3_17}, + soft_purge, soft_purge, []} ] } ], [ - {"3.16.0.1", - [ - ] - }, - {"3.16", - [ - ] - }, - {"3.15.1.1", - [ - {restart_application, megaco} - ] - }, - {"3.15.1", - [ - {restart_application, megaco} - ] - }, - {"3.15", + {"3.16.0.3", [ - {restart_application, megaco} + {update, megaco_flex_scanner_handler, {advanced, downgrade_to_pre_3_17}, + soft_purge, soft_purge, []} ] } ] diff --git a/lib/megaco/src/flex/megaco_flex_scanner_drv.flex.src b/lib/megaco/src/flex/megaco_flex_scanner_drv.flex.src index 3914a81b8c..90d5c2aae6 100644 --- a/lib/megaco/src/flex/megaco_flex_scanner_drv.flex.src +++ b/lib/megaco/src/flex/megaco_flex_scanner_drv.flex.src @@ -1,8 +1,8 @@ /* * %CopyrightBegin% - * + * * Copyright Ericsson AB 2001-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 @@ -95,6 +95,13 @@ typedef struct { int token_counter; } MfsErlDrvData; +/* IBL = In Buffer Length - the raw (un-decoded) message buffer length */ +#define TERM_SPEC_SIZE_INITIAL(IBL) (1024 + 2*(IBL)) + +/* CTSS = Current term spec size - the current term spec length */ +/* S = Size - how many positions we need */ +#define TERM_SPEC_SIZE_NEXT(CTSS,S) ((CTSS) + 1024 + (S)) + #if !defined(MEGACO_REENTRANT_FLEX_SCANNER) static MfsErlDrvData mfs_drv_data; #endif @@ -737,7 +744,7 @@ v LOAD_TOKEN(mfs_VersionToken); #endif -/* #define MFS_DEBUG true */ /* temporary */ +// #define MFS_DEBUG true #if defined(MFS_DEBUG) # define DBG( proto ) printf proto # define DBG_BUF(func, bufName, buf, bufSz) mfs_dbg_buf_print(func, bufName, buf, bufSz) @@ -842,15 +849,20 @@ static void mfs_ensure_term_spec(MfsErlDrvData* dataP, int size) "\n term_spec_size: %d\n", dataP->term_spec_index, dataP->term_spec_size) ); - dataP->term_spec_size = (dataP->term_spec_size * 2) + size; + dataP->term_spec_size = TERM_SPEC_SIZE_NEXT(dataP->term_spec_size, size); DBG( ("mfs_ensure_term_spec -> " - "term_spec is at 0x%X, new term_spec_size is %d\n", - (unsigned int) dataP->term_spec, dataP->term_spec_size) ); + "term_spec is at 0x%X, new term_spec_size is %d (%lu)\n", + (unsigned int) dataP->term_spec, + dataP->term_spec_size, + dataP->term_spec_size * sizeof(ErlDrvTermData)) ); tmp = REALLOC(dataP->term_spec, dataP->term_spec_size * sizeof(ErlDrvTermData)); + DBG( ("mfs_ensure_term_spec -> " + "realloc result: 0x%X\n", (unsigned int) tmp) ); + if (tmp == NULL) { /* * Ouch, we did'nt get any new memory. @@ -942,6 +954,9 @@ static void mfs_octet_load_token(ErlDrvTermData TokenTag, int is_empty) ASSIGN_TERM_SPEC(dataP, ERL_DRV_TUPLE); ASSIGN_TERM_SPEC(dataP, 3); + + DBG( ("mfs_octet_load_token -> done\n") ); + } #if defined(MEGACO_REENTRANT_FLEX_SCANNER) @@ -1241,7 +1256,7 @@ static void mfs_load_property_groups(MfsErlDrvData* dataP) } // if ((yytext[i] != SP)... } // while ... - mfs_ensure_term_spec(dataP, 4); // 2 + 2 just in case + mfs_ensure_term_spec(dataP, 6); // 3 + 3 just in case /* Make sure we actually have some groups */ @@ -1727,7 +1742,7 @@ static ErlDrvSSizeT mfs_control(ErlDrvData handle, dataP->text_buf = tmp; dataP->text_ptr = tmp; - dataP->term_spec_size = 1000 + buf_len; /* OTP-4237 */ + dataP->term_spec_size = TERM_SPEC_SIZE_INITIAL(buf_len); DBG( ("mfs_control -> allocate term-spec buffer: " "\n term_spec_size: %d\n", dataP->term_spec_size) ); diff --git a/lib/megaco/src/flex/megaco_flex_scanner_handler.erl b/lib/megaco/src/flex/megaco_flex_scanner_handler.erl index 420202134e..ad28e25c39 100644 --- a/lib/megaco/src/flex/megaco_flex_scanner_handler.erl +++ b/lib/megaco/src/flex/megaco_flex_scanner_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-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 @@ -181,11 +181,11 @@ terminate(_Reason, _S) -> %% Returns: {ok, NewState} %%---------------------------------------------------------------------- -code_change({down, _Vsn}, #state{conf = Conf} = State, downgrade_to_pre_3_13_1) -> +code_change({down, _Vsn}, #state{conf = Conf} = State, downgrade_to_pre_3_17) -> NewPorts = bump_flex_scanner(Conf), {ok, State#state{conf = {flex, NewPorts}}}; -code_change(_Vsn, #state{conf = Conf} = State, upgrade_from_pre_3_13_1) -> +code_change(_Vsn, #state{conf = Conf} = State, upgrade_from_pre_3_17) -> NewPorts = bump_flex_scanner(Conf), {ok, State#state{conf = {flex, NewPorts}}}; diff --git a/lib/megaco/test/megaco_appup_test.erl b/lib/megaco/test/megaco_appup_test.erl index 40eebcae86..fce6cf3cba 100644 --- a/lib/megaco/test/megaco_appup_test.erl +++ b/lib/megaco/test/megaco_appup_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-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 @@ -309,6 +309,9 @@ instruction_module(Instr) -> %% Check that the modules handled in an instruction set for version X %% is a subset of the instruction set for version X-1. check_module_subset(Instructions) -> + %% io:format("check_module_subset -> " + %% "~n Instructions: ~p" + %% "~n", [Instructions]), do_check_module_subset(modules_of(Instructions)). do_check_module_subset([]) -> @@ -316,6 +319,11 @@ do_check_module_subset([]) -> do_check_module_subset([_]) -> ok; do_check_module_subset([{_V1, Mods1}|T]) -> + %% io:format("do_check_module_subset -> " + %% "~n V1: ~p" + %% "~n Mods1: ~p" + %% "~n T: ~p" + %% "~n", [_V1, Mods1, T]), {V2, Mods2} = hd(T), %% Check that the modules in V1 is a subset of V2 case do_check_module_subset2(Mods1, Mods2) of @@ -347,8 +355,21 @@ modules_of(Instructions) -> modules_of([], Acc) -> lists:reverse(Acc); modules_of([{V,Instructions}|T], Acc) -> - Mods = modules_of2(Instructions, []), - modules_of(T, [{V, Mods}|Acc]). + %% io:format("modules_of -> " + %% "~n V: ~p" + %% "~n Instructions: ~p" + %% "~n", [V, Instructions]), + case modules_of2(Instructions, []) of + Mods when is_list(Mods) -> + %% io:format("modules_of -> " + %% "~n Mods: ~p" + %% "~n", [Mods]), + modules_of(T, [{V, Mods}|Acc]); + skip -> + %% io:format("modules_of -> skip" + %% "~n", []), + modules_of(T, Acc) + end. modules_of2([], Acc) -> lists:reverse(Acc); @@ -356,6 +377,8 @@ modules_of2([Instr|Instructions], Acc) -> case module_of(Instr) of {value, Mod} -> modules_of2(Instructions, [Mod|Acc]); + skip -> + skip; false -> modules_of2(Instructions, Acc) end. @@ -368,6 +391,8 @@ module_of({load_module, Module, _Pre, _Post, _Depend}) -> {value, Module}; module_of({update, Module, _Change, _Pre, _Post, _Depend}) -> {value, Module}; +module_of({restart_application, _App}) -> + skip; module_of(_) -> false. diff --git a/lib/megaco/test/megaco_codec_flex_lib.erl b/lib/megaco/test/megaco_codec_flex_lib.erl index 93bc5d4bbc..3e70454faf 100644 --- a/lib/megaco/test/megaco_codec_flex_lib.erl +++ b/lib/megaco/test/megaco_codec_flex_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. 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 @@ -49,8 +49,14 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% init(Config) when is_list(Config) -> + %% io:format("~w:init -> entry with" + %% "~n Config: ~p" + %% "~n", [?MODULE, Config]), Flag = process_flag(trap_exit, true), Res = (catch start()), + %% io:format("~w:init -> start result" + %% "~n Res: ~p" + %% "~n", [?MODULE, Res]), process_flag(trap_exit, Flag), case Res of {error, Reason} -> diff --git a/lib/megaco/test/megaco_codec_prev3a_test.erl b/lib/megaco/test/megaco_codec_prev3a_test.erl index b2316eb509..9c4ed385a6 100644 --- a/lib/megaco/test/megaco_codec_prev3a_test.erl +++ b/lib/megaco/test/megaco_codec_prev3a_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-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 @@ -223,23 +223,9 @@ display_text_messages() -> %% ---- - -expand(RootCase) -> - expand([RootCase], []). - -expand([], Acc) -> - lists:flatten(lists:reverse(Acc)); -expand([Case|Cases], Acc) -> - case (catch apply(?MODULE,Case,[suite])) of - [] -> - expand(Cases, [Case|Acc]); - C when is_list(C) -> - expand(Cases, [expand(C, [])|Acc]); - _ -> - expand(Cases, [Case|Acc]) - end. - - +tickets() -> + %% io:format("~w:tickets -> entry~n", [?MODULE]), + megaco_test_lib:tickets(?MODULE). %% ---- @@ -268,26 +254,34 @@ end_per_testcase(Case, Config) -> %% Top test case all() -> - [{group, text}, {group, binary}, {group, erl_dist}, + [{group, text}, + {group, binary}, + {group, erl_dist}, {group, tickets}]. groups() -> [{text, [], - [{group, pretty}, {group, flex_pretty}, - {group, compact}, {group, flex_compact}]}, + [{group, pretty}, + {group, flex_pretty}, + {group, compact}, + {group, flex_compact}]}, {binary, [], - [{group, bin}, {group, ber}, {group, per}]}, + [{group, bin}, + {group, ber}, + {group, per}]}, {erl_dist, [], [{group, erl_dist_m}]}, {pretty, [], [pretty_test_msgs]}, {compact, [], [compact_test_msgs]}, {flex_pretty, [], flex_pretty_cases()}, {flex_compact, [], flex_compact_cases()}, - {bin, [], [bin_test_msgs]}, {ber, [], [ber_test_msgs]}, + {bin, [], [bin_test_msgs]}, + {ber, [], [ber_test_msgs]}, {per, [], [per_test_msgs]}, {erl_dist_m, [], [erl_dist_m_test_msgs]}, {tickets, [], [{group, compact_tickets}, - {group, flex_compact_tickets}, {group, pretty_tickets}, + {group, flex_compact_tickets}, + {group, pretty_tickets}, {group, flex_pretty_tickets}]}, {compact_tickets, [], [compact_otp4011_msg1, compact_otp4011_msg2, @@ -311,8 +305,7 @@ groups() -> compact_otp5993_msg01, compact_otp5993_msg02, compact_otp5993_msg03, compact_otp6017_msg01, compact_otp6017_msg02, compact_otp6017_msg03]}, - {flex_compact_tickets, [], - flex_compact_tickets_cases()}, + {flex_compact_tickets, [], flex_compact_tickets_cases()}, {pretty_tickets, [], [pretty_otp4632_msg1, pretty_otp4632_msg2, pretty_otp4632_msg3, pretty_otp4632_msg4, @@ -360,64 +353,61 @@ end_per_group(_GroupName, Config) -> Config. flex_pretty_cases() -> - [flex_pretty_test_msgs]. + [ + flex_pretty_test_msgs + ]. flex_compact_cases() -> - [flex_compact_test_msgs, flex_compact_dm_timers1, - flex_compact_dm_timers2, flex_compact_dm_timers3, - flex_compact_dm_timers4, flex_compact_dm_timers5, - flex_compact_dm_timers6, flex_compact_dm_timers7, - flex_compact_dm_timers8]. - -%% Support for per_bin was added to ASN.1 as of version -%% 1.3.2 (R8). And later merged into 1.3.1.3 (R7). These -%% releases are identical (as far as I know). -%% + [ + flex_compact_test_msgs, + flex_compact_dm_timers1, + flex_compact_dm_timers2, + flex_compact_dm_timers3, + flex_compact_dm_timers4, + flex_compact_dm_timers5, + flex_compact_dm_timers6, + flex_compact_dm_timers7, + flex_compact_dm_timers8 + ]. + flex_compact_tickets_cases() -> - [flex_compact_otp7431_msg01, flex_compact_otp7431_msg02, - flex_compact_otp7431_msg03, flex_compact_otp7431_msg04, - flex_compact_otp7431_msg05, flex_compact_otp7431_msg06, - flex_compact_otp7431_msg07]. + [ + flex_compact_otp7431_msg01, + flex_compact_otp7431_msg02, + flex_compact_otp7431_msg03, + flex_compact_otp7431_msg04, + flex_compact_otp7431_msg05, + flex_compact_otp7431_msg06, + flex_compact_otp7431_msg07 + ]. flex_pretty_tickets_cases() -> - [flex_pretty_otp5042_msg1, flex_pretty_otp5085_msg1, - flex_pretty_otp5085_msg2, flex_pretty_otp5085_msg3, - flex_pretty_otp5085_msg4, flex_pretty_otp5085_msg5, - flex_pretty_otp5085_msg6, flex_pretty_otp5085_msg7, - flex_pretty_otp5085_msg8, flex_pretty_otp5600_msg1, - flex_pretty_otp5600_msg2, flex_pretty_otp5601_msg1, - flex_pretty_otp5793_msg01, flex_pretty_otp7431_msg01, - flex_pretty_otp7431_msg02, flex_pretty_otp7431_msg03, - flex_pretty_otp7431_msg04, flex_pretty_otp7431_msg05, - flex_pretty_otp7431_msg06, flex_pretty_otp7431_msg07]. - -%% ---- + [ + flex_pretty_otp5042_msg1, + flex_pretty_otp5085_msg1, + flex_pretty_otp5085_msg2, + flex_pretty_otp5085_msg3, + flex_pretty_otp5085_msg4, + flex_pretty_otp5085_msg5, + flex_pretty_otp5085_msg6, + flex_pretty_otp5085_msg7, + flex_pretty_otp5085_msg8, + flex_pretty_otp5600_msg1, + flex_pretty_otp5600_msg2, + flex_pretty_otp5601_msg1, + flex_pretty_otp5793_msg01, + flex_pretty_otp7431_msg01, + flex_pretty_otp7431_msg02, + flex_pretty_otp7431_msg03, + flex_pretty_otp7431_msg04, + flex_pretty_otp7431_msg05, + flex_pretty_otp7431_msg06, + flex_pretty_otp7431_msg07 + ]. -tickets() -> - Flag = process_flag(trap_exit, true), - Cases = expand(tickets), - Fun = fun(Case) -> - C = init_per_testcase(Case, [{tc_timeout, - timer:minutes(10)}]), - io:format("Eval ~w~n", [Case]), - Result = - case (catch apply(?MODULE, Case, [C])) of - {'EXIT', Reason} -> - io:format("~n~p exited:~n ~p~n", - [Case, Reason]), - {error, {Case, Reason}}; - Res -> - Res - end, - end_per_testcase(Case, C), - Result - end, - process_flag(trap_exit, Flag), - lists:map(Fun, Cases). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pretty_test_msgs(suite) -> diff --git a/lib/megaco/test/megaco_codec_prev3b_test.erl b/lib/megaco/test/megaco_codec_prev3b_test.erl index fa24f49372..36df434e80 100644 --- a/lib/megaco/test/megaco_codec_prev3b_test.erl +++ b/lib/megaco/test/megaco_codec_prev3b_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-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 @@ -241,21 +241,9 @@ generate_text_messages() -> %% ---- - -expand(RootCase) -> - expand([RootCase], []). - -expand([], Acc) -> - lists:flatten(lists:reverse(Acc)); -expand([Case|Cases], Acc) -> - case (catch apply(?MODULE,Case,[suite])) of - [] -> - expand(Cases, [Case|Acc]); - C when is_list(C) -> - expand(Cases, [expand(C, [])|Acc]); - _ -> - expand(Cases, [Case|Acc]) - end. +tickets() -> + %% io:format("~w:tickets -> entry~n", [?MODULE]), + megaco_test_lib:tickets(?MODULE). %% ---- @@ -284,26 +272,36 @@ end_per_testcase(Case, Config) -> %% Top test case all() -> - [{group, text}, {group, binary}, {group, erl_dist}, - {group, tickets}]. + [ + {group, text}, + {group, binary}, + {group, erl_dist}, + {group, tickets} + ]. groups() -> [{text, [], - [{group, pretty}, {group, flex_pretty}, - {group, compact}, {group, flex_compact}]}, + [{group, pretty}, + {group, flex_pretty}, + {group, compact}, + {group, flex_compact}]}, {binary, [], - [{group, bin}, {group, ber}, {group, per}]}, + [{group, bin}, + {group, ber}, + {group, per}]}, {erl_dist, [], [{group, erl_dist_m}]}, {pretty, [], [pretty_test_msgs]}, {compact, [], [compact_test_msgs]}, {flex_pretty, [], flex_pretty_cases()}, {flex_compact, [], flex_compact_cases()}, - {bin, [], [bin_test_msgs]}, {ber, [], [ber_test_msgs]}, + {bin, [], [bin_test_msgs]}, + {ber, [], [ber_test_msgs]}, {per, [], [per_test_msgs]}, {erl_dist_m, [], [erl_dist_m_test_msgs]}, {tickets, [], [{group, compact_tickets}, - {group, flex_compact_tickets}, {group, pretty_tickets}, + {group, flex_compact_tickets}, + {group, pretty_tickets}, {group, flex_pretty_tickets}]}, {compact_tickets, [], [compact_otp4011_msg1, compact_otp4011_msg2, @@ -328,8 +326,7 @@ groups() -> compact_otp5993_msg02, compact_otp5993_msg03, compact_otp6017_msg01, compact_otp6017_msg02, compact_otp6017_msg03]}, - {flex_compact_tickets, [], - flex_compact_tickets_cases()}, + {flex_compact_tickets, [], flex_compact_tickets_cases()}, {pretty_tickets, [], [pretty_otp4632_msg1, pretty_otp4632_msg2, pretty_otp4632_msg3, pretty_otp4632_msg4, @@ -379,63 +376,61 @@ end_per_group(_GroupName, Config) -> Config. flex_pretty_cases() -> - [flex_pretty_test_msgs]. + [ + flex_pretty_test_msgs + ]. flex_compact_cases() -> - [flex_compact_test_msgs, flex_compact_dm_timers1, - flex_compact_dm_timers2, flex_compact_dm_timers3, - flex_compact_dm_timers4, flex_compact_dm_timers5, - flex_compact_dm_timers6, flex_compact_dm_timers7, - flex_compact_dm_timers8]. - -%% Support for per_bin was added to ASN.1 as of version -%% 1.3.2 (R8). And later merged into 1.3.1.3 (R7). These -%% releases are identical (as far as I know). -%% + [ + flex_compact_test_msgs, + flex_compact_dm_timers1, + flex_compact_dm_timers2, + flex_compact_dm_timers3, + flex_compact_dm_timers4, + flex_compact_dm_timers5, + flex_compact_dm_timers6, + flex_compact_dm_timers7, + flex_compact_dm_timers8 + ]. flex_compact_tickets_cases() -> - [flex_compact_otp7431_msg01, flex_compact_otp7431_msg02, - flex_compact_otp7431_msg03, flex_compact_otp7431_msg04, - flex_compact_otp7431_msg05, flex_compact_otp7431_msg06, - flex_compact_otp7431_msg07]. + [ + flex_compact_otp7431_msg01, + flex_compact_otp7431_msg02, + flex_compact_otp7431_msg03, + flex_compact_otp7431_msg04, + flex_compact_otp7431_msg05, + flex_compact_otp7431_msg06, + flex_compact_otp7431_msg07 + ]. flex_pretty_tickets_cases() -> - [flex_pretty_otp5042_msg1, flex_pretty_otp5085_msg1, - flex_pretty_otp5085_msg2, flex_pretty_otp5085_msg3, - flex_pretty_otp5085_msg4, flex_pretty_otp5085_msg5, - flex_pretty_otp5085_msg6, flex_pretty_otp5085_msg7, - flex_pretty_otp5085_msg8, flex_pretty_otp5600_msg1, - flex_pretty_otp5600_msg2, flex_pretty_otp5601_msg1, - flex_pretty_otp5793_msg01, flex_pretty_otp5803_msg01, - flex_pretty_otp5803_msg02, flex_pretty_otp5805_msg01, - flex_pretty_otp5836_msg01, flex_pretty_otp7431_msg01, - flex_pretty_otp7431_msg02, flex_pretty_otp7431_msg03, - flex_pretty_otp7431_msg04, flex_pretty_otp7431_msg05, - flex_pretty_otp7431_msg06, flex_pretty_otp7431_msg07]. - -%% ---- - -tickets() -> - Flag = process_flag(trap_exit, true), - Cases = expand(tickets), - Fun = fun(Case) -> - C = init_per_testcase(Case, [{tc_timeout, - timer:minutes(10)}]), - io:format("Eval ~w~n", [Case]), - Result = - case (catch apply(?MODULE, Case, [C])) of - {'EXIT', Reason} -> - io:format("~n~p exited:~n ~p~n", - [Case, Reason]), - {error, {Case, Reason}}; - Res -> - Res - end, - end_per_testcase(Case, C), - Result - end, - process_flag(trap_exit, Flag), - lists:map(Fun, Cases). + [ + flex_pretty_otp5042_msg1, + flex_pretty_otp5085_msg1, + flex_pretty_otp5085_msg2, + flex_pretty_otp5085_msg3, + flex_pretty_otp5085_msg4, + flex_pretty_otp5085_msg5, + flex_pretty_otp5085_msg6, + flex_pretty_otp5085_msg7, + flex_pretty_otp5085_msg8, + flex_pretty_otp5600_msg1, + flex_pretty_otp5600_msg2, + flex_pretty_otp5601_msg1, + flex_pretty_otp5793_msg01, + flex_pretty_otp5803_msg01, + flex_pretty_otp5803_msg02, + flex_pretty_otp5805_msg01, + flex_pretty_otp5836_msg01, + flex_pretty_otp7431_msg01, + flex_pretty_otp7431_msg02, + flex_pretty_otp7431_msg03, + flex_pretty_otp7431_msg04, + flex_pretty_otp7431_msg05, + flex_pretty_otp7431_msg06, + flex_pretty_otp7431_msg07 + ]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/megaco/test/megaco_codec_prev3c_test.erl b/lib/megaco/test/megaco_codec_prev3c_test.erl index 7f6d098ed8..3f715cbb7e 100644 --- a/lib/megaco/test/megaco_codec_prev3c_test.erl +++ b/lib/megaco/test/megaco_codec_prev3c_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-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 @@ -247,21 +247,9 @@ generate_text_messages() -> %% ---- - -expand(RootCase) -> - expand([RootCase], []). - -expand([], Acc) -> - lists:flatten(lists:reverse(Acc)); -expand([Case|Cases], Acc) -> - case (catch apply(?MODULE,Case,[suite])) of - [] -> - expand(Cases, [Case|Acc]); - C when is_list(C) -> - expand(Cases, [expand(C, [])|Acc]); - _ -> - expand(Cases, [Case|Acc]) - end. +tickets() -> + %% io:format("~w:tickets -> entry~n", [?MODULE]), + megaco_test_lib:tickets(?MODULE). %% ---- @@ -289,26 +277,36 @@ end_per_testcase(Case, Config) -> %% Top test case all() -> - [{group, text}, {group, binary}, {group, erl_dist}, - {group, tickets}]. + [ + {group, text}, + {group, binary}, + {group, erl_dist}, + {group, tickets} + ]. groups() -> [{text, [], - [{group, pretty}, {group, flex_pretty}, - {group, compact}, {group, flex_compact}]}, + [{group, pretty}, + {group, flex_pretty}, + {group, compact}, + {group, flex_compact}]}, {binary, [], - [{group, bin}, {group, ber}, {group, per}]}, + [{group, bin}, + {group, ber}, + {group, per}]}, {erl_dist, [], [{group, erl_dist_m}]}, {pretty, [], [pretty_test_msgs]}, {compact, [], [compact_test_msgs]}, {flex_pretty, [], flex_pretty_cases()}, {flex_compact, [], flex_compact_cases()}, - {bin, [], [bin_test_msgs]}, {ber, [], [ber_test_msgs]}, + {bin, [], [bin_test_msgs]}, + {ber, [], [ber_test_msgs]}, {per, [], [per_test_msgs]}, {erl_dist_m, [], [erl_dist_m_test_msgs]}, {tickets, [], [{group, compact_tickets}, - {group, flex_compact_tickets}, {group, pretty_tickets}, + {group, flex_compact_tickets}, + {group, pretty_tickets}, {group, flex_pretty_tickets}]}, {compact_tickets, [], [compact_otp4011_msg1, compact_otp4011_msg2, @@ -332,8 +330,7 @@ groups() -> compact_otp5993_msg01, compact_otp5993_msg02, compact_otp5993_msg03, compact_otp6017_msg01, compact_otp6017_msg02, compact_otp6017_msg03]}, - {flex_compact_tickets, [], - flex_compact_tickets_cases()}, + {flex_compact_tickets, [], flex_compact_tickets_cases()}, {pretty_tickets, [], [pretty_otp4632_msg1, pretty_otp4632_msg2, pretty_otp4632_msg3, pretty_otp4632_msg4, @@ -383,63 +380,62 @@ end_per_group(_GroupName, Config) -> Config. flex_pretty_cases() -> - [flex_pretty_test_msgs]. + [ + flex_pretty_test_msgs + ]. flex_compact_cases() -> - [flex_compact_test_msgs, flex_compact_dm_timers1, - flex_compact_dm_timers2, flex_compact_dm_timers3, - flex_compact_dm_timers4, flex_compact_dm_timers5, - flex_compact_dm_timers6, flex_compact_dm_timers7, - flex_compact_dm_timers8]. - -%% Support for per_bin was added to ASN.1 as of version -%% 1.3.2 (R8). And later merged into 1.3.1.3 (R7). These -%% releases are identical (as far as I know). -%% - + [ + flex_compact_test_msgs, + flex_compact_dm_timers1, + flex_compact_dm_timers2, + flex_compact_dm_timers3, + flex_compact_dm_timers4, + flex_compact_dm_timers5, + flex_compact_dm_timers6, + flex_compact_dm_timers7, + flex_compact_dm_timers8 + ]. + flex_compact_tickets_cases() -> - [flex_compact_otp4299_msg1, flex_compact_otp7431_msg01, - flex_compact_otp7431_msg02, flex_compact_otp7431_msg03, - flex_compact_otp7431_msg04, flex_compact_otp7431_msg05, - flex_compact_otp7431_msg06, flex_compact_otp7431_msg07]. + [ + flex_compact_otp4299_msg1, + flex_compact_otp7431_msg01, + flex_compact_otp7431_msg02, + flex_compact_otp7431_msg03, + flex_compact_otp7431_msg04, + flex_compact_otp7431_msg05, + flex_compact_otp7431_msg06, + flex_compact_otp7431_msg07 + ]. flex_pretty_tickets_cases() -> - [flex_pretty_otp5042_msg1, flex_pretty_otp5085_msg1, - flex_pretty_otp5085_msg2, flex_pretty_otp5085_msg3, - flex_pretty_otp5085_msg4, flex_pretty_otp5085_msg5, - flex_pretty_otp5085_msg6, flex_pretty_otp5085_msg7, - flex_pretty_otp5085_msg8, flex_pretty_otp5600_msg1, - flex_pretty_otp5600_msg2, flex_pretty_otp5601_msg1, - flex_pretty_otp5793_msg01, flex_pretty_otp5803_msg01, - flex_pretty_otp5803_msg02, flex_pretty_otp5805_msg01, - flex_pretty_otp5836_msg01, flex_pretty_otp7431_msg01, - flex_pretty_otp7431_msg02, flex_pretty_otp7431_msg03, - flex_pretty_otp7431_msg04, flex_pretty_otp7431_msg05, - flex_pretty_otp7431_msg06, flex_pretty_otp7431_msg07]. - -%% ---- - -tickets() -> - Flag = process_flag(trap_exit, true), - Cases = expand(tickets), - Fun = fun(Case) -> - C = init_per_testcase(Case, [{tc_timeout, - timer:minutes(10)}]), - io:format("Eval ~w~n", [Case]), - Result = - case (catch apply(?MODULE, Case, [C])) of - {'EXIT', Reason} -> - io:format("~n~p exited:~n ~p~n", - [Case, Reason]), - {error, {Case, Reason}}; - Res -> - Res - end, - end_per_testcase(Case, C), - Result - end, - process_flag(trap_exit, Flag), - lists:map(Fun, Cases). + [ + flex_pretty_otp5042_msg1, + flex_pretty_otp5085_msg1, + flex_pretty_otp5085_msg2, + flex_pretty_otp5085_msg3, + flex_pretty_otp5085_msg4, + flex_pretty_otp5085_msg5, + flex_pretty_otp5085_msg6, + flex_pretty_otp5085_msg7, + flex_pretty_otp5085_msg8, + flex_pretty_otp5600_msg1, + flex_pretty_otp5600_msg2, + flex_pretty_otp5601_msg1, + flex_pretty_otp5793_msg01, + flex_pretty_otp5803_msg01, + flex_pretty_otp5803_msg02, + flex_pretty_otp5805_msg01, + flex_pretty_otp5836_msg01, + flex_pretty_otp7431_msg01, + flex_pretty_otp7431_msg02, + flex_pretty_otp7431_msg03, + flex_pretty_otp7431_msg04, + flex_pretty_otp7431_msg05, + flex_pretty_otp7431_msg06, + flex_pretty_otp7431_msg07 + ]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/megaco/test/megaco_codec_v1_test.erl b/lib/megaco/test/megaco_codec_v1_test.erl index 3be0da3ae4..d1a1d31da0 100644 --- a/lib/megaco/test/megaco_codec_v1_test.erl +++ b/lib/megaco/test/megaco_codec_v1_test.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 @@ -416,20 +416,9 @@ decode_text_messages(Codec, Config, [Msg|Msgs], Acc) -> %% ---- -expand(RootCase) -> - expand([RootCase], []). - -expand([], Acc) -> - lists:flatten(lists:reverse(Acc)); -expand([Case|Cases], Acc) -> - case (catch apply(?MODULE,Case,[suite])) of - [] -> - expand(Cases, [Case|Acc]); - C when is_list(C) -> - expand(Cases, [expand(C, [])|Acc]); - _ -> - expand(Cases, [Case|Acc]) - end. +tickets() -> + %% io:format("~w:tickets -> entry~n", [?MODULE]), + megaco_test_lib:tickets(?MODULE). %% ---- @@ -594,61 +583,56 @@ end_per_group(_GroupName, Config) -> Config. flex_pretty_cases() -> - [flex_pretty_test_msgs]. + [ + flex_pretty_test_msgs + ]. flex_compact_cases() -> - [flex_compact_test_msgs, flex_compact_dm_timers1, - flex_compact_dm_timers2, flex_compact_dm_timers3, - flex_compact_dm_timers4, flex_compact_dm_timers5, - flex_compact_dm_timers6]. - -%% Support for per_bin was added to ASN.1 as of version -%% 1.3.2 (R8). And later merged into 1.3.1.3 (R7). These -%% releases are identical (as far as I know). -%% + [ + flex_compact_test_msgs, + flex_compact_dm_timers1, + flex_compact_dm_timers2, + flex_compact_dm_timers3, + flex_compact_dm_timers4, + flex_compact_dm_timers5, + flex_compact_dm_timers6 + ]. flex_compact_tickets_cases() -> - [flex_compact_otp7431_msg01a, - flex_compact_otp7431_msg01b, flex_compact_otp7431_msg02, - flex_compact_otp7431_msg03, flex_compact_otp7431_msg04, - flex_compact_otp7431_msg05, flex_compact_otp7431_msg06, - flex_compact_otp7431_msg07]. + [ + flex_compact_otp7431_msg01a, + flex_compact_otp7431_msg01b, + flex_compact_otp7431_msg02, + flex_compact_otp7431_msg03, + flex_compact_otp7431_msg04, + flex_compact_otp7431_msg05, + flex_compact_otp7431_msg06, + flex_compact_otp7431_msg07 + ]. flex_pretty_tickets_cases() -> - [flex_pretty_otp5042_msg1, flex_pretty_otp5085_msg1, - flex_pretty_otp5085_msg2, flex_pretty_otp5085_msg3, - flex_pretty_otp5085_msg4, flex_pretty_otp5085_msg5, - flex_pretty_otp5085_msg6, flex_pretty_otp5085_msg7, - flex_pretty_otp5600_msg1, flex_pretty_otp5600_msg2, - flex_pretty_otp5601_msg1, flex_pretty_otp5793_msg01, - flex_pretty_otp7431_msg01, flex_pretty_otp7431_msg02, - flex_pretty_otp7431_msg03, flex_pretty_otp7431_msg04, - flex_pretty_otp7431_msg05, flex_pretty_otp7431_msg06, - flex_pretty_otp7431_msg07]. - -%% ---- + [ + flex_pretty_otp5042_msg1, + flex_pretty_otp5085_msg1, + flex_pretty_otp5085_msg2, + flex_pretty_otp5085_msg3, + flex_pretty_otp5085_msg4, + flex_pretty_otp5085_msg5, + flex_pretty_otp5085_msg6, + flex_pretty_otp5085_msg7, + flex_pretty_otp5600_msg1, + flex_pretty_otp5600_msg2, + flex_pretty_otp5601_msg1, + flex_pretty_otp5793_msg01, + flex_pretty_otp7431_msg01, + flex_pretty_otp7431_msg02, + flex_pretty_otp7431_msg03, + flex_pretty_otp7431_msg04, + flex_pretty_otp7431_msg05, + flex_pretty_otp7431_msg06, + flex_pretty_otp7431_msg07 + ]. -tickets() -> - Flag = process_flag(trap_exit, true), - Cases = expand(tickets), - Fun = fun(Case) -> - C = init_per_testcase(Case, [{tc_timeout, - timer:minutes(10)}]), - io:format("Eval ~w~n", [Case]), - Result = - case (catch apply(?MODULE, Case, [C])) of - {'EXIT', Reason} -> - io:format("~n~p exited:~n ~p~n", - [Case, Reason]), - {error, {Case, Reason}}; - Res -> - Res - end, - end_per_testcase(Case, C), - Result - end, - process_flag(trap_exit, Flag), - lists:map(Fun, Cases). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/megaco/test/megaco_codec_v2_test.erl b/lib/megaco/test/megaco_codec_v2_test.erl index 1f522504d6..d1fb22cbee 100644 --- a/lib/megaco/test/megaco_codec_v2_test.erl +++ b/lib/megaco/test/megaco_codec_v2_test.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 @@ -37,7 +37,8 @@ -export([t/0, t/1]). --export([all/0,groups/0,init_per_group/2,end_per_group/2, +-export([all/0, + groups/0, init_per_group/2, end_per_group/2, pretty_test_msgs/1, @@ -138,7 +139,11 @@ flex_compact_otp7534_msg01/1, flex_compact_otp7573_msg01/1, flex_compact_otp7576_msg01/1, - + flex_compact_otp10998_msg01/1, + flex_compact_otp10998_msg02/1, + flex_compact_otp10998_msg03/1, + flex_compact_otp10998_msg04/1, + pretty_otp4632_msg1/1, pretty_otp4632_msg2/1, pretty_otp4632_msg3/1, @@ -392,22 +397,10 @@ decode_text_messages(Codec, Config, [Msg|Msgs], Acc) -> %% ---- -expand(RootCase) -> - expand([RootCase], []). - -expand([], Acc) -> - lists:flatten(lists:reverse(Acc)); -expand([Case|Cases], Acc) -> - case (catch apply(?MODULE,Case,[suite])) of - [] -> - expand(Cases, [Case|Acc]); - C when is_list(C) -> - expand(Cases, [expand(C, [])|Acc]); - _ -> - expand(Cases, [Case|Acc]) - end. +tickets() -> + %% io:format("~w:tickets -> entry~n", [?MODULE]), + megaco_test_lib:tickets(?MODULE). - %% ---- @@ -435,79 +428,86 @@ end_per_testcase(Case, Config) -> %% Top test case all() -> -[{group, text}, {group, binary}, {group, erl_dist}, - {group, tickets}]. + [{group, text}, + {group, binary}, + {group, erl_dist}, + {group, tickets}]. groups() -> [{text, [], - [{group, pretty}, {group, flex_pretty}, - {group, compact}, {group, flex_compact}]}, - {binary, [], - [{group, bin}, {group, ber}, {group, per}]}, - {erl_dist, [], [{group, erl_dist_m}]}, - {pretty, [], [pretty_test_msgs]}, - {compact, [], [compact_test_msgs]}, - {flex_pretty, [], flex_pretty_cases()}, - {flex_compact, [], flex_compact_cases()}, - {bin, [], [bin_test_msgs]}, {ber, [], [ber_test_msgs]}, - {per, [], [per_test_msgs]}, - {erl_dist_m, [], [erl_dist_m_test_msgs]}, - {tickets, [], - [{group, compact_tickets}, {group, pretty_tickets}, - {group, flex_compact_tickets}, - {group, flex_pretty_tickets}]}, - {compact_tickets, [], - [compact_otp4011_msg1, compact_otp4011_msg2, - compact_otp4011_msg3, compact_otp4013_msg1, - compact_otp4085_msg1, compact_otp4085_msg2, - compact_otp4280_msg1, compact_otp4299_msg1, - compact_otp4299_msg2, compact_otp4359_msg1, - compact_otp4920_msg0, compact_otp4920_msg1, - compact_otp4920_msg2, compact_otp4920_msg3, - compact_otp4920_msg4, compact_otp4920_msg5, - compact_otp4920_msg6, compact_otp4920_msg7, - compact_otp4920_msg8, compact_otp4920_msg9, - compact_otp4920_msg10, compact_otp4920_msg11, - compact_otp4920_msg12, compact_otp4920_msg20, - compact_otp4920_msg21, compact_otp4920_msg22, - compact_otp4920_msg23, compact_otp4920_msg24, - compact_otp4920_msg25, compact_otp5186_msg01, - compact_otp5186_msg02, compact_otp5186_msg03, - compact_otp5186_msg04, compact_otp5186_msg05, - compact_otp5186_msg06, compact_otp5290_msg01, - compact_otp5290_msg02, compact_otp5793_msg01, - compact_otp5993_msg01, compact_otp5993_msg02, - compact_otp5993_msg03, compact_otp6017_msg01, - compact_otp6017_msg02, compact_otp6017_msg03, - compact_otp7138_msg01, compact_otp7138_msg02, - compact_otp7457_msg01, compact_otp7457_msg02, - compact_otp7457_msg03, compact_otp7534_msg01, - compact_otp7576_msg01, compact_otp7671_msg01]}, - {flex_compact_tickets, [], - flex_compact_tickets_cases()}, - {pretty_tickets, [], - [pretty_otp4632_msg1, pretty_otp4632_msg2, - pretty_otp4632_msg3, pretty_otp4632_msg4, - pretty_otp4710_msg1, pretty_otp4710_msg2, - pretty_otp4945_msg1, pretty_otp4945_msg2, - pretty_otp4945_msg3, pretty_otp4945_msg4, - pretty_otp4945_msg5, pretty_otp4945_msg6, - pretty_otp4949_msg1, pretty_otp4949_msg2, - pretty_otp4949_msg3, pretty_otp5042_msg1, - pretty_otp5068_msg1, pretty_otp5085_msg1, - pretty_otp5085_msg2, pretty_otp5085_msg3, - pretty_otp5085_msg4, pretty_otp5085_msg5, - pretty_otp5085_msg6, pretty_otp5085_msg7, - pretty_otp5600_msg1, pretty_otp5600_msg2, - pretty_otp5601_msg1, pretty_otp5793_msg01, - pretty_otp5882_msg01, pretty_otp6490_msg01, - pretty_otp6490_msg02, pretty_otp6490_msg03, - pretty_otp6490_msg04, pretty_otp6490_msg05, - pretty_otp6490_msg06, pretty_otp7249_msg01, - pretty_otp7671_msg01, pretty_otp7671_msg02, - pretty_otp7671_msg03, pretty_otp7671_msg04, - pretty_otp7671_msg05]}, - {flex_pretty_tickets, [], flex_pretty_tickets_cases()}]. + [{group, pretty}, + {group, flex_pretty}, + {group, compact}, + {group, flex_compact}]}, + {binary, [], + [{group, bin}, + {group, ber}, + {group, per}]}, + {erl_dist, [], [{group, erl_dist_m}]}, + {pretty, [], [pretty_test_msgs]}, + {compact, [], [compact_test_msgs]}, + {flex_pretty, [], flex_pretty_cases()}, + {flex_compact, [], flex_compact_cases()}, + {bin, [], [bin_test_msgs]}, + {ber, [], [ber_test_msgs]}, + {per, [], [per_test_msgs]}, + {erl_dist_m, [], [erl_dist_m_test_msgs]}, + {tickets, [], + [{group, compact_tickets}, + {group, pretty_tickets}, + {group, flex_compact_tickets}, + {group, flex_pretty_tickets}]}, + {compact_tickets, [], + [compact_otp4011_msg1, compact_otp4011_msg2, + compact_otp4011_msg3, compact_otp4013_msg1, + compact_otp4085_msg1, compact_otp4085_msg2, + compact_otp4280_msg1, compact_otp4299_msg1, + compact_otp4299_msg2, compact_otp4359_msg1, + compact_otp4920_msg0, compact_otp4920_msg1, + compact_otp4920_msg2, compact_otp4920_msg3, + compact_otp4920_msg4, compact_otp4920_msg5, + compact_otp4920_msg6, compact_otp4920_msg7, + compact_otp4920_msg8, compact_otp4920_msg9, + compact_otp4920_msg10, compact_otp4920_msg11, + compact_otp4920_msg12, compact_otp4920_msg20, + compact_otp4920_msg21, compact_otp4920_msg22, + compact_otp4920_msg23, compact_otp4920_msg24, + compact_otp4920_msg25, compact_otp5186_msg01, + compact_otp5186_msg02, compact_otp5186_msg03, + compact_otp5186_msg04, compact_otp5186_msg05, + compact_otp5186_msg06, compact_otp5290_msg01, + compact_otp5290_msg02, compact_otp5793_msg01, + compact_otp5993_msg01, compact_otp5993_msg02, + compact_otp5993_msg03, compact_otp6017_msg01, + compact_otp6017_msg02, compact_otp6017_msg03, + compact_otp7138_msg01, compact_otp7138_msg02, + compact_otp7457_msg01, compact_otp7457_msg02, + compact_otp7457_msg03, compact_otp7534_msg01, + compact_otp7576_msg01, compact_otp7671_msg01]}, + {flex_compact_tickets, [], flex_compact_tickets_cases()}, + {pretty_tickets, [], + [pretty_otp4632_msg1, pretty_otp4632_msg2, + pretty_otp4632_msg3, pretty_otp4632_msg4, + pretty_otp4710_msg1, pretty_otp4710_msg2, + pretty_otp4945_msg1, pretty_otp4945_msg2, + pretty_otp4945_msg3, pretty_otp4945_msg4, + pretty_otp4945_msg5, pretty_otp4945_msg6, + pretty_otp4949_msg1, pretty_otp4949_msg2, + pretty_otp4949_msg3, pretty_otp5042_msg1, + pretty_otp5068_msg1, pretty_otp5085_msg1, + pretty_otp5085_msg2, pretty_otp5085_msg3, + pretty_otp5085_msg4, pretty_otp5085_msg5, + pretty_otp5085_msg6, pretty_otp5085_msg7, + pretty_otp5600_msg1, pretty_otp5600_msg2, + pretty_otp5601_msg1, pretty_otp5793_msg01, + pretty_otp5882_msg01, pretty_otp6490_msg01, + pretty_otp6490_msg02, pretty_otp6490_msg03, + pretty_otp6490_msg04, pretty_otp6490_msg05, + pretty_otp6490_msg06, pretty_otp7249_msg01, + pretty_otp7671_msg01, pretty_otp7671_msg02, + pretty_otp7671_msg03, pretty_otp7671_msg04, + pretty_otp7671_msg05]}, + {flex_pretty_tickets, [], flex_pretty_tickets_cases()}]. init_per_group(flex_pretty_tickets, Config) -> flex_pretty_init(Config); @@ -533,92 +533,72 @@ end_per_group(_GroupName, Config) -> - - - - - - - flex_pretty_cases() -> -[flex_pretty_test_msgs]. + [ + flex_pretty_test_msgs + ]. flex_compact_cases() -> -[flex_compact_test_msgs, flex_compact_dm_timers1, - flex_compact_dm_timers2, flex_compact_dm_timers3, - flex_compact_dm_timers4, flex_compact_dm_timers5, - flex_compact_dm_timers6, flex_compact_dm_timers7, - flex_compact_dm_timers8]. - - - - - - - - - - -%% Support for per_bin was added to ASN.1 as of version -%% 1.3.2 (R8). And later merged into 1.3.1.3 (R7). These -%% releases are identical (as far as I know). -%% - - - - - - - -flex_compact_tickets_cases() -> -[flex_compact_otp7138_msg01, flex_compact_otp7138_msg02, - flex_compact_otp7431_msg01, flex_compact_otp7431_msg02, - flex_compact_otp7431_msg03, flex_compact_otp7431_msg04, - flex_compact_otp7431_msg05, flex_compact_otp7431_msg06, - flex_compact_otp7431_msg07, flex_compact_otp7138_msg02, - flex_compact_otp7457_msg01, flex_compact_otp7457_msg02, - flex_compact_otp7457_msg03, flex_compact_otp7534_msg01, - flex_compact_otp7573_msg01, flex_compact_otp7576_msg01]. + [ + flex_compact_test_msgs, + flex_compact_dm_timers1, + flex_compact_dm_timers2, + flex_compact_dm_timers3, + flex_compact_dm_timers4, + flex_compact_dm_timers5, + flex_compact_dm_timers6, + flex_compact_dm_timers7, + flex_compact_dm_timers8 + ]. +flex_compact_tickets_cases() -> + [ + flex_compact_otp7138_msg01, + flex_compact_otp7138_msg02, + flex_compact_otp7431_msg01, + flex_compact_otp7431_msg02, + flex_compact_otp7431_msg03, + flex_compact_otp7431_msg04, + flex_compact_otp7431_msg05, + flex_compact_otp7431_msg06, + flex_compact_otp7431_msg07, + flex_compact_otp7138_msg02, + flex_compact_otp7457_msg01, + flex_compact_otp7457_msg02, + flex_compact_otp7457_msg03, + flex_compact_otp7534_msg01, + flex_compact_otp7573_msg01, + flex_compact_otp7576_msg01, + flex_compact_otp10998_msg01, + flex_compact_otp10998_msg02, + flex_compact_otp10998_msg03, + flex_compact_otp10998_msg04 + ]. flex_pretty_tickets_cases() -> -[flex_pretty_otp5042_msg1, flex_pretty_otp5085_msg1, - flex_pretty_otp5085_msg2, flex_pretty_otp5085_msg3, - flex_pretty_otp5085_msg4, flex_pretty_otp5085_msg5, - flex_pretty_otp5085_msg6, flex_pretty_otp5085_msg7, - flex_pretty_otp5600_msg1, flex_pretty_otp5600_msg2, - flex_pretty_otp5601_msg1, flex_pretty_otp5793_msg01, - flex_pretty_otp7431_msg01, flex_pretty_otp7431_msg02, - flex_pretty_otp7431_msg03, flex_pretty_otp7431_msg04, - flex_pretty_otp7431_msg05, flex_pretty_otp7431_msg06, - flex_pretty_otp7431_msg07]. - -%% ---- - -tickets() -> - Flag = process_flag(trap_exit, true), - Cases = expand(tickets), - Fun = fun(Case) -> - C = init_per_testcase(Case, [{tc_timeout, - timer:minutes(10)}]), - io:format("Eval ~w~n", [Case]), - Result = - case (catch apply(?MODULE, Case, [C])) of - {'EXIT', Reason} -> - io:format("~n~p exited:~n ~p~n", - [Case, Reason]), - {error, {Case, Reason}}; - Res -> - Res - end, - end_per_testcase(Case, C), - Result - end, - process_flag(trap_exit, Flag), - lists:map(Fun, Cases). - + [ + flex_pretty_otp5042_msg1, + flex_pretty_otp5085_msg1, + flex_pretty_otp5085_msg2, + flex_pretty_otp5085_msg3, + flex_pretty_otp5085_msg4, + flex_pretty_otp5085_msg5, + flex_pretty_otp5085_msg6, + flex_pretty_otp5085_msg7, + flex_pretty_otp5600_msg1, + flex_pretty_otp5600_msg2, + flex_pretty_otp5601_msg1, + flex_pretty_otp5793_msg01, + flex_pretty_otp7431_msg01, + flex_pretty_otp7431_msg02, + flex_pretty_otp7431_msg03, + flex_pretty_otp7431_msg04, + flex_pretty_otp7431_msg05, + flex_pretty_otp7431_msg06, + flex_pretty_otp7431_msg07 + ]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -3138,14 +3118,792 @@ otp7573(Codec, EC, BinMsg) -> flex_compact_otp7576_msg01(suite) -> []; flex_compact_otp7576_msg01(Config) when is_list(Config) -> -%% put(dbg, true), -%% put(severity, trc), + %% put(dbg, true), + %% put(severity, trc), d("flex_compact_otp7576_msg01 -> entry", []), Msg = compact_otp7576_msg01(), Conf = flex_scanner_conf(Config), compact_otp7576([Conf], Msg). +%% killer_42_original +flex_compact_otp10998_msg01() -> + <<"!/2 stofmg0 +P=25165898{C=34227581{AV=r01/03/01/38/22{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227613{AV=r01/03/01/38/12{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227744{AV=r01/03/01/38/11{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227755{AV=r01/03/01/38/2{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227768{AV=r01/03/01/38/14{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227774{AV=r01/03/01/38/15{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227775{AV=r01/03/01/38/16{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323119{AV=r01/03/01/38/9{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323122{AV=r01/03/01/38/7{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323156{AV=r01/03/01/38/8{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323260{AV=r01/03/01/38/13{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323272{AV=r01/03/01/38/30{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323273{AV=r01/03/01/38/29{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323275{AV=r01/03/01/38/25{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323276{AV=r01/03/01/38/28{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323279{AV=r01/03/01/38/26{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323280{AV=r01/03/01/38/24{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323281{AV=r01/03/01/38/27{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323284{AV=r01/03/01/38/23{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34129764{AV=r01/03/01/55/31{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227463{AV=r01/03/01/55/26{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227472{AV=r01/03/01/55/22{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227484{AV=r01/03/01/55/16{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227555{AV=r01/03/01/55/5{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227556{AV=r01/03/01/55/14{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227557{AV=r01/03/01/55/10{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227563{AV=r01/03/01/55/7{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227565{AV=r01/03/01/55/13{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227602{AV=r01/03/01/55/21{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227616{AV=r01/03/01/55/1{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227704{AV=r01/03/01/55/19{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227705{AV=r01/03/01/55/18{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34227715{AV=r01/03/01/55/20{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34322656{AV=r01/03/01/55/30{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34322804{AV=r01/03/01/55/24{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34322812{AV=r01/03/01/55/15{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34322825{AV=r01/03/01/55/4{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34322836{AV=r01/03/01/55/17{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323007{AV=r01/03/01/55/6{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323008{AV=r01/03/01/55/2{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323071{AV=r01/03/01/55/28{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}},C=34323075{AV=r01/03/01/55/29{M{TS{eri_terminfo/dev_state=norm,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=IV},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x00},L{ +v=0
+c=TN RFC2543 -
+m=audio - TDM -
+}}}}}">>. + + +%% size36_27_11_bad.txt +flex_compact_otp10998_msg02() -> + <<"!/2 stofmg0 +P=25167656{C=34205358{AV=r01/03/01/27/22{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34205359{AV=r01/03/01/27/13{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34205360{AV=r01/03/01/27/23{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227786{AV=r01/03/01/27/8{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34230890{AV=r01/03/01/27/15{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34230903{AV=r01/03/01/27/24{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34230904{AV=r01/03/01/27/14{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34230905{AV=r01/03/01/27/12{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34230913{AV=r01/03/01/27/4{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316801{AV=r01/03/01/27/9{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316805{AV=r01/03/01/27/19{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316814{AV=r01/03/01/27/5{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316829{AV=r01/03/01/27/7{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323013{AV=r01/03/01/27/6{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34107499{AV=r01/03/01/11/14{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34107500{AV=r01/03/01/11/4{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34107505{AV=r01/03/01/11/8{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316766{AV=r01/03/01/11/3{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316768{AV=r01/03/01/11/10{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316786{AV=r01/03/01/11/12{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316787{AV=r01/03/01/11/1{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316793{AV=r01/03/01/11/22{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316794{AV=r01/03/01/11/24{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316795{AV=r01/03/01/11/31{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316797{AV=r01/03/01/11/18{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316804{AV=r01/03/01/11/15{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316807{AV=r01/03/01/11/6{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316815{AV=r01/03/01/11/16{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316819{AV=r01/03/01/11/28{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316824{AV=r01/03/01/11/17{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316826{AV=r01/03/01/11/25{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316827{AV=r01/03/01/11/9{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316828{AV=r01/03/01/11/21{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316830{AV=r01/03/01/11/2{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316832{AV=r01/03/01/11/11{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34316850{AV=r01/03/01/11/5{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}}}">>. + + +%% size41_38_55_good.txt +flex_compact_otp10998_msg03() -> + <<"!/2 stofmg0 +P=25166035{C=34227581{AV=r01/03/01/38/22{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227613{AV=r01/03/01/38/12{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227744{AV=r01/03/01/38/11{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227755{AV=r01/03/01/38/2{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227768{AV=r01/03/01/38/14{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227774{AV=r01/03/01/38/15{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227775{AV=r01/03/01/38/16{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323122{AV=r01/03/01/38/7{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323156{AV=r01/03/01/38/8{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323260{AV=r01/03/01/38/13{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323272{AV=r01/03/01/38/30{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323273{AV=r01/03/01/38/29{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323275{AV=r01/03/01/38/25{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323276{AV=r01/03/01/38/28{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323279{AV=r01/03/01/38/26{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323280{AV=r01/03/01/38/24{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323281{AV=r01/03/01/38/27{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323284{AV=r01/03/01/38/23{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34129764{AV=r01/03/01/55/31{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227463{AV=r01/03/01/55/26{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227472{AV=r01/03/01/55/22{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227484{AV=r01/03/01/55/16{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227555{AV=r01/03/01/55/5{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227556{AV=r01/03/01/55/14{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227557{AV=r01/03/01/55/10{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227563{AV=r01/03/01/55/7{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227565{AV=r01/03/01/55/13{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227602{AV=r01/03/01/55/21{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227616{AV=r01/03/01/55/1{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227704{AV=r01/03/01/55/19{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227705{AV=r01/03/01/55/18{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227715{AV=r01/03/01/55/20{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34322656{AV=r01/03/01/55/30{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34322804{AV=r01/03/01/55/24{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34322812{AV=r01/03/01/55/15{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34322825{AV=r01/03/01/55/4{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34322836{AV=r01/03/01/55/17{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323007{AV=r01/03/01/55/6{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323008{AV=r01/03/01/55/2{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323071{AV=r01/03/01/55/28{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323075{AV=r01/03/01/55/29{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}}}">>. + + +%% size42_38_55_bad.txt +flex_compact_otp10998_msg04() -> + <<"!/2 stofmg0 +P=33555020{C=34227581{AV=r01/03/01/38/22{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227613{AV=r01/03/01/38/12{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227744{AV=r01/03/01/38/11{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227755{AV=r01/03/01/38/2{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227768{AV=r01/03/01/38/14{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227774{AV=r01/03/01/38/15{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227775{AV=r01/03/01/38/16{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323119{AV=r01/03/01/38/9{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323122{AV=r01/03/01/38/7{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323156{AV=r01/03/01/38/8{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323260{AV=r01/03/01/38/13{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323272{AV=r01/03/01/38/30{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323273{AV=r01/03/01/38/29{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323275{AV=r01/03/01/38/25{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323276{AV=r01/03/01/38/28{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323279{AV=r01/03/01/38/26{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323280{AV=r01/03/01/38/24{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323281{AV=r01/03/01/38/27{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323284{AV=r01/03/01/38/23{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34129764{AV=r01/03/01/55/31{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227463{AV=r01/03/01/55/26{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227472{AV=r01/03/01/55/22{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227484{AV=r01/03/01/55/16{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227555{AV=r01/03/01/55/5{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227556{AV=r01/03/01/55/14{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227557{AV=r01/03/01/55/10{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227563{AV=r01/03/01/55/7{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227565{AV=r01/03/01/55/13{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227602{AV=r01/03/01/55/21{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227616{AV=r01/03/01/55/1{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227704{AV=r01/03/01/55/19{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227705{AV=r01/03/01/55/18{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34227715{AV=r01/03/01/55/20{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34322656{AV=r01/03/01/55/30{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34322804{AV=r01/03/01/55/24{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34322812{AV=r01/03/01/55/15{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34322825{AV=r01/03/01/55/4{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34322836{AV=r01/03/01/55/17{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323007{AV=r01/03/01/55/6{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323008{AV=r01/03/01/55/2{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323071{AV=r01/03/01/55/28{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}},C=34323075{AV=r01/03/01/55/29{M{TS{eri_terminfo/dev_state=link,eri_terminfo/dev_type=cee1,eri_terminfo/law_conv=on,SI=OS},O{MO=SR,RV=OFF,semper/act=on,tdmc/ec=off,semper/termstatus=0x01},L{ +v=0 +c=TN RFC2543 - +m=audio - TDM - +}}}}}">>. + + +flex_compact_otp10998_num() -> + 10. + +flex_compact_otp10998_msg01(suite) -> + []; +flex_compact_otp10998_msg01(Config) when is_list(Config) -> + %% put(dbg, true), + %% put(severity, trc), + d("flex_compact_otp10998_msg01 -> entry", []), + Msg = flex_compact_otp10998_msg01(), + d("flex_compact_otp10998_msg01 -> message created", []), + Conf = + try flex_scanner_conf(Config) of + C -> + C + catch + exit:Error -> + e("Failed getting flex config: " + "~n Error: ~p", [Error]), + exit(Error) + end, + d("flex_compact_otp10998_msg01 -> flex config generated", []), + flex_compact_otp10998([Conf], flex_compact_otp10998_num(), Msg). + +flex_compact_otp10998_msg02(suite) -> + []; +flex_compact_otp10998_msg02(Config) when is_list(Config) -> + %% put(dbg, true), + %% put(severity, trc), + d("flex_compact_otp10998_msg02 -> entry", []), + Msg = flex_compact_otp10998_msg02(), + d("flex_compact_otp10998_msg02 -> message created", []), + Conf = + try flex_scanner_conf(Config) of + C -> + C + catch + exit:Error -> + e("Failed getting flex config: " + "~n Error: ~p", [Error]), + exit(Error) + end, + d("flex_compact_otp10998_msg02 -> flex config generated", []), + flex_compact_otp10998([Conf], flex_compact_otp10998_num(), Msg). + +flex_compact_otp10998_msg03(suite) -> + []; +flex_compact_otp10998_msg03(Config) when is_list(Config) -> + %% put(dbg, true), + %% put(severity, trc), + d("flex_compact_otp10998_msg03 -> entry", []), + Msg = flex_compact_otp10998_msg03(), + d("flex_compact_otp10998_msg03 -> message created", []), + Conf = + try flex_scanner_conf(Config) of + C -> + C + catch + exit:Error -> + e("Failed getting flex config: " + "~n Error: ~p", [Error]), + exit(Error) + end, + d("flex_compact_otp10998_msg03 -> flex config generated", []), + flex_compact_otp10998([Conf], flex_compact_otp10998_num(), Msg). + +flex_compact_otp10998_msg04(suite) -> + []; +flex_compact_otp10998_msg04(Config) when is_list(Config) -> + %% put(dbg, true), + %% put(severity, trc), + d("flex_compact_otp10998_msg04 -> entry", []), + Msg = flex_compact_otp10998_msg04(), + d("flex_compact_otp10998_msg04 -> message created", []), + Conf = + try flex_scanner_conf(Config) of + C -> + C + catch + exit:Error -> + e("Failed getting flex config: " + "~n Error: ~p", [Error]), + exit(Error) + end, + d("flex_compact_otp10998_msg04 -> flex config generated", []), + flex_compact_otp10998([Conf], flex_compact_otp10998_num(), Msg). + +flex_compact_otp10998(EC, N, BinMsg) -> + Codec = megaco_compact_text_encoder, + Decode = fun(No) -> + case decode_message(Codec, false, EC, BinMsg) of + {ok, _Msg} -> + d("flex_compact_otp10998 -> decode ok", []), + ok; + {error, Reason} -> + e("flex_compact_otp10998 -> " + "decode ~w failed: ~p", [No, Reason]), + throw({error, No, Reason}) + end + end, + do_flex_compact_otp10998(N, Decode). + +do_flex_compact_otp10998(N, Decode) when N > 0 -> + Decode(N), + do_flex_compact_otp10998(N-1, Decode); +do_flex_compact_otp10998(_, _) -> + ok. + + + %% ============================================================== %% %% P r e t t y T e s t c a s e s @@ -6772,7 +7530,14 @@ cre_PkgsItem(Name, Ver) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% flex_init(Config) -> - megaco_codec_flex_lib:init(Config). + %% io:format("~w:flex_init -> entry with: " + %% "~n Config: ~p" + %% "~n", [?MODULE, Config]), + Res = megaco_codec_flex_lib:init(Config), + %% io:format("~w:flex_init -> flex init result: " + %% "~n Res: ~p" + %% "~n", [?MODULE, Res]), + Res. flex_finish(Config) -> megaco_codec_flex_lib:finish(Config). diff --git a/lib/megaco/test/megaco_codec_v3_test.erl b/lib/megaco/test/megaco_codec_v3_test.erl index 9d564a0ae3..84cc863300 100644 --- a/lib/megaco/test/megaco_codec_v3_test.erl +++ b/lib/megaco/test/megaco_codec_v3_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-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 @@ -235,21 +235,9 @@ generate_text_messages() -> %% ---- - -expand(RootCase) -> - expand([RootCase], []). - -expand([], Acc) -> - lists:flatten(lists:reverse(Acc)); -expand([Case|Cases], Acc) -> - case (catch apply(?MODULE,Case,[suite])) of - [] -> - expand(Cases, [Case|Acc]); - C when is_list(C) -> - expand(Cases, [expand(C, [])|Acc]); - _ -> - expand(Cases, [Case|Acc]) - end. +tickets() -> + %% io:format("~w:tickets -> entry~n", [?MODULE]), + megaco_test_lib:tickets(?MODULE). %% ---- @@ -278,26 +266,34 @@ end_per_testcase(Case, Config) -> %% Top test case all() -> - [{group, text}, {group, binary}, {group, erl_dist}, + [{group, text}, + {group, binary}, + {group, erl_dist}, {group, tickets}]. groups() -> [{text, [], - [{group, pretty}, {group, flex_pretty}, - {group, compact}, {group, flex_compact}]}, + [{group, pretty}, + {group, flex_pretty}, + {group, compact}, + {group, flex_compact}]}, {binary, [], - [{group, bin}, {group, ber}, {group, per}]}, + [{group, bin}, + {group, ber}, + {group, per}]}, {erl_dist, [], [{group, erl_dist_m}]}, {pretty, [], [pretty_test_msgs]}, {compact, [], [compact_test_msgs]}, {flex_pretty, [], flex_pretty_cases()}, {flex_compact, [], flex_compact_cases()}, - {bin, [], [bin_test_msgs]}, {ber, [], [ber_test_msgs]}, + {bin, [], [bin_test_msgs]}, + {ber, [], [ber_test_msgs]}, {per, [], [per_test_msgs]}, {erl_dist_m, [], [erl_dist_m_test_msgs]}, {tickets, [], [{group, compact_tickets}, - {group, flex_compact_tickets}, {group, pretty_tickets}, + {group, flex_compact_tickets}, + {group, pretty_tickets}, {group, flex_pretty_tickets}]}, {compact_tickets, [], [compact_otp4011_msg1, compact_otp4011_msg2, @@ -321,8 +317,7 @@ groups() -> compact_otp5993_msg01, compact_otp5993_msg02, compact_otp5993_msg03, compact_otp6017_msg01, compact_otp6017_msg02, compact_otp6017_msg03]}, - {flex_compact_tickets, [], - flex_compact_tickets_cases()}, + {flex_compact_tickets, [], flex_compact_tickets_cases()}, {pretty_tickets, [], [pretty_otp4632_msg1, pretty_otp4632_msg2, pretty_otp4632_msg3, pretty_otp4632_msg4, @@ -373,69 +368,65 @@ end_per_group(_GroupName, Config) -> flex_pretty_cases() -> - [flex_pretty_test_msgs]. + [ + flex_pretty_test_msgs + ]. flex_compact_cases() -> - [flex_compact_test_msgs, flex_compact_dm_timers1, - flex_compact_dm_timers2, flex_compact_dm_timers3, - flex_compact_dm_timers4, flex_compact_dm_timers5, - flex_compact_dm_timers6, flex_compact_dm_timers7, - flex_compact_dm_timers8]. - - - -%% Support for per_bin was added to ASN.1 as of version -%% 1.3.2 (R8). And later merged into 1.3.1.3 (R7). These -%% releases are identical (as far as I know). -%% - + [ + flex_compact_test_msgs, + flex_compact_dm_timers1, + flex_compact_dm_timers2, + flex_compact_dm_timers3, + flex_compact_dm_timers4, + flex_compact_dm_timers5, + flex_compact_dm_timers6, + flex_compact_dm_timers7, + flex_compact_dm_timers8 + ]. flex_compact_tickets_cases() -> - [flex_compact_otp4299_msg1, flex_compact_otp7431_msg01, - flex_compact_otp7431_msg02, flex_compact_otp7431_msg03, - flex_compact_otp7431_msg04, flex_compact_otp7431_msg05, - flex_compact_otp7431_msg06, flex_compact_otp7431_msg07]. + [ + flex_compact_otp4299_msg1, + flex_compact_otp7431_msg01, + flex_compact_otp7431_msg02, + flex_compact_otp7431_msg03, + flex_compact_otp7431_msg04, + flex_compact_otp7431_msg05, + flex_compact_otp7431_msg06, + flex_compact_otp7431_msg07 + ]. flex_pretty_tickets_cases() -> - [flex_pretty_otp5042_msg1, flex_pretty_otp5085_msg1, - flex_pretty_otp5085_msg2, flex_pretty_otp5085_msg3, - flex_pretty_otp5085_msg4, flex_pretty_otp5085_msg5, - flex_pretty_otp5085_msg6, flex_pretty_otp5085_msg7, - flex_pretty_otp5085_msg8, flex_pretty_otp5600_msg1, - flex_pretty_otp5600_msg2, flex_pretty_otp5601_msg1, - flex_pretty_otp5793_msg01, flex_pretty_otp5803_msg01, - flex_pretty_otp5803_msg02, flex_pretty_otp5805_msg01, - flex_pretty_otp5836_msg01, flex_pretty_otp7431_msg01, - flex_pretty_otp7431_msg02, flex_pretty_otp7431_msg03, - flex_pretty_otp7431_msg04, flex_pretty_otp7431_msg05, - flex_pretty_otp7431_msg06, flex_pretty_otp7431_msg07]. - -%% ---- + [ + flex_pretty_otp5042_msg1, + flex_pretty_otp5085_msg1, + flex_pretty_otp5085_msg2, + flex_pretty_otp5085_msg3, + flex_pretty_otp5085_msg4, + flex_pretty_otp5085_msg5, + flex_pretty_otp5085_msg6, + flex_pretty_otp5085_msg7, + flex_pretty_otp5085_msg8, + flex_pretty_otp5600_msg1, + flex_pretty_otp5600_msg2, + flex_pretty_otp5601_msg1, + flex_pretty_otp5793_msg01, + flex_pretty_otp5803_msg01, + flex_pretty_otp5803_msg02, + flex_pretty_otp5805_msg01, + flex_pretty_otp5836_msg01, + flex_pretty_otp7431_msg01, + flex_pretty_otp7431_msg02, + flex_pretty_otp7431_msg03, + flex_pretty_otp7431_msg04, + flex_pretty_otp7431_msg05, + flex_pretty_otp7431_msg06, + flex_pretty_otp7431_msg07 + ]. -tickets() -> - Flag = process_flag(trap_exit, true), - Cases = expand(tickets), - Fun = fun(Case) -> - C = init_per_testcase(Case, [{tc_timeout, - timer:minutes(10)}]), - io:format("Eval ~w~n", [Case]), - Result = - case (catch apply(?MODULE, Case, [C])) of - {'EXIT', Reason} -> - io:format("~n~p exited:~n ~p~n", - [Case, Reason]), - {error, {Case, Reason}}; - Res -> - Res - end, - end_per_testcase(Case, C), - Result - end, - process_flag(trap_exit, Flag), - lists:map(Fun, Cases). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% pretty_test_msgs(suite) -> diff --git a/lib/megaco/test/megaco_test_lib.erl b/lib/megaco/test/megaco_test_lib.erl index 282fd91b44..41b49f6d30 100644 --- a/lib/megaco/test/megaco_test_lib.erl +++ b/lib/megaco/test/megaco_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. 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 @@ -113,72 +113,17 @@ os_based_skip(_) -> %% {Mod, Fun, ExpectedRes, ActualRes} %%---------------------------------------------------------------------- -tickets(Case) -> - Res = lists:flatten(tickets(Case, default_config())), - %% io:format("Res: ~p~n", [Res]), +tickets([Mod]) -> + tickets(Mod); +tickets(Mod) when is_atom(Mod) -> + %% p("tickets -> entry with" + %% "~n Mod: ~p", [Mod]), + Res0 = t({Mod, {group, tickets}, Mod:groups()}, default_config()), + Res = lists:flatten(Res0), + %% p("tickets(~w) -> Res: ~p~n", [Mod, Res]), display_result(Res), Res. -tickets(Cases, Config) when is_list(Cases) -> - [tickets(Case, Config) || Case <- Cases]; -tickets(Mod, Config) when is_atom(Mod) -> - Res = tickets(Mod, tickets, Config), - Res; -tickets(Bad, _Config) -> - [{badarg, Bad, ok}]. - -tickets(Mod, Func, Config) -> - case (catch Mod:Func(suite)) of - [] -> - io:format("Eval: ~p:", [{Mod, Func}]), - Res = eval(Mod, Func, Config), - {R, _, _} = Res, - io:format(" ~p~n", [R]), - Res; - - Cases when is_list(Cases) -> - io:format("Expand: ~p:~p ... ~n" - " ~p~n", [Mod, Func, Cases]), - Map = fun({M,_}) when is_atom(M) -> - tickets(M, tickets, Config); - (F) when is_atom(F) -> - tickets(Mod, F, Config); - (Case) -> Case - end, - lists:map(Map, Cases); - -%% {req, _, {conf, Init, Cases, Finish}} -> -%% case (catch Mod:Init(Config)) of -%% Conf when is_list(Conf) -> -%% io:format("Expand: ~p:~p ...~n", [Mod, Func]), -%% Map = fun({M,_}) when is_atom(M) -> -%% tickets(M, tickets, Config); -%% (F) when is_atom(F) -> -%% tickets(Mod, F, Config); -%% (Case) -> Case -%% end, -%% Res = lists:map(Map, Cases), -%% (catch Mod:Finish(Conf)), -%% Res; - -%% {'EXIT', {skipped, Reason}} -> -%% io:format(" => skipping: ~p~n", [Reason]), -%% [{skipped, {Mod, Func}, Reason}]; - -%% Error -> -%% io:format(" => init failed: ~p~n", [Error]), -%% [{failed, {Mod, Func}, Error}] -%% end; - - {'EXIT', {undef, _}} -> - io:format("Undefined: ~p~n", [{Mod, Func}]), - [{nyi, {Mod, Func}, ok}]; - - Error -> - io:format("Ignoring: ~p:~p: ~p~n", [Mod, Func, Error]), - [{failed, {Mod, Func}, Error}] - end. - display_alloc_info() -> io:format("Allocator memory information:~n", []), @@ -254,8 +199,12 @@ alloc_instance_mem_info(Key, InstanceInfo) -> t([Case]) when is_atom(Case) -> + %% p("t -> entry with" + %% "~n [Case]: [~p]", [Case]), t(Case); t(Case) -> + %% p("t -> entry with" + %% "~n Case: ~p", [Case]), process_flag(trap_exit, true), MEM = fun() -> case (catch erlang:memory()) of {'EXIT', _} -> @@ -298,9 +247,16 @@ end_group(Mod, Group, Config) -> %% This is for sub-SUITEs t({_Mod, {NewMod, all}, _Groups}, _Config) when is_atom(NewMod) -> + %% p("t(all) -> entry with" + %% "~n NewMod: ~p", [NewMod]), t(NewMod); t({Mod, {group, Name} = Group, Groups}, Config) when is_atom(Mod) andalso is_atom(Name) andalso is_list(Groups) -> + %% p("t(group) -> entry with" + %% "~n Mod: ~p" + %% "~n Name: ~p" + %% "~n Groups: ~p" + %% "~n Config: ~p", [Mod, Name, Groups, Config]), case lists:keysearch(Name, 1, Groups) of {value, {Name, _Props, GroupsAndCases}} -> try init_group(Mod, Name, Config) of @@ -317,7 +273,7 @@ t({Mod, {group, Name} = Group, Groups}, Config) exit:{skipped, SkipReason} -> io:format(" => skipping group: ~p~n", [SkipReason]), [{skipped, {Mod, Group}, SkipReason, 0}]; - exit:{undef, _} -> + error:undef -> [t({Mod, Case, Groups}, Config) || Case <- GroupsAndCases]; T:E -> @@ -328,7 +284,11 @@ t({Mod, {group, Name} = Group, Groups}, Config) end; t({Mod, Fun, _}, Config) when is_atom(Mod) andalso is_atom(Fun) -> - case catch apply(Mod, Fun, [suite]) of + %% p("t -> entry with" + %% "~n Mod: ~p" + %% "~n Fun: ~p" + %% "~n Config: ~p", [Mod, Fun, Config]), + try apply(Mod, Fun, [suite]) of [] -> io:format("Eval: ~p:", [{Mod, Fun}]), Res = eval(Mod, Fun, Config), @@ -343,18 +303,24 @@ t({Mod, Fun, _}, Config) end, t(lists:map(Map, Cases), Config); - {'EXIT', {undef, _}} -> - io:format("Undefined: ~p~n", [{Mod, Fun}]), - [{nyi, {Mod, Fun}, ok, 0}]; - Error -> io:format("Ignoring: ~p: ~p~n", [{Mod, Fun}, Error]), [{failed, {Mod, Fun}, Error, 0}] + + catch + error:undef -> + io:format("Undefined: ~p~n", [{Mod, Fun}]), + [{nyi, {Mod, Fun}, ok, 0}] + + end; t(Mod, Config) when is_atom(Mod) -> + %% p("t -> entry with" + %% "~n Mod: ~p" + %% "~n Config: ~p", [Mod, Config]), %% This is assumed to be a test suite, so we start by calling %% the top test suite function(s) (all/0 and groups/0). - case (catch Mod:all()) of + try Mod:all() of Cases when is_list(Cases) -> %% The list may contain atoms (actual test cases) and %% group-tuples (a tuple naming a group of test cases). @@ -372,17 +338,21 @@ t(Mod, Config) when is_atom(Mod) -> exit:{skipped, SkipReason} -> io:format(" => skipping suite: ~p~n", [SkipReason]), [{skipped, {Mod, init_per_suite}, SkipReason, 0}]; - exit:{undef, _} -> + error:undef -> [t({Mod, Case, Groups}, Config) || Case <- Cases]; T:E -> + io:format(" => failed suite: ~p~n", [{T,E}]), [{failed, {Mod, init_per_suite}, {T,E}, 0}] end; - {'EXIT', {undef, _}} -> - io:format("Undefined: ~p~n", [{Mod, all}]), - [{nyi, {Mod, all}, ok, 0}]; - + Crap -> Crap + + catch + error:undef -> + io:format("Undefined: ~p~n", [{Mod, all}]), + [{nyi, {Mod, all}, ok, 0}] + end; t(Bad, _Config) -> [{badarg, Bad, ok, 0}]. @@ -409,6 +379,14 @@ eval(Mod, Fun, Config) -> wait_for_evaluator(Pid, Mod, Fun, Config, Errors) -> wait_for_evaluator(Pid, Mod, Fun, Config, Errors, 0). wait_for_evaluator(Pid, Mod, Fun, Config, Errors, AccTime) -> + %% p("wait_for_evaluator -> " + %% "~n Pid: ~p" + %% "~n Mod: ~p" + %% "~n Fun: ~p" + %% "~n Config: ~p" + %% "~n Errors: ~p" + %% "~n AccTime: ~p", + %% [Pid, Mod, Fun, Config, Errors, AccTime]), TestCase = {?MODULE, Mod, Fun}, Label = lists:concat(["TEST CASE: ", Fun]), receive @@ -446,16 +424,43 @@ wait_for_evaluator(Pid, Mod, Fun, Config, Errors, AccTime) -> end. do_eval(ReplyTo, Mod, Fun, Config) -> + %% p("do_eval -> " + %% "~n ReplyTo: ~p" + %% "~n Mod: ~p" + %% "~n Fun: ~p" + %% "~n Config: ~p", [ReplyTo, Mod, Fun, Config]), display_system_info("before", Mod, Fun), - case timer:tc(Mod, Fun, [Config]) of - {Time, {'EXIT', {skipped, Reason}}} -> + T1 = os:timestamp(), + try Mod:Fun(Config) of + Res -> + %% p("do_eval -> done" + %% "~n Res: ~p", [Res]), + T2 = os:timestamp(), + Time = timer:now_diff(T2, T1), + display_tc_time(Time), + display_system_info("after", Mod, Fun), + ReplyTo ! {done, self(), Res, Time} + catch + error:undef -> + %% p("do_eval -> error - undef", []), + ReplyTo ! {'EXIT', self(), undef, 0}; + exit:{skipped, Reason} -> + %% p("do_eval -> exit - skipped" + %% "~n Reason: ~p", [Reason]), + T2 = os:timestamp(), + Time = timer:now_diff(T2, T1), display_tc_time(Time), display_system_info("after (skipped)", Mod, Fun), ReplyTo ! {'EXIT', self(), {skipped, Reason}, Time}; - {Time, Other} -> + exit:{suite_failed, Reason} -> + %% p("do_eval -> exit - suite-failed" + %% "~n Reason: ~p", [Reason]), + T2 = os:timestamp(), + Time = timer:now_diff(T2, T1), display_tc_time(Time), - display_system_info("after", Mod, Fun), - ReplyTo ! {done, self(), Other, Time} + display_system_info("after (failed)", Mod, Fun), + ReplyTo ! {done, self(), Reason, Time} + end, unlink(ReplyTo), exit(shutdown). diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index b61cf2102c..68b12c0286 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = megaco -MEGACO_VSN = 3.16.0.3 +MEGACO_VSN = 3.17 PRE_VSN = APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)" diff --git a/lib/mnesia/src/mnesia_index.erl b/lib/mnesia/src/mnesia_index.erl index f9f3ce2ea4..6f9f575d93 100644 --- a/lib/mnesia/src/mnesia_index.erl +++ b/lib/mnesia/src/mnesia_index.erl @@ -301,7 +301,13 @@ make_ram_index(Tab, [Pos | Tail]) -> add_ram_index(Tab, Pos) when is_integer(Pos) -> verbose("Creating index for ~w ~n", [Tab]), - Index = mnesia_monitor:mktab(mnesia_index, [bag, public]), + SetOrBag = val({Tab, setorbag}), + IndexType = case SetOrBag of + set -> duplicate_bag; + ordered_set -> duplicate_bag; + bag -> bag + end, + Index = mnesia_monitor:mktab(mnesia_index, [IndexType, public]), Insert = fun(Rec, _Acc) -> true = ?ets_insert(Index, {element(Pos, Rec), element(2, Rec)}) end, @@ -309,7 +315,7 @@ add_ram_index(Tab, Pos) when is_integer(Pos) -> true = ets:foldl(Insert, true, Tab), mnesia_lib:db_fixtable(ram_copies, Tab, false), mnesia_lib:set({Tab, {index, Pos}}, Index), - add_index_info(Tab, val({Tab, setorbag}), {Pos, {ram, Index}}); + add_index_info(Tab, SetOrBag, {Pos, {ram, Index}}); add_ram_index(_Tab, snmp) -> ok. diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index 4ba400fbbf..4afbea1cc2 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2011. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 @@ -487,7 +487,8 @@ finish_copy(Storage,Tab,Cs,SenderPid,DatBin,OrigTabRec) -> subscr_receiver(TabRef = {_, Tab}, RecName) -> receive - {mnesia_table_event, {Op, Val, _Tid}} -> + {mnesia_table_event, {Op, Val, _Tid}} + when element(1, Val) =:= Tab -> if Tab == RecName -> handle_event(TabRef, Op, Val); @@ -496,6 +497,15 @@ subscr_receiver(TabRef = {_, Tab}, RecName) -> end, subscr_receiver(TabRef, RecName); + {mnesia_table_event, {Op, Val, _Tid}} when element(1, Val) =:= schema -> + %% clear_table is faked via two schema events + %% a schema record delete and a write + case Op of + delete -> handle_event(TabRef, clear_table, {Tab, all}); + _ -> ok + end, + subscr_receiver(TabRef, RecName); + {'EXIT', Pid, Reason} -> handle_exit(Pid, Reason), subscr_receiver(TabRef, RecName) diff --git a/lib/mnesia/test/mnesia_evil_coverage_test.erl b/lib/mnesia/test/mnesia_evil_coverage_test.erl index 64b61288ef..0df245b75d 100644 --- a/lib/mnesia/test/mnesia_evil_coverage_test.erl +++ b/lib/mnesia/test/mnesia_evil_coverage_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. 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 @@ -39,7 +39,7 @@ all() -> db_node_lifecycle, evil_delete_db_node, start_and_stop, checkpoint, table_lifecycle, storage_options, add_copy_conflict, - add_copy_when_going_down, replica_management, + add_copy_when_going_down, replica_management, clear_table_during_load, schema_availability, local_content, {group, table_access_modifications}, replica_location, {group, table_sync}, user_properties, unsupp_user_props, @@ -569,7 +569,50 @@ storage_options(Config) when is_list(Config) -> ?verify_mnesia(Nodes, []). +clear_table_during_load(suite) -> []; +clear_table_during_load(doc) -> + ["Clear table caused during load caused a schema entry in the actual tab"]; +clear_table_during_load(Config) when is_list(Config) -> + Nodes = [_, Node2] = ?acquire_nodes(2, Config ++ [{tc_timeout, timer:minutes(2)}]), + ?match({atomic,ok}, mnesia:create_table(cleartab, [{ram_copies, Nodes}])), + Tester = self(), + Bin = <<"Testingasdasd", 0:32000>>, + Fill = fun() -> [mnesia:write({cleartab, N, Bin}) || N <- lists:seq(1, 3000)], ok end, + ?match({atomic, ok}, mnesia:sync_transaction(Fill)), + + StopAndStart = fun() -> + stopped = mnesia:stop(), + Tester ! {self(), stopped}, + receive start_node -> ok end, + ok = mnesia:start(), + ok = mnesia:wait_for_tables([cleartab], 2000), + lists:foreach(fun({cleartab,_,_}) -> ok; + (What) -> Tester ! {failed, What}, + unlink(Tester), + exit(foo) + end, + ets:tab2list(cleartab)), + Tester ! {self(), ok}, + normal + end, + Test = fun(N) -> + Pid = spawn_link(Node2, StopAndStart), + receive {Pid, stopped} -> ok end, + Pid ! start_node, + timer:sleep(N*10), + {atomic, ok} = mnesia:clear_table(cleartab), + receive + {Pid, ok} -> ok; + {failed, What} -> + io:format("Failed in ~p tries, with ~p~n",[N, What]), + exit({error, What}); + {'EXIT', Pid, Reason} -> + exit({died, Reason}) + end + end, + [Test(N) || N <- lists:seq(1, 10)], + ?verify_mnesia(Nodes, []). add_copy_conflict(suite) -> []; @@ -599,7 +642,7 @@ add_copy_conflict(Config) when is_list(Config) -> mnesia_controller:unblock_controller(), ?match_receive({test, {atomic,ok}}), - + ?match(ok, mnesia:wait_for_tables([a,b], 3000)), ?verify_mnesia(Nodes, []), ?cleanup(1, Config). @@ -635,7 +678,7 @@ add_copy_when_going_down(Config) -> end, _Lock = spawn(fun() -> mnesia:transaction(WriteAndWait) end), Tester = self(), - spawn_link(fun() -> Res = rpc:call(Node2,mnesia, add_table_copy, + spawn_link(fun() -> Res = rpc:call(Node2, mnesia, add_table_copy, [a, Node2, ram_copies]), Tester ! {test, Res} 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/public_key/asn1/ECPrivateKey.asn1 b/lib/public_key/asn1/ECPrivateKey.asn1 new file mode 100644 index 0000000000..a20fa4009c --- /dev/null +++ b/lib/public_key/asn1/ECPrivateKey.asn1 @@ -0,0 +1,24 @@ +ECPrivateKey { iso(1) identified-organization(3) dod(6) + internet(1) security(5) mechanisms(5) pkix(7) id-mod(0) + id-mod-ecprivateKey(65) } + +DEFINITIONS EXPLICIT TAGS ::= + +BEGIN + +-- EXPORTS ALL; + +IMPORTS + +-- FROM New PKIX ASN.1 [RFC5912] + +EcpkParameters FROM PKIX1Algorithms88; + +ECPrivateKey ::= SEQUENCE { + version INTEGER, + privateKey OCTET STRING, + parameters [0] EcpkParameters OPTIONAL, + publicKey [1] BIT STRING OPTIONAL +} + +END diff --git a/lib/public_key/asn1/OTP-PKIX.asn1 b/lib/public_key/asn1/OTP-PKIX.asn1 index a90fe2840c..911a156d6c 100644 --- a/lib/public_key/asn1/OTP-PKIX.asn1 +++ b/lib/public_key/asn1/OTP-PKIX.asn1 @@ -103,15 +103,16 @@ IMPORTS md5WithRSAEncryption, sha1WithRSAEncryption, rsaEncryption, RSAPublicKey, - dhpublicnumber, DomainParameters, DHPublicKey, + dhpublicnumber, DomainParameters, DHPublicKey, id-keyExchangeAlgorithm, KEA-Parms-Id, --KEA-PublicKey, - ecdsa-with-SHA1, + ecdsa-with-SHA1, ecdsa-with-SHA224, + ecdsa-with-SHA256, ecdsa-with-SHA384, ecdsa-with-SHA512, prime-field, Prime-p, characteristic-two-field, --Characteristic-two, gnBasis, tpBasis, Trinomial, ppBasis, Pentanomial, - id-ecPublicKey, EcpkParameters, ECPoint + id-ecPublicKey, EcpkParameters, ECParameters, ECPoint FROM PKIX1Algorithms88 { iso(1) identified-organization(3) dod(6) internet(1) security(5) mechanisms(5) pkix(7) id-mod(0) id-mod-pkix1-algorithms(17) } @@ -321,7 +322,11 @@ SupportedSignatureAlgorithms SIGNATURE-ALGORITHM-CLASS ::= { sha256-with-rsa-encryption | sha384-with-rsa-encryption | sha512-with-rsa-encryption | - ecdsa-with-sha1 } + ecdsa-with-sha1 | + ecdsa-with-sha224 | + ecdsa-with-sha256 | + ecdsa-with-sha384 | + ecdsa-with-sha512 } SupportedPublicKeyAlgorithms PUBLIC-KEY-ALGORITHM-CLASS ::= { dsa | rsa-encryption | dh | kea | ec-public-key } @@ -439,6 +444,22 @@ SupportedPublicKeyAlgorithms PUBLIC-KEY-ALGORITHM-CLASS ::= { ID ecdsa-with-SHA1 TYPE NULL } -- XXX Must be empty and not NULL + ecdsa-with-sha224 SIGNATURE-ALGORITHM-CLASS ::= { + ID ecdsa-with-SHA224 + TYPE NULL } -- XXX Must be empty and not NULL + + ecdsa-with-sha256 SIGNATURE-ALGORITHM-CLASS ::= { + ID ecdsa-with-SHA256 + TYPE NULL } -- XXX Must be empty and not NULL + + ecdsa-with-sha384 SIGNATURE-ALGORITHM-CLASS ::= { + ID ecdsa-with-SHA384 + TYPE NULL } -- XXX Must be empty and not NULL + + ecdsa-with-sha512 SIGNATURE-ALGORITHM-CLASS ::= { + ID ecdsa-with-SHA512 + TYPE NULL } -- XXX Must be empty and not NULL + FIELD-ID-CLASS ::= CLASS { &id OBJECT IDENTIFIER UNIQUE, &Type } @@ -489,6 +510,7 @@ SupportedPublicKeyAlgorithms PUBLIC-KEY-ALGORITHM-CLASS ::= { ID ppBasis TYPE Pentanomial } + -- SubjectPublicKeyInfo.algorithm ec-public-key PUBLIC-KEY-ALGORITHM-CLASS ::= { diff --git a/lib/public_key/asn1/OTP-PUB-KEY.set.asn b/lib/public_key/asn1/OTP-PUB-KEY.set.asn index f8fb318c93..e94f428e4b 100644 --- a/lib/public_key/asn1/OTP-PUB-KEY.set.asn +++ b/lib/public_key/asn1/OTP-PUB-KEY.set.asn @@ -6,5 +6,6 @@ PKIX1Algorithms88.asn1 PKCS-1.asn1 PKCS-3.asn1 DSS.asn1 +ECPrivateKey.asn1 PKCS-7.asn1 PKCS-10.asn1 diff --git a/lib/public_key/asn1/PKCS-1.asn1 b/lib/public_key/asn1/PKCS-1.asn1 index b5754790e7..117eacd8ad 100644 --- a/lib/public_key/asn1/PKCS-1.asn1 +++ b/lib/public_key/asn1/PKCS-1.asn1 @@ -52,8 +52,40 @@ id-md5 OBJECT IDENTIFIER ::= { iso(1) member-body(2) us(840) rsadsi(113549) digestAlgorithm(2) 5 } +id-hmacWithSHA224 OBJECT IDENTIFIER ::= { + iso(1) member-body(2) us(840) rsadsi(113549) digestAlgorithm(2) 8 +} + +id-hmacWithSHA256 OBJECT IDENTIFIER ::= { + iso(1) member-body(2) us(840) rsadsi(113549) digestAlgorithm(2) 9 +} + +id-hmacWithSHA384 OBJECT IDENTIFIER ::= { + iso(1) member-body(2) us(840) rsadsi(113549) digestAlgorithm(2) 10 +} + +id-hmacWithSHA512 OBJECT IDENTIFIER ::= { + iso(1) member-body(2) us(840) rsadsi(113549) digestAlgorithm(2) 11 +} + id-mgf1 OBJECT IDENTIFIER ::= { pkcs-1 8 } +id-sha224 OBJECT IDENTIFIER ::= { joint-iso-itu-t(2) + country(16) us(840) organization(1) gov(101) csor(3) + nistalgorithm(4) hashalgs(2) 4 } + +id-sha256 OBJECT IDENTIFIER ::= { joint-iso-itu-t(2) + country(16) us(840) organization(1) gov(101) csor(3) + nistalgorithm(4) hashalgs(2) 1 } + +id-sha384 OBJECT IDENTIFIER ::= { joint-iso-itu-t(2) + country(16) us(840) organization(1) gov(101) csor(3) + nistalgorithm(4) hashalgs(2) 2 } + +id-sha512 OBJECT IDENTIFIER ::= { joint-iso-itu-t(2) + country(16) us(840) organization(1) gov(101) csor(3) + nistalgorithm(4) hashalgs(2) 3 } + RSAPublicKey ::= SEQUENCE { modulus INTEGER, -- n diff --git a/lib/public_key/asn1/PKIX1Algorithms88.asn1 b/lib/public_key/asn1/PKIX1Algorithms88.asn1 index 74225747d3..6cc6745af6 100644 --- a/lib/public_key/asn1/PKIX1Algorithms88.asn1 +++ b/lib/public_key/asn1/PKIX1Algorithms88.asn1 @@ -98,6 +98,11 @@ -- OID for ECDSA signatures with SHA-1 ecdsa-with-SHA1 OBJECT IDENTIFIER ::= { id-ecSigType 1 } + ecdsa-with-SHA2 OBJECT IDENTIFIER ::= { id-ecSigType 3 } + ecdsa-with-SHA224 OBJECT IDENTIFIER ::= { ecdsa-with-SHA2 1 } + ecdsa-with-SHA256 OBJECT IDENTIFIER ::= { ecdsa-with-SHA2 2 } + ecdsa-with-SHA384 OBJECT IDENTIFIER ::= { ecdsa-with-SHA2 3 } + ecdsa-with-SHA512 OBJECT IDENTIFIER ::= { ecdsa-with-SHA2 4 } -- OID for an elliptic curve signature -- format for the value of an ECDSA signature value @@ -199,40 +204,83 @@ -- Named Elliptic Curves in ANSI X9.62. - ellipticCurve OBJECT IDENTIFIER ::= { ansi-X9-62 curves(3) } - - c-TwoCurve OBJECT IDENTIFIER ::= { - ellipticCurve characteristicTwo(0) } - - c2pnb163v1 OBJECT IDENTIFIER ::= { c-TwoCurve 1 } - c2pnb163v2 OBJECT IDENTIFIER ::= { c-TwoCurve 2 } - c2pnb163v3 OBJECT IDENTIFIER ::= { c-TwoCurve 3 } - c2pnb176w1 OBJECT IDENTIFIER ::= { c-TwoCurve 4 } - c2tnb191v1 OBJECT IDENTIFIER ::= { c-TwoCurve 5 } - c2tnb191v2 OBJECT IDENTIFIER ::= { c-TwoCurve 6 } - c2tnb191v3 OBJECT IDENTIFIER ::= { c-TwoCurve 7 } - c2onb191v4 OBJECT IDENTIFIER ::= { c-TwoCurve 8 } - c2onb191v5 OBJECT IDENTIFIER ::= { c-TwoCurve 9 } - c2pnb208w1 OBJECT IDENTIFIER ::= { c-TwoCurve 10 } - c2tnb239v1 OBJECT IDENTIFIER ::= { c-TwoCurve 11 } - c2tnb239v2 OBJECT IDENTIFIER ::= { c-TwoCurve 12 } - c2tnb239v3 OBJECT IDENTIFIER ::= { c-TwoCurve 13 } - c2onb239v4 OBJECT IDENTIFIER ::= { c-TwoCurve 14 } - c2onb239v5 OBJECT IDENTIFIER ::= { c-TwoCurve 15 } - c2pnb272w1 OBJECT IDENTIFIER ::= { c-TwoCurve 16 } - c2pnb304w1 OBJECT IDENTIFIER ::= { c-TwoCurve 17 } - c2tnb359v1 OBJECT IDENTIFIER ::= { c-TwoCurve 18 } - c2pnb368w1 OBJECT IDENTIFIER ::= { c-TwoCurve 19 } - c2tnb431r1 OBJECT IDENTIFIER ::= { c-TwoCurve 20 } - - primeCurve OBJECT IDENTIFIER ::= { ellipticCurve prime(1) } - - prime192v1 OBJECT IDENTIFIER ::= { primeCurve 1 } - prime192v2 OBJECT IDENTIFIER ::= { primeCurve 2 } - prime192v3 OBJECT IDENTIFIER ::= { primeCurve 3 } - prime239v1 OBJECT IDENTIFIER ::= { primeCurve 4 } - prime239v2 OBJECT IDENTIFIER ::= { primeCurve 5 } - prime239v3 OBJECT IDENTIFIER ::= { primeCurve 6 } - prime256v1 OBJECT IDENTIFIER ::= { primeCurve 7 } + -- ellipticCurve OBJECT IDENTIFIER ::= { ansi-X9-62 curves(3) } + + -- c-TwoCurve OBJECT IDENTIFIER ::= { + -- ansi-ellipticCurve characteristicTwo(0) } + + -- c2pnb163v1 OBJECT IDENTIFIER ::= { c-TwoCurve 1 } + -- c2pnb163v2 OBJECT IDENTIFIER ::= { c-TwoCurve 2 } + -- c2pnb163v3 OBJECT IDENTIFIER ::= { c-TwoCurve 3 } + -- c2pnb176w1 OBJECT IDENTIFIER ::= { c-TwoCurve 4 } + -- c2tnb191v1 OBJECT IDENTIFIER ::= { c-TwoCurve 5 } + -- c2tnb191v2 OBJECT IDENTIFIER ::= { c-TwoCurve 6 } + -- c2tnb191v3 OBJECT IDENTIFIER ::= { c-TwoCurve 7 } + -- c2onb191v4 OBJECT IDENTIFIER ::= { c-TwoCurve 8 } + -- c2onb191v5 OBJECT IDENTIFIER ::= { c-TwoCurve 9 } + -- c2pnb208w1 OBJECT IDENTIFIER ::= { c-TwoCurve 10 } + -- c2tnb239v1 OBJECT IDENTIFIER ::= { c-TwoCurve 11 } + -- c2tnb239v2 OBJECT IDENTIFIER ::= { c-TwoCurve 12 } + -- c2tnb239v3 OBJECT IDENTIFIER ::= { c-TwoCurve 13 } + -- c2onb239v4 OBJECT IDENTIFIER ::= { c-TwoCurve 14 } + -- c2onb239v5 OBJECT IDENTIFIER ::= { c-TwoCurve 15 } + -- c2pnb272w1 OBJECT IDENTIFIER ::= { c-TwoCurve 16 } + -- c2pnb304w1 OBJECT IDENTIFIER ::= { c-TwoCurve 17 } + -- c2tnb359v1 OBJECT IDENTIFIER ::= { c-TwoCurve 18 } + -- c2pnb368w1 OBJECT IDENTIFIER ::= { c-TwoCurve 19 } + -- c2tnb431r1 OBJECT IDENTIFIER ::= { c-TwoCurve 20 } + + -- primeCurve OBJECT IDENTIFIER ::= { ansi-ellipticCurve prime(1) } + + -- prime192v1 OBJECT IDENTIFIER ::= { primeCurve 1 } + -- prime192v2 OBJECT IDENTIFIER ::= { primeCurve 2 } + -- prime192v3 OBJECT IDENTIFIER ::= { primeCurve 3 } + -- prime239v1 OBJECT IDENTIFIER ::= { primeCurve 4 } + -- prime239v2 OBJECT IDENTIFIER ::= { primeCurve 5 } + -- prime239v3 OBJECT IDENTIFIER ::= { primeCurve 6 } + -- prime256v1 OBJECT IDENTIFIER ::= { primeCurve 7 } + + certicom-arc OBJECT IDENTIFIER ::= { + iso(1) identified-organization(3) certicom(132) + } + + ellipticCurve OBJECT IDENTIFIER ::= { + iso(1) identified-organization(3) certicom(132) curve(0) + } + + secp192r1 OBJECT IDENTIFIER ::= { ansi-X9-62 curves(3) prime(1) 1 } + secp256r1 OBJECT IDENTIFIER ::= { ansi-X9-62 curves(3) prime(1) 7 } + + sect163k1 OBJECT IDENTIFIER ::= { ellipticCurve 1 } + sect163r1 OBJECT IDENTIFIER ::= { ellipticCurve 2 } + sect239k1 OBJECT IDENTIFIER ::= { ellipticCurve 3 } + sect113r1 OBJECT IDENTIFIER ::= { ellipticCurve 4 } + sect113r2 OBJECT IDENTIFIER ::= { ellipticCurve 5 } + secp112r1 OBJECT IDENTIFIER ::= { ellipticCurve 6 } + secp112r2 OBJECT IDENTIFIER ::= { ellipticCurve 7 } + secp160r1 OBJECT IDENTIFIER ::= { ellipticCurve 8 } + secp160k1 OBJECT IDENTIFIER ::= { ellipticCurve 9 } + secp256k1 OBJECT IDENTIFIER ::= { ellipticCurve 10 } + sect163r2 OBJECT IDENTIFIER ::= { ellipticCurve 15 } + sect283k1 OBJECT IDENTIFIER ::= { ellipticCurve 16 } + sect283r1 OBJECT IDENTIFIER ::= { ellipticCurve 17 } + sect131r1 OBJECT IDENTIFIER ::= { ellipticCurve 22 } + sect131r2 OBJECT IDENTIFIER ::= { ellipticCurve 23 } + sect193r1 OBJECT IDENTIFIER ::= { ellipticCurve 24 } + sect193r2 OBJECT IDENTIFIER ::= { ellipticCurve 25 } + sect233k1 OBJECT IDENTIFIER ::= { ellipticCurve 26 } + sect233r1 OBJECT IDENTIFIER ::= { ellipticCurve 27 } + secp128r1 OBJECT IDENTIFIER ::= { ellipticCurve 28 } + secp128r2 OBJECT IDENTIFIER ::= { ellipticCurve 29 } + secp160r2 OBJECT IDENTIFIER ::= { ellipticCurve 30 } + secp192k1 OBJECT IDENTIFIER ::= { ellipticCurve 31 } + secp224k1 OBJECT IDENTIFIER ::= { ellipticCurve 32 } + secp224r1 OBJECT IDENTIFIER ::= { ellipticCurve 33 } + secp384r1 OBJECT IDENTIFIER ::= { ellipticCurve 34 } + secp521r1 OBJECT IDENTIFIER ::= { ellipticCurve 35 } + sect409k1 OBJECT IDENTIFIER ::= { ellipticCurve 36 } + sect409r1 OBJECT IDENTIFIER ::= { ellipticCurve 37 } + sect571k1 OBJECT IDENTIFIER ::= { ellipticCurve 38 } + sect571r1 OBJECT IDENTIFIER ::= { ellipticCurve 39 } END diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 84300f6e65..10c95a39ac 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -84,7 +84,8 @@ <p><code>pki_asn1_type() = 'Certificate' | 'RSAPrivateKey'| 'RSAPublicKey' | 'DSAPrivateKey' | 'DSAPublicKey' | 'DHParameter' | 'SubjectPublicKeyInfo' | - 'PrivateKeyInfo' | 'CertificationRequest'</code></p> + 'PrivateKeyInfo' | 'CertificationRequest' | 'ECPrivateKey'| + 'EcpkParameters'</code></p> <p><code>pem_entry () = {pki_asn1_type(), binary(), %% DER or encrypted DER not_encrypted | cipher_info()} </code></p> @@ -99,7 +100,11 @@ <p><code>dsa_public_key() = {integer(), #'Dss-Parms'{}} </code></p> <p><code>dsa_private_key() = #'DSAPrivateKey'{}</code></p> + + <p><code>ec_public_key() = {#'ECPoint'{}, #'EcpkParameters'{} | {namedCurve, oid()}} </code></p> + <p><code>ec_private_key() = #'ECPrivateKey'{}</code></p> + <p><code> public_crypt_options() = [{rsa_pad, rsa_padding()}]. </code></p> <p><code> rsa_padding() = 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' @@ -109,6 +114,8 @@ <p><code> dss_digest_type() = 'sha' </code></p> + <p><code> ecdsa_digest_type() = 'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512' </code></p> + <p><code> crl_reason() = unspecified | keyCompromise | cACompromise | affiliationChanged | superseded | cessationOfOperation | certificateHold | privilegeWithdrawn | aACompromise </code></p> @@ -147,6 +154,19 @@ <funcs> <func> + <name> compute_key(OthersKey, MyKey)-></name> + <name> compute_key(OthersKey, MyKey, Params)-></name> + <fsummary> Compute shared secret</fsummary> + <type> + <v>OthersKey = #'ECPoint'{} | binary(), MyKey = #'ECPrivateKey'{} | binary()</v> + <v>Params = #'DHParameter'{}</v> + </type> + <desc> + <p> Compute shared secret </p> + </desc> + </func> + + <func> <name>decrypt_private(CipherText, Key) -> binary()</name> <name>decrypt_private(CipherText, Key, Options) -> binary()</name> <fsummary>Public key decryption.</fsummary> @@ -204,6 +224,17 @@ </func> <func> + <name>generate_key(Params) -> {Public::binary(), Private::binary()} | #'ECPrivateKey'{} </name> + <fsummary>Generates a new keypair</fsummary> + <type> + <v> Params = #'DHParameter'{} | {namedCurve, oid()} | #'ECParameters'{} </v> + </type> + <desc> + <p>Generates a new keypair</p> + </desc> + </func> + + <func> <name>pem_decode(PemBin) -> [pem_entry()]</name> <fsummary>Decode PEM binary data and return entries as ASN.1 DER encoded entities. </fsummary> @@ -528,8 +559,8 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <d>The msg is either the binary "plain text" data to be signed or it is the hashed value of "plain text" i.e. the digest.</d> - <v>DigestType = rsa_digest_type() | dss_digest_type()</v> - <v>Key = rsa_private_key() | dsa_private_key()</v> + <v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v> + <v>Key = rsa_private_key() | dsa_private_key() | ec_private_key()</v> </type> <desc> <p> Creates a digital signature.</p> @@ -592,12 +623,12 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <v>Msg = binary() | {digest,binary()}</v> <d>The msg is either the binary "plain text" data or it is the hashed value of "plain text" i.e. the digest.</d> - <v>DigestType = rsa_digest_type() | dss_digest_type()</v> + <v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v> <v>Signature = binary()</v> - <v>Key = rsa_public_key() | dsa_public_key()</v> - </type> - <desc> - <p>Verifies a digital signature</p> + <v>Key = rsa_public_key() | dsa_public_key() | ec_public_key()</v> + </type> + <desc> + <p>Verifies a digital signature</p> </desc> </func> diff --git a/lib/public_key/include/public_key.hrl b/lib/public_key/include/public_key.hrl index 4d1d510f29..1e882e76ee 100644 --- a/lib/public_key/include/public_key.hrl +++ b/lib/public_key/include/public_key.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2012. All Rights Reserved. +%% Copyright Ericsson AB 2008-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 @@ -72,6 +72,10 @@ valid_ext }). +-record('ECPoint', { + point + }). + -define(unspecified, 0). -define(keyCompromise, 1). @@ -89,6 +93,8 @@ -type rsa_private_key() :: #'RSAPrivateKey'{}. -type dsa_private_key() :: #'DSAPrivateKey'{}. -type dsa_public_key() :: {integer(), #'Dss-Parms'{}}. +-type ec_public_key() :: {#'ECPoint'{},{namedCurve, Oid::tuple()} | #'ECParameters'{}}. +-type ec_private_key() :: #'ECPrivateKey'{}. -type der_encoded() :: binary(). -type decrypt_der() :: binary(). -type pki_asn1_type() :: 'Certificate' | 'RSAPrivateKey' | 'RSAPublicKey' diff --git a/lib/public_key/src/pubkey_cert_records.erl b/lib/public_key/src/pubkey_cert_records.erl index 98004c71a3..0449129809 100644 --- a/lib/public_key/src/pubkey_cert_records.erl +++ b/lib/public_key/src/pubkey_cert_records.erl @@ -23,7 +23,8 @@ -include("public_key.hrl"). --export([decode_cert/1, transform/2, supportedPublicKeyAlgorithms/1]). +-export([decode_cert/1, transform/2, supportedPublicKeyAlgorithms/1, + supportedCurvesTypes/1, namedCurves/1]). %%==================================================================== %% Internal application API @@ -101,6 +102,77 @@ supportedPublicKeyAlgorithms(?'dhpublicnumber') -> 'DHPublicKey'; supportedPublicKeyAlgorithms(?'id-keyExchangeAlgorithm') -> 'KEA-PublicKey'; supportedPublicKeyAlgorithms(?'id-ecPublicKey') -> 'ECPoint'. +supportedCurvesTypes(?'characteristic-two-field') -> characteristic_two_field; +supportedCurvesTypes(?'prime-field') -> prime_field. + +namedCurves(?'sect571r1') -> sect571r1; +namedCurves(?'sect571k1') -> sect571k1; +namedCurves(?'sect409r1') -> sect409r1; +namedCurves(?'sect409k1') -> sect409k1; +namedCurves(?'secp521r1') -> secp521r1; +namedCurves(?'secp384r1') -> secp384r1; +namedCurves(?'secp224r1') -> secp224r1; +namedCurves(?'secp224k1') -> secp224k1; +namedCurves(?'secp192k1') -> secp192k1; +namedCurves(?'secp160r2') -> secp160r2; +namedCurves(?'secp128r2') -> secp128r2; +namedCurves(?'secp128r1') -> secp128r1; +namedCurves(?'sect233r1') -> sect233r1; +namedCurves(?'sect233k1') -> sect233k1; +namedCurves(?'sect193r2') -> sect193r2; +namedCurves(?'sect193r1') -> sect193r1; +namedCurves(?'sect131r2') -> sect131r2; +namedCurves(?'sect131r1') -> sect131r1; +namedCurves(?'sect283r1') -> sect283r1; +namedCurves(?'sect283k1') -> sect283k1; +namedCurves(?'sect163r2') -> sect163r2; +namedCurves(?'secp256k1') -> secp256k1; +namedCurves(?'secp160k1') -> secp160k1; +namedCurves(?'secp160r1') -> secp160r1; +namedCurves(?'secp112r2') -> secp112r2; +namedCurves(?'secp112r1') -> secp112r1; +namedCurves(?'sect113r2') -> sect113r2; +namedCurves(?'sect113r1') -> sect113r1; +namedCurves(?'sect239k1') -> sect239k1; +namedCurves(?'sect163r1') -> sect163r1; +namedCurves(?'sect163k1') -> sect163k1; +namedCurves(?'secp256r1') -> secp256r1; +namedCurves(?'secp192r1') -> secp192r1; + +namedCurves(sect571r1) -> ?'sect571r1'; +namedCurves(sect571k1) -> ?'sect571k1'; +namedCurves(sect409r1) -> ?'sect409r1'; +namedCurves(sect409k1) -> ?'sect409k1'; +namedCurves(secp521r1) -> ?'secp521r1'; +namedCurves(secp384r1) -> ?'secp384r1'; +namedCurves(secp224r1) -> ?'secp224r1'; +namedCurves(secp224k1) -> ?'secp224k1'; +namedCurves(secp192k1) -> ?'secp192k1'; +namedCurves(secp160r2) -> ?'secp160r2'; +namedCurves(secp128r2) -> ?'secp128r2'; +namedCurves(secp128r1) -> ?'secp128r1'; +namedCurves(sect233r1) -> ?'sect233r1'; +namedCurves(sect233k1) -> ?'sect233k1'; +namedCurves(sect193r2) -> ?'sect193r2'; +namedCurves(sect193r1) -> ?'sect193r1'; +namedCurves(sect131r2) -> ?'sect131r2'; +namedCurves(sect131r1) -> ?'sect131r1'; +namedCurves(sect283r1) -> ?'sect283r1'; +namedCurves(sect283k1) -> ?'sect283k1'; +namedCurves(sect163r2) -> ?'sect163r2'; +namedCurves(secp256k1) -> ?'secp256k1'; +namedCurves(secp160k1) -> ?'secp160k1'; +namedCurves(secp160r1) -> ?'secp160r1'; +namedCurves(secp112r2) -> ?'secp112r2'; +namedCurves(secp112r1) -> ?'secp112r1'; +namedCurves(sect113r2) -> ?'sect113r2'; +namedCurves(sect113r1) -> ?'sect113r1'; +namedCurves(sect239k1) -> ?'sect239k1'; +namedCurves(sect163r1) -> ?'sect163r1'; +namedCurves(sect163k1) -> ?'sect163k1'; +namedCurves(secp256r1) -> ?'secp256r1'; +namedCurves(secp192r1) -> ?'secp192r1'. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -111,14 +183,24 @@ decode_supportedPublicKey(#'OTPSubjectPublicKeyInfo'{algorithm= PA = #'PublicKeyAlgorithm'{algorithm=Algo}, subjectPublicKey = {0,SPK0}}) -> Type = supportedPublicKeyAlgorithms(Algo), - {ok, SPK} = 'OTP-PUB-KEY':decode(Type, SPK0), + SPK = case Type of + 'ECPoint' -> #'ECPoint'{point = SPK0}; + _ -> {ok, SPK1} = 'OTP-PUB-KEY':decode(Type, SPK0), + SPK1 + end, #'OTPSubjectPublicKeyInfo'{subjectPublicKey = SPK, algorithm=PA}. encode_supportedPublicKey(#'OTPSubjectPublicKeyInfo'{algorithm= PA = #'PublicKeyAlgorithm'{algorithm=Algo}, subjectPublicKey = SPK0}) -> Type = supportedPublicKeyAlgorithms(Algo), - {ok, SPK} = 'OTP-PUB-KEY':encode(Type, SPK0), + SPK = case Type of + 'ECPoint' -> + SPK0#'ECPoint'.point; + _ -> + {ok, SPK1} = 'OTP-PUB-KEY':encode(Type, SPK0), + SPK1 + end, #'OTPSubjectPublicKeyInfo'{subjectPublicKey = {0,SPK}, algorithm=PA}. %%% Extensions diff --git a/lib/public_key/src/pubkey_pbe.erl b/lib/public_key/src/pubkey_pbe.erl index 43f6c42f10..6f0be53db9 100644 --- a/lib/public_key/src/pubkey_pbe.erl +++ b/lib/public_key/src/pubkey_pbe.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2011. 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 @@ -23,7 +23,7 @@ -include("public_key.hrl"). -export([encode/4, decode/4, decrypt_parameters/1]). --export([pbdkdf1/4, pbdkdf2/6]). +-export([pbdkdf1/4, pbdkdf2/7]). -define(DEFAULT_SHA_MAC_KEYLEN, 20). -define(ASN1_OCTET_STR_TAG, 4). @@ -40,16 +40,16 @@ %%-------------------------------------------------------------------- encode(Data, Password, "DES-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:des_cbc_encrypt(Key, IV, Data); + crypto:block_encrypt(des_cbc, Key, IV, Data); encode(Data, Password, "DES-EDE3-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, - crypto:des_ede3_cbc_encrypt(Key1, Key2, Key3, IV, Data); + crypto:block_encrypt(des3_cbc, [Key1, Key2, Key3], IV, Data); encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:rc2_cbc_encrypt(Key, IV, Data). + crypto:block_encrypt(rc2_cbc, Key, IV, Data). %%-------------------------------------------------------------------- -spec decode(binary(), string(), string(), term()) -> binary(). %% @@ -57,16 +57,16 @@ encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) -> %%-------------------------------------------------------------------- decode(Data, Password,"DES-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:des_cbc_decrypt(Key, IV, Data); + crypto:block_decrypt(des_cbc, Key, IV, Data); decode(Data, Password,"DES-EDE3-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, - crypto:des_ede3_cbc_decrypt(Key1, Key2, Key3, IV, Data); + crypto:block_decrypt(des3_cbc, [Key1, Key2, Key3], IV, Data); decode(Data, Password,"RC2-CBC"= Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:rc2_cbc_decrypt(Key, IV, Data). + crypto:block_decrypt(rc2_cbc, Key, IV, Data). %%-------------------------------------------------------------------- -spec pbdkdf1(string(), iodata(), integer(), atom()) -> binary(). @@ -77,21 +77,21 @@ decode(Data, Password,"RC2-CBC"= Cipher, KeyDevParams) -> pbdkdf1(_, _, 0, Acc) -> Acc; pbdkdf1(Password, Salt, Count, Hash) -> - Result = crypto:Hash([Password, Salt]), + Result = crypto:hash(Hash, [Password, Salt]), do_pbdkdf1(Result, Count-1, Result, Hash). %%-------------------------------------------------------------------- --spec pbdkdf2(string(), iodata(), integer(), integer(), fun(), integer()) +-spec pbdkdf2(string(), iodata(), integer(), integer(), fun(), atom(), integer()) -> binary(). %% %% Description: Implements password based decryption key derive function 2. %% Exported mainly for testing purposes. %%-------------------------------------------------------------------- -pbdkdf2(Password, Salt, Count, DerivedKeyLen, Prf, PrfOutputLen)-> +pbdkdf2(Password, Salt, Count, DerivedKeyLen, Prf, PrfHash, PrfOutputLen)-> NumBlocks = ceiling(DerivedKeyLen / PrfOutputLen), NumLastBlockOctets = DerivedKeyLen - (NumBlocks - 1) * PrfOutputLen , blocks(NumBlocks, NumLastBlockOctets, 1, Password, Salt, - Count, Prf, PrfOutputLen, <<>>). + Count, Prf, PrfHash, PrfOutputLen, <<>>). %%-------------------------------------------------------------------- -spec decrypt_parameters(#'EncryptedPrivateKeyInfo_encryptionAlgorithm'{}) -> {Cipher::string(), #'PBES2-params'{}}. @@ -106,10 +106,10 @@ decrypt_parameters(#'EncryptedPrivateKeyInfo_encryptionAlgorithm'{ %%% Internal functions %%-------------------------------------------------------------------- password_to_key_and_iv(Password, _, #'PBES2-params'{} = Params) -> - {Salt, ItrCount, KeyLen, PseudoRandomFunction, PseudoOtputLen, IV} = + {Salt, ItrCount, KeyLen, PseudoRandomFunction, PseudoHash, PseudoOtputLen, IV} = key_derivation_params(Params), <<Key:KeyLen/binary, _/binary>> = - pbdkdf2(Password, Salt, ItrCount, KeyLen, PseudoRandomFunction, PseudoOtputLen), + pbdkdf2(Password, Salt, ItrCount, KeyLen, PseudoRandomFunction, PseudoHash, PseudoOtputLen), {Key, IV}; password_to_key_and_iv(Password, Cipher, Salt) -> KeyLen = derived_key_length(Cipher, undefined), @@ -122,13 +122,13 @@ password_to_key_and_iv(Password, Cipher, Salt) -> pem_encrypt(_, _, _, 0, Acc, _) -> Acc; pem_encrypt(Prev, Password, Salt, Count, Acc, Hash) -> - Result = crypto:Hash([Prev, Password, Salt]), + Result = crypto:hash(Hash, [Prev, Password, Salt]), pem_encrypt(Result, Password, Salt, Count-1 , <<Acc/binary, Result/binary>>, Hash). do_pbdkdf1(_, 0, Acc, _) -> Acc; do_pbdkdf1(Prev, Count, Acc, Hash) -> - Result = crypto:Hash(Prev), + Result = crypto:hash(Hash, Prev), do_pbdkdf1(Result, Count-1 , <<Result/binary, Acc/binary>>, Hash). iv(#'PBES2-params_encryptionScheme'{algorithm = Algo, @@ -143,23 +143,23 @@ iv(#'PBES2-params_encryptionScheme'{algorithm = ?'rc2CBC', {ok, #'RC2-CBC-Parameter'{iv = IV}} = 'PKCS-FRAME':decode('RC2-CBC-Parameter', ASN1IV), iolist_to_binary(IV). -blocks(1, N, Index, Password, Salt, Count, Prf, PrfLen, Acc) -> - <<XorSum:N/binary, _/binary>> = xor_sum(Password, Salt, Count, Index, Prf, PrfLen), +blocks(1, N, Index, Password, Salt, Count, Prf, PrfHash, PrfLen, Acc) -> + <<XorSum:N/binary, _/binary>> = xor_sum(Password, Salt, Count, Index, Prf, PrfHash, PrfLen), <<Acc/binary, XorSum/binary>>; -blocks(NumBlocks, N, Index, Password, Salt, Count, Prf, PrfLen, Acc) -> - XorSum = xor_sum(Password, Salt, Count, Index, Prf, PrfLen), - blocks(NumBlocks -1, N, Index +1, Password, Salt, Count, Prf, +blocks(NumBlocks, N, Index, Password, Salt, Count, Prf, PrfHash, PrfLen, Acc) -> + XorSum = xor_sum(Password, Salt, Count, Index, Prf, PrfHash, PrfLen), + blocks(NumBlocks -1, N, Index +1, Password, Salt, Count, Prf, PrfHash, PrfLen, <<Acc/binary, XorSum/binary>>). -xor_sum(Password, Salt, Count, Index, Prf, PrfLen) -> - Result = Prf(Password, [Salt,<<Index:32/unsigned-big-integer>>], PrfLen), - do_xor_sum(Prf, PrfLen, Result, Password, Count-1, Result). +xor_sum(Password, Salt, Count, Index, Prf, PrfHash, PrfLen) -> + Result = Prf(PrfHash, Password, [Salt,<<Index:32/unsigned-big-integer>>], PrfLen), + do_xor_sum(Prf, PrfHash, PrfLen, Result, Password, Count-1, Result). -do_xor_sum(_, _, _, _, 0, Acc) -> +do_xor_sum(_, _, _, _, _, 0, Acc) -> Acc; -do_xor_sum(Prf, PrfLen, Prev, Password, Count, Acc)-> - Result = Prf(Password, Prev, PrfLen), - do_xor_sum(Prf, PrfLen, Result, Password, Count-1, crypto:exor(Acc, Result)). +do_xor_sum(Prf, PrfHash, PrfLen, Prev, Password, Count, Acc)-> + Result = Prf(PrfHash, Password, Prev, PrfLen), + do_xor_sum(Prf, PrfHash, PrfLen, Result, Password, Count-1, crypto:exor(Acc, Result)). decrypt_parameters(?'id-PBES2', DekParams) -> {ok, Params} = 'PKCS-FRAME':decode('PBES2-params', DekParams), @@ -174,18 +174,18 @@ key_derivation_params(#'PBES2-params'{keyDerivationFunc = KeyDerivationFunc, keyLength = Length, prf = Prf}} = KeyDerivationFunc, #'PBES2-params_encryptionScheme'{algorithm = Algo} = EncScheme, - {PseudoRandomFunction, PseudoOtputLen} = pseudo_random_function(Prf), + {PseudoRandomFunction, PseudoHash, PseudoOtputLen} = pseudo_random_function(Prf), KeyLen = derived_key_length(Algo, Length), {OctetSalt, Count, KeyLen, - PseudoRandomFunction, PseudoOtputLen, iv(EncScheme)}. + PseudoRandomFunction, PseudoHash, PseudoOtputLen, iv(EncScheme)}. %% This function currently matches a tuple that ougth to be the value %% ?'id-hmacWithSHA1, but we need some kind of ASN1-fix for this. pseudo_random_function(#'PBKDF2-params_prf'{algorithm = {_,_, _,'id-hmacWithSHA1'}}) -> - {fun crypto:sha_mac/3, pseudo_output_length(?'id-hmacWithSHA1')}; + {fun crypto:hmac/4, sha, pseudo_output_length(?'id-hmacWithSHA1')}; pseudo_random_function(#'PBKDF2-params_prf'{algorithm = ?'id-hmacWithSHA1'}) -> - {fun crypto:sha_mac/3, pseudo_output_length(?'id-hmacWithSHA1')}. + {fun crypto:hmac/4, sha, pseudo_output_length(?'id-hmacWithSHA1')}. pseudo_output_length(?'id-hmacWithSHA1') -> ?DEFAULT_SHA_MAC_KEYLEN. diff --git a/lib/public_key/src/pubkey_pem.erl b/lib/public_key/src/pubkey_pem.erl index 6bdc35fb79..746d142ec3 100644 --- a/lib/public_key/src/pubkey_pem.erl +++ b/lib/public_key/src/pubkey_pem.erl @@ -202,7 +202,11 @@ pem_start('CertificationRequest') -> pem_start('ContentInfo') -> <<"-----BEGIN PKCS7-----">>; pem_start('CertificateList') -> - <<"-----BEGIN X509 CRL-----">>. + <<"-----BEGIN X509 CRL-----">>; +pem_start('OTPEcpkParameters') -> + <<"-----BEGIN EC PARAMETERS-----">>; +pem_start('ECPrivateKey') -> + <<"-----BEGIN EC PRIVATE KEY-----">>. pem_end(<<"-----BEGIN CERTIFICATE-----">>) -> <<"-----END CERTIFICATE-----">>; @@ -226,6 +230,10 @@ pem_end(<<"-----BEGIN PKCS7-----">>) -> <<"-----END PKCS7-----">>; pem_end(<<"-----BEGIN X509 CRL-----">>) -> <<"-----END X509 CRL-----">>; +pem_end(<<"-----BEGIN EC PARAMETERS-----">>) -> + <<"-----END EC PARAMETERS-----">>; +pem_end(<<"-----BEGIN EC PRIVATE KEY-----">>) -> + <<"-----END EC PRIVATE KEY-----">>; pem_end(_) -> undefined. @@ -250,7 +258,11 @@ asn1_type(<<"-----BEGIN CERTIFICATE REQUEST-----">>) -> asn1_type(<<"-----BEGIN PKCS7-----">>) -> 'ContentInfo'; asn1_type(<<"-----BEGIN X509 CRL-----">>) -> - 'CertificateList'. + 'CertificateList'; +asn1_type(<<"-----BEGIN EC PARAMETERS-----">>) -> + 'OTPEcpkParameters'; +asn1_type(<<"-----BEGIN EC PRIVATE KEY-----">>) -> + 'ECPrivateKey'. pem_decrypt() -> <<"Proc-Type: 4,ENCRYPTED">>. diff --git a/lib/public_key/src/pubkey_ssh.erl b/lib/public_key/src/pubkey_ssh.erl index 008ea96dd3..aed1f57bbc 100644 --- a/lib/public_key/src/pubkey_ssh.erl +++ b/lib/public_key/src/pubkey_ssh.erl @@ -362,18 +362,18 @@ comma_list_encode([Option | Rest], Acc) -> ssh2_pubkey_encode(#'RSAPublicKey'{modulus = N, publicExponent = E}) -> TypeStr = <<"ssh-rsa">>, StrLen = size(TypeStr), - EBin = crypto:mpint(E), - NBin = crypto:mpint(N), + EBin = mpint(E), + NBin = mpint(N), <<?UINT32(StrLen), TypeStr:StrLen/binary, EBin/binary, NBin/binary>>; ssh2_pubkey_encode({Y, #'Dss-Parms'{p = P, q = Q, g = G}}) -> TypeStr = <<"ssh-dss">>, StrLen = size(TypeStr), - PBin = crypto:mpint(P), - QBin = crypto:mpint(Q), - GBin = crypto:mpint(G), - YBin = crypto:mpint(Y), + PBin = mpint(P), + QBin = mpint(Q), + GBin = mpint(G), + YBin = mpint(Y), <<?UINT32(StrLen), TypeStr:StrLen/binary, PBin/binary, QBin/binary, @@ -476,3 +476,32 @@ split_n(N, Bin, Acc) -> [Last] -> split_n(0, <<>>, [Last | Acc]) end. +%% large integer in a binary with 32bit length +%% MP representaion (SSH2) +mpint(X) when X < 0 -> mpint_neg(X); +mpint(X) -> mpint_pos(X). + +mpint_neg(X) -> + Bin = int_to_bin_neg(X, []), + Sz = byte_size(Bin), + <<?UINT32(Sz), Bin/binary>>. + +mpint_pos(X) -> + Bin = int_to_bin_pos(X, []), + <<MSB,_/binary>> = Bin, + Sz = byte_size(Bin), + if MSB band 16#80 == 16#80 -> + <<?UINT32((Sz+1)), 0, Bin/binary>>; + true -> + <<?UINT32(Sz), Bin/binary>> + end. + +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/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 736c18cdd4..3eea6f6ec4 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -35,6 +35,8 @@ encrypt_public/2, encrypt_public/3, decrypt_public/2, decrypt_public/3, sign/3, verify/4, + generate_key/1, + compute_key/2, compute_key/3, pkix_sign/2, pkix_verify/2, pkix_sign_types/1, pkix_is_self_signed/1, @@ -52,6 +54,7 @@ -type public_crypt_options() :: [{rsa_pad, rsa_padding()}]. -type rsa_digest_type() :: 'md5' | 'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'. -type dss_digest_type() :: 'none' | 'sha'. %% None is for backwards compatibility +-type ecdsa_digest_type() :: 'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'. -type crl_reason() :: unspecified | keyCompromise | cACompromise | affiliationChanged | superseded | cessationOfOperation | certificateHold | privilegeWithdrawn | aACompromise. -type oid() :: tuple(). @@ -94,7 +97,9 @@ pem_entry_decode({'SubjectPublicKeyInfo', Der, _}) -> der_decode(KeyType, Key0); 'DSAPublicKey' -> {params, DssParams} = der_decode('DSAParams', Params), - {der_decode(KeyType, Key0), DssParams} + {der_decode(KeyType, Key0), DssParams}; + 'ECPoint' -> + der_decode(KeyType, Key0) end; pem_entry_decode({Asn1Type, Der, not_encrypted}) when is_atom(Asn1Type), is_binary(Der) -> @@ -251,10 +256,9 @@ decrypt_private(CipherText, privateExponent = D} = Key, Options) when is_binary(CipherText), - is_integer(N), is_integer(E), is_integer(D), is_list(Options) -> Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), - crypto:rsa_private_decrypt(CipherText, format_rsa_private_key(Key), Padding). + crypto:private_decrypt(rsa, CipherText, format_rsa_private_key(Key), Padding). %%-------------------------------------------------------------------- -spec decrypt_public(CipherText :: binary(), rsa_public_key() | rsa_private_key()) -> @@ -318,30 +322,41 @@ encrypt_private(PlainText, Options) when is_binary(PlainText), is_integer(N), is_integer(E), is_integer(D), - is_list(Options) -> + is_list(Options) -> Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), - crypto:rsa_private_encrypt(PlainText, format_rsa_private_key(Key), Padding). + crypto:private_encrypt(rsa, PlainText, format_rsa_private_key(Key), Padding). +%%-------------------------------------------------------------------- +-spec generate_key(#'DHParameter'{} | {namedCurve, Name ::atom()} | + #'ECParameters'{}) -> {Public::binary(), Private::binary()} | + #'ECPrivateKey'{}. +%% Description: Generates a new keypair +%%-------------------------------------------------------------------- +generate_key(#'DHParameter'{prime = P, base = G}) -> + crypto:generate_key(dh, [P, G]); +generate_key({namedCurve, _} = Params) -> + ec_generate_key(Params); +generate_key(#'ECParameters'{} = Params) -> + ec_generate_key(Params). -format_rsa_private_key(#'RSAPrivateKey'{modulus = N, publicExponent = E, - privateExponent = D, - prime1 = P1, prime2 = P2, - exponent1 = E1, exponent2 = E2, - coefficient = C}) - when is_integer(P1), is_integer(P2), - is_integer(E1), is_integer(E2), is_integer(C) -> - [crypto:mpint(K) || K <- [E, N, D, P1, P2, E1, E2, C]]; +%%-------------------------------------------------------------------- +-spec compute_key(#'ECPoint'{} , #'ECPrivateKey'{}) -> binary(). +-spec compute_key(OthersKey ::binary(), MyKey::binary(), #'DHParameter'{}) -> binary(). +%% Description: Compute shared secret +%%-------------------------------------------------------------------- +compute_key(#'ECPoint'{point = Point}, #'ECPrivateKey'{privateKey = PrivKey, + parameters = Param}) -> + ECCurve = ec_curve_spec(Param), + crypto:compute_key(ecdh, Point, list_to_binary(PrivKey), ECCurve). -format_rsa_private_key(#'RSAPrivateKey'{modulus = N, publicExponent = E, - privateExponent = D}) -> - [crypto:mpint(K) || K <- [E, N, D]]. +compute_key(PubKey, PrivKey, #'DHParameter'{prime = P, base = G}) -> + crypto:compute_key(dh, PubKey, PrivKey, [P, G]). %%-------------------------------------------------------------------- - -spec pkix_sign_types(SignatureAlg::oid()) -> %% Relevant dsa digest type is subpart of rsa digest type { DigestType :: rsa_digest_type(), - SignatureType :: rsa | dsa + SignatureType :: rsa | dsa | ecdsa }. %% Description: %%-------------------------------------------------------------------- @@ -362,68 +377,60 @@ pkix_sign_types(?md5WithRSAEncryption) -> pkix_sign_types(?'id-dsa-with-sha1') -> {sha, dsa}; pkix_sign_types(?'id-dsaWithSHA1') -> - {sha, dsa}. + {sha, dsa}; +pkix_sign_types(?'ecdsa-with-SHA1') -> + {sha, ecdsa}; +pkix_sign_types(?'ecdsa-with-SHA256') -> + {sha256, ecdsa}; +pkix_sign_types(?'ecdsa-with-SHA384') -> + {sha384, ecdsa}; +pkix_sign_types(?'ecdsa-with-SHA512') -> + {sha512, ecdsa}. %%-------------------------------------------------------------------- --spec sign(binary() | {digest, binary()}, rsa_digest_type() | dss_digest_type(), +-spec sign(binary() | {digest, binary()}, rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(), rsa_private_key() | - dsa_private_key()) -> Signature :: binary(). + dsa_private_key() | ec_private_key()) -> Signature :: binary(). %% Description: Create digital signature. %%-------------------------------------------------------------------- -sign({digest,_}=Digest, DigestType, Key = #'RSAPrivateKey'{}) -> - crypto:rsa_sign(DigestType, Digest, format_rsa_private_key(Key)); +sign(DigestOrPlainText, DigestType, Key = #'RSAPrivateKey'{}) -> + crypto:sign(rsa, DigestType, DigestOrPlainText, format_rsa_private_key(Key)); -sign(PlainText, DigestType, Key = #'RSAPrivateKey'{}) -> - crypto:rsa_sign(DigestType, sized_binary(PlainText), format_rsa_private_key(Key)); +sign(DigestOrPlainText, sha, #'DSAPrivateKey'{p = P, q = Q, g = G, x = X}) -> + crypto:sign(dss, sha, DigestOrPlainText, [P, Q, G, X]); -sign({digest,_}=Digest, sha, #'DSAPrivateKey'{p = P, q = Q, g = G, x = X}) -> - crypto:dss_sign(Digest, - [crypto:mpint(P), crypto:mpint(Q), - crypto:mpint(G), crypto:mpint(X)]); - -sign(PlainText, sha, #'DSAPrivateKey'{p = P, q = Q, g = G, x = X}) -> - crypto:dss_sign(sized_binary(PlainText), - [crypto:mpint(P), crypto:mpint(Q), - crypto:mpint(G), crypto:mpint(X)]); +sign(DigestOrPlainText, DigestType, #'ECPrivateKey'{privateKey = PrivKey, + parameters = Param}) -> + ECCurve = ec_curve_spec(Param), + crypto:sign(ecdsa, DigestType, DigestOrPlainText, [list_to_binary(PrivKey), ECCurve]); %% Backwards compatible sign(Digest, none, #'DSAPrivateKey'{} = Key) -> sign({digest,Digest}, sha, Key). %%-------------------------------------------------------------------- --spec verify(binary() | {digest, binary()}, rsa_digest_type() | dss_digest_type(), +-spec verify(binary() | {digest, binary()}, rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(), Signature :: binary(), rsa_public_key() - | dsa_public_key()) -> boolean(). + | dsa_public_key() | ec_public_key()) -> boolean(). %% Description: Verifies a digital signature. %%-------------------------------------------------------------------- -verify({digest,_}=Digest, DigestType, Signature, +verify(DigestOrPlainText, DigestType, Signature, #'RSAPublicKey'{modulus = Mod, publicExponent = Exp}) -> - crypto:rsa_verify(DigestType, Digest, - sized_binary(Signature), - [crypto:mpint(Exp), crypto:mpint(Mod)]); + crypto:verify(rsa, DigestType, DigestOrPlainText, Signature, + [Exp, Mod]); -verify(PlainText, DigestType, Signature, - #'RSAPublicKey'{modulus = Mod, publicExponent = Exp}) -> - crypto:rsa_verify(DigestType, - sized_binary(PlainText), - sized_binary(Signature), - [crypto:mpint(Exp), crypto:mpint(Mod)]); +verify(DigestOrPlaintext, DigestType, Signature, {#'ECPoint'{point = Point}, Param}) -> + ECCurve = ec_curve_spec(Param), + crypto:verify(ecdsa, DigestType, DigestOrPlaintext, Signature, [Point, ECCurve]); -verify({digest,_}=Digest, sha, Signature, {Key, #'Dss-Parms'{p = P, q = Q, g = G}}) - when is_integer(Key), is_binary(Signature) -> - crypto:dss_verify(Digest, sized_binary(Signature), - [crypto:mpint(P), crypto:mpint(Q), - crypto:mpint(G), crypto:mpint(Key)]); %% Backwards compatibility verify(Digest, none, Signature, {_, #'Dss-Parms'{}} = Key ) -> verify({digest,Digest}, sha, Signature, Key); -verify(PlainText, sha, Signature, {Key, #'Dss-Parms'{p = P, q = Q, g = G}}) - when is_integer(Key), is_binary(PlainText), is_binary(Signature) -> - crypto:dss_verify(sized_binary(PlainText), - sized_binary(Signature), - [crypto:mpint(P), crypto:mpint(Q), - crypto:mpint(G), crypto:mpint(Key)]). +verify(DigestOrPlainText, sha = DigestType, Signature, {Key, #'Dss-Parms'{p = P, q = Q, g = G}}) + when is_integer(Key), is_binary(Signature) -> + crypto:verify(dss, DigestType, DigestOrPlainText, Signature, [P, Q, G, Key]). + %%-------------------------------------------------------------------- -spec pkix_sign(#'OTPTBSCertificate'{}, rsa_private_key() | dsa_private_key()) -> Der::binary(). @@ -446,7 +453,7 @@ pkix_sign(#'OTPTBSCertificate'{signature = %%-------------------------------------------------------------------- -spec pkix_verify(Cert::binary(), rsa_public_key()| - dsa_public_key()) -> boolean(). + dsa_public_key() | ec_public_key()) -> boolean(). %% %% Description: Verify pkix x.509 certificate signature. %%-------------------------------------------------------------------- @@ -458,7 +465,12 @@ pkix_verify(DerCert, {Key, #'Dss-Parms'{}} = DSAKey) pkix_verify(DerCert, #'RSAPublicKey'{} = RSAKey) when is_binary(DerCert) -> {DigestType, PlainText, Signature} = pubkey_cert:verify_data(DerCert), - verify(PlainText, DigestType, Signature, RSAKey). + verify(PlainText, DigestType, Signature, RSAKey); + +pkix_verify(DerCert, Key = {#'ECPoint'{}, _}) + when is_binary(DerCert) -> + {DigestType, PlainText, Signature} = pubkey_cert:verify_data(DerCert), + verify(PlainText, DigestType, Signature, Key). %%-------------------------------------------------------------------- -spec pkix_is_issuer(Cert :: der_encoded()| #'OTPCertificate'{} | #'CertificateList'{}, @@ -640,13 +652,11 @@ do_pem_entry_decode({Asn1Type,_, _} = PemEntry, Password) -> encrypt_public(PlainText, N, E, Options)-> Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), - crypto:rsa_public_encrypt(PlainText, [crypto:mpint(E),crypto:mpint(N)], - Padding). + crypto:public_encrypt(rsa, PlainText, [E,N], Padding). -decrypt_public(CipherText, N,E, Options) -> +decrypt_public(CipherText, N,E, Options) -> Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), - crypto:rsa_public_decrypt(CipherText,[crypto:mpint(E), crypto:mpint(N)], - Padding). + crypto:public_decrypt(rsa, CipherText,[E, N], Padding). path_validation([], #path_validation_state{working_public_key_algorithm = Algorithm, @@ -732,10 +742,6 @@ validate(Cert, #path_validation_state{working_issuer_name = Issuer, pubkey_cert:prepare_for_next_cert(OtpCert, ValidationState). -sized_binary(Binary) -> - Size = size(Binary), - <<?UINT32(Size), Binary/binary>>. - otp_cert(Der) when is_binary(Der) -> pkix_decode_cert(Der, otp); otp_cert(#'OTPCertificate'{} =Cert) -> @@ -842,3 +848,38 @@ combine(CRL, DeltaCRLs) -> end, lists:foldl(Fun, hd(Deltas), tl(Deltas)) end. + +format_rsa_private_key(#'RSAPrivateKey'{modulus = N, publicExponent = E, + privateExponent = D, + prime1 = P1, prime2 = P2, + exponent1 = E1, exponent2 = E2, + coefficient = C}) + when is_integer(N), is_integer(E), is_integer(D), + is_integer(P1), is_integer(P2), + is_integer(E1), is_integer(E2), is_integer(C) -> + [E, N, D, P1, P2, E1, E2, C]; + +format_rsa_private_key(#'RSAPrivateKey'{modulus = N, publicExponent = E, + privateExponent = D}) when is_integer(N), + is_integer(E), + is_integer(D) -> + [E, N, D]. + +ec_generate_key(Params) -> + Curve = ec_curve_spec(Params), + Term = crypto:generate_key(ecdh, Curve), + ec_key(Term, Params). + +ec_curve_spec( #'ECParameters'{fieldID = FieldId, curve = PCurve, base = Base, order = Order, cofactor = CoFactor }) -> + Field = {pubkey_cert_records:supportedCurvesTypes(FieldId#'FieldID'.fieldType), + FieldId#'FieldID'.parameters}, + Curve = {erlang:list_to_binary(PCurve#'Curve'.a), erlang:list_to_binary(PCurve#'Curve'.b), none}, + {Field, Curve, erlang:list_to_binary(Base), Order, CoFactor}; +ec_curve_spec({namedCurve, OID}) -> + pubkey_cert_records:namedCurves(OID). + +ec_key({PubKey, PrivateKey}, Params) -> + #'ECPrivateKey'{version = 1, + privateKey = binary_to_list(PrivateKey), + parameters = Params, + publicKey = {0, PubKey}}. diff --git a/lib/public_key/test/erl_make_certs.erl b/lib/public_key/test/erl_make_certs.erl index 897cf2f350..5926794ca8 100644 --- a/lib/public_key/test/erl_make_certs.erl +++ b/lib/public_key/test/erl_make_certs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. 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 @@ -45,7 +45,7 @@ %% {dnQualifer, DnQ} %% issuer = {Issuer, IssuerKey} true (i.e. a ca cert is created) %% (obs IssuerKey migth be {Key, Password} -%% key = KeyFile|KeyBin|rsa|dsa Subject PublicKey rsa or dsa generates key +%% key = KeyFile|KeyBin|rsa|dsa|ec Subject PublicKey rsa, dsa or ec generates key %% %% %% (OBS: The generated keys are for testing only) @@ -91,6 +91,16 @@ gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) -> {Key, encode_key(Key)}. %%-------------------------------------------------------------------- +%% @doc Creates a ec key (OBS: for testing only) +%% the sizes are in bytes +%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} +%% @end +%%-------------------------------------------------------------------- +gen_ec(Curve) when is_atom(Curve) -> + Key = gen_ec2(Curve), + {Key, encode_key(Key)}. + +%%-------------------------------------------------------------------- %% @doc Verifies cert signatures %% @spec (::binary(), ::tuple()) -> ::boolean() %% @end @@ -102,7 +112,10 @@ verify_signature(DerEncodedCert, DerKey, _KeyParams) -> public_key:pkix_verify(DerEncodedCert, #'RSAPublicKey'{modulus=Mod, publicExponent=Exp}); #'DSAPrivateKey'{p=P, q=Q, g=G, y=Y} -> - public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}}) + public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}}); + #'ECPrivateKey'{version = _Version, privateKey = _PrivKey, + parameters = Params, publicKey = {0, PubKey}} -> + public_key:pkix_verify(DerEncodedCert, {#'ECPoint'{point = PubKey}, Params}) end. %%%%%%%%%%%%%%%%%%%%%%%%% Implementation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -112,6 +125,7 @@ get_key(Opts) -> undefined -> make_key(rsa, Opts); rsa -> make_key(rsa, Opts); dsa -> make_key(dsa, Opts); + ec -> make_key(ec, Opts); Key -> Password = proplists:get_value(password, Opts, no_passwd), decode_key(Key, Password) @@ -129,6 +143,8 @@ decode_key(#'RSAPrivateKey'{} = Key,_) -> Key; decode_key(#'DSAPrivateKey'{} = Key,_) -> Key; +decode_key(#'ECPrivateKey'{} = Key,_) -> + Key; decode_key(PemEntry = {_,_,_}, Pw) -> public_key:pem_entry_decode(PemEntry, Pw); decode_key(PemBin, Pw) -> @@ -140,7 +156,10 @@ encode_key(Key = #'RSAPrivateKey'{}) -> {'RSAPrivateKey', Der, not_encrypted}; encode_key(Key = #'DSAPrivateKey'{}) -> {ok, Der} = 'OTP-PUB-KEY':encode('DSAPrivateKey', Key), - {'DSAPrivateKey', Der, not_encrypted}. + {'DSAPrivateKey', Der, not_encrypted}; +encode_key(Key = #'ECPrivateKey'{}) -> + {ok, Der} = 'OTP-PUB-KEY':encode('ECPrivateKey', Key), + {'ECPrivateKey', Der, not_encrypted}. make_tbs(SubjectKey, Opts) -> Version = list_to_atom("v"++integer_to_list(proplists:get_value(version, Opts, 3))), @@ -234,7 +253,7 @@ extensions(Opts) -> end. default_extensions(Exts) -> - Def = [{key_usage, default}, + Def = [{key_usage, default}, {subject_altname, undefined}, {issuer_altname, undefined}, {basic_constraints, default}, @@ -248,6 +267,8 @@ default_extensions(Exts) -> Filter = fun({Key, _}, D) -> lists:keydelete(Key, 1, D) end, Exts ++ lists:foldl(Filter, Def, Exts). + + extension({_, undefined}) -> []; extension({basic_constraints, Data}) -> case Data of @@ -265,11 +286,9 @@ extension({basic_constraints, Data}) -> #'Extension'{extnID = ?'id-ce-basicConstraints', extnValue = Data} end; - extension({key_usage, default}) -> #'Extension'{extnID = ?'id-ce-keyUsage', extnValue = [keyCertSign], critical = true}; - extension({Id, Data, Critical}) -> #'Extension'{extnID = Id, extnValue = Data, critical = Critical}. @@ -282,7 +301,14 @@ publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) -> publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) -> Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa', parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}}, - #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}. + #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}; +publickey(#'ECPrivateKey'{version = _Version, + privateKey = _PrivKey, + parameters = Params, + publicKey = {0, PubKey}}) -> + Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-ecPublicKey', parameters=Params}, + #'OTPSubjectPublicKeyInfo'{algorithm = Algo, + subjectPublicKey = #'ECPoint'{point = PubKey}}. validity(Opts) -> DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1), @@ -303,13 +329,24 @@ sign_algorithm(#'RSAPrivateKey'{}, Opts) -> end, {Type, 'NULL'}; sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) -> - {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}. + {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}; +sign_algorithm(#'ECPrivateKey'{}, Opts) -> + Type = case proplists:get_value(digest, Opts, sha1) of + sha1 -> ?'ecdsa-with-SHA1'; + sha512 -> ?'ecdsa-with-SHA512'; + sha384 -> ?'ecdsa-with-SHA384'; + sha256 -> ?'ecdsa-with-SHA256' + end, + {Type, 'NULL'}. make_key(rsa, _Opts) -> %% (OBS: for testing only) gen_rsa2(64); make_key(dsa, _Opts) -> - gen_dsa2(128, 20). %% Bytes i.e. {1024, 160} + gen_dsa2(128, 20); %% Bytes i.e. {1024, 160} +make_key(ec, _Opts) -> + %% (OBS: for testing only) + gen_ec2(secp256k1). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% RSA key generation (OBS: for testing only) @@ -359,19 +396,32 @@ gen_dsa2(LSize, NSize) -> error -> gen_dsa2(LSize, NSize); P -> - G = crypto:mod_exp(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. + G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used. X = prime(20), %% Choose x by some random method, where 0 < x < q. - Y = crypto:mod_exp(G, X, P), %% Calculate y = g^x mod p. + Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p. - #'DSAPrivateKey'{version=0, p=P, q=Q, g=G, y=Y, x=X} + #'DSAPrivateKey'{version=0, p = P, q = Q, + g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X} end. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% EC key generation (OBS: for testing only) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gen_ec2(CurveId) -> + {PubKey, PrivKey} = crypto:generate_key(ecdh, CurveId), + + #'ECPrivateKey'{version = 1, + privateKey = binary_to_list(PrivKey), + parameters = {namedCurve, pubkey_cert_records:namedCurves(CurveId)}, + publicKey = {0, PubKey}}. + %% See fips_186-3.pdf dsa_search(T, P0, Q, Iter) when Iter > 0 -> P = 2*T*Q*P0 + 1, - case is_prime(crypto:mpint(P), 50) of + case is_prime(P, 50) of true -> P; false -> dsa_search(T+1, P0, Q, Iter-1) end; @@ -382,38 +432,40 @@ dsa_search(_,_,_,_) -> %%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% prime(ByteSize) -> Rand = odd_rand(ByteSize), - crypto:erlint(prime_odd(Rand, 0)). + prime_odd(Rand, 0). prime_odd(Rand, N) -> case is_prime(Rand, 50) of true -> Rand; false -> - NotPrime = crypto:erlint(Rand), - prime_odd(crypto:mpint(NotPrime+2), N+1) + prime_odd(Rand+2, N+1) end. %% see http://en.wikipedia.org/wiki/Fermat_primality_test is_prime(_, 0) -> true; is_prime(Candidate, Test) -> - CoPrime = odd_rand(<<0,0,0,4, 10000:32>>, Candidate), - case crypto:mod_exp(CoPrime, Candidate, Candidate) of - CoPrime -> is_prime(Candidate, Test-1); - _ -> false - end. + CoPrime = odd_rand(10000, Candidate), + Result = crypto:mod_pow(CoPrime, Candidate, Candidate) , + is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test). + +is_prime(CoPrime, CoPrime, Candidate, Test) -> + is_prime(Candidate, Test-1); +is_prime(_,_,_,_) -> + false. odd_rand(Size) -> Min = 1 bsl (Size*8-1), Max = (1 bsl (Size*8))-1, - odd_rand(crypto:mpint(Min), crypto:mpint(Max)). + odd_rand(Min, Max). odd_rand(Min,Max) -> - Rand = <<Sz:32, _/binary>> = crypto:rand_uniform(Min,Max), - BitSkip = (Sz+4)*8-1, - case Rand of - Odd = <<_:BitSkip, 1:1>> -> Odd; - Even = <<_:BitSkip, 0:1>> -> - crypto:mpint(crypto:erlint(Even)+1) + Rand = crypto:rand_uniform(Min,Max), + case Rand rem 2 of + 0 -> + Rand + 1; + _ -> + Rand end. extended_gcd(A, B) -> @@ -432,3 +484,6 @@ pem_to_der(File) -> der_to_pem(File, Entries) -> PemBin = public_key:pem_encode(Entries), file:write_file(File, PemBin). + + + diff --git a/lib/public_key/test/pbe_SUITE.erl b/lib/public_key/test/pbe_SUITE.erl index 8fba1e8cd3..254601b107 100644 --- a/lib/public_key/test/pbe_SUITE.erl +++ b/lib/public_key/test/pbe_SUITE.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 @@ -109,7 +109,7 @@ pbdkdf2(Config) when is_list(Config) -> <<16#0c, 16#60, 16#c8, 16#0f, 16#96, 16#1f, 16#0e, 16#71, 16#f3, 16#a9, 16#b5, 16#24, 16#af, 16#60, 16#12, 16#06, - 16#2f, 16#e0, 16#37, 16#a6>> = pubkey_pbe:pbdkdf2("password", "salt", 1, 20, fun crypto:sha_mac/3, 20), + 16#2f, 16#e0, 16#37, 16#a6>> = pubkey_pbe:pbdkdf2("password", "salt", 1, 20, fun crypto:hmac/4, sha, 20), %% Input: %% P = "password" (8 octets) @@ -125,7 +125,7 @@ pbdkdf2(Config) when is_list(Config) -> <<16#ea, 16#6c, 16#01, 16#4d, 16#c7, 16#2d, 16#6f, 16#8c, 16#cd, 16#1e, 16#d9, 16#2a, 16#ce, 16#1d, 16#41, 16#f0, 16#d8, 16#de, 16#89, 16#57>> = - pubkey_pbe:pbdkdf2("password", "salt", 2, 20, fun crypto:sha_mac/3, 20), + pubkey_pbe:pbdkdf2("password", "salt", 2, 20, fun crypto:hmac/4, sha, 20), %% Input: %% P = "password" (8 octets) @@ -140,7 +140,7 @@ pbdkdf2(Config) when is_list(Config) -> <<16#4b, 16#00, 16#79, 16#01, 16#b7, 16#65, 16#48, 16#9a, 16#be, 16#ad, 16#49, 16#d9, 16#26, 16#f7, 16#21, 16#d0, - 16#65, 16#a4, 16#29, 16#c1>> = pubkey_pbe:pbdkdf2("password", "salt", 4096, 20, fun crypto:sha_mac/3, 20), + 16#65, 16#a4, 16#29, 16#c1>> = pubkey_pbe:pbdkdf2("password", "salt", 4096, 20, fun crypto:hmac/4, sha, 20), %% Input: %% P = "password" (8 octets) @@ -156,7 +156,7 @@ pbdkdf2(Config) when is_list(Config) -> <<16#ee, 16#fe, 16#3d, 16#61, 16#cd, 16#4d, 16#a4, 16#e4, 16#e9, 16#94, 16#5b, 16#3d, 16#6b, 16#a2, 16#15, 16#8c, - 16#26, 16#34, 16#e9, 16#84>> = pubkey_pbe:pbdkdf2("password", "salt", 16777216, 20, fun crypto:sha_mac/3, 20), + 16#26, 16#34, 16#e9, 16#84>> = pubkey_pbe:pbdkdf2("password", "salt", 16777216, 20, fun crypto:hmac/4, sha, 20), %% Input: %% P = "passwordPASSWORDpassword" (24 octets) @@ -175,7 +175,7 @@ pbdkdf2(Config) when is_list(Config) -> 16#8b, 16#29, 16#1a, 16#96, 16#4c, 16#f2, 16#f0, 16#70, 16#38>> = pubkey_pbe:pbdkdf2("passwordPASSWORDpassword", - "saltSALTsaltSALTsaltSALTsaltSALTsalt", 4096, 25, fun crypto:sha_mac/3, 20), + "saltSALTsaltSALTsaltSALTsaltSALTsalt", 4096, 25, fun crypto:hmac/4, sha, 20), %% Input: %% P = "pass\0word" (9 octets) @@ -190,7 +190,7 @@ pbdkdf2(Config) when is_list(Config) -> <<16#56, 16#fa, 16#6a, 16#a7, 16#55, 16#48, 16#09, 16#9d, 16#cc, 16#37, 16#d7, 16#f0, 16#34, 16#25, 16#e0, 16#c3>> = pubkey_pbe:pbdkdf2("pass\0word", - "sa\0lt", 4096, 16, fun crypto:sha_mac/3, 20). + "sa\0lt", 4096, 16, fun crypto:hmac/4, sha, 20). encrypted_private_key_info() -> [{doc,"Tests reading a EncryptedPrivateKeyInfo file encrypted with different ciphers"}]. diff --git a/lib/public_key/test/pkits_SUITE.erl b/lib/public_key/test/pkits_SUITE.erl index d901adaadd..c490493e13 100644 --- a/lib/public_key/test/pkits_SUITE.erl +++ b/lib/public_key/test/pkits_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2012. All Rights Reserved. +%% Copyright Ericsson AB 2008-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 @@ -758,11 +758,12 @@ warning(Format, Args, File0, Line) -> io:format("~s(~p): Warning "++Format, [File,Line|Args]). crypto_support_check(Config) -> - try crypto:sha256(<<"Test">>) of - _ -> - Config - catch error:notsup -> - crypto:stop(), + CryptoSupport = crypto:supports(), + Hashs = proplists:get_value(hashs, CryptoSupport), + case proplists:get_bool(sha256, Hashs) of + true -> + Config; + false -> {skip, "To old version of openssl"} end. diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index 0de80edeac..5a64140c67 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -551,7 +551,7 @@ dsa_sign_verify(Config) when is_list(Config) -> false = public_key:verify(Msg, sha, <<1:8, DSASign/binary>>, {DSAPublicKey, DSAParams}), - Digest = crypto:sha(Msg), + Digest = crypto:hash(sha,Msg), DigestSign = public_key:sign(Digest, none, DSAPrivateKey), true = public_key:verify(Digest, none, DigestSign, {DSAPublicKey, DSAParams}), <<_:8, RestDigest/binary>> = Digest, 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/reltool/src/reltool_utils.erl b/lib/reltool/src/reltool_utils.erl index edccb889b1..9af8f6bae8 100644 --- a/lib/reltool/src/reltool_utils.erl +++ b/lib/reltool/src/reltool_utils.erl @@ -572,7 +572,7 @@ copy_file(From, To) -> FromMode = FromInfo#file_info.mode, ToMode = ToInfo#file_info.mode, ToMode2 = FromMode bor ToMode, - FileInfo = FromInfo#file_info{mode = ToMode2}, + FileInfo = ToInfo#file_info{mode = ToMode2}, write_file_info(To, FileInfo), ok; {error, Reason} -> 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 3c4ba1af66..223d3f7218 100644 --- a/lib/snmp/src/agent/snmp_user_based_sm_mib.erl +++ b/lib/snmp/src/agent/snmp_user_based_sm_mib.erl @@ -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 @@ -214,12 +214,12 @@ check_user(User) -> case element(?usmUserAuthProtocol, User) of ?usmNoAuthProtocol -> ok; ?usmHMACMD5AuthProtocol -> - case is_crypto_supported(md5_mac_96) of + case is_crypto_supported(md5) of true -> ok; false -> exit({unsupported_crypto, md5_mac_96}) end; ?usmHMACSHAAuthProtocol -> - case is_crypto_supported(sha_mac_96) of + case is_crypto_supported(sha) of true -> ok; false -> exit({unsupported_crypto, sha_mac_96}) end @@ -227,14 +227,14 @@ check_user(User) -> case element(?usmUserPrivProtocol, User) of ?usmNoPrivProtocol -> ok; ?usmDESPrivProtocol -> - case is_crypto_supported(des_cbc_decrypt) of + case is_crypto_supported(des_cbc) of true -> ok; - false -> exit({unsupported_crypto, des_cbc_decrypt}) + false -> exit({unsupported_crypto, des_cbc}) end; ?usmAesCfb128Protocol -> - case is_crypto_supported(aes_cfb_128_decrypt) of + case is_crypto_supported(aes_cfb128) of true -> ok; - false -> exit({unsupported_crypto, aes_cfb_128_decrypt}) + false -> exit({unsupported_crypto, aes_cfb128}) end end. @@ -874,13 +874,13 @@ validate_auth_protocol(RowIndex, Cols) -> _ -> inconsistentValue(?usmUserAuthProtocol) end; ?usmHMACMD5AuthProtocol -> - case is_crypto_supported(md5_mac_96) of + case is_crypto_supported(md5) of true -> ok; false -> wrongValue(?usmUserAuthProtocol) end; ?usmHMACSHAAuthProtocol -> - case is_crypto_supported(sha_mac_96) of + case is_crypto_supported(sha) of true -> ok; false -> wrongValue(?usmUserAuthProtocol) @@ -1008,7 +1008,7 @@ validate_priv_protocol(RowIndex, Cols) -> ?usmDESPrivProtocol -> %% The 'catch' handles the case when 'crypto' is %% not present in the system. - case is_crypto_supported(des_cbc_decrypt) of + case is_crypto_supported(des_cbc) of true -> case get_auth_proto(RowIndex, Cols) of ?usmNoAuthProtocol -> @@ -1022,7 +1022,7 @@ validate_priv_protocol(RowIndex, Cols) -> ?usmAesCfb128Protocol -> %% The 'catch' handles the case when 'crypto' is %% not present in the system. - case is_crypto_supported(aes_cfb_128_decrypt) of + case is_crypto_supported(aes_cfb128) of true -> case get_auth_proto(RowIndex, Cols) of ?usmNoAuthProtocol -> @@ -1164,7 +1164,7 @@ mk_key_change(Hash, OldKey, NewKey) -> %% case in the standard where Random is pre-defined. mk_key_change(Alg, OldKey, NewKey, KeyLen, Random) -> %% OldKey and Random is of length KeyLen... - Digest = lists:sublist(binary_to_list(crypto:Alg(OldKey++Random)), KeyLen), + Digest = lists:sublist(binary_to_list(crypto:hash(Alg, OldKey++Random)), KeyLen), %% ... and so is Digest Delta = snmp_misc:str_xor(Digest, NewKey), Random ++ Delta. @@ -1181,7 +1181,7 @@ extract_new_key(Hash, OldKey, KeyChange) -> sha -> sha end, {Random, Delta} = split(KeyLen, KeyChange, []), - Digest = lists:sublist(binary_to_list(crypto:Alg(OldKey++Random)), KeyLen), + Digest = lists:sublist(binary_to_list(crypto:hash(Alg, OldKey++Random)), KeyLen), NewKey = snmp_misc:str_xor(Digest, Delta), NewKey. @@ -1219,13 +1219,10 @@ split(N, [H | T], FirstRev) when N > 0 -> split(N-1, T, [H | FirstRev]). +-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). + 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 df2c1f0b18..67e3476816 100644 --- a/lib/snmp/src/misc/snmp_usm.erl +++ b/lib/snmp/src/misc/snmp_usm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2010. 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 @@ -69,7 +69,7 @@ passwd2localized_key(Alg, Passwd, EngineID) when length(Passwd) > 0 -> %%----------------------------------------------------------------- localize_key(Alg, Key, EngineID) -> Str = [Key, EngineID, Key], - binary_to_list(crypto:Alg(Str)). + binary_to_list(crypto:hash(Alg, Str)). mk_digest(md5, Passwd) -> @@ -78,25 +78,25 @@ mk_digest(sha, Passwd) -> mk_sha_digest(Passwd). mk_md5_digest(Passwd) -> - Ctx = crypto:md5_init(), + Ctx = crypto:hash_init(md5), Ctx2 = md5_loop(0, [], Ctx, Passwd, length(Passwd)), - crypto:md5_final(Ctx2). + crypto:hash_final(Ctx2). md5_loop(Count, Buf, Ctx, Passwd, PasswdLen) when Count < 1048576 -> {Buf64, NBuf} = mk_buf64(length(Buf), Buf, Passwd, PasswdLen), - NCtx = crypto:md5_update(Ctx, Buf64), + NCtx = crypto:hash_update(Ctx, Buf64), md5_loop(Count+64, NBuf, NCtx, Passwd, PasswdLen); md5_loop(_Count, _Buf, Ctx, _Passwd, _PasswdLen) -> Ctx. mk_sha_digest(Passwd) -> - Ctx = crypto:sha_init(), + Ctx = crypto:hash_init(sha), Ctx2 = sha_loop(0, [], Ctx, Passwd, length(Passwd)), - crypto:sha_final(Ctx2). + crypto:hash_final(Ctx2). sha_loop(Count, Buf, Ctx, Passwd, PasswdLen) when Count < 1048576 -> {Buf64, NBuf} = mk_buf64(length(Buf), Buf, Passwd, PasswdLen), - NCtx = crypto:sha_update(Ctx, Buf64), + NCtx = crypto:hash_update(Ctx, Buf64), sha_loop(Count+64, NBuf, NCtx, Passwd, PasswdLen); sha_loop(_Count, _Buf, Ctx, _Passwd, _PasswdLen) -> Ctx. @@ -142,26 +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:md5_mac_96(AuthKey, Packet)), + MAC = binary_to_list(crypto:hmac(md5, AuthKey, Packet, 12)), + %% ?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:md5_mac_96(AuthKey, Packet2)), + 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 @@ -177,7 +184,7 @@ sha_auth_out(AuthKey, Message, UsmSecParams) -> Packet = snmp_pdus:enc_message_only(Message2), %% 7.3.1.2-4 is done by the crypto function %% 7.3.1.4 - MAC = binary_to_list(crypto:sha_mac_96(AuthKey, Packet)), + MAC = binary_to_list(crypto:hmac(sha, AuthKey, Packet, 12)), %% 7.3.1.5 set_msg_auth_params(Message, UsmSecParams, MAC). @@ -185,7 +192,7 @@ sha_auth_in(AuthKey, AuthParams, Packet) when length(AuthParams) =:= 12 -> %% 7.3.2.3 Packet2 = patch_packet(binary_to_list(Packet)), %% 7.3.2.5 - MAC = binary_to_list(crypto:sha_mac_96(AuthKey, Packet2)), + MAC = binary_to_list(crypto:hmac(sha, AuthKey, Packet2, 12)), %% 7.3.2.6 MAC == AuthParams; sha_auth_in(_AuthKey, _AuthParams, _Packet) -> @@ -203,7 +210,7 @@ des_encrypt(PrivKey, Data, SaltFun) -> IV = list_to_binary(snmp_misc:str_xor(PreIV, Salt)), TailLen = (8 - (length(Data) rem 8)) rem 8, Tail = mk_tail(TailLen), - EncData = crypto:des_cbc_encrypt(DesKey, IV, [Data,Tail]), + EncData = crypto:block_encrypt(des_cbc, DesKey, IV, [Data,Tail]), {ok, binary_to_list(EncData), Salt}. des_decrypt(PrivKey, MsgPrivParams, EncData) @@ -217,7 +224,7 @@ des_decrypt(PrivKey, MsgPrivParams, EncData) Salt = MsgPrivParams, IV = list_to_binary(snmp_misc:str_xor(PreIV, Salt)), %% Whatabout errors here??? E.g. not a mulitple of 8! - Data = binary_to_list(crypto:des_cbc_decrypt(DesKey, IV, EncData)), + Data = binary_to_list(crypto:block_decrypt(des_cbc, DesKey, IV, EncData)), Data2 = snmp_pdus:strip_encrypted_scoped_pdu_data(Data), {ok, Data2}; des_decrypt(PrivKey, BadMsgPrivParams, EncData) -> @@ -235,7 +242,7 @@ aes_encrypt(PrivKey, Data, SaltFun) -> EngineBoots = snmp_framework_mib:get_engine_boots(), EngineTime = snmp_framework_mib:get_engine_time(), IV = list_to_binary([?i32(EngineBoots), ?i32(EngineTime) | Salt]), - EncData = crypto:aes_cfb_128_encrypt(AesKey, IV, Data), + EncData = crypto:block_encrypt(aes_cbf128, AesKey, IV, Data), {ok, binary_to_list(EncData), Salt}. aes_decrypt(PrivKey, MsgPrivParams, EncData, EngineBoots, EngineTime) @@ -244,7 +251,7 @@ aes_decrypt(PrivKey, MsgPrivParams, EncData, EngineBoots, EngineTime) Salt = MsgPrivParams, IV = list_to_binary([?i32(EngineBoots), ?i32(EngineTime) | Salt]), %% Whatabout errors here??? E.g. not a mulitple of 8! - Data = binary_to_list(crypto:aes_cfb_128_decrypt(AesKey, IV, EncData)), + Data = binary_to_list(crypto:block_decrypt(aes_cbf128, AesKey, IV, EncData)), Data2 = snmp_pdus:strip_encrypted_scoped_pdu_data(Data), {ok, Data2}. 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/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 5841f06d70..fc6efc817f 100644 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-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 @@ -33,7 +33,6 @@ %% integer utils -export([isize/1]). --export([irandom/1, irandom/3]). -export([random/1]). -export([xor_bits/2, fill_bits/2]). -export([i2bin/2, bin2i/1]). @@ -387,31 +386,7 @@ xor_bits(XBits, YBits) -> <<Y:Sz, _/binary>> = YBits, <<(X bxor Y):Sz>>. -%% -%% irandom(N) -%% -%% Generate a N bits size random number -%% note that the top most bit is always set -%% to guarantee that the number is N bits -%% -irandom(Bits) -> - irandom(Bits, 1, 0). - -%% -%% irandom(N, Top, Bottom) -%% -%% Generate a N bits size random number -%% Where Top = 0 - do not set top bit -%% = 1 - set the most significant bit -%% = 2 - set two most significant bits -%% Bot = 0 - do not set the least signifcant bit -%% Bot = 1 - set the least signifcant bit (i.e always odd) -%% -irandom(Bits, Top, Bottom) when is_integer(Top), - 0 =< Top, Top =< 2 -> - crypto:erlint(crypto:strong_rand_mpint(Bits, Top - 1, Bottom)). -%% %% random/1 %% Generate N random bytes %% diff --git a/lib/ssh/src/ssh_math.erl b/lib/ssh/src/ssh_math.erl index 4aa385b18d..569c1cb58d 100644 --- a/lib/ssh/src/ssh_math.erl +++ b/lib/ssh/src/ssh_math.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-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 @@ -23,109 +23,19 @@ -module(ssh_math). --export([ilog2/1, ipow/3, invert/2, ipow2/3]). +-export([ipow/3]). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% INTEGER utils %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% number of bits (used) in a integer = isize(N) = |log2(N)|+1 -ilog2(N) -> - ssh_bits:isize(N) - 1. - - %% calculate A^B mod M ipow(A, B, M) when M > 0, B >= 0 -> - crypto:mod_exp(A, B, M). - -ipow2(A, B, M) when M > 0, B >= 0 -> - if A == 1 -> - 1; - true -> - ipow2(A, B, M, 1) - end. - -ipow2(A, 1, M, Prod) -> - (A*Prod) rem M; -ipow2(_A, 0, _M, Prod) -> - Prod; -ipow2(A, B, M, Prod) -> - B1 = B bsr 1, - A1 = (A*A) rem M, - if B - B1 == B1 -> - ipow2(A1, B1, M, Prod); - true -> - ipow2(A1, B1, M, (A*Prod) rem M) - end. - -%% %% -%% %% Normal gcd -%% %% -%% gcd(R, Q) when abs(Q) < abs(R) -> gcd1(Q,R); -%% gcd(R, Q) -> gcd1(R,Q). - -%% gcd1(0, Q) -> Q; -%% gcd1(R, Q) -> -%% gcd1(Q rem R, R). - - -%% %% -%% %% Least common multiple of (R,Q) -%% %% -%% lcm(0, _Q) -> 0; -%% lcm(_R, 0) -> 0; -%% lcm(R, Q) -> -%% (Q div gcd(R, Q)) * R. - -%% %% -%% %% Extended gcd gcd(R,Q) -> {G, {A,B}} such that G == R*A + Q*B -%% %% -%% %% Here we could have use for a bif divrem(Q, R) -> {Quote, Remainder} -%% %% -%% egcd(R,Q) when abs(Q) < abs(R) -> egcd1(Q,R,1,0,0,1); -%% egcd(R,Q) -> egcd1(R,Q,0,1,1,0). - -%% egcd1(0,Q,_,_,Q1,Q2) -> {Q, {Q2,Q1}}; -%% egcd1(R,Q,R1,R2,Q1,Q2) -> -%% D = Q div R, -%% egcd1(Q rem R, R, Q1-D*R1, Q2-D*R2, R1, R2). - -%% -%% Invert an element X mod P -%% Calculated as {1, {A,B}} = egcd(X,P), -%% 1 == P*A + X*B == X*B (mod P) i.e B is the inverse element -%% -%% X > 0, P > 0, X < P (P should be prime) -%% -invert(X,P) when X > 0, P > 0, X < P -> - I = inv(X,P,1,0), - if - I < 0 -> P + I; - true -> I - end. - -inv(0,_,_,Q) -> Q; -inv(X,P,R1,Q1) -> - D = P div X, - inv(P rem X, X, Q1 - D*R1, R1). - + crypto:bytes_to_integer(crypto:mod_pow(A, B, M)). -%% %% -%% %% Integer square root -%% %% -%% isqrt(0) -> 0; -%% isqrt(1) -> 1; -%% isqrt(X) when X >= 0 -> -%% R = X div 2, -%% isqrt(X div R, R, X). -%% isqrt(Q,R,X) when Q < R -> -%% R1 = (R+Q) div 2, -%% isqrt(X div R1, R1, X); -%% isqrt(_, R, _) -> R. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 98d59d01de..beaffdc025 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -792,14 +792,14 @@ encrypt(#ssh{encrypt = none} = Ssh, Data) -> encrypt(#ssh{encrypt = '3des-cbc', encrypt_keys = {K1,K2,K3}, encrypt_ctx = IV0} = Ssh, Data) -> - Enc = crypto:des3_cbc_encrypt(K1,K2,K3,IV0,Data), - IV = crypto:des_cbc_ivec(Enc), + Enc = crypto:block_encrypt(des3_cbc, [K1,K2,K3], IV0, Data), + IV = crypto:next_iv(des3_cbc, Enc), {Ssh#ssh{encrypt_ctx = IV}, Enc}; encrypt(#ssh{encrypt = 'aes128-cbc', encrypt_keys = K, encrypt_ctx = IV0} = Ssh, Data) -> - Enc = crypto:aes_cbc_128_encrypt(K,IV0,Data), - IV = crypto:aes_cbc_ivec(Enc), + Enc = crypto:block_encrypt(aes_cbc128, K,IV0,Data), + IV = crypto:next_iv(aes_cbc, Enc), {Ssh#ssh{encrypt_ctx = IV}, Enc}. @@ -846,13 +846,13 @@ decrypt(#ssh{decrypt = none} = Ssh, Data) -> decrypt(#ssh{decrypt = '3des-cbc', decrypt_keys = Keys, decrypt_ctx = IV0} = Ssh, Data) -> {K1, K2, K3} = Keys, - Dec = crypto:des3_cbc_decrypt(K1,K2,K3,IV0,Data), - IV = crypto:des_cbc_ivec(Data), + Dec = crypto:block_decrypt(des3_cbc, [K1,K2,K3], IV0, Data), + IV = crypto:next_iv(des3_cbc, Data), {Ssh#ssh{decrypt_ctx = IV}, Dec}; decrypt(#ssh{decrypt = 'aes128-cbc', decrypt_keys = Key, decrypt_ctx = IV0} = Ssh, Data) -> - Dec = crypto:aes_cbc_128_decrypt(Key,IV0,Data), - IV = crypto:aes_cbc_ivec(Data), + Dec = crypto:block_decrypt(aes_cbc128, Key,IV0,Data), + IV = crypto:next_iv(aes_cbc, Data), {Ssh#ssh{decrypt_ctx = IV}, Dec}. @@ -954,22 +954,22 @@ recv_mac_final(SSH) -> mac(none, _ , _, _) -> <<>>; mac('hmac-sha1', Key, SeqNum, Data) -> - crypto:sha_mac(Key, [<<?UINT32(SeqNum)>>, Data]); + crypto:hmac(sha, Key, [<<?UINT32(SeqNum)>>, Data]); mac('hmac-sha1-96', Key, SeqNum, Data) -> - crypto:sha_mac_96(Key, [<<?UINT32(SeqNum)>>, Data]); + crypto:hmac(sha, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-sha1-96')); mac('hmac-md5', Key, SeqNum, Data) -> - crypto:md5_mac(Key, [<<?UINT32(SeqNum)>>, Data]); + crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data]); mac('hmac-md5-96', Key, SeqNum, Data) -> - crypto:md5_mac_96(Key, [<<?UINT32(SeqNum)>>, Data]). + crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-md5-96')). %% return N hash bytes (HASH) hash(SSH, Char, Bits) -> HASH = case SSH#ssh.kex of 'diffie-hellman-group1-sha1' -> - fun(Data) -> crypto:sha(Data) end; + fun(Data) -> crypto:hash(sha, Data) end; 'diffie-hellman-group-exchange-sha1' -> - fun(Data) -> crypto:sha(Data) end; + fun(Data) -> crypto:hash(sha, Data) end; _ -> exit({bad_algorithm,SSH#ssh.kex}) end, @@ -998,7 +998,7 @@ kex_h(SSH, K_S, E, F, K) -> K_S, E,F,K], [string,string,binary,binary,binary, mpint,mpint,mpint]), - crypto:sha(L). + crypto:hash(sha,L). kex_h(SSH, K_S, Min, NBits, Max, Prime, Gen, E, F, K) -> @@ -1019,7 +1019,7 @@ kex_h(SSH, K_S, Min, NBits, Max, Prime, Gen, E, F, K) -> K_S, Min, NBits, Max, Prime, Gen, E,F,K], Ts) end, - crypto:sha(L). + crypto:hash(sha,L). mac_key_size('hmac-sha1') -> 20*8; mac_key_size('hmac-sha1-96') -> 20*8; @@ -1045,10 +1045,9 @@ peer_name({Host, _}) -> dh_group1() -> {2, 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE65381FFFFFFFFFFFFFFFF}. -dh_gen_key(G, P, _Bits) -> - Private = ssh_bits:irandom(ssh_bits:isize(P)-1, 1, 1), - Public = ssh_math:ipow(G, Private, P), - {Private,Public}. +dh_gen_key(G, P, _) -> + {Public, Private} = crypto:generate_key(dh, [P, G]), + {crypto:bytes_to_integer(Private), crypto:bytes_to_integer(Public)}. trim_tail(Str) -> lists:reverse(trim_head(lists:reverse(Str))). @@ -1058,3 +1057,5 @@ trim_head([$\t|Cs]) -> trim_head(Cs); trim_head([$\n|Cs]) -> trim_head(Cs); trim_head([$\r|Cs]) -> trim_head(Cs); trim_head(Cs) -> Cs. + + diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index d5615fecfc..1645eb15f3 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -37,17 +37,21 @@ <list type="bulleted"> <item>ssl requires the crypto and public_key applications.</item> <item>Supported SSL/TLS-versions are SSL-3.0, TLS-1.0, - TLS-1.1 and TLS-1.2 (no support for elliptic curve cipher suites yet).</item> + TLS-1.1 and TLS-1.2.</item> <item>For security reasons sslv2 is not supported.</item> <item>Ephemeral Diffie-Hellman cipher suites are supported but not Diffie Hellman Certificates cipher suites.</item> + <item>Elliptic Curve cipher suites are supported if crypto + supports it and named curves are used. + </item> <item>Export cipher suites are not supported as the U.S. lifted its export restrictions in early 2000.</item> <item>IDEA cipher suites are not supported as they have become deprecated by the latest TLS spec so there is not any real motivation to implement them.</item> - <item>CRL and policy certificate - extensions are not supported yet. </item> + <item>CRL and policy certificate extensions are not supported + yet. However CRL verification is supported by public_key, only not integrated + in ssl yet. </item> </list> </section> @@ -75,7 +79,7 @@ {fail_if_no_peer_cert, boolean()} {depth, integer()} | {cert, der_encoded()}| {certfile, path()} | - {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'PrivateKeyInfo', der_encoded()}} | + {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' |'PrivateKeyInfo', der_encoded()}} | {keyfile, path()} | {password, string()} | {cacerts, [der_encoded()]} | {cacertfile, path()} | |{dh, der_encoded()} | {dhfile, path()} | {ciphers, ciphers()} | @@ -125,6 +129,7 @@ <p><c>key_exchange() = rsa | dhe_dss | dhe_rsa | dh_anon | psk | dhe_psk | rsa_psk | srp_anon | srp_dss | srp_rsa + | ecdh_anon | ecdh_ecdsa | ecdhe_ecdsa | ecdh_rsa | ecdhe_rsa </c></p> <p><c>cipher() = rc4_128 | des_cbc | '3des_ede_cbc' @@ -157,7 +162,7 @@ <tag>{certfile, path()}</tag> <item>Path to a file containing the user's certificate.</item> - <tag>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'PrivateKeyInfo', der_encoded()}}</tag> + <tag>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' |'PrivateKeyInfo', der_encoded()}}</tag> <item> The DER encoded users private key. If this option is supplied it will override the keyfile option.</item> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index d3ba76d34e..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_srp_primes.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 70f3b4f050..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). @@ -37,7 +37,6 @@ -include("ssl_record.hrl"). -include("ssl_cipher.hrl"). -include("ssl_handshake.hrl"). --include("ssl_srp_primes.hrl"). -include_lib("public_key/include/public_key.hrl"). @@ -47,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(). @@ -93,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 -> @@ -336,699 +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([]), + Version = tls_record:highest_protocol_version([]), [suite_definition(S) || S <- ssl_cipher:suites(Version)]; cipher_suites(openssl) -> - Version = ssl_record:highest_protocol_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 == '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: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) -> - Supported = ssl_cipher:suites(Version) - ++ ssl_cipher:anonymous_suites() - ++ ssl_cipher:psk_suites(Version) - ++ ssl_cipher:srp_suites(), - 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; + 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 01a7cd93b5..b186a1015a 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -37,7 +37,8 @@ is_valid_extkey_usage/2, is_valid_key_usage/2, select_extension/2, - extensions_list/1 + extensions_list/1, + public_key_type/1 ]). %%==================================================================== @@ -166,6 +167,18 @@ extensions_list(Extensions) -> Extensions. %%-------------------------------------------------------------------- +-spec public_key_type(term()) -> rsa | dsa | ec. +%% +%% Description: +%%-------------------------------------------------------------------- +public_key_type(?'rsaEncryption') -> + rsa; +public_key_type(?'id-dsa') -> + dsa; +public_key_type(?'id-ecPublicKey') -> + ec. + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- certificate_chain(OtpCert, _Cert, CertDbHandle, CertsDbRef, Chain) -> @@ -227,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_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 173c53709b..898b421dff 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -35,7 +35,7 @@ -export([security_parameters/3, suite_definition/1, decipher/5, cipher/5, suite/1, suites/1, anonymous_suites/0, psk_suites/1, srp_suites/0, - openssl_suite/1, openssl_suite_name/1, filter/2, + openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1]). -compile(inline). @@ -73,25 +73,25 @@ cipher(?NULL, CipherState, <<>>, Fragment, _Version) -> {GenStreamCipherList, CipherState}; cipher(?RC4, CipherState, Mac, Fragment, _Version) -> State0 = case CipherState#cipher_state.state of - undefined -> crypto:rc4_set_key(CipherState#cipher_state.key); + undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key); S -> S end, GenStreamCipherList = [Fragment, Mac], - {State1, T} = crypto:rc4_encrypt_with_state(State0, GenStreamCipherList), + {State1, T} = crypto:stream_encrypt(State0, GenStreamCipherList), {T, CipherState#cipher_state{state = State1}}; cipher(?DES, CipherState, Mac, Fragment, Version) -> block_cipher(fun(Key, IV, T) -> - crypto:des_cbc_encrypt(Key, IV, T) + crypto:block_encrypt(des_cbc, Key, IV, T) end, block_size(des_cbc), CipherState, Mac, Fragment, Version); cipher(?'3DES', CipherState, Mac, Fragment, Version) -> block_cipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> - crypto:des3_cbc_encrypt(K1, K2, K3, IV, T) + crypto:block_encrypt(des3_cbc, [K1, K2, K3], IV, T) end, block_size(des_cbc), CipherState, Mac, Fragment, Version); cipher(?AES, CipherState, Mac, Fragment, Version) -> block_cipher(fun(Key, IV, T) when byte_size(Key) =:= 16 -> - crypto:aes_cbc_128_encrypt(Key, IV, T); + crypto:block_encrypt(aes_cbc128, Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> - crypto:aes_cbc_256_encrypt(Key, IV, T) + crypto:block_encrypt(aes_cbc256, Key, IV, T) end, block_size(aes_128_cbc), CipherState, Mac, Fragment, Version). build_cipher_block(BlockSz, Mac, Fragment) -> @@ -127,10 +127,10 @@ decipher(?NULL, _HashSz, CipherState, Fragment, _) -> {Fragment, <<>>, CipherState}; decipher(?RC4, HashSz, CipherState, Fragment, _) -> State0 = case CipherState#cipher_state.state of - undefined -> crypto:rc4_set_key(CipherState#cipher_state.key); + undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key); S -> S end, - try crypto:rc4_encrypt_with_state(State0, Fragment) of + try crypto:stream_decrypt(State0, Fragment) of {State, Text} -> GSC = generic_stream_cipher_from_bin(Text, HashSz), #generic_stream_cipher{content = Content, mac = Mac} = GSC, @@ -147,17 +147,17 @@ decipher(?RC4, HashSz, CipherState, Fragment, _) -> decipher(?DES, HashSz, CipherState, Fragment, Version) -> block_decipher(fun(Key, IV, T) -> - crypto:des_cbc_decrypt(Key, IV, T) + crypto:block_decrypt(des_cbc, Key, IV, T) end, CipherState, HashSz, Fragment, Version); decipher(?'3DES', HashSz, CipherState, Fragment, Version) -> block_decipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> - crypto:des3_cbc_decrypt(K1, K2, K3, IV, T) + crypto:block_decrypt(des3_cbc, [K1, K2, K3], IV, T) end, CipherState, HashSz, Fragment, Version); decipher(?AES, HashSz, CipherState, Fragment, Version) -> block_decipher(fun(Key, IV, T) when byte_size(Key) =:= 16 -> - crypto:aes_cbc_128_decrypt(Key, IV, T); + crypto:block_decrypt(aes_cbc128, Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> - crypto:aes_cbc_256_decrypt(Key, IV, T) + crypto:block_decrypt(aes_cbc256, Key, IV, T) end, CipherState, HashSz, Fragment, Version). block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, @@ -212,10 +212,14 @@ anonymous_suites() -> ?TLS_DH_anon_WITH_AES_128_CBC_SHA, ?TLS_DH_anon_WITH_AES_256_CBC_SHA, ?TLS_DH_anon_WITH_AES_128_CBC_SHA256, - ?TLS_DH_anon_WITH_AES_256_CBC_SHA256]. + ?TLS_DH_anon_WITH_AES_256_CBC_SHA256, + ?TLS_ECDH_anon_WITH_RC4_128_SHA, + ?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDH_anon_WITH_AES_128_CBC_SHA, + ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA]. %%-------------------------------------------------------------------- --spec psk_suites(tls_version()) -> [cipher_suite()]. +-spec psk_suites(tls_version() | integer()) -> [cipher_suite()]. %% %% Description: Returns a list of the PSK cipher suites, only supported %% if explicitly set by user. @@ -274,6 +278,11 @@ srp_suites() -> %% TLS v1.1 suites suite_definition(?TLS_NULL_WITH_NULL_NULL) -> {null, null, null, null}; +%% RFC 5746 - Not a real cipher suite used to signal empty "renegotiation_info" extension +%% to avoid handshake failure from old servers that do not ignore +%% hello extension data as they should. +suite_definition(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV) -> + {null, null, null, null}; %% suite_definition(?TLS_RSA_WITH_NULL_MD5) -> %% {rsa, null, md5, default_prf}; %% suite_definition(?TLS_RSA_WITH_NULL_SHA) -> @@ -423,8 +432,81 @@ suite_definition(?TLS_SRP_SHA_WITH_AES_256_CBC_SHA) -> suite_definition(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> {srp_rsa, aes_256_cbc, sha, default_prf}; suite_definition(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> - {srp_dss, aes_256_cbc, sha, default_prf}. - + {srp_dss, aes_256_cbc, sha, default_prf}; + +%% RFC 4492 EC TLS suites +suite_definition(?TLS_ECDH_ECDSA_WITH_NULL_SHA) -> + {ecdh_ecdsa, null, sha, default_prf}; +suite_definition(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> + {ecdh_ecdsa, rc4_128, sha, default_prf}; +suite_definition(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> + {ecdh_ecdsa, '3des_ede_cbc', sha, default_prf}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> + {ecdh_ecdsa, aes_128_cbc, sha, default_prf}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> + {ecdh_ecdsa, aes_256_cbc, sha, default_prf}; + +suite_definition(?TLS_ECDHE_ECDSA_WITH_NULL_SHA) -> + {ecdhe_ecdsa, null, sha, default_prf}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> + {ecdhe_ecdsa, rc4_128, sha, default_prf}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> + {ecdhe_ecdsa, '3des_ede_cbc', sha, default_prf}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> + {ecdhe_ecdsa, aes_128_cbc, sha, default_prf}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> + {ecdhe_ecdsa, aes_256_cbc, sha, default_prf}; + +suite_definition(?TLS_ECDH_RSA_WITH_NULL_SHA) -> + {ecdh_rsa, null, sha, default_prf}; +suite_definition(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> + {ecdh_rsa, rc4_128, sha, default_prf}; +suite_definition(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> + {ecdh_rsa, '3des_ede_cbc', sha, default_prf}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> + {ecdh_rsa, aes_128_cbc, sha, default_prf}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> + {ecdh_rsa, aes_256_cbc, sha, default_prf}; + +suite_definition(?TLS_ECDHE_RSA_WITH_NULL_SHA) -> + {ecdhe_rsa, null, sha, default_prf}; +suite_definition(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> + {ecdhe_rsa, rc4_128, sha, default_prf}; +suite_definition(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> + {ecdhe_rsa, '3des_ede_cbc', sha, default_prf}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> + {ecdhe_rsa, aes_128_cbc, sha, default_prf}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> + {ecdhe_rsa, aes_256_cbc, sha, default_prf}; + +suite_definition(?TLS_ECDH_anon_WITH_NULL_SHA) -> + {ecdh_anon, null, sha, default_prf}; +suite_definition(?TLS_ECDH_anon_WITH_RC4_128_SHA) -> + {ecdh_anon, rc4_128, sha, default_prf}; +suite_definition(?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA) -> + {ecdh_anon, '3des_ede_cbc', sha, default_prf}; +suite_definition(?TLS_ECDH_anon_WITH_AES_128_CBC_SHA) -> + {ecdh_anon, aes_128_cbc, sha, default_prf}; +suite_definition(?TLS_ECDH_anon_WITH_AES_256_CBC_SHA) -> + {ecdh_anon, aes_256_cbc, sha, default_prf}; + +%% RFC 5289 EC TLS suites +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> + {ecdhe_ecdsa, aes_128_cbc, sha256, sha256}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> + {ecdhe_ecdsa, aes_256_cbc, sha384, sha384}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> + {ecdh_ecdsa, aes_128_cbc, sha256, sha256}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> + {ecdh_ecdsa, aes_256_cbc, sha384, sha384}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> + {ecdhe_rsa, aes_128_cbc, sha256, sha256}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> + {ecdhe_rsa, aes_256_cbc, sha384, sha384}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> + {ecdh_rsa, aes_128_cbc, sha256, sha256}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> + {ecdh_rsa, aes_256_cbc, sha384, sha384}. %%-------------------------------------------------------------------- -spec suite(erl_cipher_suite()) -> cipher_suite(). @@ -573,7 +655,81 @@ suite({srp_anon, aes_256_cbc, sha}) -> suite({srp_rsa, aes_256_cbc, sha}) -> ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA; suite({srp_dss, aes_256_cbc, sha}) -> - ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA. + ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA; + +%%% RFC 4492 EC TLS suites +suite({ecdh_ecdsa, null, sha}) -> + ?TLS_ECDH_ECDSA_WITH_NULL_SHA; +suite({ecdh_ecdsa, rc4_128, sha}) -> + ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA; +suite({ecdh_ecdsa, '3des_ede_cbc', sha}) -> + ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA; +suite({ecdh_ecdsa, aes_128_cbc, sha}) -> + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA; +suite({ecdh_ecdsa, aes_256_cbc, sha}) -> + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA; + +suite({ecdhe_ecdsa, null, sha}) -> + ?TLS_ECDHE_ECDSA_WITH_NULL_SHA; +suite({ecdhe_ecdsa, rc4_128, sha}) -> + ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA; +suite({ecdhe_ecdsa, '3des_ede_cbc', sha}) -> + ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA; +suite({ecdhe_ecdsa, aes_128_cbc, sha}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA; +suite({ecdhe_ecdsa, aes_256_cbc, sha}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA; + +suite({ecdh_rsa, null, sha}) -> + ?TLS_ECDH_RSA_WITH_NULL_SHA; +suite({ecdh_rsa, rc4_128, sha}) -> + ?TLS_ECDH_RSA_WITH_RC4_128_SHA; +suite({ecdh_rsa, '3des_ede_cbc', sha}) -> + ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA; +suite({ecdh_rsa, aes_128_cbc, sha}) -> + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA; +suite({ecdh_rsa, aes_256_cbc, sha}) -> + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA; + +suite({ecdhe_rsa, null, sha}) -> + ?TLS_ECDHE_RSA_WITH_NULL_SHA; +suite({ecdhe_rsa, rc4_128, sha}) -> + ?TLS_ECDHE_RSA_WITH_RC4_128_SHA; +suite({ecdhe_rsa, '3des_ede_cbc', sha}) -> + ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA; +suite({ecdhe_rsa, aes_128_cbc, sha}) -> + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA; +suite({ecdhe_rsa, aes_256_cbc, sha}) -> + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA; + +suite({ecdh_anon, null, sha}) -> + ?TLS_ECDH_anon_WITH_NULL_SHA; +suite({ecdh_anon, rc4_128, sha}) -> + ?TLS_ECDH_anon_WITH_RC4_128_SHA; +suite({ecdh_anon, '3des_ede_cbc', sha}) -> + ?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA; +suite({ecdh_anon, aes_128_cbc, sha}) -> + ?TLS_ECDH_anon_WITH_AES_128_CBC_SHA; +suite({ecdh_anon, aes_256_cbc, sha}) -> + ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA; + +%%% RFC 5289 EC TLS suites +suite({ecdhe_ecdsa, aes_128_cbc, sha256}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; +suite({ecdhe_ecdsa, aes_256_cbc, sha384}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; +suite({ecdh_ecdsa, aes_128_cbc, sha256}) -> + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; +suite({ecdh_ecdsa, aes_256_cbc, sha384}) -> + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; +suite({ecdhe_rsa, aes_128_cbc, sha256}) -> + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; +suite({ecdhe_rsa, aes_256_cbc, sha384}) -> + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; +suite({ecdh_rsa, aes_128_cbc, sha256}) -> + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; +suite({ecdh_rsa, aes_256_cbc, sha384}) -> + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384. %%-------------------------------------------------------------------- -spec openssl_suite(openssl_cipher_suite()) -> cipher_suite(). @@ -633,8 +789,62 @@ openssl_suite("SRP-RSA-3DES-EDE-CBC-SHA") -> openssl_suite("SRP-DSS-AES-128-CBC-SHA") -> ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA; openssl_suite("SRP-RSA-AES-128-CBC-SHA") -> - ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA. + ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA; +%% RFC 4492 EC TLS suites +openssl_suite("ECDH-ECDSA-RC4-SHA") -> + ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA; +openssl_suite("ECDH-ECDSA-DES-CBC3-SHA") -> + ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA; +openssl_suite("ECDH-ECDSA-AES128-SHA") -> + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA; +openssl_suite("ECDH-ECDSA-AES256-SHA") -> + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA; + +openssl_suite("ECDHE-ECDSA-RC4-SHA") -> + ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA; +openssl_suite("ECDHE-ECDSA-DES-CBC3-SHA") -> + ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA; +openssl_suite("ECDHE-ECDSA-AES128-SHA") -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA; +openssl_suite("ECDHE-ECDSA-AES256-SHA") -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA; + +openssl_suite("ECDHE-RSA-RC4-SHA") -> + ?TLS_ECDHE_RSA_WITH_RC4_128_SHA; +openssl_suite("ECDHE-RSA-DES-CBC3-SHA") -> + ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA; +openssl_suite("ECDHE-RSA-AES128-SHA") -> + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA; +openssl_suite("ECDHE-RSA-AES256-SHA") -> + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA; + +openssl_suite("ECDH-RSA-RC4-SHA") -> + ?TLS_ECDH_RSA_WITH_RC4_128_SHA; +openssl_suite("ECDH-RSA-DES-CBC3-SHA") -> + ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA; +openssl_suite("ECDH-RSA-AES128-SHA") -> + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA; +openssl_suite("ECDH-RSA-AES256-SHA") -> + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA; + +%% RFC 5289 EC TLS suites +openssl_suite("ECDHE-ECDSA-AES128-SHA256") -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; +openssl_suite("ECDHE-ECDSA-AES256-SHA384") -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; +openssl_suite("ECDH-ECDSA-AES128-SHA256") -> + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; +openssl_suite("ECDH-ECDSA-AES256-SHA384") -> + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; +openssl_suite("ECDHE-RSA-AES128-SHA256") -> + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; +openssl_suite("ECDHE-RSA-AES256-SHA384") -> + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; +openssl_suite("ECDH-RSA-AES128-SHA256") -> + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; +openssl_suite("ECDH-RSA-AES256-SHA384") -> + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384. %%-------------------------------------------------------------------- -spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite(). @@ -716,6 +926,61 @@ openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> "SRP-DSS-AES-256-CBC-SHA"; +%% RFC 4492 EC TLS suites +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> + "ECDH-ECDSA-RC4-SHA"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> + "ECDH-ECDSA-DES-CBC3-SHA"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> + "ECDH-ECDSA-AES128-SHA"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> + "ECDH-ECDSA-AES256-SHA"; + +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> + "ECDHE-ECDSA-RC4-SHA"; +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> + "ECDHE-ECDSA-DES-CBC3-SHA"; +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> + "ECDHE-ECDSA-AES128-SHA"; +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> + "ECDHE-ECDSA-AES256-SHA"; + +openssl_suite_name(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> + "ECDH-RSA-RC4-SHA"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> + "ECDH-RSA-DES-CBC3-SHA"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> + "ECDH-RSA-AES128-SHA"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> + "ECDH-RSA-AES256-SHA"; + +openssl_suite_name(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> + "ECDHE-RSA-RC4-SHA"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> + "ECDHE-RSA-DES-CBC3-SHA"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> + "ECDHE-RSA-AES128-SHA"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> + "ECDHE-RSA-AES256-SHA"; + +%% RFC 5289 EC TLS suites +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> + "ECDHE-ECDSA-AES128-SHA256"; +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> + "ECDHE-ECDSA-AES256-SHA384"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> + "ECDH-ECDSA-AES128-SHA256"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> + "ECDH-ECDSA-AES256-SHA384"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> + "ECDHE-RSA-AES128-SHA256"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> + "ECDHE-RSA-AES256-SHA384"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> + "ECDH-RSA-AES128-SHA256"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> + "ECDH-RSA-AES256-SHA384"; + %% No oppenssl name openssl_suite_name(Cipher) -> suite_definition(Cipher). @@ -730,14 +995,87 @@ filter(undefined, Ciphers) -> filter(DerCert, Ciphers) -> OtpCert = public_key:pkix_decode_cert(DerCert, otp), SigAlg = OtpCert#'OTPCertificate'.signatureAlgorithm, + PubKeyInfo = OtpCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.subjectPublicKeyInfo, + PubKeyAlg = PubKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm, + + Ciphers1 = + case ssl_certificate:public_key_type(PubKeyAlg#'PublicKeyAlgorithm'.algorithm) of + rsa -> + filter_keyuse(OtpCert, ((Ciphers -- dsa_signed_suites()) -- ec_keyed_suites()) -- ecdh_suites(), + rsa_suites(), dhe_rsa_suites() ++ ecdhe_rsa_suites()); + dsa -> + (Ciphers -- rsa_keyed_suites()) -- ec_keyed_suites(); + ec -> + filter_keyuse(OtpCert, (Ciphers -- rsa_keyed_suites()) -- dsa_signed_suites(), + [], ecdhe_ecdsa_suites()) + end, case public_key:pkix_sign_types(SigAlg#'SignatureAlgorithm'.algorithm) of {_, rsa} -> - filter_rsa(OtpCert, Ciphers -- dsa_signed_suites()); + Ciphers1 -- ecdsa_signed_suites(); {_, dsa} -> - Ciphers -- rsa_signed_suites() + Ciphers1; + {_, ecdsa} -> + Ciphers1 -- rsa_signed_suites() end. %%-------------------------------------------------------------------- +-spec filter_suites([cipher_suite()]) -> [cipher_suite()]. +%% +%% Description: filter suites for algorithms +%%------------------------------------------------------------------- +filter_suites(Suites = [{_,_,_}|_]) -> + Algos = crypto:supports(), + lists:filter(fun({KeyExchange, Cipher, Hash}) -> + is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso + is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso + is_acceptable_hash(Hash, proplists:get_value(hashs, Algos)) + end, Suites); + +filter_suites(Suites = [{_,_,_,_}|_]) -> + Algos = crypto:supports(), + Hashs = proplists:get_value(hashs, Algos), + lists:filter(fun({KeyExchange, Cipher, Hash, Prf}) -> + is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso + is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso + is_acceptable_hash(Hash, Hashs) andalso + is_acceptable_prf(Prf, Hashs) + end, Suites); + +filter_suites(Suites) -> + Algos = crypto:supports(), + Hashs = proplists:get_value(hashs, Algos), + lists:filter(fun(Suite) -> + {KeyExchange, Cipher, Hash, Prf} = ssl_cipher:suite_definition(Suite), + is_acceptable_keyexchange(KeyExchange, proplists:get_value(public_keys, Algos)) andalso + is_acceptable_cipher(Cipher, proplists:get_value(ciphers, Algos)) andalso + is_acceptable_hash(Hash, Hashs) andalso + is_acceptable_prf(Prf, Hashs) + end, Suites). + +is_acceptable_keyexchange(KeyExchange, Algos) + when KeyExchange == ecdh_ecdsa; + KeyExchange == ecdhe_ecdsa; + KeyExchange == ecdh_rsa; + KeyExchange == ecdhe_rsa; + KeyExchange == ecdh_anon -> + proplists:get_bool(ecdh, Algos); +is_acceptable_keyexchange(_, _) -> + true. + +is_acceptable_cipher(_, _) -> + true. + +is_acceptable_hash(null, _Algos) -> + true; +is_acceptable_hash(Hash, Algos) -> + proplists:get_bool(Hash, Algos). + +is_acceptable_prf(default_prf, _) -> + true; +is_acceptable_prf(Prf, Algos) -> + proplists:get_bool(Prf, Algos). + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -950,7 +1288,13 @@ next_iv(Bin, IV) -> rsa_signed_suites() -> dhe_rsa_suites() ++ rsa_suites() ++ - psk_rsa_suites() ++ srp_rsa_suites(). + psk_rsa_suites() ++ srp_rsa_suites() ++ + ecdh_rsa_suites(). + +rsa_keyed_suites() -> + dhe_rsa_suites() ++ rsa_suites() ++ + psk_rsa_suites() ++ srp_rsa_suites() ++ + ecdhe_rsa_suites(). dhe_rsa_suites() -> [?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, @@ -982,7 +1326,25 @@ rsa_suites() -> ?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5, ?TLS_RSA_WITH_DES_CBC_SHA]. - + +ecdh_rsa_suites() -> + [?TLS_ECDH_RSA_WITH_NULL_SHA, + ?TLS_ECDH_RSA_WITH_RC4_128_SHA, + ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA, + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA, + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256, + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384]. + +ecdhe_rsa_suites() -> + [?TLS_ECDHE_RSA_WITH_NULL_SHA, + ?TLS_ECDHE_RSA_WITH_RC4_128_SHA, + ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA, + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA, + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256, + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384]. + dsa_signed_suites() -> dhe_dss_suites() ++ srp_dss_suites(). @@ -999,24 +1361,52 @@ srp_dss_suites() -> ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA, ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA]. -filter_rsa(OtpCert, RsaCiphers) -> +ec_keyed_suites() -> + ecdh_ecdsa_suites() ++ ecdhe_ecdsa_suites() + ++ ecdh_rsa_suites(). + +ecdsa_signed_suites() -> + ecdh_ecdsa_suites() ++ ecdhe_ecdsa_suites(). + +ecdh_suites() -> + ecdh_rsa_suites() ++ ecdh_ecdsa_suites(). + +ecdh_ecdsa_suites() -> + [?TLS_ECDH_ECDSA_WITH_NULL_SHA, + ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA, + ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA, + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256, + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384]. + +ecdhe_ecdsa_suites() -> + [?TLS_ECDHE_ECDSA_WITH_NULL_SHA, + ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA, + ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA, + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA, + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256, + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384]. + +filter_keyuse(OtpCert, Ciphers, Suites, SignSuites) -> TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, TBSExtensions = TBSCert#'OTPTBSCertificate'.extensions, Extensions = ssl_certificate:extensions_list(TBSExtensions), case ssl_certificate:select_extension(?'id-ce-keyUsage', Extensions) of undefined -> - RsaCiphers; + Ciphers; #'Extension'{extnValue = KeyUse} -> - Result = filter_rsa_suites(keyEncipherment, - KeyUse, RsaCiphers, rsa_suites()), - filter_rsa_suites(digitalSignature, - KeyUse, Result, dhe_rsa_suites()) + Result = filter_keyuse_suites(keyEncipherment, + KeyUse, Ciphers, Suites), + filter_keyuse_suites(digitalSignature, + KeyUse, Result, SignSuites) end. -filter_rsa_suites(Use, KeyUse, CipherSuits, RsaSuites) -> +filter_keyuse_suites(Use, KeyUse, CipherSuits, Suites) -> case ssl_certificate:is_valid_key_usage(KeyUse, Use) of true -> CipherSuits; false -> - CipherSuits -- RsaSuites + CipherSuits -- Suites end. diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index 90d3704efd..c7c71ee1a7 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.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 @@ -28,9 +28,9 @@ -type cipher() :: null |rc4_128 | idea_cbc | des40_cbc | des_cbc | '3des_ede_cbc' | aes_128_cbc | aes_256_cbc. --type hash() :: null | sha | md5 | sha256 | sha384 | sha512. +-type hash() :: null | sha | md5 | ssh224 | sha256 | sha384 | sha512. -type erl_cipher_suite() :: {key_algo(), cipher(), hash()}. --type int_cipher_suite() :: {key_algo(), cipher(), hash(), hash()}. +-type int_cipher_suite() :: {key_algo(), cipher(), hash(), hash() | default_prf}. -type cipher_suite() :: binary(). -type cipher_enum() :: integer(). -type openssl_cipher_suite() :: string(). @@ -219,6 +219,120 @@ %% TLS_DH_anon_WITH_AES_256_CBC_SHA256 = { 0x00,0x6D }; -define(TLS_DH_anon_WITH_AES_256_CBC_SHA256, <<?BYTE(16#00), ?BYTE(16#6D)>>). +%% RFC 4492 EC TLS suites + +%% ECDH_ECDSA + +%% TLS_ECDH_ECDSA_WITH_NULL_SHA = { 0xC0, 0x01 } +-define(TLS_ECDH_ECDSA_WITH_NULL_SHA, <<?BYTE(16#C0), ?BYTE(16#01)>>). + +%% TLS_ECDH_ECDSA_WITH_RC4_128_SHA = { 0xC0, 0x02 } +-define(TLS_ECDH_ECDSA_WITH_RC4_128_SHA, <<?BYTE(16#C0), ?BYTE(16#02)>>). + +%% TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA = { 0xC0, 0x03 } +-define(TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#03)>>). + +%% TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA = { 0xC0, 0x04 } +-define(TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#04)>>). + +%% TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA = { 0xC0, 0x05 } +-define(TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#05)>>). + +%% ECDHE_ECDSA + +%% TLS_ECDHE_ECDSA_WITH_NULL_SHA = { 0xC0, 0x06 } +-define(TLS_ECDHE_ECDSA_WITH_NULL_SHA, <<?BYTE(16#C0), ?BYTE(16#06)>>). + +%% TLS_ECDHE_ECDSA_WITH_RC4_128_SHA = { 0xC0, 0x07 } +-define(TLS_ECDHE_ECDSA_WITH_RC4_128_SHA, <<?BYTE(16#C0), ?BYTE(16#07)>>). + +%% TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA = { 0xC0, 0x08 } +-define(TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#08)>>). + +%% TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA = { 0xC0, 0x09 } +-define(TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#09)>>). + +%% TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA = { 0xC0, 0x0A } +-define(TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#0A)>>). + +%% ECDH_RSA + +%% TLS_ECDH_RSA_WITH_NULL_SHA = { 0xC0, 0x0B } +-define(TLS_ECDH_RSA_WITH_NULL_SHA, <<?BYTE(16#C0), ?BYTE(16#0B)>>). + +%% TLS_ECDH_RSA_WITH_RC4_128_SHA = { 0xC0, 0x0C } +-define(TLS_ECDH_RSA_WITH_RC4_128_SHA, <<?BYTE(16#C0), ?BYTE(16#0C)>>). + +%% TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA = { 0xC0, 0x0D } +-define(TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#0D)>>). + +%% TLS_ECDH_RSA_WITH_AES_128_CBC_SHA = { 0xC0, 0x0E } +-define(TLS_ECDH_RSA_WITH_AES_128_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#0E)>>). + +%% TLS_ECDH_RSA_WITH_AES_256_CBC_SHA = { 0xC0, 0x0F } +-define(TLS_ECDH_RSA_WITH_AES_256_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#0F)>>). + +%% ECDHE_RSA + +%% TLS_ECDHE_RSA_WITH_NULL_SHA = { 0xC0, 0x10 } +-define(TLS_ECDHE_RSA_WITH_NULL_SHA, <<?BYTE(16#C0), ?BYTE(16#10)>>). + +%% TLS_ECDHE_RSA_WITH_RC4_128_SHA = { 0xC0, 0x11 } +-define(TLS_ECDHE_RSA_WITH_RC4_128_SHA, <<?BYTE(16#C0), ?BYTE(16#11)>>). + +%% TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA = { 0xC0, 0x12 } +-define(TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#12)>>). + +%% TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA = { 0xC0, 0x13 } +-define(TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#13)>>). + +%% TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA = { 0xC0, 0x14 } +-define(TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#14)>>). + +%% ECDH_anon + +%% TLS_ECDH_anon_WITH_NULL_SHA = { 0xC0, 0x15 } +-define(TLS_ECDH_anon_WITH_NULL_SHA, <<?BYTE(16#C0), ?BYTE(16#15)>>). + +%% TLS_ECDH_anon_WITH_RC4_128_SHA = { 0xC0, 0x16 } +-define(TLS_ECDH_anon_WITH_RC4_128_SHA, <<?BYTE(16#C0), ?BYTE(16#16)>>). + +%% TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA = { 0xC0, 0x17 } +-define(TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#17)>>). + +%% TLS_ECDH_anon_WITH_AES_128_CBC_SHA = { 0xC0, 0x18 } +-define(TLS_ECDH_anon_WITH_AES_128_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#18)>>). + +%% TLS_ECDH_anon_WITH_AES_256_CBC_SHA = { 0xC0, 0x19 } +-define(TLS_ECDH_anon_WITH_AES_256_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#19)>>). + + +%% RFC 5289 EC TLS suites + +%% TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256 = {0xC0,0x23}; +-define(TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256, <<?BYTE(16#C0), ?BYTE(16#23)>>). + +%% TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 = {0xC0,0x24}; +-define(TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384, <<?BYTE(16#C0), ?BYTE(16#24)>>). + +%% TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256 = {0xC0,0x25}; +-define(TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256, <<?BYTE(16#C0), ?BYTE(16#25)>>). + +%% TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384 = {0xC0,0x26}; +-define(TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384, <<?BYTE(16#C0), ?BYTE(16#26)>>). + +%% TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256 = {0xC0,0x27}; +-define(TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256, <<?BYTE(16#C0), ?BYTE(16#27)>>). + +%% TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384 = {0xC0,0x28}; +-define(TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384, <<?BYTE(16#C0), ?BYTE(16#28)>>). + +%% TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256 = {0xC0,0x29}; +-define(TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256, <<?BYTE(16#C0), ?BYTE(16#29)>>). + +%% TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384 = {0xC0,0x2A}; +-define(TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384, <<?BYTE(16#C0), ?BYTE(16#2A)>>). + %%% Kerberos Cipher Suites %% TLS_KRB5_WITH_DES_CBC_SHA = { 0x00,0x1E }; 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 1fbb88f5f6..eb1a1dbf62 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.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 @@ -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). @@ -28,9 +28,9 @@ -include_lib("public_key/include/public_key.hrl"). --type algo_oid() :: ?'rsaEncryption' | ?'id-dsa'. --type public_key_params() :: #'Dss-Parms'{} | term(). --type public_key_info() :: {algo_oid(), #'RSAPublicKey'{} | integer() , public_key_params()}. +-type oid() :: tuple(). +-type public_key_params() :: #'Dss-Parms'{} | {namedCurve, oid()} | #'ECParameters'{} | term(). +-type public_key_info() :: {oid(), #'RSAPublicKey'{} | integer() | #'ECPoint'{}, public_key_params()}. -type tls_handshake_history() :: {[binary()], [binary()]}. -define(NO_PROTOCOL, <<>>). @@ -91,19 +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 - next_protocol_negotiation = undefined % [binary()] - }). + +%% client_hello defined in tls_handshake.hrl and dtls_handshake.hrl -record(server_hello, { server_version, @@ -113,11 +104,13 @@ compression_method, % compression_method renegotiation_info, 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()] }). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% 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>; @@ -130,6 +123,7 @@ -define(KEY_EXCHANGE_RSA, 0). -define(KEY_EXCHANGE_DIFFIE_HELLMAN, 1). +-define(KEY_EXCHANGE_EC_DIFFIE_HELLMAN, 6). -define(KEY_EXCHANGE_PSK, 2). -define(KEY_EXCHANGE_DHE_PSK, 3). -define(KEY_EXCHANGE_RSA_PSK, 4). @@ -146,6 +140,11 @@ dh_y %% opaque DH_Ys<1..2^16-1> }). +-record(server_ecdh_params, { + curve, + public %% opaque encoded ECpoint + }). + -record(server_psk_params, { hint }). @@ -183,7 +182,7 @@ -record(server_hello_done, {}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%% Certificate request - RFC 4346 section 7.4.4 +%%% Certificate request - RFC 5246 section 7.4.4 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% enum { @@ -195,6 +194,9 @@ -define(DSS_SIGN, 2). -define(RSA_FIXED_DH, 3). -define(DSS_FIXED_DH, 4). +-define(ECDSA_SIGN, 64). +-define(RSA_FIXED_ECDH, 65). +-define(ECDSA_FIXED_ECDH, 66). % opaque DistinguishedName<1..2^16-1>; @@ -231,6 +233,10 @@ dh_public }). +-record(client_ec_diffie_hellman_public, { + dh_public + }). + -record(client_psk_identity, { identity }). @@ -304,6 +310,33 @@ -record(next_protocol, {selected_protocol}). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% ECC Extensions RFC 4492 section 4 and 5 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-define(ELLIPTIC_CURVES_EXT, 10). +-define(EC_POINT_FORMATS_EXT, 11). + +-record(elliptic_curves, { + elliptic_curve_list + }). + +-record(ec_point_formats, { + ec_point_format_list + }). + +-define(ECPOINT_UNCOMPRESSED, 0). +-define(ECPOINT_ANSIX962_COMPRESSED_PRIME, 1). +-define(ECPOINT_ANSIX962_COMPRESSED_CHAR2, 2). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% ECC RFC 4492 Handshake Messages, Section 5 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-define(EXPLICIT_PRIME, 1). +-define(EXPLICIT_CHAR2, 2). +-define(NAMED_CURVE, 3). + -endif. % -ifdef(ssl_handshake). diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 96a1c8e1ce..14db4a6067 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.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 @@ -37,9 +37,9 @@ -type tls_atom_version() :: sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'. -type certdb_ref() :: reference(). -type db_handle() :: term(). --type key_algo() :: null | rsa | dhe_rsa | dhe_dss | dh_anon. +-type key_algo() :: null | rsa | dhe_rsa | dhe_dss | ecdhe_ecdsa| ecdh_ecdsa | ecdh_rsa| srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon. -type der_cert() :: binary(). --type private_key() :: #'RSAPrivateKey'{} | #'DSAPrivateKey'{}. +-type private_key() :: #'RSAPrivateKey'{} | #'DSAPrivateKey'{} | #'ECPrivateKey'{}. -type issuer() :: tuple(). -type serialnumber() :: integer(). -type cert_key() :: {reference(), integer(), issuer()}. diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index aa9da65bb8..1b06e351cf 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -103,8 +103,9 @@ connection_init(Trustedcerts, Role) -> %% Description: Cach a pem file and return its content. %%-------------------------------------------------------------------- cache_pem_file(File, DbHandle) -> + MD5 = crypto:hash(md5, File), MD5 = crypto:md5(File), - case ssl_certificate_db:lookup_cached_pem(DbHandle, MD5) of + 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:md5(File), - case ssl_certificate_db:lookup_cached_pem(PemCache, MD5) of + MD5 = crypto:hash(md5, File), + 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 ff36b5ee26..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"). @@ -100,7 +100,7 @@ add_trusted_certs(_Pid, {der, DerList}, [CerDb, _,_]) -> {ok, NewRef}; add_trusted_certs(_Pid, File, [CertsDb, RefDb, PemChache] = Db) -> - MD5 = crypto:md5(File), + MD5 = crypto:hash(md5, File), case lookup_cached_pem(Db, MD5) of [{_Content, Ref}] -> ref_count(Ref, RefDb, 1), 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/ssl_srp_primes.hrl b/lib/ssl/src/ssl_srp_primes.hrl deleted file mode 100644 index 4bd534efbf..0000000000 --- a/lib/ssl/src/ssl_srp_primes.hrl +++ /dev/null @@ -1 +0,0 @@ --type srp_parameters() :: srp_1024 | srp_1536 | srp_2048 | srp_3072 | srp_4096 | srp_6144 | srp_8192. diff --git a/lib/ssl/src/ssl_ssl3.erl b/lib/ssl/src/ssl_ssl3.erl index a11c5b8c0c..013c27ebb5 100644 --- a/lib/ssl/src/ssl_ssl3.erl +++ b/lib/ssl/src/ssl_ssl3.erl @@ -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 @@ -154,9 +154,9 @@ suites() -> %%-------------------------------------------------------------------- hash(?MD5, Data) -> - crypto:md5(Data); + crypto:hash(md5, Data); hash(?SHA, Data) -> - crypto:sha(Data). + crypto:hash(sha, Data). %%pad_1(?NULL) -> %% ""; @@ -198,6 +198,6 @@ gen(_Secret, _All, Wanted, Len, _C, _N, Acc) when Wanted =< Len -> Block; gen(Secret, All, Wanted, Len, C, N, Acc) -> Prefix = lists:duplicate(N, C), - SHA = crypto:sha([Prefix, All]), - MD5 = crypto:md5([Secret, SHA]), + SHA = crypto:hash(sha, [Prefix, All]), + MD5 = crypto:hash(md5, [Secret, SHA]), gen(Secret, All, Wanted, Len + 16, C+1, N+1, [MD5 | Acc]). diff --git a/lib/ssl/src/ssl_tls1.erl b/lib/ssl/src/ssl_tls1.erl index 41dc1bf0dc..8ab66d0627 100644 --- a/lib/ssl/src/ssl_tls1.erl +++ b/lib/ssl/src/ssl_tls1.erl @@ -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 @@ -29,7 +29,8 @@ -include("ssl_record.hrl"). -export([master_secret/4, finished/5, certificate_verify/3, mac_hash/7, - setup_keys/8, suites/1, prf/5]). + setup_keys/8, suites/1, prf/5, + ecc_curves/1, oid_to_enum/1, enum_to_oid/1]). %%==================================================================== %% Internal application API @@ -57,8 +58,8 @@ finished(Role, Version, PrfAlgo, MasterSecret, Handshake) %% verify_data %% PRF(master_secret, finished_label, MD5(handshake_messages) + %% SHA-1(handshake_messages)) [0..11]; - MD5 = crypto:md5(Handshake), - SHA = crypto:sha(Handshake), + MD5 = crypto:hash(md5, Handshake), + SHA = crypto:hash(sha, Handshake), prf(?MD5SHA, MasterSecret, finished_label(Role), [MD5, SHA], 12); finished(Role, Version, PrfAlgo, MasterSecret, Handshake) @@ -76,8 +77,8 @@ finished(Role, Version, PrfAlgo, MasterSecret, Handshake) -spec certificate_verify(md5sha | sha, integer(), [binary()]) -> binary(). certificate_verify(md5sha, _Version, Handshake) -> - MD5 = crypto:md5(Handshake), - SHA = crypto:sha(Handshake), + MD5 = crypto:hash(md5, Handshake), + SHA = crypto:hash(sha, Handshake), <<MD5/binary, SHA/binary>>; certificate_verify(HashAlgo, _Version, Handshake) -> @@ -183,24 +184,95 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, -spec suites(1|2|3) -> [cipher_suite()]. suites(Minor) when Minor == 1; Minor == 2-> + case sufficent_ec_support() of + true -> + all_suites(Minor); + false -> + no_ec_suites(Minor) + end; + +suites(Minor) when Minor == 3 -> + case sufficent_ec_support() of + true -> + all_suites(3) ++ all_suites(2); + false -> + no_ec_suites(3) ++ no_ec_suites(2) + end. + +all_suites(Minor) when Minor == 1; Minor == 2-> [ + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA, + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA, ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA, ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA, + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA, ?TLS_RSA_WITH_AES_256_CBC_SHA, + + ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_RSA_WITH_3DES_EDE_CBC_SHA, + + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA, + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_AES_128_CBC_SHA, - %%?TLS_RSA_WITH_IDEA_CBC_SHA, + + ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA, + ?TLS_ECDHE_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5, ?TLS_DHE_RSA_WITH_DES_CBC_SHA, + ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA, + ?TLS_ECDH_RSA_WITH_RC4_128_SHA, + ?TLS_RSA_WITH_DES_CBC_SHA - ]; + ]; +all_suites(3) -> + [ + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384, + + ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, + ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, + ?TLS_RSA_WITH_AES_256_CBC_SHA256, + + ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256, + ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256, + ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256, + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256, + + ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, + ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, + ?TLS_RSA_WITH_AES_128_CBC_SHA256 + ]. -suites(Minor) when Minor == 3 -> +no_ec_suites(Minor) when Minor == 1; Minor == 2-> + [ + ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA, + ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, + ?TLS_RSA_WITH_AES_256_CBC_SHA, + ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, + ?TLS_RSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, + ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, + ?TLS_RSA_WITH_AES_128_CBC_SHA, + ?TLS_RSA_WITH_RC4_128_SHA, + ?TLS_RSA_WITH_RC4_128_MD5, + ?TLS_DHE_RSA_WITH_DES_CBC_SHA, + ?TLS_RSA_WITH_DES_CBC_SHA + ]; +no_ec_suites(3) -> [ ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, @@ -208,9 +280,7 @@ suites(Minor) when Minor == 3 -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, ?TLS_RSA_WITH_AES_128_CBC_SHA256 - %% ?TLS_DH_anon_WITH_AES_128_CBC_SHA256, - %% ?TLS_DH_anon_WITH_AES_256_CBC_SHA256 - ] ++ suites(2). + ]. %%-------------------------------------------------------------------- %%% Internal functions @@ -218,16 +288,8 @@ suites(Minor) when Minor == 3 -> %%%% HMAC and the Pseudorandom Functions RFC 2246 & 4346 - 5.%%%% hmac_hash(?NULL, _, _) -> <<>>; -hmac_hash(?MD5, Key, Value) -> - crypto:md5_mac(Key, Value); -hmac_hash(?SHA, Key, Value) -> - crypto:sha_mac(Key, Value); -hmac_hash(?SHA256, Key, Value) -> - crypto:sha256_mac(Key, Value); -hmac_hash(?SHA384, Key, Value) -> - crypto:sha384_mac(Key, Value); -hmac_hash(?SHA512, Key, Value) -> - crypto:sha512_mac(Key, Value). +hmac_hash(Alg, Key, Value) -> + crypto:hmac(mac_algo(Alg), Key, Value). mac_algo(?MD5) -> md5; mac_algo(?SHA) -> sha; @@ -303,3 +365,68 @@ finished_label(client) -> <<"client finished">>; finished_label(server) -> <<"server finished">>. + +%% list ECC curves in prefered order +ecc_curves(_Minor) -> + [?sect571r1,?sect571k1,?secp521r1,?sect409k1,?sect409r1, + ?secp384r1,?sect283k1,?sect283r1,?secp256k1,?secp256r1, + ?sect239k1,?sect233k1,?sect233r1,?secp224k1,?secp224r1, + ?sect193r1,?sect193r2,?secp192k1,?secp192r1,?sect163k1, + ?sect163r1,?sect163r2,?secp160k1,?secp160r1,?secp160r2]. + +%% ECC curves from draft-ietf-tls-ecc-12.txt (Oct. 17, 2005) +oid_to_enum(?sect163k1) -> 1; +oid_to_enum(?sect163r1) -> 2; +oid_to_enum(?sect163r2) -> 3; +oid_to_enum(?sect193r1) -> 4; +oid_to_enum(?sect193r2) -> 5; +oid_to_enum(?sect233k1) -> 6; +oid_to_enum(?sect233r1) -> 7; +oid_to_enum(?sect239k1) -> 8; +oid_to_enum(?sect283k1) -> 9; +oid_to_enum(?sect283r1) -> 10; +oid_to_enum(?sect409k1) -> 11; +oid_to_enum(?sect409r1) -> 12; +oid_to_enum(?sect571k1) -> 13; +oid_to_enum(?sect571r1) -> 14; +oid_to_enum(?secp160k1) -> 15; +oid_to_enum(?secp160r1) -> 16; +oid_to_enum(?secp160r2) -> 17; +oid_to_enum(?secp192k1) -> 18; +oid_to_enum(?secp192r1) -> 19; +oid_to_enum(?secp224k1) -> 20; +oid_to_enum(?secp224r1) -> 21; +oid_to_enum(?secp256k1) -> 22; +oid_to_enum(?secp256r1) -> 23; +oid_to_enum(?secp384r1) -> 24; +oid_to_enum(?secp521r1) -> 25. + +enum_to_oid(1) -> ?sect163k1; +enum_to_oid(2) -> ?sect163r1; +enum_to_oid(3) -> ?sect163r2; +enum_to_oid(4) -> ?sect193r1; +enum_to_oid(5) -> ?sect193r2; +enum_to_oid(6) -> ?sect233k1; +enum_to_oid(7) -> ?sect233r1; +enum_to_oid(8) -> ?sect239k1; +enum_to_oid(9) -> ?sect283k1; +enum_to_oid(10) -> ?sect283r1; +enum_to_oid(11) -> ?sect409k1; +enum_to_oid(12) -> ?sect409r1; +enum_to_oid(13) -> ?sect571k1; +enum_to_oid(14) -> ?sect571r1; +enum_to_oid(15) -> ?secp160k1; +enum_to_oid(16) -> ?secp160r1; +enum_to_oid(17) -> ?secp160r2; +enum_to_oid(18) -> ?secp192k1; +enum_to_oid(19) -> ?secp192r1; +enum_to_oid(20) -> ?secp224k1; +enum_to_oid(21) -> ?secp224r1; +enum_to_oid(22) -> ?secp256k1; +enum_to_oid(23) -> ?secp256r1; +enum_to_oid(24) -> ?secp384r1; +enum_to_oid(25) -> ?secp521r1. + +sufficent_ec_support() -> + CryptoSupport = crypto:supports(), + proplists:get_bool(ecdh, proplists:get_value(public_keys, CryptoSupport)). 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 fa64915fd0..6a0461e805 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -25,17 +25,16 @@ %% 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"). --include("ssl_srp_primes.hrl"). -include_lib("public_key/include/public_key.hrl"). %% Internal application API @@ -71,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() @@ -98,7 +97,8 @@ terminated = false, % allow_renegotiate = true, expecting_next_protocol_negotiation = false :: boolean(), - next_protocol = undefined :: undefined | binary() + next_protocol = undefined :: undefined | binary(), + client_ecc % {Curves, PointFmt} }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, @@ -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,13 +414,16 @@ 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} -> - do_server_hello(Type, ProtocolsToAdvertise, State#state{connection_states = - ConnectionStates, - negotiated_version = Version, - session = Session}); + {Version, {Type, Session}, ConnectionStates, ProtocolsToAdvertise, + EcPointFormats, EllipticCurves} -> + do_server_hello(Type, ProtocolsToAdvertise, + EcPointFormats, EllipticCurves, + State#state{connection_states = ConnectionStates, + negotiated_version = Version, + session = Session, + client_ecc = {EllipticCurves, EcPointFormats}}); #alert{} = Alert -> handle_own_alert(Alert, ClientVersion, hello, State) end; @@ -445,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 -> @@ -461,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, @@ -520,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} -> @@ -533,7 +536,9 @@ certify(#certificate{} = Cert, certify(#server_key_exchange{} = KeyExchangeMsg, #state{role = client, negotiated_version = Version, key_algorithm = Alg} = State0) - when Alg == dhe_dss; Alg == dhe_rsa; Alg == dh_anon; + when Alg == dhe_dss; Alg == dhe_rsa; + Alg == ecdhe_rsa; Alg == ecdhe_ecdsa; + Alg == dh_anon; Alg == ecdh_anon; Alg == psk; Alg == dhe_psk; Alg == rsa_psk; Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon -> case handle_server_key(KeyExchangeMsg, State0) of @@ -598,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}, @@ -614,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}, @@ -635,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) @@ -653,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}, @@ -669,9 +674,20 @@ certify_client_key_exchange(#encrypted_premaster_secret{premaster_secret= EncPMS certify_client_key_exchange(#client_diffie_hellman_public{dh_public = ClientPublicDhKey}, #state{negotiated_version = Version, diffie_hellman_params = #'DHParameter'{prime = P, - base = G}, + base = G} = Params, diffie_hellman_keys = {_, ServerDhPrivateKey}} = State0) -> - case dh_master_secret(crypto:mpint(P), crypto:mpint(G), ClientPublicDhKey, ServerDhPrivateKey, State0) of + case dh_master_secret(Params, ClientPublicDhKey, ServerDhPrivateKey, State0) of + #state{} = State1 -> + {Record, State} = next_record(State1), + next_state(certify, cipher, Record, State); + #alert{} = Alert -> + handle_own_alert(Alert, Version, certify, State0) + end; + +certify_client_key_exchange(#client_ec_diffie_hellman_public{dh_public = ClientPublicEcDhPoint}, + #state{negotiated_version = Version, + diffie_hellman_keys = ECDHKey} = State0) -> + case ec_dh_master_secret(ECDHKey, #'ECPoint'{point = ClientPublicEcDhPoint}, State0) of #state{} = State1 -> {Record, State} = next_record(State1), next_state(certify, cipher, Record, State); @@ -696,7 +712,7 @@ certify_client_key_exchange(#client_dhe_psk_identity{ diffie_hellman_params = #'DHParameter'{prime = P, base = G}, diffie_hellman_keys = {_, ServerDhPrivateKey}} = State0) -> - case dhe_psk_master_secret(ClientPSKIdentity, crypto:mpint(P), crypto:mpint(G), ClientPublicDhKey, ServerDhPrivateKey, State0) of + case dhe_psk_master_secret(ClientPSKIdentity, P, G, ClientPublicDhKey, ServerDhPrivateKey, State0) of #state{} = State1 -> {Record, State} = next_record(State1), next_state(certify, cipher, Record, State); @@ -710,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), @@ -753,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), @@ -776,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 @@ -814,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} = @@ -1009,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, @@ -1024,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} @@ -1035,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)}; @@ -1278,6 +1294,7 @@ init_private_key(DbHandle, undefined, KeyFile, Password, _) -> [PemEntry] = [PemEntry || PemEntry = {PKey, _ , _} <- List, PKey =:= 'RSAPrivateKey' orelse PKey =:= 'DSAPrivateKey' orelse + PKey =:= 'ECPrivateKey' orelse PKey =:= 'PrivateKeyInfo' ], private_key(public_key:pem_entry_decode(PemEntry, Password)) @@ -1291,6 +1308,8 @@ init_private_key(_,{rsa, PrivateKey}, _, _,_) -> init_private_key('RSAPrivateKey', PrivateKey); init_private_key(_,{dsa, PrivateKey},_,_,_) -> init_private_key('DSAPrivateKey', PrivateKey); +init_private_key(_,{ec, PrivateKey},_,_,_) -> + init_private_key('ECPrivateKey', PrivateKey); init_private_key(_,{Asn1Type, PrivateKey},_,_,_) -> private_key(init_private_key(Asn1Type, PrivateKey)). @@ -1306,6 +1325,7 @@ private_key(#'PrivateKeyInfo'{privateKeyAlgorithm = #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?'id-dsa'}, privateKey = Key}) -> public_key:der_decode('DSAPrivateKey', iolist_to_binary(Key)); + private_key(Key) -> Key. @@ -1357,7 +1377,15 @@ handle_peer_cert(PeerCert, PublicKeyInfo, State1 = State0#state{session = Session#session{peer_certificate = PeerCert}, public_key_info = PublicKeyInfo}, - {Record, State} = next_record(State1), + State2 = case PublicKeyInfo of + {?'id-ecPublicKey', #'ECPoint'{point = _ECPoint} = PublicKey, PublicKeyParams} -> + ECDHKey = public_key:generate_key(PublicKeyParams), + State3 = State1#state{diffie_hellman_keys = ECDHKey}, + ec_dh_master_secret(ECDHKey, PublicKey, State3); + + _ -> State1 + end, + {Record, State} = next_record(State2), next_state(certify, certify, Record, State). certify_client(#state{client_certificate_requested = true, role = client, @@ -1369,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), @@ -1390,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} = @@ -1407,15 +1435,18 @@ verify_client_cert(#state{client_certificate_requested = true, role = client, verify_client_cert(#state{client_certificate_requested = false} = State) -> State. -do_server_hello(Type, NextProtocolsToSend, #state{negotiated_version = Version, - session = #session{session_id = SessId}, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _}} +do_server_hello(Type, NextProtocolsToSend, + EcPointFormats, EllipticCurves, + #state{negotiated_version = Version, + session = #session{session_id = SessId}, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}} = State0) when is_atom(Type) -> ServerHello = - ssl_handshake:server_hello(SessId, Version, - ConnectionStates0, Renegotiation, NextProtocolsToSend), + tls_handshake:server_hello(SessId, Version, + ConnectionStates0, Renegotiation, + NextProtocolsToSend, EcPointFormats, EllipticCurves), State = server_hello(ServerHello, State0#state{expecting_next_protocol_negotiation = NextProtocolsToSend =/= undefined}), @@ -1449,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, @@ -1478,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} = @@ -1538,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), @@ -1547,7 +1578,7 @@ server_hello_done(#state{transport_cb = Transport, tls_handshake_history = Handshake}. certify_server(#state{key_algorithm = Algo} = State) - when Algo == dh_anon; Algo == psk; Algo == dhe_psk; Algo == srp_anon -> + when Algo == dh_anon; Algo == ecdh_anon; Algo == psk; Algo == dhe_psk; Algo == srp_anon -> State; certify_server(#state{transport_cb = Transport, @@ -1558,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), @@ -1574,7 +1605,7 @@ key_exchange(#state{role = server, key_algorithm = rsa} = State) -> State; key_exchange(#state{role = server, key_algorithm = Algo, hashsign_algorithm = HashSignAlgo, - diffie_hellman_params = #'DHParameter'{prime = P, base = G} = Params, + diffie_hellman_params = #'DHParameter'{} = Params, private_key = PrivateKey, connection_states = ConnectionStates0, negotiated_version = Version, @@ -1585,13 +1616,13 @@ key_exchange(#state{role = server, key_algorithm = Algo, when Algo == dhe_dss; Algo == dhe_rsa; Algo == dh_anon -> - Keys = crypto:dh_generate_key([crypto:mpint(P), crypto:mpint(G)]), + 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, Keys, Params, + Msg = tls_handshake:key_exchange(server, Version, {dh, DHKeys, Params, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1599,9 +1630,41 @@ key_exchange(#state{role = server, key_algorithm = Algo, encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), State#state{connection_states = ConnectionStates, - diffie_hellman_keys = Keys, + diffie_hellman_keys = DHKeys, tls_handshake_history = Handshake}; +key_exchange(#state{role = server, private_key = Key, key_algorithm = Algo} = State) + when Algo == ecdh_ecdsa; Algo == ecdh_rsa -> + State#state{diffie_hellman_keys = Key}; +key_exchange(#state{role = server, key_algorithm = Algo, + hashsign_algorithm = HashSignAlgo, + private_key = PrivateKey, + connection_states = ConnectionStates0, + negotiated_version = Version, + tls_handshake_history = Handshake0, + socket = Socket, + transport_cb = Transport + } = State) + when Algo == ecdhe_ecdsa; Algo == ecdhe_rsa; + Algo == ecdh_anon -> + + ECDHKeys = public_key:generate_key(select_curve(State)), + ConnectionState = + tls_record:pending_connection_state(ConnectionStates0, read), + SecParams = ConnectionState#connection_state.security_parameters, + #security_parameters{client_random = ClientRandom, + server_random = ServerRandom} = SecParams, + Msg = tls_handshake:key_exchange(server, Version, {ecdh, ECDHKeys, + HashSignAlgo, ClientRandom, + ServerRandom, + PrivateKey}), + {BinMsg, ConnectionStates, Handshake1} = + encode_handshake(Msg, Version, ConnectionStates0, Handshake0), + Transport:send(Socket, BinMsg), + State#state{connection_states = ConnectionStates, + diffie_hellman_keys = ECDHKeys, + tls_handshake_history = Handshake1}; + key_exchange(#state{role = server, key_algorithm = psk, ssl_options = #ssl_options{psk_identity = undefined}} = State) -> State; @@ -1616,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), @@ -1633,7 +1696,7 @@ key_exchange(#state{role = server, key_algorithm = psk, key_exchange(#state{role = server, key_algorithm = dhe_psk, ssl_options = #ssl_options{psk_identity = PskIdentityHint}, hashsign_algorithm = HashSignAlgo, - diffie_hellman_params = #'DHParameter'{prime = P, base = G} = Params, + diffie_hellman_params = #'DHParameter'{} = Params, private_key = PrivateKey, connection_states = ConnectionStates0, negotiated_version = Version, @@ -1641,13 +1704,13 @@ key_exchange(#state{role = server, key_algorithm = dhe_psk, socket = Socket, transport_cb = Transport } = State) -> - Keys = crypto:dh_generate_key([crypto:mpint(P), crypto:mpint(G)]), + 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, Keys, Params, + Msg = tls_handshake:key_exchange(server, Version, {dhe_psk, PskIdentityHint, DHKeys, Params, HashSignAlgo, ClientRandom, ServerRandom, PrivateKey}), @@ -1655,7 +1718,7 @@ key_exchange(#state{role = server, key_algorithm = dhe_psk, encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), State#state{connection_states = ConnectionStates, - diffie_hellman_keys = Keys, + diffie_hellman_keys = DHKeys, tls_handshake_history = Handshake}; key_exchange(#state{role = server, key_algorithm = rsa_psk, @@ -1672,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}), @@ -1708,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}), @@ -1748,7 +1811,24 @@ 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), + State#state{connection_states = ConnectionStates, + tls_handshake_history = Handshake}; + +key_exchange(#state{role = client, + connection_states = ConnectionStates0, + key_algorithm = Algorithm, + negotiated_version = Version, + diffie_hellman_keys = Keys, + socket = Socket, transport_cb = Transport, + tls_handshake_history = Handshake0} = State) + when Algorithm == ecdhe_ecdsa; Algorithm == ecdhe_rsa; + Algorithm == ecdh_ecdsa; Algorithm == ecdh_rsa; + Algorithm == ecdh_anon -> + Msg = tls_handshake:key_exchange(client, Version, {ecdh, Keys}), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Msg, Version, ConnectionStates0, Handshake0), Transport:send(Socket, BinMsg), @@ -1762,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), @@ -1777,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), @@ -1810,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), @@ -1827,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(_, _, _) -> @@ -1843,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(_, _, _, _) -> @@ -1857,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), @@ -1872,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}, @@ -1890,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, @@ -1912,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), @@ -1922,21 +2002,21 @@ 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 - {_, anon} -> + {_, SignAlgo} when SignAlgo == anon; SignAlgo == ecdh_anon -> server_master_secret(Params#server_key_params.params, State); _ -> verify_server_key(Params, HashSign, State) @@ -1950,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 -> @@ -1969,6 +2049,11 @@ server_master_secret(#server_dh_params{dh_p = P, dh_g = G, dh_y = ServerPublicDh State) -> dh_master_secret(P, G, ServerPublicDhKey, undefined, State); +server_master_secret(#server_ecdh_params{curve = ECCurve, public = ECServerPubKey}, + State) -> + ECDHKeys = public_key:generate_key(ECCurve), + ec_dh_master_secret(ECDHKeys, #'ECPoint'{point = ECServerPubKey}, State#state{diffie_hellman_keys = ECDHKeys}); + server_master_secret(#server_psk_params{ hint = IdentityHint}, State) -> @@ -1989,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{ @@ -2000,17 +2085,23 @@ master_from_premaster_secret(PremasterSecret, Alert end. +dh_master_secret(#'DHParameter'{} = Params, OtherPublicDhKey, MyPrivateKey, State) -> + PremasterSecret = + public_key:compute_key(OtherPublicDhKey, MyPrivateKey, Params), + master_from_premaster_secret(PremasterSecret, State). + dh_master_secret(Prime, Base, PublicDhKey, undefined, State) -> - PMpint = mpint_binary(Prime), - GMpint = mpint_binary(Base), - Keys = {_, PrivateDhKey} = - crypto:dh_generate_key([PMpint,GMpint]), - dh_master_secret(PMpint, GMpint, PublicDhKey, PrivateDhKey, State#state{diffie_hellman_keys = Keys}); + Keys = {_, PrivateDhKey} = crypto:generate_key(dh, [Prime, Base]), + dh_master_secret(Prime, Base, PublicDhKey, PrivateDhKey, State#state{diffie_hellman_keys = Keys}); + +dh_master_secret(Prime, Base, PublicDhKey, PrivateDhKey, State) -> + PremasterSecret = + crypto:compute_key(dh, PublicDhKey, PrivateDhKey, [Prime, Base]), + master_from_premaster_secret(PremasterSecret, State). -dh_master_secret(PMpint, GMpint, PublicDhKey, PrivateDhKey, State) -> +ec_dh_master_secret(ECDHKeys, ECPoint, State) -> PremasterSecret = - crypto:dh_compute_key(mpint_binary(PublicDhKey), PrivateDhKey, - [PMpint, GMpint]), + public_key:compute_key(ECPoint, ECDHKeys), master_from_premaster_secret(PremasterSecret, State). handle_psk_identity(_PSKIdentity, LookupFun) @@ -2033,20 +2124,18 @@ server_psk_master_secret(ClientPSKIdentity, end. dhe_psk_master_secret(PSKIdentity, Prime, Base, PublicDhKey, undefined, State) -> - PMpint = mpint_binary(Prime), - GMpint = mpint_binary(Base), Keys = {_, PrivateDhKey} = - crypto:dh_generate_key([PMpint,GMpint]), - dhe_psk_master_secret(PSKIdentity, PMpint, GMpint, PublicDhKey, PrivateDhKey, + crypto:generate_key(dh, [Prime, Base]), + dhe_psk_master_secret(PSKIdentity, Prime, Base, PublicDhKey, PrivateDhKey, State#state{diffie_hellman_keys = Keys}); -dhe_psk_master_secret(PSKIdentity, PMpint, GMpint, PublicDhKey, PrivateDhKey, +dhe_psk_master_secret(PSKIdentity, Prime, Base, PublicDhKey, PrivateDhKey, #state{ssl_options = SslOpts} = State) -> case handle_psk_identity(PSKIdentity, SslOpts#ssl_options.user_lookup_fun) of {ok, PSK} when is_binary(PSK) -> DHSecret = - crypto:dh_compute_key(mpint_binary(PublicDhKey), PrivateDhKey, - [PMpint, GMpint]), + crypto:compute_key(dh, PublicDhKey, PrivateDhKey, + [Prime, Base]), DHLen = erlang:byte_size(DHSecret), Len = erlang:byte_size(PSK), PremasterSecret = <<?UINT16(DHLen), DHSecret/binary, ?UINT16(Len), PSK/binary>>, @@ -2075,7 +2164,7 @@ generate_srp_server_keys(_SrpParams, 10) -> generate_srp_server_keys(SrpParams = #srp_user{generator = Generator, prime = Prime, verifier = Verifier}, N) -> - case crypto:srp_generate_key(Verifier, Generator, Prime, '6a') of + case crypto:generate_key(srp, {host, [Verifier, Generator, Prime, '6a']}) of error -> generate_srp_server_keys(SrpParams, N+1); Keys -> @@ -2086,7 +2175,7 @@ generate_srp_client_keys(_Generator, _Prime, 10) -> ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); generate_srp_client_keys(Generator, Prime, N) -> - case crypto:srp_generate_key(Generator, Prime, '6a') of + case crypto:generate_key(srp, {user, [Generator, Prime, '6a']}) of error -> generate_srp_client_keys(Generator, Prime, N+1); Keys -> @@ -2098,7 +2187,7 @@ handle_srp_identity(Username, {Fun, UserState}) -> {ok, {SRPParams, Salt, DerivedKey}} when is_atom(SRPParams), is_binary(Salt), is_binary(DerivedKey) -> {Generator, Prime} = ssl_srp_primes:get_srp_params(SRPParams), - Verifier = crypto:mod_exp_prime(Generator, DerivedKey, Prime), + Verifier = crypto:mod_pow(Generator, DerivedKey, Prime), #srp_user{generator = Generator, prime = Prime, salt = Salt, verifier = Verifier}; #alert{} = Alert -> @@ -2107,8 +2196,8 @@ handle_srp_identity(Username, {Fun, UserState}) -> throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER)) end. -server_srp_master_secret(Verifier, Prime, ClientPub, State = #state{srp_keys = {ServerPub, ServerPriv}}) -> - case crypto:srp_compute_key(Verifier, Prime, ClientPub, ServerPub, ServerPriv, '6a') of +server_srp_master_secret(Verifier, Prime, ClientPub, State = #state{srp_keys = ServerKeys}) -> + case crypto:compute_key(srp, ClientPub, ServerKeys, {host, [Verifier, Prime, '6a']}) of error -> ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); PremasterSecret -> @@ -2121,14 +2210,13 @@ client_srp_master_secret(Generator, Prime, Salt, ServerPub, undefined, State) -> Keys = generate_srp_client_keys(Generator, Prime, 0), client_srp_master_secret(Generator, Prime, Salt, ServerPub, Keys, State#state{srp_keys = Keys}); -client_srp_master_secret(Generator, Prime, Salt, ServerPub, {ClientPub, ClientPriv}, - #state{ssl_options = SslOpts} = State) -> +client_srp_master_secret(Generator, Prime, Salt, ServerPub, ClientKeys, + #state{ssl_options = SslOpts} = State) -> case ssl_srp_primes:check_srp_params(Generator, Prime) of ok -> {Username, Password} = SslOpts#ssl_options.srp_identity, - DerivedKey = crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])]), - - case crypto:srp_compute_key(DerivedKey, Prime, Generator, ClientPub, ClientPriv, ServerPub, '6a') of + DerivedKey = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, Password])]), + case crypto:compute_key(srp, ServerPub, ClientKeys, {user, [DerivedKey, Prime, Generator, '6a']}) of error -> ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); PremasterSecret -> @@ -2139,12 +2227,12 @@ client_srp_master_secret(Generator, Prime, Salt, ServerPub, {ClientPub, ClientPr 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), @@ -2154,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}) -> @@ -2258,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)} @@ -2426,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}) -> @@ -2435,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 -> @@ -2463,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) -> @@ -2473,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, @@ -2488,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 -> @@ -2515,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, @@ -2534,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}, @@ -2560,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) -> @@ -2798,11 +2886,6 @@ make_premaster_secret({MajVer, MinVer}, rsa) -> make_premaster_secret(_, _) -> undefined. -mpint_binary(Binary) -> - Size = erlang:byte_size(Binary), - <<?UINT32(Size), Binary/binary>>. - - ack_connection(#state{renegotiation = {true, Initiater}} = State) when Initiater == internal; Initiater == peer -> @@ -2822,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, @@ -2893,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); _ -> @@ -2908,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) -> @@ -2938,21 +3021,29 @@ default_hashsign(_Version = {Major, Minor}, KeyExchange) (KeyExchange == rsa orelse KeyExchange == dhe_rsa orelse KeyExchange == dh_rsa orelse + KeyExchange == ecdhe_rsa orelse KeyExchange == srp_rsa) -> {sha, rsa}; default_hashsign(_Version, KeyExchange) when KeyExchange == rsa; KeyExchange == dhe_rsa; KeyExchange == dh_rsa; + KeyExchange == ecdhe_rsa; KeyExchange == srp_rsa -> {md5sha, rsa}; default_hashsign(_Version, KeyExchange) + when KeyExchange == ecdhe_ecdsa; + KeyExchange == ecdh_ecdsa; + KeyExchange == ecdh_rsa -> + {sha, ecdsa}; +default_hashsign(_Version, KeyExchange) when KeyExchange == dhe_dss; KeyExchange == dh_dss; KeyExchange == srp_dss -> {sha, dsa}; default_hashsign(_Version, KeyExchange) when KeyExchange == dh_anon; + KeyExchange == ecdh_anon; KeyExchange == psk; KeyExchange == dhe_psk; KeyExchange == rsa_psk; @@ -2987,3 +3078,8 @@ handle_close_alert(Data, StateName, State0) -> _ -> ok end. + +select_curve(#state{client_ecc = {[Curve|_], _}}) -> + {namedCurve, Curve}; +select_curve(_) -> + {namedCurve, ?secp256k1}. diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/tls_handshake.erl index 83c0092de2..fea75736f7 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -21,17 +21,17 @@ %% 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"). -include("ssl_srp.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([master_secret/4, client_hello/8, server_hello/5, hello/4, +-export([master_secret/4, client_hello/8, server_hello/7, hello/4, hello_request/0, certify/7, certificate/4, client_certificate_verify/6, certificate_verify/6, verify_signature/5, certificate_request/3, key_exchange/3, server_key_exchange_hash/2, @@ -47,6 +47,8 @@ #client_key_exchange{} | #finished{} | #certificate_verify{} | #hello_request{} | #next_protocol{}. +-define(NAMED_CURVE_TYPE, 3). + %%==================================================================== %% Internal application API %%==================================================================== @@ -62,24 +64,27 @@ 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), + {EcPointFormats, EllipticCurves} = default_ecc_extensions(Version), Id = ssl_session:client_id({Host, Port, SslOpts}, Cache, CacheCb, OwnCert), #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 = renegotiation_info(client, ConnectionStates, Renegotiation), srp = SRP, hash_signs = default_hash_signs(), + ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves, next_protocol_negotiation = encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, Renegotiation) }. @@ -96,12 +101,15 @@ encode_protocols_advertised_on_server(Protocols) -> %%-------------------------------------------------------------------- -spec server_hello(session_id(), tls_version(), #connection_states{}, - boolean(), [binary()] | undefined) -> #server_hello{}. + boolean(), [binary()] | undefined, + #ec_point_formats{} | undefined, + #elliptic_curves{} | undefined) -> #server_hello{}. %% %% Description: Creates a server hello message. %%-------------------------------------------------------------------- -server_hello(SessionId, Version, ConnectionStates, Renegotiation, ProtocolsAdvertisedOnServer) -> - Pending = ssl_record:pending_connection_state(ConnectionStates, read), +server_hello(SessionId, Version, ConnectionStates, Renegotiation, + ProtocolsAdvertisedOnServer, EcPointFormats, EllipticCurves) -> + 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, @@ -111,6 +119,8 @@ server_hello(SessionId, Version, ConnectionStates, Renegotiation, ProtocolsAdver session_id = SessionId, renegotiation_info = renegotiation_info(server, ConnectionStates, Renegotiation), + ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves, next_protocol_negotiation = encode_protocols_advertised_on_server(ProtocolsAdvertisedOnServer) }. @@ -129,7 +139,8 @@ hello_request() -> atom(), #connection_states{}, binary()}, boolean()) -> {tls_version(), session_id(), #connection_states{}, binary() | undefined}| - {tls_version(), {resumed | new, #session{}}, #connection_states{}, list(binary()) | undefined} | + {tls_version(), {resumed | new, #session{}}, #connection_states{}, [binary()] | undefined, + [oid()] | undefined, [oid()] | undefined} | #alert{}. %% %% Description: Handles a recieved hello message @@ -142,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 @@ -163,44 +174,27 @@ hello(#server_hello{cipher_suite = CipherSuite, server_version = Version, ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) end; -hello(#client_hello{client_version = ClientVersion, random = Random, - cipher_suites = CipherSuites, - renegotiation_info = Info, - srp = SRP} = Hello, - #ssl_options{versions = Versions, - secure_renegotiate = SecureRenegotation} = SslOpts, +hello(#client_hello{client_version = ClientVersion} = Hello, + #ssl_options{versions = Versions} = SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) -> -%% TODO: select hash and signature algorithm + %% 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 -> - {Type, #session{cipher_suite = CipherSuite, - compression_method = Compression} = Session1} + %% 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 + {Type, #session{cipher_suite = CipherSuite} = Session1} = select_session(Hello, Port, Session0, Version, SslOpts, Cache, CacheCb, Cert), case CipherSuite of no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); _ -> - Session = handle_srp_info(SRP, Session1), - case handle_renegotiation_info(server, Info, ConnectionStates0, - Renegotiation, SecureRenegotation, - CipherSuites) of - {ok, ConnectionStates1} -> - ConnectionStates = - hello_pending_connection_states(server, - Version, - CipherSuite, - Random, - Compression, - ConnectionStates1), - case handle_next_protocol_on_server(Hello, Renegotiation, SslOpts) of - #alert{} = Alert -> - Alert; - ProtocolsToAdvertise -> - {Version, {Type, Session}, ConnectionStates, ProtocolsToAdvertise} - end; - #alert{} = Alert -> + try handle_hello_extensions(Hello, Version, SslOpts, Session1, ConnectionStates0, Renegotiation) of + {Session, ConnectionStates, ProtocolsToAdvertise, ECPointFormats, EllipticCurves} -> + {Version, {Type, Session}, ConnectionStates, + ProtocolsToAdvertise, ECPointFormats, EllipticCurves} + catch throw:Alert -> Alert end end; @@ -350,9 +344,10 @@ verify_signature(_Version, Hash, _HashAlgo, Signature, {?rsaEncryption, PubKey, _ -> false end; verify_signature(_Version, Hash, {HashAlgo, dsa}, Signature, {?'id-dsa', PublicKey, PublicKeyParams}) -> + public_key:verify({digest, Hash}, HashAlgo, Signature, {PublicKey, PublicKeyParams}); +verify_signature(_Version, Hash, {HashAlgo, ecdsa}, Signature, {?'id-ecPublicKey', PublicKey, PublicKeyParams}) -> public_key:verify({digest, Hash}, HashAlgo, Signature, {PublicKey, PublicKeyParams}). - %%-------------------------------------------------------------------- -spec certificate_request(#connection_states{}, db_handle(), certdb_ref()) -> #certificate_request{}. @@ -362,7 +357,7 @@ verify_signature(_Version, Hash, {HashAlgo, dsa}, Signature, {?'id-dsa', PublicK 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), @@ -378,6 +373,7 @@ certificate_request(ConnectionStates, CertDbHandle, CertDbRef) -> {dh, binary()} | {dh, {binary(), binary()}, #'DHParameter'{}, {HashAlgo::atom(), SignAlgo::atom()}, binary(), binary(), private_key()} | + {ecdh, #'ECPrivateKey'{}} | {psk, binary()} | {dhe_psk, binary(), binary()} | {srp, {binary(), binary()}, #srp_user{}, {HashAlgo::atom(), SignAlgo::atom()}, @@ -391,19 +387,25 @@ key_exchange(client, _Version, {premaster_secret, Secret, {_, PublicKey, _}}) -> encrypted_premaster_secret(Secret, PublicKey), #client_key_exchange{exchange_keys = EncPremasterSecret}; -key_exchange(client, _Version, {dh, <<?UINT32(Len), PublicKey:Len/binary>>}) -> +key_exchange(client, _Version, {dh, PublicKey}) -> #client_key_exchange{ exchange_keys = #client_diffie_hellman_public{ dh_public = PublicKey} }; +key_exchange(client, _Version, {ecdh, #'ECPrivateKey'{publicKey = {0, ECPublicKey}}}) -> + #client_key_exchange{ + exchange_keys = #client_ec_diffie_hellman_public{ + dh_public = ECPublicKey} + }; + key_exchange(client, _Version, {psk, Identity}) -> #client_key_exchange{ exchange_keys = #client_psk_identity{ identity = Identity} }; -key_exchange(client, _Version, {dhe_psk, Identity, <<?UINT32(Len), PublicKey:Len/binary>>}) -> +key_exchange(client, _Version, {dhe_psk, Identity, PublicKey}) -> #client_key_exchange{ exchange_keys = #client_dhe_psk_identity{ identity = Identity, @@ -415,7 +417,7 @@ key_exchange(client, _Version, {psk_premaster_secret, PskIdentity, Secret, {_, P encrypted_premaster_secret(Secret, PublicKey), #client_key_exchange{ exchange_keys = #client_rsa_psk_identity{ - identity = PskIdentity, + identity = PskIdentity, exchange_keys = EncPremasterSecret}}; key_exchange(client, _Version, {srp, PublicKey}) -> @@ -424,31 +426,34 @@ key_exchange(client, _Version, {srp, PublicKey}) -> srp_a = PublicKey} }; -key_exchange(server, Version, {dh, {<<?UINT32(Len), PublicKey:Len/binary>>, _}, - #'DHParameter'{prime = P, base = G}, - HashSign, ClientRandom, ServerRandom, PrivateKey}) -> - <<?UINT32(_), PBin/binary>> = crypto:mpint(P), - <<?UINT32(_), GBin/binary>> = crypto:mpint(G), - ServerDHParams = #server_dh_params{dh_p = PBin, - dh_g = GBin, dh_y = PublicKey}, +key_exchange(server, Version, {dh, {PublicKey, _}, + #'DHParameter'{prime = P, base = G}, + HashSign, ClientRandom, ServerRandom, PrivateKey}) -> + ServerDHParams = #server_dh_params{dh_p = int_to_bin(P), + dh_g = int_to_bin(G), dh_y = PublicKey}, enc_server_key_exchange(Version, ServerDHParams, HashSign, ClientRandom, ServerRandom, PrivateKey); +key_exchange(server, Version, {ecdh, #'ECPrivateKey'{publicKey = {0, ECPublicKey}, + parameters = ECCurve}, HashSign, ClientRandom, ServerRandom, + PrivateKey}) -> + ServerECParams = #server_ecdh_params{curve = ECCurve, public = ECPublicKey}, + enc_server_key_exchange(Version, ServerECParams, HashSign, + ClientRandom, ServerRandom, PrivateKey); + key_exchange(server, Version, {psk, PskIdentityHint, HashSign, ClientRandom, ServerRandom, PrivateKey}) -> ServerPSKParams = #server_psk_params{hint = PskIdentityHint}, enc_server_key_exchange(Version, ServerPSKParams, HashSign, ClientRandom, ServerRandom, PrivateKey); -key_exchange(server, Version, {dhe_psk, PskIdentityHint, {<<?UINT32(Len), PublicKey:Len/binary>>, _}, +key_exchange(server, Version, {dhe_psk, PskIdentityHint, {PublicKey, _}, #'DHParameter'{prime = P, base = G}, HashSign, ClientRandom, ServerRandom, PrivateKey}) -> - <<?UINT32(_), PBin/binary>> = crypto:mpint(P), - <<?UINT32(_), GBin/binary>> = crypto:mpint(G), ServerEDHPSKParams = #server_dhe_psk_params{ hint = PskIdentityHint, - dh_params = #server_dh_params{dh_p = PBin, - dh_g = GBin, dh_y = PublicKey} + dh_params = #server_dh_params{dh_p = int_to_bin(P), + dh_g = int_to_bin(G), dh_y = PublicKey} }, enc_server_key_exchange(Version, ServerEDHPSKParams, HashSign, ClientRandom, ServerRandom, PrivateKey); @@ -494,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) @@ -508,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, @@ -591,6 +596,7 @@ get_tls_handshake(Version, Data, Buffer) -> -spec decode_client_key(binary(), key_algo(), tls_version()) -> #encrypted_premaster_secret{} | #client_diffie_hellman_public{} + | #client_ec_diffie_hellman_public{} | #client_psk_identity{} | #client_dhe_psk_identity{} | #client_rsa_psk_identity{} @@ -661,8 +667,8 @@ decrypt_premaster_secret(Secret, RSAPrivateKey) -> %% Description: Calculate server key exchange hash %%-------------------------------------------------------------------- server_key_exchange_hash(md5sha, Value) -> - MD5 = crypto:md5(Value), - SHA = crypto:sha(Value), + MD5 = crypto:hash(md5, Value), + SHA = crypto:hash(sha, Value), <<MD5/binary, SHA/binary>>; server_key_exchange_hash(Hash, Value) -> @@ -754,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)}; @@ -762,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, @@ -772,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, @@ -833,29 +839,56 @@ select_next_protocol(Protocols, NextProtocolSelector) -> Protocol end. -handle_srp_info(undefined, Session) -> - Session; -handle_srp_info(#srp{username = Username}, Session) -> - Session#session{srp_username = Username}. +default_ecc_extensions(Version) -> + CryptoSupport = proplists:get_value(public_keys, crypto:supports()), + case proplists:get_bool(ecdh, CryptoSupport) of + true -> + EcPointFormats = #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}, + EllipticCurves = #elliptic_curves{elliptic_curve_list = ssl_tls1:ecc_curves(Version)}, + {EcPointFormats, EllipticCurves}; + _ -> + {undefined, undefined} + end. + +handle_ecc_extensions(Version, EcPointFormats0, EllipticCurves0) -> + CryptoSupport = proplists:get_value(public_keys, crypto:supports()), + case proplists:get_bool(ecdh, CryptoSupport) of + true -> + EcPointFormats1 = handle_ecc_point_fmt_extension(EcPointFormats0), + EllipticCurves1 = handle_ecc_curves_extension(Version, EllipticCurves0), + {EcPointFormats1, EllipticCurves1}; + _ -> + {undefined, undefined} + end. + +handle_ecc_point_fmt_extension(undefined) -> + undefined; +handle_ecc_point_fmt_extension(_) -> + #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}. + +handle_ecc_curves_extension(Version, undefined) -> + undefined; +handle_ecc_curves_extension(Version, _) -> + #elliptic_curves{elliptic_curve_list = ssl_tls1:ecc_curves(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 @@ -871,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 -> @@ -893,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); @@ -910,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, @@ -922,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). @@ -945,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; @@ -978,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)}. @@ -1022,6 +1055,8 @@ dec_hs(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, RenegotiationInfo = proplists:get_value(renegotiation_info, DecodedExtensions, undefined), SRP = proplists:get_value(srp, DecodedExtensions, undefined), HashSigns = proplists:get_value(hash_signs, DecodedExtensions, undefined), + EllipticCurves = proplists:get_value(elliptic_curves, DecodedExtensions, + undefined), NextProtocolNegotiation = proplists:get_value(next_protocol_negotiation, DecodedExtensions, undefined), #client_hello{ @@ -1033,6 +1068,7 @@ dec_hs(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, renegotiation_info = RenegotiationInfo, srp = SRP, hash_signs = HashSigns, + elliptic_curves = EllipticCurves, next_protocol_negotiation = NextProtocolNegotiation }; @@ -1046,7 +1082,8 @@ dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, cipher_suite = Cipher_suite, compression_method = Comp_method, renegotiation_info = undefined, - hash_signs = undefined}; + hash_signs = undefined, + elliptic_curves = undefined}; dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, @@ -1058,6 +1095,8 @@ dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, undefined), HashSigns = proplists:get_value(hash_signs, HelloExtensions, undefined), + EllipticCurves = proplists:get_value(elliptic_curves, HelloExtensions, + undefined), NextProtocolNegotiation = proplists:get_value(next_protocol_negotiation, HelloExtensions, undefined), #server_hello{ @@ -1068,6 +1107,7 @@ dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, compression_method = Comp_method, renegotiation_info = RenegotiationInfo, hash_signs = HashSigns, + elliptic_curves = EllipticCurves, next_protocol_negotiation = NextProtocolNegotiation}; dec_hs(_Version, ?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>) -> #certificate{asn1_certificates = certs_to_list(ASN1Certs)}; @@ -1111,6 +1151,11 @@ dec_client_key(<<>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> dec_client_key(<<?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> #client_diffie_hellman_public{dh_public = DH_Y}; +dec_client_key(<<>>, ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, _) -> + throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE)); +dec_client_key(<<?BYTE(DH_YLen), DH_Y:DH_YLen/binary>>, + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, _) -> + #client_ec_diffie_hellman_public{dh_public = DH_Y}; dec_client_key(<<?UINT16(Len), Id:Len/binary>>, ?KEY_EXCHANGE_PSK, _) -> #client_psk_identity{identity = Id}; @@ -1161,6 +1206,19 @@ dec_server_key(<<?UINT16(PLen), P:PLen/binary, params_bin = BinMsg, hashsign = HashSign, signature = Signature}; +%% ECParameters with named_curve +%% TODO: explicit curve +dec_server_key(<<?BYTE(?NAMED_CURVE), ?UINT16(CurveID), + ?BYTE(PointLen), ECPoint:PointLen/binary, + _/binary>> = KeyStruct, + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, Version) -> + Params = #server_ecdh_params{curve = {namedCurve, ssl_tls1:enum_to_oid(CurveID)}, + public = ECPoint}, + {BinMsg, HashSign, Signature} = dec_ske_params(PointLen + 4, KeyStruct, Version), + #server_key_params{params = Params, + params_bin = BinMsg, + hashsign = HashSign, + signature = Signature}; dec_server_key(<<?UINT16(Len), PskIdentityHint:Len/binary>> = KeyStruct, KeyExchange, Version) when KeyExchange == ?KEY_EXCHANGE_PSK; KeyExchange == ?KEY_EXCHANGE_RSA_PSK -> @@ -1237,6 +1295,22 @@ dec_hello_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), dec_hello_extensions(Rest, [{hash_signs, #hash_sign_algos{hash_sign_algos = HashSignAlgos}} | Acc]); +dec_hello_extensions(<<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, Acc) -> + EllipticCurveListLen = Len - 2, + <<?UINT16(EllipticCurveListLen), EllipticCurveList/binary>> = ExtData, + EllipticCurves = [ssl_tls1:enum_to_oid(X) || <<X:16>> <= EllipticCurveList], + dec_hello_extensions(Rest, [{elliptic_curves, + #elliptic_curves{elliptic_curve_list = EllipticCurves}} | Acc]); + +dec_hello_extensions(<<?UINT16(?EC_POINT_FORMATS_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, Acc) -> + ECPointFormatListLen = Len - 1, + <<?BYTE(ECPointFormatListLen), ECPointFormatList/binary>> = ExtData, + ECPointFormats = binary_to_list(ECPointFormatList), + dec_hello_extensions(Rest, [{ec_point_formats, + #ec_point_formats{ec_point_format_list = ECPointFormats}} | Acc]); + %% Ignore data following the ClientHello (i.e., %% extensions) if not understood. @@ -1287,13 +1361,17 @@ enc_hs(#client_hello{client_version = {Major, Minor}, renegotiation_info = RenegotiationInfo, srp = SRP, hash_signs = HashSigns, + ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves, next_protocol_negotiation = NextProtocolNegotiation}, _Version) -> SIDLength = byte_size(SessionID), BinCompMethods = list_to_binary(CompMethods), CmLength = byte_size(BinCompMethods), BinCipherSuites = list_to_binary(CipherSuites), CsLength = byte_size(BinCipherSuites), - Extensions0 = hello_extensions(RenegotiationInfo, SRP, NextProtocolNegotiation), + Extensions0 = hello_extensions(RenegotiationInfo, SRP, NextProtocolNegotiation) + ++ ec_hello_extensions(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites), EcPointFormats) + ++ ec_hello_extensions(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites), EllipticCurves), Extensions1 = if Major == 3, Minor >=3 -> Extensions0 ++ hello_extensions(HashSigns); true -> Extensions0 @@ -1308,16 +1386,21 @@ enc_hs(#client_hello{client_version = {Major, Minor}, enc_hs(#server_hello{server_version = {Major, Minor}, random = Random, session_id = Session_ID, - cipher_suite = Cipher_suite, + cipher_suite = CipherSuite, compression_method = Comp_method, renegotiation_info = RenegotiationInfo, + ec_point_formats = EcPointFormats, + elliptic_curves = EllipticCurves, next_protocol_negotiation = NextProtocolNegotiation}, _Version) -> SID_length = byte_size(Session_ID), - Extensions = hello_extensions(RenegotiationInfo, NextProtocolNegotiation), + CipherSuites = [ssl_cipher:suite_definition(CipherSuite)], + Extensions = hello_extensions(RenegotiationInfo, NextProtocolNegotiation) + ++ ec_hello_extensions(CipherSuites, EcPointFormats) + ++ ec_hello_extensions(CipherSuites, EllipticCurves), ExtensionsBin = enc_hello_extensions(Extensions), {?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID/binary, - Cipher_suite/binary, ?BYTE(Comp_method), ExtensionsBin/binary>>}; + CipherSuite/binary, ?BYTE(Comp_method), ExtensionsBin/binary>>}; enc_hs(#certificate{asn1_certificates = ASN1CertList}, _Version) -> ASN1Certs = certs_from_list(ASN1CertList), ACLen = erlang:iolist_size(ASN1Certs), @@ -1370,6 +1453,9 @@ enc_cke(#encrypted_premaster_secret{premaster_secret = PKEPMS}, _) -> enc_cke(#client_diffie_hellman_public{dh_public = DHPublic}, _) -> Len = byte_size(DHPublic), <<?UINT16(Len), DHPublic/binary>>; +enc_cke(#client_ec_diffie_hellman_public{dh_public = DHPublic}, _) -> + Len = byte_size(DHPublic), + <<?BYTE(Len), DHPublic/binary>>; enc_cke(#client_psk_identity{identity = undefined}, _) -> Id = <<"psk_identity">>, Len = byte_size(Id), @@ -1398,6 +1484,11 @@ enc_server_key(#server_dh_params{dh_p = P, dh_g = G, dh_y = Y}) -> GLen = byte_size(G), YLen = byte_size(Y), <<?UINT16(PLen), P/binary, ?UINT16(GLen), G/binary, ?UINT16(YLen), Y/binary>>; +enc_server_key(#server_ecdh_params{curve = {namedCurve, ECCurve}, public = ECPubKey}) -> + %%TODO: support arbitrary keys + KLen = size(ECPubKey), + <<?BYTE(?NAMED_CURVE_TYPE), ?UINT16((ssl_tls1:oid_to_enum(ECCurve))), + ?BYTE(KLen), ECPubKey/binary>>; enc_server_key(#server_psk_params{hint = PskIdentityHint}) -> Len = byte_size(PskIdentityHint), <<?UINT16(Len), PskIdentityHint/binary>>; @@ -1431,11 +1522,46 @@ enc_sign(_HashSign, Sign, _Version) -> SignLen = byte_size(Sign), <<?UINT16(SignLen), Sign/binary>>. + +ec_hello_extensions(CipherSuites, #elliptic_curves{} = Info) -> + case advertises_ec_ciphers(CipherSuites) of + true -> + [Info]; + false -> + [] + end; +ec_hello_extensions(CipherSuites, #ec_point_formats{} = Info) -> + case advertises_ec_ciphers(CipherSuites) of + true -> + [Info]; + false -> + [] + end; +ec_hello_extensions(_, undefined) -> + []. + hello_extensions(RenegotiationInfo, NextProtocolNegotiation) -> hello_extensions(RenegotiationInfo) ++ next_protocol_extension(NextProtocolNegotiation). hello_extensions(RenegotiationInfo, SRP, NextProtocolNegotiation) -> - hello_extensions(RenegotiationInfo) ++ hello_extensions(SRP) ++ next_protocol_extension(NextProtocolNegotiation). + hello_extensions(RenegotiationInfo) + ++ hello_extensions(SRP) + ++ next_protocol_extension(NextProtocolNegotiation). + +advertises_ec_ciphers([]) -> + false; +advertises_ec_ciphers([{ecdh_ecdsa, _,_,_} | _]) -> + true; +advertises_ec_ciphers([{ecdhe_ecdsa, _,_,_} | _]) -> + true; +advertises_ec_ciphers([{ecdh_rsa, _,_,_} | _]) -> + true; +advertises_ec_ciphers([{ecdhe_rsa, _,_,_} | _]) -> + true; +advertises_ec_ciphers([{ecdh_anon, _,_,_} | _]) -> + true; +advertises_ec_ciphers([_| Rest]) -> + advertises_ec_ciphers(Rest). %% Renegotiation info hello_extensions(#renegotiation_info{renegotiated_connection = undefined}) -> @@ -1473,12 +1599,22 @@ enc_hello_extensions([#renegotiation_info{renegotiated_connection = Info} | Rest InfoLen = byte_size(Info), Len = InfoLen +1, enc_hello_extensions(Rest, <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), ?BYTE(InfoLen), Info/binary, Acc/binary>>); - +enc_hello_extensions([#elliptic_curves{elliptic_curve_list = EllipticCurves} | Rest], Acc) -> + EllipticCurveList = << <<(ssl_tls1:oid_to_enum(X)):16>> || X <- EllipticCurves>>, + ListLen = byte_size(EllipticCurveList), + Len = ListLen + 2, + enc_hello_extensions(Rest, <<?UINT16(?ELLIPTIC_CURVES_EXT), + ?UINT16(Len), ?UINT16(ListLen), EllipticCurveList/binary, Acc/binary>>); +enc_hello_extensions([#ec_point_formats{ec_point_format_list = ECPointFormats} | Rest], Acc) -> + ECPointFormatList = list_to_binary(ECPointFormats), + ListLen = byte_size(ECPointFormatList), + Len = ListLen + 1, + enc_hello_extensions(Rest, <<?UINT16(?EC_POINT_FORMATS_EXT), + ?UINT16(Len), ?BYTE(ListLen), ECPointFormatList/binary, Acc/binary>>); enc_hello_extensions([#srp{username = UserName} | Rest], Acc) -> SRPLen = byte_size(UserName), Len = SRPLen + 2, enc_hello_extensions(Rest, <<?UINT16(?SRP_EXT), ?UINT16(Len), ?BYTE(SRPLen), UserName/binary, Acc/binary>>); - enc_hello_extensions([#hash_sign_algos{hash_sign_algos = HashSignAlgos} | Rest], Acc) -> SignAlgoList = << <<(ssl_cipher:hash_algorithm(Hash)):8, (ssl_cipher:sign_algorithm(Sign)):8>> || {Hash, Sign} <- HashSignAlgos >>, @@ -1513,9 +1649,15 @@ from_2bytes(<<?UINT16(N), Rest/binary>>, Acc) -> certificate_types({KeyExchange, _, _, _}) when KeyExchange == rsa; KeyExchange == dhe_dss; - KeyExchange == dhe_rsa -> + KeyExchange == dhe_rsa; + KeyExchange == ecdhe_rsa -> <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>; +certificate_types({KeyExchange, _, _, _}) + when KeyExchange == dh_ecdsa; + KeyExchange == dhe_ecdsa -> + <<?BYTE(?ECDSA_SIGN)>>; + certificate_types(_) -> <<?BYTE(?RSA_SIGN)>>. @@ -1532,9 +1674,6 @@ certificate_authorities(CertDbHandle, CertDbRef) -> Enc = fun(#'OTPCertificate'{tbsCertificate=TBSCert}) -> OTPSubj = TBSCert#'OTPTBSCertificate'.subject, DNEncodedBin = public_key:pkix_encode('Name', OTPSubj, otp), - %%Subj = public_key:pkix_transform(OTPSubj, encode), - %% {ok, DNEncoded} = 'OTP-PUB-KEY':encode('Name', Subj), - %% DNEncodedBin = iolist_to_binary(DNEncoded), DNEncodedLen = byte_size(DNEncodedBin), <<?UINT16(DNEncodedLen), DNEncodedBin/binary>> end, @@ -1546,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 -> @@ -1555,7 +1694,9 @@ digitally_signed(_Version, Hash, HashAlgo, #'DSAPrivateKey'{} = Key) -> public_key:sign({digest, Hash}, HashAlgo, Key); digitally_signed(_Version, Hash, _HashAlgo, #'RSAPrivateKey'{} = Key) -> public_key:encrypt_private(Hash, Key, - [{rsa_pad, rsa_pkcs1_padding}]). + [{rsa_pad, rsa_pkcs1_padding}]); +digitally_signed(_Version, Hash, HashAlgo, Key) -> + public_key:sign({digest, Hash}, HashAlgo, Key). calc_master_secret({3,0}, _PrfAlgo, PremasterSecret, ClientRandom, ServerRandom) -> ssl_ssl3:master_secret(PremasterSecret, ClientRandom, ServerRandom); @@ -1588,6 +1729,10 @@ key_exchange_alg(rsa) -> key_exchange_alg(Alg) when Alg == dhe_rsa; Alg == dhe_dss; Alg == dh_dss; Alg == dh_rsa; Alg == dh_anon -> ?KEY_EXCHANGE_DIFFIE_HELLMAN; +key_exchange_alg(Alg) when Alg == ecdhe_rsa; Alg == ecdh_rsa; + Alg == ecdhe_ecdsa; Alg == ecdh_ecdsa; + Alg == ecdh_anon -> + ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN; key_exchange_alg(psk) -> ?KEY_EXCHANGE_PSK; key_exchange_alg(dhe_psk) -> @@ -1612,15 +1757,71 @@ apply_user_fun(Fun, OtpCert, ExtensionOrError, UserState0, SslState) -> -define(TLSEXT_SIGALG_RSA(MD), {MD, rsa}). -define(TLSEXT_SIGALG_DSA(MD), {MD, dsa}). +-define(TLSEXT_SIGALG_ECDSA(MD), {MD, ecdsa}). --define(TLSEXT_SIGALG(MD), ?TLSEXT_SIGALG_RSA(MD)). +-define(TLSEXT_SIGALG(MD), ?TLSEXT_SIGALG_ECDSA(MD), ?TLSEXT_SIGALG_RSA(MD)). default_hash_signs() -> + HashSigns = [?TLSEXT_SIGALG(sha512), + ?TLSEXT_SIGALG(sha384), + ?TLSEXT_SIGALG(sha256), + ?TLSEXT_SIGALG(sha224), + ?TLSEXT_SIGALG(sha), + ?TLSEXT_SIGALG_DSA(sha), + ?TLSEXT_SIGALG_RSA(md5)], + CryptoSupport = proplists:get_value(public_keys, crypto:supports()), + HasECC = proplists:get_bool(ecdsa, CryptoSupport), #hash_sign_algos{hash_sign_algos = - [?TLSEXT_SIGALG(sha512), - ?TLSEXT_SIGALG(sha384), - ?TLSEXT_SIGALG(sha256), - ?TLSEXT_SIGALG(sha224), - ?TLSEXT_SIGALG(sha), - ?TLSEXT_SIGALG_DSA(sha), - ?TLSEXT_SIGALG_RSA(md5)]}. + lists:filter(fun({_, ecdsa}) -> HasECC; + (_) -> true end, HashSigns)}. + +handle_hello_extensions(#client_hello{random = Random, + cipher_suites = CipherSuites, + renegotiation_info = Info, + srp = SRP, + ec_point_formats = EcPointFormats0, + elliptic_curves = EllipticCurves0} = Hello, Version, + #ssl_options{secure_renegotiate = SecureRenegotation} = Opts, + Session0, ConnectionStates0, Renegotiation) -> + Session = handle_srp_extension(SRP, Session0), + ConnectionStates = handle_renegotiation_extension(Version, Info, Random, Session, ConnectionStates0, + Renegotiation, SecureRenegotation, CipherSuites), + ProtocolsToAdvertise = handle_next_protocol_extension(Hello, Renegotiation, Opts), + {EcPointFormats, EllipticCurves} = handle_ecc_extensions(Version, EcPointFormats0, EllipticCurves0), + %%TODO make extensions compund data structure + {Session, ConnectionStates, ProtocolsToAdvertise, EcPointFormats, EllipticCurves}. + + +handle_renegotiation_extension(Version, Info, Random, #session{cipher_suite = CipherSuite, + compression_method = Compression}, + ConnectionStates0, Renegotiation, SecureRenegotation, CipherSuites) -> + case handle_renegotiation_info(server, Info, ConnectionStates0, + Renegotiation, SecureRenegotation, + CipherSuites) of + {ok, ConnectionStates1} -> + hello_pending_connection_states(server, + Version, + CipherSuite, + Random, + Compression, + ConnectionStates1); + #alert{} = Alert -> + throw(Alert) + end. + +handle_next_protocol_extension(Hello, Renegotiation, SslOpts)-> + case handle_next_protocol_on_server(Hello, Renegotiation, SslOpts) of + #alert{} = Alert -> + throw(Alert); + ProtocolsToAdvertise -> + ProtocolsToAdvertise + end. + +handle_srp_extension(undefined, Session) -> + Session; +handle_srp_extension(#srp{username = Username}, Session) -> + Session#session{srp_username = Username}. + +int_to_bin(I) -> + L = (length(integer_to_list(I, 16)) + 1) div 2, + <<I:(L*8)>>. 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 26aca56739..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 @@ -712,12 +712,5 @@ mac_hash({3, N} = Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) Length, Fragment). sufficient_tlsv1_2_crypto_support() -> - Data = "Sampl", - Data2 = "e #1", - Key = <<0,1,2,3,16,17,18,19,32,33,34,35,48,49,50,51,4,5,6,7,20,21,22,23,36,37,38,39, - 52,53,54,55,8,9,10,11,24,25,26,27,40,41,42,43,56,57,58,59>>, - try - crypto:sha256_mac(Key, lists:flatten([Data, Data2])), - true - catch _:_ -> false - end. + CryptoSupport = crypto:supports(), + proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)). 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/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl index 71aa985c4f..22dc951ac1 100644 --- a/lib/ssl/test/erl_make_certs.erl +++ b/lib/ssl/test/erl_make_certs.erl @@ -45,7 +45,7 @@ %% {dnQualifer, DnQ} %% issuer = {Issuer, IssuerKey} true (i.e. a ca cert is created) %% (obs IssuerKey migth be {Key, Password} -%% key = KeyFile|KeyBin|rsa|dsa Subject PublicKey rsa or dsa generates key +%% key = KeyFile|KeyBin|rsa|dsa|ec Subject PublicKey rsa, dsa or ec generates key %% %% %% (OBS: The generated keys are for testing only) @@ -91,6 +91,16 @@ gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) -> {Key, encode_key(Key)}. %%-------------------------------------------------------------------- +%% @doc Creates a ec key (OBS: for testing only) +%% the sizes are in bytes +%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} +%% @end +%%-------------------------------------------------------------------- +gen_ec(Curve) when is_atom(Curve) -> + Key = gen_ec2(Curve), + {Key, encode_key(Key)}. + +%%-------------------------------------------------------------------- %% @doc Verifies cert signatures %% @spec (::binary(), ::tuple()) -> ::boolean() %% @end @@ -102,7 +112,10 @@ verify_signature(DerEncodedCert, DerKey, _KeyParams) -> public_key:pkix_verify(DerEncodedCert, #'RSAPublicKey'{modulus=Mod, publicExponent=Exp}); #'DSAPrivateKey'{p=P, q=Q, g=G, y=Y} -> - public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}}) + public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}}); + #'ECPrivateKey'{version = _Version, privateKey = _PrivKey, + parameters = Params, publicKey = {0, PubKey}} -> + public_key:pkix_verify(DerEncodedCert, {#'ECPoint'{point = PubKey}, Params}) end. %%%%%%%%%%%%%%%%%%%%%%%%% Implementation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -112,6 +125,7 @@ get_key(Opts) -> undefined -> make_key(rsa, Opts); rsa -> make_key(rsa, Opts); dsa -> make_key(dsa, Opts); + ec -> make_key(ec, Opts); Key -> Password = proplists:get_value(password, Opts, no_passwd), decode_key(Key, Password) @@ -129,6 +143,8 @@ decode_key(#'RSAPrivateKey'{} = Key,_) -> Key; decode_key(#'DSAPrivateKey'{} = Key,_) -> Key; +decode_key(#'ECPrivateKey'{} = Key,_) -> + Key; decode_key(PemEntry = {_,_,_}, Pw) -> public_key:pem_entry_decode(PemEntry, Pw); decode_key(PemBin, Pw) -> @@ -140,7 +156,10 @@ encode_key(Key = #'RSAPrivateKey'{}) -> {'RSAPrivateKey', Der, not_encrypted}; encode_key(Key = #'DSAPrivateKey'{}) -> {ok, Der} = 'OTP-PUB-KEY':encode('DSAPrivateKey', Key), - {'DSAPrivateKey', Der, not_encrypted}. + {'DSAPrivateKey', Der, not_encrypted}; +encode_key(Key = #'ECPrivateKey'{}) -> + {ok, Der} = 'OTP-PUB-KEY':encode('ECPrivateKey', Key), + {'ECPrivateKey', Der, not_encrypted}. make_tbs(SubjectKey, Opts) -> Version = list_to_atom("v"++integer_to_list(proplists:get_value(version, Opts, 3))), @@ -277,7 +296,14 @@ publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) -> publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) -> Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa', parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}}, - #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}. + #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}; +publickey(#'ECPrivateKey'{version = _Version, + privateKey = _PrivKey, + parameters = Params, + publicKey = {0, PubKey}}) -> + Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-ecPublicKey', parameters=Params}, + #'OTPSubjectPublicKeyInfo'{algorithm = Algo, + subjectPublicKey = #'ECPoint'{point = PubKey}}. validity(Opts) -> DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1), @@ -298,13 +324,24 @@ sign_algorithm(#'RSAPrivateKey'{}, Opts) -> end, {Type, 'NULL'}; sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) -> - {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}. + {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}; +sign_algorithm(#'ECPrivateKey'{}, Opts) -> + Type = case proplists:get_value(digest, Opts, sha1) of + sha1 -> ?'ecdsa-with-SHA1'; + sha512 -> ?'ecdsa-with-SHA512'; + sha384 -> ?'ecdsa-with-SHA384'; + sha256 -> ?'ecdsa-with-SHA256' + end, + {Type, 'NULL'}. make_key(rsa, _Opts) -> %% (OBS: for testing only) gen_rsa2(64); make_key(dsa, _Opts) -> - gen_dsa2(128, 20). %% Bytes i.e. {1024, 160} + gen_dsa2(128, 20); %% Bytes i.e. {1024, 160} +make_key(ec, _Opts) -> + %% (OBS: for testing only) + gen_ec2(secp256k1). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% RSA key generation (OBS: for testing only) @@ -354,19 +391,32 @@ gen_dsa2(LSize, NSize) -> error -> gen_dsa2(LSize, NSize); P -> - G = crypto:mod_exp(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. + G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q. %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used. X = prime(20), %% Choose x by some random method, where 0 < x < q. - Y = crypto:mod_exp(G, X, P), %% Calculate y = g^x mod p. + Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p. - #'DSAPrivateKey'{version=0, p=P, q=Q, g=G, y=Y, x=X} + #'DSAPrivateKey'{version=0, p = P, q = Q, + g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X} end. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% EC key generation (OBS: for testing only) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gen_ec2(CurveId) -> + {PubKey, PrivKey} = crypto:generate_key(ecdh, CurveId), + + #'ECPrivateKey'{version = 1, + privateKey = binary_to_list(PrivKey), + parameters = {namedCurve, pubkey_cert_records:namedCurves(CurveId)}, + publicKey = {0, PubKey}}. + %% See fips_186-3.pdf dsa_search(T, P0, Q, Iter) when Iter > 0 -> P = 2*T*Q*P0 + 1, - case is_prime(crypto:mpint(P), 50) of + case is_prime(P, 50) of true -> P; false -> dsa_search(T+1, P0, Q, Iter-1) end; @@ -377,38 +427,40 @@ dsa_search(_,_,_,_) -> %%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% prime(ByteSize) -> Rand = odd_rand(ByteSize), - crypto:erlint(prime_odd(Rand, 0)). + prime_odd(Rand, 0). prime_odd(Rand, N) -> case is_prime(Rand, 50) of true -> Rand; false -> - NotPrime = crypto:erlint(Rand), - prime_odd(crypto:mpint(NotPrime+2), N+1) + prime_odd(Rand+2, N+1) end. %% see http://en.wikipedia.org/wiki/Fermat_primality_test is_prime(_, 0) -> true; is_prime(Candidate, Test) -> - CoPrime = odd_rand(<<0,0,0,4, 10000:32>>, Candidate), - case crypto:mod_exp(CoPrime, Candidate, Candidate) of - CoPrime -> is_prime(Candidate, Test-1); - _ -> false - end. + CoPrime = odd_rand(10000, Candidate), + Result = crypto:mod_pow(CoPrime, Candidate, Candidate) , + is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test). + +is_prime(CoPrime, CoPrime, Candidate, Test) -> + is_prime(Candidate, Test-1); +is_prime(_,_,_,_) -> + false. odd_rand(Size) -> Min = 1 bsl (Size*8-1), Max = (1 bsl (Size*8))-1, - odd_rand(crypto:mpint(Min), crypto:mpint(Max)). + odd_rand(Min, Max). odd_rand(Min,Max) -> - Rand = <<Sz:32, _/binary>> = crypto:rand_uniform(Min,Max), - BitSkip = (Sz+4)*8-1, - case Rand of - Odd = <<_:BitSkip, 1:1>> -> Odd; - Even = <<_:BitSkip, 0:1>> -> - crypto:mpint(crypto:erlint(Even)+1) + Rand = crypto:rand_uniform(Min,Max), + case Rand rem 2 of + 0 -> + Rand + 1; + _ -> + Rand end. extended_gcd(A, B) -> @@ -427,3 +479,4 @@ pem_to_der(File) -> der_to_pem(File, Entries) -> PemBin = public_key:pem_encode(Entries), file:write_file(File, PemBin). + diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 10bbd4d88b..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). @@ -69,6 +69,7 @@ groups() -> {session, [], session_tests()}, {renegotiate, [], renegotiate_tests()}, {ciphers, [], cipher_tests()}, + {ciphers_ec, [], cipher_tests_ec()}, {error_handling_tests, [], error_handling_tests()} ]. @@ -76,6 +77,7 @@ all_versions_groups ()-> [{group, api}, {group, renegotiate}, {group, ciphers}, + {group, ciphers_ec}, {group, error_handling_tests}]. @@ -163,6 +165,12 @@ cipher_tests() -> srp_dsa_cipher_suites, default_reject_anonymous]. +cipher_tests_ec() -> + [ciphers_ecdsa_signed_certs, + ciphers_ecdsa_signed_certs_openssl_names, + ciphers_ecdh_rsa_signed_certs, + ciphers_ecdh_rsa_signed_certs_openssl_names]. + error_handling_tests()-> [controller_dies, client_closes_socket, @@ -188,10 +196,12 @@ init_per_suite(Config0) -> Result = (catch make_certs:all(?config(data_dir, Config0), ?config(priv_dir, Config0))), - ct:print("Make certs ~p~n", [Result]), + ct:log("Make certs ~p~n", [Result]), Config1 = ssl_test_lib:make_dsa_cert(Config0), - Config = ssl_test_lib:cert_options(Config1), + Config2 = ssl_test_lib:make_ecdsa_cert(Config1), + Config3 = ssl_test_lib:make_ecdh_rsa_cert(Config2), + Config = ssl_test_lib:cert_options(Config3), [{watchdog, Dog} | Config] catch _:_ -> {skip, "Crypto did not start"} @@ -256,7 +266,7 @@ init_per_testcase(empty_protocol_versions, Config) -> %% ssl_test_lib:make_mix_cert(Config0); init_per_testcase(_TestCase, Config0) -> - ct:print("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]. @@ -319,11 +329,11 @@ connection_info(Config) when is_list(Config) -> [{ciphers,[{rsa,rc4_128,sha,no_export}]} | ClientOpts]}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [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}}}, @@ -372,7 +382,7 @@ controlling_process(Config) when is_list(Config) -> ClientMsg]}}, {options, ClientOpts}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), receive @@ -422,7 +432,7 @@ controller_dies(Config) when is_list(Config) -> ClientMsg]}}, {options, ClientOpts}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ct:sleep(?SLEEP), %% so that they are connected process_flag(trap_exit, true), @@ -460,12 +470,12 @@ controller_dies(Config) when is_list(Config) -> Client3 ! die_nice end, - ct:print("Wating on exit ~p~n",[Client3]), + ct:log("Wating on exit ~p~n",[Client3]), receive {'EXIT', Client3, normal} -> ok end, receive %% Client3 is dead but that doesn't matter, socket should not be closed. Unexpected -> - ct:print("Unexpected ~p~n",[Unexpected]), + ct:log("Unexpected ~p~n",[Unexpected]), ct:fail({line, ?LINE-1}) after 1000 -> ok @@ -596,7 +606,7 @@ peername(Config) when is_list(Config) -> ServerMsg = {ok, {ClientIp, ClientPort}}, ClientMsg = {ok, {ServerIp, Port}}, - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -629,7 +639,7 @@ peercert(Config) when is_list(Config) -> ServerMsg = {error, no_peercert}, ClientMsg = {ok, BinCert}, - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -667,7 +677,7 @@ peercert_with_client_cert(Config) when is_list(Config) -> ServerMsg = {ok, ClientBinCert}, ClientMsg = {ok, ServerBinCert}, - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -699,7 +709,7 @@ sockname(Config) when is_list(Config) -> ServerMsg = {ok, {ServerIp, Port}}, ClientMsg = {ok, {ClientIp, ClientPort}}, - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -772,7 +782,7 @@ socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) -> ssl:setopts(Socket, [{nodelay, true}]), {ok,[{nodelay, true}]} = ssl:getopts(Socket, [nodelay]), {ok, All} = ssl:getopts(Socket, []), - ct:print("All opts ~p~n", [All]), + ct:log("All opts ~p~n", [All]), ok. @@ -795,7 +805,7 @@ invalid_inet_get_option(Config) when is_list(Config) -> {mfa, {ssl_test_lib, no_result, []}}, {options, ClientOpts}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ok), @@ -821,7 +831,7 @@ invalid_inet_get_option_not_list(Config) when is_list(Config) -> {mfa, {ssl_test_lib, no_result, []}}, {options, ClientOpts}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ok), @@ -853,7 +863,7 @@ invalid_inet_get_option_improper_list(Config) when is_list(Config) -> {mfa, {ssl_test_lib, no_result, []}}, {options, ClientOpts}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ok), @@ -884,7 +894,7 @@ invalid_inet_set_option(Config) when is_list(Config) -> {mfa, {ssl_test_lib, no_result, []}}, {options, ClientOpts}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ok), @@ -916,7 +926,7 @@ invalid_inet_set_option_not_list(Config) when is_list(Config) -> {mfa, {ssl_test_lib, no_result, []}}, {options, ClientOpts}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ok), @@ -948,7 +958,7 @@ invalid_inet_set_option_improper_list(Config) when is_list(Config) -> {mfa, {ssl_test_lib, no_result, []}}, {options, ClientOpts}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ok), @@ -989,7 +999,7 @@ misc_ssl_options(Config) when is_list(Config) -> {mfa, {ssl_test_lib, send_recv_result_active, []}}, {options, TestOpts ++ ClientOpts}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -1002,7 +1012,7 @@ versions() -> versions(Config) when is_list(Config) -> [_|_] = Versions = ssl:versions(), - ct:print("~p~n", [Versions]). + ct:log("~p~n", [Versions]). %%-------------------------------------------------------------------- send_recv() -> @@ -1024,7 +1034,7 @@ send_recv(Config) when is_list(Config) -> {mfa, {ssl_test_lib, send_recv_result, []}}, {options, [{active, false} | ClientOpts]}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -1050,7 +1060,7 @@ send_close(Config) when is_list(Config) -> {ok, SslS} = rpc:call(ClientNode, ssl, connect, [TcpS,[{active, false}|ClientOpts]]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), self(), Server]), ok = ssl:send(SslS, "Hello world"), {ok,<<"Hello world">>} = ssl:recv(SslS, 11), @@ -1135,7 +1145,7 @@ upgrade(Config) when is_list(Config) -> {tcp_options, TcpOpts}, {ssl_options, ClientOpts}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -1185,7 +1195,7 @@ upgrade_with_timeout(Config) when is_list(Config) -> {tcp_options, TcpOpts}, {ssl_options, ClientOpts}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -1211,14 +1221,14 @@ tcp_connect(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(Server), {ok, Socket} = gen_tcp:connect(Hostname, Port, [binary, {packet, 0}]), - ct:print("Testcase ~p connected to Server ~p ~n", [self(), Server]), + ct:log("Testcase ~p connected to Server ~p ~n", [self(), Server]), gen_tcp:send(Socket, "<SOME GARBLED NON SSL MESSAGE>"), receive {tcp_closed, Socket} -> receive {Server, {error, Error}} -> - ct:print("Error ~p", [Error]) + ct:log("Error ~p", [Error]) end end. %%-------------------------------------------------------------------- @@ -1239,7 +1249,7 @@ tcp_connect_big(Config) when is_list(Config) -> Port = ssl_test_lib:inet_port(Server), {ok, Socket} = gen_tcp:connect(Hostname, Port, [binary, {packet, 0}]), - ct:print("Testcase ~p connected to Server ~p ~n", [self(), Server]), + ct:log("Testcase ~p connected to Server ~p ~n", [self(), Server]), Rand = crypto:rand_bytes(?MAX_CIPHER_TEXT_LENGTH+1), gen_tcp:send(Socket, <<?BYTE(0), @@ -1251,7 +1261,7 @@ tcp_connect_big(Config) when is_list(Config) -> {Server, {error, timeout}} -> ct:fail("hangs"); {Server, {error, Error}} -> - ct:print("Error ~p", [Error]) + ct:log("Error ~p", [Error]) end end. @@ -1281,7 +1291,7 @@ ipv6(Config) when is_list(Config) -> {options, [inet6, {active, false} | ClientOpts]}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -1537,10 +1547,10 @@ 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(), - ct:print("~p erlang cipher suites ~p~n", [Version, Ciphers]), + Ciphers = ssl_test_lib:rsa_suites(crypto), + ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, rsa). %%------------------------------------------------------------------- ciphers_rsa_signed_certs_openssl_names() -> @@ -1548,9 +1558,9 @@ 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([])), - Ciphers = ssl_test_lib:openssl_rsa_suites(), - ct:print("tls1 openssl cipher suites ~p~n", [Ciphers]), + 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). %%------------------------------------------------------------------- @@ -1559,10 +1569,10 @@ 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:print("~p erlang cipher suites ~p~n", [Version, Ciphers]), + ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, dsa). %%------------------------------------------------------------------- ciphers_dsa_signed_certs_openssl_names() -> @@ -1570,65 +1580,65 @@ 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:print("tls1 openssl cipher suites ~p~n", [Ciphers]), + ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]), run_suites(Ciphers, Version, Config, dsa). %%------------------------------------------------------------------- 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). %%-------------------------------------------------------------------- @@ -1656,6 +1666,48 @@ default_reject_anonymous(Config) when is_list(Config) -> Client, {error, {tls_alert, "insufficient security"}}). %%-------------------------------------------------------------------- +ciphers_ecdsa_signed_certs() -> + [{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}]. + +ciphers_ecdsa_signed_certs(Config) when is_list(Config) -> + 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]), + run_suites(Ciphers, Version, Config, ecdsa). +%%-------------------------------------------------------------------- +ciphers_ecdsa_signed_certs_openssl_names() -> + [{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}]. + +ciphers_ecdsa_signed_certs_openssl_names(Config) when is_list(Config) -> + 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). +%%-------------------------------------------------------------------- +ciphers_ecdh_rsa_signed_certs() -> + [{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}]. + +ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) -> + 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]), + run_suites(Ciphers, Version, Config, ecdh_rsa). +%%-------------------------------------------------------------------- +ciphers_ecdh_rsa_signed_certs_openssl_names() -> + [{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}]. + +ciphers_ecdh_rsa_signed_certs_openssl_names(Config) when is_list(Config) -> + 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). +%%-------------------------------------------------------------------- reuse_session() -> [{doc,"Test reuse of sessions (short handshake)"}]. reuse_session(Config) when is_list(Config) -> @@ -1694,7 +1746,7 @@ reuse_session(Config) when is_list(Config) -> {Client1, SessionInfo} -> ok; {Client1, Other} -> - ct:print("Expected: ~p, Unexpected: ~p~n", + ct:log("Expected: ~p, Unexpected: ~p~n", [SessionInfo, Other]), ct:fail(session_not_reused) end, @@ -1752,7 +1804,7 @@ reuse_session(Config) when is_list(Config) -> ct:fail( session_reused_when_session_reuse_disabled_by_server); {Client4, _Other} -> - ct:print("OTHER: ~p ~n", [_Other]), + ct:log("OTHER: ~p ~n", [_Other]), ok end, @@ -1802,7 +1854,7 @@ reuse_session_expired(Config) when is_list(Config) -> {Client1, SessionInfo} -> ok; {Client1, Other} -> - ct:print("Expected: ~p, Unexpected: ~p~n", + ct:log("Expected: ~p, Unexpected: ~p~n", [SessionInfo, Other]), ct:fail(session_not_reused) end, @@ -2032,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}, @@ -2505,7 +2557,7 @@ connect_twice(Config) when is_list(Config) -> {options, [{keepalive, true},{active, false} | ClientOpts]}]), - ct:print("Testcase ~p, Client ~p Server ~p ~n", + ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -2851,9 +2903,9 @@ result_ok(_Socket) -> ok. renegotiate(Socket, Data) -> - ct:print("Renegotiating ~n", []), + ct:log("Renegotiating ~n", []), Result = ssl:renegotiate(Socket), - ct:print("Result ~p~n", [Result]), + ct:log("Result ~p~n", [Result]), ssl:send(Socket, Data), case Result of ok -> @@ -2882,7 +2934,7 @@ renegotiate_immediately(Socket) -> {error, renegotiation_rejected} = ssl:renegotiate(Socket), ct:sleep(?RENEGOTIATION_DISABLE_TIME +1), ok = ssl:renegotiate(Socket), - ct:print("Renegotiated again"), + ct:log("Renegotiated again"), ssl:send(Socket, "Hello world"), ok. @@ -2901,7 +2953,7 @@ new_config(PrivDir, ServerOpts0) -> ServerOpts = proplists:delete(keyfile, ServerOpts2), {ok, PEM} = file:read_file(NewCaCertFile), - ct:print("CA file content: ~p~n", [public_key:pem_decode(PEM)]), + ct:log("CA file content: ~p~n", [public_key:pem_decode(PEM)]), [{cacertfile, NewCaCertFile}, {certfile, NewCertFile}, {keyfile, NewKeyFile} | ServerOpts]. @@ -3097,15 +3149,15 @@ get_close(Pid, Where) -> {'EXIT', Pid, _Reason} -> receive {_, {ssl_closed, Socket}} -> - ct:print("Socket closed ~p~n",[Socket]); + ct:log("Socket closed ~p~n",[Socket]); Unexpected -> - ct:print("Unexpected ~p~n",[Unexpected]), + ct:log("Unexpected ~p~n",[Unexpected]), ct:fail({line, ?LINE-1}) after 5000 -> ct:fail({timeout, {line, ?LINE, Where}}) end; Unexpected -> - ct:print("Unexpected ~p~n",[Unexpected]), + ct:log("Unexpected ~p~n",[Unexpected]), ct:fail({line, ?LINE-1}) after 5000 -> ct:fail({timeout, {line, ?LINE, Where}}) @@ -3119,7 +3171,7 @@ run_send_recv_rizzo(Ciphers, Config, Version, Mfa) -> [] -> ok; Error -> - ct:print("Cipher suite errors: ~p~n", [Error]), + ct:log("Cipher suite errors: ~p~n", [Error]), ct:fail(cipher_suite_failed_see_test_case_log) end. @@ -3149,12 +3201,21 @@ rizzo_test(Cipher, Config, Version, Mfa) -> [{Cipher, Error}] end. -client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == rsa orelse KeyAlgo == dhe_rsa -> +client_server_opts({KeyAlgo,_,_}, Config) + when KeyAlgo == rsa orelse + KeyAlgo == dhe_rsa orelse + KeyAlgo == ecdhe_rsa -> {?config(client_opts, Config), ?config(server_opts, Config)}; client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == dss orelse KeyAlgo == dhe_dss -> {?config(client_dsa_opts, Config), - ?config(server_dsa_opts, Config)}. + ?config(server_dsa_opts, Config)}; +client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == ecdh_ecdsa orelse KeyAlgo == ecdhe_ecdsa -> + {?config(client_opts, Config), + ?config(server_ecdsa_opts, Config)}; +client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == ecdh_rsa -> + {?config(client_opts, Config), + ?config(server_ecdh_rsa_opts, Config)}. run_suites(Ciphers, Version, Config, Type) -> {ClientOpts, ServerOpts} = @@ -3189,7 +3250,13 @@ run_suites(Ciphers, Version, Config, Type) -> ?config(server_srp_anon, Config)}; srp_dsa -> {?config(client_srp_dsa, Config), - ?config(server_srp_dsa, Config)} + ?config(server_srp_dsa, Config)}; + ecdsa -> + {?config(client_opts, Config), + ?config(server_ecdsa_opts, Config)}; + ecdh_rsa -> + {?config(client_opts, Config), + ?config(server_ecdh_rsa_opts, Config)} end, Result = lists:map(fun(Cipher) -> @@ -3199,7 +3266,7 @@ run_suites(Ciphers, Version, Config, Type) -> [] -> ok; Error -> - ct:print("Cipher suite errors: ~p~n", [Error]), + ct:log("Cipher suite errors: ~p~n", [Error]), ct:fail(cipher_suite_failed_see_test_case_log) end. @@ -3210,7 +3277,7 @@ erlang_cipher_suite(Suite) -> cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> %% process_flag(trap_exit, true), - ct:print("Testing CipherSuite ~p~n", [CipherSuite]), + ct:log("Testing CipherSuite ~p~n", [CipherSuite]), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), ErlangCipherSuite = erlang_cipher_suite(CipherSuite), diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 26938bda50..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). @@ -86,7 +86,7 @@ init_per_suite(Config0) -> Result = (catch make_certs:all(?config(data_dir, Config0), ?config(priv_dir, Config0))), - ct:print("Make certs ~p~n", [Result]), + ct:log("Make certs ~p~n", [Result]), Config1 = ssl_test_lib:make_dsa_cert(Config0), Config = ssl_test_lib:cert_options(Config1), @@ -297,7 +297,7 @@ verify_fun_always_run_client(Config) when is_list(Config) -> %% this is not a bug it is a circumstance of how tcp works! receive {Server, ServerError} -> - ct:print("Server Error ~p~n", [ServerError]) + ct:log("Server Error ~p~n", [ServerError]) end, ssl_test_lib:check_result(Client, {error, {tls_alert, "handshake failure"}}). @@ -346,7 +346,7 @@ verify_fun_always_run_server(Config) when is_list(Config) -> %% this is not a bug it is a circumstance of how tcp works! receive {Client, ClientError} -> - ct:print("Client Error ~p~n", [ClientError]) + ct:log("Client Error ~p~n", [ClientError]) end, ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}). @@ -413,7 +413,7 @@ cert_expired(Config) when is_list(Config) -> two_digits_str(Sec)])), NewValidity = {'Validity', {generalTime, NotBeforeStr}, {generalTime, NotAfterStr}}, - ct:print("Validity: ~p ~n NewValidity: ~p ~n", + ct:log("Validity: ~p ~n NewValidity: ~p ~n", [OTPTbsCert#'OTPTBSCertificate'.validity, NewValidity]), NewOTPTbsCert = OTPTbsCert#'OTPTBSCertificate'{validity = NewValidity}, @@ -644,7 +644,7 @@ no_authority_key_identifier(Config) when is_list(Config) -> NewExtensions = delete_authority_key_extension(Extensions, []), NewOTPTbsCert = OTPTbsCert#'OTPTBSCertificate'{extensions = NewExtensions}, - ct:print("Extensions ~p~n, NewExtensions: ~p~n", [Extensions, NewExtensions]), + ct:log("Extensions ~p~n, NewExtensions: ~p~n", [Extensions, NewExtensions]), NewDerCert = public_key:pkix_sign(NewOTPTbsCert, Key), ssl_test_lib:der_to_pem(NewCertFile, [{'Certificate', NewDerCert, not_encrypted}]), @@ -955,10 +955,10 @@ client_msg(Client, ClientMsg) -> {Client, ClientMsg} -> ok; {Client, {error,closed}} -> - ct:print("client got close"), + ct:log("client got close"), ok; {Client, {error, Reason}} -> - ct:print("client got econnaborted: ~p", [Reason]), + ct:log("client got econnaborted: ~p", [Reason]), ok; Unexpected -> ct:fail(Unexpected) @@ -968,10 +968,10 @@ server_msg(Server, ServerMsg) -> {Server, ServerMsg} -> ok; {Server, {error,closed}} -> - ct:print("server got close"), + ct:log("server got close"), ok; {Server, {error, Reason}} -> - ct:print("server got econnaborted: ~p", [Reason]), + ct:log("server got econnaborted: ~p", [Reason]), ok; Unexpected -> ct:fail(Unexpected) 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_handshake_SUITE.erl b/lib/ssl/test/ssl_npn_handshake_SUITE.erl index 8c1b22cf5e..7b271c4d5d 100644 --- a/lib/ssl/test/ssl_npn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl @@ -74,7 +74,7 @@ init_per_suite(Config) -> Result = (catch make_certs:all(?config(data_dir, Config), ?config(priv_dir, Config))), - ct:print("Make certs ~p~n", [Result]), + ct:log("Make certs ~p~n", [Result]), ssl_test_lib:cert_options(Config) catch _:_ -> {skip, "Crypto did not start"} @@ -311,13 +311,13 @@ run_npn_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) -> assert_npn(Socket, Protocol) -> - ct:print("Negotiated Protocol ~p, Expecting: ~p ~n", + ct:log("Negotiated Protocol ~p, Expecting: ~p ~n", [ssl:negotiated_next_protocol(Socket), Protocol]), Protocol = ssl:negotiated_next_protocol(Socket). assert_npn_and_renegotiate_and_send_data(Socket, Protocol, Data) -> assert_npn(Socket, Protocol), - ct:print("Renegotiating ~n", []), + ct:log("Renegotiating ~n", []), ok = ssl:renegotiate(Socket), ssl:send(Socket, Data), assert_npn(Socket, Protocol), @@ -332,7 +332,7 @@ ssl_receive_and_assert_npn(Socket, Protocol, Data) -> ssl_receive(Socket, Data). ssl_send(Socket, Data) -> - ct:print("Connection info: ~p~n", + ct:log("Connection info: ~p~n", [ssl:connection_info(Socket)]), ssl:send(Socket, Data). @@ -340,11 +340,11 @@ ssl_receive(Socket, Data) -> ssl_receive(Socket, Data, []). ssl_receive(Socket, Data, Buffer) -> - ct:print("Connection info: ~p~n", + ct:log("Connection info: ~p~n", [ssl:connection_info(Socket)]), receive {ssl, Socket, MoreData} -> - ct:print("Received ~p~n",[MoreData]), + ct:log("Received ~p~n",[MoreData]), NewBuffer = Buffer ++ MoreData, case NewBuffer of Data -> diff --git a/lib/ssl/test/ssl_npn_hello_SUITE.erl b/lib/ssl/test/ssl_npn_hello_SUITE.erl index 72768bcb55..ef5a02abef 100644 --- a/lib/ssl/test/ssl_npn_hello_SUITE.erl +++ b/lib/ssl/test/ssl_npn_hello_SUITE.erl @@ -23,8 +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"). %%-------------------------------------------------------------------- @@ -47,67 +49,67 @@ 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:print("~p ~n", [NextProtocolNegotiation]), + 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), + 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">>]), + 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 = <<>>, - cipher_suites = "", + cipher_suites = [?TLS_DHE_DSS_WITH_DES_CBC_SHA], compression_methods = "", next_protocol_negotiation = Npn, renegotiation_info = #renegotiation_info{} }, 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 = <<>>, - cipher_suite = <<1,2>>, + cipher_suite = ?TLS_DHE_DSS_WITH_DES_CBC_SHA, compression_method = 1, next_protocol_negotiation = Npn, renegotiation_info = #renegotiation_info{} @@ -119,7 +121,7 @@ create_connection_states() -> security_parameters = #security_parameters{ server_random = <<1:256>>, compression_algorithm = 1, - cipher_suite = <<1, 2>> + cipher_suite = ?TLS_DHE_DSS_WITH_DES_CBC_SHA } }, diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 4116bb39d1..5a374e234d 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -143,7 +143,7 @@ init_per_suite(Config) -> Result = (catch make_certs:all(?config(data_dir, Config), ?config(priv_dir, Config))), - ct:print("Make certs ~p~n", [Result]), + ct:log("Make certs ~p~n", [Result]), ssl_test_lib:cert_options(Config) catch _:_ -> {skip, "Crypto did not start"} @@ -2069,7 +2069,7 @@ client_packet_decode(Socket, [Head | Tail] = Packet) -> client_packet_decode(Socket, [Head], Tail, Packet). client_packet_decode(Socket, P1, P2, Packet) -> - ct:print("Packet: ~p ~n", [Packet]), + ct:log("Packet: ~p ~n", [Packet]), ok = ssl:send(Socket, P1), ok = ssl:send(Socket, P2), receive diff --git a/lib/ssl/test/ssl_payload_SUITE.erl b/lib/ssl/test/ssl_payload_SUITE.erl index 77ad546420..5f5166391f 100644 --- a/lib/ssl/test/ssl_payload_SUITE.erl +++ b/lib/ssl/test/ssl_payload_SUITE.erl @@ -556,33 +556,33 @@ send(Socket, Data, Size, Repeate,F) -> sender(Socket, Data, Size) -> ok = send(Socket, Data, Size, 100, fun() -> do_recv(Socket, Data, Size, <<>>, false) end), - ct:print("Sender recv: ~p~n", [ssl:getopts(Socket, [active])]), + ct:log("Sender recv: ~p~n", [ssl:getopts(Socket, [active])]), ok. sender_once(Socket, Data, Size) -> send(Socket, Data, Size, 100, fun() -> do_active_once(Socket, Data, Size, <<>>, false) end), - ct:print("Sender active once: ~p~n", + ct:log("Sender active once: ~p~n", [ssl:getopts(Socket, [active])]), ok. sender_active(Socket, Data, Size) -> F = fun() -> do_active(Socket, Data, Size, <<>>, false) end, send(Socket, Data, Size, 100, F), - ct:print("Sender active: ~p~n", [ssl:getopts(Socket, [active])]), + ct:log("Sender active: ~p~n", [ssl:getopts(Socket, [active])]), ok. echoer(Socket, Data, Size) -> - ct:print("Echoer recv: ~p~n", [ssl:getopts(Socket, [active])]), + ct:log("Echoer recv: ~p~n", [ssl:getopts(Socket, [active])]), echo(fun() -> do_recv(Socket, Data, Size, <<>>, true) end, 100). echoer_once(Socket, Data, Size) -> - ct:print("Echoer active once: ~p ~n", + ct:log("Echoer active once: ~p ~n", [ssl:getopts(Socket, [active])]), echo(fun() -> do_active_once(Socket, Data, Size, <<>>, true) end, 100). echoer_active(Socket, Data, Size) -> - ct:print("Echoer active: ~p~n", [ssl:getopts(Socket, [active])]), + ct:log("Echoer active: ~p~n", [ssl:getopts(Socket, [active])]), echo(fun() -> do_active(Socket, Data, Size, <<>>, true) end, 100). echo(_Fun, 0) -> ok; diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index fd9a0a594c..6cc6c4bdb2 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -63,7 +63,7 @@ init_per_suite(Config0) -> Result = (catch make_certs:all(?config(data_dir, Config0), ?config(priv_dir, Config0))), - ct:print("Make certs ~p~n", [Result]), + ct:log("Make certs ~p~n", [Result]), Config1 = ssl_test_lib:make_dsa_cert(Config0), Config = ssl_test_lib:cert_options(Config1), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index e4fedcd118..34c52b10b3 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -59,7 +59,7 @@ run_server(Opts) -> Options = proplists:get_value(options, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), - ct:print("ssl:listen(~p, ~p)~n", [Port, Options]), + ct:log("ssl:listen(~p, ~p)~n", [Port, Options]), {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), @@ -77,13 +77,13 @@ do_run_server(ListenSocket, AcceptSocket, Opts) -> Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), {Module, Function, Args} = proplists:get_value(mfa, Opts), - ct:print("Server: apply(~p,~p,~p)~n", + ct:log("Server: apply(~p,~p,~p)~n", [Module, Function, [AcceptSocket | Args]]), case rpc:call(Node, Module, Function, [AcceptSocket | Args]) of no_result_msg -> ok; Msg -> - ct:print("Server Msg: ~p ~n", [Msg]), + ct:log("Server Msg: ~p ~n", [Msg]), Pid ! {self(), Msg} end, receive @@ -92,10 +92,10 @@ do_run_server(ListenSocket, AcceptSocket, Opts) -> {listen, MFA} -> run_server(ListenSocket, [MFA | proplists:delete(mfa, Opts)]); close -> - ct:print("Server closing ~p ~n", [self()]), + ct:log("Server closing ~p ~n", [self()]), Result = rpc:call(Node, Transport, close, [AcceptSocket], 500), Result1 = rpc:call(Node, Transport, close, [ListenSocket], 500), - ct:print("Result ~p : ~p ~n", [Result, Result1]); + ct:log("Result ~p : ~p ~n", [Result, Result1]); {ssl_closed, _} -> ok end. @@ -115,7 +115,7 @@ connect(#sslsocket{} = ListenSocket, Opts) -> end; connect(ListenSocket, Opts) -> Node = proplists:get_value(node, Opts), - ct:print("gen_tcp:accept(~p)~n", [ListenSocket]), + ct:log("gen_tcp:accept(~p)~n", [ListenSocket]), {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]), AcceptSocket. @@ -123,10 +123,10 @@ connect(ListenSocket, Opts) -> connect(_, _, 0, AcceptSocket, _) -> AcceptSocket; connect(ListenSocket, Node, N, _, Timeout) -> - ct:print("ssl:transport_accept(~p)~n", [ListenSocket]), + ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, [ListenSocket]), - ct:print("ssl:ssl_accept(~p, ~p)~n", [AcceptSocket, Timeout]), + ct:log("ssl:ssl_accept(~p, ~p)~n", [AcceptSocket, Timeout]), case rpc:call(Node, ssl, ssl_accept, [AcceptSocket, Timeout]) of ok -> @@ -161,27 +161,27 @@ run_client(Opts) -> Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), Options = proplists:get_value(options, Opts), - ct:print("ssl:connect(~p, ~p, ~p)~n", [Host, Port, Options]), + ct:log("ssl:connect(~p, ~p, ~p)~n", [Host, Port, Options]), case rpc:call(Node, Transport, connect, [Host, Port, Options]) of {ok, Socket} -> Pid ! { connected, Socket }, - ct:print("Client: connected~n", []), + ct:log("Client: connected~n", []), %% In special cases we want to know the client port, it will %% be indicated by sending {port, 0} in options list! send_selected_port(Pid, proplists:get_value(port, Options), Socket), {Module, Function, Args} = proplists:get_value(mfa, Opts), - ct:print("Client: apply(~p,~p,~p)~n", + ct:log("Client: apply(~p,~p,~p)~n", [Module, Function, [Socket | Args]]), case rpc:call(Node, Module, Function, [Socket | Args]) of no_result_msg -> ok; Msg -> - ct:print("Client Msg: ~p ~n", [Msg]), + ct:log("Client Msg: ~p ~n", [Msg]), Pid ! {self(), Msg} end, receive close -> - ct:print("Client closing~n", []), + ct:log("Client closing~n", []), rpc:call(Node, Transport, close, [Socket]); {ssl_closed, Socket} -> ok; @@ -189,18 +189,18 @@ run_client(Opts) -> ok end; {error, Reason} -> - ct:print("Client: connection failed: ~p ~n", [Reason]), + ct:log("Client: connection failed: ~p ~n", [Reason]), Pid ! {self(), {error, Reason}} end. close(Pid) -> - ct:print("Close ~p ~n", [Pid]), + ct:log("Close ~p ~n", [Pid]), Monitor = erlang:monitor(process, Pid), Pid ! close, receive {'DOWN', Monitor, process, Pid, Reason} -> erlang:demonitor(Monitor), - ct:print("Pid: ~p down due to:~p ~n", [Pid, Reason]) + ct:log("Pid: ~p down due to:~p ~n", [Pid, Reason]) end. check_result(Server, ServerMsg, Client, ClientMsg) -> @@ -285,7 +285,7 @@ user_lookup(psk, _Identity, UserState) -> {ok, UserState}; user_lookup(srp, Username, _UserState) -> Salt = ssl:random_bytes(16), - UserPassHash = crypto:sha([Salt, crypto:sha([Username, <<$:>>, <<"secret">>])]), + UserPassHash = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, <<"secret">>])]), {ok, {srp_1024, Salt, UserPassHash}}. cert_options(Config) -> @@ -404,6 +404,51 @@ make_dsa_cert(Config) -> {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} | Config]. +make_ecdsa_cert(Config) -> + CryptoSupport = crypto:supports(), + case proplists:get_bool(ecdsa, proplists:get_value(public_keys, CryptoSupport)) of + true -> + {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, ec, ec, ""), + {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, ec, ec, ""), + [{server_ecdsa_opts, [{ssl_imp, new},{reuseaddr, true}, + {cacertfile, ServerCaCertFile}, + {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, + {server_ecdsa_verify_opts, [{ssl_imp, new},{reuseaddr, true}, + {cacertfile, ClientCaCertFile}, + {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, + {verify, verify_peer}]}, + {client_ecdsa_opts, [{ssl_imp, new},{reuseaddr, true}, + {cacertfile, ClientCaCertFile}, + {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} + | Config]; + _ -> + Config + end. + +%% RFC 4492, Sect. 2.3. ECDH_RSA +%% +%% This key exchange algorithm is the same as ECDH_ECDSA except that the +%% server's certificate MUST be signed with RSA rather than ECDSA. +make_ecdh_rsa_cert(Config) -> + CryptoSupport = crypto:supports(), + case proplists:get_bool(ecdh, proplists:get_value(public_keys, CryptoSupport)) of + true -> + {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, rsa, ec, "rsa_"), + {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, rsa, ec, "rsa_"), + [{server_ecdh_rsa_opts, [{ssl_imp, new},{reuseaddr, true}, + {cacertfile, ServerCaCertFile}, + {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, + {server_ecdh_rsa_verify_opts, [{ssl_imp, new},{reuseaddr, true}, + {cacertfile, ClientCaCertFile}, + {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, + {verify, verify_peer}]}, + {client_ecdh_rsa_opts, [{ssl_imp, new},{reuseaddr, true}, + {cacertfile, ClientCaCertFile}, + {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} + | Config]; + _ -> + Config + end. make_mix_cert(Config) -> {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, dsa, @@ -455,33 +500,33 @@ run_upgrade_server(Opts) -> SslOptions = proplists:get_value(ssl_options, Opts), Pid = proplists:get_value(from, Opts), - ct:print("gen_tcp:listen(~p, ~p)~n", [Port, TcpOptions]), + ct:log("gen_tcp:listen(~p, ~p)~n", [Port, TcpOptions]), {ok, ListenSocket} = rpc:call(Node, gen_tcp, listen, [Port, TcpOptions]), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), - ct:print("gen_tcp:accept(~p)~n", [ListenSocket]), + ct:log("gen_tcp:accept(~p)~n", [ListenSocket]), {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]), try {ok, SslAcceptSocket} = case TimeOut of infinity -> - ct:print("ssl:ssl_accept(~p, ~p)~n", + ct:log("ssl:ssl_accept(~p, ~p)~n", [AcceptSocket, SslOptions]), rpc:call(Node, ssl, ssl_accept, [AcceptSocket, SslOptions]); _ -> - ct:print("ssl:ssl_accept(~p, ~p, ~p)~n", + ct:log("ssl:ssl_accept(~p, ~p, ~p)~n", [AcceptSocket, SslOptions, TimeOut]), rpc:call(Node, ssl, ssl_accept, [AcceptSocket, SslOptions, TimeOut]) end, {Module, Function, Args} = proplists:get_value(mfa, Opts), Msg = rpc:call(Node, Module, Function, [SslAcceptSocket | Args]), - ct:print("Upgrade Server Msg: ~p ~n", [Msg]), + ct:log("Upgrade Server Msg: ~p ~n", [Msg]), Pid ! {self(), Msg}, receive close -> - ct:print("Upgrade Server closing~n", []), + ct:log("Upgrade Server closing~n", []), rpc:call(Node, ssl, close, [SslAcceptSocket]) end catch error:{badmatch, Error} -> @@ -499,24 +544,24 @@ run_upgrade_client(Opts) -> TcpOptions = proplists:get_value(tcp_options, Opts), SslOptions = proplists:get_value(ssl_options, Opts), - ct:print("gen_tcp:connect(~p, ~p, ~p)~n", + ct:log("gen_tcp:connect(~p, ~p, ~p)~n", [Host, Port, TcpOptions]), {ok, Socket} = rpc:call(Node, gen_tcp, connect, [Host, Port, TcpOptions]), send_selected_port(Pid, Port, Socket), - ct:print("ssl:connect(~p, ~p)~n", [Socket, SslOptions]), + ct:log("ssl:connect(~p, ~p)~n", [Socket, SslOptions]), {ok, SslSocket} = rpc:call(Node, ssl, connect, [Socket, SslOptions]), {Module, Function, Args} = proplists:get_value(mfa, Opts), - ct:print("apply(~p, ~p, ~p)~n", + ct:log("apply(~p, ~p, ~p)~n", [Module, Function, [SslSocket | Args]]), Msg = rpc:call(Node, Module, Function, [SslSocket | Args]), - ct:print("Upgrade Client Msg: ~p ~n", [Msg]), + ct:log("Upgrade Client Msg: ~p ~n", [Msg]), Pid ! {self(), Msg}, receive close -> - ct:print("Upgrade Client closing~n", []), + ct:log("Upgrade Client closing~n", []), rpc:call(Node, ssl, close, [SslSocket]) end. @@ -535,20 +580,20 @@ run_upgrade_server_error(Opts) -> SslOptions = proplists:get_value(ssl_options, Opts), Pid = proplists:get_value(from, Opts), - ct:print("gen_tcp:listen(~p, ~p)~n", [Port, TcpOptions]), + ct:log("gen_tcp:listen(~p, ~p)~n", [Port, TcpOptions]), {ok, ListenSocket} = rpc:call(Node, gen_tcp, listen, [Port, TcpOptions]), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), - ct:print("gen_tcp:accept(~p)~n", [ListenSocket]), + ct:log("gen_tcp:accept(~p)~n", [ListenSocket]), {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]), Error = case TimeOut of infinity -> - ct:print("ssl:ssl_accept(~p, ~p)~n", + ct:log("ssl:ssl_accept(~p, ~p)~n", [AcceptSocket, SslOptions]), rpc:call(Node, ssl, ssl_accept, [AcceptSocket, SslOptions]); _ -> - ct:print("ssl:ssl_accept(~p, ~p, ~p)~n", + ct:log("ssl:ssl_accept(~p, ~p, ~p)~n", [AcceptSocket, SslOptions, TimeOut]), rpc:call(Node, ssl, ssl_accept, [AcceptSocket, SslOptions, TimeOut]) @@ -568,26 +613,26 @@ run_server_error(Opts) -> Options = proplists:get_value(options, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), - ct:print("ssl:listen(~p, ~p)~n", [Port, Options]), + ct:log("ssl:listen(~p, ~p)~n", [Port, Options]), case rpc:call(Node, Transport, listen, [Port, Options]) of {ok, #sslsocket{} = ListenSocket} -> %% To make sure error_client will %% get {error, closed} and not {error, connection_refused} Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), - ct:print("ssl:transport_accept(~p)~n", [ListenSocket]), + ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), case rpc:call(Node, Transport, transport_accept, [ListenSocket]) of {error, _} = Error -> Pid ! {self(), Error}; {ok, AcceptSocket} -> - ct:print("ssl:ssl_accept(~p)~n", [AcceptSocket]), + ct:log("ssl:ssl_accept(~p)~n", [AcceptSocket]), Error = rpc:call(Node, ssl, ssl_accept, [AcceptSocket]), Pid ! {self(), Error} end; {ok, ListenSocket} -> Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), - ct:print("~p:accept(~p)~n", [Transport, ListenSocket]), + ct:log("~p:accept(~p)~n", [Transport, ListenSocket]), case rpc:call(Node, Transport, accept, [ListenSocket]) of {error, _} = Error -> Pid ! {self(), Error} @@ -609,7 +654,7 @@ run_client_error(Opts) -> Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), Options = proplists:get_value(options, Opts), - ct:print("ssl:connect(~p, ~p, ~p)~n", [Host, Port, Options]), + ct:log("ssl:connect(~p, ~p, ~p)~n", [Host, Port, Options]), Error = rpc:call(Node, Transport, connect, [Host, Port, Options]), Pid ! {self(), Error}. @@ -666,11 +711,16 @@ send_selected_port(Pid, 0, Socket) -> send_selected_port(_,_,_) -> ok. -rsa_suites() -> - lists:filter(fun({dhe_dss, _, _}) -> - false; +rsa_suites(CounterPart) -> + ECC = is_sane_ecc(CounterPart), + lists:filter(fun({rsa, _, _}) -> + true; + ({dhe_rsa, _, _}) -> + true; + ({ecdhe_rsa, _, _}) when ECC == true -> + true; (_) -> - true + false end, ssl:cipher_suites()). @@ -690,17 +740,38 @@ dsa_suites() -> end, ssl:cipher_suites()). +ecdsa_suites() -> + lists:filter(fun({ecdhe_ecdsa, _, _}) -> + true; + (_) -> + false + end, + ssl:cipher_suites()). + +ecdh_rsa_suites() -> + lists:filter(fun({ecdh_rsa, _, _}) -> + true; + (_) -> + false + end, + ssl:cipher_suites()). -openssl_rsa_suites() -> +openssl_rsa_suites(CounterPart) -> Ciphers = ssl:cipher_suites(openssl), + Names = case is_sane_ecc(CounterPart) of + true -> + "DSS | ECDSA"; + false -> + "DSS | ECDHE | ECDH" + end, lists:filter(fun(Str) -> - case re:run(Str,"DSS",[]) of + case re:run(Str, Names,[]) of nomatch -> - true; + false; _ -> - false + true end - end, Ciphers). + end, Ciphers). openssl_dsa_suites() -> Ciphers = ssl:cipher_suites(openssl), @@ -713,18 +784,56 @@ openssl_dsa_suites() -> end end, Ciphers). +openssl_ecdsa_suites() -> + Ciphers = ssl:cipher_suites(openssl), + lists:filter(fun(Str) -> + case re:run(Str,"ECDHE-ECDSA",[]) of + nomatch -> + false; + _ -> + true + end + end, Ciphers). + +openssl_ecdh_rsa_suites() -> + Ciphers = ssl:cipher_suites(openssl), + lists:filter(fun(Str) -> + case re:run(Str,"ECDH-RSA",[]) of + nomatch -> + false; + _ -> + true + end + end, Ciphers). + anonymous_suites() -> - [{dh_anon, rc4_128, md5}, - {dh_anon, des_cbc, sha}, - {dh_anon, '3des_ede_cbc', sha}, - {dh_anon, aes_128_cbc, sha}, - {dh_anon, aes_256_cbc, sha}]. + Suites = + [{dh_anon, rc4_128, md5}, + {dh_anon, des_cbc, sha}, + {dh_anon, '3des_ede_cbc', sha}, + {dh_anon, aes_128_cbc, sha}, + {dh_anon, aes_256_cbc, sha}, + {ecdh_anon,rc4_128,sha}, + {ecdh_anon,'3des_ede_cbc',sha}, + {ecdh_anon,aes_128_cbc,sha}, + {ecdh_anon,aes_256_cbc,sha}], + ssl_cipher:filter_suites(Suites). psk_suites() -> - [{rsa_psk, rc4_128, sha}, - {rsa_psk, '3des_ede_cbc', sha}, - {rsa_psk, aes_128_cbc, sha}, - {rsa_psk, aes_256_cbc, sha}]. + Suites = + [{psk, rc4_128, sha}, + {psk, '3des_ede_cbc', sha}, + {psk, aes_128_cbc, sha}, + {psk, aes_256_cbc, sha}, + {dhe_psk, rc4_128, sha}, + {dhe_psk, '3des_ede_cbc', sha}, + {dhe_psk, aes_128_cbc, sha}, + {dhe_psk, aes_256_cbc, sha}, + {rsa_psk, rc4_128, sha}, + {rsa_psk, '3des_ede_cbc', sha}, + {rsa_psk, aes_128_cbc, sha}, + {rsa_psk, aes_256_cbc, sha}], + ssl_cipher:filter_suites(Suites). psk_anon_suites() -> [{psk, rc4_128, sha}, @@ -737,9 +846,14 @@ psk_anon_suites() -> {dhe_psk, aes_256_cbc, sha}]. srp_suites() -> - [{srp_rsa, '3des_ede_cbc', sha}, - {srp_rsa, aes_128_cbc, sha}, - {srp_rsa, aes_256_cbc, sha}]. + Suites = + [{srp_anon, '3des_ede_cbc', sha}, + {srp_rsa, '3des_ede_cbc', sha}, + {srp_anon, aes_128_cbc, sha}, + {srp_rsa, aes_128_cbc, sha}, + {srp_anon, aes_256_cbc, sha}, + {srp_rsa, aes_256_cbc, sha}], + ssl_cipher:filter_suites(Suites). srp_anon_suites() -> [{srp_anon, '3des_ede_cbc', sha}, @@ -747,9 +861,11 @@ srp_anon_suites() -> {srp_anon, aes_256_cbc, sha}]. srp_dss_suites() -> - [{srp_dss, '3des_ede_cbc', sha}, - {srp_dss, aes_128_cbc, sha}, - {srp_dss, aes_256_cbc, sha}]. + Suites = + [{srp_dss, '3des_ede_cbc', sha}, + {srp_dss, aes_128_cbc, sha}, + {srp_dss, aes_256_cbc, sha}], + ssl_cipher:filter_suites(Suites). pem_to_der(File) -> {ok, PemBin} = file:read_file(File), @@ -761,7 +877,7 @@ der_to_pem(File, Entries) -> cipher_result(Socket, Result) -> Result = ssl:connection_info(Socket), - ct:print("Successfull connect: ~p~n", [Result]), + ct:log("Successfull connect: ~p~n", [Result]), %% Importante to send two packets here %% to properly test "cipher state" handling ssl:send(Socket, "Hello\n"), @@ -831,15 +947,11 @@ init_tls_version(Version) -> ssl:start(). sufficient_crypto_support('tlsv1.2') -> - Data = "Sampl", - Data2 = "e #1", - Key = <<0,1,2,3,16,17,18,19,32,33,34,35,48,49,50,51,4,5,6,7,20,21,22,23,36,37,38,39, - 52,53,54,55,8,9,10,11,24,25,26,27,40,41,42,43,56,57,58,59>>, - try - crypto:sha256_mac(Key, lists:flatten([Data, Data2])), - true - catch _:_ -> false - end; + CryptoSupport = crypto:supports(), + proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)); +sufficient_crypto_support(ciphers_ec) -> + CryptoSupport = crypto:supports(), + proplists:get_bool(ecdh, proplists:get_value(public_keys, CryptoSupport)); sufficient_crypto_support(_) -> true. @@ -872,3 +984,45 @@ send_recv_result_active_once(Socket) -> {ssl, Socket, "Hello world"} -> ok end. + +is_sane_ecc(openssl) -> + case os:cmd("openssl version") of + "OpenSSL 1.0.0a" ++ _ -> % Known bug in openssl + %% manifests as SSL_CHECK_SERVERHELLO_TLSEXT:tls invalid ecpointformat list + false; + "OpenSSL 1.0.0" ++ _ -> % Known bug in openssl + %% manifests as SSL_CHECK_SERVERHELLO_TLSEXT:tls invalid ecpointformat list + false; + "OpenSSL 0.9.8" ++ _ -> % Does not support ECC + false; + "OpenSSL 0.9.7" ++ _ -> % Does not support ECC + false; + _ -> + true + end; +is_sane_ecc(crypto) -> + [{_,_, Bin}] = crypto:info_lib(), + case binary_to_list(Bin) of + "OpenSSL 0.9.8" ++ _ -> % Does not support ECC + false; + "OpenSSL 0.9.7" ++ _ -> % Does not support ECC + false; + _ -> + true + end; +is_sane_ecc(_) -> + true. + +cipher_restriction(Config0) -> + case is_sane_ecc(openssl) of + false -> + Opts = proplists:get_value(server_opts, Config0), + Config1 = proplists:delete(server_opts, Config0), + VerOpts = proplists:get_value(server_verification_opts, Config1), + Config = proplists:delete(server_verification_opts, Config1), + Restricted0 = ssl:cipher_suites() -- ecdsa_suites(), + Restricted = Restricted0 -- ecdh_rsa_suites(), + [{server_opts, [{ciphers, Restricted} | Opts]}, {server_verification_opts, [{ciphers, Restricted} | VerOpts] } | Config]; + true -> + Config0 + end. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index a3d382f837..0564b37f1c 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -104,10 +104,11 @@ init_per_suite(Config0) -> Result = (catch make_certs:all(?config(data_dir, Config0), ?config(priv_dir, Config0))), - ct:print("Make certs ~p~n", [Result]), + ct:log("Make certs ~p~n", [Result]), Config1 = ssl_test_lib:make_dsa_cert(Config0), - Config = ssl_test_lib:cert_options(Config1), - [{watchdog, Dog} | Config] + Config2 = ssl_test_lib:cert_options(Config1), + Config = [{watchdog, Dog} | Config2], + ssl_test_lib:cipher_restriction(Config) catch _:_ -> {skip, "Crypto did not start"} end @@ -200,7 +201,7 @@ basic_erlang_client_openssl_server(Config) when is_list(Config) -> Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile, - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -212,7 +213,7 @@ basic_erlang_client_openssl_server(Config) when is_list(Config) -> {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, {options, ClientOpts}]), - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Client, ok), @@ -241,10 +242,10 @@ basic_erlang_server_openssl_client(Config) when is_list(Config) -> Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ " -host localhost", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - port_command(OpenSslPort, Data), + true = port_command(OpenSslPort, Data), ssl_test_lib:check_result(Server, ok), @@ -268,11 +269,11 @@ 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, - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -284,7 +285,7 @@ erlang_client_openssl_server(Config) when is_list(Config) -> {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, {options, ClientOpts}]), - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Client, ok), @@ -309,15 +310,15 @@ 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", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - port_command(OpenSslPort, Data), + true = port_command(OpenSslPort, Data), ssl_test_lib:check_result(Server, ok), @@ -343,13 +344,13 @@ 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 ++ " -key " ++ KeyFile ++ " -Verify 2 -msg", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -362,7 +363,7 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) -> erlang_ssl_receive, [Data]}}, {options, ClientOpts}]), - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Client, ok), @@ -391,15 +392,15 @@ 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", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - port_command(OpenSslPort, Data), + true = port_command(OpenSslPort, Data), ssl_test_lib:check_result(Server, ok), @@ -427,15 +428,15 @@ 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", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - port_command(OpenSslPort, Data), + true = port_command(OpenSslPort, Data), ssl_test_lib:check_result(Server, ok), @@ -462,12 +463,12 @@ 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", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -480,9 +481,9 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> delayed_send, [[ErlData, OpenSslData]]}}, {options, ClientOpts}]), - port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), + true = port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), ct:sleep(?SLEEP), - port_command(OpensslPort, OpenSslData), + true = port_command(OpensslPort, OpenSslData), ssl_test_lib:check_result(Client, ok), @@ -512,11 +513,11 @@ 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", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -558,15 +559,15 @@ 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", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - port_command(OpenSslPort, Data), + true = port_command(OpenSslPort, Data), ssl_test_lib:check_result(Server, ok), @@ -593,11 +594,11 @@ 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", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -610,7 +611,7 @@ erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) -> erlang_ssl_receive, [Data]}}, {options, ClientOpts}]), - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Client, ok), @@ -635,12 +636,12 @@ 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", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -652,7 +653,7 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) -> {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, {options, ClientOpts}]), - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Client, ok), @@ -686,15 +687,15 @@ 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", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - port_command(OpenSslPort, Data), + true = port_command(OpenSslPort, Data), ssl_test_lib:check_result(Server, ok), @@ -711,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", @@ -747,9 +748,9 @@ 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(), + Ciphers = ssl_test_lib:rsa_suites(openssl), run_suites(Ciphers, Version, Config, rsa). %%-------------------------------------------------------------------- @@ -757,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). @@ -775,11 +776,11 @@ 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 ++ "", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -793,7 +794,7 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> [{versions, [Version]} | ClientOpts]}]), %% Send garbage - port_command(OpensslPort, ?OPENSSL_GARBAGE), + true = port_command(OpensslPort, ?OPENSSL_GARBAGE), ct:sleep(?SLEEP), @@ -835,7 +836,7 @@ expired_session(Config) when is_list(Config) -> Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -893,10 +894,10 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ " -host localhost -ssl2 -msg", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), - port_command(OpenSslPort, Data), + true = port_command(OpenSslPort, Data), receive {'EXIT', OpenSslPort, _} -> ok @@ -912,7 +913,7 @@ erlang_client_openssl_server_npn() -> erlang_client_openssl_server_npn(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, fun(Client, OpensslPort) -> - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Client, ok) end), @@ -925,9 +926,9 @@ erlang_client_openssl_server_npn_renegotiate() -> erlang_client_openssl_server_npn_renegotiate(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, fun(Client, OpensslPort) -> - port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), + true = port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), ct:sleep(?SLEEP), - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Client, ok) end), ok. @@ -939,7 +940,7 @@ erlang_server_openssl_client_npn(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, fun(Server, OpensslPort) -> - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) end), ok. @@ -951,9 +952,9 @@ erlang_server_openssl_client_npn_renegotiate() -> erlang_server_openssl_client_npn_renegotiate(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, fun(Server, OpensslPort) -> - port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), + true = port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), ct:sleep(?SLEEP), - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) end), ok. @@ -962,7 +963,7 @@ erlang_client_openssl_server_npn_only_server(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_client_and_openssl_server_with_opts(Config, [], "-nextprotoneg spdy/2", Data, fun(Server, OpensslPort) -> - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) end), ok. @@ -975,7 +976,7 @@ erlang_client_openssl_server_npn_only_client(Config) when is_list(Config) -> [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}}], "", Data, fun(Server, OpensslPort) -> - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) end), ok. @@ -985,7 +986,7 @@ erlang_server_openssl_client_npn_only_server(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_server_and_openssl_client_with_opts(Config, [{next_protocols_advertised, [<<"spdy/2">>]}], "", Data, fun(Server, OpensslPort) -> - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) end), ok. @@ -994,7 +995,7 @@ erlang_server_openssl_client_npn_only_client(Config) when is_list(Config) -> Data = "From openssl to erlang", start_erlang_server_and_openssl_client_with_opts(Config, [], "-nextprotoneg spdy/2", Data, fun(Server, OpensslPort) -> - port_command(OpensslPort, Data), + true = port_command(OpensslPort, Data), ssl_test_lib:check_result(Server, ok) end), ok. @@ -1020,13 +1021,13 @@ run_suites(Ciphers, Version, Config, Type) -> [] -> ok; Error -> - ct:print("Cipher suite errors: ~p~n", [Error]), + ct:log("Cipher suite errors: ~p~n", [Error]), ct:fail(cipher_suite_failed_see_test_case_log) end. cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> process_flag(trap_exit, true), - ct:print("Testing CipherSuite ~p~n", [CipherSuite]), + ct:log("Testing CipherSuite ~p~n", [CipherSuite]), {ClientNode, _ServerNode, Hostname} = ssl_test_lib:run_where(Config), Port = ssl_test_lib:inet_port(node()), @@ -1036,7 +1037,7 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -1052,19 +1053,19 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> [{ciphers,[CipherSuite]} | ClientOpts]}]), - port_command(OpenSslPort, "Hello\n"), + true = port_command(OpenSslPort, "Hello\n"), receive {Port, {data, _}} when is_port(Port) -> ok after 500 -> - ct:print("Time out on openssl port, check that" + ct:log("Time out on openssl port, check that" " the messages Hello and world are received" " during close of port" , []), ok end, - port_command(OpenSslPort, " world\n"), + true = port_command(OpenSslPort, " world\n"), Result = ssl_test_lib:wait_for_result(Client, ok), @@ -1094,13 +1095,13 @@ 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) ++ " -cert " ++ CertFile ++ " -key " ++ KeyFile, - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -1134,12 +1135,12 @@ 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, - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -1173,11 +1174,11 @@ 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", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -1202,11 +1203,11 @@ 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", - ct:print("openssl cmd: ~p~n", [Cmd]), + ct:log("openssl cmd: ~p~n", [Cmd]), OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), @@ -1225,7 +1226,7 @@ erlang_ssl_receive_and_assert_npn(Socket, Protocol, Data) -> ok. erlang_ssl_receive(Socket, Data) -> - ct:print("Connection info: ~p~n", + ct:log("Connection info: ~p~n", [ssl:connection_info(Socket)]), receive {ssl, Socket, Data} -> @@ -1247,7 +1248,7 @@ erlang_ssl_receive(Socket, Data) -> connection_info(Socket, Version) -> case ssl:connection_info(Socket) of {ok, {Version, _} = Info} -> - ct:print("Connection info: ~p~n", [Info]), + ct:log("Connection info: ~p~n", [Info]), ok; {ok, {OtherVersion, _}} -> {wrong_version, OtherVersion} @@ -1269,28 +1270,28 @@ close_port(Port) -> close_loop(Port, Time, SentClose) -> receive {Port, {data,Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), + ct:log("openssl ~s~n",[Debug]), close_loop(Port, Time, SentClose); {ssl,_,Msg} -> - io:format("ssl Msg ~s~n",[Msg]), + ct:log("ssl Msg ~s~n",[Msg]), close_loop(Port, Time, SentClose); {Port, closed} -> - io:format("Port Closed~n",[]), + ct:log("Port Closed~n",[]), ok; {'EXIT', Port, Reason} -> - io:format("Port Closed ~p~n",[Reason]), + ct:log("Port Closed ~p~n",[Reason]), ok; Msg -> - io:format("Port Msg ~p~n",[Msg]), + ct:log("Port Msg ~p~n",[Msg]), close_loop(Port, Time, SentClose) after Time -> case SentClose of false -> - io:format("Closing port ~n",[]), + ct:log("Closing port ~n",[]), catch erlang:port_close(Port), close_loop(Port, Time, true); true -> - io:format("Timeout~n",[]) + ct:log("Timeout~n",[]) end end. @@ -1305,7 +1306,7 @@ server_sent_garbage(Socket) -> wait_for_openssl_server() -> receive {Port, {data, Debug}} when is_port(Port) -> - io:format("openssl ~s~n",[Debug]), + ct:log("openssl ~s~n",[Debug]), %% openssl has started make sure %% it will be in accept. Parsing %% output is too error prone. (Even 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 fe7e0f8e60..121f9febed 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -300,12 +300,12 @@ 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, String) -> +make_crypto_key(des3_cbc=Type, String) -> <<K1:8/binary,K2:8/binary>> = First = erlang:md5(String), <<K3:8/binary,IVec:8/binary>> = erlang:md5([First|reverse(String)]), - {K1,K2,K3,IVec}. + {Type,[K1,K2,K3],IVec,8}. %% %% Local functions @@ -864,20 +864,20 @@ mandatory_chunks() -> -define(CRYPTO_KEY_SERVER, beam_lib__crypto_key_server). -decrypt_abst(Mode, Module, File, Id, AtomTable, Bin) -> +decrypt_abst(Type, Module, File, Id, AtomTable, Bin) -> try - KeyString = get_crypto_key({debug_info, Mode, Module, File}), - Key = make_crypto_key(des3_cbc, KeyString), - Term = decrypt_abst_1(Mode, Key, Bin), + KeyString = get_crypto_key({debug_info, Type, Module, File}), + Key = make_crypto_key(Type, KeyString), + Term = decrypt_abst_1(Key, Bin), {AtomTable, {Id, Term}} catch _:_ -> error({key_missing_or_invalid, File, Id}) end. -decrypt_abst_1(des3_cbc, {K1, K2, K3, IVec}, Bin) -> +decrypt_abst_1({Type,Key,IVec,_BlockSize}, Bin) -> ok = start_crypto(), - NewBin = crypto:des3_cbc_decrypt(K1, K2, K3, IVec, Bin), + NewBin = crypto:block_decrypt(Type, Key, IVec, Bin), binary_to_term(NewBin). start_crypto() -> 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/epp.erl b/lib/stdlib/src/epp.erl index e31cd63f69..d1d060ebc8 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -601,7 +601,7 @@ enter_file2(NewF, Pname, From, St0, AtLocation) -> %% file will depend on the order of file inclusions in the parent files Path = [filename:dirname(Pname) | tl(St0#epp.path)], _ = set_encoding(NewF), - #epp{file=NewF,location=Loc,name=Pname,delta=0, + #epp{file=NewF,location=Loc,name=Pname,name2=Pname,delta=0, sstk=[St0|St0#epp.sstk],path=Path,macs=Ms}. enter_file_reply(From, Name, Location, AtLocation) -> 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_lint.erl b/lib/stdlib/src/erl_lint.erl index 68a8534f15..08b8541014 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -522,8 +522,7 @@ start(File, Opts) -> warn_format = value_option(warn_format, 1, warn_format, 1, nowarn_format, 0, Opts), enabled_warnings = Enabled, - file = File, - types = default_types() + file = File }. %% is_warn_enabled(Category, St) -> boolean(). @@ -1007,7 +1006,10 @@ check_undefined_functions(#lint{called=Called0,defined=Def0}=St0) -> check_undefined_types(#lint{usage=Usage,types=Def}=St0) -> Used = Usage#usage.used_types, UTAs = dict:fetch_keys(Used), - Undef = [{TA,dict:fetch(TA, Used)} || TA <- UTAs, not dict:is_key(TA, Def)], + Undef = [{TA,dict:fetch(TA, Used)} || + TA <- UTAs, + not dict:is_key(TA, Def), + not is_default_type(TA)], foldl(fun ({TA,L}, St) -> add_error(L, {undefined_type,TA}, St) end, St0, Undef). @@ -2440,7 +2442,7 @@ type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> end, case (dict:is_key(TypePair, TypeDefs) orelse is_var_arity_type(TypeName)) of true -> - case dict:is_key(TypePair, default_types()) of + case is_default_type(TypePair) of true -> case is_newly_introduced_builtin_type(TypePair) of %% allow some types just for bootstrapping @@ -2488,8 +2490,8 @@ check_type({paren_type, _L, [Type]}, SeenVars, St) -> check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]}, SeenVars, #lint{module=CurrentMod} = St) -> St1 = - case (dict:is_key({Name, length(Args)}, default_types()) - orelse is_var_arity_type(Name)) of + case is_default_type({Name, length(Args)}) + orelse is_var_arity_type(Name) of true -> add_error(L, {imported_predefined_type, Name}, St); false -> St end, @@ -2606,63 +2608,62 @@ is_var_arity_type(union) -> true; is_var_arity_type(record) -> true; is_var_arity_type(_) -> false. -default_types() -> - DefTypes = [{any, 0}, - {arity, 0}, - {array, 0}, - {atom, 0}, - {atom, 1}, - {binary, 0}, - {binary, 2}, - {bitstring, 0}, - {bool, 0}, - {boolean, 0}, - {byte, 0}, - {char, 0}, - {dict, 0}, - {digraph, 0}, - {float, 0}, - {'fun', 0}, - {'fun', 2}, - {function, 0}, - {gb_set, 0}, - {gb_tree, 0}, - {identifier, 0}, - {integer, 0}, - {integer, 1}, - {iodata, 0}, - {iolist, 0}, - {list, 0}, - {list, 1}, - {maybe_improper_list, 0}, - {maybe_improper_list, 2}, - {mfa, 0}, - {module, 0}, - {neg_integer, 0}, - {nil, 0}, - {no_return, 0}, - {node, 0}, - {non_neg_integer, 0}, - {none, 0}, - {nonempty_list, 0}, - {nonempty_list, 1}, - {nonempty_improper_list, 2}, - {nonempty_maybe_improper_list, 0}, - {nonempty_maybe_improper_list, 2}, - {nonempty_string, 0}, - {number, 0}, - {pid, 0}, - {port, 0}, - {pos_integer, 0}, - {queue, 0}, - {range, 2}, - {reference, 0}, - {set, 0}, - {string, 0}, - {term, 0}, - {timeout, 0}, - {var, 1}], - dict:from_list([{T, -1} || T <- DefTypes]). +is_default_type({any, 0}) -> true; +is_default_type({arity, 0}) -> true; +is_default_type({array, 0}) -> true; +is_default_type({atom, 0}) -> true; +is_default_type({atom, 1}) -> true; +is_default_type({binary, 0}) -> true; +is_default_type({binary, 2}) -> true; +is_default_type({bitstring, 0}) -> true; +is_default_type({bool, 0}) -> true; +is_default_type({boolean, 0}) -> true; +is_default_type({byte, 0}) -> true; +is_default_type({char, 0}) -> true; +is_default_type({dict, 0}) -> true; +is_default_type({digraph, 0}) -> true; +is_default_type({float, 0}) -> true; +is_default_type({'fun', 0}) -> true; +is_default_type({'fun', 2}) -> true; +is_default_type({function, 0}) -> true; +is_default_type({gb_set, 0}) -> true; +is_default_type({gb_tree, 0}) -> true; +is_default_type({identifier, 0}) -> true; +is_default_type({integer, 0}) -> true; +is_default_type({integer, 1}) -> true; +is_default_type({iodata, 0}) -> true; +is_default_type({iolist, 0}) -> true; +is_default_type({list, 0}) -> true; +is_default_type({list, 1}) -> true; +is_default_type({maybe_improper_list, 0}) -> true; +is_default_type({maybe_improper_list, 2}) -> true; +is_default_type({mfa, 0}) -> true; +is_default_type({module, 0}) -> true; +is_default_type({neg_integer, 0}) -> true; +is_default_type({nil, 0}) -> true; +is_default_type({no_return, 0}) -> true; +is_default_type({node, 0}) -> true; +is_default_type({non_neg_integer, 0}) -> true; +is_default_type({none, 0}) -> true; +is_default_type({nonempty_list, 0}) -> true; +is_default_type({nonempty_list, 1}) -> true; +is_default_type({nonempty_improper_list, 2}) -> true; +is_default_type({nonempty_maybe_improper_list, 0}) -> true; +is_default_type({nonempty_maybe_improper_list, 2}) -> true; +is_default_type({nonempty_string, 0}) -> true; +is_default_type({number, 0}) -> true; +is_default_type({pid, 0}) -> true; +is_default_type({port, 0}) -> true; +is_default_type({pos_integer, 0}) -> true; +is_default_type({queue, 0}) -> true; +is_default_type({range, 2}) -> true; +is_default_type({reference, 0}) -> true; +is_default_type({set, 0}) -> true; +is_default_type({string, 0}) -> true; +is_default_type({term, 0}) -> true; +is_default_type({timeout, 0}) -> true; +is_default_type({var, 1}) -> true; +is_default_type(_) -> false. %% R13 is_newly_introduced_builtin_type({arity, 0}) -> true; @@ -2776,10 +2777,7 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> L = gb_sets:to_list(ExpTs) ++ dict:fetch_keys(D), UsedTypes = gb_sets:from_list(L), FoldFun = - fun(_Type, -1, AccSt) -> - %% Default type - AccSt; - (Type, #typeinfo{line = FileLine}, AccSt) -> + fun(Type, #typeinfo{line = FileLine}, AccSt) -> case loc(FileLine) of {FirstFile, _} -> case gb_sets:is_member(Type, UsedTypes) of @@ -2801,10 +2799,7 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> check_local_opaque_types(St) -> #lint{types=Ts, exp_types=ExpTs} = St, FoldFun = - fun(_Type, -1, AccSt) -> - %% Default type - AccSt; - (_Type, #typeinfo{attr = type}, AccSt) -> + fun(_Type, #typeinfo{attr = type}, AccSt) -> AccSt; (Type, #typeinfo{attr = opaque, line = FileLine}, AccSt) -> case gb_sets:is_element(Type, ExpTs) of diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 7c7566e4ec..657cb5d34c 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -35,7 +35,7 @@ | fun((Expr :: erl_parse:abstract_expr(), CurrentIndentation :: integer(), CurrentPrecedence :: non_neg_integer(), - HookFunction :: hook_function()) -> + Options :: options()) -> io_lib:chars())). -type(option() :: {hook, hook_function()} @@ -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")]. @@ -225,7 +227,7 @@ lattribute(module, {M,Vs}, _Opts, _State) -> lattribute(module, M, _Opts, _State) -> attr("module", [{var,0,pname(M)}]); lattribute(export, Falist, _Opts, _State) -> - call({var,0,"-export"}, [falist(Falist)], 0, none); + call({var,0,"-export"}, [falist(Falist)], 0, options(none)); lattribute(import, Name, _Opts, _State) when is_list(Name) -> attr("import", [{var,0,pname(Name)}]); lattribute(import, {From,Falist}, _Opts, _State) -> @@ -240,10 +242,10 @@ lattribute(Name, Arg, #options{encoding = Encoding}, _State) -> typeattr(Tag, {TypeName,Type,Args}, _Opts) -> {first,leaf("-"++atom_to_list(Tag)++" "), - typed(call({atom,0,TypeName}, Args, 0, none), Type)}. + typed(call({atom,0,TypeName}, Args, 0, options(none)), Type)}. ltype({ann_type,_Line,[V,T]}) -> - typed(lexpr(V, none), T); + typed(lexpr(V, options(none)), T); ltype({paren_type,_Line,[T]}) -> [$(,ltype(T),$)]; ltype({type,_Line,union,Ts}) -> @@ -253,7 +255,7 @@ ltype({type,_Line,list,[T]}) -> ltype({type,_Line,nonempty_list,[T]}) -> {seq,$[,$],[$,],[ltype(T),leaf("...")]}; ltype({type,Line,nil,[]}) -> - lexpr({nil,Line}, 0, none); + lexpr({nil,Line}, 0, options(none)); ltype({type,Line,tuple,any}) -> simple_type({atom,Line,tuple}, []); ltype({type,_Line,tuple,Ts}) -> @@ -261,7 +263,7 @@ ltype({type,_Line,tuple,Ts}) -> ltype({type,_Line,record,[{atom,_,N}|Fs]}) -> record_type(N, Fs); ltype({type,_Line,range,[_I1,_I2]=Es}) -> - expr_list(Es, '..', fun lexpr/2, none); + expr_list(Es, '..', fun lexpr/2, options(none)); ltype({type,_Line,binary,[I1,I2]}) -> binary_type(I1, I2); % except binary() ltype({type,_Line,'fun',[]}) -> @@ -277,14 +279,14 @@ ltype({remote_type,Line,[M,F,Ts]}) -> ltype({atom,_,T}) -> leaf(write(T)); ltype(E) -> - lexpr(E, 0, none). + lexpr(E, 0, options(none)). binary_type(I1, I2) -> B = [[] || {integer,_,0} <- [I1]] =:= [], U = [[] || {integer,_,0} <- [I2]] =:= [], P = max_prec(), - E1 = [[leaf("_:"),lexpr(I1, P, none)] || B], - E2 = [[leaf("_:_*"),lexpr(I2, P, none)] || U], + E1 = [[leaf("_:"),lexpr(I1, P, options(none))] || B], + E2 = [[leaf("_:_*"),lexpr(I2, P, options(none))] || U], {seq,'<<','>>',[$,],E1++E2}. record_type(Name, Fields) -> @@ -294,7 +296,7 @@ field_types(Fs) -> tuple_type(Fs, fun field_type/1). field_type({type,_Line,field_type,[Name,Type]}) -> - typed(lexpr(Name, none), Type). + typed(lexpr(Name, options(none)), Type). typed(B, {type,_,union,Ts}) -> %% Special layout for :: followed by union. @@ -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) -> @@ -330,7 +332,8 @@ sig_type(FunType) -> fun_type([], FunType). guard_type(Before, Gs) -> - Gl = {list,[{step,'when',expr_list(Gs, [$,], fun constraint/2, none)}]}, + Opts = options(none), + Gl = {list,[{step,'when',expr_list(Gs, [$,], fun constraint/2, Opts)}]}, {list,[{step,Before,Gl}]}. constraint({type,_Line,constraint,[Tag,As]}, _Opts) -> @@ -345,7 +348,7 @@ type_args({type,_line,product,Ts}) -> targs(Ts). simple_type(Tag, Types) -> - {first,lexpr(Tag, 0, none),targs(Types)}. + {first,lexpr(Tag, 0, options(none)),targs(Types)}. targs(Ts) -> {seq,$(,$),[$,],ltypes(Ts)}. @@ -357,7 +360,7 @@ ltypes(Ts, F) -> [F(T) || T <- Ts]. attr(Name, Args) -> - call({var,0,format("-~s", [Name])}, Args, 0, none). + call({var,0,format("-~s", [Name])}, Args, 0, options(none)). pname(['' | As]) -> [$. | pname(As)]; @@ -632,11 +635,11 @@ bit_elem_types([T | Rest]) -> [bit_elem_type(T), $-|bit_elem_types(Rest)]. bit_elem_type({A,B}) -> - [lexpr(erl_parse:abstract(A), none), + [lexpr(erl_parse:abstract(A), options(none)), $:, - lexpr(erl_parse:abstract(B), none)]; + lexpr(erl_parse:abstract(B), options(none))]; bit_elem_type(T) -> - lexpr(erl_parse:abstract(T), none). + lexpr(erl_parse:abstract(T), options(none)). %% end of BITS diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index a4f4035c79..cebc9c91bd 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -66,6 +66,183 @@ obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 -> {deprecated, {rpc, multi_server_call, A}}; +%% *** CRYPTO add in R16B01 *** + +obsolete_1(crypto, md4, 1) -> + {deprecated, {crypto, hash, 2}}; +obsolete_1(crypto, md5, 1) -> + {deprecated, {crypto, hash, 2}}; +obsolete_1(crypto, sha, 1) -> + {deprecated, {crypto, hash, 2}}; + +obsolete_1(crypto, md4_init, 0) -> + {deprecated, {crypto, hash_init, 1}}; +obsolete_1(crypto, md5_init, 0) -> + {deprecated, {crypto, hash_init, 1}}; +obsolete_1(crypto, sha_init, 0) -> + {deprecated, {crypto, hash_init, 1}}; + +obsolete_1(crypto, md4_update, 2) -> + {deprecated, {crypto, hash_update, 3}}; +obsolete_1(crypto, md5_update, 2) -> + {deprecated, {crypto, hash_update, 3}}; +obsolete_1(crypto, sha_update, 2) -> + {deprecated, {crypto, hash_update, 3}}; + +obsolete_1(crypto, md4_final, 1) -> + {deprecated, {crypto, hash_final, 2}}; +obsolete_1(crypto, md5_final, 1) -> + {deprecated, {crypto, hash_final, 2}}; +obsolete_1(crypto, sha_final, 1) -> + {deprecated, {crypto, hash_final, 2}}; + +obsolete_1(crypto, md5_mac, 2) -> + {deprecated, {crypto, hmac, 3}}; +obsolete_1(crypto, sha_mac, 2) -> + {deprecated, {crypto, hmac, 3}}; +obsolete_1(crypto, sha_mac, 3) -> + {deprecated, {crypto, hmac, 4}}; + +obsolete_1(crypto, sha_mac_96, 2) -> + {deprecated, {crypto, hmac_n, 3}}; +obsolete_1(crypto, md5_mac_96, 2) -> + {deprecated, {crypto, hmac_n, 3}}; + +obsolete_1(crypto, rsa_sign, 2) -> + {deprecated, {crypto, sign, 4}}; +obsolete_1(crypto, rsa_sign, 3) -> + {deprecated, {crypto, sign, 4}}; +obsolete_1(crypto, rsa_verify, 3) -> + {deprecated, {crypto, verify, 5}}; +obsolete_1(crypto, rsa_verify, 4) -> + {deprecated, {crypto, verify, 5}}; + +obsolete_1(crypto, dss_sign, 2) -> + {deprecated, {crypto, sign, 4}}; +obsolete_1(crypto, dss_sign, 3) -> + {deprecated, {crypto, sign, 4}}; + +obsolete_1(crypto, dss_verify, 3) -> + {deprecated, {crypto, verify, 4}}; +obsolete_1(crypto, dss_verify, 4) -> + {deprecated, {crypto, verify, 4}}; + +obsolete_1(crypto, mod_exp, 3) -> + {deprecated, {crypto, mod_pow, 3}}; + +obsolete_1(crypto, dh_compute_key, 3) -> + {deprecated, {crypto, compute_key, 4}}; +obsolete_1(crypto, dh_generate_key, 1) -> + {deprecated, {crypto, generate_key, 3}}; +obsolete_1(crypto, dh_generate_key, 2) -> + {deprecated, {crypto, generate_key, 3}}; + +obsolete_1(crypto, des_cbc_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, des3_cbc_encrypt, 5) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, des_ecb_encrypt, 2) -> + {deprecated, {crypto, block_encrypt, 3}}; +obsolete_1(crypto, des_ede3_cbc_encrypt, 5) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, des_cfb_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, des3_cfb_encrypt, 5) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, blowfish_ecb_encrypt, 2) -> + {deprecated, {crypto, block_encrypt, 3}}; +obsolete_1(crypto, blowfish_cbc_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, blowfish_cfb64_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, blowfish_ofb64_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, aes_cfb_128_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, aes_cbc_128_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto, aes_cbc_256_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto,rc2_cbc_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; +obsolete_1(crypto,rc2_40_cbc_encrypt, 3) -> + {deprecated, {crypto, block_encrypt, 4}}; + +obsolete_1(crypto, des_cbc_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, des3_cbc_decrypt, 5) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, des_ecb_decrypt, 2) -> + {deprecated, {crypto, block_decrypt, 3}}; +obsolete_1(crypto, des_ede3_cbc_decrypt, 5) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, des_cfb_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, des3_cfb_decrypt, 5) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, blowfish_ecb_decrypt, 2) -> + {deprecated, {crypto, block_decrypt, 3}}; +obsolete_1(crypto, blowfish_cbc_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, blowfish_cfb64_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, blowfish_ofb64_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, aes_cfb_128_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, aes_cbc_128_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto, aes_cbc_256_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto,rc2_cbc_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; +obsolete_1(crypto,rc2_40_cbc_decrypt, 3) -> + {deprecated, {crypto, block_decrypt, 4}}; + +obsolete_1(crypto, aes_ctr_stream_decrypt, 2) -> + {deprecated, {crypto, stream_decrypt, 2}}; +obsolete_1(crypto, aes_ctr_stream_encrypt, 2) -> + {deprecated, {crypto, stream_encrypt, 2}}; +obsolete_1(crypto, aes_ctr_decrypt, 3) -> + {deprecated, {crypto, stream_decrypt, 2}}; +obsolete_1(crypto, aes_ctr_encrypt, 3) -> + {deprecated, {crypto, stream_encrypt, 2}}; +obsolete_1(crypto, rc4_encrypt, 2) -> + {deprecated, {crypto, stream_encrypt, 2}}; +obsolete_1(crypto, rc4_encrypt_with_state, 2) -> + {deprecated, {crypto, stream_encrypt, 2}}; +obsolete_1(crypto, aes_ctr_stream_init, 2) -> + {deprecated, {crypto, stream_init, 3}}; +obsolete_1(crypto, rc4_set_key, 1) -> + {deprecated, {crypto, stream_init, 2}}; + +obsolete_1(crypto, rsa_private_decrypt, 3) -> + {deprecated, {crypto, private_decrypt, 4}}; +obsolete_1(crypto, rsa_public_decrypt, 3) -> + {deprecated, {crypto, public_decrypt, 4}}; +obsolete_1(crypto, rsa_private_encrypt, 3) -> + {deprecated, {crypto, private_encrypt, 4}}; +obsolete_1(crypto, rsa_public_encrypt, 3) -> + {deprecated, {crypto, public_encrypt, 4}}; + +obsolete_1(crypto, des_cfb_ivec, 2) -> + {deprecated, {crypto, next_iv, 3}}; +obsolete_1(crypto,des_cbc_ivec, 1) -> + {deprecated, {crypto, next_iv, 2}}; +obsolete_1(crypto, aes_cbc_ivec, 1) -> + {deprecated, {crypto, next_iv, 2}}; + +obsolete_1(crypto,info, 0) -> + {deprecated, {crypto, module_info, 0}}; + +obsolete_1(crypto, strong_rand_mpint, 3) -> + {deprecated, "needed only by deprecated functions"}; +obsolete_1(crypto, erlint, 1) -> + {deprecated, "needed only by deprecated functions"}; +obsolete_1(crypto, mpint, 1) -> + {deprecated, "needed only by deprecated functions"}; + + %% *** SNMP *** obsolete_1(snmp, N, A) -> @@ -73,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/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index b2f1aa955a..0cbdf76270 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -104,6 +104,8 @@ include_local(suite) -> include_local(Config) when is_list(Config) -> ?line DataDir = ?config(data_dir, Config), ?line File = filename:join(DataDir, "include_local.erl"), + FooHrl = filename:join([DataDir,"include","foo.hrl"]), + BarHrl = filename:join([DataDir,"include","bar.hrl"]), %% include_local.erl includes include/foo.hrl which %% includes bar.hrl (also in include/) without requiring %% any additional include path, and overriding any file @@ -111,6 +113,8 @@ include_local(Config) when is_list(Config) -> ?line {ok, List} = epp:parse_file(File, [DataDir], []), ?line {value, {attribute,_,a,{true,true}}} = lists:keysearch(a,3,List), + [{File,1},{FooHrl,1},{BarHrl,1},{FooHrl,5},{File,5}] = + [ FileLine || {attribute,_,file,FileLine} <- List ], ok. %%% Here is a little reimplementation of epp:parse_file, which times out diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 9c0a43abcc..2b7cec87df 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -43,13 +43,13 @@ 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, otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1, - otp_10302/1, otp_10820/1]). + otp_10302/1, otp_10820/1, otp_11100/1]). %% Internal export. -export([ehook/6]). @@ -77,11 +77,11 @@ 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, - otp_10302, otp_10820]}]. + otp_10302, otp_10820, otp_11100]}]. init_per_suite(Config) -> Config. @@ -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) -> @@ -1103,6 +1112,45 @@ file_attr_is_string("-file(\"" ++ _) -> true; file_attr_is_string([_ | L]) -> file_attr_is_string(L). +otp_11100(doc) -> + "OTP-11100. Fix printing of invalid forms."; +otp_11100(suite) -> []; +otp_11100(Config) when is_list(Config) -> + %% There are a few places where the added code ("options(none)") + %% doesn't make a difference (pp:bit_elem_type/1 is an example). + + %% Cannot trigger the use of the hook function with export/import. + "-export([{fy,a}/b]).\n" = + pf({attribute,1,export,[{{fy,a},b}]}), + "-type foo() :: integer(INVALID-FORM:{foo,bar}:).\n" = + pf({attribute,1,type,{foo,{type,1,integer,[{foo,bar}]},[]}}), + pf({attribute,1,type, + {a,{type,1,range,[{integer,1,1},{foo,bar}]},[]}}), + "-type foo(INVALID-FORM:{foo,bar}:) :: A.\n" = + pf({attribute,1,type,{foo,{var,1,'A'},[{foo,bar}]}}), + "-type foo() :: (INVALID-FORM:{foo,bar}: :: []).\n" = + pf({attribute,1,type, + {foo,{paren_type,1, + [{ann_type,1,[{foo,bar},{type,1,nil,[]}]}]}, + []}}), + "-type foo() :: <<_:INVALID-FORM:{foo,bar}:>>.\n" = + pf({attribute,1,type, + {foo,{type,1,binary,[{foo,bar},{integer,1,0}]},[]}}), + "-type foo() :: <<_:10, _:_*INVALID-FORM:{foo,bar}:>>.\n" = + pf({attribute,1,type, + {foo,{type,1,binary,[{integer,1,10},{foo,bar}]},[]}}), + "-type foo() :: #r{INVALID-FORM:{foo,bar}: :: integer()}.\n" = + pf({attribute,1,type, + {foo,{type,1,record, + [{atom,1,r}, + {type,1,field_type, + [{foo,bar},{type,1,integer,[]}]}]}, + []}}), + ok. + +pf(Form) -> + lists:flatten(erl_pp:form(Form,none)). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index af5d5a8f21..2b29566942 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -75,6 +75,7 @@ -export([otp_9932/1]). -export([otp_9423/1]). -export([otp_10182/1]). +-export([memory_check_summary/1]). -export([init_per_testcase/2, end_per_testcase/2]). %% Convenience for manual testing @@ -149,7 +150,9 @@ all() -> give_away, setopts, bad_table, types, otp_10182, otp_9932, - otp_9423]. + otp_9423, + + memory_check_summary]. % MUST BE LAST groups() -> [{new, [], @@ -185,7 +188,8 @@ init_per_suite(Config) -> end_per_suite(_Config) -> stop_spawn_logger(), - catch erts_debug:set_internal_state(available_internal_state, false). + catch erts_debug:set_internal_state(available_internal_state, false), + ok. init_per_group(_GroupName, Config) -> Config. @@ -193,6 +197,26 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +%% Test that we did not have "too many" failed verify_etsmem()'s +%% in the test suite. +%% verify_etsmem() may give a low number of false positives +%% as concurrent activities, such as lingering processes +%% from earlier test suites, may do unrelated ets (de)allocations. +memory_check_summary(_Config) -> + case whereis(ets_test_spawn_logger) of + undefined -> + ?t:fail("No spawn logger exist"); + _ -> + ets_test_spawn_logger ! {self(), get_failed_memchecks}, + receive {get_failed_memchecks, FailedMemchecks} -> ok end, + io:format("Failed memchecks: ~p\n",[FailedMemchecks]), + if FailedMemchecks > 3 -> + ct:fail("Too many failed (~p) memchecks", [FailedMemchecks]); + true -> + ok + end + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -5602,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}, @@ -5635,7 +5667,8 @@ verify_etsmem({MemInfo,AllTabs}) -> io:format("Actual: ~p", [MemInfo2]), io:format("Changed tables before: ~p\n",[AllTabs -- AllTabs2]), io:format("Changed tables after: ~p\n", [AllTabs2 -- AllTabs]), - ?t:fail() + ets_test_spawn_logger ! failed_memcheck, + {comment, "Failed memory check"} end. @@ -5657,10 +5690,10 @@ stop_loopers(Loopers) -> looper(Fun, State) -> looper(Fun, Fun(State)). -spawn_logger(Procs) -> +spawn_logger(Procs, FailedMemchecks) -> receive {new_test_proc, Proc} -> - spawn_logger([Proc|Procs]); + spawn_logger([Proc|Procs], FailedMemchecks); {sync_test_procs, Kill, From} -> lists:foreach(fun (Proc) when From == Proc -> ok; @@ -5683,7 +5716,14 @@ spawn_logger(Procs) -> end end, Procs), From ! test_procs_synced, - spawn_logger([From]) + spawn_logger([From], FailedMemchecks); + + failed_memcheck -> + spawn_logger(Procs, FailedMemchecks+1); + + {Pid, get_failed_memchecks} -> + Pid ! {get_failed_memchecks, FailedMemchecks}, + spawn_logger(Procs, FailedMemchecks) end. pid_status(Pid) -> @@ -5699,7 +5739,7 @@ start_spawn_logger() -> case whereis(ets_test_spawn_logger) of Pid when is_pid(Pid) -> true; _ -> register(ets_test_spawn_logger, - spawn_opt(fun () -> spawn_logger([]) end, + spawn_opt(fun () -> spawn_logger([], 0) end, [{priority, max}])) end. @@ -5710,8 +5750,7 @@ start_spawn_logger() -> stop_spawn_logger() -> Mon = erlang:monitor(process, ets_test_spawn_logger), (catch exit(whereis(ets_test_spawn_logger), kill)), - receive {'DOWN', Mon, _, _, _} -> ok end, - ok. + receive {'DOWN', Mon, _, _, _} -> ok end. wait_for_test_procs() -> wait_for_test_procs(false). @@ -5811,7 +5850,7 @@ spawn_monitor_with_pid(Pid, Fun, N) -> end) of Pid -> {Pid, erlang:monitor(process, Pid)}; - Other -> + _Other -> spawn_monitor_with_pid(Pid,Fun,N-1) end. @@ -6117,11 +6156,18 @@ repeat_for_opts(F, OptGenList) -> repeat_for_opts(F, OptGenList, []). repeat_for_opts(F, [], Acc) -> - lists:map(fun(Opts) -> - OptList = lists:filter(fun(E) -> E =/= void end, Opts), - io:format("Calling with options ~p\n",[OptList]), - F(OptList) - end, Acc); + lists:foldl(fun(Opts, RV_Acc) -> + OptList = lists:filter(fun(E) -> E =/= void end, Opts), + io:format("Calling with options ~p\n",[OptList]), + RV = F(OptList), + case RV_Acc of + {comment,_} -> RV_Acc; + _ -> case RV of + {comment,_} -> RV; + _ -> [RV | RV_Acc] + end + end + end, [], Acc); repeat_for_opts(F, [OptList | Tail], []) when is_list(OptList) -> repeat_for_opts(F, Tail, [[Opt] || Opt <- OptList]); repeat_for_opts(F, [OptList | Tail], AccList) when is_list(OptList) -> diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 3b6a3f38bc..a360a0809b 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.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 @@ -1082,13 +1082,23 @@ replace_state(Config) when is_list(Config) -> %% Test that the time for a huge message queue is not %% significantly slower than with an empty message queue. call_with_huge_message_queue(Config) when is_list(Config) -> + case test_server:is_native(gen) of + true -> + {skip, + "gen is native - huge message queue optimization " + "is not implemented"}; + false -> + do_call_with_huge_message_queue() + end. + +do_call_with_huge_message_queue() -> ?line Pid = spawn_link(fun echo_loop/0), - ?line {Time,ok} = tc(fun() -> calls(10, Pid) end), + ?line {Time,ok} = tc(fun() -> calls(10000, Pid) end), ?line [self() ! {msg,N} || N <- lists:seq(1, 500000)], erlang:garbage_collect(), - ?line {NewTime,ok} = tc(fun() -> calls(10, Pid) end), + ?line {NewTime,ok} = tc(fun() -> calls(10000, Pid) end), io:format("Time for empty message queue: ~p", [Time]), io:format("Time for huge message queue: ~p", [NewTime]), diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index 7233c061ef..a57641ef62 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-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 @@ -109,13 +109,32 @@ borderline_test(Size, TempDir) -> ok. unzip_list(Archive, Name) -> - case os:find_executable("unzip") of - Unzip when is_list(Unzip) -> + case unix_unzip_exists() of + true -> unzip_list1(Archive, Name); _ -> ok end. +%% Used to do os:find_executable() to check if unzip exists, but on +%% some hosts that would give an unzip program which did not take the +%% "-Z" option. +%% Here we check that "unzip -Z" (which should display usage) and +%% check that it exists with status 0. +unix_unzip_exists() -> + case os:type() of + {unix,_} -> + Port = open_port({spawn,"unzip -Z > /dev/null"}, [exit_status]), + receive + {Port,{exit_status,0}} -> + true; + {Port,{exit_status,_Fail}} -> + false + end; + _ -> + false + end. + unzip_list1(Archive, Name) -> Expect = Name ++ "\n", cmd_expect("unzip -Z -1 " ++ Archive, Expect). 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/doc/src/eprof.xml b/lib/tools/doc/src/eprof.xml index 82eb8dd284..8397204a43 100644 --- a/lib/tools/doc/src/eprof.xml +++ b/lib/tools/doc/src/eprof.xml @@ -52,12 +52,14 @@ <func> <name>start_profiling(Rootset) -> profiling | {error, Reason}</name> <name>start_profiling(Rootset,Pattern) -> profiling | {error, Reason}</name> + <name>start_profiling(Rootset,Pattern,Options) -> profiling | {error, Reason}</name> <fsummary>Start profiling.</fsummary> <type> <v>Rootset = [atom() | pid()]</v> - <v>Pattern = {Module, Function, Arity}</v> - <v>Module = Function = atom()</v> - <v>Arity = integer()</v> + <v>Pattern = {Module, Function, Arity}</v> + <v>Module = Function = atom()</v> + <v>Arity = integer()</v> + <v>Options = [set_on_spawn]</v> <v>Reason = term()</v> </type> <desc> @@ -70,6 +72,9 @@ <p>A pattern can be selected to narrow the profiling. For instance a specific module can be selected, and only the code executed in that module will be profiled.</p> + <p>The <c>set_on_spawn</c> option will active call time tracing for + all processes spawned by processes in the rootset. This is + the default behaviour.</p> </desc> </func> <func> @@ -82,19 +87,22 @@ </func> <func> <name>profile(Fun) -> profiling | {error, Reason}</name> + <name>profile(Fun, Options) -> profiling | {error, Reason}</name> <name>profile(Rootset) -> profiling | {error, Reason}</name> <name>profile(Rootset,Fun) -> {ok, Value} | {error,Reason}</name> <name>profile(Rootset,Fun,Pattern) -> {ok, Value} | {error, Reason}</name> <name>profile(Rootset,Module,Function,Args) -> {ok, Value} | {error, Reason}</name> <name>profile(Rootset,Module,Function,Args,Pattern) -> {ok, Value} | {error, Reason}</name> + <name>profile(Rootset,Module,Function,Args,Pattern,Options) -> {ok, Value} | {error, Reason}</name> <fsummary>Start profiling.</fsummary> <type> <v>Rootset = [atom() | pid()]</v> - <v>Fun = fun() -> term()</v> - <v>Pattern = {Module, Function, Arity}</v> + <v>Fun = fun() -> term() end</v> + <v>Pattern = {Module, Function, Arity}</v> <v>Module = Function = atom()</v> <v>Args = [term()]</v> - <v>Arity = integer()</v> + <v>Arity = integer()</v> + <v>Options = [set_on_spawn]</v> <v>Value = Reason = term()</v> </type> <desc> @@ -108,8 +116,11 @@ <c>Rootset</c>, the function returns <c>{ok,Value}</c> when <c>Fun()</c>/<c>apply</c> returns with the value <c>Value</c>, or <c>{error,Reason}</c> if <c>Fun()</c>/<c>apply</c> fails with - exit reason <c>Reason</c>. Otherwise it returns <c>{error, Reason}</c> + exit reason <c>Reason</c>. Otherwise it returns <c>{error, Reason}</c> immediately.</p> + <p>The <c>set_on_spawn</c> option will active call time tracing for + all processes spawned by processes in the rootset. This is + the default behaviour.</p> <p>The programmer must ensure that the function given as argument is truly synchronous and that no work continues after the function has returned a value.</p> 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" diff --git a/lib/tools/src/eprof.erl b/lib/tools/src/eprof.erl index 87fdc1fa34..bc9345fa62 100644 --- a/lib/tools/src/eprof.erl +++ b/lib/tools/src/eprof.erl @@ -26,7 +26,7 @@ -export([start/0, stop/0, dump/0, - start_profiling/1, start_profiling/2, + start_profiling/1, start_profiling/2, start_profiling/3, profile/1, profile/2, profile/3, profile/4, profile/5, stop_profiling/0, analyze/0, analyze/1, analyze/2, @@ -39,6 +39,8 @@ handle_info/2, terminate/2, code_change/3]). + + -record(bpd, { n = 0, % number of total calls us = 0, % sum of uS for all calls @@ -46,14 +48,18 @@ mfa = [] % list of {Mfa, {Count, Us}} }). +-define(default_options, [{set_on_spawn, true}]). +-define(default_pattern, {'_','_','_'}). + -record(state, { - profiling = false, - pattern = {'_','_','_'}, - rootset = [], - fd = undefined, - start_ts = undefined, - reply = undefined, - bpd = #bpd{} + profiling = false, + pattern = ?default_pattern, + rootset = [], + trace_opts = [], + fd = undefined, + start_ts = undefined, + reply = undefined, + bpd = #bpd{} }). @@ -67,26 +73,6 @@ start() -> gen_server:start({local, ?MODULE}, ?MODULE, [], []). stop() -> gen_server:call(?MODULE, stop, infinity). -profile(Fun) when is_function(Fun) -> - profile([], Fun); -profile(Rs) when is_list(Rs) -> - start_profiling(Rs). - -profile(Pids, Fun) -> - profile(Pids, Fun, {'_','_','_'}). - -profile(Pids, Fun, Pattern) -> - profile(Pids, erlang, apply, [Fun,[]], Pattern). - -profile(Pids, M, F, A) -> - profile(Pids, M, F, A, {'_','_','_'}). - -profile(Pids, M, F, A, Pattern) -> - start(), - gen_server:call(?MODULE, {profile,Pids,Pattern,M,F,A},infinity). - -dump() -> - gen_server:call(?MODULE, dump, infinity). analyze() -> analyze(procs). @@ -98,17 +84,53 @@ analyze(Opts) when is_list(Opts) -> analyze(Type, Opts) when is_list(Opts) -> gen_server:call(?MODULE, {analyze, Type, Opts}, infinity). +%% odd duck, should only been start_profiling/1 +profile(Rootset) when is_list(Rootset) -> + start_profiling(Rootset); + +profile(Fun) when is_function(Fun) -> + profile([], Fun). + +profile(Fun, Opts) when is_function(Fun), is_list(Opts) -> + profile([], erlang, apply, [Fun, []], ?default_pattern, Opts); + +profile(Rootset, Fun) when is_list(Rootset), is_function(Fun) -> + profile(Rootset, Fun, ?default_pattern). + +profile(Rootset, Fun, Pattern) when is_list(Rootset), is_function(Fun) -> + profile(Rootset, Fun, Pattern, ?default_options). + +profile(Rootset, Fun, Pattern, Options) when is_list(Rootset), is_function(Fun), is_list(Options) -> + profile(Rootset, erlang, apply, [Fun,[]], Pattern, Options); + +profile(Rootset, M, F, A) when is_list(Rootset), is_atom(M), is_atom(F), is_list(A) -> + profile(Rootset, M, F, A, ?default_pattern). + +profile(Rootset, M, F, A, Pattern) when is_list(Rootset), is_atom(M), is_atom(F), is_list(A) -> + profile(Rootset, M, F, A, Pattern, ?default_options). + +%% Returns when M:F/A has terminated +profile(Rootset, M, F, A, Pattern, Options) -> + start(), + gen_server:call(?MODULE, {profile_start, Rootset, Pattern, {M,F,A}, Options}, infinity). + +dump() -> + gen_server:call(?MODULE, dump, infinity). + log(File) -> gen_server:call(?MODULE, {logfile, File}, infinity). +%% Does not block start_profiling(Rootset) -> - start_profiling(Rootset, {'_','_','_'}). + start_profiling(Rootset, ?default_pattern). start_profiling(Rootset, Pattern) -> + start_profiling(Rootset, Pattern, ?default_options). +start_profiling(Rootset, Pattern, Options) -> start(), - gen_server:call(?MODULE, {profile, Rootset, Pattern}, infinity). + gen_server:call(?MODULE, {profile_start, Rootset, Pattern, undefined, Options}, infinity). stop_profiling() -> - gen_server:call(?MODULE, stop_profiling, infinity). + gen_server:call(?MODULE, profile_stop, infinity). %% -------------------------------------------------------------------- %% @@ -151,74 +173,75 @@ handle_call({analyze, Type, _Opts}, _, S) -> %% profile -handle_call({profile, _Rootset, _Pattern, _M,_F,_A}, _From, #state{ profiling = true } = S) -> +handle_call({profile_start, _Rootset, _Pattern, _MFA, _Opts}, _From, #state{ profiling = true } = S) -> {reply, {error, already_profiling}, S}; -handle_call({profile, Rootset, Pattern, M,F,A}, From, #state{fd = Fd } = S) -> +handle_call({profile_start, Rootset, Pattern, {M,F,A}, Opts}, From, #state{fd = Fd } = S) -> + + ok = set_pattern_trace(false, S#state.pattern), + _ = set_process_trace(false, S#state.rootset, S#state.trace_opts), - set_pattern_trace(false, S#state.pattern), - set_process_trace(false, S#state.rootset), + Topts = get_trace_options(Opts), + Pid = setup_profiling(M,F,A), - Pid = setup_profiling(M,F,A), - case set_process_trace(true, [Pid|Rootset]) of + case set_process_trace(true, [Pid|Rootset], Topts) of true -> - set_pattern_trace(true, Pattern), + ok = set_pattern_trace(true, Pattern), T0 = now(), - execute_profiling(Pid), + ok = execute_profiling(Pid), {noreply, #state{ - profiling = true, - rootset = [Pid|Rootset], - start_ts = T0, - reply = From, - fd = Fd, - pattern = Pattern + profiling = true, + rootset = [Pid|Rootset], + start_ts = T0, + reply = From, + fd = Fd, + trace_opts = Topts, + pattern = Pattern }}; false -> exit(Pid, eprof_kill), {reply, error, #state{ fd = Fd}} end; -handle_call({profile, _Rootset, _Pattern}, _From, #state{ profiling = true } = S) -> - {reply, {error, already_profiling}, S}; - -handle_call({profile, Rootset, Pattern}, From, #state{ fd = Fd } = S) -> +handle_call({profile_start, Rootset, Pattern, undefined, Opts}, From, #state{ fd = Fd } = S) -> - set_pattern_trace(false, S#state.pattern), - set_process_trace(false, S#state.rootset), + ok = set_pattern_trace(false, S#state.pattern), + true = set_process_trace(false, S#state.rootset, S#state.trace_opts), + Topts = get_trace_options(Opts), - case set_process_trace(true, Rootset) of + case set_process_trace(true, Rootset, Topts) of true -> T0 = now(), - set_pattern_trace(true, Pattern), + ok = set_pattern_trace(true, Pattern), {reply, profiling, #state{ - profiling = true, - rootset = Rootset, - start_ts = T0, - reply = From, - fd = Fd, - pattern = Pattern + profiling = true, + rootset = Rootset, + start_ts = T0, + reply = From, + fd = Fd, + trace_opts = Topts, + pattern = Pattern }}; false -> {reply, error, #state{ fd = Fd }} end; -handle_call(stop_profiling, _From, #state{ profiling = false } = S) -> +handle_call(profile_stop, _From, #state{ profiling = false } = S) -> {reply, profiling_already_stopped, S}; -handle_call(stop_profiling, _From, #state{ profiling = true } = S) -> - - set_pattern_trace(pause, S#state.pattern), +handle_call(profile_stop, _From, #state{ profiling = true } = S) -> + ok = set_pattern_trace(pause, S#state.pattern), Bpd = collect_bpd(), - - set_process_trace(false, S#state.rootset), - set_pattern_trace(false, S#state.pattern), + _ = set_process_trace(false, S#state.rootset, S#state.trace_opts), + ok = set_pattern_trace(false, S#state.pattern), {reply, profiling_stopped, S#state{ - profiling = false, - rootset = [], - pattern = {'_','_','_'}, - bpd = Bpd + profiling = false, + rootset = [], + trace_opts = [], + pattern = ?default_pattern, + bpd = Bpd }}; %% logfile @@ -261,33 +284,33 @@ handle_info({'EXIT', _, eprof_kill}, S) -> {noreply, S}; handle_info({'EXIT', _, Reason}, #state{ reply = FromTag } = S) -> - set_process_trace(false, S#state.rootset), - set_pattern_trace(false, S#state.pattern), + _ = set_process_trace(false, S#state.rootset, S#state.trace_opts), + ok = set_pattern_trace(false, S#state.pattern), gen_server:reply(FromTag, {error, Reason}), {noreply, S#state{ - profiling = false, - rootset = [], - pattern = {'_','_','_'} + profiling = false, + rootset = [], + trace_opts = [], + pattern = ?default_pattern }}; % check if Pid is spawned process? handle_info({_Pid, {answer, Result}}, #state{ reply = {From,_} = FromTag} = S) -> - set_pattern_trace(pause, S#state.pattern), - - Bpd = collect_bpd(), - - set_process_trace(false, S#state.rootset), - set_pattern_trace(false, S#state.pattern), + ok = set_pattern_trace(pause, S#state.pattern), + Bpd = collect_bpd(), + _ = set_process_trace(false, S#state.rootset, S#state.trace_opts), + ok = set_pattern_trace(false, S#state.pattern), catch unlink(From), gen_server:reply(FromTag, {ok, Result}), {noreply, S#state{ - profiling = false, - rootset = [], - pattern = {'_','_','_'}, - bpd = Bpd + profiling = false, + rootset = [], + trace_opts = [], + pattern = ?default_pattern, + bpd = Bpd }}. %% -------------------------------------------------------------------- %% @@ -297,11 +320,11 @@ handle_info({_Pid, {answer, Result}}, #state{ reply = {From,_} = FromTag} = S) - %% -------------------------------------------------------------------- %% terminate(_Reason, #state{ fd = undefined }) -> - set_pattern_trace(false, {'_','_','_'}), + ok = set_pattern_trace(false, ?default_pattern), ok; terminate(_Reason, #state{ fd = Fd }) -> - file:close(Fd), - set_pattern_trace(false, {'_','_','_'}), + ok = file:close(Fd), + ok = set_pattern_trace(false, ?default_pattern), ok. %% -------------------------------------------------------------------- %% @@ -330,7 +353,19 @@ spin_profile(M, F, A) -> end. execute_profiling(Pid) -> - Pid ! {self(), execute}. + Pid ! {self(), execute}, + ok. + + +get_trace_options([]) -> + [call]; +get_trace_options([{set_on_spawn, true}|Opts]) -> + [set_on_spawn | get_trace_options(Opts)]; +get_trace_options([set_on_spawn|Opts]) -> + [set_on_spawn | get_trace_options(Opts)]; +get_trace_options([_|Opts]) -> + get_trace_options(Opts). + set_pattern_trace(Flag, Pattern) -> erlang:system_flag(multi_scheduling, block), @@ -339,10 +374,6 @@ set_pattern_trace(Flag, Pattern) -> erlang:system_flag(multi_scheduling, unblock), ok. -set_process_trace(Flag, Pids) -> - % do we need procs for meta info? - % could be useful - set_process_trace(Flag, Pids, [call, set_on_spawn]). set_process_trace(_, [], _) -> true; set_process_trace(Flag, [Pid|Pids], Options) when is_pid(Pid) -> try diff --git a/lib/tools/test/eprof_SUITE.erl b/lib/tools/test/eprof_SUITE.erl index 3283fa571f..148622cf07 100644 --- a/lib/tools/test/eprof_SUITE.erl +++ b/lib/tools/test/eprof_SUITE.erl @@ -21,12 +21,14 @@ -include_lib("test_server/include/test_server.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2,tiny/1,eed/1,basic/1]). + init_per_group/2,end_per_group/2]). + +-export([tiny/1,eed/1,basic/1,basic_option/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [basic, tiny, eed]. + [basic, basic_option, tiny, eed]. groups() -> []. @@ -49,140 +51,185 @@ basic(Config) when is_list(Config) -> %% load eprof_test and change directory - ?line {ok, OldCurDir} = file:get_cwd(), + {ok, OldCurDir} = file:get_cwd(), Datadir = ?config(data_dir, Config), Privdir = ?config(priv_dir, Config), - ?line {ok,eprof_test} = compile:file(filename:join(Datadir, "eprof_test"), + {ok,eprof_test} = compile:file(filename:join(Datadir, "eprof_test"), [trace,{outdir, Privdir}]), - ?line ok = file:set_cwd(Privdir), - ?line code:purge(eprof_test), - ?line {module,eprof_test} = code:load_file(eprof_test), + ok = file:set_cwd(Privdir), + code:purge(eprof_test), + {module,eprof_test} = code:load_file(eprof_test), %% rootset profiling - ?line ensure_eprof_stopped(), - ?line profiling = eprof:profile([self()]), - ?line {error, already_profiling} = eprof:profile([self()]), - ?line profiling_stopped = eprof:stop_profiling(), - ?line profiling_already_stopped = eprof:stop_profiling(), - ?line profiling = eprof:start_profiling([self(),self(),self()]), - ?line profiling_stopped = eprof:stop_profiling(), + ensure_eprof_stopped(), + profiling = eprof:profile([self()]), + {error, already_profiling} = eprof:profile([self()]), + profiling_stopped = eprof:stop_profiling(), + profiling_already_stopped = eprof:stop_profiling(), + profiling = eprof:start_profiling([self(),self(),self()]), + profiling_stopped = eprof:stop_profiling(), %% with patterns - ?line profiling = eprof:start_profiling([self()], {?MODULE, '_', '_'}), - ?line {error, already_profiling} = eprof:start_profiling([self()], {?MODULE, '_', '_'}), - ?line profiling_stopped = eprof:stop_profiling(), - ?line profiling = eprof:start_profiling([self()], {?MODULE, start_stop, '_'}), - ?line profiling_stopped = eprof:stop_profiling(), - ?line profiling = eprof:start_profiling([self()], {?MODULE, start_stop, 1}), - ?line profiling_stopped = eprof:stop_profiling(), + profiling = eprof:start_profiling([self()], {?MODULE, '_', '_'}), + {error, already_profiling} = eprof:start_profiling([self()], {?MODULE, '_', '_'}), + profiling_stopped = eprof:stop_profiling(), + profiling = eprof:start_profiling([self()], {?MODULE, start_stop, '_'}), + profiling_stopped = eprof:stop_profiling(), + profiling = eprof:start_profiling([self()], {?MODULE, start_stop, 1}), + profiling_stopped = eprof:stop_profiling(), %% with fun - ?line {ok, _} = eprof:profile(fun() -> eprof_test:go(10) end), - ?line profiling = eprof:profile([self()]), - ?line {error, already_profiling} = eprof:profile(fun() -> eprof_test:go(10) end), - ?line profiling_stopped = eprof:stop_profiling(), - ?line {ok, _} = eprof:profile(fun() -> eprof_test:go(10) end), - ?line {ok, _} = eprof:profile([], fun() -> eprof_test:go(10) end), - ?line Pid = whereis(eprof), - ?line {ok, _} = eprof:profile(erlang:processes() -- [Pid], fun() -> eprof_test:go(10) end), - ?line {ok, _} = eprof:profile([], fun() -> eprof_test:go(10) end, {eprof_test, '_', '_'}), - ?line {ok, _} = eprof:profile([], fun() -> eprof_test:go(10) end, {eprof_test, go, '_'}), - ?line {ok, _} = eprof:profile([], fun() -> eprof_test:go(10) end, {eprof_test, go, 1}), - ?line {ok, _} = eprof:profile([], fun() -> eprof_test:go(10) end, {eprof_test, dec, 1}), + {ok, _} = eprof:profile(fun() -> eprof_test:go(10) end), + profiling = eprof:profile([self()]), + {error, already_profiling} = eprof:profile(fun() -> eprof_test:go(10) end), + profiling_stopped = eprof:stop_profiling(), + {ok, _} = eprof:profile(fun() -> eprof_test:go(10) end), + {ok, _} = eprof:profile([], fun() -> eprof_test:go(10) end), + Pid = whereis(eprof), + {ok, _} = eprof:profile(erlang:processes() -- [Pid], fun() -> eprof_test:go(10) end), + {ok, _} = eprof:profile([], fun() -> eprof_test:go(10) end, {eprof_test, '_', '_'}), + {ok, _} = eprof:profile([], fun() -> eprof_test:go(10) end, {eprof_test, go, '_'}), + {ok, _} = eprof:profile([], fun() -> eprof_test:go(10) end, {eprof_test, go, 1}), + {ok, _} = eprof:profile([], fun() -> eprof_test:go(10) end, {eprof_test, dec, 1}), %% error case - ?line error = eprof:profile([Pid], fun() -> eprof_test:go(10) end), - ?line Pid = whereis(eprof), - ?line error = eprof:profile([Pid], fun() -> eprof_test:go(10) end), - ?line A = spawn(fun() -> receive _ -> ok end end), - ?line profiling = eprof:profile([A]), - ?line true = exit(A, kill_it), - ?line profiling_stopped = eprof:stop_profiling(), - ?line {error,_} = eprof:profile(fun() -> a = b end), + error = eprof:profile([Pid], fun() -> eprof_test:go(10) end), + Pid = whereis(eprof), + error = eprof:profile([Pid], fun() -> eprof_test:go(10) end), + A = spawn(fun() -> receive _ -> ok end end), + profiling = eprof:profile([A]), + true = exit(A, kill_it), + profiling_stopped = eprof:stop_profiling(), + {error,_} = eprof:profile(fun() -> a = b end), %% with mfa - ?line {ok, _} = eprof:profile([], eprof_test, go, [10]), - ?line {ok, _} = eprof:profile([], eprof_test, go, [10], {eprof_test, dec, 1}), + {ok, _} = eprof:profile([], eprof_test, go, [10]), + {ok, _} = eprof:profile([], eprof_test, go, [10], {eprof_test, dec, 1}), %% dump - ?line {ok, _} = eprof:profile([], fun() -> eprof_test:go(10) end, {eprof_test, '_', '_'}), - ?line [{_, Mfas}] = eprof:dump(), - ?line Dec_mfa = {eprof_test, dec, 1}, - ?line Go_mfa = {eprof_test, go, 1}, - ?line {value, {Go_mfa, { 1, _Time1}}} = lists:keysearch(Go_mfa, 1, Mfas), - ?line {value, {Dec_mfa, {11, _Time2}}} = lists:keysearch(Dec_mfa, 1, Mfas), + {ok, _} = eprof:profile([], fun() -> eprof_test:go(10) end, {eprof_test, '_', '_'}), + [{_, Mfas}] = eprof:dump(), + Dec_mfa = {eprof_test, dec, 1}, + Go_mfa = {eprof_test, go, 1}, + {value, {Go_mfa, { 1, _Time1}}} = lists:keysearch(Go_mfa, 1, Mfas), + {value, {Dec_mfa, {11, _Time2}}} = lists:keysearch(Dec_mfa, 1, Mfas), %% change current working directory - ?line ok = file:set_cwd(OldCurDir), - ?line stopped = eprof:stop(), + ok = file:set_cwd(OldCurDir), + stopped = eprof:stop(), + ok. + +basic_option(Config) when is_list(Config) -> + %% load eprof_test and change directory + + {ok, OldCurDir} = file:get_cwd(), + Datadir = ?config(data_dir, Config), + Privdir = ?config(priv_dir, Config), + {ok,eprof_test} = compile:file(filename:join(Datadir, "eprof_test"), + [trace,{outdir, Privdir}]), + ok = file:set_cwd(Privdir), + code:purge(eprof_test), + {module,eprof_test} = code:load_file(eprof_test), + + % vanilla + {ok, _} = eprof:profile(fun() -> eprof_test:do(10) end, [{set_on_spawn, true}]), + + [{_, MfasDo1},{_, MfasLists1}] = eprof:dump(), + Mfas1 = MfasDo1 ++ MfasLists1, + + {value, {_, {11, _}}} = lists:keysearch({eprof_test,dec,1}, 1, Mfas1), + {value, {_, { 1, _}}} = lists:keysearch({eprof_test, go,1}, 1, Mfas1), + {value, {_, { 9, _}}} = lists:keysearch({lists, split_2,5}, 1, Mfas1), + {value, {_, { 4, _}}} = lists:keysearch({lists, seq_loop,3}, 1, Mfas1), + + {ok, _} = eprof:profile(fun() -> eprof_test:do(10) end, [set_on_spawn]), + + [{_, MfasDo2},{_, MfasLists2}] = eprof:dump(), + Mfas2 = MfasDo2 ++ MfasLists2, + {value, {_, {11, _}}} = lists:keysearch({eprof_test,dec,1}, 1, Mfas2), + {value, {_, { 1, _}}} = lists:keysearch({eprof_test, go,1}, 1, Mfas2), + {value, {_, { 9, _}}} = lists:keysearch({lists, split_2,5}, 1, Mfas2), + {value, {_, { 4, _}}} = lists:keysearch({lists, seq_loop,3}, 1, Mfas2), + + % disable trace set_on_spawn + {ok, _} = eprof:profile(fun() -> eprof_test:do(10) end, []), + [{_, Mfas3}] = eprof:dump(), + {value, {_, {11, _}}} = lists:keysearch({eprof_test,dec,1}, 1, Mfas3), + {value, {_, { 1, _}}} = lists:keysearch({eprof_test, go,1}, 1, Mfas3), + false = lists:keysearch({lists, split_2,5}, 1, Mfas3), + false = lists:keysearch({lists, seq_loop,3}, 1, Mfas3), + + %% change current working directory + ok = file:set_cwd(OldCurDir), + stopped = eprof:stop(), ok. tiny(suite) -> []; tiny(Config) when is_list(Config) -> - ?line ensure_eprof_stopped(), - ?line {ok, OldCurDir} = file:get_cwd(), + ensure_eprof_stopped(), + {ok, OldCurDir} = file:get_cwd(), Datadir = ?config(data_dir, Config), Privdir = ?config(priv_dir, Config), - ?line TTrap=?t:timetrap(60*1000), + TTrap=?t:timetrap(60*1000), % (Trace)Compile to priv_dir and make sure the correct version is loaded. - ?line {ok,eprof_suite_test} = compile:file(filename:join(Datadir, + {ok,eprof_suite_test} = compile:file(filename:join(Datadir, "eprof_suite_test"), [trace,{outdir, Privdir}]), - ?line ok = file:set_cwd(Privdir), - ?line code:purge(eprof_suite_test), - ?line {module,eprof_suite_test} = code:load_file(eprof_suite_test), - ?line {ok,_Pid} = eprof:start(), - ?line nothing_to_analyze = eprof:analyze(), - ?line nothing_to_analyze = eprof:analyze(total), - ?line eprof:profile([], eprof_suite_test, test, [Config]), - ?line ok = eprof:analyze(), - ?line ok = eprof:analyze(total), - ?line ok = eprof:log("eprof_SUITE_logfile"), - ?line stopped = eprof:stop(), - ?line ?t:timetrap_cancel(TTrap), - ?line ok = file:set_cwd(OldCurDir), + ok = file:set_cwd(Privdir), + code:purge(eprof_suite_test), + {module,eprof_suite_test} = code:load_file(eprof_suite_test), + {ok,_Pid} = eprof:start(), + nothing_to_analyze = eprof:analyze(), + nothing_to_analyze = eprof:analyze(total), + eprof:profile([], eprof_suite_test, test, [Config]), + ok = eprof:analyze(), + ok = eprof:analyze(total), + ok = eprof:log("eprof_SUITE_logfile"), + stopped = eprof:stop(), + ?t:timetrap_cancel(TTrap), + ok = file:set_cwd(OldCurDir), ok. eed(suite) -> []; eed(Config) when is_list(Config) -> - ?line ensure_eprof_stopped(), - ?line Datadir = ?config(data_dir, Config), - ?line Privdir = ?config(priv_dir, Config), - ?line TTrap=?t:timetrap(5*60*1000), + ensure_eprof_stopped(), + Datadir = ?config(data_dir, Config), + Privdir = ?config(priv_dir, Config), + TTrap=?t:timetrap(5*60*1000), %% (Trace)Compile to priv_dir and make sure the correct version is loaded. - ?line code:purge(eed), - ?line {ok,eed} = c:c(filename:join(Datadir, "eed"), [trace,{outdir,Privdir}]), - ?line {ok,_Pid} = eprof:start(), - ?line Script = filename:join(Datadir, "ed.script"), - ?line ok = file:set_cwd(Datadir), - ?line {T1,_} = statistics(runtime), - ?line ok = eed:file(Script), - ?line ok = eed:file(Script), - ?line ok = eed:file(Script), - ?line ok = eed:file(Script), - ?line ok = eed:file(Script), - ?line ok = eed:file(Script), - ?line ok = eed:file(Script), - ?line ok = eed:file(Script), - ?line ok = eed:file(Script), - ?line ok = eed:file(Script), - ?line {T2,_} = statistics(runtime), - ?line {ok,ok} = eprof:profile([], eed, file, [Script]), - ?line {T3,_} = statistics(runtime), - ?line profiling_already_stopped = eprof:stop_profiling(), - ?line ok = eprof:analyze(), - ?line ok = eprof:analyze(total), - ?line ok = eprof:log("eprof_SUITE_logfile"), - ?line stopped = eprof:stop(), - ?line ?t:timetrap_cancel(TTrap), + code:purge(eed), + {ok,eed} = c:c(filename:join(Datadir, "eed"), [trace,{outdir,Privdir}]), + {ok,_Pid} = eprof:start(), + Script = filename:join(Datadir, "ed.script"), + ok = file:set_cwd(Datadir), + {T1,_} = statistics(runtime), + ok = eed:file(Script), + ok = eed:file(Script), + ok = eed:file(Script), + ok = eed:file(Script), + ok = eed:file(Script), + ok = eed:file(Script), + ok = eed:file(Script), + ok = eed:file(Script), + ok = eed:file(Script), + ok = eed:file(Script), + {T2,_} = statistics(runtime), + {ok,ok} = eprof:profile([], eed, file, [Script]), + {T3,_} = statistics(runtime), + profiling_already_stopped = eprof:stop_profiling(), + ok = eprof:analyze(), + ok = eprof:analyze(total), + ok = eprof:log("eprof_SUITE_logfile"), + stopped = eprof:stop(), + ?t:timetrap_cancel(TTrap), try S = lists:flatten(io_lib:format("~p times slower", [10*(T3-T2)/(T2-T1)])), @@ -198,5 +245,5 @@ ensure_eprof_stopped() -> undefined -> ok; Pid -> - ?line stopped=eprof:stop() + stopped=eprof:stop() end. diff --git a/lib/tools/test/eprof_SUITE_data/eprof_test.erl b/lib/tools/test/eprof_SUITE_data/eprof_test.erl index 33c428e893..2d9e4c2945 100644 --- a/lib/tools/test/eprof_SUITE_data/eprof_test.erl +++ b/lib/tools/test/eprof_SUITE_data/eprof_test.erl @@ -1,5 +1,5 @@ -module(eprof_test). --export([go/1]). +-export([go/1, do/1]). go(N) -> 0 = dec(N), @@ -7,3 +7,16 @@ go(N) -> dec(0) -> 0; dec(N) -> dec(N - 1). + + + +load(N, Pid) -> + _ = lists:sort(lists:reverse(lists:seq(1, N))), + Pid ! {self(), ok}. + + +do(N) -> + Me = self(), + Pid = spawn_link(fun() -> load(N, Me) end), + ok = go(N), + receive {Pid, ok} -> ok end. diff --git a/make/run_make.mk b/make/run_make.mk index 1b4213107f..bb0da6743c 100644 --- a/make/run_make.mk +++ b/make/run_make.mk @@ -30,7 +30,7 @@ include $(ERL_TOP)/make/target.mk .PHONY: valgrind -opt debug purify quantify purecov valgrind gcov gprof lcnt: +opt debug purify quantify purecov valgrind gcov gprof lcnt frmptr: $(make_verbose)$(MAKE) -f $(TARGET)/Makefile TYPE=$@ plain smp frag smp_frag: |