diff options
604 files changed, 36673 insertions, 21074 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 @@ -28,10 +28,13 @@ Here are the [instructions for submitting patches] [2]. In short: * We prefer to receive proposed updates via email on the - [`erlang-patches`] [3] mailing list rather than through a pull request. - Pull requests are not practical because we have a strict policy never to - merge any untested changes to the development branch (the only exception - being **obviously** correct changes, such as corrections of typos). + [`erlang-patches`] [3] mailing list or through a pull request. + +* Pull requests will be handled once everyday and there will be + essential testing before we will take a decision on the outcome + of the request. If the essential testings fails, the pull request + will be closed and you will have to fix the problem and submit another + pull request when this is done. * We merge all proposed updates to the `pu` (*proposed updates*) branch, typically within one working day. 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/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex a2e0f1050e..9360e60827 100644 --- a/bootstrap/lib/compiler/ebin/beam_utils.beam +++ b/bootstrap/lib/compiler/ebin/beam_utils.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/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup index 8cc82fff38..577ebb149d 100644 --- a/bootstrap/lib/compiler/ebin/compiler.appup +++ b/bootstrap/lib/compiler/ebin/compiler.appup @@ -1 +1 @@ -{"4.9",[],[]}. +{"4.9.1",[],[]}. diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex 06010a82dd..e4362955bd 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam Binary files differindex 116aacacdc..674fef3a42 100644 --- a/bootstrap/lib/kernel/ebin/inet_db.beam +++ b/bootstrap/lib/kernel/ebin/inet_db.beam diff --git a/bootstrap/lib/kernel/ebin/inet_hosts.beam b/bootstrap/lib/kernel/ebin/inet_hosts.beam Binary files differindex c73b477683..78e81ce23d 100644 --- a/bootstrap/lib/kernel/ebin/inet_hosts.beam +++ b/bootstrap/lib/kernel/ebin/inet_hosts.beam diff --git a/bootstrap/lib/kernel/ebin/inet_res.beam b/bootstrap/lib/kernel/ebin/inet_res.beam Binary files differindex 18ccc23eb0..698fd4b721 100644 --- a/bootstrap/lib/kernel/ebin/inet_res.beam +++ b/bootstrap/lib/kernel/ebin/inet_res.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index 5a6be8c68e..9c715bacd8 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -15,7 +15,7 @@ %% under the License. %% %% %CopyrightEnd% -{"2.16.1", +{"2.16.2", %% Up from - max two major revisions back [{<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 {<<"2\\.15(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R15 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/c.beam b/bootstrap/lib/stdlib/ebin/c.beam Binary files differindex e02d502159..b2999a6255 100644 --- a/bootstrap/lib/stdlib/ebin/c.beam +++ b/bootstrap/lib/stdlib/ebin/c.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..de1c007a77 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index 0f374eb279..382b0438c0 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -15,7 +15,7 @@ %% under the License. %% %% %CopyrightEnd% -{"1.19.1", +{"1.19.2", %% Up from - max two major revisions back [{<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 {<<"1\\.18(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R15 diff --git a/erts/autoconf/vxworks/sed.general b/erts/autoconf/vxworks/sed.general index e2d2f415f1..dbb9420b67 100644 --- a/erts/autoconf/vxworks/sed.general +++ b/erts/autoconf/vxworks/sed.general @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2012. All Rights Reserved. +# Copyright Ericsson AB 1997-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 diff --git a/erts/autoconf/vxworks/sed.vxworks_ppc32 b/erts/autoconf/vxworks/sed.vxworks_ppc32 index 48ec912b4f..f00daef74c 100644 --- a/erts/autoconf/vxworks/sed.vxworks_ppc32 +++ b/erts/autoconf/vxworks/sed.vxworks_ppc32 @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2010. 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 diff --git a/erts/autoconf/vxworks/sed.vxworks_simlinux b/erts/autoconf/vxworks/sed.vxworks_simlinux index fbf6d7bc9d..67ddbf1575 100644 --- a/erts/autoconf/vxworks/sed.vxworks_simlinux +++ b/erts/autoconf/vxworks/sed.vxworks_simlinux @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2008-2010. 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 diff --git a/erts/autoconf/vxworks/sed.vxworks_simso b/erts/autoconf/vxworks/sed.vxworks_simso index 17ec092dee..1af88cef31 100644 --- a/erts/autoconf/vxworks/sed.vxworks_simso +++ b/erts/autoconf/vxworks/sed.vxworks_simso @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2010. 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 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..8f5515baca 100644 --- a/erts/doc/src/crash_dump.xml +++ b/erts/doc/src/crash_dump.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1999</year><year>2010</year> + <year>1999</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -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..70569b1c6c 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> @@ -1021,6 +1037,20 @@ <p>For more information, see <seealso marker="erlang#system_info_cpu_topology">erlang:system_info(cpu_topology)</seealso>.</p> </item> + <tag><marker id="+sfwi"><c>+sfwi Interval</c></marker></tag> + <item> + <p>Set scheduler forced wakeup interval. All run queues will + be scanned each <c>Interval</c> milliseconds. While there are + sleeping schedulers in the system, one scheduler will be woken + for each non-empty run queue found. An <c>Interval</c> of zero + disables this feature, which also is the default. + </p> + <p>This feature has been introduced as a temporary workaround + for lengthy executing native code, and native code that do not + bump reductions properly in OTP. When these bugs have be fixed + the <c>+sfwi</c> flag will be removed. + </p> + </item> <tag><marker id="+stbt"><c>+stbt BindType</c></marker></tag> <item> <p>Try to set scheduler bind type. The same as the diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 7dc59ea954..767edc1cc0 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -6058,6 +6058,49 @@ ok notice. </p> </item> + <tag><c>{long_schedule, Time}</c></tag> + <item> + <p>If a process or port in the system runs uninterrupted + for at least <c>Time</c> wall clock milliseconds, a + message <c>{monitor, PidOrPort, long_schedule, Info}</c> + is sent to <c>MonitorPid</c>. <c>PidOrPort</c> is the + process or port that was running and <c>Info</c> is a + list of two-element tuples describing the event. In case + of a <c>pid()</c>, the tuples <c>{timeout, Millis}</c>, + <c>{in, Location}</c> and <c>{out, Location}</c> will be + present, where <c>Location</c> is either an MFA + (<c>{Module, Function, Arity}</c>) describing the + function where the process was scheduled in/out, or the + atom <c>undefined</c>. In case of a <c>port()</c>, the + tuples <c>{timeout, Millis}</c> and <c>{port_op,Op}</c> + will be present. <c>Op</c> will be one of <c>proc_sig</c>, + <c>timeout</c>, <c>input</c>, <c>output</c>, + <c>event</c> or <c>dist_cmd</c>, depending on which + driver callback was executing. <c>proc_sig</c> is an + internal operation and should never appear, while the + others represent the corresponding driver callbacks + <c>timeout</c>, <c>ready_input</c>, <c>ready_output</c>, + <c>event</c> and finally <c>outputv</c> (when the port + is used by distribution). The <c>Millis</c> value in + the <c>timeout</c> tuple will tell you the actual + uninterrupted execution time of the process or port, + which will always be <c>>=</c> the <c>Time</c> value + supplied when starting the trace. New tuples may be + added to the <c>Info</c> list in the future, and the + order of the tuples in the list may be changed at any + time without prior notice. + </p> + <p>This can be used to detect problems with NIF's or + drivers that take too long to execute. Generally, 1 ms + is considered a good maximum time for a driver callback + or a NIF. However, a time sharing system should usually + consider everything below 100 ms as "possible" and + fairly "normal". Schedule times above that might however + indicate swapping or a NIF/driver that is + misbehaving. Misbehaving NIF's and drivers could cause + bad resource utilization and bad overall performance of + the system.</p> + </item> <tag><c>{large_heap, Size}</c></tag> <item> <p>If a garbage collection in the system results in diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml index c73cdfd290..6ce2261430 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,24 @@ 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 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 "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>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 +224,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 +245,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 +318,43 @@ 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 strategies <c>aoff</c>, <c>aoffcbf</c> and <c>aoffcaobf</c> 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>aoffcbf</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|aoffcbf|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>aoffcbf</c> (address order first fit carrier best 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 +448,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/doc/src/notes.xml b/erts/doc/src/notes.xml index 3a2c644ff7..f94d71ee3d 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -30,6 +30,369 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 5.10.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A bug in prim_inet has been corrected. If the port owner + was killed at a bad time while closing the socket port + the port could become orphaned hence causing port and + socket leaking. Reported by Fred Herbert, Dmitry Belyaev + and others.</p> + <p> + Own Id: OTP-10497 Aux Id: OTP-10562 </p> + </item> + <item> + <p> + Compilation fixes for NetBSD. Thanks to YAMAMOTO Takashi.</p> + <p> + Own Id: OTP-10941</p> + </item> + <item> + <p> + Fixed a race condition when using delayed_write when + writing to a file which would cause the same data to be + written multiple times.</p> + <p> + Own Id: OTP-10984</p> + </item> + <item> + <p> + Fix small memory leak from tracing with option + <c>meta</c>.</p> + <p> + Own Id: OTP-10997</p> + </item> + <item> + <p> + Correct typo in erlsrv usage. Thanks to Bryan Hunter</p> + <p> + Own Id: OTP-11002</p> + </item> + <item> + <p> + ct_run: delete unused function. Thanks to Tuncer Ayaz.</p> + <p> + Own Id: OTP-11003</p> + </item> + <item> + <p> + Corrections to run_erl/to_erl handshake behaviour.</p> + <p> + Own Id: OTP-11012</p> + </item> + <item> + <p> + Fix typo in type: erlang:process_info_item(). Thanks to + Andrew Tunnell-Jones.</p> + <p> + Own Id: OTP-11024</p> + </item> + <item> + <p> + Fix src/dest overlap issue in ttsl driver. Thanks to + Steve Vinoski.</p> + <p> + Own Id: OTP-11064</p> + </item> + <item> + <p> + When sending to a port using <c>erlang:send(Port, Msg, + [nosuspend])</c>, the send operation was performed + synchronously. This bug has now been fixed.</p> + <p> + Own Id: OTP-11076 Aux Id: OTP-10336 </p> + </item> + <item> + <p> + When converting a faulty binary to a list with + unicode:characters_to_list, the error return value could + contain a faulty "rest", i.e. the io_list of characters + that could not be converted was wrong. This happened only + if input was a sub binary and conversion was from utf8. + This is now corrected.</p> + <p> + Own Id: OTP-11080</p> + </item> + <item> + <p> + Runtime system could crash when reporting stale + <c>driver_select()</c>.</p> + <p> + Own Id: OTP-11084</p> + </item> + <item> + <p> + Fix lock order violation for memory instrumentation + (+Mim, +Mis, +Mit).</p> + <p> + Own Id: OTP-11085</p> + </item> + <item> + <p> + Fixed some compilation warnings on miscellaneous + platforms. Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11086</p> + </item> + <item> + <p> + Fixed issue when flushing i/o during shutdown on windows + where the Erlang VM would sometime hang due to a race + condition.</p> + <p> + Own Id: OTP-11096</p> + </item> + <item> + <p> + Fixed issue where repeated calls to erlang:nodes() could + cause unnecessary contention in the dist_table lock.</p> + <p> + Own Id: OTP-11097</p> + </item> + <item> + <p> + Properly guard WIDE_TAG use with HAVE_WCWIDTH in + ttsl_drv. Thanks to Anthony Ramine</p> + <p> + Own Id: OTP-11106</p> + </item> + <item> + <p> + Fix some Makefile rules that didn't support silent rules. + Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11111</p> + </item> + <item> + <p> + Fix receive support in erl_eval with a BEAM module. + Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11137</p> + </item> + <item> + <p> + erlang:now() could suddenly jump ~24 days into the future + on Windows. This is now corrected. Thanks to Garret Smith + for reporting and testing fixes.</p> + <p> + Own Id: OTP-11146</p> + </item> + <item> + <p> + erlang:term_to_binary will now cost an appropriate amount + of reductions and will interrupt (yield) for reschedule + if the term is big. This avoids too long schedules when + term_to_binary is used. </p> + <p> + Impact: Programs running term_to_binary on large terms + will run more smothly, but rescheduling will impact the + single process performance of the BIF. Single threaded + benchmarks will show degraded performance of the BIF when + called with very large terms, while general system + behaviour will be improved. The overhead for allowing + restart and reduction counting also degrades local + performance of the BIF with between 5% and 10% even for + small terms.</p> + <p> + Own Id: OTP-11163</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Replaced the lock protecting gathering of garbage + collection statistics with a lock-free solution.</p> + <p> + Own Id: OTP-10271 Aux Id: kunagi-108 + [04c5410f-9cc4-4696-8639-36bf98686c7a-7] </p> + </item> + <item> + <p>Support for migration of memory carriers between + memory allocator instances has been introduced.</p> + <p>By default this feature is not enabled and do not + effect the characteristics of the system. When enabled it + has the following impact on the characteristics of the + system:</p> <list> <item>Reduced memory footprint when + the memory load is unevenly distributed between scheduler + specific allocator instances.</item> <item>Depending on + the default allocaton strategy used on a specific + allocator there might or might not be a slight + performance loss.</item> <item>When enabled on the + <c>fix_alloc</c> allocator, a different strategy for + management of fix blocks will be used.</item> <item>The + information returned from <seealso + marker="erlang:system_info_allocator_tuple"><c>erlang:system_info({allocator, + A})</c></seealso>, and <seealso + marker="erlang:system_info_allocator_sizes"><c>erlang:system_info({allocator_sizes, + A})</c></seealso> will be slightly different when this + feature has been enabled. An <c>mbcs_pool</c> tuple will + be present giving information about abandoned carriers, + and in the <c>fix_alloc</c> case no <c>fix_types</c> + tuple will be present. </item></list> + <p>For more information, see the documentation of the + <seealso + marker="erts_alloc#M_acul"><c>+M<S>acul</c></seealso> + command line argument.</p> + <p> + Own Id: OTP-10279</p> + </item> + <item> + <p> + Change specs for spawn_opt to use the process_level() + type declaration instead of re-defining it in various + places. Thanks to Kostis Sagonas.</p> + <p> + Own Id: OTP-11008</p> + </item> + <item> + <p> Postscript files no longer needed for the generation + of PDF files have been removed. </p> + <p> + Own Id: OTP-11016</p> + </item> + <item> + <p>Erlang source files with non-ASCII characters are now + encoded in UTF-8 (instead of latin1).</p> + <p> + Own Id: OTP-11041 Aux Id: OTP-10907 </p> + </item> + <item> + <p> + Optimization of simultaneous <c>inet_db</c> operations on + the same socket by using a lock free implementation.</p> + <p> + Impact on the characteristics of the system: Improved + performance.</p> + <p> + Own Id: OTP-11074</p> + </item> + <item> + <p> + The <c>high_msgq_watermark</c> and + <c>low_msgq_watermark</c> <c>inet</c> socket options + introduced in OTP-R16A could only be set on TCP sockets. + These options are now generic and can be set on all types + of sockets.</p> + <p> + Own Id: OTP-11075 Aux Id: OTP-10336 </p> + </item> + <item> + <p>A new better algorithm for management of the process, + and port tables has been introduced.</p> + <p>Impact on the characteristics of the system:</p> + <list> <item>The new algorithm ensures that both insert + and delete operations can be made in O(1) time + complexity. Previously used algorithm either caused + insert or delete to be O(N).</item> <item>The new + algorithm will also ensure that reuse of identifiers will + be less frequent than when the old algorithm was + used.</item> <item>Previously used algorithm ensured that + the latest created identifier compared as the largest + when comparing two identifiers of the same type that had + been created on the same node as long as no identifiers + had been reused. Since identifiers can be reused quite + fast, one has never been able to rely on this property. + Due to the introduction of this new algorithm this + property will not hold even if no identifiers has been + reused yet. This could be considered as an + incompatibility.</item> </list> + <p>Due to the above mensioned potential incompatibility, + it will still be possible to enable the old algorithm for + some time. The command line argument <seealso + marker="erl#+P"><c>+P legacy</c></seealso> will enable + the old algorithm on the process table, and <seealso + marker="erl#+Q"><c>+Q legacy</c></seealso> will do the + same for the port table. These command line arguments are + however deprecated as of their introduction and have been + scheduled for removal in OTP-R18.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-11077</p> + </item> + <item> + <p> + Support wide characters in the shell through wcwidth(). + Thanks to Anthony Ramine. Reported by Lo�c Hoguin.</p> + <p> + Own Id: OTP-11088</p> + </item> + <item> + <p> + Added total used memory for each process in erlang crash + dumps.</p> + <p> + Own Id: OTP-11098</p> + </item> + <item> + <p> + Added support for hipe on Raspberry Pi (armv6l). Thanks + to Klaus Alfert.</p> + <p> + Own Id: OTP-11125</p> + </item> + <item> + <p> + Remove 'query' from the list of reserved words in docs. + Thanks to Matthias Endler and Lo�c Hoguin.</p> + <p> + Own Id: OTP-11158</p> + </item> + <item> + <p> + Lift static limitation (FD_SETSIZE) for file descriptors + on Mac OS X. (Thanks to Anthony Ramine)</p> + <p> + Own Id: OTP-11159</p> + </item> + </list> + </section> + + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p>Miscellaneous native code in OTP misbehave either due + to lengthy execution, or due to not bumping reductions + properly. Problems typically occur when passing huge sets + of data to a misbehaving BIF. Fixing this has high + priority and is being worked on, but there will remain + issues like this for some time.</p> + <p>In order to alleviate problems with scheduling which + might occur when executing misbehaving native code, the + command line argument <seealso + marker="erl#+sfwi">+sfwi</seealso> has been + introduced.</p> + <p>By default this feature is disabled and you are + advised not to enable it if you do not encounter problems + with misbehaving native code.</p> + <p>When enabled it has the following impact on the + characteristics of the system:</p> <list> <item>Work will + always be distributed between schedulers even when + executing misbehaving native code.</item> <item>It may + cause an increased amount of processes and/or ports + bouncing between schedulers which in turn will cause a + performance loss.</item> <item>It may cause reduced + performance due to reduced or lost work compaction when + all schedulers do not execute under full load.</item> + <item>An increased contention on run queue locks.</item> + </list> + <p> + Own Id: OTP-11164</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 5.10.1.2</title> <section><title>Fixed Bugs and Malfunctions</title> 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 ce60bb9bbc..eba1d0fa23 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -178,6 +178,7 @@ atom disable_trace atom disabled atom display_items atom dist +atom dist_cmd atom Div='/' atom div atom dlink @@ -248,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 @@ -312,6 +314,7 @@ atom load_cancelled atom load_failure atom local atom long_gc +atom long_schedule atom low atom Lt='<' atom machine @@ -322,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 @@ -430,6 +434,7 @@ atom port atom ports atom port_count atom port_limit +atom port_op atom print atom priority atom private @@ -441,6 +446,7 @@ atom process_display atom process_limit atom process_dump atom procs +atom proc_sig atom profile atom protected atom protection @@ -528,6 +534,7 @@ atom system_version atom system_architecture atom SYSTEM='SYSTEM' atom table +atom term_to_binary_trap atom this atom thread_pool_size atom threads diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index ce025c9b6d..68907a771a 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -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 diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 944ed6da81..5781009f58 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -924,6 +924,7 @@ extern int count_instructions; # define NOINLINE #endif + /* * The following functions are called directly by process_main(). * Don't inline them. @@ -1153,6 +1154,9 @@ void process_main(void) Eterm pt_arity; /* Used by do_put_tuple */ + Uint64 start_time = 0; /* Monitor long schedule */ + BeamInstr* start_time_i = NULL; + ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */ @@ -1175,6 +1179,16 @@ void process_main(void) do_schedule: reds_used = REDS_IN(c_p) - FCALLS; do_schedule1: + + if (start_time != 0) { + Sint64 diff = erts_timestamp_millis() - start_time; + if (diff > 0 && (Uint) diff > erts_system_monitor_long_schedule) { + BeamInstr *inptr = find_function_from_pc(start_time_i); + BeamInstr *outptr = find_function_from_pc(c_p->i); + monitor_long_schedule_proc(c_p,inptr,outptr,(Uint) diff); + } + } + PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); #if HALFWORD_HEAP @@ -1183,11 +1197,18 @@ void process_main(void) ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); c_p = schedule(c_p, reds_used); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + start_time = 0; #ifdef DEBUG pid = c_p->common.id; /* Save for debugging purpouses */ #endif ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); + + if (erts_system_monitor_long_schedule != 0) { + start_time = erts_timestamp_millis(); + start_time_i = c_p->i; + } + reg = ERTS_PROC_GET_SCHDATA(c_p)->x_reg_array; freg = ERTS_PROC_GET_SCHDATA(c_p)->f_reg_array; #if !HEAP_ON_C_STACK @@ -6151,6 +6172,7 @@ apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg) } + static Eterm new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free) { 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..6b43c53985 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -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 @@ -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..ad9a89b642 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -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 @@ -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..5eacff8829 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,41 +240,32 @@ do { \ sys_memcpy((void *) (IP), (void *) &aui__, sizeof(struct au_init)); \ } while (0) -static void -set_default_sbmbc_alloc_opts(struct au_init *ip) +#if ERTS_ALC_DEFAULT_ACUL \ + || ERTS_ALC_DEFAULT_ACUL_LL_ALLOC \ + || ERTS_ALC_DEFAULT_ACUL_EHEAP_ALLOC + +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.flavor = AOFF_BF; + ip->init.util.acul = acul; } +#endif + static void 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 +288,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 +310,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 +333,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 +341,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 +364,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 +391,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 +413,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 +435,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 +457,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 +528,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, aoffcbf 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 aoffcbf */ + auip->atype = AOFIRSTFIT; + auip->init.aoff.flavor = AOFF_BF; + } +} + void erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) { @@ -515,9 +613,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 +631,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 +655,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 +667,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 +678,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 +712,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 +755,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 +767,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 +798,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 +851,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 +1187,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 +1201,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 +1217,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 +1290,26 @@ handle_au_arg(struct au_init *auip, } else if (strcmp("aoff", alg) == 0) { auip->atype = AOFIRSTFIT; + auip->init.aoff.flavor = AOFF_AOFF; + } + else if (strcmp("aoffcbf", alg) == 0) { + auip->atype = AOFIRSTFIT; + auip->init.aoff.flavor = AOFF_BF; + } + else if (strcmp("aoffcaobf", alg) == 0) { + auip->atype = AOFIRSTFIT; + auip->init.aoff.flavor = AOFF_AOBF; } 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 +1369,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 +1384,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 +1399,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 +1425,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 +1466,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 +1531,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 +1558,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 +1623,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 +2169,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 +2213,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 +2247,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 +2256,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 +2382,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 +2417,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 +2497,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 +2656,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 +2918,7 @@ reply_alloc_info(void *vair) int i; Eterm (*info_func)(Allctr_t *, int, + int, int *, void *, Uint **, @@ -2939,8 +3047,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 +3083,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 +3139,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 +3152,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 +3218,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 +3296,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 +3348,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 +3474,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..b5975c6c32 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2012. 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 @@ -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..bb5eba80be 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 @@ -156,6 +150,7 @@ type LINK_LH STANDARD PROCESSES link_lh type SUSPEND_MON STANDARD PROCESSES suspend_monitor type PEND_SUSPEND SHORT_LIVED PROCESSES pending_suspend type PROC_LIST SHORT_LIVED PROCESSES proc_list +type EXTRA_ROOT SHORT_LIVED PROCESSES extra_root type FUN_ENTRY LONG_LIVED CODE fun_entry type ATOM_TXT LONG_LIVED ATOM atom_text type BEAM_REGISTER EHEAP PROCESSES beam_register @@ -272,6 +267,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 +346,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 +360,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 +378,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 @@ -401,6 +398,7 @@ type POLLSET_UPDREQ SHORT_LIVED SYSTEM pollset_update_req type POLL_FDS LONG_LIVED SYSTEM poll_fds type POLL_RES_EVS LONG_LIVED SYSTEM poll_result_events type FD_STATUS LONG_LIVED SYSTEM fd_status +type SELECT_FDS LONG_LIVED SYSTEM select_fds +if unix diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index ac7f420708..bf8a37c71b 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); - fix[ix].allocated--; + if (!res) { + fix->u.nocpool.allocated--; + fix->u.nocpool.used--; + } + return res; +} + +static ERTS_INLINE void +fix_nocpool_free(Allctr_t *allctr, + ErtsAlcType_t type, + void *p) +{ + Block_t *blk; + ErtsAlcFixList_t *fix; + + ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= type + && type <= ERTS_ALC_N_MAX_A_FIXED_SIZE); + + fix = &allctr->fix[type - ERTS_ALC_N_MIN_A_FIXED_SIZE]; + + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); + fix->u.nocpool.used--; + if (fix->u.nocpool.allocated < fix->u.nocpool.limit + && fix->list_size < ERTS_ALCU_FIX_MAX_LIST_SZ) { + *((void **) p) = fix->list; + fix->list = p; + fix->list_size++; + sched_fix_shrink(allctr, 1); + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); + return; + } + fix->u.nocpool.allocated--; + if (fix->list && fix->u.nocpool.allocated > fix->u.nocpool.limit) { + blk = UMEM2BLK(p); + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk, NULL); + else + mbc_free(allctr, p, NULL); + p = fix->list; + fix->list = *((void **) p); + fix->list_size--; + fix->u.nocpool.allocated--; + } + + blk = UMEM2BLK(p); + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk, NULL); + else + mbc_free(allctr, p, NULL); + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); +} + +static ERTS_INLINE erts_aint32_t +fix_nocpool_alloc_shrink(Allctr_t *allctr, erts_aint32_t flgs) +{ + int all_empty = 1; + erts_aint32_t res = 0; + int ix, o; + int flush = flgs == 0; + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_lock(&allctr->mutex); +#endif + + for (ix = 0; ix < ERTS_ALC_NO_FIXED_SIZES; ix++) { + ErtsAlcFixList_t *fix = &allctr->fix[ix]; + ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 1); + if (flgs & ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM) { + fix->u.nocpool.limit = fix->u.nocpool.max_used; + if (fix->u.nocpool.limit < fix->u.nocpool.used) + fix->u.nocpool.limit = fix->u.nocpool.used; + fix->u.nocpool.max_used = fix->u.nocpool.used; + ASSERT(fix->u.nocpool.limit >= 0); + + } + if (flush) { + fix->u.nocpool.limit = 0; + fix->u.nocpool.max_used = fix->u.nocpool.used; + ASSERT(fix->u.nocpool.limit >= 0); } - if (fix[ix].list_size != 0) { - if (fix[ix].limit < fix[ix].allocated) + for (o = 0; o < ERTS_ALC_FIX_MAX_SHRINK_OPS || flush; o++) { + void *ptr; + + if (!flush && fix->u.nocpool.limit >= fix->u.nocpool.allocated) + break; + if (fix->list_size == 0) + break; + ptr = fix->list; + fix->list = *((void **) ptr); + fix->list_size--; + dealloc_block(allctr, ptr, 0); + fix->u.nocpool.allocated--; + } + if (fix->list_size != 0) { + if (fix->u.nocpool.limit < fix->u.nocpool.allocated) res |= ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC; all_empty = 0; } ERTS_DBG_CHK_FIX_LIST(allctr, fix, ix, 0); } - if (all_empty && allctr->fix_shrink_scheduled) { - allctr->fix_shrink_scheduled = 0; - erts_set_aux_work_timeout(allctr->ix, - (ERTS_SSI_AUX_WORK_FIX_ALLOC_LOWER_LIM - | ERTS_SSI_AUX_WORK_FIX_ALLOC_DEALLOC), - 0); - } + if (all_empty) + sched_fix_shrink(allctr, 0); #ifdef USE_THREADS if (allctr->thread_safe) @@ -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,36 @@ handle_delayed_dealloc(Allctr_t *allctr, res = 1; - INC_CC(allctr->calls.this_free); + 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. For more info + * see schedule_dealloc_carrier(). + * + * 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); + ERTS_ALC_CPOOL_ASSERT(((erts_aint_t) allctr) + != (erts_smp_atomic_read_nob(&crr->allctr) + & ~FLG_MASK)); - 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--; - } + erts_smp_atomic_set_nob(&crr->allctr, ((erts_aint_t) 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 +1788,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 +1806,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 +1878,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 +1973,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 +2005,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 +2046,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 +2067,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 +2077,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 +2113,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 +2129,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 +2162,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 +2189,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 +2202,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 +2256,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 +2278,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 +2290,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 +2300,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 +2327,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 +2340,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 +2370,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 +2380,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 +2441,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 +2463,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 +2477,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 +2500,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 +2509,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 +2534,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 +2545,647 @@ 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 *orig_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; + } + + orig_allctr = crr->cpool.orig_allctr; + + if (allctr != orig_allctr) { + Block_t *blk = MBC_TO_FIRST_BLK(allctr, crr); + int cinit = orig_allctr->dd.ix - allctr->dd.ix; + + /* + * We send the carrier to its origin for deallocation. + * This in order: + * - not to complicate things for the thread specific + * instances of mseg_alloc, and + * - to ensure that we always only reuse empty carriers + * originating from our own thread specific mseg_alloc + * instance which is beneficial on NUMA systems. + * + * The receiver will recognize that this is a carrier to + * deallocate (and not a block which is the common case) + * since the block is an mbc block that is free and last + * in the 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(allctr, blk)); + ERTS_ALC_CPOOL_ASSERT(((erts_aint_t) allctr) + == (erts_smp_atomic_read_nob(&crr->allctr) + & ~FLG_MASK)); + + if (ddq_enqueue(&orig_allctr->dd.q, BLK2UMEM(blk), cinit)) + erts_alloc_notify_delayed_dealloc(orig_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 +3229,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 +3257,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 +3402,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 +3554,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 +3581,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 +3590,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 +3609,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 +3672,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 +3709,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 +3727,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 +3764,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 +3801,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 +3815,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 +3848,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 +3889,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 +3914,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 +3988,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 +4002,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 +4026,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 +4092,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 +4116,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 +4235,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 +4248,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 +4274,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 +4323,7 @@ info_options(Allctr_t *allctr, Uint *szp) { Eterm res = THE_NON_VALUE; + int acul; if (!allctr) { if (print_to_p) @@ -3056,6 +4335,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 +4369,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 +4391,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 +4399,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 +4523,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 +4546,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 +4568,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 +4654,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 +4684,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 +4703,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 +4717,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 +4744,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 +4792,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 +4809,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 +4892,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 +4924,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 +4938,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 +4969,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 +4991,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 +5001,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 +5014,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 +5034,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 +5060,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 +5071,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 +5112,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 +5136,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 +5150,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 +5171,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 +5186,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 +5210,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 +5237,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 +5280,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 +5297,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 +5362,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 +5477,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 +5513,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 +5524,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 +5548,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 +5558,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 +5569,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 +5577,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 +5588,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 +5630,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 +5646,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 +5681,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 +5752,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 +5773,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 +5910,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..02cbe5c5d0 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2002-2012. 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 @@ -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..4e6c8b317e 100644 --- a/erts/emulator/beam/erl_ao_firstfit_alloc.c +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c @@ -28,11 +28,17 @@ * * 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. + * Bestfit within carrier: + * The only difference for "bestfit within carrier" is the tree + * sorting order. Blocks within the same carrier are sorted + * wrt size instead of address. The 'max_sz' field is maintained + * in order to dismiss entire carriers with too small blocks. * * Authors: Rickard Green/Sverker Eriksson */ @@ -62,6 +68,15 @@ # define LEFT_VISITED_FLG (((Uint) 1) << 2) # define RIGHT_VISITED_FLG (((Uint) 1) << 3) #endif +#ifdef DEBUG +# define IS_BF_FLG (((Uint) 1) << 4) +#endif + +#define IS_TREE_NODE(N) (((AOFF_RBTree_t *) (N))->flags & TREE_NODE_FLG) +#define IS_LIST_ELEM(N) (!IS_TREE_NODE(((AOFF_RBTree_t *) (N)))) + +#define SET_TREE_NODE(N) (((AOFF_RBTree_t *) (N))->flags |= TREE_NODE_FLG) +#define SET_LIST_ELEM(N) (((AOFF_RBTree_t *) (N))->flags &= ~TREE_NODE_FLG) #define IS_RED(N) (((AOFF_RBTree_t *) (N)) \ && ((AOFF_RBTree_t *) (N))->flags & RED_FLG) @@ -85,21 +100,55 @@ 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) +/* BF block nodes keeps list of all with equal size + */ +typedef struct { + AOFF_RBTree_t t; + AOFF_RBTree_t *next; +}AOFF_RBTreeList_t; + +#define LIST_NEXT(N) (((AOFF_RBTreeList_t*) (N))->next) +#define LIST_PREV(N) (((AOFF_RBTreeList_t*) (N))->t.parent) + +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,FLV,ROOT,SZ) check_tree(CRR, FLV, ROOT, SZ) +static AOFF_RBTree_t * check_tree(Carrier_t* within_crr, enum AOFF_Flavor flavor, AOFF_RBTree_t* root, Uint); +#else +# define HARD_CHECK_IS_MEMBER(ROOT,NODE) +# define HARD_CHECK_TREE(CRR,FLV,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 +162,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 +181,53 @@ static ERTS_INLINE void lower_max_size(AOFF_RBTree_t *node, else ASSERT(new_max == old_max); } +static ERTS_INLINE SWord cmp_blocks(enum AOFF_Flavor flavor, + AOFF_RBTree_t* lhs, AOFF_RBTree_t* rhs) +{ + ASSERT(lhs != rhs); + ASSERT(flavor == AOFF_AOFF || FBLK_TO_MBC(&lhs->hdr) == FBLK_TO_MBC(&rhs->hdr)); + if (flavor != AOFF_AOFF) { + SWord diff = (SWord)AOFF_BLK_SZ(lhs) - (SWord)AOFF_BLK_SZ(rhs); + if (diff || flavor == AOFF_BF) return diff; + } + return (char*)lhs - (char*)rhs; +} + +static ERTS_INLINE SWord cmp_cand_blk(enum AOFF_Flavor flavor, + Block_t* cand_blk, AOFF_RBTree_t* rhs) +{ + if (flavor != AOFF_AOFF) { + 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 || flavor == AOFF_BF) 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(enum AOFF_Flavor flavor, 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,9 +254,12 @@ erts_aoffalc_start(AOFFAllctr_t *alc, sys_memcpy((void *) alc, (void *) &zero.allctr, sizeof(AOFFAllctr_t)); + alc->flavor = aoffinit->flavor; + 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->min_block_size = (aoffinit->flavor == AOFF_BF ? + sizeof(AOFF_RBTreeList_t):sizeof(AOFF_RBTree_t)); allctr->vsn_str = ERTS_ALC_AOFF_ALLOC_VSN_STR; @@ -195,12 +268,15 @@ erts_aoffalc_start(AOFFAllctr_t *alc, allctr->get_free_block = aoff_get_free_block; allctr->link_free_block = aoff_link_free_block; - allctr->unlink_free_block = aoff_unlink_free_block; + allctr->unlink_free_block = aoff_unlink_free_block; 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 @@ -303,10 +379,7 @@ replace(AOFF_RBTree_t **root, AOFF_RBTree_t *x, AOFF_RBTree_t *y) y->parent = x->parent; y->right = x->right; y->left = x->left; - - y->max_sz = x->max_sz; - lower_max_size(y, NULL); - DESTROY_TREE_NODE(x); + y->max_sz = x->max_sz; } static void @@ -403,21 +476,72 @@ 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 *blk) +{ + AOFFAllctr_t* alc = (AOFFAllctr_t*)allctr; + AOFF_RBTree_t* del = (AOFF_RBTree_t*)blk; + AOFF_Carrier_t *crr = (AOFF_Carrier_t*) FBLK_TO_MBC(&del->hdr); + + ASSERT(crr->rbt_node.hdr.bhdr == crr->root->max_sz); + HARD_CHECK_TREE(&crr->crr, alc->flavor, crr->root, 0); + + if (alc->flavor == AOFF_BF) { + ASSERT(del->flags & IS_BF_FLG); + if (IS_LIST_ELEM(del)) { + /* Remove from list */ + ASSERT(LIST_PREV(del)); + ASSERT(LIST_PREV(del)->flags & IS_BF_FLG); + LIST_NEXT(LIST_PREV(del)) = LIST_NEXT(del); + if (LIST_NEXT(del)) { + ASSERT(LIST_NEXT(del)->flags & IS_BF_FLG); + LIST_PREV(LIST_NEXT(del)) = LIST_PREV(del); + } + return; + } + else if (LIST_NEXT(del)) { + /* Replace tree node by next element in list... */ + + ASSERT(AOFF_BLK_SZ(LIST_NEXT(del)) == AOFF_BLK_SZ(del)); + ASSERT(IS_LIST_ELEM(LIST_NEXT(del))); + + replace(&crr->root, (AOFF_RBTree_t*)del, LIST_NEXT(del)); + + HARD_CHECK_TREE(&crr->crr, alc->flavor, crr->root, 0); + return; + } + } + + rbt_delete(&crr->root, (AOFF_RBTree_t*)del); + + HARD_CHECK_TREE(&crr->crr, alc->flavor, 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... */ @@ -461,7 +585,9 @@ aoff_unlink_free_block(Allctr_t *allctr, Block_t *del, Uint32 flags) } if (y != z) { /* We spliced out the successor of z; replace z by the successor */ + ASSERT(z != &null_x); replace(root, z, y); + lower_max_size(y, NULL); } if (spliced_is_black) { @@ -572,28 +698,48 @@ aoff_unlink_free_block(Allctr_t *allctr, Block_t *del, Uint32 flags) RBT_ASSERT(!null_x.right); } } +} - DESTROY_TREE_NODE(del); +static void +aoff_link_free_block(Allctr_t *allctr, Block_t *block) +{ + AOFFAllctr_t* alc = (AOFFAllctr_t*) allctr; + AOFF_RBTree_t *blk = (AOFF_RBTree_t *) block; + 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_TREE(&blk_crr->crr, alc->flavor, blk_crr->root, 0); + + rbt_insert(alc->flavor, &blk_crr->root, blk); + + /* Update the carrier tree with a potentially 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->flavor, blk_crr->root, 0); } static void -aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) +rbt_insert(enum AOFF_Flavor flavor, AOFF_RBTree_t** root, AOFF_RBTree_t* blk) { - 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); Uint blk_sz = AOFF_BLK_SZ(blk); -#ifdef HARD_DEBUG - check_tree(*root, 0); +#ifdef DEBUG + blk->flags = (flavor == AOFF_BF) ? IS_BF_FLG : 0; +#else + blk->flags = 0; #endif - - blk->flags = 0; blk->left = NULL; blk->right = NULL; blk->max_sz = blk_sz; @@ -606,10 +752,12 @@ aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) else { AOFF_RBTree_t *x = *root; while (1) { + SWord diff; if (x->max_sz < blk_sz) { x->max_sz = blk_sz; } - if (blk < x) { + diff = cmp_blocks(flavor, blk, x); + if (diff < 0) { if (!x->left) { blk->parent = x; x->left = blk; @@ -617,7 +765,7 @@ aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) } x = x->left; } - else { + else if (diff > 0) { if (!x->right) { blk->parent = x; x->right = blk; @@ -625,7 +773,18 @@ aoff_link_free_block(Allctr_t *allctr, Block_t *block, Uint32 flags) } x = x->right; } - + else { + ASSERT(flavor == AOFF_BF); + ASSERT(blk->flags & IS_BF_FLG); + ASSERT(x->flags & IS_BF_FLG); + SET_LIST_ELEM(blk); + LIST_NEXT(blk) = LIST_NEXT(x); + LIST_PREV(blk) = x; + if (LIST_NEXT(x)) + LIST_PREV(LIST_NEXT(x)) = blk; + LIST_NEXT(x) = blk; + return; + } } /* Insert block into size tree */ @@ -635,38 +794,63 @@ 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 + if (flavor == AOFF_BF) { + SET_TREE_NODE(blk); + LIST_NEXT(blk) = NULL; + } } -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->flavor, crr->root, size); +#endif + + blk = rbt_search(crr->root, size); + ASSERT(blk); #ifdef HARD_DEBUG ASSERT(blk == dbg_blk); @@ -675,15 +859,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->flavor, 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(AOFF_AOFF, 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(AOFF_AOFF, 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 +948,8 @@ aoff_get_free_block(Allctr_t *allctr, Uint size, static struct { Eterm as; Eterm aoff; + Eterm aoffcaobf; + Eterm aoffcbf; #ifdef DEBUG Eterm end_of_atoms; #endif @@ -720,6 +978,8 @@ init_atoms(void) #endif AM_INIT(as); AM_INIT(aoff); + AM_INIT(aoffcaobf); + AM_INIT(aoffcbf); #ifdef DEBUG for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) { @@ -749,14 +1009,17 @@ info_options(Allctr_t *allctr, Uint **hpp, Uint *szp) { + AOFFAllctr_t* alc = (AOFFAllctr_t*) allctr; Eterm res = THE_NON_VALUE; + const char* flavor_str[3] = {"aoff", "aoffcaobf", "aoffcbf"}; + Eterm flavor_atom[3] = {am.aoff, am.aoffcaobf, am.aoffcbf}; if (print_to_p) { erts_print(*print_to_p, print_to_arg, "%sas: %s\n", prefix, - "aoff"); + flavor_str[alc->flavor]); } if (hpp || szp) { @@ -766,7 +1029,7 @@ 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, flavor_atom[alc->flavor]); } return res; @@ -780,19 +1043,28 @@ 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 0x500: return (UWord) ((AOFFAllctr_t *) a1)->flavor == AOFF_AOBF; + 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 0x505: return (UWord) LIST_NEXT(a1); + case 0x506: return (UWord) IS_BLACK((AOFF_RBTree_t *) a1); + case 0x507: return (UWord) IS_TREE_NODE((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)->flavor == AOFF_BF; + case 0x50b: return (UWord) LIST_PREV(a1); + default: ASSERT(0); return ~((UWord) 0); } } @@ -804,6 +1076,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,16 +1122,19 @@ 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, enum AOFF_Flavor flavor, 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); #endif + ASSERT(within_crr || flavor == AOFF_AOFF); if (!root) return res; @@ -859,12 +1144,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 +1169,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 +1181,30 @@ 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 (flavor == AOFF_BF) { + AOFF_RBTree_t* y = x; + AOFF_RBTree_t* nxt = LIST_NEXT(y); + ASSERT(IS_TREE_NODE(x)); + while (nxt) { + ASSERT(IS_LIST_ELEM(nxt)); + ASSERT(AOFF_BLK_SZ(nxt) == AOFF_BLK_SZ(x)); + ASSERT(FBLK_TO_MBC(&nxt->hdr) == within_crr); + ASSERT(LIST_PREV(nxt) == y); + y = nxt; + nxt = LIST_NEXT(nxt); + } + } if (IS_RED(x)) { ASSERT(IS_BLACK(x->right)); @@ -901,13 +1215,13 @@ check_tree(AOFF_RBTree_t* root, Uint size) if (x->left) { ASSERT(x->left->parent == x); - ASSERT(x->left < x); + ASSERT(cmp_blocks(flavor, 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(flavor, x->right, x) > 0); ASSERT(x->right->max_sz <= x->max_sz); } ASSERT(x->max_sz >= AOFF_BLK_SZ(x)); @@ -916,7 +1230,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(flavor, x, res) < 0) { res = x; } } @@ -926,10 +1240,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 +1269,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..25b344c6a8 100644 --- a/erts/emulator/beam/erl_ao_firstfit_alloc.h +++ b/erts/emulator/beam/erl_ao_firstfit_alloc.h @@ -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 @@ -27,8 +27,14 @@ typedef struct AOFFAllctr_t_ AOFFAllctr_t; +enum AOFF_Flavor { + AOFF_AOFF = 0, + AOFF_AOBF = 1, + AOFF_BF = 2 +}; + typedef struct { - int dummy; + enum AOFF_Flavor flavor; } AOFFAllctrInit_t; #define ERTS_DEFAULT_AOFF_ALLCTR_INIT {0/*dummy*/} @@ -51,10 +57,10 @@ struct AOFFAllctr_t_ { Allctr_t allctr; /* Has to be first! */ struct AOFF_RBTree_t_* mbc_root; - struct AOFF_RBTree_t_* sbmbc_root; + enum AOFF_Flavor flavor; }; -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..41f449bb28 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,22 @@ 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; /* IS_AOBF */ + 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) LIST_NEXT(a1); + 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 */ + case 0x20a: return (UWord) !((BFAllctr_t *) a1)->address_order; /* IS_BF */ + case 0x20b: return (UWord) LIST_PREV(a1); + 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..870439e886 100644 --- a/erts/emulator/beam/erl_bestfit_alloc.h +++ b/erts/emulator/beam/erl_bestfit_alloc.h @@ -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 @@ -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 41c98bbffb..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; @@ -2014,6 +2012,7 @@ void erts_system_monitor_clear(Process *c_p) { #endif erts_set_system_monitor(NIL); erts_system_monitor_long_gc = 0; + erts_system_monitor_long_schedule = 0; erts_system_monitor_large_heap = 0; erts_system_monitor_flags.busy_port = 0; erts_system_monitor_flags.busy_dist_port = 0; @@ -2038,12 +2037,17 @@ static Eterm system_monitor_get(Process *p) Uint hsz = 3 + (erts_system_monitor_flags.busy_dist_port ? 2 : 0) + (erts_system_monitor_flags.busy_port ? 2 : 0); Eterm long_gc = NIL; + Eterm long_schedule = NIL; Eterm large_heap = NIL; if (erts_system_monitor_long_gc != 0) { hsz += 2+3; (void) erts_bld_uint(NULL, &hsz, erts_system_monitor_long_gc); } + if (erts_system_monitor_long_schedule != 0) { + hsz += 2+3; + (void) erts_bld_uint(NULL, &hsz, erts_system_monitor_long_schedule); + } if (erts_system_monitor_large_heap != 0) { hsz += 2+3; (void) erts_bld_uint(NULL, &hsz, erts_system_monitor_large_heap); @@ -2053,6 +2057,10 @@ static Eterm system_monitor_get(Process *p) if (erts_system_monitor_long_gc != 0) { long_gc = erts_bld_uint(&hp, NULL, erts_system_monitor_long_gc); } + if (erts_system_monitor_long_schedule != 0) { + long_schedule = erts_bld_uint(&hp, NULL, + erts_system_monitor_long_schedule); + } if (erts_system_monitor_large_heap != 0) { large_heap = erts_bld_uint(&hp, NULL, erts_system_monitor_large_heap); } @@ -2061,6 +2069,10 @@ static Eterm system_monitor_get(Process *p) Eterm t = TUPLE2(hp, am_long_gc, long_gc); hp += 3; res = CONS(hp, t, res); hp += 2; } + if (long_schedule != NIL) { + Eterm t = TUPLE2(hp, am_long_schedule, long_schedule); hp += 3; + res = CONS(hp, t, res); hp += 2; + } if (large_heap != NIL) { Eterm t = TUPLE2(hp, am_large_heap, large_heap); hp += 3; res = CONS(hp, t, res); hp += 2; @@ -2115,7 +2127,7 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list) } if (is_not_list(list)) goto error; else { - Uint long_gc, large_heap; + Uint long_gc, long_schedule, large_heap; int busy_port, busy_dist_port; system_blocked = 1; @@ -2125,7 +2137,8 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list) if (!erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, monitor_pid, 0)) goto error; - for (long_gc = 0, large_heap = 0, busy_port = 0, busy_dist_port = 0; + for (long_gc = 0, long_schedule = 0, large_heap = 0, + busy_port = 0, busy_dist_port = 0; is_list(list); list = CDR(list_val(list))) { Eterm t = CAR(list_val(list)); @@ -2135,6 +2148,9 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list) if (tp[1] == am_long_gc) { if (! term_to_Uint(tp[2], &long_gc)) goto error; if (long_gc < 1) long_gc = 1; + } else if (tp[1] == am_long_schedule) { + if (! term_to_Uint(tp[2], &long_schedule)) goto error; + if (long_schedule < 1) long_schedule = 1; } else if (tp[1] == am_large_heap) { if (! term_to_Uint(tp[2], &large_heap)) goto error; if (large_heap < 16384) large_heap = 16384; @@ -2150,6 +2166,7 @@ system_monitor(Process *p, Eterm monitor_pid, Eterm list) prev = system_monitor_get(p); erts_set_system_monitor(monitor_pid); erts_system_monitor_long_gc = long_gc; + erts_system_monitor_long_schedule = long_schedule; erts_system_monitor_large_heap = large_heap; erts_system_monitor_flags.busy_port = !!busy_port; erts_system_monitor_flags.busy_dist_port = !!busy_dist_port; diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 298909c921..8ba94d89e9 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 @@ -1943,6 +1964,17 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) ++n; } + /* + * A trapping BIF can add to rootset by setting the extra_root + * in the process_structure. + */ + if (p->extra_root != NULL) { + roots[n].v = p->extra_root->objv; + roots[n].sz = p->extra_root->sz; + ++n; + } + + ASSERT((is_nil(p->seq_trace_token) || is_tuple(follow_moved(p->seq_trace_token)) || is_atom(p->seq_trace_token))); @@ -2520,6 +2552,12 @@ offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size, p->dictionary->used, offs, area, area_size); } + if (p->extra_root != NULL) { + offset_heap_ptr(p->extra_root->objv, + p->extra_root->sz, + offs, area, area_size); + } + offset_heap_ptr(&p->fvalue, 1, offs, area, area_size); offset_heap_ptr(&p->ftrace, 1, offs, area, area_size); offset_heap_ptr(&p->seq_trace_token, 1, offs, area, area_size); @@ -2543,6 +2581,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..385de0da23 100644 --- a/erts/emulator/beam/erl_goodfit_alloc.h +++ b/erts/emulator/beam/erl_goodfit_alloc.h @@ -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 @@ -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..4bae3dfeb4 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,13 +333,14 @@ 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(); erts_init_bif_binary(); erts_init_bif_re(); erts_init_unicode(); /* after RE to get access to PCRE unicode */ + erts_init_external(); erts_delay_trap = erts_export_put(am_erlang, am_delay_trap, 2); erts_late_init_process(); #if HAVE_ERTS_MSEG @@ -923,6 +930,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 +1278,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 */ @@ -1462,6 +1480,22 @@ erl_start(int argc, char **argv) ("suggested scheduler thread stack size %d kilo words\n", erts_sched_thread_suggested_stack_size)); } + else if (has_prefix("fwi", sub_param)) { + long val; + arg = get_arg(sub_param+3, argv[i+1], &i); + errno = 0; + val = strtol(arg, NULL, 10); + if (errno != 0 || val < 0) { + erts_fprintf(stderr, + "bad scheduler forced wakeup " + "interval %s\n", + arg); + erts_usage(); + } +#ifdef ERTS_SMP + erts_runq_supervision_interval = val; +#endif + } else { erts_fprintf(stderr, "bad scheduling option %s\n", argv[i]); erts_usage(); @@ -1642,8 +1676,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..2114d0c001 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -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 @@ -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..c6d136f951 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -1,7 +1,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 @@ -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 0ed08bee01..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)); @@ -1578,6 +1594,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) int fpe_was_unmasked; erts_aint32_t state; int active; + Uint64 start_time = 0; ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); @@ -1639,6 +1656,10 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reset_handle(ptp); + if (erts_system_monitor_long_schedule != 0) { + start_time = erts_timestamp_millis(); + } + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); ERTS_SMP_CHK_NO_PROC_LOCKS; ASSERT(pp->drv_ptr); @@ -1707,6 +1728,14 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds += erts_port_driver_callback_epilogue(pp, &state); + if (start_time != 0) { + Sint64 diff = erts_timestamp_millis() - start_time; + if (diff > 0 && (Uint) diff > erts_system_monitor_long_schedule) { + monitor_long_schedule_port(pp,ptp->type,(Uint) diff); + } + } + start_time = 0; + aborted_port_task: schedule_port_task_free(ptp); @@ -1912,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..e4d964146e 100644 --- a/erts/emulator/beam/erl_port_task.h +++ b/erts/emulator/beam/erl_port_task.h @@ -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 @@ -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 5d9c5af55f..2439a46ab6 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -246,6 +246,10 @@ static erts_smp_atomic32_t function_calls; #ifdef ERTS_SMP static erts_smp_atomic32_t doing_sys_schedule; static erts_smp_atomic32_t no_empty_run_queues; +long erts_runq_supervision_interval = 0; +static ethr_event runq_supervision_event; +static erts_tid_t runq_supervisor_tid; +static erts_atomic_t runq_supervisor_sleeping; #else /* !ERTS_SMP */ ErtsSchedulerData *erts_scheduler_data; #endif @@ -267,6 +271,7 @@ static Uint last_exact_reductions; Uint erts_default_process_flags; Eterm erts_system_monitor; Eterm erts_system_monitor_long_gc; +Uint erts_system_monitor_long_schedule; Eterm erts_system_monitor_large_heap; struct erts_system_monitor_flags_t erts_system_monitor_flags; @@ -485,7 +490,7 @@ release_process(void *vproc) /* initialize the scheduler */ void -erts_init_process(int ncpu, int proc_tab_size) +erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab) { #ifdef ERTS_SMP @@ -505,7 +510,8 @@ erts_init_process(int ncpu, int proc_tab_size) (ErtsPTabElementCommon *) &erts_invalid_process.common, proc_tab_size, sizeof(Process), - "process_table"); + "process_table", + legacy_proc_tab); last_reductions = 0; last_exact_reductions = 0; @@ -1326,6 +1332,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) { @@ -2032,7 +2049,13 @@ empty_runq(ErtsRunQueue *rq) */ ASSERT(0 <= empty && empty < 2*erts_no_run_queues); #endif - erts_smp_atomic32_inc_relb(&no_empty_run_queues); + if (!erts_runq_supervision_interval) + erts_smp_atomic32_inc_relb(&no_empty_run_queues); + else { + erts_smp_atomic32_inc_mb(&no_empty_run_queues); + if (erts_atomic_read_nob(&runq_supervisor_sleeping)) + ethr_event_set(&runq_supervision_event); + } } } @@ -2049,7 +2072,14 @@ non_empty_runq(ErtsRunQueue *rq) */ ASSERT(0 < empty && empty <= 2*erts_no_run_queues); #endif - erts_smp_atomic32_dec_relb(&no_empty_run_queues); + if (!erts_runq_supervision_interval) + erts_smp_atomic32_dec_relb(&no_empty_run_queues); + else { + erts_aint32_t no; + no = erts_smp_atomic32_dec_read_mb(&no_empty_run_queues); + if (no > 0 && erts_atomic_read_nob(&runq_supervisor_sleeping)) + ethr_event_set(&runq_supervision_event); + } } } @@ -2653,7 +2683,6 @@ try_inc_no_active_runqs(int active) return 0; } - static ERTS_INLINE int chk_wake_sched(ErtsRunQueue *crq, int ix, int activate) { @@ -4319,6 +4348,53 @@ set_wakeup_other_data(void) } } +static int +no_runqs_to_supervise(void) +{ + int used; + erts_aint32_t nerq = erts_smp_atomic32_read_acqb(&no_empty_run_queues); + if (nerq <= 0) + return 0; + get_no_runqs(NULL, &used); + if (nerq >= used) + return 0; + return used; +} + +static void * +runq_supervisor(void *unused) +{ + while (1) { + int ix, no_rqs; + + erts_milli_sleep(erts_runq_supervision_interval); + no_rqs = no_runqs_to_supervise(); + if (!no_rqs) { + erts_atomic_set_nob(&runq_supervisor_sleeping, 1); + while (1) { + ethr_event_reset(&runq_supervision_event); + no_rqs = no_runqs_to_supervise(); + if (no_rqs) { + erts_atomic_set_nob(&runq_supervisor_sleeping, 0); + break; + } + ethr_event_wait(&runq_supervision_event); + } + } + + for (ix = 0; ix < no_rqs; ix++) { + ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); + if (ERTS_RUNQ_FLGS_GET(rq) & ERTS_RUNQ_FLG_NONEMPTY) { + erts_smp_runq_lock(rq); + if (rq->len != 0) + wake_scheduler_on_empty_runq(rq); /* forced wakeup... */ + erts_smp_runq_unlock(rq); + } + } + } + return NULL; +} + #endif void @@ -4670,6 +4746,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(); @@ -5740,6 +5818,22 @@ erts_start_schedulers(void) ethr_thr_opts opts = ETHR_THR_OPTS_DEFAULT_INITER; opts.detached = 1; + +#ifdef ERTS_SMP + if (erts_runq_supervision_interval) { + opts.suggested_stack_size = 16; + erts_atomic_init_nob(&runq_supervisor_sleeping, 0); + if (0 != ethr_event_init(&runq_supervision_event)) + erl_exit(1, "Failed to create run-queue supervision event\n"); + if (0 != ethr_thr_create(&runq_supervisor_tid, + runq_supervisor, + NULL, + &opts)) + erl_exit(1, "Failed to create run-queue supervision thread\n"); + + } +#endif + opts.suggested_stack_size = erts_sched_thread_suggested_stack_size; if (wanted < 1) @@ -7498,6 +7592,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->htop = p->heap; p->heap_sz = sz; p->catches = 0; + p->extra_root = NULL; p->bin_vheap_sz = p->min_vheap_size; p->bin_old_vheap_sz = p->min_vheap_size; @@ -8930,6 +9025,12 @@ erts_continue_exit_process(Process *p) if (pbt) erts_free(ERTS_ALC_T_BPD, (void *) pbt); + if (p->extra_root != NULL) { + (p->extra_root->cleanup)(p->extra_root); /* Should deallocate + whole structure */ + p->extra_root = NULL; + } + delete_process(p); #ifdef ERTS_SMP diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 3d3579fa7e..8e5467f196 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -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 @@ -387,6 +387,10 @@ struct ErtsRunQueue_ { } ports; }; +#ifdef ERTS_SMP +extern long erts_runq_supervision_interval; +#endif + typedef union { ErtsRunQueue runq; char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsRunQueue))]; @@ -420,6 +424,11 @@ typedef struct { } ErtsSchedWallTime; typedef struct { + Uint64 reclaimed; + Uint64 garbage_cols; +} ErtsGCInfo; + +typedef struct { int sched; erts_aint32_t aux_work; } ErtsDelayedAuxWorkWakeupJob; @@ -507,6 +516,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; @@ -692,6 +703,14 @@ struct ErtsPendingSuspend_ { #endif + +typedef struct ErlExtraRootSet_ ErlExtraRootSet; +struct ErlExtraRootSet_ { + Eterm *objv; + Uint sz; + void (*cleanup)(ErlExtraRootSet *); +}; + /* Defines to ease the change of memory architecture */ # define HEAP_START(p) (p)->heap # define HEAP_TOP(p) (p)->htop @@ -785,6 +804,8 @@ struct process { ErlMessageQueue msg; /* Message queue */ + ErlExtraRootSet *extra_root; /* Used by trapping BIF's */ + union { ErtsBifTimer *bif_timers; /* Bif timers aiming at this process */ void *terminate; @@ -1002,6 +1023,7 @@ extern erts_smp_rwmtx_t erts_cpu_bind_rwmtx; */ extern Eterm erts_system_monitor; extern Uint erts_system_monitor_long_gc; +extern Uint erts_system_monitor_long_schedule; extern Uint erts_system_monitor_large_heap; struct erts_system_monitor_flags_t { unsigned int busy_port : 1; @@ -1125,6 +1147,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); @@ -1332,6 +1355,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 @@ -1351,7 +1375,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 *); @@ -1421,6 +1445,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) @@ -1964,6 +1990,7 @@ erts_sched_poke(ErtsSchedulerSleepInfo *ssi) } } + #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ #endif /* #ifdef ERTS_SMP */ 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..d69619dd44 100644 --- a/erts/emulator/beam/erl_ptab.c +++ b/erts/emulator/beam/erl_ptab.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012. All Rights Reserved. + * Copyright Ericsson AB 2012-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 @@ -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_smp_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..c2d8bd9cad 100644 --- a/erts/emulator/beam/erl_ptab.h +++ b/erts/emulator/beam/erl_ptab.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012. All Rights Reserved. + * Copyright Ericsson AB 2012-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 @@ -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/erl_thr_progress.h b/erts/emulator/beam/erl_thr_progress.h index 1aeecf2b06..5f392944c2 100644 --- a/erts/emulator/beam/erl_thr_progress.h +++ b/erts/emulator/beam/erl_thr_progress.h @@ -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 diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index 848877d43e..fa015ee4b9 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -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 @@ -2268,7 +2268,134 @@ trace_gc(Process *p, Eterm what) #undef LOCAL_HEAP_SIZE } +void +monitor_long_schedule_proc(Process *p, BeamInstr *in_fp, BeamInstr *out_fp, Uint time) +{ + ErlHeapFragment *bp; + ErlOffHeap *off_heap; +#ifndef ERTS_SMP + Process *monitor_p; +#endif + Uint hsz; + Eterm *hp, list, in_mfa = am_undefined, out_mfa = am_undefined; + Eterm in_tpl, out_tpl, tmo_tpl, tmo, msg; + + +#ifndef ERTS_SMP + ASSERT(is_internal_pid(system_monitor)); + monitor_p = erts_proc_lookup(system_monitor); + if (!monitor_p || p == monitor_p) { + return; + } +#endif + /* + * Size: {monitor, pid, long_schedule, [{timeout, T}, {in, {M,F,A}},{out,{M,F,A}}]} -> + * 5 (top tuple of 4), (3 (elements) * 2 (cons)) + 3 (timeout tuple of 2) + size of Timeout + + * (2 * 3 (in/out tuple of 2)) + + * 0 (unknown) or 4 (MFA tuple of 3) + 0 (unknown) or 4 (MFA tuple of 3) + * = 20 + (in_fp != NULL) ? 4 : 0 + (out_fp != NULL) ? 4 : 0 + size of Timeout + */ + hsz = 20 + ((in_fp != NULL) ? 4 : 0) + ((out_fp != NULL) ? 4 : 0); + (void) erts_bld_uint(NULL, &hsz, time); + hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, monitor_p); + tmo = erts_bld_uint(&hp, NULL, time); + if (in_fp != NULL) { + in_mfa = TUPLE3(hp,(Eterm) in_fp[0], (Eterm) in_fp[1], make_small(in_fp[2])); + hp +=4; + } + if (out_fp != NULL) { + out_mfa = TUPLE3(hp,(Eterm) out_fp[0], (Eterm) out_fp[1], make_small(out_fp[2])); + hp +=4; + } + tmo_tpl = TUPLE2(hp,am_timeout, tmo); + hp += 3; + in_tpl = TUPLE2(hp,am_in,in_mfa); + hp += 3; + out_tpl = TUPLE2(hp,am_out,out_mfa); + hp += 3; + list = CONS(hp,out_tpl,NIL); + hp += 2; + list = CONS(hp,in_tpl,list); + hp += 2; + list = CONS(hp,tmo_tpl,list); + hp += 2; + msg = TUPLE4(hp, am_monitor, p->common.id, am_long_schedule, list); + hp += 5; +#ifdef ERTS_SMP + enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->common.id, NIL, msg, bp); +#else + erts_queue_message(monitor_p, NULL, bp, msg, NIL +#ifdef USE_VM_PROBES + , NIL +#endif + ); +#endif +} +void +monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time) +{ + ErlHeapFragment *bp; + ErlOffHeap *off_heap; +#ifndef ERTS_SMP + Process *monitor_p; +#endif + Uint hsz; + Eterm *hp, list, op; + Eterm op_tpl, tmo_tpl, tmo, msg; + + +#ifndef ERTS_SMP + ASSERT(is_internal_pid(system_monitor)); + monitor_p = erts_proc_lookup(system_monitor); + if (!monitor_p) { + return; + } +#endif + /* + * Size: {monitor, port, long_schedule, [{timeout, T}, {op, Operation}]} -> + * 5 (top tuple of 4), (2 (elements) * 2 (cons)) + 3 (timeout tuple of 2) + * + size of Timeout + 3 (op tuple of 2 atoms) + * = 15 + size of Timeout + */ + hsz = 15; + (void) erts_bld_uint(NULL, &hsz, time); + + hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, monitor_p); + switch (type) { + case ERTS_PORT_TASK_PROC_SIG: op = am_proc_sig; break; + case ERTS_PORT_TASK_TIMEOUT: op = am_timeout; break; + case ERTS_PORT_TASK_INPUT: op = am_input; break; + case ERTS_PORT_TASK_OUTPUT: op = am_output; break; + case ERTS_PORT_TASK_EVENT: op = am_event; break; + case ERTS_PORT_TASK_DIST_CMD: op = am_dist_cmd; break; + default: op = am_undefined; break; + } + + tmo = erts_bld_uint(&hp, NULL, time); + + op_tpl = TUPLE2(hp,am_port_op,op); + hp += 3; + + tmo_tpl = TUPLE2(hp,am_timeout, tmo); + hp += 3; + + list = CONS(hp,op_tpl,NIL); + hp += 2; + list = CONS(hp,tmo_tpl,list); + hp += 2; + msg = TUPLE4(hp, am_monitor, pp->common.id, am_long_schedule, list); + hp += 5; +#ifdef ERTS_SMP + enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, pp->common.id, NIL, msg, bp); +#else + erts_queue_message(monitor_p, NULL, bp, msg, NIL +#ifdef USE_VM_PROBES + , NIL +#endif + ); +#endif +} void monitor_long_gc(Process *p, Uint time) { @@ -3011,6 +3138,7 @@ sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver) case SYS_MSG_TYPE_SYSMON: if (receiver == NIL && !erts_system_monitor_long_gc + && !erts_system_monitor_long_schedule && !erts_system_monitor_large_heap && !erts_system_monitor_flags.busy_port && !erts_system_monitor_flags.busy_dist_port) diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index 50fb27aab0..853c6cb0d8 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012. All Rights Reserved. + * Copyright Ericsson AB 2012-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 @@ -83,6 +83,8 @@ void erts_system_profile_setup_active_schedulers(void); /* system_monitor */ void monitor_long_gc(Process *p, Uint time); +void monitor_long_schedule_proc(Process *p, BeamInstr *in_i, BeamInstr *out_i, Uint time); +void monitor_long_schedule_port(Port *pp, ErtsPortTaskType type, Uint time); void monitor_large_heap(Process *p); void monitor_generic(Process *p, Eterm type, Eterm spec); Uint erts_trace_flag2bit(Eterm flag); diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index ad6f8b993a..e00440b905 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -1723,14 +1723,14 @@ static BIF_RETTYPE do_bif_utf8_to_list(Process *p, if (b_sz) { ErlSubBin *sb; Eterm orig; - ERTS_DECLARE_DUMMY(Uint offset); + Uint offset; ASSERT(state != ERTS_UTF8_OK); hp = HAlloc(p, ERL_SUB_BIN_SIZE); sb = (ErlSubBin *) hp; ERTS_GET_REAL_BIN(orig_bin, orig, offset, bitoffs, bitsize); sb->thing_word = HEADER_SUB_BIN; sb->size = b_sz; - sb->offs = num_bytes_to_process + num_processed_bytes; + sb->offs = offset + num_bytes_to_process + num_processed_bytes; sb->orig = orig; sb->bitoffs = bitoffs; sb->bitsize = bitsize; diff --git a/erts/emulator/beam/erl_zlib.c b/erts/emulator/beam/erl_zlib.c index f73d48b6c2..47fd92988e 100644 --- a/erts/emulator/beam/erl_zlib.c +++ b/erts/emulator/beam/erl_zlib.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009. All Rights Reserved. + * Copyright Ericsson AB 2009-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 @@ -44,6 +44,48 @@ void erl_zlib_zfree_callback (voidpf opaque, voidpf ptr) erts_free(ERTS_ALC_T_ZLIB, ptr); } +/* + * Initialize a z_stream with a source, to later *chunk* data into a destination + * Returns Z_OK or Error. + */ +int ZEXPORT erl_zlib_deflate_start(z_stream *streamp, const Bytef* source, + uLong sourceLen, int level) +{ + streamp->next_in = (Bytef*)source; + streamp->avail_in = (uInt)sourceLen; + streamp->total_out = streamp->avail_out = 0; + streamp->next_out = NULL; + erl_zlib_alloc_init(streamp); + return deflateInit(streamp, level); +} +/* + * Deflate a chunk, The destination length is the limit. + * Returns Z_OK if more to process, Z_STREAM_END if we are done. + */ +int ZEXPORT erl_zlib_deflate_chunk(z_stream *streamp, Bytef* dest, uLongf* destLen) +{ + int err; + uLongf last_tot = streamp->total_out; + + streamp->next_out = dest; + streamp->avail_out = (uInt)*destLen; + + if ((uLong)streamp->avail_out != *destLen) return Z_BUF_ERROR; + + err = deflate(streamp, Z_FINISH); + *destLen = streamp->total_out - last_tot; + return err; +} + + +/* + * When we are done, free up the deflate structure + * Retyurns Z_OK or Error + */ +int ZEXPORT erl_zlib_deflate_finish(z_stream *streamp) +{ + return deflateEnd(streamp); +} int ZEXPORT erl_zlib_compress2 (Bytef* dest, uLongf* destLen, const Bytef* source, uLong sourceLen, diff --git a/erts/emulator/beam/erl_zlib.h b/erts/emulator/beam/erl_zlib.h index 9054a5e428..5ac849d21c 100644 --- a/erts/emulator/beam/erl_zlib.h +++ b/erts/emulator/beam/erl_zlib.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009. All Rights Reserved. + * Copyright Ericsson AB 2009-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 @@ -31,6 +31,14 @@ (s)->zfree = erl_zlib_zfree_callback; \ } while (0) +/* + * Chunked interface, used by term_to_binary among others. + */ +int ZEXPORT erl_zlib_deflate_start(z_stream *streamp, const Bytef* source, + uLong sourceLen, int level); +int ZEXPORT erl_zlib_deflate_chunk(z_stream *streamp, Bytef* dest, uLongf* destLen); +int ZEXPORT erl_zlib_deflate_finish(z_stream *streamp); + /* Use instead of compress */ #define erl_zlib_compress(dest,destLen,source,sourceLen) \ diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 5ce0d97c74..249b1e0923 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -81,7 +81,11 @@ * */ +static Export term_to_binary_trap_export; + static byte* enc_term(ErtsAtomCacheMap *, Eterm, byte*, Uint32, struct erl_off_heap_header** off_heap); +static int enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, + struct erl_off_heap_header** off_heap, Sint *reds, byte **res); static Uint is_external_string(Eterm obj, int* p_is_string); static byte* enc_atom(ErtsAtomCacheMap *, Eterm, byte*, Uint32); static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32); @@ -89,9 +93,31 @@ static byte* dec_term(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*); static byte* dec_atom(ErtsDistExternal *, byte*, Eterm*); static byte* dec_pid(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*); static Sint decoded_size(byte *ep, byte* endp, int internal_tags); +static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1); +static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint flags, + Binary *context_b); static Uint encode_size_struct2(ErtsAtomCacheMap *, Eterm, unsigned); +static int encode_size_struct_int(Process *p, ErtsAtomCacheMap *acmp, Eterm obj, + unsigned dflags, Sint *reds, Uint *res); + +void erts_init_external(void) { +#if 1 /* In R16 */ + erts_init_trap_export(&term_to_binary_trap_export, + am_erlang, am_term_to_binary_trap, 1, + &term_to_binary_trap_1); +#else + sys_memset((void *) &term_to_binary_trap_export, 0, sizeof(Export)); + term_to_binary_trap_export.address = &term_to_binary_trap_export.code[3]; + term_to_binary_trap_export.code[0] = am_erlang; + term_to_binary_trap_export.code[1] = am_term_to_binary_trap; + term_to_binary_trap_export.code[2] = 1; + term_to_binary_trap_export.code[3] = (BeamInstr) em_apply_bif; + term_to_binary_trap_export.code[4] = (BeamInstr) &term_to_binary_trap_1; +#endif + return; +} #define ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES 255 @@ -1009,10 +1035,28 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2) BIF_ERROR(BIF_P, BADARG); } - +static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1) +{ + Eterm *tp = tuple_val(BIF_ARG_1); + Eterm Term = tp[1]; + Eterm bt = tp[2]; + Binary *bin = ((ProcBin *) binary_val(bt))->val; + Eterm res = erts_term_to_binary_int(BIF_P, Term, 0, 0,bin); + if (is_tuple(res)) { + BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res); + } else { + BIF_RET(res); + } +} + BIF_RETTYPE term_to_binary_1(BIF_ALIST_1) { - return erts_term_to_binary(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS); + Eterm res = erts_term_to_binary_int(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS, NULL); + if (is_tuple(res)) { + BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res); + } else { + BIF_RET(res); + } } BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) @@ -1022,6 +1066,8 @@ BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) Eterm Flags = BIF_ARG_2; int level = 0; Uint flags = TERM_TO_BINARY_DFLAGS; + Eterm res; + Binary *bin = NULL; while (is_list(Flags)) { Eterm arg = CAR(list_val(Flags)); @@ -1058,7 +1104,12 @@ BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) goto error; } - return erts_term_to_binary(p, Term, level, flags); + res = erts_term_to_binary_int(p, Term, level, flags, bin); + if (is_tuple(res)) { + BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res); + } else { + BIF_RET(res); + } } static uLongf binary2term_uncomp_size(byte* data, Sint size) @@ -1335,16 +1386,13 @@ external_size_2(BIF_ALIST_2) } } -Eterm -erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) +static Eterm +erts_term_to_binary_simple(Process* p, Eterm Term, Uint size, int level, Uint flags) { - Uint size; Eterm bin; size_t real_size; byte* endp; - size = encode_size_struct2(NULL, Term, flags) + 1 /* VERSION_MAGIC */; - if (level != 0) { byte buf[256]; byte* bytes = buf; @@ -1414,6 +1462,327 @@ erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) } } +Eterm +erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) { + Uint size; + size = encode_size_struct2(NULL, Term, flags) + 1 /* VERSION_MAGIC */; + return erts_term_to_binary_simple(p, Term, size, level, flags); +} + +/* Define for testing */ +/* #define EXTREME_TTB_TRAPPING 1 */ + +#ifndef EXTREME_TTB_TRAPPING +#define TERM_TO_BINARY_LOOP_FACTOR 500 +#define TERM_TO_BINARY_SIZE_FACTOR 500000 +#define TERM_TO_BINARY_COMPRESS_CHUNK 500000 +#else +#define TERM_TO_BINARY_LOOP_FACTOR 1 +#define TERM_TO_BINARY_SIZE_FACTOR 10 +#define TERM_TO_BINARY_COMPRESS_CHUNK 10 +#endif + + +typedef enum { TTBSize, TTBEncode, TTBCompress } TTBState; +typedef struct { + Uint flags; + int level; +} TTBSizeContext; + +typedef struct { + Uint flags; + int level; + Binary *result_bin; +} TTBEncodeContext; + +typedef struct { + Uint real_size; + Uint dest_len; + byte *dbytes; + Binary *result_bin; + Binary *destination_bin; + z_stream stream; +} TTBCompressContext; + +typedef struct { + int alive; + TTBState state; + union { + TTBSizeContext sc; + TTBEncodeContext ec; + TTBCompressContext cc; + } s; +} TTBContext; + +static void context_destructor(Binary *context_bin) +{ + TTBContext *context = ERTS_MAGIC_BIN_DATA(context_bin); + if (context->alive) { + context->alive = 0; + switch (context->state) { + case TTBSize: + break; + case TTBEncode: + if (context->s.ec.result_bin != NULL) { /* Set to NULL if ever made alive! */ + ASSERT(erts_refc_read(&(context->s.ec.result_bin->refc),0) == 0); + erts_bin_free(context->s.ec.result_bin); + context->s.ec.result_bin = NULL; + } + break; + case TTBCompress: + erl_zlib_deflate_finish(&(context->s.cc.stream)); + + if (context->s.cc.destination_bin != NULL) { /* Set to NULL if ever made alive! */ + ASSERT(erts_refc_read(&(context->s.cc.destination_bin->refc),0) == 0); + erts_bin_free(context->s.cc.destination_bin); + context->s.cc.destination_bin = NULL; + } + + if (context->s.cc.result_bin != NULL) { /* Set to NULL if ever made alive! */ + ASSERT(erts_refc_read(&(context->s.cc.result_bin->refc),0) == 0); + erts_bin_free(context->s.cc.result_bin); + context->s.cc.result_bin = NULL; + } + break; + } + } +} + +static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint flags, + Binary *context_b) +{ + Eterm *hp; + Eterm res; + Eterm c_term; +#ifndef EXTREME_TTB_TRAPPING + Sint reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR); +#else + Sint reds = 20; /* For testing */ +#endif + Sint initial_reds = reds; + TTBContext c_buff; + TTBContext *context = &c_buff; + +#define EXPORT_CONTEXT() \ + do { \ + if (context_b == NULL) { \ + context_b = erts_create_magic_binary(sizeof(TTBContext), \ + context_destructor); \ + context = ERTS_MAGIC_BIN_DATA(context_b); \ + memcpy(context,&c_buff,sizeof(TTBContext)); \ + } \ + } while (0) + +#define RETURN_STATE() \ + do { \ + hp = HAlloc(p, PROC_BIN_SIZE+3); \ + c_term = erts_mk_magic_binary_term(&hp, &MSO(p), context_b); \ + res = TUPLE2(hp, Term, c_term); \ + BUMP_ALL_REDS(p); \ + return res; \ + } while (0); + + + if (context_b == NULL) { + /* Setup enough to get started */ + context->state = TTBSize; + context->alive = 1; + context->s.sc.flags = flags; + context->s.sc.level = level; + } else { + context = ERTS_MAGIC_BIN_DATA(context_b); + } + /* Initialization done, now we will go through the states */ + for (;;) { + switch (context->state) { + case TTBSize: + { + Uint size; + Binary *result_bin; + int level; + Uint flags; + /* Try for fast path */ + if (encode_size_struct_int(p, NULL, Term, context->s.sc.flags, &reds, &size) < 0) { + EXPORT_CONTEXT(); + /* Same state */ + RETURN_STATE(); + } + ++size; /* VERSION_MAGIC */ + /* Move these to next state */ + flags = context->s.sc.flags; + level = context->s.sc.level; + if (size <= ERL_ONHEAP_BIN_LIMIT) { + /* Finish in one go */ + res = erts_term_to_binary_simple(p, Term, size, + level, flags); + BUMP_REDS(p, size / TERM_TO_BINARY_SIZE_FACTOR); + return res; + } + + result_bin = erts_bin_nrml_alloc(size); + result_bin->flags = 0; + result_bin->orig_size = size; + erts_refc_init(&result_bin->refc, 0); + result_bin->orig_bytes[0] = VERSION_MAGIC; + /* Next state immediately, no need to export context */ + context->state = TTBEncode; + context->s.ec.flags = flags; + context->s.ec.level = level; + context->s.ec.result_bin = result_bin; + break; + } + case TTBEncode: + { + byte *endp; + byte *bytes = (byte *) context->s.ec.result_bin->orig_bytes; + size_t real_size; + Binary *result_bin; + + flags = context->s.ec.flags; + if (enc_term_int(p,NULL,Term, bytes+1, flags, NULL, &reds, &endp) < 0) { + EXPORT_CONTEXT(); + RETURN_STATE(); + } + real_size = endp - bytes; + result_bin = erts_bin_realloc(context->s.ec.result_bin,real_size); + level = context->s.ec.level; + BUMP_REDS(p, (initial_reds - reds) / TERM_TO_BINARY_LOOP_FACTOR); + if (level == 0 || real_size < 6) { /* We are done */ + ProcBin* pb; + return_normal: + context->s.ec.result_bin = NULL; + context->alive = 0; + pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); + pb->thing_word = HEADER_PROC_BIN; + pb->size = real_size; + pb->next = MSO(p).first; + MSO(p).first = (struct erl_off_heap_header*)pb; + pb->val = result_bin; + pb->bytes = (byte*) result_bin->orig_bytes; + pb->flags = 0; + OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); + erts_refc_inc(&result_bin->refc, 1); + if (context_b && erts_refc_read(&context_b->refc,0) == 0) { + erts_bin_free(context_b); + } + return make_binary(pb); + } + /* Continue with compression... */ + /* To make absolutely sure that zlib does not barf on a reallocated context, + we make sure it's "exported" before doing anything compession-like */ + EXPORT_CONTEXT(); + bytes = (byte *) result_bin->orig_bytes; /* result_bin is reallocated */ + if (erl_zlib_deflate_start(&(context->s.cc.stream),bytes+1,real_size-1,level) + != Z_OK) { + goto return_normal; + } + context->state = TTBCompress; + context->s.cc.real_size = real_size; + context->s.cc.result_bin = result_bin; + + result_bin = erts_bin_nrml_alloc(real_size); + result_bin->flags = 0; + result_bin->orig_size = real_size; + erts_refc_init(&result_bin->refc, 0); + result_bin->orig_bytes[0] = VERSION_MAGIC; + + context->s.cc.destination_bin = result_bin; + context->s.cc.dest_len = 0; + context->s.cc.dbytes = (byte *) result_bin->orig_bytes+6; + break; + } + case TTBCompress: + { + uLongf tot_dest_len = context->s.cc.real_size - 6; + uLongf left = (tot_dest_len - context->s.cc.dest_len); + uLongf this_time = (left > TERM_TO_BINARY_COMPRESS_CHUNK) ? + TERM_TO_BINARY_COMPRESS_CHUNK : + left; + Binary *result_bin; + ProcBin *pb; + Uint max = (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_COMPRESS_CHUNK) / CONTEXT_REDS; + + if (max < this_time) { + this_time = max + 1; /* do not set this_time to 0 */ + } + + res = erl_zlib_deflate_chunk(&(context->s.cc.stream), context->s.cc.dbytes, &this_time); + context->s.cc.dbytes += this_time; + context->s.cc.dest_len += this_time; + switch (res) { + case Z_OK: + if (context->s.cc.dest_len >= tot_dest_len) { + goto no_use_compressing; + } + RETURN_STATE(); + case Z_STREAM_END: + { + byte *dbytes = (byte *) context->s.cc.destination_bin->orig_bytes + 1; + + dbytes[0] = COMPRESSED; + put_int32(context->s.cc.real_size-1,dbytes+1); + erl_zlib_deflate_finish(&(context->s.cc.stream)); + result_bin = erts_bin_realloc(context->s.cc.destination_bin, + context->s.cc.dest_len+6); + context->s.cc.destination_bin = NULL; + pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); + pb->thing_word = HEADER_PROC_BIN; + pb->size = context->s.cc.dest_len+6; + pb->next = MSO(p).first; + MSO(p).first = (struct erl_off_heap_header*)pb; + pb->val = result_bin; + pb->bytes = (byte*) result_bin->orig_bytes; + pb->flags = 0; + OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); + erts_refc_inc(&result_bin->refc, 1); + erts_bin_free(context->s.cc.result_bin); + context->s.cc.result_bin = NULL; + context->alive = 0; + BUMP_REDS(p, (this_time * CONTEXT_REDS) / TERM_TO_BINARY_COMPRESS_CHUNK); + if (context_b && erts_refc_read(&context_b->refc,0) == 0) { + erts_bin_free(context_b); + } + return make_binary(pb); + } + default: /* Compression error, revert to uncompressed binary (still in + context) */ + no_use_compressing: + result_bin = context->s.cc.result_bin; + context->s.cc.result_bin = NULL; + pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); + pb->thing_word = HEADER_PROC_BIN; + pb->size = context->s.cc.real_size; + pb->next = MSO(p).first; + MSO(p).first = (struct erl_off_heap_header*)pb; + pb->val = result_bin; + pb->bytes = (byte*) result_bin->orig_bytes; + pb->flags = 0; + OH_OVERHEAD(&(MSO(p)), pb->size / sizeof(Eterm)); + erts_refc_inc(&result_bin->refc, 1); + erl_zlib_deflate_finish(&(context->s.cc.stream)); + erts_bin_free(context->s.cc.destination_bin); + context->s.cc.destination_bin = NULL; + context->alive = 0; + BUMP_REDS(p, (this_time * CONTEXT_REDS) / TERM_TO_BINARY_COMPRESS_CHUNK); + if (context_b && erts_refc_read(&context_b->refc,0) == 0) { + erts_bin_free(context_b); + } + return make_binary(pb); + } + } + } + } +#undef EXPORT_CONTEXT +#undef RETURN_STATE +} + + + + + + + + /* * This function fills ext with the external format of atom. * If it's an old atom we just supply an index, otherwise @@ -1678,32 +2047,71 @@ dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Ete #define ENC_PATCH_FUN_SIZE ((Eterm) 2) #define ENC_LAST_ARRAY_ELEMENT ((Eterm) 3) +/* Free extra rootset (used when trapping) */ +static void cleanup_ttb_extra_root(ErlExtraRootSet *rs) +{ + if (rs->objv != NULL) { + erts_free(ERTS_ALC_T_EXTRA_ROOT, rs->objv); + } + erts_free(ERTS_ALC_T_EXTRA_ROOT, rs); +} + +/* Same as above, but we have an extra "stack" beyond GC reach, i.e. an array of two extra roots */ +static void cleanup_ttb_extra_root_2(ErlExtraRootSet *rs) +{ + if (rs->objv != NULL) { + erts_free(ERTS_ALC_T_EXTRA_ROOT, rs->objv); + } + if (rs[1].objv != NULL) { + erts_free(ERTS_ALC_T_EXTRA_ROOT, rs[1].objv); + } + + erts_free(ERTS_ALC_T_EXTRA_ROOT, rs); +} + static byte* enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, struct erl_off_heap_header** off_heap) { - DECLARE_WSTACK(s); + byte *res; + (void) enc_term_int(NULL, acmp, obj, ep, dflags, off_heap, NULL, &res); + return res; +} + +static int +enc_term_int(Process *p,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, + struct erl_off_heap_header** off_heap, Sint *reds, byte **res) +{ + DECLARE_ESTACK(s); + DECLARE_WSTACK(com); Uint n; Uint i; Uint j; Uint* ptr; Eterm val; FloatDef f; -#if HALFWORD_HEAP - UWord wobj; -#endif + int count_reds = (p != NULL && reds != NULL); + Sint r = 0; + if (count_reds) { + ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_EXTRA_ROOT); + WSTACK_CHANGE_ALLOCATOR(com, ERTS_ALC_T_EXTRA_ROOT); + r = *reds; + } + + if (p && p->extra_root) { /* restore saved stacks and byte pointer */ + ESTACK_RESTORE(s,p->extra_root[0].objv, p->extra_root[0].sz); + obj = ESTACK_POP(s); + WSTACK_RESTORE(com, p->extra_root[1].objv, p->extra_root[1].sz); + ep = (byte *) WSTACK_POP(com); + } goto L_jump_start; outer_loop: - while (!WSTACK_ISEMPTY(s)) { -#if HALFWORD_HEAP - obj = (Eterm) (wobj = WSTACK_POP(s)); -#else - obj = WSTACK_POP(s); -#endif - switch (val = WSTACK_POP(s)) { + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + switch (val = WSTACK_POP(com)) { case ENC_TERM: break; case ENC_ONE_CONS: @@ -1714,45 +2122,57 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, obj = CAR(cons); tl = CDR(cons); - WSTACK_PUSH(s, is_list(tl) ? ENC_ONE_CONS : ENC_TERM); - WSTACK_PUSH(s, tl); + WSTACK_PUSH(com, is_list(tl) ? ENC_ONE_CONS : ENC_TERM); + ESTACK_PUSH(s, tl); } break; case ENC_PATCH_FUN_SIZE: + /* obj will be discarded, it was NIL */ { -#if HALFWORD_HEAP - byte* size_p = (byte *) wobj; -#else - byte* size_p = (byte *) obj; -#endif + byte* size_p = (byte *) WSTACK_POP(com); put_int32(ep - size_p, size_p); } goto outer_loop; case ENC_LAST_ARRAY_ELEMENT: + /* obj is the tuple */ { -#if HALFWORD_HEAP - Eterm* ptr = (Eterm *) wobj; -#else - Eterm* ptr = (Eterm *) obj; -#endif - obj = *ptr; + Eterm* ptr = tuple_val(obj); + i = arityval(*ptr); + obj = ptr[i]; } break; default: /* ENC_LAST_ARRAY_ELEMENT+1 and upwards */ { -#if HALFWORD_HEAP - Eterm* ptr = (Eterm *) wobj; -#else - Eterm* ptr = (Eterm *) obj; -#endif - obj = *ptr++; - WSTACK_PUSH(s, val-1); - WSTACK_PUSH(s, (UWord) ptr); + Eterm* ptr = tuple_val(obj); + i = arityval(*ptr); + ESTACK_PUSH(s, obj); /* put back tuple and next element index */ + WSTACK_PUSH(com, val-1); + obj = ptr[i - (val - ENC_LAST_ARRAY_ELEMENT)]; /* the index is counting down */ } break; } L_jump_start: + + if (count_reds && --r == 0) { + *reds = r; + ESTACK_PUSH(s,obj); /* push back current object, to be popped on restore */ + WSTACK_PUSH(com,((UWord) ep)); + if (p->extra_root == NULL) { + /* NB. Allocate an array of two "extra-roots", of which only the first element + is seen and handled by the GC. Index 1 holds the Wstack. */ + p->extra_root = erts_alloc(ERTS_ALC_T_EXTRA_ROOT, sizeof(ErlExtraRootSet)*2); + p->extra_root->objv = NULL; + p->extra_root->sz = 0; + p->extra_root->cleanup = cleanup_ttb_extra_root_2; + p->extra_root[1].objv = NULL; + p->extra_root[1].sz = 0; + p->extra_root[1].cleanup = NULL; /* Never used */ + } + ESTACK_SAVE(s, p->extra_root[0].objv, p->extra_root[0].sz); + WSTACK_SAVE(com, p->extra_root[1].objv, (p->extra_root[1].sz)); + return -1; + } switch(tag_val_def(obj)) { case NIL_DEF: *ep++ = NIL_EXT; @@ -1896,8 +2316,8 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, ep += 4; } if (i > 0) { - WSTACK_PUSH(s, ENC_LAST_ARRAY_ELEMENT+i-1); - WSTACK_PUSH(s, (UWord) ptr); + WSTACK_PUSH(com, ENC_LAST_ARRAY_ELEMENT+i-1); + ESTACK_PUSH(s, obj); } break; @@ -2041,8 +2461,9 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, int ei; *ep++ = NEW_FUN_EXT; - WSTACK_PUSH(s, ENC_PATCH_FUN_SIZE); - WSTACK_PUSH(s, (UWord) ep); /* Position for patching in size */ + WSTACK_PUSH(com, (UWord) ep); /* Position for patching in size */ + WSTACK_PUSH(com, ENC_PATCH_FUN_SIZE); + ESTACK_PUSH(s,NIL); /* Will be thrown away */ ep += 4; *ep = funp->arity; ep += 1; @@ -2059,8 +2480,8 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, fun_env: for (ei = funp->num_free-1; ei > 0; ei--) { - WSTACK_PUSH(s, ENC_TERM); - WSTACK_PUSH(s, (UWord) funp->env[ei]); + WSTACK_PUSH(com, ENC_TERM); + ESTACK_PUSH(s, (UWord) funp->env[ei]); } if (funp->num_free != 0) { obj = funp->env[0]; @@ -2103,8 +2524,17 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, break; } } - DESTROY_WSTACK(s); - return ep; + DESTROY_ESTACK(s); + DESTROY_WSTACK(com); + if (p && p->extra_root) { + cleanup_ttb_extra_root_2(p->extra_root); + p->extra_root = NULL; + } + if (count_reds) { + *reds = r; + } + *res = ep; + return 0; } static @@ -2892,51 +3322,47 @@ dec_term_atom_common: to a sequence of bytes N.B. That this must agree with to_external2() above!!! (except for cached atoms) */ +static Uint encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) { + Uint res; + (void) encode_size_struct_int(NULL, acmp, obj, dflags, NULL, &res); + return res; +} -static Uint -encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) +static int +encode_size_struct_int(Process *p, ErtsAtomCacheMap *acmp, Eterm obj, + unsigned dflags, Sint *reds, Uint *res) { - DECLARE_WSTACK(s); + DECLARE_ESTACK(s); Uint m, i, arity; Uint result = 0; -#if HALFWORD_HEAP - UWord wobj = 0; -#endif + int count_reds = (p != NULL && reds != 0); + Sint r = 0; + + if (count_reds) { + ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_EXTRA_ROOT); + r = *reds; + } + + if (p && p->extra_root) { /* restore saved stack */ + ESTACK_RESTORE(s,p->extra_root->objv, p->extra_root->sz + 1); + result = ESTACK_POP(s); /*Untagged, beyond p->extra_root->sz */ + obj = ESTACK_POP(s); + + } goto L_jump_start; outer_loop: - while (!WSTACK_ISEMPTY(s)) { -#if HALFWORD_HEAP - obj = (Eterm) (wobj = WSTACK_POP(s)); -#else - obj = WSTACK_POP(s); -#endif + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); handle_popped_obj: - if (is_CP(obj)) { /* Does not look for CP, looks for "no tag" */ -#if HALFWORD_HEAP - Eterm* ptr = (Eterm *) wobj; -#else - Eterm* ptr = (Eterm *) obj; -#endif - /* - * Pointer into a tuple. - */ - obj = *ptr--; - if (!is_header(obj)) { - WSTACK_PUSH(s, (UWord)ptr); - } else { - /* Reached tuple header */ - ASSERT(header_is_arityval(obj)); - goto outer_loop; - } - } else if (is_list(obj)) { + if (is_list(obj)) { Eterm* cons = list_val(obj); Eterm tl; tl = CDR(cons); obj = CAR(cons); - WSTACK_PUSH(s, tl); + ESTACK_PUSH(s, tl); } else if (is_nil(obj)) { result++; goto outer_loop; @@ -2948,6 +3374,20 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) } L_jump_start: + if (count_reds && --r == 0) { + *reds = r; + ESTACK_PUSH(s,obj); /* push back current object */ + ESTACK_PUSH(s,result); /* Untagged, will be out of GC reach */ + if (p->extra_root == NULL) { + p->extra_root = erts_alloc(ERTS_ALC_T_EXTRA_ROOT, sizeof(ErlExtraRootSet)); + p->extra_root->objv = NULL; + p->extra_root->sz = 0; + p->extra_root->cleanup = cleanup_ttb_extra_root; + } + ESTACK_SAVE(s, p->extra_root->objv, p->extra_root->sz); + --p->extra_root->sz; /* Hide result from GC */ + return -1; + } switch (tag_val_def(obj)) { case NIL_DEF: result++; @@ -3034,20 +3474,24 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) case TUPLE_DEF: { Eterm* ptr = tuple_val(obj); - + Uint i; arity = arityval(*ptr); if (arity <= 0xff) { result += 1 + 1; } else { result += 1 + 4; } - ptr += arity; -#if HALFWORD_HEAP - obj = (Eterm) (wobj = (UWord) ptr); -#else - obj = (Eterm) ptr; -#endif - goto handle_popped_obj; + for (i = 1; i <= arity; ++i) { + if (is_list(ptr[i])) { + if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) { + result += m + 2 + 1; + } else { + result += 5; + } + } + ESTACK_PUSH(s,ptr[i]); + } + goto outer_loop; } break; case FLOAT_DEF: @@ -3105,14 +3549,14 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) if (is_not_list(obj)) { /* Push any non-list terms on the stack */ - WSTACK_PUSH(s, obj); + ESTACK_PUSH(s, obj); } else { /* Lists must be handled specially. */ if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) { result += m + 2 + 1; } else { result += 5; - WSTACK_PUSH(s, obj); + ESTACK_PUSH(s, obj); } } } @@ -3143,19 +3587,16 @@ encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) } } - DESTROY_WSTACK(s); - 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; + DESTROY_ESTACK(s); + if (p && p->extra_root) { + cleanup_ttb_extra_root(p->extra_root); + p->extra_root = NULL; + } + if (count_reds) { + *reds = r; + } + *res = result; + return 0; } static Sint @@ -3235,7 +3676,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 +3695,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 012c1c7e6a..25aedc91c6 100755 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -376,7 +376,7 @@ extern int stackdump_on_exit; */ -void erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end); +void erl_grow_stack(ErtsAlcType_t a_type, Eterm** start, Eterm** sp, Eterm** end); #define ESTK_CONCAT(a,b) a##b #define ESTK_SUBSCRIPT(s,i) *((Eterm *)((byte *)ESTK_CONCAT(s,_start) + (i))) #define DEF_ESTACK_SIZE (16) @@ -385,20 +385,79 @@ void erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end); Eterm ESTK_CONCAT(s,_default_stack)[DEF_ESTACK_SIZE]; \ Eterm* ESTK_CONCAT(s,_start) = ESTK_CONCAT(s,_default_stack); \ Eterm* ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start); \ - Eterm* ESTK_CONCAT(s,_end) = ESTK_CONCAT(s,_start) + DEF_ESTACK_SIZE + Eterm* ESTK_CONCAT(s,_end) = ESTK_CONCAT(s,_start) + DEF_ESTACK_SIZE;\ + ErtsAlcType_t ESTK_CONCAT(s,_alloc_type) = ERTS_ALC_T_ESTACK + +#define ESTACK_CHANGE_ALLOCATOR(s,t) \ +do { \ + if (ESTK_CONCAT(s,_start) != ESTK_CONCAT(s,_default_stack)) { \ + erl_exit(1, "Internal error - trying to change allocator " \ + "type of active estack\n"); \ + } \ + ESTK_CONCAT(s,_alloc_type) = (t); \ + } while (0) + +/* + * Do not free the stack after this, it may have pointers into what + * was saved in 'v'. 'v' and 'vsize' are changed by this macro. If + * 'v' points to anything, it should have been allocated by a previous + * call to this macro. Be careful to set a correct allocator prior to + * saving. + * 'v' can be any lvalue pointer, it will point to an array of UWord + * after calling this macro. + */ +#define ESTACK_SAVE(s,v,vsize) /* v and vsize are "name parameters" */ \ +do { \ + Uint _esz = ESTACK_COUNT(s); \ + if (ESTK_CONCAT(s,_start) == ESTK_CONCAT(s,_default_stack)) { \ + if ((v) == NULL) { \ + (v) = erts_alloc(ESTK_CONCAT(s,_alloc_type), \ + DEF_ESTACK_SIZE * sizeof(Eterm)); \ + } \ + memcpy((v),ESTK_CONCAT(s,_start),_esz*sizeof(Eterm)); \ + } else { \ + (v) = (void *) ESTK_CONCAT(s,_start); \ + } \ + (vsize) = _esz; \ + } while (0) + +/* + * Use on empty stack, only the allocator can be changed before this + * The vector parameter is reset to NULL if the vector is moved to stack, + * otherwise it's kept for reuse, so a saved and restored vector might + * need freeing using the correct allocator parameter. + * 'v' can be any lvalue pointer, it's cast to an (Eterm *). + */ +#define ESTACK_RESTORE(s, v, vsize) /*v is a "name parameter"*/ \ +do { \ + if ((vsize) > DEF_ESTACK_SIZE) { \ + Uint _ca = DEF_ESTACK_SIZE; \ + while (_ca < (vsize)) \ + _ca = _ca * 2; \ + ESTK_CONCAT(s,_start) = (Eterm *) (v); \ + ESTK_CONCAT(s,_end) = ((Eterm *)(v)) + _ca; \ + ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start) + (vsize); \ + (v) = NULL; \ + } else { \ + memcpy(ESTK_CONCAT(s,_start),(v),(vsize)*sizeof(Eterm));\ + ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start) + (vsize); \ + } \ + } while (0) + +#define ESTACK_IS_STATIC(s) (ESTK_CONCAT(s,_start) == ESTK_CONCAT(s,_default_stack)) #define DESTROY_ESTACK(s) \ do { \ if (ESTK_CONCAT(s,_start) != ESTK_CONCAT(s,_default_stack)) { \ - erts_free(ERTS_ALC_T_ESTACK, ESTK_CONCAT(s,_start)); \ + erts_free(ESTK_CONCAT(s,_alloc_type), ESTK_CONCAT(s,_start)); \ } \ } while(0) #define ESTACK_PUSH(s, x) \ do { \ if (ESTK_CONCAT(s,_sp) == ESTK_CONCAT(s,_end)) { \ - erl_grow_stack(&ESTK_CONCAT(s,_start), &ESTK_CONCAT(s,_sp), \ - &ESTK_CONCAT(s,_end)); \ + erl_grow_stack(ESTK_CONCAT(s,_alloc_type),&ESTK_CONCAT(s,_start), \ + &ESTK_CONCAT(s,_sp), &ESTK_CONCAT(s,_end)); \ } \ *ESTK_CONCAT(s,_sp)++ = (x); \ } while(0) @@ -406,8 +465,8 @@ do { \ #define ESTACK_PUSH2(s, x, y) \ do { \ if (ESTK_CONCAT(s,_sp) > ESTK_CONCAT(s,_end) - 2) { \ - erl_grow_stack(&ESTK_CONCAT(s,_start), &ESTK_CONCAT(s,_sp), \ - &ESTK_CONCAT(s,_end)); \ + erl_grow_stack(ESTK_CONCAT(s,_alloc_type),&ESTK_CONCAT(s,_start), \ + &ESTK_CONCAT(s,_sp), &ESTK_CONCAT(s,_end)); \ } \ *ESTK_CONCAT(s,_sp)++ = (x); \ *ESTK_CONCAT(s,_sp)++ = (y); \ @@ -430,7 +489,7 @@ do { \ #define ESTACK_POP(s) (*(--ESTK_CONCAT(s,_sp))) -void erl_grow_wstack(UWord** start, UWord** sp, UWord** end); +void erl_grow_wstack(ErtsAlcType_t a_type, UWord** start, UWord** sp, UWord** end); #define WSTK_CONCAT(a,b) a##b #define WSTK_SUBSCRIPT(s,i) *((UWord *)((byte *)WSTK_CONCAT(s,_start) + (i))) #define DEF_WSTACK_SIZE (16) @@ -439,20 +498,79 @@ void erl_grow_wstack(UWord** start, UWord** sp, UWord** end); UWord WSTK_CONCAT(s,_default_stack)[DEF_WSTACK_SIZE]; \ UWord* WSTK_CONCAT(s,_start) = WSTK_CONCAT(s,_default_stack); \ UWord* WSTK_CONCAT(s,_sp) = WSTK_CONCAT(s,_start); \ - UWord* WSTK_CONCAT(s,_end) = WSTK_CONCAT(s,_start) + DEF_WSTACK_SIZE + UWord* WSTK_CONCAT(s,_end) = WSTK_CONCAT(s,_start) + DEF_WSTACK_SIZE; \ + ErtsAlcType_t WSTK_CONCAT(s,_alloc_type) = ERTS_ALC_T_ESTACK + +#define WSTACK_CHANGE_ALLOCATOR(s,t) \ +do { \ + if (WSTK_CONCAT(s,_start) != WSTK_CONCAT(s,_default_stack)) { \ + erl_exit(1, "Internal error - trying to change allocator " \ + "type of active wstack\n"); \ + } \ + WSTK_CONCAT(s,_alloc_type) = (t); \ + } while (0) #define DESTROY_WSTACK(s) \ do { \ if (WSTK_CONCAT(s,_start) != WSTK_CONCAT(s,_default_stack)) { \ - erts_free(ERTS_ALC_T_ESTACK, WSTK_CONCAT(s,_start)); \ + erts_free(WSTK_CONCAT(s,_alloc_type), WSTK_CONCAT(s,_start)); \ } \ } while(0) +/* + * Do not free the stack after this, it may have pointers into what + * was saved in 'v'. 'v' and 'vsize' are changed by this macro. If + * 'v' points to anything, it should have been allocated by a previous + * call to this macro. Be careful to set a correct allocator prior to + * saving. + * 'v' can be any lvalue pointer, it will point to an array of UWord + * after calling this macro. + */ +#define WSTACK_SAVE(s,v,vsize) /* v and vsize are "name parameters" */ \ +do { \ + Uint _wsz = WSTACK_COUNT(s); \ + if (WSTK_CONCAT(s,_start) == WSTK_CONCAT(s,_default_stack)) { \ + if ((v) == NULL) { \ + (v) = erts_alloc(WSTK_CONCAT(s,_alloc_type), \ + DEF_WSTACK_SIZE * sizeof(UWord)); \ + } \ + memcpy((v),WSTK_CONCAT(s,_start),_wsz*sizeof(UWord)); \ + } else { \ + (v) = (void *) WSTK_CONCAT(s,_start); \ + } \ + (vsize) = _wsz; \ + } while (0) + +/* + * Use on empty stack, only the allocator can be changed before this + * The vector parameter is reset to NULL if the vector is moved to stack, + * otherwise it's kept for reuse, so a saved and restored vector might + * need freeing using the correct allocator parameter. + * 'v' can be any lvalue pointer, it's cast to an (UWord *). + */ +#define WSTACK_RESTORE(s, v, vsize) /*v is a "name parameter"*/ \ +do { \ + if ((vsize) > DEF_WSTACK_SIZE) { \ + Uint _ca = DEF_WSTACK_SIZE; \ + while (_ca < (vsize)) \ + _ca = _ca * 2; \ + WSTK_CONCAT(s,_start) = (UWord *) (v); \ + WSTK_CONCAT(s,_end) = ((UWord *)(v)) + _ca; \ + WSTK_CONCAT(s,_sp) = WSTK_CONCAT(s,_start) + (vsize); \ + (v) = NULL; \ + } else { \ + memcpy(WSTK_CONCAT(s,_start),(v),(vsize)*sizeof(UWord));\ + WSTK_CONCAT(s,_sp) = WSTK_CONCAT(s,_start) + (vsize); \ + } \ + } while (0) + +#define WSTACK_IS_STATIC(s) (WSTK_CONCAT(s,_start) == WSTK_CONCAT(s,_default_stack)) + #define WSTACK_PUSH(s, x) \ do { \ if (WSTK_CONCAT(s,_sp) == WSTK_CONCAT(s,_end)) { \ - erl_grow_wstack(&WSTK_CONCAT(s,_start), &WSTK_CONCAT(s,_sp), \ - &WSTK_CONCAT(s,_end)); \ + erl_grow_wstack(WSTK_CONCAT(s,_alloc_type), &WSTK_CONCAT(s,_start), \ + &WSTK_CONCAT(s,_sp), &WSTK_CONCAT(s,_end)); \ } \ *WSTK_CONCAT(s,_sp)++ = (x); \ } while(0) @@ -460,8 +578,8 @@ do { \ #define WSTACK_PUSH2(s, x, y) \ do { \ if (WSTK_CONCAT(s,_sp) > WSTK_CONCAT(s,_end) - 2) { \ - erl_grow_wstack(&WSTK_CONCAT(s,_start), &WSTK_CONCAT(s,_sp), \ - &WSTK_CONCAT(s,_end)); \ + erl_grow_wstack(WSTK_CONCAT(s,_alloc_type), &WSTK_CONCAT(s,_start), \ + &WSTK_CONCAT(s,_sp), &WSTK_CONCAT(s,_end)); \ } \ *WSTK_CONCAT(s,_sp)++ = (x); \ *WSTK_CONCAT(s,_sp)++ = (y); \ @@ -470,8 +588,8 @@ do { \ #define WSTACK_PUSH3(s, x, y, z) \ do { \ if (WSTK_CONCAT(s,_sp) > WSTK_CONCAT(s,_end) - 3) { \ - erl_grow_wstack(&WSTK_CONCAT(s,_start), &WSTK_CONCAT(s,_sp), \ - &WSTK_CONCAT(s,_end)); \ + erl_grow_wstack(WSTK_CONCAT(s,_alloc_type), &WSTK_CONCAT(s,_start), \ + &WSTK_CONCAT(s,_sp), &WSTK_CONCAT(s,_end)); \ } \ *WSTK_CONCAT(s,_sp)++ = (x); \ *WSTK_CONCAT(s,_sp)++ = (y); \ @@ -688,12 +806,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 +836,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); @@ -746,6 +858,8 @@ void erl_drv_thr_init(void); /* utils.c */ void erts_cleanup_offheap(ErlOffHeap *offheap); +Uint64 erts_timestamp_millis(void); + Export* erts_find_function(Eterm, Eterm, unsigned int, ErtsCodeIndex); Eterm store_external_or_ref_in_proc_(Process *, Eterm); @@ -777,6 +891,9 @@ Sint erts_re_set_loop_limit(Sint limit); void erts_init_bif_binary(void); Sint erts_binary_set_loop_limit(Sint limit); +/* external.c */ +void erts_init_external(void); + /* erl_unicode.c */ void erts_init_unicode(void); Sint erts_unicode_set_loop_limit(Sint limit); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 7cadd4aaad..c1e66b59af 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(prt); + 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/beam/utils.c b/erts/emulator/beam/utils.c index d5d97d748a..62caa67ce1 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -185,15 +185,15 @@ erts_set_hole_marker(Eterm* ptr, Uint sz) * Helper function for the ESTACK macros defined in global.h. */ void -erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end) +erl_grow_stack(ErtsAlcType_t a_type, Eterm** start, Eterm** sp, Eterm** end) { Uint old_size = (*end - *start); Uint new_size = old_size * 2; Uint sp_offs = *sp - *start; if (new_size > 2 * DEF_ESTACK_SIZE) { - *start = erts_realloc(ERTS_ALC_T_ESTACK, (void *) *start, new_size*sizeof(Eterm)); + *start = erts_realloc(a_type, (void *) *start, new_size*sizeof(Eterm)); } else { - Eterm* new_ptr = erts_alloc(ERTS_ALC_T_ESTACK, new_size*sizeof(Eterm)); + Eterm* new_ptr = erts_alloc(a_type, new_size*sizeof(Eterm)); sys_memcpy(new_ptr, *start, old_size*sizeof(Eterm)); *start = new_ptr; } @@ -204,15 +204,15 @@ erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end) * Helper function for the ESTACK macros defined in global.h. */ void -erl_grow_wstack(UWord** start, UWord** sp, UWord** end) +erl_grow_wstack(ErtsAlcType_t a_type, UWord** start, UWord** sp, UWord** end) { Uint old_size = (*end - *start); Uint new_size = old_size * 2; Uint sp_offs = *sp - *start; if (new_size > 2 * DEF_ESTACK_SIZE) { - *start = erts_realloc(ERTS_ALC_T_ESTACK, (void *) *start, new_size*sizeof(UWord)); + *start = erts_realloc(a_type, (void *) *start, new_size*sizeof(UWord)); } else { - UWord* new_ptr = erts_alloc(ERTS_ALC_T_ESTACK, new_size*sizeof(UWord)); + UWord* new_ptr = erts_alloc(a_type, new_size*sizeof(UWord)); sys_memcpy(new_ptr, *start, old_size*sizeof(UWord)); *start = new_ptr; } @@ -3722,6 +3722,24 @@ erts_smp_ensure_later_interval_acqb(erts_interval_t *icp, Uint64 ic) } +/* + * A millisecond timestamp without time correction where there's no hrtime + * - for tracing on "long" things... + */ +Uint64 erts_timestamp_millis(void) +{ +#ifdef HAVE_GETHRTIME + return (Uint64) (sys_gethrtime() / 1000000); +#else + Uint64 res; + SysTimeval tv; + sys_gettimeofday(&tv); + res = (Uint64) tv.tv_sec*1000000; + res += (Uint64) tv.tv_usec; + return (res / 1000); +#endif +} + #ifdef DEBUG /* * Handy functions when using a debugger - don't use in the code! 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/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h index bd85e43b8c..5387f75efc 100644 --- a/erts/emulator/drivers/common/erl_efile.h +++ b/erts/emulator/drivers/common/erl_efile.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2011. All Rights Reserved. + * Copyright Ericsson AB 1997-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 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/common/zlib_drv.c b/erts/emulator/drivers/common/zlib_drv.c index 89b7be14f2..3fe5d282dc 100644 --- a/erts/emulator/drivers/common/zlib_drv.c +++ b/erts/emulator/drivers/common/zlib_drv.c @@ -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 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/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index 2bd5177be1..55539b44dd 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2012. All Rights Reserved. + * Copyright Ericsson AB 1997-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 diff --git a/erts/emulator/drivers/win32/ttsl_drv.c b/erts/emulator/drivers/win32/ttsl_drv.c index 1a74d21e99..502cb58dfa 100644 --- a/erts/emulator/drivers/win32/ttsl_drv.c +++ b/erts/emulator/drivers/win32/ttsl_drv.c @@ -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 @@ -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/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index 1059fa5c3a..be3d86a1d2 100644 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2012. All Rights Reserved. + * Copyright Ericsson AB 1997-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 diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c index 64c0e0da3e..8f997aafab 100644 --- a/erts/emulator/hipe/hipe_x86_signal.c +++ b/erts/emulator/hipe/hipe_x86_signal.c @@ -2,7 +2,7 @@ * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2011. 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 @@ -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/internal_doc/dec.erl b/erts/emulator/internal_doc/dec.erl index 255018abe0..bb69e6e81b 100644 --- a/erts/emulator/internal_doc/dec.erl +++ b/erts/emulator/internal_doc/dec.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2010. 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 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/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index a523d67158..5861b30315 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -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 @@ -40,6 +40,13 @@ # include "config.h" #endif +#if defined(__DARWIN__) || defined(__APPLE__) && defined(__MACH__) +/* Setting _DARWIN_UNLIMITED_SELECT before including sys/select.h enables + * the version of select() that does not place a limit on the fd_set. + */ +# define _DARWIN_UNLIMITED_SELECT +#endif + #ifndef WANT_NONBLOCKING # define WANT_NONBLOCKING #endif @@ -90,6 +97,52 @@ #define HARD_DEBUG #endif +#ifdef _DARWIN_UNLIMITED_SELECT +typedef struct { + size_t sz; + fd_set* ptr; +}ERTS_fd_set; +# define ERTS_FD_CLR(fd, fds) FD_CLR((fd), (fds)->ptr) +# define ERTS_FD_SET(fd, fds) FD_SET((fd), (fds)->ptr) +# define ERTS_FD_ISSET(fd,fds) FD_ISSET((fd), (fds)->ptr) +# define ERTS_FD_ZERO(fds) memset((fds)->ptr, 0, (fds)->sz) +# define ERTS_FD_SIZE(n) ((((n)+NFDBITS-1)/NFDBITS)*sizeof(fd_mask)) + +static void ERTS_FD_COPY(ERTS_fd_set *src, ERTS_fd_set *dst) +{ + if (dst->sz != src->sz) { + dst->ptr = dst->ptr + ? erts_realloc(ERTS_ALC_T_SELECT_FDS, dst->ptr, src->sz) + : erts_alloc(ERTS_ALC_T_SELECT_FDS, src->sz); + dst->sz = src->sz; + } + memcpy(dst->ptr, src->ptr, src->sz); +} + +static ERTS_INLINE +int ERTS_SELECT(int nfds, ERTS_fd_set *readfds, ERTS_fd_set *writefds, + ERTS_fd_set *exceptfds, struct timeval *timeout) +{ + ASSERT(!readfds || readfds->sz >= nfds); + ASSERT(!writefds || writefds->sz >= nfds); + ASSERT(!exceptfds); + return select(nfds, + (readfds ? readfds->ptr : NULL ), + (writefds ? writefds->ptr : NULL), + NULL, + timeout); +} + +#else /* !_DARWIN_UNLIMITED_SELECT */ +# define ERTS_fd_set fd_set +# define ERTS_FD_CLR FD_CLR +# define ERTS_FD_ISSET FD_ISSET +# define ERTS_FD_SET FD_SET +# define ERTS_FD_ZERO FD_ZERO +# define ERTS_FD_COPY(src,dst) (*(dst) = *(src)) +# define ERTS_SELECT select +#endif + #define ERTS_POLL_USE_BATCH_UPDATE_POLLSET (ERTS_POLL_USE_DEVPOLL \ || ERTS_POLL_USE_KQUEUE) #define ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE \ @@ -244,10 +297,10 @@ struct ErtsPollSet_ { #if ERTS_POLL_USE_FALLBACK int no_select_fds; #endif - fd_set input_fds; - fd_set res_input_fds; - fd_set output_fds; - fd_set res_output_fds; + ERTS_fd_set input_fds; + ERTS_fd_set res_input_fds; + ERTS_fd_set output_fds; + ERTS_fd_set res_output_fds; #endif #if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE ErtsPollSetUpdateRequestsBlock update_requests; @@ -624,6 +677,33 @@ grow_poll_fds(ErtsPollSet ps, int min_ix) } #endif +#ifdef _DARWIN_UNLIMITED_SELECT +static void +grow_select_fds(int fd, ERTS_fd_set* fds) +{ + int new_len = ERTS_POLL_EXPORT(erts_poll_get_table_len)(fd + 1); + if (new_len > max_fds) + new_len = max_fds; + new_len = ERTS_FD_SIZE(new_len); + fds->ptr = fds->sz + ? erts_realloc(ERTS_ALC_T_SELECT_FDS, fds->ptr, new_len) + : erts_alloc(ERTS_ALC_T_SELECT_FDS, new_len); + memset((char*)fds->ptr + fds->sz, 0, new_len - fds->sz); + fds->sz = new_len; +} +static ERTS_INLINE void +ensure_select_fds(int fd, ERTS_fd_set* in, ERTS_fd_set* out) +{ + ASSERT(in->sz == out->sz); + if (ERTS_FD_SIZE(fd+1) > in->sz) { + grow_select_fds(fd, in); + grow_select_fds(fd, out); + } +} +#else +# define ensure_select_fds(fd, in, out) do {} while(0) +#endif /* _DARWIN_UNLIMITED_SELECT */ + static void grow_fds_status(ErtsPollSet ps, int min_fd) { @@ -1290,22 +1370,23 @@ static int update_pollset(ErtsPollSet ps, int fd) #elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */ { ErtsPollEvents events = ps->fds_status[fd].events; + ensure_select_fds(fd, &ps->input_fds, &ps->output_fds); if ((ERTS_POLL_EV_IN & events) != (ERTS_POLL_EV_IN & ps->fds_status[fd].used_events)) { if (ERTS_POLL_EV_IN & events) { - FD_SET(fd, &ps->input_fds); + ERTS_FD_SET(fd, &ps->input_fds); } else { - FD_CLR(fd, &ps->input_fds); + ERTS_FD_CLR(fd, &ps->input_fds); } } if ((ERTS_POLL_EV_OUT & events) != (ERTS_POLL_EV_OUT & ps->fds_status[fd].used_events)) { if (ERTS_POLL_EV_OUT & events) { - FD_SET(fd, &ps->output_fds); + ERTS_FD_SET(fd, &ps->output_fds); } else { - FD_CLR(fd, &ps->output_fds); + ERTS_FD_CLR(fd, &ps->output_fds); } } @@ -1789,7 +1870,7 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, while (fd < end_fd && res < max_res) { pr[res].events = (ErtsPollEvents) 0; - if (FD_ISSET(fd, &ps->res_input_fds)) { + if (ERTS_FD_ISSET(fd, &ps->res_input_fds)) { #if ERTS_POLL_USE_FALLBACK if (fd == ps->kp_fd) { res += get_kp_results(ps, &pr[res], max_res-res); @@ -1805,7 +1886,7 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, #endif pr[res].events |= ERTS_POLL_EV_IN; } - if (FD_ISSET(fd, &ps->res_output_fds)) + if (ERTS_FD_ISSET(fd, &ps->res_output_fds)) pr[res].events |= ERTS_POLL_EV_OUT; if (pr[res].events) { pr[res].fd = fd; @@ -1832,24 +1913,23 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, while (fd < end_fd && res < max_res) { if (ps->fds_status[fd].events) { int sres; - fd_set *iset = NULL; - fd_set *oset = NULL; + ERTS_fd_set *iset = NULL; + ERTS_fd_set *oset = NULL; if (ps->fds_status[fd].events & ERTS_POLL_EV_IN) { iset = &ps->res_input_fds; - FD_ZERO(iset); - FD_SET(fd, iset); + ERTS_FD_ZERO(iset); + ERTS_FD_SET(fd, iset); } if (ps->fds_status[fd].events & ERTS_POLL_EV_OUT) { oset = &ps->res_output_fds; - FD_ZERO(oset); - FD_SET(fd, oset); - + ERTS_FD_ZERO(oset); + ERTS_FD_SET(fd, oset); } do { /* Initiate 'tv' each time; select() may modify it */ SysTimeval tv = {0, 0}; - sres = select(ps->max_fd+1, iset, oset, NULL, &tv); + sres = ERTS_SELECT(ps->max_fd+1, iset, oset, NULL, &tv); } while (sres < 0 && errno == EINTR); if (sres < 0) { #if ERTS_POLL_USE_FALLBACK @@ -1873,7 +1953,7 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, } else if (sres > 0) { pr[res].fd = fd; - if (iset && FD_ISSET(fd, iset)) { + if (iset && ERTS_FD_ISSET(fd, iset)) { #if ERTS_POLL_USE_FALLBACK if (fd == ps->kp_fd) { res += get_kp_results(ps, @@ -1891,7 +1971,7 @@ save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, #endif pr[res].events |= ERTS_POLL_EV_IN; } - if (oset && FD_ISSET(fd, oset)) { + if (oset && ERTS_FD_ISSET(fd, oset)) { pr[res].events |= ERTS_POLL_EV_OUT; } ASSERT(pr[res].events); @@ -1992,14 +2072,14 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res) #elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */ SysTimeval to = *tv; - ps->res_input_fds = ps->input_fds; - ps->res_output_fds = ps->output_fds; - + ERTS_FD_COPY(&ps->input_fds, &ps->res_input_fds); + ERTS_FD_COPY(&ps->output_fds, &ps->res_output_fds); + #ifdef ERTS_SMP if (to.tv_sec || to.tv_usec) erts_thr_progress_prepare_wait(NULL); #endif - res = select(ps->max_fd + 1, + res = ERTS_SELECT(ps->max_fd + 1, &ps->res_input_fds, &ps->res_output_fds, NULL, @@ -2027,7 +2107,7 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res) ERTS_POLLSET_LOCK(ps); handle_update_requests(ps); ERTS_POLLSET_UNLOCK(ps); - res = select(ps->max_fd + 1, + res = ERTS_SELECT(ps->max_fd + 1, &ps->res_input_fds, &ps->res_output_fds, NULL, @@ -2233,7 +2313,8 @@ ERTS_POLL_EXPORT(erts_poll_init)(void) max_fds = OPEN_MAX; #endif -#if ERTS_POLL_USE_SELECT && defined(FD_SETSIZE) +#if ERTS_POLL_USE_SELECT && defined(FD_SETSIZE) && \ + !defined(_DARWIN_UNLIMITED_SELECT) if (max_fds > FD_SETSIZE) max_fds = FD_SETSIZE; #endif @@ -2301,10 +2382,21 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void) #if ERTS_POLL_USE_FALLBACK ps->no_select_fds = 0; #endif - FD_ZERO(&ps->input_fds); - FD_ZERO(&ps->res_input_fds); - FD_ZERO(&ps->output_fds); - FD_ZERO(&ps->res_output_fds); +#ifdef _DARWIN_UNLIMITED_SELECT + ps->input_fds.sz = 0; + ps->input_fds.ptr = NULL; + ps->res_input_fds.sz = 0; + ps->res_input_fds.ptr = NULL; + ps->output_fds.sz = 0; + ps->output_fds.ptr = NULL; + ps->res_output_fds.sz = 0; + ps->res_output_fds.ptr = NULL; +#else + ERTS_FD_ZERO(&ps->input_fds); + ERTS_FD_ZERO(&ps->res_input_fds); + ERTS_FD_ZERO(&ps->output_fds); + ERTS_FD_ZERO(&ps->res_output_fds); +#endif #endif #if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE ps->update_requests.next = NULL; @@ -2382,6 +2474,16 @@ ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet ps) if (ps->poll_fds) erts_free(ERTS_ALC_T_POLL_FDS, (void *) ps->poll_fds); #elif ERTS_POLL_USE_SELECT +#ifdef _DARWIN_UNLIMITED_SELECT + if (ps->input_fds.ptr) + erts_free(ERTS_ALC_T_SELECT_FDS, (void *) ps->input_fds.ptr); + if (ps->res_input_fds.ptr) + erts_free(ERTS_ALC_T_SELECT_FDS, (void *) ps->res_input_fds.ptr); + if (ps->output_fds.ptr) + erts_free(ERTS_ALC_T_SELECT_FDS, (void *) ps->output_fds.ptr); + if (ps->res_output_fds.ptr) + erts_free(ERTS_ALC_T_SELECT_FDS, (void *) ps->res_output_fds.ptr); +#endif #endif #if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE { @@ -2445,6 +2547,10 @@ ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip) #if ERTS_POLL_USE_POLL size += ps->poll_fds_len*sizeof(struct pollfd); #elif ERTS_POLL_USE_SELECT +#ifdef _DARWIN_UNLIMITED_SELECT + size += ps->input_fds.sz + ps->res_input_fds.sz + + ps->output_fds.sz + ps->res_output_fds.sz; +#endif #endif #if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE 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..b84c8f85ce 100644 --- a/erts/emulator/sys/win32/sys_time.c +++ b/erts/emulator/sys/win32/sys_time.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2011. All Rights Reserved. + * Copyright Ericsson AB 1997-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 @@ -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..801ed0f85a 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.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 @@ -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..2d6c5f9dc7 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,17 @@ 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_BF(A) ((Ulong) ALC_TEST1(RBT_OP(0xa), (A))) +#define RBT_PREV(T) ((RBTL_t *) ALC_TEST1(RBT_OP(0xb), (T))) /* From erl_mseg.c */ #define HAVE_MSEG() ((int) ALC_TEST0(0x400)) @@ -129,5 +140,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..9da49a0d14 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", "aoffcbf", "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..49df2f0245 100644 --- a/erts/emulator/test/alloc_SUITE_data/rbtree.c +++ b/erts/emulator/test/alloc_SUITE_data/rbtree.c @@ -85,20 +85,23 @@ 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 } type; int i, max_i; char stk[128]; RBT_t *root, *x, *y, *res; Ulong x_sz, y_sz, is_x_black; long blacks, curr_blacks; + int have_max_sz; res = NULL; - if (IS_AOBF(alc)) type = AOBF; - else if (IS_AOFF(alc)) type = AOFF; - else type = BF; + if (IS_AOBF(alc)) type = AOBF; + else if (IS_BF(alc)) type = BF; + else type = AOFF; - root = RBT_ROOT(alc); + have_max_sz = !IS_BF_ALGO(alc); + + root = RBT_ROOT(alc, size); #ifdef PRINT_TREE print_tree(tcs, root); @@ -186,9 +189,11 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) break; case AOFF: ASSERT(tcs, y < x); - ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x)); break; } + if (have_max_sz) { + ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x)); + } } y = RBT_RIGHT(x); @@ -205,18 +210,22 @@ check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) break; case AOFF: ASSERT(tcs, y > x); - ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x)); break; } + if (have_max_sz) { + ASSERT(tcs, RBT_MAX_SZ(y) <= RBT_MAX_SZ(x)); + } } if (type == BF) { Ulong l_sz; - RBTL_t *l = RBT_NEXT(x); + RBTL_t *l, *prev=x; for (l = RBT_NEXT(x); l; l = RBT_NEXT(l)) { l_sz = BLK_SZ(l); ASSERT(tcs, l_sz == x_sz); ASSERT(tcs, !RBT_IS_TREE(l)); + ASSERT(tcs, RBT_PREV(l) == prev); + prev = l; } } @@ -263,17 +272,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(a)) { ASSERT(tcs, x == y); } else { @@ -306,7 +318,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 +327,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 +336,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)); - ASSERT(tcs, !RBT_LEFT(RBT_ROOT(a))); - ASSERT(tcs, !RBT_RIGHT(RBT_ROOT(a))); + 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); + } + + 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 +462,8 @@ testcase_run(TestCaseState_t *tcs) char *argv1[] = {"-tasbf", NULL}; char *argv2[] = {"-tasaobf", NULL}; char *argv3[] = {"-tasaoff", NULL}; + char *argv4[] = {"-tasaoffcaobf", NULL}; + char *argv5[] = {"-tasaoffcbf", NULL}; Allctr_t *a; rbtree_test_data *td; @@ -390,7 +485,9 @@ 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)); + ASSERT(tcs, IS_BF(a)); test_it(tcs); @@ -407,7 +504,9 @@ 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)); + ASSERT(tcs, !IS_BF(a)); test_it(tcs); @@ -424,11 +523,56 @@ 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_AOBF(a)); + ASSERT(tcs, !IS_BF(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, aobf 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_AOBF(a)); + ASSERT(tcs, !IS_BF(a)); + + test_it(tcs); + test_carrier_migration(tcs); + + STOP_ALC(a); + td->allocator = NULL; + + testcase_printf(tcs, "aoffcaobf test succeeded!\n"); + + /* Address order first fit, bf within carrier */ + + testcase_printf(tcs, "Starting test of aoffcbf...\n"); + + current_rbt_type_op_base = AO_FIRSTFIT_OP_BASE; + td->allocator = a = START_ALC("rbtree_aoffcbf_", 0, argv5); + + ASSERT(tcs, a); + ASSERT(tcs, !IS_BF_ALGO(a)); + ASSERT(tcs, !IS_AOBF(a)); + ASSERT(tcs, IS_BF(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/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index babdb3363f..fe0a745db8 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -57,10 +57,10 @@ ordering/1,unaligned_order/1,gc_test/1, bit_sized_binary_sizes/1, otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1, - otp_8180/1]). + otp_8180/1, ttb_trap/1]). %% Internal exports. --export([sleeper/0]). +-export([sleeper/0,ttb_loop/2]). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,2}}]. @@ -75,7 +75,7 @@ all() -> bad_term_to_binary, more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order, gc_test, bit_sized_binary_sizes, otp_6817, otp_8117, deep, - obsolete_funs, robustness, otp_8180]. + obsolete_funs, robustness, otp_8180, ttb_trap]. groups() -> []. @@ -1322,6 +1322,38 @@ run_otp_8180(Name) -> end || Bin <- Bins], ok. +%% Test that exit and GC during term_to_binary trap does not crash. +ttb_trap(Config) when is_list(Config)-> + case erlang:system_info(wordsize) of + N when N < 8 -> + {skipped, "Only on 64bit machines"}; + _ -> + do_ttb_trap(5) + end. + +do_ttb_trap(0) -> + ok; +do_ttb_trap(N) -> + Pid = spawn(?MODULE,ttb_loop,[1000,self()]), + receive ok -> ok end, + receive after 100 -> ok end, + erlang:garbage_collect(Pid), + receive after 100 -> ok end, + exit(Pid,kill), + receive after 1 -> ok end, + do_ttb_trap(N-1). + +ttb_loop(N,Pid) -> + Term = lists:duplicate(2000000,2000000), + Pid ! ok, + ttb_loop2(N,Term). +ttb_loop2(0,_T) -> + ok; +ttb_loop2(N,T) -> + apply(erlang,term_to_binary,[T]), + ttb_loop2(N-1,T). + + %% Utilities. make_sub_binary(Bin) when is_binary(Bin) -> 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/code_parallel_load_SUITE.erl b/erts/emulator/test/code_parallel_load_SUITE.erl index d2c80c1ca0..1cfe015ea6 100644 --- a/erts/emulator/test/code_parallel_load_SUITE.erl +++ b/erts/emulator/test/code_parallel_load_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% Copyright Ericsson AB 2012-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 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..fcd4457c34 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -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]). @@ -628,16 +628,23 @@ iter_max_ports(Config) when is_list(Config) -> iter_max_ports_test(Config) -> - Dog = test_server:timetrap(test_server:minutes(20)), + Dog = test_server:timetrap(test_server:minutes(30)), PortTest = port_test(Config), Command = lists:concat([PortTest, " -h0 -q"]), Iters = case os:type() of {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..b631f55a03 100644 --- a/erts/emulator/test/send_term_SUITE.erl +++ b/erts/emulator/test/send_term_SUITE.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 @@ -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/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl index 221b65309a..0f513f0dcb 100644 --- a/erts/emulator/test/trace_SUITE.erl +++ b/erts/emulator/test/trace_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -34,6 +34,7 @@ system_monitor_args/1, more_system_monitor_args/1, system_monitor_long_gc_1/1, system_monitor_long_gc_2/1, system_monitor_large_heap_1/1, system_monitor_large_heap_2/1, + system_monitor_long_schedule/1, bad_flag/1, trace_delivered/1]). -include_lib("test_server/include/test_server.hrl"). @@ -52,6 +53,7 @@ all() -> set_on_first_spawn, system_monitor_args, more_system_monitor_args, system_monitor_long_gc_1, system_monitor_long_gc_2, system_monitor_large_heap_1, + system_monitor_long_schedule, system_monitor_large_heap_2, bad_flag, trace_delivered]. groups() -> @@ -508,6 +510,65 @@ try_l(Val) -> ?line {Self,Comb1} = erlang:system_monitor(undefined), ?line [{large_heap,Val},{long_gc,Arbitrary2}] = lists:sort(Comb1). +monitor_sys(Parent) -> + receive + {monitor,Pid,long_schedule,Data} when is_pid(Pid) -> + io:format("Long schedule of ~w: ~w~n",[Pid,Data]), + Parent ! {Pid,Data}, + monitor_sys(Parent); + {monitor,Port,long_schedule,Data} when is_port(Port) -> + {name,Name} = erlang:port_info(Port,name), + io:format("Long schedule of ~w (~p): ~w~n",[Port,Name,Data]), + Parent ! {Port,Data}, + monitor_sys(Parent); + Other -> + erlang:display(Other) + end. + +start_monitor() -> + Parent = self(), + Mpid = spawn_link(fun() -> monitor_sys(Parent) end), + erlang:system_monitor(Mpid,[{long_schedule,100}]), + erlang:yield(), % Need to be rescheduled for the trace to take + ok. + +system_monitor_long_schedule(suite) -> + []; +system_monitor_long_schedule(doc) -> + ["Tests erlang:system_monitor(Pid, [{long_schedule,Time}])"]; +system_monitor_long_schedule(Config) when is_list(Config) -> + Path = ?config(data_dir, Config), + erl_ddll:start(), + case (catch load_driver(Path, slow_drv)) of + ok -> + do_system_monitor_long_schedule(); + _Error -> + {skip, "Unable to load slow_drv (windows or no usleep()?)"} + end. +do_system_monitor_long_schedule() -> + start_monitor(), + Port = open_port({spawn_driver,slow_drv}, []), + "ok" = erlang:port_control(Port,0,[]), + Self = self(), + receive + {Self,L} when is_list(L) -> + ok + after 1000 -> + ?t:fail(no_trace_of_pid) + end, + "ok" = erlang:port_control(Port,1,[]), + "ok" = erlang:port_control(Port,2,[]), + receive + {Port,LL} when is_list(LL) -> + ok + after 1000 -> + ?t:fail(no_trace_of_port) + end, + port_close(Port), + erlang:system_monitor(undefined), + ok. + + -define(LONG_GC_SLEEP, 670). system_monitor_long_gc_1(suite) -> @@ -1521,3 +1582,11 @@ issue_non_empty_runq_warning(DeadLine, RQLen) -> " Processes info: ~p~n", [DeadLine div 1000, RQLen, self(), PIs]), receive after 1000 -> ok end. + +load_driver(Dir, Driver) -> + case erl_ddll:load_driver(Dir, Driver) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res + end. diff --git a/erts/emulator/valgrind/suppress.standard b/erts/emulator/valgrind/suppress.standard index beecf1a7b5..a4da31a61d 100644 --- a/erts/emulator/valgrind/suppress.standard +++ b/erts/emulator/valgrind/suppress.standard @@ -174,6 +174,7 @@ obj:*/crypto.valgrind.* { Crypto internal... Memcheck:Cond +... obj:*/libcrypto.* } { @@ -194,6 +195,7 @@ obj:*/crypto.valgrind.* { Crypto internal... Memcheck:Value8 +... obj:*/libcrypto.* } { diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 31d9b2e0ad..e61ebe15f5 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 }; @@ -124,6 +122,7 @@ static char *pluss_val_switches[] = { "bwt", "cl", "ct", + "fwi", "tbt", "wct", "wt", diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index cc7d77fd9a..0d45917e4b 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -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 @@ -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/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c index a3bcdb85d9..53c779b1be 100644 --- a/erts/etc/unix/run_erl.c +++ b/erts/etc/unix/run_erl.c @@ -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 diff --git a/erts/etc/unix/to_erl.c b/erts/etc/unix/to_erl.c index 094006c5fd..0f27b64811 100644 --- a/erts/etc/unix/to_erl.c +++ b/erts/etc/unix/to_erl.c @@ -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 diff --git a/erts/etc/win32/erlsrv/erlsrv_interactive.c b/erts/etc/win32/erlsrv/erlsrv_interactive.c index 3f7e20b923..e8d73ae047 100644 --- a/erts/etc/win32/erlsrv/erlsrv_interactive.c +++ b/erts/etc/win32/erlsrv/erlsrv_interactive.c @@ -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 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/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 7903f01f76..a8c9961d87 100644 --- a/erts/preloaded/ebin/erl_prim_loader.beam +++ b/erts/preloaded/ebin/erl_prim_loader.beam diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 29fb8aaebf..09eafbcc29 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..78a45c4325 100644 --- a/erts/preloaded/ebin/erts_internal.beam +++ b/erts/preloaded/ebin/erts_internal.beam diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam Binary files differindex c2bd80df1a..f95a09c003 100644 --- a/erts/preloaded/ebin/init.beam +++ b/erts/preloaded/ebin/init.beam diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam Binary files differindex 226e5a4134..25c620bdd7 100644 --- a/erts/preloaded/ebin/otp_ring0.beam +++ b/erts/preloaded/ebin/otp_ring0.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..12e6471159 --- /dev/null +++ b/erts/preloaded/ebin/prim_eval.beam diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 67e62e53f1..0b9562b8c6 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 7b9da42e4f..8638ef677e 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam Binary files differindex 589f45e75e..58da9ce5ea 100644 --- a/erts/preloaded/ebin/prim_zip.beam +++ b/erts/preloaded/ebin/prim_zip.beam diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam Binary files differindex 72d1090a52..35e4d963fd 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.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..7a7b7fb644 100644 --- a/erts/preloaded/src/Makefile +++ b/erts/preloaded/src/Makefile @@ -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 @@ -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 fefe0f21e0..e016a50c4c 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]). @@ -187,6 +188,7 @@ 'busy_port' | 'busy_dist_port' | {'long_gc', non_neg_integer()} | + {'long_schedule', non_neg_integer()} | {'large_heap', non_neg_integer()}. @@ -2086,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(); @@ -2705,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 @@ -3125,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)). @@ -3293,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); @@ -3317,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) -> @@ -3368,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, @@ -3392,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) -> @@ -3548,3 +3553,18 @@ 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) -> + {number(),number(),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..8a8cd52d64 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% Copyright Ericsson AB 2012-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 @@ -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..fb1269cf91 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,59 @@ 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) -> + case erlang:process_info(self(), trap_exit) of + {trap_exit,true} -> + %% Ensure exit message and consume it + link(S), + %% This is still not a perfect solution. + %% + %% The problem is to close the port and consume any exit + %% message while not knowing if this process traps exit + %% nor if this process has a link to the port. Here we + %% just knows that this process traps exit. + %% + %% If we right here get killed for some reason that exit + %% signal will propagate to the port and onwards to anyone + %% that is linked to the port. E.g when we close a socket + %% that is not ours. + %% + %% The problem can be solved with lists:member on our link + %% list but we deem that as potentially too expensive. We + %% need an is_linked/1 function or guard, or we need + %% a port_close function that can atomically unlink... + catch erlang:port_close(S), + receive {'EXIT',S,_} -> ok end; + {trap_exit,false} -> + catch erlang:port_close(S), + ok + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% BIND(insock(), IP, Port) -> {ok, integer()} | {error, Reason} @@ -1072,8 +1101,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 +1157,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/nt_SUITE.erl b/erts/test/nt_SUITE.erl index 7580a7b364..e440b9e5d9 100644 --- a/erts/test/nt_SUITE.erl +++ b/erts/test/nt_SUITE.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 diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl index 78968ed405..ccf22a9b6b 100644 --- a/erts/test/z_SUITE.erl +++ b/erts/test/z_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 @@ -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/erts/vsn.mk b/erts/vsn.mk index 255def22ca..e235c50f0b 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -17,8 +17,8 @@ # %CopyrightEnd% # -VSN = 5.10.2 -SYSTEM_VSN = R16B01 +VSN = 5.10.3 +SYSTEM_VSN = R16B02 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/asn1/doc/src/notes.xml b/lib/asn1/doc/src/notes.xml index 76d605569d..4b5bba742c 100644 --- a/lib/asn1/doc/src/notes.xml +++ b/lib/asn1/doc/src/notes.xml @@ -31,6 +31,72 @@ <p>This document describes the changes made to the asn1 application.</p> +<section><title>Asn1 2.0.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix some Makefile rules that didn't support silent rules. + Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11111</p> + </item> + <item> + <p>PER/UPER: A semi-constrained INTEGER with a non-zero + lower bound would be incorrectly decoded. This bug was + introduced in R16.</p> + <p>PER/UPER: Given <c>INTEGER (10..MAX, ...)</c>, + attempting to decode any integer below 10 would cause the + encoder to enter an infinite loop.</p> + <p>PER/UPER: For a type with an extensible SIZE + constraint, sizes outside of the root range were + incorrectly encoded.</p> + <p>Given a constraint such as <c>(SIZE (5, ...))</c>, + encoding a size less than 5 would fail (PER/UPER). + Similarly, for BER decoding would fail.</p> + <p>PER: The encoder did not align a known multiplier + string (such as IA5String) of length 16 bits (exactly) to + an octet boundary.</p> + <p>In rare circumstances, DEFAULT values for the UPER + backend could be wrongly encoded.</p> + <p> + Own Id: OTP-11134</p> + </item> + <item> + <p>UPER: The compiler would crash when compiling an + ENUMERATED having more than 63 extended values.</p> + <p>PER/UPER: A SEQUENCE with more 64 extended values + could not be decoded.</p> + <p> + Own Id: OTP-11153</p> + </item> + <item> + <p> + When decoding a SEQUENCE defined inline inside a an + extension addition group, the record named generated by + the decoding code would not match the name in the + generated .hrl file.</p> + <p> + Own Id: OTP-11154 Aux Id: seq12339 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> Postscript files no longer needed for the generation + of PDF files have been removed. </p> + <p> + Own Id: OTP-11016</p> + </item> + </list> + </section> + +</section> + <section><title>Asn1 2.0.1.2</title> <section><title>Fixed Bugs and Malfunctions</title> 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..869b36ddbd 100644 --- a/lib/asn1/src/asn1_db.erl +++ b/lib/asn1/src/asn1_db.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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,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..d279e9697f 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,21 +345,16 @@ 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), demit({"Result = "}), %dbg %% return value as record - RecordName = lists:concat([get_record_name_prefix(), - asn1ct_gen:list2rname(Typename)]), + RecordName = record_name(Typename), case Typename of ['EXTERNAL'] -> emit({" OldFormat={'",RecordName, @@ -401,6 +376,29 @@ gen_dec_constructed_imm_2(Typename, CompList, end, emit({{curr,bytes},"}"}). +%% record_name([TypeName]) -> RecordNameString +%% Construct a record name for the constructed type, ignoring any +%% fake sequences that are used to represent an extension addition +%% group. Such fake sequences never appear as a top type, and their +%% name always start with "ExtAddGroup". + +record_name(Typename0) -> + [TopType|Typename1] = lists:reverse(Typename0), + Typename = filter_ext_add_groups(Typename1, [TopType]), + lists:concat([get_record_name_prefix(), + asn1ct_gen:list2rname(Typename)]). + +filter_ext_add_groups([H|T], Acc) when is_atom(H) -> + case atom_to_list(H) of + "ExtAddGroup"++_ -> + filter_ext_add_groups(T, Acc); + _ -> + filter_ext_add_groups(T, [H|Acc]) + end; +filter_ext_add_groups([H|T], Acc) -> + filter_ext_add_groups(T, [H|Acc]); +filter_ext_add_groups([], Acc) -> Acc. + textual_order([#'ComponentType'{textual_order=undefined}|_],TermList) -> TermList; textual_order(CompList,TermList) when is_list(CompList) -> @@ -489,7 +487,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 +501,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 +514,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 +552,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 +563,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 +576,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 +606,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 +618,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 +644,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 +652,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 +976,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 +997,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 +1026,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 +1192,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 +1280,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 +1299,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 +1343,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 +1375,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 +1389,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 +1406,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 +1426,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 +1438,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 +1461,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 +1486,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,40 +1541,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, - EncObj = - case asn1ct_gen:get_constraint(Type#type.constraint, - componentrelation) of - no -> - case Type#type.tablecinf of - [{objfun,_}|_] -> - {"got objfun through args","ObjFun"}; - _ ->false - end; - _ -> {no_attr,"ObjFun"} - end, - emit({{asis,Cname}," ->",nl}), - DoExt = case Ext of - {ext,ExtPos,_} when (Pos + 1) < ExtPos -> noext; - _ -> Ext - end, - gen_enc_line(Erule,TopType,Cname,Type,"element(2,Val)", - Pos+1,EncObj,DoExt), - emit({";",nl}), - gen_enc_choice2(Erule,TopType,[H2|T], Pos+1, Ext); -gen_enc_choice2(Erule,TopType,[H1|T], Pos, Ext) - when is_record(H1,'ComponentType') -> - Cname = H1#'ComponentType'.name, - Type = H1#'ComponentType'.typespec, +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 @@ -1646,106 +1556,157 @@ gen_enc_choice2(Erule,TopType,[H1|T], Pos, Ext) 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 +1777,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 +1788,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..ab0dbcce8f 100644 --- a/lib/asn1/src/asn1ct_func.erl +++ b/lib/asn1/src/asn1ct_func.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% Copyright Ericsson AB 2012-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,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..69d9d51bf1 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) -> @@ -268,19 +250,10 @@ emit_enc_enumerated_case(Erules, C, EnumName, Count) -> enc_ext_and_val(per, E, F, Args) -> [E|apply(asn1ct_eval_per, F, Args)]; enc_ext_and_val(uper, E, F, Args) -> - <<E:1,(apply(asn1ct_eval_uper, F, Args))/bitstring>>. + Bs = list_to_bitstring([apply(asn1ct_eval_uper, F, Args)]), + <<E:1,Bs/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 +274,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 +301,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 +394,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 +405,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 +425,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 +436,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 +447,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 +466,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 +480,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 +527,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 +561,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 +570,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 +629,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 +637,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 +701,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 +774,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 +795,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 +842,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 +891,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 +922,6 @@ gen_internal_funcs(Erules,[TypeDef|Rest]) -> %% DECODING ***************************** %%*************************************** - gen_decode(Erules,Type) when is_record(Type,typedef) -> D = Type, emit({nl,nl}), @@ -1054,7 +958,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 +970,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 +994,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 +1048,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 +1078,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..bf362db843 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]). @@ -85,7 +86,7 @@ per_dec_enumerated(BaseNamedList, NamedListExt0, Aligned) -> bit_case(Base, Ext). per_dec_extension_map(Aligned) -> - Len = {add,per_dec_normally_small_number(Aligned),1}, + Len = per_dec_normally_small_length(Aligned), {get_bits,Len,[1,bitstring]}. per_dec_integer(Constraint0, Aligned) -> @@ -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); @@ -231,6 +240,11 @@ per_dec_normally_small_number(Aligned) -> Unlimited = per_decode_semi_constrained(0, Aligned), bit_case(Small, Unlimited). +per_dec_normally_small_length(Aligned) -> + Small = {add,{get_bits,6,[1]},1}, + Unlimited = decode_unconstrained_length(false, Aligned), + bit_case(Small, Unlimited). + per_decode_semi_constrained(Lb, Aligned) -> add_lb(Lb, {get_bits,decode_unconstrained_length(false, Aligned),[8]}). @@ -700,7 +714,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..ba52e66ce3 100644 --- a/lib/asn1/src/asn1ct_name.erl +++ b/lib/asn1/src/asn1ct_name.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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,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..1abccc8626 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -2,7 +2,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 @@ -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..f00b23a8b2 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, @@ -454,10 +454,13 @@ testSeqDefault(Config, Rule, Opts) -> testSeqExtension(Config) -> test(Config, fun testSeqExtension/3). testSeqExtension(Config, Rule, Opts) -> - asn1_test_lib:compile_all(["External", "SeqExtension"], Config, + asn1_test_lib:compile_all(["External", + "SeqExtension", + "SeqExtension2"], + Config, [Rule|Opts]), DataDir = ?config(data_dir, Config), - testSeqExtension:main(DataDir, [Rule|Opts]). + testSeqExtension:main(Rule, DataDir, [Rule|Opts]). testSeqExternal(Config) -> test(Config, fun testSeqExternal/3). testSeqExternal(Config, Rule, Opts) -> @@ -655,7 +658,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 +743,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 +857,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 +903,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 +1021,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 +1084,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 +1101,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..8dc5f3d7e1 100644 --- a/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/EnumExt.asn1 @@ -1,28 +1,55 @@ -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 +} + +EnumExtBig ::= ENUMERATED { + base, + ..., + e00,e01,e02,e03,e04,e05,e06,e07,e08,e09,e0a,e0b,e0c,e0d,e0e,e0f, + e10,e11,e12,e13,e14,e15,e16,e17,e18,e19,e1a,e1b,e1c,e1d,e1e,e1f, + e20,e21,e22,e23,e24,e25,e26,e27,e28,e29,e2a,e2b,e2c,e2d,e2e,e2f, + e30,e31,e32,e33,e34,e35,e36,e37,e38,e39,e3a,e3b,e3c,e3d,e3e,e3f, + e40,e41,e42,e43,e44,e45,e46,e47,e48,e49,e4a,e4b,e4c,e4d,e4e,e4f, + e50,e51,e52,e53,e54,e55,e56,e57,e58,e59,e5a,e5b,e5c,e5d,e5e,e5f, + e60,e61,e62,e63,e64,e65,e66,e67,e68,e69,e6a,e6b,e6c,e6d,e6e,e6f, + e70,e71,e72,e73,e74,e75,e76,e77,e78,e79,e7a,e7b,e7c,e7d,e7e,e7f, + e80 +} + +SeqBig ::= SEQUENCE { + b BOOLEAN, + e EnumExtBig, + i INTEGER +} + +END + diff --git a/lib/asn1/test/asn1_SUITE_data/Extension-Addition-Group.asn b/lib/asn1/test/asn1_SUITE_data/Extension-Addition-Group.asn index b07dcd8baa..0e905d8839 100644 --- a/lib/asn1/test/asn1_SUITE_data/Extension-Addition-Group.asn +++ b/lib/asn1/test/asn1_SUITE_data/Extension-Addition-Group.asn @@ -118,4 +118,23 @@ AC-BarringConfig ::= SEQUENCE { ac-BarringForSpecialAC BIT STRING (SIZE(5)) } +InlinedSeq ::= SEQUENCE { + ..., + [[ + s SEQUENCE { + a INTEGER, + b BOOLEAN + } + ]] +} + +-- 'ExtAddGroup1' is used internally to represent fake sequences for +-- extension addition groups. Make sure that a real sequence with that +-- name at the top-level doesn't cause a problem. + +ExtAddGroup1 ::= SEQUENCE { + x INTEGER, + y 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/SeqExtension2.asn1 b/lib/asn1/test/asn1_SUITE_data/SeqExtension2.asn1 new file mode 100644 index 0000000000..44900d9d39 --- /dev/null +++ b/lib/asn1/test/asn1_SUITE_data/SeqExtension2.asn1 @@ -0,0 +1,208 @@ +SeqExtension2 DEFINITIONS AUTOMATIC TAGS ::= +BEGIN + +SeqExt66 ::= SEQUENCE { + ..., + i0 INTEGER (0..127) OPTIONAL, + i1 INTEGER (0..127) OPTIONAL, + i2 INTEGER (0..127) OPTIONAL, + i3 INTEGER (0..127) OPTIONAL, + i4 INTEGER (0..127) OPTIONAL, + i5 INTEGER (0..127) OPTIONAL, + i6 INTEGER (0..127) OPTIONAL, + i7 INTEGER (0..127) OPTIONAL, + i8 INTEGER (0..127) OPTIONAL, + i9 INTEGER (0..127) OPTIONAL, + i10 INTEGER (0..127) OPTIONAL, + i11 INTEGER (0..127) OPTIONAL, + i12 INTEGER (0..127) OPTIONAL, + i13 INTEGER (0..127) OPTIONAL, + i14 INTEGER (0..127) OPTIONAL, + i15 INTEGER (0..127) OPTIONAL, + i16 INTEGER (0..127) OPTIONAL, + i17 INTEGER (0..127) OPTIONAL, + i18 INTEGER (0..127) OPTIONAL, + i19 INTEGER (0..127) OPTIONAL, + i20 INTEGER (0..127) OPTIONAL, + i21 INTEGER (0..127) OPTIONAL, + i22 INTEGER (0..127) OPTIONAL, + i23 INTEGER (0..127) OPTIONAL, + i24 INTEGER (0..127) OPTIONAL, + i25 INTEGER (0..127) OPTIONAL, + i26 INTEGER (0..127) OPTIONAL, + i27 INTEGER (0..127) OPTIONAL, + i28 INTEGER (0..127) OPTIONAL, + i29 INTEGER (0..127) OPTIONAL, + i30 INTEGER (0..127) OPTIONAL, + i31 INTEGER (0..127) OPTIONAL, + i32 INTEGER (0..127) OPTIONAL, + i33 INTEGER (0..127) OPTIONAL, + i34 INTEGER (0..127) OPTIONAL, + i35 INTEGER (0..127) OPTIONAL, + i36 INTEGER (0..127) OPTIONAL, + i37 INTEGER (0..127) OPTIONAL, + i38 INTEGER (0..127) OPTIONAL, + i39 INTEGER (0..127) OPTIONAL, + i40 INTEGER (0..127) OPTIONAL, + i41 INTEGER (0..127) OPTIONAL, + i42 INTEGER (0..127) OPTIONAL, + i43 INTEGER (0..127) OPTIONAL, + i44 INTEGER (0..127) OPTIONAL, + i45 INTEGER (0..127) OPTIONAL, + i46 INTEGER (0..127) OPTIONAL, + i47 INTEGER (0..127) OPTIONAL, + i48 INTEGER (0..127) OPTIONAL, + i49 INTEGER (0..127) OPTIONAL, + i50 INTEGER (0..127) OPTIONAL, + i51 INTEGER (0..127) OPTIONAL, + i52 INTEGER (0..127) OPTIONAL, + i53 INTEGER (0..127) OPTIONAL, + i54 INTEGER (0..127) OPTIONAL, + i55 INTEGER (0..127) OPTIONAL, + i56 INTEGER (0..127) OPTIONAL, + i57 INTEGER (0..127) OPTIONAL, + i58 INTEGER (0..127) OPTIONAL, + i59 INTEGER (0..127) OPTIONAL, + i60 INTEGER (0..127) OPTIONAL, + i61 INTEGER (0..127) OPTIONAL, + i62 INTEGER (0..127) OPTIONAL, + i63 INTEGER (0..127) OPTIONAL, + i64 INTEGER (0..127) OPTIONAL, + i65 INTEGER (0..127) OPTIONAL +} + +SeqExt130 ::= SEQUENCE { + ..., + i0 INTEGER (0..255) OPTIONAL, + i1 INTEGER (0..255) OPTIONAL, + i2 INTEGER (0..255) OPTIONAL, + i3 INTEGER (0..255) OPTIONAL, + i4 INTEGER (0..255) OPTIONAL, + i5 INTEGER (0..255) OPTIONAL, + i6 INTEGER (0..255) OPTIONAL, + i7 INTEGER (0..255) OPTIONAL, + i8 INTEGER (0..255) OPTIONAL, + i9 INTEGER (0..255) OPTIONAL, + i10 INTEGER (0..255) OPTIONAL, + i11 INTEGER (0..255) OPTIONAL, + i12 INTEGER (0..255) OPTIONAL, + i13 INTEGER (0..255) OPTIONAL, + i14 INTEGER (0..255) OPTIONAL, + i15 INTEGER (0..255) OPTIONAL, + i16 INTEGER (0..255) OPTIONAL, + i17 INTEGER (0..255) OPTIONAL, + i18 INTEGER (0..255) OPTIONAL, + i19 INTEGER (0..255) OPTIONAL, + i20 INTEGER (0..255) OPTIONAL, + i21 INTEGER (0..255) OPTIONAL, + i22 INTEGER (0..255) OPTIONAL, + i23 INTEGER (0..255) OPTIONAL, + i24 INTEGER (0..255) OPTIONAL, + i25 INTEGER (0..255) OPTIONAL, + i26 INTEGER (0..255) OPTIONAL, + i27 INTEGER (0..255) OPTIONAL, + i28 INTEGER (0..255) OPTIONAL, + i29 INTEGER (0..255) OPTIONAL, + i30 INTEGER (0..255) OPTIONAL, + i31 INTEGER (0..255) OPTIONAL, + i32 INTEGER (0..255) OPTIONAL, + i33 INTEGER (0..255) OPTIONAL, + i34 INTEGER (0..255) OPTIONAL, + i35 INTEGER (0..255) OPTIONAL, + i36 INTEGER (0..255) OPTIONAL, + i37 INTEGER (0..255) OPTIONAL, + i38 INTEGER (0..255) OPTIONAL, + i39 INTEGER (0..255) OPTIONAL, + i40 INTEGER (0..255) OPTIONAL, + i41 INTEGER (0..255) OPTIONAL, + i42 INTEGER (0..255) OPTIONAL, + i43 INTEGER (0..255) OPTIONAL, + i44 INTEGER (0..255) OPTIONAL, + i45 INTEGER (0..255) OPTIONAL, + i46 INTEGER (0..255) OPTIONAL, + i47 INTEGER (0..255) OPTIONAL, + i48 INTEGER (0..255) OPTIONAL, + i49 INTEGER (0..255) OPTIONAL, + i50 INTEGER (0..255) OPTIONAL, + i51 INTEGER (0..255) OPTIONAL, + i52 INTEGER (0..255) OPTIONAL, + i53 INTEGER (0..255) OPTIONAL, + i54 INTEGER (0..255) OPTIONAL, + i55 INTEGER (0..255) OPTIONAL, + i56 INTEGER (0..255) OPTIONAL, + i57 INTEGER (0..255) OPTIONAL, + i58 INTEGER (0..255) OPTIONAL, + i59 INTEGER (0..255) OPTIONAL, + i60 INTEGER (0..255) OPTIONAL, + i61 INTEGER (0..255) OPTIONAL, + i62 INTEGER (0..255) OPTIONAL, + i63 INTEGER (0..255) OPTIONAL, + i64 INTEGER (0..255) OPTIONAL, + i65 INTEGER (0..255) OPTIONAL, + i66 INTEGER (0..255) OPTIONAL, + i67 INTEGER (0..255) OPTIONAL, + i68 INTEGER (0..255) OPTIONAL, + i69 INTEGER (0..255) OPTIONAL, + i70 INTEGER (0..255) OPTIONAL, + i71 INTEGER (0..255) OPTIONAL, + i72 INTEGER (0..255) OPTIONAL, + i73 INTEGER (0..255) OPTIONAL, + i74 INTEGER (0..255) OPTIONAL, + i75 INTEGER (0..255) OPTIONAL, + i76 INTEGER (0..255) OPTIONAL, + i77 INTEGER (0..255) OPTIONAL, + i78 INTEGER (0..255) OPTIONAL, + i79 INTEGER (0..255) OPTIONAL, + i80 INTEGER (0..255) OPTIONAL, + i81 INTEGER (0..255) OPTIONAL, + i82 INTEGER (0..255) OPTIONAL, + i83 INTEGER (0..255) OPTIONAL, + i84 INTEGER (0..255) OPTIONAL, + i85 INTEGER (0..255) OPTIONAL, + i86 INTEGER (0..255) OPTIONAL, + i87 INTEGER (0..255) OPTIONAL, + i88 INTEGER (0..255) OPTIONAL, + i89 INTEGER (0..255) OPTIONAL, + i90 INTEGER (0..255) OPTIONAL, + i91 INTEGER (0..255) OPTIONAL, + i92 INTEGER (0..255) OPTIONAL, + i93 INTEGER (0..255) OPTIONAL, + i94 INTEGER (0..255) OPTIONAL, + i95 INTEGER (0..255) OPTIONAL, + i96 INTEGER (0..255) OPTIONAL, + i97 INTEGER (0..255) OPTIONAL, + i98 INTEGER (0..255) OPTIONAL, + i99 INTEGER (0..255) OPTIONAL, + i100 INTEGER (0..255) OPTIONAL, + i101 INTEGER (0..255) OPTIONAL, + i102 INTEGER (0..255) OPTIONAL, + i103 INTEGER (0..255) OPTIONAL, + i104 INTEGER (0..255) OPTIONAL, + i105 INTEGER (0..255) OPTIONAL, + i106 INTEGER (0..255) OPTIONAL, + i107 INTEGER (0..255) OPTIONAL, + i108 INTEGER (0..255) OPTIONAL, + i109 INTEGER (0..255) OPTIONAL, + i110 INTEGER (0..255) OPTIONAL, + i111 INTEGER (0..255) OPTIONAL, + i112 INTEGER (0..255) OPTIONAL, + i113 INTEGER (0..255) OPTIONAL, + i114 INTEGER (0..255) OPTIONAL, + i115 INTEGER (0..255) OPTIONAL, + i116 INTEGER (0..255) OPTIONAL, + i117 INTEGER (0..255) OPTIONAL, + i118 INTEGER (0..255) OPTIONAL, + i119 INTEGER (0..255) OPTIONAL, + i120 INTEGER (0..255) OPTIONAL, + i121 INTEGER (0..255) OPTIONAL, + i122 INTEGER (0..255) OPTIONAL, + i123 INTEGER (0..255) OPTIONAL, + i124 INTEGER (0..255) OPTIONAL, + i125 INTEGER (0..255) OPTIONAL, + i126 INTEGER (0..255) OPTIONAL, + i127 INTEGER (0..255) OPTIONAL, + i128 INTEGER (0..255) OPTIONAL, + i129 INTEGER (0..255) OPTIONAL +} + +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..8e21e6ca84 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,41 @@ %%%------------------------------------------------------------------- -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), + + roundtrip('InlinedSeq', #'InlinedSeq'{s=#'InlinedSeq_s'{a=42,b=true}}), + roundtrip('ExtAddGroup1', #'ExtAddGroup1'{x=42,y=1023}), + + 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 +140,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..60b2b2b42e 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.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 @@ -22,6 +22,7 @@ -export([compile/3]). -export([compile_all/3]). -export([compile_erlang/3]). +-export([hex_to_bin/1]). -export([ticket_7407_compile/2,ticket_7407_code/1, ticket_7678/2, ticket_7708/2, ticket_7763/1, ticket_7876/3]). @@ -39,17 +40,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 +60,14 @@ 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]). + +hex_to_bin(S) -> + << <<(hex2num(C)):4>> || C <- S, C =/= $\s >>. + +%%% +%%% Internal functions. +%%% should_load(File, Options) -> case lists:member(abs, Options) of @@ -78,6 +87,10 @@ strip_extension(File, Ext) when Ext == ".asn"; Ext == ".set"; Ext == ".asn1"-> strip_extension(File, _Ext) -> File. +hex2num(C) when $0 =< C, C =< $9 -> C - $0; +hex2num(C) when $A =< C, C =< $F -> C - $A + 10; +hex2num(C) when $a =< C, C =< $f -> C - $a + 10. + ticket_7407_compile(Config,Option) -> ?line DataDir = ?config(data_dir,Config), 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..c6a07646c2 100644 --- a/lib/asn1/test/testChoExtension.erl +++ b/lib/asn1/test/testChoExtension.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -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..f74992a79e 100644 --- a/lib/asn1/test/testCompactBitString.erl +++ b/lib/asn1/test/testCompactBitString.erl @@ -1,7 +1,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 @@ -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..03a09492af 100644 --- a/lib/asn1/test/testConstraints.erl +++ b/lib/asn1/test/testConstraints.erl @@ -1,7 +1,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 @@ -122,32 +122,118 @@ int_constraints(Rules) -> range_error(Rules, 'X1', 21), %%========================================================== + %% SemiConstrained + %%========================================================== + + roundtrip('SemiConstrained', 100), + v_roundtrip(Rules, 'SemiConstrained', 100+128), + roundtrip('SemiConstrained', 397249742397243), + roundtrip('SemiConstrained', 100 + 1 bsl 128*8), + roundtrip('SemiConstrained', 100 + 1 bsl 256*8), + + roundtrip('NegSemiConstrained', -128), + v_roundtrip(Rules, 'NegSemiConstrained', 0), + roundtrip('NegSemiConstrained', -1), + roundtrip('NegSemiConstrained', 500), + + roundtrip('SemiConstrainedExt', -65536), + roundtrip('SemiConstrainedExt', 0), + roundtrip('SemiConstrainedExt', 42), + v_roundtrip(Rules, 'SemiConstrainedExt', 42+128), + roundtrip('SemiConstrainedExt', 100), + roundtrip('SemiConstrainedExt', 47777789), + roundtrip('SemiConstrainedExt', 42 + 1 bsl 128*8), + roundtrip('SemiConstrainedExt', 42 + 1 bsl 256*8), + + roundtrip('NegSemiConstrainedExt', -1023), + roundtrip('NegSemiConstrainedExt', -128), + roundtrip('NegSemiConstrainedExt', -1), + v_roundtrip(Rules, 'NegSemiConstrainedExt', 0), + 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. + +%% PER: Ensure that if the lower bound is Lb, Lb+16#80 is encoded +%% in two bytes as 16#0180. (Not in three bytes as 16#010080.) +v(ber, 'SemiConstrained', 100+128) -> "020200E4"; +v(per, 'SemiConstrained', 100+128) -> "0180"; +v(uper, 'SemiConstrained', 100+128) -> "0180"; +v(ber, 'NegSemiConstrained', 0) -> "020100"; +v(per, 'NegSemiConstrained', 0) -> "0180"; +v(uper, 'NegSemiConstrained', 0) -> "0180"; +v(ber, 'SemiConstrainedExt', 42+128) -> "020200AA"; +v(per, 'SemiConstrainedExt', 42+128) -> "000180"; +v(uper, 'SemiConstrainedExt', 42+128) -> "00C000"; +v(ber, 'NegSemiConstrainedExt', 0) -> "020100"; +v(per, 'NegSemiConstrainedExt', 0) -> "000180"; +v(uper, 'NegSemiConstrainedExt', 0) -> "00C000". + +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), ?line {error,_Reason} = asn1_wrapper:encode('Constraints','AnotherThing',fred3). +v_roundtrip(Erule, Type, Value) -> + Encoded = asn1_test_lib:hex_to_bin(v(Erule, Type, Value)), + Encoded = roundtrip('Constraints', Type, Value). + roundtrip(Type, Value) -> roundtrip('Constraints', Type, Value). roundtrip(Module, Type, Value) -> {ok,Encoded} = Module:encode(Type, Value), {ok,Value} = Module:decode(Type, Encoded), - ok. + Encoded. + +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..f17dedc043 100644 --- a/lib/asn1/test/testDeepTConstr.erl +++ b/lib/asn1/test/testDeepTConstr.erl @@ -1,7 +1,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 @@ -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..cbc13ee6da 100644 --- a/lib/asn1/test/testEnumExt.erl +++ b/lib/asn1/test/testEnumExt.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2012. 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 @@ -38,8 +38,7 @@ main(Rule) when Rule =:= per; Rule =:= uper -> %% ENUMERATED no extensionmark B64 = <<64>>, B64 = roundtrip('Noext', red), - ok; - + common(Rule); main(ber) -> io:format("main(ber)~n",[]), %% ENUMERATED with extensionmark (value is in root set) @@ -57,9 +56,38 @@ main(ber) -> roundtrip('Globalstate', preop), roundtrip('Globalstate', com), + common(ber). + +common(Erule) -> + 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}), + + [begin + S = io_lib:format("e~2.016.0b", [I]), + E = list_to_atom(lists:flatten(S)), + roundtrip('SeqBig', {'SeqBig',true,E,9357}) + end || I <- lists:seq(0, 128)], + + v_roundtrip(Erule, 'SeqBig', {'SeqBig',true,e40,9357}), + v_roundtrip(Erule, 'SeqBig', {'SeqBig',true,e80,9357}), ok. roundtrip(Type, Value) -> {ok,Encoded} = 'EnumExt':encode(Type, Value), {ok,Value} = 'EnumExt':decode(Type, Encoded), Encoded. + +v_roundtrip(Erule, Type, Value) -> + Encoded = roundtrip(Type, Value), + Encoded = asn1_test_lib:hex_to_bin(v(Erule, Value)). + +v(ber, {'SeqBig',true,e40,9357}) -> "300A8001 FF810141 8202248D"; +v(ber, {'SeqBig',true,e80,9357}) -> "300B8001 FF810200 81820224 8D"; +v(per, {'SeqBig',true,e40,9357}) -> "E0014002 248D"; +v(per, {'SeqBig',true,e80,9357}) -> "E0018002 248D"; +v(uper, {'SeqBig',true,e40,9357}) -> "E0280044 91A0"; +v(uper, {'SeqBig',true,e80,9357}) -> "E0300044 91A0". diff --git a/lib/asn1/test/testInfObj.erl b/lib/asn1/test/testInfObj.erl index 03e70c730a..c7b19a0cbb 100644 --- a/lib/asn1/test/testInfObj.erl +++ b/lib/asn1/test/testInfObj.erl @@ -1,7 +1,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 @@ -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/testParameterizedInfObj.erl b/lib/asn1/test/testParameterizedInfObj.erl index 212df79fd4..1dfa52f401 100644 --- a/lib/asn1/test/testParameterizedInfObj.erl +++ b/lib/asn1/test/testParameterizedInfObj.erl @@ -1,7 +1,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 diff --git a/lib/asn1/test/testPrim.erl b/lib/asn1/test/testPrim.erl index 91fb9fffca..a6e68a9fe0 100644 --- a/lib/asn1/test/testPrim.erl +++ b/lib/asn1/test/testPrim.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -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/testSeqExtension.erl b/lib/asn1/test/testSeqExtension.erl index 1128d9a7c3..b996634996 100644 --- a/lib/asn1/test/testSeqExtension.erl +++ b/lib/asn1/test/testSeqExtension.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -module(testSeqExtension). -include("External.hrl"). --export([main/2]). +-export([main/3]). -include_lib("test_server/include/test_server.hrl"). @@ -32,7 +32,7 @@ -record('SeqExt6',{i1,i2,i3,i4,i5,i6,i7}). -record('SuperSeq',{s1,s2,s3,s4,s5,s6,i}). -main(DataDir, Opts) -> +main(Erule, DataDir, Opts) -> roundtrip('SeqExt1', #'SeqExt1'{}), roundtrip('SeqExt2', #'SeqExt2'{bool=true,int=99}), @@ -92,9 +92,38 @@ main(DataDir, Opts) -> s5={'SeqExt5'}, s6={'SeqExt6',531,601,999,777,11953}, i=BigInt} = DecodedSuperSeq, + + + %% Test more than 64 extensions. + roundtrip2('SeqExt66', + list_to_tuple(['SeqExt66'|lists:seq(0, 65)])), + v_roundtrip2(Erule, 'SeqExt66', + list_to_tuple(['SeqExt66'| + lists:duplicate(65, asn1_NOVALUE)++[125]])), + roundtrip2('SeqExt130', + list_to_tuple(['SeqExt130'|lists:seq(0, 129)])), + v_roundtrip2(Erule, 'SeqExt130', + list_to_tuple(['SeqExt130'| + lists:duplicate(129, asn1_NOVALUE)++[199]])), ok. roundtrip(Type, Value) -> {ok,Encoded} = 'SeqExtension':encode(Type, Value), {ok,Value} = 'SeqExtension':decode(Type, Encoded), ok. + +v_roundtrip2(Erule, Type, Value) -> + Encoded = asn1_test_lib:hex_to_bin(v(Erule, Type)), + Encoded = roundtrip2(Type, Value). + +roundtrip2(Type, Value) -> + {ok,Encoded} = 'SeqExtension2':encode(Type, Value), + {ok,Value} = 'SeqExtension2':decode(Type, Encoded), + Encoded. + +v(ber, 'SeqExt66') -> "30049F41 017D"; +v(per, 'SeqExt66') -> "C0420000 00000000 00004001 FA"; +v(uper, 'SeqExt66') -> "D0800000 00000000 00101FA0"; +v(ber, 'SeqExt130') -> "30069F81 010200C7"; +v(per, 'SeqExt130') -> "C0808200 00000000 00000000 00000000 00000040 01C7"; +v(uper, 'SeqExt130') -> "E0208000 00000000 00000000 00000000 0000101C 70". diff --git a/lib/asn1/test/testSeqOf.erl b/lib/asn1/test/testSeqOf.erl index 1aa1eab26d..db537b1478 100644 --- a/lib/asn1/test/testSeqOf.erl +++ b/lib/asn1/test/testSeqOf.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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,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/asn1/vsn.mk b/lib/asn1/vsn.mk index 9245f83280..b75de179dc 100644 --- a/lib/asn1/vsn.mk +++ b/lib/asn1/vsn.mk @@ -1,2 +1,2 @@ #next version number to use is 2.0 -ASN1_VSN = 2.0.1.2 +ASN1_VSN = 2.0.2 diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index 5d2c065385..2d6bcc0d8b 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -32,6 +32,158 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.7.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A design flaw in the generic connection handling in + Common Test made it impossible to implement a connection + handler that could map multiple connection names (i.e. + configuration variable aliases) to single connection + pids. This problem has been solved.</p> + <p> + Own Id: OTP-10126 Aux Id: kunagi-178 [89] </p> + </item> + <item> + <p> + If a telnet connection is hanging, then a call to + ct_telnet:close/1 will time out after 5 seconds and the + connection process is brutally killed. In some cases the + connection would not be unregistered and attempts at + opening a new connection with the same name would make + common_test try to reuse the same connection since it + believed that it was still alive. This has been corrected + - a killed connection is now always unregistered.</p> + <p> + Own Id: OTP-10648 Aux Id: seq12212 </p> + </item> + <item> + <p> + Test performance has been improved by means of a cache + for the top level HTML index logs (all_runs.html and + index.html, in the logdir directory). This solves + problems with slow start up times and test execution + times increasing with the number of ct_run directories + stored in logdir. The cached index entries are stored in + RAM during test execution and are saved to file in logdir + (for faster start up times) whenever a test run finishes.</p> + <p> + Own Id: OTP-10855</p> + </item> + <item> + <p> + Testing of the test specification functionality has been + improved and a couple of minor bugs have been discovered + and corrected.</p> + <p> + Own Id: OTP-10857</p> + </item> + <item> + <p> + Links to the top level index files in some HTML footers + had disappeared. This error has been corrected. Also, a + problem with the suite overview log file not being closed + properly has been solved.</p> + <p> + Own Id: OTP-11046</p> + </item> + <item> + <p> + Common Test would, in case of timetrap error, print a + warning in the log if end_per_testcase wasn't implemented + in the suite, even though it's an optional function. This + printout has been removed.</p> + <p> + Own Id: OTP-11052</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + If it could not be decided which test case a certain log + printout belonged to, the common test framework log was + earlier used. Such printouts are now instead sent to + unexpected_io.log.html in test_server so that there is + only one place to look for "missing" printouts.</p> + <p> + Own Id: OTP-10494 Aux Id: kunagi-319 [230] </p> + </item> + <item> + <p> + Make cover smarter about finding source from beam.</p> + <p> + In particular, search using the source path in + module_info if the current heuristic fails.</p> + <p> + Own Id: OTP-10902</p> + </item> + <item> + <p> + Add a variant of ct_slave:start/2 that starts a node with + specified options on the local host.</p> + <p> + Own Id: OTP-10920</p> + </item> + <item> + <p> + Integrate elliptic curve contribution from Andreas + Schultz </p> + <p> + In order to be able to support elliptic curve cipher + suites in SSL/TLS, additions to handle elliptic curve + infrastructure has been added to public_key and crypto.</p> + <p> + This also has resulted in a rewrite of the crypto API to + gain consistency and remove unnecessary overhead. All OTP + applications using crypto has been updated to use the new + API.</p> + <p> + Impact: Elliptic curve cryptography (ECC) offers + equivalent security with smaller key sizes than other + public key algorithms. Smaller key sizes result in + savings for power, memory, bandwidth, and computational + cost that make ECC especially attractive for constrained + environments.</p> + <p> + Own Id: OTP-11009</p> + </item> + <item> + <p> Postscript files no longer needed for the generation + of PDF files have been removed. </p> + <p> + Own Id: OTP-11016</p> + </item> + <item> + <p> + A link is added from the red error printout in a test + case log (for a failed test case) to the full error + description at the end of the log. The reason for this is + that the error description in the red field is sometimes + truncated at 50 characters in order to keep the log as + short and easy to read as possible.</p> + <p> + Own Id: OTP-11044 Aux Id: seq12304 </p> + </item> + <item> + <p> + A new option 'no_prompt_check' is added to + ct_telnet:expect/3. If this option is used, ct_telnet + will not wait for a prompt or a newline before attempting + to match the given pattern.</p> + <p> + Own Id: OTP-11095</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.7.1</title> <section><title>Fixed Bugs and Malfunctions</title> 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..71fd8754ff 100644 --- a/lib/common_test/src/ct_ftp.erl +++ b/lib/common_test/src/ct_ftp.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 @@ -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..d6f7d24af7 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -540,22 +540,51 @@ get_capabilities(Client) -> get_capabilities(Client, Timeout) -> call(Client, get_capabilities, Timeout). -%% @private +%%---------------------------------------------------------------------- +%% @spec send(Client, SimpleXml) -> Result +%% @equiv send(Client, SimpleXml, infinity) send(Client, SimpleXml) -> send(Client, SimpleXml, ?DEFAULT_TIMEOUT). -%% @private + +%%---------------------------------------------------------------------- +-spec send(Client, SimpleXml, Timeout) -> Result when + Client :: client(), + SimpleXml :: simple_xml(), + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. +%% @doc Send an XML document to the server. +%% +%% The given XML document is sent as is to the server. This function +%% can be used for sending XML documents that can not be expressed by +%% other interface functions in this module. send(Client, SimpleXml, Timeout) -> call(Client,{send, Timeout, SimpleXml}). -%% @private +%%---------------------------------------------------------------------- +%% @spec send_rpc(Client, SimpleXml) -> Result +%% @equiv send_rpc(Client, SimpleXml, infinity) send_rpc(Client, SimpleXml) -> send_rpc(Client, SimpleXml, ?DEFAULT_TIMEOUT). -%% @private + +%%---------------------------------------------------------------------- +-spec send_rpc(Client, SimpleXml, Timeout) -> Result when + Client :: client(), + SimpleXml :: simple_xml(), + Timeout :: timeout(), + Result :: ok | {error,error_reason()}. +%% @doc Send a Netconf <code>rpc</code> request to the server. +%% +%% The given XML document is wrapped in a valid Netconf +%% <code>rpc</code> request and sent to the server. The +%% <code>message-id</code> and namespace attributes are added to the +%% <code>rpc</code> element. +%% +%% This function can be used for sending <code>rpc</code> requests +%% that can not be expressed by other interface functions in this +%% module. send_rpc(Client, SimpleXml, Timeout) -> call(Client,{send_rpc, SimpleXml, Timeout}). - - %%---------------------------------------------------------------------- %% @spec lock(Client, Target) -> Result %% @equiv lock(Client, Target, infinity) @@ -1164,13 +1193,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 +1329,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_run.erl b/lib/common_test/src/ct_run.erl index 41d53c7b43..266ca73417 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -402,7 +402,8 @@ script_start2(Opts = #opts{vts = undefined, Relaxed = get_start_opt(allow_user_terms, true, false, Args), case catch ct_testspec:collect_tests_from_file(Specs1, Relaxed) of {E,Reason} when E == error ; E == 'EXIT' -> - {error,Reason}; + StackTrace = erlang:get_stacktrace(), + {error,{invalid_testspec,{Reason,StackTrace}}}; TestSpecData -> execute_all_specs(TestSpecData, Opts, Args, []) end; @@ -1101,7 +1102,8 @@ run_spec_file(Relaxed, AbsSpecs1 = get_start_opt(join_specs, [AbsSpecs], AbsSpecs, StartOpts), case catch ct_testspec:collect_tests_from_file(AbsSpecs1, Relaxed) of {Error,CTReason} when Error == error ; Error == 'EXIT' -> - exit({error,CTReason}); + StackTrace = erlang:get_stacktrace(), + exit({error,{invalid_testspec,{CTReason,StackTrace}}}); TestSpecData -> run_all_specs(TestSpecData, Opts, StartOpts, []) end. diff --git a/lib/common_test/src/ct_ssh.erl b/lib/common_test/src/ct_ssh.erl index c6ea27b10e..974791bd70 100644 --- a/lib/common_test/src/ct_ssh.erl +++ b/lib/common_test/src/ct_ssh.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-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 @@ -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_testspec.erl b/lib/common_test/src/ct_testspec.erl index 71b03c0ea6..c07ea323e6 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -253,7 +253,7 @@ collect_tests_from_file(Specs,Nodes,Relaxed) when is_list(Nodes) -> Specs2 = [filename:absname(S) || S <- Specs1], TS0 = #testspec{nodes=NodeRefs}, - try create_specs(Specs2,TS0,Relaxed,Join) of + try create_testspecs(Specs2,TS0,Relaxed,Join) of {{[],_},SeparateTestSpecs} -> filter_and_convert(SeparateTestSpecs); {{_,#testspec{tests=[]}},SeparateTestSpecs} -> @@ -262,8 +262,10 @@ collect_tests_from_file(Specs,Nodes,Relaxed) when is_list(Nodes) -> [filter_and_convert(Joined) | filter_and_convert(SeparateTestSpecs)] catch + _:Error={error,_} -> + Error; _:Error -> - Error + {error,Error} end. filter_and_convert(Joined) when is_tuple(Joined) -> @@ -293,9 +295,12 @@ delete_dups1([E|Es],Keep) -> delete_dups1([],Keep) -> Keep. -create_specs(Specs,TestSpec,Relaxed,Join) -> - SpecsTree = create_spec_tree(Specs,TestSpec,Join,[]), - create_specs(SpecsTree,TestSpec,Relaxed). +create_testspecs(Specs,TestSpec,Relaxed,Join) -> + %% SpecsTree = {SpecAbsName, TermsInSpec, + %% IncludedJoinTree, IncludedSeparateTree, + %% JoinSpecWithRest, RestSpecsTree} + SpecsTree = create_spec_tree(Specs,TestSpec,Join,[]), + create_specs(SpecsTree,TestSpec,TestSpec,Relaxed). create_spec_tree([Spec|Specs],TS,JoinWithNext,Known) -> SpecDir = filename:dirname(filename:absname(Spec)), @@ -325,27 +330,31 @@ create_spec_tree([],_TS,_JoinWithNext,_Known) -> []. create_specs({Spec,Terms,InclJoin,InclSep,JoinWithNext,NextSpec}, - TestSpec,Relaxed) -> + TestSpec,TestSpec0,Relaxed) -> SpecDir = filename:dirname(filename:absname(Spec)), TestSpec1 = create_spec(Terms,TestSpec#testspec{spec_dir=SpecDir}, JoinWithNext,Relaxed), - {{JoinSpecs1,JoinTS1},Separate1} = create_specs(InclJoin,TestSpec1,Relaxed), + {{JoinSpecs1,JoinTS1},Separate1} = create_specs(InclJoin,TestSpec1, + TestSpec0,Relaxed), {{JoinSpecs2,JoinTS2},Separate2} = case JoinWithNext of true -> - create_specs(NextSpec,JoinTS1,Relaxed); + create_specs(NextSpec,JoinTS1, + TestSpec0,Relaxed); false -> {{[],JoinTS1},[]} end, - {SepJoinSpecs,Separate3} = create_specs(InclSep,TestSpec,Relaxed), + {SepJoinSpecs,Separate3} = create_specs(InclSep,TestSpec0, + TestSpec0,Relaxed), {SepJoinSpecs1,Separate4} = case JoinWithNext of true -> {{[],TestSpec},[]}; false -> - create_specs(NextSpec,TestSpec,Relaxed) + create_specs(NextSpec,TestSpec0, + TestSpec0,Relaxed) end, SpecInfo = {Spec,TestSpec1#testspec.merge_tests}, @@ -354,7 +363,6 @@ create_specs({Spec,Terms,InclJoin,InclSep,JoinWithNext,NextSpec}, [SepJoinSpecs]++Separate2++ [SepJoinSpecs1]++Separate4, Ss /= []], - case {JoinWithNext,JoinSpecs1} of {true,_} -> {{[SpecInfo|(JoinSpecs1++JoinSpecs2)],JoinTS2}, @@ -366,7 +374,7 @@ create_specs({Spec,Terms,InclJoin,InclSep,JoinWithNext,NextSpec}, {{[SpecInfo|(JoinSpecs1++JoinSpecs2)],JoinTS2}, AllSeparate} end; -create_specs([],TestSpec,_Relaxed) -> +create_specs([],TestSpec,_,_Relaxed) -> {{[],TestSpec},[]}. create_spec(Terms,TestSpec,JoinedByPrev,Relaxed) -> @@ -842,7 +850,8 @@ add_tests([{cases,Node,Dir,Suite,Cs}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_cases(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec), - Suite,Cs,Tests, Spec#testspec.merge_tests), + Suite,Cs,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- skip_suites --- @@ -1246,17 +1255,22 @@ insert_cases(Node,Dir,Suite,Cases,Tests,false) when is_list(Cases) -> append({{Node,Dir},[{Suite,Cases}]},Tests); insert_cases(Node,Dir,Suite,Cases,Tests,true) when is_list(Cases) -> {Tests1,Done} = - lists:foldr(fun(All={{N,D},[{all,_}]},{Replaced,_}) when N == Node, + lists:foldr(fun(All={{N,D},[{all,_}]},{Merged,_}) when N == Node, D == Dir -> - {[All|Replaced],true}; - ({{N,D},Suites0},{Replaced,_}) when N == Node, + {[All|Merged],true}; + ({{N,D},Suites0},{Merged,_}) when N == Node, D == Dir -> Suites1 = insert_cases1(Suite,Cases,Suites0), - {[{{N,D},Suites1}|Replaced],true}; - (T,{Replaced,Match}) -> - {[T|Replaced],Match} + {[{{N,D},Suites1}|Merged],true}; + (T,{Merged,Match}) -> + {[T|Merged],Match} end, {[],false}, Tests), - if not Done -> + if Tests == [] -> + %% initial case with length(Cases) > 1, we need to do this + %% to merge possible duplicate cases in Cases + [{{Node,Dir},insert_cases1(Suite,Cases,[{Suite,[]}])}]; + not Done -> + %% no merging done, simply add these cases to Tests Tests ++ [{{Node,Dir},[{Suite,Cases}]}]; true -> Tests1 @@ -1301,14 +1315,14 @@ skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests,false) when skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests,true) when ((Cases == all) or is_list(Cases)) and is_list(Groups) -> {Tests1,Done} = - lists:foldr(fun({{N,D},Suites0},{Replaced,_}) when N == Node, + lists:foldr(fun({{N,D},Suites0},{Merged,_}) when N == Node, D == Dir -> Suites1 = skip_groups1(Suite, [{Gr,Cases} || Gr <- Groups], Cmt,Suites0), - {[{{N,D},Suites1}|Replaced],true}; - (T,{Replaced,Match}) -> - {[T|Replaced],Match} + {[{{N,D},Suites1}|Merged],true}; + (T,{Merged,Match}) -> + {[T|Merged],Match} end, {[],false}, Tests), if not Done -> Tests ++ [{{Node,Dir},skip_groups1(Suite, @@ -1339,12 +1353,12 @@ skip_cases(Node,Dir,Suite,Cases,Cmt,Tests,false) when is_list(Cases) -> append({{Node,Dir},Suites1},Tests); skip_cases(Node,Dir,Suite,Cases,Cmt,Tests,true) when is_list(Cases) -> {Tests1,Done} = - lists:foldr(fun({{N,D},Suites0},{Replaced,_}) when N == Node, + lists:foldr(fun({{N,D},Suites0},{Merged,_}) when N == Node, D == Dir -> Suites1 = skip_cases1(Suite,Cases,Cmt,Suites0), - {[{{N,D},Suites1}|Replaced],true}; - (T,{Replaced,Match}) -> - {[T|Replaced],Match} + {[{{N,D},Suites1}|Merged],true}; + (T,{Merged,Match}) -> + {[T|Merged],Match} end, {[],false}, Tests), if not Done -> Tests ++ [{{Node,Dir},skip_cases1(Suite,Cases,Cmt,[])}]; 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..49d6edca86 --- /dev/null +++ b/lib/common_test/test/ct_gen_conn_SUITE.erl @@ -0,0 +1,135 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-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% +%% + +%%%------------------------------------------------------------------- +%%% 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..1344878675 --- /dev/null +++ b/lib/common_test/test/ct_gen_conn_SUITE_data/conn_SUITE.erl @@ -0,0 +1,240 @@ +%% +%% %CopyrightBegin% +%% +%% 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 +%% 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/ct_testspec_3_SUITE.erl b/lib/common_test/test/ct_testspec_3_SUITE.erl index 6b4b729552..5fa187e5b4 100644 --- a/lib/common_test/test/ct_testspec_3_SUITE.erl +++ b/lib/common_test/test/ct_testspec_3_SUITE.erl @@ -284,6 +284,24 @@ events_to_check(_, 0) -> events_to_check(Test, N) -> test_events(Test) ++ events_to_check(Test, N-1). + +%%%! +%%%! IMPORTANT NOTE ABOUT THE TEST ORDER: +%%%! +%%%! When merging testspec terms, CT will group the tests by TestDir and +%%%! Suite, before term order (in testspec). That means that if tests +%%%! are ordered like e.g: +%%%! {Dir1,Suite11}, {Dir2,Suite21}, {Dir1,Suite12}, +%%%! the execution order after merge (even if no merge takes place), +%%%! will be: +%%%! {Dir1,[Suite11,Suite12]}, {Dir2,Suite21} +%%%! +%%%! Also, tests in a tree of included testspecs are always collected +%%%! and merged in depth-first manner, meaning even if a particular test is +%%%! on a higher level in the tree, it may be executed later than a test on a +%%%! lower level. +%%%! + test_events(start_separate) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, @@ -300,6 +318,7 @@ test_events(start_separate) -> {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,start_info,{3,2,15}}, @@ -415,6 +434,7 @@ test_events(incl_separate1) -> {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,start_info,{3,2,15}}, @@ -448,6 +468,7 @@ test_events(incl_separate2) -> {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,start_info,{3,2,15}}, @@ -468,6 +489,7 @@ test_events(incl_separate2) -> {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,start_info,{2,2,10}}, @@ -483,6 +505,7 @@ test_events(incl_separate2) -> {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,start_info,{2,2,10}}, @@ -498,6 +521,7 @@ test_events(incl_separate2) -> {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,start_info,{3,2,15}}, @@ -545,6 +569,7 @@ test_events(incl_join1) -> {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,start_info,{4,4,20}}, @@ -614,6 +639,7 @@ test_events(incl_both1) -> {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,start_info,{3,2,15}}, @@ -634,6 +660,7 @@ test_events(incl_both1) -> {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,start_info,{2,2,10}}, @@ -649,6 +676,7 @@ test_events(incl_both1) -> {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,start_info,{2,2,10}}, @@ -692,6 +720,7 @@ test_events(incl_both2) -> {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,start_info,{3,2,15}}, @@ -712,6 +741,7 @@ test_events(incl_both2) -> {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,start_info,{2,2,10}}, @@ -728,18 +758,890 @@ test_events(incl_both2) -> {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]; -test_events(incl_both_and_join1) -> []; -test_events(incl_both_and_join2) -> []; -test_events(rec_incl_separate1) -> []; -test_events(rec_incl_separate2) -> []; -test_events(rec_incl_join1) -> []; -test_events(rec_incl_join2) -> []; -test_events(rec_incl_separate_join1) -> []; -test_events(rec_incl_separate_join2) -> []; -test_events(rec_incl_join_separate1) -> []; -test_events(rec_incl_join_separate2) -> []; - -test_events(_) -> - []. +test_events(incl_both_and_join1) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{5,3,25}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{2,4,{2,2}}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{3,6,{3,3}}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{4,8,{4,4}}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{5,10,{5,5}}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{3,2,15}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{2,4,{2,2}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{3,6,{3,3}}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,20}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{2,4,{2,2}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{3,6,{3,3}}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{4,8,{4,4}}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{2,2,10}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{2,4,{2,2}}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]; + +test_events(incl_both_and_join2) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,20}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{2,4,{2,2}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{3,6,{3,3}}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{4,8,{4,4}}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{3,2,15}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{2,4,{2,2}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{3,6,{3,3}}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{2,2,10}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{2,4,{2,2}}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]; + +test_events(rec_incl_separate1) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,5}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,5}}, + {?eh,tc_start,{t23_SUITE,init_per_suite}}, + {?eh,tc_done,{t23_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t23_SUITE,end_per_suite}}, + {?eh,tc_done,{t23_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,5}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]; + +test_events(rec_incl_separate2) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,5}}, + {?eh,tc_start,{t23_SUITE,init_per_suite}}, + {?eh,tc_done,{t23_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t23_SUITE,end_per_suite}}, + {?eh,tc_done,{t23_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,5}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,5}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]; + +test_events(rec_incl_join1) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,20}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{4,8,{4,4}}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{5,5,25}}, + {?eh,tc_start,{t23_SUITE,init_per_suite}}, + {?eh,tc_done,{t23_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t23_SUITE,end_per_suite}}, + {?eh,tc_done,{t23_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{5,10,{5,5}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]; +test_events(rec_incl_join2) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{5,5,25}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t23_SUITE,init_per_suite}}, + {?eh,tc_done,{t23_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{5,10,{5,5}}}, + {?eh,tc_start,{t23_SUITE,end_per_suite}}, + {?eh,tc_done,{t23_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]; + +test_events(rec_incl_separate_join1) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,20}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{4,8,{4,4}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,20}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{4,8,{4,4}}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,5}}, + {?eh,tc_start,{t23_SUITE,init_per_suite}}, + {?eh,tc_done,{t23_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t23_SUITE,end_per_suite}}, + {?eh,tc_done,{t23_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,20}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{4,8,{4,4}}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,20}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{4,8,{4,4}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]; + +test_events(rec_incl_separate_join2) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,5}}, + {?eh,tc_start,{t23_SUITE,init_per_suite}}, + {?eh,tc_done,{t23_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t23_SUITE,end_per_suite}}, + {?eh,tc_done,{t23_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,20}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{4,8,{4,4}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,20}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{4,8,{4,4}}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + + {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,20}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{4,8,{4,4}}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{4,4,20}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{4,8,{4,4}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]; + +test_events(rec_incl_join_separate1) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{2,2,10}}, + {?eh,tc_start,{t23_SUITE,init_per_suite}}, + {?eh,tc_done,{t23_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t23_SUITE,end_per_suite}}, + {?eh,tc_done,{t23_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{2,4,{2,2}}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{2,2,10}}, + {?eh,tc_start,{t23_SUITE,init_per_suite}}, + {?eh,tc_done,{t23_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t23_SUITE,end_per_suite}}, + {?eh,tc_done,{t23_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{2,4,{2,2}}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]; + +test_events(rec_incl_join_separate2) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{2,2,10}}, + {?eh,tc_start,{t23_SUITE,init_per_suite}}, + {?eh,tc_done,{t23_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t23_SUITE,end_per_suite}}, + {?eh,tc_done,{t23_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,test_stats,{2,4,{2,2}}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec2_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}, + + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}] + ++ flat_spec1_events() ++ + [{?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]. + +%%%----------------------------------------------------------------- + +flat_spec1_events() -> + [ + {?eh,start_info,{2,2,10}}, + {?eh,tc_start,{t11_SUITE,init_per_suite}}, + {?eh,tc_done,{t11_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t11_SUITE,ok_tc}}, + {?eh,tc_done,{t11_SUITE,ok_tc,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{t11_SUITE,exit_tc}}, + {?eh,tc_done,{t11_SUITE,exit_tc,{failed,{error,kaboom}}}}, + {?eh,test_stats,{1,1,{0,0}}}, + {?eh,tc_start,{t11_SUITE,to_tc}}, + {?eh,tc_done,{t11_SUITE,to_tc,{failed,{timetrap_timeout,1}}}}, + {?eh,test_stats,{1,2,{0,0}}}, + {?eh,tc_start,{t11_SUITE,autoskip_tc}}, + {?eh,tc_done, + {t11_SUITE,autoskip_tc,{skipped, + {failed, + {t11_SUITE,init_per_testcase, + {kaboom,'_'}}}}}}, + {?eh,test_stats,{1,2,{0,1}}}, + {?eh,tc_start,{t11_SUITE,userskip_tc}}, + {?eh,tc_done,{t11_SUITE,userskip_tc,{skipped,"user skipped"}}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t11_SUITE,end_per_suite}}, + {?eh,tc_done,{t11_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,init_per_suite}}, + {?eh,tc_done,{t21_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t21_SUITE,ok_tc}}, + {?eh,tc_done,{t21_SUITE,ok_tc,ok}}, + {?eh,test_stats,{2,2,{1,1}}}, + {?eh,tc_start,{t21_SUITE,exit_tc}}, + {?eh,tc_done,{t21_SUITE,exit_tc,{failed,{error,kaboom}}}}, + {?eh,test_stats,{2,3,{1,1}}}, + {?eh,tc_start,{t21_SUITE,to_tc}}, + {?eh,tc_done,{t21_SUITE,to_tc,{failed,{timetrap_timeout,1}}}}, + {?eh,test_stats,{2,4,{1,1}}}, + {?eh,tc_start,{t21_SUITE,autoskip_tc}}, + {?eh,tc_done, + {t21_SUITE,autoskip_tc,{skipped, + {failed, + {t21_SUITE,init_per_testcase, + {kaboom,'_'}}}}}}, + {?eh,test_stats,{2,4,{1,2}}}, + {?eh,tc_start,{t21_SUITE,userskip_tc}}, + {?eh,tc_done,{t21_SUITE,userskip_tc,{skipped,"user skipped"}}}, + {?eh,test_stats,{2,4,{2,2}}}, + {?eh,tc_start,{t21_SUITE,end_per_suite}}, + {?eh,tc_done,{t21_SUITE,end_per_suite,ok}}]. + +flat_spec2_events() -> + [ + {?eh,start_info,{3,2,15}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,ok_tc}}, + {?eh,tc_done,{t12_SUITE,ok_tc,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{t12_SUITE,exit_tc}}, + {?eh,tc_done,{t12_SUITE,exit_tc,{failed,{error,kaboom}}}}, + {?eh,test_stats,{1,1,{0,0}}}, + {?eh,tc_start,{t12_SUITE,to_tc}}, + {?eh,tc_done,{t12_SUITE,to_tc,{failed,{timetrap_timeout,1}}}}, + {?eh,test_stats,{1,2,{0,0}}}, + {?eh,tc_start,{t12_SUITE,autoskip_tc}}, + {?eh,tc_done, + {t12_SUITE,autoskip_tc,{skipped, + {failed, + {t12_SUITE,init_per_testcase, + {kaboom,'_'}}}}}}, + {?eh,test_stats,{1,2,{0,1}}}, + {?eh,tc_start,{t12_SUITE,userskip_tc}}, + {?eh,tc_done,{t12_SUITE,userskip_tc,{skipped,"user skipped"}}}, + {?eh,test_stats,{1,2,{1,1}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,init_per_suite}}, + {?eh,tc_done,{t12_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t12_SUITE,ok_tc}}, + {?eh,tc_done,{t12_SUITE,ok_tc,ok}}, + {?eh,test_stats,{2,2,{1,1}}}, + {?eh,tc_start,{t12_SUITE,exit_tc}}, + {?eh,tc_done,{t12_SUITE,exit_tc,{failed,{error,kaboom}}}}, + {?eh,test_stats,{2,3,{1,1}}}, + {?eh,tc_start,{t12_SUITE,to_tc}}, + {?eh,tc_done,{t12_SUITE,to_tc,{failed,{timetrap_timeout,1}}}}, + {?eh,test_stats,{2,4,{1,1}}}, + {?eh,tc_start,{t12_SUITE,autoskip_tc}}, + {?eh,tc_done, + {t12_SUITE,autoskip_tc,{skipped, + {failed, + {t12_SUITE,init_per_testcase, + {kaboom,'_'}}}}}}, + {?eh,test_stats,{2,4,{1,2}}}, + {?eh,tc_start,{t12_SUITE,userskip_tc}}, + {?eh,tc_done,{t12_SUITE,userskip_tc,{skipped,"user skipped"}}}, + {?eh,test_stats,{2,4,{2,2}}}, + {?eh,tc_start,{t12_SUITE,end_per_suite}}, + {?eh,tc_done,{t12_SUITE,end_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,init_per_suite}}, + {?eh,tc_done,{t22_SUITE,init_per_suite,ok}}, + {?eh,tc_start,{t22_SUITE,ok_tc}}, + {?eh,tc_done,{t22_SUITE,ok_tc,ok}}, + {?eh,test_stats,{3,4,{2,2}}}, + {?eh,tc_start,{t22_SUITE,exit_tc}}, + {?eh,tc_done,{t22_SUITE,exit_tc,{failed,{error,kaboom}}}}, + {?eh,test_stats,{3,5,{2,2}}}, + {?eh,tc_start,{t22_SUITE,to_tc}}, + {?eh,tc_done,{t22_SUITE,to_tc,{failed,{timetrap_timeout,1}}}}, + {?eh,test_stats,{3,6,{2,2}}}, + {?eh,tc_start,{t22_SUITE,autoskip_tc}}, + {?eh,tc_done, + {t22_SUITE,autoskip_tc,{skipped, + {failed, + {t22_SUITE,init_per_testcase, + {kaboom,'_'}}}}}}, + {?eh,test_stats,{3,6,{2,3}}}, + {?eh,tc_start,{t22_SUITE,userskip_tc}}, + {?eh,tc_done,{t22_SUITE,userskip_tc,{skipped,"user skipped"}}}, + {?eh,test_stats,{3,6,{3,3}}}, + {?eh,tc_start,{t22_SUITE,end_per_suite}}, + {?eh,tc_done,{t22_SUITE,end_per_suite,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/common_test/vsn.mk b/lib/common_test/vsn.mk index 87d762b697..d60b4ba675 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.7.1 +COMMON_TEST_VSN = 1.7.2 diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index 94fea84557..33b32a3dce 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -31,6 +31,57 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 4.9.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Compiling functions with complex boolean operations in + guards could be very slow. (Thanks to Magnus Muller for + reporting this issue.)</p> + <p> + Own Id: OTP-10939</p> + </item> + <item> + <p> + Certain guard expressions used in a receive statement + could cause the compiler to crash.</p> + <p> + Own Id: OTP-11119 Aux Id: seq12342 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix optimization of some binary comprehensions. Thanks to + Anthony Ramine.</p> + <p> + Own Id: OTP-11005</p> + </item> + <item> + <p> + Use a set to store ref registers in beam_receive. Thanks + to Anthony Ramine.</p> + <p> + Own Id: OTP-11069</p> + </item> + <item> + <p> + Fix renaming of bs_put_string instructions. Thanks to + Anthony Ramine.</p> + <p> + Own Id: OTP-11129</p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 4.9.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index 1c51226314..c590c5e35b 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% Copyright Ericsson AB 2012-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 @@ -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..e9911fefd9 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.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 @@ -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/src/v3_core.erl b/lib/compiler/src/v3_core.erl index eea54b30a2..d6fdcb2b21 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.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 diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl index 451a9b1e3b..f6d8b1c532 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_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 diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 229e5a98a1..97777568b6 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -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/compiler/vsn.mk b/lib/compiler/vsn.mk index 90d2bff0ad..1c6f49d89b 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 4.9.1 +COMPILER_VSN = 4.9.2 diff --git a/lib/cosEvent/doc/src/notes.xml b/lib/cosEvent/doc/src/notes.xml index b0ac50ab10..ba986792c5 100644 --- a/lib/cosEvent/doc/src/notes.xml +++ b/lib/cosEvent/doc/src/notes.xml @@ -32,7 +32,22 @@ <file>notes.xml</file> </header> - <section><title>cosEvent 2.1.13</title> + <section><title>cosEvent 2.1.14</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> Postscript files no longer needed for the generation + of PDF files have been removed. </p> + <p> + Own Id: OTP-11016</p> + </item> + </list> + </section> + +</section> + +<section><title>cosEvent 2.1.13</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/cosEvent/vsn.mk b/lib/cosEvent/vsn.mk index 85c5c6aadd..6745bee079 100644 --- a/lib/cosEvent/vsn.mk +++ b/lib/cosEvent/vsn.mk @@ -1,3 +1,3 @@ -COSEVENT_VSN = 2.1.13 +COSEVENT_VSN = 2.1.14 diff --git a/lib/cosFileTransfer/doc/src/notes.xml b/lib/cosFileTransfer/doc/src/notes.xml index 56a85f2060..d68a52655a 100644 --- a/lib/cosFileTransfer/doc/src/notes.xml +++ b/lib/cosFileTransfer/doc/src/notes.xml @@ -30,7 +30,22 @@ <file>notes.xml</file> </header> - <section><title>cosFileTransfer 1.1.14</title> + <section><title>cosFileTransfer 1.1.15</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> Postscript files no longer needed for the generation + of PDF files have been removed. </p> + <p> + Own Id: OTP-11016</p> + </item> + </list> + </section> + +</section> + +<section><title>cosFileTransfer 1.1.14</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/cosFileTransfer/vsn.mk b/lib/cosFileTransfer/vsn.mk index 58545be931..cf33926334 100644 --- a/lib/cosFileTransfer/vsn.mk +++ b/lib/cosFileTransfer/vsn.mk @@ -1 +1 @@ -COSFILETRANSFER_VSN = 1.1.14 +COSFILETRANSFER_VSN = 1.1.15 diff --git a/lib/cosNotification/doc/src/notes.xml b/lib/cosNotification/doc/src/notes.xml index babf29d4a9..2d126271a9 100644 --- a/lib/cosNotification/doc/src/notes.xml +++ b/lib/cosNotification/doc/src/notes.xml @@ -31,7 +31,22 @@ <file>notes.xml</file> </header> - <section><title>cosNotification 1.1.19</title> + <section><title>cosNotification 1.1.20</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> Postscript files no longer needed for the generation + of PDF files have been removed. </p> + <p> + Own Id: OTP-11016</p> + </item> + </list> + </section> + +</section> + +<section><title>cosNotification 1.1.19</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/cosNotification/vsn.mk b/lib/cosNotification/vsn.mk index 20eb6167ac..ea59800164 100644 --- a/lib/cosNotification/vsn.mk +++ b/lib/cosNotification/vsn.mk @@ -1,2 +1,2 @@ -COSNOTIFICATION_VSN = 1.1.19 +COSNOTIFICATION_VSN = 1.1.20 diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index fac77308f6..c28ff8136c 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> @@ -129,6 +142,19 @@ (s)[3] = (char)((i) & 0xff);\ } +/* This shall correspond to the similar macro in crypto.erl */ +/* Current value is: erlang:system_info(context_reductions) * 10 */ +#define MAX_BYTES_TO_NIF 20000 + +#define CONSUME_REDS(NifEnv, Ibin) \ +do { \ + int _cost = ((Ibin).size * 100) / MAX_BYTES_TO_NIF;\ + if (_cost) { \ + (void) enif_consume_timeslice((NifEnv), \ + (_cost > 100) ? 100 : _cost); \ + } \ + } while (0) + /* NIF interface declarations */ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); @@ -192,10 +218,10 @@ 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[]); +static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -209,13 +235,17 @@ 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_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 +277,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,10 +346,10 @@ 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}, + {"do_exor", 2, do_exor}, {"rc4_encrypt", 2, rc4_encrypt}, {"rc4_set_key", 1, rc4_set_key}, {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state}, @@ -325,17 +360,116 @@ 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_generate", 1, ec_key_generate}, + {"ecdsa_sign_nif", 4, ecdsa_sign_nif}, + {"ecdsa_verify_nif", 5, ecdsa_verify_nif}, + {"ecdh_compute_key_nif", 3, 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)) + +#endif /* HAVE_EC */ + ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload) @@ -368,6 +502,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 +521,15 @@ static ERL_NIF_TERM atom_none; static ERL_NIF_TERM atom_notsup; static ERL_NIF_TERM atom_digest; +#if defined(HAVE_EC) +static ERL_NIF_TERM atom_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; +#endif + /* #define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n") #define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1) @@ -434,6 +578,7 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) PRINTF_ERR1("CRYPTO: Invalid load_info '%T'", load_info); return 0; } + if (library_refc > 0) { /* Repeated loading of this library (module upgrade). * Atoms and callbacks are already set, we are done. @@ -448,6 +593,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 +612,21 @@ 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"); + + { + int i; + for (i = 0; i < EC_CURVES_CNT; i++) + ec_curves[i].atom = enif_make_atom(env,ec_curves[i].name); + } +#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[]) @@ -614,6 +778,7 @@ static ERL_NIF_TERM md5(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) } MD5((unsigned char *) ibin.data, ibin.size, enif_make_new_binary(env,MD5_LEN, &ret)); + CONSUME_REDS(env,ibin); return ret; } static ERL_NIF_TERM md5_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -635,6 +800,7 @@ static ERL_NIF_TERM md5_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv new_ctx = (MD5_CTX*) enif_make_new_binary(env,MD5_CTX_LEN, &ret); memcpy(new_ctx, ctx_bin.data, MD5_CTX_LEN); MD5_Update(new_ctx, data_bin.data, data_bin.size); + CONSUME_REDS(env,data_bin); return ret; } static ERL_NIF_TERM md5_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -656,10 +822,11 @@ static ERL_NIF_TERM ripemd160(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ ERL_NIF_TERM ret; if (!enif_inspect_iolist_as_binary(env, argv[0], &ibin)) { - return enif_make_badarg(env); + return enif_make_badarg(env); } RIPEMD160((unsigned char *) ibin.data, ibin.size, - enif_make_new_binary(env,RIPEMD160_LEN, &ret)); + enif_make_new_binary(env,RIPEMD160_LEN, &ret)); + CONSUME_REDS(env,ibin); return ret; } static ERL_NIF_TERM ripemd160_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -674,13 +841,14 @@ static ERL_NIF_TERM ripemd160_update(ErlNifEnv* env, int argc, const ERL_NIF_TER ErlNifBinary ctx_bin, data_bin; ERL_NIF_TERM ret; if (!enif_inspect_binary(env, argv[0], &ctx_bin) - || ctx_bin.size != RIPEMD160_CTX_LEN - || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { - return enif_make_badarg(env); + || ctx_bin.size != RIPEMD160_CTX_LEN + || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) { + return enif_make_badarg(env); } new_ctx = (RIPEMD160_CTX*) enif_make_new_binary(env,RIPEMD160_CTX_LEN, &ret); memcpy(new_ctx, ctx_bin.data, RIPEMD160_CTX_LEN); RIPEMD160_Update(new_ctx, data_bin.data, data_bin.size); + CONSUME_REDS(env, data_bin); return ret; } static ERL_NIF_TERM ripemd160_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -689,7 +857,7 @@ static ERL_NIF_TERM ripemd160_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM RIPEMD160_CTX ctx_clone; ERL_NIF_TERM ret; if (!enif_inspect_binary(env, argv[0], &ctx_bin) || ctx_bin.size != RIPEMD160_CTX_LEN) { - return enif_make_badarg(env); + return enif_make_badarg(env); } memcpy(&ctx_clone, ctx_bin.data, RIPEMD160_CTX_LEN); /* writable */ RIPEMD160_Final(enif_make_new_binary(env, RIPEMD160_LEN, &ret), &ctx_clone); @@ -707,6 +875,7 @@ static ERL_NIF_TERM sha(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) } SHA1((unsigned char *) ibin.data, ibin.size, enif_make_new_binary(env,SHA_LEN, &ret)); + CONSUME_REDS(env,ibin); return ret; } static ERL_NIF_TERM sha_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -727,6 +896,7 @@ static ERL_NIF_TERM sha_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv new_ctx = (SHA_CTX*) enif_make_new_binary(env,SHA_CTX_LEN, &ret); memcpy(new_ctx, ctx_bin.data, SHA_CTX_LEN); SHA1_Update(new_ctx, data_bin.data, data_bin.size); + CONSUME_REDS(env,data_bin); return ret; } static ERL_NIF_TERM sha_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -753,6 +923,7 @@ static ERL_NIF_TERM sha224_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv } SHA224((unsigned char *) ibin.data, ibin.size, enif_make_new_binary(env,SHA224_LEN, &ret)); + CONSUME_REDS(env,ibin); return ret; #else return atom_notsup; @@ -781,6 +952,7 @@ static ERL_NIF_TERM sha224_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE new_ctx = (SHA256_CTX*) enif_make_new_binary(env,sizeof(SHA256_CTX), &ret); memcpy(new_ctx, ctx_bin.data, sizeof(SHA256_CTX)); SHA224_Update(new_ctx, data_bin.data, data_bin.size); + CONSUME_REDS(env,data_bin); return ret; #else return atom_notsup; @@ -814,6 +986,7 @@ static ERL_NIF_TERM sha256_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv } SHA256((unsigned char *) ibin.data, ibin.size, enif_make_new_binary(env,SHA256_LEN, &ret)); + CONSUME_REDS(env,ibin); return ret; #else return atom_notsup; @@ -842,6 +1015,7 @@ static ERL_NIF_TERM sha256_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE new_ctx = (SHA256_CTX*) enif_make_new_binary(env,sizeof(SHA256_CTX), &ret); memcpy(new_ctx, ctx_bin.data, sizeof(SHA256_CTX)); SHA256_Update(new_ctx, data_bin.data, data_bin.size); + CONSUME_REDS(env,data_bin); return ret; #else return atom_notsup; @@ -875,6 +1049,7 @@ static ERL_NIF_TERM sha384_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv } SHA384((unsigned char *) ibin.data, ibin.size, enif_make_new_binary(env,SHA384_LEN, &ret)); + CONSUME_REDS(env,ibin); return ret; #else return atom_notsup; @@ -903,6 +1078,7 @@ static ERL_NIF_TERM sha384_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE new_ctx = (SHA512_CTX*) enif_make_new_binary(env,sizeof(SHA512_CTX), &ret); memcpy(new_ctx, ctx_bin.data, sizeof(SHA512_CTX)); SHA384_Update(new_ctx, data_bin.data, data_bin.size); + CONSUME_REDS(env,data_bin); return ret; #else return atom_notsup; @@ -936,6 +1112,7 @@ static ERL_NIF_TERM sha512_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv } SHA512((unsigned char *) ibin.data, ibin.size, enif_make_new_binary(env,SHA512_LEN, &ret)); + CONSUME_REDS(env,ibin); return ret; #else return atom_notsup; @@ -964,6 +1141,7 @@ static ERL_NIF_TERM sha512_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE new_ctx = (SHA512_CTX*) enif_make_new_binary(env,sizeof(SHA512_CTX), &ret); memcpy(new_ctx, ctx_bin.data, sizeof(SHA512_CTX)); SHA512_Update(new_ctx, data_bin.data, data_bin.size); + CONSUME_REDS(env,data_bin); return ret; #else return atom_notsup; @@ -997,6 +1175,7 @@ static ERL_NIF_TERM md4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) } MD4((unsigned char *) ibin.data, ibin.size, enif_make_new_binary(env,MD4_LEN, &ret)); + CONSUME_REDS(env,ibin); return ret; } static ERL_NIF_TERM md4_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -1017,6 +1196,7 @@ static ERL_NIF_TERM md4_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv new_ctx = (MD4_CTX*) enif_make_new_binary(env,MD4_CTX_LEN, &ret); memcpy(new_ctx, ctx_bin.data, MD4_CTX_LEN); MD4_Update(new_ctx, data_bin.data, data_bin.size); + CONSUME_REDS(env,data_bin); return ret; } static ERL_NIF_TERM md4_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -1046,6 +1226,7 @@ static ERL_NIF_TERM md5_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ } hmac_md5(key.data, key.size, data.data, data.size, hmacbuf); memcpy(enif_make_new_binary(env, mac_sz, &ret), hmacbuf, mac_sz); + CONSUME_REDS(env,data); return ret; } @@ -1064,6 +1245,7 @@ static ERL_NIF_TERM sha_mac_n(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ hmac_sha1(key.data, key.size, data.data, data.size, hmacbuf); memcpy(enif_make_new_binary(env, mac_sz, &ret), hmacbuf, mac_sz); + CONSUME_REDS(env,data); return ret; } @@ -1083,6 +1265,7 @@ static ERL_NIF_TERM sha224_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM hmac_sha224(key.data, key.size, data.data, data.size, hmacbuf); memcpy(enif_make_new_binary(env, mac_sz, &ret), hmacbuf, mac_sz); + CONSUME_REDS(env,data); return ret; #else return atom_notsup; @@ -1105,6 +1288,7 @@ static ERL_NIF_TERM sha256_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM hmac_sha256(key.data, key.size, data.data, data.size, hmacbuf); memcpy(enif_make_new_binary(env, mac_sz, &ret), hmacbuf, mac_sz); + CONSUME_REDS(env,data); return ret; #else return atom_notsup; @@ -1127,6 +1311,7 @@ static ERL_NIF_TERM sha384_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM hmac_sha384(key.data, key.size, data.data, data.size, hmacbuf); memcpy(enif_make_new_binary(env, mac_sz, &ret), hmacbuf, mac_sz); + CONSUME_REDS(env,data); return ret; #else return atom_notsup; @@ -1150,6 +1335,7 @@ static ERL_NIF_TERM sha512_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM hmac_sha512(key.data, key.size, data.data, data.size, hmacbuf); memcpy(enif_make_new_binary(env, mac_sz, &ret), hmacbuf, mac_sz); + CONSUME_REDS(env,data); return ret; #else return atom_notsup; @@ -1207,6 +1393,7 @@ static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg ctx_buf = enif_make_new_binary(env, sizeof(HMAC_CTX), &ret); memcpy(ctx_buf, context.data, context.size); HMAC_Update((HMAC_CTX *)ctx_buf, data.data, data.size); + CONSUME_REDS(env,data); return ret; } @@ -1237,7 +1424,7 @@ static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv HMAC_CTX_cleanup(&ctx); if (argc == 2 && req_len < mac_len) { - // Only truncate to req_len bytes if asked. + /* Only truncate to req_len bytes if asked. */ mac_len = req_len; } mac_bin = enif_make_new_binary(env, mac_len, &ret); @@ -1263,6 +1450,7 @@ static ERL_NIF_TERM des_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a DES_set_key((const_DES_cblock*)key.data, &schedule); DES_ncbc_encrypt(text.data, enif_make_new_binary(env, text.size, &ret), text.size, &schedule, &ivec_clone, (argv[3] == atom_true)); + CONSUME_REDS(env,text); return ret; } @@ -1282,6 +1470,7 @@ static ERL_NIF_TERM des_cfb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a DES_set_key((const_DES_cblock*)key.data, &schedule); DES_cfb_encrypt(text.data, enif_make_new_binary(env, text.size, &ret), 8, text.size, &schedule, &ivec_clone, (argv[3] == atom_true)); + CONSUME_REDS(env,text); return ret; } @@ -1298,6 +1487,7 @@ static ERL_NIF_TERM des_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a DES_ecb_encrypt((const_DES_cblock*)text.data, (DES_cblock*)enif_make_new_binary(env, 8, &ret), &schedule, (argv[2] == atom_true)); + CONSUME_REDS(env,text); return ret; } @@ -1324,6 +1514,7 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T DES_ede3_cbc_encrypt(text.data, enif_make_new_binary(env,text.size,&ret), text.size, &schedule1, &schedule2, &schedule3, &ivec_clone, (argv[5] == atom_true)); + CONSUME_REDS(env,text); return ret; } @@ -1350,6 +1541,7 @@ static ERL_NIF_TERM des_ede3_cfb_crypt_nif(ErlNifEnv* env, int argc, const ERL_N DES_ede3_cfb_encrypt(text.data, enif_make_new_binary(env,text.size,&ret), 8, text.size, &schedule1, &schedule2, &schedule3, &ivec_clone, (argv[5] == atom_true)); + CONSUME_REDS(env,text); return ret; #else return atom_notsup; @@ -1376,6 +1568,7 @@ static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TE enif_make_new_binary(env, text.size, &ret), text.size, &aes_key, ivec_clone, &new_ivlen, (argv[3] == atom_true)); + CONSUME_REDS(env,text); return ret; } @@ -1401,6 +1594,7 @@ static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM AES_ctr128_encrypt((unsigned char *) text.data, enif_make_new_binary(env, text.size, &ret), text.size, &aes_key, ivec_clone, ecount_buf, &num); + CONSUME_REDS(env,text); /* To do an incremental {en|de}cryption, the state to to keep between calls must include ivec_clone, ecount_buf and num. */ @@ -1444,6 +1638,7 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N num2_term = enif_make_uint(env, num); new_state_term = enif_make_tuple4(env, state_term[0], ivec2_term, ecount2_term, num2_term); ret = enif_make_tuple2(env, new_state_term, cipher_term); + CONSUME_REDS(env,text_bin); return ret; } @@ -1631,13 +1826,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 +1849,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 +1864,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 +1889,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 +2015,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 +2035,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 +2045,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); @@ -1897,10 +2086,11 @@ static ERL_NIF_TERM aes_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a ret_ptr = enif_make_new_binary(env, data_bin.size, &ret); memcpy(ivec, ivec_bin.data, 16); /* writable copy */ AES_cbc_encrypt(data_bin.data, ret_ptr, data_bin.size, &aes_key, ivec, i); + CONSUME_REDS(env,data_bin); return ret; } -static ERL_NIF_TERM exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Data1, Data2) */ ErlNifBinary d1, d2; unsigned char* ret_ptr; @@ -1917,6 +2107,7 @@ static ERL_NIF_TERM exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) for (i=0; i<d1.size; i++) { ret_ptr[i] = d1.data[i] ^ d2.data[i]; } + CONSUME_REDS(env,d1); return ret; } @@ -1933,6 +2124,7 @@ static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg RC4_set_key(&rc4_key, key.size, key.data); RC4(&rc4_key, data.size, data.data, enif_make_new_binary(env, data.size, &ret)); + CONSUME_REDS(env,data); return ret; } @@ -1965,7 +2157,7 @@ static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_N memcpy(rc4_key, state.data, sizeof(RC4_KEY)); RC4(rc4_key, data.size, data.data, enif_make_new_binary(env, data.size, &new_data)); - + CONSUME_REDS(env,data); return enif_make_tuple2(env,new_state,new_data); } @@ -1992,6 +2184,7 @@ static ERL_NIF_TERM rc2_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a data_bin.size, &rc2_key, iv_copy, (argv[3] == atom_true)); + CONSUME_REDS(env,data_bin); return ret; } @@ -2001,22 +2194,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 +2246,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 +2305,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 +2326,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 +2380,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 +2479,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 +2496,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 +2520,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 +2542,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 +2569,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 +2652,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 +2732,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 @@ -2621,6 +2816,7 @@ static ERL_NIF_TERM bf_cfb64_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM BF_cfb64_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), data_bin.size, &bf_key, bf_tkey, &bf_n, (argv[3] == atom_true ? BF_ENCRYPT : BF_DECRYPT)); + CONSUME_REDS(env,data_bin); return ret; } @@ -2644,6 +2840,7 @@ static ERL_NIF_TERM bf_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar BF_cbc_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), data_bin.size, &bf_key, bf_tkey, (argv[3] == atom_true ? BF_ENCRYPT : BF_DECRYPT)); + CONSUME_REDS(env,data_bin); return ret; } @@ -2661,6 +2858,7 @@ static ERL_NIF_TERM bf_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar BF_set_key(&bf_key, key_bin.size, key_bin.data); BF_ecb_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), &bf_key, (argv[2] == atom_true ? BF_ENCRYPT : BF_DECRYPT)); + CONSUME_REDS(env,data_bin); return ret; } @@ -2683,10 +2881,534 @@ static ERL_NIF_TERM blowfish_ofb64_encrypt(ErlNifEnv* env, int argc, const ERL_N memcpy(bf_tkey, ivec_bin.data, 8); BF_ofb64_encrypt(data_bin.data, enif_make_new_binary(env,data_bin.size,&ret), data_bin.size, &bf_key, bf_tkey, &bf_n); + CONSUME_REDS(env,data_bin); + 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); + ERL_VALGRIND_MAKE_MEM_DEFINED(ptr, dlen); + 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); + } + ERL_VALGRIND_MAKE_MEM_DEFINED(bin.data, bin.size); + return enif_make_binary(env, &bin); +} + +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; } +static int get_ec_key(ErlNifEnv* env, + ERL_NIF_TERM curve, ERL_NIF_TERM priv, ERL_NIF_TERM pub, + EC_KEY** res) +{ + EC_KEY *key = NULL; + BIGNUM *priv_key = NULL; + EC_POINT *pub_key = NULL; + EC_GROUP *group = NULL; + + if (!(priv == atom_undefined || get_bn_from_bin(env, priv, &priv_key)) + || !(pub == atom_undefined || enif_is_binary(env, pub))) { + goto out_err; + } + + key = ec_key_new(env, curve); + + if (!key) { + goto out_err; + } + + if (!group) + group = EC_GROUP_dup(EC_KEY_get0_group(key)); + + if (term2point(env, pub, group, &pub_key)) { + if (!EC_KEY_set_public_key(key, pub_key)) { + goto out_err; + } + } + if (priv != 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; + } + } + + 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 (priv_key) BN_clear_free(priv_key); + if (pub_key) EC_POINT_free(pub_key); + if (group) EC_GROUP_free(group); + if (!key) + return 0; + *res = key; + return 1; +} +#endif /* HAVE_EC */ + +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)) { + const EC_GROUP *group; + const EC_POINT *public_key; + ERL_NIF_TERM priv_key; + ERL_NIF_TERM pub_key = atom_undefined; + + group = EC_KEY_get0_group(key); + public_key = EC_KEY_get0_public_key(key); + + if (group && public_key) { + pub_key = point2term(env, group, public_key, + EC_KEY_get_conv_form(key)); + } + priv_key = bn2term(env, EC_KEY_get0_private_key(key)); + EC_KEY_free(key); + return enif_make_tuple2(env, pub_key, priv_key); + } + else + return enif_make_badarg(env); +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Type, Data|{digest,Digest}, Curve, Key) */ +#if defined(HAVE_EC) + ErlNifBinary data_bin, ret_bin; + unsigned char hmacbuf[SHA_DIGEST_LENGTH]; + unsigned int dsa_s_len; + EC_KEY* key = NULL; + 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 (!get_ec_key(env, argv[2], argv[3], atom_undefined, &key)) + goto badarg; + + 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) { + + goto badarg; + } + digest = data_bin.data; + } + else { + if (!enif_inspect_binary(env,argv[1],&data_bin)) { + goto badarg; + } + digest = hmacbuf; + digp->funcp(data_bin.data, data_bin.size, digest); + } + + enif_alloc_binary(ECDSA_size(key), &ret_bin); + + i = ECDSA_sign(digp->NID_type, digest, digp->len, + ret_bin.data, &dsa_s_len, key); + + EC_KEY_free(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; + } + +badarg: + if (key) + EC_KEY_free(key); + return enif_make_badarg(env); +#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, Curve, Key) */ +#if defined(HAVE_EC) + ErlNifBinary data_bin, sign_bin; + unsigned char hmacbuf[SHA512_LEN]; + int i; + EC_KEY* key = NULL; + 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) + || !get_ec_key(env, argv[3], atom_undefined, argv[4], &key)) + goto badarg; + + 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) { + + goto badarg; + } + 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 { + goto badarg; + } + + i = ECDSA_verify(digp->NID_type, digest, digp->len, + sign_bin.data, sign_bin.size, key); + + EC_KEY_free(key); + + return (i==1 ? atom_true : atom_false); + +badarg: + if (key) + EC_KEY_free(key); + return enif_make_badarg(env); +#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[]) +/* (OtherPublicKey, Curve, My) */ +{ +#if defined(HAVE_EC) + ERL_NIF_TERM ret; + unsigned char *p; + EC_KEY* key = NULL; + int field_size = 0; + int i; + EC_GROUP *group; + const BIGNUM *priv_key; + EC_POINT *my_ecpoint; + EC_KEY *other_ecdh = NULL; + if (!get_ec_key(env, argv[1], argv[2], atom_undefined, &key)) + return enif_make_badarg(env); + + group = EC_GROUP_dup(EC_KEY_get0_group(key)); + priv_key = EC_KEY_get0_private_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); + if (key) EC_KEY_free(key); + + 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..99d167bfa9 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> + <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>Name = binary()</v> - <v>VerNum = integer()</v> - <v>VerStr = binary()</v> + <v>Type = block_cipher() </v> + <v>Key = block_key() </v> + <v>PlainText = iodata() </v> + <v>IVec = CipherText = 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> - <type> - <v>Data = iolist() | binary()</v> - <v>Digest = 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,20 +259,22 @@ 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 which digest to use. The returned context should be used as argument - to <seealso marker="#hash_update/2">hash_update</seealso>.</p> + to <seealso marker="#hash_update-2">hash_update</seealso>.</p> <p>May throw exception <c>notsup</c> in case the chosen <c>Type</c> is not supported by the underlying OpenSSL implementation.</p> </desc> </func> + <func> <name>hash_update(Context, Data) -> NewContext</name> <fsummary></fsummary> @@ -310,10 +283,10 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </type> <desc> <p>Updates the digest represented by <c>Context</c> using the given <c>Data</c>. <c>Context</c> - must have been generated using <seealso marker="#hash_init/1">hash_init</seealso> + must have been generated using <seealso marker="#hash_init-1">hash_init</seealso> or a previous call to this function. <c>Data</c> can be any length. <c>NewContext</c> must be passed into the next call to <c>hash_update</c> - or <seealso marker="#hash_final/1">hash_final</seealso>.</p> + or <seealso marker="#hash_final-1">hash_final</seealso>.</p> </desc> </func> <func> @@ -324,43 +297,18 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </type> <desc> <p>Finalizes the hash operation referenced by <c>Context</c> returned - from a previous call to <seealso marker="#hash_update/2">hash_update</seealso>. + from a previous call to <seealso marker="#hash_update-2">hash_update</seealso>. The size of <c>Digest</c> is determined by the type of hash 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> + <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> + or to one of the functions <seealso marker="#hmac_final-1">hmac_final</seealso> and + <seealso marker="#hmac_final_n-2">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,491 +379,151 @@ 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> + <name>info_lib() -> [{Name,VerNum,VerStr}]</name> + <fsummary>Provides information about the libraries used by crypto.</fsummary> <type> - <v>Key = Cipher = iolist() | binary()</v> - <v>Text = binary()</v> + <v>Name = binary()</v> + <v>VerNum = integer()</v> + <v>VerStr = 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> + <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>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> + <name>mod_pow(N, P, M) -> Result</name> + <fsummary>Computes the function: N^P mod M</fsummary> <type> - <v>Key = Text = iolist() | binary()</v> - <v>Cipher = binary()</v> + <v>N, P, M = binary() | integer()</v> + <v>Result = binary() | error</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> + <p>Computes the function <c>N^P mod M</c>.</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> + <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>blowfish_cfb64_encrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>using Blowfish in CFB mode with 64 - bit feedback</fsummary> + <name>private_decrypt(Type, ChipherText, PrivateKey, Padding) -> PlainText</name> + <fsummary>Decrypts ChipherText using the private Key.</fsummary> <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> + <v>Type = rsa</v> + <v>ChipherText = binary()</v> + <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>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> + <p>Decrypts the <c>ChipherText</c>, encrypted with + <seealso marker="#public_encrypt-4">public_encrypt/4</seealso> (or equivalent function) + using the <c>PrivateKey</c>, and returns the + plaintext (message digest). This is a low level signature verification operation + used for instance by older versions of the SSL protocol. + See also <seealso marker="public_key:public_key#decrypt_private-2">public_key:decrypt_private/[2,3]</seealso> + </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> + <name>private_encrypt(Type, PlainText, PrivateKey, Padding) -> ChipherText</name> + <fsummary>Encrypts PlainText using the private Key.</fsummary> <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> + <v>Type = rsa</v> + <v>PlainText = binary()</v> + <d> The size of the <c>PlainText</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 N is public modulus of the RSA key.</d> + <v>PrivateKey = rsa_private()</v> + <v>Padding = rsa_pkcs1_padding | rsa_no_padding</v> + <v>ChipherText = 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> + <p>Encrypts the <c>PlainText</c> using the <c>PrivateKey</c> + and returns the ciphertext. This is a low level signature operation + used for instance by older versions of the SSL protocol. See + also <seealso + marker="public_key:public_key#encrypt_private-2">public_key:encrypt_private/[2,3]</seealso> + </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>public_decrypt(Type, ChipherText, PublicKey, Padding) -> PlainText</name> + <fsummary>Decrypts ChipherText using the public Key.</fsummary> <type> - <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> + <v>Type = rsa</v> + <v>ChipherText = binary()</v> + <v>PublicKey = rsa_public() </v> + <v>Padding = rsa_pkcs1_padding | rsa_no_padding</v> + <v>PlainText = 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>Decrypts the <c>ChipherText</c>, encrypted with + <seealso marker="#private_encrypt-4">private_encrypt/4</seealso>(or equivalent function) + using the <c>PrivateKey</c>, and returns the + plaintext (message digest). This is a low level signature verification operation + used for instance by older versions of the SSL protocol. + See also <seealso marker="public_key:public_key#decrypt_public-2">public_key:decrypt_public/[2,3]</seealso> + </p> </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> + <name>public_encrypt(Type, PlainText, PublicKey, Padding) -> ChipherText</name> + <fsummary>Encrypts PlainText using the public Key.</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> + <v>Type = rsa</v> + <v>PlainText = binary()</v> + <d> The size of the <c>PlainText</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 N is public modulus of the RSA key.</d> + <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>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> + <p>Encrypts the <c>PlainText</c> (message digest) using the <c>PublicKey</c> + and returns the <c>CipherText</c>. This is a low level signature operation + used for instance by older versions of the SSL protocol. See also <seealso + marker="public_key:public_key#encrypt_public-2">public_key:encrypt_public/[2,3]</seealso> + </p> </desc> </func> + <func> <name>rand_bytes(N) -> binary()</name> <fsummary>Generate a binary of random bytes</fsummary> @@ -920,527 +536,242 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> 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> + + <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> + <v>Lo, Hi, N = integer()</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> - <fsummary>Computes the function: N^P mod M</fsummary> - <type> - <v>N, P, M = binary()</v> - <v>Result = binary() | error</v> - </type> - <desc> - <p>Computes the function <c>N^P mod M</c>.</p> + <c>crypto</c> library pseudo-random number generator. + <c>Hi</c> must be larger than <c>Lo</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> + <name>sign(Algorithm, DigestType, Msg, Key) -> binary()</name> + <fsummary> Create digital signature.</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> + <v>Algorithm = rsa | dss | ecdsa </v> + <v>Msg = binary() | {digest,binary()}</v> + <d>The msg is either the binary "cleartext" data to be + signed or it is the hashed value of "cleartext" i.e. the + digest (plaintext).</d> + <v>DigestType = digest_type()</v> + <v>Key = rsa_private() | dss_private() | [ecdh_private(),ecdh_params()]</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> + <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>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> + <name>start() -> ok</name> + <fsummary> Equivalent to application:start(crypto). </fsummary> <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> + <p> Equivalent to application:start(crypto).</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> + <name>stop() -> ok</name> + <fsummary> Equivalent to application:stop(crypto).</fsummary> <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> + <p> Equivalent to application:stop(crypto).</p> </desc> </func> <func> - <name>rsa_private_decrypt(ChipherText, PrivateKey, Padding) -> PlainText</name> - <fsummary>Decrypts ChipherText using the private Key.</fsummary> + <name>strong_rand_bytes(N) -> binary()</name> + <fsummary>Generate a binary of random bytes</fsummary> <type> - <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>Padding = rsa_pkcs1_padding | rsa_pkcs1_oaep_padding | rsa_no_padding</v> - <v>PlainText = binary()</v> + <v>N = integer()</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>) - 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>. - </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>rsa_private_encrypt(PlainText, PrivateKey, Padding) -> ChipherText</name> - <fsummary>Encrypts Msg using the private Key.</fsummary> + <name>stream_init(Type, Key) -> State</name> + <fsummary></fsummary> <type> - <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>Padding = rsa_pkcs1_padding | rsa_no_padding</v> - <v>ChipherText = binary()</v> + <v>Type = rc4 </v> + <v>State = opaque() </v> + <v>Key = iodata()</v> </type> <desc> - <p>Encrypts the <c>PlainText</c> using the <c>PrivateKey</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. - 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>. - </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>rsa_public_decrypt(ChipherText, PublicKey, Padding) -> PlainText</name> - <fsummary>Decrypts ChipherText using the public Key.</fsummary> - <type> - <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>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>) - 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>. - </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> + <func> + <name>stream_init(Type, Key, IVec) -> State</name> + <fsummary></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 = aes_ctr </v> + <v>State = opaque() </v> + <v>Key = iodata()</v> + <v>IVec = 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>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>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>stream_encrypt(State, PlainText) -> { NewState, CipherText}</name> + <fsummary></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>Text = iodata()</v> + <v>CipherText = binary()</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>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>rc2_cbc_encrypt(Key, IVec, Text) -> Cipher</name> - <fsummary>Encrypt <c>Text</c>according to RC2 in CBC mode</fsummary> + <name>stream_decrypt(State, CipherText) -> { NewState, PlainText }</name> + <fsummary></fsummary> <type> - <v>Key = Text = iolist() | binary()</v> - <v>Ivec = Cipher = binary()</v> + <v>CipherText = iodata()</v> + <v>PlainText = binary()</v> </type> <desc> - <p>Encrypts <c>Text</c> according to RC2 in CBC mode.</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>rc2_cbc_decrypt(Key, IVec, Cipher) -> Text</name> - <fsummary>Decrypts <c>Cipher</c>according to RC2 in CBC mode</fsummary> + <func> + <name>supports() -> AlgorithmList </name> + <fsummary>Provide a list of available crypto algorithms.</fsummary> <type> - <v>Key = Text = iolist() | binary()</v> - <v>Ivec = Cipher = binary()</v> + <v> AlgorithmList = [{hashs, [hash_algorithms()]}, + {ciphers, [cipher_algorithms()]}, + {public_keys, [public_key_algorithms()]} + </v> </type> <desc> - <p>Decrypts <c>Cipher</c> according to RC2 in CBC mode.</p> + <p> Can be used to determine which crypto algorithms that are supported + by the underlying OpenSSL library</p> </desc> </func> + - <func> - <name>rc4_encrypt(Key, Data) -> Result</name> - <fsummary>Encrypt data using RC4</fsummary> - <type> - <v>Key, Data = iolist() | binary()</v> - <v>Result = binary()</v> - </type> - <desc> - <p>Encrypts the data with RC4 symmetric stream encryption. - Since it is symmetric, the same function is used for - decryption.</p> - </desc> - </func> + <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 "cleartext" data + or it is the hashed value of "cleartext" i.e. the digest (plaintext).</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> - <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> - <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> - </type> - <desc> - <p>Generates a Diffie-Hellman <c>PublicKey</c> and <c>PrivateKey</c> (if not given). - </p> + See also <seealso marker="public_key:public_key#verify-4">public_key:verify/4</seealso> </desc> </func> - <func> - <name>dh_compute_key(OthersPublicKey, MyPrivateKey, DHParams) -> SharedSecret</name> - <fsummary>Computes the shared secret</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> - </type> - <desc> - <p>Computes the shared secret from the private key and the other party's public key. - </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> - <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> - </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> - </desc> - </func> + </funcs> - <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> - <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> - </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> - </desc> - </func> - - <func> - <name>exor(Data1, Data2) -> Result</name> - <fsummary>XOR data</fsummary> - <type> - <v>Data1, Data2 = iolist() | binary()</v> - <v>Result = binary()</v> - </type> - <desc> - <p>Performs bit-wise XOR (exclusive or) on the data supplied.</p> - </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[ --> - <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> + <!-- 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/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index bd1f179f7d..09ecc97ef7 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -30,6 +30,65 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 3.0</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Integrate elliptic curve contribution from Andreas + Schultz </p> + <p> + In order to be able to support elliptic curve cipher + suites in SSL/TLS, additions to handle elliptic curve + infrastructure has been added to public_key and crypto.</p> + <p> + This also has resulted in a rewrite of the crypto API to + gain consistency and remove unnecessary overhead. All OTP + applications using crypto has been updated to use the new + API.</p> + <p> + Impact: Elliptic curve cryptography (ECC) offers + equivalent security with smaller key sizes than other + public key algorithms. Smaller key sizes result in + savings for power, memory, bandwidth, and computational + cost that make ECC especially attractive for constrained + environments.</p> + <p> + Own Id: OTP-11009</p> + </item> + <item> + <p> + Fixed a spelling mistake in crypto docs. Thanks to Klaus + Trainer</p> + <p> + Own Id: OTP-11058</p> + </item> + </list> + </section> + + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + Make the crypto functions interruptible by chunking input + when it is very large and bumping reductions in the nifs.</p> + <p> + Not yet implemented for block_encrypt|decrypt/4</p> + <p> + Impact: Individual calls to crypto functions may take + longer time but over all system performance should + improve as crypto calls will not become throughput + bottlenecks.</p> + <p> + Own Id: OTP-11142</p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 2.3</title> <section><title>Improvements and New Features</title> diff --git a/lib/crypto/src/crypto.appup.src b/lib/crypto/src/crypto.appup.src index b39ef734eb..5b4ce5acee 100644 --- a/lib/crypto/src/crypto.appup.src +++ b/lib/crypto/src/crypto.appup.src @@ -1,7 +1,8 @@ +%% -*- erlang -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-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 @@ -17,6 +18,11 @@ %% %CopyrightEnd% %% {"%VSN%", - [], - [] -}. + [ + {<<"2\\.*">>, [{restart_application, crypto}]} + {<<"1\\.*">>, [{restart_application, crypto}]} + ], + [ + {<<"2\\.*">>, [{restart_application, crypto}]} + {<<"1\\.*">>, [{restart_application, crypto}]} + ]}. diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 1d0a9943c3..8e8370f3b0 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -21,110 +21,600 @@ -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([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}). --export([dh_generate_parameters/2, dh_check/1]). %% Testing see below - +%% Replaced by crypto:module_info() +-export([info/0]). +-deprecated({info, 0, next_major_release}). --define(FUNC_LIST, [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, - 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, - rand_bytes, - strong_rand_bytes, - strong_rand_mpint, - rand_uniform, - mod_exp, mod_exp_prime, - 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, - 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]). +%% This should correspond to the similar macro in crypto.c +-define(MAX_BYTES_TO_NIF, 20000). %% Current value is: erlang:system_info(context_reductions) * 10 +-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}. + +-on_load(on_load/0). +-define(CRYPTO_NIF_VSN,201). -define(nif_stub,nif_stub_error(?LINE)). +nif_stub_error(Line) -> + erlang:nif_error({nif_not_loaded,module,?MODULE,line,Line}). --on_load(on_load/0). +%%-------------------------------------------------------------------- +%%% API +%%-------------------------------------------------------------------- +%% Crypto app version history: +%% (no version): Driver implementation +%% 2.0 : NIF implementation, requires OTP R14 +version() -> ?CRYPTO_VSN. + +start() -> + application:start(crypto). + +stop() -> + application:stop(crypto). + +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 + ]. + +info_lib() -> ?nif_stub. + +-spec hash(_, iodata()) -> binary(). + +hash(Hash, Data0) -> + Data = iolist_to_binary(Data0), + MaxByts = max_bytes(), + hash(Hash, Data, erlang:byte_size(Data), MaxByts, initial). + +-spec hash_init('md5'|'md4'|'ripemd160'| + 'sha'|'sha224'|'sha256'|'sha384'|'sha512') -> any(). + +hash_init(md5) -> {md5, md5_init()}; +hash_init(md4) -> {md4, md4_init()}; +hash_init(sha) -> {sha, sha_init()}; +hash_init(ripemd160) -> {ripemd160, ripemd160_init()}; +hash_init(sha224) -> {sha224, sha224_init()}; +hash_init(sha256) -> {sha256, sha256_init()}; +hash_init(sha384) -> {sha384, sha384_init()}; +hash_init(sha512) -> {sha512, sha512_init()}. + +-spec hash_update(_, iodata()) -> any(). + +hash_update(State, Data0) -> + Data = iolist_to_binary(Data0), + MaxBytes = max_bytes(), + hash_update(State, Data, erlang:byte_size(Data), MaxBytes). + +-spec hash_final(_) -> binary(). + +hash_final({md5,Context}) -> md5_final(Context); +hash_final({md4,Context}) -> md4_final(Context); +hash_final({sha,Context}) -> sha_final(Context); +hash_final({ripemd160,Context}) -> ripemd160_final(Context); +hash_final({sha224,Context}) -> sha224_final(Context); +hash_final({sha256,Context}) -> sha256_final(Context); +hash_final({sha384,Context}) -> sha384_final(Context); +hash_final({sha512,Context}) -> sha512_final(Context). + + +-spec hmac(_, iodata(), iodata()) -> binary(). +-spec hmac(_, iodata(), iodata(), integer()) -> binary(). +-spec hmac_init(atom(), iodata()) -> binary(). +-spec hmac_update(binary(), iodata()) -> binary(). +-spec hmac_final(binary()) -> binary(). +-spec hmac_final_n(binary(), integer()) -> binary(). + +hmac(Type, Key, Data0) -> + Data = iolist_to_binary(Data0), + hmac(Type, Key, Data, undefined, erlang:byte_size(Data), max_bytes(), initial). +hmac(Type, Key, Data0, MacSize) -> + Data = iolist_to_binary(Data0), + hmac(Type, Key, Data, MacSize, erlang:byte_size(Data), max_bytes(), initial). + + +hmac_init(_Type, _Key) -> ?nif_stub. + +hmac_update(State, Data0) -> + Data = iolist_to_binary(Data0), + hmac_update(State, Data, erlang:byte_size(Data), max_bytes()). +hmac_final(_Context) -> ? nif_stub. +hmac_final_n(_Context, _HashLen) -> ? 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(State, Data0) -> + Data = iolist_to_binary(Data0), + MaxByts = max_bytes(), + stream_crypt(fun do_stream_encrypt/2, State, Data, erlang:byte_size(Data), MaxByts, []). + +stream_decrypt(State, Data0) -> + Data = iolist_to_binary(Data0), + MaxByts = max_bytes(), + stream_crypt(fun do_stream_decrypt/2, State, Data, erlang:byte_size(Data), MaxByts, []). + +%% +%% RAND - pseudo random numbers using RN_ functions in crypto lib +%% +-spec rand_bytes(non_neg_integer()) -> binary(). +-spec strong_rand_bytes(non_neg_integer()) -> binary(). +-spec rand_uniform(crypto_integer(), crypto_integer()) -> + crypto_integer(). + +rand_bytes(_Bytes) -> ?nif_stub. + +strong_rand_bytes(Bytes) -> + case strong_rand_bytes_nif(Bytes) of + false -> erlang:error(low_entropy); + Bin -> Bin + end. +strong_rand_bytes_nif(_Bytes) -> ?nif_stub. + +rand_bytes(_Bytes, _Topmask, _Bottommask) -> ?nif_stub. + + +rand_uniform(From,To) when is_binary(From), is_binary(To) -> + case rand_uniform_nif(From,To) of + <<Len:32/integer, MSB, Rest/binary>> when MSB > 127 -> + <<(Len + 1):32/integer, 0, MSB, Rest/binary>>; + Whatever -> + Whatever + end; +rand_uniform(From,To) when is_integer(From),is_integer(To) -> + if From < 0 -> + rand_uniform_pos(0, To - From) + From; + true -> + rand_uniform_pos(From, To) + end. + +rand_uniform_pos(From,To) when From < To -> + BinFrom = mpint(From), + BinTo = mpint(To), + case rand_uniform(BinFrom, BinTo) of + Result when is_binary(Result) -> + erlint(Result); + Other -> + Other + end; +rand_uniform_pos(_,_) -> + error(badarg). + +rand_uniform_nif(_From,_To) -> ?nif_stub. + + +-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. +verify(dss, none, Data, Signature, Key) when is_binary(Data) -> + verify(dss, sha, {digest, Data}, Signature, Key); +verify(Alg, Type, Data, Signature, Key) when is_binary(Data) -> + verify(Alg, Type, {digest, hash(Type, Data)}, Signature, 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, nif_curve_params(Curve), ensure_int_as_bin(Key)) of + notsup -> erlang:error(notsup); + Bool -> Bool + end. +sign(dss, none, Data, Key) when is_binary(Data) -> + sign(dss, sha, {digest, Data}, Key); +sign(Alg, Type, Data, Key) when is_binary(Data) -> + sign(Alg, Type, {digest, hash(Type, Data)}, Key); +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, nif_curve_params(Curve), ensure_int_as_bin(Key)) of + error -> erlang:error(badkey, [Type,DataOrDigest,Key]); + Sign -> Sign + end. + +-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. + +%% +%% XOR - xor to iolists and return a binary +%% NB doesn't check that they are the same size, just concatenates +%% them and sends them to the driver +%% +-spec exor(iodata(), iodata()) -> binary(). + +exor(Bin1, Bin2) -> + Data1 = iolist_to_binary(Bin1), + Data2 = iolist_to_binary(Bin2), + MaxBytes = max_bytes(), + exor(Data1, Data2, erlang:byte_size(Data1), MaxBytes, []). + +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); + +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_generate(Curve). + + +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_atom(Version) -> + HostPubBin = ensure_int_as_bin(HostPublic), + Multiplier = srp_multiplier(Version, Generator, Prime), + 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_atom(Version) -> + 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), + nif_curve_params(Curve), + ensure_int_as_bin(My)). --define(CRYPTO_NIF_VSN,201). + +random_bytes(N) -> + try strong_rand_bytes(N) of + RandBytes -> + RandBytes + catch + error:low_entropy -> + rand_bytes(N) + end. + +%%-------------------------------------------------------------------- +%%% On load +%%-------------------------------------------------------------------- on_load() -> LibBaseName = "crypto", @@ -142,7 +632,7 @@ on_load() -> (filelib:wildcard( filename:join( [PrivDir, - "lib", + "lib", erlang:system_info(system_architecture), LibTypeName ++ "*"])) /= []) of true -> LibTypeName; @@ -153,8 +643,8 @@ on_load() -> Status = case erlang:load_nif(Lib, {?CRYPTO_NIF_VSN,Lib}) of ok -> ok; {error, {load_failed, _}}=Error1 -> - ArchLibDir = - filename:join([PrivDir, "lib", + ArchLibDir = + filename:join([PrivDir, "lib", erlang:system_info(system_architecture)]), Candidate = filelib:wildcard(filename:join([ArchLibDir,LibName ++ "*" ])), @@ -173,78 +663,53 @@ on_load() -> "OpenSSL might not be installed on this system.~n",[E,Str]), Status end. +%%-------------------------------------------------------------------- +%%% Internal functions (some internal API functions are part of the deprecated API) +%%-------------------------------------------------------------------- +max_bytes() -> + ?MAX_BYTES_TO_NIF. + +%% HASH -------------------------------------------------------------------- +hash(Hash, Data, Size, Max, initial) when Size =< Max -> + do_hash(Hash, Data); +hash(State0, Data, Size, Max, continue) when Size =< Max -> + State = do_hash_update(State0, Data), + hash_final(State); +hash(Hash, Data, _Size, Max, initial) -> + <<Increment:Max/binary, Rest/binary>> = Data, + State0 = hash_init(Hash), + State = do_hash_update(State0, Increment), + hash(State, Rest, erlang:byte_size(Rest), max_bytes(), continue); +hash(State0, Data, _Size, MaxByts, continue) -> + <<Increment:MaxByts/binary, Rest/binary>> = Data, + State = do_hash_update(State0, Increment), + hash(State, Rest, erlang:byte_size(Rest), max_bytes(), continue). + +do_hash(md5, Data) -> md5(Data); +do_hash(md4, Data) -> md4(Data); +do_hash(sha, Data) -> sha(Data); +do_hash(ripemd160, Data) -> ripemd160(Data); +do_hash(sha224, Data) -> sha224(Data); +do_hash(sha256, Data) -> sha256(Data); +do_hash(sha384, Data) -> sha384(Data); +do_hash(sha512, Data) -> sha512(Data). + +hash_update(State, Data, Size, MaxBytes) when Size =< MaxBytes -> + do_hash_update(State, Data); +hash_update(State0, Data, _, MaxBytes) -> + <<Increment:MaxBytes/binary, Rest/binary>> = Data, + State = do_hash_update(State0, Increment), + hash_update(State, Rest, erlang:byte_size(Rest), MaxBytes). + +do_hash_update({md5,Context}, Data) -> {md5, md5_update(Context,Data)}; +do_hash_update({md4,Context}, Data) -> {md4, md4_update(Context,Data)}; +do_hash_update({sha,Context}, Data) -> {sha, sha_update(Context,Data)}; +do_hash_update({ripemd160,Context}, Data) -> {ripemd160, ripemd160_update(Context,Data)}; +do_hash_update({sha224,Context}, Data) -> {sha224, sha224_update(Context,Data)}; +do_hash_update({sha256,Context}, Data) -> {sha256, sha256_update(Context,Data)}; +do_hash_update({sha384,Context}, Data) -> {sha384, sha384_update(Context,Data)}; +do_hash_update({sha512,Context}, Data) -> {sha512, sha512_update(Context,Data)}. -nif_stub_error(Line) -> - erlang:nif_error({nif_not_loaded,module,?MODULE,line,Line}). - -start() -> - application:start(crypto). - -stop() -> - application:stop(crypto). - -info() -> - ?FUNC_LIST. - -info_lib() -> ?nif_stub. - -algorithms() -> ?nif_stub. - -%% Crypto app version history: -%% (no version): Driver implementation -%% 2.0 : NIF implementation, requires OTP R14 -version() -> ?CRYPTO_VSN. - -%% Below Key and Data are binaries or IO-lists. IVec is a binary. -%% Output is always a binary. Context is a binary. - -%% -%% MESSAGE DIGESTS -%% - --spec hash(_, iodata()) -> binary(). -hash(md5, Data) -> md5(Data); -hash(md4, Data) -> md4(Data); -hash(sha, Data) -> sha(Data); -hash(ripemd160, Data) -> ripemd160(Data); -hash(sha224, Data) -> sha224(Data); -hash(sha256, Data) -> sha256(Data); -hash(sha384, Data) -> sha384(Data); -hash(sha512, Data) -> sha512(Data). - --spec hash_init('md5'|'md4'|'ripemd160'| - 'sha'|'sha224'|'sha256'|'sha384'|'sha512') -> any(). - -hash_init(md5) -> {md5, md5_init()}; -hash_init(md4) -> {md4, md4_init()}; -hash_init(sha) -> {sha, sha_init()}; -hash_init(ripemd160) -> {ripemd160, ripemd160_init()}; -hash_init(sha224) -> {sha224, sha224_init()}; -hash_init(sha256) -> {sha256, sha256_init()}; -hash_init(sha384) -> {sha384, sha384_init()}; -hash_init(sha512) -> {sha512, sha512_init()}. - --spec hash_update(_, iodata()) -> any(). - -hash_update({md5,Context}, Data) -> {md5, md5_update(Context,Data)}; -hash_update({md4,Context}, Data) -> {md4, md4_update(Context,Data)}; -hash_update({sha,Context}, Data) -> {sha, sha_update(Context,Data)}; -hash_update({ripemd160,Context}, Data) -> {ripemd160, ripemd160_update(Context,Data)}; -hash_update({sha224,Context}, Data) -> {sha224, sha224_update(Context,Data)}; -hash_update({sha256,Context}, Data) -> {sha256, sha256_update(Context,Data)}; -hash_update({sha384,Context}, Data) -> {sha384, sha384_update(Context,Data)}; -hash_update({sha512,Context}, Data) -> {sha512, sha512_update(Context,Data)}. - --spec hash_final(_) -> binary(). - -hash_final({md5,Context}) -> md5_final(Context); -hash_final({md4,Context}) -> md4_final(Context); -hash_final({sha,Context}) -> sha_final(Context); -hash_final({ripemd160,Context}) -> ripemd160_final(Context); -hash_final({sha224,Context}) -> sha224_final(Context); -hash_final({sha256,Context}) -> sha256_final(Context); -hash_final({sha384,Context}) -> sha384_final(Context); -hash_final({sha512,Context}) -> sha512_final(Context). %% %% MD5 @@ -436,40 +901,56 @@ sha512_init_nif() -> ?nif_stub. sha512_update_nif(_Context, _Data) -> ?nif_stub. sha512_final_nif(_Context) -> ?nif_stub. -%% -%% MESSAGE AUTHENTICATION CODES -%% +%% HMAC -------------------------------------------------------------------- -%% -%% HMAC (multiple hash options) -%% - --spec hmac(_, iodata(), iodata()) -> binary(). --spec hmac(_, iodata(), iodata(), integer()) -> binary(). --spec hmac_init(atom(), iodata()) -> binary(). --spec hmac_update(binary(), iodata()) -> binary(). --spec hmac_final(binary()) -> binary(). --spec hmac_final_n(binary(), integer()) -> binary(). - -hmac(md5, Key, Data) -> md5_mac(Key, Data); -hmac(sha, Key, Data) -> sha_mac(Key, Data); -hmac(sha224, Key, Data) -> sha224_mac(Key, Data); -hmac(sha256, Key, Data) -> sha256_mac(Key, Data); -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(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); -hmac(sha512, Key, Data, Size) -> sha512_mac(Key, Data, Size). +hmac(Type, Key, Data, MacSize, Size, MaxBytes, initial) when Size =< MaxBytes -> + case MacSize of + undefined -> + do_hmac(Type, Key, Data); + _ -> + do_hmac(Type, Key, Data, MacSize) + end; +hmac(Type, Key, Data, MacSize, _, MaxBytes, initial) -> + <<Increment:MaxBytes/binary, Rest/binary>> = Data, + State0 = hmac_init(Type, Key), + State = hmac_update(State0, Increment), + hmac(State, Rest, MacSize, erlang:byte_size(Rest), max_bytes(), continue). +hmac(State0, Data, MacSize, Size, MaxBytes, continue) when Size =< MaxBytes -> + State = hmac_update(State0, Data), + case MacSize of + undefined -> + hmac_final(State); + _ -> + hmac_final_n(State, MacSize) + end; +hmac(State0, Data, MacSize, _Size, MaxBytes, continue) -> + <<Increment:MaxBytes/binary, Rest/binary>> = Data, + State = hmac_update(State0, Increment), + hmac(State, Rest, MacSize, erlang:byte_size(Rest), max_bytes(), continue). + +hmac_update(State, Data, Size, MaxBytes) when Size =< MaxBytes -> + do_hmac_update(State, Data); +hmac_update(State0, Data, _, MaxBytes) -> + <<Increment:MaxBytes/binary, Rest/binary>> = Data, + State = do_hmac_update(State0, Increment), + hmac_update(State, Rest, erlang:byte_size(Rest), MaxBytes). + +do_hmac(md5, Key, Data) -> md5_mac(Key, Data); +do_hmac(sha, Key, Data) -> sha_mac(Key, Data); +do_hmac(sha224, Key, Data) -> sha224_mac(Key, Data); +do_hmac(sha256, Key, Data) -> sha256_mac(Key, Data); +do_hmac(sha384, Key, Data) -> sha384_mac(Key, Data); +do_hmac(sha512, Key, Data) -> sha512_mac(Key, Data). + +do_hmac(md5, Key, Data, Size) -> md5_mac_n(Key, Data, Size); +do_hmac(sha, Key, Data, Size) -> sha_mac_n(Key, Data, Size); +do_hmac(sha224, Key, Data, Size) -> sha224_mac(Key, Data, Size); +do_hmac(sha256, Key, Data, Size) -> sha256_mac(Key, Data, Size); +do_hmac(sha384, Key, Data, Size) -> sha384_mac(Key, Data, Size); +do_hmac(sha512, Key, Data, Size) -> sha512_mac(Key, Data, Size). + +do_hmac_update(_Context, _Data) -> ? nif_stub. -hmac_init(_Type, _Key) -> ?nif_stub. -hmac_update(_Context, _Data) -> ? nif_stub. -hmac_final(_Context) -> ? nif_stub. -hmac_final_n(_Context, _HashLen) -> ? nif_stub. - %% %% MD5_MAC %% @@ -565,64 +1046,7 @@ sha512_mac(Key, Data, MacSz) -> sha512_mac_nif(_Key,_Data,_MacSz) -> ?nif_stub. -%% -%% CRYPTO FUNCTIONS -%% - -%% -%% DES - in cipher block chaining mode (CBC) -%% --spec des_cbc_encrypt(iodata(), binary(), iodata()) -> binary(). --spec des_cbc_decrypt(iodata(), binary(), iodata()) -> binary(). - -des_cbc_encrypt(Key, IVec, Data) -> - des_cbc_crypt(Key, IVec, Data, true). - -des_cbc_decrypt(Key, IVec, Data) -> - des_cbc_crypt(Key, IVec, Data, false). - -des_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. - -%% -%% dec_cbc_ivec(Data) -> binary() -%% -%% Returns the IVec to be used in the next iteration of -%% des_cbc_[encrypt|decrypt]. -%% --spec des_cbc_ivec(iodata()) -> binary(). - -des_cbc_ivec(Data) when is_binary(Data) -> - {_, IVec} = split_binary(Data, size(Data) - 8), - IVec; -des_cbc_ivec(Data) when is_list(Data) -> - des_cbc_ivec(list_to_binary(Data)). - -%% -%% DES - in 8-bits cipher feedback mode (CFB) -%% --spec des_cfb_encrypt(iodata(), binary(), iodata()) -> binary(). --spec des_cfb_decrypt(iodata(), binary(), iodata()) -> binary(). - -des_cfb_encrypt(Key, IVec, Data) -> - des_cfb_crypt(Key, IVec, Data, true). - -des_cfb_decrypt(Key, IVec, Data) -> - des_cfb_crypt(Key, IVec, Data, false). - -des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. - -%% -%% dec_cfb_ivec(IVec, Data) -> binary() -%% -%% Returns the IVec to be used in the next iteration of -%% des_cfb_[encrypt|decrypt]. -%% --spec des_cfb_ivec(iodata(), iodata()) -> binary(). - -des_cfb_ivec(IVec, Data) -> - IVecAndData = list_to_binary([IVec, Data]), - {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8), - NewIVec. +%% CIPHERS -------------------------------------------------------------------- %% %% DES - in electronic codebook mode (ECB) @@ -713,8 +1137,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) %% @@ -730,192 +1158,63 @@ aes_cfb_128_decrypt(Key, IVec, Data) -> aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. -%% -%% RAND - pseudo random numbers using RN_ functions in crypto lib %% --spec rand_bytes(non_neg_integer()) -> binary(). --spec strong_rand_bytes(non_neg_integer()) -> binary(). --spec rand_uniform(crypto_integer(), crypto_integer()) -> - crypto_integer(). --spec strong_rand_mpint(Bits::non_neg_integer(), - Top::-1..1, - Bottom::0..1) -> binary(). - -rand_bytes(_Bytes) -> ?nif_stub. - -strong_rand_bytes(Bytes) -> - case strong_rand_bytes_nif(Bytes) of - false -> erlang:error(low_entropy); - Bin -> Bin - end. -strong_rand_bytes_nif(_Bytes) -> ?nif_stub. - -rand_bytes(_Bytes, _Topmask, _Bottommask) -> ?nif_stub. - -strong_rand_mpint(Bits, Top, Bottom) -> - case strong_rand_mpint_nif(Bits,Top,Bottom) of - false -> erlang:error(low_entropy); - Bin -> Bin - end. -strong_rand_mpint_nif(_Bits, _Top, _Bottom) -> ?nif_stub. - +%% DES - in cipher block chaining mode (CBC) +%% +-spec des_cbc_encrypt(iodata(), binary(), iodata()) -> binary(). +-spec des_cbc_decrypt(iodata(), binary(), iodata()) -> binary(). -rand_uniform(From,To) when is_binary(From), is_binary(To) -> - case rand_uniform_nif(From,To) of - <<Len:32/integer, MSB, Rest/binary>> when MSB > 127 -> - <<(Len + 1):32/integer, 0, MSB, Rest/binary>>; - Whatever -> - Whatever - end; -rand_uniform(From,To) when is_integer(From),is_integer(To) -> - if From < 0 -> - rand_uniform_pos(0, To - From) + From; - true -> - rand_uniform_pos(From, To) - end. +des_cbc_encrypt(Key, IVec, Data) -> + des_cbc_crypt(Key, IVec, Data, true). -rand_uniform_pos(From,To) when From < To -> - BinFrom = mpint(From), - BinTo = mpint(To), - case rand_uniform(BinFrom, BinTo) of - Result when is_binary(Result) -> - erlint(Result); - Other -> - Other - end; -rand_uniform_pos(_,_) -> - error(badarg). +des_cbc_decrypt(Key, IVec, Data) -> + des_cbc_crypt(Key, IVec, Data, false). -rand_uniform_nif(_From,_To) -> ?nif_stub. +des_cbc_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% -%% mod_exp - utility for rsa generation and SRP +%% dec_cbc_ivec(Data) -> binary() %% -mod_exp(Base, Exponent, Modulo) - when is_integer(Base), is_integer(Exponent), is_integer(Modulo) -> - bin_to_int(mod_exp_nif(int_to_bin(Base), int_to_bin(Exponent), int_to_bin(Modulo), 0)); - -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 - <<0>> -> error; - R -> R - end. - +%% Returns the IVec to be used in the next iteration of +%% des_cbc_[encrypt|decrypt]. +%% +-spec des_cbc_ivec(iodata()) -> binary(). -mod_exp_nif(_Base,_Exp,_Mod,_bin_hdr) -> ?nif_stub. +des_cbc_ivec(Data) when is_binary(Data) -> + {_, IVec} = split_binary(Data, size(Data) - 8), + IVec; +des_cbc_ivec(Data) when is_list(Data) -> + des_cbc_ivec(list_to_binary(Data)). %% -%% DSS, RSA - verify +%% DES - in 8-bits cipher feedback mode (CFB) %% --spec dss_verify(data_or_digest(), binary(), [binary()]) -> boolean(). --spec dss_verify(dss_digest_type(), data_or_digest(), binary(), [binary()]) -> boolean(). --spec rsa_verify(data_or_digest(), binary(), [binary()]) -> boolean(). --spec rsa_verify(rsa_digest_type(), data_or_digest(), binary(), [binary()]) -> - boolean(). - -%% 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. +-spec des_cfb_encrypt(iodata(), binary(), iodata()) -> binary(). +-spec des_cfb_decrypt(iodata(), binary(), iodata()) -> binary(). -% 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 - notsup -> erlang:error(notsup); - Bool -> Bool - end. +des_cfb_encrypt(Key, IVec, Data) -> + des_cfb_crypt(Key, IVec, Data, true). -rsa_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub. +des_cfb_decrypt(Key, IVec, Data) -> + des_cfb_crypt(Key, IVec, Data, false). +des_cfb_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% -%% DSS, RSA - sign +%% dec_cfb_ivec(IVec, Data) -> binary() %% -%% Key = [P,Q,G,X] P,Q,G=DSSParams X=PrivateKey --spec dss_sign(data_or_digest(), [binary()]) -> binary(). --spec dss_sign(dss_digest_type(), data_or_digest(), [binary()]) -> binary(). --spec rsa_sign(data_or_digest(), [binary()]) -> binary(). --spec rsa_sign(rsa_digest_type(), data_or_digest(), [binary()]) -> binary(). - -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_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 - error -> erlang:error(badkey, [Type,DataOrDigest,Key]); - Sign -> Sign - end. - -rsa_sign_nif(_Type,_Data,_Key) -> ?nif_stub. - - +%% Returns the IVec to be used in the next iteration of +%% des_cfb_[encrypt|decrypt]. %% -%% rsa_public_encrypt -%% rsa_private_decrypt --type rsa_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | 'rsa_no_padding'. --spec rsa_public_encrypt(binary(), [binary()], rsa_padding()) -> - binary(). --spec rsa_public_decrypt(binary(), [binary()], rsa_padding()) -> - binary(). --spec rsa_private_encrypt(binary(), [binary()], rsa_padding()) -> - binary(). --spec rsa_private_decrypt(binary(), [binary()], rsa_padding()) -> - binary(). - -%% Binary, Key = [E,N] -rsa_public_encrypt(BinMesg, Key, Padding) -> - case rsa_public_crypt(BinMesg, Key, Padding, true) of - error -> - erlang:error(encrypt_failed, [BinMesg,Key, Padding]); - Sign -> Sign - end. - -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 - error -> - erlang:error(decrypt_failed, [BinMesg,Key, Padding]); - Sign -> Sign - end. +-spec des_cfb_ivec(iodata(), iodata()) -> binary(). -rsa_private_crypt(_BinMsg, _Key, _Padding, _IsEncrypt) -> ?nif_stub. +des_cfb_ivec(IVec, Data) -> + IVecAndData = list_to_binary([IVec, Data]), + {_, NewIVec} = split_binary(IVecAndData, byte_size(IVecAndData) - 8), + NewIVec. - -%% Binary, Key = [E,N,D] -rsa_private_encrypt(BinMesg, Key, Padding) -> - case rsa_private_crypt(BinMesg, Key, Padding, true) of - error -> - erlang:error(encrypt_failed, [BinMesg,Key, Padding]); - Sign -> Sign - end. -%% Binary, Key = [E,N] -rsa_public_decrypt(BinMesg, Key, Padding) -> - case rsa_public_crypt(BinMesg, Key, Padding, false) of - error -> - erlang:error(decrypt_failed, [BinMesg,Key, Padding]); - Sign -> Sign - end. - %% %% AES - with 128 or 256 bit key in cipher block chaining mode (CBC) %% @@ -955,6 +1254,33 @@ aes_cbc_ivec(Data) when is_binary(Data) -> aes_cbc_ivec(Data) when is_list(Data) -> aes_cbc_ivec(list_to_binary(Data)). + +%% Stream ciphers -------------------------------------------------------------------- + +stream_crypt(Fun, State, Data, Size, MaxByts, []) when Size =< MaxByts -> + Fun(State, Data); +stream_crypt(Fun, State0, Data, Size, MaxByts, Acc) when Size =< MaxByts -> + {State, Cipher} = Fun(State0, Data), + {State, list_to_binary(lists:reverse([Cipher | Acc]))}; +stream_crypt(Fun, State0, Data, _, MaxByts, Acc) -> + <<Increment:MaxByts/binary, Rest/binary>> = Data, + {State, CipherText} = Fun(State0, Increment), + stream_crypt(Fun, State, Rest, erlang:byte_size(Rest), MaxByts, [CipherText | Acc]). + +do_stream_encrypt({aes_ctr, State0}, Data) -> + {State, Cipher} = aes_ctr_stream_encrypt(State0, Data), + {{aes_ctr, State}, Cipher}; +do_stream_encrypt({rc4, State0}, Data) -> + {State, Cipher} = rc4_encrypt_with_state(State0, Data), + {{rc4, State}, Cipher}. + +do_stream_decrypt({aes_ctr, State0}, Data) -> + {State, Text} = aes_ctr_stream_decrypt(State0, Data), + {{aes_ctr, State}, Text}; +do_stream_decrypt({rc4, State0}, Data) -> + {State, Text} = rc4_encrypt_with_state(State0, Data), + {{rc4, State}, Text}. + %% %% AES - in counter mode (CTR) %% @@ -962,7 +1288,7 @@ aes_cbc_ivec(Data) when is_list(Data) -> binary(). -spec aes_ctr_decrypt(iodata(), binary(), iodata()) -> binary(). - + aes_ctr_encrypt(_Key, _IVec, _Data) -> ?nif_stub. aes_ctr_decrypt(_Key, _IVec, _Cipher) -> ?nif_stub. @@ -983,15 +1309,6 @@ aes_ctr_stream_encrypt({_Key, _IVec, _ECount, _Num}=_State, _Data) -> ?nif_stub. aes_ctr_stream_decrypt({_Key, _IVec, _ECount, _Num}=_State, _Cipher) -> ?nif_stub. %% -%% XOR - xor to iolists and return a binary -%% NB doesn't check that they are the same size, just concatenates -%% them and sends them to the driver -%% --spec exor(iodata(), iodata()) -> binary(). - -exor(_A, _B) -> ?nif_stub. - -%% %% RC4 - symmetric stream cipher %% -spec rc4_encrypt(iodata(), iodata()) -> binary(). @@ -1020,7 +1337,76 @@ rc2_40_cbc_encrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 -> rc2_40_cbc_decrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 -> rc2_cbc_crypt(Key,IVec,Data,false). -%% + +%% Secure remote password ------------------------------------------------------------------- + +user_srp_gen_key(Private, Generator, Prime) -> + case mod_pow(Generator, Private, Prime) of + error -> + error; + Public -> + {Public, Private} + end. + +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 -> + error; + Public -> + {Public, Private} + end. + +srp_multiplier('6a', Generator, Prime) -> + %% k = SHA1(N | PAD(g)) from http://srp.stanford.edu/design.html + C0 = sha_init(), + C1 = sha_update(C0, Prime), + C2 = sha_update(C1, srp_pad_to(erlang:byte_size(Prime), Generator)), + sha_final(C2); +srp_multiplier('6', _, _) -> + <<3/integer>>; +srp_multiplier('3', _, _) -> + <<1/integer>>. + +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, UserPublic)), + C2 = sha_update(C1, srp_pad_to(PadLength, HostPublic)), + sha_final(C2); +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(HostPublic), + U. + +srp_pad_length(Width, Length) -> + (Width - Length rem Width) rem Width. + +srp_pad_to(Width, Binary) -> + case srp_pad_length(Width, size(Binary)) of + 0 -> Binary; + N -> << 0:(N*8), Binary/binary>> + end. + +srp_host_secret_nif(_Verifier, _B, _U, _A, _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. + + +%% Digital signatures -------------------------------------------------------------------- +rsa_sign_nif(_Type,_Data,_Key) -> ?nif_stub. +dss_sign_nif(_Type,_Data,_Key) -> ?nif_stub. +ecdsa_sign_nif(_Type, _DataOrDigest, _Curve, _Key) -> ?nif_stub. + +dss_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub. +rsa_verify_nif(_Type, _Data, _Signature, _Key) -> ?nif_stub. +ecdsa_verify_nif(_Type, _DataOrDigest, _Signature, _Curve, _Key) -> ?nif_stub. + +%% Public Keys -------------------------------------------------------------------- %% DH Diffie-Hellman functions %% @@ -1052,166 +1438,219 @@ 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. +ec_key_generate(_Key) -> ?nif_stub. -%%% 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), - is_binary(Generator), - is_binary(ClientPublic), - is_binary(ClientPrivate), - is_binary(ServerPublic), - is_atom(Version) -> - Multiplier = srp_multiplier(Version, Generator, Prime), - Scrambler = srp_scrambler(Version, ClientPublic, ServerPublic, Prime), - srp_client_secret_nif(ClientPrivate, Scrambler, ServerPublic, Multiplier, - Generator, DerivedKey, Prime); +ecdh_compute_key_nif(_Others, _Curve, _My) -> ?nif_stub. -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). +%% +%% EC +%% --spec srp_compute_key(binary(), binary(), binary(), binary(), binary(), atom()) -> binary(). -srp_compute_key(Verifier, Prime, ClientPublic, ServerPublic, ServerPrivate, Version) when - is_binary(Verifier), - is_binary(Prime), - is_binary(ClientPublic), - is_binary(ServerPublic), - is_binary(ServerPrivate), - is_atom(Version) -> - Scrambler = srp_scrambler(Version, ClientPublic, ServerPublic, Prime), - srp_server_secret_nif(Verifier, ServerPrivate, Scrambler, ClientPublic, Prime). +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}. +nif_curve_params({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)}; +nif_curve_params(Curve) when is_atom(Curve) -> + %% named curve + Curve. + +%% MISC -------------------------------------------------------------------- + +exor(Data1, Data2, Size, MaxByts, []) when Size =< MaxByts -> + do_exor(Data1, Data2); +exor(Data1, Data2, Size, MaxByts, Acc) when Size =< MaxByts -> + Result = do_exor(Data1, Data2), + list_to_binary(lists:reverse([Result | Acc])); +exor(Data1, Data2, _Size, MaxByts, Acc) -> + <<Increment1:MaxByts/binary, Rest1/binary>> = Data1, + <<Increment2:MaxByts/binary, Rest2/binary>> = Data2, + Result = do_exor(Increment1, Increment2), + exor(Rest1, Rest2, erlang:byte_size(Rest1), MaxByts, [Result | Acc]). + +do_exor(_A, _B) -> ?nif_stub. + +algorithms() -> ?nif_stub. + +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]). + +bytes_to_integer(Bin) -> + bin_to_int(Bin). + +bin_to_int(Bin) when is_binary(Bin) -> + Bits = bit_size(Bin), + <<Integer:Bits/integer>> = Bin, + Integer; +bin_to_int(undefined) -> + undefined. + +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). + +%%-------------------------------------------------------------------- +%%% Deprecated +%%-------------------------------------------------------------------- %% -%% LOCAL FUNCTIONS -%% +%% rsa_public_encrypt +%% rsa_private_decrypt +-type rsa_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | 'rsa_no_padding'. -client_srp_gen_key(Private, Generator, Prime) -> - case mod_exp_prime(Generator, Private, Prime) of +-spec rsa_public_encrypt(binary(), [binary()], rsa_padding()) -> + binary(). +-spec rsa_public_decrypt(binary(), [integer() | mpint()], rsa_padding()) -> + binary(). +-spec rsa_private_encrypt(binary(), [integer() | mpint()], rsa_padding()) -> + binary(). +-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, map_to_norm_bin(Key), Padding, true) of error -> - error; - Public -> - {Public, Private} + erlang:error(encrypt_failed, [BinMesg,Key, Padding]); + Sign -> Sign end. -server_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 -> - error; - Public -> - {Public, Private} - end. +rsa_public_crypt(_BinMsg, _Key, _Padding, _IsEncrypt) -> ?nif_stub. -srp_multiplier('6a', Generator, Prime) -> - %% k = SHA1(N | PAD(g)) from http://srp.stanford.edu/design.html - C0 = sha_init(), - C1 = sha_update(C0, Prime), - C2 = sha_update(C1, srp_pad_to(erlang:byte_size(Prime), Generator)), - sha_final(C2); -srp_multiplier('6', _, _) -> - <<3/integer>>; -srp_multiplier('3', _, _) -> - <<1/integer>>. +%% Binary, Key = [E,N,D] +rsa_private_decrypt(BinMesg, Key, Padding) -> + case rsa_private_crypt(BinMesg, map_to_norm_bin(Key), Padding, false) of + error -> + erlang:error(decrypt_failed, [BinMesg,Key, Padding]); + Sign -> Sign + end. -srp_scrambler(Version, ClientPublic, ServerPublic, 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)), - sha_final(C2); -srp_scrambler('3', _, ServerPublic, _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. +rsa_private_crypt(_BinMsg, _Key, _Padding, _IsEncrypt) -> ?nif_stub. -srp_pad_length(Width, Length) -> - (Width - Length rem Width) rem Width. -srp_pad_to(Width, Binary) -> - case srp_pad_length(Width, size(Binary)) of - 0 -> Binary; - N -> << 0:(N*8), Binary/binary>> +%% Binary, Key = [E,N,D] +rsa_private_encrypt(BinMesg, Key, Padding) -> + case rsa_private_crypt(BinMesg, map_to_norm_bin(Key), Padding, true) of + error -> + erlang:error(encrypt_failed, [BinMesg,Key, Padding]); + Sign -> Sign end. -srp_server_secret_nif(_Verifier, _B, _U, _A, _Prime) -> ?nif_stub. +%% Binary, Key = [E,N] +rsa_public_decrypt(BinMesg, Key, Padding) -> + case rsa_public_crypt(BinMesg, map_to_norm_bin(Key), Padding, false) of + error -> + erlang:error(decrypt_failed, [BinMesg,Key, Padding]); + Sign -> Sign + end. -srp_client_secret_nif(_A, _U, _B, _Multiplier, _Generator, _Exponent, _Prime) -> ?nif_stub. +map_mpint_to_bin(List) -> + lists:map(fun(E) -> mpint_to_bin(E) end, List ). + +%% +%% DSS, RSA - sign +%% +%% Key = [P,Q,G,X] P,Q,G=DSSParams X=PrivateKey +-spec dss_sign(data_or_digest(), [binary()]) -> binary(). +-spec dss_sign(dss_digest_type(), data_or_digest(), [binary()]) -> binary(). +-spec rsa_sign(data_or_digest(), [binary()]) -> binary(). +-spec rsa_sign(rsa_digest_type(), data_or_digest(), [binary()]) -> binary(). + +dss_sign(DataOrDigest,Key) -> + dss_sign(sha,DataOrDigest,Key). +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)). + + +%% Key = [E,N,D] E=PublicExponent N=PublicModulus D=PrivateExponent +rsa_sign(DataOrDigest,Key) -> + rsa_sign(sha, DataOrDigest, Key). + +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)). + +%% +%% DSS, RSA - verify +%% +-spec dss_verify(data_or_digest(), binary(), [binary()]) -> boolean(). +-spec dss_verify(dss_digest_type(), data_or_digest(), binary(), [binary()]) -> boolean(). +-spec rsa_verify(data_or_digest(), binary(), [binary()]) -> boolean(). +-spec rsa_verify(rsa_digest_type(), data_or_digest(), binary(), [binary()]) -> + boolean(). + +%% 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) 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(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)). + +-spec strong_rand_mpint(Bits::non_neg_integer(), + Top::-1..1, + Bottom::0..1) -> binary(). + +strong_rand_mpint(Bits, Top, Bottom) -> + case strong_rand_mpint_nif(Bits,Top,Bottom) of + false -> erlang:error(low_entropy); + Bin -> Bin + end. +strong_rand_mpint_nif(_Bits, _Top, _Bottom) -> ?nif_stub. -srp_value_B_nif(_Multiplier, _Verifier, _Generator, _Exponent, _Prime) -> ?nif_stub. %% large integer in a binary with 32bit length %% MP representaion (SSH2) @@ -1236,28 +1675,6 @@ mpint_pos(X) -> <<?UINT32(Sz), Bin/binary>> end. -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(X) when X >= 0 -> -%% 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]). - - -bin_to_int(Bin) -> - Bits = bit_size(Bin), - <<Integer:Bits/integer>> = Bin, - Integer. - %% int from integer in a binary with 32bit length erlint(<<MPIntSize:32/integer,MPIntValue/binary>>) -> Bits= MPIntSize * 8, @@ -1267,11 +1684,71 @@ erlint(<<MPIntSize:32/integer,MPIntValue/binary>>) -> mpint_to_bin(<<Len:32, Bin:Len/binary>>) -> Bin. -random_bytes(N) -> - try strong_rand_bytes(N) of - RandBytes -> - RandBytes - catch - error:low_entropy -> - rand_bytes(N) - end. +%% +%% mod_exp - utility for rsa generation and SRP +%% +mod_exp(Base, Exponent, Modulo) + when is_integer(Base), is_integer(Exponent), is_integer(Modulo) -> + bin_to_int(mod_exp_nif(int_to_bin(Base), int_to_bin(Exponent), int_to_bin(Modulo), 0)); + +mod_exp(Base, Exponent, Modulo) -> + mod_exp_nif(mpint_to_bin(Base),mpint_to_bin(Exponent),mpint_to_bin(Modulo), 4). + +mod_exp_nif(_Base,_Exp,_Mod,_bin_hdr) -> ?nif_stub. + +-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, + md5_mac, md5_mac_96, + sha_mac, sha_mac_96, + %% + 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, + rand_uniform, + 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, + %% + stream_init, stream_encrypt, stream_decrypt, + %% deprecated + rc4_encrypt, rc4_set_key, rc4_encrypt_with_state, + aes_ctr_encrypt, aes_ctr_decrypt, + aes_ctr_stream_init, aes_ctr_stream_encrypt, aes_ctr_stream_decrypt, + %% + next_iv, + %% deprecated + aes_cbc_ivec, + des_cbc_ivec, des_cfb_ivec, + info, + %% + info_lib, supports]). +info() -> + ?FUNC_LIST. 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..58aaa78d28 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,1210 @@ 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) -> + do_exor(<<1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>), + do_exor(term_to_binary(lists:seq(1, 1000000))). +%%-------------------------------------------------------------------- +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)). -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 +%%-------------------------------------------------------------------- +%% Internal functions ------------------------------------------------ +%%-------------------------------------------------------------------- +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")). - -%% -%% -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")). +hash_increment(State, []) -> + crypto:hash_final(State); +hash_increment(State0, [Increment | Rest]) -> + State = crypto:hash_update(State0, Increment), + hash_increment(State, Rest). -%% -%% -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")). +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(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_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_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")). +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. -%% -%% -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). +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_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)). +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(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() +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. -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)). +hexstr2bin(S) -> + list_to_binary(hexstr2list(S)). -%% -%% -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. +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. +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) when is_binary(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; +iolistify(Msg) -> + iolistify(list_to_binary(Msg)). + +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(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. +%% 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. -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). +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. -%% -%% -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). +do_exor(B) -> + 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_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() ++ [long_hmac_key(md5)], + Data = rfc_2202_msgs() ++ [long_msg()], + Hmac = rfc_2202_hmac_md5() ++ [long_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(),long_msg()], + Digests = rfc_4634_sha_digests() ++ [long_sha_digest()], + Keys = rfc_2202_sha_keys() ++ [long_hmac_key(sha)], + Data = rfc_2202_msgs() ++ [long_msg()], + Hmac = rfc_2202_hmac_sha() ++ [long_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(), long_msg()], + Digests = rfc_4634_sha256_digests() ++ [long_sha256_digest()], + Keys = rfc_4231_keys() ++ [long_hmac_key(sha256)], + Data = rfc_4231_msgs() ++ [long_msg()], + Hmac = rfc4231_hmac_sha256() ++ [long_hmac(sha256)], + [{hash, {Type, Msgs, Digests}}, {hmac, {Type, Keys, Data, Hmac}} | Config]; +group_config(sha384 = Type, Config) -> + Msgs = [rfc_4634_test1(), rfc_4634_test2(), long_msg()], + Digests = rfc_4634_sha384_digests() ++ [long_sha384_digest()], + Keys = rfc_4231_keys() ++ [long_hmac_key(sha384)], + Data = rfc_4231_msgs() ++ [long_msg()], + Hmac = rfc4231_hmac_sha384() ++ [long_hmac(sha384)], + [{hash, {Type, Msgs, Digests}}, {hmac, {Type, Keys, Data, Hmac}} | Config]; +group_config(sha512 = Type, Config) -> + Msgs = [rfc_4634_test1(), rfc_4634_test2(), long_msg()], + Digests = rfc_4634_sha512_digests() ++ [long_sha512_digest()], + Keys = rfc_4231_keys() ++ [long_hmac_key(sha512)], + Data = rfc_4231_msgs() ++ [long_msg()], + Hmac = rfc4231_hmac_sha512() ++ [long_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")]. + +long_msg() -> + lists:duplicate(1000000, $a). + +long_sha_digest() -> + hexstr2bin("34aa973c" "d4c4daa4" "f61eeb2b" "dbad2731" "6534016f"). + +long_sha256_digest() -> + hexstr2bin("cdc76e5c" "9914fb92" "81a1c7e2" "84d73e67" "f1809a48" "a497200e" "046d39cc" "c7112cd0"). + +long_sha384_digest() -> + hexstr2bin("9d0e1809716474cb" "086e834e310a4a1c" "ed149e9c00f24852" "7972cec5704c2a5b" + "07b8b3dc38ecc4eb" "ae97ddd87f3d8985"). + +long_sha512_digest() -> + hexstr2bin("e718483d0ce76964" "4e2e42c7bc15b463" "8e1f98b13b204428" "5632a803afa973eb" + "de0ff244877ea60a" "4cb0432ce577c31b" "eb009c5c2c49aa2e" "4eadb217ad8cc09b"). + +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">>]. + +%% https://www.cosic.esat.kuleuven.be/nessie/testvectors/ +long_hmac_key(Type) when Type == sha384; + Type == sha512 -> + hexstr2bin("00112233445566778899AABBCCDDEEFF" + "0123456789ABCDEF0011223344556677" + "8899AABBCCDDEEFF0123456789ABCDEF" + "00112233445566778899AABBCCDDEEFF"); +long_hmac_key(_) -> + hexstr2bin("0123456789ABCDEF0123456789ABCDEF" + "0123456789ABCDEF0123456789ABCDEF" + "0123456789ABCDEF0123456789ABCDEF" + "0123456789ABCDEF0123456789ABCDEF"). +long_hmac(md5) -> + hexstr2bin("82FDDA30202CB6ACC6F24D4F8A50EB7A"); +long_hmac(sha) -> + hexstr2bin("61D1D0B6459860755FDA892938C23DD401E54A7E"); +long_hmac(sha256) -> + hexstr2bin("50008B8DC7ED3926936347FDC1A01E9D" + "5220C6CC4B038B482C0F28A4CD88CA37"); +long_hmac(sha384) -> + hexstr2bin("C1EB08DAFA015833D3FC6B29A387558B" + "3F6FA1524AA1A8EB64798D5A76A39D6E" + "A1465525342E060EE996277B4FFCDDC9"); +long_hmac(sha512) -> + hexstr2bin("D116BF471AAE1264854F1906025E846A" + "61618A965FCA30B695220EA2D6E547E3" + "F3B5A4B54E6778928C26D5D3D810498E" + "8DF86CB3CC1E9F66A00419B13B6B0C9A"). + +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))}, + {rc4, <<"apaapa">>, lists:duplicate(1000000, $a)} + ]. + +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")}, + + {aes_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), + lists:duplicate(1000000, $a)} + ]. + +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 +1367,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 +1409,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 +1436,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/crypto/vsn.mk b/lib/crypto/vsn.mk index 2a0cb57aa9..d5d7c8a128 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 2.3 +CRYPTO_VSN = 3.0 diff --git a/lib/debugger/doc/src/notes.xml b/lib/debugger/doc/src/notes.xml index d5eef5d6a2..aef7ef8619 100644 --- a/lib/debugger/doc/src/notes.xml +++ b/lib/debugger/doc/src/notes.xml @@ -32,6 +32,32 @@ <p>This document describes the changes made to the Debugger application.</p> +<section><title>Debugger 3.2.11</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> A new checkbox has been added. When it is checked, + the range set by the <c>erl</c> flag <c>+pc</c> is used + for determining when to print lists of integers as + strings. When it is unchecked, integer lists are never + printed as strings. </p> <p>A minor incompatibility: + settings saved by Erlang R16B01 or later cannot be read + by Erlang R16B or earlier.</p> + <p> + Own Id: OTP-10899</p> + </item> + <item> + <p>Erlang source files with non-ASCII characters are now + encoded in UTF-8 (instead of latin1).</p> + <p> + Own Id: OTP-11041 Aux Id: OTP-10907 </p> + </item> + </list> + </section> + +</section> + <section><title>Debugger 3.2.10</title> <section><title>Improvements and New Features</title> diff --git a/lib/debugger/src/dbg_istk.erl b/lib/debugger/src/dbg_istk.erl index ced42a5f9f..d8f83eef3d 100644 --- a/lib/debugger/src/dbg_istk.erl +++ b/lib/debugger/src/dbg_istk.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 diff --git a/lib/debugger/vsn.mk b/lib/debugger/vsn.mk index 58d462f409..c3e3579e2c 100644 --- a/lib/debugger/vsn.mk +++ b/lib/debugger/vsn.mk @@ -1 +1 @@ -DEBUGGER_VSN = 3.2.10 +DEBUGGER_VSN = 3.2.11 diff --git a/lib/dialyzer/doc/src/notes.xml b/lib/dialyzer/doc/src/notes.xml index cd809662f2..70ebee678c 100644 --- a/lib/dialyzer/doc/src/notes.xml +++ b/lib/dialyzer/doc/src/notes.xml @@ -31,6 +31,77 @@ <p>This document describes the changes made to the Dialyzer application.</p> +<section><title>Dialyzer 2.6.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> A bug that made it impossible to do any analyses from + the GUI has been fixed. </p> + <p> + Own Id: OTP-11057 Aux Id: seq12313 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Include module, function and arity in Dialyzer's + "overlapping domain" warnings. Thanks to Magnus Henoch.</p> + <p> + Own Id: OTP-10918</p> + </item> + <item> + <p> + Improve Dialyzer output for scan errors. Thanks to Magnus + Henoch.</p> + <p> + Own Id: OTP-10996</p> + </item> + <item> + <p> + Integrate elliptic curve contribution from Andreas + Schultz </p> + <p> + In order to be able to support elliptic curve cipher + suites in SSL/TLS, additions to handle elliptic curve + infrastructure has been added to public_key and crypto.</p> + <p> + This also has resulted in a rewrite of the crypto API to + gain consistency and remove unnecessary overhead. All OTP + applications using crypto has been updated to use the new + API.</p> + <p> + Impact: Elliptic curve cryptography (ECC) offers + equivalent security with smaller key sizes than other + public key algorithms. Smaller key sizes result in + savings for power, memory, bandwidth, and computational + cost that make ECC especially attractive for constrained + environments.</p> + <p> + Own Id: OTP-11009</p> + </item> + <item> + <p> + Bitstring type inference and duplicate module error + message fixes. Thanks to Stavros Aronis.</p> + <p> + Own Id: OTP-11027</p> + </item> + <item> + <p>Erlang source files with non-ASCII characters are now + encoded in UTF-8 (instead of latin1).</p> + <p> + Own Id: OTP-11041 Aux Id: OTP-10907 </p> + </item> + </list> + </section> + +</section> + <section><title>Dialyzer 2.6</title> <section><title>Improvements and New Features</title> diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index be4b9b6e12..822aa0826a 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -2,7 +2,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 diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index affb89385e..0fbaf1d47c 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -2,7 +2,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 diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 410be8586e..332a326b0d 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -2,7 +2,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 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/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk index bdb8692f8a..af32c5b901 100644 --- a/lib/dialyzer/vsn.mk +++ b/lib/dialyzer/vsn.mk @@ -1 +1 @@ -DIALYZER_VSN = 2.6 +DIALYZER_VSN = 2.6.1 diff --git a/lib/diameter/Makefile b/lib/diameter/Makefile index 9961d627cf..aa1c9f7f20 100644 --- a/lib/diameter/Makefile +++ b/lib/diameter/Makefile @@ -1,7 +1,7 @@ -# +# # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2012. All Rights Reserved. +# Copyright Ericsson AB 2010-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 @@ -22,11 +22,11 @@ include vsn.mk include subdirs.mk SUB_DIRECTORIES = $(SUB_DIRS) doc/src -SPECIAL_TARGETS = +SPECIAL_TARGETS = include $(ERL_TOP)/make/otp_subdir.mk -info: +info: @echo "APP_VSN = $(APP_VSN)" .PHONY: info diff --git a/lib/diameter/doc/src/Makefile b/lib/diameter/doc/src/Makefile index 99a6680f12..bd2b6b103a 100644 --- a/lib/diameter/doc/src/Makefile +++ b/lib/diameter/doc/src/Makefile @@ -1,4 +1,4 @@ -# +# # %CopyrightBegin% # # Copyright Ericsson AB 2010-2013. All Rights Reserved. @@ -117,7 +117,7 @@ info: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 318c98f786..db19fbb271 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -1,5 +1,7 @@ <?xml version="1.0" encoding="latin1" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd" [ + <!ENTITY spawn_opt + '<seealso marker="erts:erlang#spawn_opt-2">erlang:spawn_opt/2</seealso>'> <!ENTITY nodes '<seealso marker="erts:erlang#nodes-0">erlang:nodes/0</seealso>'> <!ENTITY make_ref @@ -27,12 +29,12 @@ 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>diameter(3)</title> @@ -871,6 +873,18 @@ of a single Diameter node across multiple Erlang nodes.</p> </note> </item> +<tag><c>{spawn_opt, [term()]}</c></tag> +<item> +<p> +An options list passed to &spawn_opt; when spawning a process for an +incoming Diameter request, unless the transport in question +specifies another value. +Options <c>monitor</c> and <c>link</c> are ignored.</p> + +<p> +Defaults to the empty list.</p> +</item> + <tag><c>{use_shared_peers, boolean() | [node()] | evaluable()}</c></tag> <item> <p> @@ -1161,6 +1175,18 @@ Defaults to 30000 for a connecting transport and 60000 for a listening transport.</p> </item> +<marker id="spawn_opt"/> +<tag><c>{spawn_opt, [term()]}</c></tag> +<item> +<p> +An options list passed to &spawn_opt; when spawning a process for an +incoming Diameter request. +Options <c>monitor</c> and <c>link</c> are ignored.</p> + +<p> +Defaults to the list configured on the service if not specified.</p> +</item> + <marker id="transport_config"/> <tag><c>{transport_config, term()}</c></tag> <tag><c>{transport_config, term(), &dict_Unsigned32; | infinity}</c></tag> @@ -1626,7 +1652,7 @@ The <c>caps</c> entry identifies the capabilities sent by the local node and received from the peer during capabilities exchange. The <c>port</c> entry displays socket-level information about the transport connection. -The <c>statistics</c> entry presents Diameter-level counters, +The <c>statistics</c> entry presents Diameter-level counters, an entry like <c>{{{0,280,1},recv},2}</c> saying that the client has received 2 DWR messages: <c>{0,280,1} = {Application_Id, Command_Code, R_Flag}</c>.</p> 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_compile.xml b/lib/diameter/doc/src/diameter_compile.xml index fc81e4efed..6630019e5c 100644 --- a/lib/diameter/doc/src/diameter_compile.xml +++ b/lib/diameter/doc/src/diameter_compile.xml @@ -16,9 +16,9 @@ </copyright> <legalnotice> -The program may be used and/or copied only with the written permission -from Ericsson AB, or in accordance with the terms and conditions -stipulated in the agreement/contract under which the program has been +The program may be used and/or copied only with the written permission +from Ericsson AB, or in accordance with the terms and conditions +stipulated in the agreement/contract under which the program has been supplied. </legalnotice> diff --git a/lib/diameter/doc/src/diameter_dict.xml b/lib/diameter/doc/src/diameter_dict.xml index 419dc143af..4fcde495b3 100644 --- a/lib/diameter/doc/src/diameter_dict.xml +++ b/lib/diameter/doc/src/diameter_dict.xml @@ -25,12 +25,12 @@ 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>diameter_dict(4)</title> diff --git a/lib/diameter/doc/src/diameter_intro.xml b/lib/diameter/doc/src/diameter_intro.xml index fd578ccf45..288ebc0c7c 100644 --- a/lib/diameter/doc/src/diameter_intro.xml +++ b/lib/diameter/doc/src/diameter_intro.xml @@ -7,7 +7,7 @@ <chapter> <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> @@ -17,12 +17,12 @@ 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>Introduction</title> diff --git a/lib/diameter/doc/src/diameter_sctp.xml b/lib/diameter/doc/src/diameter_sctp.xml index df140b16b9..5fe14b1ef6 100644 --- a/lib/diameter/doc/src/diameter_sctp.xml +++ b/lib/diameter/doc/src/diameter_sctp.xml @@ -70,10 +70,15 @@ and implements the behaviour documented in <v>Type = connect | accept</v> <v>Ref = &mod_transport_ref;</v> <v>Svc = #diameter_service{}</v> -<v>Opt = {raddr, &ip_address;} | {rport, integer()} | term()</v> +<v>Opt = OwnOpt | SctpOpt</v> <v>Pid = pid()</v> <v>LAddr = &ip_address;</v> <v>Reason = term()</v> +<v>OwnOpt = {raddr, &ip_address;} + | {rport, integer()} + | {accept, Match}</v> +<v>SctpOpt = term()</v> +<v>Match = &ip_address; | string() | [Match]</v> </type> <desc> @@ -85,9 +90,20 @@ Options <c>raddr</c> and <c>rport</c> specify the remote address and port for a connecting transport and not valid for a listening transport: the former is required while latter defaults to 3868 if unspecified. -More than one <c>raddr</c> option can be specified, in which case the +Mupltiple <c>raddr</c> options can be specified, in which case the connecting transport in question attempts each in sequence until -an association is established. +an association is established.</p> + +<p> +Option <c>accept</c> specifies remote addresses for a listening +transport and is not valid for a connecting transport. +If specified, a remote address that does not match one of the +specified addresses causes the association to be aborted. +Multiple <c>accept</c> options can be specified. +A string-valued <c>Match</c> that does not parse as an address is +interpreted as a regular expression.</p> + +<p> Remaining options are any accepted by &gen_sctp_open1;, with the exception of options <c>mode</c>, <c>binary</c>, <c>list</c>, <c>active</c> and <c>sctp_events</c>. diff --git a/lib/diameter/doc/src/diameter_tcp.xml b/lib/diameter/doc/src/diameter_tcp.xml index 8e509aa829..ce4d6cfd0f 100644 --- a/lib/diameter/doc/src/diameter_tcp.xml +++ b/lib/diameter/doc/src/diameter_tcp.xml @@ -96,10 +96,12 @@ before configuring TLS capability on diameter transports.</p> <v>Reason = term()</v> <v>OwnOpt = {raddr, &ip_address;} | {rport, integer()} + | {accept, Match} | {port, integer()} | {fragment_timer, infinity | 0..16#FFFFFFFF}</v> <v>SslOpt = {ssl_options, true | list()}</v> <v>TcpOpt = term()</v> +<v>Match = &ip_address; | string() | [Match]</v> </type> <desc> @@ -109,7 +111,18 @@ The start function required by &man_transport;.</p> <p> Options <c>raddr</c> and <c>rport</c> specify the remote address and port for a connecting transport and are not valid for a listening -transport. +transport.</p> + +<p> +Option <c>accept</c> specifies remote addresses for a listening +transport and is not valid for a connecting transport. +If specified, a remote address that does not match one of the +specified addresses causes the connection to be aborted. +Multiple <c>accept</c> options can be specified. +A string-valued <c>Match</c> that does not parse as an address is +interpreted as a regular expression.</p> + +<p> Option <c>ssl_options</c> must be specified for a transport that should support TLS: a value of <c>true</c> results in a TLS handshake immediately upon connection establishment while 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/doc/src/diameter_using.xml b/lib/diameter/doc/src/diameter_using.xml index 7d9c0cd492..c487d94a16 100644 --- a/lib/diameter/doc/src/diameter_using.xml +++ b/lib/diameter/doc/src/diameter_using.xml @@ -5,7 +5,7 @@ <header> <copyright> -<year>2011</year><year>2012</year> +<year>2011</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> @@ -15,12 +15,12 @@ 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>Usage</title> diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index ad61f12b5b..e750b56f1e 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -42,6 +42,229 @@ first.</p> <!-- ===================================================================== --> +<section><title>diameter 1.4.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix handling of 5014 (INVALID_AVP_LENGTH) errors.</p> + <p> + This was in some cases reported as 3009 + (INVALID_AVP_BITS).</p> + <p> + Note that the correction is partially implemented in + modules generated by diameterc(1): a dictionary file must + be recompiled for the correction to apply to any messages + it defines.</p> + <p> + Own Id: OTP-11007</p> + </item> + <item> + <p> + Fix faulty capitalization in release notes.</p> + <p> + Diameter = the protocol.<br/> diameter = the Erlang + application.</p> + <p> + Own Id: OTP-11014</p> + </item> + <item> + <p> + Fix watchdog memory leak.</p> + <p> + Entries were not removed from a service-specific ets + table, causing them to be orphaned at connection + reestablishment for listening transports, and + diameter:remove_transport/2 for both listening and + connecting transports.</p> + <p> + The fault was introduced by OTP-10692 in diameter-1.4.1 + (R16B).</p> + <p> + Own Id: OTP-11019 Aux Id: OTP-10692 </p> + </item> + <item> + <p> + Fix decode failure on AVP Length < 8.</p> + <p> + The failure caused the message in question to be + discarded.</p> + <p> + Own Id: OTP-11026</p> + </item> + <item> + <p> + Respect Host-IP-Address configuration.</p> + <p> + Addresses returned from a transport module were always + used to populate Host-IP-Address AVP's in an outgoing + CER/CEA, which precluded the sending of a VIP address. + Transport addresses are now only used if Host-IP-Address + is unspecified.</p> + <p> + Own Id: OTP-11045</p> + </item> + <item> + <p> + Fix mkdir race.</p> + <p> + Install could fail if examples/code and examples/dict + were created in parallel. Noticed on FreeBSD.</p> + <p> + Own Id: OTP-11051</p> + </item> + <item> + <p> + Fix recognition of 5001 on mandatory AVP's.</p> + <p> + An AVP setting the M-bit was not regarded as erroneous if + it was defined in the dictionary in question and its + container (message or Grouped AVP) had an 'AVP' field. + It's now regarded as a 5001 error (AVP_UNSUPPORTED), as + in the case that the AVP is not defined.</p> + <p> + Note that the correction is partially implemented in + modules generated by diameterc(1): a dictionary file must + be recompiled for the correction to apply to any messages + it defines.</p> + <p> + Own Id: OTP-11087</p> + </item> + <item> + <p> + Fix setting of Failed-AVP on handle_request + {answer_message, 5xxx} return.</p> + <p> + Failed-AVP was never in the outgoing answer-message. It + is now set with the AVP from the first entry with the + specified Result-Code in the errors field of the incoming + diameter_packet, if found.</p> + <p> + Own Id: OTP-11092</p> + </item> + <item> + <p> + Fix watchdog function_clause</p> + <p> + A listening transport on a service that allowed multiple + connections to the same peer could result in a + function_clause error in module diameter_watchdog. The + resulting crash was harmless but unseemly.</p> + <p> + Thanks to Aleksander Nycz.</p> + <p> + Own Id: OTP-11115</p> + </item> + <item> + <p> + Fix population of Failed-AVP.</p> + <p> + In cases in which diameter populated this AVP, many + values were sent instead of one as suggested by RFC 6733. + This was partially corrected by OTP-11007.</p> + <p> + Own Id: OTP-11127 Aux Id: OTP-11007 </p> + </item> + <item> + <p> + Fix list-valued Vendor-Specific-Application-Id config</p> + <p> + R16B (specifically, OTP-10760) broke the handling of such + configuration, resulting in a function clause error if + the list was not of length 3, and faulty interpretation + of the list's contents otherwise. Only record-valued + configuration was properly interpreted.</p> + <p> + Own Id: OTP-11165</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Allow peer connections to be shared between Erlang nodes + for the purpose of sending outgoing requests.</p> + <p> + A diameter_app(3) pick_peer/4 callback gets a list of + remote candidates as argument, allowing a callback on one + node to select a transport connection established on + another node. The service_opt() share_peers controls the + extent to which local connections are shared with remote + nodes. The service_opt() use_shared_peers controls the + extent to which connections shared from remote nodes are + utilized on the local node.</p> + <p> + Own Id: OTP-9610</p> + </item> + <item> + <p> + Allow listening diameter_{tcp,sctp} transports to be + configured with remote addresses.</p> + <p> + Option 'accept' allows remote addresses to be configured + as tuples or regular expressions. Remote addresses are + matched against the configured values at connection + establishment, any non-matching address causing the + connection to be aborted.</p> + <p> + Own Id: OTP-10893</p> + </item> + <item> + <p> + Detect more transport_opt() configuration errors at + diameter:add_transport/2.</p> + <p> + Many errors would previously not be detected until + transport start, diameter:add_transport/2 returning 'ok' + but transport connections failing to be established. An + error tuple is now returned.</p> + <p> + Own Id: OTP-10972</p> + </item> + <item> + <p> + Make explicit local address configuration optional in + diameter_tcp:start/3.</p> + <p> + The default address (as determined by gen_tcp) is now + used when a local address is not explicitly configured.</p> + <p> + Own Id: OTP-10986</p> + </item> + <item> + <p> + Improve handling of unrecognized service options.</p> + <p> + Such options were silently ignored by + diameter:start_service/2. An error tuple is now returned.</p> + <p> + Own Id: OTP-11017</p> + </item> + <item> + <p> + Don't send default Inband-Security-Id in CER/CEA.</p> + <p> + RFC 6733 recommends against the use of + Inband-Security-Id. Only send a value that differs from + the default, NO_INBAND_SECURITY = 0.</p> + <p> + Own Id: OTP-11050</p> + </item> + <item> + <p> + Make spawn options for request processes configurable.</p> + <p> + Own Id: OTP-11060</p> + </item> + </list> + </section> + +</section> + <section><title>diameter 1.4.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> 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/Makefile b/lib/diameter/src/Makefile index c0cf418f06..578bbaee2e 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -1,19 +1,19 @@ -# +# # %CopyrightBegin% -# +# # Copyright Ericsson AB 2010-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% include $(ERL_TOP)/make/target.mk diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl index 57730cad61..77200cc7d0 100644 --- a/lib/diameter/src/base/diameter.erl +++ b/lib/diameter/src/base/diameter.erl @@ -306,7 +306,8 @@ call(SvcName, App, Message) -> | {restrict_connections, restriction()} | {sequence, sequence() | evaluable()} | {share_peers, remotes()} - | {use_shared_peers, remotes()}. + | {use_shared_peers, remotes()} + | {spawn_opt, list()}. -type application_opt() :: {alias, app_alias()} @@ -345,6 +346,7 @@ call(SvcName, App, Message) -> | {reconnect_timer, 'Unsigned32'()} | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} | {watchdog_config, [{okay|suspect, non_neg_integer()}]} + | {spawn_opt, list()} | {private, any()}. %% Predicate passed to remove_transport/2 diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl index 9a443fead0..1a931a9854 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}, @@ -402,12 +419,13 @@ app_union(#diameter_caps{auth_application_id = U, vendor_specific_application_id = V}) -> set_list(U ++ C ++ lists:flatmap(fun vsa_apps/1, V)). -vsa_apps([_ | [_,_] = Ids]) -> - lists:append(Ids); +vsa_apps(Vals) + when is_list(Vals) -> + lists:flatmap(fun({'Vendor-Id', _}) -> []; ({_, Ids}) -> Ids end, Vals); vsa_apps(Rec) when is_tuple(Rec) -> - [_|T] = tuple_to_list(Rec), - vsa_apps(T). + [_Name, _VendorId | Idss] = tuple_to_list(Rec), + lists:append(Idss). %% It's a configuration error for a locally advertised application not %% to be represented in Apps. Don't just match on lists:keyfind/3 in diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index e446a0209c..1d647b8c87 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) @@ -196,7 +204,7 @@ msg_header(Mod, 'answer-message' = MsgName, Header) -> #diameter_header{application_id = Aid, cmd_code = Code} = Header, - {-1, Flags, ?DIAMETER_APP_ID_COMMON} = Mod:msg_header(MsgName), + {-1, Flags, ?APP_ID_COMMON} = Mod:msg_header(MsgName), {Code, Flags, Aid}; msg_header(Mod, MsgName, _) -> @@ -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_config.erl b/lib/diameter/src/base/diameter_config.erl index 2a145c874b..fc5c284bf2 100644 --- a/lib/diameter/src/base/diameter_config.erl +++ b/lib/diameter/src/base/diameter_config.erl @@ -549,6 +549,9 @@ opt({watchdog_timer, Tmo}) -> opt({watchdog_config, L}) -> is_list(L) andalso lists:all(fun wdopt/1, L); +opt({spawn_opt, Opts}) -> + is_list(Opts); + %% Options that we can't validate. opt({K, _}) when K == transport_config; @@ -632,7 +635,8 @@ make_config(SvcName, Opts) -> {false, use_shared_peers}, {false, monitor}, {?NOMASK, sequence}, - {nodes, restrict_connections}]), + {nodes, restrict_connections}, + {[], spawn_opt}]), #service{name = SvcName, rec = #diameter_service{applications = Apps, @@ -647,6 +651,9 @@ make_opts(Opts, Defs) -> [{K, opt(K,V)} || {K,V} <- Known]. +opt(spawn_opt, L) -> + is_list(L); + opt(K, false = B) when K /= sequence -> B; diff --git a/lib/diameter/src/base/diameter_peer.erl b/lib/diameter/src/base/diameter_peer.erl index 0d2efd4d1f..e5d4b28766 100644 --- a/lib/diameter/src/base/diameter_peer.erl +++ b/lib/diameter/src/base/diameter_peer.erl @@ -25,7 +25,8 @@ -export([recv/2, up/1, up/2, - up/3]). + up/3, + match/2]). %% ... and the stack. -export([start/1, @@ -63,16 +64,16 @@ -define(DEFAULT_TCFG, []). -define(DEFAULT_TTMO, infinity). -%%% --------------------------------------------------------------------------- -%%% # notify/3 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # notify/3 +%% --------------------------------------------------------------------------- notify(Nodes, SvcName, T) -> rpc:abcast(Nodes, ?SERVER, {notify, SvcName, T}). -%%% --------------------------------------------------------------------------- -%%% # start/1 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # start/1 +%% --------------------------------------------------------------------------- -spec start({T, [Opt], #diameter_service{}}) -> {TPid, [Addr], Tmo, Data} @@ -180,9 +181,34 @@ start(T, [M|Ms], Cfg, Svc, Tmo, Rest, Errs) -> start(Mod, Args) -> apply(Mod, start, Args). -%%% --------------------------------------------------------------------------- -%%% # up/1-3 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # match/2 +%% --------------------------------------------------------------------------- + +match(Addrs, Matches) + when is_list(Addrs) -> + lists:all(fun(A) -> match1(A, Matches) end, Addrs). + +match1(Addr, Matches) + when not is_integer(hd(Matches)) -> + lists:any(fun(M) -> match1(Addr, M) end, Matches); + +match1(Addr, Match) -> + match(Addr, addr(Match), Match). + +match(Addr, {ok, A}, _) -> + Addr == A; +match(Addr, {error, _}, RE) -> + match == re:run(inet_parse:ntoa(Addr), RE, [{capture, none}]). + +addr([_|_] = A) -> + inet_parse:address(A); +addr(A) -> + {ok, A}. + +%% --------------------------------------------------------------------------- +%% # up/1-3 +%% --------------------------------------------------------------------------- up(Pid) -> %% accepting transport ifc_send(Pid, {self(), connected}). @@ -193,16 +219,16 @@ up(Pid, Remote) -> %% connecting transport up(Pid, Remote, LAddrs) -> %% connecting transport ifc_send(Pid, {self(), connected, Remote, LAddrs}). -%%% --------------------------------------------------------------------------- -%%% # recv/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # recv/2 +%% --------------------------------------------------------------------------- recv(Pid, Pkt) -> ifc_send(Pid, {recv, Pkt}). -%%% --------------------------------------------------------------------------- -%%% # send/2 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # send/2 +%% --------------------------------------------------------------------------- send(Pid, #diameter_packet{transport_data = undefined, bin = Bin}) -> @@ -211,16 +237,16 @@ send(Pid, #diameter_packet{transport_data = undefined, send(Pid, Pkt) -> ifc_send(Pid, {send, Pkt}). -%%% --------------------------------------------------------------------------- -%%% # close/1 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # close/1 +%% --------------------------------------------------------------------------- close(Pid) -> ifc_send(Pid, {close, self()}). -%%% --------------------------------------------------------------------------- -%%% # abort/1 -%%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- +%% # abort/1 +%% --------------------------------------------------------------------------- abort(Pid) -> exit(Pid, shutdown). @@ -241,16 +267,16 @@ state() -> uptime() -> call(uptime). -%%% ---------------------------------------------------------- -%%% # init(Role) -%%% ---------------------------------------------------------- +%% ---------------------------------------------------------- +%% # init(Role) +%% ---------------------------------------------------------- init([]) -> {ok, #state{}}. -%%% ---------------------------------------------------------- -%%% # handle_call(Request, From, State) -%%% ---------------------------------------------------------- +%% ---------------------------------------------------------- +%% # handle_call(Request, From, State) +%% ---------------------------------------------------------- handle_call(state, _, State) -> {reply, State, State}; @@ -262,17 +288,17 @@ handle_call(Req, From, State) -> ?UNEXPECTED([Req, From]), {reply, nok, State}. -%%% ---------------------------------------------------------- -%%% # handle_cast(Request, State) -%%% ---------------------------------------------------------- +%% ---------------------------------------------------------- +%% # handle_cast(Request, State) +%% ---------------------------------------------------------- handle_cast(Msg, State) -> ?UNEXPECTED([Msg]), {noreply, State}. -%%% ---------------------------------------------------------- -%%% # handle_info(Request, State) -%%% ---------------------------------------------------------- +%% ---------------------------------------------------------- +%% # handle_info(Request, State) +%% ---------------------------------------------------------- %% Remote service is distributing a message. handle_info({notify, SvcName, T}, S) -> 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_service.erl b/lib/diameter/src/base/diameter_service.erl index 112e83476d..9dd8aafc61 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -770,10 +770,8 @@ start(Ref, Type, Opts, #state{watchdogT = WatchdogT, = Svc = merge_service(Opts, Svc0), {_,_} = Mask = proplists:get_value(sequence, SvcOpts), - Pid = s(Type, Ref, {diameter_traffic:make_recvdata([SvcName, - PeerT, - Apps, - Mask]), + RecvData = diameter_traffic:make_recvdata([SvcName, PeerT, Apps, Mask]), + Pid = s(Type, Ref, {{spawn_opts([Opts, SvcOpts]), RecvData}, Opts, SvcOpts, Svc}), @@ -787,6 +785,12 @@ start(Ref, Type, Opts, #state{watchdogT = WatchdogT, %% record so that each watchdog may get a different record. This %% record is what is passed back into application callbacks. +spawn_opts(Optss) -> + SpawnOpts = get_value(spawn_opt, Optss, []), + [T || T <- SpawnOpts, + T /= link, + T /= monitor]. + s(Type, Ref, T) -> {_MRef, Pid} = diameter_watchdog:start({Type, Ref}, T), Pid. @@ -986,6 +990,18 @@ keyfind([Key | Rest], Pos, L) -> T end. +%% get_value/3 + +get_value(_, [], Def) -> + Def; +get_value(Key, [L | Rest], Def) -> + case lists:keyfind(Key, 1, L) of + {_,V} -> + V; + _ -> + get_value(Key, Rest, Def) + end. + %% find_outgoing_app/2 find_outgoing_app(Alias, Apps) -> diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index 25b902e3f2..8b6f026b34 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -48,6 +48,7 @@ -define(BASE, ?DIAMETER_DICT_COMMON). %% Note: the RFC 3588 dictionary -define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests +-define(DEFAULT_SPAWN_OPTS, []). %% Table containing outgoing requests for which a reply has yet to be %% received. @@ -153,13 +154,8 @@ receive_message(TPid, Pkt, Dict0, RecvData) RecvData). %% Incoming request ... -recv(true, false, TPid, Pkt, Dict0, RecvData) -> - try - spawn(fun() -> recv_request(TPid, Pkt, Dict0, RecvData) end) - catch - error: system_limit = E -> %% discard - ?LOG({error, E}, now()) - end; +recv(true, false, TPid, Pkt, Dict0, T) -> + spawn_request(TPid, Pkt, Dict0, T); %% ... answer to known request ... recv(false, #request{ref = Ref, handler = Pid} = Req, _, Pkt, Dict0, _) -> @@ -177,6 +173,21 @@ recv(false, #request{ref = Ref, handler = Pid} = Req, _, Pkt, Dict0, _) -> recv(false, false, _, _, _, _) -> ok. +%% spawn_request/4 + +spawn_request(TPid, Pkt, Dict0, {Opts, RecvData}) -> + spawn_request(TPid, Pkt, Dict0, Opts, RecvData); +spawn_request(TPid, Pkt, Dict0, RecvData) -> + spawn_request(TPid, Pkt, Dict0, ?DEFAULT_SPAWN_OPTS, RecvData). + +spawn_request(TPid, Pkt, Dict0, Opts, RecvData) -> + try + spawn_opt(fun() -> recv_request(TPid, Pkt, Dict0, RecvData) end, Opts) + catch + error: system_limit = E -> %% discard + ?LOG({error, E}, now()) + end. + %% --------------------------------------------------------------------------- %% recv_request/4 %% --------------------------------------------------------------------------- @@ -226,10 +237,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 +311,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 +490,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 +605,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(#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)}. -reset(Msg, Dict, N) - when is_integer(N) -> - ResultCode = rc(Msg, {'Result-Code', N}, Dict), - set(Msg, ResultCode, Dict); - -reset(Msg, _, _) -> - Msg. - -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 +751,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 +789,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 +871,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 +890,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/src/base/diameter.app.src b/lib/diameter/src/diameter.app.src index ceefb9b398..ceefb9b398 100644 --- a/lib/diameter/src/base/diameter.app.src +++ b/lib/diameter/src/diameter.app.src diff --git a/lib/diameter/src/base/diameter.appup.src b/lib/diameter/src/diameter.appup.src index 359f434941..62ace16faa 100644 --- a/lib/diameter/src/base/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -31,10 +31,36 @@ {"1.4", [{restart_application, diameter}]}, %% R16A {"1.4.1", [{load_module, diameter_reg}, %% R16B {load_module, diameter_stats}, + {load_module, diameter_traffic}, {load_module, diameter_service}, + {load_module, diameter_config}, + {load_module, diameter_peer}, + {load_module, diameter_peer_fsm}, {load_module, diameter_watchdog}, {load_module, diameter_capx}, - {load_module, diameter}]} + {load_module, diameter_codec}, + {load_module, diameter_gen_base_rfc3588}, + {load_module, diameter_gen_base_accounting}, + {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_gen_base_acct6733}, + {load_module, diameter_tcp}, + {load_module, diameter_lib}, + {load_module, diameter}]}, + {"1.4.1.1", [{load_module, diameter_traffic}, + {load_module, diameter_service}, + {load_module, diameter_config}, + {load_module, diameter_peer}, + {load_module, diameter_peer_fsm}, + {load_module, diameter_watchdog}, + {load_module, diameter_capx}, + {load_module, diameter_codec}, + {load_module, diameter_gen_base_rfc3588}, + {load_module, diameter_gen_base_accounting}, + {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_gen_base_acct6733}, + {load_module, diameter_tcp}, + {load_module, diameter_lib}, + {load_module, diameter}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -46,6 +72,7 @@ {"1.3", [{restart_application, diameter}]}, {"1.3.1", [{restart_application, diameter}]}, {"1.4", [{restart_application, diameter}]}, - {"1.4.1", [{restart_application, diameter}]} + {"1.4.1", [{restart_application, diameter}]}, + {"1.4.1.1", [{restart_application, diameter}]} ] }. diff --git a/lib/diameter/src/dict/base_rfc3588.dia b/lib/diameter/src/dict/base_rfc3588.dia index acd7fffd00..43a417b8dc 100644 --- a/lib/diameter/src/dict/base_rfc3588.dia +++ b/lib/diameter/src/dict/base_rfc3588.dia @@ -1,7 +1,7 @@ ;; ;; %CopyrightBegin% ;; -;; Copyright Ericsson AB 2010-2011. All Rights Reserved. +;; Copyright Ericsson AB 2010-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 @@ -421,7 +421,7 @@ DIAMETER_INVALID_AVP_BIT_COMBO 5016 DIAMETER_NO_COMMON_SECURITY 5017 -@grouped +@grouped Proxy-Info ::= < AVP Header: 284 > { Proxy-Host } @@ -440,7 +440,7 @@ [ Auth-Application-Id ] [ Acct-Application-Id ] -;; The E2E-Sequence AVP is defined in RFC 3588 as Grouped, but +;; The E2E-Sequence AVP is defined in RFC 3588 as Grouped, but ;; there is no definition of the group - only an informal text stating ;; that there should be a nonce (an OctetString) and a counter ;; (integer) diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index 8b8c2a6694..49a530b4eb 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -42,6 +42,9 @@ -export([ports/0, ports/1]). +-export_type([listen_option/0, + connect_option/0]). + -include_lib("kernel/include/inet_sctp.hrl"). -include_lib("diameter/include/diameter.hrl"). @@ -54,6 +57,9 @@ %% The default port for a listener. -define(DEFAULT_PORT, 3868). %% RFC 3588, ch 2.1 +%% Remote addresses to accept connections from. +-define(DEFAULT_ACCEPT, []). %% any + %% How long a listener with no associations lives before offing %% itself. -define(LISTENER_TIMEOUT, 30000). @@ -62,6 +68,17 @@ %% association establishment. -define(ACCEPT_TIMEOUT, 5000). +-type connect_option() :: {raddr, inet:ip_address()} + | {rport, inet:port_number()} + | gen_sctp:open_option(). + +-type match() :: inet:ip_address() + | string() + | [match()]. + +-type listen_option() :: {accept, match()} + | gen_sctp:open_option(). + -type uint() :: non_neg_integer(). %% Accepting/connecting transport process state. @@ -69,7 +86,7 @@ {parent :: pid(), mode :: {accept, pid()} | accept - | {connect, {list(inet:ip_address()), uint(), list()}} + | {connect, {[inet:ip_address()], uint(), list()}} %% {RAs, RP, Errors} | connect, socket :: gen_sctp:sctp_socket(), @@ -86,7 +103,8 @@ tmap = ets:new(?MODULE, []) :: ets:tid(), %% {MRef, Pid|AssocId}, {AssocId, Pid} pending = {0, ets:new(?MODULE, [ordered_set])}, - tref :: reference()}). + tref :: reference(), + accept :: [match()]}). %% Field tmap is used to map an incoming message or event to the %% relevent transport process. Field pending implements a queue of %% transport processes to which an association has been assigned (at @@ -102,6 +120,13 @@ %% # start/3 %% --------------------------------------------------------------------------- +-spec start({accept, Ref}, #diameter_service{}, [listen_option()]) + -> {ok, pid(), [inet:ip_address()]} + when Ref :: diameter:transport_ref(); + ({connect, Ref}, #diameter_service{}, [connect_option()]) + -> {ok, pid(), [inet:ip_address()]} + when Ref :: diameter:transport_ref(). + start(T, #diameter_service{capabilities = Caps}, Opts) when is_list(Opts) -> diameter_sctp_sup:start(), %% start supervisors on demand @@ -169,12 +194,14 @@ init(T) -> %% A process owning a listening socket. i({listen, Ref, {Opts, Addrs}}) -> - {LAs, Sock} = AS = open(Addrs, Opts, ?DEFAULT_PORT), + {[Matches], Rest} = proplists:split(Opts, [accept]), + {LAs, Sock} = AS = open(Addrs, Rest, ?DEFAULT_PORT), proc_lib:init_ack({ok, self(), LAs}), ok = gen_sctp:listen(Sock, true), true = diameter_reg:add_new({?MODULE, listener, {Ref, AS}}), start_timer(#listener{ref = Ref, - socket = Sock}); + socket = Sock, + accept = accept(Matches)}); %% A connecting transport. i({connect, Pid, Opts, Addrs, Ref}) -> @@ -311,6 +338,9 @@ handle_call({{accept, Ref}, Pid}, _, #listener{ref = Ref, {TPid, NewS} = accept(Ref, Pid, S), {reply, {ok, TPid}, NewS#listener{count = N+1}}; +handle_call(T, From, {listener,_,_,_,_,_,_} = S) -> % started in old code + handle_call(T, From, upgrade(S)); + handle_call(_, _, State) -> {reply, nok, State}. @@ -329,7 +359,10 @@ handle_info(T, #transport{} = S) -> {noreply, #transport{} = t(T,S)}; handle_info(T, #listener{} = S) -> - {noreply, #listener{} = l(T,S)}. + {noreply, #listener{} = l(T,S)}; + +handle_info(T, {listener,_,_,_,_,_,_} = S) -> % started in old code + handle_info(T, upgrade(S)). %% --------------------------------------------------------------------------- %% # code_change/3 @@ -363,6 +396,9 @@ terminate(_, #listener{socket = Sock}) -> %% --------------------------------------------------------------------------- +upgrade(S) -> + #listener{} = erlang:append_element(S, ?DEFAULT_ACCEPT). + putr(Key, Val) -> put({?MODULE, Key}, Val). @@ -386,7 +422,7 @@ l({sctp, Sock, _RA, _RP, Data} = Msg, #listener{socket = Sock} = S) -> try find(Id, Data, S) of {TPid, NewS} -> - TPid ! {peeloff, peeloff(Sock, Id, TPid), Msg}, + TPid ! {peeloff, peeloff(Sock, Id, TPid), Msg, S#listener.accept}, NewS; false -> S @@ -460,11 +496,14 @@ t(T,S) -> %% transition/2 %% Listening process is transfering ownership of an association. -transition({peeloff, Sock, {sctp, LSock, _RA, _RP, _Data} = Msg}, +transition({peeloff, Sock, {sctp, LSock, _RA, _RP, _Data} = Msg, Matches}, #transport{mode = {accept, _}, socket = LSock} = S) -> + ok = accept_peer(Sock, Matches), transition(Msg, S#transport{socket = Sock}); +transition({peeloff = T, _Sock, _Msg} = T, #transport{} = S) ->% from old code + transition(erlang:append_element(T, ?DEFAULT_ACCEPT), S); %% Incoming message. transition({sctp, _Sock, _RA, _RP, Data}, #transport{socket = Sock} = S) -> @@ -510,6 +549,27 @@ transition({resolve_port, Pid}, #transport{socket = Sock}) %% Crash on anything unexpected. +ok({ok, T}) -> + T; +ok(T) -> + x(T). + +%% accept_peer/2 + +accept_peer(_, []) -> + ok; + +accept_peer(Sock, Matches) -> + {RAddrs, _} = ok(inet:peername(Sock)), + diameter_peer:match(RAddrs, Matches) + orelse x({accept, RAddrs, Matches}), + ok. + +%% accept/1 + +accept(Opts) -> + [[M] || {accept, M} <- Opts]. + %% accept/3 %% %% Start a new transport process or use one that's already been diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl index cbbba714ac..4d1b8bec51 100644 --- a/lib/diameter/src/transport/diameter_tcp.erl +++ b/lib/diameter/src/transport/diameter_tcp.erl @@ -42,6 +42,9 @@ -export([ports/0, ports/1]). +-export_type([connect_option/0, + listen_option/0]). + -include_lib("diameter/include/diameter.hrl"). %% Keys into process dictionary. @@ -80,6 +83,25 @@ -type frag() :: {length(), size(), binary(), list(binary())} | binary(). +-type connect_option() :: {raddr, inet:ip_address()} + | {rport, pos_integer()} + | {ssl_options, true | [ssl:connect_option()]} + | option() + | ssl:connect_option() + | gen_tcp:connect_option(). + +-type match() :: inet:ip_address() + | string() + | [match()]. + +-type listen_option() :: {accept, match()} + | {ssl_options, true | [ssl:listen_option()]} + | ssl:listen_option() + | gen_tcp:listen_option(). + +-type option() :: {port, non_neg_integer()} + | {fragment_timer, 0..16#FFFFFFFF}. + %% Accepting/connecting transport process state. -record(transport, {socket :: inet:socket() | ssl:sslsocket(), %% accept/connect socket @@ -100,18 +122,14 @@ %% # start/3 %% --------------------------------------------------------------------------- --spec start({accept, Ref}, Svc, [Opt]) +-spec start({accept, Ref}, #diameter_service{}, [listen_option()]) -> {ok, pid(), [inet:ip_address()]} - when Ref :: diameter:transport_ref(), - Svc :: #diameter_service{}, - Opt :: diameter:transport_opt(); - ({connect, Ref}, Svc, [Opt]) + when Ref :: diameter:transport_ref(); + ({connect, Ref}, #diameter_service{}, [connect_option()]) -> {ok, pid(), [inet:ip_address()]} | {ok, pid()} - when Ref :: diameter:transport_ref(), - Svc :: #diameter_service{}, - Opt :: diameter:transport_opt(). - + when Ref :: diameter:transport_ref(). + start({T, Ref}, #diameter_service{capabilities = Caps}, Opts) -> diameter_tcp_sup:start(), %% start tcp supervisors on demand {Mod, Rest} = split(Opts), @@ -225,10 +243,10 @@ laddr([], Mod, Sock) -> Addr; laddr([{ip, Addr}], _, _) -> Addr. - + own(Opts) -> - {Own, Rest} = proplists:split(Opts, [fragment_timer]), - {lists:append(Own), Rest}. + {[Own], Rest} = proplists:split(Opts, [fragment_timer]), + {Own, Rest}. ssl(Opts) -> {[SslOpts], Rest} = proplists:split(Opts, [ssl_options]), @@ -257,9 +275,11 @@ init(Type, Ref, Mod, Pid, _, Opts, Addrs) -> %% init/6 init(accept = T, Ref, Mod, Pid, Opts, Addrs) -> - {LAddr, LSock} = listener(Ref, {Mod, Opts, Addrs}), + {[Matches], Rest} = proplists:split(Opts, [accept]), + {LAddr, LSock} = listener(Ref, {Mod, Rest, Addrs}), proc_lib:init_ack({ok, self(), [LAddr]}), Sock = ok(accept(Mod, LSock)), + ok = accept_peer(Mod, Sock, accept(Matches)), publish(Mod, T, Ref, Sock), diameter_peer:up(Pid), Sock; @@ -282,7 +302,7 @@ init_rc([]) -> up(Pid, Remote, [{ip, _Addr}], _, _) -> diameter_peer:up(Pid, Remote); -up(Pid, Remote, [], Mod, Sock) -> +up(Pid, Remote, [], Mod, Sock) -> {Addr, _Port} = ok(sockname(Mod, Sock)), diameter_peer:up(Pid, Remote, [Addr]). @@ -298,6 +318,22 @@ ok(No) -> x(Reason) -> exit({shutdown, Reason}). +%% accept_peer/3 + +accept_peer(_Mod, _Sock, []) -> + ok; + +accept_peer(Mod, Sock, Matches) -> + {RAddr, _} = ok(peername(Mod, Sock)), + diameter_peer:match([RAddr], Matches) + orelse x({accept, RAddr, Matches}), + ok. + +%% accept/1 + +accept(Opts) -> + [[M] || {accept, M} <- Opts]. + %% listener/2 listener(LRef, T) -> diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index 9719c67b32..aff1b18cf8 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -1,4 +1,4 @@ -# +# # %CopyrightBegin% # # Copyright Ericsson AB 2010-2013. All Rights Reserved. @@ -76,7 +76,7 @@ any: opt $(MAKE) -i $(SUITES) clean: - rm -f $(TARGET_FILES) + rm -f $(TARGET_FILES) rm -f depend.mk coverspec realclean: clean @@ -159,7 +159,7 @@ log: # ---------------------------------------------------- # Release Targets -# ---------------------------------------------------- +# ---------------------------------------------------- /%: % force sed -f release.sed $< > "$(RELSYSDIR)$@" 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_capx_SUITE.erl b/lib/diameter/test/diameter_capx_SUITE.erl index 8c9bb67e61..deabdd720b 100644 --- a/lib/diameter/test/diameter_capx_SUITE.erl +++ b/lib/diameter/test/diameter_capx_SUITE.erl @@ -27,6 +27,8 @@ -export([suite/0, all/0, groups/0, + init_per_suite/1, + end_per_suite/1, init_per_group/2, end_per_group/2, init_per_testcase/2, @@ -56,6 +58,11 @@ peer_down/4]). -include("diameter.hrl"). +-include("diameter_gen_base_rfc3588.hrl"). +%% Use only the Vendor-Specific-Application-Id record from the base +%% include, to test the independence of capabilities configuration +%% from the different definitions of Vendor-Id in RFC's 3588 and RFC +%% 6733. %% =========================================================================== @@ -69,6 +76,11 @@ -define(REALM, "erlang.org"). -define(HOST(Name), Name ++ "." ++ ?REALM). +%% Application id's that are never agreed upon at capabilities +%% exchange. Testcase no_common_application references them in order +%% to exercise Vendor-Specific-Application-Id handling. +-define(NOAPPS, [1111, 2222, 3333, 4444]). + %% Config for diameter:start_service/2. -define(SERVICE, [{'Origin-Realm', ?REALM}, @@ -83,7 +95,10 @@ || {A,D} <- [{base3588, diameter_gen_base_rfc3588}, {acct3588, diameter_gen_base_accounting}, {base6733, diameter_gen_base_rfc6733}, - {acct6733, diameter_gen_acct_rfc6733}]]]). + {acct6733, diameter_gen_acct_rfc6733}]]] + ++ [{application, [{dictionary, dict(N)}, + {module, not_really}]} + || N <- ?NOAPPS]). -define(A, list_to_atom). -define(L, atom_to_list). @@ -116,6 +131,16 @@ groups() -> Tc = lists:flatmap(fun tc/1, tc()), [{D, [], Tc} || D <- ?DICTS]. +init_per_suite(Config) -> + lists:foreach(fun load_dict/1, ?NOAPPS), + Config. + +end_per_suite(_Config) -> + [] = [Mod || N <- ?NOAPPS, + Mod <- [dict(N)], + false <- [code:delete(Mod)]], + ok. + %% Generate a unique hostname for each testcase so that watchdogs %% don't prevent a connection from being brought up immediately. init_per_testcase(Name, Config) -> @@ -160,7 +185,7 @@ start(_Config) -> ok = diameter:start(). %% Ensure that both integer and list-valued vendor id's can be -%% configured in a 'Vendor-Specific-Application-Id, the arity having +%% configured in a Vendor-Specific-Application-Id, the arity having %% changed between RFC 3588 and RFC 6733. vendor_id(_Config) -> [] = ?util:run([[fun vid/1, V] || V <- [1, [1], [1,2], x]]). @@ -188,13 +213,13 @@ add_listeners(Config) -> Acct = [listen(?SERVER, [{capabilities, [{'Origin-Host', ?HOST(H)}, {'Auth-Application-Id', []}]}, - {applications, [A]}, + {applications, [A | noapps()]}, {capabilities_cb, [fun server_capx/3, acct]}]) || {A,H} <- [{acct3588, "acct3588-srv"}, {acct6733, "acct6733-srv"}]], Base = [listen(?SERVER, [{capabilities, [{'Origin-Host', ?HOST(H)}]}, - {applications, A}, + {applications, A ++ noapps()}, {capabilities_cb, [fun server_capx/3, base]}]) || {A,H} <- [{[base3588, acct3588], "base3588-srv"}, {[base6733, acct6733], "base6733-srv"}]], @@ -224,15 +249,33 @@ stop(_Config) -> %% DIAMETER_NO_COMMON_APPLICATION = 5010. s_no_common_application(Config) -> - server_closed(Config, fun no_common_application/1, 5010). + Vs = [[{'Vendor-Id', 111}, + {'Auth-Application-Id', [1111]}], + #'diameter_base_Vendor-Specific-Application-Id' + {'Vendor-Id' = [222], + 'Acct-Application-Id' = [2222]}], + server_closed(Config, + fun(C) -> no_common_application(C,Vs) end, + 5010). c_no_common_application(Config) -> - client_closed(Config, "acct-srv", fun no_common_application/1, 5010). - -no_common_application(Config) -> + Vs = [#'diameter_base_Vendor-Specific-Application-Id' + {'Vendor-Id' = 333, + 'Auth-Application-Id' = [3333]}, + [{'Vendor-Id', [444]}, + {'Acct-Application-Id', [4444]}]], + client_closed(Config, + "acct-srv", + fun(C) -> no_common_application(C,Vs) end, + 5010). + +no_common_application(Config, Vs) -> [Common, _Acct] = apps(Config), - connect(Config, acct, [{capabilities, [{'Acct-Application-Id', []}]}, - {applications, [Common]}]). + connect(Config, + acct, + [{capabilities, [{'Acct-Application-Id', []}, + {'Vendor-Specific-Application-Id', Vs}]}, + {applications, [Common | noapps()]}]). %% ==================== %% Ask the base server to speak accounting with an unknown security @@ -324,6 +367,25 @@ client_reject(Config) -> %% =========================================================================== +noapps() -> + lists:map(fun dict/1, ?NOAPPS). + +dict(N) -> + ?A(?L(?MODULE) ++ "_" ++ integer_to_list(N)). + +%% Compile and load minimal dictionary modules. These actually have to +%% exists since diameter will call their id/0 to extract application +%% id's, failing with app_not_configured if it can't. +load_dict(N) -> + Mod = dict(N), + Forms = [{attribute, 1, module, Mod}, + {attribute, 2, compile, [export_all]}, + {function, 3, id, 0, + [{clause, 4, [], [], [{integer, 4, N}]}]}], + {ok, Mod, Bin, []} = compile:forms(Forms, [return]), + {module, Mod} = code:load_binary(Mod, Mod, Bin), + N = Mod:id(). + %% server_closed/3 server_closed(Config, F, RC) -> diff --git a/lib/diameter/test/diameter_codec_SUITE.erl b/lib/diameter/test/diameter_codec_SUITE.erl index 2e219bbb10..cd8ca41f66 100644 --- a/lib/diameter/test/diameter_codec_SUITE.erl +++ b/lib/diameter/test/diameter_codec_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 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..cdf0cf55e1 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 @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -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..75b542b679 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, @@ -147,7 +149,7 @@ to_erl(File, Opts) -> No -> throw({make, No}) end. - + to_beam(Name) -> case compile:file(Name ++ ".erl", [return]) of {ok, _, _} -> @@ -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..a97c54fc04 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, @@ -168,7 +171,8 @@ {'Product-Name', "OTP/diameter"}, {'Auth-Application-Id', [?DIAMETER_APP_ID_COMMON]}, {'Acct-Application-Id', [?DIAMETER_APP_ID_ACCOUNTING]}, - {restrict_connections, false} + {restrict_connections, false}, + {spawn_opt, [{min_heap_size, 5000}]} | [{application, [{dictionary, D}, {module, ?MODULE}, {answer_errors, callback}]} @@ -268,9 +272,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, @@ -315,6 +322,7 @@ add_transports(Config) -> LRef = ?util:listen(?SERVER, tcp, [{capabilities_cb, fun capx/2}, + {spawn_opt, [{min_heap_size, 8096}]}, {applications, apps(rfc3588)}]), Cs = [?util:connect(?CLIENT, tcp, @@ -405,7 +413,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 +424,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 +464,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 +490,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 +527,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 +583,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 +591,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 +599,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 +714,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 +798,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 +820,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 +835,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 +899,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 +977,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 +993,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 +1010,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 +1140,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/diameter_util.erl b/lib/diameter/test/diameter_util.erl index aa489fef5f..92c72c84e7 100644 --- a/lib/diameter/test/diameter_util.erl +++ b/lib/diameter/test/diameter_util.erl @@ -336,7 +336,7 @@ opts(Prot, T) -> {transport_config, [{ip, ?ADDR}, {port, 0} | opts(T)]}]. opts(listen) -> - []; + [{accept, M} || M <- [{256,0,0,1}, ["256.0.0.1", ["^.+$"]]]]; opts(PortNr) -> [{raddr, ?ADDR}, {rport, PortNr}]. 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/diameter/vsn.mk b/lib/diameter/vsn.mk index 757f29a32e..f7462c3916 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -18,5 +18,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.4.1.1 +DIAMETER_VSN = 1.4.2 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml index 4c0267c264..2fdc839c7b 100644 --- a/lib/erl_interface/doc/src/notes.xml +++ b/lib/erl_interface/doc/src/notes.xml @@ -30,6 +30,22 @@ </header> <p>This document describes the changes made to the Erl_interface application.</p> +<section><title>Erl_Interface 3.7.13</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + A guard was added to check if file descriptor is valid + before closing it.</p> + <p> + Own Id: OTP-11167</p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.7.12</title> <section><title>Fixed Bugs and Malfunctions</title> 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/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index 9287e105df..6f08d380ca 100644 --- a/lib/erl_interface/vsn.mk +++ b/lib/erl_interface/vsn.mk @@ -1 +1 @@ -EI_VSN = 3.7.12 +EI_VSN = 3.7.13 diff --git a/lib/et/doc/src/et_desc.xmlsrc b/lib/et/doc/src/et_desc.xmlsrc index 36274f6316..68017b972e 100644 --- a/lib/et/doc/src/et_desc.xmlsrc +++ b/lib/et/doc/src/et_desc.xmlsrc @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2002</year><year>2010</year> + <year>2002</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/et/doc/src/notes.xml b/lib/et/doc/src/notes.xml index 8d9675b801..d45d0a89bf 100644 --- a/lib/et/doc/src/notes.xml +++ b/lib/et/doc/src/notes.xml @@ -36,6 +36,29 @@ one section in this document. The title of each section is the version number of <c>Event Tracer (ET)</c>.</p> +<section><title>ET 1.4.4.4</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Use erlang:demonitor(Ref, [flush]) where applicable. + Thanks to Lo�c Hoguin.</p> + <p> + Own Id: OTP-11039</p> + </item> + <item> + <p> + Rename and document lists:zf/2 as lists:filtermap/2. + Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11078</p> + </item> + </list> + </section> + +</section> + <section><title>ET 1.4.4.3</title> <section><title>Improvements and New Features</title> diff --git a/lib/et/src/et_collector.erl b/lib/et/src/et_collector.erl index ce8cf6d4e0..a78b30c419 100644 --- a/lib/et/src/et_collector.erl +++ b/lib/et/src/et_collector.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2010. 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 diff --git a/lib/et/vsn.mk b/lib/et/vsn.mk index 99532ee3f3..40cdc2b298 100644 --- a/lib/et/vsn.mk +++ b/lib/et/vsn.mk @@ -1 +1 @@ -ET_VSN = 1.4.4.3 +ET_VSN = 1.4.4.4 diff --git a/lib/hipe/doc/src/hipe_app.xml b/lib/hipe/doc/src/hipe_app.xml index 9a1aa943d4..0612392c3f 100644 --- a/lib/hipe/doc/src/hipe_app.xml +++ b/lib/hipe/doc/src/hipe_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>1997</year><year>2010</year> + <year>1997</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/hipe/doc/src/notes.xml b/lib/hipe/doc/src/notes.xml index 73ab1dbfda..b3c41bd396 100644 --- a/lib/hipe/doc/src/notes.xml +++ b/lib/hipe/doc/src/notes.xml @@ -30,6 +30,36 @@ </header> <p>This document describes the changes made to HiPE.</p> +<section><title>Hipe 3.10.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix the title of hipe_app documentation page. Thanks to + Lo�c Hoguin.</p> + <p> + Own Id: OTP-10904</p> + </item> + <item> + <p> + Fix native code compiler crash involving bs_match_string. + Thanks to Kostis Sagonas.</p> + <p> + Own Id: OTP-10985</p> + </item> + <item> + <p> + Loosen the assumptions of code that handles escaping + functions. Thanks to Kostis Sagonas</p> + <p> + Own Id: OTP-11031</p> + </item> + </list> + </section> + +</section> + <section><title>Hipe 3.10.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/hipe/icode/Makefile b/lib/hipe/icode/Makefile index 238f70cf59..87015aa51c 100644 --- a/lib/hipe/icode/Makefile +++ b/lib/hipe/icode/Makefile @@ -1,7 +1,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 diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl index dfea092af2..6d4758bbf1 100644 --- a/lib/hipe/icode/hipe_icode.erl +++ b/lib/hipe/icode/hipe_icode.erl @@ -2,7 +2,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 diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl index 89d297ef01..060493e61e 100644 --- a/lib/hipe/icode/hipe_icode.hrl +++ b/lib/hipe/icode/hipe_icode.hrl @@ -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 diff --git a/lib/hipe/icode/hipe_icode_callgraph.erl b/lib/hipe/icode/hipe_icode_callgraph.erl index 6d004823e2..5789328f47 100644 --- a/lib/hipe/icode/hipe_icode_callgraph.erl +++ b/lib/hipe/icode/hipe_icode_callgraph.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. 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 diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl index 46c5a39f2c..1a2cbfae31 100644 --- a/lib/hipe/icode/hipe_icode_range.erl +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -2,7 +2,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 diff --git a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl index 718d5d442b..2337ef9323 100644 --- a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl +++ b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. 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 diff --git a/lib/hipe/regalloc/hipe_ls_regalloc.erl b/lib/hipe/regalloc/hipe_ls_regalloc.erl index 7fb65be6a0..4276b8f968 100644 --- a/lib/hipe/regalloc/hipe_ls_regalloc.erl +++ b/lib/hipe/regalloc/hipe_ls_regalloc.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. 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 diff --git a/lib/hipe/rtl/Makefile b/lib/hipe/rtl/Makefile index 0312e67822..751e87636a 100644 --- a/lib/hipe/rtl/Makefile +++ b/lib/hipe/rtl/Makefile @@ -1,7 +1,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 diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk index 6cd87708ef..deb16b02fd 100644 --- a/lib/hipe/vsn.mk +++ b/lib/hipe/vsn.mk @@ -1 +1 @@ -HIPE_VSN = 3.10.1 +HIPE_VSN = 3.10.2 diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml index 92cc7cab7a..c93528ace4 100644 --- a/lib/ic/doc/src/notes.xml +++ b/lib/ic/doc/src/notes.xml @@ -30,7 +30,23 @@ <file>notes.xml</file> </header> - <section><title>IC 4.3.1</title> + <section><title>IC 4.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed some compilation warnings on miscellaneous + platforms. Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11086</p> + </item> + </list> + </section> + +</section> + +<section><title>IC 4.3.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> 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..420067fa09 100644 --- a/lib/ic/src/icparse.yrl +++ b/lib/ic/src/icparse.yrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -230,6 +230,9 @@ Terminals Rootsymbol '<specification>'. +Expect 9. + + %%------------------------------------------------------------ %% Clauses %% diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index 9fd8aedb63..53b81ad731 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1 +1 @@ -IC_VSN = 4.3.1 +IC_VSN = 4.3.2 diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 525beecd31..d2e7ade5d6 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,9 +32,66 @@ <file>notes.xml</file> </header> - - <section><title>Inets 5.9.4</title> + <section><title>Inets 5.9.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Reverted incorrect commit that broke cookie handling when + using httpc-profiles.</p> + <p> + Own Id: OTP-10956</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix http_request:http_headers/1 to send content-length + when length is zero. Thanks to CA Meijer.</p> + <p> + Own Id: OTP-10934</p> + </item> + <item> + <p> + Integrate elliptic curve contribution from Andreas + Schultz </p> + <p> + In order to be able to support elliptic curve cipher + suites in SSL/TLS, additions to handle elliptic curve + infrastructure has been added to public_key and crypto.</p> + <p> + This also has resulted in a rewrite of the crypto API to + gain consistency and remove unnecessary overhead. All OTP + applications using crypto has been updated to use the new + API.</p> + <p> + Impact: Elliptic curve cryptography (ECC) offers + equivalent security with smaller key sizes than other + public key algorithms. Smaller key sizes result in + savings for power, memory, bandwidth, and computational + cost that make ECC especially attractive for constrained + environments.</p> + <p> + Own Id: OTP-11009</p> + </item> + <item> + <p> + Fix {stream, {self, once}} in httpc to work as expected. + Thanks to Masatake Daimon</p> + <p> + Own Id: OTP-11122</p> + </item> + </list> + </section> +</section> + +<section><title>Inets 5.9.4</title> <section><title>Improvements and New Features</title> <list> <item> @@ -102,6 +159,19 @@ </section> +<section><title>Inets 5.9.2.1</title> + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fixed obsolete error report in inets.</p> + <p> + Own Id: OTP-11185 Aux Id: seq12357 </p> + </item> + </list> + </section> +</section> + <section><title>Inets 5.9.2</title> <section><title>Improvements and New Features</title> diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 64a60b82aa..4d7023a8e9 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-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 @@ -175,7 +175,7 @@ request(Method, request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) - when ((Method =:= post) orelse (Method =:= put)) andalso + when ((Method =:= post) orelse (Method =:= put) orelse (Method =:= delete)) andalso (is_atom(Profile) orelse is_pid(Profile)) -> ?hcrt("request", [{method, Method}, {url, Url}, 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..d15d7ba49a 100644 --- a/lib/inets/src/http_lib/http_chunk.erl +++ b/lib/inets/src/http_lib/http_chunk.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. 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 @@ -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/src/http_lib/http_request.erl b/lib/inets/src/http_lib/http_request.erl index fbfbe7c632..aa9f9f6774 100644 --- a/lib/inets/src/http_lib/http_request.erl +++ b/lib/inets/src/http_lib/http_request.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. 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 diff --git a/lib/inets/src/http_server/httpd_manager.erl b/lib/inets/src/http_server/httpd_manager.erl index c83d06a158..00384fa108 100644 --- a/lib/inets/src/http_server/httpd_manager.erl +++ b/lib/inets/src/http_server/httpd_manager.erl @@ -507,37 +507,8 @@ code_change(_FromVsn, State, _Extra) -> check_connections(#state{connections = []} = State, _Pid, _Reason) -> State; -check_connections(#state{admin_state = shutting_down, - connections = Connections} = State, Pid, Reason) -> - %% Could be a crashing request handler - case lists:delete(Pid, Connections) of - [] -> % Crashing request handler => block complete - String = - lists:flatten( - io_lib:format("request handler (~p) crashed:" - "~n ~p", [Pid, Reason])), - report_error(State, String), - demonitor_blocker(State#state.blocker_ref), - {Tmr,From,Ref} = State#state.blocking_tmr, - stop_block_tmr(Tmr), - From ! {block_reply,ok,Ref}, - State#state{admin_state = blocked, connections = [], - blocker_ref = undefined}; - Connections1 -> - State#state{connections = Connections1} - end; -check_connections(#state{connections = Connections} = State, Pid, Reason) -> - case lists:delete(Pid, Connections) of - Connections -> % Not a request handler, so ignore - State; - NewConnections -> - String = - lists:flatten( - io_lib:format("request handler (~p) crashed:" - "~n ~p", [Pid, Reason])), - report_error(State, String), - State#state{connections = NewConnections} - end. +check_connections(#state{connections = Connections} = State, Pid, _Reason) -> + State#state{connections = lists:delete(Pid, Connections)}. %% ------------------------------------------------------------------------- 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/http_format_SUITE.erl b/lib/inets/test/http_format_SUITE.erl index c913964094..c5920a3968 100644 --- a/lib/inets/test/http_format_SUITE.erl +++ b/lib/inets/test/http_format_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. 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 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/inets/test/httpc_proxy_SUITE.erl b/lib/inets/test/httpc_proxy_SUITE.erl index 84db39e76b..ddd23d0c65 100644 --- a/lib/inets/test/httpc_proxy_SUITE.erl +++ b/lib/inets/test/httpc_proxy_SUITE.erl @@ -69,6 +69,7 @@ local_proxy_cases() -> http_post, http_put, http_delete, + http_delete_body, http_headers, http_proxy_auth, http_doesnotexist, @@ -262,6 +263,22 @@ http_delete(Config) when is_list(Config) -> %%-------------------------------------------------------------------- +http_delete_body(doc) -> + ["Perform a DELETE request with a content body. The server will not allow it " + "but we only test sending the request."]; +http_delete_body(Config) when is_list(Config) -> + Method = delete, + URL = url("/delete.html", Config), + Content = "foo=bar", + Request = {URL,[],"application/x-www-form-urlencoded",Content}, + HttpOpts = [], + Opts = [], + {ok,{{_,405,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + http_headers(doc) -> ["Use as many request headers as possible"]; http_headers(Config) when is_list(Config) -> diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index f5abaf9764..3f464c8684 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.9.4 +INETS_VSN = 5.9.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" 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/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index c18ae897b4..0175c38397 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -30,6 +30,91 @@ </header> <p>This document describes the changes made to the Kernel application.</p> +<section><title>Kernel 2.16.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A bug in prim_inet has been corrected. If the port owner + was killed at a bad time while closing the socket port + the port could become orphaned hence causing port and + socket leaking. Reported by Fred Herbert, Dmitry Belyaev + and others.</p> + <p> + Own Id: OTP-10497 Aux Id: OTP-10562 </p> + </item> + <item> + <p> + A few bugs regarding case sensitivity for hostname + resolution while using e.g the internal lookup types + 'file' and 'dns' has been corrected. When looking up + hostnames ASCII letters a-z are to be regarded as the + same as A-Z according to RFC 4343 "Domain Name System + (DNS) Case Insensitivity Clarification", and this was not + always the case.</p> + <p> + Own Id: OTP-10689 Aux Id: seq12227 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add <c>application:ensure_started/1,2</c>. It is + equivavlent to <c>application:start/1,2</c> except it + returns <c>ok</c> for already started applications.</p> + <p> + Own Id: OTP-10910</p> + </item> + <item> + <p> + Optimize communication with file io server. Thanks to + Anthony Ramine.</p> + <p> + Own Id: OTP-11040</p> + </item> + <item> + <p>Erlang source files with non-ASCII characters are now + encoded in UTF-8 (instead of latin1).</p> + <p> + Own Id: OTP-11041 Aux Id: OTP-10907 </p> + </item> + <item> + <p> + Optimization of simultaneous <c>inet_db</c> operations on + the same socket by using a lock free implementation.</p> + <p> + Impact on the characteristics of the system: Improved + performance.</p> + <p> + Own Id: OTP-11074</p> + </item> + <item> + <p> + The <c>high_msgq_watermark</c> and + <c>low_msgq_watermark</c> <c>inet</c> socket options + introduced in OTP-R16A could only be set on TCP sockets. + These options are now generic and can be set on all types + of sockets.</p> + <p> + Own Id: OTP-11075 Aux Id: OTP-10336 </p> + </item> + <item> + <p> + Fix deep list argument error under Windows in os:cmd/1. + Thanks to Aleksandr Vinokurov .</p> + <p> + Own Id: OTP-11104</p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 2.16.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/kernel/src/application_master.erl b/lib/kernel/src/application_master.erl index 34a3efcaf2..3e636197bb 100644 --- a/lib/kernel/src/application_master.erl +++ b/lib/kernel/src/application_master.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 diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl index 07fb55f390..0bcb1a658b 100644 --- a/lib/kernel/src/file_io_server.erl +++ b/lib/kernel/src/file_io_server.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 diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index 74ad192802..58d84ae924 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.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 @@ -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..e82b11d2ef 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -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..3ea530a366 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -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): @@ -946,21 +947,34 @@ gethostbyname_self(Name, Type) when is_atom(Name) -> gethostbyname_self(Name, Type) when is_list(Name), Type =:= inet; is_list(Name), Type =:= inet6 -> - case inet_db:gethostname() of - Name -> - {ok,make_hostent(Name, - [translate_ip(loopback, Type)], - [], Type)}; - Self -> + N = inet_db:tolower(Name), + Self = inet_db:gethostname(), + %% + %% This is the final fallback that pretends /etc/hosts has got + %% a line for the hostname on the loopback address. + %% Lookups into /etc/hosts are case insensitive and return + %% what is in the file. Therefore the letter case may differ between + %% the returned hostent record and the hostname that was asked for. + %% + case inet_db:tolower(Self) of + N -> + {ok, + make_hostent( + Self, [translate_ip(loopback, Type)], [], Type)}; + _ -> case inet_db:res_option(domain) of - "" -> {error,nxdomain}; + "" -> + {error,nxdomain}; Domain -> - case lists:append([Self,".",Domain]) of - Name -> - {ok,make_hostent(Name, - [translate_ip(loopback, Type)], - [], Type)}; - _ -> {error,nxdomain} + FQDN = lists:append([Self,".",Domain]), + case inet_db:tolower(FQDN) of + N -> + {ok, + make_hostent( + FQDN, + [translate_ip(loopback, Type)], [], Type)}; + _ -> + {error,nxdomain} end end end; diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index d4749b9756..a7679c531b 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -845,7 +845,8 @@ init([]) -> process_flag(trap_exit, true), Db = ets:new(inet_db, [public, named_table]), reset_db(Db), - Cache = ets:new(inet_cache, [public, bag, {keypos,2}, named_table]), + CacheOpts = [public, bag, {keypos,#dns_rr.domain}, named_table], + Cache = ets:new(inet_cache, CacheOpts), BynameOpts = [protected, bag, named_table, {keypos,1}], ByaddrOpts = [protected, bag, named_table, {keypos,3}], HostsByname = ets:new(inet_hosts_byname, BynameOpts), @@ -901,15 +902,21 @@ reset_db(Db) -> handle_call(Request, From, #state{db=Db}=State) -> case Request of {load_hosts_file,IPNmAs} when is_list(IPNmAs) -> - NIPs = lists:flatten([ [{N,if tuple_size(IP) =:= 4 -> inet; - tuple_size(IP) =:= 8 -> inet6 - end,IP} || N <- [Nm|As]] - || {IP,Nm,As} <- IPNmAs]), + NIPs = + lists:flatten( + [ [{N, + if tuple_size(IP) =:= 4 -> inet; + tuple_size(IP) =:= 8 -> inet6 + end,IP} || N <- [Nm|As]] + || {IP,Nm,As} <- IPNmAs]), Byname = State#state.hosts_file_byname, Byaddr = State#state.hosts_file_byaddr, ets:delete_all_objects(Byname), ets:delete_all_objects(Byaddr), - ets:insert(Byname, NIPs), + %% Byname has lowercased names while Byaddr keep the name casing. + %% This is to be able to reconstruct the original + %% /etc/hosts entry. + ets:insert(Byname, [{tolower(N),Type,IP} || {N,Type,IP} <- NIPs]), ets:insert(Byaddr, NIPs), {reply, ok, State}; @@ -938,16 +945,14 @@ handle_call(Request, From, #state{db=Db}=State) -> {reply, ok, State}; {add_rr, RR} when is_record(RR, dns_rr) -> - RR1 = lower_rr(RR), - ?dbg("add_rr: ~p~n", [RR1]), - do_add_rr(RR1, Db, State), + ?dbg("add_rr: ~p~n", [RR]), + do_add_rr(RR, Db, State), {reply, ok, State}; {del_rr, RR} when is_record(RR, dns_rr) -> - RR1 = lower_rr(RR), %% note. del_rr will handle wildcards !!! Cache = State#state.cache, - ets:match_delete(Cache, RR1), + ets:match_delete(Cache, RR), {reply, ok, State}; {lookup_rr, Domain, Class, Type} -> @@ -1225,15 +1230,18 @@ handle_set_file(ParseFun, Bin, From, State) -> handle_rc_list(Opts, From, State) end. +%% Byname has lowercased names while Byaddr keep the name casing. +%% This is to be able to reconstruct the original /etc/hosts entry. + do_add_host(Byname, Byaddr, Names, Type, IP) -> do_del_host(Byname, Byaddr, IP), - NIPs = [{tolower(N),Type,IP} || N <- Names], - ets:insert(Byname, NIPs), - ets:insert(Byaddr, NIPs), + ets:insert(Byname, [{tolower(N),Type,IP} || N <- Names]), + ets:insert(Byaddr, [{N,Type,IP} || N <- Names]), ok. do_del_host(Byname, Byaddr, IP) -> - [ets:delete_object(Byname, NIP) || NIP <- ets:lookup(Byaddr, IP)], + [ets:delete_object(Byname, {tolower(Name),Type,Addr}) || + {Name,Type,Addr} <- ets:lookup(Byaddr, IP)], ets:delete(Byaddr, IP), ok. @@ -1369,7 +1377,7 @@ times() -> %% lookup and remove old entries do_lookup_rr(Domain, Class, Type) -> - match_rr(#dns_rr{domain = tolower(Domain), class = Class,type = Type, + match_rr(#dns_rr{domain = Domain, class = Class,type = Type, cnt = '_', tm = '_', ttl = '_', bm = '_', func = '_', data = '_'}). @@ -1393,23 +1401,20 @@ filter_rr([], _Time) -> []. %% -%% Lower case the domain name before storage -%% -lower_rr(RR) -> - Dn = RR#dns_rr.domain, - if is_list(Dn) -> - RR#dns_rr { domain = tolower(Dn) }; - true -> RR - end. - +%% Case fold upper-case to lower-case according to RFC 4343 +%% "Domain Name System (DNS) Case Insensitivity Clarification". %% -%% Map upper-case to lower-case %% NOTE: this code is in kernel and we don't want to relay -%% to much on stdlib +%% to much on stdlib. Furthermore string:to_lower/1 +%% does not follow RFC 4343. %% tolower([]) -> []; -tolower([C|Cs]) when C >= $A, C =< $Z -> [(C-$A)+$a|tolower(Cs)]; -tolower([C|Cs]) -> [C|tolower(Cs)]. +tolower([C|Cs]) when is_integer(C) -> + if C >= $A, C =< $Z -> + [(C-$A)+$a|tolower(Cs)]; + true -> + [C|tolower(Cs)] + end. dn_ip6_int(A,B,C,D,E,F,G,H) -> dnib(H) ++ dnib(G) ++ dnib(F) ++ dnib(E) ++ diff --git a/lib/kernel/src/inet_gethost_native.erl b/lib/kernel/src/inet_gethost_native.erl index df866660b4..65d4c84e3b 100644 --- a/lib/kernel/src/inet_gethost_native.erl +++ b/lib/kernel/src/inet_gethost_native.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. 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 diff --git a/lib/kernel/src/inet_hosts.erl b/lib/kernel/src/inet_hosts.erl index df1d4fc0be..6e9719b4aa 100644 --- a/lib/kernel/src/inet_hosts.erl +++ b/lib/kernel/src/inet_hosts.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -38,9 +38,12 @@ gethostbyname(_) -> {error, formerr}. gethostbyname(Name, Type) when is_list(Name), is_atom(Type) -> - case gethostbyname(Name, Type, inet_hosts_byname, inet_hosts_byaddr) of + %% Byname has lowercased names while Byaddr keep the name casing. + %% This is to be able to reconstruct the original /etc/hosts entry. + N = inet_db:tolower(Name), + case gethostbyname(N, Type, inet_hosts_byname, inet_hosts_byaddr) of false -> - case gethostbyname(Name, Type, + case gethostbyname(N, Type, inet_hosts_file_byname, inet_hosts_file_byaddr) of false -> {error,nxdomain}; diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl index 000119bc74..67a99913a1 100644 --- a/lib/kernel/src/inet_int.hrl +++ b/lib/kernel/src/inet_int.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -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/inet_res.erl b/lib/kernel/src/inet_res.erl index 59ba408d7a..94a9f7c64d 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-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,8 +181,8 @@ lookup(Name, Class, Type, Opts, Timeout) -> lookup_filter({ok,#dns_rec{anlist=Answers}}, Class, Type) -> [A#dns_rr.data || A <- Answers, - A#dns_rr.class =:= Class, - A#dns_rr.type =:= Type]; + Class =:= any orelse A#dns_rr.class =:= Class, + Type =:= any orelse A#dns_rr.type =:= Type]; lookup_filter({error,_}, _, _) -> []. %% -------------------------------------------------------------------------- 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/src/rpc.erl b/lib/kernel/src/rpc.erl index 83e0b59cc2..ced6f47bfe 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.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 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_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl index c5d8becfd3..e89cb44797 100644 --- a/lib/kernel/test/gen_sctp_SUITE.erl +++ b/lib/kernel/test/gen_sctp_SUITE.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 diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 6b672004ec..ee271fbdfa 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2012. 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 @@ -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/global_SUITE_data/global_trace.erl b/lib/kernel/test/global_SUITE_data/global_trace.erl index ddbe608c0a..00bacf8f54 100644 --- a/lib/kernel/test/global_SUITE_data/global_trace.erl +++ b/lib/kernel/test/global_SUITE_data/global_trace.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. 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 diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index 1f7724d0dc..62ba95e1a3 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -183,80 +183,74 @@ t_gethostbyname(Config) when is_list(Config) -> h_addr_list = [IP]}, ?line HEntF_ = HEntF, ?line check_elems([{HEnt#hostent.h_aliases,[[],Aliases]}]), + %% + ?line FullNameU = toupper(FullName), + ?line {ok,HEntU} = inet:gethostbyname(FullNameU), + ?line FullNameU = toupper(HEntU#hostent.h_name), + ?line #hostent{ + h_addrtype = inet, + h_length = 4, + h_addr_list = [IP]} = HEntU, + ?line check_elems( + [{[toupper(H) || H <- HEntU#hostent.h_aliases], + [[],[toupper(A) || A <- Aliases]]}]), ?line {DName, _DFullName, _DIPStr, _DIP, _, _, _} = ct:get_config(test_dummy_host), ?line {error,nxdomain} = inet:gethostbyname(DName), - ?line {error,nxdomain} = inet:gethostbyname(IP_46_Str). + ?line {error,nxdomain} = inet:gethostbyname(IP_46_Str), + ok. t_gethostbyname_v6() -> required(v6). t_gethostbyname_v6(doc) -> "Test the inet:gethostbyname/1 inet6 function."; t_gethostbyname_v6(suite) -> []; t_gethostbyname_v6(Config) when is_list(Config) -> - ?line {Name, _, _, _,Aliases,IP_46_Str,IP_46} = - ct:get_config(test_host_ipv4_only), + {Name, FullName, IPStr, IP, Aliases} = + ct:get_config(test_host_ipv6_only), - case {inet:gethostbyname(IP_46_Str, inet6), - inet:gethostbyname(Name, inet6)} of - {{ok,HEnt46},{ok,_}} -> - ?line HEnt46_ = HEnt46#hostent{h_name = IP_46_Str, - h_addrtype = inet6, - h_length = 16, - h_addr_list = [IP_46]}, - ?line HEnt46_ = HEnt46, - ?line check_elems([{HEnt46#hostent.h_aliases,[[],Aliases]}]), - - ?line {Name6, FullName6, IPStr6, IP6, Aliases6} = - ct:get_config(test_host_ipv6_only), - ?line {ok,_} = inet:gethostbyname(IPStr6, inet6), - ?line {ok,HEnt6} = inet:gethostbyname(Name6, inet6), - ?line {ok,HEnt6} = inet:gethostbyname(list_to_atom(Name6), inet6), - ?line case HEnt6#hostent.h_addr_list of - [IP6] -> % ipv6 ok - ?line HEnt6_ = HEnt6#hostent{h_addrtype = inet6, - h_length = 16, - h_addr_list = [IP6]}, - ?line HEnt6_ = HEnt6, - ?line check_elems([{HEnt6#hostent.h_name,[Name6,FullName6]}, - {HEnt6#hostent.h_aliases,[[],Aliases6]}]); - _ -> % ipv4 compatible addr - ?line {ok,HEnt4} = inet:gethostbyname(Name6, inet), - ?line [IP4] = HEnt4#hostent.h_addr_list, - ?line {ok,IP46_2} = - inet_parse:ipv6_address("::ffff:"++inet_parse:ntoa(IP4)), - ?line HEnt6_ = HEnt6#hostent{h_addrtype = inet6, - h_length = 16, - h_addr_list = [IP46_2]}, - ?line HEnt6_ = HEnt6, - ?line check_elems([{HEnt6#hostent.h_name,[Name6,FullName6]}]) - end, - - ?line {ok,HEntF6} = inet:gethostbyname(FullName6, inet6), - ?line case HEntF6#hostent.h_addr_list of - [IP6] -> % ipv6 ok - ?line HEntF6_ = HEntF6#hostent{h_name = FullName6, - h_addrtype = inet6, - h_length = 16, - h_addr_list = [IP6]}, - ?line HEntF6_ = HEntF6, - ?line check_elems([{HEntF6#hostent.h_aliases,[[],Aliases6]}]); - _ -> % ipv4 compatible addr - ?line {ok,HEntF4} = inet:gethostbyname(FullName6, inet), - ?line [IPF4] = HEntF4#hostent.h_addr_list, - ?line {ok,IPF46_2} = - inet_parse:ipv6_address("::ffff:"++inet_parse:ntoa(IPF4)), - ?line HEntF6_ = HEntF6#hostent{h_addrtype = inet6, - h_length = 16, - h_addr_list = [IPF46_2]}, - ?line HEntF6_ = HEntF6, - ?line check_elems([{HEntF6#hostent.h_name,[Name6,FullName6]}]) - end, - - ?line {DName6, _DFullName6, _DIPStr6, _DIP6, _} = - ct:get_config(test_dummy_ipv6_host), - ?line {error,nxdomain} = inet:gethostbyname(DName6, inet6), - ok; - {_,_} -> + case inet:gethostbyname(Name, inet6) of + {ok,HEnt} -> + {ok,_} = inet:gethostbyname(IPStr, inet6), + {ok,HEnt} = inet:gethostbyname(list_to_atom(Name), inet6), + case HEnt#hostent.h_addr_list of + [IP] -> % IPv6 address + #hostent{h_addrtype = inet6, + h_length = 16} = HEnt, + check_elems( + [{HEnt#hostent.h_name,[Name,FullName]}, + {HEnt#hostent.h_aliases,[[],Aliases]}]); + [IP46] -> % IPv4 compatible address + {ok,HEnt4} = inet:gethostbyname(Name, inet), + #hostent{h_addrtype = inet, + h_length = 4, + h_addr_list = [IP4]} = HEnt4, + {ok,IP46} = + inet_parse:ipv6_address( + "::ffff:" ++ inet_parse:ntoa(IP4)), + check_elems( + [{HEnt#hostent.h_name,[Name,FullName]}]) + end, + + {ok,HEntF} = inet:gethostbyname(FullName, inet6), + case HEntF#hostent.h_addr_list of + [IP] -> % IPv6 address + #hostent{h_name = FullName, + h_addrtype = inet6, + h_length = 16} = HEntF, + check_elems( + [{HEnt#hostent.h_aliases,[[],Aliases]}]); + [IP46F] -> % IPv4 compatible address + {ok,HEnt4F} = inet:gethostbyname(FullName, inet), + #hostent{h_addrtype = inet, + h_length = 4, + h_addr_list = [IP4F]} = HEnt4F, + {ok,IP46F} = + inet_parse:ipv6_address( + "::ffff:" ++ inet_parse:ntoa(IP4F)), + check_elems( + [{HEntF#hostent.h_name,[Name,FullName]}]) + end; + _ -> {skip, "IPv6 is not supported on this host"} end. @@ -290,47 +284,35 @@ t_getaddr(Config) when is_list(Config) -> ?line {error,nxdomain} = inet:getaddr(DName, inet), ?line {error,nxdomain} = inet:getaddr(DFullName, inet), ?line {ok,DIP} = inet:getaddr(DIPStr, inet), - ?line {ok,DIP} = inet:getaddr(DIP, inet). + ?line {ok,DIP} = inet:getaddr(DIP, inet), + ok. t_getaddr_v6() -> required(v4) ++ required(v6). t_getaddr_v6(doc) -> "Test the inet:getaddr/2 function."; t_getaddr_v6(suite) -> []; t_getaddr_v6(Config) when is_list(Config) -> - ?line {Name,FullName,IPStr,_IP,_,IP_46_Str,IP46} = - ct:get_config(test_host_ipv4_only), - case {inet:getaddr(IP_46_Str, inet6),inet:getaddr(Name, inet6)} of - {{ok,IP46},{ok,V4Addr}} when V4Addr /= {0,0,0,0,0,0,0,1} -> - %% Since we suceeded in parsing an IPv6 address string and - %% look up the name, this computer fully supports IPv6. - ?line {ok,IP46} = inet:getaddr(IP46, inet6), - ?line {ok,IP46} = inet:getaddr(Name, inet6), - ?line {ok,IP46} = inet:getaddr(FullName, inet6), - ?line {ok,IP46} = inet:getaddr(IPStr, inet6), -%% ?line IP4toIP6 = inet:getaddr(IPStr, inet6), -%% ?line case IP4toIP6 of -%% {ok,IP46} -> -%% ?line ok; -%% {error,nxdomain} -> -%% ?line false = -%% lists:member(native, -%% inet_db:res_option(lookup)) -%% end, - ?line {Name6, FullName6, IPStr6, IP6, _} = - ct:get_config(test_host_ipv6_only), - ?line {ok,_} = inet:getaddr(list_to_atom(Name6), inet6), - ?line {ok,_} = inet:getaddr(Name6, inet6), - ?line {ok,_} = inet:getaddr(FullName6, inet6), - ?line {ok,IP6} = inet:getaddr(IP6, inet6), - ?line {ok,IP6} = inet:getaddr(IPStr6, inet6), - - ?line {DName6, DFullName6, DIPStr6, DIP6, _} = + {Name,FullName,IPStr,IP,_} = + ct:get_config(test_host_ipv6_only), + + case inet:getaddr(Name, inet6) of + {ok,Addr} -> + IP = Addr, + {ok,IP} = inet:getaddr(toupper(Name), inet6), + {ok,IP} = inet:getaddr(list_to_atom(Name), inet6), + {ok,IP} = inet:getaddr(list_to_atom(toupper(Name)), inet6), + {ok,IP} = inet:getaddr(FullName, inet6), + {ok,IP} = inet:getaddr(toupper(FullName), inet6), + {ok,IP} = inet:getaddr(IP, inet6), + {ok,IP} = inet:getaddr(IPStr, inet6), + %% + {DName,DFullName,DIPStr,DIP,_} = ct:get_config(test_dummy_ipv6_host), - ?line {error,nxdomain} = inet:getaddr(DName6, inet6), - ?line {error,nxdomain} = inet:getaddr(DFullName6, inet6), - ?line {ok,DIP6} = inet:getaddr(DIPStr6, inet6), - ?line {ok,DIP6} = inet:getaddr(DIP6, inet6), + {error,nxdomain} = inet:getaddr(DName, inet6), + {error,nxdomain} = inet:getaddr(DFullName, inet6), + {ok,DIP} = inet:getaddr(DIPStr, inet6), + {ok,DIP} = inet:getaddr(DIP, inet6), ok; - {_,_} -> + _ -> {skip, "IPv6 is not supported on this host"} end. @@ -608,8 +590,12 @@ t_parse_address(Func, [String|L]) -> t_parse_address(Func, L). parse_strict_address(Config) when is_list(Config) -> - {ok, Ipv4} = inet:parse_strict_address("127.0.0.1"), - {ok, Ipv6} = inet:parse_strict_address("c11:0c22:5c33:c440:55c0:c66c:77:0088"). + {ok, {127,0,0,1}} = + inet:parse_strict_address("127.0.0.1"), + {ok, {3089,3106,23603,50240,21952,50796,119,136}} = + inet:parse_strict_address("c11:0c22:5c33:c440:55c0:c66c:77:0088"), + {ok, {3089,3106,23603,50240,0,0,119,136}} = + inet:parse_strict_address("c11:0c22:5c33:c440::077:0088"). t_gethostnative(suite) ->[]; t_gethostnative(doc) ->[]; @@ -1102,3 +1088,14 @@ ip_member({127,_,_,_}, [{127,_,_,_}|_]) -> true; ip_member(K, [K|_]) -> true; ip_member(K, [_|T]) -> ip_member(K, T); ip_member(_, []) -> false. + +%% Case fold to upper case according to RFC 4343 +%% +toupper([C|Cs]) when is_integer(C) -> + if $a =< C, C =< $z -> + [(C - $a + $A)|toupper(Cs)]; + true -> + [C|toupper(Cs)] + end; +toupper([]) -> + []. diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index f3ba28e4f9..1bc93e3138 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2011. All Rights Reserved. +%% Copyright Ericsson AB 2009-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 @@ -282,6 +282,7 @@ basic(doc) -> basic(Config) when is_list(Config) -> NS = ns(Config), Name = "ns.otptest", + NameC = caseflip(Name), IP = {127,0,0,254}, %% %% nslookup @@ -292,6 +293,17 @@ basic(Config) when is_list(Config) -> Bin1 = inet_dns:encode(Msg1), %%io:format("Bin1 = ~w~n", [Bin1]), {ok,Msg1} = inet_dns:decode(Bin1), + %% Now with scrambled case + {ok,Msg1b} = inet_res:nslookup(NameC, in, a, [NS]), + io:format("~p~n", [Msg1b]), + [RR1b] = inet_dns:msg(Msg1b, anlist), + IP = inet_dns:rr(RR1b, data), + Bin1b = inet_dns:encode(Msg1b), + %%io:format("Bin1b = ~w~n", [Bin1b]), + {ok,Msg1b} = inet_dns:decode(Bin1b), + true = + (tolower(inet_dns:rr(RR1, domain)) + =:= tolower(inet_dns:rr(RR1b, domain))), %% %% resolve {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]},verbose]), @@ -301,15 +313,29 @@ basic(Config) when is_list(Config) -> Bin2 = inet_dns:encode(Msg2), %%io:format("Bin2 = ~w~n", [Bin2]), {ok,Msg2} = inet_dns:decode(Bin2), + %% Now with scrambled case + {ok,Msg2b} = inet_res:resolve(NameC, in, a, [{nameservers,[NS]},verbose]), + io:format("~p~n", [Msg2b]), + [RR2b] = inet_dns:msg(Msg2b, anlist), + IP = inet_dns:rr(RR2b, data), + Bin2b = inet_dns:encode(Msg2b), + %%io:format("Bin2b = ~w~n", [Bin2b]), + {ok,Msg2b} = inet_dns:decode(Bin2b), + true = + (tolower(inet_dns:rr(RR2, domain)) + =:= tolower(inet_dns:rr(RR2b, domain))), %% %% lookup [IP] = inet_res:lookup(Name, in, a, [{nameservers,[NS]},verbose]), + [IP] = inet_res:lookup(NameC, in, a, [{nameservers,[NS]},verbose]), %% %% gethostbyname {ok,#hostent{h_addr_list=[IP]}} = inet_res:gethostbyname(Name), + {ok,#hostent{h_addr_list=[IP]}} = inet_res:gethostbyname(NameC), %% %% getbyname {ok,#hostent{h_addr_list=[IP]}} = inet_res:getbyname(Name, a), + {ok,#hostent{h_addr_list=[IP]}} = inet_res:getbyname(NameC, a), ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -317,63 +343,115 @@ basic(Config) when is_list(Config) -> resolve(doc) -> ["Lookup different records using resolve/2..4"]; resolve(Config) when is_list(Config) -> + Class = in, NS = ns(Config), Domain = "otptest", RDomain4 = "0.0.127.in-addr.arpa", RDomain6 = "0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa", Name = "resolve."++Domain, - L = [{in,a,Name,[{127,0,0,28}],undefined}, - {in,aaaa,Name,[{0,0,0,0,0,0,32512,28}],undefined}, - {in,cname,"cname."++Name,[Name],undefined}, - {in,a,"cname."++Name,[Name,{127,0,0,28}],undefined}, - {in,ns,"ns."++Name,[],[Name]}, - {in,soa,Domain,[],[{"ns.otptest","lsa.otptest",1,60,10,300,30}]}, + L = [{a,Name,[{a,{127,0,0,28}}],undefined}, + {aaaa,Name,[{aaaa,{0,0,0,0,0,0,32512,28}}],undefined}, + {cname,"cname."++Name,[{cname,Name}],undefined}, + {a,"cname."++Name,[{cname,Name},{a,{127,0,0,28}}],undefined}, + {ns,"ns."++Name,[],[{ns,Name}]}, + {soa,Domain,[],[{soa,{"ns.otptest","lsa.otptest",1,60,10,300,30}}]}, %% WKS: protocol TCP (6), services (bits) TELNET (23) and SMTP (25) - {in,wks,"wks."++Name,[{{127,0,0,28},6,<<0,0,1,64>>}],undefined}, - {in,ptr,"28."++RDomain4,[Name],undefined}, - {in,ptr,"c.1.0.0.0.0.f.7."++RDomain6,[Name],undefined}, - {in,hinfo,Name,[{"BEAM","Erlang/OTP"}],undefined}, - {in,mx,RDomain4,[{10,"mx."++Domain}],undefined}, - {in,srv,"_srv._tcp."++Name,[{10,3,4711,Name}],undefined}, - {in,naptr,"naptr."++Name, - [{10,5,"s","http","","_srv._tcp."++Name}],undefined}, - {in,txt,"txt."++Name, - [["Hej ","du ","glade "],["ta ","en ","spade!"]],undefined}, - {in,mb,"mb."++Name,["mx."++Name],undefined}, - {in,mg,"mg."++Name,["lsa."++Domain],undefined}, - {in,mr,"mr."++Name,["lsa."++Domain],undefined}, - {in,minfo,"minfo."++Name, - [{"minfo-owner."++Name,"minfo-bounce."++Name}],undefined}, - {in,any,"cname."++Name,[Name],undefined}, - {in,any,Name,[{127,0,0,28}, - {0,0,0,0,0,0,32512,28}, - {"BEAM","Erlang/OTP"}],undefined} + {wks,"wks."++Name,[{wks,{{127,0,0,28},6,<<0,0,1,64>>}}],undefined}, + {ptr,"28."++RDomain4,[{ptr,Name}],undefined}, + {ptr,"c.1.0.0.0.0.f.7."++RDomain6,[{ptr,Name}],undefined}, + {hinfo,Name,[{hinfo,{"BEAM","Erlang/OTP"}}],undefined}, + {mx,RDomain4,[{mx,{10,"mx."++Domain}}],undefined}, + {srv,"_srv._tcp."++Name,[{srv,{10,3,4711,Name}}],undefined}, + {naptr,"naptr."++Name, + [{naptr,{10,5,"s","http","","_srv._tcp."++Name}}], + undefined}, + {txt,"txt."++Name, + [{txt,["Hej ","du ","glade "]},{txt,["ta ","en ","spade!"]}], + undefined}, + {mb,"mb."++Name,[{mb,"mx."++Name}],undefined}, + {mg,"mg."++Name,[{mg,"Lsa."++Domain}],undefined}, + {mr,"mr."++Name,[{mr,"LSA."++Domain}],undefined}, + {minfo,"minfo."++Name, + [{minfo,{"minfo-OWNER."++Name,"MinfoBounce."++Name}}], + undefined}, + {any,"cname."++Name,[{cname,Name}],undefined}, + {any,Name, + [{a,{127,0,0,28}}, + {aaaa,{0,0,0,0,0,0,32512,28}}, + {hinfo,{"BEAM","Erlang/OTP"}}], + undefined} ], - resolve([{edns,false},{nameservers,[NS]}], L), - resolve([{edns,0},{nameservers,[NS]}], L). - -resolve(_Opts, []) -> ok; -resolve(Opts, [{Class,Type,Name,Answers,Authority}=Q|Qs]) -> + resolve(Class, [{edns,0},{nameservers,[NS]}], L), + resolve(Class, [{edns,false},{nameservers,[NS]}], L), + %% Again, to see ensure the cache does not mess things up + resolve(Class, [{edns,0},{nameservers,[NS]}], L), + resolve(Class, [{edns,false},{nameservers,[NS]}], L). + +resolve(_Class, _Opts, []) -> + ok; +resolve(Class, Opts, [{Type,Nm,Answers,Authority}=Q|Qs]) -> io:format("Query: ~p~nOptions: ~p~n", [Q,Opts]), - {ok,Msg} = inet_res:resolve(Name, Class, Type, Opts), + {Name,NameC} = + case erlang:phash2(Q) band 4 of + 0 -> + {Nm,caseflip(Nm)}; + _ -> + {caseflip(Nm),Nm} + end, AnList = if Answers =/= undefined -> - lists:sort(Answers); + normalize_answers(Answers); true -> undefined end, NsList = if Authority =/= undefined -> - lists:sort(Authority); + normalize_answers(Authority); true -> undefined end, - case {lists:sort - ([inet_dns:rr(RR, data) || RR <- inet_dns:msg(Msg, anlist)]), - lists:sort - ([inet_dns:rr(RR, data) || RR <- inet_dns:msg(Msg, nslist)])} of + {ok,Msg} = inet_res:resolve(Name, Class, Type, Opts), + check_msg(Class, Type, Msg, AnList, NsList), + {ok,MsgC} = inet_res:resolve(NameC, Class, Type, Opts), + check_msg(Class, Type, MsgC, AnList, NsList), + resolve(Class, Opts, Qs). + + + +normalize_answers(AnList) -> + lists:sort([normalize_answer(Answer) || Answer <- AnList]). + +normalize_answer({soa,{NS,HM,Ser,Ref,Ret,Exp,Min}}) -> + {tolower(NS),tolower_email(HM),Ser,Ref,Ret,Exp,Min}; +normalize_answer({mx,{Prio,DN}}) -> + {Prio,tolower(DN)}; +normalize_answer({srv,{Prio,Weight,Port,DN}}) -> + {Prio,Weight,Port,tolower(DN)}; +normalize_answer({naptr,{Order,Pref,Flags,Service,RE,Repl}}) -> + {Order,Pref,Flags,Service,RE,tolower(Repl)}; +normalize_answer({minfo,{RespM,ErrM}}) -> + {tolower_email(RespM),tolower_email(ErrM)}; +normalize_answer({T,MN}) when T =:= mg; T =:= mr -> + tolower_email(MN); +normalize_answer({T,DN}) when T =:= cname; T =:= ns; T =:= ptr; T =:= mb -> + tolower(DN); +normalize_answer(Answer) -> + Answer. + +check_msg(Class, Type, Msg, AnList, NsList) -> + io:format("check_msg Type: ~p, Msg: ~p~n.", [Type,Msg]), + case {normalize_answers( + [begin + Class = inet_dns:rr(RR, class), + {inet_dns:rr(RR, type),inet_dns:rr(RR, data)} + end || RR <- inet_dns:msg(Msg, anlist)]), + normalize_answers( + [begin + Class = inet_dns:rr(RR, class), + {inet_dns:rr(RR, type),inet_dns:rr(RR, data)} + end || RR <- inet_dns:msg(Msg, nslist)])} of {AnList,NsList} -> ok; {NsList,AnList} when Type =:= ns -> @@ -389,7 +467,7 @@ resolve(Opts, [{Class,Type,Name,Answers,Authority}=Q|Qs]) -> end, Buf = inet_dns:encode(Msg), {ok,Msg} = inet_dns:decode(Buf), - resolve(Opts, Qs). + ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -497,6 +575,7 @@ files_monitor(Config) when is_list(Config) -> do_files_monitor(Config) -> Dir = ?config(priv_dir, Config), {ok,Hostname} = inet:gethostname(), + io:format("Hostname = ~p.~n", [Hostname]), FQDN = case inet_db:res_option(domain) of "" -> @@ -504,11 +583,13 @@ do_files_monitor(Config) -> _ -> Hostname++"."++inet_db:res_option(domain) end, + io:format("FQDN = ~p.~n", [FQDN]), HostsFile = filename:join(Dir, "files_monitor_hosts"), ResolvConf = filename:join(Dir, "files_monitor_resolv.conf"), ok = inet_db:res_option(resolv_conf, ResolvConf), ok = inet_db:res_option(hosts_file, HostsFile), [] = inet_db:res_option(search), + %% The inet function will use its final fallback to find this host {ok,#hostent{h_name = Hostname, h_addrtype = inet, h_length = 4, @@ -521,6 +602,7 @@ do_files_monitor(Config) -> {error,nxdomain} = inet_res:gethostbyname(FQDN), {ok,{127,0,0,10}} = inet:getaddr("mx.otptest", inet), {ok,{0,0,0,0,0,0,32512,28}} = inet:getaddr("resolve.otptest", inet6), + %% The inet function will use its final fallback to find this host {ok,#hostent{h_name = Hostname, h_addrtype = inet6, h_length = 16, @@ -603,3 +685,41 @@ ipv4_to_ipv6() -> inet_SUITE:ipv4_to_ipv6(). ipv4_to_ipv6(Config) -> inet_SUITE:ipv4_to_ipv6(Config). host_and_addr() -> inet_SUITE:host_and_addr(). host_and_addr(Config) -> inet_SUITE:host_and_addr(Config). + + + +%% Case flip helper + +caseflip([C|Cs]) when is_integer(C), $a =< C, C =< $z -> + [(C - $a + $A)|caseflip_skip(Cs)]; +caseflip([C|Cs]) when is_integer(C), $A =< C, C =< $Z -> + [(C - $A + $a)|caseflip_skip(Cs)]; +caseflip([C|Cs]) -> + [C|caseflip(Cs)]; +caseflip([]) -> + []. + +caseflip_skip([C|Cs]) when is_integer(C), $a =< C, C =< $z -> + [C|caseflip(Cs)]; +caseflip_skip([C|Cs]) when is_integer(C), $A =< C, C =< $Z -> + [C|caseflip(Cs)]; +caseflip_skip([C|Cs]) -> + [C|caseflip_skip(Cs)]; +caseflip_skip([]) -> + []. + +tolower_email([$.|Cs]) -> + [$.|tolower(Cs)]; +tolower_email([C|Cs]) -> + [C|tolower_email(Cs)]. + +%% Case fold to lower case according to RFC 4343 +%% +tolower([C|Cs]) when is_integer(C) -> + if $A =< C, C =< $Z -> + [(C - $A + $a)|tolower(Cs)]; + true -> + [C|tolower(Cs)] + end; +tolower([]) -> + []. diff --git a/lib/kernel/test/inet_res_SUITE_data/otptest/named_inc.conf b/lib/kernel/test/inet_res_SUITE_data/otptest/named_inc.conf index 0b01b25204..2d68f6e59c 100644 --- a/lib/kernel/test/inet_res_SUITE_data/otptest/named_inc.conf +++ b/lib/kernel/test/inet_res_SUITE_data/otptest/named_inc.conf @@ -2,11 +2,11 @@ zone "." in { type master; file "root.zone"; }; -zone "0.0.127.in-addr.arpa" in { +zone "0.0.127.in-addr.arpa." in { type master; file "0.0.127.in-addr.arpa.zone"; }; -zone "0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa" in { +zone "0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa." in { type master; file "0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa.zone"; -};
\ No newline at end of file +}; diff --git a/lib/kernel/test/inet_res_SUITE_data/otptest/root.zone b/lib/kernel/test/inet_res_SUITE_data/otptest/root.zone index 11cba18d45..5a56eac95c 100644 --- a/lib/kernel/test/inet_res_SUITE_data/otptest/root.zone +++ b/lib/kernel/test/inet_res_SUITE_data/otptest/root.zone @@ -43,8 +43,8 @@ naptr.resolve.otptest IN NAPTR 10 5 "S" "HTTP" "" _srv._tcp.resolve.otptest txt.resolve.otptest IN TXT "Hej " "du " "glade " txt.resolve.otptest IN TXT "ta " "en " "spade!" mb.resolve.otptest IN MB mx.resolve.otptest -mg.resolve.otptest IN MG lsa.otptest -mr.resolve.otptest IN MR lsa.otptest -minfo.resolve.otptest IN MINFO minfo-owner.resolve.otptest minfo-bounce.resolve.otptest +mg.resolve.otptest IN MG Lsa.otptest +mr.resolve.otptest IN MR LSA.otptest +minfo.resolve.otptest IN MINFO minfo-OWNER.resolve.otptest MinfoBounce.resolve.otptest ns.otptest IN A 127.0.0.254 diff --git a/lib/kernel/test/inet_sockopt_SUITE.erl b/lib/kernel/test/inet_sockopt_SUITE.erl index 75496ce745..9d236a8a0a 100644 --- a/lib/kernel/test/inet_sockopt_SUITE.erl +++ b/lib/kernel/test/inet_sockopt_SUITE.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 @@ -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/kernel/vsn.mk b/lib/kernel/vsn.mk index 49404196dd..96c1e3d83d 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 2.16.2 +KERNEL_VSN = 2.16.3 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..25edf8bb7d 100644 --- a/lib/megaco/doc/src/notes.xml +++ b/lib/megaco/doc/src/notes.xml @@ -36,24 +36,153 @@ section is the version number of Megaco.</p> - <section><title>Megaco 3.16.0.3</title> + <section><title>Megaco 3.17.0.1</title> <section><title>Improvements and New Features</title> <list> <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> Postscript files no longer needed for the generation + of PDF files have been removed. </p> <p> - Own Id: OTP-10630</p> + Own Id: OTP-11016</p> </item> </list> </section> </section> -<section><title>Megaco 3.16.0.2</title> +<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> + + <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> + </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> + <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.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 +786,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..db956102a6 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.0.1 PRE_VSN = APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)" diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index 5942a40a87..790f5d92b5 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -38,7 +38,37 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.8</title> + <section><title>Mnesia 4.9</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + If mnesia:clear_table/2 was called during a table load on + that table, the schema record was written to the table + instead of clearing table.</p> + <p> + Own Id: OTP-11030 Aux Id: seq12267 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Optimize index creation for Mnesia set tables. Thanks to + Nick Marino.</p> + <p> + Own Id: OTP-11103</p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.8</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/src/mnesia_index.erl b/lib/mnesia/src/mnesia_index.erl index f9f3ce2ea4..54db45e3ba 100644 --- a/lib/mnesia/src/mnesia_index.erl +++ b/lib/mnesia/src/mnesia_index.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 @@ -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/src/mnesia_subscr.erl b/lib/mnesia/src/mnesia_subscr.erl index 415c69d508..8f78dc55e8 100644 --- a/lib/mnesia/src/mnesia_subscr.erl +++ b/lib/mnesia/src/mnesia_subscr.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -447,8 +447,12 @@ deactivate(ClientPid, What, Var, SubscrTab) -> {'EXIT', _} -> unlink(ClientPid) end, - del_subscr(Var, What, ClientPid), - {ok, node()}. + try + del_subscr(Var, What, ClientPid), + {ok, node()} + catch _:_ -> + {error, badarg} + end. del_subscr(subscribers, _What, Pid) -> mnesia_lib:del(subscribers, Pid); diff --git a/lib/mnesia/test/mnesia_durability_test.erl b/lib/mnesia/test/mnesia_durability_test.erl index 1de62a7d25..4434abaa1e 100644 --- a/lib/mnesia/test/mnesia_durability_test.erl +++ b/lib/mnesia/test/mnesia_durability_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 diff --git a/lib/mnesia/test/mnesia_evil_coverage_test.erl b/lib/mnesia/test/mnesia_evil_coverage_test.erl index 64b61288ef..db23a39943 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), @@ -1942,6 +1985,10 @@ subscribe_standard(Config) when is_list(Config)-> ?match({atomic, ok}, mnesia:create_table(Tab, Def)), %% Check system events + ?match({error, {badarg, foo}}, mnesia:unsubscribe(foo)), + ?match({error, badarg}, mnesia:unsubscribe({table, foo})), + ?match(_, mnesia:unsubscribe(activity)), + ?match({ok, N1}, mnesia:subscribe(system)), ?match({ok, N1}, mnesia:subscribe(activity)), diff --git a/lib/mnesia/test/mnesia_isolation_test.erl b/lib/mnesia/test/mnesia_isolation_test.erl index 3273bc4d40..d57f976d1f 100644 --- a/lib/mnesia/test/mnesia_isolation_test.erl +++ b/lib/mnesia/test/mnesia_isolation_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 @@ -613,11 +613,11 @@ unbound2(Config) when is_list(Config) -> ?match_receive({B, continuing}), %% B should now be in lock queue. - A ! continue, - ?match_receive({A, {atomic, ok}}), - ?match_receive({B, {atomic, [{ul,{key,{17,42}},val}]}}), + A ! continue, + ?match_multi_receive([{A, {atomic, ok}}, + {B, {atomic, [{ul,{key,{17,42}},val}]}}]), ok. - + receiver() -> receive {_Pid, begin_trans} -> diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index 8cd97342af..d7a132bc1a 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.8 +MNESIA_VSN = 4.9 diff --git a/lib/observer/doc/src/crashdump_ug.xml b/lib/observer/doc/src/crashdump_ug.xml index 8b60f6ee98..8aef1ffdf0 100644 --- a/lib/observer/doc/src/crashdump_ug.xml +++ b/lib/observer/doc/src/crashdump_ug.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2011</year> + <year>2003</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/observer/doc/src/notes.xml b/lib/observer/doc/src/notes.xml index ddf3b3fe37..34e87374a2 100644 --- a/lib/observer/doc/src/notes.xml +++ b/lib/observer/doc/src/notes.xml @@ -31,6 +31,69 @@ <p>This document describes the changes made to the Observer application.</p> +<section><title>Observer 1.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Some bugs related to calculation of CPU/scheduler + utilization in observer are corrected.</p> + <p> + Current function for a process is accepted to be + 'undefined' when running hipe.</p> + <p> + Own Id: OTP-10894</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + <list> <item> The new Memory field from a crash dump is + now presented by crashdump viewer, both in the process + overview and in the process detail page. </item> <item> A + summary of blocks- and carriers sizes is added to the + allocator information page in the crashdump viewer. + </item> </list></p> + <p> + Own Id: OTP-10604 Aux Id: kunagi-336 [247] </p> + </item> + <item> + <p> + Use "open" as default browser for crashdump viewer on Mac + OS X. Thanks to Magnus Henoch.</p> + <p> + Own Id: OTP-10929</p> + </item> + <item> + <p> + Fix observer table viewer crash on formatting improper + lists. Thanks to Andrey Tsirulev</p> + <p> + Own Id: OTP-10931</p> + </item> + <item> + <p> Postscript files no longer needed for the generation + of PDF files have been removed. </p> + <p> + Own Id: OTP-11016</p> + </item> + <item> + <p> + Add processes state view in observer. Thanks to Eric + Pailleau.</p> + <p> + Own Id: OTP-11136</p> + </item> + </list> + </section> + +</section> + <section><title>Observer 1.3</title> <section><title>Improvements and New Features</title> 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..98d0403139 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.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 @@ -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/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl index 83619414ad..b4832d9599 100644 --- a/lib/observer/src/observer_tv_table.erl +++ b/lib/observer/src/observer_tv_table.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 diff --git a/lib/observer/vsn.mk b/lib/observer/vsn.mk index 1ff1b3ec52..96d9d885da 100644 --- a/lib/observer/vsn.mk +++ b/lib/observer/vsn.mk @@ -1 +1 @@ -OBSERVER_VSN = 1.3 +OBSERVER_VSN = 1.3.1 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/odbc/doc/src/notes.xml b/lib/odbc/doc/src/notes.xml index 792dc3fddd..ebbacb2327 100644 --- a/lib/odbc/doc/src/notes.xml +++ b/lib/odbc/doc/src/notes.xml @@ -31,7 +31,36 @@ <p>This document describes the changes made to the odbc application. </p> - <section><title>ODBC 2.10.15</title> + <section><title>ODBC 2.10.16</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix a 64bit related bug in odbcserver. Thanks to Satoshi + Kinoshita.</p> + <p> + Own Id: OTP-10993</p> + </item> + <item> + <p> Postscript files no longer needed for the generation + of PDF files have been removed. </p> + <p> + Own Id: OTP-11016</p> + </item> + <item> + <p> + Fix checking for odbc in standard locations when + "with-odbc" flag present. Thanks to Alexey Saltanov.</p> + <p> + Own Id: OTP-11126</p> + </item> + </list> + </section> + +</section> + +<section><title>ODBC 2.10.15</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/odbc/test/oracle.erl b/lib/odbc/test/oracle.erl index 95cf7155dc..3e49a1b64d 100644 --- a/lib/odbc/test/oracle.erl +++ b/lib/odbc/test/oracle.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 diff --git a/lib/odbc/test/postgres.erl b/lib/odbc/test/postgres.erl index 0c1761b835..99a191c46a 100644 --- a/lib/odbc/test/postgres.erl +++ b/lib/odbc/test/postgres.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 diff --git a/lib/odbc/vsn.mk b/lib/odbc/vsn.mk index b3ffff2cf8..98a9f4ab4a 100644 --- a/lib/odbc/vsn.mk +++ b/lib/odbc/vsn.mk @@ -1 +1 @@ -ODBC_VSN = 2.10.15 +ODBC_VSN = 2.10.16 diff --git a/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl b/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl index aa582d1d4e..5ec0c084e3 100644 --- a/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl +++ b/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. 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 diff --git a/lib/orber/doc/src/notes.xml b/lib/orber/doc/src/notes.xml index 9e896f03c8..04507d8078 100644 --- a/lib/orber/doc/src/notes.xml +++ b/lib/orber/doc/src/notes.xml @@ -33,7 +33,22 @@ </header> - <section><title>Orber 3.6.26</title> + <section><title>Orber 3.6.26.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> Postscript files no longer needed for the generation + of PDF files have been removed. </p> + <p> + Own Id: OTP-11016</p> + </item> + </list> + </section> + +</section> + +<section><title>Orber 3.6.26</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/orber/src/orber_env.erl b/lib/orber/src/orber_env.erl index 67d31018ff..1c8a90bc81 100644 --- a/lib/orber/src/orber_env.erl +++ b/lib/orber/src/orber_env.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. 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 diff --git a/lib/orber/src/orber_iiop_outproxy.erl b/lib/orber/src/orber_iiop_outproxy.erl index 9c4e603753..8319d89088 100644 --- a/lib/orber/src/orber_iiop_outproxy.erl +++ b/lib/orber/src/orber_iiop_outproxy.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-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 diff --git a/lib/orber/vsn.mk b/lib/orber/vsn.mk index 4e09532f88..7bbebc65dc 100644 --- a/lib/orber/vsn.mk +++ b/lib/orber/vsn.mk @@ -1,2 +1,2 @@ -ORBER_VSN = 3.6.26 +ORBER_VSN = 3.6.26.1 diff --git a/lib/os_mon/c_src/memsup.c b/lib/os_mon/c_src/memsup.c index 8e610f951b..b5114d10ed 100644 --- a/lib/os_mon/c_src/memsup.c +++ b/lib/os_mon/c_src/memsup.c @@ -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 diff --git a/lib/os_mon/doc/src/notes.xml b/lib/os_mon/doc/src/notes.xml index 61eac937e1..2206f93d34 100644 --- a/lib/os_mon/doc/src/notes.xml +++ b/lib/os_mon/doc/src/notes.xml @@ -30,6 +30,34 @@ </header> <p>This document describes the changes made to the OS_Mon application.</p> +<section><title>Os_Mon 2.2.12</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Compilation fixes for NetBSD. Thanks to YAMAMOTO Takashi.</p> + <p> + Own Id: OTP-10941</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fixed disksup:get_disk_data for SUSv3, specifically OS X + ML. Thanks to Sriram Melkote.</p> + <p> + Own Id: OTP-10945</p> + </item> + </list> + </section> + +</section> + <section><title>Os_Mon 2.2.11</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl index f906f33d32..8c8bbe843a 100644 --- a/lib/os_mon/src/disksup.erl +++ b/lib/os_mon/src/disksup.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 diff --git a/lib/os_mon/vsn.mk b/lib/os_mon/vsn.mk index 7d6c5484a7..e3acea0258 100644 --- a/lib/os_mon/vsn.mk +++ b/lib/os_mon/vsn.mk @@ -1 +1 @@ -OS_MON_VSN = 2.2.11 +OS_MON_VSN = 2.2.12 diff --git a/lib/percept/doc/src/notes.xml b/lib/percept/doc/src/notes.xml index 82ce47c0ef..795dd98545 100644 --- a/lib/percept/doc/src/notes.xml +++ b/lib/percept/doc/src/notes.xml @@ -32,6 +32,21 @@ </header> <p>This document describes the changes made to the Percept application.</p> +<section><title>Percept 0.8.8.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> Postscript files no longer needed for the generation + of PDF files have been removed. </p> + <p> + Own Id: OTP-11016</p> + </item> + </list> + </section> + +</section> + <section><title>Percept 0.8.8</title> <section><title>Improvements and New Features</title> diff --git a/lib/percept/vsn.mk b/lib/percept/vsn.mk index 07e9ac5085..2ea0341ddf 100644 --- a/lib/percept/vsn.mk +++ b/lib/percept/vsn.mk @@ -1 +1 @@ -PERCEPT_VSN = 0.8.8 +PERCEPT_VSN = 0.8.8.1 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/notes.xml b/lib/public_key/doc/src/notes.xml index 3a7ccbe568..47b3e60afd 100644 --- a/lib/public_key/doc/src/notes.xml +++ b/lib/public_key/doc/src/notes.xml @@ -34,6 +34,50 @@ <file>notes.xml</file> </header> +<section><title>Public_Key 0.19</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add support for ISO oids 1.3.14.3.2.29 and 1.3.14.3.2.27 + that are somtimes used instead of the PKCS defined oids + 1.2.840.113549.1.1.5 and 1.2.840.10040.4.3. Add function + pkix_sign_types:/1 that translates oids to to algorithm + atoms ex:</p> + <p> + > public_key:pkix_sign_types({1,3,14,3,2,29}). {sha,rsa}</p> + <p> + Own Id: OTP-10873</p> + </item> + <item> + <p> + Integrate elliptic curve contribution from Andreas + Schultz </p> + <p> + In order to be able to support elliptic curve cipher + suites in SSL/TLS, additions to handle elliptic curve + infrastructure has been added to public_key and crypto.</p> + <p> + This also has resulted in a rewrite of the crypto API to + gain consistency and remove unnecessary overhead. All OTP + applications using crypto has been updated to use the new + API.</p> + <p> + Impact: Elliptic curve cryptography (ECC) offers + equivalent security with smaller key sizes than other + public key algorithms. Smaller key sizes result in + savings for power, memory, bandwidth, and computational + cost that make ECC especially attractive for constrained + environments.</p> + <p> + Own Id: OTP-11009</p> + </item> + </list> + </section> + +</section> + <section><title>Public_Key 0.18</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 84300f6e65..bce6d58682 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -43,7 +43,8 @@ <title>public_key</title> <list type="bulleted"> - <item>public_key requires the crypto application.</item> + <item>public_key requires the crypto and asn1 applications, the latter since R16 (hopefully the runtime dependency on asn1 will + be removed again in the future).</item> <item>Supports <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280 </url> - Internet X.509 Public Key Infrastructure Certificate and Certificate Revocation List (CRL) Profile </item> @@ -84,7 +85,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 +101,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 +115,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 +155,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> @@ -156,7 +177,8 @@ <v>Options = public_crypt_options()</v> </type> <desc> - <p>Public key decryption using the private key.</p> + <p>Public key decryption using the private key. See also <seealso + marker="crypto:crypto#private_decrypt/4">crypto:private_decrypt/4</seealso></p> </desc> </func> @@ -170,7 +192,8 @@ <v>Options = public_crypt_options()</v> </type> <desc> - <p> Public key decryption using the public key.</p> + <p> Public key decryption using the public key. See also <seealso + marker="crypto:crypto#public_decrypt/4">crypto:public_decrypt/4</seealso></p> </desc> </func> @@ -204,6 +227,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> @@ -273,7 +307,9 @@ <v>Key = rsa_private_key()</v> </type> <desc> - <p> Public key encryption using the private key.</p> + <p> Public key encryption using the private key. + See also <seealso + marker="crypto:crypto#private_encrypt/4">crypto:private_encrypt/4</seealso></p> </desc> </func> @@ -285,7 +321,8 @@ <v>Key = rsa_public_key()</v> </type> <desc> - <p> Public key encryption using the public key.</p> + <p> Public key encryption using the public key. See also <seealso + marker="crypto:crypto#public_encrypt/4">crypto:public_encrypt/4</seealso></p> </desc> </func> @@ -528,8 +565,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 +629,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..41280b9e14 100644 --- a/lib/public_key/src/pubkey_ssh.erl +++ b/lib/public_key/src/pubkey_ssh.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 @@ -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.app.src b/lib/public_key/src/public_key.app.src index 9f0677606d..736a778a4b 100644 --- a/lib/public_key/src/public_key.app.src +++ b/lib/public_key/src/public_key.app.src @@ -11,7 +11,7 @@ 'OTP-PUB-KEY', 'PKCS-FRAME' ]}, - {applications, [crypto, kernel, stdlib]}, + {applications, [asn1, crypto, kernel, stdlib]}, {registered, []}, {env, []} ] diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 736c18cdd4..cdbfe6e07c 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) -> @@ -247,14 +252,12 @@ decrypt_private(CipherText, Key) -> decrypt_private(CipherText, Key, []). decrypt_private(CipherText, - #'RSAPrivateKey'{modulus = N, publicExponent = E, - privateExponent = D} = Key, + #'RSAPrivateKey'{} = 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 +321,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 +376,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(PlainText, DigestType, Key = #'RSAPrivateKey'{}) -> - crypto:rsa_sign(DigestType, sized_binary(PlainText), format_rsa_private_key(Key)); +sign(DigestOrPlainText, DigestType, Key = #'RSAPrivateKey'{}) -> + crypto:sign(rsa, DigestType, DigestOrPlainText, format_rsa_private_key(Key)); -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(DigestOrPlainText, sha, #'DSAPrivateKey'{p = P, q = Q, g = G, x = X}) -> + crypto:sign(dss, sha, DigestOrPlainText, [P, Q, G, 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 +452,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 +464,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 +651,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 +741,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 +847,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..2c9b17478d 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 @@ -42,6 +42,7 @@ groups() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> + application:stop(crypto), try crypto:start() of ok -> Config @@ -109,7 +110,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 +126,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 +141,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 +157,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 +176,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 +191,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..699481b20f 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 @@ -111,14 +111,17 @@ groups() -> %%-------------------------------------------------------------------- init_per_suite(Config) -> + application:stop(crypto), try crypto:start() of ok -> + application:start(asn1), crypto_support_check(Config) catch _:_ -> {skip, "Crypto did not start"} end. end_per_suite(_Config) -> + application:stop(asn1), application:stop(crypto). %%-------------------------------------------------------------------- @@ -758,11 +761,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..c3aa2e2366 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -56,14 +56,17 @@ groups() -> ]. %%------------------------------------------------------------------- init_per_suite(Config) -> + application:stop(crypto), try crypto:start() of ok -> + application:start(asn1), Config catch _:_ -> {skip, "Crypto did not start"} end. end_per_suite(_Config) -> + application:stop(asn1), application:stop(crypto). %%------------------------------------------------------------------- @@ -551,7 +554,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/public_key/vsn.mk b/lib/public_key/vsn.mk index bd20a5546b..b820f24d2a 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 0.18 +PUBLIC_KEY_VSN = 0.19 diff --git a/lib/reltool/doc/src/notes.xml b/lib/reltool/doc/src/notes.xml index a9aed2b0a3..598d3333f8 100644 --- a/lib/reltool/doc/src/notes.xml +++ b/lib/reltool/doc/src/notes.xml @@ -37,7 +37,48 @@ thus constitutes one section in this document. The title of each section is the version number of Reltool.</p> - <section><title>Reltool 0.6.3</title> + <section><title>Reltool 0.6.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix receive support in erl_eval with a BEAM module. + Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11137</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Reltool used to fail if an application was mentioned in + the config file which was not found in the file system, + even if the application was explicitly excluded in the + config. This has been changed and will only produce a + warning. If the application is not explicitly excluded it + will still cause reltool to fail. Thanks to H�kan + Mattsson!</p> + <p> + Own Id: OTP-10988</p> + </item> + <item> + <p> + Fix possibly "not owner" error while file copy with + reltool. Thanks to Alexey Saltanov.</p> + <p> + Own Id: OTP-11099</p> + </item> + </list> + </section> + +</section> + +<section><title>Reltool 0.6.3</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/reltool/doc/src/reltool_examples.xml b/lib/reltool/doc/src/reltool_examples.xml index 19a3f37819..7dfe0cbff5 100644 --- a/lib/reltool/doc/src/reltool_examples.xml +++ b/lib/reltool/doc/src/reltool_examples.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2009</year> - <year>2011</year> + <year>2013</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -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/reltool/vsn.mk b/lib/reltool/vsn.mk index 9df2fc8406..412e78f49f 100644 --- a/lib/reltool/vsn.mk +++ b/lib/reltool/vsn.mk @@ -1 +1 @@ -RELTOOL_VSN = 0.6.3 +RELTOOL_VSN = 0.6.4 diff --git a/lib/runtime_tools/doc/src/notes.xml b/lib/runtime_tools/doc/src/notes.xml index cd59be1e63..2281ac4a49 100644 --- a/lib/runtime_tools/doc/src/notes.xml +++ b/lib/runtime_tools/doc/src/notes.xml @@ -31,6 +31,37 @@ <p>This document describes the changes made to the Runtime_Tools application.</p> +<section><title>Runtime_Tools 1.8.11</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Some bugs related to calculation of CPU/scheduler + utilization in observer are corrected.</p> + <p> + Current function for a process is accepted to be + 'undefined' when running hipe.</p> + <p> + Own Id: OTP-10894</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>Erlang source files with non-ASCII characters are now + encoded in UTF-8 (instead of latin1).</p> + <p> + Own Id: OTP-11041 Aux Id: OTP-10907 </p> + </item> + </list> + </section> + +</section> + <section><title>Runtime_Tools 1.8.10</title> <section><title>Fixed Bugs and Malfunctions</title> 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/runtime_tools/vsn.mk b/lib/runtime_tools/vsn.mk index d9c03b7e25..5faae06b53 100644 --- a/lib/runtime_tools/vsn.mk +++ b/lib/runtime_tools/vsn.mk @@ -1 +1 @@ -RUNTIME_TOOLS_VSN = 1.8.10 +RUNTIME_TOOLS_VSN = 1.8.11 diff --git a/lib/sasl/doc/src/notes.xml b/lib/sasl/doc/src/notes.xml index f54b04c223..a3260a5b93 100644 --- a/lib/sasl/doc/src/notes.xml +++ b/lib/sasl/doc/src/notes.xml @@ -30,6 +30,22 @@ </header> <p>This document describes the changes made to the SASL application.</p> +<section><title>SASL 2.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix receive support in erl_eval with a BEAM module. + Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11137</p> + </item> + </list> + </section> + +</section> + <section><title>SASL 2.3.1</title> <section><title>Improvements and New Features</title> 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/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index 367cab1d77..3921b2d3bb 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -59,6 +59,7 @@ -export([otp_6226_outdir/1]). -export([init_per_suite/1, end_per_suite/1, init_per_testcase/2, end_per_testcase/2]). +-export([delete_tree/1]). -import(lists, [foldl/3]). @@ -299,6 +300,11 @@ unicode_script(Config) when is_list(Config) -> %% 3. path (directory name where unicode_app.tgz is extracted) true = lists:member({path,[P1]},Instr), + %% If all is good, delete the unicode dir to avoid lingering files + %% on windows. + rpc:call(Node,code,add_pathz,[filename:dirname(code:which(?MODULE))]), + rpc:call(Node,?MODULE,delete_tree,[UnicodeLibDir]), + ok. unicode_script(cleanup,Config) -> diff --git a/lib/sasl/vsn.mk b/lib/sasl/vsn.mk index 0e52133166..551c833446 100644 --- a/lib/sasl/vsn.mk +++ b/lib/sasl/vsn.mk @@ -1 +1 @@ -SASL_VSN = 2.3.1 +SASL_VSN = 2.3.2 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..91fd18ca85 100644 --- a/lib/snmp/doc/src/files.mk +++ b/lib/snmp/doc/src/files.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2011. 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 @@ -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..9495486c39 100644 --- a/lib/snmp/doc/src/ref_man.xml +++ b/lib/snmp/doc/src/ref_man.xml @@ -4,7 +4,7 @@ <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2011</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -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..b4ca8a2d9f 100644 --- a/lib/snmp/src/agent/depend.mk +++ b/lib/snmp/src/agent/depend.mk @@ -2,7 +2,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 @@ -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..1c6632e065 100644 --- a/lib/snmp/src/agent/snmpa_agent_sup.erl +++ b/lib/snmp/src/agent/snmpa_agent_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-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,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/agent/snmpa_target_cache.erl b/lib/snmp/src/agent/snmpa_target_cache.erl index 1fcaf82373..391d711dc5 100644 --- a/lib/snmp/src/agent/snmpa_target_cache.erl +++ b/lib/snmp/src/agent/snmpa_target_cache.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2010. 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 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..28a6fef7e9 100644 --- a/lib/snmp/src/app/snmp_app.erl +++ b/lib/snmp/src/app/snmp_app.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2009. 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 @@ -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..736debe544 100644 --- a/lib/snmp/src/manager/snmpm_config.erl +++ b/lib/snmp/src/manager/snmpm_config.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 @@ -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..945b8719fc 100644 --- a/lib/snmp/src/misc/snmp_config.erl +++ b/lib/snmp/src/misc/snmp_config.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 @@ -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..c36cee2a53 100644 --- a/lib/snmp/src/misc/snmp_misc.erl +++ b/lib/snmp/src/misc/snmp_misc.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 @@ -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..7e4b713e56 100644 --- a/lib/snmp/test/snmp_agent_test_lib.erl +++ b/lib/snmp/test/snmp_agent_test_lib.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 @@ -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..fbb891e40d 100644 --- a/lib/snmp/test/snmp_test_lib.erl +++ b/lib/snmp/test/snmp_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. 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 @@ -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/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index f65b66a7c5..299dd5058a 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -29,6 +29,58 @@ <file>notes.xml</file> </header> +<section><title>Ssh 2.1.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + ssh:daemon will get feeded with an argument even if it is + not a valid expression.</p> + <p> + Own Id: OTP-10975</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Properly ignore everything in lib/ssh/doc/html/. Thanks + to Anthony Ramine.</p> + <p> + Own Id: OTP-10983</p> + </item> + <item> + <p> + Integrate elliptic curve contribution from Andreas + Schultz </p> + <p> + In order to be able to support elliptic curve cipher + suites in SSL/TLS, additions to handle elliptic curve + infrastructure has been added to public_key and crypto.</p> + <p> + This also has resulted in a rewrite of the crypto API to + gain consistency and remove unnecessary overhead. All OTP + applications using crypto has been updated to use the new + API.</p> + <p> + Impact: Elliptic curve cryptography (ECC) offers + equivalent security with smaller key sizes than other + public key algorithms. Smaller key sizes result in + savings for power, memory, bandwidth, and computational + cost that make ECC especially attractive for constrained + environments.</p> + <p> + Own Id: OTP-11009</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 2.1.6</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -143,8 +195,6 @@ </item> </list> </section> - - <section><title>Improvements and New Features</title> <list> <item> @@ -199,7 +249,20 @@ </section> </section> +<section><title>Ssh 2.1.2.1</title> +<section><title>Improvements and New Features</title> + <list> + <item> + <p> + Removed error report in ssh_connection_handler triggered + by badmatch failure.</p> + <p> + Own Id: OTP-11188</p> + </item> + </list> + </section> +</section> <section><title>Ssh 2.1.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index b25e0c9e37..32f7cc470b 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,22 +19,12 @@ {"%VSN%", [ - {<<"2.1.4">>, [{load_module, ssh_sftp, soft_purge, soft_purge, []}, - {load_module, ssh_connection_handler, soft_purge, soft_purge, []}]}, - {<<"2.1.3">>, [{restart_application, ssh}]}, - {<<"2.1.2">>, [{restart_application, ssh}]}, - {<<"2.1.1">>, [{restart_application, ssh}]}, - {<<"2.1">>, [{restart_application, ssh}]}, + {<<"2.1\\.*">>, [{restart_application, ssh}]}, {<<"2.0\\.*">>, [{restart_application, ssh}]}, {<<"1\\.*">>, [{restart_application, ssh}]} ], [ - {<<"2.1.4">>, [{load_module, ssh_sftp, soft_purge, soft_purge, []}, - {load_module, ssh_connection_handler, soft_purge, soft_purge, []}]}, - {<<"2.1.3">>, [{restart_application, ssh}]}, - {<<"2.1.2">>, [{restart_application, ssh}]}, - {<<"2.1.1">>, [{restart_application, ssh}]}, - {<<"2.1">>,[{restart_application, ssh}]}, + {<<"2.1\\.*">>,[{restart_application, ssh}]}, {<<"2.0\\.*">>, [{restart_application, ssh}]}, {<<"1\\.*">>, [{restart_application, ssh}]} ] diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 3a7aa79d16..7d5478c3f6 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -41,11 +41,13 @@ %%-------------------------------------------------------------------- start() -> application:start(crypto), + application:start(asn1), application:start(public_key), application:start(ssh). start(Type) -> application:start(crypto, Type), + application:start(asn1), application:start(public_key, Type), application:start(ssh, Type). 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_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 1c4477aeb3..df6175e27c 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -451,11 +451,12 @@ userauth(#ssh_msg_userauth_failure{authentications = Methodes}, case ssh_auth:userauth_request_msg(Ssh1) of {disconnect, DisconnectMsg, {Msg, Ssh}} -> send_msg(Msg, State), - handle_disconnect(DisconnectMsg, State#state{ssh_params = Ssh}); + handle_disconnect(DisconnectMsg, State#state{ssh_params = Ssh}); {Msg, Ssh} -> send_msg(Msg, State), {next_state, userauth, next_packet(State#state{ssh_params = Ssh})} end; + %% The prefered authentication method failed try next method userauth(#ssh_msg_userauth_failure{}, #state{ssh_params = #ssh{role = client} = Ssh0} = State) -> 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/ssh/src/ssh_xfer.erl b/lib/ssh/src/ssh_xfer.erl index 93f9e20663..b299868d41 100644 --- a/lib/ssh/src/ssh_xfer.erl +++ b/lib/ssh/src/ssh_xfer.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 diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index d5ca1cb3fe..231779b75a 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 2.1.6 +SSH_VSN = 2.1.7 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index a61f52b809..8875d07535 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -26,7 +26,80 @@ </header> <p>This document describes the changes made to the SSL application.</p> - <section><title>SSL 5.2.1</title> + <section><title>SSL 5.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Honor the versions option to ssl:connect and ssl:listen.</p> + <p> + Own Id: OTP-10905</p> + </item> + <item> + <p> + Next protocol negotiation with reused sessions will now + succeed</p> + <p> + Own Id: OTP-10909</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add support for PSK (Pre Shared Key) and SRP (Secure + Remote Password) chipher suits, thanks to Andreas + Schultz.</p> + <p> + Own Id: OTP-10450 Aux Id: kunagi-269 [180] </p> + </item> + <item> + <p> + Fix SSL Next Protocol Negotiation documentation. Thanks + to Julien Barbot.</p> + <p> + Own Id: OTP-10955</p> + </item> + <item> + <p> + Fix ssl_connection to support reading proxy/chain + certificates. Thanks to Valentin Kuznetsov.</p> + <p> + Own Id: OTP-10980</p> + </item> + <item> + <p> + Integrate elliptic curve contribution from Andreas + Schultz </p> + <p> + In order to be able to support elliptic curve cipher + suites in SSL/TLS, additions to handle elliptic curve + infrastructure has been added to public_key and crypto.</p> + <p> + This also has resulted in a rewrite of the crypto API to + gain consistency and remove unnecessary overhead. All OTP + applications using crypto has been updated to use the new + API.</p> + <p> + Impact: Elliptic curve cryptography (ECC) offers + equivalent security with smaller key sizes than other + public key algorithms. Smaller key sizes result in + savings for power, memory, bandwidth, and computational + cost that make ECC especially attractive for constrained + environments.</p> + <p> + Own Id: OTP-11009</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 5.2.1</title> <section><title>Improvements and New Features</title> <list> 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.appup.src b/lib/ssl/src/ssl.appup.src index a8a494b2fc..9e5bec26f1 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,14 +1,14 @@ %% -*- erlang -*- {"%VSN%", [ - {<<"5.2">>, [{restart_application, ssl}]}, + {<<"5.2\\*">>, [{restart_application, ssl}]}, {<<"5.1\\*">>, [{restart_application, ssl}]}, {<<"5.0\\*">>, [{restart_application, ssl}]}, {<<"4\\.*">>, [{restart_application, ssl}]}, {<<"3\\.*">>, [{restart_application, ssl}]} ], [ - {<<"5.2">>, [{restart_application, ssl}]}, + {<<"5.2\\*">>, [{restart_application, ssl}]}, {<<"5.1\\*">>, [{restart_application, ssl}]}, {<<"5.0\\*">>, [{restart_application, ssl}]}, {<<"4\\.*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 70f3b4f050..0c1e47311d 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(). - -%%--------------------------------------------------------------- --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])); + tls:clear_pem_cache(). -format_error(Error) -> - case inet:format_error(Error) of - "unknown POSIX" ++ _ -> - unexpected_format(Error); - Other -> - Other - end. +format_error(Error) -> + tls:format_error(Error). -%%-------------------------------------------------------------------- --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..ec5d793d65 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 %%-------------------------------------------------------------------- @@ -852,14 +1190,16 @@ hash_size(md5) -> 16; hash_size(sha) -> 20; -hash_size(sha224) -> - 28; +%% Uncomment when adding cipher suite that needs it +%% hash_size(sha224) -> +%% 28; hash_size(sha256) -> 32; hash_size(sha384) -> - 48; -hash_size(sha512) -> - 64. + 48. +%% Uncomment when adding cipher suite that needs it +%% hash_size(sha512) -> +%% 64. %% RFC 5246: 6.2.3.2. CBC Block Cipher %% @@ -950,7 +1290,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 +1328,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 +1363,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..7af4a68461 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -103,8 +103,8 @@ connection_init(Trustedcerts, Role) -> %% Description: Cach a pem file and return its content. %%-------------------------------------------------------------------- cache_pem_file(File, DbHandle) -> - MD5 = crypto:md5(File), - case ssl_certificate_db:lookup_cached_pem(DbHandle, MD5) of + MD5 = crypto:hash(md5, File), + case ssl_pkix_db:lookup_cached_pem(DbHandle, MD5) of [{Content,_}] -> {ok, Content}; [Content] -> @@ -132,7 +132,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 +194,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 +227,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 +244,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 +252,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 +315,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 +328,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 +357,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 +466,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..bb02695c12 --- /dev/null +++ b/lib/ssl/src/tls.erl @@ -0,0 +1,1039 @@ +%% +%% %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(asn1), + application:start(public_key), + application:start(ssl). + +start(Type) -> + application:start(crypto, Type), + application:start(asn1), + 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..246fecf34a 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}, @@ -668,10 +673,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}, + diffie_hellman_params = #'DHParameter'{} = 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 +711,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 +725,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 +768,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 +791,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 +829,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 +1024,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 +1039,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 +1050,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 +1293,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 +1307,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 +1324,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 +1376,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 +1396,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 +1417,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 +1434,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 +1479,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 +1508,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 +1568,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 +1577,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 +1588,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 +1604,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 +1615,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 +1629,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 +1678,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 +1695,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 +1703,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 +1717,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 +1734,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 +1770,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 +1810,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 +1841,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 +1856,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 +1889,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 +1906,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 +1922,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 +1936,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 +1951,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 +1969,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 +1991,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 +2001,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 +2029,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 +2048,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 +2073,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 +2084,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(PMpint, GMpint, PublicDhKey, PrivateDhKey, State) -> +dh_master_secret(Prime, Base, PublicDhKey, PrivateDhKey, State) -> PremasterSecret = - crypto:dh_compute_key(mpint_binary(PublicDhKey), PrivateDhKey, - [PMpint, GMpint]), + crypto:compute_key(dh, PublicDhKey, PrivateDhKey, [Prime, Base]), + master_from_premaster_secret(PremasterSecret, State). + +ec_dh_master_secret(ECDHKeys, ECPoint, State) -> + PremasterSecret = + public_key:compute_key(ECPoint, ECDHKeys), master_from_premaster_secret(PremasterSecret, State). handle_psk_identity(_PSKIdentity, LookupFun) @@ -2033,20 +2123,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 +2163,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 +2174,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 +2186,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 +2195,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 +2209,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 +2226,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 +2241,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 +2345,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 +2513,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 +2522,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 +2550,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 +2560,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 +2575,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 +2602,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 +2621,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 +2647,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 +2885,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 +2904,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 +2975,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 +2990,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 +3020,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 +3077,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..51fd2e1dc9 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..b5cf6d1212 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, @@ -182,16 +190,17 @@ init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of ok -> - application:start(public_key), - + ssl:start(), %% make rsa certs using oppenssl 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 +265,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 +328,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 +381,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 +431,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 +469,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 +605,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 +638,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 +676,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 +708,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 +781,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 +804,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 +830,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 +862,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 +893,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 +925,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 +957,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 +998,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 +1011,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 +1033,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 +1059,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 +1144,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 +1194,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 +1220,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 +1248,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 +1260,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 +1290,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 +1546,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 +1557,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 +1568,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 +1579,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 +1665,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 +1745,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 +1803,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 +1853,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 +2083,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 +2556,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 +2902,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 +2933,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 +2952,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 +3148,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 +3170,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 +3200,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 +3249,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 +3265,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 +3276,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..f76c55f670 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). @@ -80,13 +80,12 @@ init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of ok -> - application:start(public_key), - application:start(ssl), + ssl:start(), %% make rsa certs using oppenssl 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 +296,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 +345,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 +412,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 +643,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 +954,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 +967,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..30c0a67a36 100644 --- a/lib/ssl/test/ssl_npn_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl @@ -69,12 +69,11 @@ init_per_suite(Config) -> catch crypto:stop(), try crypto:start() of ok -> - application:start(public_key), ssl:start(), 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 +310,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 +331,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 +339,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..36f7af784d 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -139,11 +139,11 @@ init_per_suite(Config) -> catch crypto:stop(), try crypto:start() of ok -> - application:start(public_key), + ssl:start(), 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..f95eae51b7 100644 --- a/lib/ssl/test/ssl_payload_SUITE.erl +++ b/lib/ssl/test/ssl_payload_SUITE.erl @@ -71,7 +71,6 @@ init_per_suite(Config) -> catch crypto:stop(), try crypto:start() of ok -> - application:start(public_key), ssl:start(), make_certs:all(?config(data_dir, Config), ?config(priv_dir, Config)), ssl_test_lib:cert_options(Config) @@ -556,33 +555,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..c31f6c2d7d 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -56,14 +56,12 @@ init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of ok -> - application:start(public_key), ssl:start(), - %% make rsa certs using oppenssl 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..019ed58b1b 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -99,15 +99,15 @@ init_per_suite(Config0) -> catch crypto:stop(), try crypto:start() of ok -> - application:start(public_key), ssl:start(), 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 +200,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 +212,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 +241,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 +268,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 +284,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 +309,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 +343,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 +362,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 +391,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 +427,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 +462,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 +480,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 +512,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 +558,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 +593,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 +610,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 +635,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 +652,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 +686,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 +711,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 +747,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 +757,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 +775,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 +793,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 +835,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 +893,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 +912,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 +925,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 +939,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 +951,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 +962,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 +975,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 +985,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 +994,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 +1020,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 +1036,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 +1052,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 +1094,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 +1134,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 +1173,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 +1202,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 +1225,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 +1247,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 +1269,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 +1305,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/ssl/vsn.mk b/lib/ssl/vsn.mk index 1f3bef83c8..9dd151553c 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 5.2.1 +SSL_VSN = 5.3 diff --git a/lib/stdlib/doc/src/c.xml b/lib/stdlib/doc/src/c.xml index ddae388a1b..f2e3d8fb44 100644 --- a/lib/stdlib/doc/src/c.xml +++ b/lib/stdlib/doc/src/c.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2011</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -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..fd78788a45 100644 --- a/lib/stdlib/doc/src/erl_eval.xml +++ b/lib/stdlib/doc/src/erl_eval.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2011</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -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/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index 1aff78f4fc..16f81bdba1 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2012</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index 2ec0d6a60f..38cd44def6 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -30,6 +30,179 @@ </header> <p>This document describes the changes made to the STDLIB application.</p> +<section><title>STDLIB 1.19.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> The Erlang scanner no longer accepts floating point + numbers in the input string. </p> + <p> + Own Id: OTP-10990</p> + </item> + <item> + <p> + When converting a faulty binary to a list with + unicode:characters_to_list, the error return value could + contain a faulty "rest", i.e. the io_list of characters + that could not be converted was wrong. This happened only + if input was a sub binary and conversion was from utf8. + This is now corrected.</p> + <p> + Own Id: OTP-11080</p> + </item> + <item> + <p>The type <c>hook_function()</c> has been corrected in + <c>erl_pp</c>, the Erlang Pretty Printer. </p> + <p>The printing of invalid forms, e.g. record field + types, has also been fixed. It has been broken since + R16B. </p> + <p> (Thanks to Tomáš Janoušek.) </p> + <p> + Own Id: OTP-11100</p> + </item> + <item> + <p> + Fix receive support in erl_eval with a BEAM module. + Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11137</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Delete obsolete note about simple-one-for-one supervisor. + Thanks to Magnus Henoch.</p> + <p> + Own Id: OTP-10938</p> + </item> + <item> + <p> When selecting encoding of a script written in Erlang + (<c>escript</c>) the optional directive on the second + line is now recognized. </p> + <p> + Own Id: OTP-10951</p> + </item> + <item> + <p> The function <c>erl_parse:abstract/2</c> has been + documented. </p> + <p> + Own Id: OTP-10992</p> + </item> + <item> + <p> + Integrate elliptic curve contribution from Andreas + Schultz </p> + <p> + In order to be able to support elliptic curve cipher + suites in SSL/TLS, additions to handle elliptic curve + infrastructure has been added to public_key and crypto.</p> + <p> + This also has resulted in a rewrite of the crypto API to + gain consistency and remove unnecessary overhead. All OTP + applications using crypto has been updated to use the new + API.</p> + <p> + Impact: Elliptic curve cryptography (ECC) offers + equivalent security with smaller key sizes than other + public key algorithms. Smaller key sizes result in + savings for power, memory, bandwidth, and computational + cost that make ECC especially attractive for constrained + environments.</p> + <p> + Own Id: OTP-11009</p> + </item> + <item> + <p> + Added sys:get_state/1,2 and sys:replace_state/2,3. Thanks + to Steve Vinoski.</p> + <p> + Own Id: OTP-11013</p> + </item> + <item> + <p> + Optimizations to gen mechanism. Thanks to Lo�c Hoguin.</p> + <p> + Own Id: OTP-11025</p> + </item> + <item> + <p> + Optimizations to gen.erl. Thanks to Lo�c Hoguin.</p> + <p> + Own Id: OTP-11035</p> + </item> + <item> + <p> + Use erlang:demonitor(Ref, [flush]) where applicable. + Thanks to Lo�c Hoguin.</p> + <p> + Own Id: OTP-11039</p> + </item> + <item> + <p>Erlang source files with non-ASCII characters are now + encoded in UTF-8 (instead of latin1).</p> + <p> + Own Id: OTP-11041 Aux Id: OTP-10907 </p> + </item> + <item> + <p> + Fix rest_for_one and one_for_all restarting a child not + terminated. Thanks to James Fish.</p> + <p> + Own Id: OTP-11042</p> + </item> + <item> + <p> + Fix excessive CPU consumption of timer_server. Thanks to + Aliaksey Kandratsenka.</p> + <p> + Own Id: OTP-11053</p> + </item> + <item> + <p> + Rename and document lists:zf/2 as lists:filtermap/2. + Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11078</p> + </item> + <item> + <p> + Fixed an inconsistent state in epp. Thanks to Anthony + Ramine</p> + <p> + Own Id: OTP-11079</p> + </item> + <item> + <p> + c:ls(File) will now print File, similar to ls(1) in Unix. + The error messages have also been improved. (Thanks to + Bengt Kleberg.)</p> + <p> + Own Id: OTP-11108</p> + </item> + <item> + <p> + Support callback attributes in erl_pp. Thanks to Anthony + Ramine.</p> + <p> + Own Id: OTP-11140</p> + </item> + <item> + <p> + Improve erl_lint performance. Thanks to Jos� Valim.</p> + <p> + Own Id: OTP-11143</p> + </item> + </list> + </section> + +</section> + <section><title>STDLIB 1.19.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 3f36c58d24..ed09f6e1f2 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2012</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml index 0ffc5bc433..b66a6b17bd 100644 --- a/lib/stdlib/doc/src/sys.xml +++ b/lib/stdlib/doc/src/sys.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2011</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> 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/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/gen.erl b/lib/stdlib/src/gen.erl index 5df5530ba1..7281549ea7 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.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 diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index bfebf29080..7629e88fbf 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.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 diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index d9411e58cf..9e9d4ee4bb 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.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 diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 30a81ade49..bc76c9fd10 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.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 diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index 0c033acd88..b5577165f4 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.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 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/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 54328cd9ff..6d8e25b1de 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/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 diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index bffeb44179..c186eab940 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.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 diff --git a/lib/stdlib/src/timer.erl b/lib/stdlib/src/timer.erl index e11fb046e9..3cf358630f 100644 --- a/lib/stdlib/src/timer.erl +++ b/lib/stdlib/src/timer.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 diff --git a/lib/stdlib/test/c_SUITE.erl b/lib/stdlib/test/c_SUITE.erl index 25281365be..a018db9c91 100644 --- a/lib/stdlib/test/c_SUITE.erl +++ b/lib/stdlib/test/c_SUITE.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 @@ -20,7 +20,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). -export([c_1/1, c_2/1, c_3/1, c_4/1, nc_1/1, nc_2/1, nc_3/1, nc_4/1, - memory/1]). + ls/1, memory/1]). -include_lib("test_server/include/test_server.hrl"). @@ -29,7 +29,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [c_1, c_2, c_3, c_4, nc_1, nc_2, nc_3, nc_4, memory]. + [c_1, c_2, c_3, c_4, nc_1, nc_2, nc_3, nc_4, ls, memory]. groups() -> []. @@ -147,6 +147,13 @@ nc_4(Config) when is_list(Config) -> ?line Result = nc(R,[{outdir,W}]), ?line {ok, m} = Result. +ls(Config) when is_list(Config) -> + Directory = ?config(data_dir, Config), + ok = c:ls(Directory), + File = filename:join(Directory, "m.erl"), + ok = c:ls(File), + ok = c:ls("no_such_file"). + memory(doc) -> ["Checks that c:memory/[0,1] returns consistent results."]; memory(suite) -> diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 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_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 6be5a299b6..5819ef3890 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.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 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/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl index cd7210f8ec..92253ef5b9 100644 --- a/lib/stdlib/test/lists_SUITE.erl +++ b/lib/stdlib/test/lists_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 diff --git a/lib/stdlib/test/qlc_SUITE_data/join_info_compat.erl b/lib/stdlib/test/qlc_SUITE_data/join_info_compat.erl index b93b907392..a631b9dbcf 100644 --- a/lib/stdlib/test/qlc_SUITE_data/join_info_compat.erl +++ b/lib/stdlib/test/qlc_SUITE_data/join_info_compat.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. 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 diff --git a/lib/stdlib/test/supervisor_3.erl b/lib/stdlib/test/supervisor_3.erl index 31b3037d6f..0023219ff3 100644 --- a/lib/stdlib/test/supervisor_3.erl +++ b/lib/stdlib/test/supervisor_3.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 diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index ff5be6bb95..ac5a34c3bc 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_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 diff --git a/lib/stdlib/test/unicode_SUITE.erl b/lib/stdlib/test/unicode_SUITE.erl index 4055af2741..e2d789bbe6 100644 --- a/lib/stdlib/test/unicode_SUITE.erl +++ b/lib/stdlib/test/unicode_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. 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 @@ -29,7 +29,7 @@ random_lists/1, roundtrips/1, latin1/1, - exceptions/1]). + exceptions/1, binaries_errors/1]). init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> Dog=?t:timetrap(?t:minutes(20)), @@ -44,7 +44,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [utf8_illegal_sequences_bif, utf16_illegal_sequences_bif, random_lists, roundtrips, - latin1, exceptions]. + latin1, exceptions, binaries_errors]. groups() -> []. @@ -61,6 +61,149 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +binaries_errors(Config) when is_list(Config) -> + setlimit(10), + ex_binaries_errors_utf8(Config), + setlimit(default), + ex_binaries_errors_utf8(Config), + ex_binaries_errors_utf16_little(Config), + ex_binaries_errors_utf16_big(Config), + ex_binaries_errors_utf32_little(Config), + ex_binaries_errors_utf32_big(Config). + +ex_binaries_errors_utf8(Config) when is_list(Config) -> + %% Original smoke test, we should not forget the original offset... + <<_:8,_:8,RR2/binary>> = <<$a,$b,164,165,$c>>, + {error,[],<<164,165,$c>>} = unicode:characters_to_list(RR2), + %% Now, try with longer binary (trapping) + BrokenPart = list_to_binary(lists:seq(128,255)), + BrokenSz = byte_size(BrokenPart), + [ begin + OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))), + OKBin = unicode:characters_to_binary(OKList), + OKLen = length(OKList), + %% Copy to avoid that the binary get's writable + PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>), + PBSz = byte_size(PartlyBroken), + {error,OKList,DeepBrokenPart} = + unicode:characters_to_list(PartlyBroken), + BrokenPart = iolist_to_binary(DeepBrokenPart), + [ begin + NewList = lists:nthtail(X, OKList), + NewSz = byte_size(unicode:characters_to_binary(NewList)) + + BrokenSz, + Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz), + true = (binary:referenced_byte_size(Chomped) =:= PBSz), + {error,NewList,DeepBrokenPart2} = + unicode:characters_to_list(Chomped), + BrokenPart = iolist_to_binary(DeepBrokenPart2) + end || X <- lists:seq(1,OKLen) ] + end || N <- lists:seq(1,20) ], + ok. + +ex_binaries_errors_utf16_little(Config) when is_list(Config) -> + BrokenPart = << <<X:16/little>> || X <- lists:seq(16#DC00,16#DFFF) >>, + BrokenSz = byte_size(BrokenPart), + [ begin + OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))), + OKBin = unicode:characters_to_binary(OKList,unicode,{utf16,little}), + OKLen = length(OKList), + %% Copy to avoid that the binary get's writable + PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>), + PBSz = byte_size(PartlyBroken), + {error,OKList,DeepBrokenPart} = + unicode:characters_to_list(PartlyBroken,{utf16,little}), + BrokenPart = iolist_to_binary(DeepBrokenPart), + [ begin + NewList = lists:nthtail(X, OKList), + NewSz = byte_size(unicode:characters_to_binary(NewList,unicode,{utf16,little})) + + BrokenSz, + Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz), + true = (binary:referenced_byte_size(Chomped) =:= PBSz), + {error,NewList,DeepBrokenPart2} = + unicode:characters_to_list(Chomped,{utf16,little}), + BrokenPart = iolist_to_binary(DeepBrokenPart2) + end || X <- lists:seq(1,OKLen) ] + end || N <- lists:seq(1,15) ], + ok. +ex_binaries_errors_utf16_big(Config) when is_list(Config) -> + BrokenPart = << <<X:16/big>> || X <- lists:seq(16#DC00,16#DFFF) >>, + BrokenSz = byte_size(BrokenPart), + [ begin + OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))), + OKBin = unicode:characters_to_binary(OKList,unicode,{utf16,big}), + OKLen = length(OKList), + %% Copy to avoid that the binary get's writable + PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>), + PBSz = byte_size(PartlyBroken), + {error,OKList,DeepBrokenPart} = + unicode:characters_to_list(PartlyBroken,{utf16,big}), + BrokenPart = iolist_to_binary(DeepBrokenPart), + [ begin + NewList = lists:nthtail(X, OKList), + NewSz = byte_size(unicode:characters_to_binary(NewList,unicode,{utf16,big})) + + BrokenSz, + Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz), + true = (binary:referenced_byte_size(Chomped) =:= PBSz), + {error,NewList,DeepBrokenPart2} = + unicode:characters_to_list(Chomped,{utf16,big}), + BrokenPart = iolist_to_binary(DeepBrokenPart2) + end || X <- lists:seq(1,OKLen) ] + end || N <- lists:seq(1,15) ], + ok. + +ex_binaries_errors_utf32_big(Config) when is_list(Config) -> + BrokenPart = << <<X:32/big>> || X <- lists:seq(16#DC00,16#DFFF) >>, + BrokenSz = byte_size(BrokenPart), + [ begin + OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))), + OKBin = unicode:characters_to_binary(OKList,unicode,{utf32,big}), + OKLen = length(OKList), + %% Copy to avoid that the binary get's writable + PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>), + PBSz = byte_size(PartlyBroken), + {error,OKList,DeepBrokenPart} = + unicode:characters_to_list(PartlyBroken,{utf32,big}), + BrokenPart = iolist_to_binary(DeepBrokenPart), + [ begin + NewList = lists:nthtail(X, OKList), + NewSz = byte_size(unicode:characters_to_binary(NewList,unicode,{utf32,big})) + + BrokenSz, + Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz), + true = (binary:referenced_byte_size(Chomped) =:= PBSz), + {error,NewList,DeepBrokenPart2} = + unicode:characters_to_list(Chomped,{utf32,big}), + BrokenPart = iolist_to_binary(DeepBrokenPart2) + end || X <- lists:seq(1,OKLen) ] + end || N <- lists:seq(1,15) ], + ok. + +ex_binaries_errors_utf32_little(Config) when is_list(Config) -> + BrokenPart = << <<X:32/little>> || X <- lists:seq(16#DC00,16#DFFF) >>, + BrokenSz = byte_size(BrokenPart), + [ begin + OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))), + OKBin = unicode:characters_to_binary(OKList,unicode,{utf32,little}), + OKLen = length(OKList), + %% Copy to avoid that the binary get's writable + PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>), + PBSz = byte_size(PartlyBroken), + {error,OKList,DeepBrokenPart} = + unicode:characters_to_list(PartlyBroken,{utf32,little}), + BrokenPart = iolist_to_binary(DeepBrokenPart), + [ begin + NewList = lists:nthtail(X, OKList), + NewSz = byte_size(unicode:characters_to_binary(NewList,unicode,{utf32,little})) + + BrokenSz, + Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz), + true = (binary:referenced_byte_size(Chomped) =:= PBSz), + {error,NewList,DeepBrokenPart2} = + unicode:characters_to_list(Chomped,{utf32,little}), + BrokenPart = iolist_to_binary(DeepBrokenPart2) + end || X <- lists:seq(1,OKLen) ] + end || N <- lists:seq(1,15) ], + ok. + exceptions(Config) when is_list(Config) -> 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/stdlib/vsn.mk b/lib/stdlib/vsn.mk index fbb838c686..ba6f7cdb8a 100644 --- a/lib/stdlib/vsn.mk +++ b/lib/stdlib/vsn.mk @@ -1 +1 @@ -STDLIB_VSN = 1.19.2 +STDLIB_VSN = 1.19.3 diff --git a/lib/test_server/doc/src/notes.xml b/lib/test_server/doc/src/notes.xml index b35929f1e6..c6c166c796 100644 --- a/lib/test_server/doc/src/notes.xml +++ b/lib/test_server/doc/src/notes.xml @@ -32,6 +32,56 @@ <file>notes.xml</file> </header> +<section><title>Test_Server 3.6.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Some unused code related to remote targets is removed, + and documentation is updated.</p> + <p> + Own Id: OTP-10607 Aux Id: kunagi-338 [249] </p> + </item> + <item> + <p> + A bug in test_server_gl caused io requests containing + invalid data (i.e. not unicode:chardata()) to hang, since + no io reply was sent. This has been corrected.</p> + <p> + Own Id: OTP-10991</p> + </item> + <item> + <p> + Common Test would, in case of timetrap error, print a + warning in the log if end_per_testcase wasn't implemented + in the suite, even though it's an optional function. This + printout has been removed.</p> + <p> + Own Id: OTP-11052</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The '-force_stop' flag to use with time-limited repeats + of test runs can now be used with a new 'skip_rest' + option which causes the rest of the test cases in the + ongoing test job to be skipped when the time limit is + reached. E.g. 'ct_run -spec xxx -duration 010000 + -force_stop skip_rest'</p> + <p> + Own Id: OTP-10856 Aux Id: OTP-10832 </p> + </item> + </list> + </section> + +</section> + <section><title>Test_Server 3.6.1</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -226,8 +276,6 @@ unicode:characters_to_binary for conversion between binaries and strings instead of binary_to_list and list_to_binary. </item> </list></p> - <p> - Own Id: OTP-10783</p> </item> </list> </section> diff --git a/lib/test_server/src/configure.in b/lib/test_server/src/configure.in index 785bab395c..3815027721 100644 --- a/lib/test_server/src/configure.in +++ b/lib/test_server/src/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script for Erlang. dnl dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1997-2012. All Rights Reserved. +dnl Copyright Ericsson AB 1997-2013. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -276,6 +276,7 @@ AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"])) dnl Checks for library functions. AC_CHECK_FUNCS(strerror) AC_CHECK_FUNCS(vsnprintf) +AC_CHECK_FUNCS(usleep) # First check if the library is available, then if we can choose between # two versions of gethostbyname 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_erl_config.erl b/lib/test_server/src/ts_erl_config.erl index a0fab4e2d2..8cd6a333d8 100644 --- a/lib/test_server/src/ts_erl_config.erl +++ b/lib/test_server/src/ts_erl_config.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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 diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl index 9b6e10e7e2..7746bbed6f 100644 --- a/lib/test_server/src/ts_install_cth.erl +++ b/lib/test_server/src/ts_install_cth.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% Copyright Ericsson AB 2010-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 @@ -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/test_server/vsn.mk b/lib/test_server/vsn.mk index 0a5c4246f1..1753bbb913 100644 --- a/lib/test_server/vsn.mk +++ b/lib/test_server/vsn.mk @@ -1 +1 @@ -TEST_SERVER_VSN = 3.6.1 +TEST_SERVER_VSN = 3.6.2 diff --git a/lib/tools/doc/src/eprof.xml b/lib/tools/doc/src/eprof.xml index 82eb8dd284..8b4986297a 100644 --- a/lib/tools/doc/src/eprof.xml +++ b/lib/tools/doc/src/eprof.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2012</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -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/doc/src/notes.xml b/lib/tools/doc/src/notes.xml index 20dc9679f1..05049d7107 100644 --- a/lib/tools/doc/src/notes.xml +++ b/lib/tools/doc/src/notes.xml @@ -30,6 +30,72 @@ </header> <p>This document describes the changes made to the Tools application.</p> +<section><title>Tools 2.6.11</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + When cover:stop(Node) was called on a non-existing node, + a process waiting for cover data from the node would hang + forever. This has been corrected.</p> + <p> + Own Id: OTP-10979</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Make cover smarter about finding source from beam.</p> + <p> + In particular, search using the source path in + module_info if the current heuristic fails.</p> + <p> + Own Id: OTP-10902</p> + </item> + <item> + <p> + Remove Flymake dependency in erlang-pkg.el. Thanks to + Magnus Henoch.</p> + <p> + Own Id: OTP-10930</p> + </item> + <item> + <p> + Erlang-mode: Add autoload cookies for file extension + associations. Thanks to Magnus Henoch.</p> + <p> + Own Id: OTP-10999</p> + </item> + <item> + <p> Postscript files no longer needed for the generation + of PDF files have been removed. </p> + <p> + Own Id: OTP-11016</p> + </item> + <item> + <p> + Fix a race condition when there're several applications + in apps directory. Thanks to Manuel Rubio.</p> + <p> + Own Id: OTP-11028</p> + </item> + <item> + <p> + New option for eprof, 'set_on_spawn'. This option was + previously always on and is also the default.</p> + <p> + Own Id: OTP-11144</p> + </item> + </list> + </section> + +</section> + <section><title>Tools 2.6.10</title> <section><title>Improvements and New Features</title> diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el index 355b223822..527e812444 100644 --- a/lib/tools/emacs/erlang-skels.el +++ b/lib/tools/emacs/erlang-skels.el @@ -457,7 +457,7 @@ Please see the function `tempo-define-template'.") "handle_info/2," n> "terminate/2, code_change/3])." n n - "-define(SERVER, ?MODULE). " n n + "-define(SERVER, ?MODULE)." n n "-record(state, {})." n n @@ -572,7 +572,7 @@ Please see the function `tempo-define-template'.") "-export([init/1, handle_event/2, handle_call/2, " n> "handle_info/2, terminate/2, code_change/3])." n n - "-define(SERVER, ?MODULE). " n n + "-define(SERVER, ?MODULE)." n n "-record(state, {})." n n 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..bfbbefb473 100644 --- a/lib/tools/src/eprof.erl +++ b/lib/tools/src/eprof.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. 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 @@ -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/src/fprof.erl b/lib/tools/src/fprof.erl index 877218bda0..75840e54ff 100644 --- a/lib/tools/src/fprof.erl +++ b/lib/tools/src/fprof.erl @@ -1,7 +1,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 diff --git a/lib/tools/test/eprof_SUITE.erl b/lib/tools/test/eprof_SUITE.erl index 3283fa571f..26685a6a84 100644 --- a/lib/tools/test/eprof_SUITE.erl +++ b/lib/tools/test/eprof_SUITE.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 @@ -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/lib/tools/vsn.mk b/lib/tools/vsn.mk index 4fb2f30e4f..a30b16fc49 100644 --- a/lib/tools/vsn.mk +++ b/lib/tools/vsn.mk @@ -1 +1 @@ -TOOLS_VSN = 2.6.10 +TOOLS_VSN = 2.6.11 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: diff --git a/system/doc/design_principles/fsm.xml b/system/doc/design_principles/fsm.xml index 7decbb48cd..803283b37a 100644 --- a/system/doc/design_principles/fsm.xml +++ b/system/doc/design_principles/fsm.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2011</year> + <year>1997</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/system/doc/reference_manual/introduction.xml b/system/doc/reference_manual/introduction.xml index 7737c34469..d143a154b6 100644 --- a/system/doc/reference_manual/introduction.xml +++ b/system/doc/reference_manual/introduction.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2012</year> + <year>2003</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -75,7 +75,7 @@ <title>Reserved Words</title> <p>The following are reserved words in Erlang:</p> <p>after and andalso band begin bnot bor bsl bsr bxor case catch - cond div end fun if let not of or orelse query receive rem try + cond div end fun if let not of or orelse receive rem try when xor</p> </section> diff --git a/system/doc/top/templates/index.html.src b/system/doc/top/templates/index.html.src index 180dd73b6f..a176bc9a14 100644 --- a/system/doc/top/templates/index.html.src +++ b/system/doc/top/templates/index.html.src @@ -2,7 +2,7 @@ <!-- %CopyrightBegin% -Copyright Ericsson AB 2009-2012. All Rights Reserved. +Copyright Ericsson AB 2009-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 diff --git a/system/doc/tutorial/nif.xmlsrc b/system/doc/tutorial/nif.xmlsrc index 6cb54ff7ff..79cef31160 100644 --- a/system/doc/tutorial/nif.xmlsrc +++ b/system/doc/tutorial/nif.xmlsrc @@ -29,7 +29,7 @@ <file>nif.xml</file> </header> <p>This is an example of how to solve the <seealso marker="example">example problem</seealso> - by using NIFs. NIFs where introduced in R13B03 as an experimental + by using NIFs. NIFs were introduced in R13B03 as an experimental feature. It is a simpler and more efficient way of calling C-code than using port drivers. NIFs are most suitable for synchronous functions like <c>foo</c> and <c>bar</c> in the example, that does some @@ -85,7 +85,7 @@ <p>The function arguments passed to a NIF appears in an array <c>argv</c>, with <c>argc</c> as the length of the array and thus the arity of the function. The Nth argument of the function can be accessed as - <c>argv[N-1]</c>. NIFs also takes an environment argument that + <c>argv[N-1]</c>. NIFs also take an environment argument that serves as an opaque handle that is needed to be passed on to most API functions. The environment contains information about the calling Erlang process.</p> @@ -98,7 +98,7 @@ structures containing name, arity and function pointer of each NIF. The other arguments are pointers to callback functions that can be used to initialize the library. We do not use them - is this simple example so we set them all to <c>NULL</c>.</p> + in this simple example so we set them all to <c>NULL</c>.</p> <p>Function arguments and return values are represented as values of type <c>ERL_NIF_TERM</c>. We use functions like <c>enif_get_int</c> and <c>enif_make_int</c> to convert between Erlang term and C-type. |