diff options
743 files changed, 26515 insertions, 10977 deletions
diff --git a/.gitignore b/.gitignore index d40f49b56f..eb14036789 100644 --- a/.gitignore +++ b/.gitignore @@ -208,6 +208,7 @@ JAVADOC-GENERATED # common_test +/lib/common_test/doc/src/ct_property_test.xml /lib/common_test/doc/src/ct_slave.xml /lib/common_test/priv/install.sh diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md index 5b3a09df2b..7a7e63164c 100644 --- a/HOWTO/INSTALL.md +++ b/HOWTO/INSTALL.md @@ -385,7 +385,7 @@ Some of the available `configure` options are: * `--enable-static-{nifs,drivers}` - To allow usage of nifs and drivers on OSs that do not support dynamic linking of libraries it is possible to statically link nifs and drivers with the main Erlang VM binary. This is done by passing - a comma seperated list to the archives that you want to statically link. e.g. + a comma separated list to the archives that you want to statically link. e.g. `--enable-static-nifs=/home/$USER/my_nif.a`. The path has to be absolute and the name of the archive has to be the same as the module, i.e. `my_nif` in the example above. This is also true for drivers, but then it is the driver name diff --git a/OTP_VERSION b/OTP_VERSION index 59a75133a2..1fbc0d2431 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -17.1.2 +18.0-rc0 diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex b57eef57ab..7e93eb7f7a 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex b57eef57ab..7e93eb7f7a 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 42ff7e9c1f..0758874641 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam Binary files differindex 11482a1451..0eca719d0d 100644 --- a/bootstrap/lib/compiler/ebin/beam_block.beam +++ b/bootstrap/lib/compiler/ebin/beam_block.beam diff --git a/bootstrap/lib/compiler/ebin/beam_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam Binary files differindex 35dae78125..de1a719a4e 100644 --- a/bootstrap/lib/compiler/ebin/beam_flatten.beam +++ b/bootstrap/lib/compiler/ebin/beam_flatten.beam diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam Binary files differindex 1d12f2cf1d..e99c0a69b9 100644 --- a/bootstrap/lib/compiler/ebin/beam_split.beam +++ b/bootstrap/lib/compiler/ebin/beam_split.beam diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex 8507db5454..659bb08d48 100644 --- a/bootstrap/lib/compiler/ebin/beam_utils.beam +++ b/bootstrap/lib/compiler/ebin/beam_utils.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex 07225dc8b1..ba1ea73dc4 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam Binary files differindex 0f0670c9ae..5e1c698ae8 100644 --- a/bootstrap/lib/compiler/ebin/cerl.beam +++ b/bootstrap/lib/compiler/ebin/cerl.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam Binary files differindex 2f7f220ebd..7328f75f34 100644 --- a/bootstrap/lib/compiler/ebin/cerl_inline.beam +++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam Binary files differindex 1338631c23..f36cc31458 100644 --- a/bootstrap/lib/compiler/ebin/cerl_trees.beam +++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index f415965277..5f15db4437 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -18,7 +18,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "5.0"}, + {vsn, "5.0.2"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup index e73b9aa60c..bde95b1878 100644 --- a/bootstrap/lib/compiler/ebin/compiler.appup +++ b/bootstrap/lib/compiler/ebin/compiler.appup @@ -15,7 +15,7 @@ %% under the License. %% %% %CopyrightEnd% -{"5.0", +{"5.0.2", [{<<".*">>,[{restart_application, compiler}]}], [{<<".*">>,[{restart_application, compiler}]}] }. diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam Binary files differindex e172ec6af7..9f83408bae 100644 --- a/bootstrap/lib/compiler/ebin/core_lint.beam +++ b/bootstrap/lib/compiler/ebin/core_lint.beam diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex e6e60fb658..cb02293c1d 100644 --- a/bootstrap/lib/compiler/ebin/core_pp.beam +++ b/bootstrap/lib/compiler/ebin/core_pp.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex 923c4d98fd..cce0ac7832 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam Binary files differindex c0c537f623..96f22d0970 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex 3670fd206c..822c7e34e6 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 5da654686a..f492d3428c 100644 --- a/bootstrap/lib/compiler/ebin/v3_core.beam +++ b/bootstrap/lib/compiler/ebin/v3_core.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam Binary files differindex 1e549a41c7..b56f507f47 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex 6946d17545..ba3a5ef81d 100644 --- a/bootstrap/lib/kernel/ebin/application.beam +++ b/bootstrap/lib/kernel/ebin/application.beam diff --git a/bootstrap/lib/kernel/ebin/erl_boot_server.beam b/bootstrap/lib/kernel/ebin/erl_boot_server.beam Binary files differindex 7e43b0fb36..6e56a1061d 100644 --- a/bootstrap/lib/kernel/ebin/erl_boot_server.beam +++ b/bootstrap/lib/kernel/ebin/erl_boot_server.beam diff --git a/bootstrap/lib/kernel/ebin/erl_epmd.beam b/bootstrap/lib/kernel/ebin/erl_epmd.beam Binary files differindex 1a74da7f1f..bf171450e9 100644 --- a/bootstrap/lib/kernel/ebin/erl_epmd.beam +++ b/bootstrap/lib/kernel/ebin/erl_epmd.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex 46263fae7b..e6141fd7f1 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex fe203f816f..4d156b726c 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam Binary files differindex 9fd86024e0..41486bed9a 100644 --- a/bootstrap/lib/kernel/ebin/inet_dns.beam +++ b/bootstrap/lib/kernel/ebin/inet_dns.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index 1fd4edd044..1b39f7df07 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -21,7 +21,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "3.0"}, + {vsn, "3.0.3"}, {modules, [application, application_controller, application_master, @@ -115,6 +115,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-6.0", "stdlib-2.0", "sasl-2.4"]} + {runtime_dependencies, ["erts-6.1.2", "stdlib-2.0", "sasl-2.4"]} ] }. diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index fda418ae8a..02cf129b42 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -15,11 +15,9 @@ %% under the License. %% %% %CopyrightEnd% -{"3.0", +{"3.0.3", %% Up from - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 %% Down to - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 }. diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam Binary files differindex fb722b3b4e..4b09aae8a5 100644 --- a/bootstrap/lib/kernel/ebin/net_adm.beam +++ b/bootstrap/lib/kernel/ebin/net_adm.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex 95454c885a..15f0e940fd 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_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam Binary files differindex b851ca484e..d3e41be66b 100644 --- a/bootstrap/lib/stdlib/ebin/erl_internal.beam +++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 8ae35899d0..9c6c4be617 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_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex 998bb0b209..ddef03db31 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex ff196f3a45..cb6bd2056c 100644 --- a/bootstrap/lib/stdlib/ebin/erl_pp.beam +++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam Binary files differindex fe45755343..b2b97bda8a 100644 --- a/bootstrap/lib/stdlib/ebin/erl_scan.beam +++ b/bootstrap/lib/stdlib/ebin/erl_scan.beam diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam Binary files differindex 1f84adafa5..ab3600c2f2 100644 --- a/bootstrap/lib/stdlib/ebin/filelib.beam +++ b/bootstrap/lib/stdlib/ebin/filelib.beam diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam Binary files differindex 4c64d477aa..551e2d3f01 100644 --- a/bootstrap/lib/stdlib/ebin/filename.beam +++ b/bootstrap/lib/stdlib/ebin/filename.beam diff --git a/bootstrap/lib/stdlib/ebin/gen.beam b/bootstrap/lib/stdlib/ebin/gen.beam Binary files differindex 6f15e461f6..b9f4b6a6d7 100644 --- a/bootstrap/lib/stdlib/ebin/gen.beam +++ b/bootstrap/lib/stdlib/ebin/gen.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex d45e508d22..4359a69f03 100644 --- a/bootstrap/lib/stdlib/ebin/gen_event.beam +++ b/bootstrap/lib/stdlib/ebin/gen_event.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam Binary files differindex bf5bbb7839..d04466bf92 100644 --- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam +++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam Binary files differindex fe95ca0826..7a7b4ad0f0 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam Binary files differindex e579d3cb2e..fcfce54d0e 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_format.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_format.beam diff --git a/bootstrap/lib/stdlib/ebin/maps.beam b/bootstrap/lib/stdlib/ebin/maps.beam Binary files differindex 4268a97fec..8473da95d7 100644 --- a/bootstrap/lib/stdlib/ebin/maps.beam +++ b/bootstrap/lib/stdlib/ebin/maps.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex 23b140aeb5..670943aad3 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/pg.beam b/bootstrap/lib/stdlib/ebin/pg.beam Binary files differdeleted file mode 100644 index 31f30461d8..0000000000 --- a/bootstrap/lib/stdlib/ebin/pg.beam +++ /dev/null diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam Binary files differindex ee23fef6f0..55cfff4680 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex 3756c0d46a..8c4734f208 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 1d255fb2c8..968f2e4d2f 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -19,7 +19,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "2.0"}, + {vsn, "2.2"}, {modules, [array, base64, beam_lib, @@ -77,7 +77,6 @@ orddict, ordsets, otp_internal, - pg, pool, proc_lib, proplists, @@ -103,7 +102,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.4","kernel-3.0","erts-6.0","crypto-3.3", + {runtime_dependencies, ["sasl-2.4","kernel-3.0.2","erts-6.2","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index d4db0c865e..541b1925e5 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -15,11 +15,11 @@ %% under the License. %% %% %CopyrightEnd% -{"2.0", +{"2.2", %% Up from - max one major revision back - [{<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 + [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 + {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0 %% Down to - max one major revision back - [{<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 + [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 + {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0 }. diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex 40d9b28a18..c2f7d78ec2 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam Binary files differindex 54d7385738..d4b8cab555 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam Binary files differindex 1413b822f2..a569f8003f 100644 --- a/bootstrap/lib/stdlib/ebin/sys.beam +++ b/bootstrap/lib/stdlib/ebin/sys.beam diff --git a/configure.in b/configure.in index be906dcb4e..be169b8428 100644 --- a/configure.in +++ b/configure.in @@ -262,6 +262,10 @@ AS_HELP_STRING([--with-ssl=PATH], [specify location of OpenSSL include and lib]) AS_HELP_STRING([--with-ssl], [use SSL (default)]) AS_HELP_STRING([--without-ssl], [don't use SSL])) +AC_ARG_WITH(ssl-incl, +AS_HELP_STRING([--with-ssl-incl=PATH], + [location of OpenSSL include dir, if different than specified by --with-ssl=PATH])) + AC_ARG_ENABLE(dynamic-ssl-lib, AS_HELP_STRING([--disable-dynamic-ssl-lib], [disable using dynamic openssl libraries])) @@ -366,6 +370,12 @@ elif test X"$TMPSYS" '=' X"Darwin-i386"; then export LDFLAGS fi +m4_define(DEFAULT_SANITIZERS, [address,undefined]) +AC_ARG_ENABLE(sanitizers, + AS_HELP_STRING( + [--enable-sanitizers@<:@=comma-separated list of sanitizers@:>@], + [Default=DEFAULT_SANITIZERS])) + AC_ARG_ENABLE([silent-rules], [dnl AS_HELP_STRING( [--enable-silent-rules], diff --git a/erts/configure.in b/erts/configure.in index f66110b98b..9864d03cde 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -446,13 +446,13 @@ else fi AC_ARG_ENABLE(static-nifs, -AS_HELP_STRING([--enable-static-nifs], [link nifs statically. If yes then all nifs in all Erlang/OTP applications will be statically linked into the main binary. It is also possible to give a list of nifs that should be linked statically. The list should be a comma seperated and contain the absolute path to a .a archive for each nif that is to be statically linked. The name of the .a archive has to be the same as the name of the nif. Note that you have to link any external dependencies that the nifs have to the main binary, so for the crypto nif you want to pass LIBS=-lcrypto to configure.]), +AS_HELP_STRING([--enable-static-nifs], [link nifs statically. If yes then all nifs in all Erlang/OTP applications will be statically linked into the main binary. It is also possible to give a list of nifs that should be linked statically. The list should be a comma separated and contain the absolute path to a .a archive for each nif that is to be statically linked. The name of the .a archive has to be the same as the name of the nif. Note that you have to link any external dependencies that the nifs have to the main binary, so for the crypto nif you want to pass LIBS=-lcrypto to configure.]), STATIC_NIFS="$enableval", STATIC_NIFS=no) AC_SUBST(STATIC_NIFS) AC_ARG_ENABLE(static-drivers, -AS_HELP_STRING([--enable-static-drivers], [comma seperated list of linked-in drivers to link statically with the main binary. The list should contain the absolute path to a .a archive for each driver that is to be statically linked. The name of the .a archive has to be the same as the name of the driver.]), +AS_HELP_STRING([--enable-static-drivers], [comma separated list of linked-in drivers to link statically with the main binary. The list should contain the absolute path to a .a archive for each driver that is to be statically linked. The name of the .a archive has to be the same as the name of the driver.]), STATIC_DRIVERS="$enableval", STATIC_DRIVERS=no) AC_SUBST(STATIC_DRIVERS) @@ -2109,6 +2109,17 @@ AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlop flockfile fstat strlcpy strlcat setsid posix2time time2posix \ setlocale nl_langinfo poll mlockall]) +AC_MSG_CHECKING([for isfinite]) +AC_TRY_LINK([#include <math.h>], + [isfinite(0);], have_isfinite=yes, have_isfinite=no), + +if test $have_isfinite = yes; then + AC_DEFINE(HAVE_ISFINITE,[1], + [Define to 1 if you have the `isfinite' function.]) + AC_MSG_RESULT(yes) +else + AC_MSG_RESULT(no) +fi case X$erl_xcomp_posix_memalign in Xno) ;; @@ -3988,7 +3999,7 @@ dnl If set to --with-ssl=PATH we use that path as the prefix, i.e. we dnl use "PATH/include" and "PATH/lib". AC_SUBST(SSL_INCLUDE) -AC_SUBST(SSL_ROOT) +AC_SUBST(SSL_INCDIR) AC_SUBST(SSL_LIBDIR) AC_SUBST(SSL_CRYPTO_LIBNAME) AC_SUBST(SSL_SSL_LIBNAME) @@ -4082,6 +4093,15 @@ AS_HELP_STRING([--with-ssl=PATH], [specify location of OpenSSL include and lib]) AS_HELP_STRING([--with-ssl], [use SSL (default)]) AS_HELP_STRING([--without-ssl], [don't use SSL])) +AC_ARG_WITH(ssl-incl, +AS_HELP_STRING([--with-ssl-incl=PATH], [location of OpenSSL include dir, if different than specified by --with-ssl=PATH]), +[ +case X$with_ssl in + X | Xyes | Xno) AC_MSG_ERROR([--with-ssl-incl=PATH set without --with-ssl=PATH]);; +esac +], +[with_ssl_incl=$with_ssl]) #default + AC_ARG_ENABLE(dynamic-ssl-lib, AS_HELP_STRING([--disable-dynamic-ssl-lib], [disable using dynamic openssl libraries]), @@ -4196,7 +4216,7 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in dir="$erl_xcomp_sysroot$rdir" if test -f "$erl_xcomp_isysroot$rdir/include/openssl/opensslv.h"; then is_real_ssl=yes - SSL_ROOT="$dir" + SSL_INCDIR="$dir" if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes"; then if test -f "$dir/lib/VC/libeay32.lib"; then SSL_RUNTIME_LIBDIR="$rdir/lib/VC" @@ -4326,8 +4346,8 @@ case "$erl_xcomp_without_sysroot-$with_ssl" in # Trust OpenBSD to have everything the in the correct locations. ssl_found=yes ssl_linkable=yes - SSL_ROOT="$erl_xcomp_sysroot/usr" - AC_MSG_RESULT([$SSL_ROOT]) + SSL_INCDIR="$erl_xcomp_sysroot/usr" + AC_MSG_RESULT([$SSL_INCDIR]) SSL_RUNTIME_LIB="/usr/lib" SSL_LIB="$erl_xcomp_sysroot/usr/lib" SSL_BINDIR="/usr/sbin" @@ -4394,7 +4414,10 @@ dnl so it is - be adoptable if test ! -d "$with_ssl" ; then AC_MSG_ERROR(Invalid path to option --with-ssl=PATH) fi - SSL_ROOT="$with_ssl" + if test ! -d "$with_ssl_incl" ; then + AC_MSG_ERROR(Invalid path to option --with-ssl-incl=PATH) + fi + SSL_INCDIR="$with_ssl_incl" SSL_CRYPTO_LIBNAME=crypto SSL_SSL_LIBNAME=ssl if test "x$MIXED_CYGWIN" = "xyes" -o "x$MIXED_MSYS" = "xyes" && test -d "$with_ssl/lib/VC"; then @@ -4444,12 +4467,12 @@ dnl so it is - be adoptable elif test '!' -f ${SSL_LIBDIR}/lib${SSL_CRYPTO_LIBNAME}.so -a '!' -f "$SSL_LIBDIR/lib${SSL_CRYPTO_LIBNAME}.dylib"; then SSL_STATIC_ONLY=yes fi - SSL_INCLUDE="-I$with_ssl/include" + SSL_INCLUDE="-I$with_ssl_incl/include" SSL_APP=ssl CRYPTO_APP=crypto SSH_APP=ssh if test "$cross_compiling" = "yes"; then - SSL_RUNTIME_LIBDIR=`echo "$SSL_LIBDIR" | sed -n "s|^$erl_xcomp_sysroot\(.*\)\$|\1|p"` + SSL_RUNTIME_LIBDIR=`echo "$SSL_LIBDIR" | sed -n "s|^$erl_xcomp_sysroot\(/*\)\(.*\)\$|/\2|p"` else SSL_RUNTIME_LIBDIR="$SSL_LIBDIR" fi @@ -4507,8 +4530,8 @@ if test "x$SSL_APP" != "x" ; then SSL_KRB5_INCLUDE= if test "x$ssl_krb5_enabled" = "xyes" ; then AC_MSG_CHECKING(for krb5.h in standard locations) - for dir in $extra_dir "$SSL_ROOT/include" "$SSL_ROOT/include/openssl" \ - "$SSL_ROOT/include/kerberos" \ + for dir in $extra_dir "$SSL_INCDIR/include" "$SSL_INCDIR/include/openssl" \ + "$SSL_INCDIR/include/kerberos" \ "$erl_xcomp_isysroot/cygdrive/c/kerberos/include" \ "$erl_xcomp_isysroot/usr/local/kerberos/include" \ "$erl_xcomp_isysroot/usr/kerberos/include" \ @@ -4805,7 +4828,7 @@ AH_BOTTOM([ #define HAVE_GETHRVTIME #endif -#ifndef HAVE_FINITE +#if !defined(HAVE_ISFINITE) && !defined(HAVE_FINITE) # if defined(HAVE_ISINF) && defined(HAVE_ISNAN) # define USE_ISINF_ISNAN # endif @@ -4821,6 +4844,26 @@ if test "x$GCC" = xyes; then fi dnl ---------------------------------------------------------------------- +dnl Enable -fsanitize= flags. +dnl ---------------------------------------------------------------------- + +m4_define(DEFAULT_SANITIZERS, [address,undefined]) +AC_ARG_ENABLE( + sanitizers, + AS_HELP_STRING( + [--enable-sanitizers@<:@=comma-separated list of sanitizers@:>@], + [Default=DEFAULT_SANITIZERS]), +[ +case "$enableval" in + no) sanitizers= ;; + yes) sanitizers="-fsanitize=DEFAULT_SANITIZERS" ;; + *) sanitizers="-fsanitize=$enableval" ;; +esac +CFLAGS="$CFLAGS $sanitizers" +LDFLAGS="$LDFLAGS $sanitizers" +]) + +dnl ---------------------------------------------------------------------- dnl Output the result. dnl ---------------------------------------------------------------------- diff --git a/erts/doc/src/crash_dump.xml b/erts/doc/src/crash_dump.xml index c59741f250..2b5fc877c3 100644 --- a/erts/doc/src/crash_dump.xml +++ b/erts/doc/src/crash_dump.xml @@ -85,20 +85,22 @@ operating system.</p> <list type="bulleted"> <item>"<em><A></em>: Cannot allocate <em><N></em> - bytes of memory (of type "<em><T></em>")." - The system - has run out of memory. <A> is the allocator that failed - to allocate memory, <N> is the number of bytes that - <A> tried to allocate, and <T> is the memory block - type that the memory was needed for. The most common case is - that a process stores huge amounts of data. In this case - <T> is most often <c><![CDATA[heap]]></c>, <c><![CDATA[old_heap]]></c>, - <c><![CDATA[heap_frag]]></c>, or <c><![CDATA[binary]]></c>. For more information on - allocators see - <seealso marker="erts_alloc">erts_alloc(3)</seealso>.</item> + bytes of memory (of type "<em><T></em>", thread + <em><I></em>em>)." - The system has run out of memory. <A> + is the allocator that failed to allocate memory, <N> is the + number of bytes that <A> tried to allocate, <T> is the + memory block type that the memory was needed for, and <I> is the + thread identifier. The most common case is that a process stores huge + amounts of data. In this case <T> is most often + <c><![CDATA[heap]]></c>, <c><![CDATA[old_heap]]></c>, + <c><![CDATA[heap_frag]]></c>, or <c><![CDATA[binary]]></c>. + For more information on allocators see + <seealso marker="erts_alloc">erts_alloc(3)</seealso>.</item> <item>"<em><A></em>: Cannot reallocate <em><N></em> - bytes of memory (of type "<em><T></em>")." - Same as - above with the exception that memory was being reallocated - instead of being allocated when the system ran out of memory.</item> + bytes of memory (of type "<em><T></em>", thread + <em><I></em>em>)." - Same as above with the exception that memory + was being reallocated instead of being allocated when the system ran + out of memory.</item> <item>"Unexpected op code <em>N</em>" - Error in compiled code, <c><![CDATA[beam]]></c> file damaged or error in the compiler.</item> <item>"Module <em>Name</em> undefined" <c><![CDATA[|]]></c> "Function @@ -113,8 +115,9 @@ sockets/pipes can be used simultaneously by Erlang (due to limitations in the Unix <c><![CDATA[select]]></c> call). The number of open regular files is not affected by this.</item> - <item>"Received SIGUSR1" - The SIGUSR1 signal was sent to the - Erlang machine (Unix only).</item> + <item>"Received SIGUSR1" - Sending the SIGUSR1 signal to a + Erlang machine (Unix only) forces a crash dump. This slogan reflects + that the Erlang machine crash-dumped due to receiving that signal.</item> <item>"Kernel pid terminated (<em>Who</em>) (<em>Exit-reason</em>)" - The kernel supervisor has detected a failure, usually that the <c><![CDATA[application_controller]]></c> @@ -246,6 +249,9 @@ <tag><em>Last scheduled in for | Current call</em></tag> <item>The current function of the process. These fields will not always exist.</item> + <tag><em>Run queue</em></tag> + <item>The identifier of the scheduler run queue in which the process is + running.</item> <tag><em>Spawned by</em></tag> <item>The parent of the process, i.e. the process which executed <c><![CDATA[spawn]]></c> or <c><![CDATA[spawn_link]]></c>.</item> diff --git a/erts/doc/src/epmd.xml b/erts/doc/src/epmd.xml index 963d35c3c8..25f819ab50 100644 --- a/erts/doc/src/epmd.xml +++ b/erts/doc/src/epmd.xml @@ -58,12 +58,12 @@ of the IP address and a port number. The name of the node is an atom on the form of <c><![CDATA[Name@Node]]></c>. The job of the <c><![CDATA[epmd]]></c> daemon is to keep track of which - node name listens on which address. Hence, <c><![CDATA[epmd]]></c> map + node name listens on which address. Hence, <c><![CDATA[epmd]]></c> maps symbolic node names to machine addresses.</p> <p>The TCP/IP <c>epmd</c> daemon actually only keeps track of - the <c>Name</c> (first) part of an Erlang node name, the <c>Host</c> - part (whatever is after the <c><![CDATA[@]]></c> is implicit in the + the <c>Name</c> (first) part of an Erlang node name. The <c>Host</c> + part (whatever is after the <c><![CDATA[@]]></c>) is implicit in the node name where the <c>epmd</c> daemon was actually contacted, as is the IP address where the Erlang node can be reached. Consistent and correct TCP naming services are @@ -77,12 +77,12 @@ <p>The daemon is started automatically by the <c>erl</c> command if the node is to be distributed and there is no running instance present. If automatically launched, - environment variables has to be used to alter the behavior of + environment variables have to be used to alter the behavior of the daemon. See the <seealso marker="#environment_variables">Environment variables</seealso> section below.</p> - <p>If the -daemon argument is not given, the + <p>If the -daemon argument is not given, <c><![CDATA[epmd]]></c> runs as a normal program with the controlling terminal of the shell in which it is started. Normally, it should run as a daemon.</p> @@ -122,7 +122,7 @@ comma-separated list of IP addresses and on the loopback address (which is implicitly added to the list if it has not been specified). This can also be set using the - <c><![CDATA[ERL_EPMD_ADDRESS]]></c> environment variable, see the + <c><![CDATA[ERL_EPMD_ADDRESS]]></c> environment variable. See the section <seealso marker="#environment_variables">Environment variables</seealso> below.</p> </item> @@ -130,7 +130,7 @@ <item> <p>Let this instance of epmd listen to another TCP port than default 4369. This can also be set using the - <c><![CDATA[ERL_EPMD_PORT]]></c> environment variable, see the + <c><![CDATA[ERL_EPMD_PORT]]></c> environment variable. See the section <seealso marker="#environment_variables">Environment variables</seealso> below</p> </item> @@ -153,7 +153,7 @@ <p>With relaxed command checking, the <c>epmd</c> daemon can be killed from the localhost with i.e. <c>epmd -kill</c> even if there are active nodes registered. Normally only daemons with an empty node database can be killed with the <c>epmd -kill</c> command.</p> </item> <item> - <p>The <c>epmd -stop</c> command (and the corresponding messages to epmd, as can be given using <c>erl_interface/ei</c>) is normally always ignored, as it opens up for strange situation when two nodes of the same name can be alive at the same time. A node unregisters itself by just closing the connection to epmd, why the <c>stop</c> command was only intended for use in debugging situations.</p> + <p>The <c>epmd -stop</c> command (and the corresponding messages to epmd, as can be given using <c>erl_interface/ei</c>) is normally always ignored, as it opens up the possibility of a strange situation where two nodes of the same name can be alive at the same time. A node unregisters itself by just closing the connection to epmd, which is why the <c>stop</c> command was only intended for use in debugging situations.</p> <p>With relaxed command checking enabled, you can forcibly unregister live nodes.</p> </item> </list> @@ -166,7 +166,7 @@ <section> <marker id="debug_flags"></marker> <title>DbgExtra options</title> - <p>These options are purely for debugging and testing epmd clients, they should not be used in normal operation.</p> + <p>These options are purely for debugging and testing epmd clients. They should not be used in normal operation.</p> <taglist> <tag><c><![CDATA[-packet_timeout Seconds]]></c></tag> @@ -177,9 +177,9 @@ </item> <tag><c><![CDATA[-delay_accept Seconds]]></c></tag> <item> - <p>To simulate a busy server you can insert a delay between epmd - gets notified about that a new connection is requested and - when the connections gets accepted.</p> + <p>To simulate a busy server you can insert a delay between when epmd + gets notified that a new connection is requested and + when the connection gets accepted.</p> </item> <tag><c><![CDATA[-delay_write Seconds]]></c></tag> <item> @@ -191,15 +191,15 @@ <section> <marker id="interactive_flags"></marker> <title>Interactive options</title> - <p>These options make <c>epmd</c> run as an interactive command displaying the results of sending queries ta an already running instance of <c>epmd</c>. The epmd contacted is always on the local node, but the <c>-port</c> option can be used to select between instances if several are running using different port on the host.</p> + <p>These options make <c>epmd</c> run as an interactive command, displaying the results of sending queries to an already running instance of <c>epmd</c>. The epmd contacted is always on the local node, but the <c>-port</c> option can be used to select between instances if several are running using different ports on the host.</p> <taglist> <tag><c><![CDATA[-port No]]></c></tag> <item> <p>Contacts the <c>epmd</c> listening on the given TCP port number (default 4369). This can also be set using the - <c><![CDATA[ERL_EPMD_PORT]]></c> environment variable, see the + <c><![CDATA[ERL_EPMD_PORT]]></c> environment variable. See the section <seealso marker="#environment_variables">Environment - variables</seealso> below</p> + variables</seealso> below.</p> </item> <tag><c><![CDATA[-names]]></c></tag> <item> @@ -210,7 +210,7 @@ <p>Kill the currently running <c>epmd</c>.</p> <p>Killing the running <c>epmd</c> is only allowed if <c>epmd - -names</c> show an empty database or + -names</c> shows an empty database or <c>-relaxed_command_check</c> was given when the running instance of <c>epmd</c> was started. Note that <c>-relaxed_command_check</c> is given when starting the @@ -228,7 +228,7 @@ <p>This command can only be used when contacting <c>epmd</c> instances started with the <c>-relaxed_command_check</c> flag. Note that relaxed command checking has to be enabled for - the <c>epmd</c> daemon contacted, When running epmd + the <c>epmd</c> daemon contacted. When running epmd interactively, <c>-relaxed_command_check</c> has no effect.</p> </item> @@ -259,7 +259,7 @@ <item> <p>If set prior to start, the <c>epmd</c> daemon will behave as if the <c>-relaxed_command_check</c> option was given at - start-up. If consequently setting this option before starting + start-up. Consequently, if this option is set before starting the Erlang virtual machine, the automatically started <c>epmd</c> will accept the <c>-kill</c> and <c>-stop</c> commands without restrictions.</p> @@ -287,8 +287,8 @@ remote hosts. However, only the query commands are answered (and acted upon) if the query comes from a remote host. It is always an error to try to register a nodename if the client is not a process - located on the same host as the <c>epmd</c> instance is running on, - why such requests are considered hostile and the connection is + located on the same host as the <c>epmd</c> instance is running on- + such requests are considered hostile and the connection is immediately closed.</p> <p>The queries accepted from remote nodes are:</p> @@ -307,3 +307,4 @@ </comref> + diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 5bde285311..16000191dc 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -525,7 +525,8 @@ core dump and no crash dump if an internal error is detected.</p> <p>Calling <c>erlang:halt/1</c> with a string argument will still - produce a crash dump.</p> + produce a crash dump. On Unix systems, sending an emulator process + a SIGUSR1 signal will also force a crash dump.</p> </item> <tag><marker id="+e"><c><![CDATA[+e Number]]></c></marker></tag> <item> @@ -1141,6 +1142,23 @@ <p>For more information, see <seealso marker="erlang#system_info_cpu_topology">erlang:system_info(cpu_topology)</seealso>.</p> </item> + <tag><marker id="+secio"><c>+secio true|false</c></marker></tag> + <item> + <p>Enable or disable eager check I/O scheduling. The default + is currently <c>true</c>. The default was changed from <c>false</c> + to <c>true</c> as of erts version 7.0. The behaviour before this + flag was introduced corresponds to <c>+secio false</c>.</p> + <p>The flag effects when schedulers will check for I/O + operations possible to execute, and when such I/O operations + will execute. As the name of the parameter implies, + schedulers will be more eager to check for I/O when + <c>true</c> is passed. This however also implies that + execution of outstanding I/O operation will not be + prioritized to the same extent as when <c>false</c> is + passed.</p> + <p><seealso marker="erlang#system_info_eager_check_io"><c>erlang:system_info(eager_check_io)</c></seealso> + returns the value of this parameter used when starting the VM.</p> + </item> <tag><marker id="+sfwi"><c>+sfwi Interval</c></marker></tag> <item> <p>Set scheduler forced wakeup interval. All run queues will @@ -1186,7 +1204,7 @@ utilization. </p> </item> - <tag><marker id="+swct"><c>+sws very_eager|eager|medium|lazy|very_lazy</c></marker></tag> + <tag><marker id="+swct"><c>+swct very_eager|eager|medium|lazy|very_lazy</c></marker></tag> <item> <p> Set scheduler wake cleanup threshold. Default is <c>medium</c>. diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index ad37813ac0..77fc906aca 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -546,6 +546,7 @@ typedef struct ErlDrvSysInfo { int scheduler_threads; int nif_major_version; int nif_minor_version; + int dirty_scheduler_support; } ErlDrvSysInfo; </code> @@ -610,6 +611,10 @@ typedef struct ErlDrvSysInfo { <tag><c>nif_minor_version</c></tag> <item>The value of <c>ERL_NIF_MINOR_VERSION</c> when the runtime system was compiled. </item> + <tag><c>dirty_scheduler_support</c></tag> + <item>A value <c>!= 0</c> if the runtime system has support for dirty scheduler threads; + otherwise <c>0</c>. + </item> </taglist> </item> <tag><marker id="ErlDrvBinary"/>ErlDrvBinary</tag> @@ -2028,7 +2033,8 @@ ERL_DRV_MAP int sz entry function is called. If <c>ready_async</c> is null in the driver entry, the <c>async_free</c> function is called instead.</p> - <p>The return value is a handle to the asynchronous task.</p> + <p>The return value is -1 if the <c>driver_async</c> call + fails.</p> <note> <p>As of erts version 5.5.4.3 the default stack size for threads in the async-thread pool is 16 kilowords, diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 6b1f4cccf8..3de94be9ff 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -168,16 +168,18 @@ ok <p><marker id="lengthy_work"/> As mentioned in the <seealso marker="#WARNING">warning</seealso> text at the beginning of this document it is of vital importance that a native function - does return relatively fast. It is hard to give an exact maximum amount + return relatively quickly. It is hard to give an exact maximum amount of time that a native function is allowed to work, but as a rule of thumb - a well behaving native function should return to its caller before a + a well-behaving native function should return to its caller before a millisecond has passed. This can be achieved using different approaches. - If you have full control over the code that are to execute in the native + If you have full control over the code to execute in the native function, the best approach is to divide the work into multiple chunks of - work and call the native function multiple times. Function + work and call the native function multiple times, either directly from Erlang code + or by having a native function schedule a future NIF call via the + <seealso marker="#enif_schedule_nif"> enif_schedule_nif</seealso> function. Function <seealso marker="#enif_consume_timeslice">enif_consume_timeslice</seealso> can be - used this facilitate such work division. In some cases, however, this might not - be possible, e.g. when calling third party libraries. Then you typically want + used to help with such work division. In some cases, however, this might not + be possible, e.g. when calling third-party libraries. Then you typically want to dispatch the work to another thread, return from the native function, and wait for the result. The thread can send the result back to the calling thread using message passing. Information @@ -342,37 +344,38 @@ ok libraries might however fail if deprecated features are used. </p></item> - <tag>Dirty NIFs</tag> - <item><p><marker id="dirty_nifs"/><em>Note that the dirty NIF functionality - is experimental</em> and that you have to enable support for dirty - schedulers when building OTP in order to try the functionality out. Native functions + <tag>Long-running NIFs</tag> + <item><p><marker id="dirty_nifs"/>Native functions <seealso marker="#lengthy_work"> must normally run quickly</seealso>, as explained earlier in this document. They generally should execute for no more than a millisecond. But not all native functions can execute so quickly; for example, functions that encrypt large blocks of data or perform lengthy file system operations can often run for tens of seconds or more.</p> - <p>A NIF that cannot execute in a millisecond or less is called a "dirty NIF" since - it performs work that the Erlang runtime cannot handle cleanly. Applications - that make use of such functions must indicate to the runtime that the functions are + <p>If the functionality of a long-running NIF can be split so that its work can be + achieved through a series of shorter NIF calls, the application can either make that series + of NIF calls from the Erlang level, or it can call a NIF that first performs a chunk of the + work, then invokes the <seealso marker="#enif_schedule_nif">enif_schedule_nif</seealso> + function to schedule another NIF call to perform the next chunk. The final call scheduled + in this manner can then return the overall result. Breaking up a long-running function in + this manner enables the VM to regain control between calls to the NIFs, thereby avoiding + degraded responsiveness, scheduler load balancing problems, and other strange behaviours.</p> + <p>A NIF that cannot be split and cannot execute in a millisecond or less is called a "dirty NIF" + because it performs work that the Erlang runtime cannot handle cleanly. + <em>Note that the dirty NIF functionality described here is experimental</em> and that you have to + enable support for dirty schedulers when building OTP in order to try the functionality out. + Applications that make use of such functions must indicate to the runtime that the functions are dirty so they can be handled specially. To schedule a dirty NIF for execution, the - application calls <seealso marker="#enif_schedule_dirty_nif">enif_schedule_dirty_nif</seealso>, - passing to it a pointer to the dirty NIF to be executed and indicating with a flag + appropriate flags value can be set for the NIF in its <seealso marker="#ErlNifFunc">ErlNifFunc</seealso> + entry, or the application can call <seealso marker="#enif_schedule_nif">enif_schedule_nif</seealso>, + passing to it a pointer to the dirty NIF to be executed and indicating with the <c>flags</c> argument whether it expects the operation to be CPU-bound or I/O-bound.</p> - <p>All dirty NIFs must ultimately invoke the <seealso marker="#enif_schedule_dirty_nif_finalizer"> - enif_schedule_dirty_nif_finalizer</seealso> as their final action, passing to it the - result they wish to return to the original caller. A finalizer function can either - receive the result and return it directly, or it can return a different value instead. - For convenience, the NIF API provides the <seealso marker="#enif_dirty_nif_finalizer"> - enif_dirty_nif_finalizer</seealso> function that applications can use as a finalizer; - it simply returns its result argument.</p> <note><p>Dirty NIF support is available only when the emulator is configured with dirty schedulers enabled. This feature is currently disabled by default. To determine whether the dirty NIF API is available, native code can check to see if the C preprocessor macro <c>ERL_NIF_DIRTY_SCHEDULER_SUPPORT</c> is defined. Also, if the Erlang runtime was built without threading support, dirty schedulers are disabled. To check at runtime for the presence - of dirty scheduler threads, code can call the <seealso marker="#enif_have_dirty_schedulers"><c> - enif_have_dirty_schedulers()</c></seealso> API function, which returns true if dirty - scheduler threads are present, false otherwise.</p></note> + of dirty scheduler threads, code can use the <seealso marker="#enif_system_info"><c> + enif_system_info()</c></seealso> API function.</p></note> </item> </taglist> </section> @@ -498,6 +501,7 @@ typedef struct { const char* <em>name</em>; unsigned <em>arity</em>; ERL_NIF_TERM (*<em>fptr</em>)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + unsigned flags; } ErlNifFunc; </code> <p>Describes a NIF by its name, arity and implementation. @@ -508,7 +512,17 @@ typedef struct { will thus denote the Nth argument to the NIF. Note that the <c>argc</c> argument allows for the same C function to implement several Erlang functions with different arity (but - same name probably).</p> + same name probably). For a regular NIF, <c>flags</c> is 0 (and + so its value can be omitted for statically initialized <c>ErlNifFunc</c> + instances), or it can be used to indicate that the NIF is a <seealso + marker="#dirty_nifs">dirty NIF</seealso> that should be executed + on a dirty scheduler thread (<em>note that the dirty NIF functionality + described here is experimental</em> and that you have to enable + support for dirty schedulers when building OTP in order to try the + functionality out). If the dirty NIF is expected to be + CPU-bound, its <c>flags</c> field should be set to + <c>ERL_NIF_DIRTY_JOB_CPU_BOUND</c>, or for I/O-bound jobs, + <c>ERL_NIF_DIRTY_JOB_IO_BOUND</c>.</p> </item> <tag><marker id="ErlNifBinary"/>ErlNifBinary</tag> <item> @@ -672,18 +686,6 @@ typedef enum { See also the <seealso marker="#WARNING">warning</seealso> text at the beginning of this document.</p> </desc> </func> - <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_dirty_nif_finalizer(ErlNifEnv* env, ERL_NIF_TERM result)</nametext></name> - <fsummary>Simple dirty NIF result finalizer</fsummary> - <desc> - <p>A convenience function that a dirty NIF can use as a finalizer that simply - return its <c>result</c> argument as its return value. This function is provided - for dirty NIFs with results that should be returned directly to the original caller.</p> - <note><p>This function is available only when the emulator is configured with dirty - schedulers enabled. This feature is currently disabled by default. To determine whether - the dirty NIF API is available, native code can check to see if the C preprocessor macro - <c>ERL_NIF_DIRTY_SCHEDULER_SUPPORT</c> is defined.</p></note> - </desc> - </func> <func><name><ret>int</ret><nametext>enif_equal_tids(ErlNifTid tid1, ErlNifTid tid2)</nametext></name> <fsummary></fsummary> <desc><p>Same as <seealso marker="erl_driver#erl_drv_equal_tids">erl_drv_equal_tids</seealso>. @@ -804,22 +806,6 @@ typedef enum { and return true, or return false if <c>term</c> is not an unsigned integer or is outside the bounds of type <c>unsigned long</c>.</p></desc> </func> - <func><name><ret>int</ret><nametext>enif_have_dirty_schedulers()</nametext></name> - <fsummary>Runtime check for the presence of dirty scheduler threads</fsummary> - <desc> - <p>Check at runtime for the presence of dirty scheduler threads. If the emulator is - built with threading support, dirty scheduler threads are available and - <c>enif_have_dirty_schedulers()</c> returns true. If the emulator was built without - threading support, <c>enif_have_dirty_schedulers()</c> returns false.</p> - <p>If dirty scheduler threads are not available in the emulator, calls to - <c>enif_schedule_dirty_nif</c> and <c>enif_schedule_dirty_nif_finalizer</c> result in - the NIF and finalizer functions being called directly within the calling thread.</p> - <note><p>This function is available only when the emulator is configured with dirty - schedulers enabled. This feature is currently disabled by default. To determine whether - the dirty NIF API is available, native code can check to see if the C preprocessor macro - <c>ERL_NIF_DIRTY_SCHEDULER_SUPPORT</c> is defined.</p></note> - </desc> - </func> <func><name><ret>int</ret><nametext>enif_inspect_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, ErlNifBinary* bin)</nametext></name> <fsummary>Inspect the content of a binary</fsummary> <desc><p>Initialize the structure pointed to by <c>bin</c> with @@ -873,8 +859,8 @@ typedef enum { <p>Check to see if the current NIF is executing on a dirty scheduler thread. If the emulator is built with threading support, calling <c>enif_is_on_dirty_scheduler</c> from within a dirty NIF returns true. It returns false when the calling NIF is a regular - NIF or a NIF finalizer, both of which run on normal scheduler threads, or when the emulator - is built without threading support.</p> + NIF running on a normal scheduler thread, or when the emulator is built without threading + support.</p> <note><p>This function is available only when the emulator is configured with dirty schedulers enabled. This feature is currently disabled by default. To determine whether the dirty NIF API is available, native code can check to see if the C preprocessor macro @@ -1245,46 +1231,29 @@ typedef enum { <desc><p>Same as <seealso marker="erl_driver#erl_drv_rwlock_tryrwlock">erl_drv_rwlock_tryrwlock</seealso>. </p></desc> </func> - <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_schedule_dirty_nif(ErlNifEnv* env, int flags, ERL_NIF_TERM (*fp)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]), int argc, const ERL_NIF_TERM argv[])</nametext></name> - <fsummary>Schedule a dirty NIF for execution</fsummary> + <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_schedule_nif(ErlNifEnv* env, const char* fun_name, int flags, ERL_NIF_TERM (*fp)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]), int argc, const ERL_NIF_TERM argv[])</nametext></name> + <fsummary>Schedule a NIF for execution</fsummary> <desc> - <p>Schedule dirty NIF <c>fp</c> to execute a long-running operation. The <c>flags</c> - argument must be set to either <c>ERL_NIF_DIRTY_JOB_CPU_BOUND</c> if the job is expected to - be primarily CPU-bound, or <c>ERL_NIF_DIRTY_JOB_IO_BOUND</c> for jobs that will be - I/O-bound. The <c>argc</c> and <c>argv</c> arguments can either be the originals passed - into the calling NIF, or they can be values created by the calling NIF. The calling - NIF must use the return value of <c>enif_schedule_dirty_nif</c> as its own return value.</p> - <p>Be aware that <c>enif_schedule_dirty_nif</c>, as its name implies, only schedules the - dirty NIF for future execution. The calling NIF does not block waiting for the dirty NIF to - execute and return, which means that the calling NIF can't expect to receive the dirty NIF + <p>Schedule NIF <c>fp</c> to execute. This function allows an application to break up long-running + work into multiple regular NIF calls or to schedule a <seealso marker="#dirty_nifs">dirty NIF</seealso> + to execute on a dirty scheduler thread (<em>note that the dirty NIF functionality described here is + experimental</em> and that you have to enable support for dirty schedulers when building OTP in + order to try the functionality out).</p> + <p>The <c>fun_name</c> argument provides a name for the NIF being scheduled for execution. If it cannot + be converted to an atom, <c>enif_schedule_nif</c> returns a <c>badarg</c> exception.</p> + <p>The <c>flags</c> argument must be set to 0 for a regular NIF, or if the emulator was built the + experimental dirty scheduler support enabled, <c>flags</c> can be set to either <c>ERL_NIF_DIRTY_JOB_CPU_BOUND</c> + if the job is expected to be primarily CPU-bound, or <c>ERL_NIF_DIRTY_JOB_IO_BOUND</c> for jobs that will + be I/O-bound. If dirty scheduler threads are not available in the emulator, a try to schedule such a job + will result in a <c>badarg</c> exception.</p> + + <p>The <c>argc</c> and <c>argv</c> arguments can either be the originals passed into the calling NIF, or + they can be values created by the calling NIF.</p> + <p>The calling NIF must use the return value of <c>enif_schedule_nif</c> as its own return value.</p> + <p>Be aware that <c>enif_schedule_nif</c>, as its name implies, only schedules the + NIF for future execution. The calling NIF does not block waiting for the scheduled NIF to + execute and return, which means that the calling NIF can't expect to receive the scheduled NIF return value and use it for further operations.</p> - <p>A dirty NIF may not invoke the <seealso marker="#enif_make_badarg">enif_make_badarg</seealso> - to raise an exception. If it wishes to return an exception, the dirty NIF should pass a - regular result indicating the exception details to its finalizer, and allow the finalizer - to raise the exception on its behalf.</p> - <note><p>This function is available only when the emulator is configured with dirty schedulers - enabled. This feature is currently disabled by default. To determine whether the dirty NIF API - is available, native code can check to see if the C preprocessor macro - <c>ERL_NIF_DIRTY_SCHEDULER_SUPPORT</c> is defined.</p></note> - </desc> - </func> - <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_schedule_dirty_nif_finalizer(ErlNifEnv* env, ERL_NIF_TERM result, ERL_NIF_TERM (*fp)(ErlNifEnv* env, ERL_NIF_TERM result))</nametext></name> - <fsummary>Schedule a dirty NIF finalizer</fsummary> - <desc> - <p>When a dirty NIF finishes executing, it must schedule a finalizer function to return - its result to the original NIF caller. The dirty NIF passes <c>result</c> as the value it - wants the finalizer to use as the return value. The <c>fp</c> argument is a pointer to the - finalizer function. The NIF API provides the <seealso marker="#enif_dirty_nif_finalizer"> - enif_dirty_nif_finalizer</seealso> function that can be used as a finalizer that simply - returns its <c>result</c> argument. You are also free to write your own custom finalizer - that uses <c>result</c> to derive a different return value, or ignores <c>result</c> - entirely and returns a completely different value.</p> - <p>Without exception, all dirty NIFs must invoke <c>enif_schedule_dirty_nif_finalizer</c> - to complete their execution.</p> - <note><p>This function is available only when the emulator is configured with dirty - schedulers enabled. This feature is currently disabled by default. To determine whether - the dirty NIF API is available, native code can check to see if the C preprocessor macro - <c>ERL_NIF_DIRTY_SCHEDULER_SUPPORT</c> is defined.</p></note> </desc> </func> <func><name><ret>ErlNifPid *</ret><nametext>enif_self(ErlNifEnv* caller_env, ErlNifPid* pid)</nametext></name> @@ -1384,4 +1353,3 @@ typedef enum { <p><seealso marker="erlang#load_nif-2">erlang:load_nif/2</seealso></p> </section> </cref> - diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 84168397f6..226f2c0150 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -1252,10 +1252,11 @@ true <fsummary>Check if a function is exported and loaded</fsummary> <desc> <p>Returns <c>true</c> if the module <c><anno>Module</anno></c> is loaded - and contains an exported function <c><anno>Function</anno>/<anno>Arity</anno></c>; - otherwise <c>false</c>.</p> - <p>Returns <c>false</c> for any BIF (functions implemented in C - rather than in Erlang).</p> + and contains an exported function <c><anno>Function</anno>/<anno>Arity</anno></c>, + or if there is a BIF (a built-in function implemented in C) + with the given name; otherwise returns <c>false</c>.</p> + <note><p>This function used to return false for built-in + functions before the 18.0 release.</p></note> </desc> </func> <func> @@ -1376,6 +1377,19 @@ true </desc> </func> <func> + <name name="get_keys" arity="0"/> + <fsummary>Return a list of all keys from the process dictionary</fsummary> + <desc> + <p>Returns a list of keys all keys present in the process dictionary.</p> + <pre> +> <input>put(dog, {animal,1}),</input> +<input>put(cow, {animal,2}),</input> +<input>put(lamb, {animal,3}),</input> +<input>get_keys().</input> +[dog,cow,lamb]</pre> + </desc> + </func> + <func> <name name="get_keys" arity="1"/> <fsummary>Return a list of keys from the process dictionary</fsummary> <desc> @@ -5775,6 +5789,7 @@ ok <name name="system_info" arity="1" clause_i="52"/> <name name="system_info" arity="1" clause_i="53"/> <name name="system_info" arity="1" clause_i="54"/> + <name name="system_info" arity="1" clause_i="55"/> <fsummary>Information about the system</fsummary> <desc> <p>Returns various information about the current system @@ -5970,6 +5985,16 @@ ok The return value will always be <c>false</c> since the elib_malloc allocator has been removed.</p> </item> + <tag><marker id="system_info_eager_check_io"><c>eager_check_io</c></marker></tag> + <item> + <p> + Returns the value of the <c>erl</c> + <seealso marker="erl#+secio">+secio</seealso> command line + flag which is either <c>true</c> or <c>false</c>. See the + documentation of the command line flag for information about + the different values. + </p> + </item> <tag><c>ets_limit</c></tag> <item> <p>Returns the maximum number of ETS tables allowed. This limit diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 50de3c5d4d..743369951f 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -30,6 +30,176 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 6.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + General documentation updates.</p> + <p> + Own Id: OTP-12052</p> + </item> + <item> + <p>A bug in the VM code implementing sending of signals + to ports could cause the receiving port queue to remain + in a busy state forever. When this state had been + reached, processes sending command signals to the port + either got suspended forever, or, if the <c>nosuspend</c> + feature was used, always failed to send to the port. This + bug was introduced in ERTS version 5.10.</p> + <p>In order for this bug to be triggered on a port, one + had to at least once utilize the <c>nosuspend</c> + functionality when passing a signal to the port. This by + either calling</p> <list> <item> <seealso + marker="erlang#port_command/3"><c>port_command(Port, + Data, [nosuspend | Options])</c></seealso>, </item> + <item> <seealso + marker="erlang#send/3"><c>erlang:send(Port, {PortOwner, + {command, Data}}, [nosuspend | Options])</c></seealso>, + </item> <item> <seealso + marker="erlang#send_nosuspend/2"><c>erlang:send_nosuspend(Port, + {PortOwner, {command, Data}})</c></seealso>, or </item> + <item> <seealso + marker="erlang#send_nosuspend/3"><c>erlang:send_nosuspend(Port, + {PortOwner, {command, Data}}, Options)</c></seealso>. + </item> </list> + <p>Thanks Vasily Demidenok for reporting the issue, and + Sergey Kudryashov for providing a testcase.</p> + <p> + Own Id: OTP-12082 Aux Id: OTP-10336 </p> + </item> + <item> + <p> + Fix size overflow bug at memory allocation. A memory + allocation call, with an insane size close to the entire + address space, could return successfully as if it had + allocated just a few bytes. (Thanks to Don A. Bailey for + reporting)</p> + <p> + Own Id: OTP-12091</p> + </item> + <item> + <p> + Fix various issues where negating a signed integer would + trigger undefined behaviour. This fixes issues in the + enif_make_int64 interface and some edge cases inside the + erlang runtime system.</p> + <p> + Own Id: OTP-12097</p> + </item> + <item> + <p> + The documentation erroneously listed the <seealso + marker="erl#+swct"><c>+swct</c></seealso> command line + argument under <c>+sws</c>.</p> + <p> + Own Id: OTP-12102 Aux Id: OTP-10994 </p> + </item> + <item> + <p> + Profiling messages could be delivered out of order when + profiling on <c>runnable_procs</c> and/or + <c>runnable_ports</c> using <seealso + marker="erlang#system_profile/2"><c>erlang:system_profile/2</c></seealso>. + This bug was introduced in ERTS version 5.10.</p> + <p> + Own Id: OTP-12105 Aux Id: OTP-10336 </p> + </item> + <item> + <p> + Various logging fixes, including: Add run queue index to + the process dump in crash dumps.<br/> Add thread index to + enomem slogan when crashing.<br/> Remove error logger + message for sending messages to old instances of the same + node.</p> + <p> + Own Id: OTP-12115</p> + </item> + <item> + <p> + Fix compiler warnings reported by LLVM</p> + <p> + Own Id: OTP-12138</p> + </item> + <item> + <p> + Correct conversion of <c>MIN_SMALL</c> by + <c>list_to_integer/1</c> and <c>binary_to_integer/1</c>. + The bug produced an unnormalized bignum which can cause + strange behavior such as comparing different to a correct + <c>MIN_SMALL</c> integer. The value <c>MIN_SMALL</c> is + <c>-(1 bsl 27) = -134217728</c> on a 32-bit VM and <c>-(1 + bsl 59) = -576460752303423488</c> on a 64-bit VM. (Thanks + to Jesper Louis Andersen, Mikael Pettersson and Anthony + Ramine for report, patch and optimization suggestion)</p> + <p> + Own Id: OTP-12140</p> + </item> + <item> + <p> + Fix bug in <c>term_to_binary</c> that reallocates binary + with inconsistent size information. Bug has never been + confirmed to be the cause of any faulty behavior.</p> + <p> + Own Id: OTP-12141</p> + </item> + <item> + <p> + Real_path method used while prim loading archive files + was not taking into account the fact that windows + directory symlinks can be across different drives.</p> + <p> + Own Id: OTP-12155</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add log2 histogram to lcnt for lock wait time</p> + <p> + Own Id: OTP-12059</p> + </item> + <item> + <p> + Introduced <seealso + marker="erl_nif#enif_schedule_nif"><c>enif_schedule_nif()</c></seealso> + to the NIF API.</p> + <p> + The <c>enif_schedule_nif()</c> function allows a + long-running NIF to be broken into separate NIF + invocations without the help of a wrapper function + written in Erlang. The NIF first executes part of the + long-running task, then calls <c>enif_schedule_nif()</c> + to schedule a NIF for later execution to continue the + task. Any number of NIFs can be scheduled in this manner, + one after another. Since the emulator regains control + between invocations, this helps avoid problems caused by + native code tying up scheduler threads for too long.</p> + <p> + The <c>enif_schedule_nif()</c> function also replaces the + <c>enif_schedule_dirty_nif()</c> in the experimental + dirty NIF API. Note that the only incompatible changes + made are in the experimental dirty NIF API.</p> + <p> + See the <seealso marker="erl_nif">NIF + documentation</seealso> for more information.</p> + <p> + Thanks to Steve Vinoski.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-12128</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 6.1.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -940,6 +1110,12 @@ Thanks to Matwey V. Kornilov</p> <p> Own Id: OTP-11829</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 5.10.4.1</title> <section><title>Known Bugs and Problems</title> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 7145824f91..53fc7bd713 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -112,18 +112,24 @@ NO_INLINE_FUNCTIONS=true else ifeq ($(TYPE),lcnt) -PURIFY = +PURIFY = TYPEMARKER = .lcnt TYPE_FLAGS = @CFLAGS@ -DERTS_ENABLE_LOCK_COUNT else ifeq ($(TYPE),frmptr) -PURIFY = +PURIFY = OMIT_OMIT_FP=yes TYPEMARKER = .frmptr TYPE_FLAGS = @CFLAGS@ -DERTS_FRMPTR else +ifeq ($(TYPE),icount) +PURIFY = +TYPEMARKER = .icount +TYPE_FLAGS = @CFLAGS@ -DERTS_OPCODE_COUNTER_SUPPORT +else + # If type isn't one of the above, it *is* opt type... override TYPE=opt PURIFY = @@ -138,6 +144,7 @@ endif endif endif endif +endif comma:=, space:= diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 5d06a32941..721a1ff219 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -279,7 +279,6 @@ atom http httph https http_response http_request http_header http_eoh http_error atom id atom if_clause atom ignore -atom imports atom in atom in_exiting atom inactive @@ -335,6 +334,7 @@ atom max atom maximum atom max_tables max_processes atom mbuf_size +atom md5 atom memory atom memory_internal atom memory_types diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 1026e5f649..e9f5fd798b 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -241,10 +241,6 @@ BeamInstr beam_return_time_trace[1]; /* OpCode(i_return_time_trace) */ void** beam_ops; #endif -#ifndef ERTS_SMP /* Not supported with smp emulator */ -extern int count_instructions; -#endif - #define SWAPIN \ HTOP = HEAP_TOP(c_p); \ E = c_p->stop @@ -1163,14 +1159,15 @@ void process_main(void) Eterm (*arith_func)(Process* p, Eterm* reg, Uint live); -#ifndef NO_JUMP_TABLE - static void* opcodes[] = { DEFINE_OPCODES }; #ifdef ERTS_OPCODE_COUNTER_SUPPORT static void* counting_opcodes[] = { DEFINE_COUNTING_OPCODES }; -#endif +#else +#ifndef NO_JUMP_TABLE + static void* opcodes[] = { DEFINE_OPCODES }; #else int Go; #endif +#endif Uint temp_bits; /* Temporary used by BsSkipBits2 & BsGetInteger2 */ @@ -3503,6 +3500,7 @@ get_map_elements_fail: * I[0]: &&call_nif * I[1]: Function pointer to NIF function * I[2]: Pointer to erl_module_nif + * I[3]: Function pointer to dirty NIF */ BifFunction vbf; @@ -3523,13 +3521,6 @@ get_map_elements_fail: reg[0] = r(0); nif_bif_result = (*fp)(&env, bif_nif_arity, reg); erts_post_nif(&env); -#ifdef ERTS_DIRTY_SCHEDULERS - if (is_non_value(nif_bif_result) && c_p->freason == TRAP) { - Export* ep = ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(c_p); - ep->code[0] = I[-3]; - ep->code[1] = I[-2]; - } -#endif } ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result)); PROCESS_MAIN_CHK_LOCKS(c_p); @@ -3788,8 +3779,6 @@ get_map_elements_fail: * Allocate the binary struct itself. */ bptr = erts_bin_nrml_alloc(num_bytes); - bptr->flags = 0; - bptr->orig_size = num_bytes; erts_refc_init(&bptr->refc, 1); erts_current_bin = (byte *) bptr->orig_bytes; @@ -3889,8 +3878,6 @@ get_map_elements_fail: * Allocate the binary struct itself. */ bptr = erts_bin_nrml_alloc(tmp_arg1); - bptr->flags = 0; - bptr->orig_size = tmp_arg1; erts_refc_init(&bptr->refc, 1); erts_current_bin = (byte *) bptr->orig_bytes; @@ -4993,14 +4980,14 @@ get_map_elements_fail: * ... remainder of original BEAM code */ ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); - c_p->hipe.ncallee = (void(*)(void)) I[-4]; + c_p->hipe.u.ncallee = (void(*)(void)) I[-4]; cmd = HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8); ++hipe_trap_count; goto L_hipe_mode_switch; } OpCase(hipe_trap_call_closure): { ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); - c_p->hipe.ncallee = (void(*)(void)) I[-4]; + c_p->hipe.u.ncallee = (void(*)(void)) I[-4]; cmd = HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8); ++hipe_trap_count; goto L_hipe_mode_switch; @@ -5034,7 +5021,10 @@ get_map_elements_fail: case HIPE_MODE_SWITCH_RES_RETURN: ASSERT(is_value(reg[0])); MoveReturn(reg[0], r(0)); - case HIPE_MODE_SWITCH_RES_CALL: + case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: + c_p->i = c_p->hipe.u.callee_exp->addressv[erts_active_code_ix()]; + /*fall through*/ + case HIPE_MODE_SWITCH_RES_CALL_BEAM: SET_I(c_p->i); r(0) = reg[0]; Dispatch(); @@ -5151,22 +5141,16 @@ get_map_elements_fail: #ifndef NO_JUMP_TABLE #ifdef ERTS_OPCODE_COUNTER_SUPPORT - /* Are tables correctly generated by beam_makeops? */ ASSERT(sizeof(counting_opcodes) == sizeof(opcodes)); - - if (count_instructions) { #ifdef DEBUG - counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y); + counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y); #endif - counting_opcodes[op_i_func_info_IaaI] = LabelAddr(lb_i_func_info_IaaI); - beam_ops = counting_opcodes; - } - else -#endif /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */ - { - beam_ops = opcodes; - } + counting_opcodes[op_i_func_info_IaaI] = LabelAddr(lb_i_func_info_IaaI); + beam_ops = counting_opcodes; +#else /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */ + beam_ops = opcodes; +#endif /* ERTS_OPCODE_COUNTER_SUPPORT */ #endif /* NO_JUMP_TABLE */ em_call_error_handler = OpCode(call_error_handler); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index e96177cfd9..07654f6d5c 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -245,7 +245,7 @@ typedef struct { /* * This structure contains all information about the module being loaded. */ - +#define MD5_SIZE 16 typedef struct LoaderState { /* * The current logical file within the binary. @@ -292,7 +292,7 @@ typedef struct LoaderState { StringPatch* string_patches; /* Linked list of position into string table to patch. */ BeamInstr catches; /* Linked list of catch_yf instructions. */ unsigned loaded_size; /* Final size of code when loaded. */ - byte mod_md5[16]; /* MD5 for module code. */ + byte mod_md5[MD5_SIZE]; /* MD5 for module code. */ int may_load_nif; /* true if NIFs may later be loaded for this module */ int on_load; /* Index in the code for the on_load function * (or 0 if there is no on_load function) @@ -528,6 +528,7 @@ static Eterm exported_from_module(Process* p, Eterm mod); static Eterm functions_in_module(Process* p, Eterm mod); static Eterm attributes_for_module(Process* p, Eterm mod); static Eterm compilation_info_for_module(Process* p, Eterm mod); +static Eterm md5_of_module(Process* p, Eterm mod); static Eterm native_addresses(Process* p, Eterm mod); int patch_funentries(Eterm Patchlist); int patch(Eterm Addresses, Uint fe); @@ -648,6 +649,7 @@ erts_prepare_loading(Binary* magic, Process *c_p, Eterm group_leader, stp->code[MI_COMPILE_PTR] = 0; stp->code[MI_COMPILE_SIZE] = 0; stp->code[MI_COMPILE_SIZE_ON_HEAP] = 0; + stp->code[MI_MD5_PTR] = 0; /* * Read the atom table. @@ -2363,7 +2365,11 @@ load_code(LoaderState* stp) if (stp->may_load_nif) { const int finfo_ix = ci - FUNC_INFO_SZ; - enum { MIN_FUNC_SZ = 3 }; +#ifdef ERTS_DIRTY_SCHEDULERS + enum { MIN_FUNC_SZ = 4 }; +#else + enum { MIN_FUNC_SZ = 3 }; +#endif if (finfo_ix - last_func_start < MIN_FUNC_SZ && last_func_start) { /* Must make room for call_nif op */ int pad = MIN_FUNC_SZ - (finfo_ix - last_func_start); @@ -4038,7 +4044,7 @@ freeze_code(LoaderState* stp) } size = (stp->ci * sizeof(BeamInstr)) + (stp->total_literal_size * sizeof(Eterm)) + - strtab_size + attr_size + compile_size + line_size; + strtab_size + attr_size + compile_size + MD5_SIZE + line_size; /* * Move the code to its final location. @@ -4247,11 +4253,20 @@ freeze_code(LoaderState* stp) code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size; } CHKBLK(ERTS_ALC_T_CODE,code); + { + byte* md5_sum = str_table + strtab_size + attr_size + compile_size; + CHKBLK(ERTS_ALC_T_CODE,code); + sys_memcpy(md5_sum, stp->mod_md5, MD5_SIZE); + CHKBLK(ERTS_ALC_T_CODE,code); + code[MI_MD5_PTR] = (BeamInstr) md5_sum; + CHKBLK(ERTS_ALC_T_CODE,code); + } + CHKBLK(ERTS_ALC_T_CODE,code); /* * Make sure that we have not overflowed the allocated code space. */ - ASSERT(str_table + strtab_size + attr_size + compile_size == + ASSERT(str_table + strtab_size + attr_size + compile_size + MD5_SIZE == ((byte *) code) + size); /* @@ -5103,10 +5118,11 @@ erts_module_info_0(Process* p, Eterm module) hp += 3; \ list = CONS(hp, tup, list) + BUILD_INFO(am_md5); BUILD_INFO(am_compile); BUILD_INFO(am_attributes); - BUILD_INFO(am_imports); BUILD_INFO(am_exports); + BUILD_INFO(am_module); #undef BUILD_INFO return list; } @@ -5116,8 +5132,8 @@ erts_module_info_1(Process* p, Eterm module, Eterm what) { if (what == am_module) { return module; - } else if (what == am_imports) { - return NIL; + } else if (what == am_md5) { + return md5_of_module(p, module); } else if (what == am_exports) { return exported_from_module(p, module); } else if (what == am_functions) { @@ -5306,7 +5322,7 @@ attributes_for_module(Process* p, /* Process whose heap to use. */ Eterm result = NIL; Eterm* end; - if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) { + if (is_not_atom(mod)) { return THE_NON_VALUE; } @@ -5345,7 +5361,7 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */ Eterm result = NIL; Eterm* end; - if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) { + if (is_not_atom(mod)) { return THE_NON_VALUE; } @@ -5368,6 +5384,33 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */ } /* + * Returns the MD5 checksum for a module + * + * Returns a tagged term, or 0 on error. + */ + +Eterm +md5_of_module(Process* p, /* Process whose heap to use. */ + Eterm mod) /* Tagged atom for module. */ +{ + Module* modp; + BeamInstr* code; + Eterm res = NIL; + + if (is_not_atom(mod)) { + return THE_NON_VALUE; + } + + modp = erts_get_module(mod, erts_active_code_ix()); + if (modp == NULL) { + return THE_NON_VALUE; + } + code = modp->curr.code; + res = new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE); + return res; +} + +/* * Build a single {M,F,A,Loction} item to be part of * a stack trace. */ @@ -5543,7 +5586,7 @@ code_module_md5_1(BIF_ALIST_1) res = am_undefined; goto done; } - res = new_binary(p, stp->mod_md5, sizeof(stp->mod_md5)); + res = new_binary(p, stp->mod_md5, MD5_SIZE); done: erts_free_aligned_binary_bytes(temp_alloc); @@ -5939,6 +5982,7 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) code[MI_LITERALS_END] = 0; code[MI_LITERALS_OFF_HEAP] = 0; code[MI_ON_LOAD_FUNCTION_PTR] = 0; + code[MI_MD5_PTR] = 0; ci = MI_FUNCTIONS + n + 1; /* diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index bd22b0c4de..0e3ca0bdb0 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -91,7 +91,6 @@ extern Uint erts_total_code_size; #define MI_LITERALS_END 8 #define MI_LITERALS_OFF_HEAP 9 - /* * Pointer to the on_load function (or NULL if none). */ @@ -103,6 +102,11 @@ extern Uint erts_total_code_size; #define MI_LINE_TABLE 11 /* + * Pointer to the module MD5 sum (16 bytes) + */ +#define MI_MD5_PTR 12 + +/* * Start of function pointer table. This table contains pointers to * all functions in the module plus an additional pointer just beyond * the end of the last function. @@ -111,7 +115,7 @@ extern Uint erts_total_code_size; * this table. */ -#define MI_FUNCTIONS 12 +#define MI_FUNCTIONS 13 /* * Layout of the line table. diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index fcbeb6cf5c..12a1ecd50e 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. All Rights Reserved. * * The 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,9 @@ #include "global.h" #include "erl_process.h" #include "error.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "big.h" #include "dist.h" #include "erl_version.h" @@ -1869,6 +1871,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { } else if (is_external_pid(to)) { dep = external_pid_dist_entry(to); if(dep == erts_this_dist_entry) { +#if DEBUG erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "Discarding message %T from %T to %T in an old " @@ -1879,6 +1882,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { external_pid_creation(to), erts_this_node->creation); erts_send_error_to_logger(p->group_leader, dsbufp); +#endif return 0; } return remote_send(p, dep, to, to, msg, suspend); @@ -1912,6 +1916,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { } else if (is_external_port(to) && (external_port_dist_entry(to) == erts_this_dist_entry)) { +#if DEBUG erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "Discarding message %T from %T to %T in an old " @@ -1922,6 +1927,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { external_port_creation(to), erts_this_node->creation); erts_send_error_to_logger(p->group_leader, dsbufp); +#endif return 0; } else if (is_internal_port(to)) { int ret_val; @@ -2887,9 +2893,6 @@ static int do_list_to_integer(Process *p, Eterm orig_list, res = big_plus_small(res, m, hp); } - if (is_big(res)) /* check if small */ - res = big_plus_small(res, 0, hp); /* includes conversion to small */ - if (neg) { if (is_small(res)) res = make_small(-signed_val(res)); @@ -2899,8 +2902,12 @@ static int do_list_to_integer(Process *p, Eterm orig_list, } } - if (is_big(res)) { - hp += (big_arity(res)+1); + if (is_not_small(res)) { + res = big_plus_small(res, 0, hp); /* includes conversion to small */ + + if (is_not_small(res)) { + hp += (big_arity(res)+1); + } } HRelease(p,hp_end,hp); } @@ -3989,16 +3996,19 @@ BIF_RETTYPE halt_2(BIF_ALIST_2) BIF_RETTYPE function_exported_3(BIF_ALIST_3) { + int arity; if (is_not_atom(BIF_ARG_1) || is_not_atom(BIF_ARG_2) || is_not_small(BIF_ARG_3)) { BIF_ERROR(BIF_P, BADARG); } - if (erts_find_function(BIF_ARG_1, BIF_ARG_2, signed_val(BIF_ARG_3), - erts_active_code_ix()) == NULL) { - BIF_RET(am_false); + arity = signed_val(BIF_ARG_3); + if (erts_find_function(BIF_ARG_1, BIF_ARG_2, arity, + erts_active_code_ix()) != NULL || + erts_is_builtin(BIF_ARG_1, BIF_ARG_2, arity)) { + BIF_RET(am_true); } - BIF_RET(am_true); + BIF_RET(am_false); } /**********************************************************************/ diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h index 72c55ccb55..7b69b39511 100644 --- a/erts/emulator/beam/bif.h +++ b/erts/emulator/beam/bif.h @@ -465,6 +465,8 @@ erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, Eterm args[], int nargs); +#ifdef ERL_WANT_HIPE_BIF_WRAPPER__ + #ifndef HIPE #define HIPE_WRAPPER_BIF_DISABLE_GC(BIF_NAME, ARITY) @@ -509,6 +511,7 @@ BIF_RETTYPE hipe_wrapper_ ## BIF_NAME ## _ ## ARITY (Process* c_p, \ #endif +#endif /* ERL_WANT_HIPE_BIF_WRAPPER__ */ #include "erl_bif_table.h" diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 011e49f1fe..55ac778475 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -578,7 +578,7 @@ bif io:printable_range/0 bif os:unsetenv/1 # -# New in R17A +# New in 17.0 # bif re:inspect/2 @@ -601,6 +601,17 @@ bif maps:values/1 bif erts_internal:cmp_term/2 # +# New in 17.1 +# + +bif erlang:fun_info_mfa/1 + +# New in 18.0 +# + +bif erlang:get_keys/0 + +# # Obsolete # diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 41a041eba6..a8710dd910 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -274,6 +274,9 @@ _b = _b << _s; \ _vn1 = _b >> H_EXP; \ _vn0 = _b & LO_MASK; \ + /* Sometimes _s is 0 which triggers undefined behaviour for the \ + (_a0>>(D_EXP-_s)) shift, but this is ok because the \ + & -s will make it all to 0 later anyways. */ \ _un32 = (_a1 << _s) | ((_a0>>(D_EXP-_s)) & (-_s >> (D_EXP-1))); \ _un10 = _a0 << _s; \ _un1 = _un10 >> H_EXP; \ @@ -1506,13 +1509,15 @@ Eterm uword_to_big(UWord x, Eterm *y) */ Eterm small_to_big(Sint x, Eterm *y) { + Uint xu; if (x >= 0) { + xu = x; *y = make_pos_bignum_header(1); } else { - x = -x; + xu = -(Uint)x; *y = make_neg_bignum_header(1); } - BIG_DIGIT(y, 0) = x; + BIG_DIGIT(y, 0) = xu; return make_big(y); } @@ -1540,21 +1545,24 @@ Eterm erts_uint64_to_big(Uint64 x, Eterm **hpp) Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp) { Eterm *hp = *hpp; + Uint64 ux; int neg; - if (x >= 0) + if (x >= 0) { neg = 0; + ux = x; + } else { neg = 1; - x = -x; + ux = -(Uint64)x; } #if defined(ARCH_32) || HALFWORD_HEAP - if (x >= (((Uint64) 1) << 32)) { + if (ux >= (((Uint64) 1) << 32)) { if (neg) *hp = make_neg_bignum_header(2); else *hp = make_pos_bignum_header(2); - BIG_DIGIT(hp, 0) = (Uint) (x & ((Uint) 0xffffffff)); - BIG_DIGIT(hp, 1) = (Uint) ((x >> 32) & ((Uint) 0xffffffff)); + BIG_DIGIT(hp, 0) = (Uint) (ux & ((Uint) 0xffffffff)); + BIG_DIGIT(hp, 1) = (Uint) ((ux >> 32) & ((Uint) 0xffffffff)); *hpp += 3; } else @@ -1564,7 +1572,7 @@ Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp) *hp = make_neg_bignum_header(1); else *hp = make_pos_bignum_header(1); - BIG_DIGIT(hp, 0) = (Uint) x; + BIG_DIGIT(hp, 0) = (Uint) ux; *hpp += 2; } return make_big(hp); @@ -2667,9 +2675,6 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, res = big_plus_small(res, m, hp); } - if (is_big(res)) /* check if small */ - res = big_plus_small(res, 0, hp); /* includes conversion to small */ - if (neg) { if (is_small(res)) res = make_small(-signed_val(res)); @@ -2679,8 +2684,12 @@ Eterm erts_chars_to_integer(Process *BIF_P, char *bytes, } } - if (is_big(res)) { - hp += (big_arity(res) + 1); + if (is_not_small(res)) { + res = big_plus_small(res, 0, hp); /* includes conversion to small */ + + if (is_not_small(res)) { + hp += (big_arity(res) + 1); + } } HRelease(BIF_P, hp_end, hp); goto bytebuf_to_integer_1_done; diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index d80111822e..da31876d75 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -101,7 +101,7 @@ typedef Uint dsize_t; /* Vector size type */ #define ERTS_SINT64_HEAP_SIZE(X) \ (IS_SSMALL((X)) \ ? 0 \ - : ERTS_UINT64_BIG_HEAP_SIZE__((X) >= 0 ? (X) : -(X))) + : ERTS_UINT64_BIG_HEAP_SIZE__((X) >= 0 ? (X) : -(Uint64)(X))) #define ERTS_UINT64_HEAP_SIZE(X) \ (IS_USMALL(0, (X)) ? 0 : ERTS_UINT64_BIG_HEAP_SIZE__((X))) diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c index f50d484576..cc0b3b9b6c 100644 --- a/erts/emulator/beam/binary.c +++ b/erts/emulator/beam/binary.c @@ -26,7 +26,9 @@ #include "global.h" #include "erl_process.h" #include "error.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "big.h" #include "erl_binary.h" #include "erl_bits.h" @@ -83,8 +85,6 @@ new_binary(Process *p, byte *buf, Uint len) * Allocate the binary struct itself. */ bptr = erts_bin_nrml_alloc(len); - bptr->flags = 0; - bptr->orig_size = len; erts_refc_init(&bptr->refc, 1); if (buf != NULL) { sys_memcpy(bptr->orig_bytes, buf, len); @@ -122,8 +122,6 @@ Eterm erts_new_mso_binary(Process *p, byte *buf, int len) * Allocate the binary struct itself. */ bptr = erts_bin_nrml_alloc(len); - bptr->flags = 0; - bptr->orig_size = len; erts_refc_init(&bptr->refc, 1); if (buf != NULL) { sys_memcpy(bptr->orig_bytes, buf, len); @@ -177,7 +175,6 @@ erts_realloc_binary(Eterm bin, size_t size) } else { /* REFC */ ProcBin* pb = (ProcBin *) bval; Binary* newbin = erts_bin_realloc(pb->val, size); - newbin->orig_size = size; pb->val = newbin; pb->size = size; pb->bytes = (byte*) newbin->orig_bytes; diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 7d4f52ee23..08265b590d 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -256,6 +256,7 @@ print_process_info(int to, void *to_arg, Process *p) p->current[1], p->current[2]); } + erts_print(to, to_arg, "Run queue: %d\n", erts_get_runq_proc(p)->ix); erts_print(to, to_arg, "Spawned by: %T\n", p->parent); approx_started = (time_t) p->approx_started; diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 50548850eb..0010f6a440 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -21,6 +21,8 @@ # include "config.h" #endif +#define ERL_WANT_GC_INTERNALS__ + #include "sys.h" #include "erl_vm.h" #include "global.h" diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index ec07ddcd9c..dcbbb857da 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -622,9 +622,7 @@ alloc_dist_obuf(Uint size) ErtsDistOutputBuf *obuf; Uint obuf_size = sizeof(ErtsDistOutputBuf)+sizeof(byte)*(size-1); Binary *bin = erts_bin_drv_alloc(obuf_size); - bin->flags = BIN_FLAG_DRV; erts_refc_init(&bin->refc, 1); - bin->orig_size = (SWord) obuf_size; obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[0]; #ifdef DEBUG obuf->dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN; diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 05ac24e04d..90cd227fae 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1873,8 +1873,8 @@ erts_alc_fatal_error(int error, int func, ErtsAlcType_t n, ...) size = va_arg(argp, Uint); va_end(argp); erl_exit(1, - "%s: Cannot %s %lu bytes of memory (of type \"%s\").\n", - allctr_str, op, size, t_str); + "%s: Cannot %s %lu bytes of memory (of type \"%s\", thread %d).\n", + allctr_str, op, size, t_str, ERTS_ALC_GET_THR_IX()); break; } case ERTS_ALC_E_NOALLCTR: diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 17ac6316b7..61def65235 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -267,7 +267,6 @@ 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 type PROC_SYS_TSK SHORT_LIVED PROCESSES proc_sys_task type PROC_SYS_TSK_QS SHORT_LIVED PROCESSES proc_sys_task_queues @@ -357,12 +356,14 @@ type DB_MS_PSDO_PROC LONG_LIVED_LOW ETS db_match_pseudo_proc type SCHDLR_DATA LONG_LIVED_LOW SYSTEM scheduler_data type LL_TEMP_TERM LONG_LIVED_LOW SYSTEM ll_temp_term +type NIF_TRAP_EXPORT STANDARD_LOW CODE nif_trap_export_entry type EXPORT LONG_LIVED_LOW CODE export_entry 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 +type PORT_DATA_HEAP STANDARD_LOW SYSTEM port_data_heap +else # "fullword" @@ -375,12 +376,14 @@ type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc type SCHDLR_DATA LONG_LIVED SYSTEM scheduler_data type LL_TEMP_TERM LONG_LIVED SYSTEM ll_temp_term +type NIF_TRAP_EXPORT STANDARD CODE nif_trap_export_entry type EXPORT LONG_LIVED CODE export_entry 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 +type PORT_DATA_HEAP STANDARD SYSTEM port_data_heap +endif @@ -395,6 +398,7 @@ type DRV_EV_STATE LONG_LIVED SYSTEM driver_event_state type DRV_EV_D_STATE FIXED_SIZE SYSTEM driver_event_data_state type DRV_SEL_D_STATE FIXED_SIZE SYSTEM driver_select_data_state type FD_LIST SHORT_LIVED SYSTEM fd_list +type ACTIVE_FD_ARR SHORT_LIVED SYSTEM active_fd_array type POLLSET LONG_LIVED SYSTEM pollset type POLLSET_UPDREQ SHORT_LIVED SYSTEM pollset_update_req type POLL_FDS LONG_LIVED SYSTEM poll_fds @@ -411,6 +415,8 @@ type CS_PROG_PATH LONG_LIVED SYSTEM cs_prog_path type ENVIRONMENT TEMPORARY SYSTEM environment type PUTENV_STR SYSTEM SYSTEM putenv_string type PRT_REP_EXIT STANDARD SYSTEM port_report_exit +type SYS_BLOCKING STANDARD SYSTEM sys_blocking +type SYS_WRITE_BUF TEMPORARY SYSTEM sys_write_buf +endif diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 7e0e825a0d..bd0d7c71cc 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -32,7 +32,9 @@ #include "global.h" #include "erl_process.h" #include "error.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "big.h" #include "erl_binary.h" #include "erl_bits.h" @@ -1324,9 +1326,9 @@ static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp) goto badarg; } if (len < 0) { - Sint lentmp = -len; + Uint lentmp = -(Uint)len; /* overflow */ - if (lentmp == len || lentmp < 0 || -lentmp != len) { + if ((Sint)lentmp < 0) { goto badarg; } len = lentmp; @@ -1555,9 +1557,9 @@ BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen) goto badarg; } if (len < 0) { - Sint lentmp = -len; + Uint lentmp = -(Uint)len; /* overflow */ - if (lentmp == len || lentmp < 0 || -lentmp != len) { + if ((Sint)lentmp < 0) { goto badarg; } len = lentmp; @@ -1644,9 +1646,9 @@ BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is goto badarg; } if (len < 0) { - Sint lentmp = -len; + Uint lentmp = -(Uint)len; /* overflow */ - if (lentmp == len || lentmp < 0 || -lentmp != len) { + if ((Sint)lentmp < 0) { goto badarg; } len = lentmp; @@ -2213,9 +2215,9 @@ static BIF_RETTYPE binary_bin_to_list_common(Process *p, goto badarg; } if (len < 0) { - Sint lentmp = -len; + Uint lentmp = -(Uint)len; /* overflow */ - if (lentmp == len || lentmp < 0 || -lentmp != len) { + if ((Sint)lentmp < 0) { goto badarg; } len = lentmp; @@ -2424,8 +2426,6 @@ static BIF_RETTYPE do_binary_copy(Process *p, Eterm bin, Eterm en) } cbs->result = erts_bin_nrml_alloc(target_size); /* Always offheap if trapping */ - cbs->result->flags = 0; - cbs->result->orig_size = target_size; erts_refc_init(&(cbs->result->refc), 1); t = (byte *) cbs->result->orig_bytes; /* No offset or anything */ pos = 0; diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 6915765dab..e92842c7d1 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -115,6 +115,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #ifdef ERTS_ENABLE_LOCK_COUNT " [lock-counting]" #endif +#ifdef ERTS_OPCODE_COUNTER_SUPPORT + " [instruction-counting]" +#endif #ifdef PURIFY " [purify-compiled]" #endif @@ -2300,7 +2303,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) for (i = num_instructions-1; i >= 0; i--) { res = erts_bld_cons(hpp, hszp, erts_bld_tuple(hpp, hszp, 2, - erts_atom_put(opc[i].name, + erts_atom_put((byte *)opc[i].name, strlen(opc[i].name), ERTS_ATOM_ENC_LATIN1, 1), @@ -2696,6 +2699,9 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) ? am_disabled : am_enabled); } + else if (ERTS_IS_ATOM_STR("eager_check_io",BIF_ARG_1)) { + BIF_RET(erts_eager_check_io ? am_true : am_false); + } BIF_ERROR(BIF_P, BADARG); } @@ -3055,6 +3061,25 @@ fun_info_2(BIF_ALIST_2) return TUPLE2(hp, what, val); } +BIF_RETTYPE +fun_info_mfa_1(BIF_ALIST_1) +{ + Process* p = BIF_P; + Eterm fun = BIF_ARG_1; + Eterm* hp; + + if (is_fun(fun)) { + ErlFunThing* funp = (ErlFunThing *) fun_val(fun); + hp = HAlloc(p, 4); + BIF_RET(TUPLE3(hp,funp->fe->module,funp->fe->address[-2],make_small(funp->arity))); + } else if (is_export(fun)) { + Export* exp = (Export *) ((UWord) (export_val(fun))[1]); + hp = HAlloc(p, 4); + BIF_RET(TUPLE3(hp,exp->code[0],exp->code[1],make_small(exp->code[2]))); + } + BIF_ERROR(p, BADARG); +} + BIF_RETTYPE is_process_alive_1(BIF_ALIST_1) { if(is_internal_pid(BIF_ARG_1)) { @@ -3285,17 +3310,38 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) BIF_RET(make_small((Uint) words)); } else if (ERTS_IS_ATOM_STR("check_io_debug", BIF_ARG_1)) { - /* Used by (emulator) */ - int res; + /* Used by driver_SUITE (emulator) */ + Uint sz, *szp; + Eterm res, *hp, **hpp; + int no_errors; + ErtsCheckIoDebugInfo ciodi = {0}; #ifdef HAVE_ERTS_CHECK_IO_DEBUG erts_smp_proc_unlock(BIF_P,ERTS_PROC_LOCK_MAIN); - res = erts_check_io_debug(); + no_errors = erts_check_io_debug(&ciodi); erts_smp_proc_lock(BIF_P,ERTS_PROC_LOCK_MAIN); #else - res = 0; + no_errors = 0; #endif - ASSERT(res >= 0); - BIF_RET(erts_make_integer((Uint) res, BIF_P)); + sz = 0; + szp = &sz; + hpp = NULL; + while (1) { + res = erts_bld_tuple(hpp, szp, 4, + erts_bld_uint(hpp, szp, + (Uint) no_errors), + erts_bld_uint(hpp, szp, + (Uint) ciodi.no_used_fds), + erts_bld_uint(hpp, szp, + (Uint) ciodi.no_driver_select_structs), + erts_bld_uint(hpp, szp, + (Uint) ciodi.no_driver_event_structs)); + if (hpp) + break; + hp = HAlloc(BIF_P, sz); + szp = NULL; + hpp = &hp; + } + BIF_RET(res); } else if (ERTS_IS_ATOM_STR("process_info_args", BIF_ARG_1)) { /* Used by process_SUITE (emulator) */ diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c index afb33c1cdb..64bd598ba6 100644 --- a/erts/emulator/beam/erl_bif_port.c +++ b/erts/emulator/beam/erl_bif_port.c @@ -493,8 +493,8 @@ 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); + cleanup_old_port_data(erts_smp_atomic_xchg_nob(&prt->data, + (erts_aint_t) NULL)); } Uint @@ -554,6 +554,7 @@ BIF_RETTYPE port_set_data_2(BIF_ALIST_2) hp = &pdhp->heap[0]; pdhp->off_heap.first = NULL; pdhp->off_heap.overhead = 0; + pdhp->hsize = hsize; pdhp->data = copy_struct(BIF_ARG_2, hsize, &hp, &pdhp->off_heap); data = (erts_aint_t) pdhp; ASSERT((data & 0x3) == 0); @@ -561,8 +562,14 @@ BIF_RETTYPE port_set_data_2(BIF_ALIST_2) data = erts_smp_atomic_xchg_wb(&prt->data, data); + if (data == (erts_aint_t)NULL) { + /* Port terminated by racing thread */ + data = erts_smp_atomic_xchg_wb(&prt->data, data); + ASSERT(data != (erts_aint_t)NULL); + cleanup_old_port_data(data); + BIF_ERROR(BIF_P, BADARG); + } cleanup_old_port_data(data); - BIF_RET(am_true); } @@ -581,6 +588,8 @@ BIF_RETTYPE port_get_data_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); data = erts_smp_atomic_read_ddrb(&prt->data); + if (data == (erts_aint_t)NULL) + BIF_ERROR(BIF_P, BADARG); /* Port terminated by racing thread */ if ((data & 0x3) != 0) { res = (Eterm) (UWord) data; diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index 06dfeb1260..8d264d166e 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -231,41 +231,58 @@ erts_free_aligned_binary_bytes(byte* buf) # define CHICKEN_PAD (sizeof(void*) - 1) #endif +/* Caller must initialize 'refc' +*/ ERTS_GLB_INLINE Binary * erts_bin_drv_alloc_fnf(Uint size) { Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; - void *res; + Binary *res; + if (bsize < size) /* overflow */ return NULL; res = erts_alloc_fnf(ERTS_ALC_T_DRV_BINARY, bsize); ERTS_CHK_BIN_ALIGNMENT(res); - return (Binary *) res; + if (res) { + res->orig_size = size; + res->flags = BIN_FLAG_DRV; + } + return res; } +/* Caller must initialize 'refc' +*/ ERTS_GLB_INLINE Binary * erts_bin_drv_alloc(Uint size) { Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; - void *res; + Binary *res; + if (bsize < size) /* overflow */ erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, size); res = erts_alloc(ERTS_ALC_T_DRV_BINARY, bsize); ERTS_CHK_BIN_ALIGNMENT(res); - return (Binary *) res; + res->orig_size = size; + res->flags = BIN_FLAG_DRV; + return res; } +/* Caller must initialize 'refc' +*/ ERTS_GLB_INLINE Binary * erts_bin_nrml_alloc(Uint size) { Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; - void *res; + Binary *res; + if (bsize < size) /* overflow */ erts_alloc_enomem(ERTS_ALC_T_BINARY, size); res = erts_alloc(ERTS_ALC_T_BINARY, bsize); ERTS_CHK_BIN_ALIGNMENT(res); - return (Binary *) res; + res->orig_size = size; + res->flags = 0; + return res; } ERTS_GLB_INLINE Binary * @@ -280,6 +297,8 @@ erts_bin_realloc_fnf(Binary *bp, Uint size) return NULL; nbp = erts_realloc_fnf(type, (void *) bp, bsize); ERTS_CHK_BIN_ALIGNMENT(nbp); + if (nbp) + nbp->orig_size = size; return nbp; } @@ -297,6 +316,7 @@ erts_bin_realloc(Binary *bp, Uint size) if (!nbp) erts_realloc_enomem(type, bp, bsize); ERTS_CHK_BIN_ALIGNMENT(nbp); + nbp->orig_size = size; return nbp; } @@ -329,4 +349,4 @@ erts_create_magic_binary(Uint size, void (*destructor)(Binary *)) #endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ -#endif +#endif /* !__ERL_BINARY_H */ diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 73765772c8..71d31c01aa 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -1299,7 +1299,6 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term, if (binp->orig_size < pb->size) { Uint new_size = 2*pb->size; binp = erts_bin_realloc(binp, new_size); - binp->orig_size = new_size; pb->val = binp; pb->bytes = (byte *) binp->orig_bytes; } @@ -1371,8 +1370,6 @@ erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term, * Allocate the binary data struct itself. */ bptr = erts_bin_nrml_alloc(bin_size); - bptr->flags = 0; - bptr->orig_size = bin_size; erts_refc_init(&bptr->refc, 1); erts_current_bin = (byte *) bptr->orig_bytes; @@ -1475,7 +1472,6 @@ erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit) * is safe to reallocate it. */ binp = erts_bin_realloc(binp, new_size); - binp->orig_size = new_size; pb->val = binp; pb->bytes = (byte *) binp->orig_bytes; } else { @@ -1488,8 +1484,6 @@ erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit) * binary and copy the contents of the old binary into it. */ Binary* bptr = erts_bin_nrml_alloc(new_size); - bptr->flags = 0; - bptr->orig_size = new_size; erts_refc_init(&bptr->refc, 1); sys_memcpy(bptr->orig_bytes, binp->orig_bytes, binp->orig_size); pb->flags |= PB_IS_WRITABLE | PB_ACTIVE_WRITER; @@ -1537,8 +1531,6 @@ erts_bs_init_writable(Process* p, Eterm sz) * Allocate the binary data struct itself. */ bptr = erts_bin_nrml_alloc(bin_size); - bptr->flags = 0; - bptr->orig_size = bin_size; erts_refc_init(&bptr->refc, 1); /* @@ -1585,9 +1577,7 @@ erts_emasculate_writable_binary(ProcBin* pb) /* Our allocators are 8 byte aligned, i.e., shrinking with less than 8 bytes will have no real effect */ if (unused >= 8) { - Uint new_size = pb->size; binp = erts_bin_realloc(binp, pb->size); - binp->orig_size = new_size; pb->val = binp; pb->bytes = (byte *) binp->orig_bytes; } diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h index 908cec11d4..e68081a5b1 100644 --- a/erts/emulator/beam/erl_db_hash.h +++ b/erts/emulator/beam/erl_db_hash.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1998-2013. All Rights Reserved. + * Copyright Ericsson AB 1998-2014. All Rights Reserved. * * The 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,7 +42,7 @@ typedef struct hash_db_term { typedef struct db_table_hash_fine_locks { union { erts_smp_rwmtx_t lck; - byte _cache_line_alignment[64]; + byte _cache_line_alignment[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(erts_smp_rwmtx_t))]; }lck_vec[DB_HASH_LOCK_CNT]; } DbTableHashFineLocks; diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 5ced8c5ca0..f9938fc66c 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -133,7 +133,7 @@ typedef struct { #define ERL_DRV_EXTENDED_MARKER (0xfeeeeeed) #define ERL_DRV_EXTENDED_MAJOR_VERSION 3 -#define ERL_DRV_EXTENDED_MINOR_VERSION 0 +#define ERL_DRV_EXTENDED_MINOR_VERSION 1 /* * The emulator will refuse to load a driver with a major version diff --git a/erts/emulator/beam/erl_drv_nif.h b/erts/emulator/beam/erl_drv_nif.h index 3f829ea7ea..4e8c6dc68b 100644 --- a/erts/emulator/beam/erl_drv_nif.h +++ b/erts/emulator/beam/erl_drv_nif.h @@ -35,6 +35,7 @@ typedef struct { int scheduler_threads; int nif_major_version; int nif_minor_version; + int dirty_scheduler_support; } ErlDrvSysInfo; typedef struct { diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index aa15d2cc57..5f78a7b532 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -20,6 +20,8 @@ # include "config.h" #endif +#define ERL_WANT_GC_INTERNALS__ + #include "sys.h" #include "erl_vm.h" #include "global.h" @@ -2018,6 +2020,20 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) roots[n].sz = 1; n++; } + + /* + * If a NIF has saved arguments, they need to be added + */ + if (ERTS_PROC_GET_NIF_TRAP_EXPORT(p)) { + Eterm* argv; + int argc; + if (erts_setup_nif_gc(p, &argv, &argc)) { + roots[n].v = argv; + roots[n].sz = argc; + n++; + } + } + ASSERT(n <= rootset->size); mp = p->msg.first; @@ -2386,7 +2402,6 @@ sweep_off_heap(Process *p, int fullsweep) } pb->val = erts_bin_realloc(pb->val, new_size); - pb->val->orig_size = new_size; pb->bytes = (byte *) pb->val->orig_bytes; } } diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h index 5203dda263..bf0496c112 100644 --- a/erts/emulator/beam/erl_gc.h +++ b/erts/emulator/beam/erl_gc.h @@ -20,10 +20,12 @@ #ifndef __ERL_GC_H__ #define __ERL_GC_H__ -#include "erl_map.h" +#if defined(ERL_WANT_GC_INTERNALS__) || defined(ERTS_DO_INCL_GLB_INLINE_FUNC_DEF) /* GC declarations shared by beam/erl_gc.c and hipe/hipe_gc.c */ +#include "erl_map.h" + #if defined(DEBUG) && !ERTS_GLB_INLINE_INCL_FUNC_DEF # define HARDDEBUG 1 #endif @@ -67,8 +69,6 @@ do { \ #define in_area(ptr,start,nbytes) \ ((UWord)((char*)(ptr) - (char*)(start)) < (nbytes)) -extern Uint erts_test_long_gc_sleep; - #if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) int within(Eterm *ptr, Process *p); #endif @@ -97,4 +97,33 @@ ERTS_GLB_INLINE Eterm follow_moved(Eterm term) } #endif +#endif /* ERL_GC_C__ || HIPE_GC_C__ */ + +/* + * Global exported + */ + +extern Uint erts_test_long_gc_sleep; + +typedef struct { + Uint64 reclaimed; + Uint64 garbage_cols; +} ErtsGCInfo; + +void erts_gc_info(ErtsGCInfo *gcip); +void erts_init_gc(void); +int erts_garbage_collect(struct process*, int, Eterm*, int); +void erts_garbage_collect_hibernate(struct process* p); +Eterm erts_gc_after_bif_call(struct process* p, Eterm result, Eterm* regs, Uint arity); +void erts_garbage_collect_literals(struct process* p, Eterm* literals, + Uint lit_size, + struct erl_off_heap_header* oh); +Uint erts_next_heap_size(Uint, Uint); +Eterm erts_heap_sizes(struct process* p); + +void erts_offset_off_heap(struct erl_off_heap*, Sint, Eterm*, Eterm*); +void erts_offset_heap_ptr(Eterm*, Uint, Sint, Eterm*, Eterm*); +void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*); +void erts_free_heap_frags(struct process* p); + #endif /* __ERL_GC_H__ */ diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 5e6d812242..77445ef1ff 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -161,9 +161,6 @@ int H_MIN_SIZE; /* The minimum heap grain */ int BIN_VH_MIN_SIZE; /* The minimum binary virtual*/ Uint32 erts_debug_flags; /* Debug flags. */ -#ifdef ERTS_OPCODE_COUNTER_SUPPORT -int count_instructions; -#endif int erts_backtrace_depth; /* How many functions to show in a backtrace * in error codes. */ @@ -548,6 +545,8 @@ void erts_usage(void) erts_fprintf(stderr, " see the erl(1) documentation for more info.\n"); erts_fprintf(stderr, "-sct cput set cpu topology,\n"); erts_fprintf(stderr, " see the erl(1) documentation for more info.\n"); + erts_fprintf(stderr, "-secio bool enable/disable eager check I/O scheduling,\n"); + erts_fprintf(stderr, " see the erl(1) documentation for more info.\n"); #if ERTS_HAVE_SCHED_UTIL_BALANCING_SUPPORT_OPT erts_fprintf(stderr, "-sub bool enable/disable scheduler utilization balancing,\n"); #else @@ -1674,6 +1673,22 @@ erl_start(int argc, char **argv) erts_usage(); } } + else if (has_prefix("ecio", sub_param)) { + arg = get_arg(sub_param+4, argv[i+1], &i); +#ifndef __OSE__ + if (sys_strcmp("true", arg) == 0) + erts_eager_check_io = 1; + else +#endif + if (sys_strcmp("false", arg) == 0) + erts_eager_check_io = 0; + else { + erts_fprintf(stderr, + "bad schedule eager check I/O value '%s'\n", + arg); + erts_usage(); + } + } else if (has_prefix("pp", sub_param)) { arg = get_arg(sub_param+2, argv[i+1], &i); if (sys_strcmp(arg, "true") == 0) @@ -1882,11 +1897,6 @@ erl_start(int argc, char **argv) if (argv[i][2] == 0) { /* -c: documented option */ erts_disable_tolerant_timeofday = 1; } -#ifdef ERTS_OPCODE_COUNTER_SUPPORT - else if (argv[i][2] == 'i') { /* -ci: undcoumented option*/ - count_instructions = 1; - } -#endif break; case 'W': arg = get_arg(argv[i]+2, argv[i+1], &i); @@ -2066,8 +2076,10 @@ erl_exit_vv(int n, int flush_async, char *fmt, va_list args1, va_list args2) system_cleanup(flush_async); save_statistics(); - - an = abs(n); + if (n < 0) + an = -(unsigned int)n; + else + an = n; if (erts_mtrace_enabled) erts_mtrace_exit((Uint32) an); diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index c13eb87012..b105ece6f1 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -139,7 +139,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "drv_tsd", NULL }, { "async_enq_mtx", NULL }, #ifdef ERTS_SMP - { "sys_msg_q", NULL }, { "atom_tab", NULL }, { "make_ref", NULL }, { "misc_op_list_pre_alloc_lock", "address" }, @@ -148,6 +147,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "btm_pre_alloc_lock", NULL, }, { "dist_entry_out_queue", "address" }, { "port_sched_lock", "port_id" }, + { "sys_msg_q", NULL }, { "port_table", NULL }, #endif { "mtrace_op", NULL }, @@ -227,8 +227,7 @@ rw_op_str(Uint16 flags) case ERTS_LC_FLG_LO_READ: return " (r)"; case ERTS_LC_FLG_LO_WRITE: - erts_fprintf(stderr, "\nInternal error\n"); - lc_abort(); + ERTS_INTERNAL_ERROR("Only write flag present"); default: break; } @@ -311,8 +310,7 @@ static ERTS_INLINE void lc_free(void *p) static void *lc_core_alloc(void) { lc_unlock(); - erts_fprintf(stderr, "Lock checker out of memory!\n"); - lc_abort(); + ERTS_INTERNAL_ERROR("Lock checker out of memory!\n"); } #else @@ -325,8 +323,7 @@ static void *lc_core_alloc(void) fbs = (erts_lc_free_block_t *) malloc(sizeof(erts_lc_free_block_t) * ERTS_LC_FB_CHUNK_SIZE); if (!fbs) { - erts_fprintf(stderr, "Lock checker failed to allocate memory!\n"); - lc_abort(); + ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!"); } for (i = 1; i < ERTS_LC_FB_CHUNK_SIZE - 1; i++) { #ifdef DEBUG @@ -366,11 +363,11 @@ create_locked_locks(char *thread_name) { erts_lc_locked_locks_t *l_lcks = malloc(sizeof(erts_lc_locked_locks_t)); if (!l_lcks) - lc_abort(); + ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!"); l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown"); if (!l_lcks->thread_name) - lc_abort(); + ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!"); l_lcks->emu_thread = 0; l_lcks->tid = erts_thr_self(); @@ -691,7 +688,7 @@ erts_lc_set_thread_name(char *thread_name) free((void *) l_lcks->thread_name); l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown"); if (!l_lcks->thread_name) - lc_abort(); + ERTS_INTERNAL_ERROR("strdup failed"); } l_lcks->emu_thread = 1; } @@ -1330,7 +1327,7 @@ erts_lc_init(void) #endif /* #ifdef ERTS_LC_STATIC_ALLOC */ if (ethr_spinlock_init(&free_blocks_lock) != 0) - lc_abort(); + ERTS_INTERNAL_ERROR("spinlock_init failed"); erts_tsd_key_create(&locks_key,"erts_lock_check_key"); } diff --git a/erts/emulator/beam/erl_lock_count.c b/erts/emulator/beam/erl_lock_count.c index 17ddfdc8ae..cf6996ea06 100644 --- a/erts/emulator/beam/erl_lock_count.c +++ b/erts/emulator/beam/erl_lock_count.c @@ -151,6 +151,9 @@ static erts_lcnt_thread_data_t *lcnt_thread_data_alloc(void) { erts_lcnt_thread_data_t *eltd; eltd = (erts_lcnt_thread_data_t*)malloc(sizeof(erts_lcnt_thread_data_t)); + if (!eltd) { + ERTS_INTERNAL_ERROR("Lock counter failed to allocate memory!"); + } eltd->timer_set = 0; eltd->lock_in_conflict = 0; @@ -272,6 +275,9 @@ void erts_lcnt_init() { /* init lcnt structure */ erts_lcnt_data = (erts_lcnt_data_t*)malloc(sizeof(erts_lcnt_data_t)); + if (!erts_lcnt_data) { + ERTS_INTERNAL_ERROR("Lock counter failed to allocate memory!"); + } erts_lcnt_data->current_locks = erts_lcnt_list_init(); erts_lcnt_data->deleted_locks = erts_lcnt_list_init(); @@ -293,6 +299,9 @@ erts_lcnt_lock_list_t *erts_lcnt_list_init(void) { erts_lcnt_lock_list_t *list; list = (erts_lcnt_lock_list_t*)malloc(sizeof(erts_lcnt_lock_list_t)); + if (!list) { + ERTS_INTERNAL_ERROR("Lock counter failed to allocate memory!"); + } list->head = NULL; list->tail = NULL; list->n = 0; @@ -399,6 +408,9 @@ void erts_lcnt_destroy_lock(erts_lcnt_lock_t *lock) { /* copy structure and insert the copy */ deleted_lock = (erts_lcnt_lock_t*)malloc(sizeof(erts_lcnt_lock_t)); + if (!deleted_lock) { + ERTS_INTERNAL_ERROR("Lock counter failed to allocate memory!"); + } memcpy(deleted_lock, lock, sizeof(erts_lcnt_lock_t)); deleted_lock->next = NULL; diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 59a677a12c..8870fac7d9 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -415,7 +415,13 @@ erts_queue_dist_message(Process *rcvr, if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ); - erts_proc_notify_new_message(rcvr); + erts_proc_notify_new_message(rcvr, +#ifdef ERTS_SMP + *rcvr_locks +#else + 0 +#endif + ); } } @@ -542,7 +548,13 @@ queue_message(Process *c_p, if (locked_msgq) erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ); - erts_proc_notify_new_message(receiver); + erts_proc_notify_new_message(receiver, +#ifdef ERTS_SMP + *receiver_locks +#else + 0 +#endif + ); #ifndef ERTS_SMP ERTS_HOLE_CHECK(receiver); diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 10c7af5a9d..caa9eba8a7 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -472,6 +472,18 @@ int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin) struct enif_tmp_obj_t* tmp; byte* raw_ptr; }u; + + if (is_boxed(bin_term) && *binary_val(bin_term) == HEADER_SUB_BIN) { + ErlSubBin* sb = (ErlSubBin*) binary_val(bin_term); + if (sb->is_writable) { + ProcBin* pb = (ProcBin*) binary_val(sb->orig); + ASSERT(pb->thing_word == HEADER_PROC_BIN); + if (pb->flags) { + erts_emasculate_writable_binary(pb); + sb->is_writable = 0; + } + } + } u.tmp = NULL; bin->data = erts_get_aligned_binary_bytes_extra(bin_term, &u.raw_ptr, allocator, sizeof(struct enif_tmp_obj_t)); @@ -539,9 +551,7 @@ int enif_alloc_binary(size_t size, ErlNifBinary* bin) if (refbin == NULL) { return 0; /* The NIF must take action */ } - refbin->flags = BIN_FLAG_DRV; /* BUGBUG: Flag? */ erts_refc_init(&refbin->refc, 1); - refbin->orig_size = (SWord) size; bin->size = size; bin->data = (unsigned char*) refbin->orig_bytes; @@ -561,7 +571,6 @@ int enif_realloc_binary(ErlNifBinary* bin, size_t size) if (!newbin) { return 0; } - newbin->orig_size = size; bin->ref_bin = newbin; bin->data = (unsigned char*) newbin->orig_bytes; bin->size = size; @@ -1513,72 +1522,263 @@ int enif_consume_timeslice(ErlNifEnv* env, int percent) return ERTS_BIF_REDS_LEFT(env->proc) == 0; } -#ifdef ERTS_DIRTY_SCHEDULERS - -/* NIFs exports need one more item than the Export struct provides, the - * erl_module_nif*, so the DirtyNifExport below adds that. The Export - * member must be first in the struct. +/* + * NIF exports need a few more items than the Export struct provides, + * including the erl_module_nif* and a NIF function pointer, so the + * NifExport below adds those. The Export member must be first in the + * struct. The saved_mfa, saved_argc, nif_level, alloced_argv_sz and argv + * members are used to track the MFA and arguments of the top NIF in case a + * chain of one or more enif_schedule_nif() calls results in an exception, + * since in that case the original MFA and registers have to be restored + * before returning to Erlang to ensure stacktrace information associated + * with the exception is correct. */ +typedef ERL_NIF_TERM (*NativeFunPtr)(ErlNifEnv*, int, const ERL_NIF_TERM[]); + typedef struct { Export exp; struct erl_module_nif* m; -} DirtyNifExport; + NativeFunPtr fp; + Eterm saved_mfa[3]; + int saved_argc; + int alloced_argv_sz; + Eterm argv[1]; +} NifExport; -static void -alloc_proc_psd(Process* proc, DirtyNifExport **ep) +/* + * If a process has saved arguments, they need to be part of the GC + * rootset. The function below is called from setup_rootset() in + * erl_gc.c. This function is declared in erl_process.h. + */ +int +erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj) { + NifExport* ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + int gc = (ep && ep->saved_argc > 0); + + if (gc) { + *objv = ep->argv; + *nobj = ep->saved_argc; + } + return gc; +} + +/* + * Allocate a NifExport and set it in proc specific data + */ +static NifExport* +allocate_nif_sched_data(Process* proc, int argc) +{ + NifExport* ep; + size_t argv_extra, total; int i; - if (!*ep) { - *ep = erts_alloc(ERTS_ALC_T_PSD, sizeof(DirtyNifExport)); - sys_memset((void*) *ep, 0, sizeof(DirtyNifExport)); - for (i=0; i<ERTS_NUM_CODE_IX; i++) { - (*ep)->exp.addressv[i] = &(*ep)->exp.code[3]; - } - (*ep)->exp.code[3] = (BeamInstr) em_call_nif; + + argv_extra = argc > 1 ? sizeof(Eterm)*(argc-1) : 0; + total = sizeof(NifExport) + argv_extra; + ep = erts_alloc(ERTS_ALC_T_NIF_TRAP_EXPORT, total); + sys_memset((void*) ep, 0, total); + ep->alloced_argv_sz = argc; + for (i=0; i<ERTS_NUM_CODE_IX; i++) { + ep->exp.addressv[i] = &ep->exp.code[3]; } - (void) ERTS_PROC_SET_DIRTY_SCHED_TRAP_EXPORT(proc, ERTS_PROC_LOCK_MAIN, &(*ep)->exp); + ep->exp.code[3] = (BeamInstr) em_call_nif; + (void) ERTS_PROC_SET_NIF_TRAP_EXPORT(proc, ERTS_PROC_LOCK_MAIN, ep); + return ep; +} + +static ERTS_INLINE void +destroy_nif_export(NifExport *nif_export) +{ + erts_free(ERTS_ALC_T_NIF_TRAP_EXPORT, (void *) nif_export); } +void +erts_destroy_nif_export(void *nif_export) +{ + destroy_nif_export((NifExport *) nif_export); +} + +/* + * Initialize a NifExport struct. Create it if needed and store it in the + * proc. The direct_fp function is what will be invoked by op_call_nif, and + * the indirect_fp function, if not NULL, is what the direct_fp function + * will call. If the allocated NifExport isn't enough to hold all of argv, + * allocate a larger one. Save MFA and registers only if the need_save + * parameter is true. + */ static ERL_NIF_TERM -execute_dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +init_nif_sched_data(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirect_fp, + int need_save, int argc, const ERL_NIF_TERM argv[]) { - Eterm* reg = ERTS_PROC_GET_SCHDATA(env->proc)->x_reg_array; - ERL_NIF_TERM result, dirty_result = (ERL_NIF_TERM) reg[0]; - typedef ERL_NIF_TERM (*FinalizerFP)(ErlNifEnv*, ERL_NIF_TERM); - FinalizerFP fp; -#if HAVE_INT64 && SIZEOF_LONG != 8 - ASSERT(sizeof(fp) <= sizeof(ErlNifUInt64)); - enif_get_uint64(env, reg[1], (ErlNifUInt64 *) &fp); -#else - ASSERT(sizeof(fp) <= sizeof(unsigned long)); - enif_get_ulong(env, reg[1], (unsigned long *) &fp); -#endif - result = (*fp)(env, dirty_result); - if (erts_refc_dectest(&env->mod_nif->rt_dtor_cnt, 0) == 0 - && env->mod_nif->mod == NULL) - close_lib(env->mod_nif); - return result; + Process* proc = env->proc; + Eterm* reg = ERTS_PROC_GET_SCHDATA(proc)->x_reg_array; + NifExport* ep; + int i; + + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + if (!ep) + ep = allocate_nif_sched_data(proc, argc); + else if (need_save && ep->alloced_argv_sz < argc) { + NifExport* new_ep = allocate_nif_sched_data(proc, argc); + destroy_nif_export(ep); + ep = new_ep; + } + ERTS_VBUMP_ALL_REDS(proc); + for (i = 0; i < argc; i++) { + if (need_save) + ep->argv[i] = reg[i]; + reg[i] = (Eterm) argv[i]; + } + if (need_save) { + ep->saved_mfa[0] = proc->current[0]; + ep->saved_mfa[1] = proc->current[1]; + ep->saved_mfa[2] = proc->current[2]; + ep->saved_argc = argc; + } + proc->i = (BeamInstr*) ep->exp.addressv[0]; + ep->exp.code[0] = (BeamInstr) proc->current[0]; + ep->exp.code[1] = (BeamInstr) proc->current[1]; + ep->exp.code[2] = argc; + ep->exp.code[4] = (BeamInstr) direct_fp; + ep->m = env->mod_nif; + ep->fp = indirect_fp; + proc->freason = TRAP; + return THE_NON_VALUE; } -#endif /* ERTS_DIRTY_SCHEDULERS */ +/* + * Restore saved MFA and registers. Registers are restored only when the + * exception flag is true. + */ +static void +restore_nif_mfa(Process* proc, NifExport* ep, int exception) +{ + int i; + Eterm* reg = ERTS_PROC_GET_SCHDATA(proc)->x_reg_array; -#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT + proc->current[0] = ep->saved_mfa[0]; + proc->current[1] = ep->saved_mfa[1]; + proc->current[2] = ep->saved_mfa[2]; + if (exception) + for (i = 0; i < ep->saved_argc; i++) + reg[i] = ep->argv[i]; + ep->saved_argc = 0; + ep->saved_mfa[0] = THE_NON_VALUE; +} -ERL_NIF_TERM -enif_schedule_dirty_nif(ErlNifEnv* env, int flags, - ERL_NIF_TERM (*fp)(ErlNifEnv*, int, const ERL_NIF_TERM[]), - int argc, const ERL_NIF_TERM argv[]) +#ifdef ERTS_DIRTY_SCHEDULERS + +/* + * Finalize a dirty NIF call. This function is scheduled to cause the VM to + * switch the process off a dirty scheduler thread and back onto a regular + * scheduler thread, and then return the result from the dirty NIF. It also + * restores the original NIF MFA when necessary based on the value of + * ep->fp set by execute_dirty_nif via init_nif_sched_data -- non-NULL + * means restore, NULL means do not restore. + */ +static ERL_NIF_TERM +dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + Process* proc = env->proc; + NifExport* ep; + + ASSERT(argc == 1); + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(env->proc->scheduler_data)); + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + if (ep->fp) + restore_nif_mfa(proc, ep, 0); + return argv[0]; +} + +/* Finalize a dirty NIF call that raised an exception. Otherwise same as + * the dirty_nif_finalizer() function. + */ +static ERL_NIF_TERM +dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + Process* proc = env->proc; + NifExport* ep; + + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(env->proc->scheduler_data)); + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + if (ep->fp) + restore_nif_mfa(proc, ep, 1); + return enif_make_badarg(env); +} + +/* + * Dirty NIF execution wrapper function. Invoke an application's dirty NIF, + * then check the result and schedule the appropriate finalizer function + * where needed. Also restore the original NIF MFA when appropriate. + */ +static ERL_NIF_TERM +execute_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + Process* proc = env->proc; + NativeFunPtr fp = (NativeFunPtr) proc->current[6]; + NifExport* ep; + ERL_NIF_TERM result; + + ASSERT(ERTS_SCHEDULER_IS_DIRTY(env->proc->scheduler_data)); + + /* + * Set ep->fp to NULL before the native call so we know later whether it scheduled another NIF for execution + */ + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + ep->fp = NULL; + result = (*fp)(env, argc, argv); + erts_smp_atomic32_read_band_mb(&proc->state, + ~(ERTS_PSFLG_DIRTY_CPU_PROC + |ERTS_PSFLG_DIRTY_IO_PROC + |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q + |ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); + if (erts_refc_dectest(&env->mod_nif->rt_dtor_cnt, 0) == 0 && env->mod_nif->mod == NULL) + close_lib(env->mod_nif); + /* + * If no more NIFs were scheduled by the native call via + * enif_schedule_nif(), then ep->fp will still be NULL as set above, in + * which case we need to restore the original NIF calling + * context. Reuse fp essentially as a boolean for this, passing it to + * init_nif_sched_data below. Both dirty_nif_exception and + * dirty_nif_finalizer then check ep->fp to decide whether or not to + * restore the original calling context. + */ + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + if (ep->fp) + fp = NULL; + if (is_non_value(result)) { + if (proc->freason != TRAP) { + ASSERT(proc->freason == BADARG); + return init_nif_sched_data(env, dirty_nif_exception, fp, 0, argc, argv); + } else { + if (ep->fp == NULL) + restore_nif_mfa(proc, ep, 1); + return result; + } + } + else + return init_nif_sched_data(env, dirty_nif_finalizer, fp, 0, 1, &result); +} + +/* + * Dirty NIF scheduling wrapper function. Schedule a dirty NIF to execute + * via the execute_dirty_nif() wrapper function. The dirty scheduler thread + * type (CPU or I/O) is indicated in flags parameter. + */ +static ERTS_INLINE ERL_NIF_TERM +schedule_dirty_nif(ErlNifEnv* env, int flags, int argc, const ERL_NIF_TERM argv[]) { -#ifdef USE_THREADS erts_aint32_t state, n, a; Process* proc = env->proc; - Eterm* reg = ERTS_PROC_GET_SCHDATA(proc)->x_reg_array; - DirtyNifExport* ep = NULL; - int i; + NativeFunPtr fp = (NativeFunPtr) proc->current[6]; + NifExport* ep; + int need_save; - int chkflgs = (flags & (ERL_NIF_DIRTY_JOB_IO_BOUND|ERL_NIF_DIRTY_JOB_CPU_BOUND)); - if (chkflgs != ERL_NIF_DIRTY_JOB_IO_BOUND && chkflgs != ERL_NIF_DIRTY_JOB_CPU_BOUND) - return enif_make_badarg(env); + ASSERT(flags==ERL_NIF_DIRTY_JOB_IO_BOUND || flags==ERL_NIF_DIRTY_JOB_CPU_BOUND); a = erts_smp_atomic32_read_acqb(&proc->state); while (1) { @@ -1590,7 +1790,7 @@ enif_schedule_dirty_nif(ErlNifEnv* env, int flags, */ n &= ~(ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q); - if (chkflgs == ERL_NIF_DIRTY_JOB_CPU_BOUND) + if (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND) n |= ERTS_PSFLG_DIRTY_CPU_PROC; else n |= ERTS_PSFLG_DIRTY_IO_PROC; @@ -1598,85 +1798,106 @@ enif_schedule_dirty_nif(ErlNifEnv* env, int flags, if (a == state) break; } - if (!(ep = (DirtyNifExport*) ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(proc))) - alloc_proc_psd(proc, &ep); - ERTS_VBUMP_ALL_REDS(proc); - ep->exp.code[2] = argc; - for (i = 0; i < argc; i++) { - reg[i] = (Eterm) argv[i]; - } - proc->i = (BeamInstr*) ep->exp.addressv[0]; - ep->exp.code[4] = (BeamInstr) fp; - ep->m = env->mod_nif; - proc->freason = TRAP; - erts_refc_inc(&env->mod_nif->rt_dtor_cnt, 1); + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + need_save = (ep == NULL || is_non_value(ep->saved_mfa[0])); + return init_nif_sched_data(env, execute_dirty_nif, fp, need_save, argc, argv); +} - return THE_NON_VALUE; -#else - return (*fp)(env, argc, argv); -#endif +static ERL_NIF_TERM +schedule_dirty_io_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_IO_BOUND, argc, argv); +} + +static ERL_NIF_TERM +schedule_dirty_cpu_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, argc, argv); +} + +#endif /* ERTS_DIRTY_SCHEDULERS */ + +/* + * NIF execution wrapper used by enif_schedule_nif() for regular NIFs. It + * calls the actual NIF, restores original NIF MFA if necessary, and + * then returns the NIF result. + */ +static ERL_NIF_TERM +execute_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + Process* proc = env->proc; + NativeFunPtr fp = (NativeFunPtr) proc->current[6]; + NifExport* ep; + ERL_NIF_TERM result; + + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + ep->fp = NULL; + result = (*fp)(env, argc, argv); + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + /* + * If no NIFs were scheduled by the native call via + * enif_schedule_nif(), then ep->fp will still be NULL as set above, in + * which case we need to restore the original NIF MFA. + */ + if (ep->fp == NULL) + restore_nif_mfa(proc, ep, is_non_value(result) && proc->freason != TRAP); + return result; } ERL_NIF_TERM -enif_schedule_dirty_nif_finalizer(ErlNifEnv* env, ERL_NIF_TERM result, - ERL_NIF_TERM (*fp)(ErlNifEnv*, ERL_NIF_TERM)) +enif_schedule_nif(ErlNifEnv* env, const char* fun_name, int flags, + ERL_NIF_TERM (*fp)(ErlNifEnv*, int, const ERL_NIF_TERM[]), + int argc, const ERL_NIF_TERM argv[]) { -#ifdef USE_THREADS Process* proc = env->proc; - Eterm* reg = ERTS_PROC_GET_SCHDATA(proc)->x_reg_array; - DirtyNifExport* ep; + NifExport* ep; + ERL_NIF_TERM fun_name_atom, result; + int need_save; - erts_smp_atomic32_read_band_mb(&proc->state, - ~(ERTS_PSFLG_DIRTY_CPU_PROC - |ERTS_PSFLG_DIRTY_IO_PROC - |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q - |ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); - if (!(ep = (DirtyNifExport*) ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(proc))) - alloc_proc_psd(proc, &ep); - ERTS_VBUMP_ALL_REDS(proc); - ep->exp.code[2] = 2; - reg[0] = (Eterm) result; -#if HAVE_INT64 && SIZEOF_LONG != 8 - ASSERT(sizeof(fp) <= sizeof(ErlNifUInt64)); - reg[1] = (Eterm) enif_make_uint64(env, (ErlNifUInt64) fp); -#else - ASSERT(sizeof(fp) <= sizeof(unsigned long)); - reg[1] = (Eterm) enif_make_ulong(env, (unsigned long) fp); -#endif - proc->i = (BeamInstr*) ep->exp.addressv[0]; - ep->exp.code[4] = (BeamInstr) execute_dirty_nif_finalizer; - proc->freason = TRAP; + if (argc > MAX_ARG) + return enif_make_badarg(env); + fun_name_atom = enif_make_atom(env, fun_name); + if (enif_is_exception(env, fun_name_atom)) + return fun_name_atom; - return THE_NON_VALUE; + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + need_save = (ep == NULL || is_non_value(ep->saved_mfa[0])); + + if (flags) { +#ifdef ERTS_DIRTY_SCHEDULERS + NativeFunPtr sched_fun; + int chkflgs = (flags & (ERL_NIF_DIRTY_JOB_IO_BOUND|ERL_NIF_DIRTY_JOB_CPU_BOUND)); + if (chkflgs == ERL_NIF_DIRTY_JOB_IO_BOUND) + sched_fun = schedule_dirty_io_nif; + else if (chkflgs == ERL_NIF_DIRTY_JOB_CPU_BOUND) + sched_fun = schedule_dirty_cpu_nif; + else + return enif_make_badarg(env); + result = init_nif_sched_data(env, sched_fun, fp, need_save, argc, argv); #else - return (*fp)(env, result); + return enif_make_badarg(env); #endif -} + } + else + result = init_nif_sched_data(env, execute_nif, fp, need_save, argc, argv); -/* A simple finalizer that just returns its result argument */ -ERL_NIF_TERM -enif_dirty_nif_finalizer(ErlNifEnv* env, ERL_NIF_TERM result) -{ + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + ep->exp.code[1] = (BeamInstr) fun_name_atom; return result; } +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT + int enif_is_on_dirty_scheduler(ErlNifEnv* env) { return ERTS_SCHEDULER_IS_DIRTY(env->proc->scheduler_data); } -int -enif_have_dirty_schedulers() -{ -#ifdef USE_THREADS - return 1; -#else - return 0; -#endif -} - #endif /* ERL_NIF_DIRTY_SCHEDULER_SUPPORT */ /* Maps */ @@ -1983,6 +2204,35 @@ static Eterm load_nif_error(Process* p, const char* atom, const char* format, .. return ret; } +/* + * The function below is for looping through ErlNifFunc arrays, helping + * provide backwards compatibility across the version 2.7 change that added + * the "flags" field to ErlNifFunc. + */ +static ErlNifFunc* next_func(ErlNifEntry* entry, int* incrp, ErlNifFunc* func) +{ + ASSERT(incrp); + if (!*incrp) { + if (entry->major > 2 || (entry->major == 2 && entry->minor >= 7)) + *incrp = sizeof(ErlNifFunc); + else { + /* + * ErlNifFuncV1 below is what ErlNifFunc was before the + * addition of the flags field for 2.7, and is needed to handle + * backward compatibility. + */ + typedef struct { + const char* name; + unsigned arity; + ERL_NIF_TERM (*fptr)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + }ErlNifFuncV1; + *incrp = sizeof(ErlNifFuncV1); + } + } + return (ErlNifFunc*) ((char*)func + *incrp); +} + + BIF_RETTYPE load_nif_2(BIF_ALIST_2) { static const char bad_lib[] = "bad_lib"; @@ -2092,22 +2342,48 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) } else { /*erts_fprintf(stderr, "Found module %T\r\n", mod_atom);*/ - + + int maybe_dirty_nifs = ((entry->major > 2 || (entry->major == 2 && entry->minor >= 7)) + && (entry->options & ERL_NIF_DIRTY_NIF_OPTION)); + int incr = 0; + ErlNifFunc* f = entry->funcs; for (i=0; i < entry->num_of_funcs && ret==am_ok; i++) { BeamInstr** code_pp; - ErlNifFunc* f = &entry->funcs[i]; if (!erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1) || (code_pp = get_func_pp(mod->curr.code, f_atom, f->arity))==NULL) { ret = load_nif_error(BIF_P,bad_lib,"Function not found %T:%s/%u", mod_atom, f->name, f->arity); - } - else if (code_pp[1] - code_pp[0] < (5+3)) { + } + else if (maybe_dirty_nifs && f->flags) { + /* + * If the flags field is non-zero and this emulator was + * built with dirty scheduler support, check that the flags + * value is legal. But if this emulator was built without + * dirty scheduler support, treat a non-zero flags field as + * a load error. + */ +#ifdef ERTS_DIRTY_SCHEDULERS + if (f->flags != ERL_NIF_DIRTY_JOB_IO_BOUND && f->flags != ERL_NIF_DIRTY_JOB_CPU_BOUND) + ret = load_nif_error(BIF_P, bad_lib, "Illegal flags field value %d for NIF %T:%s/%u", + f->flags, mod_atom, f->name, f->arity); +#else + ret = load_nif_error(BIF_P, bad_lib, "NIF %T:%s/%u requires a runtime with dirty scheduler support.", + mod_atom, f->name, f->arity); +#endif + } +#ifdef ERTS_DIRTY_SCHEDULERS + else if (code_pp[1] - code_pp[0] < (5+4)) +#else + else if (code_pp[1] - code_pp[0] < (5+3)) +#endif + { ret = load_nif_error(BIF_P,bad_lib,"No explicit call to load_nif" - " in module (%T:%s/%u to small)", - mod_atom, entry->funcs[i].name, entry->funcs[i].arity); + " in module (%T:%s/%u too small)", + mod_atom, f->name, f->arity); } /*erts_fprintf(stderr, "Found NIF %T:%s/%u\r\n", - mod_atom, entry->funcs[i].name, entry->funcs[i].arity);*/ + mod_atom, f->name, f->arity);*/ + f = next_func(entry, &incr, f); } } @@ -2133,7 +2409,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) * is deprecated and was only ment as a development feature not to * be used in production systems. (See warning below) */ - int k; + int k, old_incr = 0; + ErlNifFunc* old_func; lib->priv_data = mod->curr.nif->priv_data; ASSERT(mod->curr.nif->entry != NULL); @@ -2142,13 +2419,16 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) goto error; } /* Check that no NIF is removed */ + old_func = mod->curr.nif->entry->funcs; for (k=0; k < mod->curr.nif->entry->num_of_funcs; k++) { - ErlNifFunc* old_func = &mod->curr.nif->entry->funcs[k]; + int incr = 0; + ErlNifFunc* f = entry->funcs; for (i=0; i < entry->num_of_funcs; i++) { - if (old_func->arity == entry->funcs[i].arity - && sys_strcmp(old_func->name, entry->funcs[i].name) == 0) { + if (old_func->arity == f->arity + && sys_strcmp(old_func->name, f->name) == 0) { break; } + f = next_func(entry, &incr, f); } if (i == entry->num_of_funcs) { ret = load_nif_error(BIF_P,reload,"Reloaded library missing " @@ -2156,7 +2436,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) old_func->name, old_func->arity); goto error; } - } + old_func = next_func(mod->curr.nif->entry, &old_incr, old_func); + } erts_pre_nif(&env, BIF_P, lib); veto = entry->reload(&env, &lib->priv_data, BIF_ARG_2); erts_post_nif(&env); @@ -2203,13 +2484,17 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) /* ** Everything ok, patch the beam code with op_call_nif */ - mod->curr.nif = lib; + + int incr = 0; + ErlNifFunc* f = entry->funcs; + + mod->curr.nif = lib; for (i=0; i < entry->num_of_funcs; i++) { BeamInstr* code_ptr; - erts_atom_get(entry->funcs[i].name, sys_strlen(entry->funcs[i].name), &f_atom, ERTS_ATOM_ENC_LATIN1); - code_ptr = *get_func_pp(mod->curr.code, f_atom, entry->funcs[i].arity); - + erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1); + code_ptr = *get_func_pp(mod->curr.code, f_atom, f->arity); + if (code_ptr[1] == 0) { code_ptr[5+0] = (BeamInstr) BeamOp(op_call_nif); } @@ -2217,10 +2502,21 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) GenericBp* g = (GenericBp *) code_ptr[1]; ASSERT(code_ptr[5+0] == (BeamInstr) BeamOp(op_i_generic_breakpoint)); - g->orig_instr = (BeamInstr) BeamOp(op_call_nif); - } - code_ptr[5+1] = (BeamInstr) entry->funcs[i].fptr; + g->orig_instr = (BeamInstr) BeamOp(op_call_nif); + } + if ((entry->major > 2 || (entry->major == 2 && entry->minor >= 7)) + && (entry->options & ERL_NIF_DIRTY_NIF_OPTION) && f->flags) { +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT + code_ptr[5+3] = (BeamInstr) f->fptr; + code_ptr[5+1] = (f->flags == ERL_NIF_DIRTY_JOB_IO_BOUND) ? + (BeamInstr) schedule_dirty_io_nif : + (BeamInstr) schedule_dirty_cpu_nif; +#endif + } + else + code_ptr[5+1] = (BeamInstr) f->fptr; code_ptr[5+2] = (BeamInstr) lib; + f = next_func(entry, &incr, f); } } else { diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 5b93c2398e..849024453c 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -42,9 +42,13 @@ ** 2.5: R17 Maps API additions ** 2.6: R17 with maps ** R17 dirty schedulers +** 2.7: 17.3 add enif_schedule_nif +** remove enif_schedule_dirty_nif, enif_schedule_dirty_nif_finalizer, enif_dirty_nif_finalizer +** add ErlNifEntry options +** add ErlNifFunc flags */ #define ERL_NIF_MAJOR_VERSION 2 -#define ERL_NIF_MINOR_VERSION 6 +#define ERL_NIF_MINOR_VERSION 7 /* * The emulator will refuse to load a nif-lib with a major version @@ -125,8 +129,10 @@ typedef struct const char* name; unsigned arity; ERL_NIF_TERM (*fptr)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + unsigned flags; }ErlNifFunc; + typedef struct enif_entry_t { int major; @@ -139,8 +145,11 @@ typedef struct enif_entry_t int (*upgrade)(ErlNifEnv*, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); void (*unload) (ErlNifEnv*, void* priv_data); const char* vm_variant; + unsigned options; }ErlNifEntry; +/* Field bits for ErlNifEntry options */ +#define ERL_NIF_DIRTY_NIF_OPTION 1 typedef struct @@ -243,6 +252,11 @@ extern TWinDynNifCallbacks WinDynNifCallbacks; # endif #endif +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT +# define ERL_NIF_ENTRY_OPTIONS ERL_NIF_DIRTY_NIF_OPTION +#else +# define ERL_NIF_ENTRY_OPTIONS 0 +#endif #ifdef __cplusplus } @@ -268,7 +282,8 @@ ERL_NIF_INIT_DECL(NAME) \ sizeof(FUNCS) / sizeof(*FUNCS), \ FUNCS, \ LOAD, RELOAD, UPGRADE, UNLOAD, \ - ERL_NIF_VM_VARIANT \ + ERL_NIF_VM_VARIANT, \ + ERL_NIF_ENTRY_OPTIONS \ }; \ ERL_NIF_INIT_BODY; \ return &entry; \ diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index d7c554e60b..630cefae93 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -22,7 +22,7 @@ #endif /* -** WARNING: add new ERL_NIF_API_FUNC_DECL entries at the bottom of the list +** WARNING: Add new ERL_NIF_API_FUNC_DECL entries at the bottom of the list ** to keep compatibility on Windows!!! ** ** And don't forget to increase ERL_NIF_MINOR_VERSION in erl_nif.h @@ -141,14 +141,6 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); ERL_NIF_API_FUNC_DECL(void*,enif_dlopen,(const char* lib, void (*err_handler)(void*,const char*), void* err_arg)); ERL_NIF_API_FUNC_DECL(void*,enif_dlsym,(void* handle, const char* symbol, void (*err_handler)(void*,const char*), void* err_arg)); ERL_NIF_API_FUNC_DECL(int,enif_consume_timeslice,(ErlNifEnv*, int percent)); -#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT -ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_dirty_nif,(ErlNifEnv*,int,ERL_NIF_TERM (*)(ErlNifEnv*,int,const ERL_NIF_TERM[]),int,const ERL_NIF_TERM[])); -ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_dirty_nif_finalizer,(ErlNifEnv*,ERL_NIF_TERM,ERL_NIF_TERM (*)(ErlNifEnv*,ERL_NIF_TERM))); -ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_dirty_nif_finalizer,(ErlNifEnv*,ERL_NIF_TERM)); -ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*)); -ERL_NIF_API_FUNC_DECL(int,enif_have_dirty_schedulers,(void)); -#endif - ERL_NIF_API_FUNC_DECL(int, enif_is_map, (ErlNifEnv* env, ERL_NIF_TERM term)); ERL_NIF_API_FUNC_DECL(int, enif_get_map_size, (ErlNifEnv* env, ERL_NIF_TERM term, size_t *size)); ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM, enif_make_new_map, (ErlNifEnv* env)); @@ -163,12 +155,22 @@ ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_is_tail, (ErlNifEnv *env, ErlNifMap ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_next, (ErlNifEnv *env, ErlNifMapIterator *iter)); ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_prev, (ErlNifEnv *env, ErlNifMapIterator *iter)); ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_get_pair, (ErlNifEnv *env, ErlNifMapIterator *iter, ERL_NIF_TERM *key, ERL_NIF_TERM *value)); - +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_nif,(ErlNifEnv*,const char*,int,ERL_NIF_TERM (*)(ErlNifEnv*,int,const ERL_NIF_TERM[]),int,const ERL_NIF_TERM[])); /* -** Add new entries here to keep compatibility on Windows!!! +** ADD NEW ENTRIES HERE (before this comment) !!! */ + + +/* + * Conditional EXPERIMENTAL stuff always last. + * Must be moved up and made unconditional to support binary backward + * compatibility on Windows. + */ +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT +ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*)); #endif +#endif /* ERL_NIF_API_FUNC_DECL */ /* ** Please keep the ERL_NIF_API_FUNC_MACRO list below in the same order @@ -282,21 +284,12 @@ ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_get_pair, (ErlNifEnv *env, ErlNifMa # define enif_make_int64 ERL_NIF_API_FUNC_MACRO(enif_make_int64) # define enif_make_uint64 ERL_NIF_API_FUNC_MACRO(enif_make_uint64) #endif - # define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception) # define enif_make_reverse_list ERL_NIF_API_FUNC_MACRO(enif_make_reverse_list) # define enif_is_number ERL_NIF_API_FUNC_MACRO(enif_is_number) # define enif_dlopen ERL_NIF_API_FUNC_MACRO(enif_dlopen) # define enif_dlsym ERL_NIF_API_FUNC_MACRO(enif_dlsym) # define enif_consume_timeslice ERL_NIF_API_FUNC_MACRO(enif_consume_timeslice) -#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT -# define enif_schedule_dirty_nif ERL_NIF_API_FUNC_MACRO(enif_schedule_dirty_nif) -# define enif_schedule_dirty_nif_finalizer ERL_NIF_API_FUNC_MACRO(enif_schedule_dirty_nif_finalizer) -# define enif_dirty_nif_finalizer ERL_NIF_API_FUNC_MACRO(enif_dirty_nif_finalizer) -# define enif_is_on_dirty_scheduler ERL_NIF_API_FUNC_MACRO(enif_is_on_dirty_scheduler) -# define enif_have_dirty_schedulers ERL_NIF_API_FUNC_MACRO(enif_have_dirty_schedulers) -#endif - # define enif_is_map ERL_NIF_API_FUNC_MACRO(enif_is_map) # define enif_get_map_size ERL_NIF_API_FUNC_MACRO(enif_get_map_size) # define enif_make_new_map ERL_NIF_API_FUNC_MACRO(enif_make_new_map) @@ -311,11 +304,21 @@ ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_get_pair, (ErlNifEnv *env, ErlNifMa # define enif_map_iterator_next ERL_NIF_API_FUNC_MACRO(enif_map_iterator_next) # define enif_map_iterator_prev ERL_NIF_API_FUNC_MACRO(enif_map_iterator_prev) # define enif_map_iterator_get_pair ERL_NIF_API_FUNC_MACRO(enif_map_iterator_get_pair) +# define enif_schedule_nif ERL_NIF_API_FUNC_MACRO(enif_schedule_nif) /* -** Add new entries here +** ADD NEW ENTRIES HERE (before this comment) */ + +/* + * Conditional EXPERIMENTAL stuff always last + * Must be moved up and made unconditional to support binary backward + * compatibility on Windows. + */ +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT +# define enif_is_on_dirty_scheduler ERL_NIF_API_FUNC_MACRO(enif_is_on_dirty_scheduler) #endif +#endif /* ERL_NIF_API_FUNC_MACRO */ #if defined(__GNUC__) && !(defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 31d9a1e26e..2aa0a27197 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -32,6 +32,7 @@ #include "global.h" #include "erl_port_task.h" #include "dist.h" +#include "erl_check_io.h" #include "dtrace-wrapper.h" #include <stdarg.h> @@ -68,6 +69,13 @@ static void chk_task_queues(Port *pp, ErtsPortTask *execq, int processing_busy_q #define DTRACE_DRIVER(PROBE_NAME, PP) do {} while(0) #endif +#define ERTS_SMP_LC_VERIFY_RQ(RQ, PP) \ + do { \ + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); \ + ERTS_SMP_LC_ASSERT((RQ) == ((ErtsRunQueue *) \ + erts_smp_atomic_read_nob(&(PP)->run_queue))); \ + } while (0) + erts_smp_atomic_t erts_port_task_outstanding_io_tasks; #define ERTS_PT_STATE_SCHEDULED 0 @@ -543,6 +551,16 @@ reset_handle(ErtsPortTask *ptp) } static ERTS_INLINE void +reset_executed_io_task_handle(ErtsPortTask *ptp) +{ + if (ptp->u.alive.handle) { + ASSERT(ptp == handle2task(ptp->u.alive.handle)); + erts_io_notify_port_task_executed(ptp->u.alive.handle); + reset_port_task_handle(ptp->u.alive.handle); + } +} + +static ERTS_INLINE void set_handle(ErtsPortTask *ptp, ErtsPortTaskHandle *pthp) { ptp->u.alive.handle = pthp; @@ -798,12 +816,13 @@ schedule_port_task_handle_list_free(ErtsPortTaskHandleList *pthlp) static ERTS_INLINE void abort_nosuspend_task(Port *pp, ErtsPortTaskType type, - ErtsPortTaskTypeData *tdp) + ErtsPortTaskTypeData *tdp, + int bpq_data) { ASSERT(type == ERTS_PORT_TASK_PROC_SIG); - if (!pp->sched.taskq.bpq) + if (!bpq_data) tdp->psig.callback(NULL, ERTS_PORT_SFLG_INVALID, ERTS_PROC2PORT_SIG_ABORT_NOSUSPEND, @@ -991,6 +1010,7 @@ static ERTS_INLINE int finalize_exec(Port *pp, ErtsPortTask **execq, int processing_busy_q) { erts_aint32_t act; + unsigned int prof_runnable_ports; if (!processing_busy_q) pp->sched.taskq.local.first = *execq; @@ -1007,6 +1027,10 @@ finalize_exec(Port *pp, ErtsPortTask **execq, int processing_busy_q) if (act & ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q) act = check_unset_busy_port_q(pp, act, pp->sched.taskq.bpq); + prof_runnable_ports = erts_system_profile_flags.runnable_ports; + if (prof_runnable_ports) + erts_port_task_sched_lock(&pp->sched); + while (1) { erts_aint32_t new, exp; @@ -1018,12 +1042,24 @@ finalize_exec(Port *pp, ErtsPortTask **execq, int processing_busy_q) act = erts_smp_atomic32_cmpxchg_relb(&pp->sched.flags, new, exp); - ASSERT(!(act & ERTS_PTS_FLG_IN_RUNQ)); + ERTS_LC_ASSERT(!(act & ERTS_PTS_FLG_IN_RUNQ)); + ERTS_LC_ASSERT(!(act & ERTS_PTS_FLG_EXEC_IMM)); if (exp == act) break; } + if (prof_runnable_ports | IS_TRACED_FL(pp, F_TRACE_SCHED_PORTS)) { + /* trace port scheduling, out */ + if (IS_TRACED_FL(pp, F_TRACE_SCHED_PORTS)) + trace_sched_ports(pp, am_out); + if (prof_runnable_ports) { + if (!(act & (ERTS_PTS_FLG_EXEC_IMM|ERTS_PTS_FLG_HAVE_TASKS))) + profile_runnable_port(pp, am_inactive); + erts_port_task_sched_unlock(&pp->sched); + } + } + return (act & ERTS_PTS_FLG_HAVE_TASKS) != 0; } @@ -1345,7 +1381,7 @@ erts_port_task_abort_nosuspend_tasks(Port *pp) #endif schedule_port_task_handle_list_free(pthlp); - abort_nosuspend_task(pp, type, &td); + abort_nosuspend_task(pp, type, &td, pp->sched.taskq.bpq != NULL); } } @@ -1369,11 +1405,9 @@ erts_port_task_schedule(Eterm id, Port *pp; ErtsPortTask *ptp = NULL; erts_aint32_t act, add_flags; + unsigned int prof_runnable_ports; - if (pthp && erts_port_task_is_scheduled(pthp)) { - ASSERT(0); - erts_port_task_abort(pthp); - } + ERTS_LC_ASSERT(!pthp || !erts_port_task_is_scheduled(pthp)); ASSERT(is_internal_port(id)); @@ -1457,6 +1491,10 @@ erts_port_task_schedule(Eterm id, if (ns_pthlp) add_flags |= ERTS_PTS_FLG_HAVE_NS_TASKS; + prof_runnable_ports = erts_system_profile_flags.runnable_ports; + if (prof_runnable_ports) + erts_port_task_sched_lock(&pp->sched); + while (1) { erts_aint32_t new, exp; @@ -1481,6 +1519,13 @@ erts_port_task_schedule(Eterm id, goto done; /* Died after our task insert... */ } + if (prof_runnable_ports) { + if (!(act & ERTS_PTS_FLG_EXEC_IMM)) + profile_runnable_port(pp, am_active); + erts_port_task_sched_unlock(&pp->sched); + prof_runnable_ports = 0; + } + /* Enqueue port on run-queue */ runq = erts_port_runq(pp); @@ -1489,8 +1534,10 @@ erts_port_task_schedule(Eterm id, #ifdef ERTS_SMP xrunq = erts_check_emigration_need(runq, ERTS_PORT_PRIO_LEVEL); + ERTS_SMP_LC_ASSERT(runq != xrunq); + ERTS_SMP_LC_VERIFY_RQ(runq, pp); if (xrunq) { - /* Port emigrated ... */ + /* Emigrate port ... */ erts_smp_atomic_set_nob(&pp->run_queue, (erts_aint_t) xrunq); erts_smp_runq_unlock(runq); runq = erts_port_runq(pp); @@ -1500,10 +1547,6 @@ erts_port_task_schedule(Eterm id, #endif enqueue_port(runq, pp); - - if (erts_system_profile_flags.runnable_ports) { - profile_runnable_port(pp, am_active); - } erts_smp_runq_unlock(runq); @@ -1511,6 +1554,9 @@ erts_port_task_schedule(Eterm id, done: + if (prof_runnable_ports) + erts_port_task_sched_unlock(&pp->sched); + #ifdef ERTS_SMP if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED) erts_port_dec_refc(pp); @@ -1525,7 +1571,7 @@ abort_nosuspend: erts_port_dec_refc(pp); #endif - abort_nosuspend_task(pp, ptp->type, &ptp->u.alive.td); + abort_nosuspend_task(pp, ptp->type, &ptp->u.alive.td, 0); ASSERT(ns_pthlp); erts_free(ERTS_ALC_T_PT_HNDL_LIST, ns_pthlp); @@ -1609,6 +1655,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) goto done; } + ERTS_SMP_LC_VERIFY_RQ(runq, pp); + erts_smp_runq_unlock(runq); *curr_port_pp = pp; @@ -1659,8 +1707,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) goto aborted_port_task; } - reset_handle(ptp); - if (erts_system_monitor_long_schedule != 0) { start_time = erts_timestamp_millis(); } @@ -1671,6 +1717,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) switch (ptp->type) { case ERTS_PORT_TASK_TIMEOUT: + reset_handle(ptp); reds = ERTS_PORT_REDS_TIMEOUT; if (!(state & ERTS_PORT_SFLGS_DEAD)) { DTRACE_DRIVER(driver_timeout, pp); @@ -1685,6 +1732,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) for input and output */ (*pp->drv_ptr->ready_input)((ErlDrvData) pp->drv_data, ptp->u.alive.td.io.event); + reset_executed_io_task_handle(ptp); io_tasks_executed++; break; case ERTS_PORT_TASK_OUTPUT: @@ -1693,6 +1741,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) DTRACE_DRIVER(driver_ready_output, pp); (*pp->drv_ptr->ready_output)((ErlDrvData) pp->drv_data, ptp->u.alive.td.io.event); + reset_executed_io_task_handle(ptp); io_tasks_executed++; break; case ERTS_PORT_TASK_EVENT: @@ -1702,10 +1751,12 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) (*pp->drv_ptr->event)((ErlDrvData) pp->drv_data, ptp->u.alive.td.io.event, ptp->u.alive.td.io.event_data); + reset_executed_io_task_handle(ptp); io_tasks_executed++; break; case ERTS_PORT_TASK_PROC_SIG: { ErtsProc2PortSigData *sigdp = &ptp->u.alive.td.psig.data; + reset_handle(ptp); ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); if (!pp->sched.taskq.bpq) reds = ptp->u.alive.td.psig.callback(pp, @@ -1723,6 +1774,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) break; } case ERTS_PORT_TASK_DIST_CMD: + reset_handle(ptp); reds = erts_dist_command(pp, CONTEXT_REDS - pp->reds); break; default: @@ -1765,10 +1817,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) erts_unblock_fpe(fpe_was_unmasked); - /* trace port scheduling, out */ - if (IS_TRACED_FL(pp, F_TRACE_SCHED_PORTS)) { - trace_sched_ports(pp, am_out); - } if (io_tasks_executed) { ASSERT(erts_smp_atomic_read_nob(&erts_port_task_outstanding_io_tasks) @@ -1791,11 +1839,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) erts_smp_runq_lock(runq); - if (!active) { - if (erts_system_profile_flags.runnable_ports) - profile_runnable_port(pp, am_inactive); - } - else { + if (active) { #ifdef ERTS_SMP ErtsRunQueue *xrunq; #endif @@ -1804,6 +1848,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) #ifdef ERTS_SMP xrunq = erts_check_emigration_need(runq, ERTS_PORT_PRIO_LEVEL); + ERTS_SMP_LC_ASSERT(runq != xrunq); + ERTS_SMP_LC_VERIFY_RQ(runq, pp); if (!xrunq) { #endif enqueue_port(runq, pp); @@ -1811,7 +1857,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) #ifdef ERTS_SMP } else { - /* Port emigrated ... */ + /* Emigrate port... */ erts_smp_atomic_set_nob(&pp->run_queue, (erts_aint_t) xrunq); erts_smp_runq_unlock(runq); diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h index 1d30465ec9..406cd3c492 100644 --- a/erts/emulator/beam/erl_port_task.h +++ b/erts/emulator/beam/erl_port_task.h @@ -78,6 +78,7 @@ extern erts_smp_atomic_t erts_port_task_outstanding_io_tasks; #define ERTS_PTS_FLG_PARALLELISM (((erts_aint32_t) 1) << 9) #define ERTS_PTS_FLG_FORCE_SCHED (((erts_aint32_t) 1) << 10) #define ERTS_PTS_FLG_EXITING (((erts_aint32_t) 1) << 11) +#define ERTS_PTS_FLG_EXEC_IMM (((erts_aint32_t) 1) << 12) #define ERTS_PTS_FLGS_BUSY \ (ERTS_PTS_FLG_BUSY_PORT | ERTS_PTS_FLG_BUSY_PORT_Q) @@ -87,6 +88,7 @@ extern erts_smp_atomic_t erts_port_task_outstanding_io_tasks; | ERTS_PTS_FLG_HAVE_BUSY_TASKS \ | ERTS_PTS_FLG_HAVE_TASKS \ | ERTS_PTS_FLG_EXEC \ + | ERTS_PTS_FLG_EXEC_IMM \ | ERTS_PTS_FLG_FORCE_SCHED \ | ERTS_PTS_FLG_EXITING) @@ -154,7 +156,7 @@ erts_port_task_handle_init(ErtsPortTaskHandle *pthp) ERTS_GLB_INLINE int erts_port_task_is_scheduled(ErtsPortTaskHandle *pthp) { - return ((void *) erts_smp_atomic_read_nob(pthp)) != NULL; + return ((void *) erts_smp_atomic_read_acqb(pthp)) != NULL; } ERTS_GLB_INLINE void erts_port_task_pre_init_sched(ErtsPortTaskSched *ptsp, diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c index d18760dc43..1a0c7a9fc9 100644 --- a/erts/emulator/beam/erl_printf_term.c +++ b/erts/emulator/beam/erl_printf_term.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2013. All Rights Reserved. + * Copyright Ericsson AB 2005-2014. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -25,6 +25,7 @@ #include "sys.h" #include "big.h" #include "erl_map.h" +#include "erl_binary.h" #define PRINT_CHAR(CNT, FN, ARG, C) \ do { \ @@ -138,6 +139,25 @@ is_printable_string(Eterm list, Eterm* base) return 0; } +static int is_printable_ascii(byte* bytep, Uint bytesize, Uint bitoffs) +{ + if (!bitoffs) { + while (bytesize--) { + if (*bytep < ' ' || *bytep >= 127) + return 0; + bytep++; + } + } else { + while (bytesize--) { + byte octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs)); + if (octet < ' ' || octet >= 127) + return 0; + bytep++; + } + } + return 1; +} + /* print a atom doing what quoting is necessary */ static int print_atom_name(fmtfn_t fn, void* arg, Eterm atom, long *dcount) { @@ -446,13 +466,65 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount, PRINT_STRING(res, fn, arg, "#MatchState"); } else { - ProcBin* pb = (ProcBin *) binary_val(wobj); - if (pb->size == 1) - PRINT_STRING(res, fn, arg, "<<1 byte>>"); - else { + byte* bytep; + Uint bytesize = binary_size_rel(obj,obj_base); + Uint bitoffs; + Uint bitsize; + byte octet; + ERTS_GET_BINARY_BYTES_REL(obj, bytep, bitoffs, bitsize, obj_base); + + if (bitsize || !bytesize + || !is_printable_ascii(bytep, bytesize, bitoffs)) { + int is_first = 1; PRINT_STRING(res, fn, arg, "<<"); - PRINT_UWORD(res, fn, arg, 'u', 0, 1, (ErlPfUWord) pb->size); - PRINT_STRING(res, fn, arg, " bytes>>"); + while (bytesize) { + if (is_first) + is_first = 0; + else + PRINT_CHAR(res, fn, arg, ','); + if (bitoffs) + octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs)); + else + octet = bytep[0]; + PRINT_UWORD(res, fn, arg, 'u', 0, 1, octet); + ++bytep; + --bytesize; + } + if (bitsize) { + Uint bits = bitoffs + bitsize; + octet = bytep[0]; + if (bits < 8) + octet >>= 8 - bits; + else if (bits > 8) { + bits -= 8; /* bits in last byte */ + octet <<= bits; + octet |= bytep[1] >> (8 - bits); + } + octet &= (1 << bitsize) - 1; + if (is_first) + is_first = 0; + else + PRINT_CHAR(res, fn, arg, ','); + PRINT_UWORD(res, fn, arg, 'u', 0, 1, octet); + PRINT_CHAR(res, fn, arg, ':'); + PRINT_UWORD(res, fn, arg, 'u', 0, 1, bitsize); + } + PRINT_STRING(res, fn, arg, ">>"); + } + else { + PRINT_STRING(res, fn, arg, "<<\""); + while (bytesize) { + if (bitoffs) + octet = (bytep[0] << bitoffs) | (bytep[1] >> (8-bitoffs)); + else + octet = bytep[0]; + if (octet == '"') + PRINT_CHAR(res, fn, arg, '\\'); + PRINT_CHAR(res, fn, arg, octet); + ++bytep; + --bytesize; + } + PRINT_STRING(res, fn, arg, "\">>"); } } break; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index b73f9b7f92..7b272885a7 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -148,6 +148,12 @@ extern BeamInstr beam_apply[]; extern BeamInstr beam_exit[]; extern BeamInstr beam_continue_exit[]; +#ifdef __OSE__ +/* Eager check I/O not supported on OSE yet. */ +int erts_eager_check_io = 0; +#else +int erts_eager_check_io = 1; +#endif int erts_sched_compact_load; int erts_sched_balance_util = 0; Uint erts_no_schedulers; @@ -590,12 +596,10 @@ erts_pre_init_process(void) erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].set_locks = ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS; -#ifdef ERTS_DIRTY_SCHEDULERS - erts_psd_required_locks[ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT].get_locks - = ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT].set_locks - = ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT_SET_LOCKS; -#endif + erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].get_locks + = ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].set_locks + = ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS; /* Check that we have locks for all entries */ for (ix = 0; ix < ERTS_PSD_SIZE; ix++) { @@ -2211,6 +2215,9 @@ aux_work_timeout_early_init(int no_schedulers) p = (UWord) malloc((sizeof(ErtsAuxWorkTmo) + sizeof(erts_atomic32_t)*(no_schedulers+1)) + ERTS_CACHE_LINE_SIZE-1); + if (!p) { + ERTS_INTERNAL_ERROR("malloc failed to allocate memory!"); + } if (p & ERTS_CACHE_LINE_MASK) p = (p & ~ERTS_CACHE_LINE_MASK) + ERTS_CACHE_LINE_SIZE; ASSERT((p & ERTS_CACHE_LINE_MASK) == 0); @@ -2380,29 +2387,47 @@ try_set_sys_scheduling(void) #endif static ERTS_INLINE int -prepare_for_sys_schedule(ErtsSchedulerData *esdp) +prepare_for_sys_schedule(ErtsSchedulerData *esdp, int non_blocking) { + if (non_blocking && erts_eager_check_io) { #ifdef ERTS_SMP - while (!erts_port_task_have_outstanding_io_tasks() - && try_set_sys_scheduling()) { #ifdef ERTS_SCHED_ONLY_POLL_SCHED_1 - if (esdp->no != 1) { - /* If we are not scheduler 1 and ERTS_SCHED_ONLY_POLL_SCHED_1 is used - then we make sure to wake scheduler 1 */ - ErtsRunQueue *rq = ERTS_RUNQ_IX(0); - clear_sys_scheduling(); - wake_scheduler(rq); - return 0; - } + if (esdp->no != 1) { + /* If we are not scheduler 1 and ERTS_SCHED_ONLY_POLL_SCHED_1 is used + then we make sure to wake scheduler 1 */ + ErtsRunQueue *rq = ERTS_RUNQ_IX(0); + wake_scheduler(rq); + return 0; + } #endif - if (!erts_port_task_have_outstanding_io_tasks()) + return try_set_sys_scheduling(); +#else return 1; - clear_sys_scheduling(); +#endif } - return 0; + else { +#ifdef ERTS_SMP + while (!erts_port_task_have_outstanding_io_tasks() + && try_set_sys_scheduling()) { +#ifdef ERTS_SCHED_ONLY_POLL_SCHED_1 + if (esdp->no != 1) { + /* If we are not scheduler 1 and ERTS_SCHED_ONLY_POLL_SCHED_1 is used + then we make sure to wake scheduler 1 */ + ErtsRunQueue *rq = ERTS_RUNQ_IX(0); + clear_sys_scheduling(); + wake_scheduler(rq); + return 0; + } +#endif + if (!erts_port_task_have_outstanding_io_tasks()) + return 1; + clear_sys_scheduling(); + } + return 0; #else - return !erts_port_task_have_outstanding_io_tasks(); + return !erts_port_task_have_outstanding_io_tasks(); #endif + } } #ifdef ERTS_SMP @@ -2779,7 +2804,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) * be waiting in erl_sys_schedule() */ - if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule(esdp)) { + if (ERTS_SCHEDULER_IS_DIRTY(esdp) || !prepare_for_sys_schedule(esdp, 0)) { sched_waiting(esdp->no, rq); @@ -2943,7 +2968,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) * Got to check that we still got I/O tasks; otherwise * we have to continue checking for I/O... */ - if (!prepare_for_sys_schedule(esdp)) { + if (!prepare_for_sys_schedule(esdp, 0)) { spincount *= ERTS_SCHED_TSE_SLEEP_SPINCOUNT_FACT; goto tse_wait; } @@ -2965,7 +2990,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) * Got to check that we still got I/O tasks; otherwise * we have to wait in erl_sys_schedule() after all... */ - if (!prepare_for_sys_schedule(esdp)) { + if (!prepare_for_sys_schedule(esdp, 0)) { /* * Not allowed to wait in erl_sys_schedule; * do tse wait instead... @@ -3755,17 +3780,25 @@ evacuate_run_queue(ErtsRunQueue *rq, } #ifdef ERTS_DIRTY_SCHEDULERS else if (state & ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q) { - erts_aint32_t old; - old = erts_smp_atomic32_read_band_nob(&proc->state, - ~(ERTS_PSFLG_DIRTY_CPU_PROC - | ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q)); +#ifdef DEBUG + erts_aint32_t old = +#else + (void) +#endif + erts_smp_atomic32_read_band_nob(&proc->state, + ~(ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q)); /* assert that no other dirty flags are set */ ASSERT(!(old & (ERTS_PSFLG_DIRTY_IO_PROC|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q))); } else if (state & ERTS_PSFLG_DIRTY_IO_PROC_IN_Q) { - erts_aint32_t old; - old = erts_smp_atomic32_read_band_nob(&proc->state, - ~(ERTS_PSFLG_DIRTY_IO_PROC - | ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); +#ifdef DEBUG + erts_aint32_t old = +#else + (void) +#endif + erts_smp_atomic32_read_band_nob(&proc->state, + ~(ERTS_PSFLG_DIRTY_IO_PROC + | ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); /* assert that no other dirty flags are set */ ASSERT(!(old & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q))); } @@ -5874,6 +5907,9 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces case ERTS_ENQUEUE_NOT: if (erts_system_profile_flags.runnable_procs) { + /* Status lock prevents out of order "runnable proc" trace msgs */ + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + if (!(a & ERTS_PSFLG_ACTIVE_SYS) && (!(a & ERTS_PSFLG_ACTIVE) || (a & ERTS_PSFLG_SUSPENDED))) { @@ -5987,7 +6023,8 @@ change_proc_schedule_state(Process *p, erts_aint32_t clear_state_flags, erts_aint32_t set_state_flags, erts_aint32_t *statep, - erts_aint32_t *enq_prio_p) + erts_aint32_t *enq_prio_p, + ErtsProcLocks locks) { /* * NOTE: ERTS_PSFLG_RUNNING, ERTS_PSFLG_RUNNING_SYS and @@ -5996,6 +6033,11 @@ change_proc_schedule_state(Process *p, */ erts_aint32_t a = *statep, n; int enqueue; /* < 0 -> use proxy */ + unsigned int prof_runnable_procs = erts_system_profile_flags.runnable_procs; + unsigned int lock_status = (prof_runnable_procs + && !(locks & ERTS_PROC_LOCK_STATUS)); + + ERTS_SMP_LC_ASSERT(locks == erts_proc_lc_my_proc_locks(p)); ASSERT(!(a & ERTS_PSFLG_PROXY)); ASSERT((clear_state_flags & (ERTS_PSFLG_RUNNING @@ -6005,6 +6047,9 @@ change_proc_schedule_state(Process *p, | ERTS_PSFLG_RUNNING_SYS | ERTS_PSFLG_ACTIVE_SYS)) == 0); + if (lock_status) + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + while (1) { erts_aint32_t e; n = e = a; @@ -6040,7 +6085,9 @@ change_proc_schedule_state(Process *p, break; } - if (erts_system_profile_flags.runnable_procs) { + if (prof_runnable_procs) { + + /* Status lock prevents out of order "runnable proc" trace msgs */ if (((n & (ERTS_PSFLG_SUSPENDED | ERTS_PSFLG_ACTIVE)) == ERTS_PSFLG_ACTIVE) @@ -6053,15 +6100,18 @@ change_proc_schedule_state(Process *p, profile_runnable_proc(p, am_active); } + if (lock_status) + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); } + *statep = a; return enqueue; } static ERTS_INLINE void -schedule_process(Process *p, erts_aint32_t in_state) +schedule_process(Process *p, erts_aint32_t in_state, ErtsProcLocks locks) { erts_aint32_t enq_prio = -1; erts_aint32_t state = in_state; @@ -6069,7 +6119,8 @@ schedule_process(Process *p, erts_aint32_t in_state) 0, ERTS_PSFLG_ACTIVE, &state, - &enq_prio); + &enq_prio, + locks); if (enqueue != ERTS_ENQUEUE_NOT) add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), state, @@ -6077,16 +6128,27 @@ schedule_process(Process *p, erts_aint32_t in_state) } void -erts_schedule_process(Process *p, erts_aint32_t state) +erts_schedule_process(Process *p, erts_aint32_t state, ErtsProcLocks locks) { - schedule_process(p, state); + schedule_process(p, state, locks); } static void schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) { + /* + * Expects status lock to be locked when called, and + * returns with status lock unlocked... + */ erts_aint32_t a = state, n, enq_prio = -1; int enqueue; /* < 0 -> use proxy */ + unsigned int prof_runnable_procs = erts_system_profile_flags.runnable_procs; + + /* Status lock prevents out of order "runnable proc" trace msgs */ + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + + if (!prof_runnable_procs) + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); ASSERT(!(state & ERTS_PSFLG_PROXY)); @@ -6095,7 +6157,7 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) n = e = a; if (a & ERTS_PSFLG_FREE) - return; /* We don't want to schedule free processes... */ + goto cleanup; /* We don't want to schedule free processes... */ enqueue = ERTS_ENQUEUE_NOT; n |= ERTS_PSFLG_ACTIVE_SYS; @@ -6108,7 +6170,7 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) goto cleanup; } - if (erts_system_profile_flags.runnable_procs) { + if (prof_runnable_procs) { if (!(a & (ERTS_PSFLG_ACTIVE_SYS | ERTS_PSFLG_RUNNING @@ -6118,6 +6180,8 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) profile_runnable_proc(p, am_active); } + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + prof_runnable_procs = 0; } if (enqueue != ERTS_ENQUEUE_NOT) { @@ -6132,8 +6196,14 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) } cleanup: + + if (prof_runnable_procs) + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + if (proxy) free_proxy_proc(proxy); + + ERTS_SMP_LC_ASSERT(!(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p))); } static ERTS_INLINE int @@ -6200,7 +6270,7 @@ suspend_process(Process *c_p, Process *p) } static ERTS_INLINE void -resume_process(Process *p) +resume_process(Process *p, ErtsProcLocks locks) { erts_aint32_t state, enq_prio = -1; int enqueue; @@ -6217,7 +6287,8 @@ resume_process(Process *p) ERTS_PSFLG_SUSPENDED, 0, &state, - &enq_prio); + &enq_prio, + locks); if (enqueue) add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), state, @@ -7818,6 +7889,9 @@ erts_start_schedulers(void) #ifdef ETHR_HAVE_THREAD_NAMES opts.name = malloc(80); + if (!opts.name) { + ERTS_INTERNAL_ERROR("malloc failed to allocate memory!"); + } #endif #ifdef ERTS_SMP @@ -8030,7 +8104,8 @@ handle_pend_sync_suspend(Process *suspendee, } /* suspender is suspended waiting for suspendee to suspend; resume suspender */ - resume_process(suspender); + ASSERT(suspendee != suspender); + resume_process(suspender, ERTS_PROC_LOCK_STATUS); erts_smp_proc_unlock(suspender, ERTS_PROC_LOCK_STATUS); } } @@ -8065,7 +8140,7 @@ pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks, ASSERT(c_p->flags & F_P2PNR_RESCHED); c_p->flags &= ~F_P2PNR_RESCHED; if (!suspend && rp) - resume_process(rp); + resume_process(rp, rp_locks); } else { @@ -8223,7 +8298,8 @@ handle_pend_bif_sync_suspend(Process *suspendee, } /* suspender is suspended waiting for suspendee to suspend; resume suspender */ - resume_process(suspender); + ASSERT(suspender != suspendee); + resume_process(suspender, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); erts_smp_proc_unlock(suspender, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); } @@ -8583,7 +8659,8 @@ resume_process_1(BIF_ALIST_1) ASSERT(ERTS_PSFLG_SUSPENDED & erts_smp_atomic32_read_nob(&suspendee->state)); - resume_process(suspendee); + ASSERT(BIF_P != suspendee); + resume_process(suspendee, ERTS_PROC_LOCK_STATUS); erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS); } @@ -8713,7 +8790,7 @@ erts_resume(Process* process, ErtsProcLocks process_locks) ERTS_SMP_LC_ASSERT(process_locks == erts_proc_lc_my_proc_locks(process)); if (!(process_locks & ERTS_PROC_LOCK_STATUS)) erts_smp_proc_lock(process, ERTS_PROC_LOCK_STATUS); - resume_process(process); + resume_process(process, process_locks|ERTS_PROC_LOCK_STATUS); if (!(process_locks & ERTS_PROC_LOCK_STATUS)) erts_smp_proc_unlock(process, ERTS_PROC_LOCK_STATUS); } @@ -8732,7 +8809,7 @@ erts_resume_processes(ErtsProcList *list) proc = erts_pid2proc(NULL, 0, plp->pid, ERTS_PROC_LOCK_STATUS); if (proc) { if (erts_proclist_same(plp, proc)) { - resume_process(proc); + resume_process(proc, ERTS_PROC_LOCK_STATUS); nresumed++; } erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_STATUS); @@ -9147,7 +9224,7 @@ Process *schedule(Process *p, int calls) } else if (!ERTS_SCHEDULER_IS_DIRTY(esdp) && (fcalls > input_reductions && - prepare_for_sys_schedule(esdp))) { + prepare_for_sys_schedule(esdp, !0))) { /* * Schedule system-level activities. */ @@ -9155,8 +9232,6 @@ Process *schedule(Process *p, int calls) erts_smp_atomic32_set_relb(&function_calls, 0); fcalls = 0; - ASSERT(!erts_port_task_have_outstanding_io_tasks()); - #if 0 /* Not needed since we wont wait in sys schedule */ erts_sys_schedule_interrupt(0); #endif @@ -9188,7 +9263,9 @@ Process *schedule(Process *p, int calls) if (RUNQ_READ_LEN(&rq->ports.info.len)) { int have_outstanding_io; have_outstanding_io = erts_port_task_execute(rq, &esdp->current_port); - if ((have_outstanding_io && fcalls > 2*input_reductions) + if ((!erts_eager_check_io + && have_outstanding_io + && fcalls > 2*input_reductions) || rq->halt_in_progress) { /* * If we have performed more than 2*INPUT_REDUCTIONS since @@ -9968,8 +10045,10 @@ erts_internal_request_system_task_3(BIF_ALIST_3) rp_state = n; } - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); - + /* + * schedule_process_sys_task() unlocks status + * lock on process. + */ schedule_process_sys_task(rp, rp_state, NULL); if (free_stqs) @@ -10714,7 +10793,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). * Schedule process for execution. */ - schedule_process(p, state); + schedule_process(p, state, 0); VERBOSE(DEBUG_PROCESSES, ("Created a new process: %T\n",p->common.id)); @@ -11035,7 +11114,8 @@ set_proc_exiting(Process *p, ERTS_PSFLG_SUSPENDED|ERTS_PSFLG_PENDING_EXIT, ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE, &state, - &enq_prio); + &enq_prio, + ERTS_PROC_LOCKS_ALL); p->fvalue = reason; if (bp) @@ -11076,7 +11156,8 @@ set_proc_self_exiting(Process *c_p) ERTS_PSFLG_SUSPENDED|ERTS_PSFLG_PENDING_EXIT, ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE, &state, - &enq_prio); + &enq_prio, + ERTS_PROC_LOCKS_ALL); ASSERT(!enqueue); return state; @@ -11721,8 +11802,9 @@ resume_suspend_monitor(ErtsSuspendMonitor *smon, void *vc_p) Process *suspendee = erts_pid2proc((Process *) vc_p, ERTS_PROC_LOCK_MAIN, smon->pid, ERTS_PROC_LOCK_STATUS); if (suspendee) { + ASSERT(suspendee != vc_p); if (smon->active) - resume_process(suspendee); + resume_process(suspendee, ERTS_PROC_LOCK_STATUS); erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS); } erts_destroy_suspend_monitor(smon); @@ -11814,6 +11896,7 @@ erts_continue_exit_process(Process *p) struct saved_calls *scb; process_breakpoint_time_t *pbt; erts_aint32_t state; + void *nif_export; #ifdef DEBUG int yield_allowed = 1; @@ -11964,6 +12047,7 @@ erts_continue_exit_process(Process *p) : NULL); scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, ERTS_PROC_LOCKS_ALL, NULL); pbt = ERTS_PROC_SET_CALL_TIME(p, ERTS_PROC_LOCKS_ALL, NULL); + nif_export = ERTS_PROC_SET_NIF_TRAP_EXPORT(p, ERTS_PROC_LOCKS_ALL, NULL); erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL); #ifdef BM_COUNTERS @@ -12011,6 +12095,9 @@ erts_continue_exit_process(Process *p) if (pbt) erts_free(ERTS_ALC_T_BPD, (void *) pbt); + if (nif_export) + erts_destroy_nif_export(nif_export); + delete_process(p); #ifdef ERTS_SMP @@ -12055,7 +12142,7 @@ timeout_proc(Process* p) state = erts_smp_atomic32_read_acqb(&p->state); if (!(state & ERTS_PSFLG_ACTIVE)) - schedule_process(p, state); + schedule_process(p, state, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); } diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index ed6dadbffa..3d08be25ff 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -58,6 +58,7 @@ typedef struct process Process; #include "external.h" #include "erl_mseg.h" #include "erl_async.h" +#include "erl_gc.h" #ifdef HIPE #include "hipe_process.h" @@ -104,6 +105,7 @@ struct saved_calls { }; extern Export exp_send, exp_receive, exp_timeout; +extern int erts_eager_check_io; extern int erts_sched_compact_load; extern int erts_sched_balance_util; extern Uint erts_no_schedulers; @@ -488,11 +490,6 @@ typedef struct { } ErtsSchedWallTime; typedef struct { - Uint64 reclaimed; - Uint64 garbage_cols; -} ErtsGCInfo; - -typedef struct { int sched; erts_aint32_t aux_work; } ErtsDelayedAuxWorkWakeupJob; @@ -734,13 +731,9 @@ erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi) #define ERTS_PSD_DIST_ENTRY 3 #define ERTS_PSD_CALL_TIME_BP 4 #define ERTS_PSD_DELAYED_GC_TASK_QS 5 -#ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT 6 +#define ERTS_PSD_NIF_TRAP_EXPORT 6 #define ERTS_PSD_SIZE 7 -#else -#define ERTS_PSD_SIZE 6 -#endif typedef struct { void *data[ERTS_PSD_SIZE]; @@ -767,10 +760,8 @@ typedef struct { #define ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS ERTS_PROC_LOCK_MAIN #define ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS ERTS_PROC_LOCK_MAIN -#ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT_GET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT_SET_LOCKS ERTS_PROC_LOCK_MAIN -#endif +#define ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS ERTS_PROC_LOCK_MAIN typedef struct { ErtsProcLocks get_locks; @@ -1367,6 +1358,9 @@ Uint64 erts_get_proc_interval(void); Uint64 erts_ensure_later_proc_interval(Uint64); Uint64 erts_step_proc_interval(void); +int erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj); /* see erl_nif.c */ +void erts_destroy_nif_export(void *); /* see erl_nif.c */ + ErtsProcList *erts_proclist_create(Process *); void erts_proclist_destroy(ErtsProcList *); @@ -1704,17 +1698,17 @@ ErtsSchedulerData *erts_get_scheduler_data(void) #endif #endif -void erts_schedule_process(Process *, erts_aint32_t); +void erts_schedule_process(Process *, erts_aint32_t, ErtsProcLocks); -ERTS_GLB_INLINE void erts_proc_notify_new_message(Process *p); +ERTS_GLB_INLINE void erts_proc_notify_new_message(Process *p, ErtsProcLocks locks); #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void -erts_proc_notify_new_message(Process *p) +erts_proc_notify_new_message(Process *p, ErtsProcLocks locks) { /* No barrier needed, due to msg lock */ erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state); if (!(state & ERTS_PSFLG_ACTIVE)) - erts_schedule_process(p, state); + erts_schedule_process(p, state, locks); } #endif @@ -1817,12 +1811,10 @@ erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data) #define ERTS_PROC_SET_DELAYED_GC_TASK_QS(P, L, PBT) \ ((ErtsProcSysTaskQs *) erts_psd_set((P), (L), ERTS_PSD_DELAYED_GC_TASK_QS, (void *) (PBT))) -#ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(P) \ - ((Export *) erts_psd_get((P), ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT)) -#define ERTS_PROC_SET_DIRTY_SCHED_TRAP_EXPORT(P, L, DSTE) \ - ((Export *) erts_psd_set((P), (L), ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT, (void *) (DSTE))) -#endif +#define ERTS_PROC_GET_NIF_TRAP_EXPORT(P) \ + erts_psd_get((P), ERTS_PSD_NIF_TRAP_EXPORT) +#define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, L, NTE) \ + erts_psd_set((P), (L), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (NTE)) ERTS_GLB_INLINE Eterm erts_proc_get_error_handler(Process *p); diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c index 23e5bf737f..3ce707efda 100644 --- a/erts/emulator/beam/erl_process_dict.c +++ b/erts/emulator/beam/erl_process_dict.c @@ -82,6 +82,7 @@ static void pd_hash_erase(Process *p, Eterm id, Eterm *ret); static void pd_hash_erase_all(Process *p); static Eterm pd_hash_get_keys(Process *p, Eterm value); +static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd); static Eterm pd_hash_get_all(Process *p, ProcDict *pd); static Eterm pd_hash_put(Process *p, Eterm id, Eterm value); @@ -275,6 +276,16 @@ BIF_RETTYPE get_1(BIF_ALIST_1) BIF_RET(ret); } +BIF_RETTYPE get_keys_0(BIF_ALIST_0) +{ + Eterm ret; + + PD_CHECK(BIF_P->dictionary); + ret = pd_hash_get_all_keys(BIF_P,BIF_P->dictionary); + PD_CHECK(BIF_P->dictionary); + BIF_RET(ret); +} + BIF_RETTYPE get_keys_1(BIF_ALIST_1) { Eterm ret; @@ -412,6 +423,47 @@ Eterm erts_pd_hash_get(Process *p, Eterm id) return am_undefined; } +#define PD_GET_TKEY(Dst,Src) \ +do { \ + ASSERT(is_tuple((Src))); \ + ASSERT(arityval(*((Eterm*)tuple_val((Src)))) == 2); \ + (Dst) = ((Eterm*)tuple_val((Src)))[1]; \ +} while(0) + +static Eterm pd_hash_get_all_keys(Process *p, ProcDict *pd) { + Eterm* hp; + Eterm res = NIL; + Eterm tmp, tmp2; + unsigned int i; + unsigned int num; + + if (pd == NULL) { + return res; + } + + num = HASH_RANGE(pd); + hp = HAlloc(p, pd->numElements * 2); + + for (i = 0; i < num; ++i) { + tmp = ARRAY_GET(pd, i); + if (is_boxed(tmp)) { + PD_GET_TKEY(tmp,tmp); + res = CONS(hp, tmp, res); + hp += 2; + } else if (is_list(tmp)) { + while (tmp != NIL) { + tmp2 = TCAR(tmp); + PD_GET_TKEY(tmp2,tmp2); + res = CONS(hp, tmp2, res); + hp += 2; + tmp = TCDR(tmp); + } + } + } + return res; +} +#undef PD_GET_TKEY + static Eterm pd_hash_get_keys(Process *p, Eterm value) { Eterm *hp; diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index b7de8208ad..78d98229d8 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -20,8 +20,6 @@ #ifndef __ERL_VM_H__ #define __ERL_VM_H__ -/* #define ERTS_OPCODE_COUNTER_SUPPORT */ - /* FORCE_HEAP_FRAGS: * Debug provocation to make HAlloc always create heap fragments (if allowed) * even if there is room on heap. diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 8d240355b0..48e717bb6f 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -36,7 +36,9 @@ #include "erl_process.h" #include "error.h" #include "external.h" +#define ERL_WANT_HIPE_BIF_WRAPPER__ #include "bif.h" +#undef ERL_WANT_HIPE_BIF_WRAPPER__ #include "big.h" #include "dist.h" #include "erl_binary.h" @@ -1899,8 +1901,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla } 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 */ @@ -1961,8 +1961,6 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla 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; @@ -3385,8 +3383,6 @@ dec_term_atom_common: } else { Binary* dbin = erts_bin_nrml_alloc(n); ProcBin* pb; - dbin->flags = 0; - dbin->orig_size = n; erts_refc_init(&dbin->refc, 1); pb = (ProcBin *) hp; hp += PROC_BIN_SIZE; @@ -3439,8 +3435,6 @@ dec_term_atom_common: Binary* dbin = erts_bin_nrml_alloc(n); ProcBin* pb; - dbin->flags = 0; - dbin->orig_size = n; erts_refc_init(&dbin->refc, 1); pb = (ProcBin *) hp; pb->thing_word = HEADER_PROC_BIN; diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 891046a8b5..da9f029a9f 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -41,6 +41,7 @@ #include "error.h" #include "erl_utils.h" #include "erl_port.h" +#include "erl_gc.h" struct enif_environment_t /* ErlNifEnv */ { @@ -809,23 +810,6 @@ void MD5Init(MD5_CTX *); void MD5Update(MD5_CTX *, unsigned char *, unsigned int); void MD5Final(unsigned char [16], MD5_CTX *); -/* ggc.c */ - -void erts_gc_info(ErtsGCInfo *gcip); -void erts_init_gc(void); -int erts_garbage_collect(Process*, int, Eterm*, int); -void erts_garbage_collect_hibernate(Process* p); -Eterm erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity); -void erts_garbage_collect_literals(Process* p, Eterm* literals, - Uint lit_size, - struct erl_off_heap_header* oh); -Uint erts_next_heap_size(Uint, Uint); -Eterm erts_heap_sizes(Process* p); - -void erts_offset_off_heap(ErlOffHeap *, Sint, Eterm*, Eterm*); -void erts_offset_heap_ptr(Eterm*, Uint, Sint, Eterm*, Eterm*); -void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*); -void erts_free_heap_frags(Process* p); /* io.c */ diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index d028737664..4d262ff022 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1218,9 +1218,10 @@ typedef struct { static ERTS_INLINE ErtsTryImmDrvCallResult try_imm_drv_call(ErtsTryImmDrvCallState *sp) { + unsigned int prof_runnable_ports; ErtsTryImmDrvCallResult res; int reds_left_in; - erts_aint32_t invalid_state, invalid_sched_flags; + erts_aint32_t act, exp, invalid_state, invalid_sched_flags; Port *prt = sp->port; Process *c_p = sp->c_p; @@ -1247,18 +1248,39 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp) goto locked_fail; } - sp->sched_flags = erts_smp_atomic32_read_nob(&prt->sched.flags); - if (sp->sched_flags & invalid_sched_flags) { - res = ERTS_TRY_IMM_DRV_CALL_INVALID_SCHED_FLAGS; - goto locked_fail; - } + prof_runnable_ports = erts_system_profile_flags.runnable_ports; + if (prof_runnable_ports) + erts_port_task_sched_lock(&prt->sched); + + act = erts_smp_atomic32_read_nob(&prt->sched.flags); + do { + erts_aint32_t new; + + if (act & invalid_sched_flags) { + res = ERTS_TRY_IMM_DRV_CALL_INVALID_SCHED_FLAGS; + sp->sched_flags = act; + goto locked_fail; + } + exp = act; + new = act | ERTS_PTS_FLG_EXEC_IMM; + act = erts_smp_atomic32_cmpxchg_mb(&prt->sched.flags, new, exp); + } while (act != exp); + + sp->sched_flags = act; if (!c_p) reds_left_in = CONTEXT_REDS/10; else { if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) trace_virtual_sched(c_p, am_out); + /* + * No status lock held while sending runnable + * proc trace messages. It is however not needed + * in this case, since only this thread can send + * such messages for this process until the process + * has been scheduled out. + */ if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) profile_runnable_proc(c_p, am_inactive); @@ -1273,11 +1295,14 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp) ERTS_SMP_CHK_NO_PROC_LOCKS; - if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) - trace_sched_ports_where(prt, am_in, sp->port_op); - if (erts_system_profile_flags.runnable_ports - && !erts_port_is_scheduled(prt)) - profile_runnable_port(prt, am_active); + if (prof_runnable_ports | IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) { + if (prof_runnable_ports && !(act & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC))) + profile_runnable_port(prt, am_active); + if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) + trace_sched_ports_where(prt, am_in, sp->port_op); + if (prof_runnable_ports) + erts_port_task_sched_unlock(&prt->sched); + } sp->fpe_was_unmasked = erts_block_fpe(); @@ -1294,17 +1319,31 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) int reds; Port *prt = sp->port; Process *c_p = sp->c_p; + erts_aint32_t act; + unsigned int prof_runnable_ports; reds = prt->reds; reds += erts_port_driver_callback_epilogue(prt, NULL); erts_unblock_fpe(sp->fpe_was_unmasked); - if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) - trace_sched_ports_where(prt, am_out, sp->port_op); - if (erts_system_profile_flags.runnable_ports - && !erts_port_is_scheduled(prt)) - profile_runnable_port(prt, am_inactive); + prof_runnable_ports = erts_system_profile_flags.runnable_ports; + if (prof_runnable_ports) + erts_port_task_sched_lock(&prt->sched); + + act = erts_smp_atomic32_read_band_mb(&prt->sched.flags, + ~ERTS_PTS_FLG_EXEC_IMM); + ERTS_SMP_LC_ASSERT(act & ERTS_PTS_FLG_EXEC_IMM); + + if (prof_runnable_ports | IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) { + if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) + trace_sched_ports_where(prt, am_out, sp->port_op); + if (prof_runnable_ports) { + if (!(act & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC))) + profile_runnable_port(prt, am_inactive); + erts_port_task_sched_unlock(&prt->sched); + } + } erts_port_release(prt); @@ -1319,6 +1358,13 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) trace_virtual_sched(c_p, am_in); + /* + * No status lock held while sending runnable + * proc trace messages. It is however not needed + * in this case, since only this thread can send + * such messages for this process until the process + * has been scheduled out. + */ if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) profile_runnable_proc(c_p, am_active); @@ -3107,8 +3153,6 @@ static void deliver_read_message(Port* prt, erts_aint32_t state, Eterm to, Binary* bptr; bptr = erts_bin_nrml_alloc(len); - bptr->flags = 0; - bptr->orig_size = len; erts_refc_init(&bptr->refc, 1); sys_memcpy(bptr->orig_bytes, buf, len); @@ -5460,8 +5504,6 @@ driver_deliver_term(Eterm to, ErlDrvTermData* data, int len) ProcBin* pbp; Binary* bp = erts_bin_nrml_alloc(size); ASSERT(bufp); - bp->flags = 0; - bp->orig_size = (SWord) size; erts_refc_init(&bp->refc, 1); sys_memcpy((void *) bp->orig_bytes, (void *) bufp, size); pbp = (ProcBin *) hp; @@ -5953,9 +5995,7 @@ driver_alloc_binary(ErlDrvSizeT size) bin = erts_bin_drv_alloc_fnf((Uint) size); if (!bin) return NULL; /* The driver write must take action */ - bin->flags = BIN_FLAG_DRV; erts_refc_init(&bin->refc, 1); - bin->orig_size = (SWord) size; return Binary2ErlDrvBinary(bin); } @@ -5985,7 +6025,6 @@ ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, ErlDrvSizeT size) if (!newbin) return NULL; - newbin->orig_size = size; return Binary2ErlDrvBinary(newbin); } @@ -7166,7 +7205,7 @@ char *driver_dl_error(void) #define ERL_DRV_SYS_INFO_SIZE(LAST_FIELD) \ - (((size_t) &((ErlDrvSysInfo *) 0)->LAST_FIELD) \ + (offsetof(ErlDrvSysInfo, LAST_FIELD) \ + sizeof(((ErlDrvSysInfo *) 0)->LAST_FIELD)) void @@ -7228,6 +7267,18 @@ driver_system_info(ErlDrvSysInfo *sip, size_t si_size) sip->nif_major_version = ERL_NIF_MAJOR_VERSION; sip->nif_minor_version = ERL_NIF_MINOR_VERSION; } + /* + * 'dirty_scheduler_support' is the last field in the 4th version + * (driver version 3.1, NIF version 2.7) + */ + if (si_size >= ERL_DRV_SYS_INFO_SIZE(dirty_scheduler_support)) { +#if defined(ERL_NIF_DIRTY_SCHEDULER_SUPPORT) && defined(USE_THREADS) + sip->dirty_scheduler_support = 1; +#else + sip->dirty_scheduler_support = 0; +#endif + } + } diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 3d8dd9c6d0..c29d4b3777 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -66,8 +66,12 @@ */ #ifndef ERTS_SYS_FD_TYPE +#define ERTS_SYS_FD_INVALID ((ErtsSysFdType) -1) typedef int ErtsSysFdType; #else +#ifndef ERTS_SYS_FD_INVALID +# error missing ERTS_SYS_FD_INVALID +#endif typedef ERTS_SYS_FD_TYPE ErtsSysFdType; #endif @@ -501,7 +505,7 @@ extern volatile int erts_writing_erl_crash_dump; # define NO_ERF # define NO_ERFC /* This definition doesn't take NaN into account, but matherr() gets those */ -# define finite(x) (fabs(x) != HUGE_VAL) +# define isfinite(x) (fabs(x) != HUGE_VAL) # define USE_MATHERR # define HAVE_FINITE #endif @@ -744,6 +748,14 @@ void init_getenv_state(GETENV_STATE *); char * getenv_string(GETENV_STATE *); void fini_getenv_state(GETENV_STATE *); +#define HAVE_ERTS_CHECK_IO_DEBUG +typedef struct { + int no_used_fds; + int no_driver_select_structs; + int no_driver_event_structs; +} ErtsCheckIoDebugInfo; +int erts_check_io_debug(ErtsCheckIoDebugInfo *ip); + /* xxxP */ #define SYS_DEFAULT_FLOAT_DECIMALS 20 void init_sys_float(void); diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 72092ec7b0..9b3ee5cc65 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -48,6 +48,10 @@ #include "erl_sched_spec_pre_alloc.h" #include "beam_bp.h" #include "erl_ptab.h" +#include "erl_check_io.h" +#ifdef HIPE +# include "hipe_mode_switch.h" +#endif #undef M_TRIM_THRESHOLD #undef M_TOP_PAD @@ -3948,6 +3952,9 @@ erts_save_emu_args(int argc, char **argv) size += sz+1; } ptr = (char *) malloc(size); + if (!ptr) { + ERTS_INTERNAL_ERROR("malloc failed to allocate memory!"); + } #ifdef DEBUG end_ptr = ptr + size; #endif diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 09d90f4984..891589d1c5 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -5778,7 +5778,7 @@ done: ia_p->Ipv6IfIndex && ia_p->Ipv6IfIndex != index) { - /* Oops, there was an other interface for IPv6. Possible? XXX */ + /* Oops, there was another interface for IPv6. Possible? XXX */ index = ia_p->Ipv6IfIndex; goto index; } diff --git a/erts/emulator/drivers/unix/multi_drv.c b/erts/emulator/drivers/unix/multi_drv.c index 822c96730c..724d325ed5 100644 --- a/erts/emulator/drivers/unix/multi_drv.c +++ b/erts/emulator/drivers/unix/multi_drv.c @@ -20,7 +20,7 @@ /* Purpose: Multidriver interface This is an example of a driver which allows multiple instances of itself. I.e have one erlang process execute open_port(multi......) and - at the same time have an other erlang process open an other port + at the same time have another erlang process open another port running multi there as well. */ diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c index 491e0a090e..be2fee1f25 100644 --- a/erts/emulator/drivers/unix/ttsl_drv.c +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -32,6 +32,10 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*); #ifdef HAVE_TERMCAP /* else make an empty driver that can not be opened */ +#ifndef WANT_NONBLOCKING +#define WANT_NONBLOCKING +#endif + #include "sys.h" #include <ctype.h> #include <stdlib.h> @@ -39,6 +43,7 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*); #include <string.h> #include <signal.h> #include <fcntl.h> +#include <limits.h> #include <locale.h> #include <unistd.h> #include <termios.h> @@ -57,6 +62,14 @@ static ErlDrvData ttysl_start(ErlDrvPort, char*); #include <langinfo.h> #endif +#if defined IOV_MAX +#define MAXIOV IOV_MAX +#elif defined UIO_MAXIOV +#define MAXIOV UIO_MAXIOV +#else +#define MAXIOV 16 +#endif + #define TRUE 1 #define FALSE 0 @@ -80,12 +93,15 @@ static volatile int cols_needs_update = FALSE; #define OP_INSC 2 #define OP_DELC 3 #define OP_BEEP 4 +#define OP_PUTC_SYNC 5 /* Control op */ #define CTRL_OP_GET_WINSIZE 100 #define CTRL_OP_GET_UNICODE_STATE 101 #define CTRL_OP_SET_UNICODE_STATE 102 - +/* We use 1024 as the buf size as that was the default buf size of FILE streams + on all platforms that I checked. */ +#define TTY_BUFFSIZE 1024 static int lbuf_size = BUFSIZ; static Uint32 *lbuf; /* The current line buffer */ @@ -113,13 +129,19 @@ static int lpos; /* The current "cursor position" in the line buf /* Main interface functions. */ static void ttysl_stop(ErlDrvData); static void ttysl_from_erlang(ErlDrvData, char*, ErlDrvSizeT); +static void ttysl_to_tty(ErlDrvData, ErlDrvEvent); +static void ttysl_flush_tty(ErlDrvData); static void ttysl_from_tty(ErlDrvData, ErlDrvEvent); static void ttysl_stop_select(ErlDrvEvent, void*); static Sint16 get_sint16(char*); static ErlDrvPort ttysl_port; static int ttysl_fd; -static FILE *ttysl_out; +static int ttysl_terminate = 0; +static int ttysl_send_ok = 0; +static ErlDrvBinary *putcbuf; +static int putcpos; +static int putclen; /* Functions that work on the line buffer. */ static int start_lbuf(void); @@ -201,22 +223,22 @@ struct erl_drv_entry ttsl_driver_entry = { IF_IMPL(ttysl_stop), IF_IMPL(ttysl_from_erlang), IF_IMPL(ttysl_from_tty), - NULL, - "tty_sl", - NULL, - NULL, + IF_IMPL(ttysl_to_tty), + "tty_sl", /* driver_name */ + NULL, /* finish */ + NULL, /* handle */ IF_IMPL(ttysl_control), NULL, /* timeout */ NULL, /* outputv */ NULL, /* ready_async */ - NULL, /* flush */ + IF_IMPL(ttysl_flush_tty), NULL, /* call */ NULL, /* event */ ERL_DRV_EXTENDED_MARKER, ERL_DRV_EXTENDED_MAJOR_VERSION, ERL_DRV_EXTENDED_MINOR_VERSION, 0, /* ERL_DRV_FLAGs */ - NULL, + NULL, /* handle2 */ NULL, /* process_exit */ IF_IMPL(ttysl_stop_select) }; @@ -296,8 +318,7 @@ static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) return ERL_DRV_ERROR_GENERAL; } - /* Open the terminal and set the terminal */ - ttysl_out = fdopen(ttysl_fd, "w"); + SET_NONBLOCKING(ttysl_fd); #ifdef PRIMITIVE_UTF8_CHECK setlocale(LC_CTYPE, ""); /* Set international environment, @@ -400,12 +421,14 @@ static void ttysl_stop(ErlDrvData ttysl_data) stop_lbuf(); stop_termcap(); tty_reset(ttysl_fd); - driver_select(ttysl_port, (ErlDrvEvent)(UWord)ttysl_fd, ERL_DRV_READ|ERL_DRV_USE, 0); + driver_select(ttysl_port, (ErlDrvEvent)(UWord)ttysl_fd, + ERL_DRV_WRITE|ERL_DRV_READ|ERL_DRV_USE, 0); sys_sigset(SIGCONT, SIG_DFL); sys_sigset(SIGWINCH, SIG_DFL); } ttysl_port = (ErlDrvPort)-1; ttysl_fd = -1; + ttysl_terminate = 0; /* return TRUE; */ } @@ -650,10 +673,26 @@ static int check_buf_size(byte *s, int n) static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT count) { + ErlDrvSizeT sz; + + sz = driver_sizeq(ttysl_port); + + putclen = count > TTY_BUFFSIZE ? TTY_BUFFSIZE : count; + putcbuf = driver_alloc_binary(putclen); + putcpos = 0; + if (lpos > MAXSIZE) put_chars((byte*)"\n", 1); switch (buf[0]) { + case OP_PUTC_SYNC: + /* Using sync means that we have to send an ok to the + controlling process for each command call. We delay + sending ok if the driver queue exceeds a certain size. + We do not set ourselves as a busy port, as this + could be very bad for user_drv, if it gets blocked on + the port_command. */ + /* fall through */ case OP_PUTC: DEBUGLOG(("OP: Putc(%lu)",(unsigned long) count-1)); if (check_buf_size((byte*)buf+1, count-1) == 0) @@ -678,10 +717,104 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun /* Unknown op, just ignore. */ break; } - fflush(ttysl_out); + + driver_enq_bin(ttysl_port,putcbuf,0,putcpos); + + if (sz == 0) { + for (;;) { + int written, qlen; + SysIOVec *iov; + + iov = driver_peekq(ttysl_port,&qlen); + if (iov) + written = writev(ttysl_fd, iov, qlen > MAXIOV ? MAXIOV : qlen); + else + written = 0; + if (written < 0) { + if (errno == EAGAIN) { + driver_select(ttysl_port,(ErlDrvEvent)(long)ttysl_fd, + ERL_DRV_USE|ERL_DRV_WRITE,1); + break; + } else { + /* we ignore all other errors */ + break; + } + } else { + if (driver_deq(ttysl_port, written) == 0) + break; + } + } + } + + if (buf[0] == OP_PUTC_SYNC) { + if (driver_sizeq(ttysl_port) > TTY_BUFFSIZE && !ttysl_terminate) { + /* We delay sending the ack until the buffer has been consumed */ + ttysl_send_ok = 1; + } else { + ErlDrvTermData spec[] = { + ERL_DRV_PORT, driver_mk_port(ttysl_port), + ERL_DRV_ATOM, driver_mk_atom("ok"), + ERL_DRV_TUPLE, 2 + }; + ASSERT(ttysl_send_ok == 0); + erl_drv_output_term(driver_mk_port(ttysl_port), spec, + sizeof(spec) / sizeof(spec[0])); + } + } + return; /* TRUE; */ } +static void ttysl_to_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) { + for (;;) { + int written, qlen; + SysIOVec *iov; + ErlDrvSizeT sz; + + iov = driver_peekq(ttysl_port,&qlen); + if (iov) + written = writev(ttysl_fd, iov, qlen > MAXIOV ? MAXIOV : qlen); + else + written = 0; + if (written < 0) { + if (errno == EAGAIN) { + break; + } else { + /* we ignore all other errors */ + } + } else { + sz = driver_deq(ttysl_port, written); + if (sz < TTY_BUFFSIZE && ttysl_send_ok) { + ErlDrvTermData spec[] = { + ERL_DRV_PORT, driver_mk_port(ttysl_port), + ERL_DRV_ATOM, driver_mk_atom("ok"), + ERL_DRV_TUPLE, 2 + }; + ttysl_send_ok = 0; + erl_drv_output_term(driver_mk_port(ttysl_port), spec, + sizeof(spec) / sizeof(spec[0])); + } + if (sz == 0) { + driver_select(ttysl_port,(ErlDrvEvent)(long)ttysl_fd, + ERL_DRV_WRITE,0); + if (ttysl_terminate) + /* flush has been called, which means we should terminate + when queue is empty. This will not send any exit + message */ + driver_failure_atom(ttysl_port, "normal"); + break; + } + } + } + + return; +} + +static void ttysl_flush_tty(ErlDrvData ttysl_data) { + ttysl_terminate = 1; + return; +} + static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) { byte b[1024]; @@ -1070,7 +1203,14 @@ static int write_buf(Uint32 *s, int n) /* The basic procedure for outputting one character. */ static int outc(int c) { - return (int)putc(c, ttysl_out); + putcbuf->orig_bytes[putcpos++] = c; + if (putcpos == putclen) { + driver_enq_bin(ttysl_port,putcbuf,0,putclen); + putcpos = 0; + putclen = TTY_BUFFSIZE; + putcbuf = driver_alloc_binary(BUFSIZ); + } + return 1; } static int move_cursor(int from, int to) diff --git a/erts/emulator/drivers/win32/ttsl_drv.c b/erts/emulator/drivers/win32/ttsl_drv.c index 502cb58dfa..851c336a11 100644 --- a/erts/emulator/drivers/win32/ttsl_drv.c +++ b/erts/emulator/drivers/win32/ttsl_drv.c @@ -46,6 +46,7 @@ static int rows; /* Number of rows available. */ #define OP_INSC 2 #define OP_DELC 3 #define OP_BEEP 4 +#define OP_PUTC_SYNC 5 /* Control op */ #define CTRL_OP_GET_WINSIZE 100 @@ -458,6 +459,7 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun switch (buf[0]) { case OP_PUTC: + case OP_PUTC_SYNC: DEBUGLOG(("OP: Putc(%I64u)",(unsigned long long)count-1)); if (check_buf_size((byte*)buf+1, count-1) == 0) return; @@ -481,6 +483,20 @@ static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, ErlDrvSizeT coun /* Unknown op, just ignore. */ break; } + + if (buf[0] == OP_PUTC_SYNC) { + /* On windows we do a blocking write to the tty so we just + send the ack immidiately. If at some point in the future + someone has a problem with tty output being blocking + this has to be changed. */ + ErlDrvTermData spec[] = { + ERL_DRV_PORT, driver_mk_port(ttysl_port), + ERL_DRV_ATOM, driver_mk_atom("ok"), + ERL_DRV_TUPLE, 2 + }; + erl_drv_output_term(driver_mk_port(ttysl_port), spec, + sizeof(spec) / sizeof(spec[0])); + } return; } diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c index a321bb9641..7e4043fc1b 100644 --- a/erts/emulator/drivers/win32/win_efile.c +++ b/erts/emulator/drivers/win32/win_efile.c @@ -1288,6 +1288,10 @@ do_fileinfo(Efile_call_state* state, Efile_info* pInfo, { HANDLE handle; /* Handle returned by CreateFile() */ BY_HANDLE_FILE_INFORMATION fileInfo; /* from CreateFile() */ + + /* We initialise nNumberOfLinks as GetFileInformationByHandle + does not always initialise this field */ + fileInfo.nNumberOfLinks = 1; if (handle = CreateFileW(name, GENERIC_READ, FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, 0, NULL)) { GetFileInformationByHandle(handle, &fileInfo); diff --git a/erts/emulator/hipe/hipe_amd64.c b/erts/emulator/hipe/hipe_amd64.c index b5dff06987..16c597e7b4 100644 --- a/erts/emulator/hipe/hipe_amd64.c +++ b/erts/emulator/hipe/hipe_amd64.c @@ -224,18 +224,19 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process * return alloc_code(nrbytes); } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) + +/* Make stub for native code calling exported beam function. +*/ +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { /* * This creates a native code stub with the following contents: * - * movq $Address, P_BEAM_IP(%ebp) %% Actually two movl + * movq $Address, P_CALLEE_EXP(%ebp) %% Actually two movl * movb $Arity, P_ARITY(%ebp) * jmp callemu * - * The stub has variable size, depending on whether the P_BEAM_IP + * The stub has variable size, depending on whether the P_CALLEE_EXP * and P_ARITY offsets fit in 8-bit signed displacements or not. * The rel32 offset in the final jmp depends on its actual location, * which also depends on the size of the previous instructions. @@ -248,49 +249,49 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) codeSize = /* 23, 26, 29, or 32 bytes */ 23 + /* 23 when all offsets are 8-bit */ - (P_BEAM_IP >= 128 ? 3 : 0) + - ((P_BEAM_IP + 4) >= 128 ? 3 : 0) + + (P_CALLEE_EXP >= 128 ? 3 : 0) + + ((P_CALLEE_EXP + 4) >= 128 ? 3 : 0) + (P_ARITY >= 128 ? 3 : 0); codep = code = alloc_code(codeSize); - /* movl $beamAddress, P_BEAM_IP(%ebp); 3 or 6 bytes, plus 4 */ + /* movl $callee_exp, P_CALLEE_EXP(%ebp); 3 or 6 bytes, plus 4 */ codep[0] = 0xc7; -#if P_BEAM_IP >= 128 +#if P_CALLEE_EXP >= 128 codep[1] = 0x85; /* disp32[EBP] */ - codep[2] = P_BEAM_IP & 0xFF; - codep[3] = (P_BEAM_IP >> 8) & 0xFF; - codep[4] = (P_BEAM_IP >> 16) & 0xFF; - codep[5] = (P_BEAM_IP >> 24) & 0xFF; + codep[2] = P_CALLEE_EXP & 0xFF; + codep[3] = (P_CALLEE_EXP >> 8) & 0xFF; + codep[4] = (P_CALLEE_EXP >> 16) & 0xFF; + codep[5] = (P_CALLEE_EXP >> 24) & 0xFF; codep += 6; #else codep[1] = 0x45; /* disp8[EBP] */ - codep[2] = P_BEAM_IP; + codep[2] = P_CALLEE_EXP; codep += 3; #endif - codep[0] = ((unsigned long)beamAddress ) & 0xFF; - codep[1] = ((unsigned long)beamAddress >> 8) & 0xFF; - codep[2] = ((unsigned long)beamAddress >> 16) & 0xFF; - codep[3] = ((unsigned long)beamAddress >> 24) & 0xFF; + codep[0] = ((unsigned long)callee_exp ) & 0xFF; + codep[1] = ((unsigned long)callee_exp >> 8) & 0xFF; + codep[2] = ((unsigned long)callee_exp >> 16) & 0xFF; + codep[3] = ((unsigned long)callee_exp >> 24) & 0xFF; codep += 4; - /* movl (shl 32 $beamAddress), P_BEAM_IP+4(%ebp); 3 or 6 bytes, plus 4 */ + /* movl (shl 32 $callee_exp), P_CALLEE_EXP+4(%ebp); 3 or 6 bytes, plus 4 */ codep[0] = 0xc7; -#if P_BEAM_IP+4 >= 128 +#if P_CALLEE_EXP+4 >= 128 codep[1] = 0x85; /* disp32[EBP] */ - codep[2] = (P_BEAM_IP+4) & 0xFF; - codep[3] = ((P_BEAM_IP+4) >> 8) & 0xFF; - codep[4] = ((P_BEAM_IP+4) >> 16) & 0xFF; - codep[5] = ((P_BEAM_IP+4) >> 24) & 0xFF; + codep[2] = (P_CALLEE_EXP+4) & 0xFF; + codep[3] = ((P_CALLEE_EXP+4) >> 8) & 0xFF; + codep[4] = ((P_CALLEE_EXP+4) >> 16) & 0xFF; + codep[5] = ((P_CALLEE_EXP+4) >> 24) & 0xFF; codep += 6; #else codep[1] = 0x45; /* disp8[EBP] */ - codep[2] = (P_BEAM_IP+4); + codep[2] = (P_CALLEE_EXP+4); codep += 3; #endif - codep[0] = ((unsigned long)beamAddress >> 32) & 0xFF; - codep[1] = ((unsigned long)beamAddress >> 40) & 0xFF; - codep[2] = ((unsigned long)beamAddress >> 48) & 0xFF; - codep[3] = ((unsigned long)beamAddress >> 56) & 0xFF; + codep[0] = ((unsigned long)callee_exp >> 32) & 0xFF; + codep[1] = ((unsigned long)callee_exp >> 40) & 0xFF; + codep[2] = ((unsigned long)callee_exp >> 48) & 0xFF; + codep[3] = ((unsigned long)callee_exp >> 56) & 0xFF; codep += 4; /* movb $beamArity, P_ARITY(%ebp); 3 or 6 bytes */ diff --git a/erts/emulator/hipe/hipe_amd64_asm.m4 b/erts/emulator/hipe/hipe_amd64_asm.m4 index 7c81040b8b..b4b3c073ab 100644 --- a/erts/emulator/hipe/hipe_amd64_asm.m4 +++ b/erts/emulator/hipe/hipe_amd64_asm.m4 @@ -33,7 +33,35 @@ define(HEAP_LIMIT_IN_REGISTER,0)dnl global for HL define(SIMULATE_NSP,0)dnl change to 1 to simulate call/ret insns `#define AMD64_LEAF_WORDS 'LEAF_WORDS -`#define LEAF_WORDS 'LEAF_WORDS +`#define LEAF_WORDS 'LEAF_WORDS +`#define AMD64_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + +`#define AMD64_HP_IN_REGISTER 'HP_IN_REGISTER +`#if AMD64_HP_IN_REGISTER' +`#define AMD64_HEAP_POINTER 15' +define(HP,%r15)dnl Only change this together with above +`#endif' + +`#define AMD64_FCALLS_IN_REGISTER 'FCALLS_IN_REGISTER +`#if AMD64_FCALLS_IN_REGISTER' +`#define AMD64_FCALLS_REGISTER 11' +define(FCALLS,%r11)dnl This goes together with line above +`#endif' + +`#define AMD64_HEAP_LIMIT_IN_REGISTER 'HEAP_LIMIT_IN_REGISTER +`#if AMD64_HEAP_LIMIT_IN_REGISTER' +`#define AMD64_HEAP_LIMIT_REGISTER 12' +define(HEAP_LIMIT,%r12)dnl Change this together with line above +`#endif' + +`#define AMD64_SIMULATE_NSP 'SIMULATE_NSP + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ /* * Workarounds for Darwin. @@ -63,33 +91,24 @@ ifelse(OPSYS,darwin,`` */ `#define P %rbp' -`#define AMD64_HP_IN_REGISTER 'HP_IN_REGISTER `#if AMD64_HP_IN_REGISTER -#define AMD64_HEAP_POINTER 15' -define(HP,%r15)dnl Only change this together with above -`#define SAVE_HP movq 'HP`, P_HP(P) +#define SAVE_HP movq 'HP`, P_HP(P) #define RESTORE_HP movq P_HP(P), 'HP` #else #define SAVE_HP /*empty*/ #define RESTORE_HP /*empty*/ #endif' -`#define AMD64_FCALLS_IN_REGISTER 'FCALLS_IN_REGISTER `#if AMD64_FCALLS_IN_REGISTER -#define AMD64_FCALLS_REGISTER 11' -define(FCALLS,%r11)dnl This goes together with line above -`#define SAVE_FCALLS movq 'FCALLS`, P_FCALLS(P) +#define SAVE_FCALLS movq 'FCALLS`, P_FCALLS(P) #define RESTORE_FCALLS movq P_FCALLS(P), 'FCALLS` #else #define SAVE_FCALLS /*empty*/ #define RESTORE_FCALLS /*empty*/ #endif' -`#define AMD64_HEAP_LIMIT_IN_REGISTER 'HEAP_LIMIT_IN_REGISTER `#if AMD64_HEAP_LIMIT_IN_REGISTER -#define AMD64_HEAP_LIMIT_REGISTER 12' -define(HEAP_LIMIT,%r12)dnl Change this together with line above -`#define RESTORE_HEAP_LIMIT movq P_HP_LIMIT(P), 'HEAP_LIMIT` +#define RESTORE_HEAP_LIMIT movq P_HP_LIMIT(P), 'HEAP_LIMIT` #else #define RESTORE_HEAP_LIMIT /*empty*/ #endif' @@ -99,7 +118,6 @@ define(NSP,%rsp)dnl `#define SAVE_CSP movq %rsp, P_CSP(P) #define RESTORE_CSP movq P_CSP(P), %rsp' -`#define AMD64_SIMULATE_NSP 'SIMULATE_NSP /* * Context switching macros. @@ -132,8 +150,6 @@ define(NSP,%rsp)dnl /* * Argument (parameter) registers. */ -`#define AMD64_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS define(defarg,`define(ARG$1,`$2')dnl #`define ARG'$1 $2' @@ -263,4 +279,6 @@ define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl `/* #define NBIF_RET_3 'NBIF_RET(3)` */' `/* #define NBIF_RET_5 'NBIF_RET(5)` */' +`#endif /* ASM */' + `#endif /* HIPE_AMD64_ASM_H */' diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4 index 0de69a617f..7a4bb30447 100644 --- a/erts/emulator/hipe/hipe_amd64_bifs.m4 +++ b/erts/emulator/hipe/hipe_amd64_bifs.m4 @@ -18,7 +18,7 @@ changecom(`/*', `*/')dnl * %CopyrightEnd% */ - +#`define ASM' include(`hipe/hipe_amd64_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" @@ -39,7 +39,10 @@ define(HANDLE_GOT_MBUF,` jmp 2b') `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) -# define CALL_BIF(F) movq $CSYM(F), P_BIF_CALLEE(P); call CSYM(hipe_debug_bif_wrapper) +# define CALL_BIF(F) \ + movq CSYM(F)@GOTPCREL(%rip), %r11; \ + movq %r11, P_BIF_CALLEE(P); \ + call CSYM(hipe_debug_bif_wrapper) #else # define CALL_BIF(F) call CSYM(F) #endif' diff --git a/erts/emulator/hipe/hipe_amd64_glue.S b/erts/emulator/hipe/hipe_amd64_glue.S index 8816906870..955f7362b4 100644 --- a/erts/emulator/hipe/hipe_amd64_glue.S +++ b/erts/emulator/hipe/hipe_amd64_glue.S @@ -17,10 +17,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_amd64_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" /* @@ -109,7 +108,7 @@ ASYM(nbif_return): * stub (hipe_x86_loader.erl) which should look as follows: * * stub for f/N: - * movq $<f's BEAM code address>, P_BEAM_IP(P) + * movq $<f's export entry address>, P_CALLEE_EXP(P) * movb $<N>, P_ARITY(P) * jmp nbif_callemu * @@ -119,7 +118,7 @@ ASYM(nbif_return): GLOBAL(ASYM(nbif_callemu)) ASYM(nbif_callemu): STORE_ARG_REGS - movl $HIPE_MODE_SWITCH_RES_CALL, %eax + movl $HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %eax jmp .suspend_exit /* diff --git a/erts/emulator/hipe/hipe_arm.c b/erts/emulator/hipe/hipe_arm.c index 3db3ffe9b1..165eb543c8 100644 --- a/erts/emulator/hipe/hipe_arm.c +++ b/erts/emulator/hipe/hipe_arm.c @@ -260,9 +260,9 @@ int hipe_patch_insn(void *address, Uint32 value, Eterm type) return 0; } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +/* Make stub for native code calling exported beam function +*/ +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { unsigned int *code; unsigned int *tramp_callemu; @@ -272,9 +272,9 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) * Native code calls BEAM via a stub looking as follows: * * mov r0, #beamArity - * ldr r8, [pc,#0] // beamAddress + * ldr r8, [pc,#0] // callee_exp * b nbif_callemu - * .long beamAddress + * .long callee_exp * * I'm using r0 and r8 since they aren't used for * parameter passing in native code. The branch to @@ -292,12 +292,12 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) /* mov r0, #beamArity */ code[0] = 0xE3A00000 | (beamArity & 0xFF); - /* ldr r8, [pc,#0] // beamAddress */ + /* ldr r8, [pc,#0] // callee_exp */ code[1] = 0xE59F8000; /* b nbif_callemu */ code[2] = 0xEA000000 | (callemu_offset & 0x00FFFFFF); - /* .long beamAddress */ - code[3] = (unsigned int)beamAddress; + /* .long callee_exp */ + code[3] = (unsigned int)callee_exp; hipe_flush_icache_range(code, 4*sizeof(int)); diff --git a/erts/emulator/hipe/hipe_arm_asm.m4 b/erts/emulator/hipe/hipe_arm_asm.m4 index 85dc84973d..b2e3f83d1e 100644 --- a/erts/emulator/hipe/hipe_arm_asm.m4 +++ b/erts/emulator/hipe/hipe_arm_asm.m4 @@ -29,6 +29,14 @@ define(LEAF_WORDS,16)dnl number of stack words for leaf functions define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive `#define ARM_LEAF_WORDS 'LEAF_WORDS +`#define ARM_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ /* * Reserved registers. @@ -77,8 +85,6 @@ define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive /* * Argument (parameter) registers. */ -`#define ARM_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS define(defarg,`define(ARG$1,`$2')dnl #`define ARG'$1 $2' @@ -195,4 +201,6 @@ define(QUICK_CALL_RET,`NBIF_POP_N(eval(RET_POP($2)))b $1')dnl `/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */' `/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */' +`#endif /* ASM */' + `#endif /* HIPE_ARM_ASM_H */' diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4 index bd8bc5ab6b..57e51bb8b1 100644 --- a/erts/emulator/hipe/hipe_arm_bifs.m4 +++ b/erts/emulator/hipe/hipe_arm_bifs.m4 @@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl */ +#`define ASM' include(`hipe/hipe_arm_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" diff --git a/erts/emulator/hipe/hipe_arm_glue.S b/erts/emulator/hipe/hipe_arm_glue.S index 2e2b8604a6..069cb4512e 100644 --- a/erts/emulator/hipe/hipe_arm_glue.S +++ b/erts/emulator/hipe/hipe_arm_glue.S @@ -17,10 +17,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_arm_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" .text @@ -135,7 +134,7 @@ hipe_arm_throw_to_native: * which should look as follows: * * stub for f/N: - * <set r8 to f's BEAM code address> + * <set r8 to f's export entry address> * <set r0 to N> * b nbif_callemu * @@ -143,10 +142,10 @@ hipe_arm_throw_to_native: */ .global nbif_callemu nbif_callemu: - str r8, [P, #P_BEAM_IP] + str r8, [P, #P_CALLEE_EXP] str r0, [P, #P_ARITY] STORE_ARG_REGS - mov r0, #HIPE_MODE_SWITCH_RES_CALL + mov r0, #HIPE_MODE_SWITCH_RES_CALL_EXPORTED b .suspend_exit /* diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index 2497d51df1..9eb0b88ced 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -89,25 +89,6 @@ static Eterm address_to_term(const void *address, Process *p) /* * BIFs for reading and writing memory. Used internally by HiPE. */ -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_read_u8_1(BIF_ALIST_1) -{ - unsigned char *address = term_to_address(BIF_ARG_1); - if (!address) - BIF_ERROR(BIF_P, BADARG); - BIF_RET(make_small(*address)); -} -#endif - -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_read_u32_1(BIF_ALIST_1) -{ - Uint32 *address = term_to_address(BIF_ARG_1); - if (!address || !hipe_word32_address_ok(address)) - BIF_ERROR(BIF_P, BADARG); - BIF_RET(Uint_to_term(*address, BIF_P)); -} -#endif BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2) { @@ -120,22 +101,6 @@ BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2) BIF_RET(NIL); } -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_write_s32_2(BIF_ALIST_2) -{ - Sint32 *address; - Sint value; - - address = term_to_address(BIF_ARG_1); - if (!address || !hipe_word32_address_ok(address)) - BIF_ERROR(BIF_P, BADARG); - if (!term_to_Sint32(BIF_ARG_2, &value)) - BIF_ERROR(BIF_P, BADARG); - *address = value; - BIF_RET(NIL); -} -#endif - BIF_RETTYPE hipe_bifs_write_u32_2(BIF_ALIST_2) { Uint32 *address; @@ -639,33 +604,6 @@ BIF_RETTYPE hipe_bifs_fun_to_address_1(BIF_ALIST_1) BIF_RET(address_to_term(pc, BIF_P)); } -static void *hipe_get_emu_address(Eterm m, Eterm f, unsigned int arity, int is_remote) -{ - void *address = NULL; - if (!is_remote) - address = hipe_find_emu_address(m, f, arity); - if (!address) { - /* if not found, stub it via the export entry */ - /* no lock needed around erts_export_get_or_make_stub() */ - Export *export_entry = erts_export_get_or_make_stub(m, f, arity); - address = export_entry->addressv[erts_active_code_ix()]; - } - return address; -} - -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_get_emu_address_1(BIF_ALIST_1) -{ - struct mfa mfa; - void *address; - - if (!term_to_mfa(BIF_ARG_1, &mfa)) - BIF_ERROR(BIF_P, BADARG); - address = hipe_get_emu_address(mfa.mod, mfa.fun, mfa.ari); - BIF_RET(address_to_term(address, BIF_P)); -} -#endif - BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3) { Eterm *pc; @@ -713,33 +651,6 @@ BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3) BIF_RET(am_false); } -#if 0 /* XXX: unused */ -/* - * hipe_bifs_address_to_fun(Address) - * - Address is the address of the start of a emu function's code - * - returns {Module, Function, Arity} - */ -BIF_RETTYPE hipe_bifs_address_to_fun_1(BIF_ALIST_1) -{ - Eterm *pc; - Eterm *funcinfo; - Eterm *hp; - - pc = term_to_address(BIF_ARG_1); - if (!pc) - BIF_ERROR(BIF_P, BADARG); - funcinfo = find_function_from_pc(pc); - if (!funcinfo) - BIF_RET(am_false); - hp = HAlloc(BIF_P, 4); - hp[0] = make_arityval(3); - hp[1] = funcinfo[0]; - hp[2] = funcinfo[1]; - hp[3] = make_small(funcinfo[2]); - BIF_RET(make_tuple(hp)); -} -#endif - BIF_RETTYPE hipe_bifs_enter_sdesc_1(BIF_ALIST_1) { struct sdesc *sdesc; @@ -948,37 +859,6 @@ BIF_RETTYPE hipe_bifs_primop_address_1(BIF_ALIST_1) BIF_RET(address_to_term(primop->address, BIF_P)); } -#if 0 /* XXX: unused */ -/* - * hipe_bifs_gbif_address(F,A) -> address or false - */ -#define GBIF_LIST(ATOM,ARY,CFUN) extern Eterm gbif_##CFUN(void); -#include "hipe_gbif_list.h" -#undef GBIF_LIST - -BIF_RETTYPE hipe_bifs_gbif_address_2(BIF_ALIST_2) -{ - Uint arity; - void *address; - - if (is_not_atom(BIF_ARG_1) || is_not_small(BIF_ARG_2)) - BIF_RET(am_false); /* error or false, does it matter? */ - arity = signed_val(BIF_ARG_2); - /* XXX: replace with a hash table later */ - do { /* trick to let us use 'break' instead of 'goto' */ -#define GBIF_LIST(ATOM,ARY,CFUN) if (BIF_ARG_1 == ATOM && arity == ARY) { address = CFUN; break; } -#include "hipe_gbif_list.h" -#undef GBIF_LIST - printf("\r\n%s: guard BIF ", __FUNCTION__); - fflush(stdout); - erts_printf("%T", BIF_ARG_1); - printf("/%lu isn't listed in hipe_gbif_list.h\r\n", arity); - BIF_RET(am_false); - } while (0); - BIF_RET(address_to_term(address, BIF_P)); -} -#endif - BIF_RETTYPE hipe_bifs_atom_to_word_1(BIF_ALIST_1) { if (is_not_atom(BIF_ARG_1)) @@ -1022,83 +902,12 @@ BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1) */ void hipe_emulate_fpe(Process* p) { - if (!finite(p->hipe.float_result)) { + if (!isfinite(p->hipe.float_result)) { p->fp_exception = 1; } } #endif -#if 0 /* XXX: unused */ -/* - * At least parts of this should be inlined in native code. - * The rest could be made a primop used by both the emulator and - * native code... - */ -BIF_RETTYPE hipe_bifs_make_fun_3(BIF_ALIST_3) -{ - Eterm free_vars; - Eterm mod; - Eterm *tp; - Uint index; - Uint uniq; - Uint num_free; - Eterm tmp_var; - Uint *tmp_ptr; - unsigned needed; - ErlFunThing *funp; - Eterm *hp; - int i; - - if (is_not_list(BIF_ARG_1) && is_not_nil(BIF_ARG_1)) - BIF_ERROR(BIF_P, BADARG); - free_vars = BIF_ARG_1; - - if (is_not_atom(BIF_ARG_2)) - BIF_ERROR(BIF_P, BADARG); - mod = BIF_ARG_2; - - if (is_not_tuple(BIF_ARG_3) || - (arityval(*tuple_val(BIF_ARG_3)) != 3)) - BIF_ERROR(BIF_P, BADARG); - tp = tuple_val(BIF_ARG_3); - - if (term_to_Uint(tp[1], &index) == 0) - BIF_ERROR(BIF_P, BADARG); - if (term_to_Uint(tp[2], &uniq) == 0) - BIF_ERROR(BIF_P, BADARG); - if (term_to_Uint(tp[3], &num_free) == 0) - BIF_ERROR(BIF_P, BADARG); - - needed = ERL_FUN_SIZE + num_free; - funp = (ErlFunThing *) HAlloc(BIF_P, needed); - hp = funp->env; - - funp->thing_word = HEADER_FUN; - - /* Need a ErlFunEntry *fe - * fe->refc++; - * funp->fe = fe; - */ - - funp->num_free = num_free; - funp->creator = BIF_P->id; - for (i = 0; i < num_free; i++) { - if (is_nil(free_vars)) - BIF_ERROR(BIF_P, BADARG); - tmp_ptr = list_val(free_vars); - tmp_var = CAR(tmp_ptr); - free_vars = CDR(tmp_ptr); - *hp++ = tmp_var; - } - if (is_not_nil(free_vars)) - BIF_ERROR(BIF_P, BADARG); - - funp->next = MSO(BIF_P).funs; - MSO(BIF_P).funs = funp; - - BIF_RET(make_fun(funp)); -} -#endif /* * args: Module, {Uniq, Index, BeamAddress} @@ -1163,22 +972,6 @@ BIF_RETTYPE hipe_bifs_set_native_address_in_fe_2(BIF_ALIST_2) BIF_RET(am_true); } -#if 0 /* XXX: unused */ -BIF_RETTYPE hipe_bifs_make_native_stub_2(BIF_ALIST_2) -{ - void *beamAddress; - Uint beamArity; - void *stubAddress; - - if ((beamAddress = term_to_address(BIF_ARG_1)) == 0 || - is_not_small(BIF_ARG_2) || - (beamArity = unsigned_val(BIF_ARG_2)) >= 256) - BIF_ERROR(BIF_P, BADARG); - stubAddress = hipe_make_native_stub(beamAddress, beamArity); - BIF_RET(address_to_term(stubAddress, BIF_P)); -} -#endif - /* * MFA info hash table: * - maps MFA to native code entry point @@ -1323,16 +1116,6 @@ static inline struct hipe_mfa_info *hipe_mfa_info_table_get_locked(Eterm m, Eter return NULL; } -#if 0 /* XXX: unused */ -void *hipe_mfa_find_na(Eterm m, Eterm f, unsigned int arity) -{ - const struct hipe_mfa_info *p; - - p = hipe_mfa_info_table_get(m, f, arity); - return p ? p->address : NULL; -} -#endif - static struct hipe_mfa_info *hipe_mfa_info_table_put_locked(Eterm m, Eterm f, unsigned int arity) { unsigned long h; @@ -1490,18 +1273,13 @@ void hipe_mfa_save_orig_beam_op(Eterm mod, Eterm fun, unsigned int ari, Eterm *p static void *hipe_make_stub(Eterm m, Eterm f, unsigned int arity, int is_remote) { - void *BEAMAddress; + Export *export_entry; void *StubAddress; -#if 0 - if (is_not_atom(m) || is_not_atom(f) || arity > 255) - return NULL; -#endif - BEAMAddress = hipe_get_emu_address(m, f, arity, is_remote); - StubAddress = hipe_make_native_stub(BEAMAddress, arity); -#if 0 - hipe_mfa_set_na(m, f, arity, StubAddress); -#endif + ASSERT(is_remote); + + export_entry = erts_export_get_or_make_stub(m, f, arity); + StubAddress = hipe_make_native_stub(export_entry, arity); return StubAddress; } diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c index 32694a8f97..61406b92af 100644 --- a/erts/emulator/hipe/hipe_debug.c +++ b/erts/emulator/hipe/hipe_debug.c @@ -172,8 +172,10 @@ void hipe_print_pcb(Process *p) printf("P: 0x%0*lx\r\n", 2*(int)sizeof(long), (unsigned long)p); printf("-----------------------------------------------\r\n"); printf("Offset| Name | Value | *Value |\r\n"); +#undef U #define U(n,x) \ printf(" % 4d | %s | 0x%0*lx | |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x) +#undef P #define P(n,x) \ printf(" % 4d | %s | 0x%0*lx | 0x%0*lx |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x, 2*(int)sizeof(long), p->x ? (unsigned long)*(p->x) : -1UL) @@ -231,7 +233,7 @@ void hipe_print_pcb(Process *p) U("nsp ", hipe.nsp); U("nstack ", hipe.nstack); U("nstend ", hipe.nstend); - U("ncallee ", hipe.ncallee); + U("ncallee ", hipe.u.ncallee); hipe_arch_print_pcb(&p->hipe); #endif /* HIPE */ #undef U diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c index 86c4068072..b10263f6e2 100644 --- a/erts/emulator/hipe/hipe_gc.c +++ b/erts/emulator/hipe/hipe_gc.c @@ -22,6 +22,9 @@ #ifdef HAVE_CONFIG_H #include "config.h" #endif + +#define ERL_WANT_GC_INTERNALS__ + #include "global.h" #include "erl_gc.h" diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c index 0e287908b1..ed355ce264 100644 --- a/erts/emulator/hipe/hipe_mkliterals.c +++ b/erts/emulator/hipe/hipe_mkliterals.c @@ -498,8 +498,8 @@ static const struct rts_param rts_params[] = { { 38, "P_ARG4", 1, offsetof(struct process, def_arg_reg[4]) }, { 39, "P_ARG5", 1, offsetof(struct process, def_arg_reg[5]) }, { 40, "P_NSP", 1, offsetof(struct process, hipe.nsp) }, - { 41, "P_NCALLEE", 1, offsetof(struct process, hipe.ncallee) }, - { 42, "P_CLOSURE", 1, offsetof(struct process, hipe.closure) }, + { 41, "P_NCALLEE", 1, offsetof(struct process, hipe.u.ncallee) }, + { 42, "P_CLOSURE", 1, offsetof(struct process, hipe.u.closure) }, { 43, "P_NSP_LIMIT", 1, offsetof(struct process, hipe.nstack) }, { 44, "P_CSP", #if defined(__i386__) || defined(__x86_64__) @@ -524,6 +524,7 @@ static const struct rts_param rts_params[] = { }, { 49, "P_MSG_FIRST", 1, offsetof(struct process, msg.first) }, { 50, "P_MSG_SAVE", 1, offsetof(struct process, msg.save) }, + { 51, "P_CALLEE_EXP", 1, offsetof(struct process, hipe.u.callee_exp) }, }; #define NR_PARAMS ARRAY_SIZE(rts_params) diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index 4ddc2790b1..8c73312d45 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -2,7 +2,7 @@ * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2013. All Rights Reserved. + * Copyright Ericsson AB 2001-2014. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -140,7 +140,6 @@ void hipe_check_pcb(Process *p, const char *file, unsigned line) #endif /* HIPE_DEBUG > 0 */ /* ensure that at least nwords words are available on the native stack */ -static void hipe_check_nstack(Process *p, unsigned nwords); #if defined(__sparc__) #include "hipe_sparc_glue.h" @@ -159,7 +158,7 @@ static void hipe_check_nstack(Process *p, unsigned nwords); Uint hipe_beam_pc_return[1]; /* needed in hipe_debug.c */ Uint hipe_beam_pc_throw[1]; /* needed in hipe_debug.c */ Uint hipe_beam_pc_resume[1]; /* needed by hipe_set_timeout() */ -static Eterm hipe_beam_catch_throw; +Eterm hipe_beam_catch_throw; void hipe_mode_switch_init(void) { @@ -185,48 +184,31 @@ void hipe_set_call_trap(Uint *bfun, void *nfun, int is_closure) bfun[-4] = (Uint)nfun; } -void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) -{ - /* ensure that at least 2 words are available on the BEAM stack */ - if ((p->stop - 2) < p->htop) { - DPRINTF("calling gc to reserve BEAM stack size"); - p->fcalls -= erts_garbage_collect(p, 2, reg, arity); - ASSERT(!((p->stop - 2) < p->htop)); - } - p->stop -= 2; - p->stop[0] = NIL; - p->stop[1] = NIL; -} - static __inline__ void hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) { - if (p->flags & F_DISABLE_GC) { + if (&p->stop[1] < p->hend && p->stop[1] == hipe_beam_catch_throw) { /* Trap frame already reserved */ - ASSERT(p->stop[0] == NIL && p->stop[1] == NIL); + ASSERT(p->stop[0] == NIL); } else { + ASSERT(!(p->flags & F_DISABLE_GC)); if ((p->stop - 2) < p->htop) { DPRINTF("calling gc to increase BEAM stack size"); p->fcalls -= erts_garbage_collect(p, 2, reg, arity); ASSERT(!((p->stop - 2) < p->htop)); } p->stop -= 2; + p->stop[1] = hipe_beam_catch_throw; } - p->stop[1] = hipe_beam_catch_throw; p->stop[0] = make_cp(p->cp); ++p->catches; p->cp = hipe_beam_pc_return; } -void hipe_unreserve_beam_trap_frame(Process *p) -{ - ASSERT(p->stop[0] == NIL && p->stop[1] == NIL); - p->stop += 2; -} - static __inline__ void hipe_pop_beam_trap_frame(Process *p) { + ASSERT(p->stop[1] == hipe_beam_catch_throw); p->cp = cp_val(p->stop[0]); --p->catches; p->stop += 2; @@ -257,14 +239,14 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) /* BEAM calls a native code function */ unsigned arity = cmd >> 8; - /* p->hipe.ncallee set in beam_emu */ + /* p->hipe.u.ncallee set in beam_emu */ if (p->cp == hipe_beam_pc_return) { /* Native called BEAM, which now tailcalls native. */ hipe_pop_beam_trap_frame(p); result = hipe_tailcall_to_native(p, arity, reg); break; } - DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity); + DPRINTF("calling %#lx/%u", (long)p->hipe.u.ncallee, arity); result = hipe_call_to_native(p, arity, reg); break; } @@ -282,18 +264,18 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) arity -= funp->num_free; /* arity == #formals */ reg[arity] = fun; ++arity; /* correct for having added the closure */ - /* HIPE_ASSERT(p->hipe.ncallee == (void(*)(void))funp->native_address); */ + /* HIPE_ASSERT(p->hipe.u.ncallee == (void(*)(void))funp->native_address); */ /* just like a normal call from now on */ - /* p->hipe.ncallee set in beam_emu */ + /* p->hipe.u.ncallee set in beam_emu */ if (p->cp == hipe_beam_pc_return) { /* Native called BEAM, which now tailcalls native. */ hipe_pop_beam_trap_frame(p); result = hipe_tailcall_to_native(p, arity, reg); break; } - DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity); + DPRINTF("calling %#lx/%u", (long)p->hipe.u.ncallee, arity); result = hipe_call_to_native(p, arity, reg); break; } @@ -396,13 +378,13 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) if (is_recursive) hipe_push_beam_trap_frame(p, reg, p->arity); - result = HIPE_MODE_SWITCH_RES_CALL; + result = HIPE_MODE_SWITCH_RES_CALL_BEAM; break; } - case HIPE_MODE_SWITCH_RES_CALL: { + case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: { /* Native code calls or tailcalls BEAM. * - * p->i is the callee's BEAM code + * p->hipe.u.callee_exp is the callee's export entry * p->arity is the callee's arity * p->def_arg_reg[] contains the register parameters * p->hipe.nsp[] contains the stacked parameters @@ -422,15 +404,15 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) * F(A1, ..., AN, FV1, ..., FVM, Closure) * (Where Ai is argument i and FVj is free variable j) * - * p->hipe.closure contains the closure + * p->hipe.u.closure contains the closure * p->def_arg_reg[] contains the register parameters * p->hipe.nsp[] contains the stacked parameters */ ErlFunThing *closure; unsigned num_free, arity, i, is_recursive; - HIPE_ASSERT(is_fun(p->hipe.closure)); - closure = (ErlFunThing*)fun_val(p->hipe.closure); + HIPE_ASSERT(is_fun(p->hipe.u.closure)); + closure = (ErlFunThing*)fun_val(p->hipe.u.closure); num_free = closure->num_free; arity = closure->fe->arity; @@ -460,10 +442,10 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) p->i = closure->fe->address; /* Change result code to the faster plain CALL type. */ - result = HIPE_MODE_SWITCH_RES_CALL; + result = HIPE_MODE_SWITCH_RES_CALL_BEAM; } /* Append the closure as the last parameter. Don't increment arity. */ - reg[arity] = p->hipe.closure; + reg[arity] = p->hipe.u.closure; if (is_recursive) { /* BEAM called native, which now calls BEAM. @@ -541,7 +523,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) } } HIPE_CHECK_PCB(p); - result = HIPE_MODE_SWITCH_RES_CALL; + result = HIPE_MODE_SWITCH_RES_CALL_BEAM; p->def_arg_reg[3] = result; return p; } @@ -569,7 +551,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) address = hipe_get_remote_na(mfa[0], mfa[1], arity); if (!address) goto do_apply_fail; - p->hipe.ncallee = (void(*)(void)) address; + p->hipe.u.ncallee = (void(*)(void)) address; result = hipe_tailcall_to_native(p, arity, reg); goto do_return_from_native; do_apply_fail: @@ -599,7 +581,6 @@ static unsigned hipe_next_nstack_size(unsigned size) } #if 0 && defined(HIPE_NSTACK_GROWS_UP) -#define hipe_nstack_avail(p) ((p)->hipe.nstend - (p)->hipe.nsp) void hipe_inc_nstack(Process *p) { Eterm *old_nstack = p->hipe.nstack; @@ -623,7 +604,6 @@ void hipe_inc_nstack(Process *p) #endif #if defined(HIPE_NSTACK_GROWS_DOWN) -#define hipe_nstack_avail(p) ((unsigned)((p)->hipe.nsp - (p)->hipe.nstack)) void hipe_inc_nstack(Process *p) { unsigned old_size = p->hipe.nstend - p->hipe.nstack; @@ -655,12 +635,6 @@ void hipe_empty_nstack(Process *p) p->hipe.nstend = NULL; } -static void hipe_check_nstack(Process *p, unsigned nwords) -{ - while (hipe_nstack_avail(p) < nwords) - hipe_inc_nstack(p); -} - void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free) { unsigned arity; diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h index 06721e3c04..b8de12fcbb 100644 --- a/erts/emulator/hipe/hipe_mode_switch.h +++ b/erts/emulator/hipe/hipe_mode_switch.h @@ -31,7 +31,7 @@ /* result codes for beam_emu <- hipe_mode_switch() return */ #define HIPE_MODE_SWITCH_RES_RETURN 4 -#define HIPE_MODE_SWITCH_RES_CALL 5 +#define HIPE_MODE_SWITCH_RES_CALL_EXPORTED 5 #define HIPE_MODE_SWITCH_RES_THROW 6 /* additional result codes for hipe_mode_switch() <- native return */ @@ -45,6 +45,8 @@ #define HIPE_MODE_SWITCH_RES_APPLY 13 /* mode_switch <- native */ +#define HIPE_MODE_SWITCH_RES_CALL_BEAM 14 + #ifndef ASM #include "error.h" @@ -59,13 +61,58 @@ void hipe_empty_nstack(Process *p); void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free); Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s); -void hipe_reserve_beam_trap_frame(Process*, Eterm reg[], unsigned arity); -void hipe_unreserve_beam_trap_frame(Process*); +ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process*, Eterm reg[], unsigned arity); +ERTS_GLB_INLINE void hipe_unreserve_beam_trap_frame(Process*); extern Uint hipe_beam_pc_return[]; extern Uint hipe_beam_pc_throw[]; extern Uint hipe_beam_pc_resume[]; +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +#include "erl_gc.h" +#include "hipe_stack.h" + +#if defined(__sparc__) +#include "hipe_sparc_glue.h" +#elif defined(__i386__) +#include "hipe_x86_glue.h" +#elif defined(__x86_64__) +#include "hipe_amd64_glue.h" +#elif defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) +#include "hipe_ppc_glue.h" +#elif defined(__arm__) +#include "hipe_arm_glue.h" +#endif + +extern Eterm hipe_beam_catch_throw; + +ERTS_GLB_INLINE void hipe_reserve_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) +{ + if (!hipe_bifcall_from_native_is_recursive(p)) + return; + + /* ensure that at least 2 words are available on the BEAM stack */ + if ((p->stop - 2) < p->htop) { + p->fcalls -= erts_garbage_collect(p, 2, reg, arity); + ASSERT(!((p->stop - 2) < p->htop)); + } + p->stop -= 2; + p->stop[0] = NIL; + p->stop[1] = hipe_beam_catch_throw; +} + +ERTS_GLB_INLINE void hipe_unreserve_beam_trap_frame(Process *p) +{ + if (!hipe_bifcall_from_native_is_recursive(p)) + return; + + ASSERT(p->stop[0] == NIL && p->stop[1] == hipe_beam_catch_throw); + p->stop += 2; +} + +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + #endif /* ASM */ #endif /* HIPE_MODE_SWITCH_H */ diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index 7d343dd91e..7e8632b50d 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -330,8 +330,6 @@ char *hipe_bs_allocate(int len) Binary *bptr; bptr = erts_bin_nrml_alloc(len); - bptr->flags = 0; - bptr->orig_size = len; erts_smp_atomic_init_nob(&bptr->refc, 1); return bptr->orig_bytes; } @@ -341,7 +339,6 @@ Binary *hipe_bs_reallocate(Binary* oldbptr, int newsize) Binary *bptr; bptr = erts_bin_realloc(oldbptr, newsize); - bptr->orig_size = newsize; return bptr; } diff --git a/erts/emulator/hipe/hipe_ppc.c b/erts/emulator/hipe/hipe_ppc.c index 2d8fd61e1e..4dc26cdbc8 100644 --- a/erts/emulator/hipe/hipe_ppc.c +++ b/erts/emulator/hipe/hipe_ppc.c @@ -285,7 +285,7 @@ int hipe_patch_insn(void *address, Uint64 value, Eterm type) } } -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { unsigned int *code; @@ -294,16 +294,16 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) code = alloc_stub(7); - /* addis r12,0,beamAddress@highest */ - code[0] = 0x3d800000 | (((unsigned long)beamAddress >> 48) & 0xffff); - /* ori r12,r12,beamAddress@higher */ - code[1] = 0x618c0000 | (((unsigned long)beamAddress >> 32) & 0xffff); + /* addis r12,0,callee_exp@highest */ + code[0] = 0x3d800000 | (((unsigned long)callee_exp >> 48) & 0xffff); + /* ori r12,r12,callee_exp@higher */ + code[1] = 0x618c0000 | (((unsigned long)callee_exp >> 32) & 0xffff); /* sldi r12,r12,32 (rldicr r12,r12,32,31) */ code[2] = 0x798c07c6; - /* oris r12,r12,beamAddress@h */ - code[3] = 0x658c0000 | (((unsigned long)beamAddress >> 16) & 0xffff); - /* ori r12,r12,beamAddress@l */ - code[4] = 0x618c0000 | ((unsigned long)beamAddress & 0xffff); + /* oris r12,r12,callee_exp@h */ + code[3] = 0x658c0000 | (((unsigned long)callee_exp >> 16) & 0xffff); + /* ori r12,r12,callee_exp@l */ + code[4] = 0x618c0000 | ((unsigned long)callee_exp & 0xffff); /* addi r0,0,beamArity */ code[5] = 0x38000000 | (beamArity & 0x7FFF); /* ba nbif_callemu */ @@ -355,18 +355,16 @@ int hipe_patch_insn(void *address, Uint32 value, Eterm type) return 0; } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { unsigned int *code; /* * Native code calls BEAM via a stub looking as follows: * - * addi r12,0,beamAddress@l + * addi r12,0,callee_exp@l * addi r0,0,beamArity - * addis r12,r12,beamAddress@ha + * addis r12,r12,callee_exp@ha * ba nbif_callemu * * I'm using r0 and r12 since the standard SVR4 ABI allows @@ -384,12 +382,12 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) code = alloc_stub(4); - /* addi r12,0,beamAddress@l */ - code[0] = 0x39800000 | ((unsigned long)beamAddress & 0xFFFF); + /* addi r12,0,callee_exp@l */ + code[0] = 0x39800000 | ((unsigned long)callee_exp & 0xFFFF); /* addi r0,0,beamArity */ code[1] = 0x38000000 | (beamArity & 0x7FFF); - /* addis r12,r12,beamAddress@ha */ - code[2] = 0x3D8C0000 | at_ha((unsigned long)beamAddress); + /* addis r12,r12,callee_exp@ha */ + code[2] = 0x3D8C0000 | at_ha((unsigned long)callee_exp); /* ba nbif_callemu */ code[3] = 0x48000002 | (unsigned long)&nbif_callemu; diff --git a/erts/emulator/hipe/hipe_ppc_asm.m4 b/erts/emulator/hipe/hipe_ppc_asm.m4 index 343402f9f0..4a1caa1543 100644 --- a/erts/emulator/hipe/hipe_ppc_asm.m4 +++ b/erts/emulator/hipe/hipe_ppc_asm.m4 @@ -23,6 +23,22 @@ changecom(`/*', `*/')dnl #define HIPE_PPC_ASM_H' /* + * Tunables. + */ +define(LEAF_WORDS,16)dnl number of stack words for leaf functions +define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive + +`#define PPC_LEAF_WORDS 'LEAF_WORDS +`#define PPC_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ + +/* * Handle 32 vs 64-bit. */ ifelse(ARCH,ppc64,` @@ -53,13 +69,6 @@ define(WSIZE,4)dnl `#define STORE 'STORE `#define CMPI 'CMPI -/* - * Tunables. - */ -define(LEAF_WORDS,16)dnl number of stack words for leaf functions -define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive - -`#define PPC_LEAF_WORDS 'LEAF_WORDS /* * Workarounds for Darwin. @@ -193,8 +202,6 @@ NAME: \ /* * Argument (parameter) registers. */ -`#define PPC_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS define(defarg,`define(ARG$1,`$2')dnl #`define ARG'$1 $2' @@ -309,4 +316,6 @@ define(QUICK_CALL_RET,`NBIF_POP_N(eval(RET_POP($2)))b $1')dnl `/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */' `/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */' +`#endif /* ASM */' + `#endif /* HIPE_PPC_ASM_H */' diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4 index 7cc2b5c7b6..f53b79b52e 100644 --- a/erts/emulator/hipe/hipe_ppc_bifs.m4 +++ b/erts/emulator/hipe/hipe_ppc_bifs.m4 @@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl */ +#`define ASM' include(`hipe/hipe_ppc_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" diff --git a/erts/emulator/hipe/hipe_ppc_glue.S b/erts/emulator/hipe/hipe_ppc_glue.S index 6f0217c738..c48fb150af 100644 --- a/erts/emulator/hipe/hipe_ppc_glue.S +++ b/erts/emulator/hipe/hipe_ppc_glue.S @@ -17,10 +17,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_ppc_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" .text @@ -296,7 +295,7 @@ CSYM(hipe_ppc_throw_to_native): * which should look as follows: * * stub for f/N: - * <set r12 to f's BEAM code address> + * <set r12 to f's export entry address> * <set r0 to N> * b nbif_callemu * @@ -312,10 +311,10 @@ CSYM(hipe_ppc_throw_to_native): */ GLOBAL(ASYM(nbif_callemu)) ASYM(nbif_callemu): - STORE r12, P_BEAM_IP(P) + STORE r12, P_CALLEE_EXP(P) STORE r0, P_ARITY(P) STORE_ARG_REGS - li r3, HIPE_MODE_SWITCH_RES_CALL + li r3, HIPE_MODE_SWITCH_RES_CALL_EXPORTED b .suspend_exit /* diff --git a/erts/emulator/hipe/hipe_process.h b/erts/emulator/hipe/hipe_process.h index 4ee99d78a2..86655ad42c 100644 --- a/erts/emulator/hipe/hipe_process.h +++ b/erts/emulator/hipe/hipe_process.h @@ -23,14 +23,17 @@ #define HIPE_PROCESS_H #include "erl_alloc.h" +#include "export.h" struct hipe_process_state { Eterm *nsp; /* Native stack pointer. */ Eterm *nstack; /* Native stack block start. */ Eterm *nstend; /* Native stack block end (start+size). */ - /* XXX: ncallee and closure could share space in a union */ - void (*ncallee)(void); /* Native code callee (label) to invoke. */ - Eterm closure; /* Used to pass a closure from native code. */ + union { + void (*ncallee)(void); /* Native code callee (label) to invoke. */ + Eterm closure; /* Used to pass a closure from native code. */ + Export* callee_exp; /* Used to pass export entry from native code */ + }u; Eterm *nstgraylim; /* Gray/white stack boundary. */ Eterm *nstblacklim; /* Black/gray stack boundary. Must exist if graylim exists. Ignored if no graylim. */ diff --git a/erts/emulator/hipe/hipe_risc_glue.h b/erts/emulator/hipe/hipe_risc_glue.h index cc2671c016..dbb7086dae 100644 --- a/erts/emulator/hipe/hipe_risc_glue.h +++ b/erts/emulator/hipe/hipe_risc_glue.h @@ -214,6 +214,14 @@ hipe_trap_from_native_is_recursive(Process *p) return 0; } +/* Native called BIF. Is it a recursive call? + i.e should we return back to native when BIF is done? */ +static __inline__ int +hipe_bifcall_from_native_is_recursive(Process *p) +{ + return (p->hipe.nra != (void(*)(void))&nbif_return); +} + /* Native makes a call which needs to unload the parameters. This differs from hipe_call_from_native_is_recursive() in diff --git a/erts/emulator/hipe/hipe_risc_stack.c b/erts/emulator/hipe/hipe_risc_stack.c index 1183856c7e..bea3a0fecd 100644 --- a/erts/emulator/hipe/hipe_risc_stack.c +++ b/erts/emulator/hipe/hipe_risc_stack.c @@ -226,7 +226,7 @@ void (*hipe_handle_stack_trap(Process *p))(void) * The native stack MUST contain a stack frame as it appears on * entry to a function (actuals, caller's frame, caller's return address). * p->hipe.narity MUST contain the arity (number of actuals). - * On exit, p->hipe.ncallee is set to the handler's PC and p->hipe.nsp + * On exit, p->hipe.u.ncallee is set to the handler's PC and p->hipe.nsp * is set to its SP (low address of its stack frame). */ void hipe_find_handler(Process *p) @@ -254,7 +254,7 @@ void hipe_find_handler(Process *p) if ((exnra = sdesc_exnra(sdesc)) != 0 && (p->catches >= 0 || exnra == (unsigned long)&nbif_fail)) { - p->hipe.ncallee = (void(*)(void)) exnra; + p->hipe.u.ncallee = (void(*)(void)) exnra; p->hipe.nsp = nsp; p->hipe.narity = 0; /* update the gray/white boundary if we threw past it */ diff --git a/erts/emulator/hipe/hipe_sparc.c b/erts/emulator/hipe/hipe_sparc.c index 49d4da7bab..2052aa8498 100644 --- a/erts/emulator/hipe/hipe_sparc.c +++ b/erts/emulator/hipe/hipe_sparc.c @@ -204,9 +204,7 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process * return alloc_code(nrbytes); } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { unsigned int *code; unsigned int callEmuOffset; @@ -215,11 +213,11 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) code = alloc_code(5*sizeof(int)); /* sethi %hi(Address), %i4 */ - code[0] = 0x39000000 | (((unsigned int)beamAddress >> 10) & 0x3FFFFF); + code[0] = 0x39000000 | (((unsigned int)callee_exp >> 10) & 0x3FFFFF); /* or %g0, %o7, %i3 ! mov %o7, %i3 */ code[1] = 0xB610000F; /* or %i4, %lo(Address), %i4 */ - code[2] = 0xB8172000 | ((unsigned int)beamAddress & 0x3FF); + code[2] = 0xB8172000 | ((unsigned int)callee_exp & 0x3FF); /* call callemu */ callEmuOffset = (char*)nbif_callemu - (char*)&code[3]; code[3] = (1 << 30) | ((callEmuOffset >> 2) & 0x3FFFFFFF); diff --git a/erts/emulator/hipe/hipe_sparc_asm.m4 b/erts/emulator/hipe/hipe_sparc_asm.m4 index 227d10ed80..c3c3bcb74a 100644 --- a/erts/emulator/hipe/hipe_sparc_asm.m4 +++ b/erts/emulator/hipe/hipe_sparc_asm.m4 @@ -29,6 +29,14 @@ define(LEAF_WORDS,16)dnl number of stack words for leaf functions define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive `#define SPARC_LEAF_WORDS 'LEAF_WORDS +`#define SPARC_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ /* * Reserved registers. @@ -80,9 +88,6 @@ define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive /* * Argument (parameter) registers. */ -`#define SPARC_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS - define(defarg,`define(ARG$1,`$2')dnl #`define ARG'$1 $2' )dnl @@ -210,4 +215,6 @@ define(QUICK_CALL_RET,`ba $1; NBIF_POP_N(eval(RET_POP($2)))')dnl `/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */' `/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */' +`#endif /* ASM */' + `#endif /* HIPE_SPARC_ASM_H */' diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4 index ca5af45d58..2bfe3a4646 100644 --- a/erts/emulator/hipe/hipe_sparc_bifs.m4 +++ b/erts/emulator/hipe/hipe_sparc_bifs.m4 @@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl */ +#`define ASM' include(`hipe/hipe_sparc_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" diff --git a/erts/emulator/hipe/hipe_sparc_glue.S b/erts/emulator/hipe/hipe_sparc_glue.S index 44bdf1bc7e..6c8c841194 100644 --- a/erts/emulator/hipe/hipe_sparc_glue.S +++ b/erts/emulator/hipe/hipe_sparc_glue.S @@ -18,10 +18,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_sparc_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" .section ".text" @@ -155,9 +154,9 @@ hipe_sparc_throw_to_native: * which should look as follows: * * stub for f/N: - * sethi %hi(f's BEAM code address), TEMP_ARG0 + * sethi %hi(f's export entry address), TEMP_ARG0 * mov RA, TEMP_RA ! because the call below clobbers RA (%o7) - * or TEMP_ARG0, %lo(f's BEAM code address), TEMP_ARG0 + * or TEMP_ARG0, %lo(f's export entry address), TEMP_ARG0 * call nbif_callemu ! clobbers RA! * mov N, TEMP_ARG1 ! delay slot: TEMP_ARG1 := ARITY * @@ -165,12 +164,12 @@ hipe_sparc_throw_to_native: */ .global nbif_callemu nbif_callemu: - st TEMP_ARG0, [P+P_BEAM_IP] + st TEMP_ARG0, [P+P_CALLEE_EXP] st TEMP_ARG1, [P+P_ARITY] st TEMP_RA, [P+P_NRA] STORE_ARG_REGS ba .flush_exit - mov HIPE_MODE_SWITCH_RES_CALL, %o0 + mov HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %o0 /* * nbif_apply diff --git a/erts/emulator/hipe/hipe_stack.h b/erts/emulator/hipe/hipe_stack.h index 66f9f04c73..4cfdb54dd8 100644 --- a/erts/emulator/hipe/hipe_stack.h +++ b/erts/emulator/hipe/hipe_stack.h @@ -108,12 +108,23 @@ extern int hipe_fill_stacktrace(Process*, int, Eterm**); #if 0 && defined(HIPE_NSTACK_GROWS_UP) #define hipe_nstack_start(p) ((p)->hipe.nstack) #define hipe_nstack_used(p) ((p)->hipe.nsp - (p)->hipe.nstack) +#define hipe_nstack_avail(p) ((p)->hipe.nstend - (p)->hipe.nsp) #endif #if defined(HIPE_NSTACK_GROWS_DOWN) #define hipe_nstack_start(p) ((p)->hipe.nsp) #define hipe_nstack_used(p) ((p)->hipe.nstend - (p)->hipe.nsp) +#define hipe_nstack_avail(p) ((unsigned)((p)->hipe.nsp - (p)->hipe.nstack)) #endif +/* ensure that at least nwords words are available on the native stack */ +static __inline__ void hipe_check_nstack(Process *p, unsigned nwords) +{ + extern void hipe_inc_nstack(Process *p); + + while (hipe_nstack_avail(p) < nwords) + hipe_inc_nstack(p); +} + /* * GC support procedures */ diff --git a/erts/emulator/hipe/hipe_x86.c b/erts/emulator/hipe/hipe_x86.c index 327c74e9aa..314f6b597c 100644 --- a/erts/emulator/hipe/hipe_x86.c +++ b/erts/emulator/hipe/hipe_x86.c @@ -182,18 +182,16 @@ void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process * return alloc_code(nrbytes); } -/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() - and hipe_bif0.c:hipe_make_stub() */ -void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +void *hipe_make_native_stub(void *callee_exp, unsigned int beamArity) { /* * This creates a native code stub with the following contents: * - * movl $Address, P_BEAM_IP(%ebp) + * movl $Address, P_CALLEE_EXP(%ebp) * movb $Arity, P_ARITY(%ebp) * jmp callemu * - * The stub has variable size, depending on whether the P_BEAM_IP + * The stub has variable size, depending on whether the P_CALLEE_EXP * and P_ARITY offsets fit in 8-bit signed displacements or not. * The rel32 offset in the final jmp depends on its actual location, * which also depends on the size of the previous instructions. @@ -206,28 +204,28 @@ void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) codeSize = /* 16, 19, or 22 bytes */ 16 + /* 16 when both offsets are 8-bit */ - (P_BEAM_IP >= 128 ? 3 : 0) + + (P_CALLEE_EXP >= 128 ? 3 : 0) + (P_ARITY >= 128 ? 3 : 0); codep = code = alloc_code(codeSize); - /* movl $beamAddress, P_BEAM_IP(%ebp); 3 or 6 bytes, plus 4 */ + /* movl $beamAddress, P_CALLEE_EXP(%ebp); 3 or 6 bytes, plus 4 */ codep[0] = 0xc7; -#if P_BEAM_IP >= 128 +#if P_CALLEE_EXP >= 128 codep[1] = 0x85; /* disp32[EBP] */ - codep[2] = P_BEAM_IP & 0xFF; - codep[3] = (P_BEAM_IP >> 8) & 0xFF; - codep[4] = (P_BEAM_IP >> 16) & 0xFF; - codep[5] = (P_BEAM_IP >> 24) & 0xFF; + codep[2] = P_CALLEE_EXP & 0xFF; + codep[3] = (P_CALLEE_EXP >> 8) & 0xFF; + codep[4] = (P_CALLEE_EXP >> 16) & 0xFF; + codep[5] = (P_CALLEE_EXP >> 24) & 0xFF; codep += 6; #else codep[1] = 0x45; /* disp8[EBP] */ - codep[2] = P_BEAM_IP; + codep[2] = P_CALLEE_EXP; codep += 3; #endif - codep[0] = ((unsigned int)beamAddress) & 0xFF; - codep[1] = ((unsigned int)beamAddress >> 8) & 0xFF; - codep[2] = ((unsigned int)beamAddress >> 16) & 0xFF; - codep[3] = ((unsigned int)beamAddress >> 24) & 0xFF; + codep[0] = ((unsigned int)callee_exp) & 0xFF; + codep[1] = ((unsigned int)callee_exp >> 8) & 0xFF; + codep[2] = ((unsigned int)callee_exp >> 16) & 0xFF; + codep[3] = ((unsigned int)callee_exp >> 24) & 0xFF; codep += 4; /* movb $beamArity, P_ARITY(%ebp); 3 or 6 bytes */ diff --git a/erts/emulator/hipe/hipe_x86_asm.m4 b/erts/emulator/hipe/hipe_x86_asm.m4 index 020ccf8d4b..39c5cb1044 100644 --- a/erts/emulator/hipe/hipe_x86_asm.m4 +++ b/erts/emulator/hipe/hipe_x86_asm.m4 @@ -33,6 +33,18 @@ define(SIMULATE_NSP,0)dnl change to 1 to simulate call/ret insns `#define X86_LEAF_WORDS 'LEAF_WORDS `#define LEAF_WORDS 'LEAF_WORDS +`#define X86_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + +`#define X86_HP_IN_ESI 'HP_IN_ESI +`#define X86_SIMULATE_NSP 'SIMULATE_NSP + + +`#ifdef ASM' +/* + * Only assembler stuff from here on (when included from *.S) + */ + /* * Workarounds for Darwin. */ @@ -60,7 +72,6 @@ ifelse(OPSYS,darwin,`` */ `#define P %ebp' -`#define X86_HP_IN_ESI 'HP_IN_ESI `#if X86_HP_IN_ESI #define SAVE_HP movl %esi, P_HP(P) #define RESTORE_HP movl P_HP(P), %esi @@ -73,7 +84,6 @@ ifelse(OPSYS,darwin,`` #define SAVE_CSP movl %esp, P_CSP(P) #define RESTORE_CSP movl P_CSP(P), %esp' -`#define X86_SIMULATE_NSP 'SIMULATE_NSP /* * Context switching macros. @@ -100,12 +110,10 @@ ifelse(OPSYS,darwin,`` SAVE_CACHED_STATE; \ SWITCH_ERLANG_TO_C_QUICK' + /* * Argument (parameter) registers. */ -`#define X86_NR_ARG_REGS 'NR_ARG_REGS -`#define NR_ARG_REGS 'NR_ARG_REGS - ifelse(eval(NR_ARG_REGS >= 1),0,, ``#define ARG0 %eax '')dnl @@ -282,4 +290,6 @@ define(LOAD_CALLER_SAVE,`LAR_N(eval(NR_CALLER_SAVE-1))')dnl `#define STORE_CALLER_SAVE 'STORE_CALLER_SAVE `#define LOAD_CALLER_SAVE 'LOAD_CALLER_SAVE +`#endif /* ASM */' + `#endif /* HIPE_X86_ASM_H */' diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4 index dd6980f555..a0f16efa33 100644 --- a/erts/emulator/hipe/hipe_x86_bifs.m4 +++ b/erts/emulator/hipe/hipe_x86_bifs.m4 @@ -19,6 +19,7 @@ changecom(`/*', `*/')dnl */ +#`define ASM' include(`hipe/hipe_x86_asm.m4') #`include' "config.h" #`include' "hipe_literals.h" diff --git a/erts/emulator/hipe/hipe_x86_glue.S b/erts/emulator/hipe/hipe_x86_glue.S index 88b86f4de7..9d38eaaafd 100644 --- a/erts/emulator/hipe/hipe_x86_glue.S +++ b/erts/emulator/hipe/hipe_x86_glue.S @@ -18,10 +18,9 @@ * %CopyrightEnd% */ - +#define ASM #include "hipe_x86_asm.h" #include "hipe_literals.h" -#define ASM #include "hipe_mode_switch.h" /* @@ -104,7 +103,7 @@ ASYM(nbif_return): * stub (hipe_x86_loader.erl) which should look as follows: * * stub for f/N: - * movl $<f's BEAM code address>, P_BEAM_IP(P) + * movl $<f's export entry address>, P_CALLEE_EXP(P) * movb $<N>, P_ARITY(P) * jmp nbif_callemu * @@ -114,7 +113,7 @@ ASYM(nbif_return): GLOBAL(ASYM(nbif_callemu)) ASYM(nbif_callemu): STORE_ARG_REGS - movl $HIPE_MODE_SWITCH_RES_CALL, %eax + movl $HIPE_MODE_SWITCH_RES_CALL_EXPORTED, %eax jmp .suspend_exit /* diff --git a/erts/emulator/hipe/hipe_x86_glue.h b/erts/emulator/hipe/hipe_x86_glue.h index 63ad250d60..4b6e495b9a 100644 --- a/erts/emulator/hipe/hipe_x86_glue.h +++ b/erts/emulator/hipe/hipe_x86_glue.h @@ -207,6 +207,14 @@ hipe_trap_from_native_is_recursive(Process *p) return 0; } +/* Native called BIF. Is it a recursive call? + i.e should we return back to native when BIF is done? */ +static __inline__ int +hipe_bifcall_from_native_is_recursive(Process *p) +{ + return (*p->hipe.nsp != (Eterm)nbif_return); +} + /* Native makes a call which needs to unload the parameters. This differs from hipe_call_from_native_is_recursive() in diff --git a/erts/emulator/hipe/hipe_x86_stack.c b/erts/emulator/hipe/hipe_x86_stack.c index 9ad3fa9d31..7f1c2f7d41 100644 --- a/erts/emulator/hipe/hipe_x86_stack.c +++ b/erts/emulator/hipe/hipe_x86_stack.c @@ -209,7 +209,7 @@ void (*hipe_handle_stack_trap(Process *p))(void) * The native stack MUST contain a stack frame as it appears on * entry to a function (return address, actuals, caller's frame). * p->hipe.narity MUST contain the arity (number of actuals). - * On exit, p->hipe.ncallee is set to the handler's PC and p->hipe.nsp + * On exit, p->hipe.u.ncallee is set to the handler's PC and p->hipe.nsp * is set to its SP (low address of its stack frame). */ void hipe_find_handler(Process *p) @@ -240,7 +240,7 @@ void hipe_find_handler(Process *p) if ((exnra = sdesc_exnra(sdesc)) != 0 && (p->catches >= 0 || exnra == (unsigned long)nbif_fail)) { - p->hipe.ncallee = (void(*)(void)) exnra; + p->hipe.u.ncallee = (void(*)(void)) exnra; p->hipe.nsp = nsp; p->hipe.narity = 0; /* update the gray/white boundary if we threw past it */ diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 1db673e7f3..81cb5dc4bb 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -52,8 +52,17 @@ typedef char EventStateType; #define ERTS_EV_TYPE_STOP_USE ((EventStateType) 3) /* pending stop_select */ typedef char EventStateFlags; -#define ERTS_EV_FLAG_USED ((EventStateFlags) 1) /* ERL_DRV_USE has been turned on */ +#define ERTS_EV_FLAG_USED ((EventStateFlags) 1) /* ERL_DRV_USE has been turned on */ +#define ERTS_EV_FLAG_DEFER_IN_EV ((EventStateFlags) 2) +#define ERTS_EV_FLAG_DEFER_OUT_EV ((EventStateFlags) 4) +#ifdef DEBUG +# define ERTS_ACTIVE_FD_INC 2 +#else +# define ERTS_ACTIVE_FD_INC 128 +#endif + +#define ERTS_CHECK_IO_POLL_RES_LEN 512 #if defined(ERTS_KERNEL_POLL_VERSION) # define ERTS_CIO_EXPORT(FUNC) FUNC ## _kp @@ -67,6 +76,7 @@ typedef char EventStateFlags; (ERTS_POLL_USE_POLL && !ERTS_POLL_USE_KERNEL_POLL) #define ERTS_CIO_POLL_CTL ERTS_POLL_EXPORT(erts_poll_control) +#define ERTS_CIO_POLL_CTLV ERTS_POLL_EXPORT(erts_poll_controlv) #define ERTS_CIO_POLL_WAIT ERTS_POLL_EXPORT(erts_poll_wait) #ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT #define ERTS_CIO_POLL_AS_INTR ERTS_POLL_EXPORT(erts_poll_async_sig_interrupt) @@ -85,6 +95,13 @@ static struct pollset_info { ErtsPollSet ps; erts_smp_atomic_t in_poll_wait; /* set while doing poll */ + struct { + int six; /* start index */ + int eix; /* end index */ + erts_smp_atomic32_t no; + int size; + ErtsSysFdType *array; + } active_fd; #ifdef ERTS_SMP struct removed_fd* removed_list; /* list of deselected fd's*/ erts_smp_spinlock_t removed_list_lock; @@ -97,9 +114,11 @@ typedef struct { SafeHashBucket hb; #endif ErtsSysFdType fd; - union { - ErtsDrvEventDataState *event; /* ERTS_EV_TYPE_DRV_EV */ + struct { ErtsDrvSelectDataState *select; /* ERTS_EV_TYPE_DRV_SEL */ +#if ERTS_CIO_HAVE_DRV_EVENT + ErtsDrvEventDataState *event; /* ERTS_EV_TYPE_DRV_EV */ +#endif erts_driver_t* drv_ptr; /* ERTS_EV_TYPE_STOP_USE */ } driver; ErtsPollEvents events; @@ -169,6 +188,10 @@ static ERTS_INLINE ErtsDrvEventState* hash_new_drv_ev_state(ErtsSysFdType fd) ErtsDrvEventState tmpl; tmpl.fd = fd; tmpl.driver.select = NULL; +#if ERTS_CIO_HAVE_DRV_EVENT + tmpl.driver.event = NULL; +#endif + tmpl.driver.drv_ptr = NULL; tmpl.events = 0; tmpl.remove_cnt = 0; tmpl.type = ERTS_EV_TYPE_NONE; @@ -209,6 +232,65 @@ ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(removed_fd, struct removed_fd, 64, ERTS_ALC_T_F #endif static ERTS_INLINE void +init_iotask(ErtsIoTask *io_task) +{ + erts_port_task_handle_init(&io_task->task); + erts_smp_atomic_init_nob(&io_task->executed_time, ~((erts_aint_t) 0)); +} + +static ERTS_INLINE int +is_iotask_active(ErtsIoTask *io_task, erts_aint_t current_cio_time) +{ + if (erts_port_task_is_scheduled(&io_task->task)) + return 1; + if (erts_smp_atomic_read_nob(&io_task->executed_time) == current_cio_time) + return 1; + return 0; +} + +static ERTS_INLINE ErtsDrvSelectDataState * +alloc_drv_select_data(void) +{ + ErtsDrvSelectDataState *dsp = erts_alloc(ERTS_ALC_T_DRV_SEL_D_STATE, + sizeof(ErtsDrvSelectDataState)); + dsp->inport = NIL; + dsp->outport = NIL; + init_iotask(&dsp->iniotask); + init_iotask(&dsp->outiotask); + return dsp; +} + +static ERTS_INLINE void +free_drv_select_data(ErtsDrvSelectDataState *dsp) +{ + ASSERT(!erts_port_task_is_scheduled(&dsp->iniotask.task)); + ASSERT(!erts_port_task_is_scheduled(&dsp->outiotask.task)); + erts_free(ERTS_ALC_T_DRV_SEL_D_STATE, dsp); +} + +static ERTS_INLINE ErtsDrvEventDataState * +alloc_drv_event_data(void) +{ + ErtsDrvEventDataState *dep = erts_alloc(ERTS_ALC_T_DRV_EV_D_STATE, + sizeof(ErtsDrvEventDataState)); + dep->port = NIL; + dep->data = NULL; + dep->removed_events = 0; +#if ERTS_CIO_DEFER_ACTIVE_EVENTS + dep->deferred_events = 0; +#endif + init_iotask(&dep->iotask); + return dep; +} + +static ERTS_INLINE void +free_drv_event_data(ErtsDrvEventDataState *dep) +{ + ASSERT(!erts_port_task_is_scheduled(&dep->iotask.task)); + erts_free(ERTS_ALC_T_DRV_EV_D_STATE, dep); +} + +static ERTS_INLINE void remember_removed(ErtsDrvEventState *state, struct pollset_info* psi) { #ifdef ERTS_SMP @@ -288,7 +370,7 @@ forget_removed(struct pollset_info* psi) drv_ptr = state->driver.drv_ptr; ASSERT(drv_ptr); state->type = ERTS_EV_TYPE_NONE; - state->flags = 0; + state->flags &= ~ERTS_EV_FLAG_USED; state->driver.drv_ptr = NULL; /* Fall through */ case ERTS_EV_TYPE_NONE: @@ -345,6 +427,10 @@ grow_drv_ev_state(int min_ix) for (i = erts_smp_atomic_read_nob(&drv_ev_state_len); i < new_len; i++) { drv_ev_state[i].fd = (ErtsSysFdType) i; drv_ev_state[i].driver.select = NULL; +#if ERTS_CIO_HAVE_DRV_EVENT + drv_ev_state[i].driver.event = NULL; +#endif + drv_ev_state[i].driver.drv_ptr = NULL; drv_ev_state[i].events = 0; drv_ev_state[i].remove_cnt = 0; drv_ev_state[i].type = ERTS_EV_TYPE_NONE; @@ -365,11 +451,7 @@ grow_drv_ev_state(int min_ix) static ERTS_INLINE void abort_task(Eterm id, ErtsPortTaskHandle *pthp, EventStateType type) { - if (is_nil(id)) { - ASSERT(type == ERTS_EV_TYPE_NONE - || !erts_port_task_is_scheduled(pthp)); - } - else if (erts_port_task_is_scheduled(pthp)) { + if (is_not_nil(id) && erts_port_task_is_scheduled(pthp)) { erts_port_task_abort(pthp); ASSERT(erts_is_port_alive(id)); } @@ -384,7 +466,7 @@ abort_tasks(ErtsDrvEventState *state, int mode) #if ERTS_CIO_HAVE_DRV_EVENT case ERTS_EV_TYPE_DRV_EV: abort_task(state->driver.event->port, - &state->driver.event->task, + &state->driver.event->iotask.task, ERTS_EV_TYPE_DRV_EV); return; #endif @@ -398,14 +480,14 @@ abort_tasks(ErtsDrvEventState *state, int mode) case ERL_DRV_WRITE: ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL); abort_task(state->driver.select->outport, - &state->driver.select->outtask, + &state->driver.select->outiotask.task, state->type); if (mode == ERL_DRV_WRITE) break; case ERL_DRV_READ: ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL); abort_task(state->driver.select->inport, - &state->driver.select->intask, + &state->driver.select->iniotask.task, state->type); break; default: @@ -443,16 +525,14 @@ deselect(ErtsDrvEventState *state, int mode) if (!(state->events)) { switch (state->type) { case ERTS_EV_TYPE_DRV_SEL: - ASSERT(!erts_port_task_is_scheduled(&state->driver.select->intask)); - ASSERT(!erts_port_task_is_scheduled(&state->driver.select->outtask)); - erts_free(ERTS_ALC_T_DRV_SEL_D_STATE, - state->driver.select); + state->driver.select->inport = NIL; + state->driver.select->outport = NIL; break; #if ERTS_CIO_HAVE_DRV_EVENT case ERTS_EV_TYPE_DRV_EV: - ASSERT(!erts_port_task_is_scheduled(&state->driver.event->task)); - erts_free(ERTS_ALC_T_DRV_EV_D_STATE, - state->driver.event); + state->driver.event->port = NIL; + state->driver.event->data = NULL; + state->driver.event->removed_events = (ErtsPollEvents) 0; break; #endif case ERTS_EV_TYPE_NONE: @@ -462,20 +542,297 @@ deselect(ErtsDrvEventState *state, int mode) break; } - state->driver.select = NULL; state->type = ERTS_EV_TYPE_NONE; - state->flags = 0; + state->flags &= ~ERTS_EV_FLAG_USED; remember_removed(state, &pollset); } } - #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS # define IS_FD_UNKNOWN(state) ((state)->type == ERTS_EV_TYPE_NONE && (state)->remove_cnt == 0) #else # define IS_FD_UNKNOWN(state) ((state) == NULL) #endif +static ERTS_INLINE void +check_fd_cleanup(ErtsDrvEventState *state, +#if ERTS_CIO_HAVE_DRV_EVENT + ErtsDrvEventDataState **free_event, +#endif + ErtsDrvSelectDataState **free_select) +{ + erts_aint_t current_cio_time; + + ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(fd_mtx(state->fd))); + + current_cio_time = erts_smp_atomic_read_acqb(&erts_check_io_time); + *free_select = NULL; + if (state->driver.select + && (state->type != ERTS_EV_TYPE_DRV_SEL) + && !is_iotask_active(&state->driver.select->iniotask, current_cio_time) + && !is_iotask_active(&state->driver.select->outiotask, current_cio_time)) { + + *free_select = state->driver.select; + state->driver.select = NULL; + } + +#if ERTS_CIO_HAVE_DRV_EVENT + *free_event = NULL; + if (state->driver.event + && (state->type != ERTS_EV_TYPE_DRV_EV) + && !is_iotask_active(&state->driver.event->iotask, current_cio_time)) { + + *free_event = state->driver.event; + state->driver.event = NULL; + } +#endif + +#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS + if (((state->type != ERTS_EV_TYPE_NONE) + | state->remove_cnt +#if ERTS_CIO_HAVE_DRV_EVENT + | (state->driver.event != NULL) +#endif + | (state->driver.select != NULL)) == 0) { + + hash_erase_drv_ev_state(state); + + } +#endif +} + +static ERTS_INLINE int +check_cleanup_active_fd(ErtsSysFdType fd, +#if ERTS_CIO_DEFER_ACTIVE_EVENTS + ErtsPollControlEntry *pce, + int *pce_ix, +#endif + erts_aint_t current_cio_time) +{ + ErtsDrvEventState *state; + int active = 0; + erts_smp_mtx_t *mtx = fd_mtx(fd); + void *free_select = NULL; +#if ERTS_CIO_HAVE_DRV_EVENT + void *free_event = NULL; +#endif +#if ERTS_CIO_DEFER_ACTIVE_EVENTS + ErtsPollEvents evon = 0, evoff = 0; +#endif + + erts_smp_mtx_lock(mtx); + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + state = &drv_ev_state[(int) fd]; +#else + state = hash_get_drv_ev_state(fd); /* may be NULL! */ + if (state) +#endif + { + if (state->driver.select) { +#if ERTS_CIO_DEFER_ACTIVE_EVENTS + if (is_iotask_active(&state->driver.select->iniotask, current_cio_time)) { + active = 1; + if ((state->events & ERTS_POLL_EV_IN) + && !(state->flags & ERTS_EV_FLAG_DEFER_IN_EV)) { + evoff |= ERTS_POLL_EV_IN; + state->flags |= ERTS_EV_FLAG_DEFER_IN_EV; + } + } + else if (state->flags & ERTS_EV_FLAG_DEFER_IN_EV) { + if (state->events & ERTS_POLL_EV_IN) + evon |= ERTS_POLL_EV_IN; + state->flags &= ~ERTS_EV_FLAG_DEFER_IN_EV; + } + if (is_iotask_active(&state->driver.select->outiotask, current_cio_time)) { + active = 1; + if ((state->events & ERTS_POLL_EV_OUT) + && !(state->flags & ERTS_EV_FLAG_DEFER_OUT_EV)) { + evoff |= ERTS_POLL_EV_OUT; + state->flags |= ERTS_EV_FLAG_DEFER_OUT_EV; + } + } + else if (state->flags & ERTS_EV_FLAG_DEFER_OUT_EV) { + if (state->events & ERTS_POLL_EV_OUT) + evon |= ERTS_POLL_EV_OUT; + state->flags &= ~ERTS_EV_FLAG_DEFER_OUT_EV; + } + if (active) + (void) 0; + else +#else + if (is_iotask_active(&state->driver.select->iniotask, current_cio_time) + || is_iotask_active(&state->driver.select->outiotask, current_cio_time)) + active = 1; + else +#endif + if (state->type != ERTS_EV_TYPE_DRV_SEL) { + free_select = state->driver.select; + state->driver.select = NULL; + } + } + +#if ERTS_CIO_HAVE_DRV_EVENT + if (state->driver.event) { + if (is_iotask_active(&state->driver.event->iotask, current_cio_time)) { +#if ERTS_CIO_DEFER_ACTIVE_EVENTS + ErtsPollEvents evs = state->events & ~state->driver.event->deferred_events; + if (evs) { + evoff |= evs; + state->driver.event->deferred_events |= evs; + } +#endif + active = 1; + } + else if (state->type != ERTS_EV_TYPE_DRV_EV) { + free_event = state->driver.event; + state->driver.event = NULL; + } +#if ERTS_CIO_DEFER_ACTIVE_EVENTS + else { + ErtsPollEvents evs = state->events & state->driver.event->deferred_events; + if (evs) { + evon |= evs; + state->driver.event->deferred_events = 0; + } + } +#endif + + } +#endif + +#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS + if (((state->type != ERTS_EV_TYPE_NONE) | state->remove_cnt | active) == 0) + hash_erase_drv_ev_state(state); +#endif + + } + + erts_smp_mtx_unlock(mtx); + + if (free_select) + free_drv_select_data(free_select); +#if ERTS_CIO_HAVE_DRV_EVENT + if (free_event) + free_drv_event_data(free_event); +#endif + +#if ERTS_CIO_DEFER_ACTIVE_EVENTS + if (evoff) { + ErtsPollControlEntry *pcep = &pce[(*pce_ix)++]; + pcep->fd = fd; + pcep->events = evoff; + pcep->on = 0; + } + if (evon) { + ErtsPollControlEntry *pcep = &pce[(*pce_ix)++]; + pcep->fd = fd; + pcep->events = evon; + pcep->on = 1; + } +#endif + + return active; +} + +static void +check_cleanup_active_fds(erts_aint_t current_cio_time) +{ + int six = pollset.active_fd.six; + int eix = pollset.active_fd.eix; + erts_aint32_t no = erts_smp_atomic32_read_dirty(&pollset.active_fd.no); + int size = pollset.active_fd.size; + int ix = six; +#if ERTS_CIO_DEFER_ACTIVE_EVENTS + /* every fd might add two entries */ + Uint pce_sz = 2*sizeof(ErtsPollControlEntry)*no; + ErtsPollControlEntry *pctrl_entries = (pce_sz + ? erts_alloc(ERTS_ALC_T_TMP, pce_sz) + : NULL); + int pctrl_ix = 0; +#endif + + while (ix != eix) { + ErtsSysFdType fd = pollset.active_fd.array[ix]; + int nix = ix + 1; + if (nix >= size) + nix = 0; + ASSERT(fd != ERTS_SYS_FD_INVALID); + if (!check_cleanup_active_fd(fd, +#if ERTS_CIO_DEFER_ACTIVE_EVENTS + pctrl_entries, + &pctrl_ix, +#endif + current_cio_time)) { + no--; + if (ix == six) { +#ifdef DEBUG + pollset.active_fd.array[ix] = ERTS_SYS_FD_INVALID; +#endif + six = nix; + } + else { + pollset.active_fd.array[ix] = pollset.active_fd.array[six]; +#ifdef DEBUG + pollset.active_fd.array[six] = ERTS_SYS_FD_INVALID; +#endif + six++; + if (six >= size) + six = 0; + } + } + ix = nix; + } + +#if ERTS_CIO_DEFER_ACTIVE_EVENTS + ASSERT(pctrl_ix <= pce_sz/sizeof(ErtsPollControlEntry)); + if (pctrl_ix) + ERTS_CIO_POLL_CTLV(pollset.ps, pctrl_entries, pctrl_ix); + if (pctrl_entries) + erts_free(ERTS_ALC_T_TMP, pctrl_entries); +#endif + + pollset.active_fd.six = six; + pollset.active_fd.eix = eix; + erts_smp_atomic32_set_relb(&pollset.active_fd.no, no); +} + +static ERTS_INLINE void +add_active_fd(ErtsSysFdType fd) +{ + int eix = pollset.active_fd.eix; + int size = pollset.active_fd.size; + + + pollset.active_fd.array[eix] = fd; + + erts_smp_atomic32_set_relb(&pollset.active_fd.no, + (erts_smp_atomic32_read_dirty(&pollset.active_fd.no) + + 1)); + + eix++; + if (eix >= size) + eix = 0; + if (pollset.active_fd.six == eix) { + pollset.active_fd.six = 0; + eix = size; + size += ERTS_ACTIVE_FD_INC; + pollset.active_fd.array = erts_realloc(ERTS_ALC_T_ACTIVE_FD_ARR, + pollset.active_fd.array, + sizeof(ErtsSysFdType)*size); + pollset.active_fd.size = size; +#ifdef DEBUG + { + int i; + for (i = eix + 1; i < size; i++) + pollset.active_fd.array[i] = ERTS_SYS_FD_INVALID; + } +#endif + + } + + pollset.active_fd.eix = eix; +} int ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, @@ -492,6 +849,10 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, ErtsDrvEventState *state; int wake_poller; int ret; +#if ERTS_CIO_HAVE_DRV_EVENT + ErtsDrvEventDataState *free_event = NULL; +#endif + ErtsDrvSelectDataState *free_select = NULL; #ifdef USE_VM_PROBES DTRACE_CHARBUF(name, 64); #endif @@ -593,9 +954,9 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) { if (state->type == ERTS_EV_TYPE_DRV_SEL && !state->events) { state->type = ERTS_EV_TYPE_NONE; - state->flags = 0; - erts_free(ERTS_ALC_T_DRV_SEL_D_STATE, state->driver.select); - state->driver.select = NULL; + state->flags &= ~ERTS_EV_FLAG_USED; + state->driver.select->inport = NIL; + state->driver.select->outport = NIL; } ret = -1; goto done; @@ -613,18 +974,10 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, state->events = new_events; if (ctl_events) { if (on) { - if (state->type == ERTS_EV_TYPE_NONE) { - ErtsDrvSelectDataState *dsdsp - = erts_alloc(ERTS_ALC_T_DRV_SEL_D_STATE, - sizeof(ErtsDrvSelectDataState)); - dsdsp->inport = NIL; - dsdsp->outport = NIL; - erts_port_task_handle_init(&dsdsp->intask); - erts_port_task_handle_init(&dsdsp->outtask); - ASSERT(state->driver.select == NULL); - state->driver.select = dsdsp; + if (!state->driver.select) + state->driver.select = alloc_drv_select_data(); + if (state->type == ERTS_EV_TYPE_NONE) state->type = ERTS_EV_TYPE_DRV_SEL; - } ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL); if (ctl_events & ERTS_POLL_EV_IN) state->driver.select->inport = id; @@ -645,17 +998,12 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, state->driver.select->outport = NIL; } if (new_events == 0) { - ASSERT(!erts_port_task_is_scheduled(&state->driver.select->intask)); - ASSERT(!erts_port_task_is_scheduled(&state->driver.select->outtask)); if (old_events != 0) { remember_removed(state, &pollset); } if ((mode & ERL_DRV_USE) || !(state->flags & ERTS_EV_FLAG_USED)) { state->type = ERTS_EV_TYPE_NONE; - state->flags = 0; - erts_free(ERTS_ALC_T_DRV_SEL_D_STATE, - state->driver.select); - state->driver.select = NULL; + state->flags &= ~ERTS_EV_FLAG_USED; } /*else keep it, as fd will probably be selected upon again */ } @@ -686,13 +1034,15 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, ret = 0; -done:; -#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS - if (state->type == ERTS_EV_TYPE_NONE && state->remove_cnt == 0) { - hash_erase_drv_ev_state(state); - } +done: + + check_fd_cleanup(state, +#if ERTS_CIO_HAVE_DRV_EVENT + &free_event, #endif -done_unknown: + &free_select); + +done_unknown: erts_smp_mtx_unlock(fd_mtx(fd)); if (stop_select_fn) { int was_unmasked = erts_block_fpe(); @@ -700,6 +1050,12 @@ done_unknown: (*stop_select_fn)(e, NULL); erts_unblock_fpe(was_unmasked); } + if (free_select) + free_drv_select_data(free_select); +#if ERTS_CIO_HAVE_DRV_EVENT + if (free_event) + free_drv_event_data(free_event); +#endif return ret; } @@ -719,6 +1075,10 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix, ErtsDrvEventState *state; int do_wake = 0; int ret; +#if ERTS_CIO_HAVE_DRV_EVENT + ErtsDrvEventDataState *free_event; +#endif + ErtsDrvSelectDataState *free_select; Port *prt = erts_drvport2port(ix); if (prt == ERTS_INVALID_ERL_DRV_PORT) @@ -799,10 +1159,8 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix, state->driver.event->removed_events |= remove_events; } else { - state->driver.event - = erts_alloc(ERTS_ALC_T_DRV_EV_D_STATE, - sizeof(ErtsDrvEventDataState)); - erts_port_task_handle_init(&state->driver.event->task); + if (!state->driver.event) + state->driver.event = alloc_drv_event_data(); state->driver.event->port = id; state->driver.event->removed_events = (ErtsPollEvents) 0; state->type = ERTS_EV_TYPE_DRV_EV; @@ -812,10 +1170,10 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix, else { if (state->type == ERTS_EV_TYPE_DRV_EV) { abort_tasks(state, 0); - erts_free(ERTS_ALC_T_DRV_EV_D_STATE, - state->driver.event); + state->driver.event->port = NIL; + state->driver.event->data = NULL; + state->driver.event->removed_events = (ErtsPollEvents) 0; } - state->driver.select = NULL; state->type = ERTS_EV_TYPE_NONE; remember_removed(state, &pollset); } @@ -825,12 +1183,22 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix, ret = 0; done: -#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS - if (state->type == ERTS_EV_TYPE_NONE && state->remove_cnt == 0) { - hash_erase_drv_ev_state(state); - } + + check_fd_cleanup(state, +#if ERTS_CIO_HAVE_DRV_EVENT + &free_event, #endif + &free_select); + erts_smp_mtx_unlock(fd_mtx(fd)); + + if (free_select) + free_drv_select_data(free_select); +#if ERTS_CIO_HAVE_DRV_EVENT + if (free_event) + free_drv_event_data(free_event); +#endif + return ret; #endif } @@ -1027,7 +1395,7 @@ steal_pending_stop_select(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix, * In either case stop_select should not be called. */ state->type = ERTS_EV_TYPE_NONE; - state->flags = 0; + state->flags &= ~ERTS_EV_FLAG_USED; if (state->driver.drv_ptr->handle) { erts_ddll_dereference_driver(state->driver.drv_ptr->handle); } @@ -1099,38 +1467,103 @@ event_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data #endif #endif +static ERTS_INLINE int +io_task_schedule_allowed(ErtsDrvEventState *state, + ErtsPortTaskType type, + erts_aint_t current_cio_time) +{ + ErtsIoTask *io_task; + + switch (type) { + case ERTS_PORT_TASK_INPUT: + if (!state->driver.select) + return 0; +#if ERTS_CIO_HAVE_DRV_EVENT + if (state->driver.event) + return 0; +#endif + io_task = &state->driver.select->iniotask; + break; + case ERTS_PORT_TASK_OUTPUT: + if (!state->driver.select) + return 0; +#if ERTS_CIO_HAVE_DRV_EVENT + if (state->driver.event) + return 0; +#endif + io_task = &state->driver.select->outiotask; + break; +#if ERTS_CIO_HAVE_DRV_EVENT + case ERTS_PORT_TASK_EVENT: + if (!state->driver.event) + return 0; + if (state->driver.select) + return 0; + io_task = &state->driver.event->iotask; + break; +#endif + default: + ERTS_INTERNAL_ERROR("Invalid I/O-task type"); + return 0; + } + + return !is_iotask_active(io_task, current_cio_time); +} + static ERTS_INLINE void -iready(Eterm id, ErtsDrvEventState *state) +iready(Eterm id, ErtsDrvEventState *state, erts_aint_t current_cio_time) { - if (erts_port_task_schedule(id, - &state->driver.select->intask, - ERTS_PORT_TASK_INPUT, - (ErlDrvEvent) state->fd) != 0) { - stale_drv_select(id, state, ERL_DRV_READ); + if (io_task_schedule_allowed(state, + ERTS_PORT_TASK_INPUT, + current_cio_time)) { + ErtsIoTask *iotask = &state->driver.select->iniotask; + erts_smp_atomic_set_nob(&iotask->executed_time, current_cio_time); + if (erts_port_task_schedule(id, + &iotask->task, + ERTS_PORT_TASK_INPUT, + (ErlDrvEvent) state->fd) != 0) { + stale_drv_select(id, state, ERL_DRV_READ); + } + add_active_fd(state->fd); } } static ERTS_INLINE void -oready(Eterm id, ErtsDrvEventState *state) +oready(Eterm id, ErtsDrvEventState *state, erts_aint_t current_cio_time) { - if (erts_port_task_schedule(id, - &state->driver.select->outtask, - ERTS_PORT_TASK_OUTPUT, - (ErlDrvEvent) state->fd) != 0) { - stale_drv_select(id, state, ERL_DRV_WRITE); + if (io_task_schedule_allowed(state, + ERTS_PORT_TASK_OUTPUT, + current_cio_time)) { + ErtsIoTask *iotask = &state->driver.select->outiotask; + erts_smp_atomic_set_nob(&iotask->executed_time, current_cio_time); + if (erts_port_task_schedule(id, + &iotask->task, + ERTS_PORT_TASK_OUTPUT, + (ErlDrvEvent) state->fd) != 0) { + stale_drv_select(id, state, ERL_DRV_WRITE); + } + add_active_fd(state->fd); } } #if ERTS_CIO_HAVE_DRV_EVENT static ERTS_INLINE void -eready(Eterm id, ErtsDrvEventState *state, ErlDrvEventData event_data) +eready(Eterm id, ErtsDrvEventState *state, ErlDrvEventData event_data, + erts_aint_t current_cio_time) { - if (erts_port_task_schedule(id, - &state->driver.event->task, - ERTS_PORT_TASK_EVENT, - (ErlDrvEvent) state->fd, - event_data) != 0) { - stale_drv_select(id, state, 0); + if (io_task_schedule_allowed(state, + ERTS_PORT_TASK_EVENT, + current_cio_time)) { + ErtsIoTask *iotask = &state->driver.event->iotask; + erts_smp_atomic_set_nob(&iotask->executed_time, current_cio_time); + if (erts_port_task_schedule(id, + &iotask->task, + ERTS_PORT_TASK_EVENT, + (ErlDrvEvent) state->fd, + event_data) != 0) { + stale_drv_select(id, state, 0); + } + add_active_fd(state->fd); } } #endif @@ -1161,10 +1594,11 @@ ERTS_CIO_EXPORT(erts_check_io_interrupt_timed)(int set, void ERTS_CIO_EXPORT(erts_check_io)(int do_wait) { - ErtsPollResFd pollres[256]; + ErtsPollResFd *pollres; int pollres_len; SysTimeval wait_time; int poll_ret, i; + erts_aint_t current_cio_time; restart: @@ -1181,10 +1615,24 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) wait_time.tv_usec = 0; } + /* + * No need for an atomic inc op when incrementing + * erts_check_io_time, since only one thread can + * check io at a time. + */ + current_cio_time = erts_smp_atomic_read_dirty(&erts_check_io_time); + current_cio_time++; + erts_smp_atomic_set_relb(&erts_check_io_time, current_cio_time); + + check_cleanup_active_fds(current_cio_time); + #ifdef ERTS_ENABLE_LOCK_CHECK erts_lc_check_exact(NULL, 0); /* No locks should be locked */ #endif - pollres_len = sizeof(pollres)/sizeof(ErtsPollResFd); + + pollres_len = erts_smp_atomic32_read_dirty(&pollset.active_fd.no) + ERTS_CHECK_IO_POLL_RES_LEN; + + pollres = erts_alloc(ERTS_ALC_T_TMP, sizeof(ErtsPollResFd)*pollres_len); erts_smp_atomic_set_nob(&pollset.in_poll_wait, 1); @@ -1204,6 +1652,7 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) if (poll_ret != 0) { erts_smp_atomic_set_nob(&pollset.in_poll_wait, 0); forget_removed(&pollset); + erts_free(ERTS_ALC_T_TMP, pollres); if (poll_ret == EAGAIN) { goto restart; } @@ -1263,15 +1712,15 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) if ((revents & ERTS_POLL_EV_IN) || (!(revents & ERTS_POLL_EV_OUT) && state->events & ERTS_POLL_EV_IN)) { - iready(state->driver.select->inport, state); + iready(state->driver.select->inport, state, current_cio_time); } else if (state->events & ERTS_POLL_EV_OUT) { - oready(state->driver.select->outport, state); + oready(state->driver.select->outport, state, current_cio_time); } } else if (revents & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) { if (revents & ERTS_POLL_EV_OUT) { - oready(state->driver.select->outport, state); + oready(state->driver.select->outport, state, current_cio_time); } /* Someone might have deselected input since revents was read (true also on the non-smp emulator since @@ -1279,7 +1728,7 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) revents... */ revents &= ~(~state->events & ERTS_POLL_EV_IN); if (revents & ERTS_POLL_EV_IN) { - iready(state->driver.select->inport, state); + iready(state->driver.select->inport, state, current_cio_time); } } else if (revents & ERTS_POLL_EV_NVAL) { @@ -1287,6 +1736,7 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) state->driver.select->inport, state->driver.select->outport, state->events); + add_active_fd(state->fd); } break; } @@ -1304,8 +1754,7 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) if (revents) { event_data->events = state->events; event_data->revents = revents; - - eready(state->driver.event->port, state, event_data); + eready(state->driver.event->port, state, event_data, current_cio_time); } break; } @@ -1323,6 +1772,7 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) (int) state->type); ASSERT(0); deselect(state, 0); + add_active_fd(state->fd); break; } } @@ -1334,6 +1784,7 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait) } erts_smp_atomic_set_nob(&pollset.in_poll_wait, 0); + erts_free(ERTS_ALC_T_TMP, pollres); forget_removed(&pollset); } @@ -1469,10 +1920,27 @@ static void drv_ev_state_free(void *des) void ERTS_CIO_EXPORT(erts_init_check_io)(void) { + erts_smp_atomic_init_nob(&erts_check_io_time, 0); erts_smp_atomic_init_nob(&pollset.in_poll_wait, 0); + ERTS_CIO_POLL_INIT(); pollset.ps = ERTS_CIO_NEW_POLLSET(); + pollset.active_fd.six = 0; + pollset.active_fd.eix = 0; + erts_smp_atomic32_init_nob(&pollset.active_fd.no, 0); + pollset.active_fd.size = ERTS_ACTIVE_FD_INC; + pollset.active_fd.array = erts_alloc(ERTS_ALC_T_ACTIVE_FD_ARR, + sizeof(ErtsSysFdType)*ERTS_ACTIVE_FD_INC); +#ifdef DEBUG + { + int i; + for (i = 0; i < ERTS_ACTIVE_FD_INC; i++) + pollset.active_fd.array[i] = ERTS_SYS_FD_INVALID; + } +#endif + + #ifdef ERTS_SMP init_removed_fd_alloc(); pollset.removed_list = NULL; @@ -1548,12 +2016,27 @@ Eterm ERTS_CIO_EXPORT(erts_check_io_info)(void *proc) { Process *p = (Process *) proc; - Eterm tags[15], values[15], res; + Eterm tags[16], values[16], res; Uint sz, *szp, *hp, **hpp, memory_size; Sint i; ErtsPollInfo pi; - - ERTS_CIO_POLL_INFO(pollset.ps, &pi); + erts_aint_t cio_time = erts_smp_atomic_read_acqb(&erts_check_io_time); + int active_fds = (int) erts_smp_atomic32_read_acqb(&pollset.active_fd.no); + + while (1) { + erts_aint_t post_cio_time; + int post_active_fds; + + ERTS_CIO_POLL_INFO(pollset.ps, &pi); + + post_cio_time = erts_smp_atomic_read_mb(&erts_check_io_time); + post_active_fds = (int) erts_smp_atomic32_read_acqb(&pollset.active_fd.no); + if (cio_time == post_cio_time && active_fds == post_active_fds) + break; + cio_time = post_cio_time; + active_fds = post_active_fds; + } + memory_size = pi.memory_size; #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS memory_size += sizeof(ErtsDrvEventState) * erts_smp_atomic_read_nob(&drv_ev_state_len); @@ -1617,6 +2100,9 @@ ERTS_CIO_EXPORT(erts_check_io_info)(void *proc) tags[i] = erts_bld_atom(hpp, szp, "max_fds"); values[i++] = erts_bld_uint(hpp, szp, (Uint) pi.max_fds); + tags[i] = erts_bld_atom(hpp, szp, "active_fds"); + values[i++] = erts_bld_uint(hpp, szp, (Uint) active_fds); + #ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS tags[i] = erts_bld_atom(hpp, szp, "no_avoided_wakeups"); values[i++] = erts_bld_uint(hpp, szp, (Uint) pi.no_avoided_wakeups); @@ -1671,6 +2157,8 @@ print_events(ErtsPollEvents ev) typedef struct { int used_fds; int num_errors; + int no_driver_select_structs; + int no_driver_event_structs; #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS int internal_fds; ErtsPollEvents *epep; @@ -1693,6 +2181,13 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters) struct stat stat_buf; #endif + if (state->driver.select) + counters->no_driver_select_structs++; +#if ERTS_CIO_HAVE_DRV_EVENT + if (state->driver.event) + counters->no_driver_event_structs++; +#endif + #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS if (state->events || ep_events) { if (ep_events & ERTS_POLL_EV_NVAL) { @@ -1831,6 +2326,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters) } } } +#if ERTS_CIO_HAVE_DRV_EVENT else if (state->type == ERTS_EV_TYPE_DRV_EV) { Eterm id; erts_printf("driver_event "); @@ -1866,6 +2362,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters) erts_free_port_names(pnp); } } +#endif #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS else if (internal) { erts_printf("internal "); @@ -1905,7 +2402,7 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters) } int -ERTS_CIO_EXPORT(erts_check_io_debug)(void) +ERTS_CIO_EXPORT(erts_check_io_debug)(ErtsCheckIoDebugInfo *ciodip) { #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS int fd, len; @@ -1915,6 +2412,10 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void) ErtsDrvEventState null_des; null_des.driver.select = NULL; +#if ERTS_CIO_HAVE_DRV_EVENT + null_des.driver.event = NULL; +#endif + null_des.driver.drv_ptr = NULL; null_des.events = 0; null_des.remove_cnt = 0; null_des.type = ERTS_EV_TYPE_NONE; @@ -1935,6 +2436,8 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void) #endif counters.used_fds = 0; counters.num_errors = 0; + counters.no_driver_select_structs = 0; + counters.no_driver_event_structs = 0; #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS len = erts_smp_atomic_read_nob(&drv_ev_state_len); @@ -1951,8 +2454,16 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void) erts_smp_thr_progress_unblock(); + ciodip->no_used_fds = counters.used_fds; + ciodip->no_driver_select_structs = counters.no_driver_select_structs; + ciodip->no_driver_event_structs = counters.no_driver_event_structs; + erts_printf("\n"); erts_printf("used fds=%d\n", counters.used_fds); + erts_printf("Number of driver_select() structures=%d\n", counters.no_driver_select_structs); +#if ERTS_CIO_HAVE_DRV_EVENT + erts_printf("Number of driver_event() structures=%d\n", counters.no_driver_event_structs); +#endif #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS erts_printf("internal fds=%d\n", counters.internal_fds); #endif @@ -1961,6 +2472,7 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(void) #ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS erts_free(ERTS_ALC_T_TMP, (void *) counters.epep); #endif + return counters.num_errors; } diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h index edab7947ba..d01297d55c 100644 --- a/erts/emulator/sys/common/erl_check_io.h +++ b/erts/emulator/sys/common/erl_check_io.h @@ -26,6 +26,7 @@ #ifndef ERL_CHECK_IO_H__ #define ERL_CHECK_IO_H__ +#include "sys.h" #include "erl_sys_driver.h" #ifdef ERTS_ENABLE_KERNEL_POLL @@ -52,8 +53,8 @@ void erts_check_io_kp(int); void erts_check_io_nkp(int); void erts_init_check_io_kp(void); void erts_init_check_io_nkp(void); -int erts_check_io_debug_kp(void); -int erts_check_io_debug_nkp(void); +int erts_check_io_debug_kp(ErtsCheckIoDebugInfo *); +int erts_check_io_debug_nkp(ErtsCheckIoDebugInfo *); #else /* !ERTS_ENABLE_KERNEL_POLL */ @@ -70,6 +71,27 @@ void erts_init_check_io(void); #endif +extern erts_smp_atomic_t erts_check_io_time; + +typedef struct { + ErtsPortTaskHandle task; + erts_smp_atomic_t executed_time; +} ErtsIoTask; + +ERTS_GLB_INLINE void erts_io_notify_port_task_executed(ErtsPortTaskHandle *pthp); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_io_notify_port_task_executed(ErtsPortTaskHandle *pthp) +{ + ErtsIoTask *itp = (ErtsIoTask *) (((char *) pthp) - offsetof(ErtsIoTask, task)); + erts_aint_t ci_time = erts_smp_atomic_read_acqb(&erts_check_io_time); + erts_smp_atomic_set_relb(&itp->executed_time, ci_time); +} + +#endif + #endif /* ERL_CHECK_IO_H__ */ #if !defined(ERL_CHECK_IO_C__) && !defined(ERTS_ALLOC_C__) @@ -81,6 +103,16 @@ void erts_init_check_io(void); #include "erl_poll.h" #include "erl_port_task.h" +#ifdef __WIN32__ +/* + * Current erts_poll implementation for Windows cannot handle + * active events in the set of events polled. + */ +# define ERTS_CIO_DEFER_ACTIVE_EVENTS 1 +#else +# define ERTS_CIO_DEFER_ACTIVE_EVENTS 0 +#endif + /* * ErtsDrvEventDataState is used by driver_event() which is almost never * used. We allocate ErtsDrvEventDataState separate since we dont wan't @@ -91,13 +123,16 @@ typedef struct { Eterm port; ErlDrvEventData data; ErtsPollEvents removed_events; - ErtsPortTaskHandle task; +#if ERTS_CIO_DEFER_ACTIVE_EVENTS + ErtsPollEvents deferred_events; +#endif + ErtsIoTask iotask; } ErtsDrvEventDataState; typedef struct { Eterm inport; Eterm outport; - ErtsPortTaskHandle intask; - ErtsPortTaskHandle outtask; + ErtsIoTask iniotask; + ErtsIoTask outiotask; } ErtsDrvSelectDataState; #endif /* #ifndef ERL_CHECK_IO_INTERNAL__ */ diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index 0a58a625b2..aa412a20c8 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -2157,7 +2157,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, #ifdef ERTS_POLL_DEBUG_PRINT erts_printf("Entering erts_poll_wait(), timeout=%d\n", - (int) tv->tv_sec*1000 + tv->tv_usec/1000); + (int) tvp->tv_sec*1000 + tvp->tv_usec/1000); #endif if (ERTS_POLLSET_SET_POLLED_CHK(ps)) { diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c index e3ba741058..e63f0bda54 100644 --- a/erts/emulator/sys/common/erl_sys_common_misc.c +++ b/erts/emulator/sys/common/erl_sys_common_misc.c @@ -44,6 +44,14 @@ #endif #endif +/* + * erts_check_io_time is used by the erl_check_io implementation. The + * global erts_check_io_time variable is declared here since there + * (often) exist two versions of erl_check_io (kernel-poll and + * non-kernel-poll), and we dont want two versions of this variable. + */ +erts_smp_atomic_t erts_check_io_time; + /* Written once and only once */ static int filename_encoding = ERL_FILENAME_UNKNOWN; diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h index 176fc049a7..c3dba69acb 100644 --- a/erts/emulator/sys/unix/erl_unix_sys.h +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -135,9 +135,6 @@ /* File descriptors are numbers anc consecutively allocated on Unix */ #define ERTS_SYS_CONTINOUS_FD_NUMBERS -#define HAVE_ERTS_CHECK_IO_DEBUG -int erts_check_io_debug(void); - #ifndef ERTS_SMP # undef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT # define ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT @@ -230,8 +227,13 @@ extern void sys_stop_cat(void); */ #ifdef USE_ISINF_ISNAN /* simulate finite() */ -# define finite(f) (!isinf(f) && !isnan(f)) -# define HAVE_FINITE +# define isfinite(f) (!isinf(f) && !isnan(f)) +# define HAVE_ISFINITE +#elif defined(isfinite) && !defined(HAVE_ISFINITE) +# define HAVE_ISFINITE +#elif !defined(HAVE_ISFINITE) && defined(HAVE_FINITE) +# define isfinite finite +# define HAVE_ISFINITE #endif #ifdef NO_FPE_SIGNALS @@ -241,7 +243,7 @@ extern void sys_stop_cat(void); #define erts_thread_init_fp_exception() do{}while(0) #endif # define __ERTS_FP_CHECK_INIT(fpexnp) do {} while (0) -# define __ERTS_FP_ERROR(fpexnp, f, Action) if (!finite(f)) { Action; } else {} +# define __ERTS_FP_ERROR(fpexnp, f, Action) if (!isfinite(f)) { Action; } else {} # define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) __ERTS_FP_ERROR(fpexnp, f, Action) # define __ERTS_SAVE_FP_EXCEPTION(fpexnp) # define __ERTS_RESTORE_FP_EXCEPTION(fpexnp) @@ -305,7 +307,7 @@ static __inline__ void __ERTS_FP_CHECK_INIT(volatile unsigned long *fp_exception code to always throw floating-point exceptions on errors. */ static __inline__ int erts_check_fpe_thorough(volatile unsigned long *fp_exception, double f) { - return erts_check_fpe(fp_exception, f) || !finite(f); + return erts_check_fpe(fp_exception, f) || !isfinite(f); } # define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) \ do { if (erts_check_fpe_thorough((fpexnp),(f))) { Action; } } while (0) diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index c3d7440409..5de0c281c4 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -34,6 +34,7 @@ #include <termios.h> #include <ctype.h> #include <sys/utsname.h> +#include <sys/select.h> #ifdef ISC32 #include <sys/bsdtypes.h> @@ -91,8 +92,10 @@ static erts_smp_rwmtx_t environ_rwmtx; # else # define CHLDWTHR 0 # endif +# define FDBLOCK 1 #else # define CHLDWTHR 0 +# define FDBLOCK 0 #endif /* * [OTP-3906] @@ -121,6 +124,15 @@ struct ErtsSysReportExit_ { #endif }; +/* Used by the fd driver iff the fd could not be set to non-blocking */ +typedef struct ErtsSysBlocking_ { + ErlDrvPDL pdl; + int res; + int err; + unsigned int pkey; +} ErtsSysBlocking; + + /* This data is shared by these drivers - initialized by spawn_init() */ static struct driver_data { ErlDrvPort port_num; @@ -129,6 +141,8 @@ static struct driver_data { int pid; int alive; int status; + int terminating; + ErtsSysBlocking *blocking; } *driver_data; /* indexed by fd */ static ErtsSysReportExit *report_exit_list; @@ -284,7 +298,7 @@ struct { void (*check_io)(int); Uint (*size)(void); Eterm (*info)(void *); - int (*check_io_debug)(void); + int (*check_io_debug)(ErtsCheckIoDebugInfo *); } io_func = {0}; @@ -306,9 +320,9 @@ Eterm erts_check_io_info(void *p) } int -erts_check_io_debug(void) +erts_check_io_debug(ErtsCheckIoDebugInfo *ip) { - return (*io_func.check_io_debug)(); + return (*io_func.check_io_debug)(ip); } @@ -1108,11 +1122,16 @@ void fini_getenv_state(GETENV_STATE *state) /* Driver interfaces */ static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*); +#if FDBLOCK +static void fd_async(void *); +static void fd_ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data); +#endif static ErlDrvSSizeT fd_control(ErlDrvData, unsigned int, char *, ErlDrvSizeT, char **, ErlDrvSizeT); static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*); static int spawn_init(void); static void fd_stop(ErlDrvData); +static void fd_flush(ErlDrvData); static void stop(ErlDrvData); static void ready_input(ErlDrvData, ErlDrvEvent); static void ready_output(ErlDrvData, ErlDrvEvent); @@ -1157,8 +1176,12 @@ struct erl_drv_entry fd_driver_entry = { fd_control, NULL, outputv, - NULL, /* ready_async */ - NULL, /* flush */ +#if FDBLOCK + fd_ready_async, /* ready_async */ +#else + NULL, +#endif + fd_flush, /* flush */ NULL, /* call */ NULL, /* event */ ERL_DRV_EXTENDED_MARKER, @@ -1212,13 +1235,28 @@ static RETSIGTYPE onchld(int signum) #endif } +static int set_blocking_data(struct driver_data *dd) { + + dd->blocking = erts_alloc(ERTS_ALC_T_SYS_BLOCKING, sizeof(ErtsSysBlocking)); + + erts_smp_atomic_add_nob(&sys_misc_mem_sz, sizeof(ErtsSysBlocking)); + + dd->blocking->pdl = driver_pdl_create(dd->port_num); + dd->blocking->res = 0; + dd->blocking->err = 0; + dd->blocking->pkey = driver_async_port_key(dd->port_num); + + return 1; +} + static int set_driver_data(ErlDrvPort port_num, int ifd, int ofd, int packet_bytes, int read_write, int exit_status, - int pid) + int pid, + int is_blocking) { Port *prt; ErtsSysReportExit *report_exit; @@ -1250,8 +1288,13 @@ static int set_driver_data(ErlDrvPort port_num, driver_data[ifd].pid = pid; driver_data[ifd].alive = 1; driver_data[ifd].status = 0; + driver_data[ifd].terminating = 0; + driver_data[ifd].blocking = NULL; if (read_write & DO_WRITE) { driver_data[ifd].ofd = ofd; + if (is_blocking && FDBLOCK) + if (!set_blocking_data(driver_data+ifd)) + return -1; if (ifd != ofd) driver_data[ofd] = driver_data[ifd]; /* structure copy */ } else { /* DO_READ only */ @@ -1267,6 +1310,11 @@ static int set_driver_data(ErlDrvPort port_num, driver_data[ofd].pid = pid; driver_data[ofd].alive = 1; driver_data[ofd].status = 0; + driver_data[ofd].terminating = 0; + driver_data[ofd].blocking = NULL; + if (is_blocking && FDBLOCK) + if (!set_blocking_data(driver_data+ofd)) + return -1; return(ofd); } } @@ -1276,6 +1324,7 @@ static int spawn_init() int i; #if CHLDWTHR erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER; + thr_opts.detached = 0; thr_opts.suggested_stack_size = 0; /* Smallest possible */ #endif @@ -1755,7 +1804,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op } res = set_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, - opts->read_write, opts->exit_status, pid); + opts->read_write, opts->exit_status, pid, 0); /* Don't unblock SIGCHLD until now, since the call above must first complete putting away the info about our new subprocess. */ unblock_signals(); @@ -1840,6 +1889,7 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) { ErlDrvData res; + int non_blocking = 0; if (((opts->read_write & DO_READ) && opts->ifd >= max_files) || ((opts->read_write & DO_WRITE) && opts->ofd >= max_files)) @@ -1912,6 +1962,20 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, * case - it can be called with any old pre-existing file descriptors, * the relations between which (if they're even two) we can only guess * at - still, we try our best... + * + * Added note OTP 18: Some systems seem to use stdout/stderr to log data + * using unix pipes, so we cannot allow the system to block on a write. + * Therefore we use an async thread to write the data to fd's that could + * not be set to non-blocking. When no async threads are available we + * fall back on the old behaviour. + * + * Also the guarantee about what is delivered to the OS has changed. + * Pre 18 the fd driver did no flushing of data before terminating. + * Now it does. This is because we want to be able to guarantee that things + * such as escripts and friends really have outputted all data before + * terminating. This could potentially block the termination of the system + * for a very long time, but if the user wants to terminate fast she should + * use erlang:halt with flush=false. */ if (opts->read_write & DO_READ) { @@ -1934,6 +1998,7 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, imagine a scenario where setting non-blocking mode here would cause problems - go ahead and do it. */ + non_blocking = 1; SET_NONBLOCKING(opts->ofd); } else { /* output fd is a tty, input fd isn't */ @@ -1976,6 +2041,7 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, (nfd = open(tty, O_WRONLY)) != -1) { dup2(nfd, opts->ofd); close(nfd); + non_blocking = 1; SET_NONBLOCKING(opts->ofd); } } @@ -1984,8 +2050,9 @@ static ErlDrvData fd_start(ErlDrvPort port_num, char* name, } CHLD_STAT_LOCK; res = (ErlDrvData)(long)set_driver_data(port_num, opts->ifd, opts->ofd, - opts->packet_bytes, - opts->read_write, 0, -1); + opts->packet_bytes, + opts->read_write, 0, -1, + !non_blocking); CHLD_STAT_UNLOCK; return res; } @@ -2011,14 +2078,30 @@ static void nbio_stop_fd(ErlDrvPort prt, int fd) SET_BLOCKING(fd); } -static void fd_stop(ErlDrvData fd) /* Does not close the fds */ +static void fd_stop(ErlDrvData ev) /* Does not close the fds */ { int ofd; + int fd = (int)(long)ev; + ErlDrvPort prt = driver_data[fd].port_num; - nbio_stop_fd(driver_data[(int)(long)fd].port_num, (int)(long)fd); - ofd = driver_data[(int)(long)fd].ofd; - if (ofd != (int)(long)fd && ofd != -1) - nbio_stop_fd(driver_data[(int)(long)fd].port_num, (int)(long)ofd); +#if FDBLOCK + if (driver_data[fd].blocking) { + erts_free(ERTS_ALC_T_SYS_BLOCKING,driver_data[fd].blocking); + driver_data[fd].blocking = NULL; + erts_smp_atomic_add_nob(&sys_misc_mem_sz, -1*sizeof(ErtsSysBlocking)); + } +#endif + + nbio_stop_fd(prt, fd); + ofd = driver_data[fd].ofd; + if (ofd != fd && ofd != -1) + nbio_stop_fd(prt, ofd); +} + +static void fd_flush(ErlDrvData fd) +{ + if (!driver_data[(int)(long)fd].terminating) + driver_data[(int)(long)fd].terminating = 1; } static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name, @@ -2041,8 +2124,8 @@ static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name, CHLD_STAT_LOCK; res = (ErlDrvData)(long)set_driver_data(port_num, fd, fd, - opts->packet_bytes, - opts->read_write, 0, -1); + opts->packet_bytes, + opts->read_write, 0, -1, 0); CHLD_STAT_UNLOCK; return res; } @@ -2079,6 +2162,7 @@ static void stop(ErlDrvData fd) } } +/* used by fd_driver */ static void outputv(ErlDrvData e, ErlIOVec* ev) { int fd = (int)(long)e; @@ -2104,12 +2188,21 @@ static void outputv(ErlDrvData e, ErlIOVec* ev) ev->iov[0].iov_base = lbp; ev->iov[0].iov_len = pb; ev->size += pb; + + if (driver_data[fd].blocking && FDBLOCK) + driver_pdl_lock(driver_data[fd].blocking->pdl); + if ((sz = driver_sizeq(ix)) > 0) { driver_enqv(ix, ev, 0); + + if (driver_data[fd].blocking && FDBLOCK) + driver_pdl_unlock(driver_data[fd].blocking->pdl); + if (sz + ev->size >= (1 << 13)) set_busy_port(ix, 1); } - else { + else if (!driver_data[fd].blocking || !FDBLOCK) { + /* We try to write directly if the fd in non-blocking */ int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize; n = writev(ofd, (const void *) (ev->iov), vsize); @@ -2125,10 +2218,22 @@ static void outputv(ErlDrvData e, ErlIOVec* ev) driver_enqv(ix, ev, n); /* n is the skip value */ driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1); } +#if FDBLOCK + else { + if (ev->size != 0) { + driver_enqv(ix, ev, 0); + driver_pdl_unlock(driver_data[fd].blocking->pdl); + driver_async(ix, &driver_data[fd].blocking->pkey, + fd_async, driver_data+fd, NULL); + } else { + driver_pdl_unlock(driver_data[fd].blocking->pdl); + } + } +#endif /* return 0;*/ } - +/* Used by spawn_driver and vanilla driver */ static void output(ErlDrvData e, char* buf, ErlDrvSizeT len) { int fd = (int)(long)e; @@ -2191,6 +2296,23 @@ static int port_inp_failure(ErlDrvPort port_num, int ready_fd, int res) ASSERT(res <= 0); (void) driver_select(port_num, ready_fd, ERL_DRV_READ|ERL_DRV_WRITE, 0); clear_fd_data(ready_fd); + + if (driver_data[ready_fd].blocking && FDBLOCK) { + driver_pdl_lock(driver_data[ready_fd].blocking->pdl); + if (driver_sizeq(driver_data[ready_fd].port_num) > 0) { + driver_pdl_unlock(driver_data[ready_fd].blocking->pdl); + /* We have stuff in the output queue, so we just + set the state to terminating and wait for fd_async_ready + to terminate the port */ + if (res == 0) + driver_data[ready_fd].terminating = 2; + else + driver_data[ready_fd].terminating = -err; + return 0; + } + driver_pdl_unlock(driver_data[ready_fd].blocking->pdl); + } + if (res == 0) { if (driver_data[ready_fd].report_exit) { CHLD_STAT_LOCK; @@ -2241,6 +2363,7 @@ static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) port_num = driver_data[fd].port_num; packet_bytes = driver_data[fd].packet_bytes; + if (packet_bytes == 0) { byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, ERTS_SYS_READ_BUF_SZ); @@ -2364,6 +2487,8 @@ static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd) if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) { driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); + if (driver_data[fd].terminating) + driver_failure_atom(driver_data[fd].port_num,"normal"); return; /* 0; */ } vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize; @@ -2389,6 +2514,82 @@ static void stop_select(ErlDrvEvent fd, void* _) close((int)fd); } +#if FDBLOCK + +static void +fd_async(void *async_data) +{ + int res; + struct driver_data *dd = (struct driver_data*)async_data; + SysIOVec *iov0; + SysIOVec *iov; + int iovlen; + int iovcnt; + int p; + /* much of this code is stolen from efile_drv:invoke_writev */ + driver_pdl_lock(dd->blocking->pdl); + iov0 = driver_peekq(dd->port_num, &iovlen); + /* Calculate iovcnt */ + for (p = 0, iovcnt = 0; iovcnt < iovlen; + p += iov0[iovcnt++].iov_len) + ; + iov = erts_alloc_fnf(ERTS_ALC_T_SYS_WRITE_BUF, + sizeof(SysIOVec)*iovcnt); + if (!iov) { + res = -1; + errno = ENOMEM; + erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov); + driver_pdl_unlock(dd->blocking->pdl); + } else { + memcpy(iov,iov0,iovcnt*sizeof(SysIOVec)); + driver_pdl_unlock(dd->blocking->pdl); + + res = writev(dd->ofd, iov, iovlen); + + erts_free(ERTS_ALC_T_SYS_WRITE_BUF, iov); + } + dd->blocking->res = res; + dd->blocking->err = errno; +} + +void fd_ready_async(ErlDrvData drv_data, + ErlDrvThreadData thread_data) { + struct driver_data *dd = (struct driver_data *)thread_data; + ErlDrvPort port_num = dd->port_num; + + ASSERT(dd->blocking); + ASSERT(dd == (driver_data + (int)(long)drv_data)); + + if (dd->blocking->res > 0) { + driver_pdl_lock(dd->blocking->pdl); + if (driver_deq(port_num, dd->blocking->res) == 0) { + driver_pdl_unlock(dd->blocking->pdl); + set_busy_port(port_num, 0); + if (dd->terminating) { + /* The port is has been ordered to terminate + from either fd_flush or port_inp_failure */ + if (dd->terminating == 1) + driver_failure_atom(port_num, "normal"); + else if (dd->terminating == 2) + driver_failure_eof(port_num); + else if (dd->terminating < 0) + driver_failure_posix(port_num, -dd->terminating); + return; /* -1; */ + } + } else { + driver_pdl_unlock(dd->blocking->pdl); + /* still data left to write in queue */ + driver_async(port_num, &dd->blocking->pkey, fd_async, dd, NULL); + return /* 0; */; + } + } else if (dd->blocking->res < 0) { + driver_failure_posix(port_num, dd->blocking->err); + return; /* -1; */ + } + return; /* 0; */ +} + +#endif void erts_do_break_handling(void) { @@ -2658,18 +2859,30 @@ void sys_preload_end(Preload* p) /* Nothing */ } -/* Read a key from console (?) */ - +/* Read a key from console, used by break.c + Here we assume that all schedulers are stopped so that erl_poll + does not interfere with the select below. +*/ int sys_get_key(fd) int fd; { - int c; + int c, ret; unsigned char rbuf[64]; + fd_set fds; fflush(stdout); /* Flush query ??? */ - if ((c = read(fd,rbuf,64)) <= 0) { - return c; + FD_ZERO(&fds); + FD_SET(fd,&fds); + + ret = select(fd+1, &fds, NULL, NULL, NULL); + + if (ret == 1) { + do { + c = read(fd,rbuf,64); + } while (c < 0 && errno == EAGAIN); + if (c <= 0) + return c; } return rbuf[0]; diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c index 7a1d129cd5..972170d465 100644 --- a/erts/emulator/sys/win32/erl_poll.c +++ b/erts/emulator/sys/win32/erl_poll.c @@ -1085,7 +1085,7 @@ void erts_poll_controlv(ErtsPollSet ps, pcev[i].events, pcev[i].on); } - ERTS_POLLSET_LOCK(ps); + ERTS_POLLSET_UNLOCK(ps); HARDTRACEF(("Out erts_poll_controlv")); } diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h index a78dbf64af..838f0c61eb 100644 --- a/erts/emulator/sys/win32/erl_win_sys.h +++ b/erts/emulator/sys/win32/erl_win_sys.h @@ -113,12 +113,10 @@ /* * Our own type of "FD's" */ +#define ERTS_SYS_FD_INVALID INVALID_HANDLE_VALUE #define ERTS_SYS_FD_TYPE HANDLE #define NO_FSTAT_ON_SYS_FD_TYPE 1 /* They are events, not files */ -#define HAVE_ERTS_CHECK_IO_DEBUG -int erts_check_io_debug(void); - /* * For erl_time_sup */ diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 0ded6b274e..ae44c8424f 100644 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -1392,39 +1392,46 @@ int parse_command(wchar_t* cmd){ return i; } -static BOOL need_quotes(wchar_t *str) -{ - int in_quote = 0; - int backslashed = 0; - int naked_space = 0; - while (*str != L'\0') { - switch (*str) { - case L'\\' : - backslashed = !backslashed; - break; - case L'"': - if (backslashed) { - backslashed=0; - } else { - in_quote = !in_quote; - } - break; - case L' ': - backslashed = 0; - if (!(backslashed || in_quote)) { - naked_space++; - } - break; - default: - backslashed = 0; +/* + * Translating of command line arguments to correct format. In the examples + * below the '' are not part of the actual string. + * 'io:format("hello").' -> 'io:format(\"hello\").' + * 'io:format("is anybody in there?").' -> '"io:format(\"is anybody in there?\")."' + * 'Just nod if you can hear me.' -> '"Just nod if you can hear me."' + * 'Is there ""anyone at home?' -> '"Is there \"\"anyone at home?"' + * 'Relax."' -> 'Relax.\"' + * + * If new == NULL we just calculate the length. + * + * The reason for having to quote all of the is becasue CreateProcessW removes + * one level of escaping since it takes a single long command line rather + * than the argument chunks that unix uses. + */ +static int escape_and_quote(wchar_t *str, wchar_t *new, BOOL *quoted) { + int i, j = 0; + if (new == NULL) + *quoted = FALSE; + else if (*quoted) + new[j++] = L'"'; + for ( i = 0; str[i] != L'\0'; i++,j++) { + if (str[i] == L' ' && new == NULL && *quoted == FALSE) { + *quoted = TRUE; + j++; + } + /* check if we have to escape quotes */ + if (str[i] == L'"') { + if (new) new[j] = L'\\'; + j++; } - ++str; + if (new) new[j] = str[i]; } - return (naked_space > 0); + if (*quoted) { + if (new) new[j] = L'"'; + j++; + } + return j; } - - /* *---------------------------------------------------------------------- @@ -1585,31 +1592,24 @@ create_child_process wcscpy(appname, execPath); } if (argv == NULL) { - BOOL orig_need_q = need_quotes(execPath); + BOOL orig_need_q; wchar_t *ptr; - int ocl = wcslen(execPath); + int ocl = escape_and_quote(execPath, NULL, &orig_need_q); if (run_cmd) { newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, - (ocl + ((orig_need_q) ? 3 : 1) - + 11)*sizeof(wchar_t)); + (ocl + 1 + 11)*sizeof(wchar_t)); memcpy(newcmdline,L"cmd.exe /c ",11*sizeof(wchar_t)); ptr = newcmdline + 11; } else { newcmdline = (wchar_t *) erts_alloc(ERTS_ALC_T_TMP, - (ocl + ((orig_need_q) ? 3 : 1))*sizeof(wchar_t)); + (ocl + 1)*sizeof(wchar_t)); ptr = (wchar_t *) newcmdline; } - if (orig_need_q) { - *ptr++ = L'"'; - } - memcpy(ptr,execPath,ocl*sizeof(wchar_t)); - ptr += ocl; - if (orig_need_q) { - *ptr++ = L'"'; - } - *ptr = L'\0'; + ptr += escape_and_quote(execPath, ptr, &orig_need_q); + ptr[0] = L'\0'; } else { - int sum = 1; /* '\0' */ + int sum = 0; + BOOL *qte = NULL; wchar_t **ar = argv; wchar_t *n; wchar_t *save_arg0 = NULL; @@ -1620,11 +1620,13 @@ create_child_process if (run_cmd) { sum += 11; /* cmd.exe /c */ } + + while (*ar != NULL) ar++; + qte = erts_alloc(ERTS_ALC_T_TMP, (ar - argv)*sizeof(BOOL)); + + ar = argv; while (*ar != NULL) { - sum += wcslen(*ar); - if (need_quotes(*ar)) { - sum += 2; /* quotes */ - } + sum += escape_and_quote(*ar,NULL,qte+(ar - argv)); sum++; /* space */ ++ar; } @@ -1636,26 +1638,18 @@ create_child_process n += 11; } while (*ar != NULL) { - int q = need_quotes(*ar); - sum = wcslen(*ar); - if (q) { - *n++ = L'"'; - } - memcpy(n,*ar,sum*sizeof(wchar_t)); - n += sum; - if (q) { - *n++ = L'"'; - } + n += escape_and_quote(*ar,n,qte+(ar - argv)); *n++ = L' '; ++ar; } - *(n-1) = L'\0'; + *(n-1) = L'\0'; /* overwrite last space with '\0' */ if (save_arg0 != NULL) { argv[0] = save_arg0; } + erts_free(ERTS_ALC_T_TMP, qte); } - DEBUGF(("Creating child process: %s, createFlags = %d\n", newcmdline, createFlags)); + DEBUGF((stderr,"Creating child process: %S, createFlags = %d\n", newcmdline, createFlags)); ok = CreateProcessW((wchar_t *) appname, (wchar_t *) newcmdline, NULL, diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 0b0568c31a..dfbe47786a 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -31,6 +31,7 @@ MODULES= \ a_SUITE \ after_SUITE \ alloc_SUITE \ + async_ports_SUITE \ beam_SUITE \ beam_literals_SUITE \ bif_SUITE \ diff --git a/erts/emulator/test/a_SUITE.erl b/erts/emulator/test/a_SUITE.erl index 195c9c0a5f..17579be416 100644 --- a/erts/emulator/test/a_SUITE.erl +++ b/erts/emulator/test/a_SUITE.erl @@ -97,23 +97,13 @@ display_check_io(ChkIo) -> catch erlang:display('--- CHECK IO INFO ---'), catch erlang:display(ChkIo), catch erts_debug:set_internal_state(available_internal_state, true), - NoOfErrorFds = (catch erts_debug:get_internal_state(check_io_debug)), + NoOfErrorFds = (catch element(1, erts_debug:get_internal_state(check_io_debug))), catch erlang:display({'NoOfErrorFds', NoOfErrorFds}), catch erts_debug:set_internal_state(available_internal_state, false), catch erlang:display('--- CHECK IO INFO ---'), ok. get_check_io_info() -> - ChkIo = erlang:system_info(check_io), - case lists:keysearch(pending_updates, 1, ChkIo) of - {value, {pending_updates, 0}} -> - display_check_io(ChkIo), - ChkIo; - false -> - ChkIo; - _ -> - receive after 10 -> ok end, - get_check_io_info() - end. + z_SUITE:get_check_io_info(). diff --git a/erts/emulator/test/async_ports_SUITE.erl b/erts/emulator/test/async_ports_SUITE.erl new file mode 100644 index 0000000000..c89b3655ff --- /dev/null +++ b/erts/emulator/test/async_ports_SUITE.erl @@ -0,0 +1,118 @@ +-module(async_ports_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-compile(export_all). + +-define(PACKET_SIZE, (10 * 1024 * 8)). +-define(CPORT_DELAY, 100). +-define(TEST_LOOPS_COUNT, 100000). +-define(SLEEP_BEFORE_CHECK, 1000). +-define(TEST_PROCS_COUNT, 2). +-define(TC_TIMETRAP_SECONDS, 10). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + permanent_busy_test + ]. + +permanent_busy_test(Config) -> + ct:timetrap({seconds, ?TC_TIMETRAP_SECONDS}), + ExePath = filename:join(?config(data_dir, Config), "cport"), + + Self = self(), + spawn_link( + fun() -> + Block = <<0:?PACKET_SIZE>>, + + Port = open_port(ExePath), + + Testers = + lists:map( + fun(_) -> + erlang:spawn_link(?MODULE, run_loop, + [Self, + Port, + Block, + ?TEST_LOOPS_COUNT, + 0]) + end, + lists:seq(1, ?TEST_PROCS_COUNT)), + Self ! {test_info, Port, Testers}, + endless_flush(Port) + end), + + receive + {test_info, Port, Testers} -> + MaxWaitTime = round(0.7 * ?TC_TIMETRAP_SECONDS * 1000), + ct:log("wait testers, maximum ~w mcsec~n", [MaxWaitTime]), + ok = wait_testers(MaxWaitTime, Testers), + timer:sleep(?SLEEP_BEFORE_CHECK), + case erlang:port_command(Port, <<"test">>, [nosuspend]) of + false -> + exit(port_dead); + true -> + ok + end + end. + +wait_testers(Timeout, Testers) -> + lists:foldl( + fun(Pid, AccIn) -> + StartWait = os:timestamp(), + receive + {Pid, port_dead} -> + recalc_timeout(AccIn, StartWait) + after AccIn -> + Pid ! stop, + recalc_timeout(AccIn, StartWait) + end + end, Timeout, Testers), + ok. + +recalc_timeout(TimeoutIn, WaitStart) -> + erlang:max(0, TimeoutIn - round(timer:now_diff(os:timestamp(), WaitStart)) div 1000). + +open_port(ExePath) -> + erlang:open_port({spawn, ExePath ++ " 100"}, [{packet, 4}, eof, exit_status, use_stdio, binary]). + +run_loop(RootProc, Port, Block, CheckLimit, BusyCnt) -> + receive + stop -> + ok + after 0 -> + case erlang:port_command(Port, Block, [nosuspend]) of + true -> + run_loop(RootProc, Port, Block, CheckLimit, 0); + false -> + if + BusyCnt + 1 > CheckLimit -> + check_dead(RootProc, Port, Block, CheckLimit); + true -> + run_loop(RootProc, Port, Block, CheckLimit, BusyCnt + 1) + end + end + end. + +check_dead(RootProc, Port, Block, CheckLimit) -> + ct:log("~p: check port dead~n", [self()]), + timer:sleep(?SLEEP_BEFORE_CHECK), + case erlang:port_command(Port, Block, [nosuspend]) of + true -> + ct:log("not dead~n"), + run_loop(RootProc, Port, Block, CheckLimit, 0); + false -> + ct:log("port dead: ~p~n", [Port]), + RootProc ! {self(), port_dead}, + ok + end. + +endless_flush(Port) -> + receive + {Port, {data, _}} -> + endless_flush(Port); + {Port, SomethingWrong} -> + erlang:error({someting_wrong, SomethingWrong}) + end. diff --git a/erts/emulator/test/async_ports_SUITE_data/Makefile.src b/erts/emulator/test/async_ports_SUITE_data/Makefile.src new file mode 100644 index 0000000000..56da3fbe12 --- /dev/null +++ b/erts/emulator/test/async_ports_SUITE_data/Makefile.src @@ -0,0 +1,15 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = cport@exe@ + + +all: $(PROGS) + +cport@exe@: cport@obj@ + $(LD) $(CROSSLDFLAGS) -o cport cport@obj@ @LIBS@ + +cport@obj@: cport.c + $(CC) -c -o cport@obj@ $(CFLAGS) cport.c diff --git a/erts/emulator/test/async_ports_SUITE_data/cport.c b/erts/emulator/test/async_ports_SUITE_data/cport.c new file mode 100644 index 0000000000..033aff382a --- /dev/null +++ b/erts/emulator/test/async_ports_SUITE_data/cport.c @@ -0,0 +1,81 @@ +#include <stdlib.h> +#include <stdio.h> +#include <errno.h> +#include <string.h> +#ifdef __WIN32__ +# include "windows.h" +# include "winbase.h" +#else +# include <unistd.h> +#endif + +typedef unsigned char byte; + +int read_cmd(byte *buf) +{ + int len; + if (read_exact(buf, 4) != 4) + return(-1); + + len = (buf[0] << 24) | (buf[1] << 16) | (buf[2] << 8) | buf[3]; + return read_exact(buf, len); +} + +int write_cmd(byte *buf, int len) +{ + byte li[4]; + li[0] = (len >> 24) & 0xff; + li[1] = (len >> 16) & 0xff; + li[2] = (len >> 8) & 0xff; + li[3] = len & 0xff; + write_exact(&li, 4); + + return write_exact(buf, len); +} + +int read_exact(byte *buf, int len) +{ + int i, got=0; + do { + if ((i = read(0, buf+got, len-got)) <= 0) + { + return(i); + } + got += i; + } while (got<len); + return len; +} + +int write_exact(byte *buf, int len) +{ + int i, wrote = 0; + do { + if ((i = write(1, buf+wrote, len-wrote)) < 0) + return (i); + wrote += i; + } while (wrote<len); + return len; +} + +byte static_buf[31457280]; // 30 mb + +int main(int argc, char **argv) { + int sleep_time = atoi(argv[1]); + int fn, arg, res; + byte *buf = &static_buf[0]; + int len = 0; + if (sleep_time <= 0) + sleep_time = 0; +#ifdef __WIN32__ + else + sleep_time = ((sleep_time - 1) / 1000) + 1; /* Milli seconds */ +#endif + while ((len = read_cmd(buf)) > 0) { +#ifdef __WIN32__ + Sleep((DWORD) sleep_time); +#else + usleep(sleep_time); +#endif + write_cmd(buf, len); + } +} diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl index 4b4af0babe..2ed5aaa0d0 100644 --- a/erts/emulator/test/busy_port_SUITE.erl +++ b/erts/emulator/test/busy_port_SUITE.erl @@ -98,8 +98,10 @@ generator(0, Writer, _Data) -> %% Calling process_info(Pid, current_function) on a suspended process %% used to crash Beam. - {current_function, {erlang, send, 2}} = - process_info(Writer, current_function), + case process_info(Writer, [status,current_function]) of + [{status,suspended},{current_function,{erlang,send,2}}] -> ok; + [{status,suspended},{current_function,{erlang,bif_return_trap,_}}] -> ok + end, unlock_slave(); generator(N, Writer, Data) -> Writer ! {exec, Data}, diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index c62bc0c454..8d2c620be0 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -31,8 +31,9 @@ end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2, end_per_testcase/2, + + a_test/1, outputv_echo/1, - timer_measure/1, timer_cancel/1, timer_change/1, @@ -79,7 +80,8 @@ thr_free_drv/1, async_blast/1, thr_msg_blast/1, - consume_timeslice/1]). + consume_timeslice/1, + z_test/1]). -export([bin_prefix/2]). @@ -122,19 +124,19 @@ init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> _ -> erts_debug:set_internal_state(available_internal_state, true) end, erlang:display({init_per_testcase, Case}), - ?line 0 = erts_debug:get_internal_state(check_io_debug), + ?line 0 = element(1, erts_debug:get_internal_state(check_io_debug)), [{watchdog, Dog},{testcase, Case}|Config]. end_per_testcase(Case, Config) -> Dog = ?config(watchdog, Config), erlang:display({end_per_testcase, Case}), - ?line 0 = erts_debug:get_internal_state(check_io_debug), + ?line 0 = element(1, erts_debug:get_internal_state(check_io_debug)), ?t:timetrap_cancel(Dog). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> - [outputv_errors, outputv_echo, queue_echo, {group, timer}, +all() -> %% Keep a_test first and z_test last... + [a_test, outputv_errors, outputv_echo, queue_echo, {group, timer}, driver_unloaded, io_ready_exit, use_fallback_pollset, bad_fd_in_pollset, driver_event, fd_change, steal_control, otp_6602, driver_system_info_base_ver, @@ -151,7 +153,8 @@ all() -> thr_free_drv, async_blast, thr_msg_blast, - consume_timeslice]. + consume_timeslice, + z_test]. groups() -> [{timer, [], @@ -917,8 +920,7 @@ steal_control_test(Hndl = {erts_poll_info, Before}) -> end. chkio_test_init(Config) when is_list(Config) -> - ?line wait_until_no_pending_updates(), - ?line ChkIo = erlang:system_info(check_io), + ?line ChkIo = get_stable_check_io_info(), ?line case catch lists:keysearch(name, 1, ChkIo) of {value, {name, erts_poll}} -> ?line ?t:format("Before test: ~p~n", [ChkIo]), @@ -937,8 +939,7 @@ chkio_test_fini({skipped, _} = Res) -> chkio_test_fini({chkio_test_result, Res, Before}) -> ?line ok = erl_ddll:unload_driver('chkio_drv'), ?line ok = erl_ddll:stop(), - ?line wait_until_no_pending_updates(), - ?line After = erlang:system_info(check_io), + ?line After = get_stable_check_io_info(), ?line ?t:format("After test: ~p~n", [After]), ?line verify_chkio_state(Before, After), ?line Res. @@ -985,7 +986,7 @@ chkio_test({erts_poll_info, Before}, ?line Fun(), ?line During = erlang:system_info(check_io), ?line erlang:display(During), - ?line 0 = erts_debug:get_internal_state(check_io_debug), + ?line 0 = element(1, erts_debug:get_internal_state(check_io_debug)), ?line ?t:format("During test: ~p~n", [During]), ?line chk_chkio_port(Port), ?line case erlang:port_control(Port, ?CHKIO_STOP, "") of @@ -1034,18 +1035,22 @@ verify_chkio_state(Before, After) -> After) end, ?line ok. - - -wait_until_no_pending_updates() -> - case lists:keysearch(pending_updates, 1, erlang:system_info(check_io)) of - {value, {pending_updates, 0}} -> - ok; - false -> - ok; +get_stable_check_io_info() -> + ChkIo = erlang:system_info(check_io), + PendUpdNo = case lists:keysearch(pending_updates, 1, ChkIo) of + {value, {pending_updates, PendNo}} -> + PendNo; + false -> + 0 + end, + {value, {active_fds, ActFds}} = lists:keysearch(active_fds, 1, ChkIo), + case {PendUpdNo, ActFds} of + {0, 0} -> + ChkIo; _ -> receive after 10 -> ok end, - wait_until_no_pending_updates() + get_stable_check_io_info() end. otp_6602(doc) -> ["Missed port lock when stealing control of fd from a " @@ -1062,10 +1067,9 @@ otp_6602(Config) when is_list(Config) -> %% Inet driver use port locking... {ok, S} = gen_udp:open(0), {ok, Fd} = inet:getfd(S), - {ok, Port} = inet:port(S), %% Steal fd (lock checker used to %% trigger here). - {ok, _S2} = gen_udp:open(Port,[{fd,Fd}]), + {ok, _S2} = gen_udp:open(0,[{fd,Fd}]), Parent ! Done end), ?line receive Done -> ok end, @@ -1085,7 +1089,15 @@ otp_6602(Config) when is_list(Config) -> ["async_thrs", "sched_thrs"])). --define(EXPECTED_SYSTEM_INFO_NAMES, ?EXPECTED_SYSTEM_INFO_NAMES2). +-define(EXPECTED_SYSTEM_INFO_NAMES3, + (?EXPECTED_SYSTEM_INFO_NAMES2 ++ + ["emu_nif_vsn"])). + +-define(EXPECTED_SYSTEM_INFO_NAMES4, + (?EXPECTED_SYSTEM_INFO_NAMES3 ++ + ["dirty_sched"])). + +-define(EXPECTED_SYSTEM_INFO_NAMES, ?EXPECTED_SYSTEM_INFO_NAMES4). 'driver_system_info_base_ver'(doc) -> []; @@ -1133,16 +1145,18 @@ check_driver_system_info_result(Result) -> drv_vsn_str2tup(erlang:system_info(driver_version))} of {DDVSN, DDVSN} -> ?line [] = Ns; - {{1, 0}, _} -> - ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES - -- ?EXPECTED_SYSTEM_INFO_NAMES1), - ?line ExpNs = lists:sort(Ns); - {{1, 1}, _} -> + %% {{1, 0}, _} -> + %% ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES + %% -- ?EXPECTED_SYSTEM_INFO_NAMES1), + %% ?line ExpNs = lists:sort(Ns); + %% {{1, 1}, _} -> + %% ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES + %% -- ?EXPECTED_SYSTEM_INFO_NAMES2), + %% ?line ExpNs = lists:sort(Ns); + {{3, 0}, _} -> ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES - -- ?EXPECTED_SYSTEM_INFO_NAMES2), - ?line ExpNs = lists:sort(Ns); - {{2, 0}, _} -> - ?line [] = Ns + -- ?EXPECTED_SYSTEM_INFO_NAMES3), + ?line ExpNs = lists:sort(Ns) end. chk_sis(SIs, Ns) -> @@ -1189,6 +1203,14 @@ check_si_res(["async_thrs", Value]) -> check_si_res(["sched_thrs", Value]) -> ?line Value = integer_to_list(erlang:system_info(schedulers)); +%% Data added in 3rd version of driver_system_info() (driver version 1.5) +check_si_res(["emu_nif_vsn", _Value]) -> + true; + +%% Data added in 4th version of driver_system_info() (driver version 3.1) +check_si_res(["dirty_sched", _Value]) -> + true; + check_si_res(Unexpected) -> ?line ?t:fail({unexpected_result, Unexpected}). @@ -2370,10 +2392,25 @@ count_proc_sched(Ps, PNs) -> PNs end. +a_test(Config) when is_list(Config) -> + check_io_debug(). + +z_test(Config) when is_list(Config) -> + check_io_debug(). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Utilities %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +check_io_debug() -> + get_stable_check_io_info(), + {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} + = erts_debug:get_internal_state(check_io_debug), + 0 = NoErrorFds, + NoUsedFds = NoDrvSelStructs, + 0 = NoDrvEvStructs, + ok. + %flush_msgs() -> % receive % M -> diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c b/erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c index e44c7dbd5e..964034f5a6 100644 --- a/erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c +++ b/erts/emulator/test/driver_SUITE_data/sys_info_base_drv.c @@ -41,7 +41,9 @@ "thread=%s " \ "smp=%s " \ "async_thrs=%d " \ - "sched_thrs=%d" + "sched_thrs=%d " \ + "emu_nif_vsn=%d.%d" + static size_t sys_info_drv_max_res_len(ErlDrvSysInfo *sip) @@ -55,6 +57,7 @@ sys_info_drv_max_res_len(ErlDrvSysInfo *sip) slen += 5; /* smp */ slen += 20; /* async_thrs */ slen += 20; /* sched_thrs */ + slen += 2*20; /* emu_nif_vsn */ return slen; } @@ -72,7 +75,9 @@ sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *sip, char *str) sip->thread_support ? "true" : "false", sip->smp_support ? "true" : "false", sip->async_threads, - sip->scheduler_threads); + sip->scheduler_threads, + sip->nif_major_version, + sip->nif_minor_version); } #include "sys_info_drv_impl.c" diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c b/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c index 5bbc966932..6d2c47fdaf 100644 --- a/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c +++ b/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c @@ -40,7 +40,9 @@ "thread=%s " \ "smp=%s " \ "async_thrs=%d " \ - "sched_thrs=%d" + "sched_thrs=%d " \ + "emu_nif_vsn=%d.%d " \ + "dirty_sched=%s" static size_t sys_info_drv_max_res_len(ErlDrvSysInfo *sip) @@ -54,6 +56,8 @@ sys_info_drv_max_res_len(ErlDrvSysInfo *sip) slen += 5; /* smp */ slen += 20; /* async_thrs */ slen += 20; /* sched_thrs */ + slen += 2*20; /* emu_nif_vsn */ + slen += 5; /* dirty_sched */ return slen; } @@ -71,7 +75,10 @@ sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *sip, char *str) sip->thread_support ? "true" : "false", sip->smp_support ? "true" : "false", sip->async_threads, - sip->scheduler_threads); + sip->scheduler_threads, + sip->nif_major_version, + sip->nif_minor_version, + sip->dirty_scheduler_support ? "true" : "false"); } #include "sys_info_drv_impl.c" diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c b/erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c index 63c69f751c..2271d7027b 100644 --- a/erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c +++ b/erts/emulator/test/driver_SUITE_data/sys_info_prev_drv.c @@ -41,7 +41,9 @@ "thread=%s " \ "smp=%s " \ "async_thrs=%d " \ - "sched_thrs=%d" + "sched_thrs=%d " \ + "emu_nif_vsn=%d.%d" + static size_t sys_info_drv_max_res_len(ErlDrvSysInfo *sip) @@ -55,6 +57,7 @@ sys_info_drv_max_res_len(ErlDrvSysInfo *sip) slen += 5; /* smp */ slen += 20; /* async_thrs */ slen += 20; /* sched_thrs */ + slen += 2*20; /* emu_nif_vsn */ return slen; } @@ -72,7 +75,9 @@ sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *sip, char *str) sip->thread_support ? "true" : "false", sip->smp_support ? "true" : "false", sip->async_threads, - sip->scheduler_threads); + sip->scheduler_threads, + sip->nif_major_version, + sip->nif_minor_version); } #include "sys_info_drv_impl.c" diff --git a/erts/emulator/test/float_SUITE_data/fp_drv.c b/erts/emulator/test/float_SUITE_data/fp_drv.c index b80385c3f9..82d18d6440 100644 --- a/erts/emulator/test/float_SUITE_data/fp_drv.c +++ b/erts/emulator/test/float_SUITE_data/fp_drv.c @@ -29,9 +29,14 @@ #if defined (__GNUC__) int _finite(double x); #endif -#ifndef finite -#define finite _finite +#ifndef isfinite +#define isfinite _finite #endif +#elif !defined(HAVE_ISFINITE) && defined(HAVE_FINITE) +/* If not windows and we do not have isfinite */ +#define isfinite finite +#elif !defined(HAVE_ISFINITE) +# error "No finite function found!" #endif #include "erl_driver.h" @@ -79,21 +84,21 @@ do_test(void *unused) x = 3.23e133; y = 3.57e257; z = x*y; - if (finite(z)) + if (isfinite(z)) return "is finite (1)"; x = 5.0; y = 0.0; z = x/y; - if (finite(z)) + if (isfinite(z)) return "is finite (2)"; z = log(-1.0); - if (finite(z)) + if (isfinite(z)) return "is finite (3)"; z = log(0.0); - if (finite(z)) + if (isfinite(z)) return "is finite (4)"; return "ok"; diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl index 8ad5f290ed..2968f5bebb 100644 --- a/erts/emulator/test/fun_SUITE.erl +++ b/erts/emulator/test/fun_SUITE.erl @@ -30,7 +30,7 @@ fun_to_port/1,t_hash/1,t_phash/1,t_phash2/1,md5/1, refc/1,refc_ets/1,refc_dist/1, const_propagation/1,t_arity/1,t_is_function2/1, - t_fun_info/1]). + t_fun_info/1,t_fun_info_mfa/1]). -export([nothing/0]). @@ -42,7 +42,8 @@ all() -> [bad_apply, bad_fun_call, badarity, ext_badarity, equality, ordering, fun_to_port, t_hash, t_phash, t_phash2, md5, refc, refc_ets, refc_dist, - const_propagation, t_arity, t_is_function2, t_fun_info]. + const_propagation, t_arity, t_is_function2, t_fun_info, + t_fun_info_mfa]. groups() -> []. @@ -824,6 +825,24 @@ t_fun_info(Config) when is_list(Config) -> ?line bad_info(<<1,2>>), ok. +t_fun_info_mfa(Config) when is_list(Config) -> + Fun1 = fun spawn_call/2, + {module,M1} = erlang:fun_info(Fun1, module), + {name,F1} = erlang:fun_info(Fun1, name), + {arity,A1} = erlang:fun_info(Fun1, arity), + {M1,F1,A1=2} = erlang:fun_info_mfa(Fun1), + %% Module fun. + Fun2 = fun ?MODULE:t_fun_info/1, + {module,M2} = erlang:fun_info(Fun2, module), + {name,F2} = erlang:fun_info(Fun2, name), + {arity,A2} = erlang:fun_info(Fun2, arity), + {M2,F2,A2=1} = erlang:fun_info_mfa(Fun2), + + %% Not fun. + {'EXIT',_} = (catch erlang:fun_info_mfa(id(d))), + ok. + + bad_info(Term) -> try erlang:fun_info(Term, module) of Any -> diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl index 8a63d9fe3e..f3986f0c4f 100644 --- a/erts/emulator/test/module_info_SUITE.erl +++ b/erts/emulator/test/module_info_SUITE.erl @@ -24,7 +24,7 @@ -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, - exports/1,functions/1,native/1]). + exports/1,functions/1,native/1,info/1]). %%-compile(native). @@ -52,8 +52,8 @@ end_per_group(_GroupName, Config) -> Config. -modules() -> - [exports, functions, native]. +modules() -> + [exports, functions, native, info]. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog = ?t:timetrap(?t:minutes(3)), @@ -122,6 +122,22 @@ native_proj({Name,Arity,Addr}) -> native_filter(Set) -> sofs:no_elements(Set) =/= 1. +%% Test that the module info of this module is correct. Use +%% erlang:get_module_info(?MODULE) to avoid compiler optimization tricks. +info(Config) when is_list(Config) -> + Info = erlang:get_module_info(?MODULE), + All = all_exported(), + {ok,{?MODULE,MD5}} = beam_lib:md5(code:which(?MODULE)), + {module, ?MODULE} = lists:keyfind(module, 1, Info), + {md5, MD5} = lists:keyfind(md5, 1, Info), + {exports, Exports} = lists:keyfind(exports, 1, Info), + All = lists:sort(Exports), + {attributes, Attrs} = lists:keyfind(attributes, 1, Info), + {vsn,_} = lists:keyfind(vsn, 1, Attrs), + {compile, Compile} = lists:keyfind(compile, 1, Info), + {options,_} = lists:keyfind(options, 1, Compile), + ok. + %% Helper functions (local). add_arity(L) -> diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index b2da6f58af..14e6585220 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -37,7 +37,9 @@ threading/1, send/1, send2/1, send3/1, send_threaded/1, neg/1, is_checks/1, get_length/1, make_atom/1, make_string/1, reverse_list_test/1, - otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1 + otp_9828/1, + otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1, + dirty_nif_exception/1, nif_schedule/1 ]). -export([many_args_100/100]). @@ -64,7 +66,9 @@ all() -> resource_takeover, threading, send, send2, send3, send_threaded, neg, is_checks, get_length, make_atom, make_string,reverse_list_test, - otp_9668, consume_timeslice, dirty_nif, dirty_nif_send + otp_9828, + otp_9668, consume_timeslice, + nif_schedule, dirty_nif, dirty_nif_send, dirty_nif_exception ]. groups() -> @@ -1440,6 +1444,20 @@ otp_9668(Config) -> ?line verify_tmpmem(TmpMem), ok. +otp_9828(doc) -> ["Copy of writable binary"]; +otp_9828(Config) -> + ensure_lib_loaded(Config, 1), + + otp_9828_loop(<<"I'm alive!">>, 1000). + +otp_9828_loop(Bin, 0) -> + ok; +otp_9828_loop(Bin, Val) -> + WrtBin = <<Bin/binary, Val:32>>, + ok = otp_9828_nif(WrtBin), + otp_9828_loop(WrtBin, Val-1). + + consume_timeslice(Config) when is_list(Config) -> CONTEXT_REDS = 2000, Me = self(), @@ -1524,6 +1542,20 @@ consume_timeslice(Config) when is_list(Config) -> ok. +nif_schedule(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + A = "this is a string", + B = {this,is,a,tuple}, + {B,A} = call_nif_schedule(A, B), + ok = try call_nif_schedule(1, 2) + catch + error:badarg -> + [{?MODULE,call_nif_schedule,[1,2],_}|_] = + erlang:get_stacktrace(), + ok + end, + ok. + dirty_nif(Config) when is_list(Config) -> try erlang:system_info(dirty_cpu_schedulers) of N when is_integer(N) -> @@ -1556,6 +1588,24 @@ dirty_nif_send(Config) when is_list(Config) -> {skipped,"No dirty scheduler support"} end. +dirty_nif_exception(Config) when is_list(Config) -> + try erlang:system_info(dirty_cpu_schedulers) of + N when is_integer(N) -> + ensure_lib_loaded(Config), + try + call_dirty_nif_exception(), + ?t:fail(expected_badarg) + catch + error:badarg -> + [{?MODULE,call_dirty_nif_exception,[],_}|_] = + erlang:get_stacktrace(), + ok + end + catch + error:badarg -> + {skipped,"No dirty scheduler support"} + end. + next_msg(_Pid) -> receive M -> M @@ -1684,9 +1734,12 @@ reverse_list(_) -> ?nif_stub. echo_int(_) -> ?nif_stub. type_sizes() -> ?nif_stub. otp_9668_nif(_) -> ?nif_stub. +otp_9828_nif(_) -> ?nif_stub. consume_timeslice_nif(_,_) -> ?nif_stub. +call_nif_schedule(_,_) -> ?nif_stub. call_dirty_nif(_,_,_) -> ?nif_stub. send_from_dirty_nif(_) -> ?nif_stub. +call_dirty_nif_exception() -> ?nif_stub. %% maps is_map_nif(_) -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 955dc64189..291c903947 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1473,6 +1473,26 @@ static ERL_NIF_TERM otp_9668_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar return atom_ok; } +static ERL_NIF_TERM otp_9828_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + /* copy a writable binary could reallocate it due to "emasculation" + and thereby render a previous inspection invalid. + */ + ErlNifBinary bin1; + ErlNifEnv* myenv; + + if (!enif_inspect_binary(env, argv[0], &bin1)) { + return enif_make_badarg(env); + } + + myenv = enif_alloc_env(); + enif_make_copy(myenv, argv[0]); + enif_free_env(myenv); + + return memcmp(bin1.data, "I'm alive!", 10)==0 ? atom_ok : atom_false; +} + + static ERL_NIF_TERM consume_timeslice_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { int percent; @@ -1493,25 +1513,57 @@ static ERL_NIF_TERM consume_timeslice_nif(ErlNifEnv* env, int argc, const ERL_NI } } +static ERL_NIF_TERM nif_sched2(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + char s[64]; + if (!enif_get_string(env, argv[2], s, sizeof s, ERL_NIF_LATIN1)) + return enif_make_badarg(env); + return enif_make_tuple2(env, argv[3], argv[2]); +} + +static ERL_NIF_TERM nif_sched1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM new_argv[4]; + new_argv[0] = enif_make_atom(env, "garbage0"); + new_argv[1] = enif_make_atom(env, "garbage1"); + new_argv[2] = argv[0]; + new_argv[3] = argv[1]; + return enif_schedule_nif(env, "nif_sched2", 0, nif_sched2, 4, new_argv); +} + +static ERL_NIF_TERM call_nif_schedule(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + if (argc != 2) + return enif_make_atom(env, "false"); + return enif_schedule_nif(env, "nif_sched1", 0, nif_sched1, argc, argv); +} + #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT + +static int have_dirty_schedulers(void) +{ + ErlNifSysInfo si; + enif_system_info(&si, sizeof(si)); + return si.dirty_scheduler_support; +} + static ERL_NIF_TERM dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { int n; char s[10]; ErlNifBinary b; ERL_NIF_TERM result; - if (enif_have_dirty_schedulers()) { + if (have_dirty_schedulers()) { assert(enif_is_on_dirty_scheduler(env)); } assert(argc == 3); enif_get_int(env, argv[0], &n); enif_get_string(env, argv[1], s, sizeof s, ERL_NIF_LATIN1); enif_inspect_binary(env, argv[2], &b); - result = enif_make_tuple3(env, - enif_make_int(env, n), - enif_make_string(env, s, ERL_NIF_LATIN1), - enif_make_binary(env, &b)); - return enif_schedule_dirty_nif_finalizer(env, result, enif_dirty_nif_finalizer); + return enif_make_tuple3(env, + enif_make_int(env, n), + enif_make_string(env, s, ERL_NIF_LATIN1), + enif_make_binary(env, &b)); } static ERL_NIF_TERM call_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -1522,11 +1574,11 @@ static ERL_NIF_TERM call_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM assert(!enif_is_on_dirty_scheduler(env)); if (argc != 3) return enif_make_badarg(env); - if (enif_have_dirty_schedulers()) { + if (have_dirty_schedulers()) { if (enif_get_int(env, argv[0], &n) && enif_get_string(env, argv[1], s, sizeof s, ERL_NIF_LATIN1) && enif_inspect_binary(env, argv[2], &b)) - return enif_schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_nif, argc, argv); + return enif_schedule_nif(env, "call_dirty_nif", ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_nif, argc, argv); else return enif_make_badarg(env); } else { @@ -1534,35 +1586,42 @@ static ERL_NIF_TERM call_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM } } -static ERL_NIF_TERM dirty_sender(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ERL_NIF_TERM result; ErlNifPid pid; ErlNifEnv* menv; int res; - enif_get_local_pid(env, argv[0], &pid); + if (!enif_get_local_pid(env, argv[0], &pid)) + return enif_make_badarg(env); result = enif_make_tuple2(env, enif_make_atom(env, "ok"), enif_make_pid(env, &pid)); menv = enif_alloc_env(); res = enif_send(env, &pid, menv, result); enif_free_env(menv); if (!res) - /* Note the next line will crash, since dirty nifs can't return exceptions. - * This is intentional, since enif_send should not fail if the test succeeds. - */ - return enif_schedule_dirty_nif_finalizer(env, enif_make_badarg(env), enif_dirty_nif_finalizer); + return enif_make_badarg(env); else - return enif_schedule_dirty_nif_finalizer(env, result, enif_dirty_nif_finalizer); + return result; } -static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM call_dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - ERL_NIF_TERM result; - ErlNifPid pid; - - if (!enif_get_local_pid(env, argv[0], &pid)) + switch (argc) { + case 0: { + ERL_NIF_TERM args[255]; + int i; + for (i = 0; i < 255; i++) + args[i] = enif_make_int(env, i); + return enif_schedule_nif(env, "call_dirty_nif_exception", ERL_NIF_DIRTY_JOB_CPU_BOUND, + call_dirty_nif_exception, 255, argv); + } + case 1: return enif_make_badarg(env); - return enif_schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_sender, argc, argv); + default: + return enif_schedule_nif(env, "call_dirty_nif_exception", ERL_NIF_DIRTY_JOB_CPU_BOUND, + call_dirty_nif_exception, argc-1, argv); + } } #endif @@ -1741,10 +1800,13 @@ static ErlNifFunc nif_funcs[] = {"echo_int", 1, echo_int}, {"type_sizes", 0, type_sizes}, {"otp_9668_nif", 1, otp_9668_nif}, + {"otp_9828_nif", 1, otp_9828_nif}, {"consume_timeslice_nif", 2, consume_timeslice_nif}, + {"call_nif_schedule", 2, call_nif_schedule}, #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT {"call_dirty_nif", 3, call_dirty_nif}, - {"send_from_dirty_nif", 1, send_from_dirty_nif}, + {"send_from_dirty_nif", 1, send_from_dirty_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND}, + {"call_dirty_nif_exception", 0, call_dirty_nif_exception, ERL_NIF_DIRTY_JOB_IO_BOUND}, #endif {"is_map_nif", 1, is_map_nif}, {"get_map_size_nif", 1, get_map_size_nif}, diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index ff8d18eef8..8cf8377c30 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -394,18 +394,15 @@ t_string_to_integer(Config) when is_list(Config) -> test_sti(268435455), test_sti(-268435455), - %% 1 bsl 28 - 1, just before 32 bit bignum - test_sti(1 bsl 28 - 1), - %% 1 bsl 28, just beyond 32 bit small - test_sti(1 bsl 28), - %% 1 bsl 33, just beyond 32 bit - test_sti(1 bsl 33), - %% 1 bsl 60 - 1, just before 64 bit bignum - test_sti(1 bsl 60 - 1), - %% 1 bsl 60, just beyond 64 bit small - test_sti(1 bsl 60), - %% 1 bsl 65, just beyond 64 bit - test_sti(1 bsl 65), + % Interesting values around 2-pows, such as MIN_SMALL and MAX_SMALL. + lists:foreach(fun(Bits) -> + N = 1 bsl Bits, + test_sti(N - 1), + test_sti(N), + test_sti(N + 1) + end, + lists:seq(16, 130)), + %% Bignums. test_sti(123456932798748738738,16), test_sti(list_to_integer(lists:duplicate(2000, $1))), @@ -454,10 +451,11 @@ test_sti(Num) -> end|| Base <- lists:seq(2,36)]. test_sti(Num,Base) -> - Num = list_to_integer(int2list(Num,Base),Base), - Num = -1*list_to_integer(int2list(Num*-1,Base),Base), - Num = binary_to_integer(int2bin(Num,Base),Base), - Num = -1*binary_to_integer(int2bin(Num*-1,Base),Base). + Neg = -Num, + Num = list_to_integer(int2list(Num,Base),Base), + Neg = list_to_integer(int2list(Num*-1,Base),Base), + Num = binary_to_integer(int2bin(Num,Base),Base), + Neg = binary_to_integer(int2bin(Num*-1,Base),Base). % Calling this function (which is not supposed to be inlined) prevents % the compiler from calculating the answer, so we don't test the compiler diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index e01b2f253b..1bb4cb3637 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -90,6 +90,7 @@ mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1, exit_status_multi_scheduling_block/1, ports/1, spawn_driver/1, spawn_executable/1, close_deaf_port/1, + port_setget_data/1, unregister_name/1, parallelism_option/1]). -export([do_iter_max_ports/2]). @@ -115,6 +116,7 @@ all() -> mix_up_ports, otp_5112, otp_5119, exit_status_multi_scheduling_block, ports, spawn_driver, spawn_executable, close_deaf_port, unregister_name, + port_setget_data, parallelism_option]. groups() -> @@ -1405,6 +1407,12 @@ spawn_executable(Config) when is_list(Config) -> run_echo_args(SpaceDir,[ExactFile2,"hello world","dlrow olleh"]), [ExactFile2,"hello world","dlrow olleh"] = run_echo_args(SpaceDir,[binary, ExactFile2,"hello world","dlrow olleh"]), + + [ExactFile2,"hello \"world\"","\"dlrow\" olleh"] = + run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]), + [ExactFile2,"hello \"world\"","\"dlrow\" olleh"] = + run_echo_args(SpaceDir,[binary, ExactFile2,"hello \"world\"","\"dlrow\" olleh"]), + [ExactFile2] = run_echo_args(SpaceDir,[default]), [ExactFile2,"hello world","dlrow olleh"] = run_echo_args(SpaceDir,[switch_order,ExactFile2,"hello world", @@ -2333,6 +2341,55 @@ close_deaf_port_1(N, Cmd) -> {comment, "Could not spawn more than " ++ integer_to_list(N) ++ " OS processes."} end. +%% Test undocumented port_set_data/2 and port_get_data/1 +%% Hammer from multiple processes a while +%% and then abrubtly close the port (OTP-12208). +port_setget_data(Config) when is_list(Config) -> + ok = load_driver(?config(data_dir, Config), "echo_drv"), + Port = erlang:open_port({spawn_driver, "echo_drv"}, []), + + NSched = erlang:system_info(schedulers_online), + PRs = lists:map(fun(I) -> + spawn_opt(fun() -> port_setget_data_hammer(Port,1) end, + [monitor, {scheduler, I rem NSched}]) + end, + lists:seq(1,10)), + receive after 100 -> ok end, + Papa = self(), + lists:foreach(fun({Pid,_}) -> Pid ! {Papa,prepare_for_close} end, PRs), + lists:foreach(fun({Pid,_}) -> + receive {Pid,prepare_for_close} -> ok end + end, + PRs), + port_close(Port), + lists:foreach(fun({Pid,Ref}) -> + receive {'DOWN', Ref, process, Pid, normal} -> ok end + end, + PRs), + ok. + +port_setget_data_hammer(Port, N) -> + Rand = random:uniform(3), + try case Rand of + 1 -> true = erlang:port_set_data(Port, atom); + 2 -> true = erlang:port_set_data(Port, {1,2,3}); + 3 -> erlang:port_get_data(Port) + end + catch + error:badarg -> + true = get(prepare_for_close), + io:format("~p did ~p rounds before port closed\n", [self(), N]), + exit(normal) + end, + receive {Papa, prepare_for_close} -> + put(prepare_for_close, true), + Papa ! {self(),prepare_for_close} + after 0 -> + ok + end, + port_setget_data_hammer(Port, N+1). + + wait_until(Fun) -> case catch Fun() of true -> diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl index 46ece41096..f627eea07f 100644 --- a/erts/emulator/test/tuple_SUITE.erl +++ b/erts/emulator/test/tuple_SUITE.erl @@ -21,8 +21,9 @@ init_per_group/2,end_per_group/2, t_size/1, t_tuple_size/1, t_element/1, t_setelement/1, t_insert_element/1, t_delete_element/1, - t_list_to_tuple/1, t_tuple_to_list/1, - t_make_tuple_2/1, t_make_tuple_3/1, t_append_element/1, + t_list_to_tuple/1, t_list_to_upper_boundry_tuple/1, t_tuple_to_list/1, + t_make_tuple_2/1, t_make_upper_boundry_tuple_2/1, t_make_tuple_3/1, + t_append_element/1, t_append_element_upper_boundry/1, build_and_match/1, tuple_with_case/1, tuple_in_guard/1]). -include_lib("test_server/include/test_server.hrl"). @@ -40,8 +41,10 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [build_and_match, t_size, t_tuple_size, t_list_to_tuple, + t_list_to_upper_boundry_tuple, t_tuple_to_list, t_element, t_setelement, - t_make_tuple_2, t_make_tuple_3, t_append_element, + t_make_tuple_2, t_make_upper_boundry_tuple_2, t_make_tuple_3, + t_append_element, t_append_element_upper_boundry, t_insert_element, t_delete_element, tuple_with_case, tuple_in_guard]. @@ -49,11 +52,21 @@ groups() -> []. init_per_suite(Config) -> + A0 = case application:start(sasl) of + ok -> [sasl]; + _ -> [] + end, + A = case application:start(os_mon) of + ok -> [os_mon|A0]; + _ -> A0 + end, + [{started_apps, A}|Config]. + +end_per_suite(Config) -> + As = ?config(started_apps, Config), + lists:foreach(fun (A) -> application:stop(A) end, As), Config. -end_per_suite(_Config) -> - ok. - init_per_group(_GroupName, Config) -> Config. @@ -176,14 +189,19 @@ t_list_to_tuple(Config) when is_list(Config) -> {'EXIT', {badarg, _}} = (catch list_to_tuple(id([a|b]))), {'EXIT', {badarg, _}} = (catch list_to_tuple(id([a|b]))), - % test upper boundry, 16777215 elements - MaxSize = 1 bsl 24 - 1, - MaxTuple = list_to_tuple(lists:seq(1, MaxSize)), - MaxSize = size(MaxTuple), - {'EXIT', {badarg,_}} = (catch list_to_tuple(lists:seq(1, 1 bsl 24))), ok. +t_list_to_upper_boundry_tuple(Config) when is_list(Config) -> + sys_mem_cond_run(2048, + fun () -> + %% test upper boundry, 16777215 elements + MaxSize = 1 bsl 24 - 1, + MaxTuple = list_to_tuple(lists:seq(1, MaxSize)), + MaxSize = size(MaxTuple), + ok + end). + %% Tests tuple_to_list/1. t_tuple_to_list(Config) when is_list(Config) -> @@ -214,8 +232,6 @@ t_make_tuple_2(Config) when is_list(Config) -> t_make_tuple1({a}), t_make_tuple1(erlang:make_tuple(400, [])), - % test upper boundry, 16777215 elements - t_make_tuple(1 bsl 24 - 1, a), {'EXIT', {badarg,_}} = (catch erlang:make_tuple(1 bsl 24, a)), {'EXIT', {badarg,_}} = (catch erlang:make_tuple(-1, a)), @@ -225,6 +241,13 @@ t_make_tuple_2(Config) when is_list(Config) -> {'EXIT', {badarg,_}} = (catch erlang:make_tuple(1 bsl 65 + 3, a)), ok. +t_make_upper_boundry_tuple_2(Config) when is_list(Config) -> + sys_mem_cond_run(2048, + fun () -> + %% test upper boundry, 16777215 elements + t_make_tuple(1 bsl 24 - 1, a) + end). + t_make_tuple1(Element) -> lists:foreach(fun(Size) -> t_make_tuple(Size, Element) end, [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 255, 256, 511, 512, 999, @@ -309,13 +332,17 @@ t_delete_element(Config) when is_list(Config) -> %% Tests the append_element/2 BIF. t_append_element(Config) when is_list(Config) -> - ok = t_append_element({}, 2048, 2048), - - % test upper boundry, 16777215 elements - MaxSize = 1 bsl 24 - 1, - MaxTuple = list_to_tuple(lists:seq(1, MaxSize)), - {'EXIT',{badarg,_}} = (catch erlang:append_element(MaxTuple, a)), - ok. + ok = t_append_element({}, 2048, 2048). + +t_append_element_upper_boundry(Config) when is_list(Config) -> + sys_mem_cond_run(2048, + fun () -> + %% test upper boundry, 16777215 elements + MaxSize = 1 bsl 24 - 1, + MaxTuple = list_to_tuple(lists:seq(1, MaxSize)), + {'EXIT',{badarg,_}} = (catch erlang:append_element(MaxTuple, a)), + ok + end). t_append_element(_Tuple, 0, _High) -> ok; t_append_element(Tuple, N, High) -> @@ -371,3 +398,31 @@ tuple_in_guard(Config) when is_list(Config) -> %% Use this function to avoid compile-time evaluation of an expression. id(I) -> I. + +sys_mem_cond_run(ReqSizeMB, TestFun) when is_integer(ReqSizeMB) -> + case total_memory() of + TotMem when is_integer(TotMem), TotMem >= ReqSizeMB -> + TestFun(); + TotMem when is_integer(TotMem) -> + {skipped, "Not enough memory ("++integer_to_list(TotMem)++" MB)"}; + undefined -> + {skipped, "Could not retrieve memory information"} + end. + + +total_memory() -> + %% Totat memory in MB. + try + MemoryData = memsup:get_system_memory_data(), + case lists:keysearch(total_memory, 1, MemoryData) of + {value, {total_memory, TM}} -> + TM div (1024*1024); + false -> + {value, {system_total_memory, STM}} = + lists:keysearch(system_total_memory, 1, MemoryData), + STM div (1024*1024) + end + catch + _ : _ -> + undefined + end. diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl index 4b3075a164..b0c6224dfe 100644 --- a/erts/emulator/test/z_SUITE.erl +++ b/erts/emulator/test/z_SUITE.erl @@ -38,7 +38,7 @@ -export([schedulers_alive/1, node_container_refc_check/1, long_timers/1, pollset_size/1, - check_io_debug/1]). + check_io_debug/1, get_check_io_info/0]). -define(DEFAULT_TIMEOUT, ?t:minutes(5)). @@ -288,11 +288,14 @@ check_io_debug(Config) when is_list(Config) -> end. check_io_debug_test() -> + ?line erlang:display(get_check_io_info()), ?line erts_debug:set_internal_state(available_internal_state, true), - ?line erlang:display(erlang:system_info(check_io)), - ?line NoOfErrorFds = erts_debug:get_internal_state(check_io_debug), + ?line {NoErrorFds, NoUsedFds, NoDrvSelStructs, NoDrvEvStructs} + = erts_debug:get_internal_state(check_io_debug), ?line erts_debug:set_internal_state(available_internal_state, false), - ?line 0 = NoOfErrorFds, + ?line 0 = NoErrorFds, + ?line NoUsedFds = NoDrvSelStructs, + ?line 0 = NoDrvEvStructs, ?line ok. @@ -305,7 +308,7 @@ display_check_io(ChkIo) -> catch erlang:display('--- CHECK IO INFO ---'), catch erlang:display(ChkIo), catch erts_debug:set_internal_state(available_internal_state, true), - NoOfErrorFds = (catch erts_debug:get_internal_state(check_io_debug)), + NoOfErrorFds = (catch element(1, erts_debug:get_internal_state(check_io_debug))), catch erlang:display({'NoOfErrorFds', NoOfErrorFds}), catch erts_debug:set_internal_state(available_internal_state, false), catch erlang:display('--- CHECK IO INFO ---'), @@ -313,14 +316,19 @@ display_check_io(ChkIo) -> get_check_io_info() -> ChkIo = erlang:system_info(check_io), - case lists:keysearch(pending_updates, 1, ChkIo) of - {value, {pending_updates, 0}} -> + PendUpdNo = case lists:keysearch(pending_updates, 1, ChkIo) of + {value, {pending_updates, PendNo}} -> + PendNo; + false -> + 0 + end, + {value, {active_fds, ActFds}} = lists:keysearch(active_fds, 1, ChkIo), + case {PendUpdNo, ActFds} of + {0, 0} -> display_check_io(ChkIo), ChkIo; - false -> - ChkIo; _ -> - receive after 10 -> ok end, + receive after 100 -> ok end, get_check_io_info() end. diff --git a/erts/emulator/valgrind/suppress.patched.3.6.0 b/erts/emulator/valgrind/suppress.patched.3.6.0 index b3507bdba7..f79e3ff634 100644 --- a/erts/emulator/valgrind/suppress.patched.3.6.0 +++ b/erts/emulator/valgrind/suppress.patched.3.6.0 @@ -273,6 +273,11 @@ obj:*/ssleay.* fun:AES_cbc_encrypt ... } +{ + crypto RC4 can do harmless word aligned read past end of input + Memcheck:Addr8 + fun:RC4 +} { erts_bits_init_state; Why is this needed? diff --git a/erts/emulator/valgrind/suppress.standard b/erts/emulator/valgrind/suppress.standard index a4da31a61d..b3c77119fb 100644 --- a/erts/emulator/valgrind/suppress.standard +++ b/erts/emulator/valgrind/suppress.standard @@ -260,6 +260,11 @@ obj:*/ssleay.* fun:AES_cbc_encrypt ... } +{ + crypto RC4 can do harmless word aligned read past end of input + Memcheck:Addr8 + fun:RC4 +} { Prebuilt constant terms in os_info_init (PossiblyLost) diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c index 3cfa7a782f..0823dcaa4e 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -345,7 +345,7 @@ static void run_daemon(EpmdVars *g) inform it of that the log is closed. */ closelog(); - /* These chouldn't be needed but for safety... */ + /* These shouldn't be needed but for safety... */ open("/dev/null", O_RDONLY); /* Order is important! */ open("/dev/null", O_WRONLY); @@ -386,7 +386,7 @@ static void run_daemon(EpmdVars *g) close(1); close(2); - /* These chouldn't be needed but for safety... */ + /* These shouldn't be needed but for safety... */ open("nul", O_RDONLY); open("nul", O_WRONLY); @@ -498,7 +498,11 @@ static void dbg_gen_printf(int onsyslog,int perr,int from_level, #ifdef HAVE_SYSLOG_H if (onsyslog) { - erts_vsnprintf(buf, DEBUG_BUFFER_SIZE, format, args); + int len; + len = erts_vsnprintf(buf, DEBUG_BUFFER_SIZE, format, args); + if (perr != 0 && len < sizeof(buf)) { + erts_snprintf(buf+len, sizeof(buf)-len, ": %s", strerror(perr)); + } syslog(LOG_ERR,"epmd: %s",buf); } #endif diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 709c6f02d1..5ebde8ca3c 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -128,6 +128,7 @@ static char *pluss_val_switches[] = { "bwt", "cl", "ct", + "ecio", "fwi", "tbt", "wct", diff --git a/erts/etc/common/run_erl_common.c b/erts/etc/common/run_erl_common.c index dc55c2bea4..580b6cc3c5 100644 --- a/erts/etc/common/run_erl_common.c +++ b/erts/etc/common/run_erl_common.c @@ -74,15 +74,6 @@ * run_erl multiple times with different global variables without them * effecting eachother. */ -typedef struct run_erl_ run_erl; - -#ifdef __OSE__ -static OSPPDKEY run_erl_pp_key; -#define RE_DATA (*(run_erl**)ose_get_ppdata(run_erl_pp_key)) -#else -static run_erl re; -#define RE_DATA (&re) -#endif #define STATUSFILE (RE_DATA->statusfile) #define LOG_DIR (RE_DATA->log_dir) @@ -116,6 +107,16 @@ struct run_erl_ { unsigned protocol_ver; }; +typedef struct run_erl_ run_erl; + +#ifdef __OSE__ +static OSPPDKEY run_erl_pp_key; +#define RE_DATA (*(run_erl**)ose_get_ppdata(run_erl_pp_key)) +#else +static run_erl re; +#define RE_DATA (&re) +#endif + /* prototypes */ static int next_log(int log_num); diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index 78fefbea55..aa51eabfc5 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -43,6 +43,7 @@ # -gcov Run emulator compiled for gcov # -valgrind Run emulator compiled for valgrind # -lcnt Run emulator compiled for lock counting +# -icount Run emulator compiled for instruction counting # -nox Unset the DISPLAY variable to disable us of X Windows # # FIXME For GDB you can also set the break point using "-break FUNCTION". @@ -180,6 +181,11 @@ while [ $# -gt 0 ]; do cargs="$cargs -frmptr" TYPE=.frmptr ;; + "-icount") + shift + cargs="$cargs -icount" + TYPE=.icount + ;; "-dump") shift GDB=dump diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index bf6eb00314..1a723ad936 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -1065,8 +1065,8 @@ define etp-cp-1 set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2 end if $etp_cp_p - # 12 = MI_FUNCTIONS - set $etp_cp_low = (Eterm**)($etp_cp_p->start + 12) + # 13 = MI_FUNCTIONS + set $etp_cp_low = (Eterm**)($etp_cp_p->start + 13) # 0 = MI_NUM_FUNCTIONS set $etp_cp_high = $etp_cp_low +$etp_cp_p->start[0] set $etp_cp_p = 0 @@ -3481,11 +3481,13 @@ end define etp-carrier-blocks set $etp_crr = (Carrier_t*) $arg0 set $etp_alc = (Allctr_t*)($etp_crr->allctr.counter & ~7) + set $etp_crr_end = ((char*)$etp_crr + ($etp_crr->chdr & ~7) - (sizeof(void*) & ~8)) set $etp_blk = (Block_t*) ((char*)$etp_crr + $etp_alc->mbc_header_size) set $etp_prev_blk = 0 set $etp_error_cnt = 0 set $etp_ablk_cnt = 0 set $etp_fblk_cnt = 0 + set $etp_aborted = 0 if $argc == 2 set $etp_be_silent = $arg1 @@ -3532,14 +3534,21 @@ define etp-carrier-blocks end set $etp_prev_blk = $etp_blk set $etp_blk = (Block_t*) ((char*)$etp_blk + $etp_blk_sz) + if $etp_blk < (Block_t*) ((char*)$etp_prev_blk + $etp_alc->min_block_size) || $etp_blk >= $etp_crr_end + printf "ERROR: Invalid size of block at %#lx. ABORTING\n", $etp_prev_blk + set $etp_aborted = 1 + loop_break + end end - if ((char*)$etp_blk + $etp_blk_sz) != ((char*)$etp_crr + ($etp_crr->chdr & ~7)) - printf "ERROR: Last block not at end of carrier\n" - set $etp_error_cnt = $etp_error_cnt + 1 + if !$etp_aborted + if ((char*)$etp_blk + $etp_blk_sz) != $etp_crr_end + printf "ERROR: Last block not at end of carrier\n" + set $etp_error_cnt = $etp_error_cnt + 1 + end + printf "Allocated blocks: %u\n", $etp_ablk_cnt + printf "Free blocks: %u\n", $etp_fblk_cnt end - printf "Allocated blocks: %u\n", $etp_ablk_cnt - printf "Free blocks: %u\n", $etp_fblk_cnt if $etp_error_cnt printf "%u ERRORs reported above\n", $etp-error-cnt end @@ -3552,6 +3561,39 @@ document etp-carrier-blocks %--------------------------------------------------------------------------- end +define etp-address-to-beam-opcode + set $etp_i = 0 + set $etp_min_diff = ((UWord)1 << (sizeof(UWord)*8 - 1)) + set $etp_min_opcode = -1 + set $etp_addr = (UWord) ($arg0) + + while $etp_i < num_instructions && $etp_min_diff > 0 + if ($etp_addr - (UWord)beam_ops[$etp_i]) < $etp_min_diff + set $etp_min_diff = $etp_addr - (UWord)beam_ops[$etp_i] + set $etp_min_opcode = $etp_i + end + set $etp_i = $etp_i + 1 + end + if $etp_min_diff == 0 + printf "Address %p is start of '%s'\n", $etp_addr, opc[$etp_min_opcode].name + else + if $etp_min_opcode >= 0 + printf "Address is %ld bytes into opcode '%s' at %p\n", $etp_min_diff, opc[$etp_min_opcode].name, beam_ops[$etp_min_opcode] + else + printf "Invalid opcode address\n" + end + end +end + +document etp-address-to-beam-opcode +%--------------------------------------------------------------------------- +% Get beam opcode from a native instruction address (within process_main()) +% Arg: Instructon pointer value +% +% Does not work with NO_JUMP_TABLE +%--------------------------------------------------------------------------- +end + ############################################################################ # Toolbox parameter handling diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c index a6fc4c2bf5..4b123b8911 100644 --- a/erts/etc/unix/run_erl.c +++ b/erts/etc/unix/run_erl.c @@ -40,9 +40,13 @@ #ifdef HAVE_CONFIG_H # include "config.h" #endif + #ifdef HAVE_WORKING_POSIX_OPENPT +#ifndef _XOPEN_SOURCE #define _XOPEN_SOURCE 600 #endif +#endif + #include <sys/types.h> #include <sys/wait.h> #include <sys/stat.h> diff --git a/erts/etc/win32/Install.c b/erts/etc/win32/Install.c index 500fd166f8..9d85d642ab 100644 --- a/erts/etc/win32/Install.c +++ b/erts/etc/win32/Install.c @@ -80,7 +80,7 @@ int wmain(int argc, wchar_t **argv) } } if (root == NULL) { - if (module = NULL) { + if (module == NULL) { fprintf(stderr, "Cannot GetModuleHandle()\n"); exit(1); } diff --git a/erts/etc/win32/erl.c b/erts/etc/win32/erl.c index 1d116bf36e..772b668586 100644 --- a/erts/etc/win32/erl.c +++ b/erts/etc/win32/erl.c @@ -264,7 +264,7 @@ static void get_parameters(void) int len; - if (module = NULL) { + if (module == NULL) { error("Cannot GetModuleHandle()"); } diff --git a/erts/lib_src/Makefile.in b/erts/lib_src/Makefile.in index b680c03b1d..d0ebab49d8 100644 --- a/erts/lib_src/Makefile.in +++ b/erts/lib_src/Makefile.in @@ -92,6 +92,11 @@ CFLAGS += -DERTS_FRMPTR OMIT_OMIT_FP=yes PRE_LD= else +ifeq ($(TYPE),icount) +TYPE_SUFFIX = .icount +CFLAGS += -DERTS_OPCODE_COUNTER_SUPPORT +PRE_LD= +else override TYPE=opt OMIT_FP=true TYPE_SUFFIX= @@ -105,6 +110,7 @@ endif endif endif endif +endif OPSYS=@OPSYS@ sol2CFLAGS= diff --git a/erts/lib_src/common/erl_misc_utils.c b/erts/lib_src/common/erl_misc_utils.c index d58a28b5cb..7833dd8219 100644 --- a/erts/lib_src/common/erl_misc_utils.c +++ b/erts/lib_src/common/erl_misc_utils.c @@ -1515,7 +1515,7 @@ const char* parse_topology_spec_group(erts_cpu_info_t *cpuinfo, const char* xml, if (is_thread_group) { thread++; } else { - *core_p = (*core_p)++; + *core_p = (*core_p) + 1; } index_procs++; } @@ -1535,9 +1535,9 @@ const char* parse_topology_spec_group(erts_cpu_info_t *cpuinfo, const char* xml, if (parentCacheLevel == 0) { *core_p = 0; - *processor_p = (*processor_p)++; + *processor_p = (*processor_p) + 1; } else { - *core_p = (*core_p)++; + *core_p = (*core_p) + 1; } if (error) diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam Binary files differindex 5f2b619322..c8ec111e57 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 260badbcb3..d0f9907709 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 7dc7407a81..ba45e4e011 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 5c139c4550..26f779500c 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 cf32b79e8d..4d22d8bace 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 differindex 37ed8d0365..efc8347b6e 100644 --- a/erts/preloaded/ebin/prim_eval.beam +++ 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 d49578abfa..6c49b5185e 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 8420052533..f58ee4b4d5 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 8dc8cb961b..73be297bbb 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 7507efb076..193cebdc31 100644 --- a/erts/preloaded/ebin/zlib.beam +++ b/erts/preloaded/ebin/zlib.beam diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index 466e0b0020..6b86a427ba 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -1507,7 +1507,14 @@ real_path(Name,[Path|Paths],Acc,Links) -> [""|_] = LinkPaths -> real_path(Name,LinkPaths++Paths,[],[ThisFile|Links]); LinkPaths -> - real_path(Name,LinkPaths++Paths,Acc,[ThisFile|Links]) + % windows currently does not allow creation of relative symlinks + % across different drives + case erlang:system_info(os_type) of + {win32, _} -> + real_path(Name,LinkPaths++Paths,[],[ThisFile|Links]); + _ -> + real_path(Name,LinkPaths++Paths,Acc,[ThisFile|Links]) + end end; _ -> real_path(Name,Paths,This,Links) diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 4ff0513321..83a38da26b 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -91,9 +91,9 @@ -export([external_size/2, finish_after_on_load/2, finish_loading/1, float/1]). -export([float_to_binary/1, float_to_binary/2, float_to_list/1, float_to_list/2]). --export([fun_info/2, fun_to_list/1, function_exported/3]). +-export([fun_info/2, fun_info_mfa/1, fun_to_list/1, function_exported/3]). -export([garbage_collect/0, garbage_collect/1, garbage_collect/2]). --export([garbage_collect_message_area/0, get/0, get/1, get_keys/1]). +-export([garbage_collect_message_area/0, get/0, get/1, get_keys/0, get_keys/1]). -export([get_module_info/1, get_stacktrace/0, group_leader/0]). -export([group_leader/2, halt/0, halt/1, halt/2, hash/2, hibernate/3]). -export([insert_element/3]). @@ -827,6 +827,15 @@ float_to_list(_Float, _Options) -> fun_info(_Fun, _Item) -> erlang:nif_error(undefined). +%% fun_info_mfa/1 +-spec erlang:fun_info_mfa(Fun) -> {Mod, Name, Arity} when + Fun :: function(), + Mod :: atom(), + Name :: atom(), + Arity :: non_neg_integer(). +fun_info_mfa(_Fun) -> + erlang:nif_error(undefined). + %% fun_to_list/1 -spec erlang:fun_to_list(Fun) -> string() when Fun :: function(). @@ -922,6 +931,12 @@ get() -> get(_Key) -> erlang:nif_error(undefined). +%% get_keys/0 +-spec get_keys() -> [Key] when + Key :: term(). +get_keys() -> + erlang:nif_error(undefined). + %% get_keys/1 -spec get_keys(Val) -> [Key] when Val :: term(), @@ -1642,7 +1657,7 @@ element(_N, _Tuple) -> %% Not documented -spec erlang:get_module_info(Module, Item) -> ModuleInfo when Module :: atom(), - Item :: module | imports | exports | functions | attributes | compile | native_addresses, + Item :: module | imports | exports | functions | attributes | compile | native_addresses | md5, ModuleInfo :: atom() | [] | [{atom(), arity()}] | [{atom(), term()}] | [{atom(), arity(), integer()}]. get_module_info(_Module, _Item) -> erlang:nif_error(undefined). @@ -2224,6 +2239,7 @@ tuple_to_list(_Tuple) -> (dynamic_trace) -> none | dtrace | systemtap; (dynamic_trace_probes) -> boolean(); (elib_malloc) -> false; + (eager_check_io) -> boolean(); (ets_limit) -> pos_integer(); (fullsweep_after) -> {fullsweep_after, non_neg_integer()}; (garbage_collection) -> [{atom(), integer()}]; diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src index a15da3a421..345a6ae3be 100644 --- a/erts/preloaded/src/erts.app.src +++ b/erts/preloaded/src/erts.app.src @@ -35,7 +35,6 @@ {registered, []}, {applications, []}, {env, []}, - {mod, {erts, []}}, {runtime_dependencies, ["stdlib-2.0", "kernel-3.0", "sasl-2.4"]} ]}. diff --git a/erts/test/erlc_SUITE_data/src/start_ok.script b/erts/test/erlc_SUITE_data/src/start_ok.script index 4cd89f0439..7ef97dc3f3 100644 --- a/erts/test/erlc_SUITE_data/src/start_ok.script +++ b/erts/test/erlc_SUITE_data/src/start_ok.script @@ -52,7 +52,6 @@ shell_default, timer, gen_fsm, - pg, unix, dict, pool, @@ -156,7 +155,6 @@ {timer,1}, {gen_fsm,1}, {io_lib_pretty,1}, - {pg,1}, {slave,1}, {unix,1}, {dict,1}, diff --git a/erts/test/upgrade_SUITE.erl b/erts/test/upgrade_SUITE.erl index d5a920e03d..7b3bc1b063 100644 --- a/erts/test/upgrade_SUITE.erl +++ b/erts/test/upgrade_SUITE.erl @@ -237,7 +237,10 @@ do_upgrade(FromVsn,FromApps,ToRel,ToApps,InstallDir) -> [{"OTP upgrade test",FromVsn,_,permanent}] = rpc:call(Node,release_handler,which_releases,[]), - {ok,ToVsn} = rpc:call(Node,release_handler,unpack_release,[ToRel]), + ToRelName = filename:basename(ToRel), + copy_file(ToRel++".tar.gz", + filename:join([InstallDir,releases,ToRelName++".tar.gz"])), + {ok,ToVsn} = rpc:call(Node,release_handler,unpack_release,[ToRelName]), [{"OTP upgrade test",ToVsn,_,unpacked}, {"OTP upgrade test",FromVsn,_,permanent}] = rpc:call(Node,release_handler,which_releases,[]), diff --git a/erts/vsn.mk b/erts/vsn.mk index 0db4370ea8..ab98bd4a17 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -17,7 +17,7 @@ # %CopyrightEnd% # -VSN = 6.1.2 +VSN = 7.0 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/asn1/c_src/asn1_erl_nif.c b/lib/asn1/c_src/asn1_erl_nif.c index 8a0e4b1cf0..317a464060 100644 --- a/lib/asn1/c_src/asn1_erl_nif.c +++ b/lib/asn1/c_src/asn1_erl_nif.c @@ -941,16 +941,31 @@ static int ber_decode_value(ErlNifEnv* env, ERL_NIF_TERM *value, unsigned char * int maybe_ret; unsigned int len = 0; unsigned int lenoflen = 0; - int indef = 0; unsigned char *tmp_out_buff; ERL_NIF_TERM term = 0, curr_head = 0; if (((in_buf[*ib_index]) & 0x80) == ASN1_SHORT_DEFINITE_LENGTH) { len = in_buf[*ib_index]; - } else if (in_buf[*ib_index] == ASN1_INDEFINITE_LENGTH - ) - indef = 1; - else /* long definite length */{ + } else if (in_buf[*ib_index] == ASN1_INDEFINITE_LENGTH) { + (*ib_index)++; + curr_head = enif_make_list(env, 0); + if (*ib_index+1 >= in_buf_len || form == ASN1_PRIMITIVE) { + return ASN1_INDEF_LEN_ERROR; + } + while (!(in_buf[*ib_index] == 0 && in_buf[*ib_index + 1] == 0)) { + maybe_ret = ber_decode(env, &term, in_buf, ib_index, in_buf_len); + if (maybe_ret <= ASN1_ERROR) { + return maybe_ret; + } + curr_head = enif_make_list_cell(env, term, curr_head); + if (*ib_index+1 >= in_buf_len) { + return ASN1_INDEF_LEN_ERROR; + } + } + enif_make_reverse_list(env, curr_head, value); + (*ib_index) += 2; /* skip the indefinite length end bytes */ + return ASN1_OK; + } else /* long definite length */{ lenoflen = (in_buf[*ib_index] & 0x7f); /*length of length */ if (lenoflen > (in_buf_len - (*ib_index + 1))) return ASN1_LEN_ERROR; @@ -965,23 +980,7 @@ static int ber_decode_value(ErlNifEnv* env, ERL_NIF_TERM *value, unsigned char * if (len > (in_buf_len - (*ib_index + 1))) return ASN1_VALUE_ERROR; (*ib_index)++; - if (indef == 1) { /* in this case it is desireably to check that indefinite length - end bytes exist in inbuffer */ - curr_head = enif_make_list(env, 0); - while (!(in_buf[*ib_index] == 0 && in_buf[*ib_index + 1] == 0)) { - if (*ib_index >= in_buf_len) - return ASN1_INDEF_LEN_ERROR; - - if ((maybe_ret = ber_decode(env, &term, in_buf, ib_index, in_buf_len)) - <= ASN1_ERROR - ) - return maybe_ret; - curr_head = enif_make_list_cell(env, term, curr_head); - } - enif_make_reverse_list(env, curr_head, value); - (*ib_index) += 2; /* skip the indefinite length end bytes */ - } else if (form == ASN1_CONSTRUCTED) - { + if (form == ASN1_CONSTRUCTED) { int end_index = *ib_index + len; if (end_index > in_buf_len) return ASN1_LEN_ERROR; diff --git a/lib/asn1/doc/src/asn1_ug.xml b/lib/asn1/doc/src/asn1_ug.xml index 020e58c615..8b33497dd3 100644 --- a/lib/asn1/doc/src/asn1_ug.xml +++ b/lib/asn1/doc/src/asn1_ug.xml @@ -1390,7 +1390,7 @@ GENERAL-PROCEDURES GENERAL-PROCEDURE ::= { instance, if a Type is used in a definition with certain purpose, one want the type-name to express the intention. This can be done with parameterization.</p> - <p>When many types (or an other ASN.1 entity) only differs in some + <p>When many types (or another ASN.1 entity) only differs in some minor cases, but the structure of the types are similar, only one general type can be defined and the differences may be supplied through parameters. </p> diff --git a/lib/asn1/doc/src/notes.xml b/lib/asn1/doc/src/notes.xml index 11de9ad98f..a7032737bd 100644 --- a/lib/asn1/doc/src/notes.xml +++ b/lib/asn1/doc/src/notes.xml @@ -31,6 +31,30 @@ <p>This document describes the changes made to the asn1 application.</p> +<section><title>Asn1 3.0.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Several problems where the ASN.1 compiler would crash + when attempting to compile correct specifications have + been corrected.</p> + <p> + Own Id: OTP-12125</p> + </item> + <item> + <p> + Robustness when decoding incorrect BER messages has been + improved.</p> + <p> + Own Id: OTP-12145</p> + </item> + </list> + </section> + +</section> + <section><title>Asn1 3.0.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl index 396ba0fcfa..6c1cf1b12a 100644 --- a/lib/asn1/src/asn1_records.hrl +++ b/lib/asn1/src/asn1_records.hrl @@ -37,7 +37,7 @@ -record('ObjectClassFieldType',{classname,class,fieldname,type}). -record(typedef,{checked=false,pos,name,typespec}). --record(classdef,{checked=false,pos,name,typespec}). +-record(classdef, {checked=false,pos,name,module,typespec}). -record(valuedef,{checked=false,pos,name,type,value,module}). -record(ptypedef,{checked=false,pos,name,args,typespec}). -record(pvaluedef,{checked=false,pos,name,args,type,value}). @@ -45,7 +45,6 @@ -record(pobjectdef,{checked=false,pos,name,args,class,def}). -record(pobjectsetdef,{checked=false,pos,name,args,class,def}). --record(identifier,{pos,val}). -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, @@ -73,6 +72,15 @@ % Externalvaluereference -> modulename '.' typename -record('Externalvaluereference',{pos,module,value}). +%% Used to hold a tag for a field in a SEQUENCE/SET. It can also +%% be used for identifiers in OBJECT IDENTIFIER values, since the +%% parser cannot always distinguish a SEQUENCE with one element from +%% an OBJECT IDENTIFIER. +-record(seqtag, + {pos :: integer(), + module :: atom(), + val :: atom()}). + -record(state,{module,mname,type,tname,value,vname,erule,parameters=[], inputmodules,abscomppath=[],recordtopname=[],options, sourcedir}). diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 8470e5a1b4..df341e5aab 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -43,7 +43,7 @@ add_tobe_refed_func/1,add_generated_refed_func/1, 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]). + parse_and_save/2,verbose/3,warning/3,warning/4,error/3,format_error/1]). -export([get_bit_string_format/0,use_legacy_types/0]). -include("asn1_records.hrl"). @@ -143,7 +143,8 @@ parse_and_save_passes() -> {pass,save,fun save_pass/1}]. common_passes() -> - [{pass,check,fun check_pass/1}, + [{iff,parse,{pass,parse_listing,fun parse_listing/1}}, + {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}}]. @@ -243,6 +244,16 @@ save_pass(#st{code=M,erule=Erule,dbfile=DbFile}=St) -> asn1_db:dbsave(DbFile,M#module.name), {ok,St}. +parse_listing(#st{code=Code,outfile=OutFile0}=St) -> + OutFile = OutFile0 ++ ".parse", + case file:write_file(OutFile, io_lib:format("~p\n", [Code])) of + ok -> + done; + {error,Reason} -> + Error = {write_error,OutFile,Reason}, + {error,St#st{error=[{structured_error,{OutFile0,none},?MODULE,Error}]}} + end. + abs_listing(#st{code={M,_},outfile=OutFile}) -> pretty2(M#module.name, OutFile++".abs"), done. @@ -2430,6 +2441,10 @@ verbose(Format, Args, S) -> ok end. +format_error({write_error,File,Reason}) -> + io_lib:format("writing output file ~s failed: ~s", + [File,file:format_error(Reason)]). + is_error(S) when is_record(S, state) -> is_error(S#state.options); is_error(O) -> diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index e788aa5c6c..5d8740b92e 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -91,7 +91,7 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> save_asn1db_uptodate(S,S#state.erule,S#state.mname), put(top_module,S#state.mname), - _ = checkp(S, ParameterizedTypes), %must do this before the templates are used + ParamError = 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), @@ -160,8 +160,10 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> Exporterror = check_exports(S,S#state.module), ImportError = check_imports(S,S#state.module), - case {Terror3,Verror5,Cerror,Oerror,Exporterror,ImportError} of - {[],[],[],[],[],[]} -> + AllErrors = lists:flatten([ParamError,Terror3,Verror5,Cerror, + Oerror,Exporterror,ImportError]), + case AllErrors of + [] -> ContextSwitchTs = context_switch_in_spec(), InstanceOf = instance_of_in_spec(S#state.mname), NewTypes = lists:subtract(Types,AddClasses) ++ ContextSwitchTs @@ -175,8 +177,7 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> lists:subtract(NewObjects,ExclO)++InlinedObjects, lists:subtract(NewObjectSets,ExclOS)++ParObjectSetNames}}; _ -> - {error,lists:flatten([Terror3,Verror5,Cerror, - Oerror,Exporterror,ImportError])} + {error,AllErrors} end. context_switch_in_spec() -> @@ -549,14 +550,10 @@ check_class(S = #state{mname=M,tname=T},ClassSpec) #objectclass{fields=Def}; % in case of recursive definitions Tref = #'Externaltypereference'{type=TName} -> {MName,RefType} = get_referenced_type(S,Tref), - case is_class(S,RefType) of - true -> - NewState = update_state(S#state{type=RefType, - tname=TName},MName), - check_class(NewState,get_class_def(S,RefType)); - _ -> - error({class,{internal_error,RefType},S}) - end; + #classdef{} = CD = get_class_def(S, RefType), + NewState = update_state(S#state{type=RefType, + tname=TName}, MName), + check_class(NewState, CD); {pt,ClassRef,Params} -> %% parameterized class {_,PClassDef} = get_referenced_type(S,ClassRef), @@ -950,6 +947,8 @@ prepare_objset(ObjDef={object,definedsyntax,_ObjFields}) -> {set,[ObjDef],false}; prepare_objset({ObjDef=#type{},Ext}) when is_list(Ext) -> {set,[ObjDef|Ext],true}; +prepare_objset({#type{}=Type,#type{}=Ext}) -> + {set,[Type,Ext],true}; prepare_objset(Ret) -> Ret. @@ -1277,10 +1276,25 @@ get_fieldname_element(_S,Def,[{_RefType,_FieldName}|_RestFName]) check_fieldname_element(S,{value,{_,Def}}) -> check_fieldname_element(S,Def); -check_fieldname_element(S,TDef) when is_record(TDef,typedef) -> - check_type(S,TDef,TDef#typedef.typespec); -check_fieldname_element(S,VDef) when is_record(VDef,valuedef) -> - check_value(S,VDef); +check_fieldname_element(S, #typedef{typespec=Ts}=TDef) -> + case Ts of + #'Object'{} -> + check_object(S, TDef, Ts); + _ -> + check_type(S, TDef, Ts) + end; +check_fieldname_element(S, #valuedef{}=VDef) -> + try + check_value(S, VDef) + catch + throw:{objectdef} -> + #valuedef{checked=C,pos=Pos,name=N,type=Type, + value=Def} = VDef, + ClassName = Type#type.def, + NewSpec = #'Object'{classname=ClassName,def=Def}, + NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec}, + check_fieldname_element(S, NewDef) + end; check_fieldname_element(S,Eref) when is_record(Eref,'Externaltypereference'); is_record(Eref,'Externalvaluereference') -> @@ -1803,12 +1817,10 @@ convert_to_defaultfield(S,ObjFieldName,[OFS|RestOFS],CField)-> FieldName); ValSetting = #valuedef{} -> ValSetting; - ValSetting = {'CHOICE',{Alt,_ChVal}} when is_atom(Alt) -> - #valuedef{type=element(3,CField), - value=ValSetting, - module=S#state.mname}; ValSetting -> - #identifier{val=ValSetting} + #valuedef{type=element(3,CField), + value=ValSetting, + module=S#state.mname} end, ?dbg("fixedtypevaluefield ValRef: ~p~n",[ValRef]), case ValRef of @@ -2292,22 +2304,23 @@ validate_oid(_, S, OID, [Id|Vrest], Acc) error({value, {"illegal "++to_string(OID),[Id,Vrest],Acc}, S}) end end; -validate_oid(_, S, OID, [{Atom,Value}],[]) +validate_oid(_, S, OID, [{#seqtag{module=Mod,val=Atom},Value}], []) when is_atom(Atom),is_integer(Value) -> %% this case when an OBJECT IDENTIFIER value has been parsed as a %% SEQUENCE value - Rec = #'Externalvaluereference'{module=S#state.mname, + Rec = #'Externalvaluereference'{module=Mod, value=Atom}, validate_objectidentifier1(S, OID, [Rec,Value]); -validate_oid(_, S, OID, [{Atom,EVRef}],[]) +validate_oid(_, S, OID, [{#seqtag{module=Mod,val=Atom},EVRef}], []) when is_atom(Atom),is_record(EVRef,'Externalvaluereference') -> %% this case when an OBJECT IDENTIFIER value has been parsed as a %% SEQUENCE value OTP-4354 - Rec = #'Externalvaluereference'{module=EVRef#'Externalvaluereference'.module, + Rec = #'Externalvaluereference'{module=Mod, value=Atom}, validate_objectidentifier1(S, OID, [Rec,EVRef]); -validate_oid(_, S, OID, [Atom|Rest],Acc) when is_atom(Atom) -> - Rec = #'Externalvaluereference'{module=S#state.mname, +validate_oid(_, S, OID, [#seqtag{module=Mod,val=Atom}|Rest], Acc) + when is_atom(Atom) -> + Rec = #'Externalvaluereference'{module=Mod, value=Atom}, validate_oid(true,S, OID, [Rec|Rest],Acc); validate_oid(_, S, OID, V, Acc) -> @@ -2689,20 +2702,20 @@ normalize_set(S,Value,Components,NameList) -> normalized_record('SET',S,SortedVal,Components,NameList) end. -sort_value(Components,Value) -> - ComponentNames = lists:map(fun(#'ComponentType'{name=Cname}) -> Cname end, - Components), - sort_value1(ComponentNames,Value,[]). -sort_value1(_,V=#'Externalvaluereference'{},_) -> - %% sort later, get the value in normalize_seq_or_set - V; -sort_value1([N|Ns],Value,Acc) -> - case lists:keysearch(N,1,Value) of - {value,V} ->sort_value1(Ns,Value,[V|Acc]); - _ -> sort_value1(Ns,Value,Acc) - end; -sort_value1([],_,Acc) -> - lists:reverse(Acc). +sort_value(Components, Value0) when is_list(Value0) -> + {Keys0,_} = lists:mapfoldl(fun(#'ComponentType'{name=N}, I) -> + {{N,I},I+1} + end, 0, Components), + Keys = gb_trees:from_orddict(orddict:from_list(Keys0)), + Value1 = [{case gb_trees:lookup(N, Keys) of + {value,K} -> K; + none -> 'end' + end,Pair} || {#seqtag{val=N},_}=Pair <- Value0], + Value = lists:sort(Value1), + [Pair || {_,Pair} <- Value]; +sort_value(_Components, #'Externalvaluereference'{}=Value) -> + %% Sort later. + Value. sort_val_if_set(['SET'|_],Val,Type) -> sort_value(Type,Val); @@ -2735,9 +2748,9 @@ is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) -> is_record_normalized(_,_,_,_) -> false. -normalize_seq_or_set(SorS,S,[{Cname,V}|Vs], +normalize_seq_or_set(SorS, S, [{#seqtag{val=Cname},V}|Vs], [#'ComponentType'{name=Cname,typespec=TS}|Cs], - NameList,Acc) -> + NameList, Acc) -> NewNameList = case TS#type.def of #'Externaltypereference'{type=TName} -> @@ -2915,8 +2928,7 @@ get_canonic_type(S,Type,NameList) -> check_ptype(S,Type,Ts) when is_record(Ts,type) -> - %Tag = Ts#type.tag, - %Constr = Ts#type.constraint, + check_formal_parameters(S, Type#ptypedef.args), Def = Ts#type.def, NewDef= case Def of @@ -2942,6 +2954,16 @@ check_ptype(S,Type,Ts) when is_record(Ts,type) -> check_ptype(_S,_PTDef,Ts) when is_record(Ts,objectclass) -> throw({asn1_param_class,Ts}). +check_formal_parameters(S, Args) -> + _ = [check_formal_parameter(S, A) || A <- Args], + ok. + +check_formal_parameter(_, {_,_}) -> + ok; +check_formal_parameter(_, #'Externaltypereference'{}) -> + ok; +check_formal_parameter(S, #'Externalvaluereference'{value=Name}=Ref) -> + asn1_error(S, Ref, {illegal_typereference,Name}). % check_type(S,Type,ObjSpec={{objectclassname,_},_}) -> % check_class(S,ObjSpec); @@ -2989,9 +3011,9 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> {TmpRefMod,TmpRefDef} -> {TmpRefMod,TmpRefDef,false} end, - case is_class(S,RefTypeDef) of - true -> throw({asn1_class,RefTypeDef}); - _ -> ok + case get_class_def(S, RefTypeDef) of + none -> ok; + #classdef{} -> throw({asn1_class,RefTypeDef}) end, Ct = TestFun(Ext), {RefType,ExtRef} = @@ -3372,23 +3394,17 @@ get_type_from_object(S,Object,TypeField) ObjSpec = check_object(S,ObjectDef,ObjectDef#typedef.typespec), get_fieldname_element(S,ObjectDef#typedef{typespec=ObjSpec},TypeField). -is_class(_S,#classdef{}) -> - true; -is_class(S,#typedef{typespec=#type{def=Eref}}) - when is_record(Eref,'Externaltypereference')-> - is_class(S,Eref); -is_class(S,Eref) when is_record(Eref,'Externaltypereference')-> - {_,NextDef} = get_referenced_type(S,Eref), - is_class(S,NextDef); -is_class(_,_) -> - false. - -get_class_def(_S,CD=#classdef{}) -> +%% get_class_def(S, Type) -> #classdef{} | 'none'. +get_class_def(S, #typedef{typespec=#type{def=#'Externaltypereference'{}=Eref}}) -> + {_,NextDef} = get_referenced_type(S, Eref), + get_class_def(S, NextDef); +get_class_def(S, #'Externaltypereference'{}=Eref) -> + {_,NextDef} = get_referenced_type(S, Eref), + get_class_def(S, NextDef); +get_class_def(_S, #classdef{}=CD) -> CD; -get_class_def(S,#typedef{typespec=#type{def=Eref}}) - when is_record(Eref,'Externaltypereference') -> - {_,NextDef} = get_referenced_type(S,Eref), - get_class_def(S,NextDef). +get_class_def(_S, _) -> + none. maybe_illicit_implicit_tag(Kind,Tag) -> case Tag of @@ -3595,109 +3611,54 @@ match_args(_,_, _, _) -> %% categorize_arg(S,FormalArg,ActualArg) -> {FormalArg,CatgorizedActualArg} %% categorize_arg(S,{Governor,Param},ActArg) -> - case {governor_category(S,Governor),parameter_name_style(Param,ActArg)} of -%% {absent,beginning_uppercase} -> %% a type -%% categorize(S,type,ActArg); - {type,beginning_lowercase} -> %% a value - categorize(S,value,Governor,ActArg); - {type,beginning_uppercase} -> %% a value set - categorize(S,value_set,ActArg); -%% {absent,entirely_uppercase} -> %% a class -%% categorize(S,class,ActArg); + case {governor_category(S, Governor),parameter_name_style(Param)} of + {type,beginning_lowercase} -> %a value + categorize(S, value, Governor, ActArg); + {type,beginning_uppercase} -> %a value set + categorize(ActArg); {{class,ClassRef},beginning_lowercase} -> - categorize(S,object,ActArg,ClassRef); + categorize(S, object, ActArg, ClassRef); {{class,ClassRef},beginning_uppercase} -> - categorize(S,object_set,ActArg,ClassRef); - _ -> - [ActArg] + categorize(S, object_set, ActArg, ClassRef) end; -categorize_arg(S,FormalArg,ActualArg) -> - %% governor is absent => a type or a class - case FormalArg of - #'Externaltypereference'{type=Name} -> - case is_class_name(Name) of - true -> - categorize(S,class,ActualArg); - _ -> - categorize(S,type,ActualArg) - end; - FA -> - throw({error,{unexpected_formal_argument,FA}}) - end. - -governor_category(S,#type{def=Eref}) - when is_record(Eref,'Externaltypereference') -> - governor_category(S,Eref); -governor_category(_S,#type{}) -> +categorize_arg(_S, _FormalArg, ActualArg) -> + %% Governor is absent -- must be a type or a class. We have already + %% checked that the FormalArg begins with an uppercase letter. + categorize(ActualArg). + +%% governor_category(S, Item) -> type | {class,#'Externaltypereference'{}} +%% Determine whether Item is a type or a class. +governor_category(S, #type{def=#'Externaltypereference'{}=Eref}) -> + governor_category(S, Eref); +governor_category(_S, #type{}) -> type; -governor_category(S,Ref) when is_record(Ref,'Externaltypereference') -> - case is_class(S,Ref) of - true -> - {class,Ref}; - _ -> +governor_category(S, #'Externaltypereference'{}=Ref) -> + case get_class_def(S, Ref) of + #classdef{pos=Pos,module=Mod,name=Name} -> + {class,#'Externaltypereference'{pos=Pos,module=Mod,type=Name}}; + none -> type - end; -governor_category(_,Class) - when Class == 'TYPE-IDENTIFIER'; Class == 'ABSTRACT-SYNTAX' -> - class. -%% governor_category(_,_) -> -%% absent. + end. %% parameter_name_style(Param,Data) -> Result %% gets the Parameter and the name of the Data and if it exists tells %% whether it begins with a lowercase letter or is partly or entirely %% spelled with uppercase letters. Otherwise returns undefined %% -parameter_name_style(_,#'Externaltypereference'{type=Name}) -> - name_category(Name); -parameter_name_style(_,#'Externalvaluereference'{value=Name}) -> - name_category(Name); -parameter_name_style(_,{valueset,_}) -> - %% It is a object set or value set +parameter_name_style(#'Externaltypereference'{}) -> beginning_uppercase; -parameter_name_style(#'Externalvaluereference'{},_) -> - beginning_lowercase; -parameter_name_style(#'Externaltypereference'{type=Name},_) -> - name_category(Name); -parameter_name_style(_,_) -> - undefined. - -name_category(Atom) when is_atom(Atom) -> - name_category(atom_to_list(Atom)); -name_category([H|T]) -> - case is_lowercase(H) of - true -> - beginning_lowercase; - _ -> - case is_class_name(T) of - true -> - entirely_uppercase; - _ -> - beginning_uppercase - end - end; -name_category(_) -> - undefined. +parameter_name_style(#'Externalvaluereference'{}) -> + beginning_lowercase. is_lowercase(X) when X >= $A,X =< $W -> false; is_lowercase(_) -> true. - -is_class_name(Name) when is_atom(Name) -> - is_class_name(atom_to_list(Name)); -is_class_name(Name) -> - case [X||X <- Name, X >= $a,X =< $w] of - [] -> - true; - _ -> - false - end. -%% categorize(S,Category,Parameter) -> CategorizedParameter +%% categorize(Parameter) -> CategorizedParameter %% If Parameter has an abstract syntax of another category than %% Category, transform it to a known syntax. -categorize(_S,type,{object,_,Type}) -> +categorize({object,_,Type}) -> %% One example of this case is an object with a parameterized type %% having a locally defined type as parameter. Def = fun(D = #type{}) -> @@ -3709,11 +3670,12 @@ categorize(_S,type,{object,_,Type}) -> D end, [Def(X)||X<-Type]; -categorize(_S,type,Def) when is_record(Def,type) -> +categorize(#type{}=Def) -> [#typedef{name = new_reference_name("type_argument"), typespec = Def#type{inlined=yes}}]; -categorize(_,_,Def) -> +categorize(Def) -> [Def]. + categorize(S,object_set,Def,ClassRef) -> NewObjSetSpec = check_object(S,Def,#'ObjectSet'{class = ClassRef, @@ -4546,55 +4508,43 @@ check_reference(S,#'Externaltypereference'{pos=Pos,module=Emod,type=Name}) -> #'Externaltypereference'{pos=Pos,module=ModName,type=Name} end. +get_referenced_type(S, T) -> + case do_get_referenced_type(S, T) of + {_,#type{def=#'Externaltypereference'{}=ERef}} -> + get_referenced_type(S, ERef); + {_,#type{def=#'Externalvaluereference'{}=VRef}} -> + get_referenced_type(S, VRef); + {_,_}=Res -> + Res + end. -get_referenced_type(S,Ext) when is_record(Ext,'Externaltypereference') -> - case match_parameters(S,Ext, S#state.parameters) of - Ext -> - #'Externaltypereference'{pos=Pos,module=Emod,type=Etype} = Ext, - case S#state.mname of - Emod -> % a local reference in this module - get_referenced1(S,Emod,Etype,Pos); - _ ->% always when multi file compiling - case lists:member(Emod,S#state.inputmodules) of - true -> - get_referenced1(S,Emod,Etype,Pos); - false -> - get_referenced(S,Emod,Etype,Pos) - end - end; - ERef = #'Externaltypereference'{} -> - get_referenced_type(S,ERef); - Other -> - {undefined,Other} - end; -get_referenced_type(S=#state{mname=Emod}, - ERef=#'Externalvaluereference'{pos=P,module=Emod, - value=Eval}) -> - case match_parameters(S,ERef,S#state.parameters) of - ERef -> - get_referenced1(S,Emod,Eval,P); - OtherERef when is_record(OtherERef,'Externalvaluereference') -> - get_referenced_type(S,OtherERef); - Value -> - {Emod,Value} - end; -get_referenced_type(S,ERef=#'Externalvaluereference'{pos=Pos,module=Emod, - value=Eval}) -> - case match_parameters(S,ERef,S#state.parameters) of - ERef -> - case lists:member(Emod,S#state.inputmodules) of - true -> - get_referenced1(S,Emod,Eval,Pos); - false -> - get_referenced(S,Emod,Eval,Pos) - end; - OtherERef -> - get_referenced_type(S,OtherERef) - end; -get_referenced_type(S,#identifier{val=Name,pos=Pos}) -> - get_referenced1(S,undefined,Name,Pos); -get_referenced_type(_S,Type) -> - {undefined,Type}. +do_get_referenced_type(#state{parameters=Ps}=S, T0) -> + case match_parameters(S, T0, Ps) of + T0 -> + do_get_ref_type_1(S, T0); + T -> + do_get_referenced_type(S, T) + end. + +do_get_ref_type_1(S, #'Externaltypereference'{pos=P, + module=M, + type=T}) -> + do_get_ref_type_2(S, P, M, T); +do_get_ref_type_1(S, #'Externalvaluereference'{pos=P, + module=M, + value=V}) -> + do_get_ref_type_2(S, P, M, V); +do_get_ref_type_1(_, T) -> + {undefined,T}. + +do_get_ref_type_2(#state{mname=Current,inputmodules=Modules}=S, + Pos, M, T) -> + case M =:= Current orelse lists:member(M, Modules) of + true -> + get_referenced1(S, M, T, Pos); + false -> + get_referenced(S, M, T, Pos) + end. %% get_referenced/3 %% The referenced entity Ename may in case of an imported parameterized @@ -6760,6 +6710,8 @@ format_error({illegal_instance_of,Class}) -> [Class]); format_error(illegal_octet_string_value) -> "expecting a bstring or an hstring as value for an OCTET STRING"; +format_error({illegal_typereference,Name}) -> + io_lib:format("'~p' is used as a typereference, but does not start with an uppercase letter", [Name]); format_error({invalid_fields,Fields,Obj}) -> io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]); format_error({invalid_bit_number,Bit}) -> @@ -7006,7 +6958,7 @@ include_default_class1(_,[]) -> include_default_class1(Module,[{Name,TS}|Rest]) -> case asn1_db:dbget(Module,Name) of undefined -> - C = #classdef{checked=true,name=Name, + C = #classdef{checked=true,module=Module,name=Name, typespec=TS}, asn1_db:dbput(Module,Name,C); _ -> ok diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 283616b157..3891fce8d3 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -25,7 +25,8 @@ %% Only used internally within this module. -record(typereference, {pos,val}). --record(constraint,{c,e}). +-record(constraint, {c,e}). +-record(identifier, {pos,val}). %% parse all types in module parse(Tokens) -> @@ -112,6 +113,9 @@ parse_ModuleDefinition(Tokens) -> parse_Exports([{'EXPORTS',_L1},{';',_L2}|Rest]) -> {{exports,[]},Rest}; +parse_Exports([{'EXPORTS',_},{'ALL',_},{';',_}|Rest]) -> + %% Same as no exports definition. + {{exports,all},Rest}; parse_Exports([{'EXPORTS',_L1}|Rest]) -> {SymbolList,Rest2} = parse_SymbolList(Rest), case Rest2 of @@ -1037,10 +1041,6 @@ parse_DefinedObjectClass([{typereference,_,_ModName},{'.',_},Tr={typereference,_ parse_DefinedObjectClass([Tr={typereference,_,_ObjClName}|Rest]) -> % {{objectclassname,tref2Exttref(Tr)},Rest}; {tref2Exttref(Tr),Rest}; -parse_DefinedObjectClass([{'TYPE-IDENTIFIER',_}|Rest]) -> - {'TYPE-IDENTIFIER',Rest}; -parse_DefinedObjectClass([{'ABSTRACT-SYNTAX',_}|Rest]) -> - {'ABSTRACT-SYNTAX',Rest}; parse_DefinedObjectClass(Tokens) -> throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), [got,get_token(hd(Tokens)),expected, @@ -1051,7 +1051,8 @@ parse_DefinedObjectClass(Tokens) -> parse_ObjectClassAssignment([{typereference,L1,ObjClName},{'::=',_}|Rest]) -> {Type,Rest2} = parse_ObjectClass(Rest), - {#classdef{pos=L1,name=ObjClName,typespec=Type},Rest2}; + {#classdef{pos=L1,name=ObjClName,module=resolve_module(Type), + typespec=Type},Rest2}; parse_ObjectClassAssignment(Tokens) -> throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), [got,get_token(hd(Tokens)),expected, @@ -2134,8 +2135,7 @@ parse_ParameterizedObjectSetAssignment(Tokens) -> %% Parameter = {Governor,Reference} | Reference %% Governor = Type | DefinedObjectClass %% Type = #type{} -%% DefinedObjectClass = #'Externaltypereference'{} | -%% 'ABSTRACT-SYNTAX' | 'TYPE-IDENTIFIER' +%% DefinedObjectClass = #'Externaltypereference'{} %% Reference = #'Externaltypereference'{} | #'Externalvaluereference'{} parse_ParameterList([{'{',_}|Rest]) -> parse_ParameterList(Rest,[]); @@ -2863,13 +2863,14 @@ parse_SequenceValue(Tokens) -> throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), [got,get_token(hd(Tokens)),expected,'{']}}). -parse_SequenceValue([{identifier,_,IdName}|Rest],Acc) -> +parse_SequenceValue([{identifier,Pos,IdName}|Rest],Acc) -> {Value,Rest2} = parse_Value(Rest), + SeqTag = #seqtag{pos=Pos,module=get(asn1_module),val=IdName}, case Rest2 of [{',',_}|Rest3] -> - parse_SequenceValue(Rest3,[{IdName,Value}|Acc]); + parse_SequenceValue(Rest3, [{SeqTag,Value}|Acc]); [{'}',_}|Rest3] -> - {lists:reverse([{IdName,Value}|Acc]),Rest3}; + {lists:reverse(Acc, [{SeqTag,Value}]),Rest3}; _ -> throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), [got,get_token(hd(Rest2)),expected,'}']}}) diff --git a/lib/asn1/src/asn1ct_tok.erl b/lib/asn1/src/asn1ct_tok.erl index 33f4379173..8687ed955c 100644 --- a/lib/asn1/src/asn1ct_tok.erl +++ b/lib/asn1/src/asn1ct_tok.erl @@ -309,7 +309,6 @@ check_hex(_) -> %% returns rstrtype if A is a reserved word in the group %% RestrictedCharacterStringType reserved_word('ABSENT') -> true; -%reserved_word('ABSTRACT-SYNTAX') -> true; % impl as predef item reserved_word('ALL') -> true; reserved_word('ANY') -> true; reserved_word('APPLICATION') -> true; @@ -380,7 +379,6 @@ reserved_word('T61String') -> rstrtype; reserved_word('TAGS') -> true; reserved_word('TeletexString') -> rstrtype; reserved_word('TRUE') -> true; -%% reserved_word('TYPE-IDENTIFIER') -> true; % impl as predef item reserved_word('UNION') -> true; reserved_word('UNIQUE') -> true; reserved_word('UNIVERSAL') -> true; diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index 11d1b82fb4..888339a4d2 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -134,14 +134,13 @@ groups() -> testChoiceIndefinite, per_open_type, testInfObjectClass, - testParameterizedInfObj, + testParam, testFragmented, testMergeCompile, testobj, testDeepTConstr, testExport, testImport, - testParamBasic, testDER, testDEFAULT, testMvrasn6, @@ -520,12 +519,6 @@ testSetDefault(Config, Rule, Opts) -> asn1_test_lib:compile("SetDefault", Config, [Rule|Opts]), testSetDefault:main(Rule). -testParamBasic(Config) -> - test(Config, fun testParamBasic/3, [ber,{ber,[der]},per,uper]). -testParamBasic(Config, Rule, Opts) -> - asn1_test_lib:compile("ParamBasic", Config, [Rule|Opts]), - testParamBasic:main(Rule). - testSetOptional(Config) -> test(Config, fun testSetOptional/3). testSetOptional(Config, Rule, Opts) -> asn1_test_lib:compile("SetOptional", Config, [Rule|Opts]), @@ -758,11 +751,12 @@ testInfObjectClass(Config, Rule, Opts) -> testInfObjectClass:main(Rule), testInfObj:main(Rule). -testParameterizedInfObj(Config) -> - test(Config, fun testParameterizedInfObj/3). -testParameterizedInfObj(Config, Rule, Opts) -> - Files = ["Param","Param2"], +testParam(Config) -> + test(Config, fun testParam/3, [ber,{ber,[der]},per,uper]). +testParam(Config, Rule, Opts) -> + Files = ["ParamBasic","Param","Param2"], asn1_test_lib:compile_all(Files, Config, [Rule|Opts]), + testParamBasic:main(Rule), testParameterizedInfObj:main(Config, Rule), asn1_test_lib:compile("Param", Config, [legacy_erlang_types,Rule|Opts]), diff --git a/lib/asn1/test/asn1_SUITE_data/Constructed.asn b/lib/asn1/test/asn1_SUITE_data/Constructed.asn index 09a66d0c0d..bd49741726 100644 --- a/lib/asn1/test/asn1_SUITE_data/Constructed.asn +++ b/lib/asn1/test/asn1_SUITE_data/Constructed.asn @@ -1,6 +1,3 @@ - - - Constructed DEFINITIONS ::= BEGIN @@ -20,4 +17,7 @@ C ::= CHOICE { S3 ::= SEQUENCE {i INTEGER} S3ext ::= SEQUENCE {i INTEGER, ...} + +OS ::= OCTET STRING + END diff --git a/lib/asn1/test/asn1_SUITE_data/InfObj.asn b/lib/asn1/test/asn1_SUITE_data/InfObj.asn index 880e81c3b1..719119f418 100644 --- a/lib/asn1/test/asn1_SUITE_data/InfObj.asn +++ b/lib/asn1/test/asn1_SUITE_data/InfObj.asn @@ -255,6 +255,51 @@ Multiple-Optionals ::= SEQUENCE { t3 [2] MULTIPLE-OPTIONALS.&T3 ({Multiple-Optionals-Set}{@id}) OPTIONAL } +-- Test different ways of constructing object sets. + +OBJECT-SET-TEST ::= CLASS { + &id INTEGER UNIQUE, + &Type +} WITH SYNTAX { + &id IS &Type +} + +ObjectSetTest{OBJECT-SET-TEST:ObjectSet} ::= + SEQUENCE { + id OBJECT-SET-TEST.&id ({ObjectSet}), + type OBJECT-SET-TEST.&Type ({ObjectSet}{@id}) + } + +ost1 OBJECT-SET-TEST ::= { 1 IS BIT STRING } +ost2 OBJECT-SET-TEST ::= { 2 IS OCTET STRING } +ost3 OBJECT-SET-TEST ::= { 3 IS ENUMERATED {donald,scrooge} } +ost4 OBJECT-SET-TEST ::= { 4 IS BOOLEAN } +ost5 OBJECT-SET-TEST ::= { 5 IS INTEGER (0..15) } + +Ost12 OBJECT-SET-TEST ::= { ost1 | ost2 } +Ost123 OBJECT-SET-TEST ::= { ost3 | Ost12 } +Ost1234 OBJECT-SET-TEST ::= { Ost123 | ost4 } +Ost45 OBJECT-SET-TEST ::= { ost4 | ost5 } +Ost12345 OBJECT-SET-TEST ::= { Ost123 | Ost45 } + +OstSeq12 ::= ObjectSetTest{ {Ost12} } +OstSeq123 ::= ObjectSetTest{ {Ost123} } +OstSeq1234 ::= ObjectSetTest{ {Ost1234} } +OstSeq45 ::= ObjectSetTest{ {Ost45} } +OstSeq12345 ::= ObjectSetTest{ {Ost12345} } + +ExOst12 OBJECT-SET-TEST ::= { ost1, ..., ost2 } +ExOst123 OBJECT-SET-TEST ::= { ost3, ..., ExOst12 } +--ExOst1234 OBJECT-SET-TEST ::= { ExOst123, ..., ost4 } +ExOst45 OBJECT-SET-TEST ::= { ost4, ..., ost5 } +ExOst12345 OBJECT-SET-TEST ::= { ExOst123, ..., ExOst45 } + +ExOstSeq12 ::= ObjectSetTest{ {ExOst12} } +ExOstSeq123 ::= ObjectSetTest{ {ExOst123} } +--ExOstSeq1234 ::= ObjectSetTest{ {ExOst1234} } +ExOstSeq45 ::= ObjectSetTest{ {ExOst45} } +ExOstSeq12345 ::= ObjectSetTest{ {ExOst12345} } + END diff --git a/lib/asn1/test/asn1_SUITE_data/ParamBasic.asn1 b/lib/asn1/test/asn1_SUITE_data/ParamBasic.asn1 index 491bdf8956..68fc782f33 100644 --- a/lib/asn1/test/asn1_SUITE_data/ParamBasic.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/ParamBasic.asn1 @@ -20,4 +20,26 @@ T21 ::= General2{PrintableString} T22 ::= General2{BIT STRING} + +-- +-- Test a class parameter that is the governor for another parameter. +-- + +AlgorithmIdentifier{ALGORITHM-TYPE, ALGORITHM-TYPE:AlgorithmSet} ::= + SEQUENCE { + algorithm ALGORITHM-TYPE.&id ({AlgorithmSet}), + type ALGORITHM-TYPE.&Type ({AlgorithmSet}{@algorithm}) + } + +AnAlgorithm ::= AlgorithmIdentifier{ SIGNATURE-ALGORITHM, + { {KEY 1 CONTAINING INTEGER} | + {KEY 2 CONTAINING BOOLEAN} } } + +SIGNATURE-ALGORITHM ::= CLASS { + &id INTEGER UNIQUE, + &Type +} WITH SYNTAX { + KEY &id CONTAINING &Type +} + END diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl index 06e9b2c093..da07cd1118 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.erl @@ -112,6 +112,7 @@ roundtrip(Mod, Type, Value) -> roundtrip(Mod, Type, Value, ExpectedValue) -> {ok,Encoded} = Mod:encode(Type, Value), {ok,ExpectedValue} = Mod:decode(Type, Encoded), + test_ber_indefinite(Mod, Type, Encoded, ExpectedValue), ok. roundtrip_enc(Mod, Type, Value) -> @@ -120,6 +121,7 @@ roundtrip_enc(Mod, Type, Value) -> roundtrip_enc(Mod, Type, Value, ExpectedValue) -> {ok,Encoded} = Mod:encode(Type, Value), {ok,ExpectedValue} = Mod:decode(Type, Encoded), + test_ber_indefinite(Mod, Type, Encoded, ExpectedValue), Encoded. %%% @@ -129,3 +131,52 @@ roundtrip_enc(Mod, Type, Value, ExpectedValue) -> 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. + +test_ber_indefinite(Mod, Type, Encoded, ExpectedValue) -> + case Mod:encoding_rule() of + ber -> + Indefinite = iolist_to_binary(ber_indefinite(Encoded)), + {ok,ExpectedValue} = Mod:decode(Type, Indefinite); + _ -> + ok + end. + +%% Rewrite all definite lengths for constructed values to an +%% indefinite length. +ber_indefinite(Bin0) -> + case ber_get_tag(Bin0) of + done -> + []; + primitive -> + Bin0; + {constructed,Tag,Bin1} -> + {Len,Bin2} = ber_get_len(Bin1), + <<Val0:Len/binary,Bin/binary>> = Bin2, + Val = iolist_to_binary(ber_indefinite(Val0)), + [<<Tag/binary,16#80,Val/binary,0,0>>|ber_indefinite(Bin)] + end. + +ber_get_tag(<<>>) -> + done; +ber_get_tag(<<_:2,0:1,_:5,_/binary>>) -> + primitive; +ber_get_tag(<<_:2,1:1,_:5,_/binary>>=Bin0) -> + TagLen = ber_tag_length(Bin0), + <<Tag:TagLen/binary,Bin/binary>> = Bin0, + {constructed,Tag,Bin}. + +ber_tag_length(<<_:3,2#11111:5,T/binary>>) -> + ber_tag_length_1(T, 1); +ber_tag_length(_) -> + 1. + +ber_tag_length_1(<<1:1,_:7,T/binary>>, N) -> + ber_tag_length_1(T, N+1); +ber_tag_length_1(<<0:1,_:7,_/binary>>, N) -> + N+1. + +ber_get_len(<<0:1,L:7,T/binary>>) -> + {L,T}; +ber_get_len(<<1:1,Octets:7,T0/binary>>) -> + <<L:Octets/unit:8,T/binary>> = T0, + {L,T}. diff --git a/lib/asn1/test/ber_decode_error.erl b/lib/asn1/test/ber_decode_error.erl index 8be92292ee..ef11717c45 100644 --- a/lib/asn1/test/ber_decode_error.erl +++ b/lib/asn1/test/ber_decode_error.erl @@ -51,4 +51,22 @@ run([]) -> {error,{asn1,{invalid_value,_}}} = (catch 'Constructed':decode('I', <<8,7>>)), + %% Short indefinite length. Make sure that the decoder doesn't look + %% beyond the end of binary when looking for a 0,0 terminator. + {error,{asn1,{invalid_length,_}}} = + (catch 'Constructed':decode('S', sub(<<8,16#80,0,0>>, 3))), + {error,{asn1,{invalid_length,_}}} = + (catch 'Constructed':decode('S', sub(<<8,16#80,0,0>>, 2))), + {error,{asn1,{invalid_length,_}}} = + (catch 'Constructed':decode('S', sub(<<40,16#80,1,1,255,0,0>>, 6))), + {error,{asn1,{invalid_length,_}}} = + (catch 'Constructed':decode('S', sub(<<40,16#80,1,1,255,0,0>>, 5))), + + %% A primitive must not be encoded with an indefinite length. + {error,{asn1,{invalid_length,_}}} = + (catch 'Constructed':decode('OS', <<4,128,4,3,97,98,99,0,0>>)), ok. + +sub(Bin, Bytes) -> + <<B:Bytes/binary,_/binary>> = Bin, + B. diff --git a/lib/asn1/test/error_SUITE.erl b/lib/asn1/test/error_SUITE.erl index 8a0414708d..1edd60f7c8 100644 --- a/lib/asn1/test/error_SUITE.erl +++ b/lib/asn1/test/error_SUITE.erl @@ -20,7 +20,8 @@ -module(error_SUITE). -export([suite/0,all/0,groups/0, already_defined/1,bitstrings/1,enumerated/1, - imports/1,instance_of/1,integers/1,objects/1,values/1]). + imports/1,instance_of/1,integers/1,objects/1, + parameterization/1,values/1]). -include_lib("test_server/include/test_server.hrl"). @@ -38,6 +39,7 @@ groups() -> instance_of, integers, objects, + parameterization, values]}]. parallel() -> @@ -219,6 +221,19 @@ objects(Config) -> } = run(P, Config), ok. +parameterization(Config) -> + M = 'Parameterization', + P = {M, + <<"Parameterization DEFINITIONS AUTOMATIC TAGS ::= BEGIN\n" + " NotUppercase{lowercase} ::= INTEGER (lowercase)\n" + "END\n">>}, + {error, + [{structured_error,{'Parameterization',2},asn1ct_check, + {illegal_typereference,lowercase}} + ] + } = run(P, Config), + ok. + values(Config) -> M = 'Values', P = {M, diff --git a/lib/asn1/test/testInfObj.erl b/lib/asn1/test/testInfObj.erl index 311595cfda..37c134b1b9 100644 --- a/lib/asn1/test/testInfObj.erl +++ b/lib/asn1/test/testInfObj.erl @@ -118,7 +118,41 @@ main(_Erule) -> roundtrip('InfObj', 'Multiple-Optionals', {'Multiple-Optionals',1,42,true,asn1_NOVALUE}), roundtrip('InfObj', 'Multiple-Optionals', - {'Multiple-Optionals',1,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}). + {'Multiple-Optionals',1,asn1_NOVALUE,asn1_NOVALUE,asn1_NOVALUE}), + + test_objset('OstSeq12', [1,2]), + test_objset('OstSeq123', [1,2,3]), + test_objset('OstSeq1234', [1,2,3,4]), + test_objset('OstSeq45', [4,5]), + test_objset('OstSeq12345', [1,2,3,4,5]), + + test_objset('ExOstSeq12', [1,2]), + test_objset('ExOstSeq123', [1,2,3]), + %%test_objset('ExOstSeq1234', [1,2,3,4]), + test_objset('ExOstSeq45', [4,5]), + test_objset('ExOstSeq12345', [1,2,3,4,5]), + + ok. + +test_objset(Type, Keys) -> + _ = [test_object(Type, Key) || Key <- Keys], + _ = [(catch test_object(Type, Key)) || + Key <- lists:seq(1, 5) -- Keys], + ok. + +test_object(T, 1) -> + roundtrip('InfObj', T, {T,1,<<42:7>>}); +test_object(T, 2) -> + roundtrip('InfObj', T, {T,2,<<"abc">>}); +test_object(T, 3) -> + roundtrip('InfObj', T, {T,3,donald}), + roundtrip('InfObj', T, {T,3,scrooge}); +test_object(T, 4) -> + roundtrip('InfObj', T, {T,4,true}), + roundtrip('InfObj', T, {T,4,false}); +test_object(T, 5) -> + roundtrip('InfObj', T, {T,5,0}), + roundtrip('InfObj', T, {T,5,15}). roundtrip(M, T, V) -> asn1_test_lib:roundtrip(M, T, V). diff --git a/lib/asn1/test/testParamBasic.erl b/lib/asn1/test/testParamBasic.erl index 3db89ca174..39f7947e8d 100644 --- a/lib/asn1/test/testParamBasic.erl +++ b/lib/asn1/test/testParamBasic.erl @@ -43,6 +43,9 @@ main(Rules) -> #'T12'{number=11,string = <<10:4>>}); _ -> ok end, + roundtrip('AnAlgorithm', {'AnAlgorithm',1,42}), + roundtrip('AnAlgorithm', {'AnAlgorithm',2,true}), + roundtrip('AnAlgorithm', {'AnAlgorithm',2,false}), ok. roundtrip(Type, Value) -> diff --git a/lib/asn1/vsn.mk b/lib/asn1/vsn.mk index 37c843204a..d87c50637d 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 = 3.0.1 +ASN1_VSN = 3.0.2 diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile index 99161ce68a..57233a7f6c 100644 --- a/lib/common_test/doc/src/Makefile +++ b/lib/common_test/doc/src/Makefile @@ -47,6 +47,7 @@ CT_MODULES = \ ct_snmp \ unix_telnet \ ct_slave \ + ct_property_test \ ct_netconfc CT_XML_FILES = $(CT_MODULES:=.xml) diff --git a/lib/common_test/doc/src/ct_master_chapter.xml b/lib/common_test/doc/src/ct_master_chapter.xml index 37a0805055..adfe79e41a 100644 --- a/lib/common_test/doc/src/ct_master_chapter.xml +++ b/lib/common_test/doc/src/ct_master_chapter.xml @@ -198,7 +198,7 @@ <section> <title>Automatic startup of test target nodes</title> <marker id="ct_slave"></marker> - <p>Is is possible to automatically start, and perform initial actions, on + <p>It is possible to automatically start, and perform initial actions, on test target nodes by using the test specification term <c>init</c>.</p> <p>Currently, two sub-terms are supported, <c>node_start</c> and <c>eval</c>.</p> <p>Example:</p> diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index b53ba32e6c..f4ce5369f7 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -32,6 +32,54 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.8.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Ticket OTP-11971 introduced a runtime dependency towards + test_server-3.7.1, since the interface between + test_server and common_test was changed. Erroneously, the + common_test.app file was not updated according to this. + This has now been corrected.</p> + <p> + Own Id: OTP-12037</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Warning: this is experimental and may disappear or change + without previous warning.</p> + <p> + Experimental support for running Quickcheck and PropEr + tests from common_test suites is added to common_test. + See the reference manual for the new module + <c>ct_property_testing</c>.</p> + <p> + Experimental property tests are added under + <c>lib/{inet,ssh}/test/property_test</c>. They can be run + directly or from the commont_test suites + <c>inet/ftp_property_test_SUITE.erl</c> and + <c>ssh/test/ssh_property_test_SUITE.erl</c>.</p> + <p> + See the code in the <c>test</c> directories and the man + page for details.</p> + <p> + (Thanks to Tuncer Ayaz for a patch adding Triq)</p> + <p> + Own Id: OTP-12119</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.8.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/doc/src/ref_man.xml b/lib/common_test/doc/src/ref_man.xml index 2f5c892e60..c266b70d00 100644 --- a/lib/common_test/doc/src/ref_man.xml +++ b/lib/common_test/doc/src/ref_man.xml @@ -78,6 +78,7 @@ <xi:include href="unix_telnet.xml"/> <xi:include href="ct_slave.xml"/> <xi:include href="ct_hooks.xml"/> + <xi:include href="ct_property_test.xml"/> </application> diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 4600c0ad78..2723b066f0 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2013. All Rights Reserved. +# Copyright Ericsson AB 2003-2014. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -74,7 +74,9 @@ MODULES= \ ct_netconfc \ ct_conn_log_h \ cth_conn_log \ - ct_groups + ct_groups \ + ct_property_test \ + ct_release_test TARGET_MODULES= $(MODULES:%=$(EBIN)/%) BEAM_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index e28751fb59..580d5dbd7b 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -1,7 +1,7 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2014. All Rights Reserved. %% %% The 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,7 +64,7 @@ {applications, [kernel,stdlib]}, {env, []}, {runtime_dependencies,["xmerl-1.3.7","webtool-0.8.10","tools-2.6.14", - "test_server-3.7","stdlib-2.0","ssh-3.0.1", + "test_server-3.7.1","stdlib-2.0","ssh-3.0.1", "snmp-4.25.1","sasl-2.4","runtime_tools-1.8.14", "kernel-3.0","inets-5.10","erts-6.0", "debugger-4.0","crypto-3.3","compiler-5.0"]}]}. diff --git a/lib/common_test/src/ct_cover.erl b/lib/common_test/src/ct_cover.erl index cf2860ae25..c7f446dee9 100644 --- a/lib/common_test/src/ct_cover.erl +++ b/lib/common_test/src/ct_cover.erl @@ -128,20 +128,20 @@ get_spec(File) -> catch get_spec_test(File). get_spec_test(File) -> - FullName = filename:absname(File), - case filelib:is_file(FullName) of + Dir = filename:dirname(File), % always abs path in here, set in ct_run + case filelib:is_file(File) of true -> - case file:consult(FullName) of + case file:consult(File) of {ok,Terms} -> Import = case lists:keysearch(import, 1, Terms) of {value,{_,Imps=[S|_]}} when is_list(S) -> ImpsFN = lists:map(fun(F) -> - filename:absname(F) + filename:absname(F,Dir) end, Imps), test_files(ImpsFN, ImpsFN); {value,{_,Imp=[IC|_]}} when is_integer(IC) -> - ImpFN = filename:absname(Imp), + ImpFN = filename:absname(Imp,Dir), test_files([ImpFN], [ImpFN]); _ -> [] @@ -149,9 +149,9 @@ get_spec_test(File) -> Export = case lists:keysearch(export, 1, Terms) of {value,{_,Exp=[EC|_]}} when is_integer(EC) -> - filename:absname(Exp); + filename:absname(Exp,Dir); {value,{_,[Exp]}} -> - filename:absname(Exp); + filename:absname(Exp,Dir); _ -> undefined end, @@ -179,7 +179,7 @@ get_spec_test(File) -> E; [CoverSpec] -> CoverSpec1 = remove_excludes_and_dups(CoverSpec), - {FullName,Nodes,Import,Export,CoverSpec1}; + {File,Nodes,Import,Export,CoverSpec1}; _ -> {error,multiple_apps_in_cover_spec} end; @@ -190,7 +190,7 @@ get_spec_test(File) -> {error,{invalid_cover_spec,Error}} end; false -> - {error,{cant_read_cover_spec_file,FullName}} + {error,{cant_read_cover_spec_file,File}} end. collect_apps([{level,Level}|Ts], Apps) -> diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 43eabb18d5..7037cdca73 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -129,7 +129,13 @@ datestr_from_dirname([]) -> close(Info, StartDir) -> %% close executes on the ct_util process, not on the logger process %% so we need to use a local copy of the log cache data - LogCacheBin = make_last_run_index(), + LogCacheBin = + case make_last_run_index() of + {error,_} -> % log server not responding + undefined; + LCB -> + LCB + end, put(ct_log_cache,LogCacheBin), Cache2File = fun() -> case get(ct_log_cache) of @@ -710,6 +716,7 @@ logger_loop(State) -> end end, if Importance >= (100-VLvl) -> + CtLogFd = State#logger_state.ct_log_fd, case get_groupleader(Pid, GL, State) of {tc_log,TCGL,TCGLs} -> case erlang:is_process_alive(TCGL) of @@ -723,14 +730,15 @@ logger_loop(State) -> %% Group leader is dead, so write to the %% CtLog or unexpected_io log instead unexpected_io(Pid,Category,Importance, - List,State), + List,CtLogFd), + logger_loop(State) end; {ct_log,_Fd,TCGLs} -> %% If category is ct_internal then write %% to ct_log, else write to unexpected_io %% log - unexpected_io(Pid,Category,Importance,List,State), + unexpected_io(Pid,Category,Importance,List,CtLogFd), logger_loop(State#logger_state{ tc_groupleaders = TCGLs}) end; @@ -803,16 +811,15 @@ logger_loop(State) -> ok end. -create_io_fun(FromPid, State) -> +create_io_fun(FromPid, CtLogFd) -> %% we have to build one io-list of all strings %% before printing, or other io printouts (made in %% parallel) may get printed between this header %% and footer - Fd = State#logger_state.ct_log_fd, fun({Str,Args}, IoList) -> case catch io_lib:format(Str,Args) of {'EXIT',_Reason} -> - io:format(Fd, "Logging fails! Str: ~p, Args: ~p~n", + io:format(CtLogFd, "Logging fails! Str: ~p, Args: ~p~n", [Str,Args]), %% stop the testcase, we need to see the fault exit(FromPid, {log_printout_error,Str,Args}), @@ -827,28 +834,53 @@ create_io_fun(FromPid, State) -> print_to_log(sync, FromPid, Category, TCGL, List, State) -> %% in some situations (exceptions), the printout is made from the %% test server IO process and there's no valid group leader to send to + CtLogFd = State#logger_state.ct_log_fd, if FromPid /= TCGL -> - IoFun = create_io_fun(FromPid, State), + IoFun = create_io_fun(FromPid, CtLogFd), io:format(TCGL,"~ts", [lists:foldl(IoFun, [], List)]); true -> - unexpected_io(FromPid,Category,?MAX_IMPORTANCE,List,State) + unexpected_io(FromPid,Category,?MAX_IMPORTANCE,List,CtLogFd) end, State; print_to_log(async, FromPid, Category, TCGL, List, State) -> %% in some situations (exceptions), the printout is made from the %% test server IO process and there's no valid group leader to send to + CtLogFd = State#logger_state.ct_log_fd, Printer = if FromPid /= TCGL -> - IoFun = create_io_fun(FromPid, State), + IoFun = create_io_fun(FromPid, CtLogFd), fun() -> test_server:permit_io(TCGL, self()), - io:format(TCGL, "~ts", [lists:foldl(IoFun, [], List)]) + + %% Since asynchronous io gets can get buffered if + %% the file system is slow, there is also a risk that + %% the group leader has terminated before we get to + %% the io:format(GL, ...) call. We check this and + %% print "expired" messages to the unexpected io + %% log instead (best we can do). + + case erlang:is_process_alive(TCGL) of + true -> + try io:format(TCGL, "~ts", + [lists:foldl(IoFun,[],List)]) of + _ -> ok + catch + _:terminated -> + unexpected_io(FromPid, Category, + ?MAX_IMPORTANCE, + List, CtLogFd) + end; + false -> + unexpected_io(FromPid, Category, + ?MAX_IMPORTANCE, + List, CtLogFd) + end end; true -> fun() -> - unexpected_io(FromPid,Category,?MAX_IMPORTANCE, - List,State) + unexpected_io(FromPid, Category, ?MAX_IMPORTANCE, + List, CtLogFd) end end, case State#logger_state.async_print_jobs of @@ -3149,12 +3181,11 @@ html_encoding(latin1) -> html_encoding(utf8) -> "utf-8". -unexpected_io(Pid,ct_internal,_Importance,List,State) -> - IoFun = create_io_fun(Pid,State), - io:format(State#logger_state.ct_log_fd, "~ts", - [lists:foldl(IoFun, [], List)]); -unexpected_io(Pid,_Category,_Importance,List,State) -> - IoFun = create_io_fun(Pid,State), +unexpected_io(Pid,ct_internal,_Importance,List,CtLogFd) -> + IoFun = create_io_fun(Pid,CtLogFd), + io:format(CtLogFd, "~ts", [lists:foldl(IoFun, [], List)]); +unexpected_io(Pid,_Category,_Importance,List,CtLogFd) -> + IoFun = create_io_fun(Pid,CtLogFd), Data = io_lib:format("~ts", [lists:foldl(IoFun, [], List)]), test_server_io:print_unexpected(Data), ok. diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl index a3861dc745..2f66c7613c 100644 --- a/lib/common_test/src/ct_netconfc.erl +++ b/lib/common_test/src/ct_netconfc.erl @@ -190,6 +190,7 @@ get_config/4, edit_config/3, edit_config/4, + edit_config/5, delete_config/2, delete_config/3, copy_config/3, @@ -678,15 +679,39 @@ get_config(Client, Source, Filter, Timeout) -> %%---------------------------------------------------------------------- %% @spec edit_config(Client, Target, Config) -> Result -%% @equiv edit_config(Client, Target, Config, infinity) +%% @equiv edit_config(Client, Target, Config, [], infinity) edit_config(Client, Target, Config) -> edit_config(Client, Target, Config, ?DEFAULT_TIMEOUT). %%---------------------------------------------------------------------- --spec edit_config(Client, Target, Config, Timeout) -> Result when +-spec edit_config(Client, Target, Config, OptParamsOrTimeout) -> Result when Client :: client(), Target :: netconf_db(), Config :: simple_xml(), + OptParamsOrTimeout :: [simple_xml()] | timeout(), + Result :: ok | {error,error_reason()}. +%% @doc +%% +%% If `OptParamsOrTimeout' is a timeout value, then this is +%% equivalent to {@link edit_config/5. edit_config(Client, Target, +%% Config, [], Timeout)}. +%% +%% If `OptParamsOrTimeout' is a list of simple XML, then this is +%% equivalent to {@link edit_config/5. edit_config(Client, Target, +%% Config, OptParams, infinity)}. +%% +%% @end +edit_config(Client, Target, Config, Timeout) when ?is_timeout(Timeout) -> + edit_config(Client, Target, Config, [], Timeout); +edit_config(Client, Target, Config, OptParams) when is_list(OptParams) -> + edit_config(Client, Target, Config, OptParams, ?DEFAULT_TIMEOUT). + +%%---------------------------------------------------------------------- +-spec edit_config(Client, Target, Config, OptParams, Timeout) -> Result when + Client :: client(), + Target :: netconf_db(), + Config :: simple_xml(), + OptParams :: [simple_xml()], Timeout :: timeout(), Result :: ok | {error,error_reason()}. %% @doc Edit configuration data. @@ -695,10 +720,20 @@ edit_config(Client, Target, Config) -> %% include `:candidate' or `:startup' in its list of %% capabilities. %% +%% `OptParams' can be used for specifying optional parameters +%% (`default-operation', `test-option' or `error-option') that will be +%% added to the `edit-config' request. The value must be a list +%% containing valid simple XML, for example +%% +%% ``` +%% [{'default-operation', ["none"]}, +%% {'error-option', ["rollback-on-error"]}] +%%''' +%% %% @end %%---------------------------------------------------------------------- -edit_config(Client, Target, Config, Timeout) -> - call(Client, {send_rpc_op, edit_config, [Target,Config], Timeout}). +edit_config(Client, Target, Config, OptParams, Timeout) -> + call(Client, {send_rpc_op, edit_config, [Target,Config,OptParams], Timeout}). %%---------------------------------------------------------------------- @@ -1086,6 +1121,7 @@ handle_msg({get_event_streams=Op,Streams,Timeout}, From, State) -> SimpleXml = encode_rpc_operation(get,[Filter]), do_send_rpc(Op, SimpleXml, Timeout, From, State). +%% @private handle_msg({ssh_cm, CM, {data, Ch, _Type, Data}}, State) -> ssh_connection:adjust_window(CM,Ch,size(Data)), handle_data(Data, State); @@ -1234,8 +1270,8 @@ encode_rpc_operation(get,[Filter]) -> {get,filter(Filter)}; encode_rpc_operation(get_config,[Source,Filter]) -> {'get-config',[{source,[Source]}] ++ filter(Filter)}; -encode_rpc_operation(edit_config,[Target,Config]) -> - {'edit-config',[{target,[Target]},{config,[Config]}]}; +encode_rpc_operation(edit_config,[Target,Config,OptParams]) -> + {'edit-config',[{target,[Target]}] ++ OptParams ++ [{config,[Config]}]}; encode_rpc_operation(delete_config,[Target]) -> {'delete-config',[{target,[Target]}]}; encode_rpc_operation(copy_config,[Target,Source]) -> @@ -1707,6 +1743,7 @@ log(#connection{host=Host,port=Port,name=Name},Action,Data) -> %% Log callback - called from the error handler process +%% @private format_data(How,Data) -> %% Assuming that the data is encoded as UTF-8. If it is not, then %% the printout might be wrong, but the format function will not diff --git a/lib/common_test/src/ct_property_test.erl b/lib/common_test/src/ct_property_test.erl new file mode 100644 index 0000000000..52acda5388 --- /dev/null +++ b/lib/common_test/src/ct_property_test.erl @@ -0,0 +1,186 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-2014. All Rights Reserved. +%% +%% The 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% +%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +%%% @doc EXPERIMENTAL support in common-test for calling property based tests. +%%% +%%% <p>This module is a first step towards running Property Based testing in the +%%% Common Test framework. A property testing tool like QuickCheck or PropEr is +%%% assumed to be installed.</p> +%%% +%%% <p>The idea is to have a common_test testsuite calling a property testing +%%% tool with special property test suites as defined by that tool. In this manual +%%% we assume the usual Erlang Application directory structure. The tests are +%%% collected in the application's <c>test</c> directory. The test directory +%%% has a sub-directory called <c>property_test</c> where everything needed for +%%% the property tests are collected.</p> +%%% +%%% <p>A typical ct test suite using <c>ct_property_test</c> is organized as follows: +%%% </p> +%%% ``` +%%% -include_lib("common_test/include/ct.hrl"). +%%% +%%% all() -> [prop_ftp_case]. +%%% +%%% init_per_suite(Config) -> +%%% ct_property_test:init_per_suite(Config). +%%% +%%% %%%---- test case +%%% prop_ftp_case(Config) -> +%%% ct_property_test:quickcheck( +%%% ftp_simple_client_server:prop_ftp(Config), +%%% Config +%%% ). +%%% ''' +%%% +%%% <warning> +%%% <p> +%%% This is experimental code which may be changed or removed +%%% anytime without any warning. +%%% </p> +%%% </warning> +%%% +%%% @end + +-module(ct_property_test). + +%% API +-export([init_per_suite/1, + quickcheck/2]). + +-include_lib("common_test/include/ct.hrl"). + +%%%----------------------------------------------------------------- +%%% @spec init_per_suite(Config) -> Config | {skip,Reason} +%%% +%%% @doc Initializes Config for property testing. +%%% +%%% <p>The function investigates if support is available for either Quickcheck, PropEr, +%%% or Triq. +%%% The options <c>{property_dir,AbsPath}</c> and +%%% <c>{property_test_tool,Tool}</c> is set in the Config returned.</p> +%%% <p>The function is intended to be called in the init_per_suite in the test suite.</p> +%%% <p>The property tests are assumed to be in the subdirectory <c>property_test</c>.</p> +%%% @end + +init_per_suite(Config) -> + case which_module_exists([eqc,proper,triq]) of + {ok,ToolModule} -> + ct:pal("Found property tester ~p",[ToolModule]), + Path = property_tests_path("property_test", Config), + case compile_tests(Path,ToolModule) of + error -> + {fail, "Property test compilation failed in "++Path}; + up_to_date -> + add_code_pathz(Path), + [{property_dir,Path}, + {property_test_tool,ToolModule} | Config] + end; + + not_found -> + ct:pal("No property tester found",[]), + {skip, "No property testing tool found"} + end. + +%%%----------------------------------------------------------------- +%%% @spec quickcheck(Property, Config) -> true | {fail,Reason} +%%% +%%% @doc Call quickcheck and return the result in a form suitable for common_test. +%%% +%%% <p>The function is intended to be called in the test cases in the test suite.</p> +%%% @end + +quickcheck(Property, Config) -> + Tool = proplists:get_value(property_test_tool,Config), + F = function_name(quickcheck, Tool), + mk_ct_return( Tool:F(Property), Tool ). + + +%%%================================================================ +%%% +%%% Local functions +%%% + +%%% Make return values back to the calling Common Test suite +mk_ct_return(true, _Tool) -> + true; +mk_ct_return(Other, Tool) -> + try lists:last(hd(Tool:counterexample())) + of + {set,{var,_},{call,M,F,Args}} -> + {fail, io_lib:format("~p:~p/~p returned bad result",[M,F,length(Args)])} + catch + _:_ -> + {fail, Other} + end. + +%%% Check if a property testing tool is found +which_module_exists([Module|Modules]) -> + case module_exists(Module) of + true -> {ok,Module}; + false -> which_module_exists(Modules) + end; +which_module_exists(_) -> + not_found. + +module_exists(Module) -> + is_list(catch Module:module_info()). + +%%% The path to the property tests +property_tests_path(Dir, Config) -> + DataDir = proplists:get_value(data_dir, Config), + filename:join(lists:droplast(filename:split(DataDir))++[Dir]). + +%%% Extend the code path with Dir if it not already present +add_code_pathz(Dir) -> + case lists:member(Dir, code:get_path()) of + true -> ok; + false -> code:add_pathz(Dir) + end. + +compile_tests(Path, ToolModule) -> + MacroDefs = macro_def(ToolModule), + {ok,Cwd} = file:get_cwd(), + ok = file:set_cwd(Path), + {ok,FileNames} = file:list_dir("."), + BeamFiles = [F || F<-FileNames, + filename:extension(F) == ".beam"], + [file:delete(F) || F<-BeamFiles], + ct:pal("Compiling in ~p:~n Deleted ~p~n MacroDefs=~p",[Path,BeamFiles,MacroDefs]), + Result = make:all([load|MacroDefs]), + file:set_cwd(Cwd), + Result. + + +macro_def(eqc) -> [{d, 'EQC'}]; +macro_def(proper) -> [{d, 'PROPER'}]; +macro_def(triq) -> [{d, 'TRIQ'}]. + +function_name(quickcheck, triq) -> check; +function_name(F, _) -> F. + diff --git a/lib/common_test/src/ct_release_test.erl b/lib/common_test/src/ct_release_test.erl new file mode 100644 index 0000000000..eb9e9c832f --- /dev/null +++ b/lib/common_test/src/ct_release_test.erl @@ -0,0 +1,847 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The 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% +%% +%%----------------------------------------------------------------- +%% @doc EXPERIMENTAL support for testing of upgrade. +%% +%% This is a library module containing support for test of release +%% related activities in one or more applications. Currenty it +%% supports upgrade only. +%% +%% == Configuration == +%% +%% In order to find version numbers of applications to upgrade from, +%% `{@module}' needs to access and start old OTP +%% releases. A `common_test' configuration file can be used for +%% specifying the location of such releases, for example: +%% +%% ``` +%% %% old-rels.cfg +%% {otp_releases,[{r16b,"/path/to/R16B03-1/bin/erl"}, +%% {'17',"/path/to/17.3/bin/erl"}]}.''' +%% +%% The configuration file should preferably point out the latest patch +%% level on each major release. +%% +%% If no such configuration file is given, {@link init/1} will return +%% `{skip,Reason}' and any attempt at running {@link upgrade/4} +%% will fail. +%% +%% == Callback functions == +%% +%% The following functions should be exported from a {@module} +%% callback module. +%% +%% All callback functions are called on the node where the upgrade is +%% executed. +%% +%% <dl> +%% <dt>Module:upgrade_init(State) -> NewState</dt> +%% <dd>Types: +%% +%% <b><c>State = NewState = cb_state()</c></b> +%% +%% Initialyze system before upgrade test starts. +%% +%% This function is called before the upgrade is started. All +%% applications given in {@link upgrade/4} are already started by +%% the boot script, so this callback is intended for additional +%% initialization, if necessary. +%% +%% Example: +%% +%% ``` +%% upgrade_init(State) -> +%% open_connection(State).''' +%% </dd> +%% +%% <dt>Module:upgrade_upgraded(State) -> NewState</dt> +%% <dd>Types: +%% +%% <b><c>State = NewState = cb_state()</c></b> +%% +%% Check that upgrade was successful. +%% +%% This function is called after the release_handler has +%% successfully unpacked and installed the new release, and it has +%% been made permanent. It allows application specific checks to +%% ensure that the upgrade was successful. +%% +%% Example: +%% +%% ``` +%% upgrade_upgraded(State) -> +%% check_connection_still_open(State).''' +%% </dd> +%% +%% <dt>Module:upgrade_downgraded(State) -> NewState</dt> +%% <dd>Types: +%% +%% <b><c>State = NewState = cb_state()</c></b> +%% +%% Check that downgrade was successful. +%% +%% This function is called after the release_handler has +%% successfully re-installed the original release, and it has been +%% made permanent. It allows application specific checks to ensure +%% that the downgrade was successful. +%% +%% Example: +%% +%% ``` +%% upgrade_init(State) -> +%% check_connection_closed(State).''' +%% </dd> +%% </dl> +%% @end +%%----------------------------------------------------------------- +-module(ct_release_test). + +-export([init/1, upgrade/4, cleanup/1]). + +-include_lib("kernel/include/file.hrl"). + +%%----------------------------------------------------------------- +-define(testnode, otp_upgrade). +-define(exclude_apps, [hipe, typer, dialyzer]). % never include these apps + +%%----------------------------------------------------------------- +-type config() :: [{atom(),term()}]. +-type cb_state() :: term(). + +-callback upgrade_init(cb_state()) -> cb_state(). +-callback upgrade_upgraded(cb_state()) -> cb_state(). +-callback upgrade_downgraded(cb_state()) -> cb_state(). + +%%----------------------------------------------------------------- +-spec init(Config) -> Result when + Config :: config(), + Result :: config() | SkipOrFail, + SkipOrFail :: {skip,Reason} | {fail,Reason}. +%% @doc Initialize `{@module}'. +%% +%% This function can be called from any of the +%% `init_per_*' functions in the test suite. It updates +%% the given `Config' with data that will be +%% used by future calls to other functions in this module. The +%% returned configuration must therefore also be returned from +%% the calling `init_per_*'. +%% +%% If the initialization fails, e.g. if a required release can +%% not be found, the function returns `{skip,Reason}'. In +%% this case the other test support functions in this mudule +%% can not be used. +%% +%% Example: +%% +%% ``` +%% init_per_suite(Config) -> +%% ct_release_test:init(Config).''' +%% +init(Config) -> + try init_upgrade_test() of + {Major,Minor} -> + [{release_test,[{major,Major},{minor,Minor}]} | Config] + catch throw:Thrown -> + Thrown + end. + +%%----------------------------------------------------------------- +-spec upgrade(App,Level,Callback,Config) -> any() when + App :: atom(), + Level :: minor | major, + Callback :: {module(),InitState}, + InitState :: cb_state(), + Config :: config(); + (Apps,Level,Callback,Config) -> any() when + Apps :: [App], + App :: atom(), + Level :: minor | major, + Callback :: {module(),InitState}, + InitState :: cb_state(), + Config :: config(). +%% @doc Test upgrade of the given application(s). +%% +%% This function can be called from a test case. It requires that +%% `Config' has been initialized by calling {@link +%% init/1} prior to this, for example from `init_per_suite/1'. +%% +%% Upgrade tests are performed as follows: +%% +%% <ol> +%% <li>Figure out which OTP release to test upgrade +%% from. Start a node running that release and find the +%% application versions on that node. Terminate the +%% node.</li> +%% <li>Figure out all dependencies for the applications under +%% test.</li> +%% <li>Create a release containing the core +%% applications `kernel', `stdlib' and `sasl' +%% in addition to the application(s) under test and all +%% dependencies of these. The versions of the applications +%% under test will be the ones found on the OTP release to +%% upgrade from. The versions of all other applications will +%% be those found on the current node, i.e. the common_test +%% node. This is the "From"-release.</li> +%% <li>Create another release containing the same +%% applications as in the previous step, but with all +%% application versions taken from the current node. This is +%% the "To"-release.</li> +%% <li>Install the "From"-release and start a new node +%% running this release.</li> +%% <li>Perform the upgrade test and allow customized +%% control by using callbacks: +%% <ol> +%% <li>Callback: `upgrade_init/1'</li> +%% <li>Unpack the new release</li> +%% <li>Install the new release</li> +%% <li>Callback: `upgrade_upgraded/1'</li> +%% <li>Install the original release</li> +%% <li>Callback: `upgrade_downgraded/1'</li> +%% </ol> +%% </li> +%% </ol> +%% +%% `App' or `Apps' +%% specifies the applications under test, i.e. the applications +%% which shall be upgraded. All other applications that are +%% included have the same releases in the "From"- and +%% "To"-releases and will therefore not be upgraded. +%% +%% `Level' specifies which OTP release to +%% pick the "From" versions from. +%% <dl> +%% <dt>major</dt> +%% <dd>From verions are picked from the previous major +%% release. For example, if the test is run on an OTP-17 +%% node, `{@module}' will pick the application +%% "From" versions from an OTP installation running OTP +%% R16B.</dd> +%% +%% <dt>minor</dt> +%% <dd>From verions are picked from the current major +%% release. For example, if the test is run on an OTP-17 +%% node, `{@module}' will pick the application +%% "From" versions from an OTP installation running an +%% earlier patch level of OTP-17.</dd> +%% </dl> +%% +%% The application "To" versions are allways picked from the +%% current node, i.e. the common_test node. +%% +%% `Callback' specifies the module (normally the +%% test suite) which implements the {@section Callback functions}, and +%% the initial value of the `State' variable used in these +%% functions. +%% +%% `Config' is the input argument received +%% in the test case function. +%% +%% Example: +%% +%% ``` +%% minor_upgrade(Config) -> +%% ct_release_test:upgrade(ssl,minor,{?MODULE,[]},Config). +%% ''' +%% +upgrade(App,Level,Callback,Config) when is_atom(App) -> + upgrade([App],Level,Callback,Config); +upgrade(Apps,Level,Callback,Config) -> + Dir = proplists:get_value(priv_dir,Config), + CreateDir = filename:join([Dir,Level,create]), + InstallDir = filename:join([Dir,Level,install]), + ok = filelib:ensure_dir(filename:join(CreateDir,"*")), + ok = filelib:ensure_dir(filename:join(InstallDir,"*")), + try upgrade(Apps,Level,Callback,CreateDir,InstallDir,Config) of + ok -> + %%rm_rf(CreateDir), + Tars = filelib:wildcard(filename:join(CreateDir,"*.tar.gz")), + _ = [file:delete(Tar) || Tar <- Tars], + rm_rf(InstallDir), + ok + catch throw:{fail,Reason} -> + ct:fail(Reason); + throw:{skip,Reason} -> + rm_rf(CreateDir), + rm_rf(InstallDir), + {skip,Reason} + after + %% Brutally kill all nodes that erroneously survived the test. + %% Note, we will not reach this if the test fails with a + %% timetrap timeout in the test suite! Thus we can have + %% hanging nodes... + Nodes = nodes(), + [rpc:call(Node,erlang,halt,[]) || Node <- Nodes] + end. + +%%----------------------------------------------------------------- +-spec cleanup(Config) -> Result when + Config :: config(), + Result :: config(). +%% @doc Clean up after tests. +%% +%% This function shall be called from the `end_per_*' function +%% complementing the `init_per_*' function where {@link init/1} +%% is called. +%% +%% It cleans up after the test, for example kills hanging +%% nodes. +%% +%% Example: +%% +%% ``` +%% end_per_suite(Config) -> +%% ct_release_test:cleanup(Config).''' +%% +cleanup(Config) -> + Nodes = [node_name(?testnode)|nodes()], + [rpc:call(Node,erlang,halt,[]) || Node <- Nodes], + Config. + +%%----------------------------------------------------------------- +init_upgrade_test() -> + %% Check that a real release is running, not e.g. cerl + ok = application:ensure_started(sasl), + case release_handler:which_releases() of + [{_,_,[],_}] -> + %% Fake release, no applications + throw({skip, "Need a real release running to create other releases"}); + _ -> + Major = init_upgrade_test(major), + Minor = init_upgrade_test(minor), + {Major,Minor} + end. + +init_upgrade_test(Level) -> + {FromVsn,ToVsn} = get_rels(Level), + OldRel = + case test_server:is_release_available(FromVsn) of + true -> + {release,FromVsn}; + false -> + case ct:get_config({otp_releases,list_to_atom(FromVsn)}) of + undefined -> + false; + Prog0 -> + case os:find_executable(Prog0) of + false -> + false; + Prog -> + {prog,Prog} + end + end + end, + case OldRel of + false -> + ct:log("Release ~p is not available." + " Upgrade on '~p' level can not be tested.", + [FromVsn,Level]), + undefined; + _ -> + init_upgrade_test(FromVsn,ToVsn,OldRel) + end. + +get_rels(major) -> + %% Given that the current major release is X, then this is an + %% upgrade from major release X-1 to the current release. + Current = erlang:system_info(otp_release), + PreviousMajor = previous_major(Current), + {PreviousMajor,Current}; +get_rels(minor) -> + %% Given that this is a (possibly) patched version of major + %% release X, then this is an upgrade from major release X to the + %% current release. + CurrentMajor = erlang:system_info(otp_release), + Current = CurrentMajor++"_patched", + {CurrentMajor,Current}. + +init_upgrade_test(FromVsn,ToVsn,OldRel) -> + OtpRel = list_to_atom("otp-"++FromVsn), + ct:log("Starting node to fetch application versions to upgrade from"), + {ok,Node} = test_server:start_node(OtpRel,peer,[{erl,[OldRel]}]), + {Apps,Path} = fetch_all_apps(Node), + test_server:stop_node(Node), + {FromVsn,ToVsn,Apps,Path}. + +fetch_all_apps(Node) -> + Paths = rpc:call(Node,code,get_path,[]), + %% Find all possible applications in the path + AppFiles = + lists:flatmap( + fun(P) -> + filelib:wildcard(filename:join(P,"*.app")) + end, + Paths), + %% Figure out which version of each application is running on this + %% node. Using application:load and application:get_key instead of + %% reading the .app files since there might be multiple versions + %% of a .app file and we only want the one that is actually + %% running. + AppVsns = + lists:flatmap( + fun(F) -> + A = list_to_atom(filename:basename(filename:rootname(F))), + _ = rpc:call(Node,application,load,[A]), + case rpc:call(Node,application,get_key,[A,vsn]) of + {ok,V} -> [{A,V}]; + _ -> [] + end + end, + AppFiles), + ErtsVsn = rpc:call(Node, erlang, system_info, [version]), + {[{erts,ErtsVsn}|AppVsns], Paths}. + + +%%----------------------------------------------------------------- +upgrade(Apps,Level,Callback,CreateDir,InstallDir,Config) -> + ct:log("Test upgrade of the following applications: ~p",[Apps]), + ct:log(".rel files and start scripts are created in:~n~ts",[CreateDir]), + ct:log("The release is installed in:~n~ts",[InstallDir]), + case proplists:get_value(release_test,Config) of + undefined -> + throw({fail,"ct_release_test:init/1 not run"}); + RTConfig -> + case proplists:get_value(Level,RTConfig) of + undefined -> + throw({skip,"Old release not available"}); + Data -> + {FromVsn,FromRel,FromAppsVsns} = + target_system(Apps, CreateDir, InstallDir, Data), + {ToVsn,ToRel,ToAppsVsns} = + upgrade_system(Apps, FromRel, CreateDir, + InstallDir, Data), + ct:log("Upgrade from: OTP-~ts, ~p",[FromVsn, FromAppsVsns]), + ct:log("Upgrade to: OTP-~ts, ~p",[ToVsn, ToAppsVsns]), + do_upgrade(Callback, FromVsn, FromAppsVsns, ToRel, + ToAppsVsns, InstallDir) + end + end. + +%%% This is similar to sasl/examples/src/target_system.erl, but with +%%% the following adjustments: +%%% - add a log directory +%%% - use an own 'start' script +%%% - chmod 'start' and 'start_erl' +target_system(Apps,CreateDir,InstallDir,{FromVsn,_,AllAppsVsns,Path}) -> + RelName0 = "otp-"++FromVsn, + + AppsVsns = [{A,V} || {A,V} <- AllAppsVsns, lists:member(A,Apps)], + {RelName,ErtsVsn} = create_relfile(AppsVsns,CreateDir,RelName0,FromVsn), + + %% Create .script and .boot + ok = systools(make_script,[RelName,[{path,Path}]]), + + %% Create base tar file - i.e. erts and all apps + ok = systools(make_tar,[RelName,[{erts,code:root_dir()}, + {path,Path}]]), + + %% Unpack the tar to complete the installation + erl_tar:extract(RelName ++ ".tar.gz", [{cwd, InstallDir}, compressed]), + + %% Add bin and log dirs + BinDir = filename:join([InstallDir, "bin"]), + file:make_dir(BinDir), + file:make_dir(filename:join(InstallDir,"log")), + + %% Delete start scripts - they will be added later + ErtsBinDir = filename:join([InstallDir, "erts-" ++ ErtsVsn, "bin"]), + file:delete(filename:join([ErtsBinDir, "erl"])), + file:delete(filename:join([ErtsBinDir, "start"])), + file:delete(filename:join([ErtsBinDir, "start_erl"])), + + %% Copy .boot to bin/start.boot + copy_file(RelName++".boot",filename:join([BinDir, "start.boot"])), + + %% Copy scripts from erts-xxx/bin to bin + copy_file(filename:join([ErtsBinDir, "epmd"]), + filename:join([BinDir, "epmd"]), [preserve]), + copy_file(filename:join([ErtsBinDir, "run_erl"]), + filename:join([BinDir, "run_erl"]), [preserve]), + copy_file(filename:join([ErtsBinDir, "to_erl"]), + filename:join([BinDir, "to_erl"]), [preserve]), + + %% create start_erl.data, sys.config and start.src + StartErlData = filename:join([InstallDir, "releases", "start_erl.data"]), + write_file(StartErlData, io_lib:fwrite("~s ~s~n", [ErtsVsn, FromVsn])), + SysConfig = filename:join([InstallDir, "releases", FromVsn, "sys.config"]), + write_file(SysConfig, "[]."), + StartSrc = filename:join(ErtsBinDir,"start.src"), + write_file(StartSrc,start_script()), + ok = file:change_mode(StartSrc,8#0755), + + %% Make start_erl executable + %% (this has been fixed in OTP 17 - it is now installed with + %% $INSTALL_SCRIPT instead of $INSTALL_DATA and should therefore + %% be executable from the start) + ok = file:change_mode(filename:join(ErtsBinDir,"start_erl.src"),8#0755), + + %% Substitute variables in erl.src, start.src and start_erl.src + %% (.src found in erts-xxx/bin - result stored in bin) + subst_src_scripts(["erl", "start", "start_erl"], ErtsBinDir, BinDir, + [{"FINAL_ROOTDIR", InstallDir}, {"EMU", "beam"}], + [preserve]), + + %% Create RELEASES + RelFile = filename:join([InstallDir, "releases", + filename:basename(RelName) ++ ".rel"]), + release_handler:create_RELEASES(InstallDir, RelFile), + + {FromVsn, RelName,AppsVsns}. + +systools(Func,Args) -> + case apply(systools,Func,Args) of + ok -> + ok; + error -> + throw({fail,{systools,Func,Args}}) + end. + +%%% This is a copy of $ROOT/erts-xxx/bin/start.src, modified to add +%%% sname and heart +start_script() -> + ["#!/bin/sh\n" + "ROOTDIR=%FINAL_ROOTDIR%\n" + "\n" + "if [ -z \"$RELDIR\" ]\n" + "then\n" + " RELDIR=$ROOTDIR/releases\n" + "fi\n" + "\n" + "START_ERL_DATA=${1:-$RELDIR/start_erl.data}\n" + "\n" + "$ROOTDIR/bin/run_erl -daemon /tmp/ $ROOTDIR/log \"exec $ROOTDIR/bin/start_erl $ROOTDIR $RELDIR $START_ERL_DATA -sname ",atom_to_list(?testnode)," -heart\"\n"]. + +%%% Create a release containing the current (the test node) OTP +%%% release, including relup to allow upgrade from an earlier OTP +%%% release. +upgrade_system(Apps, FromRel, CreateDir, InstallDir, {_,ToVsn,_,_}) -> + ct:log("Generating release to upgrade to."), + + RelName0 = "otp-"++ToVsn, + + AppsVsns = get_vsns(Apps), + {RelName,_} = create_relfile(AppsVsns,CreateDir,RelName0,ToVsn), + FromPath = filename:join([InstallDir,lib,"*",ebin]), + + ok = systools(make_script,[RelName]), + ok = systools(make_relup,[RelName,[FromRel],[FromRel], + [{path,[FromPath]}, + {outdir,CreateDir}]]), + SysConfig = filename:join([CreateDir, "sys.config"]), + write_file(SysConfig, "[]."), + + ok = systools(make_tar,[RelName,[{erts,code:root_dir()}]]), + + {ToVsn, RelName,AppsVsns}. + +%%% Start a new node running the release from target_system/6 +%%% above. Then upgrade to the system from upgrade_system/6. +do_upgrade({Cb,InitState},FromVsn,FromAppsVsns,ToRel,ToAppsVsns,InstallDir) -> + ct:log("Upgrade test attempting to start node.~n" + "If test fails, logs can be found in:~n~ts", + [filename:join(InstallDir,log)]), + Start = filename:join([InstallDir,bin,start]), + {ok,Node} = start_node(Start,FromVsn,FromAppsVsns), + + ct:log("Node started: ~p",[Node]), + State1 = do_callback(Node,Cb,upgrade_init,InitState), + + [{"OTP upgrade test",FromVsn,_,permanent}] = + rpc:call(Node,release_handler,which_releases,[]), + ToRelName = filename:basename(ToRel), + copy_file(ToRel++".tar.gz", + filename:join([InstallDir,releases,ToRelName++".tar.gz"])), + ct:log("Unpacking new release"), + {ok,ToVsn} = rpc:call(Node,release_handler,unpack_release,[ToRelName]), + [{"OTP upgrade test",ToVsn,_,unpacked}, + {"OTP upgrade test",FromVsn,_,permanent}] = + rpc:call(Node,release_handler,which_releases,[]), + ct:log("Installing new release"), + case rpc:call(Node,release_handler,install_release,[ToVsn]) of + {ok,FromVsn,_} -> + ok; + {continue_after_restart,FromVsn,_} -> + ct:log("Waiting for node restart") + end, + %% even if install_release returned {ok,...} there might be an + %% emulator restart (instruction restart_emulator), so we must + %% always make sure the node is running. + wait_node_up(current,ToVsn,ToAppsVsns), + + [{"OTP upgrade test",ToVsn,_,current}, + {"OTP upgrade test",FromVsn,_,permanent}] = + rpc:call(Node,release_handler,which_releases,[]), + ct:log("Permanenting new release"), + ok = rpc:call(Node,release_handler,make_permanent,[ToVsn]), + [{"OTP upgrade test",ToVsn,_,permanent}, + {"OTP upgrade test",FromVsn,_,old}] = + rpc:call(Node,release_handler,which_releases,[]), + + State2 = do_callback(Node,Cb,upgrade_upgraded,State1), + + ct:log("Re-installing old release"), + case rpc:call(Node,release_handler,install_release,[FromVsn]) of + {ok,FromVsn,_} -> + ok; + {continue_after_restart,FromVsn,_} -> + ct:log("Waiting for node restart") + end, + %% even if install_release returned {ok,...} there might be an + %% emulator restart (instruction restart_emulator), so we must + %% always make sure the node is running. + wait_node_up(current,FromVsn,FromAppsVsns), + + [{"OTP upgrade test",ToVsn,_,permanent}, + {"OTP upgrade test",FromVsn,_,current}] = + rpc:call(Node,release_handler,which_releases,[]), + ct:log("Permanenting old release"), + ok = rpc:call(Node,release_handler,make_permanent,[FromVsn]), + [{"OTP upgrade test",ToVsn,_,old}, + {"OTP upgrade test",FromVsn,_,permanent}] = + rpc:call(Node,release_handler,which_releases,[]), + + _State3 = do_callback(Node,Cb,upgrade_downgraded,State2), + + ct:log("Terminating node ~p",[Node]), + erlang:monitor_node(Node,true), + _ = rpc:call(Node,init,stop,[]), + receive {nodedown,Node} -> ok end, + ct:log("Node terminated"), + + ok. + +do_callback(Node,Mod,Func,State) -> + Dir = filename:dirname(code:which(Mod)), + _ = rpc:call(Node,code,add_path,[Dir]), + ct:log("Calling ~p:~p/1",[Mod,Func]), + R = rpc:call(Node,Mod,Func,[State]), + ct:log("~p:~p/1 returned: ~p",[Mod,Func,R]), + case R of + {badrpc,Error} -> + test_server:fail({test_upgrade_callback,Mod,Func,State,Error}); + NewState -> + NewState + end. + +%%% Library functions +previous_major("17") -> + "r16b"; +previous_major(Rel) -> + integer_to_list(list_to_integer(Rel)-1). + +create_relfile(AppsVsns,CreateDir,RelName0,RelVsn) -> + UpgradeAppsVsns = [{A,V,restart_type(A)} || {A,V} <- AppsVsns], + + CoreAppVsns0 = get_vsns([kernel,stdlib,sasl]), + CoreAppVsns = + [{A,V,restart_type(A)} || {A,V} <- CoreAppVsns0, + false == lists:keymember(A,1,AppsVsns)], + + Apps = [App || {App,_} <- AppsVsns], + StartDepsVsns = get_start_deps(Apps,CoreAppVsns), + StartApps = [StartApp || {StartApp,_,_} <- StartDepsVsns] ++ Apps, + + {RuntimeDepsVsns,_} = get_runtime_deps(StartApps,StartApps,[],[]), + + AllAppsVsns0 = StartDepsVsns ++ UpgradeAppsVsns ++ RuntimeDepsVsns, + + %% Should test tools really be included? Some library functions + %% here could be used by callback, but not everything since + %% processes of these applications will not be running. + TestToolAppsVsns0 = get_vsns([test_server,common_test]), + TestToolAppsVsns = + [{A,V,none} || {A,V} <- TestToolAppsVsns0, + false == lists:keymember(A,1,AllAppsVsns0)], + + AllAppsVsns1 = AllAppsVsns0 ++ TestToolAppsVsns, + AllAppsVsns = [AV || AV={A,_,_} <- AllAppsVsns1, + false == lists:member(A,?exclude_apps)], + + ErtsVsn = erlang:system_info(version), + + %% Create the .rel file + RelContent = {release,{"OTP upgrade test",RelVsn},{erts,ErtsVsn},AllAppsVsns}, + RelName = filename:join(CreateDir,RelName0), + RelFile = RelName++".rel", + {ok,Fd} = file:open(RelFile,[write,{encoding,utf8}]), + io:format(Fd,"~tp.~n",[RelContent]), + ok = file:close(Fd), + {RelName,ErtsVsn}. + +get_vsns(Apps) -> + [begin + _ = application:load(A), + {ok,V} = application:get_key(A,vsn), + {A,V} + end || A <- Apps]. + +get_start_deps([App|Apps],Acc) -> + _ = application:load(App), + {ok,StartDeps} = application:get_key(App,applications), + StartDepsVsns = + [begin + _ = application:load(StartApp), + {ok,StartVsn} = application:get_key(StartApp,vsn), + {StartApp,StartVsn,restart_type(StartApp)} + end || StartApp <- StartDeps, + false == lists:keymember(StartApp,1,Acc)], + DepsStartDeps = get_start_deps(StartDeps,Acc ++ StartDepsVsns), + get_start_deps(Apps,DepsStartDeps); +get_start_deps([],Acc) -> + Acc. + +get_runtime_deps([App|Apps],StartApps,Acc,Visited) -> + case lists:member(App,Visited) of + true -> + get_runtime_deps(Apps,StartApps,Acc,Visited); + false -> + %% runtime_dependencies should be possible to read with + %% application:get_key/2, but still isn't so we need to + %% read the .app file... + AppFile = code:where_is_file(atom_to_list(App) ++ ".app"), + {ok,[{application,App,Attrs}]} = file:consult(AppFile), + RuntimeDeps = + lists:flatmap( + fun(Str) -> + [RuntimeAppStr,_] = string:tokens(Str,"-"), + RuntimeApp = list_to_atom(RuntimeAppStr), + case {lists:keymember(RuntimeApp,1,Acc), + lists:member(RuntimeApp,StartApps)} of + {false,false} when RuntimeApp=/=erts -> + [RuntimeApp]; + _ -> + [] + end + end, + proplists:get_value(runtime_dependencies,Attrs,[])), + RuntimeDepsVsns = + [begin + _ = application:load(RuntimeApp), + {ok,RuntimeVsn} = application:get_key(RuntimeApp,vsn), + {RuntimeApp,RuntimeVsn,none} + end || RuntimeApp <- RuntimeDeps], + {DepsRuntimeDeps,NewVisited} = + get_runtime_deps(RuntimeDeps,StartApps,Acc++RuntimeDepsVsns,[App|Visited]), + get_runtime_deps(Apps,StartApps,DepsRuntimeDeps,NewVisited) + end; +get_runtime_deps([],_,Acc,Visited) -> + {Acc,Visited}. + +restart_type(App) when App==kernel; App==stdlib; App==sasl -> + permanent; +restart_type(_) -> + temporary. + +copy_file(Src, Dest) -> + copy_file(Src, Dest, []). + +copy_file(Src, Dest, Opts) -> + {ok,_} = file:copy(Src, Dest), + case lists:member(preserve, Opts) of + true -> + {ok, FileInfo} = file:read_file_info(Src), + file:write_file_info(Dest, FileInfo); + false -> + ok + end. + +write_file(FName, Conts) -> + Enc = file:native_name_encoding(), + {ok, Fd} = file:open(FName, [write]), + file:write(Fd, unicode:characters_to_binary(Conts,Enc,Enc)), + file:close(Fd). + +%% Substitute all occurrences of %Var% for Val in the given scripts +subst_src_scripts(Scripts, SrcDir, DestDir, Vars, Opts) -> + lists:foreach(fun(Script) -> + subst_src_script(Script, SrcDir, DestDir, + Vars, Opts) + end, Scripts). + +subst_src_script(Script, SrcDir, DestDir, Vars, Opts) -> + subst_file(filename:join([SrcDir, Script ++ ".src"]), + filename:join([DestDir, Script]), + Vars, Opts). + +subst_file(Src, Dest, Vars, Opts) -> + {ok, Bin} = file:read_file(Src), + Conts = binary_to_list(Bin), + NConts = subst(Conts, Vars), + write_file(Dest, NConts), + case lists:member(preserve, Opts) of + true -> + {ok, FileInfo} = file:read_file_info(Src), + file:write_file_info(Dest, FileInfo); + false -> + ok + end. + +subst(Str, [{Var,Val}|Vars]) -> + subst(re:replace(Str,"%"++Var++"%",Val,[{return,list}]),Vars); +subst(Str, []) -> + Str. + +%%% Start a node by executing the given start command. This node will +%%% be used for upgrade. +start_node(Start,ExpVsn,ExpAppsVsns) -> + Port = open_port({spawn_executable, Start}, []), + unlink(Port), + erlang:port_close(Port), + wait_node_up(permanent,ExpVsn,ExpAppsVsns). + +wait_node_up(ExpStatus,ExpVsn,ExpAppsVsns) -> + Node = node_name(?testnode), + wait_node_up(Node,ExpStatus,ExpVsn,lists:keysort(1,ExpAppsVsns),60). + +wait_node_up(Node,ExpStatus,ExpVsn,ExpAppsVsns,0) -> + test_server:fail({node_not_started,app_check_failed,ExpVsn,ExpAppsVsns, + rpc:call(Node,release_handler,which_releases,[ExpStatus]), + rpc:call(Node,application,which_applications,[])}); +wait_node_up(Node,ExpStatus,ExpVsn,ExpAppsVsns,N) -> + case {rpc:call(Node,release_handler,which_releases,[ExpStatus]), + rpc:call(Node, application, which_applications, [])} of + {[{_,ExpVsn,_,_}],Apps} when is_list(Apps) -> + case [{A,V} || {A,_,V} <- lists:keysort(1,Apps), + lists:keymember(A,1,ExpAppsVsns)] of + ExpAppsVsns -> + {ok,Node}; + _ -> + timer:sleep(2000), + wait_node_up(Node,ExpStatus,ExpVsn,ExpAppsVsns,N-1) + end; + _ -> + timer:sleep(2000), + wait_node_up(Node,ExpStatus,ExpVsn,ExpAppsVsns,N-1) + end. + +node_name(Sname) -> + {ok,Host} = inet:gethostname(), + list_to_atom(atom_to_list(Sname) ++ "@" ++ Host). + +rm_rf(Dir) -> + case file:read_file_info(Dir) of + {ok, #file_info{type = directory}} -> + {ok, Content} = file:list_dir_all(Dir), + [rm_rf(filename:join(Dir,C)) || C <- Content], + ok=file:del_dir(Dir), + ok; + {ok, #file_info{}} -> + ok=file:delete(Dir); + _ -> + ok + end. diff --git a/lib/common_test/test/ct_cover_SUITE.erl b/lib/common_test/test/ct_cover_SUITE.erl index 47080b5577..87ba4ae1b9 100644 --- a/lib/common_test/test/ct_cover_SUITE.erl +++ b/lib/common_test/test/ct_cover_SUITE.erl @@ -76,7 +76,8 @@ all() -> cover_node_option, ct_cover_add_remove_nodes, otp_9956, - cross + cross, + export_import ]. %%-------------------------------------------------------------------- @@ -199,6 +200,20 @@ cross(Config) -> ok. +export_import(Config) -> + DataDir = ?config(data_dir,Config), + false = check_cover(Config), + CoverSpec1 = + default_cover_file_content() ++ [{export,"export_import.coverdata"}], + CoverFile1 = create_cover_file(export_import1,CoverSpec1,Config), + {ok,Events1} = run_test(export_import1,default,[{cover,CoverFile1}],Config), + check_calls(Events1,1), + CoverSpec2 = + default_cover_file_content() ++ [{import,"export_import.coverdata"}], + CoverFile2 = create_cover_file(export_import2,CoverSpec2,Config), + {ok,Events2} = run_test(export_import2,default,[{cover,CoverFile2}],Config), + check_calls(Events2,2), + ok. %%%----------------------------------------------------------------- %%% HELP FUNCTIONS diff --git a/lib/common_test/test/ct_netconfc_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE.erl index c89a4cdabe..2959f77087 100644 --- a/lib/common_test/test/ct_netconfc_SUITE.erl +++ b/lib/common_test/test/ct_netconfc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2014. All Rights Reserved. %% %% The 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,7 +63,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [ - default + netconfc1_SUITE, + netconfc_remote_SUITE ]. %%-------------------------------------------------------------------- @@ -72,14 +73,21 @@ all() -> %%%----------------------------------------------------------------- %%% -default(Config) when is_list(Config) -> +netconfc1_SUITE(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), Suite = filename:join(DataDir, "netconfc1_SUITE"), CfgFile = filename:join(DataDir, "netconfc1.cfg"), {Opts,ERPid} = setup([{suite,Suite},{config,CfgFile}, - {label,default}], Config), + {label,netconfc1_SUITE}], Config), - ok = execute(default, Opts, ERPid, Config). + ok = execute(netconfc1_SUITE, Opts, ERPid, Config). + +netconfc_remote_SUITE(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + Suite = filename:join(DataDir, "netconfc_remote_SUITE"), + {Opts,ERPid} = setup([{suite,Suite},{label,netconfc_remote_SUITE}], Config), + + ok = execute(netconfc_remote_SUITE, Opts, ERPid, Config). %%%----------------------------------------------------------------- @@ -112,16 +120,15 @@ reformat(Events, EH) -> %%%----------------------------------------------------------------- %%% TEST EVENTS %%%----------------------------------------------------------------- -events_to_check(default,Config) -> - {module,_} = code:load_abs(filename:join(?config(data_dir,Config), - netconfc1_SUITE)), - TCs = netconfc1_SUITE:all(), - code:purge(netconfc1_SUITE), - code:delete(netconfc1_SUITE), +events_to_check(Suite,Config) -> + {module,_} = code:load_abs(filename:join(?config(data_dir,Config),Suite)), + TCs = Suite:all(), + code:purge(Suite), + code:delete(Suite), OneTest = [{?eh,start_logging,{'DEF','RUNDIR'}}] ++ - [{?eh,tc_done,{netconfc1_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_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl index 2bcfeeec0c..332e54d1a7 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 2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. All Rights Reserved. %% %% The 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,25 +30,10 @@ -module(netconfc1_SUITE). -include_lib("common_test/include/ct.hrl"). -include_lib("common_test/src/ct_netconfc.hrl"). --include_lib("public_key/include/public_key.hrl"). +-include("netconfc_test_lib.hrl"). -compile(export_all). -%% Default timetrap timeout (set in init_per_testcase). --define(default_timeout, ?t:minutes(1)). - --define(NS,ns). --define(LOCALHOST, "127.0.0.1"). --define(SSH_PORT, 2060). - --define(DEFAULT_SSH_OPTS,[{ssh,?LOCALHOST}, - {port,?SSH_PORT}, - {user,"xxx"}, - {password,"xxx"}]). --define(DEFAULT_SSH_OPTS(Dir), ?DEFAULT_SSH_OPTS++[{user_dir,Dir}]). - --define(ok,ok). - suite() -> [{ct_hooks, [{cth_conn_log, [{ct_netconfc,[{log_type,html}, %will be overwritten by config @@ -91,6 +76,7 @@ all() -> get_config, get_config_xpath, edit_config, + edit_config_opt_params, copy_config, delete_config, lock, @@ -136,8 +122,8 @@ end_per_testcase(_Case, Config) -> init_per_suite(Config) -> case catch {crypto:start(), ssh:start()} of {ok, ok} -> - {ok, _} = get_id_keys(Config), - make_dsa_files(Config), + {ok, _} = netconfc_test_lib:get_id_keys(Config), + netconfc_test_lib:make_dsa_files(Config), Server = ?NS:start(?config(data_dir,Config)), [{server,Server}|Config]; _ -> @@ -148,7 +134,7 @@ end_per_suite(Config) -> ?NS:stop(?config(server,Config)), ssh:stop(), crypto:stop(), - remove_id_keys(Config), + netconfc_test_lib:remove_id_keys(Config), Config. hello(Config) -> @@ -415,6 +401,18 @@ edit_config(Config) -> ?ok = ct_netconfc:close_session(Client), ok. +edit_config_opt_params(Config) -> + DataDir = ?config(data_dir,Config), + {ok,Client} = open_success(DataDir), + ?NS:expect_reply({'edit-config',{'default-operation',"none"}},ok), + ?ok = ct_netconfc:edit_config(Client,running, + {server,[{xmlns,"myns"}], + [{name,["myserver"]}]}, + [{'default-operation',["none"]}]), + ?NS:expect_do_reply('close-session',close,ok), + ?ok = ct_netconfc:close_session(Client), + ok. + copy_config(Config) -> DataDir = ?config(data_dir,Config), {ok,Client} = open_success(DataDir), @@ -1001,165 +999,3 @@ pad(I) when I<10 -> "0"++integer_to_list(I); pad(I) -> integer_to_list(I). - - -%%%----------------------------------------------------------------- -%%% BEGIN SSH key management -%% copy private keys to given dir from ~/.ssh -get_id_keys(Config) -> - DstDir = ?config(priv_dir, Config), - SrcDir = filename:join(os:getenv("HOME"), ".ssh"), - RsaOk = copyfile(SrcDir, DstDir, "id_rsa"), - DsaOk = copyfile(SrcDir, DstDir, "id_dsa"), - case {RsaOk, DsaOk} of - {{ok, _}, {ok, _}} -> {ok, both}; - {{ok, _}, _} -> {ok, rsa}; - {_, {ok, _}} -> {ok, dsa}; - {Error, _} -> Error - end. - -%% Remove later on. Use make_dsa_files instead. -remove_id_keys(Config) -> - Dir = ?config(priv_dir, Config), - file:delete(filename:join(Dir, "id_rsa")), - file:delete(filename:join(Dir, "id_dsa")). - - -make_dsa_files(Config) -> - make_dsa_files(Config, rfc4716_public_key). -make_dsa_files(Config, Type) -> - {DSA, EncodedKey} = gen_dsa(128, 20), - PKey = DSA#'DSAPrivateKey'.y, - P = DSA#'DSAPrivateKey'.p, - Q = DSA#'DSAPrivateKey'.q, - G = DSA#'DSAPrivateKey'.g, - Dss = #'Dss-Parms'{p=P, q=Q, g=G}, - {ok, Hostname} = inet:gethostname(), - {ok, {A, B, C, D}} = inet:getaddr(Hostname, inet), - IP = lists:concat([A, ".", B, ".", C, ".", D]), - Attributes = [], % Could be [{comment,"user@" ++ Hostname}], - HostNames = [{hostnames,[IP, IP]}], - PublicKey = [{{PKey, Dss}, Attributes}], - KnownHosts = [{{PKey, Dss}, HostNames}], - - KnownHostsEnc = public_key:ssh_encode(KnownHosts, known_hosts), - KnownHosts = public_key:ssh_decode(KnownHostsEnc, known_hosts), - - PublicKeyEnc = public_key:ssh_encode(PublicKey, Type), - - SystemTmpDir = ?config(data_dir, Config), - filelib:ensure_dir(SystemTmpDir), - file:make_dir(SystemTmpDir), - - DSAFile = filename:join(SystemTmpDir, "ssh_host_dsa_key.pub"), - file:delete(DSAFile), - - DSAPrivateFile = filename:join(SystemTmpDir, "ssh_host_dsa_key"), - file:delete(DSAPrivateFile), - - KHFile = filename:join(SystemTmpDir, "known_hosts"), - file:delete(KHFile), - - PemBin = public_key:pem_encode([EncodedKey]), - - file:write_file(DSAFile, PublicKeyEnc), - file:write_file(KHFile, KnownHostsEnc), - file:write_file(DSAPrivateFile, PemBin), - ok. - - -%%-------------------------------------------------------------------- -%% @doc Creates a dsa key (OBS: for testing only) -%% the sizes are in bytes -%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} -%% @end -%%-------------------------------------------------------------------- -gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) -> - Key = gen_dsa2(LSize, NSize), - {Key, encode_key(Key)}. - -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 -%% and the fips_186-3.pdf -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -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 -> - gen_dsa2(LSize, NSize); - 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_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(P, 50) of - true -> P; - false -> dsa_search(T+1, P0, Q, Iter-1) - end; -dsa_search(_,_,_,_) -> - error. - - -%%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -prime(ByteSize) -> - Rand = odd_rand(ByteSize), - prime_odd(Rand, 0). - -prime_odd(Rand, N) -> - case is_prime(Rand, 50) of - true -> - Rand; - 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(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(Min, Max). - -odd_rand(Min,Max) -> - Rand = crypto:rand_uniform(Min,Max), - case Rand rem 2 of - 0 -> - Rand + 1; - _ -> - Rand - end. - -copyfile(SrcDir, DstDir, Fn) -> - file:copy(filename:join(SrcDir, Fn), - filename:join(DstDir, Fn)). - -%%% END SSH key management -%%%----------------------------------------------------------------- diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl new file mode 100644 index 0000000000..7a44d148dd --- /dev/null +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl @@ -0,0 +1,147 @@ +%%-------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The 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(netconfc_remote_SUITE). +-include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/src/ct_netconfc.hrl"). +-include("netconfc_test_lib.hrl"). + +-compile(export_all). + +suite() -> + [{ct_hooks, [{cth_conn_log,[{ct_netconfc,[{log_type,html}]}]}]}]. + +all() -> + case os:find_executable("ssh") of + false -> + {skip, "SSH not installed on host"}; + _ -> + [remote_crash + ] + end. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(Case, Config) -> + stop_node(Case), + Dog = test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. + +end_per_testcase(Case, Config) -> + stop_node(Case), + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +stop_node(Case) -> + {ok,Host} = inet:gethostname(), + Node = list_to_atom("nc_" ++ atom_to_list(Case)++ "@" ++ Host), + rpc:call(Node,erlang,halt,[]). + + +init_per_suite(Config) -> + case {crypto:start(),ssh:start()} of + {ok,ok} -> + {ok, _} = netconfc_test_lib:get_id_keys(Config), + netconfc_test_lib:make_dsa_files(Config), + Config; + _ -> + {skip, "Crypto and/or SSH could not be started locally!"} + end. + +end_per_suite(Config) -> + ssh:stop(), + crypto:stop(), + netconfc_test_lib:remove_id_keys(Config), + Config. + +%% This test case is related to seq12645 +%% Running the netconf server in a remote node, test that the client +%% process terminates if the remote node goes down. +remote_crash(Config) -> + {ok,Node} = ct_slave:start(nc_remote_crash), + Pa = filename:dirname(code:which(?NS)), + true = rpc:call(Node,code,add_patha,[Pa]), + + case {rpc:call(Node,crypto,start,[]),rpc:call(Node,ssh,start,[])} of + {ok,ok} -> + Server = rpc:call(Node,?NS,start,[?config(data_dir,Config)]), + remote_crash(Node,Config); + _ -> + {skip, "Crypto and/or SSH could not be started remote!"} + end. + +remote_crash(Node,Config) -> + DataDir = ?config(data_dir,Config), + {ok,Client} = open_success(Node,DataDir), + + ns(Node,expect_reply,[{'create-subscription',[stream]},ok]), + ?ok = ct_netconfc:create_subscription(Client), + + true = erlang:is_process_alive(Client), + Ref = erlang:monitor(process,Client), + rpc:call(Node,erlang,halt,[]), % take the node down as brutally as possible + receive {'DOWN',Ref,process,Client,_} -> + ok + after 10000 -> + ct:fail(client_still_alive) + end. + +%%%----------------------------------------------------------------- + +break(_Config) -> + test_server:break("break test case"). + +%%%----------------------------------------------------------------- +%% Open a netconf session which is not specified in a config file +open_success(Node,Dir) -> + open_success(Node,Dir,[]). + +%% Open a netconf session which is not specified in a config file, and +%% give som extra options in addition to the test defaults. +open_success(Node,Dir,ExtraOpts) when is_list(Dir), is_list(ExtraOpts) -> + ns(Node,hello,[1]), % tell server to send hello with session id 1 + ns(Node,expect,[hello]), % tell server to expect a hello message from client + open(Dir,ExtraOpts); + +%% Open a named netconf session which is not specified in a config file +open_success(Node,KeyOrName,Dir) when is_atom(KeyOrName), is_list(Dir) -> + ns(Node,hello,[1]), + ns(Node,expect,[hello]), + ct_netconfc:open(KeyOrName,?DEFAULT_SSH_OPTS(Dir)). + +open(Dir) -> + open(Dir,[]). +open(Dir,ExtraOpts) -> + Opts = lists:ukeymerge(1,lists:keysort(1,ExtraOpts), + lists:keysort(1,?DEFAULT_SSH_OPTS(Dir))), + ct_netconfc:open(Opts). + +%%%----------------------------------------------------------------- +%%% Call server on remote node +ns(Node,Func,Args) -> + rpc:call(Node,?NS,Func,Args). + diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl new file mode 100644 index 0000000000..e058bc7600 --- /dev/null +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.erl @@ -0,0 +1,166 @@ +-module(netconfc_test_lib). + +-export([get_id_keys/1, remove_id_keys/1, make_dsa_files/1]). +-include_lib("common_test/include/ct.hrl"). +-include_lib("public_key/include/public_key.hrl"). + +%%%----------------------------------------------------------------- +%%% BEGIN SSH key management +%% copy private keys to given dir from ~/.ssh +get_id_keys(Config) -> + DstDir = ?config(priv_dir, Config), + SrcDir = filename:join(os:getenv("HOME"), ".ssh"), + RsaOk = copyfile(SrcDir, DstDir, "id_rsa"), + DsaOk = copyfile(SrcDir, DstDir, "id_dsa"), + case {RsaOk, DsaOk} of + {{ok, _}, {ok, _}} -> {ok, both}; + {{ok, _}, _} -> {ok, rsa}; + {_, {ok, _}} -> {ok, dsa}; + {Error, _} -> Error + end. + +%% Remove later on. Use make_dsa_files instead. +remove_id_keys(Config) -> + Dir = ?config(priv_dir, Config), + file:delete(filename:join(Dir, "id_rsa")), + file:delete(filename:join(Dir, "id_dsa")). + + +make_dsa_files(Config) -> + make_dsa_files(Config, rfc4716_public_key). +make_dsa_files(Config, Type) -> + {DSA, EncodedKey} = gen_dsa(128, 20), + PKey = DSA#'DSAPrivateKey'.y, + P = DSA#'DSAPrivateKey'.p, + Q = DSA#'DSAPrivateKey'.q, + G = DSA#'DSAPrivateKey'.g, + Dss = #'Dss-Parms'{p=P, q=Q, g=G}, + {ok, Hostname} = inet:gethostname(), + {ok, {A, B, C, D}} = inet:getaddr(Hostname, inet), + IP = lists:concat([A, ".", B, ".", C, ".", D]), + Attributes = [], % Could be [{comment,"user@" ++ Hostname}], + HostNames = [{hostnames,[IP, IP]}], + PublicKey = [{{PKey, Dss}, Attributes}], + KnownHosts = [{{PKey, Dss}, HostNames}], + + KnownHostsEnc = public_key:ssh_encode(KnownHosts, known_hosts), + KnownHosts = public_key:ssh_decode(KnownHostsEnc, known_hosts), + + PublicKeyEnc = public_key:ssh_encode(PublicKey, Type), + + SystemTmpDir = ?config(data_dir, Config), + filelib:ensure_dir(SystemTmpDir), + file:make_dir(SystemTmpDir), + + DSAFile = filename:join(SystemTmpDir, "ssh_host_dsa_key.pub"), + file:delete(DSAFile), + + DSAPrivateFile = filename:join(SystemTmpDir, "ssh_host_dsa_key"), + file:delete(DSAPrivateFile), + + KHFile = filename:join(SystemTmpDir, "known_hosts"), + file:delete(KHFile), + + PemBin = public_key:pem_encode([EncodedKey]), + + file:write_file(DSAFile, PublicKeyEnc), + file:write_file(KHFile, KnownHostsEnc), + file:write_file(DSAPrivateFile, PemBin), + ok. + + +%%-------------------------------------------------------------------- +%% @doc Creates a dsa key (OBS: for testing only) +%% the sizes are in bytes +%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()} +%% @end +%%-------------------------------------------------------------------- +gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) -> + Key = gen_dsa2(LSize, NSize), + {Key, encode_key(Key)}. + +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 +%% and the fips_186-3.pdf +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +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 -> + gen_dsa2(LSize, NSize); + 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_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(P, 50) of + true -> P; + false -> dsa_search(T+1, P0, Q, Iter-1) + end; +dsa_search(_,_,_,_) -> + error. + + +%%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +prime(ByteSize) -> + Rand = odd_rand(ByteSize), + prime_odd(Rand, 0). + +prime_odd(Rand, N) -> + case is_prime(Rand, 50) of + true -> + Rand; + 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(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(Min, Max). + +odd_rand(Min,Max) -> + Rand = crypto:rand_uniform(Min,Max), + case Rand rem 2 of + 0 -> + Rand + 1; + _ -> + Rand + end. + +copyfile(SrcDir, DstDir, Fn) -> + file:copy(filename:join(SrcDir, Fn), + filename:join(DstDir, Fn)). + +%%% END SSH key management +%%%----------------------------------------------------------------- diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.hrl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.hrl new file mode 100644 index 0000000000..dcaad5ba93 --- /dev/null +++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_test_lib.hrl @@ -0,0 +1,14 @@ +%% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(1)). + +-define(NS,ns). % netconf server module +-define(LOCALHOST, "127.0.0.1"). +-define(SSH_PORT, 2060). + +-define(DEFAULT_SSH_OPTS,[{ssh,?LOCALHOST}, + {port,?SSH_PORT}, + {user,"xxx"}, + {password,"xxx"}]). +-define(DEFAULT_SSH_OPTS(Dir), ?DEFAULT_SSH_OPTS++[{user_dir,Dir}]). + +-define(ok,ok). diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl index fb0734d48e..f7c7b891bb 100644 --- a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl +++ b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl @@ -1,7 +1,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -382,6 +382,7 @@ event({startElement,_,Name,_,Attrs},[ignore,{se,Name,As}|Match]) -> event({startPrefixMapping,_,Ns},[{ns,Ns}|Match]) -> Match; event({startPrefixMapping,_,Ns},[ignore,{ns,Ns}|Match]) -> Match; event({endPrefixMapping,_},Match) -> Match; +event({characters,Chs},[{characters,Chs}|Match]) -> Match; event({endElement,_,Name,_},[{ee,Name}|Match]) -> Match; event({endElement,_,Name,_},[ignore,{ee,Name}|Match]) -> Match; event(endDocument,Match) when Match==[]; Match==[ignore] -> ok; @@ -471,14 +472,17 @@ capabilities(no_caps) -> %%% expect_do_reply/3. %%% %%% match(term()) -> [Match]. -%%% Match = ignore | {se,Name} | {se,Name,Attrs} | {ee,Name} | {ns,Namespace} +%%% Match = ignore | {se,Name} | {se,Name,Attrs} | {ee,Name} | +%%% {ns,Namespace} | {characters,Chs} %%% Name = string() +%%% Chs = string() %%% Attrs = [{atom(),string()}] %%% Namespace = string() %%% %%% 'se' means start element, 'ee' means end element - i.e. to match %%% an XML element you need one 'se' entry and one 'ee' entry with the -%%% same name in the match list. +%%% same name in the match list. 'characters' can be used for matching +%%% character data (cdata) inside an element. match(hello) -> [ignore,{se,"hello"},ignore,{ee,"hello"},ignore]; match('close-session') -> @@ -487,6 +491,10 @@ match('close-session') -> match('edit-config') -> [ignore,{se,"rpc"},{se,"edit-config"},{se,"target"},ignore,{ee,"target"}, {se,"config"},ignore,{ee,"config"},{ee,"edit-config"},{ee,"rpc"},ignore]; +match({'edit-config',{'default-operation',DO}}) -> + [ignore,{se,"rpc"},{se,"edit-config"},{se,"target"},ignore,{ee,"target"}, + {se,"default-operation"},{characters,DO},{ee,"default-operation"}, + {se,"config"},ignore,{ee,"config"},{ee,"edit-config"},{ee,"rpc"},ignore]; match('get') -> match({get,subtree}); match({'get',FilterType}) -> diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp.cfg b/lib/common_test/test/ct_snmp_SUITE_data/snmp.cfg index 895e097de6..7ff356e49a 100644 --- a/lib/common_test/test/ct_snmp_SUITE_data/snmp.cfg +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp.cfg @@ -22,23 +22,23 @@ {agent_target_param_def,{data_dir_file,"target_params.conf"}}, {agent_vacm,{data_dir_file,"vacm.conf"}}]}. {snmp_app1,[{manager, [{config, [{verbosity, silence}]}, - {server,[{verbosity,silence}]}, - {net_if,[{verbosity,silence}]}, + {server,[{verbosity,log}]}, + {net_if,[{verbosity,log}]}, {versions,[v2]} ]}, {agent, [{config, [{verbosity, silence}]}, - {net_if,[{verbosity,silence}]}, + {net_if,[{verbosity,log}]}, {mib_server,[{verbosity,silence}]}, {local_db,[{verbosity,silence}]}, - {agent_verbosity,silence} + {agent_verbosity,log} ]}]}. {snmp_app2,[{manager, [{config, [{verbosity, silence}]}, - {server,[{verbosity,silence}]}, - {net_if,[{verbosity,silence}]} + {server,[{verbosity,log}]}, + {net_if,[{verbosity,log}]} ]}, {agent, [{config, [{verbosity, silence}]}, - {net_if,[{verbosity,silence}]}, + {net_if,[{verbosity,log}]}, {mib_server,[{verbosity,silence}]}, {local_db,[{verbosity,silence}]}, - {agent_verbosity,silence} + {agent_verbosity,log} ]}]}. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl index 16b2b5690c..e20832e1e7 100644 --- a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl @@ -1,7 +1,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% Copyright Ericsson AB 2012-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -288,6 +288,9 @@ override_usm(Config) -> %% Check that usm.conf is overwritten {ok,MyUsm} = snmpa_conf:read_usm_config(DataDir), {ok,UsedUsm} = snmpa_conf:read_usm_config(ConfDir), + ct:pal( + "MyUsm = ~p~nUsedUsm = ~p", + [MyUsm, UsedUsm]), true = (MyUsm == UsedUsm), %% Check that the usm user is actually configured... @@ -304,6 +307,9 @@ override_standard(Config) -> %% Check that standard.conf is overwritten {ok,MyStandard} = snmpa_conf:read_standard_config(DataDir), {ok,UsedStandard} = snmpa_conf:read_standard_config(ConfDir), + ct:pal( + "MyStandard = ~p~nUsedStandard = ~p", + [MyStandard, UsedStandard]), true = (MyStandard == UsedStandard), %% Check that the values from standard.conf is actually configured... @@ -319,6 +325,9 @@ override_context(Config) -> %% Check that context.conf is overwritten {ok,MyContext} = snmpa_conf:read_context_config(DataDir), {ok,UsedContext} = snmpa_conf:read_context_config(ConfDir), + ct:pal( + "MyContext = ~p~nUsedContext = ~p", + [MyContext, UsedContext]), true = (MyContext == UsedContext), ok. @@ -330,6 +339,9 @@ override_community(Config) -> %% Check that community.conf is overwritten {ok,MyCommunity} = snmpa_conf:read_community_config(DataDir), {ok,UsedCommunity} = snmpa_conf:read_community_config(ConfDir), + ct:pal( + "MyCommunity = ~p~nUsedCommunity = ~p", + [MyCommunity, UsedCommunity]), true = (MyCommunity == UsedCommunity), ok. @@ -341,6 +353,9 @@ override_notify(Config) -> %% Check that notify.conf is overwritten {ok,MyNotify} = snmpa_conf:read_notify_config(DataDir), {ok,UsedNotify} = snmpa_conf:read_notify_config(ConfDir), + ct:pal( + "MyNotify = ~p~nUsedNotify = ~p", + [MyNotify, UsedNotify]), true = (MyNotify == UsedNotify), ok. @@ -352,6 +367,9 @@ override_target_addr(Config) -> %% Check that target_addr.conf is overwritten {ok,MyTargetAddr} = snmpa_conf:read_target_addr_config(DataDir), {ok,UsedTargetAddr} = snmpa_conf:read_target_addr_config(ConfDir), + ct:pal( + "MyTargetAddr = ~p~nUsedTargetAddr = ~p", + [MyTargetAddr, UsedTargetAddr]), true = (MyTargetAddr == UsedTargetAddr), ok. @@ -363,6 +381,9 @@ override_target_params(Config) -> %% Check that target_params.conf is overwritten {ok,MyTargetParams} = snmpa_conf:read_target_params_config(DataDir), {ok,UsedTargetParams} = snmpa_conf:read_target_params_config(ConfDir), + ct:pal( + "MyTargetParams = ~p~nUsedTargetParams = ~p", + [MyTargetParams, UsedTargetParams]), true = (MyTargetParams == UsedTargetParams), ok. @@ -374,6 +395,9 @@ override_vacm(Config) -> %% Check that vacm.conf is overwritten {ok,MyVacm} = snmpa_conf:read_vacm_config(DataDir), {ok,UsedVacm} = snmpa_conf:read_vacm_config(ConfDir), + ct:pal( + "MyVacm = ~p~nUsedVacm = ~p", + [MyVacm, UsedVacm]), true = (MyVacm == UsedVacm), ok. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_addr.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_addr.conf index d02672a074..d3ce2fa60e 100644 --- a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_addr.conf +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_addr.conf @@ -1,2 +1,2 @@ -{"target1", snmpUDPDomain, [147,214,122,73], 5000, 1500, 3, "std_trap", "target_v3", "", [], 2048}. -{"target2", snmpUDPDomain, [147,214,122,73], 5000, 1500, 3, "std_inform", "target_v3", "", [], 2048}. +{"target1", snmpUDPDomain, {[147,214,122,73], 5000}, 1500, 3, "std_trap", "target_v3", "", [], 2048}. +{"target2", snmpUDPDomain, {[147,214,122,73], 5000}, 1500, 3, "std_inform", "target_v3", "", [], 2048}. diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index 2e2b45d59f..746469584d 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -481,6 +481,7 @@ er_loop(Evs) -> From ! {event_receiver,lists:reverse(Evs)}, er_loop(Evs); stop -> + unregister(event_receiver), ok end. diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index def8a6a6f4..00c0925b40 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.8.1 +COMMON_TEST_VSN = 1.8.2 diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index 55e9661d7d..d48a0a5599 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -31,6 +31,22 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 5.0.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Corrected a bug with incorrect code generation when + inlining was turned on.</p> + <p> + Own Id: OTP-12132</p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 5.0.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 7a30c68593..5626aa34ab 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -155,7 +155,8 @@ collect(remove_message) -> {set,[],[],remove_message}; collect({put_map,F,Op,S,D,R,{list,Puts}}) -> {set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}; collect({get_map_elements,F,S,{list,Gets}}) -> - {set,Gets,[S],{get_map_elements,F}}; + {Ss,Ds} = beam_utils:spliteven(Gets), + {set,Ds,[S|Ss],{get_map_elements,F}}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; collect(fclearerror) -> {set,[],[],fclearerror}; collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror}; diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 46835bece1..05d067dc48 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -63,7 +63,8 @@ norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I}; norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2}; norm({set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}) -> {put_map,F,Op,S,D,R,{list,Puts}}; -norm({set,Gets,[S],{get_map_elements,F}}) -> +norm({set,Ds,[S|Ss],{get_map_elements,F}}) -> + Gets = beam_utils:joineven(Ss,Ds), {get_map_elements,F,S,{list,Gets}}; norm({set,[],[],remove_message}) -> remove_message; norm({set,[],[],fclearerror}) -> fclearerror; diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index 688bba9a94..f5dba314ae 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -53,8 +53,9 @@ split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is], Bl, Acc) when Lbl =/= 0 -> split_block(Is, [], [{put_map,Fail,Op,S,D,R,{list,Puts}}| make_block(Bl, Acc)]); -split_block([{set,Gets,[S],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc) +split_block([{set,Ds,[S|Ss],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 -> + Gets = beam_utils:joineven(Ss,Ds), split_block(Is, [], [{get_map_elements,Fail,S,{list,Gets}}|make_block(Bl, Acc)]); split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 58c0f765ae..cdddad4153 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -106,6 +106,20 @@ simplify_basic_1([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Acc) -> Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]) end; +simplify_basic_1([{test,is_map,_,[R]}=I|Is], Ts0, Acc) -> + case tdb_find(R, Ts0) of + map -> simplify_basic_1(Is, Ts0, Acc); + _Other -> + Ts = update(I, Ts0), + simplify_basic_1(Is, Ts, [I|Acc]) + end; +simplify_basic_1([{test,is_nonempty_list,_,[R]}=I|Is], Ts0, Acc) -> + case tdb_find(R, Ts0) of + nonempty_list -> simplify_basic_1(Is, Ts0, Acc); + _Other -> + Ts = update(I, Ts0), + simplify_basic_1(Is, Ts, [I|Acc]) + end; simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) -> Acc = case tdb_find(R, Ts0) of {atom,_}=Atom -> Acc0; @@ -402,6 +416,10 @@ update({test,is_float,_Fail,[Src]}, Ts0) -> tdb_update([{Src,float}], Ts0); update({test,test_arity,_Fail,[Src,Arity]}, Ts0) -> tdb_update([{Src,{tuple,Arity,[]}}], Ts0); +update({test,is_map,_Fail,[Src]}, Ts0) -> + tdb_update([{Src,map}], Ts0); +update({test,is_nonempty_list,_Fail,[Src]}, Ts0) -> + tdb_update([{Src,nonempty_list}], Ts0); update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) -> case tdb_find(Reg, Ts) of error -> @@ -710,6 +728,8 @@ merge_type_info(NewType, _) -> verify_type(NewType), NewType. +verify_type(map) -> ok; +verify_type(nonempty_list) -> ok; verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok; verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok; verify_type({tuple_element,_,_}) -> ok; diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 8ca368c167..e82ba82d38 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -26,6 +26,8 @@ code_at/2,bif_to_test/3,is_pure_test/1, live_opt/1,delete_live_annos/1,combine_heap_needs/2]). +-export([joineven/2,spliteven/1]). + -import(lists, [member/2,sort/1,reverse/1,splitwith/2]). -record(live, @@ -832,3 +834,15 @@ x_live([_|Rs], Regs) -> x_live(Rs, Regs); x_live([], Regs) -> Regs. is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1. + +%% spliteven/1 +%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]} +spliteven(Rs) -> spliteven(Rs,[],[]). +spliteven([],Ss,Ds) -> {reverse(Ss),reverse(Ds)}; +spliteven([S,D|Rs],Ss,Ds) -> + spliteven(Rs,[S|Ss],[D|Ds]). + +%% joineven/1 +%% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6] +joineven([],[]) -> []; +joineven([S|Ss],[D|Ds]) -> [S,D|joineven(Ss,Ds)]. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 9d5563d13b..0acc7a227f 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1123,7 +1123,9 @@ assert_freg_set(Fr, _) -> error({bad_source,Fr}). %%% Maps %% ensure that a list of literals has a strict -%% ascending term order (also meaning unique literals) +%% ascending term order (also meaning unique literals). +%% Single item lists may have registers. +assert_strict_literal_termorder([_]) -> ok; assert_strict_literal_termorder(Ls) -> Vs = lists:map(fun (L) -> get_literal(L) end, Ls), case check_strict_value_termorder(Vs) of diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 9d6768b157..7a2c3d70de 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -3063,10 +3063,12 @@ pat_vars(Node, Vs) -> map -> pat_list_vars(map_es(Node), Vs); map_pair -> - pat_list_vars([map_pair_op(Node),map_pair_key(Node),map_pair_val(Node)],Vs); + %% map_pair_key is not a pattern var, excluded + pat_list_vars([map_pair_op(Node),map_pair_val(Node)],Vs); binary -> pat_list_vars(binary_segments(Node), Vs); bitstr -> + %% bitstr_size is not a pattern var, excluded pat_vars(bitstr_val(Node), Vs); alias -> pat_vars(alias_pat(Node), [alias_var(Node) | Vs]) diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index 75740e8b9d..f8489a800b 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -1341,23 +1341,23 @@ i_bitstr(E, Ren, Env, S) -> S3 = count_size(weight(bitstr), S2), {update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}. -i_map(E, Ctx, Ren, Env, S) -> +i_map(E, Ctx, Ren, Env, S0) -> %% Visit the segments for value. - {M1, S1} = i(map_arg(E), value, Ren, Env, S), + {M1, S1} = i(map_arg(E), value, Ren, Env, S0), {Es, S2} = mapfoldl(fun (E, S) -> i_map_pair(E, Ctx, Ren, Env, S) end, S1, map_es(E)), S3 = count_size(weight(map), S2), {update_c_map(E, M1,Es), S3}. -i_map_pair(E, Ctx, Ren, Env, S) -> - %% It is not necessary to visit the Op and Key fields, - %% since these are always literals. - {Val, S1} = i(map_pair_val(E), Ctx, Ren, Env, S), +i_map_pair(E, Ctx, Ren, Env, S0) -> + %% It is not necessary to visit the Op field + %% since it is always a literal. + {Key, S1} = i(map_pair_key(E), value, Ren, Env, S0), + {Val, S2} = i(map_pair_val(E), Ctx, Ren, Env, S1), Op = map_pair_op(E), - Key = map_pair_key(E), - S2 = count_size(weight(map_pair), S1), - {update_c_map_pair(E, Op, Key, Val), S2}. + S3 = count_size(weight(map_pair), S2), + {update_c_map_pair(E, Op, Key, Val), S3}. %% This is a simplified version of `i_pattern', for lists of parameter @@ -1420,15 +1420,11 @@ i_pattern(E, Ren, Env, Ren0, Env0, S) -> S2 = count_size(weight(binary), S1), {update_c_binary(E, Es), S2}; map -> - %% map patterns should not have args - M = map_arg(E), - {Es, S1} = mapfoldl(fun (E, S) -> i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) - end, - S, map_es(E)), + end, S, map_es(E)), S2 = count_size(weight(map), S1), - {update_c_map(E, M, Es), S2}; + {update_c_map(E, map_arg(E), Es), S2}; _ -> case is_literal(E) of true -> @@ -1464,12 +1460,12 @@ i_bitstr_pattern(E, Ren, Env, Ren0, Env0, S) -> i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) -> %% It is not necessary to visit the Op it is always a literal. - %% Same goes for Key - {Val, S1} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S), + %% Key is an expression + {Key, S1} = i(map_pair_key(E), value, Ren0, Env0, S), + {Val, S2} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S1), Op = map_pair_op(E), %% should be 'exact' literal - Key = map_pair_key(E), - S2 = count_size(weight(map_pair), S1), - {update_c_map_pair(E, Op, Key, Val), S2}. + S3 = count_size(weight(map_pair), S2), + {update_c_map_pair(E, Op, Key, Val), S3}. %% --------------------------------------------------------------------- diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index e53bdd4efb..b93da8e97f 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -520,9 +520,9 @@ variables(T, S) -> tuple -> vars_in_list(tuple_es(T), S); map -> - vars_in_list(map_es(T), S); + vars_in_list([map_arg(T)|map_es(T)], S); map_pair -> - vars_in_list([map_pair_op(T),map_pair_key(T), map_pair_val(T)], S); + vars_in_list([map_pair_op(T),map_pair_key(T),map_pair_val(T)], S); 'let' -> Vs = variables(let_body(T), S), Vs1 = var_list_names(let_vars(T)), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index c7d91070f6..f347438509 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -431,11 +431,6 @@ pass(from_core) -> {".core",[?pass(parse_core)|core_passes()]}; pass(from_asm) -> {".S",[?pass(beam_consult_asm)|asm_passes()]}; -pass(asm) -> - %% TODO: remove 'asm' in 18.0 - io:format("compile:file/2 option 'asm' has been deprecated and will be~n" - "removed in the 18.0 release. Use 'from_asm' instead.~n"), - pass(from_asm); pass(from_beam) -> {".beam",[?pass(read_beam_file)|binary_passes()]}; pass(_) -> none. diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 25df33a287..c0e2bdaba0 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -33,9 +33,6 @@ %% Values only as multiple values/variables/patterns. %% Return same number of values as requested %% Correct number of arguments -%% -%% Checks to add: -%% %% Consistency of values/variables %% Consistency of function return values/calls. %% @@ -211,7 +208,7 @@ functions(Fs, Def, St0) -> function({#c_var{name={_,_}},B}, Def, St) -> %% Body must be a fun! case B of - #c_fun{} -> expr(B, Def, any, St); + #c_fun{} -> expr(B, Def, 1, St); _ -> add_error({illegal_expr,St#lint.func}, St) end. @@ -247,40 +244,42 @@ gbody(E, Def, Rt, St0) -> false -> St1 end. -gexpr(#c_var{name=N}, Def, _Rt, St) when is_atom(N); is_integer(N) -> - expr_var(N, Def, St); -gexpr(#c_literal{}, _Def, _Rt, St) -> St; -gexpr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> - gexpr_list([H,T], Def, St); -gexpr(#c_tuple{es=Es}, Def, _Rt, St) -> - gexpr_list(Es, Def, St); -gexpr(#c_map{es=Es}, Def, _Rt, St) -> - gexpr_list(Es, Def, St); -gexpr(#c_map_pair{key=K,val=V}, Def, _Rt, St) -> - gexpr_list([K,V], Def, St); -gexpr(#c_binary{segments=Ss}, Def, _Rt, St) -> - gbitstr_list(Ss, Def, St); +gexpr(#c_var{name=N}, Def, Rt, St) when is_atom(N); is_integer(N) -> + return_match(Rt, 1, expr_var(N, Def, St)); +gexpr(#c_literal{}, _Def, Rt, St) -> + return_match(Rt, 1, St); +gexpr(#c_cons{hd=H,tl=T}, Def, Rt, St) -> + return_match(Rt, 1, gexpr_list([H,T], Def, St)); +gexpr(#c_tuple{es=Es}, Def, Rt, St) -> + return_match(Rt, 1, gexpr_list(Es, Def, St)); +gexpr(#c_map{es=Es}, Def, Rt, St) -> + return_match(Rt, 1, gexpr_list(Es, Def, St)); +gexpr(#c_map_pair{key=K,val=V}, Def, Rt, St) -> + return_match(Rt, 1, gexpr_list([K,V], Def, St)); +gexpr(#c_binary{segments=Ss}, Def, Rt, St) -> + return_match(Rt, 1, gbitstr_list(Ss, Def, St)); gexpr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) -> - St1 = gexpr(Arg, Def, any, St0), %Ignore values - gbody(B, Def, Rt, St1); + St1 = gexpr(Arg, Def, 1, St0), + return_match(Rt, 1, gbody(B, Def, Rt, St1)); gexpr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) -> St1 = gbody(Arg, Def, let_varcount(Vs), St0), %This is a guard body {Lvs,St2} = variable_list(Vs, St1), gbody(B, union(Lvs, Def), Rt, St2); gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}, args=[Arg,#c_literal{val=Tag},#c_literal{val=Size}]}, - Def, 1, St) when is_atom(Tag), is_integer(Size) -> - gexpr(Arg, Def, 1, St); + Def, Rt, St) when is_atom(Tag), is_integer(Size) -> + return_match(Rt, 1, gexpr(Arg, Def, 1, St)); gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}}, - _Def, 1, St) -> - add_error({illegal_guard,St#lint.func}, St); + _Def, Rt, St) -> + return_match(Rt, 1, add_error({illegal_guard,St#lint.func}, St)); gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As}, - Def, 1, St) when is_atom(Name) -> + Def, Rt, St0) when is_atom(Name) -> + St1 = return_match(Rt, 1, St0), case is_guard_bif(Name, length(As)) of true -> - gexpr_list(As, Def, St); + gexpr_list(As, Def, St1); false -> - add_error({illegal_guard,St#lint.func}, St) + add_error({illegal_guard,St1#lint.func}, St1) end; gexpr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) -> gexpr_list(As, Def, St0); @@ -319,23 +318,25 @@ is_guard_bif(Name, Arity) -> %% expr(Expr, Defined, RetCount, State) -> State. -expr(#c_var{name={_,_}=FA}, Def, _Rt, St) -> - expr_fname(FA, Def, St); -expr(#c_var{name=N}, Def, _Rt, St) -> expr_var(N, Def, St); -expr(#c_literal{}, _Def, _Rt, St) -> St; -expr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> - expr_list([H,T], Def, St); -expr(#c_tuple{es=Es}, Def, _Rt, St) -> - expr_list(Es, Def, St); -expr(#c_map{es=Es}, Def, _Rt, St) -> - expr_list(Es, Def, St); -expr(#c_map_pair{key=K,val=V},Def,_Rt,St) -> - expr_list([K,V],Def,St); -expr(#c_binary{segments=Ss}, Def, _Rt, St) -> - bitstr_list(Ss, Def, St); +expr(#c_var{name={_,_}=FA}, Def, Rt, St) -> + return_match(Rt, 1, expr_fname(FA, Def, St)); +expr(#c_var{name=N}, Def, Rt, St) -> + return_match(Rt, 1, expr_var(N, Def, St)); +expr(#c_literal{}, _Def, Rt, St) -> + return_match(Rt, 1, St); +expr(#c_cons{hd=H,tl=T}, Def, Rt, St) -> + return_match(Rt, 1, expr_list([H,T], Def, St)); +expr(#c_tuple{es=Es}, Def, Rt, St) -> + return_match(Rt, 1, expr_list(Es, Def, St)); +expr(#c_map{es=Es}, Def, Rt, St) -> + return_match(Rt, 1, expr_list(Es, Def, St)); +expr(#c_map_pair{key=K,val=V}, Def, Rt, St) -> + return_match(Rt, 1, expr_list([K,V], Def, St)); +expr(#c_binary{segments=Ss}, Def, Rt, St) -> + return_match(Rt, 1, bitstr_list(Ss, Def, St)); expr(#c_fun{vars=Vs,body=B}, Def, Rt, St0) -> {Vvs,St1} = variable_list(Vs, St0), - return_match(Rt, 1, body(B, union(Vvs, Def), any, St1)); + return_match(Rt, 1, body(B, union(Vvs, Def), 1, St1)); expr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) -> St1 = expr(Arg, Def, 1, St0), body(B, Def, Rt, St1); @@ -361,15 +362,26 @@ expr(#c_receive{clauses=Cs,timeout=T,action=A}, Def, Rt, St0) -> St1 = expr(T, Def, 1, St0), St2 = body(A, Def, Rt, St1), clauses(Cs, Def, 1, Rt, St2); -expr(#c_apply{op=Op,args=As}, Def, _Rt, St0) -> +expr(#c_apply{op=Op,args=As}, Def, Rt, St0) -> St1 = apply_op(Op, Def, length(As), St0), - expr_list(As, Def, St1); + return_match(Rt, 1, expr_list(As, Def, St1)); +expr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As}, + Def, Rt, St0) when is_atom(Name) -> + St1 = expr_list(As, Def, St0), + case erl_bifs:is_exit_bif(erlang, Name, length(As)) of + true -> St1; + false -> return_match(Rt, 1, St1) + end; expr(#c_call{module=M,name=N,args=As}, Def, _Rt, St0) -> St1 = expr(M, Def, 1, St0), St2 = expr(N, Def, 1, St1), expr_list(As, Def, St2); -expr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) -> - expr_list(As, Def, St0); +expr(#c_primop{name=#c_literal{val=A},args=As}, Def, Rt, St0) when is_atom(A) -> + St1 = expr_list(As, Def, St0), + case A of + match_fail -> St1; + _ -> return_match(Rt, 1, St1) + end; expr(#c_catch{body=B}, Def, Rt, St) -> return_match(Rt, 1, body(B, Def, 1, St)); expr(#c_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Def, Rt, St0) -> diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index 83412ecdd7..03801a9b6d 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -125,8 +125,8 @@ format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) -> _ -> assoc end, Cpairs = [#c_map_pair{op=#c_literal{val=Op}, - key=#c_literal{val=V}, - val=#c_literal{val=K}} || {K,V} <- Pairs], + key=#c_literal{val=K}, + val=#c_literal{val=V}} || {K,V} <- Pairs], format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt); format_1(#c_var{name={I,A}}, _) -> [core_atom(I),$/,integer_to_list(A)]; diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index ce40213bad..82817a987a 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -2248,23 +2248,23 @@ letify(#c_var{name=Vname}=Var, Val, Body) -> %% opt_case_in_let(LetExpr) -> LetExpr' -opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) -> - opt_case_in_let_0(Vs, Arg, B, Let). +opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> + opt_case_in_let_0(Vs, Arg, B, Let, Sub). opt_case_in_let_0([#c_var{name=V}], Arg, - #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let) -> + #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) -> case opt_case_in_let_1(V, Arg, Cs) of impossible -> case is_simple_case_arg(Arg) andalso not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of true -> - expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new()); + expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub)); false -> Let end; Expr -> Expr end; -opt_case_in_let_0(_, _, _, Let) -> Let. +opt_case_in_let_0(_, _, _, Let, _) -> Let. opt_case_in_let_1(V, Arg, Cs) -> try @@ -2607,7 +2607,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body0, effect, Sub) -> expr(#c_seq{arg=Arg,body=Body}, effect, sub_new_preserve_types(Sub)); true -> Let = Let0#c_let{vars=Vs,arg=Arg,body=Body}, - opt_case_in_let_arg(opt_case_in_let(Let), effect, Sub) + opt_case_in_let_arg(opt_case_in_let(Let, Sub), effect, Sub) end end; opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> @@ -2630,7 +2630,7 @@ opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub)); {Vs,Arg,Body} -> opt_case_in_let_arg( - opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}), + opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}, Sub), value, Sub) end. diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 761ae8409c..f99307c865 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The 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,12 +33,15 @@ -include("../include/erl_bits.hrl"). +-type fa() :: {atom(), arity()}. + -record(expand, {module=[], %Module name exports=[], %Exports imports=[], %Imports compile=[], %Compile flags attributes=[], %Attributes callbacks=[], %Callbacks + optional_callbacks=[] :: [fa()], %Optional callbacks defined, %Defined functions (gb_set) vcount=0, %Variable counter func=[], %Current function @@ -99,7 +102,21 @@ define_functions(Forms, #expand{defined=Predef}=St) -> module_attrs(#expand{attributes=Attributes}=St) -> Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes], Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs], - {Attrs,St#expand{callbacks=Callbacks}}. + OptionalCallbacks = get_optional_callbacks(Attrs), + {Attrs,St#expand{callbacks=Callbacks, + optional_callbacks=OptionalCallbacks}}. + +get_optional_callbacks(Attrs) -> + L = [O || + {attribute, _, optional_callbacks, O} <- Attrs, + is_fa_list(O)], + lists:append(L). + +is_fa_list([{FuncName, Arity}|L]) + when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> + is_fa_list(L); +is_fa_list([]) -> true; +is_fa_list(_) -> false. module_predef_funcs(St) -> {Mpf1,St1}=module_predef_func_beh_info(St), @@ -108,19 +125,24 @@ module_predef_funcs(St) -> module_predef_func_beh_info(#expand{callbacks=[]}=St) -> {[], St}; -module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined, +module_predef_func_beh_info(#expand{callbacks=Callbacks, + optional_callbacks=OptionalCallbacks, + defined=Defined, exports=Exports}=St) -> PreDef=[{behaviour_info,1}], PreExp=PreDef, - {[gen_beh_info(Callbacks)], + {[gen_beh_info(Callbacks, OptionalCallbacks)], St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined), exports=union(from_list(PreExp), Exports)}}. -gen_beh_info(Callbacks) -> +gen_beh_info(Callbacks, OptionalCallbacks) -> List = make_list(Callbacks), + OptionalList = make_optional_list(OptionalCallbacks), {function,0,behaviour_info,1, [{clause,0,[{atom,0,callbacks}],[], - [List]}]}. + [List]}, + {clause,0,[{atom,0,optional_callbacks}],[], + [OptionalList]}]}. make_list([]) -> {nil,0}; make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> @@ -130,6 +152,14 @@ make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> {integer,0,Arity}]}, make_list(Rest)}. +make_optional_list([]) -> {nil,0}; +make_optional_list([{Name,Arity}|Rest]) -> + {cons,0, + {tuple,0, + [{atom,0,Name}, + {integer,0,Arity}]}, + make_optional_list(Rest)}. + module_predef_funcs_mod_info(St) -> PreDef = [{module_info,0},{module_info,1}], PreExp = PreDef, @@ -232,9 +262,18 @@ pattern({map,Line,Ps}, St0) -> {TPs,St1} = pattern_list(Ps, St0), {{map,Line,TPs},St1}; pattern({map_field_exact,Line,K0,V0}, St0) -> - {K,St1} = expr(K0, St0), + %% Key should be treated as an expression + %% but since expressions are not allowed yet, + %% process it through pattern .. and handle assoc + %% (normalise unary op integer -> integer) + {K,St1} = pattern(K0, St0), {V,St2} = pattern(V0, St1), {{map_field_exact,Line,K,V},St2}; +pattern({map_field_assoc,Line,K0,V0}, St0) -> + %% when keys are Maps + {K,St1} = pattern(K0, St0), + {V,St2} = pattern(V0, St1), + {{map_field_assoc,Line,K,V},St2}; %%pattern({struct,Line,Tag,Ps}, St0) -> %% {TPs,TPsvs,St1} = pattern_list(Ps, St0), %% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1}; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 47a357c23d..8c1a0c08ac 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -210,7 +210,7 @@ need_heap_0([], H, Acc) -> need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H) -> {need_heap_need(I, H),0}; -need_heap_1(#l{ke={set,_,{map,_,_}},i=I}, H) -> +need_heap_1(#l{ke={set,_,{map,_,_,_}},i=I}, H) -> {need_heap_need(I, H),0}; need_heap_1(#l{ke={set,_,Val}}, H) -> %% Just pass through adding to needed heap. @@ -643,10 +643,6 @@ select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> [{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis]; select_val_cg(tuple, R, Vls, Tf, Vf, Sis) -> [{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis]; -select_val_cg(map, R, [_Val,{f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> - [{test,is_map,{f,Fail},[R]}|Sis]; -select_val_cg(map, R, [_Val,{f,Lbl}|_], Tf, _Vf, [{label,Lbl}|Sis]) -> - [{test,is_map,{f,Tf},[R]}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> [{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> @@ -947,27 +943,34 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> %% Assume keys are term-sorted Rsrc = fetch_var(Src, Bef), - {{HasKs,GetVs},Aft} = lists:foldr(fun - ({map_pair,Key,{var,V}},{{HasKsi,GetVsi},Int0}) -> + {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = lists:foldr(fun + ({map_pair,{var,K},{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> case vdb_find(V, Vdb) of {V,_,L} when L =< I -> - {{[Key|HasKsi],GetVsi},Int0}; + RK = fetch_var(K,Int0), + {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0}; _Other -> Reg1 = put_reg(V, Int0#sr.reg), Int1 = Int0#sr{reg=Reg1}, - {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi]},Int1} + RK = fetch_var(K,Int0), + RV = fetch_reg(V,Reg1), + {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1} + end; + ({map_pair,Key,{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> + case vdb_find(V, Vdb) of + {V,_,L} when L =< I -> + {{[Key|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0}; + _Other -> + Reg1 = put_reg(V, Int0#sr.reg), + Int1 = Int0#sr{reg=Reg1}, + {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi],HasVarVsi,GetVarVsi},Int1} end - end, {{[],[]},Bef}, Vs), - - Code = case {HasKs,GetVs} of - {HasKs,[]} -> - [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}]; - {[],GetVs} -> - [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}}]; - {HasKs,GetVs} -> - [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}, - {get_map_elements, {f,Fail},Rsrc,{list,GetVs}}] - end, + end, {{[],[],[],[]},Bef}, Vs), + + Code = [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}} || HasKs =/= []] ++ + [{test,has_map_fields,{f,Fail},Rsrc,{list,[K]}} || K <- HasVarKs] ++ + [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}} || GetVs =/= []] ++ + [{get_map_elements, {f,Fail},Rsrc,{list,[K,V]}} || [K,V] <- GetVarVs], {Code, Aft, St}. @@ -1504,9 +1507,39 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, %% Now generate the complete code for constructing the binary. Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a), {Sis++Code,Aft,St}; +% Map single variable key +set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, + #cg{in_catch=InCatch,bfail=Bfail}=St) -> + + Fail = {f,Bfail}, + {Sis,Int0} = + case InCatch of + true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); + false -> {[],Bef} + end, + SrcReg = cg_reg_arg(Map,Int0), + Line = line(Le#l.a), + + List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)], + + Live = max_reg(Bef#sr.reg), + Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, + Aft = clear_dead(Int1, Le#l.i, Vdb), + Target = fetch_reg(R, Int1#sr.reg), + + I = case Op of + assoc -> put_map_assoc; + exact -> put_map_exact + end, + {Sis++[Line]++[{I,Fail,SrcReg,Target,Live,{list,List}}],Aft,St}; + +% Map (possibly) multiple literal keys set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, #cg{in_catch=InCatch,bfail=Bfail}=St) -> + %% assert key literals + [] = [Var||{map_pair,{var,_}=Var,_} <- Es], + Fail = {f,Bfail}, {Sis,Int0} = case InCatch of diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 83cf76f241..3d9fc3a609 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -78,7 +78,7 @@ -import(ordsets, [add_element/2,del_element/2,is_element/2, union/1,union/2,intersection/2,subtract/2]). -import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1, - ann_c_map/2, ann_c_map/3]). + ann_c_map/3]). -include("core_parse.hrl"). @@ -169,60 +169,81 @@ form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) -> attribute({attribute,Line,Name,Val}) -> {#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}. +%% function_dump(module_info,_,_,_) -> ok; +%% function_dump(Name,Arity,Format,Terms) -> +%% io:format("~w/~w " ++ Format,[Name,Arity]++Terms), +%% ok. + function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) -> - %%ok = io:fwrite("~p - ", [{Name,Arity}]), St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]}, {B0,St1} = body(Cs0, Name, Arity, St0), - %%ok = io:fwrite("1", []), - %%ok = io:fwrite("~w:~p~n", [?LINE,B0]), + %% ok = function_dump(Name,Arity,"body:~n~p~n",[B0]), {B1,St2} = ubody(B0, St1), - %%ok = io:fwrite("2", []), - %%ok = io:fwrite("~w:~p~n", [?LINE,B1]), + %% ok = function_dump(Name,Arity,"ubody:~n~p~n",[B1]), {B2,#core{ws=Ws}} = cbody(B1, St2), - %%ok = io:fwrite("3~n", []), - %%ok = io:fwrite("~w:~p~n", [?LINE,B2]), + %% ok = function_dump(Name,Arity,"cbody:~n~p~n",[B2]), {{#c_var{name={Name,Arity}},B2},Ws}. body(Cs0, Name, Arity, St0) -> Anno = lineno_anno(element(2, hd(Cs0)), St0), {Args,St1} = new_vars(Anno, Arity, St0), - {Cs1,St2} = clauses(Cs0, St1), - {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = function_clause(Ps, Anno, {Name,Arity}), - {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}. + case clauses(Cs0, St1) of + {Cs1,[],St2} -> + {Ps,St3} = new_vars(Arity, St2), %Need new variables here + Fc = function_clause(Ps, Anno, {Name,Arity}), + {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}; + {Cs1,Eps,St2} -> + %% We have pre-expressions from patterns and + %% these needs to be letified before matching + %% since only bound variables are allowed + AnnoGen = #a{anno=[compiler_generated]}, + {Ps1,St3} = new_vars(Arity, St2), %Need new variables here + Fc1 = function_clause(Ps1, Anno, {Name,Arity}), + {Ps2,St4} = new_vars(Arity, St3), %Need new variables here + Fc2 = function_clause(Ps2, Anno, {Name,Arity}), + Case = #icase{anno=AnnoGen,args=Args, + clauses=Cs1, + fc=Fc2}, + {#ifun{anno=#a{anno=Anno},id=[],vars=Args, + clauses=[#iclause{anno=AnnoGen,pats=Ps1, + guard=[#c_literal{val=true}], + body=Eps ++ [Case]}], + fc=Fc1},St4} + end. %% clause(Clause, State) -> {Cclause,State} | noclause. %% clauses([Clause], State) -> {[Cclause],State}. %% Convert clauses. Trap bad pattern aliases and remove clause from %% clause list. -clauses([C0|Cs0], St0) -> +clauses([C0|Cs0],St0) -> case clause(C0, St0) of - {noclause,St} -> clauses(Cs0, St); - {C,St1} -> - {Cs,St2} = clauses(Cs0, St1), - {[C|Cs],St2} + {noclause,_,St} -> clauses(Cs0,St); + {C,Eps1,St1} -> + {Cs,Eps2,St2} = clauses(Cs0, St1), + {[C|Cs],Eps1++Eps2,St2} end; -clauses([], St) -> {[],St}. +clauses([],St) -> {[],[],St}. clause({clause,Lc,H0,G0,B0}, St0) -> try head(H0, St0) of - H1 -> - {G1,St1} = guard(G0, St0), - {B1,St2} = exprs(B0, St1), - Anno = lineno_anno(Lc, St2), - {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},St2} + {H1,Eps,St1} -> + {G1,St2} = guard(G0, St1), + {B1,St3} = exprs(B0, St2), + Anno = lineno_anno(Lc, St3), + {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},Eps,St3} catch throw:nomatch -> St = add_warning(Lc, nomatch, St0), - {noclause,St} %Bad pattern + {noclause,[],St} %Bad pattern end. clause_arity({clause,_,H0,_,_}) -> length(H0). -%% head([P], State) -> [P]. +%% head([P], State) -> {[P],[Cexpr],State}. -head(Ps, St) -> pattern_list(Ps, St). +head(Ps, St) -> + pattern_list(Ps, St). %% guard([Expr], State) -> {[Cexpr],State}. %% Build an explict and/or tree of guard alternatives, then traverse @@ -514,22 +535,7 @@ expr({tuple,L,Es0}, St0) -> A = record_anno(L, St1), {annotate_tuple(A, Es1, St1),Eps,St1}; expr({map,L,Es0}, St0) -> - % erl_lint should make sure only #{ K => V } are allowed - % in map construction. - try map_pair_list(Es0, St0) of - {Es1,Eps,St1} -> - A = lineno_anno(L, St1), - {ann_c_map(A,Es1),Eps,St1} - catch - throw:{bad_map,Warning} -> - St = add_warning(L, Warning, St0), - LineAnno = lineno_anno(L, St), - As = [#c_literal{anno=LineAnno,val=badarg}], - {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} - module=#c_literal{anno=LineAnno,val=erlang}, - name=#c_literal{anno=LineAnno,val=error}, - args=As},[],St} - end; + map_build_pair_chain(#c_literal{val=#{}},Es0,lineno_anno(L,St0),St0); expr({map,L,M0,Es0}, St0) -> try expr_map(M0,Es0,lineno_anno(L, St0),St0) of {_,_,_}=Res -> Res @@ -562,26 +568,26 @@ expr({block,_,Es0}, St0) -> {E1,Eps,St2} = expr(last(Es0), St1), {E1,Es1 ++ Eps,St2}; expr({'if',L,Cs0}, St0) -> - {Cs1,St1} = clauses(Cs0, St0), + {Cs1,Ceps,St1} = clauses(Cs0, St0), Lanno = lineno_anno(L, St1), Fc = fail_clause([], Lanno, #c_literal{val=if_clause}), - {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1}; + {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},Ceps,St1}; expr({'case',L,E0,Cs0}, St0) -> {E1,Eps,St1} = novars(E0, St0), - {Cs1,St2} = clauses(Cs0, St1), + {Cs1,Ceps,St2} = clauses(Cs0, St1), {Fpat,St3} = new_var(St2), Lanno = lineno_anno(L, St2), Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])), - {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3}; + {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps++Ceps,St3}; expr({'receive',L,Cs0}, St0) -> - {Cs1,St1} = clauses(Cs0, St0), - {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1}, [], St1}; + {Cs1,Ceps,St1} = clauses(Cs0, St0), + {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1},Ceps, St1}; expr({'receive',L,Cs0,Te0,Tes0}, St0) -> {Te1,Teps,St1} = novars(Te0, St0), {Tes1,St2} = exprs(Tes0, St1), - {Cs1,St3} = clauses(Cs0, St2), + {Cs1,Ceps,St3} = clauses(Cs0, St2), {#ireceive2{anno=#a{anno=lineno_anno(L, St3)}, - clauses=Cs1,timeout=Te1,action=Tes1},Teps,St3}; + clauses=Cs1,timeout=Te1,action=Tes1},Teps++Ceps,St3}; expr({'try',L,Es0,[],Ecs,[]}, St0) -> %% 'try ... catch ... end' {Es1,St1} = exprs(Es0, St0), @@ -595,7 +601,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> %% 'try ... of ... catch ... end' {Es1,St1} = exprs(Es0, St0), {V,St2} = new_var(St1), %This name should be arbitrary - {Cs1,St3} = clauses(Cs0, St2), + {Cs1,Ceps,St3} = clauses(Cs0, St2), {Fpat,St4} = new_var(St3), Lanno = lineno_anno(L, St4), Fc = fail_clause([Fpat], Lanno, @@ -604,7 +610,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> {#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1, vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}], evars=Evs,handler=Hs}, - [],St5}; + Ceps,St5}; expr({'try',L,Es0,[],[],As0}, St0) -> %% 'try ... after ... end' {Es1,St1} = exprs(Es0, St0), @@ -673,24 +679,24 @@ expr({match,L,P0,E0}, St0) -> {var,_,'_'} -> St0#core{wanted=false}; _ -> St0 end, - {E2,Eps,St2} = novars(E1, St1), + {E2,Eps1,St2} = novars(E1, St1), St3 = St2#core{wanted=St0#core.wanted}, - P2 = try - pattern(P1, St3) + {P2,Eps2,St4} = try + pattern(P1, St3) catch throw:Thrown -> - Thrown + {Thrown,[],St3} end, - {Fpat,St4} = new_var(St3), - Lanno = lineno_anno(L, St4), + {Fpat,St5} = new_var(St4), + Lanno = lineno_anno(L, St5), Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])), case P2 of nomatch -> - St = add_warning(L, nomatch, St4), + St = add_warning(L, nomatch, St5), {#icase{anno=#a{anno=Lanno}, - args=[E2],clauses=[],fc=Fc},Eps,St}; + args=[E2],clauses=[],fc=Fc},Eps1++Eps2,St}; Other when not is_atom(Other) -> - {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4} + {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5} end; expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> %% Optimise '++' here because of the list comprehension algorithm. @@ -772,44 +778,77 @@ expr_map(M0,Es0,A,St0) -> Fc = fail_clause([Fpat], A, #c_literal{val=badarg}), {#icase{anno=#a{anno=A},args=[M1],clauses=Cs,fc=Fc},Mps,St3}; {_,_} -> - {Es1,Eps,St2} = map_pair_list(Es0, St1), - {ann_c_map(A,M1,Es1),Mps++Eps,St2} + {M2,Eps,St2} = map_build_pair_chain(M1,Es0,A,St1), + {M2,Mps++Eps,St2} end; false -> throw({bad_map,bad_map}) end. +%% Group continuous literal blocks and single variables, i.e. +%% M0#{ a := 1, b := V1, K1 := V2, K2 := 42} +%% becomes equivalent to +%% M1 = M0#{ a := 1, b := V1 }, +%% M2 = M1#{ K1 := V1 }, +%% M3 = M2#{ K2 := 42 } + +map_build_pair_chain(M,Es,A,St) -> + %% hack, remove iset if only literal + case map_build_pair_chain(M,Es,A,St,[]) of + {_,[#iset{arg=#c_literal{}=Val}],St1} -> {Val,[],St1}; + Normal -> Normal + end. + +map_build_pair_chain(M0,[],_,St,Mps) -> + {M0,Mps,St}; +map_build_pair_chain(M0,Es0,A,St0,Mps) -> + % group continuous literal blocks + % Anno = #a{anno=[compiler_generated]}, + % order is important, we need to reverse the literals + case map_pair_block(Es0,[],[],St0) of + {{CesL,EspL},{[],[]},Es1,St1} -> + {MVar,St2} = new_var(St1), + Pre = [#iset{var=MVar, arg=ann_c_map(A,M0,reverse(CesL))}], + map_build_pair_chain(MVar,Es1,A,St2,Mps++EspL++Pre); + {{[],[]},{CesV,EspV},Es1,St1} -> + {MVar,St2} = new_var(St1), + Pre = [#iset{var=MVar, arg=#c_map{arg=M0,es=CesV, anno=A}}], + map_build_pair_chain(MVar,Es1,A,St2,Mps ++ EspV++Pre); + {{CesL,EspL},{CesV,EspV},Es1,St1} -> + {MVarL,St2} = new_var(St1), + {MVarV,St3} = new_var(St2), + Pre = [#iset{var=MVarL, arg=ann_c_map(A,M0,reverse(CesL))}, + #iset{var=MVarV, arg=#c_map{arg=MVarL,es=CesV,anno=A}}], + map_build_pair_chain(MVarV,Es1,A,St3,Mps++EspL++EspV++Pre) + end. + +map_pair_block([{Op,L,K0,V0}|Es],Ces,Esp,St0) -> + {K,Ep0,St1} = safe(K0, St0), + {V,Ep1,St2} = safe(V0, St1), + A = lineno_anno(L, St2), + Pair0 = map_op_to_c_map_pair(Op), + Pair1 = Pair0#c_map_pair{anno=A,key=K,val=V}, + case cerl:is_literal(K) of + true -> + map_pair_block(Es,[Pair1|Ces],Ep0 ++ Ep1 ++ Esp,St2); + false -> + {{Ces,Esp},{[Pair1],Ep0++Ep1},Es,St2} + end; +map_pair_block([],Ces,Esp,St) -> + {{Ces,Esp},{[],[]},[],St}. + +map_op_to_c_map_pair(map_field_assoc) -> #c_map_pair{op=#c_literal{val=assoc}}; +map_op_to_c_map_pair(map_field_exact) -> #c_map_pair{op=#c_literal{val=exact}}. + is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true; -is_valid_map_src(#c_map{}) -> true; is_valid_map_src(#c_var{}) -> true; is_valid_map_src(_) -> false. -map_pair_list(Es, St) -> - foldr(fun - ({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) -> - {K,Ep0,St1} = safe(K0, St0), - ok = ensure_valid_map_key(K), - {V,Ep1,St2} = safe(V0, St1), - A = lineno_anno(L, St2), - Pair = #c_map_pair{op=#c_literal{val=assoc},anno=A,key=K,val=V}, - {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2}; - ({map_field_exact,L,K0,V0}, {Ces,Esp,St0}) -> - {K,Ep0,St1} = safe(K0, St0), - ok = ensure_valid_map_key(K), - {V,Ep1,St2} = safe(V0, St1), - A = lineno_anno(L, St2), - Pair = #c_map_pair{op=#c_literal{val=exact},anno=A,key=K,val=V}, - {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2} - end, {[],[],St}, Es). - -ensure_valid_map_key(#c_literal{}) -> ok; -ensure_valid_map_key(_) -> throw({bad_map,bad_map_key}). - %% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}. try_exception(Ecs0, St0) -> %% Note that Tag is not needed for rethrow - it is already in Info. {Evs,St1} = new_vars(3, St0), % Tag, Value, Info - {Ecs1,St2} = clauses(Ecs0, St1), + {Ecs1,Ceps,St2} = clauses(Ecs0, St1), [_,Value,Info] = Evs, Ec = #iclause{anno=#a{anno=[compiler_generated]}, pats=[c_tuple(Evs)],guard=[#c_literal{val=true}], @@ -817,15 +856,15 @@ try_exception(Ecs0, St0) -> name=#c_literal{val=raise}, args=[Info,Value]}]}, Hs = [#icase{anno=#a{},args=[c_tuple(Evs)],clauses=Ecs1,fc=Ec}], - {Evs,Hs,St2}. + {Evs,Ceps++Hs,St2}. try_after(As, St0) -> %% See above. - {Evs,St1} = new_vars(3, St0), % Tag, Value, Info + {Evs,St1} = new_vars(3, St0), % Tag, Value, Info [_,Value,Info] = Evs, - B = As ++ [#iprimop{anno=#a{}, %Must have an #a{} - name=#c_literal{val=raise}, - args=[Info,Value]}], + B = As ++ [#iprimop{anno=#a{}, % Must have an #a{} + name=#c_literal{val=raise}, + args=[Info,Value]}], Ec = #iclause{anno=#a{anno=[compiler_generated]}, pats=[c_tuple(Evs)],guard=[#c_literal{val=true}], body=B}, @@ -959,7 +998,7 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> Arity = clause_arity(hd(Cs0)), - {Cs1,St1} = clauses(Cs0, St0), + {Cs1,Ceps,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here Anno = lineno_anno(L, St3), @@ -967,7 +1006,7 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! vars=Args,clauses=Cs1,fc=Fc,name=NameInfo}, - {Fun,[],St3}. + {Fun,Ceps,St3}. %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. %% This TQ from Simon PJ pp 127-138. @@ -1181,7 +1220,7 @@ is_generator(_) -> false. generator(Line, {generate,Lg,P0,E}, Gs, St0) -> LA = lineno_anno(Line, St0), GA = lineno_anno(Lg, St0), - {Head,St1} = list_gen_pattern(P0, Line, St0), + {Head,Ceps,St1} = list_gen_pattern(P0, Line, St0), {[Tail,Skip],St2} = new_vars(2, St1), {Cg,St3} = lc_guard_tests(Gs, St2), {AccPat,SkipPat} = case Head of @@ -1202,24 +1241,25 @@ generator(Line, {generate,Lg,P0,E}, Gs, St0) -> end, {Ce,Pre,St4} = safe(E, St3), Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, - tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Pre,Ce}}, + tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Ceps++Pre,Ce}}, {Gen,St4}; generator(Line, {b_generate,Lg,P,E}, Gs, St0) -> LA = lineno_anno(Line, St0), GA = lineno_anno(Lg, St0), - Cp = #c_binary{segments=Segs} = pattern(P, St0), + {Cp = #c_binary{segments=Segs},[],St1} = pattern(P, St0), + %% The function append_tail_segment/2 keeps variable patterns as-is, making %% it possible to have the same skip clause removal as with list generators. - {AccSegs,Tail,TailSeg,St1} = append_tail_segment(Segs, St0), + {AccSegs,Tail,TailSeg,St2} = append_tail_segment(Segs, St1), AccPat = Cp#c_binary{segments=AccSegs}, - {Cg,St2} = lc_guard_tests(Gs, St1), - {SkipSegs,St3} = emasculate_segments(AccSegs, St2), + {Cg,St3} = lc_guard_tests(Gs, St2), + {SkipSegs,St4} = emasculate_segments(AccSegs, St3), SkipPat = Cp#c_binary{segments=SkipSegs}, - {Ce,Pre,St4} = safe(E, St3), + {Ce,Pre,St5} = safe(E, St4), Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, tail=Tail,tail_pat=#c_binary{anno=LA,segments=[TailSeg]}, arg={Pre,Ce}}, - {Gen,St4}. + {Gen,St5}. append_tail_segment(Segs, St0) -> {Var,St} = new_var(St0), @@ -1248,9 +1288,9 @@ lc_guard_tests(Gs0, St0) -> list_gen_pattern(P0, Line, St) -> try - {pattern(P0, St),St} + pattern(P0,St) catch - nomatch -> {nomatch,add_warning(Line, nomatch, St)} + nomatch -> {nomatch,[],add_warning(Line, nomatch, St)} end. %%% @@ -1473,6 +1513,18 @@ force_novars(#ibinary{}=Bin, St) -> {Bin,[],St}; force_novars(Ce, St) -> force_safe(Ce, St). + +%% safe_pattern_expr(Expr, State) -> {Cexpr,[PreExpr],State}. +%% only literals and variables are safe expressions in patterns +safe_pattern_expr(E,St0) -> + case safe(E,St0) of + {#c_var{},_,_}=Safe -> Safe; + {#c_literal{},_,_}=Safe -> Safe; + {Ce,Eps,St1} -> + {V,St2} = new_var(St1), + {V,Eps++[#iset{var=V,arg=Ce}],St2} + end. + %% safe(Expr, State) -> {Safe,[PreExpr],State}. %% Generate an internal safe expression. These are simples without %% binaries which can fail. At this level we do not need to do a @@ -1547,84 +1599,109 @@ fold_match({match,L,P0,E0}, P) -> {{match,L,P0,P1},E1}; fold_match(E, P) -> {P,E}. -%% pattern(Pattern, State) -> CorePat. +%% pattern(Pattern, State) -> {CorePat,[PreExp],State}. %% Transform a pattern by removing line numbers. We also normalise %% aliases in patterns to standard form, {alias,Pat,[Var]}. - -pattern({var,L,V}, St) -> #c_var{anno=lineno_anno(L, St),name=V}; -pattern({char,L,C}, St) -> #c_literal{anno=lineno_anno(L, St),val=C}; -pattern({integer,L,I}, St) -> #c_literal{anno=lineno_anno(L, St),val=I}; -pattern({float,L,F}, St) -> #c_literal{anno=lineno_anno(L, St),val=F}; -pattern({atom,L,A}, St) -> #c_literal{anno=lineno_anno(L, St),val=A}; -pattern({string,L,S}, St) -> #c_literal{anno=lineno_anno(L, St),val=S}; -pattern({nil,L}, St) -> #c_literal{anno=lineno_anno(L, St),val=[]}; +%% +%% In patterns we may have expressions +%% 1) Binaries -> #c_bitstr{size=Expr} +%% 2) Maps -> #c_map_pair{key=Expr} +%% +%% Both of these may generate pre-expressions since only bound variables +%% or literals are allowed for these in core patterns. +%% +%% Therefor, we need to drag both the state and the collection of pre-expression +%% around in the whole pattern transformation tree. + +pattern({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},[],St}; +pattern({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},[],St}; +pattern({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},[],St}; +pattern({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},[],St}; +pattern({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},[],St}; +pattern({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},[],St}; +pattern({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},[],St}; pattern({cons,L,H,T}, St) -> - annotate_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St), St); + {Ph,Eps1,St1} = pattern(H, St), + {Pt,Eps2,St2} = pattern(T, St1), + {annotate_cons(lineno_anno(L, St), Ph, Pt, St2),Eps1++Eps2,St2}; pattern({tuple,L,Ps}, St) -> - annotate_tuple(record_anno(L, St), pattern_list(Ps, St), St); -pattern({map,L,Ps}, St) -> - #c_map{anno=lineno_anno(L, St), es=pattern_map_pairs(Ps, St)}; + {Ps1,Eps,St1} = pattern_list(Ps,St), + {annotate_tuple(record_anno(L, St), Ps1, St),Eps,St1}; +pattern({map,L,Pairs}, St0) -> + {Ps,Eps,St1} = pattern_map_pairs(Pairs, St0), + {#c_map{anno=lineno_anno(L, St1), es=Ps},Eps,St1}; pattern({bin,L,Ps}, St) -> %% We don't create a #ibinary record here, since there is %% no need to hold any used/new annotations in a pattern. - #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)}; + {#c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)},[],St}; pattern({match,_,P1,P2}, St) -> - pat_alias(pattern(P1, St), pattern(P2, St)). + {Cp1,Eps1,St1} = pattern(P1,St), + {Cp2,Eps2,St2} = pattern(P2,St1), + {pat_alias(Cp1,Cp2),Eps1++Eps2,St2}. %% pattern_map_pairs([MapFieldExact],State) -> [#c_map_pairs{}] pattern_map_pairs(Ps, St) -> - %% check literal key uniqueness (dict is needed) - %% pattern all pairs - {CMapPairs, Kdb} = lists:mapfoldl(fun - (P,Kdbi) -> - #c_map_pair{key=Ck,val=Cv} = CMapPair = pattern_map_pair(P,St), - K = core_lib:literal_value(Ck), - case dict:find(K,Kdbi) of - {ok, Vs} -> - {CMapPair, dict:store(K,[Cv|Vs],Kdbi)}; - _ -> - {CMapPair, dict:store(K,[Cv],Kdbi)} + %% check literal key uniqueness + %% - guaranteed via aliasing map pairs + %% pattern all pairs in two steps + %% 1) Construct Core Pattern + %% 2) Alias Keys in Core Pattern + {CMapPairs, {Eps,St1}} = lists:mapfoldl(fun + (P,{EpsM,Sti0}) -> + {CMapPair,EpsP,Sti1} = pattern_map_pair(P,Sti0), + {CMapPair, {EpsM++EpsP,Sti1}} + end, {[],St}, Ps), + {pat_alias_map_pairs(CMapPairs,[]),Eps,St1}. + +%% remove cluddering annotations +pattern_map_clean_key(#c_literal{val=V}) -> {literal,V}; +pattern_map_clean_key(#c_var{name=V}) -> {var,V}. + +pat_alias_map_pairs(Ps1,Ps2) -> + Ps = Ps1 ++ Ps2, + F = fun(#c_map_pair{key=Ck,val=Cv},Dbi) -> + K = pattern_map_clean_key(Ck), + case dict:find(K,Dbi) of + {ok,Cvs} -> dict:store(K,[Cv|Cvs],Dbi); + _ -> dict:store(K,[Cv],Dbi) end - end, dict:new(), Ps), - pattern_alias_map_pairs(CMapPairs,Kdb,dict:new(),St). - -pattern_alias_map_pairs([],_,_,_) -> []; -pattern_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Kset,St) -> - %% alias same keys if needed - K = core_lib:literal_value(Ck), - case dict:find(K,Kset) of - {ok,processed} -> - pattern_alias_map_pairs(Pairs,Kdb,Kset,St); - _ -> + end, + Kdb = lists:foldl(F,dict:new(),Ps), + pat_alias_map_pairs(Ps,Kdb,sets:new()). + +pat_alias_map_pairs([],_,_) -> []; +pat_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Set) -> + K = pattern_map_clean_key(Ck), + case sets:is_element(K,Set) of + true -> + pat_alias_map_pairs(Pairs,Kdb,Set); + false -> Cvs = dict:fetch(K,Kdb), - Cv = pattern_alias_map_pair_patterns(Cvs), - Kset1 = dict:store(K, processed, Kset), - [Pair#c_map_pair{val=Cv}|pattern_alias_map_pairs(Pairs,Kdb,Kset1,St)] + Cv = pat_alias_map_pair_values(Cvs), + Set1 = sets:add_element(K,Set), + [Pair#c_map_pair{val=Cv}|pat_alias_map_pairs(Pairs,Kdb,Set1)] end. -pattern_alias_map_pair_patterns([Cv]) -> Cv; -pattern_alias_map_pair_patterns([Cv1,Cv2|Cvs]) -> - pattern_alias_map_pair_patterns([pat_alias(Cv1,Cv2)|Cvs]). - -pattern_map_pair({map_field_exact,L,K,V}, St) -> - case expr(K,St) of - {#c_literal{}=Key,_,_} -> - #c_map_pair{anno=lineno_anno(L, St), - op=#c_literal{val=exact}, - key=Key, - val=pattern(V, St)}; - _ -> - %% this will throw a cryptic error message - %% but it is better than nothing - throw(nomatch) - end. +pat_alias_map_pair_values([Cv]) -> Cv; +pat_alias_map_pair_values([Cv1,Cv2|Cvs]) -> + pat_alias_map_pair_values([pat_alias(Cv1,Cv2)|Cvs]). + +pattern_map_pair({map_field_exact,L,K,V}, St0) -> + {Ck,EpsK,St1} = safe_pattern_expr(K,St0), + {Cv,EpsV,St2} = pattern(V, St1), + {#c_map_pair{anno=lineno_anno(L,St2), + op=#c_literal{val=exact}, + key=Ck, + val=Cv},EpsK++EpsV,St2}. %% pat_bin([BinElement], State) -> [BinSeg]. pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps]. -pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}, St) -> - #c_bitstr{val=pattern(Term, St),size=pattern(Size, St), +pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) -> + {Pval,[],St1} = pattern(Val,St), + {Psize,[],_St2} = pattern(Size,St1), + #c_bitstr{val=Pval,size=Psize, unit=#c_literal{val=Unit}, type=#c_literal{val=Type}, flags=#c_literal{val=Flags}}. @@ -1634,6 +1711,8 @@ pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}, St) -> pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2}; pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1}; + +%% alias cons pat_alias(#c_cons{}=Cons, #c_literal{anno=A,val=[H|T]}=S) -> pat_alias(Cons, ann_c_cons_skel(A, #c_literal{anno=A,val=H}, S#c_literal{val=T})); @@ -1642,6 +1721,8 @@ pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) -> S#c_literal{val=T}), Cons); pat_alias(#c_cons{anno=Anno,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) -> ann_c_cons(Anno, pat_alias(H1, H2), pat_alias(T1, T2)); + +%% alias tuples pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_literal{val=T}) when is_tuple(T) -> Es2 = [#c_literal{val=E} || E <- tuple_to_list(T)], ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); @@ -1650,6 +1731,12 @@ pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(T) -> ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_tuple{es=Es2}) -> ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); + +%% alias maps +%% There are no literals in maps patterns (patterns are always abstract) +pat_alias(#c_map{es=Es1}=M,#c_map{es=Es2}) -> + M#c_map{es=pat_alias_map_pairs(Es1,Es2)}; + pat_alias(#c_alias{var=V1,pat=P1}, #c_alias{var=V2,pat=P2}) -> if V1 =:= V2 -> #c_alias{var=V1,pat=pat_alias(P1, P2)}; @@ -1672,9 +1759,15 @@ pat_alias_list([A1|A1s], [A2|A2s]) -> pat_alias_list([], []) -> []; pat_alias_list(_, _) -> throw(nomatch). -%% pattern_list([P], State) -> [P]. +%% pattern_list([P], State) -> {[P],Exprs,St} + +pattern_list([P0|Ps0], St0) -> + {P1,Eps,St1} = pattern(P0, St0), + {Ps1,Epsl,St2} = pattern_list(Ps0, St1), + {[P1|Ps1], Eps ++ Epsl, St2}; +pattern_list([], St) -> + {[],[],St}. -pattern_list(Ps, St) -> [pattern(P, St) || P <- Ps]. %% make_vars([Name]) -> [{Var,Name}]. @@ -1974,9 +2067,14 @@ upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) -> upattern(#c_map{es=Es0}=Map, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0), {Map#c_map{es=Es1},Esg,Esv,Eus,St1}; -upattern(#c_map_pair{op=#c_literal{val=exact},val=V0}=MapPair, Ks, St0) -> - {V,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0), - {MapPair#c_map_pair{val=V},Vg,Vv,Vu,St1}; +upattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,Ks,St0) -> + {V,Vg,Vn,Vu,St1} = upattern(V0, Ks, St0), + % A variable key must be considered used here + Ku = case K0 of + #c_var{name=Name} -> [Name]; + _ -> [] + end, + {Pair#c_map_pair{val=V},Vg,Vn,union(Ku,Vu),St1}; upattern(#c_binary{segments=Es0}=Bin, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0), {Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1}; @@ -2347,8 +2445,6 @@ format_error(nomatch) -> "pattern cannot possibly match"; format_error(bad_binary) -> "binary construction will fail because of a type mismatch"; -format_error(bad_map_key) -> - "map construction will fail because of none literal key (large binaries are not literals)"; format_error(bad_map) -> "map construction will fail because of a type mismatch". diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 40d2f72b4c..6504351c02 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -527,9 +527,9 @@ map_split_pairs(A, Var, Ces, Sub, St0) -> Pairs0 = [{Op,K,V} || #c_map_pair{op=#c_literal{val=Op},key=K,val=V} <- Ces], {Pairs,Esp,St1} = foldr(fun ({Op,K0,V0}, {Ops,Espi,Sti0}) when Op =:= assoc; Op =:= exact -> - {K,[],Sti1} = expr(K0, Sub, Sti0), - {V,Ep,Sti2} = atomic(V0, Sub, Sti1), - {[{Op,K,V}|Ops],Ep ++ Espi,Sti2} + {K,Eps1,Sti1} = atomic(K0, Sub, Sti0), + {V,Eps2,Sti2} = atomic(V0, Sub, Sti1), + {[{Op,K,V}|Ops],Eps1 ++ Eps2 ++ Espi,Sti2} end, {[],[],St0}, Pairs0), case map_group_pairs(Pairs) of @@ -577,11 +577,12 @@ map_key_is_used(K,Used) -> dict:find(map_key_clean(K),Used). %% Be explicit instead of using set_kanno(K,[]) -map_key_clean(#k_literal{val=V}) -> {k_literal,V}; -map_key_clean(#k_int{val=V}) -> {k_int,V}; -map_key_clean(#k_float{val=V}) -> {k_float,V}; -map_key_clean(#k_atom{val=V}) -> {k_atom,V}; -map_key_clean(#k_nil{}) -> k_nil. +map_key_clean(#k_var{name=V}) -> {var,V}; +map_key_clean(#k_literal{val=V}) -> {lit,V}; +map_key_clean(#k_int{val=V}) -> {lit,V}; +map_key_clean(#k_float{val=V}) -> {lit,V}; +map_key_clean(#k_atom{val=V}) -> {lit,V}; +map_key_clean(#k_nil{}) -> {lit,[]}. %% call_type(Module, Function, Arity) -> call | bif | apply | error. @@ -757,23 +758,22 @@ flatten_alias(#c_alias{var=V,pat=P}) -> flatten_alias(Pat) -> {[],Pat}. pattern_map_pairs(Ces0, Isub, Osub0, St0) -> - %% It is assumed that all core keys are literals - %% It is later assumed that these keys are term sorted - %% so we need to sort them here - Ces1 = lists:sort(fun - (#c_map_pair{key=CkA},#c_map_pair{key=CkB}) -> - A = core_lib:literal_value(CkA), - B = core_lib:literal_value(CkB), - erts_internal:cmp_term(A,B) < 0 - end, Ces0), %% pattern the pair keys and values as normal {Kes,{Osub1,St1}} = lists:mapfoldl(fun (#c_map_pair{anno=A,key=Ck,val=Cv},{Osubi0,Sti0}) -> - {Kk,Osubi1,Sti1} = pattern(Ck, Isub, Osubi0, Sti0), - {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi1, Sti1), + {Kk,[],Sti1} = expr(Ck, Isub, Sti0), + {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi0, Sti1), {#k_map_pair{anno=A,key=Kk,val=Kv},{Osubi2,Sti2}} - end, {Osub0, St0}, Ces1), - {Kes,Osub1,St1}. + end, {Osub0, St0}, Ces0), + %% It is later assumed that these keys are term sorted + %% so we need to sort them here + Kes1 = lists:sort(fun + (#k_map_pair{key=KkA},#k_map_pair{key=KkB}) -> + A = map_key_clean(KkA), + B = map_key_clean(KkB), + erts_internal:cmp_term(A,B) < 0 + end, Kes), + {Kes1,Osub1,St1}. pattern_bin(Es, Isub, Osub0, St0) -> {Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0), @@ -1550,13 +1550,11 @@ arg_val(Arg, C) -> {set_kanno(S, []),U,T,Fs} end; #k_map{op=exact,es=Es} -> - Keys = [begin - #k_map_pair{key=#k_literal{val=Key}} = Pair, - Key - end || Pair <- Es], - %% multiple keys may have the same name - %% do not use ordsets - lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Keys) + lists:sort(fun(A,B) -> + %% on the form K :: {'lit' | 'var', term()} + %% lit < var as intended + erts_internal:cmp_term(A,B) < 0 + end, [map_key_clean(Key) || #k_map_pair{key=Key} <- Es]) end. %% ubody_used_vars(Expr, State) -> [UsedVar] @@ -1943,6 +1941,7 @@ lit_list_vars(Ps) -> %% pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}. %% Return variables in a pattern. All variables are new variables %% except those in the size field of binary segments. +%% and map_pair keys pat_vars(#k_var{name=N}) -> {[],[N]}; %%pat_vars(#k_char{}) -> {[],[]}; @@ -1967,8 +1966,10 @@ pat_vars(#k_tuple{es=Es}) -> pat_list_vars(Es); pat_vars(#k_map{es=Es}) -> pat_list_vars(Es); -pat_vars(#k_map_pair{val=V}) -> - pat_vars(V). +pat_vars(#k_map_pair{key=K,val=V}) -> + {U1,New} = pat_vars(V), + {[], U2} = pat_vars(K), + {union(U1,U2),New}. pat_list_vars(Ps) -> foldl(fun (P, {Used0,New0}) -> diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index ab66445f73..b008285d9f 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -38,7 +38,7 @@ -record(k_nil, {anno=[]}). -record(k_tuple, {anno=[],es}). --record(k_map, {anno=[],var,op,es}). +-record(k_map, {anno=[],var=#k_literal{val=#{}},op,es}). -record(k_map_pair, {anno=[],key,val}). -record(k_cons, {anno=[],hd,tl}). -record(k_binary, {anno=[],segs}). diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 0b56a49cd6..892a401c75 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -108,7 +108,7 @@ RELSYSDIR = $(RELEASE_PATH)/compiler_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint +clint0 EBIN = . diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index f7b1dbdddf..8711f35e8e 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -436,7 +436,7 @@ self_compile_1(Config, Prefix, Opts) -> %% Compile the compiler. (In this node to get better coverage.) ?line CompA = make_compiler_dir(Priv, Prefix++"compiler_a"), ?line VsnA = Version ++ ".0", - ?line compile_compiler(compiler_src(), CompA, VsnA, [clint|Opts]), + compile_compiler(compiler_src(), CompA, VsnA, [clint0,clint|Opts]), %% Compile the compiler again using the newly compiled compiler. %% (In another node because reloading the compiler would disturb cover.) diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 8cb7d1b55b..128291dc67 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -365,7 +365,7 @@ listings_big(Config) when is_list(Config) -> ?line do_listing(Big, TargetDir, dkern, ".kernel"), ?line Target = filename:join(TargetDir, big), - ?line {ok,big} = compile:file(Target, [asm,{outdir,TargetDir}]), + {ok,big} = compile:file(Target, [from_asm,{outdir,TargetDir}]), %% Cleanup. ?line ok = file:delete(Target ++ ".beam"), diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index bd877bb528..0d23f12fb5 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -23,7 +23,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, head_mismatch_line/1,warnings_as_errors/1, bif_clashes/1, - transforms/1,forbidden_maps/1,bad_utf8/1]). + transforms/1,maps_warnings/1,bad_utf8/1]). %% Used by transforms/1 test case. -export([parse_transform/2]). @@ -37,7 +37,7 @@ all() -> groups() -> [{p,test_lib:parallel(), [head_mismatch_line,warnings_as_errors,bif_clashes, - transforms,forbidden_maps,bad_utf8]}]. + transforms,maps_warnings,bad_utf8]}]. init_per_suite(Config) -> Config. @@ -241,17 +241,30 @@ parse_transform(_, _) -> error(too_bad). -forbidden_maps(Config) when is_list(Config) -> - Ts1 = [{map_illegal_use_of_pattern, +maps_warnings(Config) when is_list(Config) -> + Ts1 = [{map_ok_use_of_pattern, <<" - -export([t/0]). + -export([t/1]). + t(K) -> + #{K := 1 = V} = id(#{<<\"hi all\">> => 1}), + V. + id(I) -> I. + ">>, + [return], + []}, + {map_illegal_use_of_pattern, + <<" + -export([t/0,t/2]). + t(K,#{ K := V }) -> V. t() -> V = 32, #{<<\"hi\",V,\"all\">> := 1} = id(#{<<\"hi all\">> => 1}). id(I) -> I. ">>, [return], - {error,[{5,erl_lint,{illegal_map_key_variable,'V'}}], []}}], + {error,[{3,erl_lint,{unbound_var,'K'}}, + {6,erl_lint,illegal_map_key}],[]}} + ], [] = run2(Config, Ts1), ok. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 403b7e8405..75efce9d7b 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -21,6 +21,7 @@ ]). -export([ + %% literals t_build_and_match_literals/1, t_update_literals/1,t_match_and_update_literals/1, t_update_map_expressions/1, @@ -32,6 +33,15 @@ t_map_size/1, t_build_and_match_aliasing/1, + %% variables + t_build_and_match_variables/1, + t_update_assoc_variables/1,t_update_exact_variables/1, + t_nested_pattern_expressions/1, + t_guard_update_variables/1, + t_guard_sequence_variables/1, + t_guard_sequence_mixed/1, + t_frequency_table/1, + %% warnings t_warn_useless_build/1, t_warn_pair_key_overloaded/1, @@ -52,6 +62,7 @@ suite() -> []. all() -> [ + %% literals t_build_and_match_literals, t_update_literals, t_match_and_update_literals, t_update_map_expressions, @@ -62,6 +73,15 @@ all() -> [ t_map_size, t_build_and_match_aliasing, + %% variables + t_build_and_match_variables, + t_update_assoc_variables,t_update_exact_variables, + t_nested_pattern_expressions, + t_guard_update_variables, + t_guard_sequence_variables, + t_guard_sequence_mixed, + t_frequency_table, + %% warnings t_warn_useless_build, t_warn_pair_key_overloaded, @@ -73,6 +93,7 @@ all() -> [ t_build_and_match_nil, t_build_and_match_structure, + %% errors in 17.0-rc1 t_update_values, t_expand_map_update, @@ -119,6 +140,11 @@ t_build_and_match_literals(Config) when is_list(Config) -> %% nil key #{[]:=ok,1:=2} = id(#{[]=>ok,1=>2}), + #{1:=2,[]:=ok,1:=2} = id(#{[]=>ok,1=>2}), + + %% pseudo literals + #{ -3 := yep } = id(#{ -3 => yep }), + #{ <<0:358>> := "three" } = id(#{<<0:358>> =>"three"}), %% error case {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))), @@ -126,10 +152,10 @@ t_build_and_match_literals(Config) when is_list(Config) -> {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), - {'EXIT',{badarg,_}} = (catch id(#{<<0:258>> =>"three"})), {'EXIT',{{badmatch,_},_}} = (catch (#{#{"a"=>42} := 3}=id(#{#{"a"=>3}=>42}))), ok. + t_build_and_match_aliasing(Config) when is_list(Config) -> M1 = id(#{a=>1,b=>2,c=>3,d=>4}), #{c:=C1=_=_=C2} = M1, @@ -143,6 +169,19 @@ t_build_and_match_aliasing(Config) when is_list(Config) -> M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}), #{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2, #{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2, + + #{a:=A1,a:=A1,a:=A1,b:=B1,b:=B1} = #{a:=A1,a:=A1,a:=A1,b:=B1,b:=B1,b:=2} = M1, + #{"a":=A3,"b":=B3} = #{"a":=A3,"a":=A3} = #{"b":=B3,"b":=2} = M2, + + #{"a":=1,"b":=2,"c":=3,"d":=4} = #{"a":=A4,"b":=B4} = #{"a":=A4,"a":=A4} = #{"b":=B4,"d":=4} = M2, + #{"a":=A5,"b":=B5} = #{"a":=A5,"a":=A5} = #{"b":=B5,"d":=4} = #{"a":=1,"b":=2,"c":=3,"d":=4} = M2, + #{"a":=_,"b":=_} = #{"a":=_,"a":=_} = #{"b":=_,"d":=4} = #{"a":=1,"b":=2,"c":=3,"d":=4} = M2, + + M3 = id(#{<<12:300>>=>1,<<13:300>>=>2}), + #{<<12:300>> := V1, <<13:300>> := V2} = #{<<13:300>> := V2, <<12:300>> := V1} = M3, + #{<<12:300>> := 1, <<13:300>> := 2} = #{<<13:300>> := _, <<12:300>> := _} = M3, + #{<<13:300>> := _, <<12:300>> := _} = #{<<12:300>> := 1, <<13:300>> := 2} = M3, + ok. t_map_size(Config) when is_list(Config) -> @@ -241,11 +280,14 @@ t_update_assoc(Config) when is_list(Config) -> #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, M2 = M0#{3.0:=wrong,3.0=>new}, + % Can't handle directly yet + Bin = <<0:257>>, + #{ Bin := val } = id(M0#{<<0:257>> => val}), %% binary limitation + %% Errors cases. BadMap = id(badmap), {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}), - {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> => val}), %% limitation ok. t_update_exact(Config) when is_list(Config) -> @@ -281,8 +323,10 @@ t_update_values(Config) when is_list(Config) -> V0 = id(1337), M0 = #{ a => 1, val => V0}, V1 = get_val(M0), - M1 = M0#{ val := [V0,V1], "wazzup" => 42 }, + M1 = id(M0#{ val := [V0,V1], "wazzup" => 42 }), [1337, {some_val, 1337}] = get_val(M1), + M2 = id(M1#{ <<42:333>> => 1337 }), + {bin_key,1337} = get_val(M2), N = 110, List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)], @@ -308,6 +352,7 @@ t_export(Config) when is_list(Config) -> check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok. +get_val(#{ <<42:333>> := V }) -> {bin_key, V}; get_val(#{ "wazzup" := _, val := V}) -> V; get_val(#{ val := V }) -> {some_val, V}. @@ -437,7 +482,10 @@ guard_receive_loop() -> t_list_comprehension(Config) when is_list(Config) -> - [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + [#{k:=1},#{k:=2},#{k:=3}] = id([#{k=>I} || I <- [1,2,3]]), + Ls = id([#{<<2:301>> => I, "wat" => I + 1} || I <- [1,2,3]]), + [#{<<2:301>>:=1,"wat":=2},#{<<2:301>>:=2,"wat":=3},#{<<2:301>>:=3,"wat":=4}] = Ls, + [{1,2},{2,3},{3,4}] = id([{I2,I1} || #{"wat" := I1, <<2:301>> := I2} <- Ls]), ok. t_guard_fun(Config) when is_list(Config) -> @@ -601,5 +649,325 @@ t_build_and_match_structure(Config) when is_list(Config) -> end, ok. +%% simple build and match variables +t_build_and_match_variables(Config) when is_list(Config) -> + K0 = id(#{}), + K1 = id(1), V1 = id(a), + K2 = id(2), V2 = id(b), + K3 = id(3), V3 = id("c"), + K4 = id("4"), V4 = id("d"), + K5 = id(<<"5">>), V5 = id(<<"e">>), + K6 = id({"6",7}), V6 = id("f"), + K7 = id(#{ "a" => 3 }), + #{K1:=V1} = id(#{K1=>V1}), + #{K1:=V1,K2:=V2} = id(#{K1=>V1,K2=>V2}), + #{K1:=V1,K2:=V2,K3:=V3} = id(#{K1=>V1,K2=>V2,K3=>V3}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5,K6:=V6} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5,K6=>V6}), + + #{K5:=X,K5:=X=3,K4:=4} = id(#{K5=>3,K4=>4}), + #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{K5=>3,K4=>4}), + #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{<<"5">>=>3,K4=>4}), + + #{ K4:=#{ K3:=#{K1:=V1, K2:=V2}}, K5:=V5} = + id(#{ K5=>V5, K4=>#{ K3=>#{K2 => V2, K1 => V1}}}), + #{ K4 := #{ K5 := Res }, K6 := Res} = id(#{K4=>#{K5 => 99}, K6 => 99}), + + %% has keys + #{a :=_,b :=_,K1:=_,K2:=_,K3:=V3,K4:=ResKey,K4:=ResKey,"4":=ResKey,"4":="ok"} = + id(#{ a=>1, b=>1, K1=>V1, K2=>V2, K3=>V3, K4=>"nope", "4"=>"ok" }), + + %% function + ok = match_function_map_neg_keys(#{ -1 => a, -2 => b, -3 => c }), + + %% map key + #{ K0 := 42 } = id(#{ K0 => 42 }), + #{ K7 := 42 } = id(#{ K7 => 42 }), + + %% nil key + KNIL = id([]), + #{KNIL:=ok,1:=2} = id(#{KNIL=>ok,1=>2}), + + Bin = <<0:258>>, + #{ Bin := "three" } = id(#{<<0:258>> =>"three"}), + + %% error case + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3,x:=2} = id(#{K5=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=2} = id(#{K5=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id({a,b,c}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(#{K6=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(K7))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K7:=3} = id(#{K7=>42}))), + ok. + + +match_function_map_neg_keys(#{ -1 := a, -2 := b, -3 := c }) -> ok. + +t_update_assoc_variables(Config) when is_list(Config) -> + K1 = id(1), + K2 = id(2), + K3 = id(3.0), + K4 = id(4), + K5 = id(5), + K6 = id(2.0), + + M0 = #{K1=>a,K2=>b,K3=>c,K4=>d,K5=>e}, + + M1 = M0#{K1=>42,K2=>100,K4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,K3:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,K6=>100,4.0=>[a,b,c]}, + + M2 = M0#{K3=>new}, + #{1:=a,2:=b,K3:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,K3=>new}, + + #{ <<0:258>> := val } = id(M0#{<<0:258>> => val}), %% binary limitation + + %% Errors cases. + BadMap = id(badmap), + {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), + {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}), + ok. + +t_update_exact_variables(Config) when is_list(Config) -> + K1 = id(1), + K2 = id(2), + K3 = id(3.0), + K4 = id(4), + + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{K1:=42,K2:=100,K4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,K4:=[a,b,c],5:=e} = M1, + M1 = M0#{K1:=wrong,1:=also_wrong,K1=>42,2=>wrong,K2:=100,4:=[a,b,c]}, + + M2 = M0#{K3:=new}, + #{1:=a,K2:=b,3.0:=new,K4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,K3:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,K3:=new}, + + M3 = id(#{ 1 => val}), + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, K1 := update, K1=> update3, + K1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, + + #{ "wat" := 3, 2 := a } = id(#{ "wat" => 1, K2 => 2 }#{ K2 := a, "wat" := 3 }), + + %% Errors cases. + {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })), + {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation + ok. + +t_nested_pattern_expressions(Config) when is_list(Config) -> + K1 = id("hello"), + %K2 = id({ok}), + [_,_,#{ <<"hi">> := wat, K1 := 42 }|_] = id([k,k,#{<<"hi">> => wat, K1 => 42}]), + [_,_,#{ -1 := wat, K1 := 42 }|_] = id([k,k,#{-1 => wat, K1 => 42}]), + [_,_,{#{ -1 := #{ {-3,<<0:300>>} := V1 }, K1 := 42 },3}|_] = id([k,k,{#{-1 => #{{-3,<<0:300>>}=>"hi"}, K1 => 42},3}]), + "hi" = V1, + %[k,#{ {-1,K1,[]} := {wat,K1}, K2 := 42 }|_] = id([k,#{{-1,K1,[]} => {wat,K1}, K2 => 42}]), + %[k,#{ [-1,K2,[]] := {wat,K1}, K1 := 42 }|_] = id([k,#{[-1,K2,[]] => {wat,K1}, K1 => 42}]), + + M0 = id(#{ <<33:333>> => 1, <<332:333>> => ok, a => ok, wat => yep, watzor => ok }), + F0 = map_nested_pattern_funs(M0), + F1 = F0(wat), + F2 = F1(watzor), + {yep,ok} = F2(M0), + ok. + +map_nested_pattern_funs(M) -> + K0 = id(a), + fun(K1) -> + case M of + #{ K0 := ok, K1 := yep, <<33:333>> := 1 } -> + fun(K2) -> + case M of + #{ K2 := ok, K1 := yep, <<33:333>> := 1 } -> + fun + (#{ <<332:333>> := ok, K1 := V1, K2 := V2 }) -> + {V1,V2} + end + end + end + end + end. + +t_guard_update_variables(Config) when is_list(Config) -> + error = map_guard_update_variables(n,#{},#{}), + first = map_guard_update_variables(x,#{}, #{x=>first}), + second = map_guard_update_variables(x,#{y=>old}, #{x=>second,y=>old}), + third = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>third,y=>old}), + fourth = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>4,y=>new}), + ok. + +map_guard_update_variables(K,M1,M2) when M1#{K=>first} =:= M2 -> first; +map_guard_update_variables(K,M1,M2) when M1#{K=>second} =:= M2 -> second; +map_guard_update_variables(K,M1,M2) when M1#{K:=third} =:= M2 -> third; +map_guard_update_variables(K,M1,M2) when M1#{K:=4,y=>new} =:= M2 -> fourth; +map_guard_update_variables(_,_,_) -> error. + +t_guard_sequence_variables(Config) when is_list(Config) -> + {1,"a"} = map_guard_sequence_var_1(a,#{seq=>1,a=>id("a"),b=>no}), + {2,"b"} = map_guard_sequence_var_1(b,#{seq=>2,b=>id("b"),a=>no}), + {3,"c"} = map_guard_sequence_var_1(a,#{seq=>3,a=>id("c"),b=>no}), + {4,"d"} = map_guard_sequence_var_1(b,#{seq=>4,b=>id("d"),a=>no}), + {4,4} = map_guard_sequence_var_1(seq,#{seq=>4}), + {4,4,y} = map_guard_sequence_var_1(seq,#{seq=>4,b=>id("d"),a=>y}), + {5,"d"} = map_guard_sequence_var_1(b,#{seq=>5,b=>id("d"),a=>y}), + + %% error case + {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_var_1("a",#{seq=>4,val=>id("e")})), + ok. + + +map_guard_sequence_var_1(K,M) -> + case M of + #{seq:=1=Seq, K:=Val} -> {Seq,Val}; + #{seq:=2=Seq, K:=Val} -> {Seq,Val}; + #{seq:=3=Seq, K:=Val} -> {Seq,Val}; + #{K:=4=Seq, K:=Val1,a:=Val2} -> {Seq,Val1,Val2}; + #{seq:=4=Seq, K:=Val} -> {Seq,Val}; + #{K:=4=Seq, K:=Val} -> {Seq,Val}; + #{seq:=5=Seq, K:=Val} -> {Seq,Val} + end. + + +t_guard_sequence_mixed(Config) when is_list(Config) -> + M0 = id(#{ a=>1, b=>1, c=>1, d=>1, e=>1, f=>1, g=>1, h=>1 }), + M1 = id(M0#{ d := 3 }), + 1 = map_guard_sequence_mixed(a,d,M1), + M2 = id(M1#{ b := 2, d := 4, h := 2 }), + 2 = map_guard_sequence_mixed(a,d,M2), + M3 = id(M2#{ b := 3, e := 5, g := 3 }), + 3 = map_guard_sequence_mixed(a,e,M3), + M4 = id(M3#{ c := 4, e := 6, h := 1 }), + 4 = map_guard_sequence_mixed(a,e,M4), + M5 = id(M4#{ c := 5, f := 7, g := 2 }), + 5 = map_guard_sequence_mixed(a,f,M5), + M6 = id(M5#{ c := 6, f := 8, h := 3 }), + 6 = map_guard_sequence_mixed(a,f,M6), + + %% error case + {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_mixed(a,b,M0)), + ok. + +map_guard_sequence_mixed(K1,K2,M) -> + case M of + #{ K1 := 1, b := 1, K2 := 3, g := 1} -> 1; + #{ K1 := 1, b := 2, K2 := 4, h := 2} -> 2; + #{ K1 := 1, b := 3, K2 := 5, g := 3} -> 3; + #{ K1 := 1, c := 4, K2 := 6, h := 1} -> 4; + #{ K1 := 1, c := 5, K2 := 7, g := 2} -> 5; + #{ K1 := 1, c := 6, K2 := 8, h := 3} -> 6 + end. + + + +t_frequency_table(Config) when is_list(Config) -> + random:seed({13,1337,54}), % pseudo random + N = 100000, + Ts = rand_terms(N), + #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}), + ok = check_frequency(Ts,Tf), + ok. + + +frequency_table([T|Ts], M) -> + case M of + #{ n := N, tf := #{ T := C } = F } -> + frequency_table(Ts,M#{ n := N + 1, tf := F#{ T := C + 1 }}); + #{ n := N, tf := F } -> + frequency_table(Ts,M#{ n := N + 1, tf := F#{ T => 1 }}) + end; +frequency_table([], M) -> M. + + +check_frequency(Ts,Tf) -> + check_frequency(Ts,Tf,dict:new()). + +check_frequency([T|Ts],Tf,D) -> + case dict:find(T,D) of + error -> check_frequency(Ts,Tf,dict:store(T,1,D)); + {ok,C} -> check_frequency(Ts,Tf,dict:store(T,C+1,D)) + end; +check_frequency([],Tf,D) -> + validate_frequency(dict:to_list(D),Tf). + +validate_frequency([{T,C}|Fs],Tf) -> + case Tf of + #{ T := C } -> validate_frequency(Fs,Tf); + _ -> error + end; +validate_frequency([], _) -> ok. + + +%% aux + +rand_terms(0) -> []; +rand_terms(N) -> [rand_term()|rand_terms(N-1)]. + +rand_term() -> + case random:uniform(6) of + 1 -> rand_binary(); + 2 -> rand_number(); + 3 -> rand_atom(); + 4 -> rand_tuple(); + 5 -> rand_list(); + 6 -> rand_map() + end. + +rand_binary() -> + case random:uniform(3) of + 1 -> <<>>; + 2 -> <<"hi">>; + 3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">> + end. + +rand_number() -> + case random:uniform(3) of + 1 -> random:uniform(5); + 2 -> float(random:uniform(5)); + 3 -> 1 bsl (63 + random:uniform(3)) + end. + +rand_atom() -> + case random:uniform(3) of + 1 -> hi; + 2 -> some_atom; + 3 -> some_other_atom + end. + + +rand_tuple() -> + case random:uniform(3) of + 1 -> {ok, rand_term()}; % careful + 2 -> {1, 2, 3}; + 3 -> {<<"yep">>, 1337} + end. + +rand_list() -> + case random:uniform(3) of + 1 -> "hi"; + 2 -> [1,rand_term()]; % careful + 3 -> [improper|list] + end. + +rand_map() -> + case random:uniform(3) of + 1 -> #{ hi => 3 }; + 2 -> #{ wat => rand_term(), other => 3 }; % careful + 3 -> #{ hi => 42, other => 42, yet_anoter => 1337 } + end. + + + %% Use this function to avoid compile-time evaluation of an expression. id(I) -> I. diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 0637041873..be0348a92d 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -601,7 +601,7 @@ maps(Config) when is_list(Config) -> ">>, [], {warnings,[{3,v3_core,bad_map}]}}, - {bad_map_literal_key, + {ok_map_literal_key, <<" t() -> V = id(1), @@ -614,7 +614,7 @@ maps(Config) when is_list(Config) -> id(I) -> I. ">>, [], - {warnings,[{6,v3_core,nomatch}]}}], + []}], run(Config, Ts), ok. diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index 0a86352f40..d042596557 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 5.0.1 +COMPILER_VSN = 5.0.2 diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index e55a03d26a..a42de9adb1 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -54,6 +54,10 @@ #include <openssl/evp.h> #include <openssl/hmac.h> +#if OPENSSL_VERSION_NUMBER >= 0x1000000fL +#include <openssl/modes.h> +#endif + #include "crypto_callback.h" #if OPENSSL_VERSION_NUMBER >= 0x00908000L && !defined(OPENSSL_NO_SHA224) && defined(NID_sha224)\ @@ -85,13 +89,32 @@ # define HAVE_AES_IGE #endif +#if OPENSSL_VERSION_NUMBER >= 0x1000100fL +# define HAVE_GCM +#endif + +#if defined(NID_chacha20) && !defined(OPENSSL_NO_CHACHA) && !defined(OPENSSL_NO_POLY1305) +# define HAVE_CHACHA20_POLY1305 +#endif + #if defined(HAVE_EC) #include <openssl/ec.h> #include <openssl/ecdh.h> #include <openssl/ecdsa.h> #endif +#if defined(HAVE_CHACHA20_POLY1305) +#include <openssl/chacha.h> +#include <openssl/poly1305.h> +#if !defined(CHACHA20_NONCE_LEN) +# define CHACHA20_NONCE_LEN 8 +#endif +#if !defined(POLY1305_TAG_LEN) +# define POLY1305_TAG_LEN 16 +#endif + +#endif #ifdef VALGRIND # include <valgrind/memcheck.h> @@ -257,6 +280,11 @@ static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); /* helpers */ static void init_algorithms_types(ErlNifEnv*); @@ -387,7 +415,15 @@ static ErlNifFunc nif_funcs[] = { {"ecdsa_verify_nif", 5, ecdsa_verify_nif}, {"ecdh_compute_key_nif", 3, ecdh_compute_key_nif}, - {"rand_seed_nif", 1, rand_seed_nif} + {"rand_seed_nif", 1, rand_seed_nif}, + + {"aes_gcm_encrypt", 4, aes_gcm_encrypt}, + {"aes_gcm_decrypt", 5, aes_gcm_decrypt}, + + {"chacha20_poly1305_encrypt", 4, chacha20_poly1305_encrypt}, + {"chacha20_poly1305_decrypt", 5, chacha20_poly1305_decrypt} + + }; ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload) @@ -462,9 +498,11 @@ static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*); /* #define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n") #define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1) +#define PRINTF_ERR2(FMT, A1, A2) enif_fprintf(stderr, FMT "\n", A1, A2) */ #define PRINTF_ERR0(FMT) #define PRINTF_ERR1(FMT,A1) +#define PRINTF_ERR2(FMT,A1,A2) #ifdef __OSE__ @@ -506,6 +544,23 @@ static int init_ose_crypto() { #define CHECK_OSE_CRYPTO() #endif + +static int verify_lib_version(void) +{ + const unsigned long libv = SSLeay(); + const unsigned long hdrv = OPENSSL_VERSION_NUMBER; + +# define MAJOR_VER(V) ((unsigned long)(V) >> (7*4)) + + if (MAJOR_VER(libv) != MAJOR_VER(hdrv)) { + PRINTF_ERR2("CRYPTO: INCOMPATIBLE SSL VERSION" + " lib=%lx header=%lx\n", libv, hdrv); + return 0; + } + return 1; +} + + #ifdef HAVE_DYNAMIC_CRYPTO_LIB # if defined(DEBUG) @@ -554,6 +609,9 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) if (!INIT_OSE_CRYPTO()) return 0; + if (!verify_lib_version()) + return 0; + /* load_info: {301, <<"/full/path/of/this/library">>} */ if (!enif_get_tuple(env, load_info, &tpl_arity, &tpl_array) || tpl_arity != 2 @@ -703,7 +761,7 @@ static ERL_NIF_TERM algo_hash[8]; /* increase when extending the list */ static int algo_pubkey_cnt; static ERL_NIF_TERM algo_pubkey[3]; /* increase when extending the list */ static int algo_cipher_cnt; -static ERL_NIF_TERM algo_cipher[2]; /* increase when extending the list */ +static ERL_NIF_TERM algo_cipher[4]; /* increase when extending the list */ static void init_algorithms_types(ErlNifEnv* env) { @@ -741,6 +799,12 @@ static void init_algorithms_types(ErlNifEnv* env) #ifdef HAVE_AES_IGE algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_ige256"); #endif +#if defined(HAVE_GCM) + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_gcm"); +#endif +#if defined(HAVE_CHACHA20_POLY1305) + algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"chacha20_poly1305"); +#endif ASSERT(algo_hash_cnt <= sizeof(algo_hash)/sizeof(ERL_NIF_TERM)); ASSERT(algo_pubkey_cnt <= sizeof(algo_pubkey)/sizeof(ERL_NIF_TERM)); @@ -1738,6 +1802,236 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N return ret; } +static ERL_NIF_TERM aes_gcm_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key,Iv,AAD,In) */ +#if defined(HAVE_GCM) + GCM128_CONTEXT *ctx = NULL; + ErlNifBinary key, iv, aad, in; + AES_KEY aes_key; + unsigned char *outp; + ERL_NIF_TERM out, out_tag; + + CHECK_OSE_CRYPTO(); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 + || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 + || !enif_inspect_iolist_as_binary(env, argv[2], &aad) + || !enif_inspect_iolist_as_binary(env, argv[3], &in)) { + return enif_make_badarg(env); + } + + if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt))) + return atom_error; + + CRYPTO_gcm128_setiv(ctx, iv.data, iv.size); + + if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size)) + goto out_err; + + outp = enif_make_new_binary(env, in.size, &out); + + /* encrypt */ + if (CRYPTO_gcm128_encrypt(ctx, in.data, outp, in.size)) + goto out_err; + + /* calculate the tag */ + CRYPTO_gcm128_tag(ctx, enif_make_new_binary(env, EVP_GCM_TLS_TAG_LEN, &out_tag), EVP_GCM_TLS_TAG_LEN); + CRYPTO_gcm128_release(ctx); + + CONSUME_REDS(env, in); + + return enif_make_tuple2(env, out, out_tag); + +out_err: + CRYPTO_gcm128_release(ctx); + return atom_error; + +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM aes_gcm_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key,Iv,AAD,In,Tag) */ +#if defined(HAVE_GCM) + GCM128_CONTEXT *ctx; + ErlNifBinary key, iv, aad, in, tag; + AES_KEY aes_key; + unsigned char *outp; + ERL_NIF_TERM out; + + CHECK_OSE_CRYPTO(); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 + || !enif_inspect_binary(env, argv[1], &iv) || iv.size == 0 + || !enif_inspect_iolist_as_binary(env, argv[2], &aad) + || !enif_inspect_iolist_as_binary(env, argv[3], &in) + || !enif_inspect_iolist_as_binary(env, argv[4], &tag) || tag.size != EVP_GCM_TLS_TAG_LEN) { + return enif_make_badarg(env); + } + + if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt))) + return atom_error; + + CRYPTO_gcm128_setiv(ctx, iv.data, iv.size); + + if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size)) + goto out_err; + + outp = enif_make_new_binary(env, in.size, &out); + + /* decrypt */ + if (CRYPTO_gcm128_decrypt(ctx, in.data, outp, in.size)) + goto out_err; + + /* calculate and check the tag */ + if (CRYPTO_gcm128_finish(ctx, tag.data, EVP_GCM_TLS_TAG_LEN)) + goto out_err; + + CRYPTO_gcm128_release(ctx); + CONSUME_REDS(env, in); + + return out; + +out_err: + CRYPTO_gcm128_release(ctx); + return atom_error; +#else + return atom_notsup; +#endif +} + +#if defined(HAVE_CHACHA20_POLY1305) +static void +poly1305_update_with_length(poly1305_state *poly1305, + const unsigned char *data, size_t data_len) +{ + size_t j = data_len; + unsigned char length_bytes[8]; + unsigned i; + + for (i = 0; i < sizeof(length_bytes); i++) { + length_bytes[i] = j; + j >>= 8; + } + + CRYPTO_poly1305_update(poly1305, data, data_len); + CRYPTO_poly1305_update(poly1305, length_bytes, sizeof(length_bytes)); +} +#endif + +static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key,Iv,AAD,In) */ +#if defined(HAVE_CHACHA20_POLY1305) + ErlNifBinary key, iv, aad, in; + unsigned char *outp; + ERL_NIF_TERM out, out_tag; + ErlNifUInt64 in_len_64; + unsigned char poly1305_key[32]; + poly1305_state poly1305; + + CHECK_OSE_CRYPTO(); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 + || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN + || !enif_inspect_iolist_as_binary(env, argv[2], &aad) + || !enif_inspect_iolist_as_binary(env, argv[3], &in)) { + return enif_make_badarg(env); + } + + /* Take from OpenSSL patch set/LibreSSL: + * + * The underlying ChaCha implementation may not overflow the block + * counter into the second counter word. Therefore we disallow + * individual operations that work on more than 2TB at a time. + * in_len_64 is needed because, on 32-bit platforms, size_t is only + * 32-bits and this produces a warning because it's always false. + * Casting to uint64_t inside the conditional is not sufficient to stop + * the warning. */ + in_len_64 = in.size; + if (in_len_64 >= (1ULL << 32) * 64 - 64) + return enif_make_badarg(env); + + memset(poly1305_key, 0, sizeof(poly1305_key)); + CRYPTO_chacha_20(poly1305_key, poly1305_key, sizeof(poly1305_key), key.data, iv.data, 0); + + outp = enif_make_new_binary(env, in.size, &out); + + CRYPTO_poly1305_init(&poly1305, poly1305_key); + poly1305_update_with_length(&poly1305, aad.data, aad.size); + CRYPTO_chacha_20(outp, in.data, in.size, key.data, iv.data, 1); + poly1305_update_with_length(&poly1305, outp, in.size); + + CRYPTO_poly1305_finish(&poly1305, enif_make_new_binary(env, POLY1305_TAG_LEN, &out_tag)); + + CONSUME_REDS(env, in); + + return enif_make_tuple2(env, out, out_tag); + +#else + return atom_notsup; +#endif +} + +static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Key,Iv,AAD,In,Tag) */ +#if defined(HAVE_CHACHA20_POLY1305) + ErlNifBinary key, iv, aad, in, tag; + unsigned char *outp; + ERL_NIF_TERM out; + ErlNifUInt64 in_len_64; + unsigned char poly1305_key[32]; + unsigned char mac[POLY1305_TAG_LEN]; + poly1305_state poly1305; + + CHECK_OSE_CRYPTO(); + + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 32 + || !enif_inspect_binary(env, argv[1], &iv) || iv.size != CHACHA20_NONCE_LEN + || !enif_inspect_iolist_as_binary(env, argv[2], &aad) + || !enif_inspect_iolist_as_binary(env, argv[3], &in) + || !enif_inspect_iolist_as_binary(env, argv[4], &tag) || tag.size != POLY1305_TAG_LEN) { + return enif_make_badarg(env); + } + + /* Take from OpenSSL patch set/LibreSSL: + * + * The underlying ChaCha implementation may not overflow the block + * counter into the second counter word. Therefore we disallow + * individual operations that work on more than 2TB at a time. + * in_len_64 is needed because, on 32-bit platforms, size_t is only + * 32-bits and this produces a warning because it's always false. + * Casting to uint64_t inside the conditional is not sufficient to stop + * the warning. */ + in_len_64 = in.size; + if (in_len_64 >= (1ULL << 32) * 64 - 64) + return enif_make_badarg(env); + + memset(poly1305_key, 0, sizeof(poly1305_key)); + CRYPTO_chacha_20(poly1305_key, poly1305_key, sizeof(poly1305_key), key.data, iv.data, 0); + + CRYPTO_poly1305_init(&poly1305, poly1305_key); + poly1305_update_with_length(&poly1305, aad.data, aad.size); + poly1305_update_with_length(&poly1305, in.data, in.size); + CRYPTO_poly1305_finish(&poly1305, mac); + + if (memcmp(mac, tag.data, POLY1305_TAG_LEN) != 0) + return atom_error; + + outp = enif_make_new_binary(env, in.size, &out); + + CRYPTO_chacha_20(outp, in.data, in.size, key.data, iv.data, 1); + + CONSUME_REDS(env, in); + + return out; +#else + return atom_notsup; +#endif +} + static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Bytes) */ unsigned bytes; diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 7712173ed8..271130a9e6 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -41,7 +41,7 @@ </item> <item> <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> + Block Cipher Modes - <url href="http://csrc.nist.gov/groups/ST/toolkit/BCM/index.html"> ECB, CBC, CFB, OFB, CTR and GCM </url></p> </item> <item> <p><url href="http://www.ietf.org/rfc/rfc1321.txt"> RSA encryption RFC 1321 </url> </p> @@ -53,6 +53,12 @@ <item> <p><url href="http://www.ietf.org/rfc/rfc2945.txt"> Secure Remote Password Protocol (SRP - RFC 2945) </url></p> </item> + <item> + <p>gcm: Dworkin, M., "Recommendation for Block Cipher Modes of + Operation: Galois/Counter Mode (GCM) and GMAC", + National Institute of Standards and Technology SP 800- + 38D, November 2007.</p> + </item> </list> </description> @@ -132,6 +138,8 @@ blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | rc2_cbc </code></p> + <p><code>aead_cipher() = aes_gcm | chacha20_poly1305 </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> @@ -152,7 +160,7 @@ 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_cfb8 | aes_cfb128| aes_cbc256 | aes_ige256 | rc2_cbc | aes_ctr| rc4 </code> </p> + blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128| aes_cbc256 | aes_ige256 | aes_gcm | chacha20_poly1305 | rc2_cbc | aes_ctr| rc4 </code> </p> <p><code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code> Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported with ecdsa and ecdh. @@ -161,18 +169,23 @@ </section> <funcs> - <func> + <func> <name>block_encrypt(Type, Key, Ivec, PlainText) -> CipherText</name> - <fsummary>Encrypt <c>PlainText</c>according to <c>Type</c> block cipher</fsummary> + <name>block_encrypt(AeadType, Key, Ivec, {AAD, PlainText}) -> {CipherText, CipherTag}</name> + <fsummary>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher</fsummary> <type> <v>Type = block_cipher() </v> + <v>AeadType = aead_cipher() </v> <v>Key = block_key() </v> <v>PlainText = iodata() </v> - <v>IVec = CipherText = binary()</v> + <v>AAD = IVec = CipherText = CipherTag = binary()</v> </type> <desc> <p>Encrypt <c>PlainText</c>according to <c>Type</c> block cipher. <c>IVec</c> is an arbitrary initializing vector.</p> + <p>In AEAD (Authenticated Encryption with Associated Data) mode, encrypt + <c>PlainText</c>according to <c>Type</c> block cipher and calculate + <c>CipherTag</c> that also authenticates the <c>AAD</c> (Associated Authenticated Data).</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> @@ -180,16 +193,22 @@ <func> <name>block_decrypt(Type, Key, Ivec, CipherText) -> PlainText</name> - <fsummary>Decrypt <c>CipherText</c>according to <c>Type</c> block cipher</fsummary> + <name>block_decrypt(AeadType, Key, Ivec, {AAD, CipherText, CipherTag}) -> PlainText | error</name> + <fsummary>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher</fsummary> <type> <v>Type = block_cipher() </v> + <v>AeadType = aead_cipher() </v> <v>Key = block_key() </v> <v>PlainText = iodata() </v> - <v>IVec = CipherText = binary()</v> + <v>AAD = IVec = CipherText = CipherTag = binary()</v> </type> <desc> <p>Decrypt <c>CipherText</c>according to <c>Type</c> block cipher. <c>IVec</c> is an arbitrary initializing vector.</p> + <p>In AEAD (Authenticated Encryption with Associated Data) mode, decrypt + <c>CipherText</c>according to <c>Type</c> block cipher and check the authenticity + the <c>PlainText</c> and <c>AAD</c> (Associated Authenticated Data) using the + <c>CipherTag</c>. May return <c>error</c> if the decryption or validation fail's</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> @@ -693,7 +712,7 @@ <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> + <c>NewState</c> must be passed into the next call to <c>stream_decrypt</c>.</p> </desc> </func> diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index 1bd2034b93..82b6de9acd 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -30,6 +30,23 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 3.4.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Make <c>crypto</c> verify major version number of OpenSSL + header files and runtime library. Loading of + <c>crypto</c> will fail if there is a version mismatch.</p> + <p> + Own Id: OTP-12146 Aux Id: seq12700 </p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 3.4</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index e1fbbf9ab8..7f82fa83fd 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -282,7 +282,8 @@ hmac_final_n(_Context, _HashLen) -> ? nif_stub. -spec block_encrypt(des_cbc | des_cfb | des3_cbc | des3_cbf | des_ede3 | blowfish_cbc | blowfish_cfb64 | aes_cbc128 | aes_cfb8 | aes_cfb128 | aes_cbc256 | rc2_cbc, - Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(). + Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); + (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata()}) -> {binary(), binary()}. block_encrypt(des_cbc, Key, Ivec, Data) -> des_cbc_encrypt(Key, Ivec, Data); @@ -310,14 +311,25 @@ block_encrypt(aes_cfb8, Key, Ivec, Data) -> aes_cfb_8_encrypt(Key, Ivec, Data); block_encrypt(aes_cfb128, Key, Ivec, Data) -> aes_cfb_128_encrypt(Key, Ivec, Data); +block_encrypt(aes_gcm, Key, Ivec, {AAD, Data}) -> + case aes_gcm_encrypt(Key, Ivec, AAD, Data) of + notsup -> erlang:error(notsup); + Return -> Return + end; +block_encrypt(chacha20_poly1305, Key, Ivec, {AAD, Data}) -> + case chacha20_poly1305_encrypt(Key, Ivec, AAD, Data) of + notsup -> erlang:error(notsup); + Return -> Return + end; 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_ige256 | - aes_cfb8 | aes_cfb128 | rc2_cbc, - Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(). - + blowfish_cfb64 | blowfish_ofb64 | aes_cbc128 | aes_cbc256 | aes_ige256 | + aes_cfb8 | aes_cfb128 | rc2_cbc, + Key::iodata(), Ivec::binary(), Data::iodata()) -> binary(); + (aes_gcm | chacha20_poly1305, Key::iodata(), Ivec::binary(), + {AAD::binary(), Data::iodata(), Tag::binary()}) -> binary() | error. block_decrypt(des_cbc, Key, Ivec, Data) -> des_cbc_decrypt(Key, Ivec, Data); block_decrypt(des_cfb, Key, Ivec, Data) -> @@ -344,9 +356,18 @@ block_decrypt(aes_cfb8, Key, Ivec, Data) -> aes_cfb_8_decrypt(Key, Ivec, Data); block_decrypt(aes_cfb128, Key, Ivec, Data) -> aes_cfb_128_decrypt(Key, Ivec, Data); +block_decrypt(aes_gcm, Key, Ivec, {AAD, Data, Tag}) -> + case aes_gcm_decrypt(Key, Ivec, AAD, Data, Tag) of + notsup -> erlang:error(notsup); + Return -> Return + end; +block_decrypt(chacha20_poly1305, Key, Ivec, {AAD, Data, Tag}) -> + case chacha20_poly1305_decrypt(Key, Ivec, AAD, Data, Tag) of + notsup -> erlang:error(notsup); + Return -> Return + end; 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) -> @@ -1190,6 +1211,17 @@ aes_cfb_128_decrypt(Key, IVec, Data) -> aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. +%% +%% AES - in Galois/Counter Mode (GCM) +%% +aes_gcm_encrypt(_Key, _Ivec, _AAD, _In) -> ?nif_stub. +aes_gcm_decrypt(_Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub. + +%% +%% Chacha20/Ppoly1305 +%% +chacha20_poly1305_encrypt(_Key, _Ivec, _AAD, _In) -> ?nif_stub. +chacha20_poly1305_decrypt(_Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub. %% %% DES - in cipher block chaining mode (CBC) diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 03aa3964a5..1031e6403f 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -62,6 +62,8 @@ all() -> {group, rc2_cbc}, {group, rc4}, {group, aes_ctr}, + {group, aes_gcm}, + {group, chacha20_poly1305}, mod_pow, exor, rand_uniform @@ -100,7 +102,9 @@ groups() -> {blowfish_cfb64, [], [block]}, {blowfish_ofb64,[], [block]}, {rc4, [], [stream]}, - {aes_ctr, [], [stream]} + {aes_ctr, [], [stream]}, + {aes_gcm, [], [aead]}, + {chacha20_poly1305, [], [aead]} ]. %%------------------------------------------------------------------- @@ -203,6 +207,14 @@ stream(Config) when is_list(Config) -> lists:foreach(fun stream_cipher/1, stream_iolistify(Streams)), lists:foreach(fun stream_cipher_incment/1, stream_iolistify(Streams)). +%%-------------------------------------------------------------------- +aead() -> + [{doc, "Test AEAD ciphers"}]. +aead(Config) when is_list(Config) -> + AEADs = lazy_eval(proplists:get_value(aead, Config)), + + lists:foreach(fun aead_cipher/1, AEADs). + %%-------------------------------------------------------------------- sign_verify() -> [{doc, "Sign/verify digital signatures"}]. @@ -406,7 +418,22 @@ stream_cipher_incment(_State, OrigState, [], Acc, Plain) -> 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). - + +aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag}) -> + Plain = iolist_to_binary(PlainText), + case crypto:block_encrypt(Type, Key, IV, {AAD, Plain}) of + {CipherText, CipherTag} -> + ok; + Other0 -> + ct:fail({{crypto, block_encrypt, [Plain, PlainText]}, {expected, {CipherText, CipherTag}}, {got, Other0}}) + end, + case crypto:block_decrypt(Type, Key, IV, {AAD, CipherText, CipherTag}) of + Plain -> + ok; + Other1 -> + ct:fail({{crypto, block_decrypt, [CipherText]}, {expected, Plain}, {got, Other1}}) + end. + do_sign_verify({Type, Hash, Public, Private, Msg}) -> Signature = crypto:sign(Type, Hash, Msg, Private), case crypto:verify(Type, Hash, Msg, Signature, Public) of @@ -749,6 +776,12 @@ group_config(rc4, Config) -> group_config(aes_ctr, Config) -> Stream = aes_ctr(), [{stream, Stream} | Config]; +group_config(aes_gcm, Config) -> + AEAD = aes_gcm(), + [{aead, AEAD} | Config]; +group_config(chacha20_poly1305, Config) -> + AEAD = chacha20_poly1305(), + [{aead, AEAD} | Config]; group_config(_, Config) -> Config. @@ -1378,6 +1411,269 @@ aes_ctr() -> long_msg()} ]. + +%% AES GCM test vectors from http://csrc.nist.gov/groups/ST/toolkit/BCM/documents/proposedmodes/gcm/gcm-spec.pdf +aes_gcm() -> + [ + %% Test Case 1 + {aes_gcm, hexstr2bin("00000000000000000000000000000000"), %% Key + hexstr2bin(""), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin(""), %% CipherText + hexstr2bin("58e2fccefa7e3061367f1d57a4e7455a")}, %% CipherTag + + %% Test Case 2 + {aes_gcm, hexstr2bin("00000000000000000000000000000000"), %% Key + hexstr2bin("00000000000000000000000000000000"), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin("0388dace60b6a392f328c2b971b2fe78"), %% CipherText + hexstr2bin("ab6e47d42cec13bdf53a67b21257bddf")}, %% CipherTag + + %% Test Case 3 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308"), %% Key + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b391aafd255"), + hexstr2bin("cafebabefacedbaddecaf888"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin("42831ec2217774244b7221b784d0d49c" %% CipherText + "e3aa212f2c02a4e035c17e2329aca12e" + "21d514b25466931c7d8f6a5aac84aa05" + "1ba30b396a0aac973d58e091473f5985"), + hexstr2bin("4d5c2af327cd64a62cf35abd2ba6fab4")}, %% CipherTag + + %% Test Case 4 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308"), %% Key + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("cafebabefacedbaddecaf888"), %% IV + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("42831ec2217774244b7221b784d0d49c" %% CipherText + "e3aa212f2c02a4e035c17e2329aca12e" + "21d514b25466931c7d8f6a5aac84aa05" + "1ba30b396a0aac973d58e091"), + hexstr2bin("5bc94fbc3221a5db94fae95ae7121a47")}, %% CipherTag + + %% Test Case 5 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308"), %% Key + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("cafebabefacedbad"), %% IV + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("61353b4c2806934a777ff51fa22a4755" %% CipherText + "699b2a714fcdc6f83766e5f97b6c7423" + "73806900e49f24b22b097544d4896b42" + "4989b5e1ebac0f07c23f4598"), + hexstr2bin("3612d2e79e3b0785561be14aaca2fccb")}, %% CipherTag + + %% Test Case 6" + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308"), %% Key + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("9313225df88406e555909c5aff5269aa" %% IV + "6a7a9538534f7da1e4c303d2a318a728" + "c3c0c95156809539fcf0e2429a6b5254" + "16aedbf5a0de6a57a637b39b"), + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("8ce24998625615b603a033aca13fb894" %% CipherText + "be9112a5c3a211a8ba262a3cca7e2ca7" + "01e4a9a4fba43c90ccdcb281d48c7c6f" + "d62875d2aca417034c34aee5"), + hexstr2bin("619cc5aefffe0bfa462af43c1699d050")}, %% CipherTag + + %% Test Case 7 + {aes_gcm, hexstr2bin("00000000000000000000000000000000" %% Key + "0000000000000000"), + hexstr2bin(""), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin(""), %% CipherText + hexstr2bin("cd33b28ac773f74ba00ed1f312572435")}, %% CipherTag + + %% Test Case 8 + {aes_gcm, hexstr2bin("00000000000000000000000000000000" %% Key + "0000000000000000"), + hexstr2bin("00000000000000000000000000000000"), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin("98e7247c07f0fe411c267e4384b0f600"), %% CipherText + hexstr2bin("2ff58d80033927ab8ef4d4587514f0fb")}, %% CipherTag + + %% Test Case 9 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b391aafd255"), + hexstr2bin("cafebabefacedbaddecaf888"), %% IV + hexstr2bin(""), %% ADD + hexstr2bin("3980ca0b3c00e841eb06fac4872a2757" %% CipherText + "859e1ceaa6efd984628593b40ca1e19c" + "7d773d00c144c525ac619d18c84a3f47" + "18e2448b2fe324d9ccda2710acade256"), + hexstr2bin("9924a7c8587336bfb118024db8674a14")}, %% CipherTag + + %% Test Case 10 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("cafebabefacedbaddecaf888"), %% IV + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("3980ca0b3c00e841eb06fac4872a2757" %% CipherText + "859e1ceaa6efd984628593b40ca1e19c" + "7d773d00c144c525ac619d18c84a3f47" + "18e2448b2fe324d9ccda2710"), + hexstr2bin("2519498e80f1478f37ba55bd6d27618c")}, %% CipherTag + + %% Test Case 11 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("cafebabefacedbad"), %% IV + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("0f10f599ae14a154ed24b36e25324db8" %% CipherText + "c566632ef2bbb34f8347280fc4507057" + "fddc29df9a471f75c66541d4d4dad1c9" + "e93a19a58e8b473fa0f062f7"), + hexstr2bin("65dcc57fcf623a24094fcca40d3533f8")}, %% CipherTag + + %% Test Case 12 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("9313225df88406e555909c5aff5269aa" %% IV + "6a7a9538534f7da1e4c303d2a318a728" + "c3c0c95156809539fcf0e2429a6b5254" + "16aedbf5a0de6a57a637b39b"), + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("d27e88681ce3243c4830165a8fdcf9ff" %% CipherText + "1de9a1d8e6b447ef6ef7b79828666e45" + "81e79012af34ddd9e2f037589b292db3" + "e67c036745fa22e7e9b7373b"), + hexstr2bin("dcf566ff291c25bbb8568fc3d376a6d9")}, %% CipherTag + + %% Test Case 13 + {aes_gcm, hexstr2bin("00000000000000000000000000000000" %% Key + "00000000000000000000000000000000"), + hexstr2bin(""), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin(""), %% CipherText + hexstr2bin("530f8afbc74536b9a963b4f1c4cb738b")}, %% CipherTag + + %% Test Case 14 + {aes_gcm, hexstr2bin("00000000000000000000000000000000" %% Key + "00000000000000000000000000000000"), + hexstr2bin("00000000000000000000000000000000"), %% PlainText + hexstr2bin("000000000000000000000000"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin("cea7403d4d606b6e074ec5d3baf39d18"), %% CipherText + hexstr2bin("d0d1c8a799996bf0265b98b5d48ab919")}, %% CipherTag + + %% Test Case 15 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c6d6a8f9467308308"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b391aafd255"), + hexstr2bin("cafebabefacedbaddecaf888"), %% IV + hexstr2bin(""), %% AAD + hexstr2bin("522dc1f099567d07f47f37a32a84427d" %% CipherText + "643a8cdcbfe5c0c97598a2bd2555d1aa" + "8cb08e48590dbb3da7b08b1056828838" + "c5f61e6393ba7a0abcc9f662898015ad"), + hexstr2bin("b094dac5d93471bdec1a502270e3cc6c")}, %% CipherTag + + %% Test Case 16 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c6d6a8f9467308308"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("cafebabefacedbaddecaf888"), %% IV + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("522dc1f099567d07f47f37a32a84427d" %% CipherText + "643a8cdcbfe5c0c97598a2bd2555d1aa" + "8cb08e48590dbb3da7b08b1056828838" + "c5f61e6393ba7a0abcc9f662"), + hexstr2bin("76fc6ece0f4e1768cddf8853bb2d551b")}, %% CipherTag + + %% Test Case 17 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c6d6a8f9467308308"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("cafebabefacedbad"), %% IV + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("c3762df1ca787d32ae47c13bf19844cb" %% CipherText + "af1ae14d0b976afac52ff7d79bba9de0" + "feb582d33934a4f0954cc2363bc73f78" + "62ac430e64abe499f47c9b1f"), + hexstr2bin("3a337dbf46a792c45e454913fe2ea8f2")}, %% CipherTag + + %% Test Case 18 + {aes_gcm, hexstr2bin("feffe9928665731c6d6a8f9467308308" %% Key + "feffe9928665731c6d6a8f9467308308"), + hexstr2bin("d9313225f88406e5a55909c5aff5269a" %% PlainText + "86a7a9531534f7da2e4c303d8a318a72" + "1c3c0c95956809532fcf0e2449a6b525" + "b16aedf5aa0de657ba637b39"), + hexstr2bin("9313225df88406e555909c5aff5269aa" %% IV + "6a7a9538534f7da1e4c303d2a318a728" + "c3c0c95156809539fcf0e2429a6b5254" + "16aedbf5a0de6a57a637b39b"), + hexstr2bin("feedfacedeadbeeffeedfacedeadbeef" %% AAD + "abaddad2"), + hexstr2bin("5a8def2f0c9e53f1f75d7853659e2a20" %% CipherText + "eeb2b22aafde6419a058ab4f6f746bf4" + "0fc0c3b780f244452da3ebf1c5d82cde" + "a2418997200ef82e44ae7e3f"), + hexstr2bin("a44a8266ee1c8eb0c8b5d4cf5ae9f19a")} %% CipherTag + ]. + +%% http://tools.ietf.org/html/draft-agl-tls-chacha20poly1305-04 +chacha20_poly1305() -> + [ + {chacha20_poly1305, hexstr2bin("4290bcb154173531f314af57f3be3b500" %% Key + "6da371ece272afa1b5dbdd1100a1007"), + hexstr2bin("86d09974840bded2a5ca"), %% PlainText + hexstr2bin("cd7cf67be39c794a"), %% Nonce + hexstr2bin("87e229d4500845a079c0"), %% AAD + hexstr2bin("e3e446f7ede9a19b62a4"), %% CipherText + hexstr2bin("677dabf4e3d24b876bb284753896e1d6")} %% CipherTag + ]. + rsa_plain() -> <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" "09812312908312378623487263487623412039812 huagasd">>. diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index b2bb1d7dfb..2a7f3c4558 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 3.4 +CRYPTO_VSN = 3.4.1 diff --git a/lib/debugger/src/Makefile b/lib/debugger/src/Makefile index 90189dd297..d61519f1ad 100644 --- a/lib/debugger/src/Makefile +++ b/lib/debugger/src/Makefile @@ -63,7 +63,7 @@ MODULES= \ HRL_FILES= -INTERNAL_HRL_FILES= dbg_ieval.hrl +INTERNAL_HRL_FILES= dbg_ieval.hrl dbg_wx_filedialog_win.hrl ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl index b1bf4ebecc..ce12c1beb3 100644 --- a/lib/debugger/src/dbg_icmd.erl +++ b/lib/debugger/src/dbg_icmd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. All Rights Reserved. %% %% The 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,10 +49,6 @@ %% specifies if the process should break. %%-------------------------------------------------------------------- -%% Common Test adaptation -cmd({call_remote,0,ct_line,line,_As}, Bs, _Ieval) -> - Bs; - cmd(Expr, Bs, Ieval) -> cmd(Expr, Bs, get(next_break), Ieval). diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 77297de0f3..96f9f91808 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -457,11 +457,6 @@ do_eval_function(Mod, Fun, As0, Bs0, _, Ieval0) when is_function(Fun); exception(error, Reason, Bs0, Ieval0) end; -%% Common Test adaptation -do_eval_function(ct_line, line, As, Bs, extern, #ieval{level=Le}=Ieval) -> - debugged_cmd({apply,ct_line,line,As}, Bs, Ieval#ieval{level=Le+1}), - {value, ignore, Bs}; - do_eval_function(Mod, Name, As0, Bs0, Called, Ieval0) -> #ieval{level=Le,line=Li,top=Top} = Ieval0, trace(call, {Called, {Le,Li,Mod,Name,As0}}), @@ -896,11 +891,6 @@ expr({make_ext_fun,Line,MFA0}, Bs0, Ieval0) -> exception(error, badarg, Bs, Ieval, true) end; -%% Common test adaptation -expr({call_remote,0,ct_line,line,As0,Lc}, Bs0, Ieval0) -> - {As,_Bs} = eval_list(As0, Bs0, Ieval0), - eval_function(ct_line, line, As, Bs0, extern, Ieval0, Lc); - %% Local function call expr({local_call,Line,F,As0,Lc}, Bs0, #ieval{module=M} = Ieval0) -> Ieval = Ieval0#ieval{line=Line}, diff --git a/lib/debugger/src/int.erl b/lib/debugger/src/int.erl index 2755db64b8..908390ce50 100644 --- a/lib/debugger/src/int.erl +++ b/lib/debugger/src/int.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -265,9 +265,6 @@ first_lines(Clauses) -> first_line({clause,_L,_Vars,_,Exprs}) -> first_line(Exprs); -%% Common Test adaptation -first_line([{call_remote,0,ct_line,line,_As}|Exprs]) -> - first_line(Exprs); first_line([Expr|_Exprs]) -> % Expr = {Op, Line, ..varying no of args..} element(2, Expr). diff --git a/lib/debugger/test/map_SUITE.erl b/lib/debugger/test/map_SUITE.erl index 0076193725..e525484a8e 100644 --- a/lib/debugger/test/map_SUITE.erl +++ b/lib/debugger/test/map_SUITE.erl @@ -32,9 +32,30 @@ t_guard_receive/1, t_guard_fun/1, t_list_comprehension/1, t_map_sort_literals/1, - %t_size/1, t_map_size/1, - + t_build_and_match_aliasing/1, + + %% variables + t_build_and_match_variables/1, + t_update_assoc_variables/1,t_update_exact_variables/1, + t_nested_pattern_expressions/1, + t_guard_update_variables/1, + t_guard_sequence_variables/1, + t_guard_sequence_mixed/1, + t_frequency_table/1, + + %% not covered in 17.0-rc1 + t_build_and_match_over_alloc/1, + t_build_and_match_empty_val/1, + t_build_and_match_val/1, + t_build_and_match_nil/1, + t_build_and_match_structure/1, + + %% errors in 17.0-rc1 + t_update_values/1, + t_expand_map_update/1, + t_export/1, + %% Specific Map BIFs t_bif_map_get/1, t_bif_map_find/1, @@ -61,8 +82,7 @@ %% misc t_pdict/1, - t_ets/1, - t_dets/1 + t_ets/1 ]). -include_lib("stdlib/include/ms_transform.hrl"). @@ -77,7 +97,30 @@ all() -> [ t_guard_bifs, t_guard_sequence, t_guard_update, t_guard_receive,t_guard_fun, t_list_comprehension, t_map_sort_literals, - + t_build_and_match_aliasing, + + %% variables + t_build_and_match_variables, + t_update_assoc_variables,t_update_exact_variables, + t_nested_pattern_expressions, + t_guard_update_variables, + t_guard_sequence_variables, + t_guard_sequence_mixed, + t_frequency_table, + + %% not covered in 17.0-rc1 + t_build_and_match_over_alloc, + t_build_and_match_empty_val, + t_build_and_match_val, + t_build_and_match_nil, + t_build_and_match_structure, + + + %% errors in 17.0-rc1 + t_update_values, + t_expand_map_update, + t_export, + %% Specific Map BIFs t_bif_map_get,t_bif_map_find,t_bif_map_is_key, t_bif_map_keys, t_bif_map_merge, t_bif_map_new, @@ -94,7 +137,6 @@ all() -> [ t_maps_fold, t_maps_map, t_maps_size, t_maps_without, - %% Other functions t_pdict, t_ets @@ -147,18 +189,6 @@ t_build_and_match_literals(Config) when is_list(Config) -> {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), ok. - -%% Tests size(Map). -%% not implemented, perhaps it shouldn't be either - -%t_size(Config) when is_list(Config) -> -% 0 = size(#{}), -% 1 = size(#{a=>1}), -% 1 = size(#{a=>#{a=>1}}), -% 2 = size(#{a=>1, b=>2}), -% 3 = size(#{a=>1, b=>2, b=>"3"}), -% ok. - t_map_size(Config) when is_list(Config) -> 0 = map_size(id(#{})), 1 = map_size(id(#{a=>1})), @@ -268,6 +298,44 @@ t_update_exact(Config) when is_list(Config) -> ok. +t_update_values(Config) when is_list(Config) -> + V0 = id(1337), + M0 = #{ a => 1, val => V0}, + V1 = get_val(M0), + M1 = id(M0#{ val := [V0,V1], "wazzup" => 42 }), + [1337, {some_val, 1337}] = get_val(M1), + M2 = id(M1#{ <<42:333>> => 1337 }), + {bin_key,1337} = get_val(M2), + + N = 110, + List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)], + + {_,_,#{val2 := {1,2,3,"wat",N}, val1 := [N,1,2,3,N]}} = lists:foldl(fun + ({V2,V3},{Old2,Old3,Mi}) -> + ok = check_val(Mi,Old2,Old3), + #{ val1 := Old2, val2 := Old3 } = Mi, + {V2,V3, Mi#{ val1 := id(V2), val2 := V1, val2 => id(V3)}} + end, {none, none, #{val1=>none,val2=>none}},List), + ok. + +t_expand_map_update(Config) when is_list(Config) -> + M = #{<<"hello">> => <<"world">>}#{<<"hello">> := <<"les gens">>}, + #{<<"hello">> := <<"les gens">>} = M, + ok. + +t_export(Config) when is_list(Config) -> + Raclette = id(#{}), + case brie of brie -> Fromage = Raclette end, + Raclette = Fromage#{}, + ok. + +check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok. + +get_val(#{ <<42:333>> := V }) -> {bin_key, V}; +get_val(#{ "wazzup" := _, val := V}) -> V; +get_val(#{ val := V }) -> {some_val, V}. + + t_guard_bifs(Config) when is_list(Config) -> true = map_guard_head(#{a=>1}), false = map_guard_head([]), @@ -988,16 +1056,385 @@ t_ets(_Config) -> ets:delete(Tid), ok. -t_dets(_Config) -> +t_build_and_match_aliasing(Config) when is_list(Config) -> + M1 = id(#{a=>1,b=>2,c=>3,d=>4}), + #{c:=C1=_=_=C2} = M1, + true = C1 =:= C2, + #{a:=A,a:=A,a:=A,b:=B,b:=B} = M1, + #{a:=A,a:=A,a:=A,b:=B,b:=B,b:=2} = M1, + #{a:=A=1,a:=A,a:=A,b:=B=2,b:=B,b:=2} = M1, + #{c:=C1, c:=_, c:=3, c:=_, c:=C2} = M1, + #{c:=C=_=3=_=C} = M1, + + M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}), + #{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2, + #{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2, + ok. + +%% simple build and match variables +t_build_and_match_variables(Config) when is_list(Config) -> + K0 = id(#{}), + K1 = id(1), V1 = id(a), + K2 = id(2), V2 = id(b), + K3 = id(3), V3 = id("c"), + K4 = id("4"), V4 = id("d"), + K5 = id(<<"5">>), V5 = id(<<"e">>), + K6 = id({"6",7}), V6 = id("f"), + K7 = id(#{ "a" => 3 }), + #{K1:=V1} = id(#{K1=>V1}), + #{K1:=V1,K2:=V2} = id(#{K1=>V1,K2=>V2}), + #{K1:=V1,K2:=V2,K3:=V3} = id(#{K1=>V1,K2=>V2,K3=>V3}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5,K6:=V6} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5,K6=>V6}), + + #{K5:=X,K5:=X=3,K4:=4} = id(#{K5=>3,K4=>4}), + #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{K5=>3,K4=>4}), + #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{<<"5">>=>3,K4=>4}), + + #{ K4:=#{ K3:=#{K1:=V1, K2:=V2}}, K5:=V5} = + id(#{ K5=>V5, K4=>#{ K3=>#{K2 => V2, K1 => V1}}}), + #{ K4 := #{ K5 := Res }, K6 := Res} = id(#{K4=>#{K5 => 99}, K6 => 99}), + + %% has keys + #{a :=_,b :=_,K1:=_,K2:=_,K3:=V3,K4:=ResKey,K4:=ResKey,"4":=ResKey,"4":="ok"} = + id(#{ a=>1, b=>1, K1=>V1, K2=>V2, K3=>V3, K4=>"nope", "4"=>"ok" }), + + %% function + ok = match_function_map_neg_keys(#{ -1 => a, -2 => b, -3 => c }), + + %% map key + #{ K0 := 42 } = id(#{ K0 => 42 }), + #{ K7 := 42 } = id(#{ K7 => 42 }), + + %% nil key + KNIL = id([]), + #{KNIL:=ok,1:=2} = id(#{KNIL=>ok,1=>2}), + + Bin = <<0:258>>, + #{ Bin := "three" } = id(#{<<0:258>> =>"three"}), + + %% error case + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3,x:=2} = id(#{K5=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=2} = id(#{K5=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id({a,b,c}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(#{K6=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(K7))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K7:=3} = id(#{K7=>42}))), + ok. + + +match_function_map_neg_keys(#{ -1 := a, -2 := b, -3 := c }) -> ok. + +t_update_assoc_variables(Config) when is_list(Config) -> + K1 = id(1), + K2 = id(2), + K3 = id(3.0), + K4 = id(4), + K5 = id(5), + K6 = id(2.0), + + M0 = #{K1=>a,K2=>b,K3=>c,K4=>d,K5=>e}, + + M1 = M0#{K1=>42,K2=>100,K4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,K3:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,K6=>100,4.0=>[a,b,c]}, + + M2 = M0#{K3=>new}, + #{1:=a,2:=b,K3:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,K3=>new}, + + #{ <<0:258>> := val } = id(M0#{<<0:258>> => val}), %% binary limitation + + %% Errors cases. + BadMap = id(badmap), + {'EXIT',{{badarg,_},_}} = (catch BadMap#{nonexisting=>val}), + {'EXIT',{{badarg,_},_}} = (catch <<>>#{nonexisting=>val}), + ok. + +t_update_exact_variables(Config) when is_list(Config) -> + K1 = id(1), + K2 = id(2), + K3 = id(3.0), + K4 = id(4), + + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{K1:=42,K2:=100,K4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,K4:=[a,b,c],5:=e} = M1, + M1 = M0#{K1:=wrong,1:=also_wrong,K1=>42,2=>wrong,K2:=100,4:=[a,b,c]}, + + M2 = M0#{K3:=new}, + #{1:=a,K2:=b,3.0:=new,K4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,K3:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,K3:=new}, + + M3 = id(#{ 1 => val}), + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, K1 := update, K1=> update3, + K1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, + + %% Errors cases. + {'EXIT',{{badarg,_},_}} = (catch ((id(nil))#{ a := b })), + {'EXIT',{{badarg,_},_}} = (catch <<>>#{nonexisting:=val}), + + {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation + ok. + +t_nested_pattern_expressions(Config) when is_list(Config) -> + K1 = id("hello"), + %K2 = id({ok}), + [_,_,#{ <<"hi">> := wat, K1 := 42 }|_] = id([k,k,#{<<"hi">> => wat, K1 => 42}]), + [_,_,#{ -1 := wat, K1 := 42 }|_] = id([k,k,#{-1 => wat, K1 => 42}]), + [_,_,{#{ -1 := #{ {-3,<<0:300>>} := V1 }, K1 := 42 },3}|_] = id([k,k,{#{-1 => #{{-3,<<0:300>>}=>"hi"}, K1 => 42},3}]), + "hi" = V1, + %[k,#{ {-1,K1,[]} := {wat,K1}, K2 := 42 }|_] = id([k,#{{-1,K1,[]} => {wat,K1}, K2 => 42}]), + %[k,#{ [-1,K2,[]] := {wat,K1}, K1 := 42 }|_] = id([k,#{[-1,K2,[]] => {wat,K1}, K1 => 42}]), + ok. + +t_guard_update_variables(Config) when is_list(Config) -> + error = map_guard_update_variables(n,#{},#{}), + first = map_guard_update_variables(x,#{}, #{x=>first}), + second = map_guard_update_variables(x,#{y=>old}, #{x=>second,y=>old}), + third = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>third,y=>old}), + fourth = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>4,y=>new}), + ok. + +map_guard_update_variables(K,M1,M2) when M1#{K=>first} =:= M2 -> first; +map_guard_update_variables(K,M1,M2) when M1#{K=>second} =:= M2 -> second; +map_guard_update_variables(K,M1,M2) when M1#{K:=third} =:= M2 -> third; +map_guard_update_variables(K,M1,M2) when M1#{K:=4,y=>new} =:= M2 -> fourth; +map_guard_update_variables(_,_,_) -> error. + +t_guard_sequence_variables(Config) when is_list(Config) -> + {1,"a"} = map_guard_sequence_var_1(a,#{seq=>1,a=>id("a"),b=>no}), + {2,"b"} = map_guard_sequence_var_1(b,#{seq=>2,b=>id("b"),a=>no}), + {3,"c"} = map_guard_sequence_var_1(a,#{seq=>3,a=>id("c"),b=>no}), + {4,"d"} = map_guard_sequence_var_1(b,#{seq=>4,b=>id("d"),a=>no}), + {4,4} = map_guard_sequence_var_1(seq,#{seq=>4}), + {4,4,y} = map_guard_sequence_var_1(seq,#{seq=>4,b=>id("d"),a=>y}), + {5,"d"} = map_guard_sequence_var_1(b,#{seq=>5,b=>id("d"),a=>y}), + + %% error case + {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_var_1("a",#{seq=>4,val=>id("e")})), + ok. + + +map_guard_sequence_var_1(K,M) -> + case M of + #{seq:=1=Seq, K:=Val} -> {Seq,Val}; + #{seq:=2=Seq, K:=Val} -> {Seq,Val}; + #{seq:=3=Seq, K:=Val} -> {Seq,Val}; + #{K:=4=Seq, K:=Val1,a:=Val2} -> {Seq,Val1,Val2}; + #{seq:=4=Seq, K:=Val} -> {Seq,Val}; + #{K:=4=Seq, K:=Val} -> {Seq,Val}; + #{seq:=5=Seq, K:=Val} -> {Seq,Val} + end. + + +t_guard_sequence_mixed(Config) when is_list(Config) -> + M0 = id(#{ a=>1, b=>1, c=>1, d=>1, e=>1, f=>1, g=>1, h=>1 }), + M1 = id(M0#{ d := 3 }), + 1 = map_guard_sequence_mixed(a,d,M1), + M2 = id(M1#{ b := 2, d := 4, h := 2 }), + 2 = map_guard_sequence_mixed(a,d,M2), + M3 = id(M2#{ b := 3, e := 5, g := 3 }), + 3 = map_guard_sequence_mixed(a,e,M3), + M4 = id(M3#{ c := 4, e := 6, h := 1 }), + 4 = map_guard_sequence_mixed(a,e,M4), + M5 = id(M4#{ c := 5, f := 7, g := 2 }), + 5 = map_guard_sequence_mixed(a,f,M5), + M6 = id(M5#{ c := 6, f := 8, h := 3 }), + 6 = map_guard_sequence_mixed(a,f,M6), + + %% error case + {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_mixed(a,b,M0)), + ok. + +map_guard_sequence_mixed(K1,K2,M) -> + case M of + #{ K1 := 1, b := 1, K2 := 3, g := 1} -> 1; + #{ K1 := 1, b := 2, K2 := 4, h := 2} -> 2; + #{ K1 := 1, b := 3, K2 := 5, g := 3} -> 3; + #{ K1 := 1, c := 4, K2 := 6, h := 1} -> 4; + #{ K1 := 1, c := 5, K2 := 7, g := 2} -> 5; + #{ K1 := 1, c := 6, K2 := 8, h := 3} -> 6 + end. + + + +t_frequency_table(Config) when is_list(Config) -> + random:seed({13,1337,54}), % pseudo random + N = 100000, + Ts = rand_terms(N), + #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}), + ok = check_frequency(Ts,Tf), + ok. + + +frequency_table([T|Ts], M) -> + case M of + #{ n := N, tf := #{ T := C } = F } -> + frequency_table(Ts,M#{ n := N + 1, tf := F#{ T := C + 1 }}); + #{ n := N, tf := F } -> + frequency_table(Ts,M#{ n := N + 1, tf := F#{ T => 1 }}) + end; +frequency_table([], M) -> M. + + +check_frequency(Ts,Tf) -> + check_frequency(Ts,Tf,dict:new()). + +check_frequency([T|Ts],Tf,D) -> + case dict:find(T,D) of + error -> check_frequency(Ts,Tf,dict:store(T,1,D)); + {ok,C} -> check_frequency(Ts,Tf,dict:store(T,C+1,D)) + end; +check_frequency([],Tf,D) -> + validate_frequency(dict:to_list(D),Tf). + +validate_frequency([{T,C}|Fs],Tf) -> + case Tf of + #{ T := C } -> validate_frequency(Fs,Tf); + _ -> error + end; +validate_frequency([], _) -> ok. + + +%% aux + +rand_terms(0) -> []; +rand_terms(N) -> [rand_term()|rand_terms(N-1)]. + +rand_term() -> + case random:uniform(6) of + 1 -> rand_binary(); + 2 -> rand_number(); + 3 -> rand_atom(); + 4 -> rand_tuple(); + 5 -> rand_list(); + 6 -> rand_map() + end. + +rand_binary() -> + case random:uniform(3) of + 1 -> <<>>; + 2 -> <<"hi">>; + 3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">> + end. + +rand_number() -> + case random:uniform(3) of + 1 -> random:uniform(5); + 2 -> float(random:uniform(5)); + 3 -> 1 bsl (63 + random:uniform(3)) + end. + +rand_atom() -> + case random:uniform(3) of + 1 -> hi; + 2 -> some_atom; + 3 -> some_other_atom + end. + + +rand_tuple() -> + case random:uniform(3) of + 1 -> {ok, rand_term()}; % careful + 2 -> {1, 2, 3}; + 3 -> {<<"yep">>, 1337} + end. + +rand_list() -> + case random:uniform(3) of + 1 -> "hi"; + 2 -> [1,rand_term()]; % careful + 3 -> [improper|list] + end. + +rand_map() -> + case random:uniform(3) of + 1 -> #{ hi => 3 }; + 2 -> #{ wat => rand_term(), other => 3 }; % careful + 3 -> #{ hi => 42, other => 42, yet_anoter => 1337 } + end. + + +t_build_and_match_over_alloc(Config) when is_list(Config) -> + Ls = id([1,2,3]), + V0 = [a|Ls], + M0 = id(#{ "a" => V0 }), + #{ "a" := V1 } = M0, + V2 = id([c|Ls]), + M2 = id(#{ "a" => V2 }), + #{ "a" := V3 } = M2, + {[a,1,2,3],[c,1,2,3]} = id({V1,V3}), + ok. + +t_build_and_match_empty_val(Config) when is_list(Config) -> + F = fun(#{ "hi":=_,{1,2}:=_,1337:=_}) -> ok end, + ok = F(id(#{"hi"=>ok,{1,2}=>ok,1337=>ok})), + + %% error case + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +t_build_and_match_val(Config) when is_list(Config) -> + F = fun + (#{ "hi" := first, v := V}) -> {1,V}; + (#{ "hi" := second, v := V}) -> {2,V} + end, + + + {1,"hello"} = F(id(#{"hi"=>first,v=>"hello"})), + {2,"second"} = F(id(#{"hi"=>second,v=>"second"})), + + %% error case + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +t_build_and_match_nil(Config) when is_list(Config) -> + %% literals removed the coverage + V1 = id(cookie), + V2 = id(cake), + V3 = id(crisps), + + #{ [] := V1, "treat" := V2, {your,treat} := V3 } = id(#{ + {your,treat} => V3, + "treat" => V2, + [] => V1 }), + #{ [] := V3, [] := V3 } = id(#{ [] => V1, [] => V3 }), + ok. + +t_build_and_match_structure(Config) when is_list(Config) -> + V2 = id("it"), + S = id([42,{"hi", "=)", #{ "a" => 42, any => any, val => "get_" ++ V2}}]), + + %% match deep map values + V2 = case S of + [42,{"hi",_, #{ "a" := 42, val := "get_" ++ V1, any := _ }}] -> V1 + end, + %% match deep map + ok = case S of + [42,{"hi",_, #{ }}] -> ok + end, ok. -getmsg(_Tracer) -> - receive V -> V after 100 -> timeout end. -trace_collector(Msg,Parent) -> - io:format("~p~n",[Msg]), - Parent ! Msg, - Parent. %% Use this function to avoid compile-time evaluation of an expression. id(I) -> I. diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index 4e26a9e95e..e482b1e6f8 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -238,7 +238,10 @@ <item>Include warnings for functions that only return by means of an exception.</item> <tag><c><![CDATA[-Wrace_conditions]]></c>***</tag> - <item>Include warnings for possible race conditions.</item> + <item>Include warnings for possible race conditions. Note that the + analysis that finds data races performs intra-procedural data flow analysis + and can sometimes explode in time. Enable it at your own risk. + </item> <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> <item>Warn about underspecified functions (the -spec is strictly more allowing than the success typing).</item> diff --git a/lib/dialyzer/doc/src/notes.xml b/lib/dialyzer/doc/src/notes.xml index bdd9c61c5c..d35639aa32 100644 --- a/lib/dialyzer/doc/src/notes.xml +++ b/lib/dialyzer/doc/src/notes.xml @@ -31,6 +31,36 @@ <p>This document describes the changes made to the Dialyzer application.</p> +<section><title>Dialyzer 2.7.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> A bug concerning <c>is_record/2,3</c> has been fixed, + as well as some cases where Dialyzer could crash due to + reaching system limits. </p> + <p> + Own Id: OTP-12018</p> + </item> + <item> + <p> When given the <c>-Wunderspecs</c> flag Dialyzer + sometimes output bogus warnings for parametrized types. + This bug has been fixed. </p> + <p> + Own Id: OTP-12111</p> + </item> + <item> + <p>Dialyzer now fetch the compile options from beam + files, and use them when creating core from the abstract + code. Previously the options were ignored. </p> + <p> + Own Id: OTP-12150</p> + </item> + </list> + </section> + +</section> + <section><title>Dialyzer 2.7.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index 6a33a2acb3..af1c2b7e3a 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -373,7 +373,16 @@ compile_byte(File, Callgraph, CServer, UseContracts) -> {error, " Could not get abstract code for: " ++ File ++ "\n" ++ " Recompile with +debug_info or analyze starting from source code"}; {ok, AbstrCode} -> - compile_common(File, AbstrCode, [], Callgraph, CServer, UseContracts) + compile_byte(File, AbstrCode, Callgraph, CServer, UseContracts) + end. + +compile_byte(File, AbstrCode, Callgraph, CServer, UseContracts) -> + case dialyzer_utils:get_compile_options_from_beam(File) of + error -> + {error, " Could not get compile options for: " ++ File ++ "\n" ++ + " Recompile or analyze starting from source code"}; + {ok, CompOpts} -> + compile_common(File, AbstrCode, CompOpts, Callgraph, CServer, UseContracts) end. compile_common(File, AbstrCode, CompOpts, Callgraph, CServer, UseContracts) -> diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index 1d458b49fc..bbedd3201e 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -102,14 +102,18 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], #state{plt = Plt, codeserver = Codeserver, records = Records} = State, Acc) -> {{Behaviour, Function, Arity}, - {{_BehFile, _BehLine}, Callback}} = Cb, + {{_BehFile, _BehLine}, Callback, Xtra}} = Cb, CbMFA = {Module, Function, Arity}, CbReturnType = dialyzer_contracts:get_contract_return(Callback), CbArgTypes = dialyzer_contracts:get_contract_args(Callback), Acc0 = Acc, Acc1 = case dialyzer_plt:lookup(Plt, CbMFA) of - 'none' -> [{callback_missing, [Behaviour, Function, Arity]}|Acc0]; + 'none' -> + case lists:member(optional_callback, Xtra) of + true -> Acc0; + false -> [{callback_missing, [Behaviour, Function, Arity]}|Acc0] + end; {'value', RetArgTypes} -> Acc00 = Acc0, {ReturnType, ArgTypes} = RetArgTypes, @@ -137,7 +141,7 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], Acc2 = case dialyzer_codeserver:lookup_mfa_contract(CbMFA, Codeserver) of 'error' -> Acc1; - {ok, {{File, Line}, Contract}} -> + {ok, {{File, Line}, Contract, _Xtra}} -> Acc10 = Acc1, SpecReturnType0 = dialyzer_contracts:get_contract_return(Contract), SpecArgTypes0 = dialyzer_contracts:get_contract_args(Contract), diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index aab3d6add6..593e71f30b 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -278,10 +278,10 @@ lookup_mod_contracts(Mod, #codeserver{contracts = ContDict}) case ets_dict_find(Mod, ContDict) of error -> dict:new(); {ok, Keys} -> - dict:from_list([get_contract_pair(Key, ContDict)|| Key <- Keys]) + dict:from_list([get_file_contract(Key, ContDict)|| Key <- Keys]) end. -get_contract_pair(Key, ContDict) -> +get_file_contract(Key, ContDict) -> {Key, ets:lookup_element(ContDict, Key, 2)}. -spec lookup_mfa_contract(mfa(), codeserver()) -> diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 1d2dfc7b2d..ee147ca102 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -20,8 +20,6 @@ -module(dialyzer_contracts). --compile(export_all). - -export([check_contract/2, check_contracts/4, contracts_without_fun/3, @@ -45,7 +43,7 @@ %% Types used in other parts of the system below %%----------------------------------------------------------------------- --type file_contract() :: {file_line(), #contract{}}. +-type file_contract() :: {file_line(), #contract{}, Extra :: [_]}. -type plt_contracts() :: [{mfa(), #contract{}}]. % actually, an orddict() @@ -148,10 +146,10 @@ process_contract_remote_types(CodeServer) -> ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer), RecordDict = dialyzer_codeserver:get_records(CodeServer), ContractFun = - fun({_M, _F, _A}, {File, #tmp_contract{contract_funs = CFuns, forms = Forms}}) -> + fun({_M, _F, _A}, {File, #tmp_contract{contract_funs = CFuns, forms = Forms}, Xtra}) -> NewCs = [CFun(ExpTypes, RecordDict) || CFun <- CFuns], Args = general_domain(NewCs), - {File, #contract{contracts = NewCs, args = Args, forms = Forms}} + {File, #contract{contracts = NewCs, args = Args, forms = Forms}, Xtra} end, ModuleFun = fun(_ModuleName, ContractDict) -> @@ -177,7 +175,7 @@ check_contracts(Contracts, Callgraph, FunTypes, FindOpaques) -> case dialyzer_callgraph:lookup_name(Label, Callgraph) of {ok, {M,F,A} = MFA} -> case orddict:find(MFA, Contracts) of - {ok, {_FileLine, Contract}} -> + {ok, {_FileLine, Contract, _Xtra}} -> Opaques = FindOpaques(M), case check_contract(Contract, Type, Opaques) of ok -> @@ -364,7 +362,7 @@ contracts_without_fun(Contracts, AllFuns0, Callgraph) -> [warn_spec_missing_fun(MFA, Contracts) || MFA <- ErrorContractMFAs]. warn_spec_missing_fun({M, F, A} = MFA, Contracts) -> - {FileLine, _Contract} = dict:fetch(MFA, Contracts), + {FileLine, _Contract, _Xtra} = dict:fetch(MFA, Contracts), {?WARN_CONTRACT_SYNTAX, FileLine, {spec_missing_fun, [M, F, A]}}. %% This treats the "when" constraints. It will be extended, we hope. @@ -388,14 +386,16 @@ insert_constraints([], Dict) -> Dict. -type types() :: erl_types:type_table(). --spec store_tmp_contract(mfa(), file_line(), [_], contracts(), types()) -> +-type spec_data() :: {TypeSpec :: [_], Xtra:: [_]}. + +-spec store_tmp_contract(mfa(), file_line(), spec_data(), contracts(), types()) -> contracts(). -store_tmp_contract(MFA, FileLine, TypeSpec, SpecDict, RecordsDict) -> +store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecDict, RecordsDict) -> %% io:format("contract from form: ~p\n", [TypeSpec]), TmpContract = contract_from_form(TypeSpec, RecordsDict, FileLine), %% io:format("contract: ~p\n", [TmpContract]), - dict:store(MFA, {FileLine, TmpContract}, SpecDict). + dict:store(MFA, {FileLine, TmpContract, Xtra}, SpecDict). contract_from_form(Forms, RecDict, FileLine) -> {CFuns, Forms1} = contract_from_form(Forms, RecDict, FileLine, [], []), @@ -599,7 +599,7 @@ get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, FindOpaques, get_invalid_contract_warnings_modules([], _CodeServer, _Plt, _FindOpaques, Acc) -> Acc. -get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left], +get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left], Plt, RecDict, FindOpaques, Acc) -> case dialyzer_plt:lookup(Plt, MFA) of none -> @@ -686,7 +686,7 @@ picky_contract_check(CSig0, Sig0, MFA, FileLine, Contract, RecDict, Acc) -> true -> Acc; false -> case extra_contract_warning(MFA, FileLine, Contract, - CSig, Sig, RecDict) of + CSig0, Sig0, RecDict) of no_warning -> Acc; {warning, Warning} -> [Warning|Acc] end @@ -752,7 +752,8 @@ is_remote_types_related(Contract, CSig, Sig, RecDict) -> t_from_forms_without_remote([{FType, []}], RecDict) -> Type0 = erl_types:t_from_form(FType, RecDict), - {ok, erl_types:subst_all_remote(Type0, erl_types:t_none())}; + Type1 = erl_types:subst_all_remote(Type0, erl_types:t_none()), + {ok, erl_types:subst_all_vars_to_any(Type1)}; t_from_forms_without_remote([{_FType, _Constrs}], _RecDict) -> %% 'When' constraints unsupported; diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 92aab68ad6..46467a1303 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -93,6 +93,8 @@ -define(TYPE_LIMIT, 3). +-define(BITS, 128). + -record(state, {callgraph :: dialyzer_callgraph:callgraph(), envs :: env_tab(), fun_tab :: fun_tab(), @@ -1610,10 +1612,18 @@ bind_bin_segs([Seg|Segs], BinType, Acc, Map, State) -> SizeVal = lists:max(List), Flags = cerl:concrete(cerl:bitstr_flags(Seg)), N = SizeVal * UnitVal, - case lists:member(signed, Flags) of - true -> t_from_range(-(1 bsl (N - 1)), 1 bsl (N - 1) - 1); - false -> t_from_range(0, 1 bsl N - 1) - end + case N >= ?BITS of + true -> + case lists:member(signed, Flags) of + true -> t_from_range(neg_inf, pos_inf); + false -> t_from_range(0, pos_inf) + end; + false -> + case lists:member(signed, Flags) of + true -> t_from_range(-(1 bsl (N - 1)), 1 bsl (N - 1) - 1); + false -> t_from_range(0, 1 bsl N - 1) + end + end end end, {Map2, [_]} = bind_pat_vars([Val], [ValConstr], [], Map1, State, false), @@ -2771,8 +2781,7 @@ filter_match_fail([]) -> %%% =========================================================================== state__new(Callgraph, Tree, Plt, Module, Records) -> - Opaques = erl_types:module_builtin_opaques(Module) ++ - erl_types:t_opaque_from_records(Records), + Opaques = erl_types:t_opaque_from_records(Records), TreeMap = build_tree_map(Tree), Funs = dict:fetch_keys(TreeMap), FunTab = init_fun_tab(Funs, dict:new(), TreeMap, Callgraph, Plt), diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 63798f44b1..7c970daf41 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -158,9 +158,7 @@ lookup_contract(#mini_plt{contracts = ETSContracts}, ets_table_lookup(ETSContracts, MFA). -spec lookup_callbacks(plt(), module()) -> - 'none' | {'value', [{mfa(), {{Filename::string(), - Line::pos_integer()}, - #contract{}}}]}. + 'none' | {'value', [{mfa(), dialyzer_contracts:file_contract()}]}. lookup_callbacks(#mini_plt{callbacks = ETSCallbacks}, Mod) when is_atom(Mod) -> ets_table_lookup(ETSCallbacks, Mod). @@ -618,9 +616,7 @@ table_insert_list(Plt, [{Key, Val}|Left]) -> table_insert_list(Plt, []) -> Plt. -table_insert(Plt, Key, {_Ret, _Arg} = Obj) -> - dict:store(Key, Obj, Plt); -table_insert(Plt, Key, #contract{} = C) -> +table_insert(Plt, Key, {_File, #contract{}, _Xtra} = C) -> dict:store(Key, C, Plt). table_lookup(Plt, Obj) -> diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index ef9b00e203..6dc4285194 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -201,7 +201,7 @@ postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {CallF, CallL}, Msg}|Rest], Codeserver, WAcc, Acc) -> {contract_range, [Contract, M, F, A, ArgStrings, CRet]} = Msg, case dialyzer_codeserver:lookup_mfa_contract({M,F,A}, Codeserver) of - {ok, {{ContrF, _ContrL} = FileLine, _C}} -> + {ok, {{ContrF, _ContrL} = FileLine, _C, _X}} -> case CallF =:= ContrF of true -> NewMsg = {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]}, @@ -401,7 +401,7 @@ decorate_succ_typings(Contracts, Callgraph, FunTypes, FindOpaques) -> case dialyzer_callgraph:lookup_name(Label, Callgraph) of {ok, MFA} -> case orddict:find(MFA, Contracts) of - {ok, {_FileLine, Contract}} -> + {ok, {_FileLine, Contract, _Xtra}} -> Args = dialyzer_contracts:get_contract_args(Contract), Ret = dialyzer_contracts:get_contract_return(Contract), C = erl_types:t_fun(Args, Ret), @@ -422,10 +422,7 @@ lookup_and_find_opaques_fun(Codeserver) -> end. find_opaques_fun(Records) -> - fun(Module) -> - erl_types:module_builtin_opaques(Module) ++ - erl_types:t_opaque_from_records(Records) - end. + fun(_Module) -> erl_types:t_opaque_from_records(Records) end. get_fun_types_from_plt(FunList, Callgraph, Plt) -> get_fun_types_from_plt(FunList, Callgraph, Plt, dict:new()). diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index e1bcd72c0b..e5f5c69d45 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -31,6 +31,7 @@ format_sig/1, format_sig/2, get_abstract_code_from_beam/1, + get_compile_options_from_beam/1, get_abstract_code_from_src/1, get_abstract_code_from_src/2, get_core_from_abstract_code/1, @@ -97,7 +98,7 @@ get_abstract_code_from_src(File) -> {'ok', abstract_code()} | {'error', [string()]}. get_abstract_code_from_src(File, Opts) -> - case compile:file(File, [to_pp, binary|Opts]) of + case compile:noenv_file(File, [to_pp, binary|Opts]) of error -> {error, []}; {error, Errors, _} -> {error, format_errors(Errors)}; {ok, _, AbstrCode} -> {ok, AbstrCode} @@ -136,6 +137,26 @@ get_abstract_code_from_beam(File) -> error end. +-spec get_compile_options_from_beam(file:filename()) -> 'error' | {'ok', [compile:option()]}. + +get_compile_options_from_beam(File) -> + case beam_lib:chunks(File, [compile_info]) of + {ok, {_, List}} -> + case lists:keyfind(compile_info, 1, List) of + {compile_info, CompInfo} -> compile_info_to_options(CompInfo); + _ -> error + end; + _ -> + %% No or unsuitable compile info. + error + end. + +compile_info_to_options(CompInfo) -> + case lists:keyfind(options, 1, CompInfo) of + {options, CompOpts} -> {ok, CompOpts}; + _ -> error + end. + -type get_core_from_abs_ret() :: {'ok', cerl:c_module()} | 'error'. -spec get_core_from_abstract_code(abstract_code()) -> get_core_from_abs_ret(). @@ -150,7 +171,9 @@ get_core_from_abstract_code(AbstrCode, Opts) -> %% performed them. In some cases we end up in trouble when %% performing them again. AbstrCode1 = cleanup_parse_transforms(AbstrCode), - try compile:forms(AbstrCode1, Opts ++ src_compiler_opts()) of + %% Remove parse_transforms (and other options) from compile options. + Opts2 = cleanup_compile_options(Opts), + try compile:noenv_forms(AbstrCode1, Opts2 ++ src_compiler_opts()) of {ok, _, Core} -> {ok, Core}; _What -> error catch @@ -322,8 +345,26 @@ merge_records(NewRecords, OldRecords) -> {'ok', spec_dict(), callback_dict()} | {'error', string()}. get_spec_info(ModName, AbstractCode, RecordsDict) -> + OptionalCallbacks0 = get_optional_callbacks(AbstractCode, ModName), + OptionalCallbacks = gb_sets:from_list(OptionalCallbacks0), get_spec_info(AbstractCode, dict:new(), dict:new(), - RecordsDict, ModName, "nofile"). + RecordsDict, ModName, OptionalCallbacks, "nofile"). + +get_optional_callbacks(Abs, ModName) -> + [{ModName, F, A} || {F, A} <- get_optional_callbacks(Abs)]. + +get_optional_callbacks(Abs) -> + L = [O || + {attribute, _, optional_callbacks, O} <- Abs, + is_fa_list(O)], + lists:append(L). + +is_fa_list([{FuncName, Arity}|L]) + when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> + is_fa_list(L); +is_fa_list([]) -> true; +is_fa_list(_) -> false. + %% TypeSpec is a list of conditional contracts for a function. %% Each contract is of the form {[Argument], Range, [Constraint]} where @@ -332,13 +373,14 @@ get_spec_info(ModName, AbstractCode, RecordsDict) -> %% are erl_types:erl_type() get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left], - SpecDict, CallbackDict, RecordsDict, ModName, File) + SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File) when ((Contract =:= 'spec') or (Contract =:= 'callback')), is_list(TypeSpec) -> MFA = case Id of {_, _, _} = T -> T; {F, A} -> {ModName, F, A} end, + Xtra = [optional_callback || gb_sets:is_member(MFA, OptCb)], ActiveDict = case Contract of spec -> SpecDict; @@ -346,8 +388,9 @@ get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left], end, try dict:find(MFA, ActiveDict) of error -> + SpecData = {TypeSpec, Xtra}, NewActiveDict = - dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, TypeSpec, + dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, SpecData, ActiveDict, RecordsDict), {NewSpecDict, NewCallbackDict} = case Contract of @@ -355,8 +398,8 @@ get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left], callback -> {SpecDict, NewActiveDict} end, get_spec_info(Left, NewSpecDict, NewCallbackDict, - RecordsDict, ModName,File); - {ok, {{OtherFile, L},_C}} -> + RecordsDict, ModName, OptCb, File); + {ok, {{OtherFile, L}, _D}} -> {Mod, Fun, Arity} = MFA, Msg = flat_format(" Contract/callback for function ~w:~w/~w " "already defined in ~s:~w\n", @@ -368,13 +411,15 @@ get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left], [Ln, Error])} end; get_spec_info([{attribute, _, file, {IncludeFile, _}}|Left], - SpecDict, CallbackDict, RecordsDict, ModName, _File) -> + SpecDict, CallbackDict, RecordsDict, ModName, OptCb, _File) -> get_spec_info(Left, SpecDict, CallbackDict, - RecordsDict, ModName, IncludeFile); + RecordsDict, ModName, OptCb, IncludeFile); get_spec_info([_Other|Left], SpecDict, CallbackDict, - RecordsDict, ModName, File) -> - get_spec_info(Left, SpecDict, CallbackDict, RecordsDict, ModName, File); -get_spec_info([], SpecDict, CallbackDict, _RecordsDict, _ModName, _File) -> + RecordsDict, ModName, OptCb, File) -> + get_spec_info(Left, SpecDict, CallbackDict, + RecordsDict, ModName, OptCb, File); +get_spec_info([], SpecDict, CallbackDict, + _RecordsDict, _ModName, _OptCb, _File) -> {ok, SpecDict, CallbackDict}. %% ============================================================================ @@ -419,6 +464,20 @@ cleanup_parse_transforms([Other|Left]) -> cleanup_parse_transforms([]) -> []. +-spec cleanup_compile_options([compile:option()]) -> [compile:option()]. + +cleanup_compile_options(Opts) -> + lists:filter(fun keep_compile_option/1, Opts). + +%% Using abstract, not asm or core. +keep_compile_option(from_asm) -> false; +keep_compile_option(from_core) -> false; +%% The parse transform will already have been applied, may cause +%% problems if it is re-applied. +keep_compile_option({parse_transform, _}) -> false; +keep_compile_option(warnings_as_errors) -> false; +keep_compile_option(_) -> true. + -spec format_errors([{module(), string()}]) -> [string()]. format_errors([{Mod, Errors}|Left]) -> diff --git a/lib/dialyzer/test/dialyzer_SUITE.erl b/lib/dialyzer/test/dialyzer_SUITE.erl index 1b62291a00..8507525597 100644 --- a/lib/dialyzer/test/dialyzer_SUITE.erl +++ b/lib/dialyzer/test/dialyzer_SUITE.erl @@ -30,12 +30,12 @@ -export([init_per_testcase/2, end_per_testcase/2]). %% Test cases must be exported. --export([app_test/1, appup_test/1]). +-export([app_test/1, appup_test/1, beam_tests/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_test, appup_test]. + [app_test, appup_test, beam_tests]. groups() -> []. @@ -75,3 +75,38 @@ app_test(Config) when is_list(Config) -> %% Test that the .appup file does not contain any `basic' errors appup_test(Config) when is_list(Config) -> ok = ?t:appup_test(dialyzer). + +beam_tests(Config) when is_list(Config) -> + Prog = <<" + -module(no_auto_import). + + %% Copied from erl_lint_SUITE.erl, clash6 + + -export([size/1]). + + size([]) -> + 0; + size({N,_}) -> + N; + size([_|T]) -> + 1+size(T). + ">>, + Opts = [no_auto_import], + {ok, BeamFile} = compile(Config, Prog, no_auto_import, Opts), + [] = run_dialyzer([BeamFile]), + ok. + +compile(Config, Prog, Module, CompileOpts) -> + Source = lists:concat([Module, ".erl"]), + PrivDir = ?config(priv_dir,Config), + Filename = filename:join([PrivDir, Source]), + ok = file:write_file(Filename, Prog), + Opts = [{outdir, PrivDir}, debug_info | CompileOpts], + {ok, Module} = compile:file(Filename, Opts), + {ok, filename:join([PrivDir, lists:concat([Module, ".beam"])])}. + +run_dialyzer(Files) -> + dialyzer:run([{analysis_type, plt_build}, + {files, Files}, + {from, byte_code}, + {check_plt, false}]). diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug5.erl b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug5.erl new file mode 100644 index 0000000000..28d739de8e --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug5.erl @@ -0,0 +1,10 @@ +%% Second arg of is_record call wasn't checked properly + +-module(opaque_bug5). + +-export([b/0]). + +b() -> + is_record(id({a}), id(a)). + +id(I) -> I. diff --git a/lib/dialyzer/test/small_SUITE_data/results/behaviour_info b/lib/dialyzer/test/small_SUITE_data/results/behaviour_info new file mode 100644 index 0000000000..2da4d26acb --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/behaviour_info @@ -0,0 +1,2 @@ + +with_bad_format_status.erl:12: The inferred type for the 1st argument of format_status/2 ('bad_arg') is not a supertype of 'normal' | 'terminate', which is expected type for this argument in the callback of the gen_server behaviour diff --git a/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_bad_format_status.erl b/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_bad_format_status.erl new file mode 100644 index 0000000000..24591e08fa --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_bad_format_status.erl @@ -0,0 +1,12 @@ +-module(with_bad_format_status). + +-behaviour(gen_server). +-export([handle_call/3,handle_cast/2,handle_info/2, + code_change/3, init/1, terminate/2, format_status/2]). +handle_call(_, _, S) -> {noreply, S}. +handle_cast(_, S) -> {noreply, S}. +handle_info(_, S) -> {noreply, S}. +code_change(_, _, _) -> {error, not_implemented}. +init(_) -> {ok, state}. +terminate(_, _) -> ok. +format_status(bad_arg, _) -> ok. % optional callback diff --git a/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_format_status.erl b/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_format_status.erl new file mode 100644 index 0000000000..a56ff63d1d --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_format_status.erl @@ -0,0 +1,13 @@ +-module(with_format_status). + +-behaviour(gen_server). +-export([handle_call/3,handle_cast/2,handle_info/2, + code_change/3, init/1, terminate/2, format_status/2]). +-export([handle_call/3,handle_cast/2,handle_info/2]). +handle_call(_, _, S) -> {noreply, S}. +handle_cast(_, S) -> {noreply, S}. +handle_info(_, S) -> {noreply, S}. +code_change(_, _, _) -> {error, not_implemented}. +init(_) -> {ok, state}. +terminate(_, _) -> ok. +format_status(normal, _) -> ok. % optional callback diff --git a/lib/dialyzer/test/small_SUITE_data/src/limit.erl b/lib/dialyzer/test/small_SUITE_data/src/limit.erl new file mode 100644 index 0000000000..97ee585b77 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/limit.erl @@ -0,0 +1,20 @@ +%% Misc cases where Dialyzer would fail with system_limit or crash + +-module(limit). + +-export([tu/0, big/1, b2/0]). + +tu() -> + erlang:make_tuple(1 bsl 24, def, [{5,e},{1,a},{3,c}]). + +big(<<Int:1152921504606846976/unit:128,0,_/binary>>) -> {5,Int}. + +b2() -> + Maxbig = maxbig(), + _ = bnot Maxbig, + ok. + +maxbig() -> + %% We assume that the maximum arity is (1 bsl 19) - 1. + Ws = erlang:system_info(wordsize), + (((1 bsl ((16777184 * (Ws div 4))-1)) - 1) bsl 1) + 1. diff --git a/lib/dialyzer/test/small_SUITE_data/src/predef2.erl b/lib/dialyzer/test/small_SUITE_data/src/predef2.erl deleted file mode 100644 index b1d941a49a..0000000000 --- a/lib/dialyzer/test/small_SUITE_data/src/predef2.erl +++ /dev/null @@ -1,56 +0,0 @@ --module(predef2). - --export([array/1, dict/1, digraph/1, digraph2/1, gb_set/1, gb_tree/1, - queue/1, set/1, tid/0, tid2/0]). - --export_type([array/0, digraph/0, gb_set/0]). - --spec array(array()) -> array:array(). - -array(A) -> - array:relax(A). - --spec dict(dict()) -> dict:dict(). - -dict(D) -> - dict:store(1, a, D). - --spec digraph(digraph()) -> [digraph:edge()]. - -digraph(G) -> - digraph:edges(G). - --spec digraph2(digraph:graph()) -> [digraph:edge()]. - -digraph2(G) -> - digraph:edges(G). - --spec gb_set(gb_set()) -> gb_sets:set(). - -gb_set(S) -> - gb_sets:balance(S). - --spec gb_tree(gb_tree()) -> gb_trees:tree(). - -gb_tree(S) -> - gb_trees:balance(S). - --spec queue(queue()) -> queue:queue(). - -queue(Q) -> - queue:reverse(Q). - --spec set(set()) -> sets:set(). - -set(S) -> - sets:union([S]). - --spec tid() -> tid(). - -tid() -> - ets:new(tid, []). - --spec tid2() -> ets:tid(). - -tid2() -> - ets:new(tid, []). diff --git a/lib/dialyzer/test/underspecs_SUITE_data/results/arr b/lib/dialyzer/test/underspecs_SUITE_data/results/arr new file mode 100644 index 0000000000..9497d12eec --- /dev/null +++ b/lib/dialyzer/test/underspecs_SUITE_data/results/arr @@ -0,0 +1,4 @@ + +arr.erl:14: Type specification arr:test2(array:array(T),non_neg_integer(),T) -> array:array(T) is a supertype of the success typing: arr:test2(array:array(_),pos_integer(),_) -> array:array(_) +arr.erl:24: Type specification arr:test4(array:array(T),non_neg_integer(),_) -> array:array(T) is a supertype of the success typing: arr:test4(array:array(_),pos_integer(),_) -> array:array(_) +arr.erl:29: Type specification arr:test5(array:array(T),non_neg_integer(),T) -> array:array(T) is a supertype of the success typing: arr:test5(array:array(_),non_neg_integer(),integer()) -> array:array(_) diff --git a/lib/dialyzer/test/underspecs_SUITE_data/src/arr.erl b/lib/dialyzer/test/underspecs_SUITE_data/src/arr.erl new file mode 100644 index 0000000000..3b265ccec2 --- /dev/null +++ b/lib/dialyzer/test/underspecs_SUITE_data/src/arr.erl @@ -0,0 +1,41 @@ +-module(arr). + +%% http://erlang.org/pipermail/erlang-questions/2014-August/080445.html + +-define(A, array). + +-export([test/3, test2/3, test3/3, test4/3, test5/3, test6/3]). + +-spec test(?A:array(T), non_neg_integer(), T) -> ?A:array(T). + +test(Array, N, Value) -> + ?A:set(N, Value, Array). + +-spec test2(?A:array(T), non_neg_integer(), T) -> ?A:array(T). + +test2(Array, N, Value) when N > 0 -> + ?A:set(N, Value, Array). + +-spec test3(?A:array(T), non_neg_integer(), _) -> ?A:array(T). + +test3(Array, N, Value) -> + ?A:set(N, Value, Array). + +-spec test4(?A:array(T), non_neg_integer(), _) -> ?A:array(T). + +test4(Array, N, Value) when N > 0 -> + ?A:set(N, Value, Array). + +-spec test5(?A:array(T), non_neg_integer(), T) -> ?A:array(T). + +test5(Array, N, Value) when is_integer(Value) -> + ?A:set(N, Value, Array). + +%% One would ideally want a warning also for test6(), but the current +%% analysis of parametrized opaque types is not strong enough to +%% discover this. +-spec test6(?A:array(integer()), non_neg_integer(), integer()) -> + ?A:array(any()). + +test6(Array, N, Value) -> + ?A:set(N, Value, Array). diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk index b0cb3ec4f9..58cc77c2fa 100644 --- a/lib/dialyzer/vsn.mk +++ b/lib/dialyzer/vsn.mk @@ -1 +1 @@ -DIALYZER_VSN = 2.7.1 +DIALYZER_VSN = 2.7.2 diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index d89e1dfd26..7f69bdbfbf 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -42,6 +42,59 @@ first.</p> <!-- ===================================================================== --> +<section><title>diameter 1.7.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Don't leave extra bit in decoded AVP data.</p> + <p> + An extra bit could be communicated in the data field of a + diameter_avp record in the case of length errors. Of no + consequence for code using the record encoding of + Diameter messages, but code examining diameter_avp + records would see this bit.</p> + <p> + Dictionary files must be recompiled for the fix to have + effect.</p> + <p> + Own Id: OTP-12074</p> + </item> + <item> + <p> + Fix counting of outgoing requests and answers setting the + E-bit.</p> + <p> + OTP-11721 broke these counters for all outgoing requests + except DWR, and caused answers setting the E-bit to be + counted as unknown messages.</p> + <p> + Own Id: OTP-12080</p> + </item> + <item> + <p> + Fix Failed-AVP decode.</p> + <p> + The best-effort decode only worked for AVPs in the common + dictionary, not for those in the dictionary of the + application identified in the Diameter Header of the + answer message in question.</p> + <p> + Failed-AVP in an answer decoded with the RFC 3588 common + dictionary (diameter_gen_base_rfc3588) was regarded as an + error. The RFC 6733 dictionary was unaffected.</p> + <p> + Dictionary files must be recompiled for the fix to have + effect.</p> + <p> + Own Id: OTP-12094</p> + </item> + </list> + </section> + +</section> + <section><title>diameter 1.7</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -114,6 +167,9 @@ first.</p> M-bit, resulting in 5001) failed if the AVP contained a complete header.</p> <p> + Dictionary files must be recompiled for the fix to have + effect.</p> + <p> Own Id: OTP-11946</p> </item> <item> @@ -152,6 +208,9 @@ first.</p> otherwise not. AVPs of type Grouped are decoded as much as possible, as deeply as possible.</p> <p> + Dictionary files must be recompiled for the fix to have + effect.</p> + <p> Own Id: OTP-11936 Aux Id: OTP-11007 </p> </item> <item> diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl index 7e91ce375f..bc25f7d472 100644 --- a/lib/diameter/include/diameter_gen.hrl +++ b/lib/diameter/include/diameter_gen.hrl @@ -311,19 +311,55 @@ d(Name, Avp, Acc) -> Failed = relax(Name), %% Not AvpName or else a failed Failed-AVP %% decode is packed into 'AVP'. - try avp(decode, Data, AvpName) of + Mod = dict(Failed), %% Dictionary to decode in. + + try Mod:avp(decode, Data, AvpName) of V -> {Avps, T} = Acc, {H, A} = ungroup(V, Avp), {[H | Avps], pack_avp(Name, A, T)} catch error: Reason -> - d(undefined == Failed orelse is_failed(), Reason, Name, Avp, Acc) + d(undefined == Failed orelse is_failed(), + Reason, + Name, + trim(Avp), + Acc) after reset(?STRICT_KEY, Strict), reset(?FAILED_KEY, Failed) end. +%% trim/1 +%% +%% Remove any extra bit that was added in diameter_codec to induce a +%% 5014 error. + +trim(#diameter_avp{data = <<0:1, Bin/binary>>} = Avp) -> + Avp#diameter_avp{data = Bin}; + +trim(Avp) -> + Avp. + +%% dict/1 +%% +%% Retrieve the dictionary for the best-effort decode of Failed-AVP, +%% as put by diameter_codec:decode/2. See that function for the +%% explanation. + +dict(true) -> + case get({diameter_codec, dictionary}) of + undefined -> + ?MODULE; + Mod -> + Mod + end; + +dict(_) -> + ?MODULE. + +%% d/5 + %% Ignore a decode error within Failed-AVP ... d(true, _, Name, Avp, Acc) -> decode_AVP(Name, Avp, Acc); @@ -341,6 +377,8 @@ d(false, Reason, Name, Avp, {Avps, Acc}) -> {Rec, Failed} = Acc, {[Avp|Avps], {Rec, [rc(Reason, Avp) | Failed]}}. +%% relax/2 + %% Set false in the process dictionary as soon as we see a Grouped AVP %% that doesn't set the M-bit, so that is_strict() can say whether or %% not to ignore the M-bit on an encapsulated AVP. @@ -357,22 +395,23 @@ relax(_, _) -> is_strict() -> false /= getr(?STRICT_KEY). +%% relax/1 +%% %% Set true in the process dictionary as soon as we see Failed-AVP. %% Matching on 'Failed-AVP' assumes that this is the RFC AVP. %% Strictly, this doesn't need to be the case. + relax('Failed-AVP') -> - case getr(?FAILED_KEY) of - undefined -> - putr(?FAILED_KEY, true); - true = Yes -> - Yes - end; + is_failed() orelse putr(?FAILED_KEY, true); + relax(_) -> is_failed(). is_failed() -> true == getr(?FAILED_KEY). +%% reset/2 + reset(Key, undefined) -> eraser(Key); reset(_, _) -> @@ -453,8 +492,8 @@ pack_AVP(_, #diameter_avp{data = <<0:1, Data/binary>>} = Avp, Acc) -> {Rec, Failed} = Acc, {Rec, [{5014, Avp#diameter_avp{data = Data}} | Failed]}; -pack_AVP(Name, #diameter_avp{is_mandatory = M} = Avp, Acc) -> - case pack_arity(Name, M) of +pack_AVP(Name, #diameter_avp{is_mandatory = M, name = AvpName} = Avp, Acc) -> + case pack_arity(Name, AvpName, M) of 0 -> {Rec, Failed} = Acc, {Rec, [{if M -> 5001; true -> 5008 end, Avp} | Failed]}; @@ -462,10 +501,13 @@ pack_AVP(Name, #diameter_avp{is_mandatory = M} = Avp, Acc) -> pack(Arity, 'AVP', Avp, Acc) end. -%% Give Failed-AVP special treatment since it'll contain any -%% unrecognized mandatory AVP's. -pack_arity(Name, M) -> - NF = Name /= 'Failed-AVP' andalso not is_failed(), +%% Give Failed-AVP special treatment since (1) it'll contain any +%% unrecognized mandatory AVP's and (2) the RFC 3588 grammar failed to +%% allow for Failed-AVP in an answer-message. + +pack_arity(Name, AvpName, M) -> + IsFailed = Name == 'Failed-AVP' orelse is_failed(), + %% Not testing just Name /= 'Failed-AVP' means we're changing the %% packing of AVPs nested within Failed-AVP, but the point of %% ignoring errors within Failed-AVP is to decode as much as @@ -473,12 +515,18 @@ pack_arity(Name, M) -> %% packed into a dedicated field defeats that point. Note that we %% can't just test not is_failed() since this will be 'true' when %% packing an unknown AVP directly within Failed-AVP. - case NF andalso M andalso is_strict() of - true -> - 0; - false -> - avp_arity(Name, 'AVP') - end. + + pack_arity(IsFailed + orelse {Name, AvpName} == {'answer-message', 'Failed-AVP'} + orelse not M + orelse not is_strict(), + Name). + +pack_arity(true, Name) -> + avp_arity(Name, 'AVP'); + +pack_arity(false, _) -> + 0. %% 3588: %% diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl index 06a4f5de64..a2b04bfd63 100644 --- a/lib/diameter/src/base/diameter_codec.erl +++ b/lib/diameter/src/base/diameter_codec.erl @@ -237,15 +237,35 @@ rec2msg(Mod, Rec) -> %% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors. --spec decode(module(), #diameter_packet{} | binary()) +-spec decode(module() | {module(), module()}, #diameter_packet{} | binary()) -> #diameter_packet{}. +%% An Answer setting the E-bit. The application dictionary is needed +%% for the best-effort decode of Failed-AVP, and the best way to make +%% this available to the AVP decode in diameter_gen.hrl, without +%% having to rewrite the entire codec generation, is to place it in +%% the process dictionary. It's the code in diameter_gen.hrl (that's +%% included by every generated codec module) that looks for the entry. +%% Not ideal, but it solves the problem relatively simply. +decode({Mod, Mod}, Pkt) -> + decode(Mod, Pkt); +decode({Mod, AppMod}, Pkt) -> + Key = {?MODULE, dictionary}, + put(Key, AppMod), + try + decode(Mod, Pkt) + after + erase(Key) + end; + +%% Or not: a request, or an answer not setting the E-bit. decode(Mod, Pkt) -> decode(Mod:id(), Mod, Pkt). -%% If we're a relay application then just extract the avp's without -%% any decoding of their data since we don't know the application in -%% question. +%% decode/3 + +%% Relay application: just extract the avp's without any decoding of +%% their data since we don't know the application in question. decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) -> case collect_avps(Pkt) of {E, As} -> @@ -274,6 +294,8 @@ decode(Id, Mod, Bin) when is_binary(Bin) -> decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}). +%% decode_avps/4 + decode_avps(MsgName, Mod, Pkt, {E, Avps}) -> ?LOG(invalid_avp_length, Pkt#diameter_packet.header), #diameter_packet{errors = Failed} diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl index 31e570ae20..86fc43cdc5 100644 --- a/lib/diameter/src/base/diameter_peer_fsm.erl +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -477,6 +477,7 @@ send_CER(#state{state = {'Wait-Conn-Ack', Tmo}, hop_by_hop_id = Hid}} = Pkt = encode(CER, Dict), + incr(send, Pkt, Dict), send(TPid, Pkt), ?LOG(send, 'CER'), start_timer(Tmo, S#state{state = {'Wait-CEA', Hid, Eid}}). @@ -1100,6 +1101,7 @@ send_dpr(Reason, Opts, #state{transport = TPid, {'Origin-Realm', OR}, {'Disconnect-Cause', Cause}], Dict), + incr(send, Pkt, Dict), send(TPid, Pkt), dpa_timer(Tmo), ?LOG(send, 'DPR'), diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index b7cd311e02..ab56ca9cef 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -1573,7 +1573,8 @@ transports(#state{watchdogT = WatchdogT}) -> -define(OTHER_INFO, [connections, name, peers, - statistics]). + statistics, + info]). service_info(Item, S) when is_atom(Item) -> @@ -1663,6 +1664,7 @@ complete_info(Item, #state{service = Svc} = S) -> keys -> ?ALL_INFO ++ ?CAP_INFO ++ ?OTHER_INFO; all -> service_info(?ALL_INFO, S); statistics -> info_stats(S); + info -> info_info(S); connections -> info_connections(S); peers -> info_peers(S) end. @@ -1745,12 +1747,11 @@ peer_acc(PeerT, Acc, #watchdog{pid = Pid, state = WS, started = At, peer = TPid}) -> - dict:append(Ref, - [{type, Type}, - {options, Opts}, - {watchdog, {Pid, At, WS}} - | info_peer(PeerT, TPid, WS)], - Acc). + Info = [{type, Type}, + {options, Opts}, + {watchdog, {Pid, At, WS}} + | info_peer(PeerT, TPid, WS)], + dict:append(Ref, Info ++ [{info, info_process_info(Info)}], Acc). info_peer(PeerT, TPid, WS) when is_pid(TPid), WS /= ?WD_DOWN -> @@ -1762,6 +1763,49 @@ info_peer(PeerT, TPid, WS) info_peer(_, _, _) -> []. +info_process_info(Info) -> + lists:flatmap(fun ipi/1, Info). + +ipi({watchdog, {Pid, _, _}}) -> + info_pid(Pid); + +ipi({peer, {Pid, _}}) -> + info_pid(Pid); + +ipi({port, [{owner, Pid} | _]}) -> + info_pid(Pid); + +ipi(_) -> + []. + +info_pid(Pid) -> + case process_info(Pid, [message_queue_len, memory, binary]) of + undefined -> + []; + L -> + [{Pid, lists:map(fun({K,V}) -> {K, map_info(K,V)} end, L)}] + end. + +%% The binary list consists of 3-tuples {Ptr, Size, Count}, where Ptr +%% is a C pointer value, Size is the size of a referenced binary in +%% bytes, and Count is a global reference count. The same Ptr can +%% occur multiple times, once for each reference on the process heap. +%% In this case, the corresponding tuples will have Size in common but +%% Count may differ just because no global lock is taken when the +%% value is retrieved. +%% +%% The list can be quite large, and we aren't often interested in the +%% pointers or counts, so whittle this down to the number of binaries +%% referenced and their total byte count. +map_info(binary, L) -> + SzD = lists:foldl(fun({P,S,_}, D) -> dict:store(P,S,D) end, + dict:new(), + L), + {dict:size(SzD), dict:fold(fun(_,S,N) -> S + N end, 0, SzD)}; + +map_info(_, T) -> + T. + %% The point of extracting the config here is so that 'transport' info %% has one entry for each transport ref, the peer table only %% containing entries that have a living watchdog. @@ -1819,6 +1863,13 @@ mk_app(#diameter_app{} = A) -> info_pending(#state{} = S) -> diameter_traffic:pending(transports(S)). +%% info_info/1 +%% +%% Extract process_info from connections info. + +info_info(S) -> + [I || L <- conn_list(S), {info, I} <- L]. + %% info_connections/1 %% %% One entry per transport connection. Statistics for each entry are diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl index 5fac61f416..280d09d7e8 100644 --- a/lib/diameter/src/base/diameter_traffic.erl +++ b/lib/diameter/src/base/diameter_traffic.erl @@ -129,6 +129,11 @@ incr(Dir, #diameter_header{} = H, TPid, Dict) -> %% incr_error/4 %% --------------------------------------------------------------------------- +%% Identify messages using the application dictionary, not the encode +%% dictionary, which may differ in the case of answer-message. +incr_error(Dir, T, Pid, {_Dict, AppDict}) -> + incr_error(Dir, T, Pid, AppDict); + %% Decoded message without errors. incr_error(recv, #diameter_packet{errors = []}, _, _) -> ok; @@ -169,7 +174,7 @@ incr_error(Dir, Id, TPid) -> incr_rc(Dir, Pkt, TPid, Dict0) -> try - incr_rc(Dir, Pkt, Dict0, TPid, Dict0) + incr_result(Dir, Pkt, TPid, {Dict0, Dict0, Dict0}) catch exit: {E,_} when E == no_result_code; E == invalid_error_bit -> @@ -471,7 +476,7 @@ send_A({Caps, Pkt}, TPid, Dict0, _RecvData) -> %% unsupported application #diameter_packet{errors = [RC|_]} = Pkt, send_A(answer_message(RC, Caps, Dict0, Pkt), TPid, - Dict0, + {Dict0, Dict0}, Pkt, [], []); @@ -479,7 +484,7 @@ send_A({Caps, Pkt}, TPid, Dict0, _RecvData) -> %% unsupported application send_A({Caps, Pkt, App, {T, EvalPktFs, EvalFs}}, TPid, Dict0, RecvData) -> send_A(answer(T, Caps, Pkt, App, Dict0, RecvData), TPid, - Dict0, + {App#diameter_app.dictionary, Dict0}, Pkt, EvalPktFs, EvalFs); @@ -489,8 +494,8 @@ send_A(_, _, _, _) -> %% send_A/6 -send_A(T, TPid, Dict0, ReqPkt, EvalPktFs, EvalFs) -> - reply(T, TPid, Dict0, EvalPktFs, ReqPkt), +send_A(T, TPid, DictT, ReqPkt, EvalPktFs, EvalFs) -> + reply(T, TPid, DictT, EvalPktFs, ReqPkt), lists:foreach(fun diameter_lib:eval/1, EvalFs). %% answer/6 @@ -648,32 +653,32 @@ is_loop(Code, Vid, OH, Dict0, Avps) -> %% reply/5 %% Local answer ... -reply({Dict, Ans}, TPid, Dict0, Fs, ReqPkt) -> - reply(Ans, Dict, TPid, Dict0, Fs, ReqPkt); +reply({Dict, Ans}, TPid, {AppDict, Dict0}, Fs, ReqPkt) -> + local(Ans, TPid, {Dict, AppDict, Dict0}, Fs, ReqPkt); %% ... or relayed. reply(#diameter_packet{} = Pkt, TPid, _Dict0, Fs, _ReqPkt) -> eval_packet(Pkt, Fs), send(TPid, Pkt). -%% reply/6 +%% local/5 %% %% Send a locally originating reply. %% Skip the setting of Result-Code and Failed-AVP's below. This is %% undocumented and shouldn't be relied on. -reply([Msg], Dict, TPid, Dict0, Fs, ReqPkt) +local([Msg], TPid, DictT, Fs, ReqPkt) when is_list(Msg); is_tuple(Msg) -> - reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt#diameter_packet{errors = []}); + local(Msg, TPid, DictT, Fs, ReqPkt#diameter_packet{errors = []}); -reply(Msg, Dict, TPid, Dict0, Fs, ReqPkt) -> - Pkt = encode(Dict, +local(Msg, TPid, {Dict, AppDict, Dict0} = DictT, Fs, ReqPkt) -> + Pkt = encode({Dict, AppDict}, TPid, reset(make_answer_packet(Msg, ReqPkt), Dict, Dict0), Fs), - incr(send, Pkt, TPid, Dict), - incr_rc(send, Pkt, Dict, TPid, Dict0), %% count outgoing + incr(send, Pkt, TPid, AppDict), + incr_result(send, Pkt, TPid, DictT), %% count outgoing send(TPid, Pkt). %% reset/3 @@ -1038,29 +1043,29 @@ find(Pred, [H|T]) -> %% code, the missing vendor id, and a zero filled payload of the minimum %% required length for the omitted AVP will be added. -%% incr_rc/5 +%% incr_result/5 %% %% Increment a stats counter for result codes in incoming and outgoing %% answers. %% Outgoing message as binary: don't count. (Sending binaries is only %% partially supported.) -incr_rc(_, #diameter_packet{msg = undefined = No}, _, _, _) -> +incr_result(_, #diameter_packet{msg = undefined = No}, _, _) -> No; %% Incoming or outgoing. Outgoing with encode errors never gets here %% since encode fails. -incr_rc(Dir, Pkt, Dict, TPid, Dict0) -> +incr_result(Dir, Pkt, TPid, {Dict, AppDict, Dict0}) -> #diameter_packet{header = #diameter_header{is_error = E} = Hdr, msg = Msg, errors = Es} = Pkt, - Id = msg_id(Hdr, Dict), + Id = msg_id(Hdr, AppDict), %% Count incoming decode errors. - recv /= Dir orelse [] == Es orelse incr_error(Dir, Id, TPid, Dict), + recv /= Dir orelse [] == Es orelse incr_error(Dir, Id, TPid, AppDict), %% Exit on a missing result code. T = rc_counter(Dict, Msg), @@ -1074,12 +1079,27 @@ incr_rc(Dir, Pkt, Dict, TPid, Dict0) -> incr(TPid, {Id, Dir, Ctr}), Ctr. -%% Only count on known keeps so as not to be vulnerable to attack: -%% there are 2^32 (application ids) * 2^24 (command codes) * 2 (R-bits) -%% = 2^57 Ids for an attacker to choose from. +%% msg_id/2 + +msg_id(#diameter_packet{header = H}, Dict) -> + msg_id(H, Dict); + +%% Only count on known keys so as not to be vulnerable to attack: +%% there are 2^32 (application ids) * 2^24 (command codes) = 2^56 +%% pairs for an attacker to choose from. msg_id(Hdr, Dict) -> {_ApplId, Code, R} = Id = diameter_codec:msg_id(Hdr), - choose('' == Dict:msg_name(Code, 0 == R), unknown, Id). + case Dict:msg_name(Code, 0 == R) of + '' -> + unknown(Dict:id(), R); + _ -> + Id + end. + +unknown(?APP_ID_RELAY, R) -> + {relay, R}; +unknown(_, _) -> + unknown. %% No E-bit: can't be 3xxx. is_result(RC, false, _Dict0) -> @@ -1396,6 +1416,7 @@ send_R(Pkt0, packet = Pkt0}, try + incr(send, Pkt, TPid, Dict), TRef = send_request(TPid, Pkt, Req, SvcName, Timeout), Pid ! Ref, %% tell caller a send has been attempted handle_answer(SvcName, @@ -1431,14 +1452,14 @@ handle_answer(SvcName, App, {error, Req, Reason}) -> handle_error(App, Req, Reason, SvcName); handle_answer(SvcName, - #diameter_app{dictionary = Dict, + #diameter_app{dictionary = AppDict, id = Id} = App, {answer, Req, Dict0, Pkt}) -> - Mod = dict(Dict, Dict0, Pkt), - handle_A(errors(Id, diameter_codec:decode(Mod, Pkt)), + Dict = dict(AppDict, Dict0, Pkt), + handle_A(errors(Id, diameter_codec:decode({Dict, AppDict}, Pkt)), SvcName, - Mod, + Dict, Dict0, App, Req). @@ -1448,10 +1469,12 @@ handle_answer(SvcName, %% want to examine the answer? handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) -> - incr(recv, Pkt, TPid, Dict), + AppDict = App#diameter_app.dictionary, + + incr(recv, Pkt, TPid, AppDict), try - incr_rc(recv, Pkt, Dict, TPid, Dict0) %% count incoming + incr_result(recv, Pkt, TPid, {Dict, AppDict, Dict0}) %% count incoming of _ -> answer(Pkt, SvcName, App, Req) catch @@ -1468,6 +1491,8 @@ handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) -> answer(Pkt#diameter_packet{errors = [E|Es]}, SvcName, App, Req) end. +%% answer/4 + answer(Pkt, SvcName, #diameter_app{module = ModX, @@ -1568,13 +1593,18 @@ encode(Dict, TPid, Pkt, Fs) -> %% an encoded binary. This isn't the usual case and doesn't properly %% support retransmission but is useful for test. +encode(Dict, TPid, Pkt) + when is_atom(Dict) -> + encode({Dict, Dict}, TPid, Pkt); + %% A message to be encoded. -encode(Dict, TPid, #diameter_packet{bin = undefined} = Pkt) -> +encode(DictT, TPid, #diameter_packet{bin = undefined} = Pkt) -> + {Dict, AppDict} = DictT, try diameter_codec:encode(Dict, Pkt) catch exit: {diameter_codec, encode, T} = Reason -> - incr_error(send, T, TPid, Dict), + incr_error(send, T, TPid, AppDict), exit(Reason) end; @@ -1683,6 +1713,7 @@ resend_request(Pkt0, caps = Caps}, ?LOG(retransmission, Pkt#diameter_packet.header), + incr(TPid, {msg_id(Pkt, Dict), send, retransmission}), TRef = send_request(TPid, Pkt, Req, SvcName, Tmo), {TRef, Req}. diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl index 5a068c1a25..d91a776321 100644 --- a/lib/diameter/src/compiler/diameter_codegen.erl +++ b/lib/diameter/src/compiler/diameter_codegen.erl @@ -132,7 +132,7 @@ gen(parse, ParseD, _Mod) -> [?VERSION | ParseD]; gen(forms, ParseD, Mod) -> - pp(erl_forms(Mod, ParseD)); + preprocess(Mod, erl_forms(Mod, ParseD)); gen(hrl, ParseD, Mod) -> gen_hrl(Mod, ParseD); @@ -838,19 +838,19 @@ rec_name(Name, Prefix) -> Prefix ++ Name. %% =========================================================================== -%% pp/1 +%% preprocess/2 %% %% Preprocess forms as generated by 'forms' option. In particular, %% replace the include_lib attributes in generated forms by the %% corresponding forms, extracting the latter from an existing %% dictionary (diameter_gen_relay). The resulting forms can be %% compiled to beam using compile:forms/2 (which does no preprocessing -%% or it's own; DiY currently appears to be the only way to preprocess +%% of it's own; DiY currently appears to be the only way to preprocess %% a forms list). -pp(Forms) -> +preprocess(Mod, Forms) -> {_, Beam, _} = code:get_object_code(diameter_gen_relay), - pp(Forms, abstract_code(Beam)). + pp(Forms, remod(Mod, abstract_code(Beam))). pp(Forms, {ok, Code}) -> Files = files(Code, []), @@ -859,6 +859,25 @@ pp(Forms, {ok, Code}) -> pp(Forms, {error, Reason}) -> erlang:error({forms, Reason, Forms}). +%% Replace literal diameter_gen_relay atoms in the extracted forms. +%% ?MODULE for example. + +remod(Mod, L) + when is_list(L) -> + [remod(Mod, T) || T <- L]; + +remod(Mod, {atom, _, diameter_gen_relay} = T) -> + setelement(3, T, Mod); + +remod(Mod, T) + when is_tuple(T) -> + list_to_tuple(remod(Mod, tuple_to_list(T))); + +remod(_, T) -> + T. + +%% Replace include_lib by the corresponding forms. + include({attribute, _, include_lib, Path}, Files) -> Inc = filename:basename(Path), [{Inc, Forms}] = [T || {F, _} = T <- Files, F == Inc], %% expect one @@ -867,6 +886,8 @@ include({attribute, _, include_lib, Path}, Files) -> include(T, _) -> [T]. +%% Extract abstract code. + abstract_code(Beam) -> case beam_lib:chunks(Beam, [abstract_code]) of {ok, {_Mod, [{abstract_code, {_Vsn, Code}}]}} -> @@ -877,6 +898,8 @@ abstract_code(Beam) -> {E, Reason} end. +%% Extract filename/forms pairs for included forms. + files([{attribute, _, file, {Path, _}} | T], Acc) -> {Body, Rest} = lists:splitwith(fun({attribute, _, file, _}) -> false; (_) -> true diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index 3b6e259f5a..40580e3ce6 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -46,7 +46,16 @@ {load_module, diameter_gen_base_accounting}, {load_module, diameter_gen_relay}, {load_module, diameter_codec}, - {load_module, diameter_sctp}]} + {load_module, diameter_sctp}]}, + {"1.7", [{load_module, diameter_service}, %% 17.1 + {load_module, diameter_codec}, + {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_gen_acct_rfc6733}, + {load_module, diameter_gen_base_rfc3588}, + {load_module, diameter_gen_base_accounting}, + {load_module, diameter_gen_relay}, + {load_module, diameter_traffic}, + {load_module, diameter_peer_fsm}]} ], [ {"0.9", [{restart_application, diameter}]}, @@ -75,6 +84,15 @@ {load_module, diameter_peer_fsm}, {load_module, diameter_watchdog}, {load_module, diameter_traffic}, - {load_module, diameter_lib}]} + {load_module, diameter_lib}]}, + {"1.7", [{load_module, diameter_peer_fsm}, + {load_module, diameter_traffic}, + {load_module, diameter_gen_relay}, + {load_module, diameter_gen_base_accounting}, + {load_module, diameter_gen_base_rfc3588}, + {load_module, diameter_gen_acct_rfc6733}, + {load_module, diameter_gen_base_rfc6733}, + {load_module, diameter_codec}, + {load_module, diameter_service}]} ] }. diff --git a/lib/diameter/src/info/diameter_dbg.erl b/lib/diameter/src/info/diameter_dbg.erl index b5b3983afa..b536e5e80b 100644 --- a/lib/diameter/src/info/diameter_dbg.erl +++ b/lib/diameter/src/info/diameter_dbg.erl @@ -32,7 +32,8 @@ compiled/0, procs/0, latest/0, - nl/0]). + nl/0, + sizes/0]). -export([diameter_config/0, diameter_peer/0, @@ -69,7 +70,16 @@ -define(VALUES(Rec), tl(tuple_to_list(Rec))). %% ---------------------------------------------------------- -%% # table(TableName) +%% # sizes/0 +%% +%% Return sizes of named tables. +%% ---------------------------------------------------------- + +sizes() -> + [{T, ets:info(T, size)} || T <- ?LOCAL, T /= diameter_peer]. + +%% ---------------------------------------------------------- +%% # table/1 %% %% Pretty-print a diameter table. Returns the number of records %% printed, or undefined. @@ -97,7 +107,7 @@ split([F|Fs], [V|Vs]) -> {F, Fs, V, Vs}. %% ---------------------------------------------------------- -%% # TableName() +%% # TableName/0 %% ---------------------------------------------------------- -define(TABLE(Name), Name() -> table(Name)). @@ -111,7 +121,7 @@ split([F|Fs], [V|Vs]) -> ?TABLE(diameter_stats). %% ---------------------------------------------------------- -%% # tables() +%% # tables/0 %% %% Pretty-print diameter tables from all nodes. Returns the number of %% records printed. @@ -127,7 +137,7 @@ split(_, Fs, Vs) -> split(Fs, Vs). %% ---------------------------------------------------------- -%% # modules() +%% # modules/0 %% ---------------------------------------------------------- modules() -> @@ -140,49 +150,49 @@ appdir() -> [_|_] = code:lib_dir(?APP, ebin). %% ---------------------------------------------------------- -%% # versions() +%% # versions/0 %% ---------------------------------------------------------- versions() -> ?I:versions(modules()). %% ---------------------------------------------------------- -%% # versions() +%% # version_info/0 %% ---------------------------------------------------------- version_info() -> ?I:version_info(modules()). %% ---------------------------------------------------------- -%% # compiled() +%% # compiled/0 %% ---------------------------------------------------------- compiled() -> ?I:compiled(modules()). %% ---------------------------------------------------------- -%% procs() +%% # procs/0 %% ---------------------------------------------------------- procs() -> ?I:procs(?APP). %% ---------------------------------------------------------- -%% # latest() +%% # latest/0 %% ---------------------------------------------------------- latest() -> ?I:latest(modules()). %% ---------------------------------------------------------- -%% # nl() +%% # nl/0 %% ---------------------------------------------------------- nl() -> lists:foreach(fun(M) -> abcast = c:nl(M) end, modules()). %% ---------------------------------------------------------- -%% # pp(Bin) +%% # pp/1 %% %% Description: Pretty-print a message binary. %% ---------------------------------------------------------- @@ -317,7 +327,7 @@ ppp({Field, Value}) -> io:format(": ~-22s : ~p~n", [Field, Value]). %% ---------------------------------------------------------- -%% # subscriptions() +%% # subscriptions/0 %% %% Returns a list of {SvcName, Pid}. %% ---------------------------------------------------------- @@ -326,7 +336,7 @@ subscriptions() -> diameter_service:subscriptions(). %% ---------------------------------------------------------- -%% # children() +%% # children/0 %% ---------------------------------------------------------- children() -> diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 560c2aed50..4e54e4eafc 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -18,5 +18,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 1.7 +DIAMETER_VSN = 1.7.1 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/edoc/doc/src/notes.xml b/lib/edoc/doc/src/notes.xml index b3440ce6e1..52b7529f70 100644 --- a/lib/edoc/doc/src/notes.xml +++ b/lib/edoc/doc/src/notes.xml @@ -31,6 +31,22 @@ <p>This document describes the changes made to the EDoc application.</p> +<section><title>Edoc 0.7.15</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix spec to doc generation from erl_docgen and edoc for + maps</p> + <p> + Own Id: OTP-12058</p> + </item> + </list> + </section> + +</section> + <section><title>Edoc 0.7.14</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/edoc/src/edoc_data.erl b/lib/edoc/src/edoc_data.erl index f88ba05f4b..eceb5cb1bd 100644 --- a/lib/edoc/src/edoc_data.erl +++ b/lib/edoc/src/edoc_data.erl @@ -173,21 +173,34 @@ callbacks(Es, Module, Env, Opts) -> lists:keymember(callback, 1, Module#module.attributes) of true -> - try (Module#module.name):behaviour_info(callbacks) of - Fs -> - Fs1 = [{F,A} || {F,A} <- Fs, is_atom(F), is_integer(A)], - if Fs1 =:= [] -> - []; - true -> - [{callbacks, - [callback(F, Env, Opts) || F <- Fs1]}] - end - catch - _:_ -> [] - end; + M = Module#module.name, + Fs = get_callback_functions(M, callbacks), + Os1 = get_callback_functions(M, optional_callbacks), + Fs1 = [FA || FA <- Fs, not lists:member(FA, Os1)], + Req = if Fs1 =:= [] -> + []; + true -> + [{callbacks, + [callback(FA, Env, Opts) || FA <- Fs1]}] + end, + Opt = if Os1 =:= [] -> + []; + true -> + [{optional_callbacks, + [callback(FA, Env, Opts) || FA <- Os1]}] + end, + Req ++ Opt; false -> [] end. +get_callback_functions(M, Callbacks) -> + try + [FA || {F, A} = FA <- M:behaviour_info(Callbacks), + is_atom(F), is_integer(A), A >= 0] + catch + _:_ -> [] + end. + %% <!ELEMENT callback EMPTY> %% <!ATTLIST callback %% name CDATA #REQUIRED diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index f4e78e8f3a..36d067d9bc 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -701,6 +701,8 @@ deprecated(Es, S) -> end. behaviours(Es, Name) -> + CBs = get_content(callbacks, Es), + OCBs = get_content(optional_callbacks, Es), (case get_elem(behaviour, Es) of [] -> []; Es1 -> @@ -709,13 +711,24 @@ behaviours(Es, Name) -> ?NL] end ++ - case get_content(callbacks, Es) of - [] -> []; - Es1 -> + if CBs =:= [], OCBs =:= [] -> + []; + true -> + Req = if CBs =:= [] -> + []; + true -> + [br, " Required callback functions: "] + ++ seq(fun callback/1, CBs, ["."]) + end, + Opt = if OCBs =:= [] -> + []; + true -> + [br, " Optional callback functions: "] + ++ seq(fun callback/1, OCBs, ["."]) + end, [{p, ([{b, ["This module defines the ", {tt, [Name]}, - " behaviour."]}, - br, " Required callback functions: "] - ++ seq(fun callback/1, Es1, ["."]))}, + " behaviour."]}] + ++ Req ++ Opt)}, ?NL] end). @@ -831,8 +844,6 @@ t_type([#xmlElement{name = nonempty_list, content = Es}]) -> t_nonempty_list(Es); t_type([#xmlElement{name = map, content = Es}]) -> t_map(Es); -t_type([#xmlElement{name = map_field, content=Es}]) -> - t_map_field(Es); t_type([#xmlElement{name = tuple, content = Es}]) -> t_tuple(Es); t_type([#xmlElement{name = 'fun', content = Es}]) -> @@ -882,9 +893,10 @@ t_fun(Es) -> [") -> "] ++ t_utype(get_elem(type, Es))). t_map(Es) -> - ["#{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). + Fs = get_elem(map_field, Es), + ["#{"] ++ seq(fun t_map_field/1, Fs, ["}"]). -t_map_field([K,V]) -> +t_map_field(#xmlElement{content = [K,V]}) -> t_utype_elem(K) ++ [" => "] ++ t_utype_elem(V). t_record(E, Es) -> @@ -1084,8 +1096,6 @@ ot_type([#xmlElement{name = tuple, content = Es}]) -> ot_tuple(Es); ot_type([#xmlElement{name = map, content = Es}]) -> ot_map(Es); -ot_type([#xmlElement{name = map_field, content = Es}]) -> - ot_map_field(Es); ot_type([#xmlElement{name = 'fun', content = Es}]) -> ot_fun(Es); ot_type([#xmlElement{name = record, content = Es}]) -> @@ -1143,10 +1153,10 @@ ot_tuple(Es) -> {type,0,tuple,[ot_utype_elem(E) || E <- Es]}. ot_map(Es) -> - {type,0,map,[ot_utype_elem(E) || E <- Es]}. + {type,0,map,[ot_map_field(E) || E <- get_elem(map_field,Es)]}. -ot_map_field(Es) -> - {type,0,map_field_assoc,[ot_utype_elem(E) || E <- Es]}. +ot_map_field(#xmlElement{content=[K,V]}) -> + {type,0,map_field_assoc,ot_utype_elem(K), ot_utype_elem(V)}. ot_fun(Es) -> Range = ot_utype(get_elem(type, Es)), diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index 211a354c74..3bf81c6503 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -362,7 +362,7 @@ d2e({type,_,map,any}) -> #t_map{ types = []}; d2e({type,_,map,Es}) -> #t_map{ types = d2e(Es) }; -d2e({type,_,map_field_assoc,K,V}) -> +d2e({type,_,map_field_assoc,[K,V]}) -> #t_map_field{ k_type = d2e(K), v_type=d2e(V) }; d2e({type,_,map_field_exact,K,V}) -> #t_map_field{ k_type = d2e(K), v_type=d2e(V) }; @@ -388,6 +388,9 @@ d2e({record_field,L,_Name}=F) -> d2e({type,_,Name,Types0}) -> Types = d2e(Types0), typevar_anno(#t_type{name = #t_name{name = Name}, args = Types}, Types); +d2e({user_type,_,Name,Types0}) -> + Types = d2e(Types0), + typevar_anno(#t_type{name = #t_name{name = Name}, args = Types}, Types); d2e({var,_,'_'}) -> #t_type{name = #t_name{name = ?TOP_TYPE}}; d2e({var,_,TypeName}) -> diff --git a/lib/edoc/src/edoc_tags.erl b/lib/edoc/src/edoc_tags.erl index 264a533a52..82a1b72d84 100644 --- a/lib/edoc/src/edoc_tags.erl +++ b/lib/edoc/src/edoc_tags.erl @@ -329,10 +329,7 @@ parse_typedef(Data, Line, _Env, Where) -> NAs = length(As), case edoc_types:is_predefined(T, NAs) of true -> - case - edoc_types:is_new_predefined(T, NAs) - orelse edoc_types:is_predefined_otp_type(T, NAs) - of + case edoc_types:is_new_predefined(T, NAs) of false -> throw_error(Line, {"redefining built-in type '~w'.", [T]}); @@ -499,7 +496,6 @@ check_used_type(#t_name{name = N, module = Mod}=Name, Args, P, LocalTypes) -> Mod =/= [] orelse lists:member(TypeName, ets:lookup(DT, Name)) orelse edoc_types:is_predefined(N, NArgs) - orelse edoc_types:is_predefined_otp_type(N, NArgs) orelse lists:member(TypeName, LocalTypes) of true -> diff --git a/lib/edoc/src/edoc_types.erl b/lib/edoc/src/edoc_types.erl index d4e00d3ecd..65fba61a72 100644 --- a/lib/edoc/src/edoc_types.erl +++ b/lib/edoc/src/edoc_types.erl @@ -25,7 +25,7 @@ -module(edoc_types). --export([is_predefined/2, is_new_predefined/2, is_predefined_otp_type/2, +-export([is_predefined/2, is_new_predefined/2, to_ref/1, to_xml/2, to_label/1, arg_names/1, set_arg_names/2, arg_descs/1, range_desc/1]). @@ -34,67 +34,13 @@ -include("edoc_types.hrl"). -include_lib("xmerl/include/xmerl.hrl"). - -is_predefined(any, 0) -> true; -is_predefined(atom, 0) -> true; -is_predefined(binary, 0) -> true; -is_predefined(bool, 0) -> true; % kept for backwards compatibility -is_predefined(char, 0) -> true; is_predefined(cons, 2) -> true; is_predefined(deep_string, 0) -> true; -is_predefined(float, 0) -> true; -is_predefined(function, 0) -> true; -is_predefined(integer, 0) -> true; -is_predefined(list, 0) -> true; -is_predefined(list, 1) -> true; -is_predefined(nil, 0) -> true; -is_predefined(none, 0) -> true; -is_predefined(no_return, 0) -> true; -is_predefined(number, 0) -> true; -is_predefined(pid, 0) -> true; -is_predefined(port, 0) -> true; -is_predefined(reference, 0) -> true; -is_predefined(string, 0) -> true; -is_predefined(term, 0) -> true; -is_predefined(tuple, 0) -> true; -is_predefined(F, A) -> is_new_predefined(F, A). +is_predefined(F, A) -> erl_internal:is_type(F, A). -%% Should eventually be coalesced with is_predefined/2. -is_new_predefined(arity, 0) -> true; -is_new_predefined(bitstring, 0) -> true; -is_new_predefined(boolean, 0) -> true; -is_new_predefined(byte, 0) -> true; -is_new_predefined(iodata, 0) -> true; -is_new_predefined(iolist, 0) -> true; is_new_predefined(map, 0) -> true; -is_new_predefined(maybe_improper_list, 0) -> true; -is_new_predefined(maybe_improper_list, 2) -> true; -is_new_predefined(mfa, 0) -> true; -is_new_predefined(module, 0) -> true; -is_new_predefined(neg_integer, 0) -> true; -is_new_predefined(node, 0) -> true; -is_new_predefined(non_neg_integer, 0) -> true; -is_new_predefined(nonempty_improper_list, 2) -> true; -is_new_predefined(nonempty_list, 0) -> true; -is_new_predefined(nonempty_list, 1) -> true; -is_new_predefined(nonempty_maybe_improper_list, 0) -> true; -is_new_predefined(nonempty_maybe_improper_list, 2) -> true; -is_new_predefined(nonempty_string, 0) -> true; -is_new_predefined(pos_integer, 0) -> true; -is_new_predefined(timeout, 0) -> true; is_new_predefined(_, _) -> false. -%% The following types will be removed later, but they are currently -%% kind of built-in. -is_predefined_otp_type(array, 0) -> true; -is_predefined_otp_type(dict, 0) -> true; -is_predefined_otp_type(digraph, 0) -> true; -is_predefined_otp_type(gb_set, 0) -> true; -is_predefined_otp_type(gb_tree, 0) -> true; -is_predefined_otp_type(queue, 0) -> true; -is_predefined_otp_type(set, 0) -> true; -is_predefined_otp_type(_, _) -> false. - to_ref(#t_typedef{name = N}) -> to_ref(N); to_ref(#t_def{name = N}) -> @@ -129,8 +75,7 @@ to_xml(#t_type{name = N, args = As}, Env) -> Predef = case N of #t_name{module = [], name = T} -> NArgs = length(As), - (is_predefined(T, NArgs) - orelse is_predefined_otp_type(T, NArgs)); + is_predefined(T, NArgs); _ -> false end, @@ -143,7 +88,7 @@ to_xml(#t_fun{args = As, range = T}, Env) -> {'fun', [{argtypes, map(fun wrap_utype/2, As, Env)}, wrap_utype(T, Env)]}; to_xml(#t_map{ types = Ts}, Env) -> - {map, map(fun wrap_utype/2, Ts, Env)}; + {map, map(fun to_xml/2, Ts, Env)}; to_xml(#t_map_field{ k_type=K, v_type=V}, Env) -> {map_field, [wrap_utype(K,Env), wrap_utype(V, Env)]}; to_xml(#t_tuple{types = Ts}, Env) -> diff --git a/lib/edoc/vsn.mk b/lib/edoc/vsn.mk index 281a792118..b1cf115b29 100644 --- a/lib/edoc/vsn.mk +++ b/lib/edoc/vsn.mk @@ -1 +1 @@ -EDOC_VSN = 0.7.14 +EDOC_VSN = 0.7.15 diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index 8009a8d6a3..dbd478fb17 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -75,7 +75,9 @@ filter() See present/1, substrings/2, <p>Setup a connection to an LDAP server, the <c>HOST</c>'s are tried in order.</p> <p>The log function takes three arguments, <c>fun(Level, FormatString, [FormatArg]) end</c>.</p> <p>Timeout set the maximum time in milliseconds that each server request may take.</p> - <p>Currently, the only TCP socket option accepted is <c>inet6</c>. Default is <c>inet</c>.</p> + <p>All TCP socket options are accepted except + <c>active</c>, <c>binary</c>, <c>deliver</c>, <c>list</c>, <c>mode</c> and <c>packet</c> + </p> </desc> </func> <func> diff --git a/lib/eldap/doc/src/notes.xml b/lib/eldap/doc/src/notes.xml index 089bb731d4..f92d100757 100644 --- a/lib/eldap/doc/src/notes.xml +++ b/lib/eldap/doc/src/notes.xml @@ -30,7 +30,36 @@ </header> <p>This document describes the changes made to the Eldap application.</p> - <section><title>Eldap 1.0.3</title> + <section><title>Eldap 1.0.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + <c>eldap:open/2</c> and <c>eldap:open/3</c> gave wrong + return values for option errors.</p> + <p> + Own Id: OTP-12182</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Nearly all TCP options are possible to give in the + <c>eldap:open/2</c> call.</p> + <p> + Own Id: OTP-12171</p> + </item> + </list> + </section> + +</section> + +<section><title>Eldap 1.0.3</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 1cd328cde3..416334e365 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -12,6 +12,7 @@ -vc('$Id$ '). -export([open/1,open/2,simple_bind/3,controlling_process/2, start_tls/2, start_tls/3, + getopts/2, baseObject/0,singleLevel/0,wholeSubtree/0,close/1, equalityMatch/2,greaterOrEqual/2,lessOrEqual/2, approxMatch/2,search/2,substrings/2,present/1, @@ -92,6 +93,15 @@ start_tls(Handle, TlsOptions, Timeout) -> recv(Handle). %%% -------------------------------------------------------------------- +%%% Ask for option values on the socket. +%%% Warning: This is an undocumented function for testing purposes only. +%%% Use at own risk... +%%% -------------------------------------------------------------------- +getopts(Handle, OptNames) when is_pid(Handle), is_list(OptNames) -> + send(Handle, {getopts, OptNames}), + recv(Handle). + +%%% -------------------------------------------------------------------- %%% Shutdown connection (and process) asynchronous. %%% -------------------------------------------------------------------- @@ -374,24 +384,35 @@ parse_args([{sslopts, Opts}|T], Cpid, Data) when is_list(Opts) -> parse_args([{sslopts, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([{tcpopts, Opts}|T], Cpid, Data) when is_list(Opts) -> - parse_args(T, Cpid, Data#eldap{tcp_opts = inet6_opt(Opts) ++ Data#eldap.tcp_opts}); + parse_args(T, Cpid, Data#eldap{tcp_opts = tcp_opts(Opts,Cpid,Data#eldap.tcp_opts)}); parse_args([{log, F}|T], Cpid, Data) when is_function(F) -> parse_args(T, Cpid, Data#eldap{log = F}); parse_args([{log, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([H|_], Cpid, _) -> send(Cpid, {error,{wrong_option,H}}), + unlink(Cpid), exit(wrong_option); parse_args([], _, Data) -> Data. -inet6_opt(Opts) -> - case proplists:get_value(inet6, Opts) of +tcp_opts([Opt|Opts], Cpid, Acc) -> + Key = if is_atom(Opt) -> Opt; + is_tuple(Opt) -> element(1,Opt) + end, + case lists:member(Key,[active,binary,deliver,list,mode,packet]) of + false -> + tcp_opts(Opts, Cpid, [Opt|Acc]); true -> - [inet6]; - _ -> - [] - end. + tcp_opts_error(Opt, Cpid) + end; +tcp_opts([], _Cpid, Acc) -> Acc. + +tcp_opts_error(Opt, Cpid) -> + send(Cpid, {error, {{forbidden_tcp_option,Opt}, + "This option affects the eldap functionality and can't be set by user"}}), + unlink(Cpid), + exit(forbidden_tcp_option). %%% Try to connect to the hosts in the listed order, %%% and stop with the first one to which a successful @@ -466,6 +487,36 @@ loop(Cpid, Data) -> unlink(Cpid), exit(closed); + {From, {getopts, OptNames}} -> + Result = + try + [case OptName of + port -> {port, Data#eldap.port}; + log -> {log, Data#eldap.log}; + timeout -> {timeout, Data#eldap.timeout}; + ssl -> {ssl, Data#eldap.ldaps}; + {sslopts, SslOptNames} when Data#eldap.using_tls==true -> + case ssl:getopts(Data#eldap.fd, SslOptNames) of + {ok,SslOptVals} -> {sslopts, SslOptVals}; + {error,Reason} -> throw({error,Reason}) + end; + {sslopts, _} -> + throw({error,no_tls}); + {tcpopts, TcpOptNames} -> + case inet:getopts(Data#eldap.fd, TcpOptNames) of + {ok,TcpOptVals} -> {tcpopts, TcpOptVals}; + {error,Posix} -> throw({error,Posix}) + end + end || OptName <- OptNames] + of + OptsList -> {ok,OptsList} + catch + throw:Error -> Error; + Class:Error -> {error,{Class,Error}} + end, + send(From, Result), + ?MODULE:loop(Cpid, Data); + {Cpid, 'EXIT', Reason} -> ?PRINT("Got EXIT from Cpid, reason=~p~n",[Reason]), exit(Reason); diff --git a/lib/eldap/test/Makefile b/lib/eldap/test/Makefile index 3c5810eece..24e71cebaa 100644 --- a/lib/eldap/test/Makefile +++ b/lib/eldap/test/Makefile @@ -28,6 +28,7 @@ INCLUDES= -I. -I ../include # ---------------------------------------------------- MODULES= \ + eldap_connections_SUITE \ eldap_basic_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/eldap/test/README b/lib/eldap/test/README index 8774db1504..ec774c1ae3 100644 --- a/lib/eldap/test/README +++ b/lib/eldap/test/README @@ -19,7 +19,7 @@ This will however not work, since slapd is guarded by apparmor that checks that To make a local extension of alowed operations: sudo emacs /etc/apparmor.d/local/usr.sbin.slapd -and, after the change (yes, at least on Ubuntu it is right to edit ../local/.. but run with an other file) : +and, after the change (yes, at least on Ubuntu it is right to edit ../local/.. but run with another file): sudo apparmor_parser -r /etc/apparmor.d/usr.sbin.slapd diff --git a/lib/eldap/test/eldap_connections_SUITE.erl b/lib/eldap/test/eldap_connections_SUITE.erl new file mode 100644 index 0000000000..c5460fef09 --- /dev/null +++ b/lib/eldap/test/eldap_connections_SUITE.erl @@ -0,0 +1,147 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012-2014. All Rights Reserved. +%% +%% The 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(eldap_connections_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +%-include_lib("eldap/include/eldap.hrl"). + + +all() -> + [ + {group, v4}, + {group, v6} + ]. + + +init_per_group(v4, Config) -> + [{listen_opts, []}, + {listen_host, "localhost"}, + {connect_opts, []} + | Config]; +init_per_group(v6, Config) -> + {ok, Hostname} = inet:gethostname(), + case lists:member(list_to_atom(Hostname), ct:get_config(ipv6_hosts,[])) of + true -> + [{listen_opts, [inet6]}, + {listen_host, "::"}, + {connect_opts, [{tcpopts,[inet6]}]} + | Config]; + false -> + {skip, io_lib:format("~p is not an ipv6_host",[Hostname])} + end. + + +end_per_group(_GroupName, Config) -> + Config. + + +groups() -> + [{v4, [], [tcp_connection, tcp_connection_option]}, + {v6, [], [tcp_connection, tcp_connection_option]} + ]. + + +init_per_suite(Config) -> Config. + + +end_per_suite(_Config) -> ok. + + +init_per_testcase(_TestCase, Config) -> + case gen_tcp:listen(0, proplists:get_value(listen_opts,Config)) of + {ok,LSock} -> + {ok,{_,Port}} = inet:sockname(LSock), + [{listen_socket,LSock}, + {listen_port,Port} + | Config]; + Other -> + {fail, Other} + end. + + +end_per_testcase(_TestCase, Config) -> + catch gen_tcp:close( proplists:get_value(listen_socket, Config) ). + +%%%================================================================ +%%% +%%% Test cases +%%% +%%%---------------------------------------------------------------- +tcp_connection(Config) -> + Host = proplists:get_value(listen_host, Config), + Port = proplists:get_value(listen_port, Config), + Opts = proplists:get_value(connect_opts, Config), + case eldap:open([Host], [{port,Port}|Opts]) of + {ok,_H} -> + Sl = proplists:get_value(listen_socket, Config), + case gen_tcp:accept(Sl,1000) of + {ok,_S} -> ok; + {error,timeout} -> ct:fail("server side accept timeout",[]) + end; + Other -> ct:fail("eldap:open failed: ~p",[Other]) + end. + + +%%%---------------------------------------------------------------- +tcp_connection_option(Config) -> + Host = proplists:get_value(listen_host, Config), + Port = proplists:get_value(listen_port, Config), + Opts = proplists:get_value(connect_opts, Config), + Sl = proplists:get_value(listen_socket, Config), + + %% Make an option value to test. The option must be implemented on all + %% platforms that we test on. Must check what the default value is + %% so we don't happen to choose that particular value. + {ok,[{linger,DefaultLinger}]} = inet:getopts(Sl, [linger]), + TestLinger = case DefaultLinger of + {false,_} -> {true,5}; + {true,_} -> {false,0} + end, + + case catch eldap:open([Host], + [{port,Port},{tcpopts,[{linger,TestLinger}]}|Opts]) of + {ok,H} -> + case gen_tcp:accept(Sl,1000) of + {ok,_} -> + case eldap:getopts(H, [{tcpopts,[linger]}]) of + {ok,[{tcpopts,[{linger,ActualLinger}]}]} -> + case ActualLinger of + TestLinger -> + ok; + DefaultLinger -> + ct:fail("eldap:getopts: 'linger' didn't change," + " got ~p (=default) expected ~p", + [ActualLinger,TestLinger]); + _ -> + ct:fail("eldap:getopts: bad 'linger', got ~p expected ~p", + [ActualLinger,TestLinger]) + end; + Other -> + ct:fail("eldap:getopts: bad result ~p",[Other]) + end; + {error,timeout} -> + ct:fail("server side accept timeout",[]) + end; + + Other -> + ct:fail("eldap:open failed: ~p",[Other]) + end. diff --git a/lib/eldap/vsn.mk b/lib/eldap/vsn.mk index efdc30b476..5e32f92fa8 100644 --- a/lib/eldap/vsn.mk +++ b/lib/eldap/vsn.mk @@ -1,2 +1 @@ -ELDAP_VSN = 1.0.3 - +ELDAP_VSN = 1.0.4
\ No newline at end of file diff --git a/lib/erl_docgen/doc/src/notes.xml b/lib/erl_docgen/doc/src/notes.xml index e546eb97fc..f194fb6d6c 100644 --- a/lib/erl_docgen/doc/src/notes.xml +++ b/lib/erl_docgen/doc/src/notes.xml @@ -30,7 +30,23 @@ </header> <p>This document describes the changes made to the <em>erl_docgen</em> application.</p> - <section><title>Erl_Docgen 0.3.5</title> + <section><title>Erl_Docgen 0.3.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix spec to doc generation from erl_docgen and edoc for + maps</p> + <p> + Own Id: OTP-12058</p> + </item> + </list> + </section> + +</section> + +<section><title>Erl_Docgen 0.3.5</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl index cbdbbbee80..e2eee2b3c0 100644 --- a/lib/erl_docgen/src/docgen_otp_specs.erl +++ b/lib/erl_docgen/src/docgen_otp_specs.erl @@ -390,8 +390,6 @@ t_type([#xmlElement{name = tuple, content = Es}]) -> t_tuple(Es); t_type([#xmlElement{name = map, content = Es}]) -> t_map(Es); -t_type([#xmlElement{name = map_field, content = Es}]) -> - t_map_field(Es); t_type([#xmlElement{name = 'fun', content = Es}]) -> ["fun("] ++ t_fun(Es) ++ [")"]; t_type([E = #xmlElement{name = record, content = Es}]) -> @@ -435,9 +433,10 @@ t_tuple(Es) -> ["{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). t_map(Es) -> - ["#{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). + Fs = get_elem(map_field, Es), + ["#{"] ++ seq(fun t_map_field/1, Fs, ["}"]). -t_map_field([K,V]) -> +t_map_field(#xmlElement{content = [K,V]}) -> [t_utype_elem(K) ++ " => " ++ t_utype_elem(V)]. t_fun(Es) -> @@ -557,14 +556,12 @@ ot_type([#xmlElement{name = tuple, content = Es}]) -> ot_tuple(Es); ot_type([#xmlElement{name = map, content = Es}]) -> ot_map(Es); -ot_type([#xmlElement{name = map_field, content = Es}]) -> - ot_map_field(Es); ot_type([#xmlElement{name = 'fun', content = Es}]) -> ot_fun(Es); ot_type([#xmlElement{name = record, content = Es}]) -> ot_record(Es); ot_type([#xmlElement{name = abstype, content = Es}]) -> - ot_abstype(Es); + ot_abstype(Es); ot_type([#xmlElement{name = union, content = Es}]) -> ot_union(Es). @@ -616,10 +613,10 @@ ot_tuple(Es) -> {type,0,tuple,[ot_utype_elem(E) || E <- Es]}. ot_map(Es) -> - {type,0,map,[ot_utype_elem(E) || E <- Es]}. + {type,0,map,[ot_map_field(E) || E <- get_elem(map_field,Es)]}. -ot_map_field(Es) -> - {type,0,map_field_assoc,[ot_utype_elem(E) || E <- Es]}. +ot_map_field(#xmlElement{content=[K,V]}) -> + {type,0,map_field_assoc,[ot_utype_elem(K),ot_utype_elem(V)]}. ot_fun(Es) -> Range = ot_utype(get_elem(type, Es)), diff --git a/lib/erl_docgen/vsn.mk b/lib/erl_docgen/vsn.mk index 0f89922275..8bfcc08698 100644 --- a/lib/erl_docgen/vsn.mk +++ b/lib/erl_docgen/vsn.mk @@ -1 +1 @@ -ERL_DOCGEN_VSN = 0.3.5 +ERL_DOCGEN_VSN = 0.3.6 diff --git a/lib/erl_interface/configure.in b/lib/erl_interface/configure.in index d511f2e240..ef78f0f87b 100644 --- a/lib/erl_interface/configure.in +++ b/lib/erl_interface/configure.in @@ -311,6 +311,26 @@ else fi fi +dnl ---------------------------------------------------------------------- +dnl Enable -fsanitize= flags. +dnl ---------------------------------------------------------------------- + +m4_define(DEFAULT_SANITIZERS, [address,undefined]) +AC_ARG_ENABLE( + sanitizers, + AS_HELP_STRING( + [--enable-sanitizers@<:@=comma-separated list of sanitizers@:>@], + [Default=DEFAULT_SANITIZERS]), +[ +case "$enableval" in + no) sanitizers= ;; + yes) sanitizers="-fsanitize=DEFAULT_SANITIZERS" ;; + *) sanitizers="-fsanitize=$enableval" ;; +esac +CFLAGS="$CFLAGS $sanitizers" +LDFLAGS="$LDFLAGS $sanitizers" +]) + # --------------------------------------------------------------------------- # XXX # --------------------------------------------------------------------------- diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml index 3f85af8956..a055e854e3 100644 --- a/lib/erl_interface/doc/src/notes.xml +++ b/lib/erl_interface/doc/src/notes.xml @@ -30,6 +30,38 @@ </header> <p>This document describes the changes made to the Erl_interface application.</p> +<section><title>Erl_Interface 3.7.19</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Added a <c>.app</c> file for the application.</p> + <p> + Own Id: OTP-12178</p> + </item> + </list> + </section> + +</section> + +<section><title>Erl_Interface 3.7.18</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Implement --enable-sanitizers[=sanitizers]. Similar to + debugging with Valgrind, it's very useful to enable + -fsanitize= switches to catch bugs at runtime.</p> + <p> + Own Id: OTP-12153</p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.7.17</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/erl_interface/ebin/.gitignore b/lib/erl_interface/ebin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/erl_interface/ebin/.gitignore diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in index e36b39c1fb..7d914a02ca 100644 --- a/lib/erl_interface/src/Makefile.in +++ b/lib/erl_interface/src/Makefile.in @@ -40,6 +40,13 @@ include $(TARGET)/eidefs.mk include $(ERL_TOP)/make/output.mk +EBINDIR=../ebin + +APP_FILE= erl_interface.app + +APP_SRC= $(APP_FILE).src +APP_TARGET= $(EBINDIR)/$(APP_FILE) + USING_MINGW=@MIXED_CYGWIN_MINGW@ USING_MSYS_VC==@MIXED_MSYS_VC@ USING_CYGWIN_VC==@MIXED_MSYS_VC@ @@ -212,7 +219,8 @@ ifeq ($(USING_VC),yes) TARGETS = \ $(OBJ_TARGETS) \ - $(EXE_TARGETS) + $(EXE_TARGETS) \ + $(APP_TARGET) OBJ_TARGETS = \ $(MT_EILIB) \ @@ -241,7 +249,8 @@ else ifeq ($USING_MINGW,yes) TARGETS = \ $(OBJ_TARGETS) \ - $(EXE_TARGETS) + $(EXE_TARGETS) \ + $(APP_TARGET) OBJ_TARGETS = \ $(MD_EILIB) \ @@ -259,7 +268,8 @@ ifdef THR_DEFS TARGETS = \ $(OBJ_TARGETS) \ - $(EXE_TARGETS) + $(EXE_TARGETS) \ + $(APP_TARGET) OBJ_TARGETS = \ $(ST_EILIB) \ @@ -281,7 +291,8 @@ else TARGETS = \ $(OBJ_TARGETS) \ - $(EXE_TARGETS) + $(EXE_TARGETS) \ + $(APP_TARGET) OBJ_TARGETS = \ $(ST_EILIB) \ @@ -597,12 +608,15 @@ $(MDD_OBJDIR)/%.o: %.c # Create directories ########################################################################### -_create_dirs := $(shell mkdir -p $(BINDIR) $(OBJDIR) $(ST_OBJDIR) $(MT_OBJDIR) $(MD_OBJDIR) $(MDD_OBJDIR)) +_create_dirs := $(shell mkdir -p $(EBINDIR) $(BINDIR) $(OBJDIR) $(ST_OBJDIR) $(MT_OBJDIR) $(MD_OBJDIR) $(MDD_OBJDIR)) ########################################################################### # Special rules ########################################################################### +$(APP_TARGET): $(APP_SRC) ../vsn.mk + $(vsn_verbose)sed -e 's;%VSN%;$(ERL_INTERFACE_VSN);' $< > $@ + ifeq ($(TARGET),win32) # Windows archive creation @@ -857,6 +871,7 @@ release: opt $(INSTALL_DIR) "$(RELSYSDIR)/include" $(INSTALL_DIR) "$(RELSYSDIR)/lib" $(INSTALL_DIR) "$(RELSYSDIR)/bin" + $(INSTALL_DIR) "$(RELSYSDIR)/ebin" $(INSTALL_DIR) "$(RELSYSDIR)/src/auxdir" $(INSTALL_DIR) "$(RELSYSDIR)/src/connect" $(INSTALL_DIR) "$(RELSYSDIR)/src/decode" @@ -868,6 +883,7 @@ release: opt $(INSTALL_DIR) "$(RELSYSDIR)/src/registry" $(INSTALL_DIR) "$(RELEASE_PATH)/usr/include" $(INSTALL_DIR) "$(RELEASE_PATH)/usr/lib" + $(INSTALL_DATA) $(APP_TARGET) "$(RELSYSDIR)/ebin/$(APP_FILE)" $(INSTALL_DATA) $(HEADERS) "$(RELSYSDIR)/include" $(INSTALL_DATA) $(HEADERS) "$(RELEASE_PATH)/usr/include" $(INSTALL_DATA) $(OBJ_TARGETS) "$(RELSYSDIR)/lib" diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 2e8418d61e..45c000ef76 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -761,7 +761,7 @@ int ei_close_connection(int fd) #endif /* - * Accept and initiate a connection from an other + * Accept and initiate a connection from another * Erlang node. Return a file descriptor at success, * otherwise -1; */ diff --git a/lib/erl_interface/src/decode/decode_big.c b/lib/erl_interface/src/decode/decode_big.c index b54ac85be2..b87d97d634 100644 --- a/lib/erl_interface/src/decode/decode_big.c +++ b/lib/erl_interface/src/decode/decode_big.c @@ -151,13 +151,18 @@ int ei_big_comp(erlang_big *x, erlang_big *y) #endif #ifdef USE_ISINF_ISNAN /* simulate finite() */ -# define finite(f) (!isinf(f) && !isnan(f)) -# define HAVE_FINITE +# define isfinite(f) (!isinf(f) && !isnan(f)) +# define HAVE_ISFINITE +#elif defined(isfinite) && !defined(HAVE_ISFINITE) +# define HAVE_ISFINITE +#elif !defined(HAVE_ISFINITE) && defined(HAVE_FINITE) +# define isfinite finite +# define HAVE_ISFINITE #endif #ifdef NO_FPE_SIGNALS # define ERTS_FP_CHECK_INIT() do {} while (0) -# define ERTS_FP_ERROR(f, Action) if (!finite(f)) { Action; } else {} +# define ERTS_FP_ERROR(f, Action) if (!isfinite(f)) { Action; } else {} # define ERTS_SAVE_FP_EXCEPTION() # define ERTS_RESTORE_FP_EXCEPTION() #else diff --git a/lib/erl_interface/src/erl_interface.app.src b/lib/erl_interface/src/erl_interface.app.src new file mode 100644 index 0000000000..11f884c36b --- /dev/null +++ b/lib/erl_interface/src/erl_interface.app.src @@ -0,0 +1,32 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The 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% +%% +%% This is an -*- erlang -*- file. +%% + +{application, erl_interface, + [ + {description, "Erl Interface"}, + {vsn, "%VSN%"}, + {modules, []}, + {registered, []}, + {applications, []}, + {env, []}, + {runtime_dependencies, []} + ] +}. diff --git a/lib/erl_interface/src/legacy/erl_connect.c b/lib/erl_interface/src/legacy/erl_connect.c index ae0265a388..d70d914b79 100644 --- a/lib/erl_interface/src/legacy/erl_connect.c +++ b/lib/erl_interface/src/legacy/erl_connect.c @@ -190,7 +190,7 @@ int erl_close_connection(int fd) } /* - * Accept and initiate a connection from an other + * Accept and initiate a connection from another * Erlang node. Return a file descriptor at success, * otherwise -1; */ diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index b1e612a9eb..e39aa4f514 100644 --- a/lib/erl_interface/vsn.mk +++ b/lib/erl_interface/vsn.mk @@ -1,2 +1,2 @@ -EI_VSN = 3.7.17 +EI_VSN = 3.7.19 ERL_INTERFACE_VSN = $(EI_VSN) diff --git a/lib/eunit/doc/src/notes.xml b/lib/eunit/doc/src/notes.xml index 72ffda3cd5..e5a190e3e9 100644 --- a/lib/eunit/doc/src/notes.xml +++ b/lib/eunit/doc/src/notes.xml @@ -32,6 +32,21 @@ </header> <p>This document describes the changes made to the EUnit application.</p> +<section><title>Eunit 2.2.8</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Minor refactoring.</p> + <p> + Own Id: OTP-12051</p> + </item> + </list> + </section> + +</section> + <section><title>Eunit 2.2.7</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/eunit/src/Makefile b/lib/eunit/src/Makefile index e6dab67363..47aef104ff 100644 --- a/lib/eunit/src/Makefile +++ b/lib/eunit/src/Makefile @@ -46,6 +46,8 @@ SOURCES= \ INCLUDE_FILES = eunit.hrl +INTERNAL_HRL_FILES= eunit_internal.hrl + PARSE_TRANSFORM_BIN = $(PARSE_TRANSFORM:%.erl=$(EBIN)/%.$(EMULATOR)) TARGET_FILES= $(SOURCES:%.erl=$(EBIN)/%.$(EMULATOR)) @@ -78,7 +80,7 @@ all: $(OBJECTS) clean: - rm -f $(OBJECTS) + rm -f $(OBJECTS) $(PARSE_TRANSFORM_BIN) rm -f core *~ distclean: clean @@ -119,6 +121,7 @@ release_spec: opt $(INSTALL_DATA) $(PARSE_TRANSFORM_BIN) $(OBJECTS) "$(RELSYSDIR)/ebin" $(INSTALL_DIR) "$(RELSYSDIR)/src" $(INSTALL_DATA) $(PARSE_TRANSFORM) $(SOURCES) "$(RELSYSDIR)/src" + $(INSTALL_DATA) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src" $(INSTALL_DIR) "$(RELSYSDIR)/include" $(INSTALL_DATA) $(INCLUDE_DELIVERABLES) "$(RELSYSDIR)/include" diff --git a/lib/eunit/vsn.mk b/lib/eunit/vsn.mk index f04c0536fe..855e1dac88 100644 --- a/lib/eunit/vsn.mk +++ b/lib/eunit/vsn.mk @@ -1 +1 @@ -EUNIT_VSN = 2.2.7 +EUNIT_VSN = 2.2.8 diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index a460f16272..74e93bf098 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1891,7 +1891,11 @@ infinity_add(neg_inf, _Number) -> neg_inf; infinity_add(_Number, pos_inf) -> pos_inf; infinity_add(_Number, neg_inf) -> neg_inf; infinity_add(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> - Number1 + Number2. + try Number1 + Number2 + catch + error:system_limit when Number1 < 0 -> neg_inf; + error:system_limit -> pos_inf + end. infinity_mult(neg_inf, Number) -> Greater = infinity_geq(Number, 0), @@ -1902,7 +1906,13 @@ infinity_mult(pos_inf, Number) -> infinity_inv(infinity_mult(neg_inf, Number)); infinity_mult(Number, pos_inf) -> infinity_inv(infinity_mult(neg_inf, Number)); infinity_mult(Number, neg_inf) -> infinity_mult(neg_inf, Number); infinity_mult(Number1, Number2) when is_integer(Number1), is_integer(Number2)-> - Number1 * Number2. + try Number1 * Number2 + catch + error:system_limit -> + if (Number1 >= 0) =:= (Number2 >= 0) -> pos_inf; + true -> neg_inf + end + end. width({Min, Max}) -> infinity_max([width(Min), width(Max)]); width(pos_inf) -> pos_inf; @@ -2633,7 +2643,9 @@ opaque_args(M, F, A, Xs, Opaques) -> true -> case t_tuple_subtypes(X, Opaques) of unknown -> false; - List when length(List) >= 1 -> opaque_recargs(List, Y, Opaques) + List when length(List) >= 1 -> + (t_is_atom(Y, Opaques) andalso + opaque_recargs(List, Y, Opaques)) end; false -> t_has_opaque_subtype(X, Opaques) end]; diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 0927c17b6b..5124e7238a 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -40,7 +40,6 @@ any_none_or_unit/1, lookup_record/3, max/2, - module_builtin_opaques/1, min/2, number_max/1, number_max/2, number_min/1, number_min/2, @@ -188,7 +187,6 @@ t_subtract_list/2, t_sup/1, t_sup/2, - t_tid/0, t_timeout/0, t_to_string/1, t_to_string/2, @@ -262,6 +260,8 @@ -define(TAG_IMMED1_SIZE, 4). -define(BITS, (erlang:system_info(wordsize) * 8) - ?TAG_IMMED1_SIZE). +-define(MAX_TUPLE_SIZE, (1 bsl 10)). + %%----------------------------------------------------------------------------- %% Type tags and qualifiers %% @@ -464,16 +464,6 @@ has_opaque_subtype(T) -> t_opaque_structure(?opaque(Elements)) -> t_sup([Struct || #opaque{struct = Struct} <- ordsets:to_list(Elements)]). --spec t_opaque_modules(erl_type()) -> [module()]. - -t_opaque_modules(?opaque(Elements)) -> - case ordsets:size(Elements) of - 1 -> - [#opaque{mod = Mod}] = set_to_list(Elements), - [Mod]; - _ -> throw({error, "Unexpected multiple opaque types"}) - end. - -spec t_contains_opaque(erl_type()) -> boolean(). t_contains_opaque(Type) -> @@ -799,11 +789,6 @@ t_struct_from_opaque(Type, _Opaques) -> Type. list_struct_from_opaque(Types, Opaques) -> [t_struct_from_opaque(Type, Opaques) || Type <- Types]. --spec module_builtin_opaques(module()) -> [erl_type()]. - -module_builtin_opaques(Module) -> - [O || O <- all_opaque_builtins(), lists:member(Module, t_opaque_modules(O))]. - %%----------------------------------------------------------------------------- %% Remote types: these types are used for preprocessing; %% they should never reach the analysis stage. @@ -1770,6 +1755,8 @@ t_tuple() -> -spec t_tuple(non_neg_integer() | [erl_type()]) -> erl_type(). +t_tuple(N) when is_integer(N), N > ?MAX_TUPLE_SIZE -> + t_tuple(); t_tuple(N) when is_integer(N) -> ?tuple(lists:duplicate(N, ?any), N, ?any); t_tuple(List) -> @@ -1983,82 +1970,6 @@ t_parameterized_module() -> t_timeout() -> t_sup(t_non_neg_integer(), t_atom('infinity')). -%%----------------------------------------------------------------------------- -%% Some built-in opaque types -%% - --spec t_array() -> erl_type(). - -t_array() -> - t_opaque(array, array, [t_any()], - t_tuple([t_atom('array'), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_any(), - t_any()])). - --spec t_dict() -> erl_type(). - -t_dict() -> - t_opaque(dict, dict, [t_any(), t_any()], - t_tuple([t_atom('dict'), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_non_neg_integer()]), - t_sup([t_atom('undefined'), t_tuple()]), - t_sup([t_atom('undefined'), t_tuple()])])). - --spec t_digraph() -> erl_type(). - -t_digraph() -> - t_opaque(digraph, digraph, [], - t_tuple([t_atom('digraph'), - t_sup(t_atom(), t_tid()), - t_sup(t_atom(), t_tid()), - t_sup(t_atom(), t_tid()), - t_boolean()])). - --spec t_gb_set() -> erl_type(). - -t_gb_set() -> - t_opaque(gb_sets, gb_set, [], - t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(3))])). - --spec t_gb_tree() -> erl_type(). - -t_gb_tree() -> - t_opaque(gb_trees, gb_tree, [], - t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(4))])). - --spec t_queue() -> erl_type(). - -t_queue() -> - t_opaque(queue, queue, [t_any()], t_tuple([t_list(), t_list()])). - --spec t_set() -> erl_type(). - -t_set() -> - t_opaque(sets, set, [t_any()], - t_tuple([t_atom('set'), t_non_neg_integer(), t_non_neg_integer(), - t_pos_integer(), t_non_neg_integer(), t_non_neg_integer(), - t_non_neg_integer(), - t_sup([t_atom('undefined'), t_tuple()]), - t_sup([t_atom('undefined'), t_tuple()])])). - --spec t_tid() -> erl_type(). - -t_tid() -> - t_opaque(ets, tid, [], t_integer()). - --spec all_opaque_builtins() -> [erl_type(),...]. - -all_opaque_builtins() -> - [t_array(), t_dict(), t_digraph(), t_gb_set(), - t_gb_tree(), t_queue(), t_set(), t_tid()]. - %%------------------------------------ %% ?none is allowed in products. A product of size 1 is not a product. @@ -3313,8 +3224,8 @@ is_opaque_type2(#opaque{mod = Mod1, name = Name1, args = Args1}, Opaques) -> is_type_name(Mod, Name, Args1, Mod, Name, Args2) -> length(Args1) =:= length(Args2); -is_type_name(Mod1, Name1, Args1, Mod2, Name2, Args2) -> - is_same_type_name2(Mod1, Name1, Args1, Mod2, Name2, Args2). +is_type_name(_Mod1, _Name1, _Args1, _Mod2, _Name2, _Args2) -> + false. %% Two functions since t_unify is not symmetric. unify_tuple_set_and_tuple1(?tuple_set([{Arity, List}]), @@ -4152,15 +4063,7 @@ opaque_name(Mod, Name, Extra) -> flat_format("~s(~s)", [S, Extra]). mod_name(Mod, Name) -> - case is_obsolete_opaque_builtin(Mod, Name) of - true -> flat_format("~w", [Name]); - false -> flat_format("~w:~w", [Mod, Name]) - end. - -is_obsolete_opaque_builtin(digraph, digraph) -> true; -is_obsolete_opaque_builtin(gb_sets, gb_set) -> true; -is_obsolete_opaque_builtin(gb_trees, gb_tree) -> true; -is_obsolete_opaque_builtin(_, _) -> false. + flat_format("~w:~w", [Mod, Name]). %%============================================================================= %% @@ -4225,8 +4128,6 @@ t_from_form({type, _L, any, []}, _TypeNames, _RecDict, _VarDict) -> {t_any(), []}; t_from_form({type, _L, arity, []}, _TypeNames, _RecDict, _VarDict) -> {t_arity(), []}; -t_from_form({type, _L, array, []}, TypeNames, RecDict, VarDict) -> - builtin_type(array, t_array(), TypeNames, RecDict, VarDict); t_from_form({type, _L, atom, []}, _TypeNames, _RecDict, _VarDict) -> {t_atom(), []}; t_from_form({type, _L, binary, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4248,10 +4149,6 @@ t_from_form({type, _L, byte, []}, _TypeNames, _RecDict, _VarDict) -> {t_byte(), []}; t_from_form({type, _L, char, []}, _TypeNames, _RecDict, _VarDict) -> {t_char(), []}; -t_from_form({type, _L, dict, []}, TypeNames, RecDict, VarDict) -> - builtin_type(dict, t_dict(), TypeNames, RecDict, VarDict); -t_from_form({type, _L, digraph, []}, TypeNames, RecDict, VarDict) -> - builtin_type(digraph, t_digraph(), TypeNames, RecDict, VarDict); t_from_form({type, _L, float, []}, _TypeNames, _RecDict, _VarDict) -> {t_float(), []}; t_from_form({type, _L, function, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4267,10 +4164,6 @@ t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, {L, R1} = list_from_form(Domain, TypeNames, RecDict, VarDict), {T, R2} = t_from_form(Range, TypeNames, RecDict, VarDict), {t_fun(L, T), R1 ++ R2}; -t_from_form({type, _L, gb_set, []}, TypeNames, RecDict, VarDict) -> - builtin_type(gb_set, t_gb_set(), TypeNames, RecDict, VarDict); -t_from_form({type, _L, gb_tree, []}, TypeNames, RecDict, VarDict) -> - builtin_type(gb_tree, t_gb_tree(), TypeNames, RecDict, VarDict); t_from_form({type, _L, identifier, []}, _TypeNames, _RecDict, _VarDict) -> {t_identifier(), []}; t_from_form({type, _L, integer, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4343,8 +4236,6 @@ t_from_form({type, _L, maybe_improper_list, [Content, Termination]}, t_from_form({type, _L, product, Elements}, TypeNames, RecDict, VarDict) -> {L, R} = list_from_form(Elements, TypeNames, RecDict, VarDict), {t_product(L), R}; -t_from_form({type, _L, queue, []}, TypeNames, RecDict, VarDict) -> - builtin_type(queue, t_queue(), TypeNames, RecDict, VarDict); t_from_form({type, _L, range, [From, To]} = Type, _TypeNames, _RecDict, _VarDict) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of @@ -4356,14 +4247,10 @@ t_from_form({type, _L, record, [Name|Fields]}, TypeNames, RecDict, VarDict) -> record_from_form(Name, Fields, TypeNames, RecDict, VarDict); t_from_form({type, _L, reference, []}, _TypeNames, _RecDict, _VarDict) -> {t_reference(), []}; -t_from_form({type, _L, set, []}, TypeNames, RecDict, VarDict) -> - builtin_type(set, t_set(), TypeNames, RecDict, VarDict); t_from_form({type, _L, string, []}, _TypeNames, _RecDict, _VarDict) -> {t_string(), []}; t_from_form({type, _L, term, []}, _TypeNames, _RecDict, _VarDict) -> {t_any(), []}; -t_from_form({type, _L, tid, []}, TypeNames, RecDict, VarDict) -> - builtin_type(tid, t_tid(), TypeNames, RecDict, VarDict); t_from_form({type, _L, timeout, []}, _TypeNames, _RecDict, _VarDict) -> {t_timeout(), []}; t_from_form({type, _L, tuple, any}, _TypeNames, _RecDict, _VarDict) -> @@ -4374,7 +4261,10 @@ t_from_form({type, _L, tuple, Args}, TypeNames, RecDict, VarDict) -> t_from_form({type, _L, union, Args}, TypeNames, RecDict, VarDict) -> {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict), {t_sup(L), R}; +t_from_form({user_type, _L, Name, Args}, TypeNames, RecDict, VarDict) -> + type_from_form(Name, Args, TypeNames, RecDict, VarDict); t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) -> + %% Compatibility: modules compiled before Erlang/OTP 18.0. type_from_form(Name, Args, TypeNames, RecDict, VarDict); t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _RecDict, _VarDict) -> @@ -4618,9 +4508,12 @@ t_form_to_string({type, _L, Name, []} = T) -> try t_to_string(t_from_form(T)) catch throw:{error, _} -> atom_to_string(Name) ++ "()" end; -t_form_to_string({type, _L, Name, List}) -> +t_form_to_string({user_type, _L, Name, List}) -> flat_format("~w(~s)", - [Name, string:join(t_form_to_string_list(List), ",")]). + [Name, string:join(t_form_to_string_list(List), ",")]); +t_form_to_string({type, L, Name, List}) -> + %% Compatibility: modules compiled before Erlang/OTP 18.0. + t_form_to_string({user_type, L, Name, List}). t_form_to_string_list(List) -> t_form_to_string_list(List, []). @@ -4733,27 +4626,14 @@ do_opaque(Type, _Opaques, Pred) -> is_same_type_name(ModNameArgs, ModNameArgs) -> true; is_same_type_name({Mod, Name, Args1}, {Mod, Name, Args2}) -> all_any(Args1) orelse all_any(Args2); -is_same_type_name({Mod1, Name1, Args1}, {Mod2, Name2, Args2}) -> - is_same_type_name2(Mod1, Name1, Args1, Mod2, Name2, Args2). +is_same_type_name(_ModNameArgs1, _ModNameArgs2) -> + false. all_any([]) -> true; all_any([T|L]) -> t_is_any(T) andalso all_any(L); all_any(_) -> false. -%% Compatibility. In Erlang/OTP 17 the pre-defined opaque types -%% digraph() and so on can be used, but there are also new types such -%% as digraph:graph() with the exact same meaning. In Erlang/OTP R18.0 -%% all but the last clause can be removed. - -is_same_type_name2(digraph, digraph, [], digraph, graph, []) -> true; -is_same_type_name2(digraph, graph, [], digraph, digraph, []) -> true; -is_same_type_name2(gb_sets, gb_set, [], gb_sets, set, [_]) -> true; -is_same_type_name2(gb_sets, set, [_], gb_sets, gb_set, []) -> true; -is_same_type_name2(gb_trees, gb_tree, [], gb_trees, tree, [_, _]) -> true; -is_same_type_name2(gb_trees, tree, [_, _], gb_trees, gb_tree, []) -> true; -is_same_type_name2(_, _, _, _, _, _) -> false. - map_keys(?map(Pairs)) -> [K || {K, _} <- Pairs]. diff --git a/lib/hipe/doc/src/notes.xml b/lib/hipe/doc/src/notes.xml index e8552eabcc..2962e4a9ac 100644 --- a/lib/hipe/doc/src/notes.xml +++ b/lib/hipe/doc/src/notes.xml @@ -30,6 +30,28 @@ </header> <p>This document describes the changes made to HiPE.</p> +<section><title>Hipe 3.11.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> The pretty-printing of bitstrings has been corrected. + </p> + <p> + Own Id: OTP-12015</p> + </item> + <item> + <p> A bug concerning <c>is_record/2,3</c> has been fixed, + as well as some cases where Dialyzer could crash due to + reaching system limits. </p> + <p> + Own Id: OTP-12018</p> + </item> + </list> + </section> + +</section> + <section><title>Hipe 3.11</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk index c30695d4f0..cf1976d8d6 100644 --- a/lib/hipe/vsn.mk +++ b/lib/hipe/vsn.mk @@ -1 +1 @@ -HIPE_VSN = 3.11 +HIPE_VSN = 3.11.1 diff --git a/lib/ic/c_src/oe_ei_encode_pid.c b/lib/ic/c_src/oe_ei_encode_pid.c index b7083f84a0..609f441cf8 100644 --- a/lib/ic/c_src/oe_ei_encode_pid.c +++ b/lib/ic/c_src/oe_ei_encode_pid.c @@ -23,7 +23,7 @@ int oe_ei_encode_pid(CORBA_Environment *ev, const erlang_pid *p) { int size = ev->_iout; - (int) ei_encode_pid(NULL, &size, p); + ei_encode_pid(NULL, &size, p); if (size >= ev->_outbufsz) { char *buf = ev->_outbuf; diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml index 03af316f75..bacac09f11 100644 --- a/lib/ic/doc/src/notes.xml +++ b/lib/ic/doc/src/notes.xml @@ -30,7 +30,22 @@ <file>notes.xml</file> </header> - <section><title>IC 4.3.5</title> + <section><title>IC 4.3.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix compiler warnings reported by LLVM</p> + <p> + Own Id: OTP-12138</p> + </item> + </list> + </section> + +</section> + +<section><title>IC 4.3.5</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index 2ffbbad444..bb273c7b57 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1 +1 @@ -IC_VSN = 4.3.5 +IC_VSN = 4.3.6 diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 37eb7ba718..4178cb7d4c 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -302,7 +302,7 @@ filename() = string() will be sent to that process: <c>{http, {RequestId, stream_start, Headers}}, {http, {RequestId, stream, BinBodyPart}}, {http, {RequestId, stream_end, Headers}}</c>. When - streaming to to the calling processes using the option + streaming to the calling processes using the option <c>{self, once}</c> the first message will have an additional element e.i. <c>{http, {RequestId, stream_start, Headers, Pid}}</c>, this is the process id that should be used as an argument to @@ -332,7 +332,7 @@ filename() = string() <p>Defaults to <c>true</c>. </p> </item> - <tag><c><![CDATA[header_as_is]]></c></tag> + <tag><c><![CDATA[headers_as_is]]></c></tag> <item> <p>Shall the headers provided by the user be made lower case or be regarded as case sensitive. </p> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 3830b2e5ab..4ca038cc99 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -139,7 +139,7 @@ <marker id="prop_server_root"></marker> <tag>{server_root, path()} </tag> <item> - <p>Defines the servers home directory where log files etc can + <p>Defines the server's home directory where log files etc can be stored. Relative paths specified in other properties refer to this directory. </p> </item> @@ -904,7 +904,7 @@ bytes <p>Fetches information about the HTTP server. When called with only the pid all properties are fetched, when called with a list of specific properties they are fetched. - Available properties are the same as the servers start options. + Available properties are the same as the server's start options. </p> <note><p>Pid is the pid returned from inets:start/[2,3]. @@ -930,7 +930,7 @@ bytes <p>Fetches information about the HTTP server. When called with only the Address and Port all properties are fetched, when called with a list of specific properties they are fetched. - Available properties are the same as the servers start + Available properties are the same as the server's start options. </p> @@ -956,7 +956,7 @@ bytes server. Incoming requests will be answered with a temporary down message during the time the it takes to reload.</p> - <note><p>Available properties are the same as the servers + <note><p>Available properties are the same as the server's start options, although the properties bind_address and port can not be changed.</p></note> @@ -1068,7 +1068,7 @@ bytes <type> <v>OldData = list()</v> <v>NewData = [{response,{StatusCode,Body}}] | [{response,{response,Head,Body}}] | [{response,{already_sent,Statuscode,Size}}] </v> - <v>StausCode = integer()</v> + <v>StatusCode = integer()</v> <v>Body = io_list() | nobody | {Fun, Arg}</v> <v>Head = [HeaderOption]</v> <v>HeaderOption = {Option, Value} | {code, StatusCode}</v> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index d586536b0a..921de8e490 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,7 +32,58 @@ <file>notes.xml</file> </header> - <section><title>Inets 5.10.2</title> + <section><title>Inets 5.10.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix some spelling mistakes in documentation</p> + <p> + Own Id: OTP-12152</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + httpd: Seperate timeout for TLS/SSL handshake from + keepalive timeout</p> + <p> + Own Id: OTP-12013</p> + </item> + <item> + <p> + Warning: this is experimental and may disappear or change + without previous warning.</p> + <p> + Experimental support for running Quickcheck and PropEr + tests from common_test suites is added to common_test. + See the reference manual for the new module + <c>ct_property_testing</c>.</p> + <p> + Experimental property tests are added under + <c>lib/{inet,ssh}/test/property_test</c>. They can be run + directly or from the commont_test suites + <c>inet/ftp_property_test_SUITE.erl</c> and + <c>ssh/test/ssh_property_test_SUITE.erl</c>.</p> + <p> + See the code in the <c>test</c> directories and the man + page for details.</p> + <p> + (Thanks to Tuncer Ayaz for a patch adding Triq)</p> + <p> + Own Id: OTP-12119</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 5.10.2</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/ftp/ftp.erl b/lib/inets/src/ftp/ftp.erl index 5674599ac5..8e51b1be5a 100644 --- a/lib/inets/src/ftp/ftp.erl +++ b/lib/inets/src/ftp/ftp.erl @@ -60,6 +60,7 @@ -define(DATA_ACCEPT_TIMEOUT, infinity). -define(DEFAULT_MODE, passive). -define(PROGRESS_DEFAULT, ignore). +-define(FTP_EXT_DEFAULT, false). %% Internal Constants -define(FTP_PORT, 21). @@ -94,7 +95,8 @@ ipfamily, % inet | inet6 | inet6fb4 progress = ignore, % ignore | pid() dtimeout = ?DATA_ACCEPT_TIMEOUT, % non_neg_integer() | infinity - tls_upgrading_data_connection = false + tls_upgrading_data_connection = false, + ftp_extension = ?FTP_EXT_DEFAULT }). @@ -969,6 +971,8 @@ start_options(Options) -> %% timeout %% dtimeout %% progress +%% ftp_extension + open_options(Options) -> ?fcrt("open_options", [{options, Options}]), ValidateMode = @@ -1013,6 +1017,11 @@ open_options(Options) -> (_) -> false end, + ValidateFtpExtension = + fun(true) -> true; + (false) -> true; + (_) -> false + end, ValidOptions = [{mode, ValidateMode, false, ?DEFAULT_MODE}, {host, ValidateHost, true, ehost}, @@ -1020,7 +1029,8 @@ open_options(Options) -> {ipfamily, ValidateIpFamily, false, inet}, {timeout, ValidateTimeout, false, ?CONNECTION_TIMEOUT}, {dtimeout, ValidateDTimeout, false, ?DATA_ACCEPT_TIMEOUT}, - {progress, ValidateProgress, false, ?PROGRESS_DEFAULT}], + {progress, ValidateProgress, false, ?PROGRESS_DEFAULT}, + {ftp_extension, ValidateFtpExtension, false, ?FTP_EXT_DEFAULT}], validate_options(Options, ValidOptions, []). tls_options(Options) -> @@ -1174,12 +1184,14 @@ handle_call({_, {open, ip_comm, Opts}}, From, State) -> DTimeout = key_search(dtimeout, Opts, ?DATA_ACCEPT_TIMEOUT), Progress = key_search(progress, Opts, ignore), IpFamily = key_search(ipfamily, Opts, inet), + FtpExt = key_search(ftp_extension, Opts, ?FTP_EXT_DEFAULT), State2 = State#state{client = From, mode = Mode, progress = progress(Progress), ipfamily = IpFamily, - dtimeout = DTimeout}, + dtimeout = DTimeout, + ftp_extension = FtpExt}, ?fcrd("handle_call(open) -> setup ctrl connection with", [{host, Host}, {port, Port}, {timeout, Timeout}]), @@ -1202,11 +1214,13 @@ handle_call({_, {open, ip_comm, Host, Opts}}, From, State) -> Timeout = key_search(timeout, Opts, ?CONNECTION_TIMEOUT), DTimeout = key_search(dtimeout, Opts, ?DATA_ACCEPT_TIMEOUT), Progress = key_search(progress, Opts, ignore), + FtpExt = key_search(ftp_extension, Opts, ?FTP_EXT_DEFAULT), State2 = State#state{client = From, mode = Mode, progress = progress(Progress), - dtimeout = DTimeout}, + dtimeout = DTimeout, + ftp_extension = FtpExt}, case setup_ctrl_connection(Host, Port, Timeout, State2) of {ok, State3, WaitTimeout} -> @@ -1785,7 +1799,8 @@ handle_ctrl_result({pos_compl, Lines}, ipfamily = inet, client = From, caller = {setup_data_connection, Caller}, - timeout = Timeout} = State) -> + timeout = Timeout, + ftp_extension = false} = State) -> {_, [?LEFT_PAREN | Rest]} = lists:splitwith(fun(?LEFT_PAREN) -> false; (_) -> true end, Lines), @@ -1806,6 +1821,28 @@ handle_ctrl_result({pos_compl, Lines}, {noreply,State#state{client = undefined, caller = undefined}} end; +handle_ctrl_result({pos_compl, Lines}, + #state{mode = passive, + ipfamily = inet, + client = From, + caller = {setup_data_connection, Caller}, + csock = CSock, + timeout = Timeout, + ftp_extension = true} = State) -> + + [_, PortStr | _] = lists:reverse(string:tokens(Lines, "|")), + {ok, {IP, _}} = peername(CSock), + + ?DBG('<--data tcp connect to ~p:~p, Caller=~p~n',[IP,PortStr,Caller]), + case connect(IP, list_to_integer(PortStr), Timeout, State) of + {ok, _, Socket} -> + handle_caller(State#state{caller = Caller, dsock = {tcp, Socket}}); + {error, _Reason} = Error -> + gen_server:reply(From, Error), + {noreply, State#state{client = undefined, caller = undefined}} + end; + + %% FTP server does not support passive mode: try to fallback on active mode handle_ctrl_result(_, #state{mode = passive, @@ -2157,7 +2194,8 @@ setup_ctrl_connection(Host, Port, Timeout, State) -> setup_data_connection(#state{mode = active, caller = Caller, - csock = CSock} = State) -> + csock = CSock, + ftp_extension = FtpExt} = State) -> case (catch sockname(CSock)) of {ok, {{_, _, _, _, _, _, _, _} = IP, _}} -> {ok, LSock} = @@ -2174,11 +2212,18 @@ setup_data_connection(#state{mode = active, {ok, LSock} = gen_tcp:listen(0, [{ip, IP}, {active, false}, binary, {packet, 0}]), {ok, Port} = inet:port(LSock), - {IP1, IP2, IP3, IP4} = IP, - {Port1, Port2} = {Port div 256, Port rem 256}, - send_ctrl_message(State, - mk_cmd("PORT ~w,~w,~w,~w,~w,~w", - [IP1, IP2, IP3, IP4, Port1, Port2])), + case FtpExt of + false -> + {IP1, IP2, IP3, IP4} = IP, + {Port1, Port2} = {Port div 256, Port rem 256}, + send_ctrl_message(State, + mk_cmd("PORT ~w,~w,~w,~w,~w,~w", + [IP1, IP2, IP3, IP4, Port1, Port2])); + true -> + IpAddress = inet_parse:ntoa(IP), + Cmd = mk_cmd("EPRT |1|~s|~p|", [IpAddress, Port]), + send_ctrl_message(State, Cmd) + end, activate_ctrl_connection(State), {noreply, State#state{caller = {setup_data_connection, {LSock, Caller}}}} @@ -2191,9 +2236,17 @@ setup_data_connection(#state{mode = passive, ipfamily = inet6, {noreply, State#state{caller = {setup_data_connection, Caller}}}; setup_data_connection(#state{mode = passive, ipfamily = inet, - caller = Caller} = State) -> + caller = Caller, + ftp_extension = false} = State) -> send_ctrl_message(State, mk_cmd("PASV", [])), activate_ctrl_connection(State), + {noreply, State#state{caller = {setup_data_connection, Caller}}}; + +setup_data_connection(#state{mode = passive, ipfamily = inet, + caller = Caller, + ftp_extension = true} = State) -> + send_ctrl_message(State, mk_cmd("EPSV", [])), + activate_ctrl_connection(State), {noreply, State#state{caller = {setup_data_connection, Caller}}}. connect(Host, Port, Timeout, #state{ipfamily = inet = IpFam}) -> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 5ae6760f08..0a42e7210c 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -350,7 +350,7 @@ handle_call(#request{address = Addr} = Request, _, {reply, ok, State0#state{keep_alive = NewKeepAlive, session = NewSession}}; undefined -> - %% Note: tcp-message reciving has already been + %% Note: tcp-message receiving has already been %% activated by handle_pipeline/2. ?hcrd("no current request", []), cancel_timer(Timers#timers.queue_timer, @@ -632,7 +632,7 @@ handle_info({timeout, RequestId}, handle_info(timeout_queue, State = #state{request = undefined}) -> {stop, normal, State}; -%% Timing was such as the pipeline_timout was not canceled! +%% Timing was such as the queue_timeout was not canceled! handle_info(timeout_queue, #state{timers = Timers} = State) -> {noreply, State#state{timers = Timers#timers{queue_timer = undefined}}}; @@ -1793,7 +1793,7 @@ tls_tunnel_request(#request{headers = Headers, host_header(#http_request_h{host = Host}, _) -> Host; -%% Handles header_as_is +%% Handles headers_as_is host_header(_, URI) -> {ok, {_, _, Host, _, _, _}} = http_uri:parse(URI), Host. @@ -1850,6 +1850,7 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) -> Session2 = erlang:setelement(Pos, Session, Value), insert_session(Session2, ProfileName); T:E -> + Stacktrace = erlang:get_stacktrace(), error_logger:error_msg("Failed updating session: " "~n ProfileName: ~p" "~n SessionId: ~p" @@ -1873,7 +1874,7 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) -> {value, Value}, {etype, T}, {error, E}, - {stacktrace, erlang:get_stacktrace()}]}) + {stacktrace, Stacktrace}]}) end. diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index 6991fb6d04..4bc49e1e67 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -17,6 +17,10 @@ %% %CopyrightEnd% {"%VSN%", [ + {"5.10.2", + [ + {load_module, httpd_request_handler, soft_purge, soft_purge, + []}]}, {"5.10.1", [{load_module, httpc_handler, soft_purge, soft_purge, []}, {load_module, httpd, soft_purge, soft_purge, []}, @@ -34,6 +38,10 @@ {<<"5\\..*">>,[{restart_application, inets}]} ], [ + {"5.10.2", + [ + {load_module, httpd_request_handler, soft_purge, soft_purge, + []}]}, {"5.10.1", [{load_module, httpc_handler, soft_purge, soft_purge, []}, {load_module, httpd, soft_purge, soft_purge, []}, diff --git a/lib/inets/test/ftp_property_test_SUITE.erl b/lib/inets/test/ftp_property_test_SUITE.erl new file mode 100644 index 0000000000..c7077421f4 --- /dev/null +++ b/lib/inets/test/ftp_property_test_SUITE.erl @@ -0,0 +1,52 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The 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% +%% +%% + +%%% Run like this: +%%% ct:run_test([{suite,"ftp_property_test_SUITE"}, {logdir,"/ldisk/OTP/LOG"}]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(ftp_property_test_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +all() -> [prop_ftp_case]. + + +init_per_suite(Config) -> + inets:start(), + ct_property_test:init_per_suite(Config). + + +%%%---- test case +prop_ftp_case(Config) -> + ct_property_test:quickcheck( + ftp_simple_client_server:prop_ftp(Config), + Config + ). diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index de47760e6e..4010597657 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -148,8 +148,24 @@ init_per_suite(Config) -> inets_test_lib:del_dirs(ServerRoot), DocRoot = filename:join(ServerRoot, "htdocs"), setup_server_dirs(ServerRoot, DocRoot, DataDir), + {ok, Hostname0} = inet:gethostname(), + Inet = + case (catch ct:get_config(ipv6_hosts)) of + undefined -> + inet; + Hosts when is_list(Hosts) -> + case lists:member(list_to_atom(Hostname0), Hosts) of + true -> + inet6; + false -> + inet + end; + _ -> + inet + end, [{server_root, ServerRoot}, {doc_root, DocRoot}, + {ipfamily, Inet}, {node, node()}, {host, inets_test_lib:hostname()}, {address, getaddr()} | Config]. @@ -524,7 +540,7 @@ ipv6(Config) when is_list(Config) -> true -> Version = ?config(http_version, Config), Host = ?config(host, Config), - URI = http_request("GET /", Version, Host), + URI = http_request("GET / ", Version, Host), httpd_test_lib:verify_request(?config(type, Config), Host, ?config(port, Config), [inet6], ?config(code, Config), @@ -1397,7 +1413,7 @@ server_config(http, Config) -> {server_root, ServerRoot}, {document_root, ?config(doc_root, Config)}, {bind_address, any}, - {ipfamily, inet}, + {ipfamily, ?config(ipfamily, Config)}, {max_header_size, 256}, {max_header_action, close}, {directory_index, ["index.html", "welcome.html"]}, @@ -1666,9 +1682,10 @@ cleanup_mnesia() -> transport_opts(ssl, Config) -> PrivDir = ?config(priv_dir, Config), - [{cacertfile, filename:join(PrivDir, "public_key_cacert.pem")}]; -transport_opts(_, _) -> - []. + [?config(ipfamily, Config), + {cacertfile, filename:join(PrivDir, "public_key_cacert.pem")}]; +transport_opts(_, Config) -> + [?config(ipfamily, Config)]. %%% mod_range diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index 36a5bb9e71..647fa6f6c1 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -91,16 +91,7 @@ verify_request(SocketType, Host, Port, Node, RequestStr, Options, TimeOut) when (is_integer(TimeOut) orelse (TimeOut =:= infinity)) -> verify_request(SocketType, Host, Port, [], Node, RequestStr, Options, TimeOut). -verify_request(SocketType, Host, Port, TranspOpts0, Node, RequestStr, Options, TimeOut) -> - %% For now, until we modernize the httpd tests - TranspOpts = - case lists:member(inet6, TranspOpts0) of - true -> - TranspOpts0; - false -> - [inet | TranspOpts0] - end, - +verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, TimeOut) -> try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of {ok, Socket} -> ok = inets_test_lib:send(SocketType, Socket, RequestStr), diff --git a/lib/inets/test/property_test/README b/lib/inets/test/property_test/README new file mode 100644 index 0000000000..57602bf719 --- /dev/null +++ b/lib/inets/test/property_test/README @@ -0,0 +1,12 @@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +The test in this directory are written assuming that the user has a QuickCheck license. They are to be run manually. Some may be possible to be run with other tools, e.g. PropEr. + diff --git a/lib/inets/test/property_test/ftp_simple_client_server.erl b/lib/inets/test/property_test/ftp_simple_client_server.erl new file mode 100644 index 0000000000..40e630ee5c --- /dev/null +++ b/lib/inets/test/property_test/ftp_simple_client_server.erl @@ -0,0 +1,306 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The 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(ftp_simple_client_server). + +-compile(export_all). + +-ifndef(EQC). +-ifndef(PROPER). +-define(EQC,true). +%%-define(PROPER,true). +-endif. +-endif. + + +-ifdef(EQC). + +-include_lib("eqc/include/eqc.hrl"). +-include_lib("eqc/include/eqc_statem.hrl"). +-define(MOD_eqc, eqc). +-define(MOD_eqc_gen, eqc_gen). +-define(MOD_eqc_statem, eqc_statem). + +-else. +-ifdef(PROPER). + +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc, proper). +-define(MOD_eqc_gen, proper_gen). +-define(MOD_eqc_statem, proper_statem). + +-endif. +-endif. + +-record(state, { + initialized = false, + priv_dir, + data_dir, + servers = [], % [ {IP,Port,Userid,Pwd} ] + clients = [], % [ client_ref() ] + store = [] % [ {Name,Contents} ] + }). + +-define(fmt(F,A), io:format(F,A)). +%%-define(fmt(F,A), ok). + +-define(v(K,L), proplists:get_value(K,L)). + +%%%================================================================ +%%% +%%% Properties +%%% + +%% This function is for normal eqc calls: +prop_ftp() -> + {ok,PWD} = file:get_cwd(), + prop_ftp(filename:join([PWD,?MODULE_STRING++"_data"]), + filename:join([PWD,?MODULE_STRING,"_files"])). + +%% This function is for calls from common_test test cases: +prop_ftp(Config) -> + prop_ftp(filename:join([?v(property_dir,Config), ?MODULE_STRING++"_data"]), + ?v(priv_dir,Config) ). + + +prop_ftp(DataDir, PrivDir) -> + S0 = #state{data_dir = DataDir, + priv_dir = PrivDir}, + ?FORALL(Cmds, more_commands(10,commands(?MODULE,S0)), + aggregate(command_names(Cmds), + begin {_H,S,Result} = run_commands(?MODULE,Cmds), + % io:format('**** Result=~p~n',[Result]), + % io:format('**** S=~p~n',[S]), + % io:format('**** _H=~p~n',[_H]), + % io:format('**** Cmds=~p~n',[Cmds]), + [cmnd_stop_server(X) || X <- S#state.servers], + [inets:stop(ftpc,X) || {ok,X} <- S#state.clients], + Result==ok + end) + ). + +%%%================================================================ +%%% +%%% State model +%%% + +%% @doc Returns the state in which each test case starts. (Unless a different +%% initial state is supplied explicitly to, e.g. commands/2.) +-spec initial_state() ->?MOD_eqc_statem:symbolic_state(). +initial_state() -> + ?fmt("Initial_state()~n",[]), + #state{}. + +%% @doc Command generator, S is the current state +-spec command(S :: ?MOD_eqc_statem:symbolic_state()) -> ?MOD_eqc_gen:gen(eqc_statem:call()). + +command(#state{initialized=false, + priv_dir=PrivDir}) -> + {call,?MODULE,cmnd_init,[PrivDir]}; + +command(#state{servers=[], + priv_dir=PrivDir, + data_dir=DataDir}) -> + {call,?MODULE,cmnd_start_server,[PrivDir,DataDir]}; + +command(#state{servers=Ss=[_|_], + clients=[]}) -> + {call,?MODULE,cmnd_start_client,[oneof(Ss)]}; + +command(#state{servers=Ss=[_|_], + clients=Cs=[_|_], + store=Store=[_|_] + }) -> + frequency([ + { 5, {call,?MODULE,cmnd_start_client,[oneof(Ss)]}}, + { 5, {call,?MODULE,cmnd_stop_client,[oneof(Cs)]}}, + {10, {call,?MODULE,cmnd_put,[oneof(Cs),file_path(),file_contents()]}}, + {20, {call,?MODULE,cmnd_get,[oneof(Cs),oneof(Store)]}}, + {10, {call,?MODULE,cmnd_delete,[oneof(Cs),oneof(Store)]}} + ]); + +command(#state{servers=Ss=[_|_], + clients=Cs=[_|_], + store=[] + }) -> + frequency([ + {5, {call,?MODULE,cmnd_start_client,[oneof(Ss)]}}, + {5, {call,?MODULE,cmnd_stop_client,[oneof(Cs)]}}, + {10, {call,?MODULE,cmnd_put,[oneof(Cs),file_path(),file_contents()]}} + ]). + +%% @doc Precondition, checked before command is added to the command sequence. +-spec precondition(S :: ?MOD_eqc_statem:symbolic_state(), C :: ?MOD_eqc_statem:call()) -> boolean(). + +precondition(#state{clients=Cs}, {call, _, cmnd_put, [C,_,_]}) -> lists:member(C,Cs); + +precondition(#state{clients=Cs, store=Store}, + {call, _, cmnd_get, [C,X]}) -> lists:member(C,Cs) andalso lists:member(X,Store); + +precondition(#state{clients=Cs, store=Store}, + {call, _, cmnd_delete, [C,X]}) -> lists:member(C,Cs) andalso lists:member(X,Store); + +precondition(#state{servers=Ss}, {call, _, cmnd_start_client, _}) -> Ss =/= []; + +precondition(#state{clients=Cs}, {call, _, cmnd_stop_client, [C]}) -> lists:member(C,Cs); + +precondition(#state{initialized=IsInit}, {call, _, cmnd_init, _}) -> IsInit==false; + +precondition(_S, {call, _, _, _}) -> true. + + +%% @doc Postcondition, checked after command has been evaluated +%% Note: S is the state before next_state(S,_,C) +-spec postcondition(S :: ?MOD_eqc_statem:dynamic_state(), C :: ?MOD_eqc_statem:call(), + Res :: term()) -> boolean(). + +postcondition(_S, {call, _, cmnd_get, [_,{_Name,Expected}]}, {ok,Value}) -> + Value == Expected; + +postcondition(S, {call, _, cmnd_delete, [_,{Name,_Expected}]}, ok) -> + ?fmt("file:read_file(..) = ~p~n",[file:read_file(filename:join(S#state.priv_dir,Name))]), + {error,enoent} == file:read_file(filename:join(S#state.priv_dir,Name)); + +postcondition(S, {call, _, cmnd_put, [_,Name,Value]}, ok) -> + {ok,Bin} = file:read_file(filename:join(S#state.priv_dir,Name)), + Bin == unicode:characters_to_binary(Value); + +postcondition(_S, {call, _, cmnd_stop_client, _}, ok) -> true; + +postcondition(_S, {call, _, cmnd_start_client, _}, {ok,_}) -> true; + +postcondition(_S, {call, _, cmnd_init, _}, ok) -> true; + +postcondition(_S, {call, _, cmnd_start_server, _}, {ok,_}) -> true. + + +%% @doc Next state transformation, S is the current state. Returns next state. +-spec next_state(S :: ?MOD_eqc_statem:symbolic_state(), + V :: ?MOD_eqc_statem:var(), + C :: ?MOD_eqc_statem:call()) -> ?MOD_eqc_statem:symbolic_state(). + +next_state(S, _V, {call, _, cmnd_put, [_,Name,Val]}) -> + S#state{store = [{Name,Val} | lists:keydelete(Name,1,S#state.store)]}; + +next_state(S, _V, {call, _, cmnd_delete, [_,{Name,_Val}]}) -> + S#state{store = lists:keydelete(Name,1,S#state.store)}; + +next_state(S, V, {call, _, cmnd_start_client, _}) -> + S#state{clients = [V | S#state.clients]}; + +next_state(S, V, {call, _, cmnd_start_server, _}) -> + S#state{servers = [V | S#state.servers]}; + +next_state(S, _V, {call, _, cmnd_stop_client, [C]}) -> + S#state{clients = S#state.clients -- [C]}; + +next_state(S, _V, {call, _, cmnd_init, _}) -> + S#state{initialized=true}; + +next_state(S, _V, {call, _, _, _}) -> + S. + +%%%================================================================ +%%% +%%% Data model +%%% + +file_path() -> non_empty(list(alphanum_char())). +%%file_path() -> non_empty( list(oneof([alphanum_char(), utf8_char()])) ). + +%%file_contents() -> list(alphanum_char()). +file_contents() -> list(oneof([alphanum_char(), utf8_char()])). + +alphanum_char() -> oneof(lists:seq($a,$z) ++ lists:seq($A,$Z) ++ lists:seq($0,$9)). + +utf8_char() -> oneof("åäöÅÄÖ話话カタカナひらがな"). + +%%%================================================================ +%%% +%%% Commands doing something with the System Under Test +%%% + +cmnd_init(PrivDir) -> + ?fmt('Call cmnd_init(~p)~n',[PrivDir]), + os:cmd("killall vsftpd"), + clear_files(PrivDir), + ok. + +cmnd_start_server(PrivDir, DataDir) -> + ?fmt('Call cmnd_start_server(~p, ~p)~n',[PrivDir,DataDir]), + Cmnd = ["vsftpd ", filename:join(DataDir,"vsftpd.conf"), + " -oftpd_banner=erlang_otp_testing" + " -oanon_root=",PrivDir + ], + ?fmt("Cmnd=~s~n",[Cmnd]), + case os:cmd(Cmnd) of + [] -> + {ok,{"localhost",9999,"ftp","[email protected]"}}; + Other -> + {error,Other} + end. + +cmnd_stop_server({ok,{_Host,Port,_Usr,_Pwd}}) -> + os:cmd("kill `netstat -tpln | grep "++integer_to_list(Port)++" | awk '{print $7}' | awk -F/ '{print $1}'`"). + +cmnd_start_client({ok,{Host,Port,Usr,Pwd}}) -> + ?fmt('Call cmnd_start_client(~p)...',[{Host,Port,Usr,Pwd}]), + case inets:start(ftpc, [{host,Host},{port,Port}]) of + {ok,Client} -> + ?fmt("~p...",[{ok,Client}]), + case ftp:user(Client, Usr, Pwd) of + ok -> + ?fmt("OK!~n",[]), + {ok,Client}; + Other -> + ?fmt("Other1=~p~n",[Other]), + inets:stop(ftpc,Client), Other + end; + Other -> + ?fmt("Other2=~p~n",[Other]), + Other + end. + +cmnd_stop_client({ok,Client}) -> + ?fmt('Call cmnd_stop_client(~p)~n',[Client]), + inets:stop(ftpc, Client). %% -> ok | Other + +cmnd_delete({ok,Client}, {Name,_ExpectedValue}) -> + ?fmt('Call cmnd_delete(~p, ~p)~n',[Client,Name]), + R=ftp:delete(Client, Name), + ?fmt("R=~p~n",[R]), + R. + +cmnd_put({ok,Client}, Name, Value) -> + ?fmt('Call cmnd_put(~p, ~p, ~p)...',[Client, Name, Value]), + R = ftp:send_bin(Client, unicode:characters_to_binary(Value), Name), % ok | {error,Error} + ?fmt('~p~n',[R]), + R. + +cmnd_get({ok,Client}, {Name,_ExpectedValue}) -> + ?fmt('Call cmnd_get(~p, ~p)~n',[Client,Name]), + case ftp:recv_bin(Client, Name) of + {ok,Bin} -> {ok, unicode:characters_to_list(Bin)}; + Other -> Other + end. + + +clear_files(Dir) -> + os:cmd(["rm -fr ",filename:join(Dir,"*")]). diff --git a/lib/inets/test/property_test/ftp_simple_client_server_data/vsftpd.conf b/lib/inets/test/property_test/ftp_simple_client_server_data/vsftpd.conf new file mode 100644 index 0000000000..fd48e2abf0 --- /dev/null +++ b/lib/inets/test/property_test/ftp_simple_client_server_data/vsftpd.conf @@ -0,0 +1,26 @@ + +### +### Some parameters are given in the vsftpd start command. +### +### Typical command-line paramters are such that has a file path +### component like cert files. +### + + +listen=YES +listen_port=9999 +run_as_launching_user=YES +ssl_enable=NO +#allow_anon_ssl=YES + +background=YES + +write_enable=YES +anonymous_enable=YES +anon_upload_enable=YES +anon_mkdir_write_enable=YES +anon_other_write_enable=YES +anon_world_readable_only=NO + +### Shouldn't be necessary.... +require_ssl_reuse=NO diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 79081f371c..029f6ac4d2 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.10.2 +INETS_VSN = 5.10.3 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/doc/src/notes.xml b/lib/jinterface/doc/src/notes.xml index e81a9f82d2..46d89f0cdb 100644 --- a/lib/jinterface/doc/src/notes.xml +++ b/lib/jinterface/doc/src/notes.xml @@ -30,6 +30,56 @@ </header> <p>This document describes the changes made to the Jinterface application.</p> +<section><title>Jinterface 1.5.11</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Added a <c>.app</c> file for the application.</p> + <p> + Own Id: OTP-12178</p> + </item> + </list> + </section> + +</section> + +<section><title>Jinterface 1.5.10</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Array now show meaningful values in exceptions.</p> + <p> + Own Id: OTP-12049</p> + </item> + <item> + <p> + Documentation improvements.</p> + <p> + Own Id: OTP-12050</p> + </item> + <item> + <p> + Include the cause when raising a new IOException, which + should make the reason for the exception clearer.</p> + <p> + Own Id: OTP-12075</p> + </item> + <item> + <p> + Arrays (here: md5 and freeVars) must not be compared with + equals, which is broken (compares identity).</p> + <p> + Own Id: OTP-12121</p> + </item> + </list> + </section> + +</section> + <section><title>Jinterface 1.5.9</title> <section><title>Improvements and New Features</title> diff --git a/lib/jinterface/ebin/.gitignore b/lib/jinterface/ebin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/jinterface/ebin/.gitignore diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java index 7aa30eef4a..b8a973753a 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java @@ -20,7 +20,6 @@ package com.ericsson.otp.erlang; import java.io.IOException; -import java.io.InputStream; import java.net.Socket; import java.util.Random; @@ -87,7 +86,7 @@ public abstract class AbstractConnection extends Thread { protected boolean connected = false; // connection status protected Socket socket; // communication channel protected OtpPeer peer; // who are we connected to - protected OtpLocalNode self; // this nodes id + protected OtpLocalNode localNode; // this nodes id String name; // local name of this connection protected boolean cookieOk = false; // already checked the cookie for this @@ -137,7 +136,7 @@ public abstract class AbstractConnection extends Thread { */ protected AbstractConnection(final OtpLocalNode self, final Socket s) throws IOException, OtpAuthException { - this.self = self; + this.localNode = self; peer = new OtpPeer(); socket = s; @@ -181,7 +180,7 @@ public abstract class AbstractConnection extends Thread { protected AbstractConnection(final OtpLocalNode self, final OtpPeer other) throws IOException, OtpAuthException { peer = other; - this.self = self; + this.localNode = self; socket = null; int port; @@ -234,6 +233,7 @@ public abstract class AbstractConnection extends Thread { if (!connected) { throw new IOException("Not connected"); } + @SuppressWarnings("resource") final OtpOutputStream header = new OtpOutputStream(headerLen); // preamble: 4 byte length + "passthrough" tag + version @@ -246,7 +246,7 @@ public abstract class AbstractConnection extends Thread { header.write_long(regSendTag); header.write_any(from); if (sendCookie) { - header.write_atom(self.cookie()); + header.write_atom(localNode.cookie()); } else { header.write_atom(""); } @@ -278,6 +278,7 @@ public abstract class AbstractConnection extends Thread { if (!connected) { throw new IOException("Not connected"); } + @SuppressWarnings("resource") final OtpOutputStream header = new OtpOutputStream(headerLen); // preamble: 4 byte length + "passthrough" tag + version @@ -289,7 +290,7 @@ public abstract class AbstractConnection extends Thread { header.write_tuple_head(3); header.write_long(sendTag); if (sendCookie) { - header.write_atom(self.cookie()); + header.write_atom(localNode.cookie()); } else { header.write_atom(""); } @@ -312,6 +313,7 @@ public abstract class AbstractConnection extends Thread { private void cookieError(final OtpLocalNode local, final OtpErlangAtom cookie) throws OtpAuthException { try { + @SuppressWarnings("resource") final OtpOutputStream header = new OtpOutputStream(headerLen); // preamble: 4 byte length + "passthrough" tag + version @@ -347,6 +349,7 @@ public abstract class AbstractConnection extends Thread { msg[0] = new OtpErlangAtom("$gen_cast"); msg[1] = new OtpErlangTuple(msgbody); + @SuppressWarnings("resource") final OtpOutputStream payload = new OtpOutputStream( new OtpErlangTuple(msg)); @@ -384,6 +387,7 @@ public abstract class AbstractConnection extends Thread { if (!connected) { throw new IOException("Not connected"); } + @SuppressWarnings("resource") final OtpOutputStream header = new OtpOutputStream(headerLen); // preamble: 4 byte length + "passthrough" tag @@ -420,6 +424,7 @@ public abstract class AbstractConnection extends Thread { if (!connected) { throw new IOException("Not connected"); } + @SuppressWarnings("resource") final OtpOutputStream header = new OtpOutputStream(headerLen); // preamble: 4 byte length + "passthrough" tag @@ -468,6 +473,7 @@ public abstract class AbstractConnection extends Thread { if (!connected) { throw new IOException("Not connected"); } + @SuppressWarnings("resource") final OtpOutputStream header = new OtpOutputStream(headerLen); // preamble: 4 byte length + "passthrough" tag @@ -488,6 +494,7 @@ public abstract class AbstractConnection extends Thread { do_send(header); } + @SuppressWarnings("resource") @Override public void run() { if (!connected) { @@ -506,7 +513,7 @@ public abstract class AbstractConnection extends Thread { // don't return until we get a real message // or a failure of some kind (e.g. EXIT) // read length and read buffer must be atomic! - tick_loop: do { + do { // read 4 bytes - get length of incoming packet // socket.getInputStream().read(lbuf); readSock(socket, lbuf); @@ -526,6 +533,7 @@ public abstract class AbstractConnection extends Thread { final byte[] tmpbuf = new byte[len]; // i = socket.getInputStream().read(tmpbuf); readSock(socket, tmpbuf); + ibuf.close(); ibuf = new OtpInputStream(tmpbuf, flags); if (ibuf.read1() != passThrough) { @@ -567,12 +575,12 @@ public abstract class AbstractConnection extends Thread { } cookie = (OtpErlangAtom) head.elementAt(1); if (sendCookie) { - if (!cookie.atomValue().equals(self.cookie())) { - cookieError(self, cookie); + if (!cookie.atomValue().equals(localNode.cookie())) { + cookieError(localNode, cookie); } } else { if (!cookie.atomValue().equals("")) { - cookieError(self, cookie); + cookieError(localNode, cookie); } } cookieOk = true; @@ -610,12 +618,12 @@ public abstract class AbstractConnection extends Thread { } cookie = (OtpErlangAtom) head.elementAt(2); if (sendCookie) { - if (!cookie.atomValue().equals(self.cookie())) { - cookieError(self, cookie); + if (!cookie.atomValue().equals(localNode.cookie())) { + cookieError(localNode, cookie); } } else { if (!cookie.atomValue().equals("")) { - cookieError(self, cookie); + cookieError(localNode, cookie); } } cookieOk = true; @@ -749,13 +757,14 @@ public abstract class AbstractConnection extends Thread { final int oldLevel = traceLevel; // pin the value + int theLevel = level; if (level < 0) { - level = 0; + theLevel = 0; } else if (level > 4) { - level = 4; + theLevel = 4; } - traceLevel = level; + traceLevel = theLevel; return oldLevel; } @@ -908,18 +917,16 @@ public abstract class AbstractConnection extends Thread { int got = 0; final int len = b.length; int i; - InputStream is = null; synchronized (this) { if (s == null) { throw new IOException("expected " + len + " bytes, socket was closed"); } - is = s.getInputStream(); } while (got < len) { - i = is.read(b, got, len - got); + i = s.getInputStream().read(b, got, len - got); if (i < 0) { throw new IOException("expected " + len @@ -943,9 +950,9 @@ public abstract class AbstractConnection extends Thread { try { sendStatus("ok"); final int our_challenge = genChallenge(); - sendChallenge(peer.distChoose, self.flags, our_challenge); + sendChallenge(peer.distChoose, localNode.flags, our_challenge); final int her_challenge = recvChallengeReply(our_challenge); - final byte[] our_digest = genDigest(her_challenge, self.cookie()); + final byte[] our_digest = genDigest(her_challenge, localNode.cookie()); sendChallengeAck(our_digest); connected = true; cookieOk = true; @@ -959,7 +966,9 @@ public abstract class AbstractConnection extends Thread { } catch (final Exception e) { final String nn = peer.node(); close(); - throw new IOException("Error accepting connection from " + nn); + IOException ioe = new IOException("Error accepting connection from " + nn); + ioe.initCause(e); + throw ioe; } if (traceLevel >= handshakeThreshold) { System.out.println("<- MD5 ACCEPTED " + peer.host()); @@ -976,10 +985,10 @@ public abstract class AbstractConnection extends Thread { System.out.println("-> MD5 CONNECT TO " + peer.host() + ":" + port); } - sendName(peer.distChoose, self.flags); + sendName(peer.distChoose, localNode.flags); recvStatus(); final int her_challenge = recvChallenge(); - final byte[] our_digest = genDigest(her_challenge, self.cookie()); + final byte[] our_digest = genDigest(her_challenge, localNode.cookie()); final int our_challenge = genChallenge(); sendChallengeReply(our_challenge, our_digest); recvChallengeAck(our_challenge); @@ -990,7 +999,9 @@ public abstract class AbstractConnection extends Thread { throw ae; } catch (final Exception e) { close(); - throw new IOException("Cannot connect to peer node"); + IOException ioe = new IOException("Cannot connect to peer node"); + ioe.initCause(e); + throw ioe; } } @@ -1050,33 +1061,35 @@ public abstract class AbstractConnection extends Thread { return res; } - protected void sendName(final int dist, final int flags) throws IOException { + protected void sendName(final int dist, final int aflags) throws IOException { + @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); - final String str = self.node(); + final String str = localNode.node(); obuf.write2BE(str.length() + 7); // 7 bytes + nodename obuf.write1(AbstractNode.NTYPE_R6); obuf.write2BE(dist); - obuf.write4BE(flags); + obuf.write4BE(aflags); obuf.write(str.getBytes()); obuf.writeTo(socket.getOutputStream()); if (traceLevel >= handshakeThreshold) { - System.out.println("-> " + "HANDSHAKE sendName" + " flags=" + flags - + " dist=" + dist + " local=" + self); + System.out.println("-> " + "HANDSHAKE sendName" + " flags=" + aflags + + " dist=" + dist + " local=" + localNode); } } - protected void sendChallenge(final int dist, final int flags, + protected void sendChallenge(final int dist, final int aflags, final int challenge) throws IOException { + @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); - final String str = self.node(); + final String str = localNode.node(); obuf.write2BE(str.length() + 11); // 11 bytes + nodename obuf.write1(AbstractNode.NTYPE_R6); obuf.write2BE(dist); - obuf.write4BE(flags); + obuf.write4BE(aflags); obuf.write4BE(challenge); obuf.write(str.getBytes()); @@ -1084,8 +1097,8 @@ public abstract class AbstractConnection extends Thread { if (traceLevel >= handshakeThreshold) { System.out.println("-> " + "HANDSHAKE sendChallenge" + " flags=" - + flags + " dist=" + dist + " challenge=" + challenge - + " local=" + self); + + aflags + " dist=" + dist + " challenge=" + challenge + + " local=" + localNode); } } @@ -1096,6 +1109,7 @@ public abstract class AbstractConnection extends Thread { byte[] tmpbuf; readSock(socket, lbuf); + @SuppressWarnings("resource") final OtpInputStream ibuf = new OtpInputStream(lbuf, 0); final int len = ibuf.read2BE(); tmpbuf = new byte[len]; @@ -1103,41 +1117,42 @@ public abstract class AbstractConnection extends Thread { return tmpbuf; } - protected void recvName(final OtpPeer peer) throws IOException { + protected void recvName(final OtpPeer apeer) throws IOException { String hisname = ""; try { final byte[] tmpbuf = read2BytePackage(); + @SuppressWarnings("resource") final OtpInputStream ibuf = new OtpInputStream(tmpbuf, 0); byte[] tmpname; final int len = tmpbuf.length; - peer.ntype = ibuf.read1(); - if (peer.ntype != AbstractNode.NTYPE_R6) { + apeer.ntype = ibuf.read1(); + if (apeer.ntype != AbstractNode.NTYPE_R6) { throw new IOException("Unknown remote node type"); } - peer.distLow = peer.distHigh = ibuf.read2BE(); - if (peer.distLow < 5) { + apeer.distLow = apeer.distHigh = ibuf.read2BE(); + if (apeer.distLow < 5) { throw new IOException("Unknown remote node type"); } - peer.flags = ibuf.read4BE(); + apeer.flags = ibuf.read4BE(); tmpname = new byte[len - 7]; ibuf.readN(tmpname); hisname = OtpErlangString.newString(tmpname); // Set the old nodetype parameter to indicate hidden/normal status // When the old handshake is removed, the ntype should also be. - if ((peer.flags & AbstractNode.dFlagPublished) != 0) { - peer.ntype = AbstractNode.NTYPE_R4_ERLANG; + if ((apeer.flags & AbstractNode.dFlagPublished) != 0) { + apeer.ntype = AbstractNode.NTYPE_R4_ERLANG; } else { - peer.ntype = AbstractNode.NTYPE_R4_HIDDEN; + apeer.ntype = AbstractNode.NTYPE_R4_HIDDEN; } - if ((peer.flags & AbstractNode.dFlagExtendedReferences) == 0) { + if ((apeer.flags & AbstractNode.dFlagExtendedReferences) == 0) { throw new IOException( "Handshake failed - peer cannot handle extended references"); } - if ((peer.flags & AbstractNode.dFlagExtendedPidsPorts) == 0) { + if ((apeer.flags & AbstractNode.dFlagExtendedPidsPorts) == 0) { throw new IOException( "Handshake failed - peer cannot handle extended pids and ports"); } @@ -1147,13 +1162,13 @@ public abstract class AbstractConnection extends Thread { } final int i = hisname.indexOf('@', 0); - peer.node = hisname; - peer.alive = hisname.substring(0, i); - peer.host = hisname.substring(i + 1, hisname.length()); + apeer.node = hisname; + apeer.alive = hisname.substring(0, i); + apeer.host = hisname.substring(i + 1, hisname.length()); if (traceLevel >= handshakeThreshold) { - System.out.println("<- " + "HANDSHAKE" + " ntype=" + peer.ntype - + " dist=" + peer.distHigh + " remote=" + peer); + System.out.println("<- " + "HANDSHAKE" + " ntype=" + apeer.ntype + + " dist=" + apeer.distHigh + " remote=" + apeer); } } @@ -1163,6 +1178,7 @@ public abstract class AbstractConnection extends Thread { try { final byte[] buf = read2BytePackage(); + @SuppressWarnings("resource") final OtpInputStream ibuf = new OtpInputStream(buf, 0); peer.ntype = ibuf.read1(); if (peer.ntype != AbstractNode.NTYPE_R6) { @@ -1195,7 +1211,7 @@ public abstract class AbstractConnection extends Thread { if (traceLevel >= handshakeThreshold) { System.out.println("<- " + "HANDSHAKE recvChallenge" + " from=" - + peer.node + " challenge=" + challenge + " local=" + self); + + peer.node + " challenge=" + challenge + " local=" + localNode); } return challenge; @@ -1204,6 +1220,7 @@ public abstract class AbstractConnection extends Thread { protected void sendChallengeReply(final int challenge, final byte[] digest) throws IOException { + @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); obuf.write2BE(21); obuf.write1(ChallengeReply); @@ -1214,7 +1231,7 @@ public abstract class AbstractConnection extends Thread { if (traceLevel >= handshakeThreshold) { System.out.println("-> " + "HANDSHAKE sendChallengeReply" + " challenge=" + challenge + " digest=" + hex(digest) - + " local=" + self); + + " local=" + localNode); } } @@ -1237,6 +1254,7 @@ public abstract class AbstractConnection extends Thread { try { final byte[] buf = read2BytePackage(); + @SuppressWarnings("resource") final OtpInputStream ibuf = new OtpInputStream(buf, 0); final int tag = ibuf.read1(); if (tag != ChallengeReply) { @@ -1244,7 +1262,7 @@ public abstract class AbstractConnection extends Thread { } challenge = ibuf.read4BE(); ibuf.readN(her_digest); - final byte[] our_digest = genDigest(our_challenge, self.cookie()); + final byte[] our_digest = genDigest(our_challenge, localNode.cookie()); if (!digests_equals(her_digest, our_digest)) { throw new OtpAuthException("Peer authentication error."); } @@ -1255,7 +1273,7 @@ public abstract class AbstractConnection extends Thread { if (traceLevel >= handshakeThreshold) { System.out.println("<- " + "HANDSHAKE recvChallengeReply" + " from=" + peer.node + " challenge=" + challenge - + " digest=" + hex(her_digest) + " local=" + self); + + " digest=" + hex(her_digest) + " local=" + localNode); } return challenge; @@ -1263,6 +1281,7 @@ public abstract class AbstractConnection extends Thread { protected void sendChallengeAck(final byte[] digest) throws IOException { + @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); obuf.write2BE(17); obuf.write1(ChallengeAck); @@ -1272,7 +1291,7 @@ public abstract class AbstractConnection extends Thread { if (traceLevel >= handshakeThreshold) { System.out.println("-> " + "HANDSHAKE sendChallengeAck" - + " digest=" + hex(digest) + " local=" + self); + + " digest=" + hex(digest) + " local=" + localNode); } } @@ -1282,13 +1301,14 @@ public abstract class AbstractConnection extends Thread { final byte[] her_digest = new byte[16]; try { final byte[] buf = read2BytePackage(); + @SuppressWarnings("resource") final OtpInputStream ibuf = new OtpInputStream(buf, 0); final int tag = ibuf.read1(); if (tag != ChallengeAck) { throw new IOException("Handshake protocol error"); } ibuf.readN(her_digest); - final byte[] our_digest = genDigest(our_challenge, self.cookie()); + final byte[] our_digest = genDigest(our_challenge, localNode.cookie()); if (!digests_equals(her_digest, our_digest)) { throw new OtpAuthException("Peer authentication error."); } @@ -1301,12 +1321,13 @@ public abstract class AbstractConnection extends Thread { if (traceLevel >= handshakeThreshold) { System.out.println("<- " + "HANDSHAKE recvChallengeAck" + " from=" + peer.node + " digest=" + hex(her_digest) + " local=" - + self); + + localNode); } } protected void sendStatus(final String status) throws IOException { + @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); obuf.write2BE(status.length() + 1); obuf.write1(ChallengeStatus); @@ -1316,7 +1337,7 @@ public abstract class AbstractConnection extends Thread { if (traceLevel >= handshakeThreshold) { System.out.println("-> " + "HANDSHAKE sendStatus" + " status=" - + status + " local=" + self); + + status + " local=" + localNode); } } @@ -1324,6 +1345,7 @@ public abstract class AbstractConnection extends Thread { try { final byte[] buf = read2BytePackage(); + @SuppressWarnings("resource") final OtpInputStream ibuf = new OtpInputStream(buf, 0); final int tag = ibuf.read1(); if (tag != ChallengeStatus) { @@ -1342,7 +1364,7 @@ public abstract class AbstractConnection extends Thread { } if (traceLevel >= handshakeThreshold) { System.out.println("<- " + "HANDSHAKE recvStatus (ok)" + " local=" - + self); + + localNode); } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java index 3ef44b8851..3bb1bbbd18 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java @@ -128,7 +128,12 @@ public class AbstractNode { final File dotCookieFile = new File(dotCookieFilename); br = new BufferedReader(new FileReader(dotCookieFile)); - defaultCookie = br.readLine().trim(); + final String line = br.readLine(); + if (line == null) { + defaultCookie = ""; + } else { + defaultCookie = line.trim(); + } } catch (final IOException e) { defaultCookie = ""; } finally { @@ -260,8 +265,7 @@ public class AbstractNode { final String drive = System.getenv("HOMEDRIVE"); final String path = System.getenv("HOMEPATH"); return (drive != null && path != null) ? drive + path : home; - } else { - return home; } + return home; } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/Link.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/Link.java index 2b085761e3..c8b4fcebde 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/Link.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/Link.java @@ -41,11 +41,12 @@ class Link { return local.equals(pid) || remote.equals(pid); } - public boolean equals(final OtpErlangPid local, final OtpErlangPid remote) { - return this.local.equals(local) && this.remote.equals(remote) - || this.local.equals(remote) && this.remote.equals(local); + public boolean equals(final OtpErlangPid alocal, final OtpErlangPid aremote) { + return local.equals(alocal) && remote.equals(aremote) + || local.equals(aremote) && remote.equals(alocal); } + @Override public int hashCode() { if (hashCodeValue == 0) { OtpErlangObject.Hash hash = new OtpErlangObject.Hash(5); diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile b/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile index f476d4594d..fd923f85ae 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile @@ -32,6 +32,15 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk include $(ERL_TOP)/lib/jinterface/vsn.mk VSN=$(JINTERFACE_VSN) +# + +EBINDIR=$(ERL_TOP)/lib/jinterface/ebin + +APP_FILE= jinterface.app + +APP_SRC= $(APP_FILE).src +APP_TARGET= $(EBINDIR)/$(APP_FILE) + # ---------------------------------------------------- # Release directory specification # ---------------------------------------------------- @@ -45,7 +54,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/jinterface-$(VSN) # all java sourcefiles listed in common include file include $(ERL_TOP)/lib/jinterface/java_src/$(JAVA_CLASS_SUBDIR)/java_files -TARGET_FILES= $(JAVA_FILES:%=$(JAVA_DEST_ROOT)$(JAVA_CLASS_SUBDIR)%.class) +TARGET_FILES= $(JAVA_FILES:%=$(JAVA_DEST_ROOT)$(JAVA_CLASS_SUBDIR)%.class) $(APP_TARGET) JAVA_SRC= $(JAVA_FILES:%=%.java) JARFILE= OtpErlang.jar @@ -66,7 +75,7 @@ ifneq ($(V),0) JARFLAGS=-cfv endif -JAVA_OPTIONS = +JAVA_OPTIONS = -Xlint ifeq ($(TESTROOT),) RELEASE_PATH="$(ERL_TOP)/release/$(TARGET)" @@ -79,6 +88,9 @@ endif # Make Rules # ---------------------------------------------------- +$(APP_TARGET): $(APP_SRC) $(ERL_TOP)/lib/jinterface/vsn.mk + $(vsn_verbose)sed -e 's;%VSN%;$(JINTERFACE_VSN);' $< > $@ + debug opt: make_dirs $(JAVA_DEST_ROOT)$(JARFILE) make_dirs: @@ -106,6 +118,8 @@ release_spec: opt $(V_at)$(INSTALL_DATA) $(JAVA_SRC) "$(RELSYSDIR)/java_src/com/ericsson/otp/erlang" $(V_at)$(INSTALL_DIR) "$(RELSYSDIR)/priv" $(V_at)$(INSTALL_DATA) $(JAVA_DEST_ROOT)$(JARFILE) "$(RELSYSDIR)/priv" + $(V_at)$(INSTALL_DIR) "$(RELSYSDIR)/ebin" + $(V_at)$(INSTALL_DATA) $(APP_TARGET) "$(RELSYSDIR)/ebin/$(APP_FILE)" release_docs_spec: @@ -113,4 +127,3 @@ release_docs_spec: # ---------------------------------------------------- - diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpConnection.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpConnection.java index e7a9d1092c..9ad02506fd 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpConnection.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpConnection.java @@ -358,6 +358,7 @@ public class OtpConnection extends AbstractConnection { * if the connection is not active or a communication * error occurs. */ + @SuppressWarnings("resource") public void send(final OtpErlangPid dest, final OtpErlangObject msg) throws IOException { // encode and send the message @@ -376,6 +377,7 @@ public class OtpConnection extends AbstractConnection { * if the connection is not active or a communication * error occurs. */ + @SuppressWarnings("resource") public void send(final String dest, final OtpErlangObject msg) throws IOException { // encode and send the message diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpCookedConnection.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpCookedConnection.java index 5abf6e33f7..43b0cad222 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpCookedConnection.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpCookedConnection.java @@ -149,6 +149,7 @@ public class OtpCookedConnection extends AbstractConnection { /* * send to pid */ + @SuppressWarnings("resource") void send(final OtpErlangPid from, final OtpErlangPid dest, final OtpErlangObject msg) throws IOException { // encode and send the message @@ -159,6 +160,7 @@ public class OtpCookedConnection extends AbstractConnection { * send to remote name dest is recipient's registered name, the nodename is * implied by the choice of connection. */ + @SuppressWarnings("resource") void send(final OtpErlangPid from, final String dest, final OtpErlangObject msg) throws IOException { // encode and send the message diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java index 1868dc7740..8a8ba785d9 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpEpmd.java @@ -160,6 +160,7 @@ public class OtpEpmd { try { s = new Socket((String) null, EpmdPort.get()); + @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); obuf.write2BE(node.alive().length() + 1); obuf.write1(stopReq); @@ -189,6 +190,7 @@ public class OtpEpmd { Socket s = null; try { + @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); s = new Socket(node.host(), EpmdPort.get()); @@ -219,6 +221,7 @@ public class OtpEpmd { + node.host() + " when looking up " + node.alive()); } + @SuppressWarnings("resource") final OtpInputStream ibuf = new OtpInputStream(tmpbuf, 0); final int response = ibuf.read1(); @@ -279,6 +282,7 @@ public class OtpEpmd { Socket s = null; try { + @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); s = new Socket((String) null, EpmdPort.get()); @@ -310,13 +314,12 @@ public class OtpEpmd { final int n = s.getInputStream().read(tmpbuf); if (n < 0) { - if (s != null) { s.close(); - } throw new IOException("Nameserver not responding on " + node.host() + " when publishing " + node.alive()); } + @SuppressWarnings("resource") final OtpInputStream ibuf = new OtpInputStream(tmpbuf, 0); final int response = ibuf.read1(); @@ -341,9 +344,7 @@ public class OtpEpmd { throw new IOException("Nameserver not responding on " + node.host() + " when publishing " + node.alive()); } catch (final OtpErlangDecodeException e) { - if (s != null) { s.close(); - } if (traceLevel >= traceThreshold) { System.out.println("<- (invalid response)"); } @@ -351,9 +352,7 @@ public class OtpEpmd { + " when publishing " + node.alive()); } - if (s != null) { s.close(); - } return null; } @@ -366,6 +365,7 @@ public class OtpEpmd { Socket s = null; try { + @SuppressWarnings("resource") final OtpOutputStream obuf = new OtpOutputStream(); try { s = new Socket(address, EpmdPort.get()); @@ -390,6 +390,7 @@ public class OtpEpmd { out.write(buffer, 0, bytesRead); } final byte[] tmpbuf = out.toByteArray(); + @SuppressWarnings("resource") final OtpInputStream ibuf = new OtpInputStream(tmpbuf, 0); ibuf.read4BE(); // read port int // final int port = ibuf.read4BE(); diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangAtom.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangAtom.java index 0371740b26..bff3e2c0e3 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangAtom.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangAtom.java @@ -18,17 +18,15 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang atoms. Atoms can be created from * strings whose length is not more than {@link #maxAtomLength maxAtomLength} * characters. */ -public class OtpErlangAtom extends OtpErlangObject implements Serializable, - Cloneable { +public class OtpErlangAtom extends OtpErlangObject { // don't change this! - static final long serialVersionUID = -3204386396807876641L; + private static final long serialVersionUID = -3204386396807876641L; /** The maximun allowed length of an atom, in characters */ public static final int maxAtomLength = 0xff; // one byte length @@ -119,9 +117,8 @@ public class OtpErlangAtom extends OtpErlangObject implements Serializable, public String toString() { if (atomNeedsQuoting(atom)) { return "'" + escapeSpecialChars(atom) + "'"; - } else { - return atom; } + return atom; } /** @@ -139,8 +136,8 @@ public class OtpErlangAtom extends OtpErlangObject implements Serializable, return false; } - final OtpErlangAtom atom = (OtpErlangAtom) o; - return this.atom.compareTo(atom.atom) == 0; + final OtpErlangAtom other = (OtpErlangAtom) o; + return this.atom.compareTo(other.atom) == 0; } @Override diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangBinary.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangBinary.java index a9eaad540e..0891781f8d 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangBinary.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangBinary.java @@ -18,16 +18,14 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang binaries. Anything that can be * represented as a sequence of bytes can be made into an Erlang binary. */ -public class OtpErlangBinary extends OtpErlangBitstr implements Serializable, - Cloneable { +public class OtpErlangBinary extends OtpErlangBitstr { // don't change this! - static final long serialVersionUID = -3781009633593609217L; + private static final long serialVersionUID = -3781009633593609217L; /** * Create a binary from a byte array diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangBitstr.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangBitstr.java index 97897fe182..8cb4e0e685 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangBitstr.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangBitstr.java @@ -20,17 +20,15 @@ package com.ericsson.otp.erlang; import java.io.ByteArrayOutputStream; import java.io.IOException; -import java.io.Serializable; /** * Provides a Java representation of Erlang bitstrs. An Erlang bitstr is an * Erlang binary with a length not an integral number of bytes (8-bit). Anything * can be represented as a sequence of bytes can be made into an Erlang bitstr. */ -public class OtpErlangBitstr extends OtpErlangObject implements Serializable, - Cloneable { +public class OtpErlangBitstr extends OtpErlangObject { // don't change this! - static final long serialVersionUID = -3781009633593609217L; + private static final long serialVersionUID = -3781009633593609217L; protected byte[] bin; protected int pad_bits; @@ -63,18 +61,18 @@ public class OtpErlangBitstr extends OtpErlangObject implements Serializable, check_bitstr(this.bin, this.pad_bits); } - private void check_bitstr(final byte[] bin, final int pad_bits) { - if (pad_bits < 0 || 7 < pad_bits) { + private void check_bitstr(final byte[] abin, final int a_pad_bits) { + if (a_pad_bits < 0 || 7 < a_pad_bits) { throw new java.lang.IllegalArgumentException( "Padding must be in range 0..7"); } - if (pad_bits != 0 && bin.length == 0) { + if (a_pad_bits != 0 && abin.length == 0) { throw new java.lang.IllegalArgumentException( "Padding on zero length bitstr"); } - if (bin.length != 0) { + if (abin.length != 0) { // Make sure padding is zero - bin[bin.length - 1] &= ~((1 << pad_bits) - 1); + abin[abin.length - 1] &= ~((1 << a_pad_bits) - 1); } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangBoolean.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangBoolean.java index b97b5b7d90..eecd2ea288 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangBoolean.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangBoolean.java @@ -18,14 +18,12 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang booleans, which are special cases of * atoms with values 'true' and 'false'. */ -public class OtpErlangBoolean extends OtpErlangAtom implements Serializable, - Cloneable { +public class OtpErlangBoolean extends OtpErlangAtom { // don't change this! static final long serialVersionUID = 1087178844844988393L; diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangByte.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangByte.java index 2d598c119e..eb6f3d8aba 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangByte.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangByte.java @@ -18,15 +18,13 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang integral types. */ -public class OtpErlangByte extends OtpErlangLong implements Serializable, - Cloneable { +public class OtpErlangByte extends OtpErlangLong { // don't change this! - static final long serialVersionUID = 5778019796466613446L; + private static final long serialVersionUID = 5778019796466613446L; /** * Create an Erlang integer from the given value. @@ -56,6 +54,6 @@ public class OtpErlangByte extends OtpErlangLong implements Serializable, throws OtpErlangRangeException, OtpErlangDecodeException { super(buf); - final byte i = byteValue(); + byteValue(); } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangChar.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangChar.java index b442bbcec1..e7c6dd8ad4 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangChar.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangChar.java @@ -18,15 +18,13 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang integral types. */ -public class OtpErlangChar extends OtpErlangLong implements Serializable, - Cloneable { +public class OtpErlangChar extends OtpErlangLong { // don't change this! - static final long serialVersionUID = 3225337815669398204L; + private static final long serialVersionUID = 3225337815669398204L; /** * Create an Erlang integer from the given value. @@ -56,6 +54,6 @@ public class OtpErlangChar extends OtpErlangLong implements Serializable, throws OtpErlangRangeException, OtpErlangDecodeException { super(buf); - final char i = charValue(); + charValue(); } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangDecodeException.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangDecodeException.java index db55deaedf..6986e26908 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangDecodeException.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangDecodeException.java @@ -26,6 +26,8 @@ package com.ericsson.otp.erlang; * @see OtpInputStream */ public class OtpErlangDecodeException extends OtpErlangException { + private static final long serialVersionUID = 1L; + /** * Provides a detailed message. */ diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangDouble.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangDouble.java index 793940e858..e92ce11431 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangDouble.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangDouble.java @@ -18,7 +18,6 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang floats and doubles. Erlang defines @@ -26,10 +25,9 @@ import java.io.Serializable; * {@link OtpErlangFloat} are used to provide representations corresponding to * the Java types Double and Float. */ -public class OtpErlangDouble extends OtpErlangObject implements Serializable, - Cloneable { +public class OtpErlangDouble extends OtpErlangObject { // don't change this! - static final long serialVersionUID = 132947104811974021L; + private static final long serialVersionUID = 132947104811974021L; private final double d; @@ -120,8 +118,8 @@ public class OtpErlangDouble extends OtpErlangObject implements Serializable, return false; } - final OtpErlangDouble d = (OtpErlangDouble) o; - return this.d == d.d; + final OtpErlangDouble other = (OtpErlangDouble) o; + return this.d == other.d; } @Override diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangFloat.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangFloat.java index 8662b74c53..7d48f848f0 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangFloat.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangFloat.java @@ -18,15 +18,13 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang floats and doubles. */ -public class OtpErlangFloat extends OtpErlangDouble implements Serializable, - Cloneable { +public class OtpErlangFloat extends OtpErlangDouble { // don't change this! - static final long serialVersionUID = -2231546377289456934L; + private static final long serialVersionUID = -2231546377289456934L; /** * Create an Erlang float from the given float value. @@ -53,6 +51,6 @@ public class OtpErlangFloat extends OtpErlangDouble implements Serializable, throws OtpErlangDecodeException, OtpErlangRangeException { super(buf); - final float f = floatValue(); + floatValue(); } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangFun.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangFun.java index fc104e9564..05fa0cbb23 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangFun.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangFun.java @@ -18,10 +18,9 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; import java.util.Arrays; -public class OtpErlangFun extends OtpErlangObject implements Serializable { +public class OtpErlangFun extends OtpErlangObject { // don't change this! private static final long serialVersionUID = -3423031125356706472L; @@ -94,7 +93,7 @@ public class OtpErlangFun extends OtpErlangObject implements Serializable { return false; } } else { - if (!md5.equals(f.md5)) { + if (!Arrays.equals(md5, f.md5)) { return false; } } @@ -104,7 +103,7 @@ public class OtpErlangFun extends OtpErlangObject implements Serializable { if (freeVars == null) { return f.freeVars == null; } - return freeVars.equals(f.freeVars); + return Arrays.equals(freeVars, f.freeVars); } @Override diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangInt.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangInt.java index d947421459..741fc29dd0 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangInt.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangInt.java @@ -18,15 +18,13 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang integral types. */ -public class OtpErlangInt extends OtpErlangLong implements Serializable, - Cloneable { +public class OtpErlangInt extends OtpErlangLong { // don't change this! - static final long serialVersionUID = 1229430977614805556L; + private static final long serialVersionUID = 1229430977614805556L; /** * Create an Erlang integer from the given value. @@ -56,6 +54,6 @@ public class OtpErlangInt extends OtpErlangLong implements Serializable, throws OtpErlangRangeException, OtpErlangDecodeException { super(buf); - final int j = intValue(); + intValue(); } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangList.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangList.java index 3456fd7412..9f7c5f5499 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangList.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangList.java @@ -18,7 +18,6 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; import java.util.Iterator; import java.util.NoSuchElementException; @@ -30,9 +29,9 @@ import java.util.NoSuchElementException; * The arity of the list is the number of elements it contains. */ public class OtpErlangList extends OtpErlangObject implements - Iterable<OtpErlangObject>, Serializable, Cloneable { + Iterable<OtpErlangObject> { // don't change this! - static final long serialVersionUID = 5999112769036676548L; + private static final long serialVersionUID = 5999112769036676548L; private static final OtpErlangObject[] NO_ELEMENTS = new OtpErlangObject[0]; @@ -187,12 +186,11 @@ public class OtpErlangList extends OtpErlangObject implements public OtpErlangObject[] elements() { if (arity() == 0) { return NO_ELEMENTS; - } else { + } final OtpErlangObject[] res = new OtpErlangObject[arity()]; System.arraycopy(elems, 0, res, 0, res.length); return res; } - } /** * Get the string representation of the list. @@ -326,7 +324,7 @@ public class OtpErlangList extends OtpErlangObject implements try { return new OtpErlangList(elements(), getLastTail()); } catch (final OtpErlangException e) { - return null; + throw new AssertionError(this); } } @@ -361,9 +359,8 @@ public class OtpErlangList extends OtpErlangObject implements if (arity >= n) { if (arity == n && lastTail != null) { return lastTail; - } else { - return new SubList(this, n); } + return new SubList(this, n); } return null; } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangLong.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangLong.java index 84b1355c54..c6021a6ae1 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangLong.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangLong.java @@ -18,7 +18,6 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; import java.math.BigInteger; /** @@ -30,10 +29,9 @@ import java.math.BigInteger; * {@link OtpErlangUInt} and {@link OtpErlangUShort} are provided for Corba * compatibility. See the documentation for IC for more information. */ -public class OtpErlangLong extends OtpErlangObject implements Serializable, - Cloneable { +public class OtpErlangLong extends OtpErlangObject { // don't change this! - static final long serialVersionUID = 1610466859236755096L; + private static final long serialVersionUID = 1610466859236755096L; private long val; private BigInteger bigVal = null; @@ -94,9 +92,8 @@ public class OtpErlangLong extends OtpErlangObject implements Serializable, public BigInteger bigIntegerValue() { if (bigVal != null) { return bigVal; - } else { - return BigInteger.valueOf(val); } + return BigInteger.valueOf(val); } /** @@ -109,9 +106,8 @@ public class OtpErlangLong extends OtpErlangObject implements Serializable, public long longValue() { if (bigVal != null) { return bigVal.longValue(); - } else { - return val; } + return val; } /** @@ -159,7 +155,7 @@ public class OtpErlangLong extends OtpErlangObject implements Serializable, } if (val == 0 || val == -1) { return 0; - } else { + } // Binary search for bit length int i = 32; // mask length long m = (1L << i) - 1; // AND mask with ones in little end @@ -193,7 +189,6 @@ public class OtpErlangLong extends OtpErlangObject implements Serializable, } return i; } - } /** * Return the signum function of this object. @@ -203,9 +198,8 @@ public class OtpErlangLong extends OtpErlangObject implements Serializable, public int signum() { if (bigVal != null) { return bigVal.signum(); - } else { - return val > 0 ? 1 : val < 0 ? -1 : 0; } + return val > 0 ? 1 : val < 0 ? -1 : 0; } /** @@ -342,9 +336,8 @@ public class OtpErlangLong extends OtpErlangObject implements Serializable, public String toString() { if (bigVal != null) { return "" + bigVal; - } else { - return "" + val; } + return "" + val; } /** @@ -392,8 +385,7 @@ public class OtpErlangLong extends OtpErlangObject implements Serializable, protected int doHashCode() { if (bigVal != null) { return bigVal.hashCode(); - } else { - return BigInteger.valueOf(val).hashCode(); } + return BigInteger.valueOf(val).hashCode(); } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java index 0254edd5da..7f1a64b87d 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java @@ -18,7 +18,6 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang maps. Maps are created from one or @@ -29,8 +28,7 @@ import java.io.Serializable; * values can be retrieved as arrays and the value for a key can be queried. * */ -public class OtpErlangMap extends OtpErlangObject implements Serializable, - Cloneable { +public class OtpErlangMap extends OtpErlangObject { // don't change this! private static final long serialVersionUID = -6410770117696198497L; diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangObject.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangObject.java index 81220c5685..5215e5887b 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangObject.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangObject.java @@ -171,14 +171,14 @@ public abstract class OtpErlangObject implements Serializable, Cloneable { for (j = 0, k = 0; j + 4 < b.length; j += 4, k += 1, k %= 3) { - abc[k] += ((int)b[j+0] & 0xFF) + ((int)b[j+1]<<8 & 0xFF00) - + ((int)b[j+2]<<16 & 0xFF0000) + ((int)b[j+3]<<24); + abc[k] += (b[j+0] & 0xFF) + (b[j+1]<<8 & 0xFF00) + + (b[j+2]<<16 & 0xFF0000) + (b[j+3]<<24); mix(); } for (int n = 0, m = 0xFF; j < b.length; j++, n += 8, m <<= 8) { - abc[k] += (int)b[j]<<n & m; + abc[k] += b[j]<<n & m; } mix(); } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java index f75e4353d0..4c9f5c78a3 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java @@ -18,16 +18,14 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang PIDs. PIDs represent Erlang * processes and consist of a nodename and a number of integers. */ -public class OtpErlangPid extends OtpErlangObject implements Serializable, - Cloneable, Comparable<Object> { +public class OtpErlangPid extends OtpErlangObject implements Comparable<Object> { // don't change this! - static final long serialVersionUID = 1664394142301803659L; + private static final long serialVersionUID = 1664394142301803659L; private final String node; private final int id; @@ -197,14 +195,11 @@ public class OtpErlangPid extends OtpErlangObject implements Serializable, if (serial == pid.serial) { if (id == pid.id) { return node.compareTo(pid.node); - } else { + } return id - pid.id; } - } else { return serial - pid.serial; } - } else { return creation - pid.creation; } } -} diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java index 2a0eab0a9c..8557e17325 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java @@ -18,15 +18,13 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang ports. */ -public class OtpErlangPort extends OtpErlangObject implements Serializable, - Cloneable { +public class OtpErlangPort extends OtpErlangObject { // don't change this! - static final long serialVersionUID = 4037115468007644704L; + private static final long serialVersionUID = 4037115468007644704L; private final String node; private final int id; @@ -40,6 +38,7 @@ public class OtpErlangPort extends OtpErlangObject implements Serializable, * * @deprecated use OtpLocalNode:createPort() instead */ + @SuppressWarnings("unused") private OtpErlangPort(final OtpSelf self) { final OtpErlangPort p = self.createPort(); diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java index 8056439962..13a83333fa 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java @@ -18,17 +18,15 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang refs. There are two styles of Erlang * refs, old style (one id value) and new style (array of id values). This class * manages both types. */ -public class OtpErlangRef extends OtpErlangObject implements Serializable, - Cloneable { +public class OtpErlangRef extends OtpErlangObject { // don't change this! - static final long serialVersionUID = -7022666480768586521L; + private static final long serialVersionUID = -7022666480768586521L; private final String node; private final int creation; diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangShort.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangShort.java index cd232570dd..6ef56defbd 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangShort.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangShort.java @@ -18,13 +18,11 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang integral types. */ -public class OtpErlangShort extends OtpErlangLong implements Serializable, - Cloneable { +public class OtpErlangShort extends OtpErlangLong { // don't change this! static final long serialVersionUID = 7162345156603088099L; @@ -57,7 +55,7 @@ public class OtpErlangShort extends OtpErlangLong implements Serializable, throws OtpErlangRangeException, OtpErlangDecodeException { super(buf); - final short j = shortValue(); + shortValue(); } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java index a5e202c473..1bccfcc567 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java @@ -18,17 +18,14 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; -import java.lang.Character; import java.io.UnsupportedEncodingException; /** * Provides a Java representation of Erlang strings. */ -public class OtpErlangString extends OtpErlangObject implements Serializable, - Cloneable { +public class OtpErlangString extends OtpErlangObject { // don't change this! - static final long serialVersionUID = -7053595217604929233L; + private static final long serialVersionUID = -7053595217604929233L; private final String str; @@ -138,6 +135,7 @@ public class OtpErlangString extends OtpErlangObject implements Serializable, return false; } + @Override protected int doHashCode() { return str.hashCode(); } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java index bffce7f14d..dffaa530cd 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangTuple.java @@ -18,7 +18,6 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang tuples. Tuples are created from one @@ -29,10 +28,9 @@ import java.io.Serializable; * indexed from 0 to (arity-1) and can be retrieved individually by using the * appropriate index. */ -public class OtpErlangTuple extends OtpErlangObject implements Serializable, - Cloneable { +public class OtpErlangTuple extends OtpErlangObject { // don't change this! - static final long serialVersionUID = 9163498658004915935L; + private static final long serialVersionUID = 9163498658004915935L; private static final OtpErlangObject[] NO_ELEMENTS = new OtpErlangObject[0]; @@ -51,9 +49,8 @@ public class OtpErlangTuple extends OtpErlangObject implements Serializable, if (elem == null) { throw new java.lang.IllegalArgumentException( "Tuple element cannot be null"); - } else { - elems = new OtpErlangObject[] { elem }; } + elems = new OtpErlangObject[] { elem }; } /** @@ -242,6 +239,7 @@ public class OtpErlangTuple extends OtpErlangObject implements Serializable, return true; } + @Override protected int doHashCode() { OtpErlangObject.Hash hash = new OtpErlangObject.Hash(9); final int a = arity(); diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangUInt.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangUInt.java index f01354d821..a02996e437 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangUInt.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangUInt.java @@ -18,13 +18,11 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang integral types. */ -public class OtpErlangUInt extends OtpErlangLong implements Serializable, - Cloneable { +public class OtpErlangUInt extends OtpErlangLong { // don't change this! static final long serialVersionUID = -1450956122937471885L; @@ -40,7 +38,7 @@ public class OtpErlangUInt extends OtpErlangLong implements Serializable, public OtpErlangUInt(final int i) throws OtpErlangRangeException { super(i); - final int j = uIntValue(); + uIntValue(); } /** @@ -62,6 +60,6 @@ public class OtpErlangUInt extends OtpErlangLong implements Serializable, throws OtpErlangRangeException, OtpErlangDecodeException { super(buf); - final int j = uIntValue(); + uIntValue(); } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangUShort.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangUShort.java index 6b6bc7a56b..e9d251f815 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangUShort.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangUShort.java @@ -18,13 +18,11 @@ */ package com.ericsson.otp.erlang; -import java.io.Serializable; /** * Provides a Java representation of Erlang integral types. */ -public class OtpErlangUShort extends OtpErlangLong implements Serializable, - Cloneable { +public class OtpErlangUShort extends OtpErlangLong { // don't change this! static final long serialVersionUID = 300370950578307246L; @@ -40,7 +38,7 @@ public class OtpErlangUShort extends OtpErlangLong implements Serializable, public OtpErlangUShort(final short s) throws OtpErlangRangeException { super(s); - final short j = uShortValue(); + uShortValue(); } /** @@ -62,6 +60,6 @@ public class OtpErlangUShort extends OtpErlangLong implements Serializable, throws OtpErlangRangeException, OtpErlangDecodeException { super(buf); - final short j = uShortValue(); + uShortValue(); } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpException.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpException.java index 33d25b6021..874c7da104 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpException.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpException.java @@ -22,6 +22,8 @@ package com.ericsson.otp.erlang; * Base class for the other OTP exception classes. */ public abstract class OtpException extends Exception { + private static final long serialVersionUID = 1L; + /** * Provides no message. */ diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java index f813594541..bab0629382 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java @@ -85,16 +85,17 @@ public class OtpInputStream extends ByteArrayInputStream { * * @return the previous position in the stream. */ - public int setPos(int pos) { + public int setPos(final int pos) { final int oldpos = super.pos; + int apos = pos; if (pos > super.count) { - pos = super.count; + apos = super.count; } else if (pos < 0) { - pos = 0; + apos = 0; } - super.pos = pos; + super.pos = apos; return oldpos; } @@ -108,8 +109,8 @@ public class OtpInputStream extends ByteArrayInputStream { * @exception OtpErlangDecodeException * if the next byte cannot be read. */ - public int readN(final byte[] buf) throws OtpErlangDecodeException { - return this.readN(buf, 0, buf.length); + public int readN(final byte[] abuf) throws OtpErlangDecodeException { + return this.readN(abuf, 0, abuf.length); } /** @@ -121,12 +122,12 @@ public class OtpInputStream extends ByteArrayInputStream { * @exception OtpErlangDecodeException * if the next byte cannot be read. */ - public int readN(final byte[] buf, final int off, final int len) + public int readN(final byte[] abuf, final int off, final int len) throws OtpErlangDecodeException { if (len == 0 && available() == 0) { return 0; } - final int i = super.read(buf, off, len); + final int i = super.read(abuf, off, len); if (i < 0) { throw new OtpErlangDecodeException("Cannot read from input stream"); } @@ -214,7 +215,6 @@ public class OtpInputStream extends ByteArrayInputStream { } catch (final IOException e) { throw new OtpErlangDecodeException("Cannot read from input stream"); } - ; return (b[0] << 8 & 0xff00) + (b[1] & 0xff); } @@ -233,7 +233,6 @@ public class OtpInputStream extends ByteArrayInputStream { } catch (final IOException e) { throw new OtpErlangDecodeException("Cannot read from input stream"); } - ; return (b[0] << 24 & 0xff000000) + (b[1] << 16 & 0xff0000) + (b[2] << 8 & 0xff00) + (b[3] & 0xff); } @@ -253,7 +252,6 @@ public class OtpInputStream extends ByteArrayInputStream { } catch (final IOException e) { throw new OtpErlangDecodeException("Cannot read from input stream"); } - ; return (b[1] << 8 & 0xff00) + (b[0] & 0xff); } @@ -272,7 +270,6 @@ public class OtpInputStream extends ByteArrayInputStream { } catch (final IOException e) { throw new OtpErlangDecodeException("Cannot read from input stream"); } - ; return (b[3] << 24 & 0xff000000) + (b[2] << 16 & 0xff0000) + (b[1] << 8 & 0xff00) + (b[0] & 0xff); } @@ -288,17 +285,17 @@ public class OtpInputStream extends ByteArrayInputStream { * @exception OtpErlangDecodeException * if the next byte cannot be read. */ - public long readLE(int n) throws OtpErlangDecodeException { + public long readLE(final int n) throws OtpErlangDecodeException { final byte[] b = new byte[n]; try { super.read(b); } catch (final IOException e) { throw new OtpErlangDecodeException("Cannot read from input stream"); } - ; long v = 0; - while (n-- > 0) { - v = v << 8 | (long) b[n] & 0xff; + int i = n; + while (i-- > 0) { + v = v << 8 | (long) b[i] & 0xff; } return v; } @@ -321,7 +318,6 @@ public class OtpInputStream extends ByteArrayInputStream { } catch (final IOException e) { throw new OtpErlangDecodeException("Cannot read from input stream"); } - ; long v = 0; for (int i = 0; i < n; i++) { v = v << 8 | (long) b[i] & 0xff; @@ -350,6 +346,7 @@ public class OtpInputStream extends ByteArrayInputStream { * @exception OtpErlangDecodeException * if the next term in the stream is not an atom. */ + @SuppressWarnings("fallthrough") public String read_atom() throws OtpErlangDecodeException { int tag; int len = -1; @@ -382,7 +379,7 @@ public class OtpInputStream extends ByteArrayInputStream { case OtpExternal.smallAtomUtf8Tag: len = read1(); - /* fall through */ + // fall-through case OtpExternal.atomUtf8Tag: if (len < 0) { len = read2BE(); @@ -1055,7 +1052,7 @@ public class OtpInputStream extends ByteArrayInputStream { } return new OtpErlangFun(pid, module, index, uniq, freeVars); } else if (tag == OtpExternal.newFunTag) { - final int n = read4BE(); + read4BE(); final int arity = read1(); final byte[] md5 = new byte[16]; readN(md5); @@ -1149,13 +1146,13 @@ public class OtpInputStream extends ByteArrayInputStream { } final int size = read4BE(); - final byte[] buf = new byte[size]; + final byte[] abuf = new byte[size]; final java.util.zip.InflaterInputStream is = new java.util.zip.InflaterInputStream(this, new java.util.zip.Inflater(), size); int curPos = 0; try { int curRead; - while(curPos < size && (curRead = is.read(buf, curPos, size - curPos)) != -1) { + while(curPos < size && (curRead = is.read(abuf, curPos, size - curPos)) != -1) { curPos += curRead; } if (curPos != size) { @@ -1166,7 +1163,8 @@ public class OtpInputStream extends ByteArrayInputStream { throw new OtpErlangDecodeException("Cannot read from input stream"); } - final OtpInputStream ois = new OtpInputStream(buf, flags); + @SuppressWarnings("resource") + final OtpInputStream ois = new OtpInputStream(abuf, flags); return ois.read_any(); } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMD5.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMD5.java index 903a446258..a5a4d86602 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMD5.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMD5.java @@ -101,8 +101,11 @@ class OtpMD5 { private void to_buffer(int to_start, final int[] from, int from_start, int num) { - while (num-- > 0) { - buffer[to_start++] = from[from_start++]; + int ix = num; + int to_ix = to_start; + int from_ix = from_start; + while (ix-- > 0) { + buffer[to_ix++] = from[from_ix++]; } } @@ -121,7 +124,7 @@ class OtpMD5 { count[1] = plus(count[1], shr(inlen, 29)); - /* dumpstate(); */ + // dumpstate(); if (inlen >= partlen) { to_buffer(index, bytes, 0, (int) partlen); @@ -144,6 +147,7 @@ class OtpMD5 { } + @SuppressWarnings("unused") private void dumpstate() { System.out.println("state = {" + state[0] + ", " + state[1] + ", " + state[2] + ", " + state[3] + "}"); @@ -185,30 +189,30 @@ class OtpMD5 { private long FF(long a, final long b, final long c, final long d, final long x, final long s, final long ac) { - a = plus(a, plus(plus(F(b, c, d), x), ac)); - a = ROTATE_LEFT(a, s); - return plus(a, b); + long tmp = plus(a, plus(plus(F(b, c, d), x), ac)); + tmp = ROTATE_LEFT(tmp, s); + return plus(tmp, b); } private long GG(long a, final long b, final long c, final long d, final long x, final long s, final long ac) { - a = plus(a, plus(plus(G(b, c, d), x), ac)); - a = ROTATE_LEFT(a, s); - return plus(a, b); + long tmp = plus(a, plus(plus(G(b, c, d), x), ac)); + tmp = ROTATE_LEFT(tmp, s); + return plus(tmp, b); } private long HH(long a, final long b, final long c, final long d, final long x, final long s, final long ac) { - a = plus(a, plus(plus(H(b, c, d), x), ac)); - a = ROTATE_LEFT(a, s); - return plus(a, b); + long tmp = plus(a, plus(plus(H(b, c, d), x), ac)); + tmp = ROTATE_LEFT(tmp, s); + return plus(tmp, b); } private long II(long a, final long b, final long c, final long d, final long x, final long s, final long ac) { - a = plus(a, plus(plus(I(b, c, d), x), ac)); - a = ROTATE_LEFT(a, s); - return plus(a, b); + long tmp = plus(a, plus(plus(I(b, c, d), x), ac)); + tmp = ROTATE_LEFT(tmp, s); + return plus(tmp, b); } private void decode(final long output[], final int input[], diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java index 4a4a1e7f8f..fc592c222c 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java @@ -128,14 +128,14 @@ public class OtpMbox { * supercede that name. * </p> * - * @param name + * @param aname * the name to register for the mailbox. Specify null to * unregister the existing name from this mailbox. * * @return true if the name was available, or false otherwise. */ - public synchronized boolean registerName(final String name) { - return home.registerName(name, this); + public synchronized boolean registerName(final String aname) { + return home.registerName(aname, this); } /** @@ -350,21 +350,21 @@ public class OtpMbox { * Send a message to a named mailbox created from the same node as this * mailbox. * - * @param name + * @param aname * the registered name of recipient mailbox. * * @param msg * the body of the message to send. * */ - public void send(final String name, final OtpErlangObject msg) { - home.deliver(new OtpMsg(self, name, (OtpErlangObject) msg.clone())); + public void send(final String aname, final OtpErlangObject msg) { + home.deliver(new OtpMsg(self, aname, (OtpErlangObject) msg.clone())); } /** * Send a message to a named mailbox created from another node. * - * @param name + * @param aname * the registered name of recipient mailbox. * * @param node @@ -375,23 +375,23 @@ public class OtpMbox { * the body of the message to send. * */ - public void send(final String name, final String node, + public void send(final String aname, final String node, final OtpErlangObject msg) { try { final String currentNode = home.node(); if (node.equals(currentNode)) { - send(name, msg); + send(aname, msg); } else if (node.indexOf('@', 0) < 0 && node.equals(currentNode.substring(0, currentNode .indexOf('@', 0)))) { - send(name, msg); + send(aname, msg); } else { // other node final OtpCookedConnection conn = home.getConnection(node); if (conn == null) { return; } - conn.send(self, name, msg); + conn.send(self, aname, msg); } } catch (final Exception e) { } @@ -629,8 +629,8 @@ public class OtpMbox { * @return the {@link OtpErlangPid pid} corresponding to the registered * name, or null if the name is not known on this node. */ - public OtpErlangPid whereis(final String name) { - return home.whereis(name); + public OtpErlangPid whereis(final String aname) { + return home.whereis(aname); } /** diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMsg.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMsg.java index 31a5d0fb8f..7c5bc69361 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMsg.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMsg.java @@ -129,13 +129,14 @@ public class OtpMsg { } // other message types (link, unlink) - OtpMsg(int tag, final OtpErlangPid from, final OtpErlangPid to) { + OtpMsg(final int tag, final OtpErlangPid from, final OtpErlangPid to) { // convert TT-tags to equiv non-TT versions + int atag = tag; if (tag > 10) { - tag -= 10; + atag -= 10; } - this.tag = tag; + this.tag = atag; this.from = from; this.to = to; } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpNode.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpNode.java index 7ead0b9c54..68addb9f2c 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpNode.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpNode.java @@ -74,7 +74,7 @@ public class OtpNode extends OtpLocalNode { OtpNodeStatus handler; // flags - private int flags = 0; + private int connFlags = 0; /** * <p> @@ -143,12 +143,12 @@ public class OtpNode extends OtpLocalNode { init(port); } - private synchronized void init(final int port) throws IOException { + private synchronized void init(final int aport) throws IOException { if (!initDone) { connections = new Hashtable<String, OtpCookedConnection>(17, (float) 0.95); mboxes = new Mailboxes(); - acceptor = new Acceptor(port); + acceptor = new Acceptor(aport); initDone = true; } } @@ -314,13 +314,13 @@ public class OtpNode extends OtpLocalNode { * OtpNodeStatus} handler object contains callback methods, that will be * called when certain events occur. * - * @param handler + * @param ahandler * the callback object to register. To clear the handler, specify * null as the handler to use. * */ - public synchronized void registerStatusHandler(final OtpNodeStatus handler) { - this.handler = handler; + public synchronized void registerStatusHandler(final OtpNodeStatus ahandler) { + this.handler = ahandler; } /** @@ -344,7 +344,7 @@ public class OtpNode extends OtpLocalNode { * ; * </pre> * - * @param node + * @param anode * the name of the node to ping. * * @param timeout @@ -362,11 +362,11 @@ public class OtpNode extends OtpLocalNode { * * the reply: <- SEND {2,'',#Pid<[email protected]>} {#Ref<[email protected]>,yes} */ - public boolean ping(final String node, final long timeout) { - if (node.equals(this.node)) { + public boolean ping(final String anode, final long timeout) { + if (anode.equals(this.node)) { return true; - } else if (node.indexOf('@', 0) < 0 - && node.equals(this.node + } else if (anode.indexOf('@', 0) < 0 + && anode.equals(this.node .substring(0, this.node.indexOf('@', 0)))) { return true; } @@ -375,7 +375,7 @@ public class OtpNode extends OtpLocalNode { OtpMbox mbox = null; try { mbox = createMbox(); - mbox.send("net_kernel", node, getPingTuple(mbox)); + mbox.send("net_kernel", anode, getPingTuple(mbox)); final OtpErlangObject reply = mbox.receive(timeout); final OtpErlangTuple t = (OtpErlangTuple) reply; @@ -392,17 +392,17 @@ public class OtpNode extends OtpLocalNode { private OtpErlangTuple getPingTuple(final OtpMbox mbox) { final OtpErlangObject[] ping = new OtpErlangObject[3]; final OtpErlangObject[] pid = new OtpErlangObject[2]; - final OtpErlangObject[] node = new OtpErlangObject[2]; + final OtpErlangObject[] anode = new OtpErlangObject[2]; pid[0] = mbox.self(); pid[1] = createRef(); - node[0] = new OtpErlangAtom("is_auth"); - node[1] = new OtpErlangAtom(node()); + anode[0] = new OtpErlangAtom("is_auth"); + anode[1] = new OtpErlangAtom(node()); ping[0] = new OtpErlangAtom("$gen_call"); ping[1] = new OtpErlangTuple(pid); - ping[2] = new OtpErlangTuple(node); + ping[2] = new OtpErlangTuple(anode); return new OtpErlangTuple(ping); } @@ -450,9 +450,8 @@ public class OtpNode extends OtpLocalNode { /* special case for netKernel requests */ if (name.equals("net_kernel")) { return netKernel(m); - } else { - mbox = mboxes.get(name); } + mbox = mboxes.get(name); } else { mbox = mboxes.get(m.getRecipientPid()); } @@ -480,23 +479,23 @@ public class OtpNode extends OtpLocalNode { /* * find or create a connection to the given node */ - OtpCookedConnection getConnection(final String node) { + OtpCookedConnection getConnection(final String anode) { OtpPeer peer = null; OtpCookedConnection conn = null; synchronized (connections) { // first just try looking up the name as-is - conn = connections.get(node); + conn = connections.get(anode); if (conn == null) { // in case node had no '@' add localhost info and try again - peer = new OtpPeer(node); + peer = new OtpPeer(anode); conn = connections.get(peer.node()); if (conn == null) { try { conn = new OtpCookedConnection(this, peer); - conn.setFlags(flags); + conn.setFlags(connFlags); addConnection(conn); } catch (final Exception e) { /* false = outgoing */ @@ -522,35 +521,35 @@ public class OtpNode extends OtpLocalNode { } /* use these wrappers to call handler functions */ - private synchronized void remoteStatus(final String node, final boolean up, + private synchronized void remoteStatus(final String anode, final boolean up, final Object info) { if (handler == null) { return; } try { - handler.remoteStatus(node, up, info); + handler.remoteStatus(anode, up, info); } catch (final Exception e) { } } - synchronized void localStatus(final String node, final boolean up, + synchronized void localStatus(final String anode, final boolean up, final Object info) { if (handler == null) { return; } try { - handler.localStatus(node, up, info); + handler.localStatus(anode, up, info); } catch (final Exception e) { } } - synchronized void connAttempt(final String node, final boolean incoming, + synchronized void connAttempt(final String anode, final boolean incoming, final Object info) { if (handler == null) { return; } try { - handler.connAttempt(node, incoming, info); + handler.connAttempt(anode, incoming, info); } catch (final Exception e) { } } @@ -684,13 +683,13 @@ public class OtpNode extends OtpLocalNode { */ public class Acceptor extends Thread { private final ServerSocket sock; - private final int port; + private final int acceptorPort; private volatile boolean done = false; Acceptor(final int port) throws IOException { sock = new ServerSocket(port); - this.port = sock.getLocalPort(); - OtpNode.this.port = this.port; + this.acceptorPort = sock.getLocalPort(); + OtpNode.this.port = this.acceptorPort; setDaemon(true); setName("acceptor"); @@ -741,7 +740,7 @@ public class OtpNode extends OtpLocalNode { } public int port() { - return port; + return acceptorPort; } @Override @@ -771,7 +770,7 @@ public class OtpNode extends OtpLocalNode { try { synchronized (connections) { conn = new OtpCookedConnection(OtpNode.this, newsock); - conn.setFlags(flags); + conn.setFlags(connFlags); addConnection(conn); } } catch (final OtpAuthException e) { @@ -802,6 +801,6 @@ public class OtpNode extends OtpLocalNode { } public void setFlags(final int flags) { - this.flags = flags; + this.connFlags = flags; } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java index c98790bbd4..ef60a9f38a 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java @@ -25,7 +25,6 @@ import java.io.UnsupportedEncodingException; import java.math.BigDecimal; import java.math.BigInteger; import java.text.DecimalFormat; -import java.util.Arrays; import java.util.zip.Deflater; /** @@ -45,8 +44,11 @@ public class OtpOutputStream extends ByteArrayOutputStream { public static final int defaultIncrement = 2048; // static formats, used to encode floats and doubles + @SuppressWarnings("unused") private static final DecimalFormat eform = new DecimalFormat("e+00;e-00"); + @SuppressWarnings("unused") private static final BigDecimal ten = new BigDecimal(10.0); + @SuppressWarnings("unused") private static final BigDecimal one = new BigDecimal(1.0); private int fixedSize = Integer.MAX_VALUE; @@ -159,9 +161,9 @@ public class OtpOutputStream extends ByteArrayOutputStream { * @see java.io.ByteArrayOutputStream#write(byte[]) */ @Override - public void write(final byte[] buf) { + public void write(final byte[] abuf) { // don't assume that super.write(byte[]) calls write(buf, 0, buf.length) - write(buf, 0, buf.length); + write(abuf, 0, abuf.length); } /* (non-Javadoc) @@ -285,10 +287,11 @@ public class OtpOutputStream extends ByteArrayOutputStream { * @param b * the number of bytes to write from the little end. */ - public void writeLE(long n, final int b) { + public void writeLE(final long n, final int b) { + long v = n; for (int i = 0; i < b; i++) { - write((byte) (n & 0xff)); - n >>= 8; + write((byte) (v & 0xff)); + v >>= 8; } } @@ -518,16 +521,17 @@ public class OtpOutputStream extends ByteArrayOutputStream { write_double(f); } - public void write_big_integer(BigInteger v) { + public void write_big_integer(final BigInteger v) { if (v.bitLength() < 64) { this.write_long(v.longValue(), true); return; } final int signum = v.signum(); + BigInteger val = v; if (signum < 0) { - v = v.negate(); + val = val.negate(); } - final byte[] magnitude = v.toByteArray(); + final byte[] magnitude = val.toByteArray(); final int n = magnitude.length; // Reverse the array to make it little endian. for (int i = 0, j = n; i < j--; i++) { @@ -568,7 +572,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { int n; long mask; for (mask = 0xFFFFffffL, n = 4; (abs & mask) != abs; n++, mask = mask << 8 | 0xffL) { - ; // count nonzero bytes + // count nonzero bytes } write1(OtpExternal.smallBigTag); write1(n); // length @@ -827,7 +831,6 @@ public class OtpOutputStream extends ByteArrayOutputStream { write_nil(); // it should never ever get here... } } else { // unicode or longer, must code as list - final char[] charbuf = s.toCharArray(); final int[] codePoints = OtpErlangString.stringToCodePoints(s); write_list_head(codePoints.length); for (final int codePoint : codePoints) { @@ -867,6 +870,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { * the compression level (<tt>0..9</tt>) */ public void write_compressed(final OtpErlangObject o, int level) { + @SuppressWarnings("resource") final OtpOutputStream oos = new OtpOutputStream(o); /* * similar to erts_term_to_binary() in external.c: @@ -920,6 +924,11 @@ public class OtpOutputStream extends ByteArrayOutputStream { "Intermediate stream failed for Erlang object " + o); } finally { this.fixedSize = Integer.MAX_VALUE; + try { + dos.close(); + } catch (IOException e) { + // ignore + } } } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/jinterface.app.src b/lib/jinterface/java_src/com/ericsson/otp/erlang/jinterface.app.src new file mode 100644 index 0000000000..d25d9bc142 --- /dev/null +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/jinterface.app.src @@ -0,0 +1,32 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The 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% +%% +%% This is an -*- erlang -*- file. +%% + +{application, jinterface, + [ + {description, "Jinterface"}, + {vsn, "%VSN%"}, + {modules, []}, + {registered, []}, + {applications, []}, + {env, []}, + {runtime_dependencies, []} + ] +}. diff --git a/lib/jinterface/test/jinterface_SUITE.erl b/lib/jinterface/test/jinterface_SUITE.erl index cb725164cd..00abc97ff5 100644 --- a/lib/jinterface/test/jinterface_SUITE.erl +++ b/lib/jinterface/test/jinterface_SUITE.erl @@ -38,7 +38,8 @@ java_exit_with_reason_any_term/1, status_handler_localStatus/1, status_handler_remoteStatus/1, status_handler_connAttempt/1, - maps/1 + maps/1, + fun_equals/1 ]). -include_lib("common_test/include/ct.hrl"). @@ -106,7 +107,8 @@ fundamental() -> register_and_whereis, % RegisterAndWhereis.java get_names, % GetNames.java boolean_atom, % BooleanAtom.java - maps % Maps.java + maps, % Maps.java + fun_equals % FunEquals.java ]. ping() -> @@ -691,6 +693,18 @@ maps(Config) when is_list(Config) -> []). %%%----------------------------------------------------------------- +fun_equals(doc) -> + ["FunEquals.java: " + "Test OtpErlangFun.equals()"]; +fun_equals(suite) -> + []; +fun_equals(Config) when is_list(Config) -> + ok = jitu:java(?config(java, Config), + ?config(data_dir, Config), + "FunEquals", + []). + +%%%----------------------------------------------------------------- %%% INTERNAL FUNCTIONS %%%----------------------------------------------------------------- send_receive(TestCaseTag,Fun,Config) -> diff --git a/lib/jinterface/test/jinterface_SUITE_data/FunEquals.java b/lib/jinterface/test/jinterface_SUITE_data/FunEquals.java new file mode 100644 index 0000000000..961e462cb3 --- /dev/null +++ b/lib/jinterface/test/jinterface_SUITE_data/FunEquals.java @@ -0,0 +1,73 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2010. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +import com.ericsson.otp.erlang.OtpErlangAtom; +import com.ericsson.otp.erlang.OtpErlangFun; +import com.ericsson.otp.erlang.OtpErlangLong; +import com.ericsson.otp.erlang.OtpErlangObject; +import com.ericsson.otp.erlang.OtpErlangPid; + +public class FunEquals { + + /* + Implements test case jinterface_SUITE:fun_equals/1 + + Test the function OtpErlangFun.equals() + */ + + public static void main(String argv[]) { + + OtpErlangPid pid = new OtpErlangPid("here", 4, 5, 0); + String module = "mod"; + int arity = 2; + byte[] md5 = new byte[]{3,5,7}; + int index = 2; + long old_index = 1; + long uniq= 2; + OtpErlangObject[] freeVars = new OtpErlangObject[]{ + new OtpErlangAtom("hej"), new OtpErlangLong(9) + }; + + OtpErlangFun f1 = new OtpErlangFun(pid, module, arity, md5, + index, old_index, uniq, freeVars); + OtpErlangFun f2 = new OtpErlangFun(pid, module, arity, copyArray(md5), + index, old_index, uniq, copyArray(freeVars)); + + if(!f1.equals(f2)) + fail(1); + + } + + private static void fail(int reason) { + System.exit(reason); + } + + private static byte[] copyArray(byte[] source) { + byte[] result = new byte[source.length]; + System.arraycopy(source, 0, result, 0, source.length); + return result; + } + + private static OtpErlangObject[] copyArray(OtpErlangObject[] source) { + OtpErlangObject[] result = new OtpErlangObject[source.length]; + System.arraycopy(source, 0, result, 0, source.length); + return result; + } + +} diff --git a/lib/jinterface/test/jinterface_SUITE_data/GetNames.java b/lib/jinterface/test/jinterface_SUITE_data/GetNames.java index 3d2bc4ac84..54efaad242 100644 --- a/lib/jinterface/test/jinterface_SUITE_data/GetNames.java +++ b/lib/jinterface/test/jinterface_SUITE_data/GetNames.java @@ -18,7 +18,9 @@ */ import java.util.ArrayList; -import com.ericsson.otp.erlang.*; + +import com.ericsson.otp.erlang.OtpMbox; +import com.ericsson.otp.erlang.OtpNode; class GetNames { @@ -37,7 +39,7 @@ class GetNames { OtpMbox mbox3 = node.createMbox(); node.registerName("mbox3",mbox3); - ArrayList existing_names = new ArrayList(); + ArrayList<String> existing_names = new ArrayList<String>(); existing_names.add("mbox3"); existing_names.add("mbox2"); existing_names.add("mbox1"); diff --git a/lib/jinterface/test/jinterface_SUITE_data/Makefile.src b/lib/jinterface/test/jinterface_SUITE_data/Makefile.src index a15ed1aa63..cd68f1ead5 100644 --- a/lib/jinterface/test/jinterface_SUITE_data/Makefile.src +++ b/lib/jinterface/test/jinterface_SUITE_data/Makefile.src @@ -47,7 +47,8 @@ JAVA_FILES = \ MboxSendReceive.java \ MboxLinkUnlink.java \ NodeStatusHandler.java \ - Maps.java + Maps.java \ + FunEquals.java CLASS_FILES = $(JAVA_FILES:.java=.class) diff --git a/lib/jinterface/test/jinterface_SUITE_data/MboxLinkUnlink.java b/lib/jinterface/test/jinterface_SUITE_data/MboxLinkUnlink.java index 5d1d097cc8..470fdb4a14 100644 --- a/lib/jinterface/test/jinterface_SUITE_data/MboxLinkUnlink.java +++ b/lib/jinterface/test/jinterface_SUITE_data/MboxLinkUnlink.java @@ -17,7 +17,14 @@ * %CopyrightEnd% */ -import com.ericsson.otp.erlang.*; +import com.ericsson.otp.erlang.OtpErlangAtom; +import com.ericsson.otp.erlang.OtpErlangExit; +import com.ericsson.otp.erlang.OtpErlangLong; +import com.ericsson.otp.erlang.OtpErlangObject; +import com.ericsson.otp.erlang.OtpErlangPid; +import com.ericsson.otp.erlang.OtpErlangTuple; +import com.ericsson.otp.erlang.OtpMbox; +import com.ericsson.otp.erlang.OtpNode; class MboxLinkUnlink { @@ -66,7 +73,10 @@ class MboxLinkUnlink { OtpErlangObject[] msg = {mainMbox.self(),mbox.self()}; mbox.send("erl_link_server", erlNode, new OtpErlangTuple(msg)); OtpErlangObject o = mbox.receive(1000); - if (o == null) System.exit(1); + if (o == null) { + System.exit(1); + return; + } OtpErlangTuple tuple = (OtpErlangTuple)o; int tag = (int)((OtpErlangLong)tuple.elementAt(0)).longValue(); @@ -91,6 +101,7 @@ class MboxLinkUnlink { expected = tuple.elementAt(2); mbox.receive(1000); System.exit(2); + break; case erl_link_java_exit: dbg("Java got \"erl_link_java_exit\""); mbox.exit(tuple.elementAt(2)); @@ -104,6 +115,7 @@ class MboxLinkUnlink { expected = tuple.elementAt(2); mbox.receive(1000); System.exit(3); + break; case internal_link_linking_exits: dbg("Java got \"internal_link_linking_exits\""); mbox2 = node.createMbox(); @@ -113,6 +125,7 @@ class MboxLinkUnlink { expected = tuple.elementAt(2); mbox2.receive(1000); // hanging waiting for exit System.exit(4); // got someting other than exit + break; case internal_link_linked_exits: dbg("Java got \"internal_link_linked_exits\""); mbox2 = node.createMbox(); @@ -122,6 +135,7 @@ class MboxLinkUnlink { expected = tuple.elementAt(2); mbox.receive(1000); // hanging waiting for exit System.exit(5); // got someting other than exit + break; case internal_unlink_linking_exits: dbg("Java got \"internal_unlink_linking_exits\""); mbox2 = node.createMbox(); diff --git a/lib/jinterface/test/jinterface_SUITE_data/MboxSendReceive.java b/lib/jinterface/test/jinterface_SUITE_data/MboxSendReceive.java index 2db71bb5cd..44433aa619 100644 --- a/lib/jinterface/test/jinterface_SUITE_data/MboxSendReceive.java +++ b/lib/jinterface/test/jinterface_SUITE_data/MboxSendReceive.java @@ -17,7 +17,13 @@ * %CopyrightEnd% */ -import com.ericsson.otp.erlang.*; +import com.ericsson.otp.erlang.OtpErlangAtom; +import com.ericsson.otp.erlang.OtpErlangLong; +import com.ericsson.otp.erlang.OtpErlangObject; +import com.ericsson.otp.erlang.OtpErlangPid; +import com.ericsson.otp.erlang.OtpErlangTuple; +import com.ericsson.otp.erlang.OtpMbox; +import com.ericsson.otp.erlang.OtpNode; class MboxSendReceive { @@ -35,6 +41,7 @@ class MboxSendReceive { private static final int java_internal_send_receive_different_nodes = 3; private static final int java_internal_send_receive_self = 4; + @SuppressWarnings("null") public static void main(String argv[]) { String cookie = argv[0]; diff --git a/lib/jinterface/test/jinterface_SUITE_data/NodeStatusHandler.java b/lib/jinterface/test/jinterface_SUITE_data/NodeStatusHandler.java index 51ea15b5ef..06ddfa2d61 100644 --- a/lib/jinterface/test/jinterface_SUITE_data/NodeStatusHandler.java +++ b/lib/jinterface/test/jinterface_SUITE_data/NodeStatusHandler.java @@ -17,7 +17,14 @@ * %CopyrightEnd% */ -import com.ericsson.otp.erlang.*; +import com.ericsson.otp.erlang.OtpErlangAtom; +import com.ericsson.otp.erlang.OtpErlangBoolean; +import com.ericsson.otp.erlang.OtpErlangObject; +import com.ericsson.otp.erlang.OtpErlangString; +import com.ericsson.otp.erlang.OtpErlangTuple; +import com.ericsson.otp.erlang.OtpMbox; +import com.ericsson.otp.erlang.OtpNode; +import com.ericsson.otp.erlang.OtpNodeStatus; public class NodeStatusHandler extends OtpNodeStatus { /* @@ -86,7 +93,10 @@ public class NodeStatusHandler extends OtpNodeStatus { } OtpErlangObject o = mbox.receive(recTime); - if (o == null) System.exit(2); + if (o == null) { + System.exit(2); + return; + } if (! ((OtpErlangAtom)o).atomValue().equals("done")) System.exit(3); @@ -100,6 +110,7 @@ public class NodeStatusHandler extends OtpNodeStatus { + @Override public void remoteStatus(String node, boolean up, Object info) { try { dbg("Got remoteStatus: " + node + " " + up + " " + info); @@ -120,6 +131,7 @@ public class NodeStatusHandler extends OtpNodeStatus { } + @Override public void localStatus(String node, boolean up, Object info) { try { dbg("Got localStatus: " + node + " " + up + " " + info); @@ -141,6 +153,7 @@ public class NodeStatusHandler extends OtpNodeStatus { +@Override public void connAttempt(String node, boolean incoming, Object info) { try { dbg("Got connAttempt: " + node + " " + incoming + " " + info); diff --git a/lib/jinterface/test/nc_SUITE_data/echo_server.java b/lib/jinterface/test/nc_SUITE_data/echo_server.java index 2e18e908d4..0e43ea0680 100644 --- a/lib/jinterface/test/nc_SUITE_data/echo_server.java +++ b/lib/jinterface/test/nc_SUITE_data/echo_server.java @@ -148,11 +148,13 @@ public class echo_server { final String atomValue = ((OtpErlangAtom) t).atomValue(); if (atomValue.equals("binary") && i instanceof OtpErlangBinary) { final OtpErlangBinary b = (OtpErlangBinary) i; + @SuppressWarnings("resource") final OtpInputStream bis = new OtpInputStream(b.binaryValue(), 0); final OtpErlangObject o = bis.read_any(); return o; } else if (atomValue.equals("compress")) { + @SuppressWarnings("resource") final OtpOutputStream oos = new OtpOutputStream(); oos.write1(OtpExternal.versionTag); oos.write_compressed(i); @@ -206,6 +208,7 @@ public class echo_server { && i instanceof OtpErlangString) { final OtpErlangString s = (OtpErlangString) i; final String ss = s.stringValue().substring(3, 6); + @SuppressWarnings("unused") final int[] cps = OtpErlangString.stringToCodePoints(ss); return s; } else if (atomValue.equals("utf8")) { diff --git a/lib/jinterface/vsn.mk b/lib/jinterface/vsn.mk index c50200fab6..eea83c2f3f 100644 --- a/lib/jinterface/vsn.mk +++ b/lib/jinterface/vsn.mk @@ -1 +1 @@ -JINTERFACE_VSN = 1.5.9 +JINTERFACE_VSN = 1.5.11 diff --git a/lib/kernel/doc/src/error_logger.xml b/lib/kernel/doc/src/error_logger.xml index 3815b0877c..df2f0b01ee 100644 --- a/lib/kernel/doc/src/error_logger.xml +++ b/lib/kernel/doc/src/error_logger.xml @@ -58,7 +58,7 @@ specific events. (<c>add_report_handler/1,2</c>). Also, there is a useful event handler in STDLIB for multi-file logging of events, see <c>log_mf_h(3)</c>.</p> - <p>Warning events was introduced in Erlang/OTP R9C. To retain + <p>Warning events were introduced in Erlang/OTP R9C. To retain backwards compatibility, these are by default tagged as errors, thus showing up as error reports in the logs. By using the command line flag <c><![CDATA[+W <w | i>]]></c>, they can instead diff --git a/lib/kernel/doc/src/gen_udp.xml b/lib/kernel/doc/src/gen_udp.xml index 503725fe18..291d1b0da7 100644 --- a/lib/kernel/doc/src/gen_udp.xml +++ b/lib/kernel/doc/src/gen_udp.xml @@ -84,7 +84,12 @@ <item> <p>If a socket has somehow been opened without using <c>gen_udp</c>, use this option to pass the file - descriptor for it.</p> + descriptor for it. If <c><anno>Port</anno></c> is not set to 0 + and/or <c>{ip, ip_address()}</c> is combined with this option + the fd will be bound to the given interface and port after being + opened. If these options are not given it is assumed that the fd + is already bound appropriately. + </p> </item> <tag><c>inet6</c></tag> <item> diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index b75644a847..7eaf2d4a44 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -30,6 +30,21 @@ </header> <p>This document describes the changes made to the Kernel application.</p> +<section><title>Kernel 3.0.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Accept inet:ip_address() in net_adm:names/1</p> + <p> + Own Id: OTP-12154</p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 3.0.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -151,7 +166,6 @@ </list> </section> - <section><title>Improvements and New Features</title> <list> <item> @@ -292,25 +306,29 @@ corrected. </p> <p> Thanks to Max Treskin. </p> <p> Own Id: OTP-11730</p> -<section><title>Kernel 2.16.4.1</title> - - <section><title>Known Bugs and Problems</title> - <list> - <item> - <p> - When using gen_tcp:connect and the <c>fd</c> option with - <c>port</c> and/or <c>ip</c>, the <c>port</c> and - <c>ip</c> options were ignored. This has been fixed so - that if <c>port</c> and/or <c>ip</c> is specified - together with <c>fd</c> a bind is requested for that - <c>fd</c>. If <c>port</c> and/or <c>ip</c> is not - specified bind will not be called.</p> - <p> - Own Id: OTP-12061</p> </item> </list> </section> +</section> +<section><title>Kernel 2.16.4.1</title> + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + When using gen_tcp:connect and the <c>fd</c> option with + <c>port</c> and/or <c>ip</c>, the <c>port</c> and + <c>ip</c> options were ignored. This has been fixed so + that if <c>port</c> and/or <c>ip</c> is specified + together with <c>fd</c> a bind is requested for that + <c>fd</c>. If <c>port</c> and/or <c>ip</c> is not + specified bind will not be called.</p> + <p> + Own Id: OTP-12061</p> + </item> + </list> + </section> </section> <section><title>Kernel 2.16.4</title> diff --git a/lib/kernel/doc/src/pg2.xml b/lib/kernel/doc/src/pg2.xml index 5eb63c1ef6..35cf85470a 100644 --- a/lib/kernel/doc/src/pg2.xml +++ b/lib/kernel/doc/src/pg2.xml @@ -34,11 +34,8 @@ <module>pg2</module> <modulesummary>Distributed Named Process Groups</modulesummary> <description> - <p>This module implements process groups. The groups in this - module differ from the groups in the module <c>pg</c> in several - ways. In <c>pg</c>, each message is sent to all members in the - group. In this module, each message may be sent to one, some, or - all members. + <p>This module implements process groups. Each message may be sent + to one, some, or all members of the group. </p> <p>A group of processes can be accessed by a common name. For example, if there is a group named <c>foobar</c>, there can be a @@ -160,8 +157,7 @@ <section> <title>See Also</title> - <p><seealso marker="kernel_app">kernel(6)</seealso>, - <seealso marker="stdlib:pg">pg(3)</seealso></p> + <p><seealso marker="kernel_app">kernel(6)</seealso></p> </section> </erlref> diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index cb3c0a49f4..c7c70ad257 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -122,6 +122,7 @@ HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl \ ../include/net_address.hrl INTERNAL_HRL_FILES= application_master.hrl disk_log.hrl \ + erl_epmd.hrl hipe_ext_format.hrl \ inet_dns.hrl inet_res.hrl \ inet_boot.hrl inet_config.hrl inet_int.hrl \ inet_dns_record_adts.hrl diff --git a/lib/kernel/src/application_master.erl b/lib/kernel/src/application_master.erl index bc15b5a7de..7cdbe31ab2 100644 --- a/lib/kernel/src/application_master.erl +++ b/lib/kernel/src/application_master.erl @@ -103,9 +103,9 @@ call(AppMaster, Req) -> %%% The reason for not using the logical structrure is that %%% the application start function is synchronous, and %%% that the AM is GL. This means that if AM executed the start -%%% function, and this function uses spawn_request/1 -%%% or io, deadlock would occur. Therefore, this function is -%%% executed by the process X. Also, AM needs three loops; +%%% function, and this function uses io, deadlock would occur. +%%% Therefore, this function is executed by the process X. +%%% Also, AM needs three loops; %%% init_loop (waiting for the start function to return) %%% main_loop %%% terminate_loop (waiting for the process to die) diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl index b4fae24ef3..f6e2ca0954 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -85,24 +85,19 @@ port_please1(Node,HostName, Timeout) -> Else end. -names() -> +names() -> {ok, H} = inet:gethostname(), names(H). -names(HostName) when is_atom(HostName) -> - names1(atom_to_list(HostName)); -names(HostName) when is_list(HostName) -> - names1(HostName); -names(EpmdAddr) -> - get_names(EpmdAddr). - -names1(HostName) -> +names(HostName) when is_atom(HostName); is_list(HostName) -> case inet:gethostbyname(HostName) of {ok,{hostent, _Name, _ , _Af, _Size, [EpmdAddr | _]}} -> get_names(EpmdAddr); Else -> Else - end. + end; +names(EpmdAddr) -> + get_names(EpmdAddr). register_node(Name, PortNo) -> diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index b36dbf33dd..046885f885 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -111,8 +111,13 @@ start_shell1(Fun) -> server_loop(Drv, Shell, Buf0) -> receive {io_request,From,ReplyAs,Req} when is_pid(From) -> - Buf = io_request(Req, From, ReplyAs, Drv, Buf0), - server_loop(Drv, Shell, Buf); + %% This io_request may cause a transition to a couple of + %% selective receive loops elsewhere in this module. + Buf = io_request(Req, From, ReplyAs, Drv, Buf0), + server_loop(Drv, Shell, Buf); + {reply,{{From,ReplyAs},Reply}} -> + io_reply(From, ReplyAs, Reply), + server_loop(Drv, Shell, Buf0); {driver_id,ReplyTo} -> ReplyTo ! {self(),driver_id,Drv}, server_loop(Drv, Shell, Buf0); @@ -172,10 +177,13 @@ set_unicode_state(Drv,Bool) -> io_request(Req, From, ReplyAs, Drv, Buf0) -> - case io_request(Req, Drv, Buf0) of + case io_request(Req, Drv, {From,ReplyAs}, Buf0) of {ok,Reply,Buf} -> io_reply(From, ReplyAs, Reply), Buf; + {noreply,Buf} -> + %% We expect a {reply,_} message from the Drv when request is done + Buf; {error,Reply,Buf} -> io_reply(From, ReplyAs, Reply), Buf; @@ -196,78 +204,85 @@ io_request(Req, From, ReplyAs, Drv, Buf0) -> %% io_request({put_chars,unicode,Binary}, Drv, Buf) when is_binary(Binary) -> %% send_drv(Drv, {put_chars,Binary}), %% {ok,ok,Buf}; -io_request({put_chars,unicode,Chars}, Drv, Buf) -> +%% +%% These put requests have to be synchronous to the driver as otherwise +%% there is no guarantee that the data has actually been printed. +io_request({put_chars,unicode,Chars}, Drv, From, Buf) -> case catch unicode:characters_to_binary(Chars,utf8) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode, Binary}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}), + {noreply,Buf}; _ -> {error,{error,{put_chars, unicode,Chars}},Buf} end; -io_request({put_chars,unicode,M,F,As}, Drv, Buf) -> +io_request({put_chars,unicode,M,F,As}, Drv, From, Buf) -> case catch apply(M, F, As) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode,Binary}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}), + {noreply,Buf}; Chars -> case catch unicode:characters_to_binary(Chars,utf8) of B when is_binary(B) -> - send_drv(Drv, {put_chars, unicode,B}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, B, {From,ok}}), + {noreply,Buf}; _ -> {error,{error,F},Buf} end end; -io_request({put_chars,latin1,Binary}, Drv, Buf) when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode,unicode:characters_to_binary(Binary,latin1)}), - {ok,ok,Buf}; -io_request({put_chars,latin1,Chars}, Drv, Buf) -> +io_request({put_chars,latin1,Binary}, Drv, From, Buf) when is_binary(Binary) -> + send_drv(Drv, {put_chars_sync, unicode, + unicode:characters_to_binary(Binary,latin1), + {From,ok}}), + {noreply,Buf}; +io_request({put_chars,latin1,Chars}, Drv, From, Buf) -> case catch unicode:characters_to_binary(Chars,latin1) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode,Binary}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}), + {noreply,Buf}; _ -> {error,{error,{put_chars,latin1,Chars}},Buf} end; -io_request({put_chars,latin1,M,F,As}, Drv, Buf) -> +io_request({put_chars,latin1,M,F,As}, Drv, From, Buf) -> case catch apply(M, F, As) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode,unicode:characters_to_binary(Binary,latin1)}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, + unicode:characters_to_binary(Binary,latin1), + {From,ok}}), + {noreply,Buf}; Chars -> case catch unicode:characters_to_binary(Chars,latin1) of B when is_binary(B) -> - send_drv(Drv, {put_chars, unicode,B}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, B, {From,ok}}), + {noreply,Buf}; _ -> {error,{error,F},Buf} end end; -io_request({get_chars,Encoding,Prompt,N}, Drv, Buf) -> +io_request({get_chars,Encoding,Prompt,N}, Drv, _From, Buf) -> get_chars(Prompt, io_lib, collect_chars, N, Drv, Buf, Encoding); -io_request({get_line,Encoding,Prompt}, Drv, Buf) -> +io_request({get_line,Encoding,Prompt}, Drv, _From, Buf) -> get_chars(Prompt, io_lib, collect_line, [], Drv, Buf, Encoding); -io_request({get_until,Encoding, Prompt,M,F,As}, Drv, Buf) -> +io_request({get_until,Encoding, Prompt,M,F,As}, Drv, _From, Buf) -> get_chars(Prompt, io_lib, get_until, {M,F,As}, Drv, Buf, Encoding); -io_request({get_password,_Encoding},Drv,Buf) -> +io_request({get_password,_Encoding},Drv,_From,Buf) -> get_password_chars(Drv, Buf); -io_request({setopts,Opts}, Drv, Buf) when is_list(Opts) -> +io_request({setopts,Opts}, Drv, _From, Buf) when is_list(Opts) -> setopts(Opts, Drv, Buf); -io_request(getopts, Drv, Buf) -> +io_request(getopts, Drv, _From, Buf) -> getopts(Drv, Buf); -io_request({requests,Reqs}, Drv, Buf) -> - io_requests(Reqs, {ok,ok,Buf}, Drv); +io_request({requests,Reqs}, Drv, From, Buf) -> + io_requests(Reqs, {ok,ok,Buf}, From, Drv); %% New in R12 -io_request({get_geometry,columns},Drv,Buf) -> +io_request({get_geometry,columns},Drv,_From,Buf) -> case get_tty_geometry(Drv) of {W,_H} -> {ok,W,Buf}; _ -> {error,{error,enotsup},Buf} end; -io_request({get_geometry,rows},Drv,Buf) -> +io_request({get_geometry,rows},Drv,_From,Buf) -> case get_tty_geometry(Drv) of {_W,H} -> {ok,H,Buf}; @@ -276,38 +291,49 @@ io_request({get_geometry,rows},Drv,Buf) -> end; %% BC with pre-R13 -io_request({put_chars,Chars}, Drv, Buf) -> - io_request({put_chars,latin1,Chars}, Drv, Buf); -io_request({put_chars,M,F,As}, Drv, Buf) -> - io_request({put_chars,latin1,M,F,As}, Drv, Buf); -io_request({get_chars,Prompt,N}, Drv, Buf) -> - io_request({get_chars,latin1,Prompt,N}, Drv, Buf); -io_request({get_line,Prompt}, Drv, Buf) -> - io_request({get_line,latin1,Prompt}, Drv, Buf); -io_request({get_until, Prompt,M,F,As}, Drv, Buf) -> - io_request({get_until,latin1, Prompt,M,F,As}, Drv, Buf); -io_request(get_password,Drv,Buf) -> - io_request({get_password,latin1},Drv,Buf); - - - -io_request(_, _Drv, Buf) -> +io_request({put_chars,Chars}, Drv, From, Buf) -> + io_request({put_chars,latin1,Chars}, Drv, From, Buf); +io_request({put_chars,M,F,As}, Drv, From, Buf) -> + io_request({put_chars,latin1,M,F,As}, Drv, From, Buf); +io_request({get_chars,Prompt,N}, Drv, From, Buf) -> + io_request({get_chars,latin1,Prompt,N}, Drv, From, Buf); +io_request({get_line,Prompt}, Drv, From, Buf) -> + io_request({get_line,latin1,Prompt}, Drv, From, Buf); +io_request({get_until, Prompt,M,F,As}, Drv, From, Buf) -> + io_request({get_until,latin1, Prompt,M,F,As}, Drv, From, Buf); +io_request(get_password,Drv,From,Buf) -> + io_request({get_password,latin1},Drv,From,Buf); + + + +io_request(_, _Drv, _From, Buf) -> {error,{error,request},Buf}. -%% Status = io_requests(RequestList, PrevStat, Drv) -%% Process a list of output requests as long as the previous status is 'ok'. - -io_requests([R|Rs], {ok,ok,Buf}, Drv) -> - io_requests(Rs, io_request(R, Drv, Buf), Drv); -io_requests([_|_], Error, _Drv) -> +%% Status = io_requests(RequestList, PrevStat, From, Drv) +%% Process a list of output requests as long as +%% the previous status is 'ok' or noreply. +%% +%% We use undefined as the From for all but the last request +%% in order to discards acknowledgements from those requests. +%% +io_requests([R|Rs], {noreply,Buf}, From, Drv) -> + ReqFrom = if Rs =:= [] -> From; true -> undefined end, + io_requests(Rs, io_request(R, Drv, ReqFrom, Buf), From, Drv); +io_requests([R|Rs], {ok,ok,Buf}, From, Drv) -> + ReqFrom = if Rs =:= [] -> From; true -> undefined end, + io_requests(Rs, io_request(R, Drv, ReqFrom, Buf), From, Drv); +io_requests([_|_], Error, _From, _Drv) -> Error; -io_requests([], Stat, _) -> +io_requests([], Stat, _From, _) -> Stat. %% io_reply(From, ReplyAs, Reply) %% The function for sending i/o command acknowledgement. %% The ACK contains the return value. +io_reply(undefined, _ReplyAs, _Reply) -> + %% Ignore these replies as they are generated from io_requests/4. + ok; io_reply(From, ReplyAs, Reply) -> From ! {io_reply,ReplyAs,Reply}, ok. @@ -619,6 +645,10 @@ more_data(What, Cont0, Drv, Ls, Encoding) -> io_request(Req, From, ReplyAs, Drv, []), %WRONG!!! send_drv_reqs(Drv, edlin:redraw_line(Cont)), get_line1({more_chars,Cont,[]}, Drv, Ls, Encoding); + {reply,{{From,ReplyAs},Reply}} -> + %% We take care of replies from puts here as well + io_reply(From, ReplyAs, Reply), + more_data(What, Cont0, Drv, Ls, Encoding); {'EXIT',Drv,interrupt} -> interrupted; {'EXIT',Drv,_} -> @@ -641,6 +671,10 @@ get_line_echo_off1({Chars,[]}, Drv) -> {io_request,From,ReplyAs,Req} when is_pid(From) -> io_request(Req, From, ReplyAs, Drv, []), get_line_echo_off1({Chars,[]}, Drv); + {reply,{{From,ReplyAs},Reply}} when From =/= undefined -> + %% We take care of replies from puts here as well + io_reply(From, ReplyAs, Reply), + get_line_echo_off1({Chars,[]},Drv); {'EXIT',Drv,interrupt} -> interrupted; {'EXIT',Drv,_} -> @@ -790,6 +824,10 @@ get_password1({Chars,[]}, Drv) -> %% set to []. But do we expect anything but plain output? get_password1({Chars, []}, Drv); + {reply,{{From,ReplyAs},Reply}} -> + %% We take care of replies from puts here as well + io_reply(From, ReplyAs, Reply), + get_password1({Chars, []},Drv); {'EXIT',Drv,interrupt} -> interrupted; {'EXIT',Drv,_} -> diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src index f8f4cc1ec2..1bae762bed 100644 --- a/lib/kernel/src/kernel.appup.src +++ b/lib/kernel/src/kernel.appup.src @@ -17,9 +17,7 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 %% Down to - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 }. diff --git a/lib/kernel/src/net_adm.erl b/lib/kernel/src/net_adm.erl index 3f5eac7822..2cdfb76417 100644 --- a/lib/kernel/src/net_adm.erl +++ b/lib/kernel/src/net_adm.erl @@ -89,18 +89,13 @@ names() -> -spec names(Host) -> {ok, [{Name, Port}]} | {error, Reason} when - Host :: atom() | string(), + Host :: atom() | string() | inet:ip_address(), Name :: string(), Port :: non_neg_integer(), Reason :: address | file:posix(). names(Hostname) -> - case inet:gethostbyname(Hostname) of - {ok, {hostent, _Name, _ , _Af, _Size, [Addr | _]}} -> - erl_epmd:names(Addr); - Else -> - Else - end. + erl_epmd:names(Hostname). -spec dns_hostname(Host) -> {ok, Name} | {error, Host} when Host :: atom() | string(), diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index a91c23539d..e6ce85c379 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -29,6 +29,7 @@ -define(OP_INSC,2). -define(OP_DELC,3). -define(OP_BEEP,4). +-define(OP_PUTC_SYNC,5). % Control op -define(CTRL_OP_GET_WINSIZE,100). -define(CTRL_OP_GET_UNICODE_STATE,101). @@ -133,7 +134,7 @@ server1(Iport, Oport, Shell) -> [erlang:system_info(system_version)]))}, Iport, Oport), %% Enter the server loop. - server_loop(Iport, Oport, Curr, User, Gr). + server_loop(Iport, Oport, Curr, User, Gr, queue:new()). rem_sh_opts(Node) -> [{expand_fun,fun(B)-> rpc:call(Node,edlin_expand,expand,[B]) end}]. @@ -158,42 +159,41 @@ start_user() -> User end. -server_loop(Iport, Oport, User, Gr) -> +server_loop(Iport, Oport, User, Gr, IOQueue) -> Curr = gr_cur_pid(Gr), put(current_group, Curr), - server_loop(Iport, Oport, Curr, User, Gr). + server_loop(Iport, Oport, Curr, User, Gr, IOQueue). -server_loop(Iport, Oport, Curr, User, Gr) -> +server_loop(Iport, Oport, Curr, User, Gr, IOQueue) -> receive {Iport,{data,Bs}} -> BsBin = list_to_binary(Bs), Unicode = unicode:characters_to_list(BsBin,utf8), - port_bytes(Unicode, Iport, Oport, Curr, User, Gr); + port_bytes(Unicode, Iport, Oport, Curr, User, Gr, IOQueue); {Iport,eof} -> Curr ! {self(),eof}, - server_loop(Iport, Oport, Curr, User, Gr); - {User,Req} -> % never block from user! - io_request(Req, Iport, Oport), - server_loop(Iport, Oport, Curr, User, Gr); - {Curr,tty_geometry} -> - Curr ! {self(),tty_geometry,get_tty_geometry(Iport)}, - server_loop(Iport, Oport, Curr, User, Gr); - {Curr,get_unicode_state} -> - Curr ! {self(),get_unicode_state,get_unicode_state(Iport)}, - server_loop(Iport, Oport, Curr, User, Gr); - {Curr,set_unicode_state, Bool} -> - Curr ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)}, - server_loop(Iport, Oport, Curr, User, Gr); - {Curr,Req} -> - io_request(Req, Iport, Oport), - server_loop(Iport, Oport, Curr, User, Gr); + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); + Req when element(1,Req) =:= User orelse element(1,Req) =:= Curr, + tuple_size(Req) =:= 2 orelse tuple_size(Req) =:= 3 -> + %% We match {User|Curr,_}|{User|Curr,_,_} + NewQ = handle_req(Req, Iport, Oport, IOQueue), + server_loop(Iport, Oport, Curr, User, Gr, NewQ); + {Oport,ok} -> + %% We get this ok from the port, in io_request we store + %% info about where to send reply at head of queue + {{value,{Origin,Reply}},ReplyQ} = queue:out(IOQueue), + Origin ! {reply,Reply}, + NewQ = handle_req(next, Iport, Oport, ReplyQ), + server_loop(Iport, Oport, Curr, User, Gr, NewQ); {'EXIT',Iport,_R} -> - server_loop(Iport, Oport, Curr, User, Gr); + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); {'EXIT',Oport,_R} -> - server_loop(Iport, Oport, Curr, User, Gr); + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); + {'EXIT',User,shutdown} -> % force data to port + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); {'EXIT',User,_R} -> % keep 'user' alive NewU = start_user(), - server_loop(Iport, Oport, Curr, NewU, gr_set_num(Gr, 1, NewU, {})); + server_loop(Iport, Oport, Curr, NewU, gr_set_num(Gr, 1, NewU, {}), IOQueue); {'EXIT',Pid,R} -> % shell and group leader exit case gr_cur_pid(Gr) of Pid when R =/= die , @@ -213,18 +213,51 @@ server_loop(Iport, Oport, Curr, User, Gr) -> {ok,Gr2} = gr_set_cur(gr_set_num(Gr1, Ix, Pid1, {shell,start,Params}), Ix), put(current_group, Pid1), - server_loop(Iport, Oport, Pid1, User, Gr2); + server_loop(Iport, Oport, Pid1, User, Gr2, IOQueue); _ -> % remote shell io_requests([{put_chars,unicode,"(^G to start new job) ***\n"}], Iport, Oport), - server_loop(Iport, Oport, Curr, User, Gr1) + server_loop(Iport, Oport, Curr, User, Gr1, IOQueue) end; _ -> % not current, just remove it - server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid)) + server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid), IOQueue) end; _X -> %% Ignore unknown messages. - server_loop(Iport, Oport, Curr, User, Gr) + server_loop(Iport, Oport, Curr, User, Gr, IOQueue) + end. + +%% We always handle geometry and unicode requests +handle_req({Curr,tty_geometry},Iport,_Oport,IOQueue) -> + Curr ! {self(),tty_geometry,get_tty_geometry(Iport)}, + IOQueue; +handle_req({Curr,get_unicode_state},Iport,_Oport,IOQueue) -> + Curr ! {self(),get_unicode_state,get_unicode_state(Iport)}, + IOQueue; +handle_req({Curr,set_unicode_state, Bool},Iport,_Oport,IOQueue) -> + Curr ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)}, + IOQueue; +handle_req(next,Iport,Oport,IOQueue) -> + case queue:out(IOQueue) of + {{value,Next},ExecQ} -> + NewQ = handle_req(Next,Iport,Oport,queue:new()), + queue:join(NewQ,ExecQ); + {empty,_} -> + IOQueue + end; +handle_req(Msg,Iport,Oport,IOQueue) -> + case queue:peek(IOQueue) of + empty -> + {Origin,Req} = Msg, + case io_request(Req, Iport, Oport) of + ok -> IOQueue; + Reply -> + %% Push reply info to front of queue + queue:in_r({Origin,Reply},IOQueue) + end; + _Else -> + %% All requests are queued when we have outstanding sync put_chars + queue:in(Msg,IOQueue) end. %% port_bytes(Bytes, InPort, OutPort, CurrentProcess, UserProcess, Group) @@ -232,34 +265,34 @@ server_loop(Iport, Oport, Curr, User, Gr) -> %% either escape to switch_loop or restart the shell. Otherwise send %% the bytes to Curr. -port_bytes([$\^G|_Bs], Iport, Oport, _Curr, User, Gr) -> - handle_escape(Iport, Oport, User, Gr); +port_bytes([$\^G|_Bs], Iport, Oport, _Curr, User, Gr, IOQueue) -> + handle_escape(Iport, Oport, User, Gr, IOQueue); -port_bytes([$\^C|_Bs], Iport, Oport, Curr, User, Gr) -> - interrupt_shell(Iport, Oport, Curr, User, Gr); +port_bytes([$\^C|_Bs], Iport, Oport, Curr, User, Gr, IOQueue) -> + interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue); -port_bytes([B], Iport, Oport, Curr, User, Gr) -> +port_bytes([B], Iport, Oport, Curr, User, Gr, IOQueue) -> Curr ! {self(),{data,[B]}}, - server_loop(Iport, Oport, Curr, User, Gr); -port_bytes(Bs, Iport, Oport, Curr, User, Gr) -> + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); +port_bytes(Bs, Iport, Oport, Curr, User, Gr, IOQueue) -> case member($\^G, Bs) of true -> - handle_escape(Iport, Oport, User, Gr); + handle_escape(Iport, Oport, User, Gr, IOQueue); false -> Curr ! {self(),{data,Bs}}, - server_loop(Iport, Oport, Curr, User, Gr) + server_loop(Iport, Oport, Curr, User, Gr, IOQueue) end. -interrupt_shell(Iport, Oport, Curr, User, Gr) -> +interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue) -> case gr_get_info(Gr, Curr) of undefined -> ok; % unknown _ -> exit(Curr, interrupt) end, - server_loop(Iport, Oport, Curr, User, Gr). + server_loop(Iport, Oport, Curr, User, Gr, IOQueue). -handle_escape(Iport, Oport, User, Gr) -> +handle_escape(Iport, Oport, User, Gr, IOQueue) -> case application:get_env(stdlib, shell_esc) of {ok,abort} -> Pid = gr_cur_pid(Gr), @@ -278,11 +311,11 @@ handle_escape(Iport, Oport, User, Gr) -> Pid1 = group:start(self(), {shell,start,[]}), io_request({put_chars,unicode,"\n"}, Iport, Oport), server_loop(Iport, Oport, User, - gr_add_cur(Gr1, Pid1, {shell,start,[]})); + gr_add_cur(Gr1, Pid1, {shell,start,[]}), IOQueue); _ -> % {ok,jcl} | undefined io_request({put_chars,unicode,"\nUser switch command\n"}, Iport, Oport), - server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr)) + server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr), IOQueue) end. switch_loop(Iport, Oport, Gr) -> @@ -492,9 +525,12 @@ set_unicode_state(Iport, Bool) -> io_request(Request, Iport, Oport) -> try io_command(Request) of - Command -> + {command,_} = Command -> Oport ! {self(),Command}, - ok + ok; + {Command,Reply} -> + Oport ! {self(),Command}, + Reply catch {requests,Rs} -> io_requests(Rs, Iport, Oport); @@ -511,6 +547,13 @@ io_requests([], _Iport, _Oport) -> put_int16(N, Tail) -> [(N bsr 8)band 255,N band 255|Tail]. +%% When a put_chars_sync command is used, user_drv guarantees that +%% the bytes have been put in the buffer of the port before an acknowledgement +%% is sent back to the process sending the request. This command was added in +%% OTP 18 to make sure that data sent from io:format is actually printed +%% to the console before the vm stops when calling erlang:halt(integer()). +io_command({put_chars_sync, unicode,Cs,Reply}) -> + {{command,[?OP_PUTC_SYNC|unicode:characters_to_binary(Cs,utf8)]},Reply}; io_command({put_chars, unicode,Cs}) -> {command,[?OP_PUTC|unicode:characters_to_binary(Cs,utf8)]}; io_command({move_rel,N}) -> diff --git a/lib/kernel/test/gen_tcp_api_SUITE_data/Makefile.src b/lib/kernel/test/gen_tcp_api_SUITE_data/Makefile.src index b6027de0d7..5477598160 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE_data/Makefile.src +++ b/lib/kernel/test/gen_tcp_api_SUITE_data/Makefile.src @@ -1,5 +1,6 @@ NIF_LIBS = gen_tcp_api_SUITE@dll@ +SHLIB_EXTRA_LDLIBS = @LIBS@ all: $(NIF_LIBS) diff --git a/lib/kernel/test/gen_tcp_api_SUITE_data/gen_tcp_api_SUITE.c b/lib/kernel/test/gen_tcp_api_SUITE_data/gen_tcp_api_SUITE.c index 6be7838363..73a6568b30 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE_data/gen_tcp_api_SUITE.c +++ b/lib/kernel/test/gen_tcp_api_SUITE_data/gen_tcp_api_SUITE.c @@ -22,13 +22,12 @@ #include <string.h> #include <assert.h> #include <limits.h> -#include <sys/socket.h> #include <sys/types.h> #ifdef __WIN32__ #include <winsock2.h> #else - +#include <sys/socket.h> #endif #define sock_open(af, type, proto) socket((af), (type), (proto)) diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 2df4bf7c95..4e4aeb67e2 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -882,7 +882,7 @@ passive_sockets_server_send(Socket, X) -> accept_closed_by_other_process(doc) -> ["Tests the return value from gen_tcp:accept when ", - "the socket is closed from an other process. (OTP-3817)"]; + "the socket is closed from another process. (OTP-3817)"]; accept_closed_by_other_process(Config) when is_list(Config) -> ?line Parent = self(), ?line {ok, ListenSocket} = gen_tcp:listen(0, []), diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl index a375adceea..7f6024f642 100644 --- a/lib/kernel/test/interactive_shell_SUITE.erl +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -296,6 +296,7 @@ ctrl_keys(doc) -> ["Tests various control keys"]; ctrl_keys(_Conf) when is_list(_Conf) -> Cu=[$\^u], Cw=[$\^w], + Cy=[$\^y], Home=[27,$O,$H], End=[27,$O,$F], rtnode([{putline,""}, @@ -308,6 +309,8 @@ ctrl_keys(_Conf) when is_list(_Conf) -> {putline,"world\"."++Home++"\"hello "}, % test <HOME> {getline,"\"hello world\""}, {putline,"world"++Home++"\"hello "++End++"\"."}, % test <END> + {getline,"\"hello world\""}, + {putline,"\"hello world\""++Cu++Cy++"."}, {getline,"\"hello world\""}] ++wordLeft()++wordRight(),[]). diff --git a/lib/kernel/test/kernel_SUITE.erl b/lib/kernel/test/kernel_SUITE.erl index 1884e8cf58..613efeeb2f 100644 --- a/lib/kernel/test/kernel_SUITE.erl +++ b/lib/kernel/test/kernel_SUITE.erl @@ -79,17 +79,29 @@ appup_test(_Config) -> appup_tests(_App,{[],[]}) -> {skip,"no previous releases available"}; -appup_tests(App,{OkVsns,NokVsns}) -> +appup_tests(App,{OkVsns0,NokVsns}) -> application:load(App), {_,_,Vsn} = lists:keyfind(App,1,application:loaded_applications()), AppupFileName = atom_to_list(App) ++ ".appup", AppupFile = filename:join([code:lib_dir(App),ebin,AppupFileName]), {ok,[{Vsn,UpFrom,DownTo}=AppupScript]} = file:consult(AppupFile), ct:log("~p~n",[AppupScript]), - ct:log("Testing ok versions: ~p~n",[OkVsns]), + OkVsns = + case OkVsns0 -- [Vsn] of + OkVsns0 -> + OkVsns0; + Ok -> + ct:log("Current version, ~p, is same as in previous release.~n" + "Removing this from the list of ok versions.", + [Vsn]), + Ok + end, + ct:log("Testing that appup allows upgrade from these versions: ~p~n", + [OkVsns]), check_appup(OkVsns,UpFrom,{ok,[restart_new_emulator]}), check_appup(OkVsns,DownTo,{ok,[restart_new_emulator]}), - ct:log("Testing not ok versions: ~p~n",[NokVsns]), + ct:log("Testing that appup does not allow upgrade from these versions: ~p~n", + [NokVsns]), check_appup(NokVsns,UpFrom,error), check_appup(NokVsns,DownTo,error), ok. diff --git a/lib/kernel/test/pdict_SUITE.erl b/lib/kernel/test/pdict_SUITE.erl index 98cff0222e..4b60beb9dc 100644 --- a/lib/kernel/test/pdict_SUITE.erl +++ b/lib/kernel/test/pdict_SUITE.erl @@ -31,7 +31,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - simple/1, complicated/1, heavy/1, info/1]). + simple/1, complicated/1, heavy/1, simple_all_keys/1, info/1]). -export([init_per_testcase/2, end_per_testcase/2]). -export([other_process/2]). @@ -46,7 +46,7 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [simple, complicated, heavy, info]. + [simple, complicated, heavy, simple_all_keys, info]. groups() -> []. @@ -70,6 +70,7 @@ simple(suite) -> []; simple(Config) when is_list(Config) -> XX = get(), + ok = match_keys(XX), erase(), L = [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p, q,r,s,t,u,v,x,y,z,'A','B','C','D'], @@ -105,6 +106,7 @@ simple(Config) when is_list(Config) -> complicated(Config) when is_list(Config) -> Previous = get(), + ok = match_keys(Previous), Previous = erase(), N = case ?t:is_debug() of false -> 500000; @@ -113,8 +115,10 @@ complicated(Config) when is_list(Config) -> comp_1(N), comp_2(N), N = comp_3(lists:sort(get()), 1), + ok = match_keys(get()), comp_4(get()), [] = get(), + [] = get_keys(), [put(Key, Value) || {Key,Value} <- Previous], ok. @@ -160,6 +164,26 @@ heavy(Config) when is_list(Config) -> [put(Key, Value) || {Key,Value} <- XX], ok. +simple_all_keys(Config) when is_list(Config) -> + erase(), + ok = simple_all_keys_add_loop(1000), + [] = get_keys(), + [] = get(), + ok. + +simple_all_keys_add_loop(0) -> + simple_all_keys_del_loop(erlang:get_keys()); +simple_all_keys_add_loop(N) -> + put(gen_key(N),value), + ok = match_keys(get()), + simple_all_keys_add_loop(N-1). + +simple_all_keys_del_loop([]) -> ok; +simple_all_keys_del_loop([K|Ks]) -> + value = erase(K), + ok = match_keys(get()), + simple_all_keys_del_loop(Ks). + info(doc) -> ["Tests process_info(Pid, dictionary)"]; info(suite) -> @@ -339,3 +363,8 @@ m(A,B,Module,Line) -> [A,B,Module,Line]), exit({no_match,{A,B},Module,Line}) end. + +match_keys(All) -> + Ks = lists:sort([K||{K,_}<-All]), + Ks = lists:sort(erlang:get_keys()), + ok. diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index 1ecfde190e..be633a304a 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 3.0.2 +KERNEL_VSN = 3.0.3 diff --git a/lib/megaco/configure.in b/lib/megaco/configure.in index 64daa959b5..e3c24a58b8 100644 --- a/lib/megaco/configure.in +++ b/lib/megaco/configure.in @@ -167,6 +167,26 @@ if test "x$GCC" = xyes; then LM_TRY_ENABLE_CFLAG([-Werror=return-type], [CFLAGS]) fi +dnl ---------------------------------------------------------------------- +dnl Enable -fsanitize= flags. +dnl ---------------------------------------------------------------------- + +m4_define(DEFAULT_SANITIZERS, [address,undefined]) +AC_ARG_ENABLE( + sanitizers, + AS_HELP_STRING( + [--enable-sanitizers@<:@=comma-separated list of sanitizers@:>@], + [Default=DEFAULT_SANITIZERS]), +[ +case "$enableval" in + no) sanitizers= ;; + yes) sanitizers="-fsanitize=DEFAULT_SANITIZERS" ;; + *) sanitizers="-fsanitize=$enableval" ;; +esac +CFLAGS="$CFLAGS $sanitizers" +LDFLAGS="$LDFLAGS $sanitizers" +]) + dnl dnl If ${ERL_TOP}/make/otp_ded.mk.in exists and contains DED_MK_VSN > 0, dnl every thing releted to compiling Dynamic Erlang Drivers can be found diff --git a/lib/megaco/doc/src/notes.xml b/lib/megaco/doc/src/notes.xml index dff36fd51c..9a260c3878 100644 --- a/lib/megaco/doc/src/notes.xml +++ b/lib/megaco/doc/src/notes.xml @@ -36,7 +36,24 @@ section is the version number of Megaco.</p> - <section><title>Megaco 3.17.1</title> + <section><title>Megaco 3.17.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Implement --enable-sanitizers[=sanitizers]. Similar to + debugging with Valgrind, it's very useful to enable + -fsanitize= switches to catch bugs at runtime.</p> + <p> + Own Id: OTP-12153</p> + </item> + </list> + </section> + +</section> + +<section><title>Megaco 3.17.1</title> <section><title>Improvements and New Features</title> <list> diff --git a/lib/megaco/src/app/megaco.appup.src b/lib/megaco/src/app/megaco.appup.src index db59f55b55..a3a2e2ea9c 100644 --- a/lib/megaco/src/app/megaco.appup.src +++ b/lib/megaco/src/app/megaco.appup.src @@ -174,11 +174,19 @@ %% | %% v %% 3.17.0.3 +%% | +%% v +%% 3.17.1 +%% | +%% v +%% 3.17.2 %% %% {"%VSN%", [ + {"3.17.1", [{restart_application,megaco}]}, + {"3.17.0.3", [{restart_application,megaco}]}, {"3.17.0.2", []}, {"3.17.0.1", []}, {"3.17", []}, @@ -190,6 +198,8 @@ } ], [ + {"3.17.1", [{restart_application,megaco}]}, + {"3.17.0.3", [{restart_application,megaco}]}, {"3.17.0.2", []}, {"3.17.0.1", []}, {"3.17", []}, diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk index 373f5199bf..1f4e3b8e95 100644 --- a/lib/megaco/vsn.mk +++ b/lib/megaco/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = megaco -MEGACO_VSN = 3.17.1 +MEGACO_VSN = 3.17.2 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 08212dfede..e5c7d87f52 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -38,7 +38,42 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.12.1</title> + <section><title>Mnesia 4.12.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Various logging fixes, including: Add run queue index to + the process dump in crash dumps.<br/> Add thread index to + enomem slogan when crashing.<br/> Remove error logger + message for sending messages to old instances of the same + node.</p> + <p> + Own Id: OTP-12115</p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.12.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a race which could make create_table fail if a node + was going down during the transaction.</p> + <p> + Own Id: OTP-12124 Aux Id: seq12694 </p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.12.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index fe2fd67d71..5a9bae54da 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -300,8 +300,13 @@ mnesia_down(Node) -> end. wait_for_schema_commit_lock() -> - link(whereis(?SERVER_NAME)), - unsafe_call(wait_for_schema_commit_lock). + try + Pid = whereis(?SERVER_NAME), + link(Pid), %% Keep the link until release_schema_commit_lock + gen_server:call(Pid, wait_for_schema_commit_lock, infinity) + catch _:_ -> + mnesia:abort({node_not_running, node()}) + end. block_controller() -> call(block_controller). @@ -557,12 +562,6 @@ cast(Msg) -> abcast(Nodes, Msg) -> gen_server:abcast(Nodes, ?SERVER_NAME, Msg). -unsafe_call(Msg) -> - case whereis(?SERVER_NAME) of - undefined -> {error, {node_not_running, node()}}; - Pid -> gen_server:call(Pid, Msg, infinity) - end. - call(Msg) -> case whereis(?SERVER_NAME) of undefined -> diff --git a/lib/mnesia/src/mnesia_frag.erl b/lib/mnesia/src/mnesia_frag.erl index 4a1616e054..66fc20913c 100644 --- a/lib/mnesia/src/mnesia_frag.erl +++ b/lib/mnesia/src/mnesia_frag.erl @@ -939,7 +939,7 @@ do_split(_FH, _OldN, _FragNames, [], Ops) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Delete a fragment from a fragmented table -%% and merge its records with an other fragment +%% and merge its records with another fragment make_multi_del_frag(Tab) -> verify_multi(Tab), diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index 4afbea1cc2..530317bcdd 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -208,7 +208,8 @@ do_get_network_copy(Tab, Reason, Ns, Storage, Cs) -> set({Tab, load_node}, Node), set({Tab, load_reason}, Reason), mnesia_controller:i_have_tab(Tab), - dbg_out("Table ~p copied from ~p to ~p~n", [Tab, Node, node()]), + dbg_out("Table ~p copied from ~p to ~p (~b entries)~n", + [Tab, Node, node(), mnesia:table_info(Tab, size)]), {loaded, ok}; Err = {error, _} when element(1, Reason) == dumper -> {not_loaded,Err}; diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index 173c46898b..d5b96c5c76 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.12.1 +MNESIA_VSN = 4.12.3 diff --git a/lib/observer/doc/src/notes.xml b/lib/observer/doc/src/notes.xml index c135e29520..658ac2c7cf 100644 --- a/lib/observer/doc/src/notes.xml +++ b/lib/observer/doc/src/notes.xml @@ -31,6 +31,21 @@ <p>This document describes the changes made to the Observer application.</p> +<section><title>Observer 2.0.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed statusbar on Windows</p> + <p> + Own Id: OTP-12162</p> + </item> + </list> + </section> + +</section> + <section><title>Observer 2.0.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/observer/doc/src/observer_ug.xml b/lib/observer/doc/src/observer_ug.xml index 3aeaf1997a..62f99c5210 100644 --- a/lib/observer/doc/src/observer_ug.xml +++ b/lib/observer/doc/src/observer_ug.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2011</year><year>2013</year> + <year>2011</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -54,9 +54,6 @@ impact only the active viewer is updated and the other views will be updated when activated. </p> - <note> - <p>Only R15B nodes can be observed.</p> - </note> <p> In general the mouse buttons behaves as expected, use left click to select objects, right click to pop up a menu with most used diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index 03ca1bf9c1..c86f5ea916 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -112,10 +112,6 @@ setup(#state{frame = Frame} = State) -> observer_lib:create_menus(DefMenus, MenuBar, default), wxFrame:setMenuBar(Frame, MenuBar), - StatusBar = wxStatusBar:new(Frame), - wxFrame:setStatusBar(Frame, StatusBar), - wxFrame:setTitle(Frame, atom_to_list(node())), - wxStatusBar:setStatusText(StatusBar, atom_to_list(node())), %% Setup panels Panel = wxPanel:new(Frame, []), @@ -131,6 +127,11 @@ setup(#state{frame = Frame} = State) -> wxSizer:add(MainSizer, Notebook, [{proportion, 1}, {flag, ?wxEXPAND}]), wxPanel:setSizer(Panel, MainSizer), + StatusBar = wxStatusBar:new(Frame), + wxFrame:setStatusBar(Frame, StatusBar), + wxFrame:setTitle(Frame, atom_to_list(node())), + wxStatusBar:setStatusText(StatusBar, atom_to_list(node())), + wxNotebook:connect(Notebook, command_notebook_page_changing), wxFrame:connect(Frame, close_window, [{skip, true}]), wxMenu:connect(Frame, command_menu_selected), diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 03ab0c20e1..1266b1f9b9 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -101,7 +101,7 @@ end_per_group(_GroupName, Config) -> init_per_suite(Config) when is_list(Config) -> delete_saved(Config), DataDir = ?config(data_dir,Config), - Rels = [R || R <- [r15b,r16b], ?t:is_release_available(R)] ++ [current], + Rels = [R || R <- [r16b,'17'], ?t:is_release_available(R)] ++ [current], io:format("Creating crash dumps for the following releases: ~p", [Rels]), AllDumps = create_dumps(DataDir,Rels), [{dumps,AllDumps}|Config]. @@ -563,12 +563,6 @@ dump_with_strange_module_name(DataDir,Rel,DumpName) -> CD. dump(Node,DataDir,Rel,DumpName) -> - case Rel of - _ when Rel<r15b, Rel=/=current -> - rpc:call(Node,os,putenv,["ERL_CRASH_DUMP_SECONDS","600"]); - _ -> - ok - end, rpc:call(Node,erlang,halt,[DumpName]), Crashdump0 = filename:join(filename:dirname(code:which(?t)), "erl_crash_dump.n1"), @@ -623,42 +617,21 @@ dos_dump(DataDir,Rel,Dump) -> rel_opt(Rel) -> case Rel of - r9b -> [{erl,[{release,"r9b_patched"}]}]; - r9c -> [{erl,[{release,"r9c_patched"}]}]; - r10b -> [{erl,[{release,"r10b_patched"}]}]; - r11b -> [{erl,[{release,"r11b_patched"}]}]; - r12b -> [{erl,[{release,"r12b_patched"}]}]; - r13b -> [{erl,[{release,"r13b_patched"}]}]; - r14b -> [{erl,[{release,"r14b_latest"}]}]; %naming convention changed - r15b -> [{erl,[{release,"r15b_latest"}]}]; r16b -> [{erl,[{release,"r16b_latest"}]}]; + '17' -> [{erl,[{release,"17_latest"}]}]; current -> [] end. dump_prefix(Rel) -> case Rel of - r9b -> "r9b_dump."; - r9c -> "r9c_dump."; - r10b -> "r10b_dump."; - r11b -> "r11b_dump."; - r12b -> "r12b_dump."; - r13b -> "r13b_dump."; - r14b -> "r14b_dump."; - r15b -> "r15b_dump."; r16b -> "r16b_dump."; - current -> "r17b_dump." + '17' -> "r17_dump."; + current -> "r18_dump." end. compat_rel(Rel) -> case Rel of - r9b -> "+R9 "; - r9c -> "+R9 "; - r10b -> "+R10 "; - r11b -> "+R11 "; - r12b -> "+R12 "; - r13b -> "+R13 "; - r14b -> "+R14 "; - r15b -> "+R15 "; r16b -> "+R16 "; + '17' -> "+R17 "; current -> "" end. diff --git a/lib/observer/vsn.mk b/lib/observer/vsn.mk index b55cff7332..dbbbde1467 100644 --- a/lib/observer/vsn.mk +++ b/lib/observer/vsn.mk @@ -1 +1 @@ -OBSERVER_VSN = 2.0.1 +OBSERVER_VSN = 2.0.2 diff --git a/lib/odbc/c_src/odbcserver.c b/lib/odbc/c_src/odbcserver.c index b4655ce373..84c201a656 100644 --- a/lib/odbc/c_src/odbcserver.c +++ b/lib/odbc/c_src/odbcserver.c @@ -389,6 +389,9 @@ DWORD WINAPI database_handler(const char *port) close_socket(socket); clean_socket_lib(); /* Exit will be done by suervisor thread */ +#ifdef WIN32 + return (DWORD)0; +#endif } /* Description: Calls the appropriate function to handle the database @@ -631,7 +634,7 @@ static db_result_msg db_query(byte *sql, db_state *state) &statement_handle(state)))) DO_EXIT(EXIT_ALLOC); - result = SQLExecDirect(statement_handle(state), sql, SQL_NTS); + result = SQLExecDirect(statement_handle(state), (SQLCHAR *)sql, SQL_NTS); /* SQL_SUCCESS_WITH_INFO at this point may indicate an error in user input. */ if (result != SQL_SUCCESS && result != SQL_NO_DATA_FOUND) { @@ -723,7 +726,7 @@ static db_result_msg db_select_count(byte *sql, db_state *state) (SQLPOINTER)SQL_SCROLLABLE, (SQLINTEGER)0); } - if(!sql_success(SQLExecDirect(statement_handle(state), sql, SQL_NTS))) { + if(!sql_success(SQLExecDirect(statement_handle(state), (SQLCHAR *)sql, SQL_NTS))) { diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); clean_state(state); return encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); @@ -864,7 +867,7 @@ static db_result_msg db_param_query(byte *buffer, db_state *state) if(params != NULL) { - result = SQLExecDirect(statement_handle(state), sql, SQL_NTS); + result = SQLExecDirect(statement_handle(state), (SQLCHAR *)sql, SQL_NTS); if (!sql_success(result) || result == SQL_NO_DATA) { diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); } @@ -955,7 +958,7 @@ static db_result_msg db_describe_table(byte *sql, db_state *state) &statement_handle(state)))) DO_EXIT(EXIT_ALLOC); - if (!sql_success(SQLPrepare(statement_handle(state), sql, SQL_NTS))){ + if (!sql_success(SQLPrepare(statement_handle(state), (SQLCHAR *)sql, SQL_NTS))){ diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); msg = encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); clean_state(state); @@ -1324,7 +1327,7 @@ static db_result_msg encode_column_name_list(SQLSMALLINT num_of_columns, if (columns(state)[i].type.c == SQL_C_BINARY) { /* retrived later by retrive_binary_data */ - }else { + } else { if(!sql_success( SQLBindCol (statement_handle(state), @@ -1336,7 +1339,7 @@ static db_result_msg encode_column_name_list(SQLSMALLINT num_of_columns, DO_EXIT(EXIT_BIND); } ei_x_encode_string_len(&dynamic_buffer(state), - name, name_len); + (char *)name, name_len); } else { columns(state)[i].type.len = 0; @@ -2739,8 +2742,8 @@ static diagnos get_diagnos(SQLSMALLINT handleType, SQLHANDLE handle, Boolean ext the error message is obtained */ for(record_nr = 1; ;record_nr++) { result = SQLGetDiagRec(handleType, handle, record_nr, current_sql_state, - &nativeError, current_errmsg_pos, - (SQLSMALLINT)errmsg_buffer_size, &errmsg_size); + &nativeError, (SQLCHAR *)current_errmsg_pos, + (SQLSMALLINT)errmsg_buffer_size, &errmsg_size); if(result == SQL_SUCCESS) { /* update the sqlstate in the diagnos record, because the SQLGetDiagRec call succeeded */ diff --git a/lib/odbc/c_src/odbcserver.h b/lib/odbc/c_src/odbcserver.h index 916a7cb31d..7112fd2d47 100644 --- a/lib/odbc/c_src/odbcserver.h +++ b/lib/odbc/c_src/odbcserver.h @@ -119,7 +119,7 @@ /*------------------------ TYPDEFS ----------------------------------*/ -typedef unsigned char byte; +typedef char byte; typedef int Boolean; typedef struct { @@ -201,4 +201,4 @@ typedef enum { #define param_query(db_state) (db_state -> param_query) #define out_params(db_state) (db_state -> out_params) #define extended_errors(db_state) (db_state -> extended_errors) -#define extended_error(db_state, errorcode) ( extended_errors(state) ? errorcode : NULL ) +#define extended_error(db_state, errorcode) ( extended_errors(state) ? ((char *)errorcode) : NULL ) diff --git a/lib/odbc/configure.in b/lib/odbc/configure.in index f86146759c..0cfcb9964b 100644 --- a/lib/odbc/configure.in +++ b/lib/odbc/configure.in @@ -136,7 +136,7 @@ AC_SUBST(THR_LIBS) odbc_lib_link_success=no AC_SUBST(TARGET_FLAGS) case $host_os in - darwin1[[0-2]].*|darwin[[0-9]].*) + darwin1[[0-4]].*|darwin[[0-9]].*) TARGET_FLAGS="-DUNIX" if test ! -d "$with_odbc" || test "$with_odbc" = "yes"; then ODBC_LIB= -L"/usr/lib" @@ -228,4 +228,24 @@ if test "x$GCC" = xyes; then LM_TRY_ENABLE_CFLAG([-Werror=return-type], [CFLAGS]) fi +dnl ---------------------------------------------------------------------- +dnl Enable -fsanitize= flags. +dnl ---------------------------------------------------------------------- + +m4_define(DEFAULT_SANITIZERS, [address,undefined]) +AC_ARG_ENABLE( + sanitizers, + AS_HELP_STRING( + [--enable-sanitizers@<:@=comma-separated list of sanitizers@:>@], + [Default=DEFAULT_SANITIZERS]), +[ +case "$enableval" in + no) sanitizers= ;; + yes) sanitizers="-fsanitize=DEFAULT_SANITIZERS" ;; + *) sanitizers="-fsanitize=$enableval" ;; +esac +CFLAGS="$CFLAGS $sanitizers" +LDFLAGS="$LDFLAGS $sanitizers" +]) + AC_OUTPUT(c_src/$host/Makefile:c_src/Makefile.in) diff --git a/lib/odbc/doc/src/error_handling.xml b/lib/odbc/doc/src/error_handling.xml index b255865263..0b6179409d 100644 --- a/lib/odbc/doc/src/error_handling.xml +++ b/lib/odbc/doc/src/error_handling.xml @@ -88,7 +88,7 @@ <section> <title>The whole picture </title> <p>As the Erlang ODBC application relies on third party products - and communicates with a database that probably runs on an other + and communicates with a database that probably runs on another computer in the network there are plenty of things that might go wrong. To fully understand the things that might happen it facilitate to know the design of the Erlang ODBC application, diff --git a/lib/odbc/doc/src/notes.xml b/lib/odbc/doc/src/notes.xml index 0ba2b1ff3f..495a675631 100644 --- a/lib/odbc/doc/src/notes.xml +++ b/lib/odbc/doc/src/notes.xml @@ -31,7 +31,30 @@ <p>This document describes the changes made to the odbc application. </p> - <section><title>ODBC 2.10.20</title> + <section><title>ODBC 2.10.21</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix compiler warnings reported by LLVM</p> + <p> + Own Id: OTP-12138</p> + </item> + <item> + <p> + Implement --enable-sanitizers[=sanitizers]. Similar to + debugging with Valgrind, it's very useful to enable + -fsanitize= switches to catch bugs at runtime.</p> + <p> + Own Id: OTP-12153</p> + </item> + </list> + </section> + +</section> + +<section><title>ODBC 2.10.20</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index 2a16388929..1907069726 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -47,7 +47,7 @@ all() -> case odbc_test_lib:odbc_check() of ok -> [not_exist_db, commit, rollback, not_explicit_commit, - no_c_node, port_dies, control_process_dies, + no_c_executable, port_dies, control_process_dies, {group, client_dies}, connect_timeout, timeout, many_timeouts, timeout_reset, disconnect_on_timeout, connection_closed, disable_scrollable_cursors, @@ -248,28 +248,31 @@ not_exist_db(_Config) -> test_server:sleep(100). %%------------------------------------------------------------------------- -no_c_node(doc) -> +no_c_executable(doc) -> "Test what happens if the port-program can not be found"; -no_c_node(suite) -> []; -no_c_node(_Config) -> +no_c_executable(suite) -> []; +no_c_executable(_Config) -> process_flag(trap_exit, true), Dir = filename:nativename(filename:join(code:priv_dir(odbc), "bin")), FileName1 = filename:nativename(os:find_executable("odbcserver", Dir)), FileName2 = filename:nativename(filename:join(Dir, "odbcsrv")), - ok = file:rename(FileName1, FileName2), - Result = - case catch odbc:connect(?RDBMS:connection_string(), - odbc_test_lib:platform_options()) of - {error, port_program_executable_not_found} -> - ok; - Else -> - Else - end, - - ok = file:rename(FileName2, FileName1), - ok = Result. + case file:rename(FileName1, FileName2) of + ok -> + Result = + case catch odbc:connect(?RDBMS:connection_string(), + odbc_test_lib:platform_options()) of + {error, port_program_executable_not_found} -> + ok; + Else -> + Else + end, + ok = file:rename(FileName2, FileName1), + ok = Result; + _ -> + {skip, "File permission issues"} + end. %%------------------------------------------------------------------------ port_dies(doc) -> diff --git a/lib/odbc/vsn.mk b/lib/odbc/vsn.mk index 1af4751248..b374e42d15 100644 --- a/lib/odbc/vsn.mk +++ b/lib/odbc/vsn.mk @@ -1 +1 @@ -ODBC_VSN = 2.10.20 +ODBC_VSN = 2.10.21 diff --git a/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl b/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl index 5ec0c084e3..c665e1fbc8 100644 --- a/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl +++ b/lib/orber/COSS/CosNaming/orber_cosnaming_utils.erl @@ -176,7 +176,6 @@ addresses({false, Adr, Rest}, Addresses) -> {lists:reverse([Adr|Addresses]), Rest}; addresses({true, Adr, Rest}, Addresses) -> addresses(address(protocol, Rest, [], []), [Adr|Addresses]). - %% Which protocol. address(protocol, [$:|T], [], []) -> address(version, T, [], [iiop]); @@ -192,6 +191,7 @@ address(protocol, What, _, _) -> [?LINE, What], ?DEBUG_LEVEL), corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{}); + %% Parsed one address, no version found or port found. address(version, [$,|T], Acc, Previous) -> {true, lists:reverse([?DEF_PORT, lists:reverse(Acc), ?DEF_VERS|Previous]), T}; @@ -208,15 +208,26 @@ address(version, [$@|T], Acc, Previous) -> [?LINE, What], ?DEBUG_LEVEL), corba:raise(#'CosNaming_NamingContextExt_InvalidAddress'{}) end; + +%% Found no iiop version, switch to ipv6. +address(version, [$[|T], [], Previous) -> + address(ipv6, T, [], [?DEF_VERS|Previous]); + %% Found no iiop version, switch to port. In this case Acc contains the %% Host. address(version, [$:|T], Acc, Previous) -> - case check_ip_version(T, [$:|Acc]) of - false -> - address(port, T, [], [lists:reverse(Acc), ?DEF_VERS|Previous]); - {ok, NewAcc, NewT, Type} -> - address(Type, NewT, [], [lists:reverse(NewAcc), ?DEF_VERS|Previous]) - end; + address(port, T, [], [lists:reverse(Acc), ?DEF_VERS|Previous]); + +%% Found IPv6 +address(address, [$[|T], [], Previous) -> + address(ipv6, T, [], Previous); + +%% Found port +address(address, [$:|T], Acc, Previous) -> + address(port, T, [], [lists:reverse(Acc)|Previous]); + +address(ipv6, [$]|T], Acc, Previous) -> + address(address, T, Acc, Previous); %% Parsed one address, port not found. address(address, [$,|T], [], Previous) -> @@ -267,68 +278,9 @@ address(address, [], [], Previous) -> address(address, [], Acc, Previous) -> {false, lists:reverse([?DEF_PORT, lists:reverse(Acc)|Previous]), []}; -%% Found port -address(address, [$:|T], Acc, Previous) -> - case check_ip_version(T, [$:|Acc]) of - false -> - address(port, T, [], [lists:reverse(Acc)|Previous]); - {ok, NewAcc, NewT, Type} -> - address(Type, NewT, [], [lists:reverse(NewAcc)|Previous]) - end; - address(Type, [H|T], Acc, Previous) -> address(Type, T, [H|Acc], Previous). - -check_ip_version(T, Acc) -> - case orber_env:ip_version() of - inet -> - false; - inet6 -> - case search_for_delimiter(1, T, Acc, $:) of - {ok, NewAcc, NewT, Type} -> - {ok, NewAcc, NewT, Type}; - _ -> - false - end - end. - -%% An IPv6 address may look like (x == hex, d == dec): -%% * "0:0:0:0:0:0:10.1.1.1" - x:x:x:x:x:x:d.d.d.d -%% * "0:0:0:0:8:800:200C:417A" - x:x:x:x:x:x:x:x -%% We cannot allow compressed addresses (::10.1.1.1) since we it is not -%% possible to know if the last part is a port number or part of the address. -search_for_delimiter(7, [], Acc, $:) -> - {ok, Acc, [], address}; -search_for_delimiter(9, [], Acc, $.) -> - {ok, Acc, [], address}; -search_for_delimiter(_, [], _, _) -> - false; -search_for_delimiter(7, [$/|T], Acc, $:) -> - {ok, Acc, [$/|T], address}; -search_for_delimiter(9, [$/|T], Acc, $.) -> - {ok, Acc, [$/|T], address}; -search_for_delimiter(_, [$/|_T], _Acc, _) -> - false; -search_for_delimiter(7, [$,|T], Acc, $:) -> - {ok, Acc, [$,|T], address}; -search_for_delimiter(9, [$,|T], Acc, $.) -> - {ok, Acc, [$,|T], address}; -search_for_delimiter(_, [$,|_T], _Acc, _) -> - false; -search_for_delimiter(7, [$:|T], Acc, $:) -> - {ok, Acc, T, port}; -search_for_delimiter(9, [$:|T], Acc, $.) -> - {ok, Acc, T, port}; -search_for_delimiter(N, [$:|T], Acc, $:) -> - search_for_delimiter(N+1, T, [$:|Acc], $:); -search_for_delimiter(N, [$.|T], Acc, $.) when N > 6, N < 9 -> - search_for_delimiter(N+1, T, [$.|Acc], $.); -search_for_delimiter(6, [$.|T], Acc, $:) -> - search_for_delimiter(7, T, [$.|Acc], $.); -search_for_delimiter(N, [H|T], Acc, LookingFor) -> - search_for_delimiter(N, T, [H|Acc], LookingFor). - %%---------------------------------------------------------------------- %% Function : key %% Arguments : A string which contain a Key we want to use and, if defined, diff --git a/lib/orber/doc/src/ch_naming_service.xml b/lib/orber/doc/src/ch_naming_service.xml index b735629a14..e355db2edb 100644 --- a/lib/orber/doc/src/ch_naming_service.xml +++ b/lib/orber/doc/src/ch_naming_service.xml @@ -273,25 +273,28 @@ lists:foreach(fun({{Id, Kind},BindingType}) -> case BindingType of <p>The notation of this scheme is similar to the more well known URL <c>HTTP</c>, and the full <c>corbaloc</c> BNF is:</p> <code type="none"><![CDATA[ -<corbaloc> = "corbaloc:"<obj_addr_list>["/"<key_string>] -<obj_addr_list> = [<obj_addr>","]*<obj_addr> -<obj_addr> = <prot_addr> | <future_prot_addr> -<prot_addr> = <rir_prot_addr> | <iiop_prot_addr> -<rir_prot_addr> = <rir_prot_token>":" -<rir_prot_token> = rir -<future_prot_addr> = <future_prot_id><future_prot_addr> -<future_prot_id> = <future_prot_token>":" -<iiop_prot_addr> = <iiop_id><iiop_addr> -<iiop_id> = <iiop_default> | <iiop_prot_token>":" -<iiop_default> = ":" -<iiop_prot_token> = "iiop" -<iiop_addr> = <version><host>[":"<port>] -<host> = DNS-style Host Name | ip_address -<version> = <major>"."<minor>"@" | empty_string -<port> = number -<major> = number -<minor> = number -<key_string> = for example NameService +<corbaloc> = "corbaloc:"<obj_addr_list>["/"<key_string>] +<obj_addr_list> = [<obj_addr>","]*<obj_addr> +<obj_addr> = <prot_addr> | <future_prot_addr> +<prot_addr> = <rir_prot_addr> | <iiop_prot_addr> +<rir_prot_addr> = <rir_prot_token>":" +<rir_prot_token> = rir +<future_prot_addr> = <future_prot_id><future_prot_addr> +<future_prot_id> = <future_prot_token>":" +<iiop_prot_addr> = <iiop_id><iiop_addr> +<iiop_id> = <iiop_default> | <iiop_prot_token>":" +<iiop_default> = ":" +<iiop_prot_token> = "iiop" +<iiop_addr> = <version><host>[":"<port>] +<host> = <DNS-style Host Name> | <ip_v4_address> | "["<ip_v6_address>"]" +<version> = <major>"."<minor>"@" | empty_string +<port> = number +<major> = number +<minor> = number +<DNS-style Host Name> = string +<ip_v4_address> = string +<ip_v6_address> = string +<key_string> = for example NameService ]]></code> <p>The <c>corbaloc</c> scheme consists of 3 parts:</p> <list type="bulleted"> diff --git a/lib/orber/doc/src/corba.xml b/lib/orber/doc/src/corba.xml index 004c7fb9b0..4a11b271b4 100644 --- a/lib/orber/doc/src/corba.xml +++ b/lib/orber/doc/src/corba.xml @@ -294,7 +294,9 @@ Example: <p>This function returns the object reference for the object id asked for. The remote modifier string has the following format: - <c>"iiop://host:port"</c>.</p> + <c>"iiop://"<host>":"<port></c> where <c><host> = <DNS hostname> | + <IPv4 address> | "["<IPv6 address>"]"</c>. + </p> <p>The <em>configuration</em> context is used to override the global SSL client side <seealso marker="ch_install#config">configuration</seealso>.</p> @@ -322,8 +324,11 @@ Example: <v>ObjectId = string()</v> </type> <desc> - <p>This function returns a list of allowed object id's. The remote modifier - string has the following format: <c>"iiop://host:port"</c>.</p> + <p>This function returns a list of allowed object id's. + The remote modifier string has the following format: + <c>"iiop://"<host>":"<port></c> where <c><host> = <DNS hostname> | + <IPv4 address> | "["<IPv6 address>"]"</c>. + </p> <p>The <em>configuration</em> context is used to override the global SSL client side <seealso marker="ch_install#config">configuration</seealso>.</p> @@ -365,9 +370,11 @@ Example: <p>This function takes a <c>corbaname</c>, <c>corbaloc</c> or an IOR on the external string representation and returns the object reference.</p> <p>To lookup the NameService reference, simply use - <c>"corbaloc:iiop:[email protected]:4001/NameService"</c></p> + <c>"corbaloc:iiop:[email protected]:4001/NameService"</c></p> <p>We can also resolve an object from the NameService by using - <c>"corbaname:iiop:[email protected]:4001/NameService#org/Erlang/MyObj"</c></p> + <c>"corbaname:iiop:[email protected]:4001/NameService#org/Erlang/MyObj"</c></p> + <p>To lookup the NameService reference with an IPv6 address, simply use + <c>"corbaloc:iiop:1.2@[FEC1:0:3:0:0312:44AF:FAB1:3D01]:4001/NameService"</c></p> <p>For more information about <c>corbaname</c> and <c>corbaloc</c>, see the User's Guide (Interoperable Naming Service).</p> <p>The <em>configuration</em> context is used to override the global diff --git a/lib/orber/doc/src/notes.xml b/lib/orber/doc/src/notes.xml index 93dc403c47..2167a43eee 100644 --- a/lib/orber/doc/src/notes.xml +++ b/lib/orber/doc/src/notes.xml @@ -33,7 +33,61 @@ </header> - <section><title>Orber 3.6.27</title> + <section><title>Orber 3.7.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Fixed problem with IPv6 addresses in Service Context + when orber is default configured for IPv4. </p> + <p> + Own Id: OTP-12193</p> + </item> + </list> + </section> + +</section> + +<section><title>Orber 3.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> The following functions have been corrected so they + work properly with IPv6 addresses. </p> <list> + <item><c>corba:resolve_initial_references_remote/2/3</c></item> + <item><c>corba:list_initial_references_remote/1/2</c></item> + <item><c>corba:string_to_object/1/2</c></item> </list> + <p> + Own Id: OTP-12016</p> + </item> + <item> + <p> A couple of macros were malformed, missing commas: + PROFILEBODY_1_1_TYPEDEF and PROFILEBODY_1_2_TYPEDEF. + Thanks to Vlad Dumitrescu. </p> + <p> + Own Id: OTP-12062</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> It is now possible to add listen interfaces for IPv6 + when orber is default configured for IPv4 and the other + way around. For more information, consult the User's + Guide and the orber module Reference Manual. </p> + <p> + Own Id: OTP-12007</p> + </item> + </list> + </section> + +</section> + +<section><title>Orber 3.6.27</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/orber/doc/src/orber.xml b/lib/orber/doc/src/orber.xml index 16781059c7..a182a56972 100644 --- a/lib/orber/doc/src/orber.xml +++ b/lib/orber/doc/src/orber.xml @@ -356,8 +356,8 @@ <v>Type = normal | ssl</v> <v>Port = integer() > 0</v> <v>ConfigurationParameters = [{Key, Value}]</v> - <v>Key = flags | iiop_in_connection_timeout | iiop_max_fragments | iiop_max_in_requests | interceptors | iiop_port | iiop_ssl_port | ssl_server_options</v> - <v>Value = as described in the User's Guide</v> + <v>Key = flags | ip_family | iiop_in_connection_timeout | iiop_max_fragments | iiop_max_in_requests | interceptors | iiop_port | iiop_ssl_port | ssl_server_options</v> + <v>Value = as described in the User's Guide or below</v> <v>Result = {ok, Ref} | {error, Reason} | {'EXCEPTION', #'BAD_PARAM'{}}</v> <v>Ref = #Ref</v> <v>Reason = string()</v> @@ -383,6 +383,9 @@ <item><em>flags</em> - currently it is only possible to override the global setting for the <c>Use Current Interface in IOR</c> and <c>Exclude CodeSet Component</c> flags.</item> + <item><em>ip_family</em> - can be set to <c>inet</c> or <c>inet6</c> and is + used to get a listen interface that uses another IP version than the default + set with flags at startup.</item> <item><em>iiop_port</em> - requires that <c>Use Current Interface in IOR</c> is activated and the supplied <c>Type</c> is <c>normal</c>. If so, exported IOR:s will contain the IIOP port defined by this configuration @@ -390,7 +393,7 @@ <item><em>iiop_ssl_port</em> - almost equivalent to <c>iiop_port</c>. The difference is that <c>Type</c> shall be <c>ssl</c> and that exported IOR:s will contain the IIOP via SSL port defined by this configuration - parameter.</item> + parameter.</item> </list> <p>If it is not possible to add a listener based on the supplied interface and port, the error message is one of the ones described in <c>inet</c> diff --git a/lib/orber/src/Makefile b/lib/orber/src/Makefile index d96350f4d5..398e481138 100644 --- a/lib/orber/src/Makefile +++ b/lib/orber/src/Makefile @@ -194,8 +194,7 @@ ERL_IDL_FLAGS += -pa $(ERL_TOP)/lib/orber/ebin ERL_COMPILE_FLAGS += $(ERL_IDL_FLAGS) \ -I$(ERL_TOP)/lib/orber/include \ +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,"orber_$(ORBER_VSN)"}' \ - -D'ORBVSN="$(ORBER_VSN)"' + +'{attribute,insert,app_vsn,"orber_$(ORBER_VSN)"}' ASN_FLAGS = -bber +der +compact_bit_string +nowarn_unused_record diff --git a/lib/orber/src/corba.erl b/lib/orber/src/corba.erl index 989e84f581..586a02d540 100644 --- a/lib/orber/src/corba.erl +++ b/lib/orber/src/corba.erl @@ -311,19 +311,18 @@ resolve_initial_references_remote(_ObjectId, [], _Ctx) -> raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}); resolve_initial_references_remote(ObjectId, [RemoteModifier| Rest], Ctx) when is_list(RemoteModifier) -> - case lists:prefix("iiop://", RemoteModifier) of - true -> - [_, Host, Port] = string:tokens(RemoteModifier, ":/"), + case parse_remote_modifier(RemoteModifier) of + {error, _} -> + resolve_initial_references_remote(ObjectId, Rest, Ctx); + {ok, Host, Port} -> IOR = iop_ior:create_external(orber:giop_version(), "", - Host, list_to_integer(Port), "INIT"), + Host, list_to_integer(Port), "INIT"), %% We know it's an external referens. Hence, no need to check. {_, Key} = iop_ior:get_key(IOR), orber_iiop:request(Key, 'get', [ObjectId], {{'tk_objref', 12, "object"}, [{'tk_string', 0}], - []}, 'true', infinity, IOR, Ctx); - false -> - resolve_initial_references_remote(ObjectId, Rest, Ctx) + []}, 'true', infinity, IOR, Ctx) end. list_initial_services_remote(Address) -> @@ -332,24 +331,44 @@ list_initial_services_remote(Address) -> list_initial_services_remote([], _Ctx) -> raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}); list_initial_services_remote([RemoteModifier| Rest], Ctx) when is_list(RemoteModifier) -> - case lists:prefix("iiop://", RemoteModifier) of - true -> - [_, Host, Port] = string:tokens(RemoteModifier, ":/"), + case parse_remote_modifier(RemoteModifier) of + {error, _} -> + resolve_initial_references_remote(Rest, Ctx); + {ok, Host, Port} -> IOR = iop_ior:create_external(orber:giop_version(), "", Host, list_to_integer(Port), "INIT"), %% We know it's an external referens. Hence, no need to check. {_, Key} = iop_ior:get_key(IOR), orber_iiop:request(Key, 'list', [], {{'tk_sequence', {'tk_string',0},0}, - [], []}, 'true', infinity, IOR, Ctx); - false -> - list_initial_services_remote(Rest, Ctx) + [], []}, 'true', infinity, IOR, Ctx) end; list_initial_services_remote(_, _) -> raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}). +parse_remote_modifier("iiop://" ++ Rest) -> + parse_host_version(Rest); +parse_remote_modifier(_RemoteModifier) -> + {error, not_supported}. + +parse_host_version("[" ++ Rest) -> + parse_ipv6(Rest, []); +parse_host_version(Rest) -> + parse_ipv4_or_dnsname(Rest, []). + + +parse_ipv4_or_dnsname([$: |Rest], Acc) -> + {ok, lists:reverse(Acc), Rest}; +parse_ipv4_or_dnsname([C |Rest], Acc) -> + parse_ipv4_or_dnsname(Rest, [C |Acc]). + +parse_ipv6("]:" ++ Rest, Acc) -> + {ok, lists:reverse(Acc), Rest}; +parse_ipv6([C |Rest], Acc) -> + parse_ipv6(Rest, [C |Acc]). + %%----------------------------------------------------------------- %% Objectreference convertions %%----------------------------------------------------------------- diff --git a/lib/orber/src/corba_request.erl b/lib/orber/src/corba_request.erl deleted file mode 100644 index c4226739a9..0000000000 --- a/lib/orber/src/corba_request.erl +++ /dev/null @@ -1,384 +0,0 @@ -%%-------------------------------------------------------------------- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% -%% -%%----------------------------------------------------------------- -%% File: corba_request.erl -%% Description: -%% This file contains an corba request server for Orber -%% -%%----------------------------------------------------------------- --module(corba_request). - --behaviour(gen_server). - --include_lib("orber/include/corba.hrl"). - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- --export([start/1, stop/0, stop_all/0, create/1, - create_schema/1]). - -%%----------------------------------------------------------------- -%% Internal exports -%%----------------------------------------------------------------- --export([init/1, terminate/2, install/2, handle_call/3, handle_info/2]). --export([handle_cast/2, dump/0, get_key_from_pid/1]). - -%%----------------------------------------------------------------- -%% Standard interface CORBA::Request -%%----------------------------------------------------------------- --export([add_arg/6, - invoke/2, - delete/1, - send/2, - get_response/2]). - -%%----------------------------------------------------------------- -%% Mnesia table definition -%%----------------------------------------------------------------- --record('corba_request', {reqid, ctx, operation, arg_list, result, req_flags, pid}). - - -%%----------------------------------------------------------------- -%% Macros -%%----------------------------------------------------------------- --define(dirty_query_context, true). - -%% This macro returns a read fun suitable for evaluation in a transaction --define(read_function(ReqId), - fun() -> - mnesia:dirty_read(ReqId) - end). - -%% This macro returns a write fun suitable for evaluation in a transaction --define(write_function(R), - fun() -> - mnesia:dirty_write(R) - end). - -%% This macro returns a write fun suitable for evaluation in a transaction --define(update(R), - fun() -> - mnesia:dirty_write(R) - end). - -%% This macro returns a delete fun suitable for evaluation in a transaction --define(delete_function(R), - fun() -> - mnesia:delete(R) - end). - --ifdef(dirty_query_context). --define(query_check(Q_res), Q_res). --else. --define(query_check(Q_res), {atomic, Q_res}). --endif. - - --define(CHECK_EXCEPTION(Res), case Res of - {'EXCEPTION', E} -> - corba:raise(E); - R -> - R - end). - -%%----------------------------------------------------------------- -%% Debugging function -%%----------------------------------------------------------------- -dump() -> - case catch mnesia:dirty_first('orber_request') of - {'EXIT', R} -> - io:format("Exited with ~p\n",[R]); - Key -> - dump_print(Key), - dump_loop(Key) - end. - -dump_loop(PreviousKey) -> - case catch mnesia:dirty_next('orber_request', PreviousKey) of - {'EXIT', R} -> - io:format("Exited with ~p\n",[R]); - '$end_of_table' -> - ok; - Key -> - dump_print(Key), - dump_loop(Key) - end. - -dump_print(Key) -> - case catch mnesia:dirty_read({'orber_request', Key}) of - {'EXIT', R} -> - io:format("Exited with ~p\n",[R]); - [X] -> - io:format("Req Id: ~p, op: ~p\n",[binary_to_term(X#orber_request.object_key), - X#orber_request.pid]); - _ -> - ok - end. - - -%%----------------------------------------------------------------- -%% External interface functions -%%----------------------------------------------------------------- -start(Opts) -> - gen_server:start_link({local, orber_requestserver}, orber_request, Opts, []). - -stop() -> - gen_server:call(orber_requestserver, stop, infinity). - - -stop_all() -> - Fun = fun() -> - mnesia:match_object({orber_request, '_', '_', '_', '_', '_', '_', '_'}) - end, - case catch mnesia:transaction(Fun) of - {atomic, Objects} -> - lists:foreach(fun({orber_request, _, _, _, _, _, _, _ }) -> - ok %gen_server:call(Pid, stop, infinity) - end, - Objects); - R -> - R - end. - -create() -> - ?CHECK_EXCEPTION(gen_server:call(orber_requestserver, - create, infinity)). - -create(Ctx, OP, Args, Flags) -> - ?CHECK_EXCEPTION(gen_server:call(orber_requestserver, - {create, Ctx, OP, Args, Flags}, infinity)). - -delete(ReqId) -> - ?CHECK_EXCEPTION(gen_server:call(orber_requestserver, - {delete, ReqId}, infinity)). - -%%------------------------------------------------------------ -%% Implementation of standard interface -%%------------------------------------------------------------ -add_arg(ReqId, ArgumentName, TC, Value, Len, ArgFlags) -> - Request = ets:lookup_element(orber_request, ReqId), - case Request of - [] -> - ok; - R -> - Args = Request#orber_request.arg_list, - NewArgs = lists:append(Args, []), - ets:insert(orber_request, NewArgs), - ok - end. - -invoke(ReqId, InvokeFlags) -> - ok. - - - -send(ReqId, InvokeFlags) -> - ok. - -get_response(ReqId, ResponseFlags) -> - [{_, Val}] = ets:lookup_element(orber_request, ReqId), - Val#'orber_request'.result. - -%%----------------------------------------------------------------- -%% Server functions -%%----------------------------------------------------------------- -init(Env) -> - case mnesia:wait_for_tables(['orber_request'], infinity) of - ok -> - process_flag(trap_exit, true), - {ok, []}; - StopReason -> - {stop, StopReason} - end. - -terminate(From, Reason) -> - ok. - - - -install(Timeout, Options) -> - %% check if there already exists a database. If not, create one. - %% DB_initialized = perhaps_create_schema(Nodelist), - %% check if mnesia is running. If not, start mnesia. - DB_started = perhaps_start_mnesia(), - - %% Do we have a complete set of IFR tables? If not, create them. - AllTabs = mnesia:system_info(tables), - - DB_Result = case lists:member(orber_request, AllTabs) of - true -> - case lists:member({local_content, true}, - Options) of - true-> - mnesia:add_table_copy(orber_request, - node(), - ram_copies); - _ -> - mnesia:create_table(orber_request, - [{attributes, - record_info(fields, - orber_objkeys)} - |Options]) - end; - _ -> - mnesia:create_table(orber_request, - [{attributes, - record_info(fields, - orber_objkeys)} - |Options]) - end, - - Wait = mnesia:wait_for_tables([orber_request], Timeout), - %% Check if any error has occured yet. If there are errors, return them. - if - DB_Result == {atomic, ok}, - Wait == ok -> - ok; - true -> - {error, {DB_Result, Wait}} - end. - -%%----------------------------------------------------------------- -%% Func: handle_call/3 -%% -%% Comment: -%% In objectkey gen_server all exceptions are tupples and corba:raise -%% may not be used. It is too time consuming to add catches in every -%% function before returning. On the client side there is a case which -%% maps every tupple on the format {'exception', E} to corba:raise(E). -%%----------------------------------------------------------------- -handle_call(stop, From, State) -> - {stop, normal, [], State}; -handle_call(create, From, State) -> - ReqId = term_to_binary({node(), now()}), - _F = ?write_function(#'corba_request'{reqid=ReqId}), - R = write_result(mnesia:transaction(_F)), - - ReqId - - ?query_check(Qres) = mnesia:dirty_read({orber_request, Objkey}), - case Qres of - [] -> - _F = ?write_function(#orber_requests{object_key=Objkey, pid=Pid}), - R = write_result(mnesia:transaction(_F)), - if - R == ok, pid(Pid) -> - link(Pid); - true -> - true - end, - {reply, R, State}; - X -> - {reply, {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}}, - State} - end; -handle_call({delete, ReqId}, From, State) -> - ?query_check(Qres) = mnesia:dirty_read({orber_request, ReqId}), - case Qres of - [] -> - true; - [X] when pid(X#orber_request.pid) -> - unlink(X#orber_request.pid); - _ -> - true - end, - _F = ?delete_function({orber_request, ReqId}), - R = write_result(mnesia:transaction(_F)), - {reply, R, State}. - -handle_info({'EXIT', Pid, Reason}, State) when pid(Pid) -> - _MF = fun() -> - mnesia:match_object({orber_request, '_', '_', '_', '_', '_', '_', Pid}) - end, - ?query_check(Qres) = mnesia:ets(_MF), - case Qres of - [] -> - true; - X -> - remove_requests(X), - unlink(Pid); - _ -> - true - end, - {noreply, State}. - -%%----------------------------------------------------------------- -%% Internal Functions -%%----------------------------------------------------------------- -get_reqids_from_pid(Pid) -> - case mnesia:dirty_match_object({orber_request, '_', '_', '_', '_', '_', '_', Pid}) of - Keys -> - [Keys] - _ -> - corba:raise(#'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO}) - end. - -remove_requests([]) -> - ok; -remove_requests([H|T]) -> - _F = ?delete_function({orber_request, H#orber_request.reqid}), - write_result(mnesia:transaction(_F)), - remove_requests(T). - -%%----------------------------------------------------------------- -%% Check a read transaction -query_result(?query_check(Qres)) -> - case Qres of - [Hres] -> - Hres#orber_request.pid; - [] -> - {'excpetion', #'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO}}; - Other -> - {'excpetion', #'INTERNAL'{completion_status=?COMPLETED_NO}} - end. - -%%----------------------------------------------------------------- -%% Check a write transaction -write_result({atomic,ok}) -> ok; -write_result(Foo) -> - {'excpetion', #'INTERNAL'{completion_status=?COMPLETED_NO}}. - - -create_schema(Nodes) -> - case mnesia:system_info(use_dir) of - false -> - mnesia:create_schema(Nodes); - _ -> - ok - end. - -perhaps_start_mnesia() -> - case mnesia:system_info(is_running) of - no -> - mnesia:start(); - _ -> - ok - end. - - -%%------------------------------------------------------------ -%% Standard gen_server cast handle -%% -handle_cast(_, State) -> - {noreply, State}. - - diff --git a/lib/orber/src/orber_env.erl b/lib/orber/src/orber_env.erl index 1c8a90bc81..16dbb74253 100644 --- a/lib/orber/src/orber_env.erl +++ b/lib/orber/src/orber_env.erl @@ -204,9 +204,9 @@ info(IoDevice) -> _ -> lists:flatten( io_lib:format("======= Orber Execution Environment ======~n" - " *** Orber-~s is not running ***~n" + " *** Orber is not running ***~n" "==========================================~n", - [?ORBVSN])) + [])) end, case IoDevice of info_msg -> @@ -223,6 +223,7 @@ info(IoDevice) -> create_main_info() -> {Major, Minor} = giop_version(), + {orber, _, OrberVsn} = lists:keyfind(orber, 1, application:loaded_applications()), [io_lib:format("======= Orber Execution Environment ======~n" "Orber version.................: ~s~n" "Orber domain..................: ~s~n" @@ -257,7 +258,7 @@ create_main_info() -> "Debug Level...................: ~p~n" "orbInitRef....................: ~p~n" "orbDefaultInitRef.............: ~p~n", - [?ORBVSN, domain(), iiop_port(), nat_iiop_port(), host(), + [OrberVsn, domain(), iiop_port(), nat_iiop_port(), host(), nat_host(), ip_address_local(), orber:orber_nodes(), Major, Minor, iiop_timeout(), iiop_connection_timeout(), diff --git a/lib/orber/src/orber_iiop_net.erl b/lib/orber/src/orber_iiop_net.erl index 33e02e3c04..1bfc6b7d58 100644 --- a/lib/orber/src/orber_iiop_net.erl +++ b/lib/orber/src/orber_iiop_net.erl @@ -157,7 +157,7 @@ terminate(_Reason, _State) -> ok. %%----------------------------------------------------------------- -%% Func: parse_options/2 +%% Func: get_options/2 %%----------------------------------------------------------------- get_options(normal, _Options) -> []; @@ -212,14 +212,21 @@ get_options(ssl, Options) -> %%----------------------------------------------------------------- parse_options([{port, Type, Port} | Rest], State) -> Options = get_options(Type, []), - Options2 = case orber_env:ip_address_variable_defined() of - false -> - Options; - Host -> - IPVersion = orber:ip_version(), - {ok, IP} = inet:getaddr(Host, IPVersion), - [{ip, IP} | Options] - end, + Family = orber_env:ip_version(), + IPFamilyOptions = + case Family of + inet -> [inet]; + inet6 -> [inet6, {ipv6_v6only, true}] + end, + Options2 = + case orber_env:ip_address_variable_defined() of + false -> + IPFamilyOptions ++ Options; + Host -> + {ok, IP} = inet:getaddr(Host, Family), + IPFamilyOptions ++ [{ip, IP} |Options] + end, + {ok, Listen, NewPort} = orber_socket:listen(Type, Port, Options2, true), {ok, Pid} = orber_iiop_socketsup:start_accept(Type, Listen, 0), link(Pid), @@ -283,28 +290,33 @@ handle_call({remove, Ref}, _From, State) -> {reply, ok, State} end; handle_call({add, IP, Type, Port, AllOptions}, _From, State) -> - Family = orber_env:ip_version(), + Family = orber_tb:keysearch(ip_family, AllOptions, orber_env:ip_version()), + IPFamilyOptions = + case Family of + inet -> [inet]; + inet6 -> [inet6, {ipv6_v6only, true}] + end, case inet:getaddr(IP, Family) of {ok, IPTuple} -> - try [{ip, IPTuple} |get_options(Type, AllOptions)] of - Options -> - Ref = make_ref(), - ProxyOptions = filter_options(AllOptions, []), - case orber_socket:listen(Type, Port, Options, false) of - {ok, Listen, NewPort} -> - {ok, Pid} = orber_iiop_socketsup:start_accept(Type, Listen, Ref, - ProxyOptions), - link(Pid), - ets:insert(?CONNECTION_DB, #listen{pid = Pid, - socket = Listen, - port = NewPort, - type = Type, ref = Ref, - options = Options, - proxy_options = ProxyOptions}), - {reply, {ok, Ref}, State}; - Error -> - {reply, Error, State} - end + try + Options = IPFamilyOptions ++ [{ip, IPTuple} |get_options(Type, AllOptions)], + Ref = make_ref(), + ProxyOptions = filter_options(AllOptions, []), + case orber_socket:listen(Type, Port, Options, false) of + {ok, Listen, NewPort} -> + {ok, Pid} = orber_iiop_socketsup:start_accept(Type, Listen, Ref, + ProxyOptions), + link(Pid), + ets:insert(?CONNECTION_DB, #listen{pid = Pid, + socket = Listen, + port = NewPort, + type = Type, ref = Ref, + options = Options, + proxy_options = ProxyOptions}), + {reply, {ok, Ref}, State}; + Error -> + {reply, Error, State} + end catch error:Reason -> {reply, {error, Reason}, State} diff --git a/lib/orber/src/orber_iiop_outproxy.erl b/lib/orber/src/orber_iiop_outproxy.erl index 8319d89088..3adb40d01a 100644 --- a/lib/orber/src/orber_iiop_outproxy.erl +++ b/lib/orber/src/orber_iiop_outproxy.erl @@ -112,7 +112,8 @@ stop(Pid) -> %%----------------------------------------------------------------- init({connect, Host, Port, SocketType, SocketOptions, Parent, Key, NewKey}) -> process_flag(trap_exit, true), - case catch orber_socket:connect(SocketType, Host, Port, SocketOptions) of + case catch orber_socket:connect(SocketType, Host, Port, + orber_socket:get_ip_family_opts(Host) ++ SocketOptions) of {'EXCEPTION', _E} -> ignore; %% We used to reply the below but since this would generate a CRASH REPORT diff --git a/lib/orber/src/orber_iiop_pm.erl b/lib/orber/src/orber_iiop_pm.erl index 927d12b3b2..fee2354f11 100644 --- a/lib/orber/src/orber_iiop_pm.erl +++ b/lib/orber/src/orber_iiop_pm.erl @@ -775,12 +775,11 @@ do_setup_connection(PMPid, Host, Port, SocketType, SocketOptions, Chars, access_allowed(Host, Port, Type, {_,_,UserInterface}) -> Flags = orber:get_flags(), - Family = orber_env:ip_version(), case ?ORB_FLAG_TEST(Flags, ?ORB_ENV_USE_ACL_OUTGOING) of false when UserInterface == 0 -> - get_local_interface(Type, Family); + get_local_interface(Type); false -> - inet:getaddr(UserInterface, Family); + inet:getaddr(UserInterface, get_ip_family(UserInterface)); true -> SearchFor = case Type of @@ -789,43 +788,48 @@ access_allowed(Host, Port, Type, {_,_,UserInterface}) -> ssl -> ssl_out end, - {ok, Ip} = inet:getaddr(Host, Family), + {ok, Ip} = inet:getaddr(Host, get_ip_family(Host)), case orber_acl:match(Ip, SearchFor, true) of {true, [], 0} -> - get_local_interface(Type, Family); + get_local_interface(Type); {true, [], Port} -> - get_local_interface(Type, Family); + get_local_interface(Type); {true, [], {Min, Max}} when Port >= Min, Port =< Max -> - get_local_interface(Type, Family); - {true, [Interface], 0} -> - {ok, NewIp} = inet:getaddr(Interface, Family), + get_local_interface(Type); + {true, [Interface], 0} -> + {ok, NewIp} = inet:getaddr(Interface, get_ip_family(Interface)), {ok, NewIp, {Host, Port, 0}}; {true, [Interface], Port} -> - {ok, NewIp} = inet:getaddr(Interface, Family), + + {ok, NewIp} = inet:getaddr(Interface, get_ip_family(Interface)), {ok, NewIp, {Host, Port, 0}}; {true, [Interface], {Min, Max}} when Port >= Min, Port =< Max -> - {ok, NewIp} = inet:getaddr(Interface, Family), + + {ok, NewIp} = inet:getaddr(Interface, get_ip_family(Interface)), {ok, NewIp, {Host, Port, 0}}; _ -> false end end. -get_local_interface(normal, Family) -> +get_local_interface(normal) -> case orber_env:ip_address_local() of [] -> ok; [Interface] -> - inet:getaddr(Interface, Family) + inet:getaddr(Interface, get_ip_family(Interface)) end; -get_local_interface(ssl, Family) -> +get_local_interface(ssl) -> case orber_env:iiop_ssl_ip_address_local() of [] -> ok; [Interface] -> - inet:getaddr(Interface, Family) + inet:getaddr(Interface, get_ip_family(Interface)) end. +get_ip_family(Addr) -> + [Family] = orber_socket:get_ip_family_opts(Addr), + Family. invoke_connection_closed(false) -> ok; diff --git a/lib/orber/src/orber_socket.erl b/lib/orber/src/orber_socket.erl index 07a0e09ccc..4507d90cce 100644 --- a/lib/orber/src/orber_socket.erl +++ b/lib/orber/src/orber_socket.erl @@ -37,7 +37,8 @@ -export([start/0, connect/4, listen/3, listen/4, accept/2, accept/3, write/3, controlling_process/3, close/2, peername/2, sockname/2, peerdata/2, peercert/2, sockdata/2, setopts/3, - clear/2, shutdown/3, post_accept/2, post_accept/3]). + clear/2, shutdown/3, post_accept/2, post_accept/3, + get_ip_family_opts/1]). %%----------------------------------------------------------------- %% Internal exports @@ -205,29 +206,27 @@ listen(normal, Port, Options, Exception) -> MaxSize -> [{packet_size, MaxSize}|Options2] end, - case catch gen_tcp:listen(Port, [binary, {packet,cdr}, {keepalive, Keepalive}, + Options4 = [binary, {packet,cdr}, {keepalive, Keepalive}, {reuseaddr,true}, {backlog, Backlog} | - Options3]) of + Options3], + + case catch gen_tcp:listen(Port, Options4) of {ok, ListenSocket} -> {ok, ListenSocket, check_port(Port, normal, ListenSocket)}; {error, Reason} when Exception == false -> {error, Reason}; {error, eaddrinuse} -> - AllOpts = [binary, {packet,cdr}, - {reuseaddr,true} | Options3], orber:dbg("[~p] orber_socket:listen(normal, ~p, ~p);~n" "Looks like the listen port is already in use.~n" "Check if another Orber is started~n" "on the same node and uses the same listen port (iiop_port). But it may also~n" "be used by any other application; confirm with 'netstat'.", - [?LINE, Port, AllOpts], ?DEBUG_LEVEL), + [?LINE, Port, Options4], ?DEBUG_LEVEL), corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO}); Error -> - AllOpts = [binary, {packet,cdr}, - {reuseaddr,true} | Options3], orber:dbg("[~p] orber_socket:listen(normal, ~p, ~p);~n" "Failed with reason: ~p", - [?LINE, Port, AllOpts, Error], ?DEBUG_LEVEL), + [?LINE, Port, Options4, Error], ?DEBUG_LEVEL), corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO}) end; listen(ssl, Port, Options, Exception) -> @@ -252,26 +251,24 @@ listen(ssl, Port, Options, Exception) -> true -> Options3 end, - case catch ssl:listen(Port, [binary, {packet,cdr}, - {backlog, Backlog} | Options4]) of + Options5 = [binary, {packet,cdr}, {backlog, Backlog} | Options4], + case catch ssl:listen(Port, Options5) of {ok, ListenSocket} -> {ok, ListenSocket, check_port(Port, ssl, ListenSocket)}; {error, Reason} when Exception == false -> {error, Reason}; {error, eaddrinuse} -> - AllOpts = [binary, {packet,cdr} | Options4], orber:dbg("[~p] orber_socket:listen(ssl, ~p, ~p);~n" "Looks like the listen port is already in use. Check if~n" "another Orber is started on the same node and uses the~n" "same listen port (iiop_port). But it may also~n" "be used by any other application; confirm with 'netstat'.", - [?LINE, Port, AllOpts], ?DEBUG_LEVEL), + [?LINE, Port, Options5], ?DEBUG_LEVEL), corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO}); Error -> - AllOpts = [binary, {packet,cdr} | Options4], orber:dbg("[~p] orber_socket:listen(ssl, ~p, ~p);~n" "Failed with reason: ~p", - [?LINE, Port, AllOpts, Error], ?DEBUG_LEVEL), + [?LINE, Port, Options5, Error], ?DEBUG_LEVEL), corba:raise(#'COMM_FAILURE'{completion_status=?COMPLETED_NO}) end. @@ -485,16 +482,50 @@ check_port(Port, _, _) -> %%----------------------------------------------------------------- %% Check Options. check_options(normal, Options, _Generation) -> - [orber:ip_version()|Options]; + Options; check_options(ssl, Options, Generation) -> - case orber:ip_version() of - inet when Generation > 2 -> + if + Generation > 2 -> [{ssl_imp, new}|Options]; - inet -> - [{ssl_imp, old}|Options]; - inet6 when Generation > 2 -> - [{ssl_imp, new}, inet6|Options]; - inet6 -> - [{ssl_imp, old}, inet6|Options] + true -> + [{ssl_imp, old}|Options] + end. + + +%%----------------------------------------------------------------- +%% Check IP Family. +get_ip_family_opts(Host) -> + case inet:parse_address(Host) of + {ok, {_,_,_,_}} -> + [inet]; + {ok, {_,_,_,_,_,_,_,_}} -> + [inet6]; + {error, einval} -> + check_family_for_name(Host, orber_env:ip_version()) + end. + +check_family_for_name(Host, inet) -> + case inet:getaddr(Host, inet) of + {ok, _Address} -> + [inet]; + {error, _} -> + case inet:getaddr(Host, inet6) of + {ok, _Address} -> + [inet6]; + {error, _} -> + [inet] + end + end; +check_family_for_name(Host, inet6) -> + case inet:getaddr(Host, inet6) of + {ok, _Address} -> + [inet6]; + {error, _} -> + case inet:getaddr(Host, inet) of + {ok, _Address} -> + [inet]; + {error, _} -> + [inet6] + end end. diff --git a/lib/orber/test/Makefile b/lib/orber/test/Makefile index 2f8777c773..50be14c24a 100644 --- a/lib/orber/test/Makefile +++ b/lib/orber/test/Makefile @@ -73,7 +73,8 @@ MODULES = \ orber_firewall_ipv6_in_SUITE \ orber_firewall_ipv4_out_SUITE \ orber_firewall_ipv6_out_SUITE \ - orber_nat_SUITE + orber_nat_SUITE \ + ip_v4v6_interop_SUITE GEN_MOD_ORBER = \ oe_orber_test \ diff --git a/lib/orber/test/ip_v4v6_interop_SUITE.erl b/lib/orber/test/ip_v4v6_interop_SUITE.erl new file mode 100644 index 0000000000..5eee5a29c2 --- /dev/null +++ b/lib/orber/test/ip_v4v6_interop_SUITE.erl @@ -0,0 +1,199 @@ +%%---------------------------------------------------------------------- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% +%% The 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 : ip_v4v6_interop_SUITE.erl +%% Description : +%% +%%---------------------------------------------------------------------- +-module(ip_v4v6_interop_SUITE). + +-compile(export_all). +%%---------------------------------------------------------------------- +%% External exports +%%---------------------------------------------------------------------- +-export([ + all/0, + init_per_suite/1, + end_per_suite/1, + init_per_testcase/2, + end_per_testcase/2, + groups/0, + init_per_group/2, + end_per_group/2 + ]). +%%----------------------------------------------------------------- +%% Internal exports +%%----------------------------------------------------------------- +-export([]). + +%%---------------------------------------------------------------------- +%% Include files +%%---------------------------------------------------------------------- +-include_lib("test_server/include/test_server.hrl"). +-include_lib("orber/include/corba.hrl"). +-include_lib("orber/COSS/CosNaming/CosNaming.hrl"). +-include_lib("orber/src/orber_iiop.hrl"). +-include_lib("orber/src/ifr_objects.hrl"). +-include("idl_output/orber_test_server.hrl"). +-include_lib("orber/COSS/CosNaming/CosNaming_NamingContextExt.hrl"). +-include_lib("orber/COSS/CosNaming/CosNaming_NamingContext.hrl"). + +%%---------------------------------------------------------------------- +%% Macros +%%---------------------------------------------------------------------- +-define(default_timeout, ?t:minutes(15)). + +-define(match(ExpectedRes,Expr), + fun() -> + AcTuAlReS = (catch (Expr)), + case AcTuAlReS of + ExpectedRes -> + io:format("------ CORRECT RESULT ------~n~p~n", + [AcTuAlReS]), + AcTuAlReS; + _ -> + io:format("###### ERROR ERROR ######~nRESULT: ~p~n", + [AcTuAlReS]), + ?line exit(AcTuAlReS) + end + end()). +%%---------------------------------------------------------------------- +%% Records +%%---------------------------------------------------------------------- + +%%====================================================================== +%% Initialization functions. +%%====================================================================== + +init_per_testcase(_Case, Config) -> + %% Starting dual configured ORB + orber:jump_start([{iiop_port, 10001}, {flags, 16#1000}]), + orber:info(), + Dog=test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. + + +end_per_testcase(_Case, Config) -> + orber:jump_stop(), + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + Config. + +%%==================================================================== +%% SUITE specification +%%==================================================================== +all() -> + [ + dual_ipv4v6 + ]. + +suite() -> [{ct_hooks,[ts_install_cth]}]. + + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +%%==================================================================== +%% Test Cases +%%==================================================================== +dual_ipv4v6(doc) -> + ["ORB configured for supporting both IPv4 and IPv6"]; +dual_ipv4v6(_Config) -> + + %% Starting slave node with ipv4 configured ORB + {ok, Ipv4Node, _Ipv4Host} = + ?match({ok,_,_}, orber_test_lib:js_node([{iiop_port, 4001}])), + Ipv4NS = orber_test_lib:remote_apply(Ipv4Node, corba, resolve_initial_references, ["NameService"]), + + %% Starting slave node with ipv6 configured ORB + {ok, Ipv6Node, _Ipv6Host} = + ?match({ok,_,_}, orber_test_lib:js_node([{iiop_port, 6001}, {flags, 16#0100}])), + Ipv6NS = orber_test_lib:remote_apply(Ipv6Node, corba, resolve_initial_references, ["NameService"]), + + %% Add the ipv6 interface in the dual configured ORB + ?match({ok, _}, orber:add_listen_interface("::1", normal, + [{ip_family, inet6}, {iiop_port, 10002}])), + DualNS = corba:resolve_initial_references("NameService"), + + %% Bind IPv4 NameServer to a name in the dual stack orbs NameServer + NSDual4 = orber_test_lib:remote_apply(Ipv4Node, corba, resolve_initial_references_remote, + ["NameService", ["iiop://127.0.0.1:10001"]]), + ?match(ok, orber_test_lib:remote_apply(Ipv4Node, 'CosNaming_NamingContext', bind, + [NSDual4, lname:new(["ns4"]), Ipv4NS])), + 'CosNaming_NamingContext':resolve(DualNS, lname:new(["ns4"])), + + %% Bind IPv6 NameServer to a name in the dual stack orbs NameServer + NSDual6 = orber_test_lib:remote_apply(Ipv6Node, corba, resolve_initial_references_remote, + ["NameService", ["iiop://[::1]:10002"]]), + ?match(ok, orber_test_lib:remote_apply(Ipv6Node, 'CosNaming_NamingContext', bind, + [NSDual6, lname:new(["ns6"]), Ipv6NS])), + 'CosNaming_NamingContext':resolve(DualNS, lname:new(["ns6"])), + + %% IPv4: Fetch IPv6 NS reference from dual stack orber and register own NameServer in that + Ipv4NSO = orber_test_lib:remote_apply(Ipv4Node, 'CosNaming_NamingContext', resolve, + [NSDual4, lname:new(["ns6"])]), + ?match(ok, orber_test_lib:remote_apply(Ipv4Node, 'CosNaming_NamingContext', bind, + [Ipv4NSO, lname:new(["nso"]), Ipv4NS])), + + %% IPv6: Fetch IPv4 NS reference from dual stack orber and register own NameServer in that + Ipv6NSO = orber_test_lib:remote_apply(Ipv6Node, 'CosNaming_NamingContext', resolve, + [NSDual6, lname:new(["ns4"])]), + ?match(ok, orber_test_lib:remote_apply(Ipv6Node, 'CosNaming_NamingContext', bind, + [Ipv6NSO, lname:new(["nso"]), Ipv6NS])), + + + %% IPv4: Fetch own NS reference from IPv6 NameServer and add a context then check that everything went well + Ipv4NSFromIpv6 = orber_test_lib:remote_apply(Ipv6Node, 'CosNaming_NamingContext', resolve, + [Ipv6NS, lname:new(["nso"])]), + _Ipv4NC = orber_test_lib:remote_apply(Ipv4Node, 'CosNaming_NamingContext', bind_new_context, + [Ipv4NSFromIpv6, lname:new(["test_context4"])]), + + %% IPv6: Fetch own NS reference from IPv4 NameServer and add a context then check that everything went well + Ipv6NSFromIpv4 = orber_test_lib:remote_apply(Ipv4Node, 'CosNaming_NamingContext', resolve, + [Ipv4NS, lname:new(["nso"])]), + _Ipv6NC = orber_test_lib:remote_apply(Ipv6Node, 'CosNaming_NamingContext', bind_new_context, + [Ipv6NSFromIpv4, lname:new(["test_context6"])]), + + %% Check that all the names are register correctly + {ok,DualNames,_} = 'CosNaming_NamingContext':list(DualNS, 100), + {ok,Ipv4Names,_} = orber_test_lib:remote_apply(Ipv4Node, 'CosNaming_NamingContext', list, [Ipv4NS, 100]), + {ok,Ipv6Names,_} = orber_test_lib:remote_apply(Ipv6Node, 'CosNaming_NamingContext', list, [Ipv6NS, 100]), + + io:format("\nNames in Dual NS: ~p\n", [DualNames]), + ?match(2, length(DualNames)), + io:format("\nNames in IPv4 NS: ~p\n", [Ipv4Names]), + ?match(2, length(Ipv4Names)), + io:format("\nNames in IPv6 NS: ~p\n", [Ipv6Names]), + ?match(2, length(Ipv6Names)), + + ok. + diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl index 41a309ff16..40d8846e0f 100644 --- a/lib/orber/test/multi_ORB_SUITE.erl +++ b/lib/orber/test/multi_ORB_SUITE.erl @@ -582,12 +582,12 @@ proxy_interface_ipv6_api2() -> IOR1 = ?match(#'IOP_IOR'{}, orber_test_lib:remote_apply(ClientNode, corba, string_to_object, - ["corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService"])), + ["corbaloc::1.2@["++IP++"]:"++integer_to_list(ServerPort)++"/NameService"])), ?match({'external', {IP, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, orber_test_lib:remote_apply(ClientNode, iop_ior, get_key, [IOR1])), IOR2 = ?match(#'IOP_IOR'{}, orber_test_lib:remote_apply(ClientNode, corba, string_to_object, - ["corbaloc::1.2@"++Loopback++":"++integer_to_list(ServerPort)++"/NameService"])), + ["corbaloc::1.2@["++Loopback++"]:"++integer_to_list(ServerPort)++"/NameService"])), ?match({'external', {Loopback, ServerPort, _ObjectKey, _Counter, _TP, _NewHD}}, orber_test_lib:remote_apply(ClientNode, iop_ior, get_key, [IOR2])), ok. diff --git a/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl b/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl index 10827b6ef5..2853949a49 100644 --- a/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl +++ b/lib/orber/test/orber_firewall_ipv6_in_SUITE.erl @@ -188,6 +188,7 @@ allow_port_range_api(_Config) -> ?ORB_ENV_USE_ACL_INCOMING)}, {iiop_acl, [{tcp_in, IP++"/128#5980/6000"}]}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), + io:format("ServerNode: ~p\nServerHost: ~p\n", [ServerNode, ServerHost]), IOR = ?match({'IOP_IOR',_,_}, corba:string_to_object("corbaloc::1.2@"++ServerHost++":"++integer_to_list(ServerPort)++"/NameService")), @@ -243,34 +244,34 @@ check_address_api(doc) -> ["Test corbaloc strings"]; check_address_api(suite) -> []; check_address_api(_Config) -> ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",2809]],"NameService"}, - orber_cosnaming_utils:addresses(":0:0:0:0:0:FFFF:C02A:2A2A/NameService")), + orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:C02A:2A2A]/NameService")), ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",2809]],[]}, - orber_cosnaming_utils:addresses(":0:0:0:0:0:FFFF:C02A:2A2A")), + orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:C02A:2A2A]")), ?match({[[iiop,{1,2},"0:0:0:0:0:FFFF:C02A:2A2A",2809]],"NameService"}, - orber_cosnaming_utils:addresses(":1.2@0:0:0:0:0:FFFF:C02A:2A2A/NameService")), + orber_cosnaming_utils:addresses(":1.2@[0:0:0:0:0:FFFF:C02A:2A2A]/NameService")), ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",4001]],"NameService"}, - orber_cosnaming_utils:addresses(":0:0:0:0:0:FFFF:C02A:2A2A:4001/NameService")), + orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:C02A:2A2A]:4001/NameService")), ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]],"NameService"}, - orber_cosnaming_utils:addresses(":1.1@0:0:0:0:0:FFFF:C02A:2A2A:4001/NameService")), + orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001/NameService")), ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]],[]}, - orber_cosnaming_utils:addresses(":1.1@0:0:0:0:0:FFFF:C02A:2A2A:4001")), + orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001")), ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]],[]}, - orber_cosnaming_utils:addresses("iiop:1.1@0:0:0:0:0:FFFF:C02A:2A2A:4001")), + orber_cosnaming_utils:addresses("iiop:1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001")), ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",2809]],"NameService"}, - orber_cosnaming_utils:addresses(":0:0:0:0:0:FFFF:10.11.11.11/NameService")), + orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:10.11.11.11]/NameService")), ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",2809]],[]}, - orber_cosnaming_utils:addresses(":0:0:0:0:0:FFFF:10.11.11.11")), + orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:10.11.11.11]")), ?match({[[iiop,{1,2},"0:0:0:0:0:FFFF:10.11.11.11",2809]],"NameService"}, - orber_cosnaming_utils:addresses(":1.2@0:0:0:0:0:FFFF:10.11.11.11/NameService")), + orber_cosnaming_utils:addresses(":1.2@[0:0:0:0:0:FFFF:10.11.11.11]/NameService")), ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",4001]],"NameService"}, - orber_cosnaming_utils:addresses(":0:0:0:0:0:FFFF:10.11.11.11:4001/NameService")), + orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:10.11.11.11]:4001/NameService")), ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001]],"NameService"}, - orber_cosnaming_utils:addresses(":1.1@0:0:0:0:0:FFFF:10.11.11.11:4001/NameService")), + orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001/NameService")), ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001]],[]}, - orber_cosnaming_utils:addresses(":1.1@0:0:0:0:0:FFFF:10.11.11.11:4001/")), + orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001/")), ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001]],[]}, - orber_cosnaming_utils:addresses("iiop:1.1@0:0:0:0:0:FFFF:10.11.11.11:4001/")), + orber_cosnaming_utils:addresses("iiop:1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001/")), ?match({[[iiop,{1,1},"myhost",4001]],[]}, orber_cosnaming_utils:addresses("iiop:1.1@myhost:4001")), @@ -282,31 +283,31 @@ check_address_api(_Config) -> ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001], [iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]], "NameService"}, - orber_cosnaming_utils:addresses(":1.1@0:0:0:0:0:FFFF:10.11.11.11:4001,:1.1@0:0:0:0:0:FFFF:C02A:2A2A:4001/NameService")), + orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001,:1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001/NameService")), ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001], [iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]], []}, - orber_cosnaming_utils:addresses(":1.1@0:0:0:0:0:FFFF:10.11.11.11:4001,:1.1@0:0:0:0:0:FFFF:C02A:2A2A:4001")), + orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001,:1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001")), ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",4001], [iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]], "NameService"}, - orber_cosnaming_utils:addresses(":0:0:0:0:0:FFFF:10.11.11.11:4001,:1.1@0:0:0:0:0:FFFF:C02A:2A2A:4001/NameService")), + orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:10.11.11.11]:4001,:1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001/NameService")), ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001], [iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",4001]], "NameService"}, - orber_cosnaming_utils:addresses(":1.1@0:0:0:0:0:FFFF:10.11.11.11:4001,:0:0:0:0:0:FFFF:C02A:2A2A:4001/NameService")), + orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001,:[0:0:0:0:0:FFFF:C02A:2A2A]:4001/NameService")), ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",2809], [iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",4001]], "NameService"}, - orber_cosnaming_utils:addresses(":1.1@0:0:0:0:0:FFFF:10.11.11.11,:1.1@0:0:0:0:0:FFFF:C02A:2A2A:4001/NameService")), + orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11],:1.1@[0:0:0:0:0:FFFF:C02A:2A2A]:4001/NameService")), ?match({[[iiop,{1,1},"0:0:0:0:0:FFFF:10.11.11.11",4001], [iiop,{1,1},"0:0:0:0:0:FFFF:C02A:2A2A",2809]], "NameService"}, - orber_cosnaming_utils:addresses(":1.1@0:0:0:0:0:FFFF:10.11.11.11:4001,:1.1@0:0:0:0:0:FFFF:C02A:2A2A/NameService")), + orber_cosnaming_utils:addresses(":1.1@[0:0:0:0:0:FFFF:10.11.11.11]:4001,:1.1@[0:0:0:0:0:FFFF:C02A:2A2A]/NameService")), ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",2809], [iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",2809]], "NameService"}, - orber_cosnaming_utils:addresses(":0:0:0:0:0:FFFF:10.11.11.11,:0:0:0:0:0:FFFF:C02A:2A2A/NameService")), + orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:10.11.11.11],:[0:0:0:0:0:FFFF:C02A:2A2A]/NameService")), ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",2809], [iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",2809]], []}, - orber_cosnaming_utils:addresses(":0:0:0:0:0:FFFF:10.11.11.11,:0:0:0:0:0:FFFF:C02A:2A2A/")), + orber_cosnaming_utils:addresses(":[0:0:0:0:0:FFFF:10.11.11.11],:[0:0:0:0:0:FFFF:C02A:2A2A]/")), ?match({[[iiop,{1,0},"0:0:0:0:0:FFFF:10.11.11.11",2809], [iiop,{1,0},"0:0:0:0:0:FFFF:C02A:2A2A",2809]], []}, - orber_cosnaming_utils:addresses("iiop:0:0:0:0:0:FFFF:10.11.11.11,:0:0:0:0:0:FFFF:C02A:2A2A/")), + orber_cosnaming_utils:addresses("iiop:[0:0:0:0:0:FFFF:10.11.11.11],:[0:0:0:0:0:FFFF:C02A:2A2A]/")), [IP] = ?match([_], orber:host()), {ok, ServerNode, _ServerHost} = @@ -315,7 +316,7 @@ check_address_api(_Config) -> {iiop_acl, [{tcp_in, IP++"/128"}]}])), ServerPort = orber_test_lib:remote_apply(ServerNode, orber, iiop_port, []), ?match({'IOP_IOR',_,_}, - corba:string_to_object("corbaloc::1.2@"++IP++":"++integer_to_list(ServerPort)++"/NameService")), + corba:string_to_object("corbaloc::1.2@["++IP++"]:"++integer_to_list(ServerPort)++"/NameService")), % ?line catch orber_test_lib:destroy_node(ServerNode, timeout), ok. diff --git a/lib/orber/test/orber_test_lib.erl b/lib/orber/test/orber_test_lib.erl index 6824d25aef..46ed26f210 100644 --- a/lib/orber/test/orber_test_lib.erl +++ b/lib/orber/test/orber_test_lib.erl @@ -166,7 +166,7 @@ get_host(Family) -> {6, _, _} when Family == inet -> "127.0.0.1"; {6, _, _} -> - "0:0:0:0:0:FFFF:7F00:0001"; + "0:0:0:0:0:0:0:0001"; _ -> [IP] = ?match([_], orber:host()), IP @@ -192,16 +192,16 @@ get_loopback_interface(Family) -> {6, _, _} when Family == inet -> "127.0.0.2"; {6, _, _} -> - "0:0:0:0:0:FFFF:7F00:0002"; + "0:0:0:0:0:0:0:0002"; _ when Family == inet -> "127.0.0.1"; _ -> - "0:0:0:0:0:FFFF:7F00:0001" + "0:0:0:0:0:0:0:0001" end; _ when Family == inet -> "127.0.0.1"; _ -> - "0:0:0:0:0:FFFF:7F00:0001" + "0:0:0:0:0:0:0:0001" end. %%------------------------------------------------------------ diff --git a/lib/orber/vsn.mk b/lib/orber/vsn.mk index 3ea64b1ff6..28fe9323fb 100644 --- a/lib/orber/vsn.mk +++ b/lib/orber/vsn.mk @@ -1,2 +1 @@ -ORBER_VSN = 3.6.27 - +ORBER_VSN = 3.7.1 diff --git a/lib/os_mon/doc/src/disksup.xml b/lib/os_mon/doc/src/disksup.xml index c8566d0126..0e76178edb 100644 --- a/lib/os_mon/doc/src/disksup.xml +++ b/lib/os_mon/doc/src/disksup.xml @@ -81,7 +81,8 @@ necessary on embedded systems with stripped-down versions of Unix tools like <c>df</c>. The returned disk data and alarms can be different when using this option.</p> - <p>The parameter is ignored on Windows.</p> + <p>The parameter is ignored on platforms that are known to not be + posix compatible (Windows and SunOS).</p> </item> </taglist> <p>See <seealso marker="kernel:config">config(4)</seealso> for diff --git a/lib/os_mon/doc/src/notes.xml b/lib/os_mon/doc/src/notes.xml index 5ac04d4f42..6bc0cf7d43 100644 --- a/lib/os_mon/doc/src/notes.xml +++ b/lib/os_mon/doc/src/notes.xml @@ -30,6 +30,23 @@ </header> <p>This document describes the changes made to the OS_Mon application.</p> +<section><title>Os_Mon 2.3</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Adds a new application parameter 'disksup_posix_only', to + make diskup use only options defined in the POSIX + standard.</p> + <p> + Own Id: OTP-12053</p> + </item> + </list> + </section> + +</section> + <section><title>Os_Mon 2.2.15</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index 34251178ee..1f088ecbde 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -543,7 +543,8 @@ measurement_server_init() -> Server = case OS of {unix, Flavor} when Flavor==sunos; Flavor==linux -> - port_server_start(); + {ok, Pid} = port_server_start_link(), + Pid; {unix, Flavor} when Flavor==darwin; Flavor==freebsd; Flavor==dragonfly; @@ -588,8 +589,9 @@ measurement_server_loop(State) -> Error -> Pid ! {error, Error} end, measurement_server_loop(State); - {'EXIT', Pid, _n} when State#internal.port == Pid -> - measurement_server_loop(State#internal{port = port_server_start()}); + {'EXIT', OldPid, _n} when State#internal.port == OldPid -> + {ok, NewPid} = port_server_start_link(), + measurement_server_loop(State#internal{port = NewPid}); _Other -> measurement_server_loop(State) end. @@ -605,12 +607,12 @@ port_server_call(Pid, Command) -> {Pid, {error, Reason}} -> {error, Reason} end. -port_server_start() -> +port_server_start_link() -> Timeout = 6000, Pid = spawn_link(fun() -> port_server_init(Timeout) end), Pid ! {self(), ?ping}, receive - {Pid, {data,4711}} -> Pid; + {Pid, {data,4711}} -> {ok, Pid}; {error,Reason} -> {error, Reason} after Timeout -> {error, timeout} diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl index 3fd80f2365..af5bcc6fe8 100644 --- a/lib/os_mon/src/disksup.erl +++ b/lib/os_mon/src/disksup.erl @@ -211,14 +211,14 @@ format_status(_Opt, [_PDict, #state{os = OS, threshold = Threshold, get_os(PosixOnly) -> case os:type() of - {unix, _} when PosixOnly -> - {unix, posix}; {unix, sunos} -> - case os:version() of + case os:version() of {5,_,_} -> {unix, solaris}; {4,_,_} -> {unix, sunos4}; V -> exit({unknown_os_version, V}) - end; + end; + {unix, _} when PosixOnly -> + {unix, posix}; {unix, irix64} -> {unix, irix}; OS -> OS diff --git a/lib/os_mon/test/disksup_SUITE.erl b/lib/os_mon/test/disksup_SUITE.erl index 2f62564959..f9addd96cf 100644 --- a/lib/os_mon/test/disksup_SUITE.erl +++ b/lib/os_mon/test/disksup_SUITE.erl @@ -49,7 +49,8 @@ init_per_testcase(_Case, Config) -> Dog = ?t:timetrap(?default_timeout), [{watchdog,Dog} | Config]. -end_per_testcase(unavailable, Config) -> +end_per_testcase(TC, Config) when TC =:= unavailable; + TC =:= posix_only -> restart(Config), end_per_testcase(dummy, Config); end_per_testcase(_Case, Config) -> @@ -61,11 +62,10 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> Bugs = [otp_5910], + Always = [api, config, alarm, port, posix_only, unavailable] ++ Bugs, case test_server:os_type() of - {unix, sunos} -> - [api, config, alarm, port, unavailable, posix_only] ++ Bugs; - {unix, _OSname} -> [api, alarm, posix_only] ++ Bugs; - {win32, _OSname} -> [api, alarm, posix_only] ++ Bugs; + {unix, _OSname} -> Always; + {win32, _OSname} -> Always; _OS -> [unavailable] end. @@ -336,6 +336,7 @@ restart(suite) -> []; restart(Config) when is_list(Config) -> ok = application:set_env(os_mon, start_disksup, true), + ok = application:set_env(os_mon, disksup_posix_only, false), {ok, _Pid} = supervisor:restart_child(os_mon_sup, disksup), ok. @@ -409,13 +410,7 @@ posix_only(Config) when is_list(Config) -> ok = supervisor:terminate_child(os_mon_sup, disksup), {ok, _Child1} = supervisor:restart_child(os_mon_sup, disksup), - ok = check_get_disk_data(), - - %% Reset option and restart disksup - ok = application:set_env(os_mon, disksup_posix_only, false), - ok = supervisor:terminate_child(os_mon_sup, disksup), - {ok, _Child2} = supervisor:restart_child(os_mon_sup, disksup), - ok. + ok = check_get_disk_data(). dump_info() -> io:format("Status: ~p~n", [sys:get_status(disksup)]). diff --git a/lib/os_mon/vsn.mk b/lib/os_mon/vsn.mk index 74397c2bc6..f90cc306f0 100644 --- a/lib/os_mon/vsn.mk +++ b/lib/os_mon/vsn.mk @@ -1 +1 @@ -OS_MON_VSN = 2.2.15 +OS_MON_VSN = 2.3 diff --git a/lib/ose/doc/src/notes.xml b/lib/ose/doc/src/notes.xml index 760b92feed..7e86355f98 100644 --- a/lib/ose/doc/src/notes.xml +++ b/lib/ose/doc/src/notes.xml @@ -30,4 +30,63 @@ </header> <p>This document describes the changes made to the OSE application.</p> +<section><title>Ose 1.0.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Add missing release notes for the OSE application.</p> + <p> + Own Id: OTP-12177</p> + </item> + </list> + </section> + +</section> + +<section><title>Ose 1.0.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix some spelling mistakes in documentation</p> + <p> + Own Id: OTP-12152</p> + </item> + </list> + </section> + +</section> + +<section><title>Ose 1.0</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Erlang/OTP has been ported to the realtime operating + system OSE. The port supports both smp and non-smp + emulator. For details around the port and how to started + see the User's Guide in the <seealso + marker="ose:ose_intro">ose</seealso> application. </p> + <p> + Note that not all parts of Erlang/OTP has been ported. </p> + <p> + Notable things that work are: non-smp and smp emulators, + OSE signal interaction, crypto, asn1, run_erl/to_erl, + tcp, epmd, distribution and most if not all non-os + specific functionality of Erlang.</p> + <p> + Notable things that does not work are: udp/sctp, os_mon, + erl_interface, binding of schedulers.</p> + <p> + Own Id: OTP-11334</p> + </item> + </list> + </section> + +</section> + </chapter> diff --git a/lib/ose/doc/src/ose_intro.xml b/lib/ose/doc/src/ose_intro.xml index b5e3ef8b33..0ed470890b 100644 --- a/lib/ose/doc/src/ose_intro.xml +++ b/lib/ose/doc/src/ose_intro.xml @@ -65,7 +65,7 @@ erl /home/erlang --</code> <p> - The arguments are printed on seperate lines to make it possible to know + The arguments are printed on separate lines to make it possible to know what has to be quoted with ". Each line is one quotable unit. So taking the arguments above you can supply them to pm_create or just execute directly on the command line. For example:</p> @@ -75,7 +75,7 @@ pid: 0x110059 rtose@acp3400> pm_start 0x110059</code> <p> Also note that since we are running erl to figure out the arguments on a - seperate machine the paths have to be updated. In the example above + separate machine the paths have to be updated. In the example above <c>/usr/local/lib/erlang</c> was replaced by <c>/mst/erlang/</c>. The goal is to in future releases not have to do the special argument handling but for now (OTP 17.0) you have to do it. diff --git a/lib/ose/vsn.mk b/lib/ose/vsn.mk index 78ffa4d496..70db2ed69d 100644 --- a/lib/ose/vsn.mk +++ b/lib/ose/vsn.mk @@ -1 +1 @@ -OSE_VSN = 1.0 +OSE_VSN = 1.0.2 diff --git a/lib/otp_mibs/src/Makefile b/lib/otp_mibs/src/Makefile index 4f03d0228a..6096240bbd 100644 --- a/lib/otp_mibs/src/Makefile +++ b/lib/otp_mibs/src/Makefile @@ -72,7 +72,7 @@ ERL_COMPILE_FLAGS += -I$(INCLUDE) +warn_obsolete_guard debug opt: $(TARGETS) clean: - rm -f $(TARGETS_FILES) + rm -f $(TARGET_FILES) rm -f $(APP_TARGET) rm -f $(APPUP_TARGET) rm -f core diff --git a/lib/parsetools/include/leexinc.hrl b/lib/parsetools/include/leexinc.hrl index dbbb688d2d..938aef58f9 100644 --- a/lib/parsetools/include/leexinc.hrl +++ b/lib/parsetools/include/leexinc.hrl @@ -36,8 +36,8 @@ string(Ics0, L0, Tcs, Ts) -> string_cont(Ics1, L1, yyaction(A, Alen, Tcs, L0), Ts); {reject,_Alen,Tlen,_Ics1,L1,_S1} -> % After a non-accepting state {error,{L0,?MODULE,{illegal,yypre(Tcs, Tlen+1)}},L1}; - {A,Alen,_Tlen,_Ics1,L1,_S1} -> - string_cont(yysuf(Tcs, Alen), L1, yyaction(A, Alen, Tcs, L0), Ts) + {A,Alen,_Tlen,_Ics1,_L1,_S1} -> + string_cont(yysuf(Tcs, Alen), L0, yyaction(A, Alen, Tcs, L0), Ts) end. %% string_cont(RestChars, Line, Token, Tokens) @@ -105,8 +105,8 @@ token(S0, Ics0, L0, Tcs, Tlen0, Tline, A0, Alen0) -> {reject,_Alen1,Tlen1,Ics1,L1,_S1} -> % No token match Error = {Tline,?MODULE,{illegal,yypre(Tcs, Tlen1+1)}}, {done,{error,Error,L1},Ics1}; - {A1,Alen1,_Tlen1,_Ics1,L1,_S1} -> % Use last accept match - token_cont(yysuf(Tcs, Alen1), L1, yyaction(A1, Alen1, Tcs, Tline)) + {A1,Alen1,_Tlen1,_Ics1,_L1,_S1} -> % Use last accept match + token_cont(yysuf(Tcs, Alen1), L0, yyaction(A1, Alen1, Tcs, Tline)) end. %% token_cont(RestChars, Line, Token) @@ -177,9 +177,9 @@ tokens(S0, Ics0, L0, Tcs, Tlen0, Tline, Ts, A0, Alen0) -> %% Skip rest of tokens. Error = {L1,?MODULE,{illegal,yypre(Tcs, Tlen1+1)}}, skip_tokens(yysuf(Tcs, Tlen1+1), L1, Error); - {A1,Alen1,_Tlen1,_Ics1,L1,_S1} -> + {A1,Alen1,_Tlen1,_Ics1,_L1,_S1} -> Token = yyaction(A1, Alen1, Tcs, Tline), - tokens_cont(yysuf(Tcs, Alen1), L1, Token, Ts) + tokens_cont(yysuf(Tcs, Alen1), L0, Token, Ts) end. %% tokens_cont(RestChars, Line, Token, Tokens) diff --git a/lib/parsetools/test/leex_SUITE.erl b/lib/parsetools/test/leex_SUITE.erl index eb15bebf63..6d2afe061e 100644 --- a/lib/parsetools/test/leex_SUITE.erl +++ b/lib/parsetools/test/leex_SUITE.erl @@ -43,8 +43,8 @@ file/1, compile/1, syntax/1, pt/1, man/1, ex/1, ex2/1, not_yet/1, - - otp_10302/1, otp_11286/1, unicode/1]). + line_wrap/1, + otp_10302/1, otp_11286/1, unicode/1]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). @@ -61,12 +61,13 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [{group, checks}, {group, examples}]. + [{group, checks}, {group, examples}, {group, bugs}]. groups() -> [{checks, [], [file, compile, syntax]}, {examples, [], [pt, man, ex, ex2, not_yet, unicode]}, - {tickets, [], [otp_10302, otp_11286]}]. + {tickets, [], [otp_10302, otp_11286]}, + {bugs, [], [line_wrap]}]. init_per_suite(Config) -> Config. @@ -871,6 +872,48 @@ scan_token_1({more, Cont}, [C | Cs], Fun, Loc, Rs) -> %% End of ex2 +line_wrap(doc) -> "Much more examples."; +line_wrap(suite) -> []; +line_wrap(Config) when is_list(Config) -> + Xrl = + <<" +Definitions. +Rules. +[a]+[\\n]*= : {token, {first, TokenLine}}. +[a]+ : {token, {second, TokenLine}}. +[\\s\\r\\n\\t]+ : skip_token. +Erlang code. + ">>, + Dir = ?privdir, + XrlFile = filename:join(Dir, "test_line_wrap.xrl"), + ?line ok = file:write_file(XrlFile, Xrl), + ErlFile = filename:join(Dir, "test_line_wrap.erl"), + {ok, _} = leex:file(XrlFile, []), + {ok, _} = compile:file(ErlFile, [{outdir,Dir}]), + code:purge(test_line_wrap), + AbsFile = filename:rootname(ErlFile, ".erl"), + code:load_abs(AbsFile, test_line_wrap), + fun() -> + S = "aaa\naaa", + {ok,[{second,1},{second,2}],2} = test_line_wrap:string(S) + end(), + fun() -> + S = "aaa\naaa", + {ok,[{second,3},{second,4}],4} = test_line_wrap:string(S, 3) + end(), + fun() -> + {done,{ok,{second,1},1},"\na"} = test_line_wrap:token([], "a\na"), + {more,Cont1} = test_line_wrap:token([], "\na"), + {done,{ok,{second,2},2},eof} = test_line_wrap:token(Cont1, eof) + end(), + fun() -> + {more,Cont1} = test_line_wrap:tokens([], "a\na"), + {done,{ok,[{second,1},{second,2}],2},eof} = test_line_wrap:tokens(Cont1, eof) + end(), + ok. + +%% End of line_wrap + not_yet(doc) -> "Not yet implemented."; not_yet(suite) -> []; diff --git a/lib/percept/src/Makefile b/lib/percept/src/Makefile index 6bf0af9dc6..0282d6346a 100644 --- a/lib/percept/src/Makefile +++ b/lib/percept/src/Makefile @@ -50,6 +50,8 @@ MODULES= \ #HRL_FILES= ../include/ +INTERNAL_HRL_FILES= egd.hrl percept.hrl + ERL_FILES= $(MODULES:%=%.erl) TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) @@ -95,6 +97,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/src" $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src" + $(INSTALL_DATA) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src" # $(INSTALL_DIR) "$(RELSYSDIR)/include" # $(INSTALL_DATA) $(HRL_FILES) "$(RELSYSDIR)/include" $(INSTALL_DIR) "$(RELSYSDIR)/ebin" diff --git a/lib/public_key/asn1/OTP-PKIX.asn1 b/lib/public_key/asn1/OTP-PKIX.asn1 index 8d3c76adf5..37196bb9bf 100644 --- a/lib/public_key/asn1/OTP-PKIX.asn1 +++ b/lib/public_key/asn1/OTP-PKIX.asn1 @@ -452,23 +452,23 @@ SupportedPublicKeyAlgorithms PUBLIC-KEY-ALGORITHM-CLASS ::= { ecdsa-with-sha1 SIGNATURE-ALGORITHM-CLASS ::= { ID ecdsa-with-SHA1 - TYPE NULL } -- XXX Must be empty and not NULL + TYPE EcpkParameters } -- 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 + TYPE EcpkParameters } -- 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 + TYPE EcpkParameters } -- 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 + TYPE EcpkParameters } -- 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 + TYPE EcpkParameters } -- XXX Must be empty and not NULL FIELD-ID-CLASS ::= CLASS { &id OBJECT IDENTIFIER UNIQUE, diff --git a/lib/public_key/doc/src/cert_records.xml b/lib/public_key/doc/src/cert_records.xml index 397c13b463..b66c66bead 100644 --- a/lib/public_key/doc/src/cert_records.xml +++ b/lib/public_key/doc/src/cert_records.xml @@ -36,8 +36,9 @@ <p>This chapter briefly describes erlang records derived from ASN1 specifications used to handle <c> X509 certificates</c> and <c>CertificationRequest</c>. - The intent is to describe the data types and not to specify the meaning of each - component for this we refer you to <url + The intent is to describe the data types +and not to specify the semantics of each component. For information on the +semantics, please see <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280</url> and <url href="http://www.ietf.org/rfc/rfc5967.txt">PKCS-10</url>. </p> @@ -79,7 +80,7 @@ <p><c> special_string() = {teletexString, string()} | {printableString, string()} | - {universalString, string()} | {utf8String, string()} | + {universalString, string()} | {utf8String, binary()} | {bmpString, string()} </c></p> diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml index 592d3c797d..fe4bf5ce2d 100644 --- a/lib/public_key/doc/src/notes.xml +++ b/lib/public_key/doc/src/notes.xml @@ -34,6 +34,22 @@ <file>notes.xml</file> </header> +<section><title>Public_Key 0.22.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Added missing encoding support for PBES2, and also + completed support for PBES1 that was incomplete.</p> + <p> + Own Id: OTP-11915</p> + </item> + </list> + </section> + +</section> + <section><title>Public_Key 0.22</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 8e93f562d4..e3473f80d7 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -75,7 +75,7 @@ <p><em>Data Types </em></p> - <p><code>oid() - a tuple of integers as generated by the ASN1 compiler.</code></p> + <p><code>oid() - Object Identifier, a tuple of integers as generated by the ASN1 compiler.</code></p> <p><code>boolean() = true | false</code></p> @@ -92,7 +92,7 @@ not_encrypted | cipher_info()}</code></p> <p><code>cipher_info() = {"RC2-CBC | "DES-CBC" | "DES-EDE3-CBC", - crypto:rand_bytes(8)} | 'PBES2-params'}</code></p> + crypto:rand_bytes(8) | {#'PBEParameter{}, digest_type()} |#'PBES2-params'{}}</code></p> <p><code>public_key() = rsa_public_key() | dsa_public_key() | ec_public_key()</code></p> <p><code>private_key() = rsa_private_key() | dsa_private_key() | ec_private_key()</code></p> @@ -113,6 +113,8 @@ <p><code>rsa_padding() = 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | 'rsa_no_padding'</code></p> + + <p><code>digest_type() - Union of below digest types</code></p> <p><code>rsa_digest_type() = 'md5' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</code></p> @@ -429,10 +431,12 @@ <name>pkix_path_validation(TrustedCert, CertChain, Options) -> {ok, {PublicKeyInfo, PolicyTree}} | {error, {bad_cert, Reason}} </name> <fsummary> Performs a basic path validation according to RFC 5280.</fsummary> <type> - <v> TrustedCert = #'OTPCertificate'{} | der_encode() | unknown_ca | selfsigned_peer </v> - <d>Normally a trusted certificate but it can also be one of the path validation - errors <c>unknown_ca </c> or <c>selfsigned_peer </c> that can be discovered while - constructing the input to this function and that should be run through the <c>verify_fun</c>.</d> + <v> TrustedCert = #'OTPCertificate'{} | der_encode() | atom() </v> + <d>Normally a trusted certificate but it can also be a path validation + error that can be discovered while + constructing the input to this function and that should be run through the <c>verify_fun</c>. + For example <c>unknown_ca </c> or <c>selfsigned_peer </c> + </d> <v> CertChain = [der_encode()]</v> <d>A list of DER encoded certificates in trust order ending with the peer certificate.</d> <v> Options = proplists:proplist()</v> @@ -440,8 +444,8 @@ rsa_public_key() | integer(), 'NULL' | 'Dss-Parms'{}}</v> <v> PolicyTree = term() </v> <d>At the moment this will always be an empty list as Policies are not currently supported</d> - <v> Reason = cert_expired | invalid_issuer | invalid_signature | unknown_ca | - selfsigned_peer | name_not_permitted | missing_basic_constraint | invalid_key_usage | crl_reason() + <v> Reason = cert_expired | invalid_issuer | invalid_signature | name_not_permitted | + missing_basic_constraint | invalid_key_usage | {revoked, crl_reason()} | atom() </v> </type> <desc> @@ -449,7 +453,7 @@ Performs a basic path validation according to <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280.</url> However CRL validation is done separately by <seealso - marker="public_key#pkix_crls_validate-3">pkix_crls_validate/3 </seealso> and should be called + marker="#pkix_crls_validate-3">pkix_crls_validate/3 </seealso> and should be called from the supplied <c>verify_fun</c> </p> @@ -462,7 +466,7 @@ <code> fun(OtpCert :: #'OTPCertificate'{}, - Event :: {bad_cert, Reason :: atom()} | + Event :: {bad_cert, Reason :: atom() | {revoked, atom()}} | {extension, #'Extension'{}}, InitialUserState :: term()) -> {valid, UserState :: term()} | @@ -491,6 +495,35 @@ fun(OtpCert :: #'OTPCertificate'{}, on. </item> </taglist> + + <p> Possible reasons for a bad certificate are: </p> + <taglist> + <tag>cert_expired</tag> + <item>The certificate is no longer valid as its expiration date has passed.</item> + + <tag>invalid_issuer</tag> + <item>The certificate issuer name does not match the name of the issuer certificate in the chain.</item> + + <tag>invalid_signature</tag> + <item>The certificate was not signed by its issuer certificate in the chain.</item> + + <tag>name_not_permitted</tag> + <item>Invalid Subject Alternative Name extension.</item> + + <tag>missing_basic_constraint</tag> + <item>Certificate, required to have the basic constraints extension, does not have + a basic constraints extension.</item> + + <tag>invalid_key_usage</tag> + <item>Certificate key is used in an invalid way according to the key usage extension.</item> + + <tag>{revoked, crl_reason()}</tag> + <item>Certificate has been revoked.</item> + + <tag>atom()</tag> + <item>Application specific error reason that should be checked by the verify_fun</item> + </taglist> + </desc> </func> @@ -499,14 +532,14 @@ fun(OtpCert :: #'OTPCertificate'{}, <fsummary> Performs CRL validation.</fsummary> <type> <v> OTPCertificate = #'OTPCertificate'{}</v> - <v> DPAndCRLs = [{DP::#'DistributionPoint'{} ,CRL::#'CertificateList'{}}] </v> + <v> DPAndCRLs = [{DP::#'DistributionPoint'{}, {DerCRL::der_encoded(), CRL::#'CertificateList'{}}}] </v> <v> Options = proplists:proplist()</v> <v> CRLStatus() = valid | {bad_cert, revocation_status_undetermined} | {bad_cert, {revoked, crl_reason()}}</v> </type> <desc> <p> Performs CRL validation. It is intended to be called from - the verify fun of <seealso marker="public_key#pkix_path_validation-3"> pkix_path_validation/3 + the verify fun of <seealso marker="#pkix_path_validation-3"> pkix_path_validation/3 </seealso></p> <taglist> <p> Available options are: </p> diff --git a/lib/public_key/doc/src/public_key_records.xml b/lib/public_key/doc/src/public_key_records.xml index 13bb996f7f..d3534846fa 100644 --- a/lib/public_key/doc/src/public_key_records.xml +++ b/lib/public_key/doc/src/public_key_records.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2008</year> - <year>2013</year> + <year>2014</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -35,17 +35,27 @@ </header> <p>This chapter briefly describes Erlang records derived from ASN1 - specifications used to handle public and private keys. The intent - is to describe the data types and not to specify the meaning of - each component for this we refer you to the relevant standards and RFCs.</p> + specifications used to handle public and private keys. + The intent is to describe the data types + and not to specify the semantics of each component. For information on the + semantics, please see the relevant standards and RFCs.</p> <p>Use the following include directive to get access to the - records and constant macros used in the following sections.</p> + records and constant macros described in the following sections.</p> <code> -include_lib("public_key/include/public_key.hrl"). </code> + <section> + <title>Common Data Types</title> + + <p>Common non-standard Erlang + data types used to described the record fields in the + below sections are defined in <seealso + marker="public_key">public key reference manual </seealso></p> + </section> + <section> - <title>RSA as defined by the PKCS-1 standard and RFC 3447.</title> + <title>RSA as defined by the PKCS-1 standard and <url href="http://www.ietf.org/rfc/rfc3447.txt"> RFC 3447 </url></title> <code> #'RSAPublicKey'{ @@ -76,7 +86,8 @@ </section> <section> - <title>DSA as defined by Digital Signature Standard (NIST FIPS PUB 186-2) + <title>DSA as defined by + <url href="http://csrc.nist.gov/publications/fips/fips186-3/fips_186-3.pdf"> Digital Signature Standard (NIST FIPS PUB 186-2) </url> </title> <code> @@ -96,4 +107,47 @@ }. </code> </section> + + <section> + <title>ECC (Elliptic Curve) <url href="http://www.ietf.org/rfc/rfc3447.txt"> RFC 5480 </url> + </title> + + <code> +#'ECPrivateKey'{ + version, % integer() + privateKey, % octet_string() + parameters, % der_encoded() - {'EcpkParameters', #'ECParameters'{}} | + {'EcpkParameters', {namedCurve, oid()}} | + {'EcpkParameters', 'NULL'} % Inherited by CA + publicKey % bitstring() + }. + +#'ECParameters'{ + version, % integer() + fieldID, % #'FieldID'{} + curve, % #'Curve'{} + base, % octet_string() + order, % integer() + cofactor % integer() + }. + +#'Curve'{ + a, % octet_string() + b, % octet_string() + seed % bitstring() - optional + + }. + +#'FieldID'{ + fieldType, % oid() + parameters % Depending on fieldType + }. + +#'ECPoint'{ + point % octet_string() - the public key + }. + + </code> + </section> + </chapter> diff --git a/lib/public_key/src/pubkey_pbe.erl b/lib/public_key/src/pubkey_pbe.erl index 460624163b..521a32189d 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-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-2014. All Rights Reserved. %% %% The 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,7 +22,7 @@ -include("public_key.hrl"). --export([encode/4, decode/4, decrypt_parameters/1]). +-export([encode/4, decode/4, decrypt_parameters/1, encrypt_parameters/1]). -export([pbdkdf1/4, pbdkdf2/7]). -define(DEFAULT_SHA_MAC_KEYLEN, 20). @@ -40,16 +40,16 @@ %%-------------------------------------------------------------------- encode(Data, Password, "DES-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_encrypt(des_cbc, Key, IV, Data); + crypto:block_encrypt(des_cbc, Key, IV, pbe_pad(Data, KeyDevParams)); 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:block_encrypt(des3_cbc, [Key1, Key2, Key3], IV, Data); + crypto:block_encrypt(des3_cbc, [Key1, Key2, Key3], IV, pbe_pad(Data)); encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_encrypt(rc2_cbc, Key, IV, Data). + crypto:block_encrypt(rc2_cbc, Key, IV, pbe_pad(Data, KeyDevParams)). %%-------------------------------------------------------------------- -spec decode(binary(), string(), string(), term()) -> binary(). %% @@ -108,6 +108,15 @@ decrypt_parameters(#'EncryptedPrivateKeyInfo_encryptionAlgorithm'{ algorithm = Oid, parameters = Param}) -> decrypt_parameters(Oid, Param). + +%%-------------------------------------------------------------------- +-spec encrypt_parameters({Cipher::string(), Params::term()}) -> + #'EncryptedPrivateKeyInfo_encryptionAlgorithm'{}. +%% +%% Description: Performs ANS1-decoding of encryption parameters. +%%-------------------------------------------------------------------- +encrypt_parameters({Cipher, Params}) -> + encrypt_parameters(Cipher, Params). %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -117,14 +126,18 @@ password_to_key_and_iv(Password, _, #'PBES2-params'{} = Params) -> <<Key:KeyLen/binary, _/binary>> = pbdkdf2(Password, Salt, ItrCount, KeyLen, PseudoRandomFunction, PseudoHash, PseudoOtputLen), {Key, IV}; +password_to_key_and_iv(Password, _Cipher, {#'PBEParameter'{salt = Salt, + iterationCount = Count}, Hash}) -> + <<Key:8/binary, IV:8/binary, _/binary>> + = pbdkdf1(Password, erlang:iolist_to_binary(Salt), Count, Hash), + {Key, IV}; password_to_key_and_iv(Password, Cipher, Salt) -> - KeyLen = derived_key_length(Cipher, undefined), + KeyLen = derived_key_length(Cipher, undefined), <<Key:KeyLen/binary, _/binary>> = pem_encrypt(<<>>, Password, Salt, ceiling(KeyLen div 16), <<>>, md5), %% Old PEM encryption does not use standard encryption method - %% pbdkdf1 and uses then salt as IV + %% pbdkdf1 and uses then salt as IV {Key, Salt}. - pem_encrypt(_, _, _, 0, Acc, _) -> Acc; pem_encrypt(Prev, Password, Salt, Count, Acc, Hash) -> @@ -169,7 +182,52 @@ do_xor_sum(Prf, PrfHash, PrfLen, Prev, Password, Count, Acc)-> decrypt_parameters(?'id-PBES2', DekParams) -> {ok, Params} = 'PKCS-FRAME':decode('PBES2-params', DekParams), - {cipher(Params#'PBES2-params'.encryptionScheme), Params}. + {cipher(Params#'PBES2-params'.encryptionScheme), Params}; +decrypt_parameters(?'pbeWithSHA1AndRC2-CBC', DekParams) -> + {ok, Params} = 'PKCS-FRAME':decode('PBEParameter', DekParams), + {"RC2-CBC", {Params, sha}}; +decrypt_parameters(?'pbeWithSHA1AndDES-CBC', DekParams) -> + {ok, Params} = 'PKCS-FRAME':decode('PBEParameter', DekParams), + {"DES-CBC", {Params, sha}}; +decrypt_parameters(?'pbeWithMD5AndRC2-CBC', DekParams) -> + {ok, Params} = 'PKCS-FRAME':decode('PBEParameter', DekParams), + {"RC2-CBC", {Params, md5}}; +decrypt_parameters(?'pbeWithMD5AndDES-CBC', DekParams) -> + {ok, Params} = 'PKCS-FRAME':decode('PBEParameter', DekParams), + {"DES-CBC", {Params, md5}}. + +encrypt_parameters(_Cipher, #'PBES2-params'{} = Params) -> + {ok, Der} ='PKCS-FRAME':encode('PBES2-params', Params), + #'EncryptedPrivateKeyInfo_encryptionAlgorithm'{ + algorithm = ?'id-PBES2', + parameters = Der}; + +encrypt_parameters(Cipher, {#'PBEParameter'{} = Params, Hash}) -> + {ok, Der} ='PKCS-FRAME':encode('PBEParameter', Params), + #'EncryptedPrivateKeyInfo_encryptionAlgorithm'{ + algorithm = pbe1_oid(Cipher, Hash), + parameters = Der}. + +pbe1_oid("RC2-CBC", sha) -> + ?'pbeWithSHA1AndRC2-CBC'; +pbe1_oid("DES-CBC", sha) -> + ?'pbeWithSHA1AndDES-CBC'; +pbe1_oid("RC2-CBC", md5) -> + ?'pbeWithMD5AndRC2-CBC'; +pbe1_oid("DES-CBC", md5) -> + ?'pbeWithMD5AndDES-CBC'. + +pbe_pad(Data, {#'PBEParameter'{}, _}) -> + pbe_pad(Data); +pbe_pad(Data, #'PBES2-params'{}) -> + pbe_pad(Data); +pbe_pad(Data, _) -> + Data. + +pbe_pad(Data) -> + N = 8 - (erlang:byte_size(Data) rem 8), + Pad = list_to_binary(lists:duplicate(N, N)), + <<Data/binary, Pad/binary>>. key_derivation_params(#'PBES2-params'{keyDerivationFunc = KeyDerivationFunc, encryptionScheme = EncScheme}) -> diff --git a/lib/public_key/src/pubkey_pem.erl b/lib/public_key/src/pubkey_pem.erl index 3a1653d989..98881c4a6a 100644 --- a/lib/public_key/src/pubkey_pem.erl +++ b/lib/public_key/src/pubkey_pem.erl @@ -68,7 +68,8 @@ encode(PemEntries) -> %%-------------------------------------------------------------------- -spec decipher({public_key:pki_asn1_type(), DerEncrypted::binary(), - {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{}}}, + {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{} + | {#'PBEParameter'{}, atom()}}}, string()) -> Der::binary(). %% %% Description: Deciphers a decrypted pem entry. @@ -77,7 +78,8 @@ decipher({_, DecryptDer, {Cipher, KeyDevParams}}, Password) -> pubkey_pbe:decode(DecryptDer, Password, Cipher, KeyDevParams). %%-------------------------------------------------------------------- --spec cipher(Der::binary(), {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{}} , +-spec cipher(Der::binary(), {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{} + | {#'PBEParameter'{}, atom()}}, string()) -> binary(). %% %% Description: Ciphers a PEM entry @@ -94,6 +96,10 @@ encode_pem_entries(Entries) -> encode_pem_entry({Type, Der, not_encrypted}) -> StartStr = pem_start(Type), [StartStr, "\n", b64encode_and_split(Der), "\n", pem_end(StartStr) ,"\n\n"]; +encode_pem_entry({'PrivateKeyInfo', Der, EncParams}) -> + EncDer = encode_encrypted_private_keyinfo(Der, EncParams), + StartStr = pem_start('EncryptedPrivateKeyInfo'), + [StartStr, "\n", b64encode_and_split(EncDer), "\n", pem_end(StartStr) ,"\n\n"]; encode_pem_entry({Type, Der, {Cipher, Salt}}) -> StartStr = pem_start(Type), [StartStr,"\n", pem_decrypt(),"\n", pem_decrypt_info(Cipher, Salt),"\n", @@ -139,6 +145,12 @@ decode_encrypted_private_keyinfo(Der) -> DecryptParams = pubkey_pbe:decrypt_parameters(AlgorithmInfo), {'PrivateKeyInfo', iolist_to_binary(Data), DecryptParams}. + +encode_encrypted_private_keyinfo(EncData, EncryptParmams) -> + AlgorithmInfo = pubkey_pbe:encrypt_parameters(EncryptParmams), + public_key:der_encode('EncryptedPrivateKeyInfo', + #'EncryptedPrivateKeyInfo'{encryptionAlgorithm = AlgorithmInfo, + encryptedData = EncData}). split_bin(Bin) -> split_bin(0, Bin). @@ -197,13 +209,15 @@ pem_start('DSAPrivateKey') -> <<"-----BEGIN DSA PRIVATE KEY-----">>; pem_start('DHParameter') -> <<"-----BEGIN DH PARAMETERS-----">>; +pem_start('EncryptedPrivateKeyInfo') -> + <<"-----BEGIN ENCRYPTED PRIVATE KEY-----">>; pem_start('CertificationRequest') -> <<"-----BEGIN CERTIFICATE REQUEST-----">>; pem_start('ContentInfo') -> <<"-----BEGIN PKCS7-----">>; pem_start('CertificateList') -> <<"-----BEGIN X509 CRL-----">>; -pem_start('OTPEcpkParameters') -> +pem_start('EcpkParameters') -> <<"-----BEGIN EC PARAMETERS-----">>; pem_start('ECPrivateKey') -> <<"-----BEGIN EC PRIVATE KEY-----">>. @@ -260,7 +274,7 @@ asn1_type(<<"-----BEGIN PKCS7-----">>) -> asn1_type(<<"-----BEGIN X509 CRL-----">>) -> 'CertificateList'; asn1_type(<<"-----BEGIN EC PARAMETERS-----">>) -> - 'OTPEcpkParameters'; + 'EcpkParameters'; asn1_type(<<"-----BEGIN EC PRIVATE KEY-----">>) -> 'ECPrivateKey'. diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index a732455aa7..1bbf4ef416 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -64,9 +64,15 @@ -type der_encoded() :: binary(). -type pki_asn1_type() :: 'Certificate' | 'RSAPrivateKey' | 'RSAPublicKey' | 'DSAPrivateKey' | 'DSAPublicKey' | 'DHParameter' - | 'SubjectPublicKeyInfo' | 'CertificationRequest' | 'CertificateList'. --type pem_entry() :: {pki_asn1_type(), binary(), %% DER or Encrypted DER - not_encrypted | {Cipher :: string(), Salt :: binary()}}. + | 'SubjectPublicKeyInfo' | 'PrivateKeyInfo' | + 'CertificationRequest' | 'CertificateList' | + 'ECPrivateKey' | 'EcpkParameters'. +-type pem_entry() :: {pki_asn1_type(), + binary(), %% DER or Encrypted DER + not_encrypted | {Cipher :: string(), Salt :: binary()} | + {Cipher :: string(), #'PBES2-params'{}} | + {Cipher :: string(), {#'PBEParameter'{}, atom()}} %% hash type + }. -type asn1_type() :: atom(). %% see "OTP-PUB-KEY.hrl -type ssh_file() :: openssh_public_key | rfc4716_public_key | known_hosts | auth_keys. @@ -133,20 +139,19 @@ pem_entry_decode({Asn1Type, CryptDer, {Cipher, #'PBES2-params'{}}} = PemEntry, is_binary(CryptDer) andalso is_list(Cipher) -> do_pem_entry_decode(PemEntry, Password); +pem_entry_decode({Asn1Type, CryptDer, {Cipher, {#'PBEParameter'{},_}}} = PemEntry, + Password) when is_atom(Asn1Type) andalso + is_binary(CryptDer) andalso + is_list(Cipher) -> + do_pem_entry_decode(PemEntry, Password); pem_entry_decode({Asn1Type, CryptDer, {Cipher, Salt}} = PemEntry, Password) when is_atom(Asn1Type) andalso is_binary(CryptDer) andalso is_list(Cipher) andalso is_binary(Salt) andalso - erlang:byte_size(Salt) == 8 -> - do_pem_entry_decode(PemEntry, Password); -pem_entry_decode({Asn1Type, CryptDer, {"AES-128-CBC"=Cipher, IV}} = PemEntry, - Password) when is_atom(Asn1Type) andalso - is_binary(CryptDer) andalso - is_list(Cipher) andalso - is_binary(IV) andalso - erlang:byte_size(IV) == 16 -> - do_pem_entry_decode(PemEntry, Password). + ((erlang:byte_size(Salt) == 8) or (erlang:byte_size(Salt) == 16)) -> + do_pem_entry_decode(PemEntry, Password). + %%-------------------------------------------------------------------- -spec pem_entry_encode(pki_asn1_type(), term()) -> pem_entry(). @@ -174,13 +179,19 @@ pem_entry_encode(Asn1Type, Entity, {{Cipher, #'PBES2-params'{}} = CipherInfo, is_list(Password) andalso is_list(Cipher) -> do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password); - +pem_entry_encode(Asn1Type, Entity, {{Cipher, + {#'PBEParameter'{}, _}} = CipherInfo, + Password}) when is_atom(Asn1Type) andalso + is_list(Password) andalso + is_list(Cipher) -> + do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password); pem_entry_encode(Asn1Type, Entity, {{Cipher, Salt} = CipherInfo, Password}) when is_atom(Asn1Type) andalso is_list(Password) andalso is_list(Cipher) andalso is_binary(Salt) andalso - erlang:byte_size(Salt) == 8 -> + ((erlang:byte_size(Salt) == 8) or + (erlang:byte_size(Salt) == 16)) -> do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password). %%-------------------------------------------------------------------- @@ -615,11 +626,11 @@ pkix_path_validation(#'OTPCertificate'{} = TrustedCert, CertChain, Options) %-------------------------------------------------------------------- -spec pkix_crls_validate(#'OTPCertificate'{}, - [{DP::#'DistributionPoint'{} ,CRL::#'CertificateList'{}}], + [{DP::#'DistributionPoint'{}, {DerCRL::binary(), CRL::#'CertificateList'{}}}], Options :: proplists:proplist()) -> valid | {bad_cert, revocation_status_undetermined} | {bad_cert, {revoked, crl_reason()}}. -%% Description: Performs a basic path validation according to RFC 5280. +%% Description: Performs a CRL validation according to RFC 5280. %%-------------------------------------------------------------------- pkix_crls_validate(OtpCert, [{_,_,_} |_] = DPAndCRLs, Options) -> pkix_crls_validate(OtpCert, DPAndCRLs, DPAndCRLs, diff --git a/lib/public_key/test/pbe_SUITE.erl b/lib/public_key/test/pbe_SUITE.erl index b68ffbd5fd..aa2bbdd24b 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-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -35,7 +35,9 @@ all() -> [ pbdkdf1, pbdkdf2, - encrypted_private_key_info]. + old_enc, + pbes1, + pbes2]. groups() -> []. @@ -192,44 +194,48 @@ pbdkdf2(Config) when is_list(Config) -> 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:hmac/4, sha, 20). - -encrypted_private_key_info() -> - [{doc,"Tests reading a EncryptedPrivateKeyInfo file encrypted with different ciphers"}]. -encrypted_private_key_info(Config) when is_list(Config) -> + +old_enc() -> + [{doc,"Tests encode/decode RSA key encrypted with different ciphers using old PEM encryption scheme"}]. +old_enc(Config) when is_list(Config) -> Datadir = ?config(data_dir, Config), - {ok, PemDes} = file:read_file(filename:join(Datadir, "des_cbc_enc_key.pem")), + %% key generated with ssh-keygen -N hello_aes -f old_aes_128_cbc_enc_key.pem + {ok, PemAesCbc} = file:read_file(filename:join(Datadir, "old_aes_128_cbc_enc_key.pem")), - PemDesEntry = public_key:pem_decode(PemDes), - ct:print("Pem entry: ~p" , [PemDesEntry]), - [{'PrivateKeyInfo', _, {"DES-CBC",_}} = PubEntry0] = PemDesEntry, - KeyInfo = public_key:pem_entry_decode(PubEntry0, "password"), - - {ok, Pem3Des} = file:read_file(filename:join(Datadir, "des_ede3_cbc_enc_key.pem")), - - Pem3DesEntry = public_key:pem_decode(Pem3Des), - ct:print("Pem entry: ~p" , [Pem3DesEntry]), - [{'PrivateKeyInfo', _, {"DES-EDE3-CBC",_}} = PubEntry1] = Pem3DesEntry, - KeyInfo = public_key:pem_entry_decode(PubEntry1, "password"), - - {ok, PemRc2} = file:read_file(filename:join(Datadir, "rc2_cbc_enc_key.pem")), - - PemRc2Entry = public_key:pem_decode(PemRc2), - ct:print("Pem entry: ~p" , [PemRc2Entry]), - [{'PrivateKeyInfo', _, {"RC2-CBC",_}} = PubEntry2] = PemRc2Entry, - KeyInfo = public_key:pem_entry_decode(PubEntry2, "password"), - - %% key generated with ssh-keygen -N hello_aes -f aes_128_cbc_enc_key - {ok, PemAesCbc} = file:read_file(filename:join(Datadir, "aes_128_cbc_enc_key")), - PemAesCbcEntry = public_key:pem_decode(PemAesCbc), ct:print("Pem entry: ~p" , [PemAesCbcEntry]), [{'RSAPrivateKey', _, {"AES-128-CBC",_}} = PubAesCbcEntry] = PemAesCbcEntry, - #'RSAPrivateKey'{} = public_key:pem_entry_decode(PubAesCbcEntry, "hello_aes"), - - check_key_info(KeyInfo). + #'RSAPrivateKey'{} = public_key:pem_entry_decode(PubAesCbcEntry, "hello_aes"). +pbes1() -> + [{doc,"Tests encode/decode EncryptedPrivateKeyInfo encrypted with different ciphers using PBES1"}]. +pbes1(Config) when is_list(Config) -> + decode_encode_key_file("pbes1_des_cbc_md5_enc_key.pem", "password", "DES-CBC", Config). + +pbes2() -> + [{doc,"Tests encode/decode EncryptedPrivateKeyInfo encrypted with different ciphers using PBES2"}]. +pbes2(Config) when is_list(Config) -> + decode_encode_key_file("pbes2_des_cbc_enc_key.pem", "password", "DES-CBC", Config), + decode_encode_key_file("pbes2_des_ede3_cbc_enc_key.pem", "password", "DES-EDE3-CBC", Config), + decode_encode_key_file("pbes2_rc2_cbc_enc_key.pem", "password", "RC2-CBC", Config). check_key_info(#'PrivateKeyInfo'{privateKeyAlgorithm = #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?rsaEncryption}, privateKey = Key}) -> #'RSAPrivateKey'{} = public_key:der_decode('RSAPrivateKey', iolist_to_binary(Key)). + +decode_encode_key_file(File, Password, Cipher, Config) -> + Datadir = ?config(data_dir, Config), + {ok, PemKey} = file:read_file(filename:join(Datadir, File)), + + PemEntry = public_key:pem_decode(PemKey), + ct:print("Pem entry: ~p" , [PemEntry]), + [{Asn1Type, _, {Cipher,_} = CipherInfo} = PubEntry] = PemEntry, + KeyInfo = public_key:pem_entry_decode(PubEntry, Password), + PemKey1 = public_key:pem_encode([public_key:pem_entry_encode(Asn1Type, KeyInfo, {CipherInfo, Password})]), + Pem = strip_ending_newlines(PemKey), + Pem = strip_ending_newlines(PemKey1), + check_key_info(KeyInfo). + +strip_ending_newlines(Bin) -> + string:strip(binary_to_list(Bin), right, 10). diff --git a/lib/public_key/test/pbe_SUITE_data/aes_128_cbc_enc_key b/lib/public_key/test/pbe_SUITE_data/old_aes_128_cbc_enc_key.pem index 34c7543f30..34c7543f30 100644 --- a/lib/public_key/test/pbe_SUITE_data/aes_128_cbc_enc_key +++ b/lib/public_key/test/pbe_SUITE_data/old_aes_128_cbc_enc_key.pem diff --git a/lib/public_key/test/pbe_SUITE_data/pbes1_des_cbc_md5_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/pbes1_des_cbc_md5_enc_key.pem new file mode 100644 index 0000000000..12e860c7a7 --- /dev/null +++ b/lib/public_key/test/pbe_SUITE_data/pbes1_des_cbc_md5_enc_key.pem @@ -0,0 +1,17 @@ +-----BEGIN ENCRYPTED PRIVATE KEY----- +MIICoTAbBgkqhkiG9w0BBQMwDgQIZmB6EGEnIOcCAggABIICgDaaKoCEUowjKt5M +uwMAIf7uugy09OcqR8PcB9ioiuk5NQGXkIBxOOlOuFb6xrP+O2dSppr5k/ZU+NEX +Lf18AdMld1nlE6lwjPytOIqt6Q3YMeny8un1/jopnkQZKthJ5moER5ohp/2osTDV +4Ih8MtHTwE879SHAmj7Y3G7itKHQi17212DVmL+D+P7iRzTCKIyPj5KMXvXN+eor +j0urZXVOeyRTABHQnf6xJn8K+dGowC/AJTQWOgFunlBKzecepqF22OQzIW2R60aM +VgykSd8A5G8o1F+tO2Qrp6KM9Ak709dUX8qRb/C02w5rjg2g0frgFyEGX0pUJbno +dJLKMOT1WvDnsXaS720beyzrOynWiAuaFZwb1/nPSQnzJ4t0mUvQQis5ph3eHSR/ +a9/PER81IDjPtjlTJjaOGuwhIRmGFsLUrQhOnVcI7Z5TCSj7EHdqK3xzjSVzu5DY +BqE2rsigiIOszPdbK4tKCDheIwBhYdptDvG9c+j3Mj0YNOXJxsX0gVoMqtpwryNG +OZy5fLujS4l+cPq64dOh/LE87mrM9St6M6gw2VRW7d0U18Muubp/MK8q9O2i80Nw +ZFrHHE1N09x3aTnty4mwdCHl6w5aJMZg6WbUXJnf0zKa8ADv5wZmAvW3fO4G8434 +3FHj1hdyKPcoVjoFVawyRUflF/jYd1pLpV+iZwDDR4lacb4ay1Lut452ifZ8DqOq +lWYL0uskCn1WI856vtlLV3gnV02xDjAilSY2hASOyoD1wypZefPn5S+U3vkLuzFZ +ycbyIwGYTLWj71u8Vu3JceRI3OIPDuM7zcNHr71eQyiwLEA0iszQQA9xgqmeFtJO +IkpUTAY= +-----END ENCRYPTED PRIVATE KEY----- diff --git a/lib/public_key/test/pbe_SUITE_data/des_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/pbes2_des_cbc_enc_key.pem index eaa06145aa..eaa06145aa 100644 --- a/lib/public_key/test/pbe_SUITE_data/des_cbc_enc_key.pem +++ b/lib/public_key/test/pbe_SUITE_data/pbes2_des_cbc_enc_key.pem diff --git a/lib/public_key/test/pbe_SUITE_data/des_ede3_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/pbes2_des_ede3_cbc_enc_key.pem index 22ea46d56f..22ea46d56f 100644 --- a/lib/public_key/test/pbe_SUITE_data/des_ede3_cbc_enc_key.pem +++ b/lib/public_key/test/pbe_SUITE_data/pbes2_des_ede3_cbc_enc_key.pem diff --git a/lib/public_key/test/pbe_SUITE_data/rc2_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/pbes2_rc2_cbc_enc_key.pem index 618cddcfd7..618cddcfd7 100644 --- a/lib/public_key/test/pbe_SUITE_data/rc2_cbc_enc_key.pem +++ b/lib/public_key/test/pbe_SUITE_data/pbes2_rc2_cbc_enc_key.pem diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index f0450918aa..2fa2d725c3 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 0.22 +PUBLIC_KEY_VSN = 0.22.1 diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl index 347e80ed7c..b3b7afd1a9 100644 --- a/lib/reltool/test/reltool_server_SUITE.erl +++ b/lib/reltool/test/reltool_server_SUITE.erl @@ -1205,14 +1205,9 @@ create_slim(Config) -> RootDir = code:root_dir(), Erl = filename:join([RootDir, "bin", "erl"]), - EscapedQuote = - case os:type() of - {win32,_} -> "\\\""; - _ -> "\"" - end, Args = ["-boot_var", "RELTOOL_EXT_LIB", TargetLibDir, "-boot", filename:join(TargetRelVsnDir,RelName), - "-sasl", "releases_dir", EscapedQuote++TargetRelDir++EscapedQuote], + "-sasl", "releases_dir", "\""++TargetRelDir++"\""], {ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl, Args)), ?msym(RootDir, rpc:call(Node, code, root_dir, [])), wait_for_app(Node,sasl,50), diff --git a/lib/sasl/doc/src/notes.xml b/lib/sasl/doc/src/notes.xml index 2928a12d22..95d7c6fa50 100644 --- a/lib/sasl/doc/src/notes.xml +++ b/lib/sasl/doc/src/notes.xml @@ -30,6 +30,26 @@ </header> <p>This document describes the changes made to the SASL application.</p> +<section><title>SASL 2.4.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The documentation erroneously specified that + <c>alarm_handler:clear_alarm/1</c> would clear + <em>all</em> alarms with id <c>AlarmId</c>. This is now + corrected according to the implementation - only the + latest received alarm with the given <c>AlarmId</c> is + cleared by the simple default handler.</p> + <p> + Own Id: OTP-12025</p> + </item> + </list> + </section> + +</section> + <section><title>SASL 2.4</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/sasl/src/sasl.appup.src b/lib/sasl/src/sasl.appup.src index e789853eea..af04d007ac 100644 --- a/lib/sasl/src/sasl.appup.src +++ b/lib/sasl/src/sasl.appup.src @@ -17,9 +17,7 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}], %% R16 + [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 %% Down to - max one major revision back - [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 + [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 }. diff --git a/lib/sasl/test/sasl_SUITE.erl b/lib/sasl/test/sasl_SUITE.erl index e91d220daf..d7b99d506e 100644 --- a/lib/sasl/test/sasl_SUITE.erl +++ b/lib/sasl/test/sasl_SUITE.erl @@ -57,17 +57,29 @@ appup_test(_Config) -> appup_tests(_App,{[],[]}) -> {skip,"no previous releases available"}; -appup_tests(App,{OkVsns,NokVsns}) -> +appup_tests(App,{OkVsns0,NokVsns}) -> application:load(App), {_,_,Vsn} = lists:keyfind(App,1,application:loaded_applications()), AppupFileName = atom_to_list(App) ++ ".appup", AppupFile = filename:join([code:lib_dir(App),ebin,AppupFileName]), {ok,[{Vsn,UpFrom,DownTo}=AppupScript]} = file:consult(AppupFile), ct:log("~p~n",[AppupScript]), - ct:log("Testing ok versions: ~p~n",[OkVsns]), + OkVsns = + case OkVsns0 -- [Vsn] of + OkVsns0 -> + OkVsns0; + Ok -> + ct:log("Current version, ~p, is same as in previous release.~n" + "Removing this from the list of ok versions.", + [Vsn]), + Ok + end, + ct:log("Testing that appup allows upgrade from these versions: ~p~n", + [OkVsns]), check_appup(OkVsns,UpFrom,{ok,[restart_new_emulator]}), check_appup(OkVsns,DownTo,{ok,[restart_new_emulator]}), - ct:log("Testing not ok versions: ~p~n",[NokVsns]), + ct:log("Testing that appup does not allow upgrade from these versions: ~p~n", + [NokVsns]), check_appup(NokVsns,UpFrom,error), check_appup(NokVsns,DownTo,error), ok. diff --git a/lib/sasl/test/test_lib.hrl b/lib/sasl/test/test_lib.hrl index c8a4e92f24..b16c4ac34c 100644 --- a/lib/sasl/test/test_lib.hrl +++ b/lib/sasl/test/test_lib.hrl @@ -1,3 +1,3 @@ -define(ertsvsn,"4.4"). --define(kernelvsn,"2.16.4"). --define(stdlibvsn,"1.19.4"). +-define(kernelvsn,"3.0"). +-define(stdlibvsn,"2.0"). diff --git a/lib/sasl/vsn.mk b/lib/sasl/vsn.mk index da8cbc5130..4259a2d76c 100644 --- a/lib/sasl/vsn.mk +++ b/lib/sasl/vsn.mk @@ -1 +1 @@ -SASL_VSN = 2.4 +SASL_VSN = 2.4.1 diff --git a/lib/snmp/.gitignore b/lib/snmp/.gitignore index 650c1d6865..aef73491a4 100644 --- a/lib/snmp/.gitignore +++ b/lib/snmp/.gitignore @@ -5,5 +5,4 @@ *.rej doc/index.html - - +mibs/.index diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 06674095f2..bbe6438f04 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -33,7 +33,46 @@ </header> - <section><title>SNMP 4.25.1</title> + <section><title>SNMP 5.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The SNMP manager has been enhanced with dual stack + IPv4+IPv6, as the agent just was. The documentation is + also now updated for both the agent and the manager.</p> + <p> + Own Id: OTP-12108 Aux Id: OTP-12020 </p> + </item> + </list> + </section> + +</section> + +<section><title>SNMP 5.0</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + SNMP has been improved to handle IPv6. The agent can + handle dual stack IPv4 + IPv6, but not yet the manager. + The documentation also still lags behind... If you do + such advanced stuff like writing a custom net_if module, + the interface for it has changed, but other than that + SNMP is backwards compatible.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-12020 Aux Id: OTP-11518 </p> + </item> + </list> + </section> + +</section> + +<section><title>SNMP 4.25.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/snmp/doc/src/snmp_agent_config_files.xml b/lib/snmp/doc/src/snmp_agent_config_files.xml index 1e8e879814..1e938c0dc8 100644 --- a/lib/snmp/doc/src/snmp_agent_config_files.xml +++ b/lib/snmp/doc/src/snmp_agent_config_files.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2013</year> + <year>1997</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -102,20 +102,41 @@ <p><c>AgentVariable</c> is one of the variables is SNMP-FRAMEWORK-MIB or one of the internal variables <c>intAgentUDPPort</c>, which defines which UDP port the agent - listens to, or <c>intAgentIpAddress</c>, which defines the IP - address of the agent. </p> + listens to, or <c>intAgentTransports</c>, which defines the + transport domains and addresses of the agent. </p> </item> <item> <p><c>Value</c> is the value for the variable.</p> </item> </list> - <p>The following example shows a <c>agent.conf</c> file: </p> + <p>The following example shows an <c>agent.conf</c> file: </p> <pre> {intAgentUDPPort, 4000}. -{intAgentIpAddress,[141,213,11,24]}. +{intAgentTransports, + [{transportDomainUdpIpv4, {141,213,11,24}}, + {transportDomainUdpIpv6, {0,0,0,0,0,0,0,1}}]}. {snmpEngineID, "mbj's engine"}. {snmpEngineMaxPacketSize, 484}. </pre> + <p>The value of <c>intAgentTransports</c> is a list of + <c>{Domain, Addr}</c> tuples, where <c>Domain</c> + is either <c>transportDomainUdpIpv4</c> or <c>transportDomainUdpIpv6</c>, + and <c>Addr</c> is the address in the domain. + <c>Addr</c> can be specified either as an + <c>IpAddr</c> or as an <c>{IpAddr, IpPort}</c> tuple. + <c>IpAddr</c> is either a regular Erlang/OTP + <seealso marker="kernel:inet#type-ip_address"><c>ip_address()</c></seealso> + or a traditional SNMP integer list and <c>IpPort</c> is an integer. + </p> + + <p>When the <c>Addr</c> value does not contain a port number, + the value of <c>intAgentUDPPort</c> is used.</p> + + <p>The legacy and intermediate variables <c>intAgentIpAddress</c> + and <c>intAgentTransportDomain</c> are still supported so old + <c>agent.conf</c> files will work. + </p> + <p>The value of <c>snmpEngineID</c> is a string, which for a deployed agent should have a very specific structure. See RFC 2271/2571 for details.</p> @@ -362,9 +383,9 @@ SNMP-TARGET-MIB and <c>snmpTargetAddrExtTable</c> in the SNMP-COMMUNITY-MIB. </p> <p>Each entry is a term: </p> - <p><c>{TargetName, Ip, Udp, Timeout, RetryCount, TagList, ParamsName, EngineId}.</c> <br></br> or <br></br> -<c>{TargetName, Ip, Udp, Timeout, RetryCount, TagList, ParamsName, EngineId, TMask, MaxMessageSize}.</c> <br></br> or <br></br> -<c>{TargetName, Domain, Ip, Udp, Timeout, RetryCount, TagList, ParamsName, EngineId, TMask, MaxMessageSize}.</c> </p> + <p><c>{TargetName, Domain, Addr, Timeout, RetryCount, TagList, ParamsName, EngineId}.</c> + <br></br> or <br></br> + <c>{TargetName, Domain, Addr, Timeout, RetryCount, TagList, ParamsName, EngineId, TMask, MaxMessageSize}.</c> </p> <list type="bulleted"> <item> <p><c>TargetName</c> is a unique non-empty string. </p> @@ -374,11 +395,14 @@ <c>transportDomainUdpIpv4</c> | <c>transportDomainUdpIpv6</c>. </p> </item> <item> - <p><c>Ip</c> is a list of four or eight integers. </p> - </item> - <item> - <p><c>Udp</c> is an integer. </p> + <p><c>Addr</c> is either an <c>IpAddr</c> or + an <c>{IpAddr, IpPort}</c> tuple. <c>IpAddr</c> is either + a regular Erlang/OTP + <seealso marker="kernel:inet#type-ip_address"><c>ip_address()</c></seealso> + or a traditional SNMP integer list, and <c>IpPort</c> is an integer.</p> + <p>If <c>IpPort</c> is omitted <c>162</c> is used.</p> </item> + <item> <p><c>Timeout</c> is an integer. </p> </item> @@ -395,13 +419,17 @@ <p><c>EngineId</c> is a string or the atom <c>discovery</c>. </p> </item> <item> - <p><c>TMask</c> is a list of integer() of size 0, - size 6 or size 10 (default: []). </p> + <p><c>TMask</c> is specified just as <c>Addr</c> or as <c>[]</c>. + Note in particular that using a list of 6 bytes for IPv4 + or 8 words plus 2 bytes for IPv6 are still valid address formats + so old configurations will work.</p> </item> <item> <p><c>MaxMessageSize</c> is an integer (default: 2048). </p> </item> </list> + <p>The old tuple formats with <c>Ip</c> address and <c>Udp</c> + port number found in old configurations still work.</p> <p>Note that if <c>EngineId</c> has the value <c>discovery</c>, the agent cannot send <c>inform</c> messages to that manager until it has performed the diff --git a/lib/snmp/doc/src/snmp_agent_netif.xml b/lib/snmp/doc/src/snmp_agent_netif.xml index fccfc8857a..a9ce05e757 100644 --- a/lib/snmp/doc/src/snmp_agent_netif.xml +++ b/lib/snmp/doc/src/snmp_agent_netif.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2013</year> + <year>1997</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -51,7 +51,8 @@ </p> <p>It is also possible to write your own Net if process. The default Net if process is implemented in the module <c>snmpa_net_if</c> and - it uses UDP as the transport protocol. + it uses UDP as the transport protocol i.e the transport domains + <c>transportDomainUdpIpv4</c> and/or <c>transportDomainUdpIpv6</c>. </p> <p>This section describes how to write a Net if process. </p> @@ -70,6 +71,12 @@ <p>The section <em>Messages</em> describes mandatory messages, which Net if must send and be able to receive. </p> + <p>In this section an <c>Address</c> field is a + <c>{Domain, Addr}</c> tuple where <c>Domain</c> is + <c>transportDomainUdpIpv4</c> or <c>transportDomainUdpIpv4</c>, + and <c>Addr</c> is an + <c>{<seealso marker="kernel:inet#type-ip_address">IpAddr</seealso>, + IpPort}</c> tuple.</p> <section> <marker id="outgoing_messages"></marker> @@ -96,10 +103,7 @@ MasterAgent ! {snmp_pdu, Vsn, Pdu, PduMS, ACMData, From, Extra} in use. Normally this is returned from <c>snmpa_mpd:process_packet</c> (see Reference Manual). </item> - <item><c>From</c> is the source address. If UDP over IP is - used, this should be a 2-tuple <c>{IP, UDPport}</c>, where - <c>IP</c> is a 4-tuple with the IP address, and <c>UDPport</c> - is an integer. + <item><c>From</c> is the source <c>Address</c>. </item> <item><c>Extra</c> is any term the Net if process wishes to send to the agent. This term can be retrieved by the @@ -127,10 +131,7 @@ Pid ! {snmp_response_received, Vsn, Pdu, From} </item> <item><c>Pdu</c> is the SNMP Pdu received </item> - <item><c>From</c> is the source address. If UDP over IP is - used, this should be a 2-tuple <c>{IP, UDPport}</c>, where - <c>IP</c> is a 4-tuple with the IP address, and <c>UDPport</c> - is an integer. + <item><c>From</c> is the source <c>Address</c>. </item> </list> </section> @@ -168,10 +169,9 @@ Pid ! {snmp_response_received, Vsn, Pdu, From} (see Reference Manual). </p> </item> <item> - <p><c>To</c> is the destination address. If UDP over IP - is used, this should be a 2-tuple <c>{IP, UDPport}</c>, - where <c>IP</c> is a 4-tuple with the IP address, and - <c>UDPport</c> is an integer. </p> + <p><c>To</c> is the destination <c>Address</c> that comes + from the <c>From</c> field in the corresponding <c>snmp_pdu</c> + message previously sent to the MasterAgent.</p> </item> <item> <p><c>Extra</c> is the term that the Net if process @@ -230,7 +230,8 @@ Pid ! {snmp_response_received, Vsn, Pdu, From} SNMPv3, it is the context information. </p> </item> <item> - <p><c>To</c> is a list of the destination addresses and + <p><c>To</c> is a list of <c>{Address, SecData}</c> + tuples i.e the destination addresses and their corresponding security parameters. This value is normally sent to <c>snmpa_mpd:generate_message/4</c>. </p> </item> @@ -268,7 +269,8 @@ Pid ! {snmp_response_received, Vsn, Pdu, From} SNMPv3, it is the context information. </p> </item> <item> - <p><c>To</c> is a list of the destination addresses and + <p><c>To</c> is a list of <c>{Address, SecData}</c> + tuples i.e the destination addresses and their corresponding security parameters. This value is normally sent to <c>snmpa_mpd:generate_message/4</c>. </p> </item> diff --git a/lib/snmp/doc/src/snmp_manager_config_files.xml b/lib/snmp/doc/src/snmp_manager_config_files.xml index 486ef7c170..d8bd4b0f3a 100644 --- a/lib/snmp/doc/src/snmp_manager_config_files.xml +++ b/lib/snmp/doc/src/snmp_manager_config_files.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2004</year><year>2013</year> + <year>2004</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -64,13 +64,42 @@ <item> <p><c>Variable</c> is one of the following:</p> <list type="bulleted"> - <item> - <p><c>address</c> - which defines the IP address of the - manager. Default is local host.</p> - </item> + <item> + <p><c>transports</c> - which defines the transport domains + and their addresses for the manager. <em>Mandatory</em> + </p> + <p><c>Value</c> is a list of <c>{Domain, Addr}</c> tuples + or <c>Domain</c> atoms. + </p> + <list type="bulleted"> + <item> + <p><c>Domain</c> is one of <c>transportDomainUdpIpv4</c> + or <c>transportDomainUdpIpv6</c>.</p> + </item> + <item> + <p><c>Addr</c> is for the currently supported domains + either an <c>IpAddr</c> or an <c>{IpAddr, IpPort}</c> + tuple.<c>IpAddr</c> is either a regular Erlang/OTP + <seealso marker="kernel:inet#type-ip_address"> + <c>ip_address()</c></seealso> or a traditional SNMP integer list + and <c>IpPort</c> is an integer. + </p> + <p>When <c>Addr</c> does not contain a port number, + the value of <c>port</c> is used. + </p> + <p>When a <c>Addr</c> is not specified i.e by + using only a <c>Domain</c> atom, the host's name + is resolved to find the IP address, and the value of + <c>port</c> is used. + </p> + </item> + </list> + </item> <item> <p><c>port</c> - which defines which UDP port the manager uses - for communicating with agents. <em>Mandatory</em>.</p> + for communicating with agents. + <em>Mandatory</em> if <c>transports</c> does not define + a port number for every transport.</p> </item> <item> <p><c>engine_id</c> - The <c>SnmpEngineID</c> as defined in @@ -87,11 +116,13 @@ </p> </item> </list> + <p>The legacy and intermediate variables <c>address</c> and <c>domain</c> + are still supported so old configurations will work.</p> <p>The following example shows a <c>manager.conf</c> file: </p> <pre> -{address, [141,213,11,24]}. -{port, 5000}. +{transports, [{transportDomainUdpIpv4, {{141,213,11,24}, 5000}}, + {transportDomainUdpIpv6, {{0,0,0,0,0,0,0,1}, 5000}}]}. {engine_id, "mgrEngine"}. {max_message_size, 484}. </pre> @@ -146,7 +177,7 @@ </p> <p>Each entry is a tuple: </p> - <p><c>{UserId, TargetName, Comm, Ip, Port, EngineID, Timeout, MaxMessageSize, Version, SecModel, SecName, SecLevel}.</c></p> + <p><c>{UserId, TargetName, Comm, Domain, Addr, EngineID, Timeout, MaxMessageSize, Version, SecModel, SecName, SecLevel}.</c></p> <list type="bulleted"> <item> <p><c>UserId</c> is the identity of the <em>manager user</em> @@ -160,10 +191,17 @@ <p><c>Comm</c> is the community string (string).</p> </item> <item> - <p><c>Ip</c> is the ip address of the agent (a list of four integers).</p> + <p><c>Domain</c> is the transport domain, either + <c>transportDomainUdpIpv4</c> or <c>transportDomainUdpIpv6</c>.</p> </item> <item> - <p><c>Port</c> is the port number of the agent (integer).</p> + <p><c>Addr</c> is the address in the transport domain, + either an <c>{IpAddr, IpPort}</c> tuple or a traditional SNMP + integer list containing port number. <c>IpAddr</c> is either + a regular Erlang/OTP + <seealso marker="kernel:inet#type-ip_address"><c>ip_address()</c></seealso> + or a traditional SNMP integer list not containing port number, + and <c>IpPort</c> is an integer.</p> </item> <item> <p><c>EngineID</c> is the engine-id of the agent (string).</p> @@ -190,6 +228,9 @@ authPriv).</p> </item> </list> + <p>Legacy configurations using tuples without <c>Domain</c> element, + as well as with all <c>TDomain</c>, <c>Ip</c> and <c>Port</c> elements + still work.</p> </section> <section> diff --git a/lib/snmp/doc/src/snmp_manager_netif.xml b/lib/snmp/doc/src/snmp_manager_netif.xml index 757ed32880..97cedf00c0 100644 --- a/lib/snmp/doc/src/snmp_manager_netif.xml +++ b/lib/snmp/doc/src/snmp_manager_netif.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2004</year><year>2013</year> + <year>2004</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -50,13 +50,14 @@ <p>The snmp application provides two different modules, <c>snmpm_net_if</c> (the default) and <c>snmpm_net_if_mt</c>, - both uses the UDP as the transport protocol. The difference - between the two modules is that the latter is "multi-threaded", - i.e. for each message/request a new process is created that - process the message/request and then exits. </p> + both uses UDP as the transport protocol i.e the transport domains + <c>transportDomainUdpIpv4</c> and/or <c>transportDomainUdpIpv6</c>. + The difference between the two modules is that the latter is + "multi-threaded", i.e. for each message/request a new process + is created that processes the message/request and then exits. </p> - <p>It is also possible to write your own Net if process, - this section describes how to write a Net if processdo that.</p> + <p>It is also possible to write your own Net if process and + this section describes how to do that.</p> <section> <marker id="mandatory_functions"></marker> @@ -70,11 +71,17 @@ <p>The section <em>Messages</em> describes mandatory messages, which Net if must send to the manager server process. </p> + <p>In this section a <c>Domain</c> field is the transport domain i.e + one of <c>transportDomainUdpIpv4</c> or <c>transportDomainUdpIpv6</c>, + and an <c>Addr</c> field is an + <c>{<seealso marker="kernel:inet#type-ip_address">IpAddr</seealso>, + IpPort}</c> tuple.</p> + <p>Net if must send the following message when it receives an SNMP PDU from the network that is aimed for the MasterAgent: </p> <pre> -Server ! {snmp_pdu, Pdu, Addr, Port} +Server ! {snmp_pdu, Pdu, Domain, Addr} </pre> <list type="bulleted"> <item> @@ -82,14 +89,14 @@ Server ! {snmp_pdu, Pdu, Addr, Port} <c>snmp_types.hrl</c>, with the SNMP request.</p> </item> <item> - <p><c>Addr</c> is the source address. </p> + <p><c>Domain</c> is the source transport domain. </p> </item> <item> - <p><c>Port</c> is port number of the sender.</p> + <p><c>Addr</c> is the source address. </p> </item> </list> <pre> -Server ! {snmp_trap, Trap, Addr, Port} +Server ! {snmp_trap, Trap, Domain, Addr} </pre> <list type="bulleted"> <item> @@ -97,14 +104,14 @@ Server ! {snmp_trap, Trap, Addr, Port} as defined in <c>snmp_types.hrl</c>, with the SNMP request.</p> </item> <item> - <p><c>Addr</c> is the source address. </p> + <p><c>Domain</c> is the source transport domain. </p> </item> <item> - <p><c>Port</c> is port number of the sender.</p> + <p><c>Addr</c> is the source address. </p> </item> </list> <pre> -Server ! {snmp_inform, Ref, Pdu, PduMS, Addr, Port} +Server ! {snmp_inform, Ref, Pdu, PduMS, Domain, Addr} </pre> <list type="bulleted"> <item> @@ -123,14 +130,14 @@ Server ! {snmp_inform, Ref, Pdu, PduMS, Addr, Port} <c>snmp_types.hrl</c>, with the SNMP request.</p> </item> <item> - <p><c>Addr</c> is the source address. </p> + <p><c>Domain</c> is the source transport domain. </p> </item> <item> - <p><c>Port</c> is port number of the sender.</p> + <p><c>Addr</c> is the source address. </p> </item> </list> <pre> -Server ! {snmp_report, Data, Addr, Port} +Server ! {snmp_report, Data, Domain, Addr} </pre> <list type="bulleted"> <item> @@ -152,10 +159,10 @@ Server ! {snmp_report, Data, Addr, Port} <p><c>ReasonInfo</c> is a term().</p> </item> <item> - <p><c>Addr</c> is the source address. </p> + <p><c>Domain</c> is the source transport domain. </p> </item> <item> - <p><c>Port</c> is port number of the sender.</p> + <p><c>Addr</c> is the source address. </p> </item> </list> diff --git a/lib/snmp/doc/src/snmp_target_mib.xml b/lib/snmp/doc/src/snmp_target_mib.xml index be6fa15c73..a076ff2d8e 100644 --- a/lib/snmp/doc/src/snmp_target_mib.xml +++ b/lib/snmp/doc/src/snmp_target_mib.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1998</year><year>2013</year> + <year>1998</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -38,18 +38,18 @@ functions for the SNMP-TARGET-MIB, and functions for configuring the database. </p> <p>The configuration files are described in the SNMP User's Manual.</p> + <p>Legacy API functions <c>add_addr/10</c> that does not specify + transport domain, and <c>add_addr/11</c> that has got separate + <c>IpAddr</c> and <c>PortNumber</c> arguments still work as before + for backwards compatibility reasons.</p> <marker id="types"></marker> </description> <section> <title>DATA TYPES</title> - <code type="none"><![CDATA[ -transportDomain() = transportDomainUdpIpv4 | transportDomainUdpIpv6 -transportAddressIPv4() = [integer()], length 4 -transportAddressIPv6() = [integer()], length 8 -transportAddressMask() = [integer()], length 0 (default), 6 (IPv4) or 10 (IPv6) - ]]></code> + <p>See the <seealso marker="snmpa_conf#types"> + data types in <c>snmpa_conf</c></seealso>.</p> <marker id="configure"></marker> </section> @@ -129,20 +129,18 @@ transportAddressMask() = [integer()], length 0 (default), 6 (IPv4) or 10 (IPv6) </func> <func> - <name>add_addr(Name, Ip, Port, Timeout, Retry, TagList, Params, EngineId, TMask, MMS) -> Ret</name> - <name>add_addr(Name, Domain, Ip, Port, Timeout, Retry, TagList, Params, EngineId, TMask, MMS) -> Ret</name> + <name>add_addr(Name, Domain, Addr, Timeout, Retry, TagList, Params, EngineId, TMask, MMS) -> Ret</name> <fsummary>Add one target address definition</fsummary> <type> <v>Name = string()</v> <v>Domain = transportDomain()</v> - <v>Ip = transportAddressIPv4() | transportAddressIPv6() (depends on the value of Domain)</v> - <v>Port = integer()</v> + <v>Addr = transportAddress() % Default port is 162</v> <v>Timeout = integer()</v> <v>Retry = integer()</v> <v>TagList = string()</v> <v>ParamsName = string()</v> <v>EngineId = string()</v> - <v>TMask = transportAddressMask() (depends on Domain)</v> + <v>TMask = transportAddressMask() % Depends on Domain</v> <v>MMS = integer()</v> <v>Ret = {ok, Key} | {error, Reason}</v> <v>Key = term()</v> diff --git a/lib/snmp/doc/src/snmpa_conf.xml b/lib/snmp/doc/src/snmpa_conf.xml index 99a56cd601..2780cec156 100644 --- a/lib/snmp/doc/src/snmpa_conf.xml +++ b/lib/snmp/doc/src/snmpa_conf.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2006</year><year>2013</year> + <year>2006</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -45,20 +45,56 @@ <title>DATA TYPES</title> <code type="none"><![CDATA[ transportDomain() = transportDomainUdpIpv4 | transportDomainUdpIpv6 -transportAddressIPv4() = [integer()], length 4 -transportAddressIPv6() = [integer()], length 8 -transportAddressMask() = [integer()], length 0 (default), 6 (IPv4) or 10 (IPv6) + +transportAddress() = + transportAddressIPv4() | transportAddressIPv6() + +transportAddressWithPort() = + transportAddressIPv4WithPort() | transportAddressIPv6WithPort() + +transportAddressWithoutPort() = + transportAddressIPv4WithoutPort() | transportAddressIPv6WithoutPort() + +transportAddressIPv4() = + transportAddressIPv4WithPort() | transportAddressIPv4WithoutPort() +transportAddressIPv4WithPort = + {transportAddressIPv4WithoutPort(), inet:port_number()} | + [byte() x 4, byte() x 2] +transportAddressIPv4WithoutPort = + inet:ip4_address() | [byte() x 4] + +transportAddressIPv6() = + transportAddressIPv6WithPort() | transportAddressIPv6WithoutPort() +transportAddressIPv6WithPort = + {transportAddressIPv6WithoutPort(), inet:port_number()} | + [word() x 8, inet:port_number()] | + [word() x 8, byte() x 2] | + {byte() x 16, byte() x 2] +transportAddressIPv6WithoutPort = + inet:ip6_address() | [word() x 8] | [byte() x 16] + +transportAddressMask() = + [] | transportAddressWithPort() + +byte() = 0..255 +word() = 0..65535 ]]></code> + <p>For <c>inet:ip4_address()</c>, <c>inet:ip6_address()</c> + and <c>inet:port_number()</c>, see also + <seealso marker="kernel:inet#type-ip_address"> + <c>inet:ip_address()</c></seealso></p> <marker id="agent_entry"></marker> </section> + + <funcs> <func> <name>agent_entry(Tag, Val) -> agent_entry()</name> <fsummary>Create an agent entry</fsummary> <type> - <v>Tag = intAgentIpAddress | intAgentUDPPort | intAgentMaxPacketSize | snmpEngineMaxMessageSize | snmpEngineID</v> + <v>Tag = intAgentTransports | intAgentUDPPort | intAgentMaxPacketSize | snmpEngineMaxMessageSize | snmpEngineID</v> <v>Val = term()</v> <v>agent_entry() = term()</v> </type> @@ -390,17 +426,15 @@ transportAddressMask() = [integer()], length 0 (default), 6 (IPv4) or 10 (IPv6) </func> <func> - <name>target_addr_entry(Name, Ip, TagList, ParamsName, EngineId) -> target_addr_entry()</name> - <name>target_addr_entry(Name, Ip, TagList, ParamsName, EngineId, TMask) -> target_addr_entry()</name> - <name>target_addr_entry(Name, Ip, Udp, TagList, ParamsName, EngineId, TMask, MaxMessageSize) -> target_addr_entry()</name> - <name>target_addr_entry(Name, Ip, Udp, Timeout, RetryCount, TagList, ParamsName, EngineId, TMask, MaxMessageSize) -> target_addr_entry()</name> - <name>target_addr_entry(Name, Domain, Ip, Udp, Timeout, RetryCount, TagList, ParamsName, EngineId, TMask, MaxMessageSize) -> target_addr_entry()</name> + <name>target_addr_entry(Name, Domain, Addr, TagList, ParamsName, EngineId) -> target_addr_entry()</name> + <name>target_addr_entry(Name, Domain, Addr, TagList, ParamsName, EngineId, TMask) -> target_addr_entry()</name> + <name>target_addr_entry(Name, Domain, Addr, TagList, ParamsName, EngineId, TMask, MaxMessageSize) -> target_addr_entry()</name> + <name>target_addr_entry(Name, Domain, Addr, Timeout, RetryCount, TagList, ParamsName, EngineId, TMask, MaxMessageSize) -> target_addr_entry()</name> <fsummary>Create an target_addr entry</fsummary> <type> <v>Name = string()</v> <v>Domain = transportDomain()</v> - <v>Ip = transportAddressIPv4() | transportAddressIPv6() (depends on Domain)</v> - <v>Udp = integer()</v> + <v>Ip = transportAddress() (depends on Domain)</v> <v>Timeout = integer()</v> <v>RetryCount = integer()</v> <v>TagList = string()</v> @@ -414,12 +448,12 @@ transportAddressMask() = [integer()], length 0 (default), 6 (IPv4) or 10 (IPv6) <p>Create an entry for the agent target_addr config file, <c>target_addr.conf</c>. </p> <p><c>Name</c> must be a <em>non-empty</em> string. </p> - <p><c>target_addr_entry/5</c> translates to the following call: - <c>target_addr_entry(Name, Ip, TagList, ParamsName, EngineId)</c>. </p> <p><c>target_addr_entry/6</c> translates to the following call: - <c>target_addr_entry(Name, Ip, 162, TagList, ParamsName, EngineId, TMask, 2048)</c>. </p> + <c>target_addr_entry(Name, Domain, Addr, TagList, ParamsName, EngineId, [])</c>. </p> + <p><c>target_addr_entry/7</c> translates to the following call: + <c>target_addr_entry(Name, Domain, Addr, TagList, ParamsName, EngineId, TMask, 2048)</c>. </p> <p><c>target_addr_entry/8</c> translates to the following call: - <c>target_addr_entry(Name, Ip, Udp, 1500, 3, TagList, ParamsName, EngineId, TMask, MaxMessageSize)</c>. </p> + <c>target_addr_entry(Name, Domain, Addr, 1500, 3, TagList, ParamsName, EngineId, TMask, MaxMessageSize)</c>. </p> <p>See <seealso marker="snmp_agent_config_files#target_addr">Target Address Definitions</seealso> for more info. </p> diff --git a/lib/snmp/doc/src/snmpa_mpd.xml b/lib/snmp/doc/src/snmpa_mpd.xml index c5ab0a0520..518100d30c 100644 --- a/lib/snmp/doc/src/snmpa_mpd.xml +++ b/lib/snmp/doc/src/snmpa_mpd.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -43,6 +43,12 @@ <marker id="init"></marker> </description> + <section> + <title>DATA TYPES</title> + <p>See the <seealso marker="snmpa_conf#types"> + data types in <c>snmpa_conf</c></seealso>.</p> + </section> + <funcs> <func> <name>init(Vsns) -> mpd_state()</name> @@ -63,16 +69,17 @@ </func> <func> - <name>process_packet(Packet, TDomain, TAddress, State, NoteStore, Log) -> {ok, Vsn, Pdu, PduMS, ACMData} | {discarded, Reason} | {discovery, DiscoPacket}</name> - <name>process_packet(Packet, TDomain, TAddress, LocalEngineID, State, NoteStore, Log) -> {ok, Vsn, Pdu, PduMS, ACMData} | {discarded, Reason} | {discovery, DiscoPacket}</name> + <name>process_packet(Packet, From, State, NoteStore, Log) -> {ok, Vsn, Pdu, PduMS, ACMData} | {discarded, Reason} | {discovery, DiscoPacket}</name> + <name>process_packet(Packet, From, LocalEngineID, State, NoteStore, Log) -> {ok, Vsn, Pdu, PduMS, ACMData} | {discarded, Reason} | {discovery, DiscoPacket}</name> <fsummary>Process a packet received from the network</fsummary> <type> <v>Packet = binary()</v> - <v>TDomain = snmpUDPDomain</v> - <v>TAddress = {Ip, Udp}</v> + <v>From = {TDomain, TAddr}</v> + <v>TDomain = transportDomainUdpIpv4 | transportDomainUdpIpv6</v> + <v>TAddr = {IpAddr, IpPort}</v> <v>LocalEngineID = string()</v> - <v>Ip = {integer(), integer(), integer(), integer()}</v> - <v>Udp = integer()</v> + <v>IpAddr = <seealso marker="kernel:inet#type-ip_address">inet:ip_address()</seealso></v> + <v>IpPort = inet:port_number()</v> <v>State = mpd_state()</v> <v>NoteStore = pid()</v> <v>Log = snmp_log()</v> @@ -85,7 +92,7 @@ </type> <desc> <p>Processes an incoming packet. Performs authentication and - decryption as necessary. The return values should be passed the + decryption as necessary. The return values should be passed to the agent.</p> <note> @@ -150,14 +157,20 @@ network. </p> <p><c>MsgData</c> is the message specific data used in - the SNMP message. This value is received in a <c>send_pdu</c> - or <c>send_pdu_req</c> message from the agent. In SNMPv1 and + the SNMP message. This value is received in a + <seealso marker="snmp_agent_netif#im_send_pdu"><c>send_pdu</c></seealso> + or + <seealso marker="snmp_agent_netif#im_send_pdu_req"> + <c>send_pdu_req</c></seealso> + message from the agent. In SNMPv1 and SNMPv2c, this message data is the community string. In - SNMPv3, it is the context information. - <c>To</c> is a list of the destination addresses and + SNMPv3, it is the context information.</p> + <p> + <c>To</c> is a list of destination addresses and their corresponding security parameters. This value is - also received from the requests mentioned above. - </p> + received in the same message from the agent and then transformed + trough <seealso marker="#process_taddrs"><c>process_taddrs</c></seealso> + before passed to this function.</p> <note> <p>Note that the use of the LocalEngineID argument is only intended @@ -166,6 +179,32 @@ (see SNMP-FRAMEWORK-MIB). </p> </note> + <marker id="process_taddrs"></marker> + </desc> + </func> + + <func> + <name>process_taddrs(TDests) -> Dests</name> + <fsummary>Transform addresses from internal MIB format to a less internal + </fsummary> + <type> + <v>TDests = [TDest]</v> + <v>TDest = {{TDomain, TAddr}, SecData} | {TDomain, TAddr}</v> + <v>TDomain = term() % Not at tuple</v> + <v>TAddr = term()</v> + <v>SecData = term()</v> + <v>Dests = [Dest]</v> + <v>Dest = {{Domain, Addr}, SecData} | {Domain, Addr}</v> + <v>Domain = transportDomain()</v> + <v>Addr = transportAddress() % Depends on Domain</v> + </type> + <desc> + <p>Transforms addresses from internal MIB format to one + more useful to <seealso marker="snmp_agent_netif">Agent Net if</seealso>. + </p> + <p>See also <seealso marker="#generate_msg"><c>generate_msg</c>.</seealso> + </p> + <marker id="discarded_pdu"></marker> </desc> </func> diff --git a/lib/snmp/doc/src/snmpa_network_interface_filter.xml b/lib/snmp/doc/src/snmpa_network_interface_filter.xml index e08a26ed92..eb640e1bc3 100644 --- a/lib/snmp/doc/src/snmpa_network_interface_filter.xml +++ b/lib/snmp/doc/src/snmpa_network_interface_filter.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2007</year><year>2013</year> + <year>2007</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -58,10 +58,10 @@ on two levels: </p> <list type="bulleted"> <item> - <p>The first level is at the UDP entry / exit point, i.e. - immediately after the receipt of the message, before any message + <p>The first level is at the transport entry / exit point, i.e. + immediately after the receipt of the message before any message processing is done (accept_recv) and - immediately before sending the message, after all message + immediately before sending the message after all message processing is done (accept_send).</p> </item> <item> @@ -78,6 +78,12 @@ <seealso marker="snmp_app#configuration_params">req_limit</seealso> and the function <seealso marker="snmpa#register_notification_filter">register_notification_filter</seealso>. </p> + <p>Legacy network interface filter modules used arguments on the form + <c>(IpAddr, PortNumber,...)</c> instead of + <c>(Domain, Addr, ...)</c>, and if the SNMP agent is run without + changing the configuration to use transport domains + the network interface filter will still get + the old arguments and work as before.</p> </description> <section> @@ -88,15 +94,17 @@ pdu_type() = 'get-request' | 'get-next-request' | 'get-response' | 'set-request' | trap | 'get-bulk-request' | 'inform-request' | report </code> + <p>See also the <seealso marker="snmpa_conf#types"> + data types in <c>snmpa_conf</c></seealso>.</p> <marker id="accept_recv"></marker> </section> <funcs> <func> - <name>accept_recv(Ip, Port) -> boolean()</name> + <name>accept_recv(Domain, Addr) -> boolean()</name> <fsummary>Shall the received message be accepted</fsummary> <type> - <v>Ip = ip_address()</v> - <v>Port = port()</v> + <v>Domain = transportDomain()</v> + <v>Addr = transportAddressWithPort()</v> </type> <desc> <p>Called at the reception of a message (before <em>any</em> processing @@ -107,11 +115,11 @@ pdu_type() = 'get-request' | 'get-next-request' | 'get-response' | </desc> </func> <func> - <name>accept_send(Ip, Port) -> boolean()</name> + <name>accept_send(Domain, Addr) -> boolean()</name> <fsummary>Shall the message be sent</fsummary> <type> - <v>Ip = ip_address()</v> - <v>Port = port()</v> + <v>Domain = transportDomain()</v> + <v>Addr = transportAddressWithPort()</v> </type> <desc> <p>Called before the sending of a message (after <em>all</em> processing @@ -122,11 +130,11 @@ pdu_type() = 'get-request' | 'get-next-request' | 'get-response' | </desc> </func> <func> - <name>accept_recv_pdu(Ip, Port, PduType) -> boolean()</name> + <name>accept_recv_pdu(Domain, Addr, PduType) -> boolean()</name> <fsummary>Shall the received pdu be accepted</fsummary> <type> - <v>Ip = ip_address()</v> - <v>Port = port()</v> + <v>Domain = transportDomain()</v> + <v>Addr = transportAddressWithPort()</v> <v>PduType = pdu_type()</v> </type> <desc> @@ -144,7 +152,9 @@ pdu_type() = 'get-request' | 'get-next-request' | 'get-response' | <type> <v>Targets = targets()</v> <v>targets() = [target()]</v> - <v>target() = {ip_address(), port()}</v> + <v>target() = {Domain, Addr}</v> + <v>Domain = transportDomain()</v> + <v>Addr = transportAddressWithPort()</v> <v>PduType = pdu_type() > 0</v> <v>Reply = boolean() | NewTargets</v> <v>NewTargets = targets()</v> @@ -155,7 +165,7 @@ pdu_type() = 'get-request' | 'get-next-request' | 'get-response' | <p>For the message to be discarded all together, the function <em>must</em> return <em>false</em>. </p> <p>Note that it is possible for this function to filter out targets - (but <em>not</em> add its own) by returning an updated + (but <em>not</em> to add its own) by returning an updated <c>Targets</c> list (<c>NewTargets</c>). </p> </desc> </func> diff --git a/lib/snmp/doc/src/snmpa_notification_delivery_info_receiver.xml b/lib/snmp/doc/src/snmpa_notification_delivery_info_receiver.xml index aff71688b6..814f02a14c 100644 --- a/lib/snmp/doc/src/snmpa_notification_delivery_info_receiver.xml +++ b/lib/snmp/doc/src/snmpa_notification_delivery_info_receiver.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2008</year> - <year>2013</year> + <year>2014</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -45,22 +45,30 @@ must export the following functions: </p> <list type="bulleted"> <item> - <p><seealso marker="#delivery_targets">delivery_targets/3</seealso></p> + <p><seealso marker="#delivery_targets/3">delivery_targets/3</seealso></p> </item> <item> - <p><seealso marker="#delivery_info">delivery_info/4</seealso></p> + <p><seealso marker="#delivery_info/4">delivery_info/4</seealso></p> </item> </list> <p>The semantics of them and their exact signatures are explained below. </p> + <p>Legacy notification delivery information receiver modules + used a target argument on the form + <c>{IpAddr, PortNumber}</c> instead of + <c>{Domain, Addr}</c>, and if the SNMP Agent is run without + changing the configuration to use transport domains + the notification delivery information receiver will still get + the old arguments and work as before.</p> + </description> <section> <title>DATA TYPES</title> - <code type="none"><![CDATA[ -address() = A 4-tuple - ]]></code> + <p>See the <seealso marker="snmpa_conf#types"> + data types in <c>snmpa_conf</c></seealso>.</p> + <marker id="accept_recv"></marker> <marker id="delivery_targets"></marker> </section> @@ -71,10 +79,8 @@ address() = A 4-tuple <fsummary>Inform about target addresses</fsummary> <type> <v>Tag = term()</v> - <v>Targets = [target()]</v> - <v>target() = {Address, Port}</v> - <v>Address = address()</v> - <v>Port = integer()</v> + <v>Targets = [Target]</v> + <v>Target = {transportDomain(), transportAddressWithPort()</v> <v>Extra = term()</v> </type> <desc> @@ -94,10 +100,8 @@ address() = A 4-tuple <fsummary>Inform about delivery result</fsummary> <type> <v>Tag = term()</v> - <v>Target = target()</v> - <v>target() = {Address, Port}</v> - <v>Address = address()</v> - <v>Port = integer()</v> + <v>Targets = [Target]</v> + <v>Target = {transportDomain(), transportAddressWithPort()</v> <v>DeliveryResult = delivery_result()</v> <v>delivery_result() = no_response | got_response</v> <v>Extra = term()</v> diff --git a/lib/snmp/doc/src/snmpm.xml b/lib/snmp/doc/src/snmpm.xml index dc8226bb87..ff90e49968 100644 --- a/lib/snmp/doc/src/snmpm.xml +++ b/lib/snmp/doc/src/snmpm.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2004</year><year>2013</year> + <year>2004</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -69,6 +69,9 @@ sec_name() = string() sec_level() = noAuthNoPriv | authNoPriv | authPriv ]]></code> + <p>See also the <seealso marker="snmpa_conf#types"> + data types in <c>snmpa_conf</c></seealso>.</p> + <marker id="monitor"></marker> </section> <funcs> @@ -300,9 +303,9 @@ sec_level = noAuthNoPriv | authNoPriv | authPriv <p>The type of <c>Val</c> depends on <c>Item</c>: </p> <code type="none"><![CDATA[ [mandatory] engine_id = string() -[mandatory] address = ip_address() -[optional] port = integer() -[optional] tdomain = transportDomainUdpIpv4 | transportDomainUdpIpv6 +[mandatory] tadress = transportAddress() % Depends on tdomain +[optional] port = inet:port_number() +[optional] tdomain = transportDomain() [optional] community = string() [optional] timeout = integer() | snmp_timer() [optional] max_message_size = integer() @@ -313,7 +316,8 @@ sec_level = noAuthNoPriv | authNoPriv | authPriv ]]></code> <p>Note that if no <c>tdomain</c> is given, the default value, <c>transportDomainUdpIpv4</c>, is used.</p> - <p>Note that if no <c>port</c> is given, the default value is used.</p> + <p>Note that if no <c>port</c> is given and if <c>taddress</c> does not + contain a port number, the default value is used.</p> <marker id="unregister_agent"></marker> </desc> diff --git a/lib/snmp/doc/src/snmpm_conf.xml b/lib/snmp/doc/src/snmpm_conf.xml index 0cc9ff3379..8635fb705b 100644 --- a/lib/snmp/doc/src/snmpm_conf.xml +++ b/lib/snmp/doc/src/snmpm_conf.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2006</year><year>2013</year> + <year>2006</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -195,14 +195,14 @@ </desc> </func> <func> - <name>agents_entry(UserId, TargetName, Comm, Ip, Port, EngineID, Timeout, MaxMessageSize, Version, SecModel, SecName, SecLevel) -> agents_entry()</name> + <name>agents_entry(UserId, TargetName, Comm, Domain, Addr, EngineID, Timeout, MaxMessageSize, Version, SecModel, SecName, SecLevel) -> agents_entry()</name> <fsummary>Create an agents entry</fsummary> <type> <v>UserId = term()</v> <v>TargetName = string()</v> <v>Comm = string()</v> - <v>Ip = string()</v> - <v>Port = integer()</v> + <v>Domain = transportDomain()</v> + <v>Addr = transportAddress()</v> <v>EngineID = string()</v> <v>Timeout = integer()</v> <v>MaxMessageSize = integer()</v> diff --git a/lib/snmp/doc/src/snmpm_mpd.xml b/lib/snmp/doc/src/snmpm_mpd.xml index ad72fd7bc0..c23b2b6833 100644 --- a/lib/snmp/doc/src/snmpm_mpd.xml +++ b/lib/snmp/doc/src/snmpm_mpd.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2004</year><year>2013</year> + <year>2004</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -39,7 +39,12 @@ It is supposed to be used from a Network Interface process (<seealso marker="snmp_manager_netif">Definition of Manager Net if</seealso>). </p> + + <p>Legacy API function <c>process_msg/7</c> that has got separate + <c>IpAddr</c> and <c>PortNumber</c> arguments still works as before + for backwards compatibility reasons.</p> </description> + <funcs> <func> <name>init_mpd(Vsns) -> mpd_state()</name> @@ -58,13 +63,12 @@ </desc> </func> <func> - <name>process_msg(Msg, TDomain, Addr, Port, State, NoteStore, Logger) -> {ok, Vsn, Pdu, PduMS, MsgData} | {discarded, Reason}</name> + <name>process_msg(Msg, Domain, Addr, State, NoteStore, Logger) -> {ok, Vsn, Pdu, PduMS, MsgData} | {discarded, Reason}</name> <fsummary>Process a message received from the network</fsummary> <type> <v>Msg = binary()</v> - <v>TDomain = snmpUDPDomain</v> - <v>Addr = {integer(), integer(), integer(), integer()}</v> - <v>Port = integer()</v> + <v>Domain = transportDomainUdpIpv4 | transportDomainUdpIpv6</v> + <v>Addr = {<seealso marker="kernel:inet#type-ip_address">inet:ip_address(), inet:port_number()</seealso>} </v> <v>State = mpd_state()</v> <v>NoteStore = pid()</v> <v>Logger = function()</v> diff --git a/lib/snmp/doc/src/snmpm_network_interface.xml b/lib/snmp/doc/src/snmpm_network_interface.xml index 6cf7bd6ed7..bea6b46dc7 100644 --- a/lib/snmp/doc/src/snmpm_network_interface.xml +++ b/lib/snmp/doc/src/snmpm_network_interface.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2004</year><year>2013</year> + <year>2004</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -69,6 +69,10 @@ <p>The semantics of them and their exact signatures are explained below. </p> + <p>Legacy API function <c>send_pdu/7</c> that has got separate + <c>IpAddr</c> and <c>PortNumber</c> arguments still works as before + for backwards compatibility reasons.</p> + <marker id="start_link"></marker> </description> @@ -103,15 +107,15 @@ </func> <func> - <name>send_pdu(Pid, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo) -> void()</name> + <name>send_pdu(Pid, Pdu, Vsn, MsgData, Domain, Addr, ExtraInfo) -> void()</name> <fsummary>Request the network interface process to send this pdu</fsummary> <type> <v>Pid = pid()</v> <v>Pdu = pdu()</v> <v>Vsn = 'version-1' | 'version-2' | 'version-3'</v> <v>MsgData = term()</v> - <v>Addr = address()</v> - <v>Port = integer()</v> + <v>Domain = transportDomainUdpIpv4 | transportDomainUdpIpv6</v> + <v>Addr = {<seealso marker="kernel:inet#type-ip_address">inet:ip_address(), inet:port_number()</seealso>} </v> <v>ExtraInfo = term()</v> </type> <desc> diff --git a/lib/snmp/doc/src/snmpm_network_interface_filter.xml b/lib/snmp/doc/src/snmpm_network_interface_filter.xml index f0526269b3..1ef4f29c0f 100644 --- a/lib/snmp/doc/src/snmpm_network_interface_filter.xml +++ b/lib/snmp/doc/src/snmpm_network_interface_filter.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2007</year><year>2013</year> + <year>2007</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -76,6 +76,12 @@ The default filter accepts all messages.</p> <p>A network interface filter can e.g. be used during testing or for load regulation. </p> + <p>Legacy network interface filter modules used arguments on the form + <c>(IpAddr, PortNumber,...)</c> instead of + <c>(Domain, Addr, ...)</c>, and if the SNMP manager is run without + changing the configuration to use transport domains + the network interface filter will still get + the old arguments and work as before.</p> </description> <section> @@ -86,16 +92,18 @@ pdu_type() = 'get-request' | 'get-next-request' | 'get-response' | 'set-request' | trap | 'get-bulk-request' | 'inform-request' | report | trappdu </code> + <p>See also the <seealso marker="snmpa_conf#types"> + data types in <c>snmpa_conf</c></seealso>.</p> <marker id="accept_recv"></marker> </section> <funcs> <func> - <name>accept_recv(Addr, Port) -> boolean()</name> + <name>accept_recv(Domain, Addr) -> boolean()</name> <fsummary>Shall the received message be accepted</fsummary> <type> - <v>Addr = ip_address()</v> - <v>Port = port()</v> + <v>Domain = transportDomain()</v> + <v>Addr = transportAddressWithPort()</v> </type> <desc> <p>Called at the reception of a message (before <em>any</em> processing @@ -107,11 +115,11 @@ pdu_type() = 'get-request' | 'get-next-request' | 'get-response' | </func> <func> - <name>accept_send(Addr, Port) -> boolean()</name> + <name>accept_send(Domain, Addr) -> boolean()</name> <fsummary>Shall the message be sent</fsummary> <type> - <v>Addr = ip_address()</v> - <v>Port = port()</v> + <v>Domain = transportDomain()</v> + <v>Addr = transportAddressWithPort()</v> </type> <desc> <p>Called before the sending of a message (after <em>all</em> processing @@ -123,11 +131,11 @@ pdu_type() = 'get-request' | 'get-next-request' | 'get-response' | </func> <func> - <name>accept_recv_pdu(Addr, Port, PduType) -> boolean()</name> + <name>accept_recv_pdu(Domain, Addr, PduType) -> boolean()</name> <fsummary>Shall the received pdu be accepted</fsummary> <type> - <v>Addr = ip_address()</v> - <v>Port = port()</v> + <v>Domain = transportDomain()</v> + <v>Addr = transportAddressWithPort()</v> <v>PduType = pdu_type()</v> </type> <desc> @@ -141,11 +149,11 @@ pdu_type() = 'get-request' | 'get-next-request' | 'get-response' | </func> <func> - <name>accept_send_pdu(Addr, Port, PduType) -> boolean()</name> + <name>accept_send_pdu(Domain, Addr, PduType) -> boolean()</name> <fsummary>Shall the pdu be sent</fsummary> <type> - <v>Addr = ip_address()</v> - <v>Port = port()</v> + <v>Domain = transportDomain()</v> + <v>Addr = transportAddressWithPort()</v> <v>PduType = pdu_type() > 0</v> </type> <desc> diff --git a/lib/snmp/doc/src/snmpm_user.xml b/lib/snmp/doc/src/snmpm_user.xml index 6f412d90f8..a4492839cd 100644 --- a/lib/snmp/doc/src/snmpm_user.xml +++ b/lib/snmp/doc/src/snmpm_user.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2004</year><year>2013</year> + <year>2004</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -63,10 +63,15 @@ <p>The semantics of them and their exact signatures are explained below. </p> <p>Some of the function has no defined return value (<c>void()</c>), - they can ofcourse return anythyng. But the functions that do have + they can of course return anything. But the functions that do have specified return value(s) <em>must</em> adhere to this. None of the functions can use exit of throw to return. </p> + <p>If the manager is not configured to use any particular + transport domain, the behaviour <c>handle_agent/4</c> + will for backwards copmpatibility reasons be called with the old + <c>IpAddr</c> and <c>PortNumber</c> arguments</p> + <marker id="types"></marker> </description> @@ -116,11 +121,11 @@ snmp_v1_trap_info() :: {Enteprise :: snmp:oid(), </func> <func> - <name>handle_agent(Addr, Port, Type, SnmpInfo, UserData) -> Reply</name> + <name>handle_agent(Domain, Addr, Type, SnmpInfo, UserData) -> Reply</name> <fsummary>Handle agent</fsummary> <type> - <v>Addr = ip_address()</v> - <v>Port = integer()</v> + <v>Domain = transportDomainUdpIpv4 | transportDomainUdpIpv6</v> + <v>Addr = {<seealso marker="kernel:inet#type-ip_address">inet:ip_address(), inet:port_number()</seealso>} </v> <v>Type = pdu | trap | report | inform</v> <v>SnmpInfo = SnmpPduInfo | SnmpTrapInfo | SnmpReportInfo | SnmpInformInfo</v> <v>SnmpPduInfo = snmp_gen_info()</v> diff --git a/lib/snmp/src/agent/snmp_community_mib.erl b/lib/snmp/src/agent/snmp_community_mib.erl index 7bdd500727..4546c343b7 100644 --- a/lib/snmp/src/agent/snmp_community_mib.erl +++ b/lib/snmp/src/agent/snmp_community_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. All Rights Reserved. %% %% The 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,7 @@ -include("snmpa_internal.hrl"). -include("SNMP-COMMUNITY-MIB.hrl"). -include("SNMP-TARGET-MIB.hrl"). +-include("SNMPv2-TM.hrl"). -include("SNMPv2-TC.hrl"). -include("snmp_types.hrl"). @@ -129,10 +130,11 @@ read_community_config_files(Dir) -> [FileName, D, Reason]), ok end, - Filter = fun(Comms) -> Comms end, - Check = fun(Entry) -> check_community(Entry) end, + Order = fun snmp_conf:no_order/2, + Filter = fun snmp_conf:no_filter/1, + Check = fun(Entry, State) -> {check_community(Entry), State} end, [Comms] = - snmp_conf:read_files(Dir, [{Gen, Filter, Check, "community.conf"}]), + snmp_conf:read_files(Dir, [{FileName, Gen, Order, Check, Filter}]), Comms. check_community({Index, CommunityName, SecName, CtxName, TransportTag}) -> @@ -192,7 +194,7 @@ add_community(Idx, CommName, SecName, EngineId, CtxName, TransportTag) -> do_add_community(Community). do_add_community(Community) -> - case (catch check_community(Community)) of + try check_community(Community) of {ok, Row} -> Key = element(1, Row), case table_cre_row(snmpCommunityTable, Key, Row) of @@ -201,11 +203,12 @@ do_add_community(Community) -> {ok, Key}; false -> {error, create_failed} - end; + end + catch {error, Reason} -> {error, Reason}; - Error -> - {error, Error} + Class:Reason -> + {error, {Class, Reason, erlang:get_stacktrace()}} end. %% FIXME: does not work with mnesia @@ -243,6 +246,10 @@ gc_tabs() -> %%----------------------------------------------------------------- community2vacm(Community, Addr) -> Idxs = ets:lookup(snmp_community_cache, Community), + ?vtrace("community2vacm ->~n" + " Community: ~p~n" + " Addr: ~p~n" + " Idxs: ~p", [Community, Addr, Idxs]), loop_c2v_rows(lists:keysort(2, Idxs), Addr). loop_c2v_rows([{_, CommunityIndex} | T], Addr) -> @@ -250,6 +257,9 @@ loop_c2v_rows([{_, CommunityIndex} | T], Addr) -> "~n CommunityIndex: ~p", [CommunityIndex]), case get_row(CommunityIndex) of {_Community, VacmParams, Tag} -> + ?vtrace("loop_c2v_rows ->~n" + " VacmParams: ~p~n" + " Tag: ~p", [VacmParams, Tag]), {TDomain, TAddr} = Addr, case snmp_target_mib:is_valid_tag(Tag, TDomain, TAddr) of true -> @@ -506,7 +516,12 @@ snmpTargetAddrExtTable(get_next, RowIndex, Cols) -> NCols = conv1(Cols), conv2(next(snmpTargetAddrExtTable, RowIndex, NCols)); snmpTargetAddrExtTable(set, RowIndex, Cols0) -> - case (catch verify_snmpTargetAddrExtTable_cols(Cols0, [])) of + case + (catch verify_snmpTargetAddrExtTable_cols( + Cols0, + get_snmpTargetAddrTDomain(RowIndex, Cols0), + [])) + of {ok, Cols} -> NCols = conv3(Cols), snmp_generic:table_func(set, RowIndex, NCols, @@ -515,7 +530,11 @@ snmpTargetAddrExtTable(set, RowIndex, Cols0) -> Error end; snmpTargetAddrExtTable(is_set_ok, RowIndex, Cols0) -> - case (catch verify_snmpTargetAddrExtTable_cols(Cols0, [])) of + case (catch verify_snmpTargetAddrExtTable_cols( + Cols0, + get_snmpTargetAddrTDomain(RowIndex, Cols0), + [])) + of {ok, Cols} -> NCols = conv3(Cols), snmp_generic:table_func(is_set_ok, RowIndex, NCols, @@ -525,29 +544,49 @@ snmpTargetAddrExtTable(is_set_ok, RowIndex, Cols0) -> end. -verify_snmpTargetAddrExtTable_cols([], Cols) -> + +get_snmpTargetAddrTDomain(RowIndex, Col) -> + case + get( + snmpTargetAddrTable, RowIndex, + [?snmpTargetAddrRowStatus,?snmpTargetAddrTDomain]) + of + [{value,?snmpTargetAddrRowStatus_active},ValueTDomain] -> + case ValueTDomain of + {value,TDomain} -> + TDomain; + _ -> + ?snmpUDPDomain + end; + _ -> + wrongValue(Col) + end. + + + +verify_snmpTargetAddrExtTable_cols([], _TDomain, Cols) -> {ok, lists:reverse(Cols)}; -verify_snmpTargetAddrExtTable_cols([{Col, Val0}|Cols], Acc) -> - Val = verify_snmpTargetAddrExtTable_col(Col, Val0), - verify_snmpTargetAddrExtTable_cols(Cols, [{Col, Val}|Acc]). +verify_snmpTargetAddrExtTable_cols([{Col, Val0}|Cols], TDomain, Acc) -> + Val = verify_snmpTargetAddrExtTable_col(Col, TDomain, Val0), + verify_snmpTargetAddrExtTable_cols(Cols, TDomain, [{Col, Val}|Acc]). -verify_snmpTargetAddrExtTable_col(?snmpTargetAddrTMask, []) -> +verify_snmpTargetAddrExtTable_col(?snmpTargetAddrTMask, _TDomain, []) -> []; -verify_snmpTargetAddrExtTable_col(?snmpTargetAddrTMask, TMask) -> - case (catch snmp_conf:check_taddress(TMask)) of +verify_snmpTargetAddrExtTable_col(?snmpTargetAddrTMask, TDomain, TMask) -> + case (catch snmp_conf:check_taddress(TDomain, TMask)) of ok -> TMask; _ -> wrongValue(?snmpTargetAddrTMask) end; -verify_snmpTargetAddrExtTable_col(?snmpTargetAddrMMS, MMS) -> +verify_snmpTargetAddrExtTable_col(?snmpTargetAddrMMS, _TDomain, MMS) -> case (catch snmp_conf:check_packet_size(MMS)) of ok -> MMS; _ -> wrongValue(?snmpTargetAddrMMS) end; -verify_snmpTargetAddrExtTable_col(_, Val) -> +verify_snmpTargetAddrExtTable_col(_, _TDomain, Val) -> Val. db(snmpTargetAddrExtTable) -> db(snmpTargetAddrTable); @@ -583,6 +622,7 @@ conv3([{Idx, Val}|T]) -> [{Idx+10, Val} | conv3(T)]; conv3([]) -> []. + get(Name, RowIndex, Cols) -> snmp_generic:handle_table_get(db(Name), RowIndex, Cols, foi(Name)). diff --git a/lib/snmp/src/agent/snmp_framework_mib.erl b/lib/snmp/src/agent/snmp_framework_mib.erl index cc191bd956..6ff9224d34 100644 --- a/lib/snmp/src/agent/snmp_framework_mib.erl +++ b/lib/snmp/src/agent/snmp_framework_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. All Rights Reserved. %% %% The 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 @@ -compile({no_auto_import,[error/1]}). -export([init/0, configure/1]). -export([intContextTable/1, intContextTable/3, + intAgentTransportDomain/1, intAgentTransports/1, intAgentUDPPort/1, intAgentIpAddress/1, snmpEngineID/1, snmpEngineBoots/1, @@ -51,7 +52,7 @@ set_engine_boots/1, set_engine_time/1, table_next/2, check_status/3]). -export([add_context/1, delete_context/1]). --export([check_agent/1, check_context/1]). +-export([check_agent/2, check_context/1, order_agent/2]). %%----------------------------------------------------------------- @@ -115,54 +116,46 @@ do_configure(Dir) -> read_internal_config_files(Dir) -> ?vdebug("read context config file",[]), - Gen = fun(D, Reason) -> - convert_context(D, Reason) - end, - Filter = fun(Contexts) -> Contexts end, - Check = fun(Entry) -> check_context(Entry) end, - [Ctxs] = snmp_conf:read_files(Dir, [{Gen, Filter, Check, "context.conf"}]), + Gen = fun gen_context/2, + Order = fun snmp_conf:no_order/2, + Filter = fun snmp_conf:no_filter/1, + Check = fun(Entry, State) -> {check_context(Entry), State} end, + [Ctxs] = + snmp_conf:read_files + (Dir, [{"context.conf", Gen, Order, Check, Filter}]), Ctxs. - read_agent(Dir) -> ?vdebug("read agent config file", []), - FileName = "agent.conf", - Check = fun(Entry) -> check_agent(Entry) end, + FileName = "agent.conf", File = filename:join(Dir, FileName), - Agent = + Conf0 = try - snmp_conf:read(File, Check) + snmp_conf:read(File, fun order_agent/2, fun check_agent/2) catch throw:{error, Reason} -> error({failed_reading_config_file, Dir, FileName, Reason}) end, - sort_agent(Agent). - - -%%----------------------------------------------------------------- -%% Make sure that each mandatory agent attribute is present, and -%% provide default values for the other non-present attributes. -%%----------------------------------------------------------------- -sort_agent(L) -> - Mand = [{intAgentIpAddress, mandatory}, - {intAgentUDPPort, mandatory}, - {snmpEngineMaxMessageSize, mandatory}, - {snmpEngineID, mandatory}], - {ok, L2} = snmp_conf:check_mandatory(L, Mand), - lists:keysort(1, L2). + Mand = + [{intAgentTransports, mandatory}, + {snmpEngineMaxMessageSize, mandatory}, + {snmpEngineID, mandatory}], + {ok, Conf} = snmp_conf:check_mandatory(Conf0, Mand), + Conf. %%----------------------------------------------------------------- %% Generate a context.conf file. %%----------------------------------------------------------------- -convert_context(Dir, _Reason) -> +gen_context(Dir, _Reason) -> config_err("missing context.conf file => generating a default file", []), File = filename:join(Dir, "context.conf"), case file:open(File, [write]) of {ok, Fid} -> ok = io:format(Fid, "~s\n", [context_header()]), ok = io:format(Fid, "%% The default context\n\"\".\n", []), - file:close(Fid); + file:close(Fid), + []; {error, Reason} -> file:delete(File), error({failed_creating_file, File, Reason}) @@ -196,10 +189,50 @@ check_context(Context) -> %% Agent %% {Name, Value}. %%----------------------------------------------------------------- -check_agent({intAgentIpAddress, Value}) -> - snmp_conf:check_ip(Value); -check_agent({intAgentUDPPort, Value}) -> - snmp_conf:check_integer(Value); +check_agent(Entry, undefined) -> + check_agent(Entry, {snmp_target_mib:default_domain(), undefined}); +check_agent({intAgentTransportDomain, Domain}, {_, Port}) -> + {snmp_conf:check_domain(Domain), {Domain, Port}}; +check_agent({intAgentUDPPort, Port}, {Domain, _}) -> + ok = snmp_conf:check_port(Port), + {ok, {Domain, Port}}; +check_agent({intAgentIpAddress, _}, {_, undefined}) -> + error({missing_mandatory, intAgentUDPPort}); +check_agent({intAgentIpAddress = Tag, Ip} = Entry, {Domain, Port} = State) -> + {case snmp_conf:check_ip(Domain, Ip) of + ok -> + [Entry, + {intAgentTransports, [{Domain, {Ip, Port}}]}]; + {ok, FixedIp} -> + [{Tag, FixedIp}, + {intAgentTransports, [{Domain, {FixedIp, Port}}]}] + end, State}; +check_agent({intAgentTransports = Tag, Transports}, {_, Port} = State) + when is_list(Transports) -> + CheckedTransports = + [case Transport of + {Domain, Address} -> + case + case Port of + undefined -> + snmp_conf:check_address(Domain, Address); + _ -> + snmp_conf:check_address(Domain, Address, Port) + end + of + ok -> + Transport; + {ok, FixedAddress} -> + {Domain, FixedAddress} + end; + _ -> + error({bad_transport, Transport}) + end + || Transport <- Transports], + {{ok, {Tag, CheckedTransports}}, State}; +check_agent(Entry, State) -> + {check_agent(Entry), State}. + %% This one is kept for backwards compatibility check_agent({intAgentMaxPacketSize, Value}) -> snmp_conf:check_packet_size(Value); @@ -210,6 +243,14 @@ check_agent({snmpEngineID, Value}) -> check_agent(X) -> error({invalid_agent_attribute, X}). +%% Ordering function to sort intAgentTransportDomain first +%% hence before intAgentIpAddress. Sort other entries on the key. +order_agent(EntryA, EntryB) -> + snmp_conf:keyorder( + 1, EntryA, EntryB, + [intAgentTransportDomain, intAgentUDPPort | sort]). + + maybe_create_table(Name) -> case snmpa_local_db:table_exists(db(Name)) of @@ -382,6 +423,14 @@ intAgentUDPPort(Op) -> intAgentIpAddress(Op) -> snmp_generic:variable_func(Op, db(intAgentIpAddress)). +intAgentTransportDomain(Op) -> + snmp_generic:variable_func(Op, db(intAgentTransportDomain)). + +intAgentTransports(Op) -> + snmp_generic:variable_func(Op, db(intAgentTransports)). + + + snmpEngineID(print) -> VarAndValue = [{snmpEngineID, snmpEngineID(get)}], snmpa_mib_lib:print_variables(VarAndValue); diff --git a/lib/snmp/src/agent/snmp_generic.erl b/lib/snmp/src/agent/snmp_generic.erl index 06afa68d96..3195ca2500 100644 --- a/lib/snmp/src/agent/snmp_generic.erl +++ b/lib/snmp/src/agent/snmp_generic.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The 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,7 +414,12 @@ table_check_status(NameDb, Col, ?'RowStatus_createAndGo', RowIndex, Cols) -> % side effect free and we only use the result temporary. case catch snmpa_local_db:table_construct_row( NameDb, RowIndex, ?'RowStatus_createAndGo', Cols) of - {'EXIT', _} -> + {'EXIT', _Reason} -> + ?vtrace( + "failed construct row (createAndGo): " + " n Reason: ~p" + " n Stack: ~p", + [_Reason, erlang:get_stacktrace()]), {noCreation, Col}; % Bad RowIndex Row -> case lists:member(noinit, tuple_to_list(Row)) of @@ -431,7 +436,12 @@ table_check_status(NameDb, Col, ?'RowStatus_createAndWait', RowIndex, Cols) -> false -> case catch snmpa_local_db:table_construct_row( NameDb, RowIndex, ?'RowStatus_createAndGo', Cols) of - {'EXIT', _} -> + {'EXIT', _Reason} -> + ?vtrace( + "failed construct row (createAndWait): " + " n Reason: ~p" + " n Stack: ~p", + [_Reason, erlang:get_stacktrace()]), {noCreation, Col}; % Bad RowIndex _Row -> {noError, 0} @@ -711,7 +721,19 @@ find_col(Col, [_H | T]) -> find_col(Col, T). try_apply(nofunc, _) -> {noError, 0}; -try_apply(F, Args) -> apply(F, Args). +try_apply(F, Args) -> maybe_verbose_apply(F, Args). + +maybe_verbose_apply(M, Args) -> + case get(verbosity) of + false -> + apply(M, Args); + _ -> + ?vlog("~n apply: ~w,~p~n", [M,Args]), + Res = apply(M,Args), + ?vlog("~n returned: ~p", [Res]), + Res + end. + table_info({Name, _Db}) -> case snmpa_symbolic_store:table_info(Name) of diff --git a/lib/snmp/src/agent/snmp_notification_mib.erl b/lib/snmp/src/agent/snmp_notification_mib.erl index 37e09f5d3e..31c7735226 100644 --- a/lib/snmp/src/agent/snmp_notification_mib.erl +++ b/lib/snmp/src/agent/snmp_notification_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2012. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -106,17 +106,19 @@ do_reconfigure(Dir) -> read_notify_config_files(Dir) -> ?vdebug("read notify config file",[]), FileName = "notify.conf", - Gen = fun(D, Reason) -> - info_msg("failed reading config file ~s" - "~n Config Dir: ~s" - "~n Reason: ~p", - [FileName, D, Reason]), - ok - end, - Filter = fun(Notifs) -> Notifs end, - Check = fun(Entry) -> check_notify(Entry) end, + Gen = + fun (D, Reason) -> + info_msg("failed reading config file ~s" + "~n Config Dir: ~s" + "~n Reason: ~p", + [FileName, D, Reason]), + ok + end, + Order = fun snmp_conf:no_order/2, + Filter = fun snmp_conf:no_filter/1, + Check = fun (Entry, State) -> {check_notify(Entry), State} end, [Notifs] = - snmp_conf:read_files(Dir, [{Gen, Filter, Check, "notify.conf"}]), + snmp_conf:read_files(Dir, [{FileName, Gen, Order, Check, Filter}]), Notifs. check_notify({Name, Tag, Type}) -> diff --git a/lib/snmp/src/agent/snmp_standard_mib.erl b/lib/snmp/src/agent/snmp_standard_mib.erl index 766b75022b..aace3fd413 100644 --- a/lib/snmp/src/agent/snmp_standard_mib.erl +++ b/lib/snmp/src/agent/snmp_standard_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -152,16 +152,19 @@ do_reconfigure(Dir) -> %%----------------------------------------------------------------- read_standard(Dir) -> ?vdebug("check standard config file",[]), - FileName = "standard.conf", - Gen = fun(D, Reason) -> - throw({error, {failed_reading_config_file, - D, FileName, - list_dir(Dir), Reason}}) - end, - Filter = fun(Standard) -> sort_standard(Standard) end, - Check = fun(Entry) -> check_standard(Entry) end, + FileName = "standard.conf", + Gen = + fun (D, Reason) -> + throw( + {error, + {failed_reading_config_file, + D, FileName, list_dir(Dir), Reason}}) + end, + Order = fun snmp_conf:no_order/2, + Check = fun (Entry, State) -> {check_standard(Entry), State} end, + Filter = fun sort_standard/1, [Standard] = - snmp_conf:read_files(Dir, [{Gen, Filter, Check, FileName}]), + snmp_conf:read_files(Dir, [{FileName, Gen, Order, Check, Filter}]), Standard. list_dir(Dir) -> diff --git a/lib/snmp/src/agent/snmp_target_mib.erl b/lib/snmp/src/agent/snmp_target_mib.erl index b01d536caa..ef9503cda8 100644 --- a/lib/snmp/src/agent/snmp_target_mib.erl +++ b/lib/snmp/src/agent/snmp_target_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2012. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -133,18 +133,22 @@ do_reconfigure(Dir) -> read_target_config_files(Dir) -> ?vdebug("check target address and parameter config file(s)",[]), - TAGen = fun(_D, _Reason) -> ok end, - TAFilter = fun(Addr) -> Addr end, - TACheck = fun(Entry) -> check_target_addr(Entry) end, - TPGen = fun(_D, _Reason) -> ok end, - TPFilter = fun(Params) -> Params end, - TPCheck = fun(Entry) -> check_target_params(Entry) end, + TAName = "target_addr.conf", + TACheck = fun (Entry, State) -> {check_target_addr(Entry), State} end, + + TPName = "target_params.conf", + TPCheck = fun (Entry, State) -> {check_target_params(Entry), State} end, + + NoGen = fun snmp_conf:no_gen/2, + NoOrder = fun snmp_conf:no_order/2, + NoFilter = fun snmp_conf:no_filter/1, [Addrs, Params] = - snmp_conf:read_files(Dir, - [{TAGen, TAFilter, TACheck, "target_addr.conf"}, - {TPGen, TPFilter, TPCheck, "target_params.conf"}]), + snmp_conf:read_files( + Dir, + [{TAName, NoGen, NoOrder, TACheck, NoFilter}, + {TPName, NoGen, NoOrder, TPCheck, NoFilter}]), {Addrs, Params}. @@ -154,79 +158,173 @@ read_target_config_files(Dir) -> %% TMask, MMS} %%----------------------------------------------------------------- -check_target_addr({Name, Domain, Ip, Udp, Timeout, RetryCount, TagList, - Params, EngineId, TMask, MMS}) -> +check_target_addr( + {Name, Domain, Ip, Udp, Timeout, RetryCount, TagList, Params, + EngineId, TMask, MMS}) -> % Arity 11 + Address = {Ip, Udp}, + check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, + EngineId, TMask, MMS); +check_target_addr( + {Name, Domain, Address, Timeout, RetryCount, TagList, Params, + EngineId, TMask, MMS}) % Arity 10 + when is_atom(Domain) -> + check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, + EngineId, TMask, MMS); +check_target_addr( + {Name, Ip, Udp, Timeout, RetryCount, TagList, Params, + EngineId, TMask, MMS}) + when is_integer(Udp) -> % Arity 10 + Domain = default_domain(), + Address = {Ip, Udp}, + check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, + EngineId, TMask, MMS); +check_target_addr( + {_Name, Domain, Address, _Timeout, _RetryCount, _TagList, _Params, + _EngineId, _TMask, _MMS}) -> % Arity 10 + error({bad_address, {Domain, Address}}); +check_target_addr( + {Name, Domain, Address, Timeout, RetryCount, TagList, Params, + EngineId}) % Arity 8 + when is_atom(Domain) -> + check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, + EngineId); +check_target_addr( + {Name, Ip, Udp, Timeout, RetryCount, TagList, Params, + EngineId}) % Arity 8 + when is_integer(Udp) -> + Domain = default_domain(), + Address = {Ip, Udp}, + check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, + EngineId); +check_target_addr( + {_Name, Domain, Address, _Timeout, _RetryCount, _TagList, _Params, + _EngineId}) ->% Arity 8 + error({bad_address, {Domain, Address}}); +%% Use dummy engine id if the old style is found +check_target_addr( + {Name, Domain, Address, Timeout, RetryCount, TagList, Params}) % Arity 7 + when is_atom(Domain) -> + check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params); +check_target_addr( + {Name, Ip, Udp, Timeout, RetryCount, TagList, Params}) % Arity 7 + when is_integer(Udp) -> + Domain = default_domain(), + Address = {Ip, Udp}, + check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params); +check_target_addr( + {_Name, Domain, Address, _Timeout, _RetryCount, _TagList, _Params}) -> % Arity 7 + error({bad_address, {Domain, Address}}); +%% Use dummy engine id if the old style is found +check_target_addr( + {Name, Domain, Address, Timeout, RetryCount, TagList, Params, + TMask, MMS}) % Arity 9 + when is_atom(Domain) -> + check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, TMask, MMS); +check_target_addr( + {Name, Ip, Udp, Timeout, RetryCount, TagList, Params, + TMask, MMS}) % Arity 9 + when is_integer(Udp) -> + Domain = default_domain(), + Address = {Ip, Udp}, + check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, TMask, MMS); +check_target_addr( + {_Name, Domain, Address, _Timeout, _RetryCount, _TagList, _Params, + _TMask, _MMS}) -> % Arity 9 + error({bad_address, {Domain, Address}}); +check_target_addr(X) -> + error({invalid_target_addr, X}). + +check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params) -> % Arity 7 + check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, + "dummy"). +%% +check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, + EngineId) -> % Arity 8 + check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, + EngineId, [], 2048). +%% +check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, + TMask, MMS) -> % Arity 9 + check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, + "dummy", TMask, MMS). +%% +check_target_addr( + Name, Domain, Address, Timeout, RetryCount, TagList, Params, + EngineId, Mask, MMS) -> % Arity 10 ?vtrace("check target address with:" "~n Name: ~s" "~n Domain: ~p" - "~n Ip: ~p" - "~n Udp: ~p" + "~n Address: ~p" "~n Timeout: ~p" "~n RetryCount: ~p" "~n TagList: ~p" "~n Params: ~p" "~n EngineId: ~p" - "~n TMask: ~p" + "~n Mask: ~p" "~n MMS: ~p", - [Name, - Domain, Ip, Udp, + [Name, Domain, Address, Timeout, RetryCount, - TagList, Params, EngineId, TMask, MMS]), + TagList, Params, EngineId, Mask, MMS]), snmp_conf:check_string(Name,{gt,0}), snmp_conf:check_domain(Domain), - snmp_conf:check_ip(Domain, Ip), - snmp_conf:check_integer(Udp, {gt, 0}), + NAddress = check_address(Domain, Address), snmp_conf:check_integer(Timeout, {gte, 0}), snmp_conf:check_integer(RetryCount, {gte,0}), snmp_conf:check_string(TagList), snmp_conf:check_string(Params), check_engine_id(EngineId), - TAddress = snmp_conf:mk_taddress(Domain, Ip, Udp), + NMask = check_mask(Domain, Mask), TDomain = snmp_conf:mk_tdomain(Domain), - check_tmask(TDomain, TMask, TAddress), + TAddress = snmp_conf:mk_taddress(Domain, NAddress), + TMask = snmp_conf:mk_taddress(Domain, NMask), snmp_conf:check_packet_size(MMS), ?vtrace("check target address done",[]), Addr = {Name, TDomain, TAddress, Timeout, RetryCount, TagList, Params, ?'StorageType_nonVolatile', ?'RowStatus_active', EngineId, TMask, MMS}, % Values for Augmenting table in SNMP-COMMUNITY-MIB - {ok, Addr}; -check_target_addr({Name, Ip, Udp, Timeout, RetryCount, TagList, - Params, EngineId, TMask, MMS}) -> - Domain = default_domain(), - check_target_addr({Name, - Domain, Ip, Udp, - Timeout, RetryCount, TagList, - Params, EngineId, TMask, MMS}); -check_target_addr({Name, Ip, Udp, Timeout, RetryCount, TagList, Params, - EngineId}) -> - check_target_addr({Name, Ip, Udp, Timeout, RetryCount, TagList, - Params, EngineId, [], 2048}); -%% Use dummy engine id if the old style is found -check_target_addr({Name, Ip, Udp, Timeout, RetryCount, TagList, Params}) -> - check_target_addr({Name, Ip, Udp, Timeout, RetryCount, TagList, - Params, "dummy", [], 2048}); -%% Use dummy engine id if the old style is found -check_target_addr({Name, Ip, Udp, Timeout, RetryCount, TagList, Params, - TMask, MMS}) -> - check_target_addr({Name, Ip, Udp, Timeout, RetryCount, TagList, - Params, "dummy", TMask, MMS}); -check_target_addr(X) -> - error({invalid_target_addr, X}). - + {ok, Addr}. check_engine_id(discovery) -> ok; check_engine_id(EngineId) -> snmp_conf:check_string(EngineId). +check_address(Domain, Address) -> + case snmp_conf:check_address(Domain, Address, 162) of + ok -> + Address; + {ok, NAddress} -> + NAddress + end. -check_tmask(_TDomain, [], _TAddress) -> - ok; -check_tmask(TDomain, TMask, TAddress) when length(TMask) =:= length(TAddress) -> - snmp_conf:check_taddress(TDomain, TMask); -check_tmask(_TDomain, TMask, _TAddr) -> - throw({error, {invalid_tmask, TMask}}). +check_mask(_Domain, [] = Mask) -> + Mask; +check_mask(Domain, Mask) -> + try snmp_conf:check_address(Domain, Mask) of + ok -> + Mask; + {ok, NMask} -> + NMask + catch + {error, {bad_address, Info}} -> + error({bad_mask, Info}) + end. %%----------------------------------------------------------------- @@ -286,16 +384,21 @@ table_del_row(Tab, Key) -> snmpa_mib_lib:table_del_row(db(Tab), Key). -add_addr(Name, Ip, Port, Timeout, Retry, TagList, - Params, EngineId, TMask, MMS) -> - Domain = default_domain(), - add_addr(Name, Domain, Ip, Port, Timeout, Retry, TagList, - Params, EngineId, TMask, MMS). - -add_addr(Name, Domain, Ip, Port, Timeout, Retry, TagList, - Params, EngineId, TMask, MMS) -> - Addr = {Name, Domain, Ip, Port, Timeout, Retry, TagList, - Params, EngineId, TMask, MMS}, +add_addr( + Name, Domain_or_Ip, Addr_or_Port, Timeout, Retry, TagList, Params, + EngineId, TMask, MMS) -> + add_addr( + {Name, Domain_or_Ip, Addr_or_Port, Timeout, Retry, TagList, Params, + EngineId, TMask, MMS}). +%% +add_addr( + Name, Domain, Ip, Port, Timeout, Retry, TagList, Params, + EngineId, TMask, MMS) -> + add_addr( + {Name, Domain, Ip, Port, Timeout, Retry, TagList, Params, + EngineId, TMask, MMS}). +%% +add_addr(Addr) -> case (catch check_target_addr(Addr)) of {ok, Row} -> Key = element(1, Row), @@ -604,6 +707,20 @@ snmpTargetAddrTable(print) -> FOI = foi(Table), PrintRow = fun(Prefix, Row) -> + TDomain = element(?snmpTargetAddrTDomain, Row), + Domain = + try snmp_conf:tdomain_to_domain(TDomain) + catch + {error, {bad_tdomain, _}} -> + undefined + end, + TAddress = element(?snmpTargetAddrTAddress, Row), + AddrString = + try snmp_conf:mk_addr_string({Domain, TAddress}) + catch + {error, {bad_address, _}} -> + "-" + end, lists:flatten( io_lib:format("~sName: ~p" "~n~sTDomain: ~p (~w)" @@ -618,21 +735,8 @@ snmpTargetAddrTable(print) -> "~n~s[Ext] TMask: ~p" "~n~s[Ext] MMS: ~p", [Prefix, element(?snmpTargetAddrName, Row), - Prefix, element(?snmpTargetAddrTDomain, Row), - case element(?snmpTargetAddrTDomain, Row) of - ?snmpUDPDomain -> snmpUDPDomain; - ?transportDomainUdpIpv4 -> transportDomainUdpIpv4; - ?transportDomainUdpIpv6 -> transportDomainUdpIpv6; - _ -> undefined - end, - Prefix, element(?snmpTargetAddrTAddress, Row), - case element(?snmpTargetAddrTAddress, Row) of - [A,B,C,D,U1,U2] -> - lists:flatten( - io_lib:format("~w.~w.~w.~w:~w", - [A, B, C, D, U1 bsl 8 + U2])); - _ -> "-" - end, + Prefix, TDomain, Domain, + Prefix, TAddress, AddrString, Prefix, element(?snmpTargetAddrTimeout, Row), Prefix, element(?snmpTargetAddrRetryCount, Row), Prefix, element(?snmpTargetAddrTagList, Row), 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 223d3f7218..69dce337ba 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-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -137,18 +137,20 @@ do_reconfigure(Dir) -> read_usm_config_files(Dir) -> ?vdebug("read usm config file",[]), - Gen = fun(D, Reason) -> generate_usm(D, Reason) end, - Filter = fun(Usms) -> Usms end, - Check = fun(Entry) -> check_usm(Entry) end, + Gen = fun (D, Reason) -> generate_usm(D, Reason) end, + Order = fun snmp_conf:no_order/2, + Check = fun (Entry, State) -> {check_usm(Entry), State} end, + Filter = fun snmp_conf:no_filter/1, [Usms] = - snmp_conf:read_files(Dir, [{Gen, Filter, Check, "usm.conf"}]), + snmp_conf:read_files(Dir, [{"usm.conf", Gen, Order, Check, Filter}]), Usms. generate_usm(Dir, _Reason) -> info_msg("Incomplete configuration. Generating empty usm.conf.", []), USMFile = filename:join(Dir, "usm.conf"), - ok = file:write_file(USMFile, list_to_binary([])). + ok = file:write_file(USMFile, list_to_binary([])), + []. check_usm({EngineID, Name, SecName, Clone, AuthP, AuthKeyC, OwnAuthKeyC, diff --git a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl index c0177b1cea..722bd7ac5b 100644 --- a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl +++ b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. All Rights Reserved. %% %% The 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,15 +123,18 @@ do_reconfigure(Dir) -> read_vacm_config_files(Dir) -> ?vdebug("read vacm config file",[]), - Gen = fun(_D, _Reason) -> ok end, - Filter = fun(Vacms) -> - Sec2Group = [X || {vacmSecurityToGroup, X} <- Vacms], - Access = [X || {vacmAccess, X} <- Vacms], - View = [X || {vacmViewTreeFamily, X} <- Vacms], - {Sec2Group, Access, View} - end, - Check = fun(Entry) -> check_vacm(Entry) end, - [Vacms] = snmp_conf:read_files(Dir, [{Gen, Filter, Check, "vacm.conf"}]), + Gen = fun snmp_conf:no_gen/2, + Order = fun snmp_conf:no_order/2, + Check = fun (Entry, State) -> {check_vacm(Entry), State} end, + Filter = + fun (Vacms) -> + Sec2Group = [X || {vacmSecurityToGroup, X} <- Vacms], + Access = [X || {vacmAccess, X} <- Vacms], + View = [X || {vacmViewTreeFamily, X} <- Vacms], + {Sec2Group, Access, View} + end, + [Vacms] = + snmp_conf:read_files(Dir, [{"vacm.conf", Gen, Order, Check, Filter}]), Vacms. %%----------------------------------------------------------------- diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index 9bed6e554e..6d3f1cca4a 100644 --- a/lib/snmp/src/agent/snmpa_agent.erl +++ b/lib/snmp/src/agent/snmpa_agent.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -2512,10 +2512,19 @@ handle_mib_of(MibServer, Oid) -> %% Func: process_msg/7 %% Returns: RePdu %%----------------------------------------------------------------- -process_msg(MibView, Vsn, Pdu, PduMS, Community, {Ip, Udp}, ContextName, - GbMaxVBs) -> +process_msg( + MibView, Vsn, Pdu, PduMS, Community, + SourceAddress, ContextName, GbMaxVBs) -> #pdu{request_id = ReqId} = Pdu, - put(snmp_address, {tuple_to_list(Ip), Udp}), + put( + snmp_address, + case SourceAddress of + {Domain, _} when is_atom(Domain) -> + SourceAddress; + {Ip, Port} when is_integer(Port) -> + %% Legacy transport domain + {tuple_to_list(Ip), Port} + end), put(snmp_request_id, ReqId), put(snmp_community, Community), put(snmp_context, ContextName), diff --git a/lib/snmp/src/agent/snmpa_conf.erl b/lib/snmp/src/agent/snmpa_conf.erl index c17a6abbd7..534d0e447b 100644 --- a/lib/snmp/src/agent/snmpa_conf.erl +++ b/lib/snmp/src/agent/snmpa_conf.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -47,7 +47,7 @@ read_standard_config/1, %% target_addr.conf - target_addr_entry/5, target_addr_entry/6, + target_addr_entry/5, target_addr_entry/6, target_addr_entry/7, target_addr_entry/8, target_addr_entry/10, target_addr_entry/11, write_target_addr_config/2, write_target_addr_config/3, append_target_addr_config/2, @@ -108,36 +108,25 @@ write_agent_config(Dir, Conf) -> Hdr = header() ++ Comment, write_agent_config(Dir, Hdr, Conf). -write_agent_config(Dir, Hdr, Conf) +write_agent_config(Dir, Hdr, Conf) when is_list(Dir) and is_list(Hdr) and is_list(Conf) -> - Verify = fun() -> verify_agent_conf(Conf) end, - Write = fun(Fd) -> write_agent_conf(Fd, Hdr, Conf) end, - write_config_file(Dir, "agent.conf", Verify, Write). - + Order = fun snmp_framework_mib:order_agent/2, + Check = fun snmp_framework_mib:check_agent/2, + Write = fun (Fd, Entries) -> write_agent_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, "agent.conf", Order, Check, Write, Conf). -append_agent_config(Dir, Conf) +append_agent_config(Dir, Conf) when is_list(Dir) and is_list(Conf) -> - Verify = fun() -> verify_agent_conf(Conf) end, - Write = fun(Fd) -> write_agent_conf(Fd, Conf) end, - append_config_file(Dir, "agent.conf", Verify, Write). - + Order = fun snmp_framework_mib:order_agent/2, + Check = fun snmp_framework_mib:check_agent/2, + Write = fun write_agent_conf/2, + append_config_file(Dir, "agent.conf", Order, Check, Write, Conf). read_agent_config(Dir) -> - Verify = fun(Entry) -> verify_agent_conf_entry(Entry) end, - read_config_file(Dir, "agent.conf", Verify). + Order = fun snmp_framework_mib:order_agent/2, + Check = fun snmp_framework_mib:check_agent/2, + read_config_file(Dir, "agent.conf", Order, Check). - -verify_agent_conf([]) -> - ok; -verify_agent_conf([H|T]) -> - verify_agent_conf_entry(H), - verify_agent_conf(T); -verify_agent_conf(X) -> - error({bad_agent_config, X}). - -verify_agent_conf_entry(Entry) -> - ok = snmp_framework_mib:check_agent(Entry), - ok. write_agent_conf(Fd, "", Conf) -> write_agent_conf(Fd, Conf); @@ -151,6 +140,10 @@ write_agent_conf(Fd, [H|T]) -> do_write_agent_conf(Fd, H), write_agent_conf(Fd, T). +do_write_agent_conf(Fd, {intAgentTransports = Tag, Val}) -> + io:format(Fd, "{~w, ~w}.~n", [Tag, Val]); +do_write_agent_conf(Fd, {intAgentTransportDomain = Tag, Val}) -> + io:format(Fd, "{~w, ~w}.~n", [Tag, Val]); do_write_agent_conf(Fd, {intAgentIpAddress = Tag, Val}) -> io:format(Fd, "{~w, ~w}.~n", [Tag, Val]); do_write_agent_conf(Fd, {intAgentUDPPort = Tag, Val} ) -> @@ -191,34 +184,27 @@ write_context_config(Dir, Conf) -> write_context_config(Dir, Hdr, Conf) when is_list(Dir) and is_list(Hdr) and is_list(Conf) -> - Verify = fun() -> verify_context_conf(Conf) end, - Write = fun(Fd) -> write_context_conf(Fd, Hdr, Conf) end, - write_config_file(Dir, "context.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_context/2, + Write = fun (Fd, Entries) -> write_context_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, "context.conf", Order, Check, Write, Conf). -append_context_config(Dir, Conf) +append_context_config(Dir, Conf) when is_list(Dir) and is_list(Conf) -> - Verify = fun() -> verify_context_conf(Conf) end, - Write = fun(Fd) -> write_context_conf(Fd, Conf) end, - append_config_file(Dir, "context.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_context/2, + Write = fun write_context_conf/2, + append_config_file(Dir, "context.conf", Order, Check, Write, Conf). read_context_config(Dir) -> - Verify = fun(Entry) -> verify_context_conf_entry(Entry) end, - read_config_file(Dir, "context.conf", Verify). + Order = fun snmp_conf:no_order/2, + Check = fun check_context/2, + read_config_file(Dir, "context.conf", Order, Check). - -verify_context_conf([]) -> - ok; -verify_context_conf([H|T]) -> - verify_context_conf_entry(H), - verify_context_conf(T); -verify_context_conf(X) -> - error({error_context_config, X}). - -verify_context_conf_entry(Context) -> - {ok, _} = snmp_framework_mib:check_context(Context), - ok. + +check_context(Entry, State) -> + {check_ok(snmp_framework_mib:check_context(Entry)), + State}. write_context_conf(Fd, "", Conf) -> write_context_conf(Fd, Conf); @@ -271,36 +257,29 @@ write_community_config(Dir, Conf) -> Hdr = header() ++ Comment, write_community_config(Dir, Hdr, Conf). -write_community_config(Dir, Hdr, Conf) +write_community_config(Dir, Hdr, Conf) when is_list(Dir) and is_list(Hdr) and is_list(Conf) -> - Verify = fun() -> verify_community_conf(Conf) end, - Write = fun(Fd) -> write_community_conf(Fd, Hdr, Conf) end, - write_config_file(Dir, "community.conf", Verify, Write). + Order = fun snmp_conf:no_order/2, + Check = fun check_community/2, + Write = fun (Fd, Entries) -> write_community_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, "community.conf", Order, Check, Write, Conf). - -append_community_config(Dir, Conf) +append_community_config(Dir, Conf) when is_list(Dir) and is_list(Conf) -> - Verify = fun() -> verify_community_conf(Conf) end, - Write = fun(Fd) -> write_community_conf(Fd, Conf) end, - append_config_file(Dir, "community.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_community/2, + Write = fun write_community_conf/2, + append_config_file(Dir, "community.conf", Order, Check, Write, Conf). read_community_config(Dir) -> - Verify = fun(Entry) -> verify_community_conf_entry(Entry) end, - read_config_file(Dir, "community.conf", Verify). + Order = fun snmp_conf:no_order/2, + Check = fun check_community/2, + read_config_file(Dir, "community.conf", Order, Check). - -verify_community_conf([]) -> - ok; -verify_community_conf([H|T]) -> - verify_community_conf_entry(H), - verify_community_conf(T); -verify_community_conf(X) -> - error({invalid_community_config, X}). - -verify_community_conf_entry(Context) -> - {ok, _} = snmp_community_mib:check_community(Context), - ok. + +check_community(Entry, State) -> + {check_ok(snmp_community_mib:check_community(Entry)), + State}. write_community_conf(Fd, "", Conf) -> write_community_conf(Fd, Conf); @@ -309,14 +288,17 @@ write_community_conf(Fd, Hdr, Conf) -> write_community_conf(Fd, Conf). write_community_conf(Fd, Conf) -> - Fun = fun({Idx, Name, SecName, CtxName, TranspTag}) -> - io:format(Fd, "{\"~s\", \"~s\", \"~s\", \"~s\", \"~s\"}.~n", - [Idx, Name, SecName, CtxName, TranspTag]); + Fun = + fun({Idx, Name, SecName, CtxName, TranspTag}) -> + io:format( + Fd, + "{\"~s\", \"~s\", \"~s\", \"~s\", \"~s\"}.~n", + [Idx, Name, SecName, CtxName, TranspTag]); (Crap) -> - error({bad_community_config, Crap}) + error({bad_community_config, Crap}) end, lists:foreach(Fun, Conf). - + %% %% ------ standard.conf ------ @@ -343,40 +325,29 @@ write_standard_config(Dir, Conf) -> Hdr = header() ++ Comment, write_standard_config(Dir, Hdr, Conf). -write_standard_config(Dir, Hdr, Conf) +write_standard_config(Dir, Hdr, Conf) when is_list(Dir) and is_list(Hdr) and is_list(Conf) -> - Verify = fun() -> verify_standard_conf(Conf) end, - Write = fun(Fd) -> write_standard_conf(Fd, Hdr, Conf) end, - write_config_file(Dir, "standard.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_standard/2, + Write = fun (Fd, Entries) -> write_standard_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, "standard.conf", Order, Check, Write, Conf). -append_standard_config(Dir, Conf) +append_standard_config(Dir, Conf) when is_list(Dir) and is_list(Conf) -> - Verify = fun() -> verify_standard_conf(Conf) end, - Write = fun(Fd) -> write_standard_conf(Fd, Conf) end, - append_config_file(Dir, "standard.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_standard/2, + Write = fun write_standard_conf/2, + append_config_file(Dir, "standard.conf", Order, Check, Write, Conf). read_standard_config(Dir) -> - Verify = fun(Entry) -> verify_standard_conf_entry(Entry) end, - read_config_file(Dir, "standard.conf", Verify). + Order = fun snmp_conf:no_order/2, + Check = fun check_standard/2, + read_config_file(Dir, "standard.conf", Order, Check). - -verify_standard_conf([]) -> - ok; -verify_standard_conf([H|T]) -> - verify_standard_conf_entry(H), - verify_standard_conf(T); -verify_standard_conf(X) -> - error({bad_standard_config, X}). - -verify_standard_conf_entry(Std) -> - case snmp_standard_mib:check_standard(Std) of - ok -> - ok; - {ok, _} -> - ok - end. + +check_standard(Entry, State) -> + {check_ok(snmp_standard_mib:check_standard(Entry)), + State}. write_standard_conf(Fd, "", Conf) -> write_standard_conf(Fd, Conf); @@ -410,72 +381,48 @@ do_write_standard_conf(_Fd, Tag, Val) -> %% ------ target_addr.conf ------ %% -target_addr_entry(Name, - Ip, - TagList, - ParamsName, - EngineId) -> +target_addr_entry( + Name, Ip, TagList, ParamsName, EngineId) -> target_addr_entry(Name, Ip, TagList, ParamsName, EngineId, []). -target_addr_entry(Name, - Ip, - TagList, - ParamsName, - EngineId, - TMask) -> - target_addr_entry(Name, Ip, 162, TagList, - ParamsName, EngineId, - TMask, 2048). - -target_addr_entry(Name, - Ip, - Udp, - TagList, - ParamsName, - EngineId, - TMask, - MaxMessageSize) -> - target_addr_entry(Name, Ip, Udp, 1500, 3, TagList, - ParamsName, EngineId, - TMask, MaxMessageSize). - -target_addr_entry(Name, - Ip, - Udp, - Timeout, - RetryCount, - TagList, - ParamsName, - EngineId, - TMask, - MaxMessageSize) -> - target_addr_entry(Name, snmp_target_mib:default_domain(), Ip, Udp, - Timeout, RetryCount, TagList, - ParamsName, EngineId, - TMask, MaxMessageSize). - -target_addr_entry(Name, - Domain, - Ip, - Udp, - Timeout, - RetryCount, - TagList, - ParamsName, - EngineId, - TMask, - MaxMessageSize) -> - {Name, - Domain, - Ip, - Udp, - Timeout, - RetryCount, - TagList, - ParamsName, - EngineId, - TMask, - MaxMessageSize}. +target_addr_entry( + Name, Domain, Addr, TagList, + ParamsName, EngineId) when is_atom(Domain) -> + target_addr_entry( + Name, Domain, Addr, TagList, + ParamsName, EngineId, []); +target_addr_entry( + Name, Ip, TagList, ParamsName, + EngineId, TMask) -> + target_addr_entry( + Name, Ip, 162, TagList, ParamsName, + EngineId, TMask, 2048). + +target_addr_entry( + Name, Domain_or_Ip, Addr_or_Port, TagList, + ParamsName, EngineId, TMask) -> + target_addr_entry( + Name, Domain_or_Ip, Addr_or_Port, TagList, + ParamsName, EngineId, TMask, 2048). + +target_addr_entry( + Name, Domain_or_Ip, Addr_or_Port, TagList, + ParamsName, EngineId, TMask, MaxMessageSize) -> + target_addr_entry( + Name, Domain_or_Ip, Addr_or_Port, 1500, 3, TagList, + ParamsName, EngineId, TMask, MaxMessageSize). + +target_addr_entry( + Name, Domain_or_Ip, Addr_or_Port, Timeout, RetryCount, TagList, + ParamsName, EngineId, TMask, MaxMessageSize) -> + {Name, Domain_or_Ip, Addr_or_Port, Timeout, RetryCount, TagList, + ParamsName, EngineId, TMask, MaxMessageSize}. + +target_addr_entry( + Name, Domain, Ip, Udp, Timeout, RetryCount, TagList, + ParamsName, EngineId,TMask, MaxMessageSize) -> + {Name, Domain, Ip, Udp, Timeout, RetryCount, TagList, + ParamsName, EngineId, TMask, MaxMessageSize}. write_target_addr_config(Dir, Conf) -> @@ -504,37 +451,29 @@ write_target_addr_config(Dir, Conf) -> Hdr = header() ++ Comment, write_target_addr_config(Dir, Hdr, Conf). -write_target_addr_config(Dir, Hdr, Conf) +write_target_addr_config(Dir, Hdr, Conf) when is_list(Dir) and is_list(Hdr) and is_list(Conf) -> - Verify = fun() -> verify_target_addr_conf(Conf) end, - Write = fun(Fd) -> write_target_addr_conf(Fd, Hdr, Conf) end, - write_config_file(Dir, "target_addr.conf", Verify, Write). + Order = fun snmp_conf:no_order/2, + Check = fun check_target_addr/2, + Write = fun (Fd, Entries) -> write_target_addr_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, "target_addr.conf", Order, Check, Write, Conf). - - -append_target_addr_config(Dir, Conf) +append_target_addr_config(Dir, Conf) when is_list(Dir) and is_list(Conf) -> - Verify = fun() -> verify_target_addr_conf(Conf) end, - Write = fun(Fd) -> write_target_addr_conf(Fd, Conf) end, - append_config_file(Dir, "target_addr.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_target_addr/2, + Write = fun write_target_addr_conf/2, + append_config_file(Dir, "target_addr.conf", Order, Check, Write, Conf). read_target_addr_config(Dir) -> - Verify = fun(Entry) -> verify_target_addr_conf_entry(Entry) end, - read_config_file(Dir, "target_addr.conf", Verify). + Order = fun snmp_conf:no_order/2, + Check = fun check_target_addr/2, + read_config_file(Dir, "target_addr.conf", Order, Check). - -verify_target_addr_conf([]) -> - ok; -verify_target_addr_conf([H|T]) -> - verify_target_addr_conf_entry(H), - verify_target_addr_conf(T); -verify_target_addr_conf(X) -> - error({bad_target_addr_config, X}). - -verify_target_addr_conf_entry(Entry) -> - {ok, _} = snmp_target_mib:check_target_addr(Entry), - ok. + +check_target_addr(Entry, State) -> + {check_ok(snmp_target_mib:check_target_addr(Entry)), + State}. write_target_addr_conf(Fd, "", Conf) -> write_target_addr_conf(Fd, Conf); @@ -547,29 +486,41 @@ write_target_addr_conf(Fd, Conf) -> lists:foreach(Fun, Conf), ok. -do_write_target_addr_conf(Fd, - {Name, - Ip, Udp, - Timeout, RetryCount, TagList, - ParamsName, EngineId, - TMask, MaxMessageSize}) -> - Domain = snmp_target_mib:default_domain(), - do_write_target_addr_conf(Fd, - {Name, - Domain, Ip, Udp, - Timeout, RetryCount, TagList, - ParamsName, EngineId, - TMask, MaxMessageSize}); -do_write_target_addr_conf(Fd, - {Name, - Domain, Ip, Udp, - Timeout, RetryCount, TagList, - ParamsName, EngineId, - TMask, MaxMessageSize}) -> - io:format(Fd, - "{\"~s\", ~w, ~w, ~w, ~w, ~w, \"~s\", \"~s\", \"~s\", ~w, ~w}.~n", - [Name, Domain, Ip, Udp, Timeout, RetryCount, TagList, - ParamsName, EngineId, TMask, MaxMessageSize]); +do_write_target_addr_conf( + Fd, + {Name, Domain, Address, Timeout, RetryCount, TagList, + ParamsName, EngineId, TMask, MaxMessageSize}) + when is_atom(Domain) -> + io:format( + Fd, + "{\"~s\", ~w, ~w, ~w, ~w, \"~s\", \"~s\", \"~s\", ~w, ~w}.~n", + [Name, Domain, Address, Timeout, RetryCount, TagList, + ParamsName, EngineId, TMask, MaxMessageSize]); +do_write_target_addr_conf( + Fd, + {Name, Ip, Udp, Timeout, RetryCount, TagList, + ParamsName, EngineId, TMask, MaxMessageSize}) + when is_integer(Udp) -> + Domain = snmp_target_mib:default_domain(), + Address = {Ip, Udp}, + do_write_target_addr_conf( + Fd, + {Name, Domain, Address, Timeout, RetryCount, TagList, + ParamsName, EngineId, TMask, MaxMessageSize}); +do_write_target_addr_conf( + _Fd, + {_Name, Domain, Address, _Timeout, _RetryCount, _TagList, + _ParamsName, _EngineId, _TMask, _MaxMessageSize}) -> + error({bad_address, {Domain, Address}}); +do_write_target_addr_conf( + Fd, + {Name, Domain, Ip, Udp, Timeout, RetryCount, TagList, + ParamsName, EngineId, TMask, MaxMessageSize}) -> + Address = {Ip, Udp}, + do_write_target_addr_conf( + Fd, + {Name, Domain, Address, Timeout, RetryCount, TagList, + ParamsName, EngineId, TMask, MaxMessageSize}); do_write_target_addr_conf(_Fd, Crap) -> error({bad_target_addr_config, Crap}). @@ -613,34 +564,27 @@ write_target_params_config(Dir, Conf) -> write_target_params_config(Dir, Hdr, Conf) when is_list(Dir) and is_list(Hdr) and is_list(Conf) -> - Verify = fun() -> verify_target_params_conf(Conf) end, - Write = fun(Fd) -> write_target_params_conf(Fd, Hdr, Conf) end, - write_config_file(Dir, "target_params.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_target_params/2, + Write = fun (Fd, Entries) -> write_target_params_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, "target_params.conf", Order, Check, Write, Conf). append_target_params_config(Dir, Conf) when is_list(Dir) and is_list(Conf) -> - Verify = fun() -> verify_target_params_conf(Conf) end, - Write = fun(Fd) -> write_target_params_conf(Fd, Conf) end, - append_config_file(Dir, "target_params.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_target_params/2, + Write = fun write_target_params_conf/2, + append_config_file(Dir, "target_params.conf", Order, Check, Write, Conf). read_target_params_config(Dir) -> - Verify = fun(Entry) -> verify_target_params_conf_entry(Entry) end, - read_config_file(Dir, "target_params.conf", Verify). + Order = fun snmp_conf:no_order/2, + Check = fun check_target_params/2, + read_config_file(Dir, "target_params.conf", Order, Check). -verify_target_params_conf([]) -> - ok; -verify_target_params_conf([H|T]) -> - verify_target_params_conf_entry(H), - verify_target_params_conf(T); -verify_target_params_conf(X) -> - error({bad_target_params_config, X}). - -verify_target_params_conf_entry(Entry) -> - {ok, _} = snmp_target_mib:check_target_params(Entry), - ok. +check_target_params(Entry, State) -> + {check_ok(snmp_target_mib:check_target_params(Entry)), + State}. write_target_params_conf(Fd, "", Conf) -> write_target_params_conf(Fd, Conf); @@ -685,34 +629,27 @@ write_notify_config(Dir, Conf) -> write_notify_config(Dir, Hdr, Conf) when is_list(Dir) and is_list(Hdr) and is_list(Conf) -> - Verify = fun() -> verify_notify_conf(Conf) end, - Write = fun(Fd) -> write_notify_conf(Fd, Hdr, Conf) end, - write_config_file(Dir, "notify.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_notify/2, + Write = fun (Fd, Entries) -> write_notify_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, "notify.conf", Order, Check, Write, Conf). append_notify_config(Dir, Conf) when is_list(Dir) and is_list(Conf) -> - Verify = fun() -> verify_notify_conf(Conf) end, - Write = fun(Fd) -> write_notify_conf(Fd, Conf) end, - append_config_file(Dir, "notify.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_notify/2, + Write = fun write_notify_conf/2, + append_config_file(Dir, "notify.conf", Order, Check, Write, Conf). read_notify_config(Dir) -> - Verify = fun(Entry) -> verify_notify_conf_entry(Entry) end, - read_config_file(Dir, "notify.conf", Verify). + Order = fun snmp_conf:no_order/2, + Check = fun check_notify/2, + read_config_file(Dir, "notify.conf", Order, Check). -verify_notify_conf([]) -> - ok; -verify_notify_conf([H|T]) -> - verify_notify_conf_entry(H), - verify_notify_conf(T); -verify_notify_conf(X) -> - error({bad_notify_config, X}). - -verify_notify_conf_entry(Entry) -> - {ok, _} = snmp_notification_mib:check_notify(Entry), - ok. +check_notify(Entry, State) -> + {check_ok(snmp_notification_mib:check_notify(Entry)), + State}. write_notify_conf(Fd, "", Conf) -> write_notify_conf(Fd, Conf); @@ -781,34 +718,27 @@ write_usm_config(Dir, Conf) -> write_usm_config(Dir, Hdr, Conf) when is_list(Dir) and is_list(Hdr) and is_list(Conf) -> - Verify = fun() -> verify_usm_conf(Conf) end, - Write = fun(Fd) -> write_usm_conf(Fd, Hdr, Conf) end, - write_config_file(Dir, "usm.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_usm/2, + Write = fun (Fd, Entries) -> write_usm_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, "usm.conf", Order, Check, Write, Conf). append_usm_config(Dir, Conf) when is_list(Dir) and is_list(Conf) -> - Verify = fun() -> verify_usm_conf(Conf) end, - Write = fun(Fd) -> write_usm_conf(Fd, Conf) end, - append_config_file(Dir, "usm.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_usm/2, + Write = fun write_usm_conf/2, + append_config_file(Dir, "usm.conf", Order, Check, Write, Conf). read_usm_config(Dir) -> - Verify = fun(Entry) -> verify_usm_conf_entry(Entry) end, - read_config_file(Dir, "usm.conf", Verify). + Order = fun snmp_conf:no_order/2, + Check = fun check_usm/2, + read_config_file(Dir, "usm.conf", Order, Check). -verify_usm_conf([]) -> - ok; -verify_usm_conf([H|T]) -> - verify_usm_conf_entry(H), - verify_usm_conf(T); -verify_usm_conf(X) -> - error({bad_usm_conf, X}). - -verify_usm_conf_entry(Entry) -> - {ok, _} = snmp_user_based_sm_mib:check_usm(Entry), - ok. +check_usm(Entry, State) -> + {check_ok(snmp_user_based_sm_mib:check_usm(Entry)), + State}. write_usm_conf(Fd, "", Conf) -> write_usm_conf(Fd, Conf); @@ -820,11 +750,12 @@ write_usm_conf(Fd, Conf) -> Fun = fun(Entry) -> do_write_usm_conf(Fd, Entry) end, lists:foreach(Fun, Conf). -do_write_usm_conf(Fd, - {EngineID, UserName, SecName, Clone, - AuthP, AuthKeyC, OwnAuthKeyC, - PrivP, PrivKeyC, OwnPrivKeyC, - Public, AuthKey, PrivKey}) -> +do_write_usm_conf( + Fd, + {EngineID, UserName, SecName, Clone, + AuthP, AuthKeyC, OwnAuthKeyC, + PrivP, PrivKeyC, OwnPrivKeyC, + Public, AuthKey, PrivKey}) -> io:format(Fd, "{", []), io:format(Fd, "\"~s\", ", [EngineID]), io:format(Fd, "\"~s\", ", [UserName]), @@ -890,34 +821,27 @@ write_vacm_config(Dir, Conf) -> write_vacm_config(Dir, Hdr, Conf) when is_list(Dir) and is_list(Hdr) and is_list(Conf) -> - Verify = fun() -> verify_vacm_conf(Conf) end, - Write = fun(Fd) -> write_vacm_conf(Fd, Hdr, Conf) end, - write_config_file(Dir, "vacm.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_vacm/2, + Write = fun (Fd, Entries) -> write_vacm_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, "vacm.conf", Order, Check, Write, Conf). append_vacm_config(Dir, Conf) when is_list(Dir) and is_list(Conf) -> - Verify = fun() -> verify_vacm_conf(Conf) end, - Write = fun(Fd) -> write_vacm_conf(Fd, Conf) end, - append_config_file(Dir, "vacm.conf", Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_vacm/2, + Write = fun write_vacm_conf/2, + append_config_file(Dir, "vacm.conf", Order, Check, Write, Conf). read_vacm_config(Dir) -> - Verify = fun(Entry) -> verify_vacm_conf_entry(Entry) end, - read_config_file(Dir, "vacm.conf", Verify). + Order = fun snmp_conf:no_order/2, + Check = fun check_vacm/2, + read_config_file(Dir, "vacm.conf", Order, Check). -verify_vacm_conf([]) -> - ok; -verify_vacm_conf([H|T]) -> - verify_vacm_conf_entry(H), - verify_vacm_conf(T); -verify_vacm_conf(X) -> - error({bad_vacm_conf, X}). - -verify_vacm_conf_entry(Entry) -> - {ok, _} = snmp_view_based_acm_mib:check_vacm(Entry), - ok. +check_vacm(Entry, State) -> + {check_ok(snmp_view_based_acm_mib:check_vacm(Entry)), + State}. write_vacm_conf(Fd, "", Conf) -> write_vacm_conf(Fd, Conf); @@ -929,49 +853,60 @@ write_vacm_conf(Fd, Conf) -> Fun = fun(Entry) -> do_write_vacm_conf(Fd, Entry) end, lists:foreach(Fun, Conf). -do_write_vacm_conf(Fd, - {vacmSecurityToGroup, - SecModel, SecName, GroupName}) -> - io:format(Fd, "{vacmSecurityToGroup, ~w, \"~s\", \"~s\"}.~n", - [SecModel, SecName, GroupName]); -do_write_vacm_conf(Fd, - {vacmAccess, - GroupName, Prefix, SecModel, SecLevel, Match, RV, WV, NV}) -> - io:format(Fd, "{vacmAccess, \"~s\", \"~s\", ~w, ~w, ~w, " - "\"~s\", \"~s\", \"~s\"}.~n", - [GroupName, Prefix, SecModel, SecLevel, - Match, RV, WV, NV]); -do_write_vacm_conf(Fd, - {vacmViewTreeFamily, - ViewIndex, ViewSubtree, ViewStatus, ViewMask}) -> - io:format(Fd, "{vacmViewTreeFamily, \"~s\", ~w, ~w, ~w}.~n", - [ViewIndex, ViewSubtree, ViewStatus, ViewMask]); +do_write_vacm_conf( + Fd, + {vacmSecurityToGroup, + SecModel, SecName, GroupName}) -> + io:format( + Fd, "{vacmSecurityToGroup, ~w, \"~s\", \"~s\"}.~n", + [SecModel, SecName, GroupName]); +do_write_vacm_conf( + Fd, + {vacmAccess, + GroupName, Prefix, SecModel, SecLevel, Match, RV, WV, NV}) -> + io:format( + Fd, "{vacmAccess, \"~s\", \"~s\", ~w, ~w, ~w, " + "\"~s\", \"~s\", \"~s\"}.~n", + [GroupName, Prefix, SecModel, SecLevel, + Match, RV, WV, NV]); +do_write_vacm_conf( + Fd, + {vacmViewTreeFamily, + ViewIndex, ViewSubtree, ViewStatus, ViewMask}) -> + io:format( + Fd, "{vacmViewTreeFamily, \"~s\", ~w, ~w, ~w}.~n", + [ViewIndex, ViewSubtree, ViewStatus, ViewMask]); do_write_vacm_conf(_Fd, Crap) -> error({bad_vacm_config, Crap}). %% ---- config file wrapper functions ---- -write_config_file(Dir, File, Verify, Write) -> - snmp_config:write_config_file(Dir, File, Verify, Write). +write_config_file(Dir, File, Order, Check, Write, Conf) -> + snmp_config:write_config_file(Dir, File, Order, Check, Write, Conf). -append_config_file(Dir, File, Verify, Write) -> - snmp_config:append_config_file(Dir, File, Verify, Write). +append_config_file(Dir, File, Order, Check, Write, Conf) -> + snmp_config:append_config_file(Dir, File, Order, Check, Write, Conf). -read_config_file(Dir, File, Verify) -> - snmp_config:read_config_file(Dir, File, Verify). +read_config_file(Dir, File, Order, Check) -> + snmp_config:read_config_file(Dir, File, Order, Check). %% ---- config file utility functions ---- +check_ok(ok) -> + ok; +check_ok({ok, _}) -> + ok. + header() -> {Y,Mo,D} = date(), {H,Mi,S} = time(), - io_lib:format("%% This file was generated by " - "~w (version-~s) ~w-~2.2.0w-~2.2.0w " - "~2.2.0w:~2.2.0w:~2.2.0w\n", - [?MODULE, ?version, Y, Mo, D, H, Mi, S]). - + io_lib:format( + "%% This file was generated by " + "~w (version-~s) ~w-~2.2.0w-~2.2.0w " + "~2.2.0w:~2.2.0w:~2.2.0w\n", + [?MODULE, ?version, Y, Mo, D, H, Mi, S]). error(R) -> throw({error, R}). diff --git a/lib/snmp/src/agent/snmpa_local_db.erl b/lib/snmp/src/agent/snmpa_local_db.erl index f991244287..292c370d51 100644 --- a/lib/snmp/src/agent/snmpa_local_db.erl +++ b/lib/snmp/src/agent/snmpa_local_db.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1011,6 +1011,10 @@ table_construct_row(Name, RowIndex, Status, Cols) -> defvals = Defs, status_col = StatusCol, first_own_index = FirstOwnIndex, not_accessible = NoAccs} = snmp_generic:table_info(Name), + ?vtrace( + "table_construct_row Indexes: ~p~n" + " RowIndex: ~p", + [Indexes, RowIndex]), Keys = snmp_generic:split_index_to_keys(Indexes, RowIndex), OwnKeys = snmp_generic:get_own_indexes(FirstOwnIndex, Keys), Row = OwnKeys ++ snmp_generic:table_create_rest(length(OwnKeys) + 1, diff --git a/lib/snmp/src/agent/snmpa_mpd.erl b/lib/snmp/src/agent/snmpa_mpd.erl index 11ae806866..642b1f7fc5 100644 --- a/lib/snmp/src/agent/snmpa_mpd.erl +++ b/lib/snmp/src/agent/snmpa_mpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. %% %% The 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([init/1, reset/0, inc/1, counters/0, discarded_pdu/1, - process_packet/6, process_packet/7, + process_packet/5, process_packet/6, process_packet/7, generate_response_msg/5, generate_response_msg/6, generate_msg/5, generate_msg/6, generate_discovery_msg/4, @@ -113,22 +113,30 @@ reset() -> % length(snmp_pdus:enc_message(M)) + 4. %%----------------------------------------------------------------- -%% Func: process_packet(Packet, TDomain, TAddress, State, Log) -> +%% Func: process_packet(Packet, Domain, Address, State, Log) -> %% {ok, SnmpVsn, Pdu, PduMS, ACMData} | {discarded, Reason} %% Types: Packet = binary() -%% TDomain = snmpUDPDomain | transportDomain() -%% TAddress = {Ip, Udp} (*but* depends on TDomain) +%% Domain = snmpUDPDomain | transportDomain() +%% Address = {Ip, Udp} (*but* depends on Domain) %% State = #state %% Purpose: This is the main Message Dispatching function. (see %% section 4.2.1 in rfc2272) %%----------------------------------------------------------------- -process_packet(Packet, TDomain, TAddress, State, NoteStore, Log) -> +process_packet(Packet, From, State, NoteStore, Log) -> LocalEngineID = ?DEFAULT_LOCAL_ENGINE_ID, - process_packet(Packet, TDomain, TAddress, LocalEngineID, - State, NoteStore, Log). - -process_packet(Packet, TDomain, TAddress, LocalEngineID, - State, NoteStore, Log) -> + process_packet(Packet, From, LocalEngineID, State, NoteStore, Log). + +process_packet( + Packet, Domain, Address, LocalEngineID, State, NoteStore, Log) -> + From = {Domain, Address}, + process_packet(Packet, From, LocalEngineID, State, NoteStore, Log). + +process_packet(Packet, Domain, Address, State, NoteStore, Log) + when is_atom(Domain) -> + LocalEngineID = ?DEFAULT_LOCAL_ENGINE_ID, + From = {Domain, Address}, + process_packet(Packet, From, LocalEngineID, State, NoteStore, Log); +process_packet(Packet, From, LocalEngineID, State, NoteStore, Log) -> inc(snmpInPkts), case catch snmp_pdus:dec_message_only(binary_to_list(Packet)) of @@ -136,17 +144,17 @@ process_packet(Packet, TDomain, TAddress, LocalEngineID, when State#state.v1 =:= true -> ?vlog("v1, community: ~s", [Community]), HS = ?empty_msg_size + length(Community), - v1_v2c_proc('version-1', NoteStore, Community, - TDomain, TAddress, - LocalEngineID, Data, HS, Log, Packet); + v1_v2c_proc( + 'version-1', NoteStore, Community, From, + LocalEngineID, Data, HS, Log, Packet); #message{version = 'version-2', vsn_hdr = Community, data = Data} when State#state.v2c =:= true -> ?vlog("v2c, community: ~s", [Community]), HS = ?empty_msg_size + length(Community), - v1_v2c_proc('version-2', NoteStore, Community, - TDomain, TAddress, - LocalEngineID, Data, HS, Log, Packet); + v1_v2c_proc( + 'version-2', NoteStore, Community, From, + LocalEngineID, Data, HS, Log, Packet); #message{version = 'version-3', vsn_hdr = V3Hdr, data = Data} when State#state.v3 =:= true -> @@ -154,9 +162,9 @@ process_packet(Packet, TDomain, TAddress, LocalEngineID, [V3Hdr#v3_hdr.msgID, V3Hdr#v3_hdr.msgFlags, V3Hdr#v3_hdr.msgSecurityModel]), - v3_proc(NoteStore, Packet, - TDomain, TAddress, - LocalEngineID, V3Hdr, Data, Log); + v3_proc( + NoteStore, Packet, From, + LocalEngineID, V3Hdr, Data, Log); {'EXIT', {bad_version, Vsn}} -> ?vtrace("exit: bad version: ~p",[Vsn]), @@ -183,11 +191,32 @@ discarded_pdu(Variable) -> inc(Variable). %%----------------------------------------------------------------- %% Handles a Community based message (v1 or v2c). %%----------------------------------------------------------------- -v1_v2c_proc(Vsn, NoteStore, Community, Domain, - {Ip, Udp}, LocalEngineID, - Data, HS, Log, Packet) -> - TDomain = snmp_conf:mk_tdomain(Domain), - TAddress = snmp_conf:mk_taddress(Domain, Ip, Udp), +v1_v2c_proc( + Vsn, NoteStore, Community, From, + LocalEngineID, Data, HS, Log, Packet) -> + try + case From of + {D, A} when is_atom(D) -> + {snmp_conf:mk_tdomain(D), + snmp_conf:mk_taddress(D, A)}; + {_, P} = A when is_integer(P) -> + {snmp_conf:mk_tdomain(), + snmp_conf:mk_taddress(A)} + end + of + {TDomain, TAddress} -> + v1_v2c_proc_dec( + Vsn, NoteStore, Community, TDomain, TAddress, + LocalEngineID, Data, HS, Log, Packet) + catch + _ -> + {discarded, {badarg, From}} + end. + + +v1_v2c_proc_dec( + Vsn, NoteStore, Community, TDomain, TAddress, + LocalEngineID, Data, HS, Log, Packet) -> AgentMS = get_engine_max_message_size(LocalEngineID), MgrMS = snmp_community_mib:get_target_addr_ext_mms(TDomain, TAddress), PduMS = case MgrMS of @@ -214,7 +243,7 @@ v1_v2c_proc(Vsn, NoteStore, Community, Domain, case Pdu#pdu.type of 'set-request' -> %% Check if this message has already been processed - Key = {agent, Ip, ReqId}, + Key = {agent, {TDomain, TAddress}, ReqId}, case snmp_note_store:get_note(NoteStore, Key) of undefined -> %% Set the processed note _after_ pdu processing. @@ -236,13 +265,7 @@ v1_v2c_proc(Vsn, NoteStore, Community, Domain, {discarded, Reason}; _TrapPdu -> {discarded, trap_pdu} - end; -v1_v2c_proc(_Vsn, _NoteStore, _Community, snmpUDPDomain, TAddress, - _LocalEngineID, _Data, _HS, _Log, _Packet) -> - {discarded, {badarg, TAddress}}; -v1_v2c_proc(_Vsn, _NoteStore, _Community, TDomain, _TAddress, - _LocalEngineID, _Data, _HS, _Log, _Packet) -> - {discarded, {badarg, TDomain}}. + end. sec_model('version-1') -> ?SEC_V1; sec_model('version-2') -> ?SEC_V2C. @@ -252,8 +275,7 @@ sec_model('version-2') -> ?SEC_V2C. %% Handles a SNMPv3 Message, following the procedures in rfc2272, %% section 4.2 and 7.2 %%----------------------------------------------------------------- -v3_proc(NoteStore, Packet, _TDomain, _TAddress, LocalEngineID, - V3Hdr, Data, Log) -> +v3_proc(NoteStore, Packet, _From, LocalEngineID, V3Hdr, Data, Log) -> case (catch v3_proc(NoteStore, Packet, LocalEngineID, V3Hdr, Data, Log)) of {'EXIT', Reason} -> exit(Reason); @@ -999,7 +1021,7 @@ generate_discovery_msg(NoteStore, {TDomain, TAddress}, InitialUserName, ContextName, Timeout) -> - {ok, {_Domain, Address}} = transform_taddr(TDomain, TAddress), + {ok, {Domain, Address}} = transform_taddr(TDomain, TAddress), %% 7.1.7 ?vdebug("generate_discovery_msg -> 7.1.7 (~w)", [ManagerEngineID]), @@ -1041,7 +1063,7 @@ generate_discovery_msg(NoteStore, {TDomain, TAddress}, %% Log(Packet), inc_snmp_out_vars(Pdu), ?vdebug("generate_discovery_msg -> done", []), - {Packet, Address}; + {Domain, Address, Packet}; Error -> throw(Error) @@ -1081,8 +1103,22 @@ transform_taddr(?transportDomainUdpIpv4, [A, B, C, D, P1, P2]) -> {ok, {Domain, Address}}; transform_taddr(?transportDomainUdpIpv4, BadAddr) -> {error, {bad_transportDomainUdpIpv4_address, BadAddr}}; -transform_taddr(?transportDomainUdpIpv6, - [A1, A2, A3, A4, A5, A6, A7, A8, P1, P2]) -> +transform_taddr( + ?transportDomainUdpIpv6, + [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, + P1, P2]) -> + Domain = transportDomainUdpIpv6, + Addr = + {(A1 bsl 8) bor A2, (A3 bsl 8) bor A4, + (A5 bsl 8) bor A6, (A7 bsl 8) bor A8, + (A9 bsl 8) bor A10, (A11 bsl 8) bor A12, + (A13 bsl 8) bor A14, (A15 bsl 8) bor A16}, + Port = P1 bsl 8 + P2, + Address = {Addr, Port}, + {ok, {Domain, Address}}; +transform_taddr( + ?transportDomainUdpIpv6, + [A1, A2, A3, A4, A5, A6, A7, A8, P1, P2]) -> Domain = transportDomainUdpIpv6, Addr = {A1, A2, A3, A4, A5, A6, A7, A8}, Port = P1 bsl 8 + P2, @@ -1171,6 +1207,9 @@ mk_v1_v2_packet_list([{Domain, Addr} | T], %% Sending from default UDP port inc_snmp_out_vars(Pdu), Entry = {Domain, Addr, Packet}, + %% It would be cleaner to return {To, Packet} to not + %% break the abstraction for an address on the + %% {Domain, Address} format. mk_v1_v2_packet_list(T, Packet, Len, Pdu, [Entry | Acc]). @@ -1277,6 +1316,9 @@ mk_v3_packet_entry(NoteStore, Domain, Addr, req_id = Pdu#pdu.request_id}, snmp_note_store:set_note(NoteStore, 1500, CacheKey, CacheVal), inc_snmp_out_vars(Pdu), + %% It would be cleaner to return {To, Packet} to not + %% break the abstraction for an address on the + %% {Domain, Address} format. {ok, {Domain, Addr, Data}} end. diff --git a/lib/snmp/src/agent/snmpa_net_if.erl b/lib/snmp/src/agent/snmpa_net_if.erl index 79c85a6e4e..840d56d563 100644 --- a/lib/snmp/src/agent/snmpa_net_if.erl +++ b/lib/snmp/src/agent/snmpa_net_if.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -35,18 +35,27 @@ -include("snmp_debug.hrl"). -include("snmp_verbosity.hrl"). --record(state, {parent, - note_store, - master_agent, - usock, - usock_opts, - mpd_state, - log, - reqs = [], - debug = false, - limit = infinity, - rcnt = [], - filter}). +-record(state, + {parent, + note_store, + master_agent, + transports = [], +%% usock, +%% usock_opts, + mpd_state, + log, + reqs = [], + debug = false, + limit = infinity, +%% rcnt = [], + filter}). +%% domain = snmpUDPDomain}). + +-record(transport, + {socket, + domain = snmpUDPDomain, + opts = [], + req_refs = []}). -ifndef(default_verbosity). -define(default_verbosity,silence). @@ -104,13 +113,9 @@ get_request_limit(Pid) -> set_request_limit(Pid, NewLimit) -> call(Pid, {set_request_limit, NewLimit}). -get_port() -> - {value, UDPPort} = snmp_framework_mib:intAgentUDPPort(get), - UDPPort. - -get_address() -> - {value, IPAddress} = snmp_framework_mib:intAgentIpAddress(get), - IPAddress. +get_transports() -> + {value, Transports} = snmp_framework_mib:intAgentTransports(get), + Transports. filter_reset(Pid) -> Pid ! filter_reset. @@ -129,7 +134,22 @@ init(Prio, NoteStore, MasterAgent, Parent, Opts) -> case (catch do_init(Prio, NoteStore, MasterAgent, Parent, Opts)) of {ok, State} -> proc_lib:init_ack({ok, self()}), - loop(State); + try loop(State) + catch + C:E when C =/= exit, E =/= shutdown -> + Fmt = + "loop/1 EXCEPTION ~w:~w~n" + " ~p", + S = erlang:get_stacktrace(), + case C of + exit -> + %% Externally killed, root cause is elsewhere + info_msg(Fmt, [C, E, S]); + _ -> + error_msg(Fmt, [C, E, S]) + end, + erlang:raise(C, E, S) + end; {error, Reason} -> config_err("failed starting net-if: ~n~p", [Reason]), proc_lib:init_ack({error, Reason}); @@ -147,12 +167,6 @@ do_init(Prio, NoteStore, MasterAgent, Parent, Opts) -> put(verbosity,get_verbosity(Opts)), ?vlog("starting",[]), - %% -- Port and address -- - UDPPort = get_port(), - ?vdebug("port: ~w",[UDPPort]), - IPAddress = get_address(), - ?vdebug("addr: ~w",[IPAddress]), - %% -- Versions -- Vsns = get_vsns(Opts), ?vdebug("vsns: ~w",[Vsns]), @@ -162,39 +176,45 @@ do_init(Prio, NoteStore, MasterAgent, Parent, Opts) -> ?vdebug("Limit: ~w", [Limit]), FilterOpts = get_filter_opts(Opts), FilterMod = create_filter(FilterOpts), - ?vdebug("FilterMod: ~w", [FilterMod]), + ?vdebug("FilterMod: ~w FilterOpts: ~p", [FilterMod,FilterOpts]), %% -- Audit trail log Log = create_log(), ?vdebug("Log: ~w",[Log]), - - %% -- Socket -- - IPOpts1 = ip_opt_bind_to_ip_address(Opts, IPAddress), - IPOpts2 = ip_opt_no_reuse_address(Opts), - IPOpts3 = ip_opt_recbuf(Opts), - IPOpts4 = ip_opt_sndbuf(Opts), - IPOpts = [binary | IPOpts1 ++ IPOpts2 ++ IPOpts3 ++ IPOpts4], - ?vdebug("open socket with options: ~w",[IPOpts]), - case gen_udp_open(UDPPort, IPOpts) of - {ok, Sock} -> + DomainAddresses = get_transports(), + ?vdebug("DomainAddresses: ~w",[DomainAddresses]), + try + [begin + SocketOpts = socket_opts(Domain, Address, Opts), + Socket = socket_open(Domain, SocketOpts), + active_once(Socket), + #transport{ + socket = Socket, + domain = Domain, + opts = SocketOpts} + end || {Domain, Address} <- DomainAddresses] + of + [] -> + ?vinfo("No transports configured: ~p", [DomainAddresses]), + {error, {no_transports,DomainAddresses}}; + Transports -> MpdState = snmpa_mpd:init(Vsns), - init_counters(), - active_once(Sock), + init_counters(), S = #state{parent = Parent, note_store = NoteStore, master_agent = MasterAgent, mpd_state = MpdState, - usock = Sock, - usock_opts = IPOpts, + transports = Transports, log = Log, limit = Limit, filter = FilterMod}, ?vdebug("started with MpdState: ~p", [MpdState]), - {ok, S}; - {error, Reason} -> - ?vinfo("Failed to open UDP socket: ~p", [Reason]), - {error, {udp_open, UDPPort, Reason}} + {ok, S} + catch + Error -> + ?vinfo("Failed to initialize socket(s): ~p", [Error]), + {error, Error} end. @@ -250,48 +270,84 @@ create_filter(BadOpts) -> throw({error, {bad_filter_opts, BadOpts}}). -log({_, []}, _, _, _, _) -> +log({_, []}, _, _, _) -> ok; -log({Log, Types}, 'set-request', Packet, Addr, Port) -> +log({Log, Types}, 'set-request', Packet, Address) -> case lists:member(write, Types) of true -> - snmp_log:log(Log, Packet, Addr, Port); + snmp_log:log(Log, Packet, format_address(Address)); false -> ok end; -log({Log, Types}, _, Packet, Addr, Port) -> +log({Log, Types}, _, Packet, Address) -> case lists:member(read, Types) of true -> - snmp_log:log(Log, Packet, Addr, Port); + snmp_log:log(Log, Packet, format_address(Address)); false -> ok - end; -log(_, _, _, _, _) -> - ok. - - -gen_udp_open(Port, Opts) -> + end. + +format_address(Address) -> + iolist_to_binary(snmp_conf:mk_addr_string(Address)). + + +socket_open(snmpUDPDomain = Domain, [IpPort | Opts]) -> case init:get_argument(snmp_fd) of {ok, [[FdStr]]} -> Fd = list_to_integer(FdStr), - gen_udp:open(0, [{fd, Fd}|Opts]); + ?vdebug("socket_open(~p, [~p | ~p]) Fd: ~p", + [Domain, IpPort, Opts, Fd]), + gen_udp_open(IpPort, [{fd, Fd} | Opts]); error -> case init:get_argument(snmpa_fd) of {ok, [[FdStr]]} -> Fd = list_to_integer(FdStr), - gen_udp:open(0, [{fd, Fd}|Opts]); + ?vdebug("socket_open(~p, [~p | ~p]) Fd: ~p", + [Domain, IpPort, Opts, Fd]), + gen_udp_open(IpPort, [{fd, Fd} | Opts]); error -> - gen_udp:open(Port, Opts) + ?vdebug("socket_open(~p, [~p | ~p])", + [Domain, IpPort, Opts]), + gen_udp_open(IpPort, Opts) end + end; +socket_open(Domain, [IpPort | Opts]) + when Domain =:= transportDomainUdpIpv4; + Domain =:= transportDomainUdpIpv6 -> + ?vdebug("socket_open(~p, [~p | ~p])", [Domain, IpPort, Opts]), + gen_udp_open(IpPort, Opts); +socket_open(Domain, Opts) -> + throw({socket_open, Domain, Opts}). + +gen_udp_open(IpPort, Opts) -> + case gen_udp:open(IpPort, Opts) of + {ok, Socket} -> + Socket; + {error, Reason} -> + throw({udp_open, IpPort, Reason}) end. -loop(S) -> + +loop(#state{transports = Transports, limit = Limit, parent = Parent} = S) -> + ?vdebug("loop(~p)", [S]), receive - {udp, _UdpId, Ip, Port, Packet} -> - ?vlog("got paket from ~w:~w",[Ip,Port]), - NewS = maybe_handle_recv(S, Ip, Port, Packet), - loop(NewS); + {udp, Socket, IpAddr, IpPort, Packet} = Msg when is_port(Socket) -> + ?vlog("got paket from ~w:~w on ~w", [IpAddr, IpPort, Socket]), + case lists:keyfind(Socket, #transport.socket, Transports) of + #transport{socket = Socket, domain = Domain} = Transport -> + From = + case Domain of + snmpUDPDomain -> + {IpAddr, IpPort}; + _ -> + {Domain, {IpAddr, IpPort}} + end, + loop(maybe_handle_recv(S, Transport, From, Packet)); + false -> + error_msg("Packet on unknown port: ~p", [Msg]), + loop(S) + end; {info, ReplyRef, Pid} -> Info = get_info(S), @@ -299,47 +355,78 @@ loop(S) -> loop(S); %% response (to get/get_next/get_bulk/set requests) - {snmp_response, Vsn, RePdu, Type, ACMData, Dest, []} -> + {snmp_response, Vsn, RePdu, Type, ACMData, To, Extra} -> ?vlog("reply pdu: " "~n ~s", [?vapply(snmp_misc, format, [256, "~w", [RePdu]])]), - NewS = maybe_handle_reply_pdu(S, Vsn, RePdu, Type, ACMData, Dest), - loop(NewS); + {_, ReqRef} = lists:keyfind(request_ref, 1, Extra), + case + case + (Limit =/= infinity) andalso + select_transport_from_req_ref(ReqRef, Transports) + of + false -> + select_transport_from_domain( + address_to_domain(To), + Transports); + T -> + T + end + of + false -> + error_msg( + "Can not find transport for response PDU to: ~s", + [format_address(To)]), + loop(S); + Transport -> + NewS = update_req_counter_outgoing(S, Transport, ReqRef), + maybe_handle_reply_pdu( + NewS, Transport, Vsn, RePdu, Type, ACMData, To), + loop(NewS) + end; %% Traps/notification - {send_pdu, Vsn, Pdu, MsgData, To} -> - ?vdebug("send pdu: " - "~n Pdu: ~p" - "~n To: ~p", [Pdu, To]), - NewS = maybe_handle_send_pdu(S, Vsn, Pdu, MsgData, To, undefined), + {send_pdu, Vsn, Pdu, MsgData, TDomAddrs} -> + ?vdebug("send pdu:~n" + " Pdu: ~p~n" + " TDomAddrs: ~p", [Pdu, TDomAddrs]), + NewS = + maybe_handle_send_pdu( + S, Vsn, Pdu, MsgData, TDomAddrs, undefined), loop(NewS); %% We dont use the extra-info at this time, ... - {send_pdu, Vsn, Pdu, MsgData, To, _ExtraInfo} -> - ?vdebug("send pdu: " - "~n Pdu: ~p" - "~n To: ~p", [Pdu, To]), - NewS = maybe_handle_send_pdu(S, Vsn, Pdu, MsgData, To, undefined), + {send_pdu, Vsn, Pdu, MsgData, TDomAddrs, _ExtraInfo} -> + ?vdebug("send pdu:~n" + " Pdu: ~p~n" + " TDomAddrs: ~p", [Pdu, TDomAddrs]), + NewS = + maybe_handle_send_pdu( + S, Vsn, Pdu, MsgData, TDomAddrs, undefined), loop(NewS); %% Informs - {send_pdu_req, Vsn, Pdu, MsgData, To, From} -> - ?vdebug("send pdu request: " - "~n Pdu: ~p" - "~n To: ~p" - "~n From: ~p", - [Pdu, To, toname(From)]), - NewS = maybe_handle_send_pdu(S, Vsn, Pdu, MsgData, To, From), + {send_pdu_req, Vsn, Pdu, MsgData, TDomAddrs, From} -> + ?vdebug("send pdu request:~n" + " Pdu: ~p~n" + " TDomAddrs: ~p~n" + " From: ~p", + [Pdu, TDomAddrs, toname(From)]), + NewS = + maybe_handle_send_pdu( + S, Vsn, Pdu, MsgData, TDomAddrs, From), loop(NewS); %% We dont use the extra-info at this time, ... - {send_pdu_req, Vsn, Pdu, MsgData, To, From, _ExtraInfo} -> - ?vdebug("send pdu request: " - "~n Pdu: ~p" - "~n To: ~p" - "~n From: ~p", - [Pdu, To, toname(From)]), - NewS = maybe_handle_send_pdu(S, Vsn, Pdu, MsgData, To, From), + {send_pdu_req, Vsn, Pdu, MsgData, TDomAddrs, From, _ExtraInfo} -> + ?vdebug("send pdu request:~n" + " Pdu: ~p~n" + " TDomAddrs: ~p~n" + " From: ~p", + [Pdu, TDomAddrs, toname(From)]), + NewS = + maybe_handle_send_pdu( + S, Vsn, Pdu, MsgData, TDomAddrs, From), loop(NewS); %% Discovery Inform @@ -365,15 +452,34 @@ loop(S) -> NewS = handle_send_discovery(S, Pdu, MsgData, To, From), loop(NewS); - {discarded_pdu, _Vsn, ReqId, _ACMData, Variable, _Extra} -> - ?vdebug("discard PDU: ~p", [Variable]), + {discarded_pdu, _Vsn, ReqId, _ACMData, Variable, Extra} -> + ?vdebug("discard PDU: ~p - ~p - ~p", + [Variable, Extra, Transports]), snmpa_mpd:discarded_pdu(Variable), - NewS = update_req_counter_outgoing(S, ReqId), - loop(NewS); + {_, ReqRef} = lists:keyfind(request_ref, 1, Extra), + if + Limit =:= infinity -> + %% The incoming PDU was not registered + loop(update_req_counter_outgoing(S, false, ReqRef)); + true -> + case + select_transport_from_req_ref(ReqRef, Transports) + of + false -> + error_msg( + "Can not find transport for discarded PDU: ~p", + [ReqId]), + loop(S); + Transport -> + loop( + update_req_counter_outgoing( + S, Transport, ReqRef)) + end + end; {get_log_type, ReplyRef, Pid} -> ?vdebug("get log type: ~p", []), - #state{log = {_, LogType}} = S, + {_, LogType} = S#state.log, Pid ! {ReplyRef, {ok, LogType}, self()}, loop(S); @@ -385,7 +491,6 @@ loop(S) -> {get_request_limit, ReplyRef, Pid} -> ?vdebug("get request limit: ~p", []), - #state{limit = Limit} = S, Pid ! {ReplyRef, {ok, Limit}, self()}, loop(S); @@ -409,36 +514,50 @@ loop(S) -> reset_counters(), loop(S); - {'EXIT', Parent, Reason} when Parent == S#state.parent -> + {'EXIT', Parent, Reason} -> ?vlog("parent (~p) exited: " "~n ~p", [Parent, Reason]), exit(Reason); - {'EXIT', Port, Reason} when Port == S#state.usock -> - UDPPort = get_port(), - NewS = - case gen_udp_open(UDPPort, S#state.usock_opts) of - {ok, Id} -> - error_msg("Port ~p exited for reason" - "~n ~p" - "~n Re-opened (~p)", [Port, Reason, Id]), - S#state{usock = Id}; - {error, ReopenReason} -> - error_msg("Port ~p exited for reason" - "~n ~p" - "~n Re-open failed with reason" - "~n ~p", - [Port, Reason, ReopenReason]), - ok - end, - loop(NewS); - - {'EXIT', Port, Reason} when is_port(Port) -> - error_msg("Exit message from port ~p for reason ~p~n", - [Port, Reason]), - loop(S); - - {'EXIT', Pid, Reason} -> + {'EXIT', Socket, Reason} when is_port(Socket) -> + case lists:keyfind(Socket, #transport.socket, Transports) of + #transport{ + socket = Socket, + domain = Domain, + opts = SocketOpts, + req_refs = ReqRefs} = Transport -> + try socket_open(Domain, SocketOpts) of + NewSocket -> + error_msg( + "Socket ~p exited for reason" + "~n ~p" + "~n Re-opened (~p)", + [Socket, Reason, NewSocket]), + (length(ReqRefs) < Limit) andalso + active_once(NewSocket), + S#state{ + transports = + lists:keyreplace( + Socket, #transport.socket, Transports, + Transport#transport{socket = NewSocket})} + catch + ReopenReason -> + error_msg( + "Socket ~p exited for reason" + "~n ~p" + "~n Re-open failed with reason" + "~n ~p", + [Socket, Reason, ReopenReason]), + exit(ReopenReason) + end; + false -> + error_msg( + "Exit message from port ~p for reason ~p~n", + [Socket, Reason]), + loop(S) + end; + + {'EXIT', Pid, Reason} when is_pid(Pid) -> ?vlog("~p exited: " "~n ~p", [Pid, Reason]), NewS = clear_reqs(Pid, S), @@ -446,205 +565,321 @@ loop(S) -> {system, From, Msg} -> ?vdebug("system event ~p from ~p", [Msg, From]), - sys:handle_system_msg(Msg, From, S#state.parent, ?MODULE, [], S); + sys:handle_system_msg(Msg, From, Parent, ?MODULE, [], S); _ -> loop(S) end. -update_req_counter_incomming(#state{limit = infinity, usock = Sock} = S, _) -> - active_once(Sock), %% No limit so activate directly +update_req_counter_incoming( + #state{limit = infinity} = S, + #transport{socket = Socket}, + _ReqRef) -> + active_once(Socket), %% No limit so activate directly S; -update_req_counter_incomming(#state{limit = Limit, - rcnt = RCnt, - usock = Sock} = S, Rid) - when length(RCnt) + 1 == Limit -> +update_req_counter_incoming( + #state{limit = Limit} = S, + #transport{socket = Socket, req_refs = ReqRefs} = T, + ReqRef) when length(ReqRefs) + 1 >= Limit -> %% Ok, one more and we are at the limit. %% Just make sure we are not already processing this one... - case lists:member(Rid, RCnt) of + case lists:member(ReqRef, ReqRefs) of false -> %% We are at the limit, do _not_ activate socket - S#state{rcnt = [Rid|RCnt]}; + update_transport_req_refs(S, T, [ReqRef | ReqRefs]); true -> - active_once(Sock), + active_once(Socket), S end; -update_req_counter_incomming(#state{rcnt = RCnt, - usock = Sock} = S, Rid) -> - active_once(Sock), - case lists:member(Rid, RCnt) of +update_req_counter_incoming( + #state{} = S, + #transport{socket = Socket, req_refs = ReqRefs} = T, + ReqRef) -> + active_once(Socket), + case lists:member(ReqRef, ReqRefs) of false -> - S#state{rcnt = [Rid|RCnt]}; + update_transport_req_refs(S, T, [ReqRef | ReqRefs]); true -> S end. - -update_req_counter_outgoing(#state{limit = infinity} = S, _Rid) -> +update_req_counter_outgoing( + #state{limit = infinity} = S, + _Transport, _ReqRef) -> %% Already activated (in the incoming function) S; -update_req_counter_outgoing(#state{limit = Limit, - rcnt = RCnt, - usock = Sock} = S, Rid) - when length(RCnt) == Limit -> - ?vtrace("handle_req_counter_outgoing(~w) -> entry with" - "~n Rid: ~w" - "~n length(RCnt): ~w", [Limit, Rid, length(RCnt)]), - case lists:delete(Rid, RCnt) of - NewRCnt when length(NewRCnt) < Limit -> +update_req_counter_outgoing( + #state{limit = Limit} = S, + #transport{socket = Socket, req_refs = ReqRefs} = Transport, + ReqRef) -> + LengthReqRefs = length(ReqRefs), + ?vtrace("update_req_counter_outgoing() -> entry with~n" + " Limit: ~w~n" + " ReqRef: ~w~n" + " length(ReqRefs): ~w", [Limit, ReqRef, LengthReqRefs]), + NewReqRefs = lists:delete(ReqRef, ReqRefs), + (LengthReqRefs >= Limit) andalso (length(NewReqRefs) < Limit) andalso + begin ?vtrace("update_req_counter_outgoing -> " - "passed below limit: activate", []), - active_once(Sock), - S#state{rcnt = NewRCnt}; - _ -> - S - end; -update_req_counter_outgoing(#state{limit = Limit, rcnt = RCnt} = S, - Rid) -> - ?vtrace("handle_req_counter_outgoing(~w) -> entry with" - "~n Rid: ~w" - "~n length(RCnt): ~w", [Limit, Rid, length(RCnt)]), - NewRCnt = lists:delete(Rid, RCnt), - S#state{rcnt = NewRCnt}. - - -maybe_handle_recv(#state{usock = Sock, filter = FilterMod} = S, - Ip, Port, Packet) -> - case (catch FilterMod:accept_recv(Ip, Port)) of + "passed below limit: activate", []), + active_once(Socket) + end, + update_transport_req_refs(S, Transport, NewReqRefs). + +update_transport_req_refs( + #state{transports = Transports} = S, + #transport{socket = Socket} = T, + ReqRefs) -> + S#state{ + transports = + lists:keyreplace( + Socket, #transport.socket, Transports, + T#transport{req_refs = ReqRefs})}. + + +maybe_handle_recv( + #state{filter = FilterMod} = S, + #transport{socket = Socket} = Transport, + From, Packet) -> + {From_1, From_2} = From, + case + try FilterMod:accept_recv(From_1, From_2) + catch + Class:Exception -> + error_msg( + "FilterMod:accept_recv(~p, ~p) crashed: ~w:~w~n ~p", + [From_1,From_2,Class,Exception,erlang:get_stacktrace()]), + true + end + of false -> %% Drop the received packet inc(netIfMsgInDrops), - active_once(Sock), + active_once(Socket), S; - _ -> - handle_recv(S, Ip, Port, Packet) + Other -> + case Other of + true -> + ok; + _ -> + error_msg( + "FilterMod:accept_recv(~p, ~p) returned: ~p", + [From_1,From_2,Other]) + end, + handle_recv(S, Transport, From, Packet) end. -handle_discovery_response(_Ip, _Port, #pdu{request_id = ReqId} = Pdu, - ManagerEngineId, - #state{usock = Sock, reqs = Reqs} = S) -> - case lists:keysearch(ReqId, 1, S#state.reqs) of - {value, {_, Pid}} -> - active_once(Sock), - Pid ! {snmp_discovery_response_received, Pdu, ManagerEngineId}, - NReqs = lists:keydelete(ReqId, 1, Reqs), - S#state{reqs = NReqs}; - _ -> - %% Ouch, timeout? resend? - S - end. - -handle_recv(#state{usock = Sock, - mpd_state = MpdState, - note_store = NS, - log = Log} = S, Ip, Port, Packet) -> +handle_recv( + #state{mpd_state = MpdState, note_store = NS, log = Log} = S, + #transport{socket = Socket} = Transport, + From, Packet) -> put(n1, erlang:now()), - LogF = fun(Type, Data) -> - log(Log, Type, Data, Ip, Port) - end, - Domain = snmp_conf:which_domain(Ip), % What the ****... - case (catch snmpa_mpd:process_packet(Packet, - Domain, {Ip, Port}, - MpdState, NS, LogF)) of + LogF = + fun(Type, Data) -> + log(Log, Type, Data, From) + end, + case (catch snmpa_mpd:process_packet( + Packet, From, MpdState, NS, LogF)) of {ok, _Vsn, Pdu, _PduMS, {discovery, ManagerEngineId}} -> - handle_discovery_response(Ip, Port, Pdu, ManagerEngineId, S); + handle_discovery_response( + S, Transport, From, Pdu, ManagerEngineId); {ok, _Vsn, Pdu, _PduMS, discovery} -> - handle_discovery_response(Ip, Port, Pdu, undefined, S); + handle_discovery_response( + S, Transport, From, Pdu, undefined); {ok, Vsn, Pdu, PduMS, ACMData} -> ?vlog("got pdu ~s", [?vapply(snmp_misc, format, [256, "~w", [Pdu]])]), - %% handle_recv_pdu(Ip, Port, Vsn, Pdu, PduMS, ACMData, S); - maybe_handle_recv_pdu(Ip, Port, Vsn, Pdu, PduMS, ACMData, S); + %% handle_recv_pdu(S, Transport, From, Vsn, Pdu, PduMS, ACMData); + maybe_handle_recv_pdu( + S, Transport, From, Vsn, Pdu, PduMS, ACMData); {discarded, Reason} -> ?vlog("packet discarded for reason: ~s", [?vapply(snmp_misc, format, [256, "~w", [Reason]])]), - active_once(Sock), + active_once(Socket), S; {discarded, Reason, ReportPacket} -> ?vlog("sending report for reason: " "~n ~s", [?vapply(snmp_misc, format, [256, "~w", [Reason]])]), - (catch udp_send(S#state.usock, Ip, Port, ReportPacket)), - active_once(Sock), + (catch udp_send(Socket, From, ReportPacket)), + active_once(Socket), S; {discovery, ReportPacket} -> ?vlog("sending discovery report", []), - (catch udp_send(S#state.usock, Ip, Port, ReportPacket)), - active_once(Sock), + (catch udp_send(Socket, From, ReportPacket)), + active_once(Socket), S; Error -> error_msg("processing of received message failed: " "~n ~p", [Error]), - active_once(Sock), + active_once(Socket), S end. - -maybe_handle_recv_pdu(Ip, Port, Vsn, #pdu{type = Type} = Pdu, PduMS, ACMData, - #state{usock = Sock, filter = FilterMod} = S) -> - case (catch FilterMod:accept_recv_pdu(Ip, Port, Type)) of + +handle_discovery_response( + #state{reqs = Reqs} = S, + #transport{socket = Socket}, + _From, + #pdu{request_id = ReqId} = Pdu, + ManagerEngineId) -> + case lists:keyfind(ReqId, 1, S#state.reqs) of + {ReqId, Pid} -> + active_once(Socket), + Pid ! {snmp_discovery_response_received, Pdu, ManagerEngineId}, + %% XXX Strange... Reqs from this Pid should be reaped + %% at process exit by clear_reqs/2 so the following + %% should be redundant. + NReqs = lists:keydelete(ReqId, 1, Reqs), + S#state{reqs = NReqs}; + false -> + %% Ouch, timeout? resend? + S + end. + +maybe_handle_recv_pdu( + #state{filter = FilterMod} = S, + #transport{socket = Socket} = Transport, + From, Vsn, + #pdu{type = Type} = Pdu, PduMS, ACMData) -> + {From_1, From_2} = From, + case + try FilterMod:accept_recv_pdu(From_1, From_2, Type) + catch + Class:Exception -> + error_msg( + "FilterMod:accept_recv_pdu(~p, ~p, ~p) crashed: ~w:~w~n" + " ~p", + [From_1,From_2,Type,Class,Exception, + erlang:get_stacktrace()]), + true + end + of false -> inc(netIfPduInDrops), - active_once(Sock), - ok; - _ -> - handle_recv_pdu(Ip, Port, Vsn, Pdu, PduMS, ACMData, S) - end; -maybe_handle_recv_pdu(Ip, Port, Vsn, Pdu, PduMS, ACMData, S) -> - handle_recv_pdu(Ip, Port, Vsn, Pdu, PduMS, ACMData, S). + active_once(Socket), + S; + Other -> + case Other of + true -> + ok; + _ -> + error_msg( + "FilterMod:accept_recv_pdu(~p, ~p, ~p) returned: ~p", + [From_1,From_2,Type,Other]) + end, + handle_recv_pdu(S, Transport, From, Vsn, Pdu, PduMS, ACMData) + end. -handle_recv_pdu(Ip, Port, Vsn, #pdu{type = 'get-response'} = Pdu, - _PduMS, _ACMData, #state{usock = Sock} = S) -> - active_once(Sock), - handle_response(Vsn, Pdu, {Ip, Port}, S), +handle_recv_pdu( + #state{reqs = Reqs} = S, + #transport{socket = Socket}, + From, Vsn, + #pdu{type = 'get-response', request_id = ReqId} = Pdu, + _PduMS, _ACMData) -> + active_once(Socket), + case lists:keyfind(ReqId, 1, Reqs) of + {ReqId, Pid} -> + ?vdebug("handle_recv_pdu -> " + "~n send response to receiver ~p", [Pid]), + Pid ! {snmp_response_received, Vsn, Pdu, From}; + false -> + ?vdebug("handle_recv_pdu -> " + "~n No receiver available for response pdu", []) + end, S; -handle_recv_pdu(Ip, Port, Vsn, #pdu{request_id = Rid, type = Type} = Pdu, - PduMS, ACMData, #state{master_agent = Pid} = S) - when ((Type =:= 'get-request') orelse - (Type =:= 'get-next-request') orelse - (Type =:= 'get-bulk-request')) -> - ?vtrace("handle_recv_pdu -> received get (~w)", [Type]), - Pid ! {snmp_pdu, Vsn, Pdu, PduMS, ACMData, {Ip, Port}, []}, - update_req_counter_incomming(S, Rid); -handle_recv_pdu(Ip, Port, Vsn, Pdu, PduMS, ACMData, - #state{usock = Sock, master_agent = Pid} = S) -> +handle_recv_pdu( + #state{master_agent = Pid} = S, + #transport{} = Transport, + From, Vsn, + #pdu{type = Type} = Pdu, + PduMS, ACMData) + when Type =:= 'set-request'; + Type =:= 'get-request'; + Type =:= 'get-next-request'; + Type =:= 'get-bulk-request' -> + ?vtrace("handle_recv_pdu -> received request (~w)", [Type]), + ReqRef = make_ref(), + Extra = [{request_ref, ReqRef}], + Pid ! {snmp_pdu, Vsn, Pdu, PduMS, ACMData, From, Extra}, + NewS = update_req_counter_incoming(S, Transport, ReqRef), + ?vdebug("handle_recv_pdu -> ~p", [NewS]), + NewS; +handle_recv_pdu( + #state{master_agent = Pid} = S, + #transport{socket = Socket}, + From, Vsn, Pdu, PduMS, ACMData) -> ?vtrace("handle_recv_pdu -> received other request", []), - active_once(Sock), - Pid ! {snmp_pdu, Vsn, Pdu, PduMS, ACMData, {Ip, Port}, []}, + active_once(Socket), + Pid ! {snmp_pdu, Vsn, Pdu, PduMS, ACMData, From, []}, S. -maybe_handle_reply_pdu(#state{filter = FilterMod} = S, Vsn, - #pdu{request_id = Rid} = Pdu, - Type, ACMData, {Ip, Port} = Dest) -> - S1 = update_req_counter_outgoing(S, Rid), - case (catch FilterMod:accept_send_pdu([{Ip, Port}], Type)) of +maybe_handle_reply_pdu( + #state{filter = FilterMod, transports = Transports} = S, + #transport{} = Transport, + Vsn, + #pdu{} = Pdu, + Type, ACMData, To) -> + %% + Addresses = [fix_filter_address(Transports, To)], + case + try + FilterMod:accept_send_pdu(Addresses, Type) + catch + Class:Exception -> + error_msg( + "FilterMod:accept_send_pdu(~p, ~p) crashed: ~w:~w~n ~p", + [Addresses, Type, Class, Exception, + erlang:get_stacktrace()]), + true + end + of false -> inc(netIfPduOutDrops), ok; - _ -> - handle_reply_pdu(S1, Vsn, Pdu, Type, ACMData, Dest) - end, - S1. - -handle_reply_pdu(#state{log = Log, - usock = Sock, - filter = FilterMod}, - Vsn, Pdu, Type, ACMData, {Ip, Port}) -> - LogF = fun(Type2, Data) -> - log(Log, Type2, Data, Ip, Port) - end, + Other -> + case Other of + true -> + ok; + _ -> + error_msg( + "FilterMod:accept_send_pdu(~p, ~p) returned: ~p", + [Addresses,Type,Other]) + end, + handle_reply_pdu(S, Transport, Vsn, Pdu, Type, ACMData, To) + end. + +handle_reply_pdu( + #state{log = Log} = S, + #transport{} = Transport, + Vsn, + #pdu{} = Pdu, + Type, ACMData, To) -> + %% + LogF = + fun(Type2, Data) -> + log(Log, Type2, Data, To) + end, case (catch snmpa_mpd:generate_response_msg(Vsn, Pdu, Type, ACMData, LogF)) of {ok, Packet} -> ?vinfo("time in agent: ~w mysec", [time_in_agent()]), - maybe_udp_send(FilterMod, Sock, Ip, Port, Packet); + try maybe_udp_send(S, Transport, To, Packet) + catch + {Reason, Sz} -> + error_msg("Cannot send message " + "~n size: ~p" + "~n reason: ~p" + "~n pdu: ~p", + [Sz, Reason, Pdu]) + end; {discarded, Reason} -> ?vlog("handle_reply_pdu -> " "~n reply discarded for reason: ~s", @@ -652,105 +887,116 @@ handle_reply_pdu(#state{log = Log, ok; {'EXIT', Reason} -> user_err("failed generating response message: " - "~nPDU: ~w~n~w", [Pdu, Reason]) + "~nPDU: ~p~n~p", [Pdu, Reason]) end. - -process_taddrs(To) -> - process_taddrs(To, []). -process_taddrs([], Acc) -> - lists:reverse(Acc); -%% v3 -process_taddrs([{{_Domain, AddrAndPort}, _SecData}|T], Acc) -> - process_taddrs(T, [AddrAndPort|Acc]); -%% v1 & v2 -process_taddrs([{_Domain, AddrAndPort}|T], Acc) -> - process_taddrs(T, [AddrAndPort|Acc]). -merge_taddrs(To1, To2) -> - merge_taddrs(To1, To2, []). +maybe_handle_send_pdu( + #state{filter = FilterMod, transports = Transports} = S, + Vsn, Pdu, MsgData, TDomAddrSecs, From) -> -merge_taddrs([], _To2, Acc) -> - lists:reverse(Acc); -%% v3 -merge_taddrs([{{_, AddrAndPort}, _} = H|To1], To2, Acc) -> - case lists:member(AddrAndPort, To2) of - true -> - merge_taddrs(To1, To2, [H|Acc]); - false -> - merge_taddrs(To1, To2, Acc) - end; -%% v1 & v2 -merge_taddrs([{_, AddrAndPort} = H|To1], To2, Acc) -> - case lists:member(AddrAndPort, To2) of - true -> - merge_taddrs(To1, To2, [H|Acc]); - false -> - merge_taddrs(To1, To2, Acc) - end; -merge_taddrs([_Crap|To1], To2, Acc) -> - merge_taddrs(To1, To2, Acc). - - -maybe_handle_send_pdu(#state{filter = FilterMod} = S, - Vsn, Pdu, MsgData, To0, From) -> + ?vtrace("maybe_handle_send_pdu -> entry with~n" + " FilterMod: ~p~n" + " TDomAddrSecs: ~p", [FilterMod, TDomAddrSecs]), - ?vtrace("maybe_handle_send_pdu -> entry with" - "~n FilterMod: ~p" - "~n To0: ~p", [FilterMod, To0]), - - To1 = snmpa_mpd:process_taddrs(To0), - To2 = process_taddrs(To1), + DomAddrSecs = snmpa_mpd:process_taddrs(TDomAddrSecs), + AddressesToFilter = + case is_legacy_transports(Transports) of + true -> + [fix_filter_legacy_mpd_address(DAS) + || DAS <- DomAddrSecs]; + false -> + [fix_filter_mpd_address(DAS) + || DAS <- DomAddrSecs] + end, - case (catch FilterMod:accept_send_pdu(To2, pdu_type_of(Pdu))) of + Type = pdu_type_of(Pdu), + + case + try FilterMod:accept_send_pdu(AddressesToFilter, Type) + catch + Class:Exception -> + error_msg( + "FilterMod:accept_send_pdu(~p, ~p) crashed: ~w:~w~n ~p", + [AddressesToFilter,Type, + Class,Exception,erlang:get_stacktrace()]), + true + end + of false -> inc(netIfPduOutDrops), ok; true -> - handle_send_pdu(S, Vsn, Pdu, MsgData, To1, From); - To3 when is_list(To3) -> - To4 = merge_taddrs(To1, To3), - ?vtrace("maybe_handle_send_pdu -> To4: " - "~n ~p", [To4]), - handle_send_pdu(S, Vsn, Pdu, MsgData, To4, From); - _ -> - handle_send_pdu(S, Vsn, Pdu, MsgData, To1, From) + handle_send_pdu(S, Vsn, Pdu, MsgData, DomAddrSecs, From); + FilteredAddresses when is_list(FilteredAddresses) -> + FilteredDomAddrSecs = + case is_legacy_transports(Transports) of + true -> + [DAS || + DAS <- DomAddrSecs, + lists:member( + fix_filter_legacy_mpd_address(DAS), + FilteredAddresses)]; + false -> + [DAS || + DAS <- DomAddrSecs, + lists:member( + fix_filter_mpd_address(DAS), + FilteredAddresses)] + end, + ?vtrace("maybe_handle_send_pdu -> FilteredDomAddrSecs:~n" + " ~p", [FilteredDomAddrSecs]), + handle_send_pdu(S, Vsn, Pdu, MsgData, FilteredDomAddrSecs, From); + Other -> + error_msg( + "FilterMod:accept_send_pdu(~p, ~p) returned: ~p", + [AddressesToFilter,Type,Other]), + handle_send_pdu(S, Vsn, Pdu, MsgData, DomAddrSecs, From) end. -handle_send_pdu(#state{note_store = NS} = S, Vsn, Pdu, MsgData, To, From) -> - - ?vtrace("handle_send_pdu -> entry with" - "~n Pdu: ~p" - "~n To: ~p", [Pdu, To]), +handle_send_pdu( + #state{note_store = NS} = S, + Vsn, Pdu, MsgData, DomAddrSecs, From) -> + %% + ?vtrace("handle_send_pdu -> entry with~n" + " Pdu: ~p~n" + " DomAddrSecs: ~p", [Pdu, DomAddrSecs]), - case (catch snmpa_mpd:generate_msg(Vsn, NS, Pdu, MsgData, To)) of + case (catch snmpa_mpd:generate_msg( + Vsn, NS, Pdu, MsgData, DomAddrSecs)) of {ok, Addresses} -> - handle_send_pdu(S, Pdu, Addresses); + do_handle_send_pdu(S, Pdu, Addresses); {discarded, Reason} -> ?vlog("handle_send_pdu -> " "~n PDU ~p not sent due to ~p", [Pdu, Reason]), ok; {'EXIT', Reason} -> user_err("failed generating message: " - "~nPDU: ~w~n~w", [Pdu, Reason]), + "~nPDU: ~p~n~p", [Pdu, Reason]), ok end, case From of undefined -> S; - Pid -> + Pid when is_pid(Pid) -> ?vtrace("link to ~p and add to request list", [Pid]), link(Pid), - NReqs = snmp_misc:keyreplaceadd(Pid, 2, S#state.reqs, - {Pdu#pdu.request_id, From}), + NReqs = + snmp_misc:keyreplaceadd( + Pid, 2, S#state.reqs, {Pdu#pdu.request_id, From}), S#state{reqs = NReqs} end. -handle_send_discovery(#state{note_store = NS} = S, - Pdu, MsgData, - To, From) -> +handle_send_discovery( + #state{ + note_store = NS, + log = Log, + reqs = Reqs, + transports = Transports} = S, + #pdu{type = Type, request_id = ReqId} = Pdu, + MsgData, To, From) when is_pid(From) -> ?vtrace("handle_send_discovery -> entry with" "~n Pdu: ~p" @@ -759,155 +1005,173 @@ handle_send_discovery(#state{note_store = NS} = S, "~n From: ~p", [Pdu, MsgData, To, From]), case (catch snmpa_mpd:generate_discovery_msg(NS, Pdu, MsgData, To)) of - {ok, {Packet, {Ip, Port}}} -> - handle_send_discovery(S, Pdu, Packet, Ip, Port, From); + {ok, {Domain, Address, Packet}} -> + case select_transport_from_domain(Domain, Transports) of + false -> + error_msg( + "Can not find transport to: ~s", + [format_address(To)]), + S; + #transport{socket = Socket} -> + log(Log, Type, Packet, {Domain, Address}), + udp_send(Socket, {Domain, Address}, Packet), + ?vtrace("handle_send_discovery -> sent (~w)", [ReqId]), + NReqs = snmp_misc:keyreplaceadd(From, 2, Reqs, {ReqId, From}), + S#state{reqs = NReqs} + end; {discarded, Reason} -> ?vlog("handle_send_discovery -> " "~n Discovery PDU ~p not sent due to ~p", [Pdu, Reason]), - ok; + S; {'EXIT', Reason} -> user_err("failed generating discovery message: " - "~n PDU: ~w" - "~n Reason: ~w", [Pdu, Reason]), - ok + "~n PDU: ~p" + "~n Reason: ~p", [Pdu, Reason]), + S end. -handle_send_discovery(#state{log = Log, - usock = Sock, - reqs = Reqs} = S, - #pdu{type = Type, - request_id = ReqId}, - Packet, Ip, Port, From) - when is_binary(Packet) -> - log(Log, Type, Packet, Ip, Port), - udp_send(Sock, Ip, Port, Packet), - ?vtrace("handle_send_discovery -> sent (~w)", [ReqId]), - NReqs = snmp_misc:keyreplaceadd(From, 2, Reqs, {ReqId, From}), - S#state{reqs = NReqs}. +do_handle_send_pdu(S, #pdu{type = Type} = Pdu, Addresses) -> + do_handle_send_pdu(S, Type, Pdu, Addresses); +do_handle_send_pdu(S, Trap, Addresses) -> + do_handle_send_pdu(S, trappdu, Trap, Addresses). -handle_send_pdu(S, #pdu{type = Type} = Pdu, Addresses) -> - handle_send_pdu(S, Type, Pdu, Addresses); -handle_send_pdu(S, Trap, Addresses) -> - handle_send_pdu(S, trappdu, Trap, Addresses). - -handle_send_pdu(S, Type, Pdu, Addresses) -> - case (catch handle_send_pdu1(S, Type, Addresses)) of +do_handle_send_pdu(S, Type, Pdu, Addresses) -> + try do_handle_send_pdu1(S, Type, Addresses) + catch {Reason, Sz} -> - error_msg("Cannot send message " - "~n size: ~p" - "~n reason: ~p" - "~n pdu: ~p", - [Sz, Reason, Pdu]); - _ -> - ok - end. - -handle_send_pdu1(#state{log = Log, - usock = Sock, - filter = FilterMod}, Type, Addresses) -> - SendFun = - fun({snmpUDPDomain, {Ip, Port}, Packet}) - when is_binary(Packet) -> - ?vdebug("[snmpUDPDomain] sending packet:" - "~n size: ~p" - "~n to: ~p:~p", - [sz(Packet), Ip, Port]), - maybe_udp_send(FilterMod, Log, Type, Sock, Ip, Port, Packet); - - ({snmpUDPDomain, {Ip, Port}, {Packet, _LogData}}) - when is_binary(Packet) -> - ?vdebug("[snmpUDPDomain] sending encrypted packet:" - "~n size: ~p" - "~n to: ~p:~p", - [sz(Packet), Ip, Port]), - maybe_udp_send(FilterMod, Log, Type, Sock, Ip, Port, Packet); - - ({transportDomainUdpIpv4, {Ip, Port}, Packet}) - when is_binary(Packet) -> - ?vdebug("[transportDomainUdpIpv4] sending packet:" - "~n size: ~p" - "~n to: ~p:~p", - [sz(Packet), Ip, Port]), - maybe_udp_send(FilterMod, Log, Type, Sock, Ip, Port, Packet); - - ({transportDomainUdpIpv4, {Ip, Port}, {Packet, _LogData}}) - when is_binary(Packet) -> - ?vdebug("[transportDomainUdpIpv4] sending encrypted packet:" - "~n size: ~p" - "~n to: ~p:~p", - [sz(Packet), Ip, Port]), - maybe_udp_send(FilterMod, Log, Type, Sock, Ip, Port, Packet); - - ({transportDomainUdpIpv6, {Ip, Port}, Packet}) - when is_binary(Packet) -> - ?vdebug("[transportDomainUdpIpv6] sending packet:" - "~n size: ~p" - "~n to: ~p:~p", - [sz(Packet), Ip, Port]), - maybe_udp_send(FilterMod, Log, Type, Sock, Ip, Port, Packet); - - ({transportDomainUdpIpv6, {Ip, Port}, {Packet, _LogData}}) - when is_binary(Packet) -> - ?vdebug("[transportDomainUdpIpv6] sending encrypted packet:" - "~n size: ~p" - "~n to: ~p:~p", - [sz(Packet), Ip, Port]), - maybe_udp_send(FilterMod, Log, Type, Sock, Ip, Port, Packet); - - (_X) -> - ?vlog("** bad res: ~p", [_X]), - ok - end, - lists:foreach(SendFun, Addresses). - - -handle_response(Vsn, Pdu, From, S) -> - case lists:keysearch(Pdu#pdu.request_id, 1, S#state.reqs) of - {value, {_, Pid}} -> - ?vdebug("handle_response -> " - "~n send response to receiver ~p", [Pid]), - Pid ! {snmp_response_received, Vsn, Pdu, From}; - _ -> - ?vdebug("handle_response -> " - "~n No receiver available for response pdu", []) + error_msg( + "Can not send message~n" + " size: ~p~n" + " reason: ~p~n" + " pdu: ~p", + [Sz, Reason, Pdu]) end. -maybe_udp_send(FilterMod, Sock, Ip, Port, Packet) -> - case (catch FilterMod:accept_send(Ip, Port)) of +do_handle_send_pdu1( + #state{transports = Transports} = S, + Type, Addresses) -> + lists:foreach( + fun ({Domain, Address, Packet}) when is_binary(Packet) -> + ?vdebug( + "[~w] sending packet:~n" + " size: ~p~n" + " to: ~p", [Domain, sz(Packet), Address]), + To = {Domain, Address}, + case select_transport_from_domain(Domain, Transports) of + false -> + error_msg( + "Can not find transport~n" + " size: ~p~n" + " to: ~s", + [sz(Packet), format_address(To)]); + Transport -> + maybe_udp_send(S, Transport, To, Packet) + end; + ({Domain, Address, {Packet, LogData}}) when is_binary(Packet) -> + ?vdebug( + "[~w] sending encrypted packet:~n" + " size: ~p~n" + " to: ~p", [Domain, sz(Packet), Address]), + To = {Domain, Address}, + case select_transport_from_domain(Domain, Transports) of + false -> + error_msg( + "Can not find transport~n" + " size: ~p~n" + " to: ~s", + [sz(Packet), format_address(To)]); + Transport -> + maybe_udp_send(S, Transport, To, Packet, Type, LogData) + end + end, + Addresses). + +maybe_udp_send( + #state{filter = FilterMod, transports = Transports}, + #transport{socket = Socket}, + To, Packet) -> + {To_1, To_2} = fix_filter_address(Transports, To), + case + try FilterMod:accept_send(To_1, To_2) + catch + Class:Exception -> + error_msg( + "FilterMod:accept_send(~p, ~p) crashed: ~w:~w~n ~p", + [To_1,To_2,Class,Exception,erlang:get_stacktrace()]), + true + end + of false -> inc(netIfMsgOutDrops), ok; - _ -> - (catch udp_send(Sock, Ip, Port, Packet)) + Other -> + case Other of + true -> + ok; + _ -> + error_msg( + "FilterMod:accept_send(~p, ~p) returned: ~p", + [To_1,To_2,Other]) + end, + udp_send(Socket, To, Packet) end. -maybe_udp_send(FilterMod, AtLog, Type, Sock, Ip, Port, Packet) -> - case (catch FilterMod:accept_send(Ip, Port)) of +maybe_udp_send( + #state{log = Log, filter = FilterMod, transports = Transports}, + #transport{socket = Socket}, + To, Packet, Type, _LogData) -> + {To_1, To_2} = fix_filter_address(Transports, To), + case + try FilterMod:accept_send(To_1, To_2) + catch + Class:Exception -> + error_msg( + "FilterMod:accept_send(~p, ~p) crashed for: ~w:~w~n ~p", + [To_1, To_2, Class, Exception, erlang:get_stacktrace()]), + true + end + of false -> inc(netIfMsgOutDrops), ok; - _ -> - log(AtLog, Type, Packet, Ip, Port), - (catch udp_send(Sock, Ip, Port, Packet)) + Other -> + case Other of + true -> + ok; + _ -> + error_msg( + "FilterMod:accept_send(~p, ~p) returned: ~p", + [To_1,To_2,Other]) + end, + log(Log, Type, Packet, To), + udp_send(Socket, To, Packet) end. - -udp_send(UdpId, AgentIp, UdpPort, B) -> - case (catch gen_udp:send(UdpId, AgentIp, UdpPort, B)) of +udp_send(Socket, To, B) -> + {IpAddr, IpPort} = + case To of + {Domain, Addr} when is_atom(Domain) -> + Addr; + {_, P} = Addr when is_integer(P) -> + Addr + end, + try gen_udp:send(Socket, IpAddr, IpPort, B) of {error, emsgsize} -> %% From this message we cannot recover, so exit sending loop throw({emsgsize, sz(B)}); {error, ErrorReason} -> error_msg("[error] cannot send message " "(destination: ~p:~p, size: ~p, reason: ~p)", - [AgentIp, UdpPort, sz(B), ErrorReason]); - {'EXIT', ExitReason} -> - error_msg("[exit] cannot send message " - "(destination: ~p:~p, size: ~p, reason: ~p)", - [AgentIp, UdpPort, sz(B), ExitReason]); - _ -> + [IpAddr, IpPort, sz(B), ErrorReason]); + ok -> ok + catch + error:ExitReason -> + error_msg("[exit] cannot send message " + "(destination: ~p:~p, size: ~p, reason: ~p, at: ~p)", + [IpAddr, IpPort, sz(B), ExitReason, + erlang:get_stacktrace()]) end. sz(L) when is_list(L) -> length(L); @@ -957,6 +1221,75 @@ active_once(Sock) -> inet:setopts(Sock, [{active, once}]). +select_transport_from_req_ref(_, []) -> + false; +select_transport_from_req_ref( + ReqRef, + [#transport{req_refs = ReqRefs} = Transport | Transports]) -> + case lists:member(ReqRef, ReqRefs) of + true -> + Transport; + false -> + select_transport_from_req_ref(ReqRef, Transports) + end. + +select_transport_from_domain(Domain, Transports) when is_atom(Domain) -> + Pos = #transport.domain, + case lists:keyfind(Domain, Pos, Transports) of + #transport{domain = Domain} = Transport -> + Transport; + false when Domain == snmpUDPDomain -> + lists:keyfind(transportDomainUdpIpv4, Pos, Transports); + false when Domain == transportDomainUdpIpv4 -> + lists:keyfind(snmpUDPDomain, Pos, Transports); + false -> + false + end. + +address_to_domain({Domain, _Addr}) when is_atom(Domain) -> + Domain; +address_to_domain({_Ip, Port}) when is_integer(Port) -> + snmpUDPDomain. + +%% If the agent uses legacy snmpUDPDomain e.g has not set +%% intAgentTransportDomain, then make sure +%% snmpa_network_interface_filter gets legacy arguments +%% to not break backwards compatibility. +%% +fix_filter_address(Transports, Address) -> + case is_legacy_transports(Transports) of + true -> + case Address of + {Domain, Addr} when is_atom(Domain) -> + Addr; + {_, IpPort} = Addr when is_integer(IpPort) -> + Addr + end; + false -> + Address + end. + +is_legacy_transports([#transport{domain = snmpUDPDomain}]) -> + true; +is_legacy_transports([#transport{} | _]) -> + false. + +fix_filter_legacy_mpd_address(Domain_Address_SecData) -> + case Domain_Address_SecData of + {{Domain, Addr}, _SecData} when is_atom(Domain) -> % v3 + Addr; + {Domain, Addr} when is_atom(Domain) -> % v1 & v2 + Addr + end. + +fix_filter_mpd_address(Domain_Address_SecData) -> + case Domain_Address_SecData of + {{Domain, _Addr} = Address, _SecData} when is_atom(Domain) -> % v3 + Address; + {Domain, _Addr} = Address when is_atom(Domain) -> % v1 & v2 + Address + end. + %%%----------------------------------------------------------------- handle_set_log_type(#state{log = {Log, OldValue}} = State, NewType) @@ -1113,37 +1446,39 @@ get_counters([Counter|Counters], Acc) -> %% ---------------------------------------------------------------- -ip_opt_bind_to_ip_address(Opts, Ip) -> - case get_bind_to_ip_address(Opts) of - true -> - [{ip, list_to_tuple(Ip)}]; - _ -> - [] - end. - -ip_opt_no_reuse_address(Opts) -> - case get_no_reuse_address(Opts) of - false -> - [{reuseaddr, true}]; - _ -> - [] - end. - -ip_opt_recbuf(Opts) -> - case get_recbuf(Opts) of - use_default -> - []; - Sz -> - [{recbuf, Sz}] - end. - -ip_opt_sndbuf(Opts) -> - case get_sndbuf(Opts) of - use_default -> - []; - Sz -> - [{sndbuf, Sz}] - end. +socket_opts(Domain, {IpAddr, IpPort}, Opts) -> + [IpPort, % Picked off at socket open, separate argument + binary + | case snmp_conf:tdomain_to_family(Domain) of + inet6 = Family -> + [Family, {ipv6_v6only, true}]; + Family -> + [Family] + end ++ + case get_bind_to_ip_address(Opts) of + true -> + [{ip, IpAddr}]; + _ -> + [] + end ++ + case get_no_reuse_address(Opts) of + false -> + [{reuseaddr, true}]; + _ -> + [] + end ++ + case get_recbuf(Opts) of + use_default -> + []; + Sz -> + [{recbuf, Sz}] + end ++ + case get_sndbuf(Opts) of + use_default -> + []; + Sz -> + [{sndbuf, Sz}] + end]. %% ---------------------------------------------------------------- @@ -1203,6 +1538,9 @@ get_bind_to_ip_address(Opts) -> error_msg(F,A) -> ?snmpa_error("NET-IF server: " ++ F, A). +info_msg(F,A) -> + ?snmpa_info("NET-IF server: " ++ F, A). + %% --- user_err(F, A) -> @@ -1227,14 +1565,14 @@ call(Pid, Req) -> %% ---------------------------------------------------------------- -get_info(#state{usock = Id, reqs = Reqs}) -> +get_info(#state{transports = Transports, reqs = Reqs}) -> ProcSize = proc_mem(self()), - PortInfo = get_port_info(Id), Counters = get_counters(), - [{reqs, Reqs}, - {counters, Counters}, - {process_memory, ProcSize}, - {port_info, PortInfo}]. + [{reqs, Reqs}, + {counters, Counters}, + {process_memory, ProcSize} + | [{port_info, get_port_info(Socket)} + || #transport{socket = Socket} <- Transports]]. proc_mem(P) when is_pid(P) -> case (catch erlang:process_info(P, memory)) of diff --git a/lib/snmp/src/agent/snmpa_net_if_filter.erl b/lib/snmp/src/agent/snmpa_net_if_filter.erl index 989f7c95b3..dd77b143d0 100644 --- a/lib/snmp/src/agent/snmpa_net_if_filter.erl +++ b/lib/snmp/src/agent/snmpa_net_if_filter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. All Rights Reserved. %% %% The 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,35 +18,49 @@ %% -module(snmpa_net_if_filter). --export([accept_recv/2, - accept_send/2, - accept_recv_pdu/3, - accept_send_pdu/2]). +%% Behaviour +-export([accept_recv/2, accept_send/2, accept_recv_pdu/3, accept_send_pdu/2]). -include("snmp_debug.hrl"). -accept_recv(_Addr, _Port) -> - ?d("accept_recv -> entry with" - "~n Addr: ~p" - "~n Port: ~p", [_Addr, _Port]), +accept_recv(Domain, _Address) when is_atom(Domain) -> + ?d("accept_recv -> entry with~n" + " Domain: ~p~n" + " Address: ~p", [Domain, _Address]), + true; +accept_recv(_Addr, Port) when is_integer(Port) -> + ?d("accept_recv -> entry with~n" + " Addr: ~p~n" + " Port: ~p", [_Addr, Port]), true. -accept_send(_Addr, _Port) -> - ?d("accept_send -> entry with" - "~n Addr: ~p" - "~n Port: ~p", [_Addr, _Port]), +accept_send(Domain, _Address) when is_atom(Domain) -> + ?d("accept_send -> entry with~n" + " Domain: ~p~n" + " Address: ~p", [Domain, _Address]), + true; +accept_send(_Addr, Port) when is_integer(Port) -> + ?d("accept_send -> entry with~n" + " Addr: ~p~n" + " Port: ~p", [_Addr, Port]), true. -accept_recv_pdu(_Addr, _Port, _PduType) -> - ?d("accept_recv_pdu -> entry with" - "~n Addr: ~p" - "~n Port: ~p" - "~n PduType: ~p", [_Addr, _Port, _PduType]), +accept_recv_pdu(Domain, _Address, _PduType) when is_atom(Domain) -> + ?d("accept_recv -> entry with~n" + " Domain: ~p~n" + " Address: ~p~n" + " PduType: ~p", [Domain, _Address, _PduType]), + true; +accept_recv_pdu(_Addr, Port, _PduType) when is_integer(Port) -> + ?d("accept_recv_pdu -> entry with~n" + " Addr: ~p~n" + " Port: ~p~n" + " PduType: ~p", [_Addr, Port, _PduType]), true. accept_send_pdu(_Targets, _PduType) -> - ?d("accept_send_pdu -> entry with" - "~n Targets: ~p" - "~n PduType: ~p", [_Targets, _PduType]), + ?d("accept_send_pdu -> entry with~n" + " Targets: ~p~n" + " PduType: ~p", [_Targets, _PduType]), true. diff --git a/lib/snmp/src/agent/snmpa_network_interface_filter.erl b/lib/snmp/src/agent/snmpa_network_interface_filter.erl index 6fa131beee..90aa54a271 100644 --- a/lib/snmp/src/agent/snmpa_network_interface_filter.erl +++ b/lib/snmp/src/agent/snmpa_network_interface_filter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. All Rights Reserved. %% %% The 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 @@ behaviour_info(callbacks) -> - [{accept_recv, 2}, + [{accept_recv, 2}, {accept_send, 2}, {accept_recv_pdu, 3}, {accept_send_pdu, 2}]; @@ -31,20 +31,21 @@ behaviour_info(_) -> undefined. -%% accept_recv(address(), port()) -> boolean() +%% accept_recv({domain(), address()}) -> boolean() %% Called at the receiption of a message %% (before *any* processing has been done). %% -%% accept_send(address(), port()) -> boolean() +%% accept_send({domain(), address()}) -> boolean() %% Called before the sending of a message %% (after *all* processing has been done). %% -%% accept_recv_pdu(Addr, Port, pdu_type()) -> boolean() +%% accept_recv_pdu({domain(), address()}, pdu_type()) -> boolean() %% Called after the basic message processing (MPD) has been done, %% but before the pdu is handed over to the master-agent for %% primary processing. %% -%% accept_send_pdu(Targets, pdu_type()) -> boolean() | NewTargets +%% accept_send_pdu([{domain(), address()}, ...] = Targets, pdu_type()) -> +%% boolean() | NewTargets %% Called before the basic message processing (MPD) is done, %% when a pdu has been received from the master-agent. %% diff --git a/lib/snmp/src/agent/snmpa_trap.erl b/lib/snmp/src/agent/snmpa_trap.erl index b9a2496341..a79b150f57 100644 --- a/lib/snmp/src/agent/snmpa_trap.erl +++ b/lib/snmp/src/agent/snmpa_trap.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -270,12 +270,13 @@ localise_type({VariableOid, Value}, Mib) when is_list(VariableOid) -> localise_type(X, _) -> X. %%----------------------------------------------------------------- -%% Func: make_v1_trap_pdu/4 +%% Func: make_v1_trap_pdu/5 %% Args: Enterprise = oid() %% Specific = integer() %% Varbinds is as returned from initiate_vars %% (but only {Oid, Type[, Value} permitted) %% SysUpTime = integer() +%% AgentIp = {A, B, C, D} %% Purpose: Make a #trappdu %% Checks the Varbinds to see that no symbolic names are %% present, and that each var has a type. Performs a get @@ -284,7 +285,7 @@ localise_type(X, _) -> X. %% Fails: yes %% NOTE: Executed at the MA %%----------------------------------------------------------------- -make_v1_trap_pdu(Enterprise, Specific, VarbindList, SysUpTime) -> +make_v1_trap_pdu(Enterprise, Specific, VarbindList, SysUpTime, AgentIp) -> {Enterp,Generic,Spec} = case Enterprise of ?snmp -> @@ -292,7 +293,6 @@ make_v1_trap_pdu(Enterprise, Specific, VarbindList, SysUpTime) -> _ -> {Enterprise,?enterpriseSpecific,Specific} end, - {value, AgentIp} = snmp_framework_mib:intAgentIpAddress(get), #trappdu{enterprise = Enterp, agent_addr = AgentIp, generic_trap = Generic, @@ -369,6 +369,7 @@ send_trap(TrapRec, NotifyName, ContextName, Recv, Vbs, LocalEngineID, {tag, T}, {err, E}, {stacktrace, erlang:get_stacktrace()}], + ?vlog("snmpa_trap:send_trap exception: ~p", [Info]), {error, {failed_sending_trap, Info}} end. @@ -789,23 +790,19 @@ send_trap_pdus([], ContextName, {TrapRec, Vbs}, send_v1_trap(_TrapRec, [], _Vbs, _ExtraInfo, _NetIf, _SysUpTime) -> ok; -send_v1_trap(#trap{enterpriseoid = Enter, specificcode = Spec}, - V1Res, Vbs, ExtraInfo, NetIf, SysUpTime) -> +send_v1_trap( + #trap{enterpriseoid = Enter, specificcode = Spec}, + V1Res, Vbs, ExtraInfo, NetIf, SysUpTime) -> ?vdebug("prepare to send v1 trap " "~n '~p'" "~n with" "~n ~p" "~n to" "~n ~p", [Enter, Spec, V1Res]), - TrapPdu = make_v1_trap_pdu(Enter, Spec, Vbs, SysUpTime), - AddrCommunities = mk_addr_communities(V1Res), - lists:foreach(fun({Community, Addrs}) -> - ?vtrace("send v1 trap pdu to ~p",[Addrs]), - NetIf ! {send_pdu, 'version-1', TrapPdu, - {community, Community}, Addrs, ExtraInfo} - end, AddrCommunities); -send_v1_trap(#notification{oid = Oid}, V1Res, Vbs, ExtraInfo, NetIf, - SysUpTime) -> + do_send_v1_trap(Enter, Spec, V1Res, Vbs, ExtraInfo, NetIf, SysUpTime); +send_v1_trap( + #notification{oid = Oid}, + V1Res, Vbs, ExtraInfo, NetIf, SysUpTime) -> %% Use alg. in rfc2089 to map a v2 trap to a v1 trap % delete Counter64 objects from vbs ?vdebug("prepare to send v1 trap '~p'",[Oid]), @@ -822,14 +819,38 @@ send_v1_trap(#notification{oid = Oid}, V1Res, Vbs, ExtraInfo, NetIf, {lists:reverse(First),Last} end end, - TrapPdu = make_v1_trap_pdu(Enter, Spec, NVbs, SysUpTime), + do_send_v1_trap(Enter, Spec, V1Res, NVbs, ExtraInfo, NetIf, SysUpTime). + +do_send_v1_trap(Enter, Spec, V1Res, NVbs, ExtraInfo, NetIf, SysUpTime) -> + {value, Transports} = snmp_framework_mib:intAgentTransports(get), + {_Domain, {AgentIp, _AgentPort}} = + case lists:keyfind(snmpUDPDomain, 1, Transports) of + false -> + case lists:keyfind(transportDomainUdpIpv4, 1, Transports) of + false -> + ?vtrace( + "snmpa_trap: can not send v1 trap " + "without IPv4 domain: ~p", + [Transports]), + user_err( + "snmpa_trap: can not send v1 trap " + "without IPv4 domain: ~p", + [Transports]); + DomainAddr -> + DomainAddr + end; + DomainAddr -> + DomainAddr + end, + TrapPdu = make_v1_trap_pdu(Enter, Spec, NVbs, SysUpTime, AgentIp), AddrCommunities = mk_addr_communities(V1Res), - lists:foreach(fun({Community, Addrs}) -> - ?vtrace("send v1 trap to ~p",[Addrs]), - NetIf ! {send_pdu, 'version-1', TrapPdu, - {community, Community}, Addrs, ExtraInfo} - end, AddrCommunities). - + lists:foreach( + fun ({Community, Addrs}) -> + ?vtrace("send v1 trap to ~p",[Addrs]), + NetIf ! {send_pdu, 'version-1', TrapPdu, + {community, Community}, Addrs, ExtraInfo} + end, AddrCommunities). + send_v2_trap(_TrapRec, [], _Vbs, _Recv, _ExtraInfo, _NetIf, _SysUpTime) -> ok; send_v2_trap(TrapRec, V2Res, Vbs, Recv, ExtraInfo, NetIf, SysUpTime) -> @@ -1045,7 +1066,7 @@ deliver_recv(#snmpa_notification_delivery_info{tag = Tag, "~n DeliveryResult: ~p" "~n TAddr: ~p" "", [Tag, Mod, Extra, DeliveryResult, TAddr]), - Addr = transform_taddr(TAddr), + [Addr] = transform_taddrs([TAddr]), (catch Mod:delivery_info(Tag, Addr, DeliveryResult, Extra)); deliver_recv({Tag, Receiver}, MsgId, Result) -> ?vtrace("deliver_recv -> entry with" @@ -1072,35 +1093,90 @@ deliver_recv(Else, _MsgId, _Result) -> [Else]), user_err("snmpa: bad receiver, ~w\n", [Else]). -transform_taddrs(Addrs) -> - [transform_taddr(Addr) || Addr <- Addrs]. +transform_taddrs(TAddrs) -> + UseTDomain = + case snmp_framework_mib:intAgentTransportDomain(get) of + {value,snmpUDPDomain} -> + false; + {value,_} -> + true; + genErr -> + false + end, + DomAddrs = [transform_taddr(TAddr) || TAddr <- TAddrs], + case UseTDomain of + true -> + DomAddrs; + false -> + [Addr || {_Domain, Addr} <- DomAddrs] + end. -transform_taddr({?snmpUDPDomain, [A1, A2, A3, A4, P1, P2]}) -> % v2 - Addr = {A1, A2, A3, A4}, - Port = P1 bsl 8 + P2, - {Addr, Port}; -transform_taddr({?transportDomainUdpIpv4, [A1, A2, A3, A4, P1, P2]}) -> % v2 - Addr = {A1, A2, A3, A4}, +%% v2 +transform_taddr({?snmpUDPDomain, Addr}) -> + transform_taddr(transportDomainIdpIpv4, Addr); +transform_taddr({?transportDomainUdpIpv4, Addr}) -> + transform_taddr(transportDomainUdpIpv4, Addr); +transform_taddr({?transportDomainUdpIpv6, Addr}) -> + transform_taddr(transportDomainUdpIpv6, Addr); +%% v3 +transform_taddr({{?snmpUDPDomain, Addr}, _MsgData}) -> + transform_taddr(transportDomainUdpIpv4, Addr); +transform_taddr({{?transportDomainUdpIpv4, Addr}, _MsgData}) -> + transform_taddr(transportDomainUdpIpv4, Addr); +transform_taddr({{?transportDomainUdpIpv6, Addr}, _MsgData}) -> + transform_taddr(transportDomainUdpIpv6, Addr). + +transform_taddr( + transportDomainUdpIpv4 = Domain, + [A1,A2,A3,A4,P1,P2]) -> + Ip = {A1, A2, A3, A4}, Port = P1 bsl 8 + P2, - {Addr, Port}; -transform_taddr({?transportDomainUdpIpv6, - [A1, A2, A3, A4, A5, A6, A7, A8, P1, P2]}) -> % v2 - Addr = {A1, A2, A3, A4, A5, A6, A7, A8}, + {Domain, {Ip, Port}}; +transform_taddr( + transportDomainUdpIpv6 = Domain, + [A1, A2, A3, A4, A5, A6, A7, A8, P1, P2]) -> + Ip = {A1, A2, A3, A4, A5, A6, A7, A8}, Port = P1 bsl 8 + P2, - {Addr, Port}; -transform_taddr({{?snmpUDPDomain, [A1, A2, A3, A4, P1, P2]}, _MsgData}) -> % v3 - Addr = {A1, A2, A3, A4}, + {Domain, {Ip, Port}}; +transform_taddr( + transportDomainUdpIpv6 = Domain, + [A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, + P1, P2]) -> + Ip = + {(A1 bsl 8) bor A2, (A3 bsl 8) bor A4, + (A5 bsl 8) bor A6, (A7 bsl 8) bor A8, + (A9 bsl 8) bor A10, (A11 bsl 8) bor A12, + (A13 bsl 8) bor A14, (A15 bsl 8) bor A16}, Port = P1 bsl 8 + P2, - {Addr, Port}; -transform_taddr({{?transportDomainUdpIpv4, [A1, A2, A3, A4, P1, P2]}, _MsgData}) -> % v3 - Addr = {A1, A2, A3, A4}, - Port = P1 bsl 8 + P2, - {Addr, Port}; -transform_taddr({{?transportDomainUdpIpv6, - [A1, A2, A3, A4, A5, A6, A7, A8, P1, P2]}, _MsgData}) -> % v3 - Addr = {A1, A2, A3, A4, A5, A6, A7, A8}, - Port = P1 bsl 8 + P2, - {Addr, Port}. + {Domain, {Ip, Port}}. + +%% transform_taddr({?snmpUDPDomain, [A1, A2, A3, A4, P1, P2]}) -> % v2 +%% Addr = {A1, A2, A3, A4}, +%% Port = P1 bsl 8 + P2, +%% {Addr, Port}; +%% transform_taddr({?transportDomainUdpIpv4, [A1, A2, A3, A4, P1, P2]}) -> % v2 +%% Addr = {A1, A2, A3, A4}, +%% Port = P1 bsl 8 + P2, +%% {Addr, Port}; +%% transform_taddr({?transportDomainUdpIpv6, +%% [A1, A2, A3, A4, A5, A6, A7, A8, P1, P2]}) -> % v2 +%% Addr = {A1, A2, A3, A4, A5, A6, A7, A8}, +%% Port = P1 bsl 8 + P2, +%% {Addr, Port}; +%% transform_taddr({{?snmpUDPDomain, [A1, A2, A3, A4, P1, P2]}, _MsgData}) -> % v3 +%% Addr = {A1, A2, A3, A4}, +%% Port = P1 bsl 8 + P2, +%% {Addr, Port}; +%% transform_taddr({{?transportDomainUdpIpv4, [A1, A2, A3, A4, P1, P2]}, _MsgData}) -> % v3 +%% Addr = {A1, A2, A3, A4}, +%% Port = P1 bsl 8 + P2, +%% {Addr, Port}; +%% transform_taddr({{?transportDomainUdpIpv6, +%% [A1, A2, A3, A4, A5, A6, A7, A8, P1, P2]}, _MsgData}) -> % v3 +%% Addr = {A1, A2, A3, A4, A5, A6, A7, A8}, +%% Port = P1 bsl 8 + P2, +%% {Addr, Port}. + check_all_varbinds(#notification{oid = Oid}, Vbs, MibView) -> diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index babc33e6a5..1cc1a17b1d 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -28,6 +28,9 @@ %% {update, snmpa_local_db, soft, soft_purge, soft_purge, []} %% {add_module, snmpm_net_if_mt} [ + {"5.0", [{restart_application, snmp}]}, + {"4.25.1", [{restart_application, snmp}]}, + {"4.25.0.1", [{restart_application, snmp}]}, {"4.25", [{restart_application, snmp}]}, {"4.24.2", [{restart_application, snmp}]}, {"4.24.1", [{restart_application, snmp}]}, @@ -40,6 +43,9 @@ %% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}} [ + {"5.0", [{restart_application, snmp}]}, + {"4.25.1", [{restart_application, snmp}]}, + {"4.25.0.1", [{restart_application, snmp}]}, {"4.25", [{restart_application, snmp}]}, {"4.24.2", [{restart_application, snmp}]}, {"4.24.1", [{restart_application, snmp}]}, diff --git a/lib/snmp/src/manager/depend.mk b/lib/snmp/src/manager/depend.mk index 2e7783c8ed..60f61b0d3b 100644 --- a/lib/snmp/src/manager/depend.mk +++ b/lib/snmp/src/manager/depend.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2012. All Rights Reserved. +# Copyright Ericsson AB 2004-2014. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -50,10 +50,11 @@ $(EBIN)/snmpm_net_if.$(EMULATOR): \ snmpm_network_interface.erl $(EBIN)/snmpm_net_if_mt.$(EMULATOR): \ + snmpm_net_if_mt.erl \ ../../include/snmp_types.hrl \ ../misc/snmp_debug.hrl \ ../misc/snmp_verbosity.hrl \ - snmpm_net_if_mt.erl \ + snmpm_net_if.erl \ snmpm_network_interface.erl $(EBIN)/snmpm_server.$(EMULATOR): \ diff --git a/lib/snmp/src/manager/snmpm.erl b/lib/snmp/src/manager/snmpm.erl index c97b635fc6..8976322c4e 100644 --- a/lib/snmp/src/manager/snmpm.erl +++ b/lib/snmp/src/manager/snmpm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -379,21 +379,33 @@ register_agent(UserId, Addr) -> register_agent(UserId, Addr, ?DEFAULT_AGENT_PORT, []). %% Backward compatibility -register_agent(UserId, Addr, Port, Config0) -> +register_agent(UserId, Domain, Addr, Config0) when is_atom(Domain) -> case lists:keymember(target_name, 1, Config0) of false -> - TargetName = mk_target_name(Addr, Port, Config0), - Config = [{reg_type, addr_port}, - {address, Addr}, {port, Port} | Config0], + TargetName = mk_target_name(Domain, Addr, Config0), + Config = + [{reg_type, addr_port}, + {tdomain, Domain}, {taddress, Addr} | Config0], do_register_agent(UserId, TargetName, ensure_engine_id(Config)); true -> {value, {_, TargetName}} = lists:keysearch(target_name, 1, Config0), Config1 = lists:keydelete(target_name, 1, Config0), - Config2 = [{reg_type, addr_port}, - {address, Addr}, {port, Port} | Config1], + Config2 = + [{reg_type, addr_port}, + {tdomain, Domain}, {taddress, Addr} | Config1], register_agent(UserId, TargetName, ensure_engine_id(Config2)) - end. + end; +register_agent(UserId, Ip, Port, Config) when is_integer(Port) -> + Domain = snmpm_config:default_transport_domain(), + Addr = + case snmp_conf:check_address(Domain, {Ip, Port}) of + ok -> + {Ip, Port}; + {ok, FixedAddr} -> + FixedAddr + end, + register_agent(UserId, Domain, Addr, Config). unregister_agent(UserId, TargetName) when is_list(TargetName) -> snmpm_config:unregister_agent(UserId, TargetName); @@ -402,8 +414,8 @@ unregister_agent(UserId, TargetName) when is_list(TargetName) -> unregister_agent(UserId, Addr) -> unregister_agent(UserId, Addr, ?DEFAULT_AGENT_PORT). -unregister_agent(UserId, Addr, Port) -> - case target_name(Addr, Port) of +unregister_agent(UserId, DomainIp, AddressPort) -> + case target_name(DomainIp, AddressPort) of {ok, TargetName} -> unregister_agent(UserId, TargetName); Error -> @@ -1264,14 +1276,17 @@ format_vb_value(Prefix, _Type, Val) -> %% --- Internal utility functions --- %% -target_name(Addr) -> - target_name(Addr, ?DEFAULT_AGENT_PORT). +target_name(Ip) -> + target_name(Ip, ?DEFAULT_AGENT_PORT). -target_name(Addr, Port) -> - snmpm_config:agent_info(Addr, Port, target_name). +target_name(DomainIp, AddressPort) -> + snmpm_config:agent_info(DomainIp, AddressPort, target_name). mk_target_name(Addr, Port, Config) -> - snmpm_config:mk_target_name(Addr, Port, Config). + R = snmpm_config:mk_target_name(Addr, Port, Config), + p(?MODULE_STRING":mk_target_name(~p, ~p, ~p) -> ~p.~n", + [Addr, Port, Config, R]), + R. ensure_engine_id(Config) -> case lists:keymember(engine_id, 1, Config) of @@ -1287,5 +1302,5 @@ ensure_engine_id(Config) -> %% p(F) -> %% p(F, []). -%% p(F, A) -> -%% io:format("~w:" ++ F ++ "~n", [?MODULE | A]). +p(F, A) -> + io:format("~w:" ++ F ++ "~n", [?MODULE | A]). diff --git a/lib/snmp/src/manager/snmpm_conf.erl b/lib/snmp/src/manager/snmpm_conf.erl index 5e2d9fdbf6..087ef6c6ea 100644 --- a/lib/snmp/src/manager/snmpm_conf.erl +++ b/lib/snmp/src/manager/snmpm_conf.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2014. All Rights Reserved. %% %% The 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,43 +78,26 @@ write_manager_config(Dir, Conf) -> Hdr = header() ++ Comment, write_manager_config(Dir, Hdr, Conf). -write_manager_config(Dir, Hdr, Conf) - when is_list(Dir) andalso is_list(Hdr) andalso is_list(Conf) -> - Verify = fun() -> verify_manager_conf(Conf) end, - Write = fun(Fid) -> write_manager_conf(Fid, Hdr, Conf) end, - write_config_file(Dir, ?MANAGER_CONF_FILE, Verify, Write). - +write_manager_config(Dir, Hdr, Conf) + when is_list(Dir), is_list(Hdr), is_list(Conf) -> + Order = fun snmpm_config:order_manager_config/2, + Check = fun snmpm_config:check_manager_config/2, + Write = fun (Fd, Entries) -> write_manager_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, ?MANAGER_CONF_FILE, Order, Check, Write, Conf). append_manager_config(Dir, Conf) - when is_list(Dir) andalso is_list(Conf) -> - Verify = fun() -> verify_manager_conf(Conf) end, - Write = fun(Fid) -> write_manager_conf(Fid, Conf) end, - append_config_file(Dir, ?MANAGER_CONF_FILE, Verify, Write). - + when is_list(Dir), is_list(Conf) -> + Order = fun snmpm_config:order_manager_config/2, + Check = fun snmpm_config:check_manager_config/2, + Write = fun write_manager_conf/2, + append_config_file(Dir, ?MANAGER_CONF_FILE, Order, Check, Write, Conf). -read_manager_config(Dir) -> - Verify = fun(Entry) -> verify_manager_conf_entry(Entry) end, - read_config_file(Dir, ?MANAGER_CONF_FILE, Verify). +read_manager_config(Dir) when is_list(Dir) -> + Order = fun snmpm_config:order_manager_config/2, + Check = fun snmpm_config:check_manager_config/2, + read_config_file(Dir, ?MANAGER_CONF_FILE, Order, Check). -verify_manager_conf([]) -> - ok; -verify_manager_conf([H|T]) -> - verify_manager_conf_entry(H), - verify_manager_conf(T); -verify_manager_conf(X) -> - error({bad_manager_config, X}). - -verify_manager_conf_entry(Entry) -> - case snmpm_config:check_manager_config(Entry) of - ok -> - ok; -%% {ok, _} -> -%% ok; - Error -> - throw(Error) - end. - write_manager_conf(Fd, "", Conf) -> write_manager_conf(Fd, Conf); write_manager_conf(Fd, Hdr, Conf) -> @@ -127,14 +110,16 @@ write_manager_conf(Fd, [H|T]) -> do_write_manager_conf(Fd, H), write_manager_conf(Fd, T). -do_write_manager_conf(Fd, {address = Tag, Val}) -> - io:format(Fd, "{~w, ~w}.~n", [Tag, Val]); -do_write_manager_conf(Fd, {port = Tag, Val} ) -> +do_write_manager_conf(Fd, {Tag, Val}) + when Tag =:= domain; + Tag =:= address; + Tag =:= port; + Tag =:= transports; + Tag =:= max_message_size -> io:format(Fd, "{~w, ~w}.~n", [Tag, Val]); -do_write_manager_conf(Fd, {engine_id = Tag, Val} ) -> +do_write_manager_conf(Fd, {Tag, Val}) + when Tag =:= engine_id -> io:format(Fd, "{~w, \"~s\"}.~n", [Tag, Val]); -do_write_manager_conf(Fd, {max_message_size = Tag, Val} ) -> - io:format(Fd, "{~w, ~w}.~n", [Tag, Val]); do_write_manager_conf(_Fd, Crap) -> error({bad_manager_config, Crap}). @@ -167,36 +152,29 @@ write_users_config(Dir, Conf) -> Hdr = header() ++ Comment, write_users_config(Dir, Hdr, Conf). -write_users_config(Dir, Hdr, Conf) +write_users_config(Dir, Hdr, Conf) when is_list(Dir) andalso is_list(Hdr) andalso is_list(Conf) -> - Verify = fun() -> verify_users_conf(Conf) end, - Write = fun(Fd) -> write_users_conf(Fd, Hdr, Conf) end, - write_config_file(Dir, ?USERS_CONF_FILE, Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_user_config/2, + Write = fun (Fd, Entries) -> write_users_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, ?USERS_CONF_FILE, Order, Check, Write, Conf). -append_users_config(Dir, Conf) +append_users_config(Dir, Conf) when is_list(Dir) andalso is_list(Conf) -> - Verify = fun() -> verify_users_conf(Conf) end, - Write = fun(Fd) -> write_users_conf(Fd, Conf) end, - append_config_file(Dir, ?USERS_CONF_FILE, Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_user_config/2, + Write = fun write_users_conf/2, + append_config_file(Dir, ?USERS_CONF_FILE, Order, Check, Write, Conf). read_users_config(Dir) when is_list(Dir) -> - Verify = fun(Entry) -> verify_users_conf_entry(Entry) end, - read_config_file(Dir, ?USERS_CONF_FILE, Verify). + Order = fun snmp_conf:no_order/2, + Check = fun check_user_config/2, + read_config_file(Dir, ?USERS_CONF_FILE, Order, Check). - -verify_users_conf([]) -> - ok; -verify_users_conf([H|T]) -> - verify_users_conf_entry(H), - verify_users_conf(T); -verify_users_conf(X) -> - error({bad_users_conf, X}). - -verify_users_conf_entry(Entry) -> - {ok, _} = snmpm_config:check_user_config(Entry), - ok. + +check_user_config(Entry, State) -> + {check_ok(snmpm_config:check_user_config(Entry)), + State}. write_users_conf(Fd, "", Conf) -> write_users_conf(Fd, Conf); @@ -222,9 +200,10 @@ do_write_users_conf(_Fd, Crap) -> %% ------ agents.conf ------ %% -agents_entry(UserId, TargetName, Comm, Ip, Port, EngineID, Timeout, - MaxMessageSize, Version, SecModel, SecName, SecLevel) -> - {UserId, TargetName, Comm, Ip, Port, EngineID, Timeout, +agents_entry( + UserId, TargetName, Comm, Domain_or_Ip, Addr_or_Port, EngineID, Timeout, + MaxMessageSize, Version, SecModel, SecName, SecLevel) -> + {UserId, TargetName, Comm, Domain_or_Ip, Addr_or_Port, EngineID, Timeout, MaxMessageSize, Version, SecModel, SecName, SecLevel}. @@ -239,36 +218,29 @@ write_agents_config(Dir, Conf) -> Hdr = header() ++ Comment, write_agents_config(Dir, Hdr, Conf). -write_agents_config(Dir, Hdr, Conf) +write_agents_config(Dir, Hdr, Conf) when is_list(Dir) andalso is_list(Hdr) andalso is_list(Conf) -> - Verify = fun() -> verify_agents_conf(Conf) end, - Write = fun(Fd) -> write_agents_conf(Fd, Hdr, Conf) end, - write_config_file(Dir, ?AGENTS_CONF_FILE, Verify, Write). + Order = fun snmp_conf:no_order/2, + Check = fun check_agent_config/2, + Write = fun (Fd, Entries) -> write_agents_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, ?AGENTS_CONF_FILE, Order, Check, Write, Conf). - -append_agents_config(Dir, Conf) +append_agents_config(Dir, Conf) when is_list(Dir) andalso is_list(Conf) -> - Verify = fun() -> verify_agents_conf(Conf) end, - Write = fun(Fd) -> write_agents_conf(Fd, Conf) end, - append_config_file(Dir, ?AGENTS_CONF_FILE, Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_agent_config/2, + Write = fun write_agents_conf/2, + append_config_file(Dir, ?AGENTS_CONF_FILE, Order, Check, Write, Conf). read_agents_config(Dir) -> - Verify = fun(Entry) -> verify_agents_conf_entry(Entry) end, - read_config_file(Dir, ?AGENTS_CONF_FILE, Verify). + Order = fun snmp_conf:no_order/2, + Check = fun check_agent_config/2, + read_config_file(Dir, ?AGENTS_CONF_FILE, Order, Check). -verify_agents_conf([]) -> - ok; -verify_agents_conf([H|T]) -> - verify_agents_conf_entry(H), - verify_agents_conf(T); -verify_agents_conf(X) -> - error({bad_agents_config, X}). - -verify_agents_conf_entry(Entry) -> - {ok, _} = snmpm_config:check_agent_config(Entry), - ok. +check_agent_config(Entry, State) -> + {check_ok(snmpm_config:check_agent_config(Entry)), + State}. write_agents_conf(Fd, "", Conf) -> write_agents_conf(Fd, Conf); @@ -282,13 +254,15 @@ write_agents_conf(Fd, [H|T]) -> do_write_agents_conf(Fd, H), write_agents_conf(Fd, T). -do_write_agents_conf(Fd, - {UserId, - TargetName, Comm, Ip, Port, EngineID, - Timeout, MaxMessageSize, Version, - SecModel, SecName, SecLevel} = _A) -> - io:format(Fd, - "{~w, \"~s\", \"~s\", ~w, ~w, \"~s\", ~w, ~w, ~w, ~w, \"~s\", ~w}.~n", [UserId, TargetName, Comm, Ip, Port, EngineID, Timeout, MaxMessageSize, Version, SecModel, SecName, SecLevel]); +do_write_agents_conf( + Fd, + {UserId, TargetName, Comm, Ip, Port, EngineID, + Timeout, MaxMessageSize, Version, SecModel, SecName, SecLevel} = _A) -> + io:format( + Fd, + "{~w, \"~s\", \"~s\", ~w, ~w, \"~s\", ~w, ~w, ~w, ~w, \"~s\", ~w}.~n", + [UserId, TargetName, Comm, Ip, Port, EngineID, + Timeout, MaxMessageSize, Version, SecModel, SecName, SecLevel]); do_write_agents_conf(_Fd, Crap) -> error({bad_agents_config, Crap}). @@ -314,37 +288,30 @@ write_usm_config(Dir, Conf) -> Hdr = header() ++ Comment, write_usm_config(Dir, Hdr, Conf). -write_usm_config(Dir, Hdr, Conf) +write_usm_config(Dir, Hdr, Conf) when is_list(Dir) andalso is_list(Hdr) andalso is_list(Conf) -> - Verify = fun() -> verify_usm_conf(Conf) end, - Write = fun(Fd) -> write_usm_conf(Fd, Hdr, Conf) end, - write_config_file(Dir, ?USM_USERS_CONF_FILE, Verify, Write). + Order = fun snmp_conf:no_order/2, + Check = fun check_usm_user_config/2, + Write = fun (Fd, Entries) -> write_usm_conf(Fd, Hdr, Entries) end, + write_config_file(Dir, ?USM_USERS_CONF_FILE, Order, Check, Write, Conf). - -append_usm_config(Dir, Conf) +append_usm_config(Dir, Conf) when is_list(Dir) andalso is_list(Conf) -> - Verify = fun() -> verify_usm_conf(Conf) end, - Write = fun(Fd) -> write_usm_conf(Fd, Conf) end, - append_config_file(Dir, ?USM_USERS_CONF_FILE, Verify, Write). - + Order = fun snmp_conf:no_order/2, + Check = fun check_usm_user_config/2, + Write = fun write_usm_conf/2, + append_config_file(Dir, ?USM_USERS_CONF_FILE, Order, Check, Write, Conf). read_usm_config(Dir) when is_list(Dir) -> - Verify = fun(Entry) -> verify_usm_conf_entry(Entry) end, - read_config_file(Dir, ?USM_USERS_CONF_FILE, Verify). + Order = fun snmp_conf:no_order/2, + Check = fun check_usm_user_config/2, + read_config_file(Dir, ?USM_USERS_CONF_FILE, Order, Check). -verify_usm_conf([]) -> - ok; -verify_usm_conf([H|T]) -> - verify_usm_conf_entry(H), - verify_usm_conf(T); -verify_usm_conf(X) -> - error({bad_usm_conf, X}). - -verify_usm_conf_entry(Entry) -> - {ok, _} = snmpm_config:check_usm_user_config(Entry), - ok. +check_usm_user_config(Entry, State) -> + {check_ok(snmpm_config:check_usm_user_config(Entry)), + State}. write_usm_conf(Fd, "", Conf) -> write_usm_conf(Fd, Conf); @@ -358,41 +325,49 @@ write_usm_conf(Fd, [H|T]) -> do_write_usm_conf(Fd, H), write_usm_conf(Fd, T). -do_write_usm_conf(Fd, - {EngineID, UserName, AuthP, AuthKey, PrivP, PrivKey}) -> - io:format(Fd, "{\"~s\", \"~s\", ~w, ~w, ~w, ~w}.~n", - [EngineID, UserName, AuthP, AuthKey, PrivP, PrivKey]); -do_write_usm_conf(Fd, - {EngineID, UserName, SecName, - AuthP, AuthKey, PrivP, PrivKey}) -> - io:format(Fd, "{\"~s\", \"~s\", \"~s\", í~w, ~w, ~w, ~w}.~n", - [EngineID, UserName, SecName, AuthP, AuthKey, PrivP, PrivKey]); +do_write_usm_conf( + Fd, + {EngineID, UserName, AuthP, AuthKey, PrivP, PrivKey}) -> + io:format( + Fd, "{\"~s\", \"~s\", ~w, ~w, ~w, ~w}.~n", + [EngineID, UserName, AuthP, AuthKey, PrivP, PrivKey]); +do_write_usm_conf( + Fd, + {EngineID, UserName, SecName, + AuthP, AuthKey, PrivP, PrivKey}) -> + io:format( + Fd, "{\"~s\", \"~s\", \"~s\", í~w, ~w, ~w, ~w}.~n", + [EngineID, UserName, SecName, AuthP, AuthKey, PrivP, PrivKey]); do_write_usm_conf(_Fd, Crap) -> error({bad_usm_conf, Crap}). %% ---- config file wrapper functions ---- -write_config_file(Dir, File, Verify, Write) -> - snmp_config:write_config_file(Dir, File, Verify, Write). - -append_config_file(Dir, File, Verify, Write) -> - snmp_config:append_config_file(Dir, File, Verify, Write). +write_config_file(Dir, File, Order, Check, Write, Conf) -> + snmp_config:write_config_file(Dir, File, Order, Check, Write, Conf). -read_config_file(Dir, File, Verify) -> - snmp_config:read_config_file(Dir, File, Verify). +append_config_file(Dir, File, Order, Check, Write, Conf) -> + snmp_config:append_config_file(Dir, File, Order, Check, Write, Conf). +read_config_file(Dir, File, Order, Check) -> + snmp_config:read_config_file(Dir, File, Order, Check). %% ---- config file utility functions ---- +check_ok(ok) -> + ok; +check_ok({ok, _}) -> + ok. + header() -> {Y,Mo,D} = date(), {H,Mi,S} = time(), - io_lib:format("%% This file was generated by " - "~w (version-~s) ~w-~2.2.0w-~2.2.0w " - "~2.2.0w:~2.2.0w:~2.2.0w\n", - [?MODULE, ?version, Y, Mo, D, H, Mi, S]). - + io_lib:format( + "%% This file was generated by " + "~w (version-~s) ~w-~2.2.0w-~2.2.0w " + "~2.2.0w:~2.2.0w:~2.2.0w\n", + [?MODULE, ?version, Y, Mo, D, H, Mi, S]). error(R) -> throw({error, R}). diff --git a/lib/snmp/src/manager/snmpm_config.erl b/lib/snmp/src/manager/snmpm_config.erl index 2101ad46e1..5cab81baf6 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-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The 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,8 +103,10 @@ get_agent_mp_model/2 ]). --export([check_manager_config/1, - check_user_config/1, +-export([ + order_manager_config/2, + check_manager_config/2, + check_user_config/1, check_agent_config/1, check_usm_user_config/1]). @@ -165,7 +167,7 @@ %%%------------------------------------------------------------------- default_transport_domain() -> - transportDomainUdpIpv4. + snmpUDPDomain. start_link(Opts) -> @@ -190,7 +192,11 @@ register_user(UserId, UserMod, UserData, DefaultAgentConfig) when (UserId =/= ?DEFAULT_USER) andalso is_list(DefaultAgentConfig) -> case (catch verify_user_behaviour(UserMod)) of ok -> - Config = default_agent_config(DefaultAgentConfig), + {ok, SystemDefaultAgentConfig} = agent_info(), + Config = + ensure_config(SystemDefaultAgentConfig, + DefaultAgentConfig), +%% Config = default_agent_config(DefaultAgentConfig), call({register_user, UserId, UserMod, UserData, Config}); Error -> Error @@ -201,19 +207,19 @@ register_user(UserId, _UserMod, _UserData, DefaultAgentConfig) register_user(UserId, _, _, _) -> {error, {bad_user_id, UserId}}. -default_agent_config(DefaultAgentConfig) -> - {ok, SystemDefaultAgentConfig} = agent_info(), - default_agent_config(SystemDefaultAgentConfig, DefaultAgentConfig). +%% default_agent_config(DefaultAgentConfig) -> +%% {ok, SystemDefaultAgentConfig} = agent_info(), +%% default_agent_config(SystemDefaultAgentConfig, DefaultAgentConfig). -default_agent_config([], DefaultAgentConfig) -> - DefaultAgentConfig; -default_agent_config([{Key, _} = Entry|T], DefaultAgentConfig) -> - case lists:keysearch(Key, 1, DefaultAgentConfig) of - {value, _} -> - default_agent_config(T, DefaultAgentConfig); - false -> - default_agent_config(T, [Entry|DefaultAgentConfig]) - end. +%% default_agent_config([], DefaultAgentConfig) -> +%% DefaultAgentConfig; +%% default_agent_config([{Key, _} = Entry|T], DefaultAgentConfig) -> +%% case lists:keymember(Key, 1, DefaultAgentConfig) of +%% true -> +%% default_agent_config(T, DefaultAgentConfig); +%% false -> +%% default_agent_config(T, [Entry|DefaultAgentConfig]) +%% end. verify_user_behaviour(UserMod) -> @@ -280,9 +286,10 @@ do_user_info(_UserId, BadItem) -> %% A target-name constructed in this way is a string with the following: %% <IP-address>:<Port>-<Version> -%% This is intended for backward compatibility and therefor has +%% This is intended for backward compatibility and therefore has %% only support for IPv4 addresses and *no* other transport domain. -mk_target_name(Addr0, Port, Config) when is_list(Config) -> +mk_target_name(Domain, Addr, Config) + when is_atom(Domain), is_list(Config) -> Version = case lists:keysearch(version, 1, Config) of {value, {_, V}} -> @@ -290,18 +297,35 @@ mk_target_name(Addr0, Port, Config) when is_list(Config) -> false -> select_lowest_supported_version() end, - case normalize_address(Addr0) of - {A, B, C, D} -> - lists:flatten( - io_lib:format("~w.~w.~w.~w:~w-~w", [A, B, C, D, Port, Version])); - [A, B, C, D] -> + try + lists:flatten( + io_lib:format( + "~s-~w", [snmp_conf:mk_addr_string({Domain, Addr}), Version])) + catch + _ -> lists:flatten( - io_lib:format("~w.~w.~w.~w:~w-~w", [A, B, C, D, Port, Version])); - _ -> + io_lib:format("~p-~w", [Addr, Version])) + end; +mk_target_name(Ip, Port, Config) + when is_integer(Port), is_list(Config) -> + Domain = default_transport_domain(), + try fix_address(Domain, {Ip, Port}) of + Address -> + mk_target_name(Domain, Address, Config) + catch + _ -> + Version = + case lists:keysearch(version, 1, Config) of + {value, {_, V}} -> + V; + false -> + select_lowest_supported_version() + end, lists:flatten( - io_lib:format("~p:~w-~w", [Addr0, Port, Version])) + io_lib:format("~p:~w-~w", [Ip, Port, Version])) end. - + + select_lowest_supported_version() -> {ok, Versions} = system_info(versions), select_lowest_supported_version([v1, v2, v3], Versions). @@ -335,27 +359,17 @@ register_agent(UserId, TargetName, Config0) %% is not present %% 3) Check that there are no invalid or erroneous configs %% 4) Check that the manager is capable of using the selected version - case verify_agent_config(Config0) of - {ok, Config} -> - call({register_agent, UserId, TargetName, Config}); - Error -> - Error - end. - - -verify_agent_config(Conf0) -> try - begin - verify_mandatory(Conf0, [engine_id, address, reg_type]), - verify_invalid(Conf0, [user_id]), - Conf = verify_agent_config3(Conf0), - Vsns = versions(), - Vsn = which_version(Conf), - verify_version(Vsn, Vsns), - {ok, Conf} - end + verify_mandatory(Config0, [engine_id, reg_type]), + verify_someof(Config0, [address, taddress]), + verify_illegal(Config0, [user_id]), + Config = verify_agent_config(Config0), + Vsns = versions(), + Vsn = which_version(Config), + verify_version(Vsn, Vsns), + call({register_agent, UserId, TargetName, Config}) catch - throw:Error -> + Error -> Error end. @@ -381,52 +395,43 @@ verify_version(Vsn, Vsns) -> ok; false -> Reason = {version_not_supported_by_manager, Vsn, Vsns}, - throw({error, Reason}) - end. - -verify_agent_config3(Conf0) -> - %% Fix (transport) address and domain - {TDomain, Conf1} = - case lists:keysearch(tdomain, 1, Conf0) of - {value, {tdomain, Dom}} -> - {Dom, Conf0}; - false -> - Dom = default_transport_domain(), - {Dom, [{tdomain, Dom} | Conf0]} - end, - Conf2 = case lists:keysearch(address, 1, Conf1) of - {value, {address, Address}} -> - lists:keyreplace(address, 1, Conf1, - {address, {TDomain, Address}}); - false -> - %% This is a mandatory config option, - %% a later test will detect this - Conf1 - end, - case verify_agent2(Conf2) of - {ok, Conf} -> - Conf; - {error, _} = ERROR -> - throw(ERROR) + error(Reason) end. -verify_agent_config2(Conf) -> - verify_agent2(Conf). unregister_agent(UserId, TargetName) -> call({unregister_agent, UserId, TargetName}). %% This is the old style agent unregistration (using Addr and Port). -unregister_agent(UserId, Addr0, Port) -> - Addr = normalize_address(Addr0), - case do_agent_info(Addr, Port, target_name) of +unregister_agent(UserId, Domain, Address) when is_atom(Domain) -> + try fix_address(Domain, Address) of + NAddress -> + do_unregister_agent(UserId, Domain, NAddress) + catch + _ -> + {error, not_found} + end; +unregister_agent(UserId, Ip, Port) when is_integer(Port) -> + Domain = default_transport_domain(), + try fix_address(Domain, {Ip, Port}) of + Address -> + do_unregister_agent(UserId, Domain, Address) + catch + _ -> + {error, not_found} + end. + +do_unregister_agent(UserId, Domain, Address) -> + case do_agent_info(Domain, Address, target_name) of {ok, TargetName} -> unregister_agent(UserId, TargetName); Error -> Error end. + + agent_info() -> agent_info(?DEFAULT_TARGETNAME, all). @@ -437,27 +442,76 @@ agent_info(TargetName, all) -> All -> {ok, [{Item, Val} || {{_, Item}, Val} <- All]} end; +%% Begin backwards compatibility +agent_info(TargetName, address) -> + case agent_info({TargetName, taddress}) of + {ok, Val} -> + {Addr, _} = Val, + {ok, Addr}; + _ -> + %% This should be redundant since 'taddress' should exist + agent_info({TargetName, address}) + end; +agent_info(TargetName, port) -> + case agent_info({TargetName, taddress}) of + {ok, Val} -> + {_, Port} = Val, + {ok, Port}; + _ -> + %% This should be redundant since 'taddress' should exist + agent_info({TargetName, port}) + end; +%% End backwards compatibility agent_info(TargetName, Item) -> - case ets:lookup(snmpm_agent_table, {TargetName, Item}) of + agent_info({TargetName, Item}). + +agent_info(Key) -> + case ets:lookup(snmpm_agent_table, Key) of [{_, Val}] -> {ok, Val}; [] -> {error, not_found} end. - -agent_info(Addr0, Port, Item) -> - Addr = normalize_address(Addr0), - do_agent_info(Addr, Port, Item). -do_agent_info(Addr, Port, target_name = Item) -> - case ets:lookup(snmpm_agent_table, {Addr, Port, Item}) of +agent_info(Domain, Address, Item) when is_atom(Domain) -> + try fix_address(Domain, Address) of + NAddress -> + do_agent_info(Domain, NAddress, Item) + catch + _Thrown -> + %% p(?MODULE_STRING":agent_info(~p, ~p, ~p) throwed ~p at.~n" + %% " ~p", + %% [Domain, Address, Item, _Thrown, erlang:get_stacktrace()]), + {error, not_found} + end; +agent_info(Ip, Port, Item) when is_integer(Port) -> + %% p(?MODULE_STRING":agent_info(~p, ~p, ~p) entry~n", + %% [Ip, Port, Item]), + Domain = default_transport_domain(), + try fix_address(Domain, {Ip, Port}) of + Address -> + do_agent_info(Domain, Address, Item) + catch + _Thrown -> + %% p(?MODULE_STRING":agent_info(~p, ~p, ~p) throwed ~p at.~n" + %% " ~p", + %% [Ip, Port, Item, _Thrown, erlang:get_stacktrace()]), + {error, not_found} + end. + +do_agent_info(Domain, Address, target_name = Item) -> + %% p(?MODULE_STRING":do_agent_info(~p, ~p, ~p) entry~n", + %% [Domain, Address, Item]), + case ets:lookup(snmpm_agent_table, {Domain, Address, Item}) of [{_, Val}] -> {ok, Val}; [] -> {error, not_found} end; -do_agent_info(Addr, Port, Item) -> - case do_agent_info(Addr, Port, target_name) of +do_agent_info(Domain, Address, Item) -> + %% p(?MODULE_STRING":do_agent_info(~p, ~p, ~p) entry~n", + %% [Domain, Address, Item]), + case do_agent_info(Domain, Address, target_name) of {ok, TargetName} -> agent_info(TargetName, Item); Error -> @@ -465,6 +519,19 @@ do_agent_info(Addr, Port, Item) -> end. +ensure_agent_info(_, [], Info) -> + Info; +ensure_agent_info(TargetName, [Item|Items], Info) -> + case lists:keymember(Item, 1, Info) of + true -> + ensure_agent_info(TargetName, Items, Info); + false -> + {ok, Value} = agent_info(TargetName, Item), + ensure_agent_info(TargetName, Items, [{Item, Value}|Info]) + end. + + + which_agents() -> which_agents('_'). @@ -474,38 +541,6 @@ which_agents(UserId) -> [TargetName || [TargetName] <- Agents]. -verify_agent_info(TargetName, Info0) -> - try - begin - verify_invalid(Info0, [user_id]), - %% Check if address is part of the list and - %% if so update it with the domain info. - Info = - case lists:keysearch(address, 1, Info0) of - {value, {address, Addr}} -> - %% If domain is part of the info, then use it. - %% If not, lookup what is already stored for - %% this agent and use that. - Domain = - case lists:keysearch(tdomain, 1, Info0) of - {value, {tdomain, Dom}} -> - Dom; - false -> - {ok, Dom} = - agent_info(TargetName, tdomain), - Dom - end, - Addr2 = {Domain, Addr}, - lists:keyreplace(address, 1, Info0, {address, Addr2}); - false -> - Info0 - end, - verify_agent2(Info) - end - catch - throw:Error -> - Error - end. update_agent_info(UserId, TargetName, Info) -> call({update_agent_info, UserId, TargetName, Info}). @@ -740,7 +775,7 @@ verify_usm_user_config(EngineID, Name, Config) -> try begin verify_mandatory(Config, []), - verify_invalid(Config, [engine_id, name]), + verify_illegal(Config, [engine_id, name]), verify_usm_user_config2(EngineID, Name, Config) end catch @@ -1073,7 +1108,11 @@ do_init(Opts) -> %% -- Prio (optional) -- Prio = get_opt(priority, Opts, normal), ets:insert(snmpm_config_table, {prio, Prio}), - process_flag(priority, Prio), + try process_flag(priority, Prio) + catch + error:badarg -> + error({invalid_priority,Prio}) + end, %% -- Server (optional) -- ServerOpts = get_opt(server, Opts, []), @@ -1271,36 +1310,6 @@ verify_options(Opts, Mandatory) -> verify_mandatory_options(Opts, Mandatory), verify_options(Opts). -%% mandatory() -> [mand()] -%% mand() -> atom() | {atom, [atom()]} -verify_mandatory_options(_Opts, []) -> - ok; -verify_mandatory_options(Opts, [Mand|Mands]) -> - verify_mandatory_option(Opts, Mand), - verify_mandatory_options(Opts, Mands). - -verify_mandatory_option(Opts, {Mand, MandSubOpts}) -> - ?d("verify_mandatory_option -> entry with" - "~n Mand: ~p" - "~n MandSubObjs: ~p", [Mand, MandSubOpts]), - case lists:keysearch(Mand, 1, Opts) of - {value, {Mand, SubOpts}} -> - verify_mandatory_options(SubOpts, MandSubOpts); - false -> - ?d("missing mandatory option: ~w [~p]", [Mand, MandSubOpts]), - error({missing_mandatory, Mand, MandSubOpts}) - end; -verify_mandatory_option(Opts, Mand) -> - ?d("verify_mandatory_option -> entry with" - "~n Mand: ~p", [Mand]), - case lists:keymember(Mand, 1, Opts) of - true -> - ok; - false -> - ?d("missing mandatory option: ~w", [Mand]), - error({missing_mandatory, Mand}) - end. - verify_options([]) -> ?d("verify_options -> done", []), ok; @@ -1506,7 +1515,9 @@ verify_versions([]) -> ok; verify_versions([Vsn|Vsns]) -> verify_version(Vsn), - verify_versions(Vsns). + verify_versions(Vsns); +verify_versions(Vsns) -> + error({invalid_versions, Vsns}). verify_version(v1) -> ok; @@ -1614,7 +1625,38 @@ verify_verbosity(Verbosity) -> _ -> error({invalid_verbosity, Verbosity}) end. + +%% mandatory() -> [mand()] +%% mand() -> atom() | {atom, [atom()]} +verify_mandatory_options(_Opts, []) -> + ok; +verify_mandatory_options(Opts, [Mand|Mands]) -> + verify_mandatory_option(Opts, Mand), + verify_mandatory_options(Opts, Mands). + +verify_mandatory_option(Opts, {Mand, MandSubOpts}) -> + ?d("verify_mandatory_option -> entry with" + "~n Mand: ~p" + "~n MandSubObjs: ~p", [Mand, MandSubOpts]), + case lists:keysearch(Mand, 1, Opts) of + {value, {Mand, SubOpts}} -> + verify_mandatory_options(SubOpts, MandSubOpts); + false -> + ?d("missing mandatory option: ~w [~p]", [Mand, MandSubOpts]), + error({missing_mandatory, Mand, MandSubOpts}) + end; +verify_mandatory_option(Opts, Mand) -> + ?d("verify_mandatory_option -> entry with" + "~n Mand: ~p", [Mand]), + case lists:keymember(Mand, 1, Opts) of + true -> + ok; + false -> + ?d("missing mandatory option: ~w", [Mand]), + error({missing_mandatory, Mand}) + end. + %% ------------------------------------------------------------------------ init_manager_config([]) -> @@ -1629,181 +1671,91 @@ init_agent_default() -> %% The purpose of the default_agent is only to have a place %% to store system wide default values related to agents. %% - - %% Port - init_agent_default(port, ?DEFAULT_AGENT_PORT), - - %% Timeout - init_agent_default(timeout, 10000), - - %% Max message (packet) size - init_agent_default(max_message_size, 484), - - %% MPModel - init_agent_default(version, v2), - - %% SecModel - init_agent_default(sec_model, v2c), - - %% SecName - init_agent_default(sec_name, "initial"), - - %% SecLevel - init_agent_default(sec_level, noAuthNoPriv), - - %% Community - init_agent_default(community, "all-rights"), - ok. - - -init_agent_default(Item, Val) when Item =/= user_id -> - case do_update_agent_info(default_agent, Item, Val) of - ok -> - ok; - {error, Reason} -> - error(Reason) - end. - + AgentDefaultConfig = + [{port, ?DEFAULT_AGENT_PORT}, % Port + {timeout, 10000}, % Timeout + {max_message_size, 484}, % Max message (packet) size + {version, v2}, % MPModel + {sec_model, v2c}, % SecModel + {sec_name, "initial"}, % SecName + {sec_level, noAuthNoPriv}, % SecLevel + {community, "all-rights"}], % Community + do_update_agent_info(default_agent, AgentDefaultConfig). read_agents_config_file(Dir) -> - Check = fun(C) -> check_agent_config2(C) end, - case read_file(Dir, "agents.conf", Check, []) of - {ok, Conf} -> - Conf; - Error -> + Order = fun snmp_conf:no_order/2, + Check = fun check_agent_config/2, + try read_file(Dir, "agents.conf", Order, Check, []) + catch + throw:Error -> ?vlog("agent config error: ~p", [Error]), - throw(Error) + erlang:raise(throw, Error, erlang:get_stacktrace()) end. -check_agent_config2(Agent) -> - case (catch check_agent_config(Agent)) of - {ok, {UserId, TargetName, Conf, Version}} -> - {ok, Vsns} = system_info(versions), - case lists:member(Version, Vsns) of - true -> - {ok, {UserId, TargetName, Conf}}; - false -> - error({version_not_supported_by_manager, - Version, Vsns}) - end; - Err -> - throw(Err) +check_agent_config(Agent, State) -> + {ok, {UserId, TargetName, Conf, Version}} = check_agent_config(Agent), + {ok, Vsns} = system_info(versions), + case lists:member(Version, Vsns) of + true -> + {{ok, {UserId, TargetName, Conf}}, State}; + false -> + error({version_not_supported_by_manager, Version, Vsns}) end. %% For backward compatibility -check_agent_config({UserId, - TargetName, - Community, - Ip, Port, - EngineId, - Timeout, MaxMessageSize, - Version, SecModel, SecName, SecLevel}) -> - TDomain = default_transport_domain(), - check_agent_config({UserId, - TargetName, - Community, - TDomain, Ip, Port, - EngineId, - Timeout, MaxMessageSize, - Version, SecModel, SecName, SecLevel}); - -check_agent_config({UserId, - TargetName, - Community, - TDomain, Ip, Port, - EngineId, - Timeout, MaxMessageSize, - Version, SecModel, SecName, SecLevel}) -> - ?vtrace("check_agent_config -> entry with" - "~n UserId: ~p" - "~n TargetName: ~p" - "~n Community: ~p" - "~n TDomain: ~p" - "~n Ip: ~p" - "~n Port: ~p" - "~n EngineId: ~p" - "~n Timeout: ~p" - "~n MaxMessageSize: ~p" - "~n Version: ~p" - "~n SecModel: ~p" - "~n SecName: ~p" - "~n SecLevel: ~p", - [UserId, TargetName, Community, - TDomain, Ip, Port, - EngineId, Timeout, MaxMessageSize, - Version, SecModel, SecName, SecLevel]), - Addr = normalize_address(TDomain, Ip), - ?vtrace("check_agent_config -> Addr: ~p", [Addr]), - Agent = {UserId, - TargetName, - Community, - TDomain, Addr, Port, - EngineId, - Timeout, MaxMessageSize, - Version, SecModel, SecName, SecLevel}, - {ok, verify_agent(Agent)}; +check_agent_config( + {UserId, TargetName, Community, Domain, Addr, + EngineId, Timeout, MaxMessageSize, + Version, SecModel, SecName, SecLevel}) when is_atom(Domain) -> + check_agent_config( + UserId, TargetName, Community, Domain, Addr, + EngineId, Timeout, MaxMessageSize, + Version, SecModel, SecName, SecLevel); +check_agent_config( + {UserId, TargetName, Community, Ip, Port, + EngineId, Timeout, MaxMessageSize, + Version, SecModel, SecName, SecLevel}) when is_integer(Port) -> + Domain = default_transport_domain(), + Addr = {Ip, Port}, + check_agent_config( + UserId, TargetName, Community, Domain, Addr, + EngineId, Timeout, MaxMessageSize, + Version, SecModel, SecName, SecLevel); +check_agent_config( + {_UserId, _TargetName, _Community, Domain, Addr, + _EngineId, _Timeout, _MaxMessageSize, + _Version, _SecModel, _SecName, _SecLevel}) -> + error({bad_address, {Domain, Addr}}); +check_agent_config( + {UserId, TargetName, Community, Domain, Ip, Port, + EngineId, Timeout, MaxMessageSize, + Version, SecModel, SecName, SecLevel}) -> + Addr = {Ip, Port}, + check_agent_config( + UserId, TargetName, Community, Domain, Addr, + EngineId, Timeout, MaxMessageSize, + Version, SecModel, SecName, SecLevel); check_agent_config(Agent) -> error({bad_agent_config, Agent}). - -init_agents_config([]) -> - ok; -init_agents_config([Agent|Agents]) -> - init_agent_config(Agent), - init_agents_config(Agents). - -init_agent_config({_UserId, ?DEFAULT_TARGETNAME = TargetName, _Config}) -> - throw({error, {invalid_target_name, TargetName}}); -init_agent_config({UserId, TargetName, Config}) -> - case handle_register_agent(UserId, TargetName, Config) of - ok -> - ok; - Error -> - throw(Error) - end. - - -%% For backward compatibility -verify_agent({UserId, - TargetName, - Comm, - Ip, Port, - EngineId, - Timeout, MMS, - Version, SecModel, SecName, SecLevel}) -> - TDomain = default_transport_domain(), - verify_agent({UserId, - TargetName, - Comm, - TDomain, Ip, Port, - EngineId, - Timeout, MMS, - Version, SecModel, SecName, SecLevel}); - -verify_agent({UserId, - TargetName, - Comm, - TDomain, Ip, Port, - EngineId, - Timeout, MMS, - Version, SecModel, SecName, SecLevel}) -> - ?vdebug("verify_agent -> entry with" +check_agent_config( + UserId, TargetName, Comm, Domain, Addr, + EngineId, Timeout, MMS, + Version, SecModel, SecName, SecLevel) -> + ?vdebug("check_agent_config -> entry with" "~n UserId: ~p" "~n TargetName: ~p", [UserId, TargetName]), snmp_conf:check_string(TargetName, {gt, 0}), - snmp_conf:check_integer(Port, {gt, 0}), %% Note that the order of Conf *is* important. %% Some properties may depend on others, so that %% in order to verify one property, another must %% be already verified (and present). An example - %% of this is the property 'address', for which + %% of this is the property 'taddress', for which %% the property tdomain is needed. - Conf0 = + Conf = [{reg_type, target_name}, - {tdomain, TDomain}, - %% This should be taddress, but what the*... - {address, {TDomain, Ip}}, - {port, Port}, + {tdomain, Domain}, + {taddress, fix_address(Domain, Addr)}, {community, Comm}, {engine_id, EngineId}, {timeout, Timeout}, @@ -1813,40 +1765,180 @@ verify_agent({UserId, {sec_name, SecName}, {sec_level, SecLevel} ], - case verify_agent2(Conf0) of - {ok, Conf} -> - {UserId, TargetName, Conf, Version}; - Err -> - throw(Err) + {ok, {UserId, TargetName, verify_agent_config(Conf), Version}}. + + + +init_agents_config([]) -> + ok; +init_agents_config([Agent|Agents]) -> + init_agent_config(Agent), + init_agents_config(Agents). + +init_agent_config({_UserId, ?DEFAULT_TARGETNAME = TargetName, _Config}) -> + error({invalid_target_name, TargetName}); +init_agent_config({UserId, TargetName, Config}) -> + case handle_register_agent(UserId, TargetName, Config) of + ok -> + ok; + Error -> + throw(Error) end. -verify_agent2(Conf) -> - verify_agent2(Conf, []). -verify_agent2([], VerifiedConf) -> - {ok, VerifiedConf}; -verify_agent2([{Item, Val0}|Items], VerifiedConf) -> - case verify_val(Item, Val0) of - {ok, Val} -> - verify_agent2(Items, [{Item, Val} | VerifiedConf]); - Err -> - Err + +%% Sort 'tdomain' first then 'port' to ensure both +%% sorts before 'taddress'. Keep the order of other items. +order_agent(ItemA, ItemB) -> + snmp_conf:keyorder(1, ItemA, ItemB, [tdomain, port]). + +fix_agent_config(Conf) -> + ?vdebug("fix_agent_config -> entry with~n~n" + " Conf: ~p", [Conf]), + fix_agent_config(lists:sort(fun order_agent/2, Conf), []). + +fix_agent_config([], FixedConf) -> + Ret = lists:reverse(FixedConf), + ?vdebug("fix_agent_config -> returns:~n" + " ~p", [Ret]), + Ret; +fix_agent_config([{taddress = Item, Address} = Entry|Conf], FixedConf) -> + {value, {tdomain, TDomain}} = lists:keysearch(tdomain, 1, FixedConf), + {value, {port, DefaultPort}} = lists:keysearch(port, 1, FixedConf), + case snmp_conf:check_address(TDomain, Address, DefaultPort) of + ok -> + fix_agent_config(Conf, [Entry|FixedConf]); + {ok, NAddress} -> + fix_agent_config(Conf, [{Item, NAddress}|FixedConf]) end; -verify_agent2([Bad|_], _VerifiedConf) -> - {error, {bad_agent_config, Bad}}. +fix_agent_config([Entry|Conf], FixedConf) -> + fix_agent_config(Conf, [Entry|FixedConf]). + + + +verify_agent_config(Conf) -> + verify_agent_config(lists:sort(fun order_agent/2, Conf), []). + +verify_agent_config([], VerifiedConf) -> + Ret = lists:reverse(VerifiedConf), + ?vdebug("verify_agent_config -> returns:~n" + " ~p", [Ret]), + Ret; +verify_agent_config([{Item, _} = Entry|Conf], VerifiedConf) -> + verify_illegal(VerifiedConf, [Item]), % Duplicates are hereby illegal + verify_agent_config(Conf, VerifiedConf, Entry); +verify_agent_config([Bad|_], _VerifiedConf) -> + error({bad_agent_config, Bad}). + +verify_agent_config( + Conf, VerifiedConf, {taddress = Item, Address} = Entry) -> + verify_illegal(VerifiedConf, [address]), + {TDomain, VC} = + case lists:keysearch(tdomain, 1, VerifiedConf) of + {value, {tdomain,TD}} -> + {TD, VerifiedConf}; + _ -> + %% Insert tdomain since it is missing + %% Note: not default_transport_domain() since + %% taddress is the new format hence the application + %% should be tdomain aware and therefore addresses + %% on the Domain, Addr format should be used and understood. + TD = transportDomainUdpIpv4, + {TD, [{tdomain, TD}|VerifiedConf]} + end, + case snmp_conf:check_address(TDomain, Address, 0) of + ok -> + verify_agent_config(Conf, [Entry|VC]); + {ok, NAddress} -> + verify_agent_config(Conf, [{Item, NAddress}|VC]) + end; +verify_agent_config(Conf, VerifiedConf, {address, Address}) -> + Item = taddress, + verify_illegal(VerifiedConf, [Item]), + {TDomain, VC} = + case lists:keysearch(tdomain, 1, VerifiedConf) of + {value, {tdomain, TD}} -> + {TD, VerifiedConf}; + _ -> + %% Insert tdomain since it is missing + TD = default_transport_domain(), + {TD, [{tdomain, TD}|VerifiedConf]} + end, + case snmp_conf:check_address(TDomain, Address, 0) of + ok -> + verify_agent_config(Conf, [{Item, Address}|VC]); + {ok, NAddress} -> + verify_agent_config(Conf, [{Item, NAddress}|VC]) + end; +verify_agent_config(Conf, VerifiedConf, {Item, Val} = Entry) -> + case verify_agent_entry(Item, Val) of + ok -> + verify_agent_config(Conf, [Entry|VerifiedConf]); + {ok, NewVal} -> + verify_agent_config(Conf, [{Item, NewVal}|VerifiedConf]) + end. + +verify_agent_entry(user_id, _UserId) -> + ok; +verify_agent_entry(reg_type, RegType) -> + if + RegType =:= addr_port; + RegType =:= target_name -> + ok; + true -> + error({bad_reg_type, RegType}) + end; +verify_agent_entry(tdomain, TDomain) -> + snmp_conf:check_domain(TDomain); +verify_agent_entry(port, Port) -> + snmp_conf:check_port(Port); +verify_agent_entry(community, Comm) -> + snmp_conf:check_string(Comm); +verify_agent_entry(engine_id, EngineId) -> + case EngineId of + discovery -> + ok; + _ -> + snmp_conf:check_string(EngineId) + end; +verify_agent_entry(timeout, Timeout) -> + snmp_conf:check_timer(Timeout); +verify_agent_entry(max_message_size, MMS) -> + snmp_conf:check_packet_size(MMS); +verify_agent_entry(version, V) -> + if + V =:= v1; + V =:= v2; + V =:= v3 -> + ok; + true -> + error({bad_version, V}) + end; +verify_agent_entry(sec_model, Model) -> + snmp_conf:check_sec_model(Model); +verify_agent_entry(sec_name, Name) -> + try snmp_conf:check_string(Name) + catch + _ -> + error({bad_sec_name, Name}) + end; +verify_agent_entry(sec_level, Level) -> + snmp_conf:check_sec_level(Level); +verify_agent_entry(Item, _) -> + error({unknown_item, Item}). + read_users_config_file(Dir) -> - Check = fun(C) -> check_user_config(C) end, - case read_file(Dir, "users.conf", Check, []) of - {ok, Conf} -> - Conf; - Error -> + Order = fun snmp_conf:no_order/2, + Check = fun (User, State) -> {check_user_config(User), State} end, + try read_file(Dir, "users.conf", Order, Check, []) + catch + throw:Error -> ?vlog("failure reading users config file: ~n ~p", [Error]), - throw(Error) + erlang:raise(throw, Error, erlang:get_stacktrace()) end. - check_user_config({Id, Mod, Data}) -> ?vtrace("check_user_config -> entry with" "~n Id: ~p" @@ -1864,21 +1956,18 @@ check_user_config({Id, Mod, Data, DefaultAgentConfig} = _User) case (catch verify_user_behaviour(Mod)) of ok -> ?vtrace("check_user_config -> user behaviour verified", []), - case verify_user_agent_config(DefaultAgentConfig) of - {ok, DefAgentConf} -> - ?vtrace("check_user_config -> " - "user agent (default) config verified", []), - User2 = {Id, Mod, Data, DefAgentConf}, - {ok, User2}; - {error, Reason} -> - error({bad_default_agent_config, Reason}) - end; + DefAgentConf = + verify_default_agent_config(DefaultAgentConfig), + ?vtrace("check_user_config -> " + "user agent (default) config verified", []), + User2 = {Id, Mod, Data, DefAgentConf}, + {ok, User2}; Error -> throw(Error) end; check_user_config({Id, _Mod, _Data, DefaultAgentConfig}) when (Id =/= ?DEFAULT_USER) -> - {error, {bad_default_agent_config, DefaultAgentConfig}}; + error({bad_default_agent_config, DefaultAgentConfig}); check_user_config({Id, _Mod, _Data, _DefaultAgentConfig}) -> error({bad_user_id, Id}); check_user_config(User) -> @@ -1904,7 +1993,7 @@ init_user_config(User) -> error_msg("user config check failed: " "~n~w~n~w", [User, Reason]) end. - + verify_user({Id, UserMod, UserData}) -> verify_user({Id, UserMod, UserData, []}); verify_user({Id, UserMod, UserData, DefaultAgentConfig}) @@ -1917,15 +2006,24 @@ verify_user({Id, UserMod, UserData, DefaultAgentConfig}) [Id, UserMod, UserData, DefaultAgentConfig]), case (catch verify_user_behaviour(UserMod)) of ok -> - case verify_user_agent_config(DefaultAgentConfig) of - {ok, DefAgentConf} -> - Config = default_agent_config(DefAgentConf), - {ok, #user{id = Id, - mod = UserMod, - data = UserData, - default_agent_config = Config}}; - {error, Reason} -> - error({bad_default_agent_config, Reason}) + try + {ok, SystemDefaultAgentConfig} = agent_info(), + Config = + ensure_config( + SystemDefaultAgentConfig, + verify_default_agent_config(DefaultAgentConfig)), +%% Config = +%% default_agent_config( +%% verify_default_agent_config(DefaultAgentConfig)), + {ok, #user{id = Id, + mod = UserMod, + data = UserData, + default_agent_config = Config}} + catch + Error -> + ?vdebug("verify_user default_agent_config -> throw" + "~n Error: ~p", [Error]), + error({bad_default_agent_config, Error}) end; Error -> throw(Error) @@ -1936,27 +2034,24 @@ verify_user({Id, _UserMod, _UserData, DefaultAgentConfig}) verify_user({Id, _, _, _}) -> {error, {bad_user_id, Id}}. -verify_user_agent_config(Conf) -> +verify_default_agent_config(Conf) -> try - begin - verify_invalid(Conf, [user_id, engine_id, address]), - verify_agent_config2(Conf) - end + verify_illegal( + Conf, + [user_id, engine_id, address, tdomain, taddress]), + verify_agent_config(Conf) catch - throw:Error -> - ?vdebug("verify_user_agent_config -> throw" + Error -> + ?vdebug("verify_default_agent_config -> throw" "~n Error: ~p", [Error]), - Error + error({bad_default_agent_config, Error}) end. + read_usm_config_file(Dir) -> - Check = fun(C) -> check_usm_user_config(C) end, - case read_file(Dir, "usm.conf", Check, []) of - {ok, Conf} -> - Conf; - Error -> - throw(Error) - end. + Order = fun snmp_conf:no_order/2, + Check = fun (User, State) -> {check_usm_user_config(User), State} end, + read_file(Dir, "usm.conf", Order, Check, []). %% Identity-function check_usm_user_config({EngineId, Name, @@ -2139,125 +2234,128 @@ is_crypto_supported(Func) -> read_manager_config_file(Dir) -> - Check = fun(Conf) -> check_manager_config(Conf) end, - case read_file(Dir, "manager.conf", Check) of - {ok, Conf} -> - ?d("read_manager_config_file -> ok: " - "~n Conf: ~p", [Conf]), - %% If the address is not specified, then we assume - %% it should be the local host. - %% If the address is not possible to determine - %% that way, then we give up... - check_mandatory_manager_config(Conf), - ensure_manager_config(Conf); - Error -> - throw(Error) - end. + Order = fun order_manager_config/2, + Check = fun check_manager_config/2, + Conf = read_file(Dir, "manager.conf", Order, Check), + ?d("read_manager_config_file -> ok: " + "~n Conf: ~p", [Conf]), + %% If the address is not specified, then we assume + %% it should be the local host. + %% If the address is not possible to determine + %% that way, then we give up... + verify_someof(Conf, [port, transports]), + verify_mandatory(Conf, [engine_id, max_message_size]), + default_manager_config(Conf). + +default_manager_config(Conf) -> + %% Ensure valid transports entry + case lists:keyfind(transports, 1, Conf) of + false -> + {port, Port} = lists:keyfind(port, 1, Conf), + Domain = + case lists:keyfind(domain, 1, Conf) of + false -> + default_transport_domain(); + {_, D} -> + D + end, + Family = snmp_conf:tdomain_to_family(Domain), + {ok, Hostname} = inet:gethostname(), + case inet:getaddr(Hostname, Family) of + {ok, Address} -> + lists:sort( + fun order_manager_config/2, + [{transports, [{Domain, {Address, Port}}]} | Conf]); + {error, _Reason} -> + ?d("default_manager_config -> " + "failed getting ~w address for ~s:~n" + " _Reason: ~p", [Family, Hostname, _Reason]), + Conf + end; + _ -> + Conf + end. + +order_manager_config(EntryA, EntryB) -> + snmp_conf:keyorder(1, EntryA, EntryB, [domain, port]). + +check_manager_config(Entry, undefined) -> + check_manager_config(Entry, {default_transport_domain(), undefined}); +check_manager_config({domain, Domain}, {_, Port}) -> + {snmp_conf:check_domain(Domain), {Domain, Port}}; +check_manager_config({port, Port}, {Domain, _}) -> + {ok = snmp_conf:check_port(Port), {Domain, Port}}; +check_manager_config({address, _}, {_, undefined}) -> + error({missing_mandatory, port}); +check_manager_config({address = Tag, Ip} = Entry, {Domain, Port} = State) -> + {case snmp_conf:check_ip(Domain, Ip) of + ok -> + [Entry, + {transports, [{Domain, {Ip, Port}}]}]; + {ok, FixedIp} -> + [{Tag, FixedIp}, + {transports, [{Domain, {FixedIp, Port}}]}] + end, State}; +check_manager_config({transports = Tag, Transports}, {_, Port} = State) + when is_list(Transports) -> + CheckedTransports = + [case Transport of + {Domain, Address} -> + case + case Port of + undefined -> + snmp_conf:check_address(Domain, Address); + _ -> + snmp_conf:check_address(Domain, Address, Port) + end + of + ok -> + Transport; + {ok, FixedAddress} -> + {Domain, FixedAddress} + end; + _Domain when Port =:= undefined-> + error({missing_mandatory, port}); + Domain -> + Family = snmp_conf:tdomain_to_family(Domain), + {ok, Hostname} = inet:gethostname(), + case inet:getaddr(Hostname, Family) of + {ok, IpAddr} -> + {Domain, {IpAddr, Port}}; + {error, _} -> + error({bad_address, {Domain, Hostname}}) + end + end + || Transport <- Transports], + {{ok, {Tag, CheckedTransports}}, State}; +check_manager_config(Entry, State) -> + {check_manager_config(Entry), State}. -default_manager_config() -> - {ok, HostName} = inet:gethostname(), - case inet:getaddr(HostName, inet) of - {ok, A} -> - [{address, tuple_to_list(A)}]; - {error, _Reason} -> - ?d("default_manager_config -> failed getting address: " - "~n _Reason: ~p", [_Reason]), - [] - end. - -check_manager_config({address, Addr}) -> - snmp_conf:check_ip(Addr); -check_manager_config({port, Port}) -> - snmp_conf:check_integer(Port, {gt, 0}); check_manager_config({engine_id, EngineID}) -> snmp_conf:check_string(EngineID); check_manager_config({max_message_size, Max}) -> snmp_conf:check_integer(Max, {gte, 484}); check_manager_config(Conf) -> - {error, {unknown_config, Conf}}. - - -check_mandatory_manager_config(Conf) -> - Mand = [port, engine_id, max_message_size], - check_mandatory_manager_config(Mand, Conf). - -check_mandatory_manager_config([], _Conf) -> - ok; -check_mandatory_manager_config([Item|Mand], Conf) -> - case lists:keysearch(Item, 1, Conf) of - false -> - error({missing_mandatory_manager_config, Item}); - _ -> - check_mandatory_manager_config(Mand, Conf) - end. - - -ensure_manager_config(Confs) -> - ensure_manager_config(Confs, default_manager_config()). - -ensure_manager_config(Confs, []) -> - Confs; -ensure_manager_config(Confs, [{Key,_} = DefKeyVal|Defs]) -> - case lists:keysearch(Key, 1, Confs) of - false -> - ensure_manager_config([DefKeyVal|Confs], Defs); - {value, _Conf} -> - ensure_manager_config(Confs, Defs) - end. - -% ensure_manager_config([], Defs, Confs) -> -% Confs ++ Defs; -% ensure_manager_config(Confs0, [{Key, DefVal}|Defs], Acc) -> -% case lists:keysearch(Key, 1, Confs0) of -% false -> -% ensure_manager_config(Confs0, Defs, [{Key, DefVal}|Acc]); -% {value, Conf} -> -% Confs = lists:keydelete(Key, 1, Confs0), -% ensure_manager_config(Confs, Defs, [Conf|Acc]) -% end. - + error({unknown_config, Conf}). -read_file(Dir, FileName, Check, Default) -> - File = filename:join(Dir, FileName), - case file:read_file_info(File) of - {ok, _} -> - case (catch do_read(File, Check)) of - {ok, Conf} -> - {ok, Conf}; - Error -> - ?vtrace("read_file -> read failed:" - "~n Error: ~p", [Error]), - Error - end; - {error, Reason} -> +read_file(Dir, FileName, Order, Check, Default) -> + try snmp_conf:read(filename:join(Dir, FileName), Order, Check) + catch + {error, Reason} when element(1, Reason) =:= failed_open -> ?vlog("failed reading config from ~s: ~p", [FileName, Reason]), - {ok, Default} + Default end. -read_file(Dir, FileName, Check) -> - File = filename:join(Dir, FileName), - case file:read_file_info(File) of - {ok, _} -> - case (catch do_read(File, Check)) of - {ok, Conf} -> - ?vtrace("read_file -> read ok" - "~n Conf: ~p", [Conf]), - {ok, Conf}; - Error -> - ?vtrace("read_file -> read failed:" - "~n Error: ~p", [Error]), - Error - end; - {error, Reason} -> +read_file(Dir, FileName, Order, Check) -> + try snmp_conf:read(filename:join(Dir, FileName), Order, Check) + catch + throw:{error, Reason} = Error + when element(1, Reason) =:= failed_open -> error_msg("failed reading config from ~s: ~p", [FileName, Reason]), - {error, {failed_reading, FileName, Reason}} + erlang:raise(throw, Error, erlang:get_stacktrace()) end. -do_read(File, Check) -> - {ok, snmp_conf:read(File, Check)}. - - %%-------------------------------------------------------------------- %% Func: handle_call/3 %% Returns: {reply, Reply, State} | @@ -2684,30 +2782,50 @@ handle_register_agent(UserId, TargetName, Config) -> "~n Config: ~p", [UserId, TargetName, Config]), case (catch agent_info(TargetName, user_id)) of {error, _} -> - ?vtrace("handle_register_agent -> user_id not found in config", []), + ?vtrace( + "handle_register_agent -> user_id not found in config", []), case ets:lookup(snmpm_user_table, UserId) of [#user{default_agent_config = DefConfig}] -> - ?vtrace("handle_register_agent -> " - "~n DefConfig: ~p", [DefConfig]), - %% First, insert this users default config - ?vtrace("handle_register_agent -> store default config", []), - do_handle_register_agent(TargetName, DefConfig), - %% Second, insert the config for this agent - ?vtrace("handle_register_agent -> store config", []), - do_handle_register_agent(TargetName, - [{user_id, UserId}|Config]), + ?vtrace("handle_register_agent ->~n" + " DefConfig: ~p", [DefConfig]), + FixedConfig = + fix_agent_config(ensure_config(DefConfig, Config)), + ?vtrace("handle_register_agent ->~n" + " FixedConfig: ~p", [FixedConfig]), + do_handle_register_agent( + TargetName, [{user_id, UserId}|FixedConfig]), %% <DIRTY-BACKWARD-COMPATIBILLITY> - %% And now for some (backward compatibillity) + %% And now for some (backward compatibillity) %% dirty crossref stuff - ?vtrace("handle_register_agent -> lookup address", []), - {ok, Addr} = agent_info(TargetName, address), - ?vtrace("handle_register_agent -> Addr: ~p, lookup Port", - [Addr]), - {ok, Port} = agent_info(TargetName, port), - ?vtrace("handle_register_agent -> register cross-ref fix", []), - ets:insert(snmpm_agent_table, - {{Addr, Port, target_name}, TargetName}), + {value, {_, Domain}} = + lists:keysearch(tdomain, 1, FixedConfig), + {value, {_, Address}} = + lists:keysearch(taddress, 1, FixedConfig), + ?vtrace( + "handle_register_agent -> register cross-ref fix", []), + ets:insert(snmpm_agent_table, + {{Domain, Address, target_name}, TargetName}), %% </DIRTY-BACKWARD-COMPATIBILLITY> + +%% %% First, insert this users default config +%% ?vtrace("handle_register_agent -> store default config", []), +%% do_handle_register_agent(TargetName, DefConfig), +%% %% Second, insert the config for this agent +%% ?vtrace("handle_register_agent -> store config", []), +%% do_handle_register_agent(TargetName, +%% [{user_id, UserId}|Config]), +%% %% <DIRTY-BACKWARD-COMPATIBILLITY> +%% %% And now for some (backward compatibillity) +%% %% dirty crossref stuff +%% ?vtrace("handle_register_agent -> lookup taddress", []), +%% {ok, {Addr, Port} = TAddress} = +%% agent_info(TargetName, taddress), +%% ?vtrace("handle_register_agent -> taddress: ~p", +%% [TAddress]), +%% ?vtrace("handle_register_agent -> register cross-ref fix", []), +%% ets:insert(snmpm_agent_table, +%% {{Addr, Port, target_name}, TargetName}), +%% %% </DIRTY-BACKWARD-COMPATIBILLITY> ok; _ -> {error, {not_found, UserId}} @@ -2729,7 +2847,7 @@ handle_register_agent(UserId, TargetName, Config) -> do_handle_register_agent(_TargetName, []) -> ok; do_handle_register_agent(TargetName, [{Item, Val}|Rest]) -> - ?vtrace("handle_register_agent -> entry with" + ?vtrace("do_handle_register_agent -> entry with" "~n TargetName: ~p" "~n Item: ~p" "~n Val: ~p" @@ -2738,7 +2856,7 @@ do_handle_register_agent(TargetName, [{Item, Val}|Rest]) -> ok -> do_handle_register_agent(TargetName, Rest); {error, Reason} -> - ?vtrace("handle_register_agent -> failed updating ~p" + ?vtrace("do_handle_register_agent -> failed updating ~p" "~n Item: ~p" "~n Reason: ~p", [Item, Reason]), ets:match_delete(snmpm_agent_table, {TargetName, '_'}), @@ -2762,9 +2880,9 @@ handle_unregister_agent(UserId, TargetName) -> %% <DIRTY-BACKWARD-COMPATIBILLITY> %% And now for some (backward compatibillity) %% dirty crossref stuff - {ok, Addr} = agent_info(TargetName, address), - {ok, Port} = agent_info(TargetName, port), - ets:delete(snmpm_agent_table, {Addr, Port, target_name}), + {ok, Domain} = agent_info(TargetName, tdomain), + {ok, Address} = agent_info(TargetName, taddress), + ets:delete(snmpm_agent_table, {Domain, Address, target_name}), %% </DIRTY-BACKWARD-COMPATIBILLITY> ets:match_delete(snmpm_agent_table, {{TargetName, '_'}, '_'}), ok; @@ -2790,21 +2908,26 @@ handle_update_agent_info(UserId, TargetName, Info) -> Error end. -handle_update_agent_info(TargetName, Info0) -> +handle_update_agent_info(TargetName, Info) -> ?vtrace("handle_update_agent_info -> entry with" "~n TargetName: ~p" - "~n Info0: ~p", [TargetName, Info0]), + "~n Info: ~p", [TargetName, Info]), %% Verify info - try verify_agent_info(TargetName, Info0) of - {ok, Info} -> - do_update_agent_info(TargetName, Info); + try + verify_illegal(Info, [user_id]), + %% If port or domain is part of the info, then use it. + %% If not, lookup what is already stored for + %% this agent and use that. + do_update_agent_info( + TargetName, + fix_agent_config( + verify_agent_config( + ensure_agent_info(TargetName, [port,tdomain], Info)))) + catch Error -> - Error - catch - throw:Error -> Error; T:E -> - {error, {failed_info_verification, Info0, T, E}} + {error, {failed_info_verification, Info, T, E}} end. handle_update_agent_info(UserId, TargetName, Item, Val) -> @@ -2816,6 +2939,9 @@ handle_update_agent_info(UserId, TargetName, Item, Val) -> handle_update_agent_info(TargetName, [{Item, Val}]). do_update_agent_info(TargetName, Info) -> + ?vtrace("do_update_agent_info -> entry with~n" + " TargetName: ~p~n" + " Info: ~p", [TargetName,Info]), InsertItem = fun({Item, Val}) -> ets:insert(snmpm_agent_table, {{TargetName, Item}, Val}) @@ -2997,109 +3123,42 @@ verify_mandatory(Conf, [Mand|Mands]) -> true -> verify_mandatory(Conf, Mands); false -> - throw({error, {missing_mandatory_config, Mand}}) + error({missing_mandatory_config, Mand}) end. -verify_invalid(_, []) -> +verify_illegal(_, []) -> ok; -verify_invalid(Conf, [Inv|Invs]) -> +verify_illegal(Conf, [Inv|Invs]) -> case lists:member(Inv, Conf) of false -> - verify_invalid(Conf, Invs); + verify_illegal(Conf, Invs); true -> - throw({error, {illegal_config, Inv}}) + error({illegal_config, Inv}) end. - -verify_val(user_id, UserId) -> - {ok, UserId}; -verify_val(reg_type, RegType) - when (RegType =:= addr_port) orelse (RegType =:= target_name) -> - {ok, RegType}; -verify_val(tdomain = Item, snmpUDPDomain = _Domain) -> - verify_val(Item, transportDomainUdpIpv4); -verify_val(tdomain, Domain) -> - case lists:member(Domain, ?SUPPORTED_DOMAINS) of +verify_someof(Conf, [Mand|Mands]) -> + case lists:keymember(Mand, 1, Conf) of true -> - {ok, Domain}; + ok; false -> - case lists:member(Domain, snmp_conf:all_domains()) of - true -> - error({unsupported_domain, Domain}); - false -> - error({unknown_domain, Domain}) + case Mands of + [] -> + error({missing_mandatory_config, Mand}); + _ -> + verify_someof(Conf, Mands) end - end; -verify_val(address, {Domain, Addr0}) -> - case normalize_address(Domain, Addr0) of - {_A1, _A2, _A3, _A4} = Addr -> - {ok, Addr}; - {_A1, _A2, _A3, _A4, _A5, _A6, _A7, _A8} = Addr -> - {ok, Addr}; - _ when is_list(Addr0) -> - case (catch snmp_conf:check_ip(Addr0)) of - ok -> - {ok, list_to_tuple(Addr0)}; - Err -> - Err - end; - _ -> - error({bad_address, Addr0}) - end; -verify_val(address, BadAddress) -> - error({bad_address, BadAddress}); -verify_val(port, Port) -> - case (catch snmp_conf:check_integer(Port, {gt, 0})) of - ok -> - {ok, Port}; - Err -> - Err - end; -verify_val(community, Comm) -> - case (catch snmp_conf:check_string(Comm)) of - ok -> - {ok, Comm}; - Err -> - Err - end; -verify_val(engine_id, discovery = EngineId) -> - {ok, EngineId}; -verify_val(engine_id, EngineId) -> - case (catch snmp_conf:check_string(EngineId)) of - ok -> - {ok, EngineId}; - Err -> - Err - end; -verify_val(timeout, Timeout) -> - (catch snmp_conf:check_timer(Timeout)); -verify_val(max_message_size, MMS) -> - case (catch snmp_conf:check_packet_size(MMS)) of - ok -> - {ok, MMS}; - Err -> - Err - end; -verify_val(version, V) - when (V =:= v1) orelse (V =:= v2) orelse (V =:= v3) -> - {ok, V}; -verify_val(version, BadVersion) -> - error({bad_version, BadVersion}); -verify_val(sec_model, Model) -> - (catch snmp_conf:check_sec_model(Model)); -verify_val(sec_name, Name) when is_list(Name) -> - case (catch snmp_conf:check_string(Name)) of - ok -> - {ok, Name}; - Err -> - Err - end; -verify_val(sec_name, BadName) -> - error({bad_sec_name, BadName}); -verify_val(sec_level, Level) -> - (catch snmp_conf:check_sec_level(Level)); -verify_val(Item, _) -> - {error, {unknown_item, Item}}. + end. + +ensure_config([], Config) -> + Config; +ensure_config([Default|Defaults], Config) -> + case lists:keymember(element(1, Default), 1, Config) of + true -> + ensure_config(Defaults, Config); + false -> + ensure_config(Defaults, [Default|Config]) + end. + %%%------------------------------------------------------------------- @@ -3257,31 +3316,14 @@ init_mini_mib_elems(MibName, [_|T], Res) -> %%---------------------------------------------------------------------- -normalize_address(Addr) -> - normalize_address(snmpUDPDomain, Addr). - -normalize_address(snmpUDPDomain, Addr) -> - normalize_address(transportDomainUdpIpv4, Addr); - -normalize_address(Domain, Addr) -> - case inet:getaddr(Addr, td2fam(Domain)) of - {ok, Addr2} -> - Addr2; - _ when is_list(Addr) -> - case (catch snmp_conf:check_ip(Domain, Addr)) of - ok -> - list_to_tuple(Addr); - _ -> - Addr - end; - _ -> - Addr +fix_address(Domain, Address) -> + case snmp_conf:check_address(Domain, Address) of + ok -> + Address; + {ok, NAddress} -> + NAddress end. -td2fam(transportDomainUdpIpv4) -> inet; -td2fam(transportDomainUdpIpv6) -> inet6. - - %%---------------------------------------------------------------------- call(Req) -> @@ -3391,4 +3433,3 @@ error_msg(F, A) -> %% p(F, A) -> %% io:format("~w:" ++ F ++ "~n", [?MODULE | A]). - diff --git a/lib/snmp/src/manager/snmpm_mpd.erl b/lib/snmp/src/manager/snmpm_mpd.erl index 953c94ab54..f8a7441c0a 100644 --- a/lib/snmp/src/manager/snmpm_mpd.erl +++ b/lib/snmp/src/manager/snmpm_mpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The 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,7 +21,7 @@ -export([init/1, - process_msg/7, + process_msg/7, process_msg/6, generate_msg/5, generate_response_msg/4, next_msg_id/0, @@ -92,8 +92,10 @@ reset(#state{v3 = V3}) -> %% Purpose: This is the main Message Dispatching function. (see %% section 4.2.1 in rfc2272) %%----------------------------------------------------------------- -process_msg(Msg, Domain, Addr, Port, State, NoteStore, Logger) -> +process_msg(Msg, Domain, Ip, Port, State, NoteStore, Logger) -> + process_msg(Msg, Domain, {Ip, Port}, State, NoteStore, Logger). +process_msg(Msg, Domain, Addr, State, NoteStore, Logger) -> inc(snmpInPkts), case (catch snmp_pdus:dec_message_only(binary_to_list(Msg))) of @@ -102,17 +104,17 @@ process_msg(Msg, Domain, Addr, Port, State, NoteStore, Logger) -> #message{version = 'version-1', vsn_hdr = Community, data = Data} when State#state.v1 =:= true -> HS = ?empty_msg_size + length(Community), - process_v1_v2c_msg('version-1', NoteStore, Msg, - Domain, Addr, Port, - Community, Data, HS, Logger); + process_v1_v2c_msg( + 'version-1', NoteStore, Msg, Domain, Addr, + Community, Data, HS, Logger); %% Version 2 #message{version = 'version-2', vsn_hdr = Community, data = Data} when State#state.v2c =:= true -> HS = ?empty_msg_size + length(Community), - process_v1_v2c_msg('version-2', NoteStore, Msg, - Domain, Addr, Port, - Community, Data, HS, Logger); + process_v1_v2c_msg( + 'version-2', NoteStore, Msg, Domain, Addr, + Community, Data, HS, Logger); %% Version 3 #message{version = 'version-3', vsn_hdr = H, data = Data} @@ -122,7 +124,7 @@ process_msg(Msg, Domain, Addr, Port, State, NoteStore, Logger) -> "~n msgFlags: ~p" "~n msgSecModel: ~p", [H#v3_hdr.msgID,H#v3_hdr.msgFlags,H#v3_hdr.msgSecurityModel]), - process_v3_msg(NoteStore, Msg, H, Data, Addr, Port, Logger); + process_v3_msg(NoteStore, Msg, H, Data, Addr, Logger); %% Crap {'EXIT', {bad_version, Vsn}} -> @@ -148,32 +150,27 @@ process_msg(Msg, Domain, Addr, Port, State, NoteStore, Logger) -> %%----------------------------------------------------------------- %% Handles a Community based message (v1 or v2c). %%----------------------------------------------------------------- -process_v1_v2c_msg(Vsn, _NoteStore, Msg, Domain, - Addr, Port, - Community, Data, HS, Log) -> +process_v1_v2c_msg( + Vsn, _NoteStore, Msg, Domain, Addr, Community, Data, HS, Log) -> ?vdebug("process_v1_v2c_msg -> entry with" "~n Vsn: ~p" "~n Domain: ~p" "~n Addr: ~p" - "~n Port: ~p" "~n Community: ~p" - "~n HS: ~p", [Vsn, Domain, Addr, Port, Community, HS]), - + "~n HS: ~p", [Vsn, Domain, Addr, Community, HS]), + {TDomain, TAddress} = try - begin - TD = snmp_conf:mk_tdomain(Domain), - TA = snmp_conf:mk_taddress(Domain, Addr, Port), - {TD, TA} - end + {snmp_conf:mk_tdomain(Domain), + snmp_conf:mk_taddress(Domain, Addr)} catch throw:{error, TReason} -> throw({discarded, {badarg, Domain, TReason}}) end, Max = get_max_message_size(), - AgentMax = get_agent_max_message_size(Addr, Port), + AgentMax = get_agent_max_message_size(Domain, Addr), PduMS = pdu_ms(Max, AgentMax, HS), ?vtrace("process_v1_v2c_msg -> PduMS: ~p", [PduMS]), @@ -213,13 +210,12 @@ sec_model('version-2') -> ?SEC_V2C. %% Handles a SNMPv3 Message, following the procedures in rfc2272, %% section 4.2 and 7.2 %%----------------------------------------------------------------- -process_v3_msg(NoteStore, Msg, Hdr, Data, Addr, Port, Log) -> +process_v3_msg(NoteStore, Msg, Hdr, Data, Address, Log) -> + ?vdebug( + "process_v3_msg -> entry with~n" + " Hdr: ~p~n" + " Address: ~p", [Hdr, Address]), - ?vdebug("process_v3_msg -> entry with" - "~n Hdr: ~p" - "~n Addr: ~p" - "~n Port: ~p", [Hdr, Addr, Port]), - %% 7.2.3 #v3_hdr{msgID = MsgID, msgMaxSize = MMS, @@ -352,8 +348,8 @@ process_v3_msg(NoteStore, Msg, Hdr, Data, Addr, Port, Log) -> %% 4.2.2.1.1 - we don't handle proxys yet => we only %% handle CtxEngineID to ourselves %% Check that we actually know of an agent with this - %% CtxEngineID and Addr/Port - case is_known_engine_id(CtxEngineID, Addr, Port) of + %% CtxEngineID and Address + case is_known_engine_id(CtxEngineID, Address) of true -> ?vtrace("and the agent EngineID (~p) " "is know to us", [CtxEngineID]), @@ -866,14 +862,23 @@ get_max_message_size() -> end. %% The the MMS of the agent -get_agent_max_message_size(Addr, Port) -> - case snmpm_config:get_agent_engine_max_message_size(Addr, Port) of +get_agent_max_message_size(Domain, Addr) -> + case snmpm_config:get_agent_engine_max_message_size(Domain, Addr) of {ok, MMS} -> MMS; _Error -> - ?vlog("unknown agent: ~w:~w", [Addr, Port]), + ?vlog("unknown agent: ~s", + [snmp_conf:mk_addr_string({Domain, Addr})]), get_max_message_size() end. +%% get_agent_max_message_size(Addr, Port) -> +%% case snmpm_config:get_agent_engine_max_message_size(Addr, Port) of +%% {ok, MMS} -> +%% MMS; +%% _Error -> +%% ?vlog("unknown agent: ~w:~w", [Addr, Port]), +%% get_max_message_size() +%% end. %% Get "our" (manager) engine id get_engine_id() -> @@ -888,9 +893,12 @@ get_engine_id() -> get_agent_engine_id(Name) -> snmpm_config:get_agent_engine_id(Name). -is_known_engine_id(EngineID, Addr, Port) -> +is_known_engine_id(EngineID, {Addr, Port}) -> snmpm_config:is_known_engine_id(EngineID, Addr, Port). +%% is_known_engine_id(EngineID, Addr, Port) -> +%% snmpm_config:is_known_engine_id(EngineID, Addr, Port). + % get_agent_engine_id(Addr, Port) -> % case snmpm_config:get_agent_engine_id(Addr, Port) of % {ok, Id} -> diff --git a/lib/snmp/src/manager/snmpm_net_if.erl b/lib/snmp/src/manager/snmpm_net_if.erl index 4d6bd9aa33..cb72871177 100644 --- a/lib/snmp/src/manager/snmpm_net_if.erl +++ b/lib/snmp/src/manager/snmpm_net_if.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The 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,7 +17,9 @@ %% %CopyrightEnd% %% +-ifndef(snmpm_net_if_mt). -module(snmpm_net_if). +-endif. -behaviour(gen_server). -behaviour(snmpm_network_interface). @@ -27,9 +29,9 @@ -export([ start_link/2, stop/1, - send_pdu/6, % Backward compatibillity - send_pdu/7, % Backward compatibillity - send_pdu/8, + send_pdu/6, % Backward compatibility + send_pdu/7, % Partly backward compatibility + send_pdu/8, % Backward compatibility inform_response/4, @@ -55,11 +57,11 @@ %% -define(VMODULE,"NET_IF"). -include("snmp_verbosity.hrl"). --record(state, +-record(state, { server, note_store, - sock, + transports = [], mpd_state, log, irb = auto, % auto | {user, integer()} @@ -67,6 +69,9 @@ filter }). +-record(transport, + {socket, + domain = snmpUDPDomain}). -define(DEFAULT_FILTER_MODULE, snmpm_net_if_filter). -define(DEFAULT_FILTER_OPTS, [{module, ?DEFAULT_FILTER_MODULE}]). @@ -99,30 +104,32 @@ start_link(Server, NoteStore) -> stop(Pid) -> call(Pid, stop). -send_pdu(Pid, Pdu, Vsn, MsgData, Addr, Port) -> - send_pdu(Pid, Pdu, Vsn, MsgData, Addr, Port, ?DEFAULT_EXTRA_INFO). - -send_pdu(Pid, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo) -> - Domain = snmpm_config:default_transport_domain(), - send_pdu(Pid, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo). +send_pdu(Pid, Pdu, Vsn, MsgData, Domain_or_Ip, Addr_or_Port) -> + send_pdu( + Pid, Pdu, Vsn, MsgData, Domain_or_Ip, Addr_or_Port, ?DEFAULT_EXTRA_INFO). -send_pdu(Pid, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo) +send_pdu(Pid, Pdu, Vsn, MsgData, Domain_or_Ip, Addr_or_Port, ExtraInfo) when is_record(Pdu, pdu) -> - ?d("send_pdu -> entry with" - "~n Pid: ~p" - "~n Pdu: ~p" - "~n Vsn: ~p" - "~n MsgData: ~p" - "~n Domain: ~p" - "~n Addr: ~p" - "~n Port: ~p", [Pid, Pdu, Vsn, MsgData, Domain, Addr, Port]), - cast(Pid, {send_pdu, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo}). + ?d("send_pdu -> entry with~n" + " Pid: ~p~n" + " Pdu: ~p~n" + " Vsn: ~p~n" + " MsgData: ~p~n" + " Domain/IP: ~p~n" + " Addr/Port: ~p", + [Pid, Pdu, Vsn, MsgData, Domain_or_Ip, Addr_or_Port]), + {Domain, Addr} = address(Domain_or_Ip, Addr_or_Port), + cast(Pid, {send_pdu, Pdu, Vsn, MsgData, Domain, Addr, ExtraInfo}). + +send_pdu(Pid, Pdu, Vsn, MsgData, Domain, Ip, Port, ExtraInfo) -> + send_pdu(Pid, Pdu, Vsn, MsgData, Domain, {Ip, Port}, ExtraInfo). note_store(Pid, NoteStore) -> call(Pid, {note_store, NoteStore}). -inform_response(Pid, Ref, Addr, Port) -> - cast(Pid, {inform_response, Ref, Addr, Port}). +inform_response(Pid, Ref, Domain_or_Ip, Addr_or_Port) -> + {Domain, Addr} = address(Domain_or_Ip, Addr_or_Port), + cast(Pid, {inform_response, Ref, Domain, Addr}). info(Pid) -> call(Pid, info). @@ -144,6 +151,64 @@ filter_reset(Pid) -> %%%------------------------------------------------------------------- +%%% Multi-thread manager +%%%------------------------------------------------------------------- + +-ifdef(snmpm_net_if_mt). + +%% This function is called through the macro below to +%% (in the not multithreaded case) avoid creating the +%% Failer/4 fun, and to avoid calling the Worker through a fun +%% (now it shall not be a fun, just a code snippet). + +worker(Worker, Failer, #state{log = Log} = State) -> + Verbosity = get(verbosity), + spawn_opt( + fun () -> + try + put(sname, mnifw), + put(verbosity, Verbosity), + NewState = + case do_reopen_log(Log) of + Log -> + State; + NewLog -> + State#state{log = NewLog} + end, + Worker(NewState) + of + Result -> + %% Winds up in handle_info {'DOWN', ...} + erlang:exit({net_if_worker, Result}) + catch + Class:Reason -> + %% Winds up in handle_info {'DOWN', ...} + erlang:exit( + {net_if_worker, Failer, + Class, Reason, erlang:get_stacktrace()}) + end + end, + [monitor]). +-define( + worker(S, Worker, Failer, State), + begin + worker( + fun (S) -> begin Worker end end, + begin Failer end, + (State)) + end). + +-else. + +-define( + worker(S, Worker, _Failer, State), + begin (S) = (State), begin Worker end end). + +-endif. + + + +%%%------------------------------------------------------------------- %%% Callback functions from gen_server %%%------------------------------------------------------------------- @@ -158,12 +223,19 @@ init([Server, NoteStore]) -> ?d("init -> entry with" "~n Server: ~p" "~n NoteStore: ~p", [Server, NoteStore]), - case (catch do_init(Server, NoteStore)) of + try do_init(Server, NoteStore) + catch {error, Reason} -> - {stop, Reason}; - {ok, State} -> - {ok, State} + {stop, Reason} end. + +-ifdef(snmpm_net_if_mt). +%% This should really be protected, but it also needs to +%% be writable for the worker processes, so... +-define(inform_table_opts, [set, public, named_table, {keypos, 1}]). +-else. +-define(inform_table_opts, [set, protected, named_table, {keypos, 1}]). +-endif. do_init(Server, NoteStore) -> process_flag(trap_exit, true), @@ -173,18 +245,18 @@ do_init(Server, NoteStore) -> process_flag(priority, Prio), %% -- Create inform request table -- - ets:new(snmpm_inform_request_table, - [set, protected, named_table, {keypos, 1}]), + ets:new(snmpm_inform_request_table, ?inform_table_opts), %% -- Verbosity -- {ok, Verbosity} = snmpm_config:system_info(net_if_verbosity), - put(sname,mnif), - put(verbosity,Verbosity), + put(sname, mnif), + put(verbosity, Verbosity), ?vlog("starting", []), %% -- MPD -- {ok, Vsns} = snmpm_config:system_info(versions), MpdState = snmpm_mpd:init(Vsns), + ?vdebug("MpdState: ~w", [MpdState]), %% -- Module dependent options -- {ok, Opts} = snmpm_config:system_info(net_if_options), @@ -193,14 +265,6 @@ do_init(Server, NoteStore) -> {ok, IRB} = snmpm_config:system_info(net_if_irb), IrGcRef = irgc_start(IRB), - %% -- Socket -- - SndBuf = get_opt(Opts, sndbuf, default), - RecBuf = get_opt(Opts, recbuf, default), - BindTo = get_opt(Opts, bind_to, false), - NoReuse = get_opt(Opts, no_reuse, false), - {ok, Port} = snmpm_config:system_info(port), - {ok, Sock} = do_open_port(Port, SndBuf, RecBuf, BindTo, NoReuse), - %% Flow control -- FilterOpts = get_opt(Opts, filter, []), FilterMod = create_filter(FilterOpts), @@ -209,77 +273,104 @@ do_init(Server, NoteStore) -> %% -- Audit trail log --- {ok, ATL} = snmpm_config:system_info(audit_trail_log), Log = do_init_log(ATL), + ?vdebug("Log: ~w", [Log]), + + {ok, DomainAddresses} = snmpm_config:system_info(transports), + ?vdebug("DomainAddresses: ~w",[DomainAddresses]), + CommonSocketOpts = common_socket_opts(Opts), + BindTo = get_opt(Opts, bind_to, false), + case + [begin + {IpPort, SocketOpts} = + socket_params(Domain, Address, BindTo, CommonSocketOpts), + Socket = socket_open(IpPort, SocketOpts), + #transport{socket = Socket, domain = Domain} + end || {Domain, Address} <- DomainAddresses] + of + [] -> + ?vinfo("No transports configured: ~p", [DomainAddresses]), + throw({error, {no_transports,DomainAddresses}}); + Transports -> + %% -- Initiate counters --- + init_counters(), + + %% -- We are done --- + State = #state{ + server = Server, + note_store = NoteStore, + mpd_state = MpdState, + transports = Transports, + log = Log, + irb = IRB, + irgc = IrGcRef, + filter = FilterMod}, + ?vdebug("started", []), + {ok, State} + end. - %% -- Initiate counters --- - init_counters(), - - %% -- We are done --- - State = #state{server = Server, - note_store = NoteStore, - mpd_state = MpdState, - sock = Sock, - log = Log, - irb = IRB, - irgc = IrGcRef, - filter = FilterMod}, - ?vdebug("started", []), - {ok, State}. - - -%% Open port -do_open_port(Port, SendSz, RecvSz, BindTo, NoReuse) -> - ?vtrace("do_open_port -> entry with" - "~n Port: ~p" - "~n SendSz: ~p" - "~n RecvSz: ~p" - "~n BindTo: ~p" - "~n NoReuse: ~p", [Port, SendSz, RecvSz, BindTo, NoReuse]), - IpOpts1 = bind_to(BindTo), - IpOpts2 = no_reuse(NoReuse), - IpOpts3 = recbuf(RecvSz), - IpOpts4 = sndbuf(SendSz), - IpOpts = [binary | IpOpts1 ++ IpOpts2 ++ IpOpts3 ++ IpOpts4], - OpenRes = - case init:get_argument(snmpm_fd) of - {ok, [[FdStr]]} -> - Fd = list_to_integer(FdStr), - gen_udp:open(0, [{fd, Fd}|IpOpts]); - error -> - gen_udp:open(Port, IpOpts) - end, - case OpenRes of +socket_open(IpPort, SocketOpts) -> + ?vtrace("socket_open -> entry with~n" + " IpPort: ~p~n" + " SocketOpts: ~p", [IpPort, SocketOpts]), + case gen_udp:open(IpPort, SocketOpts) of {error, _} = Error -> throw(Error); - OK -> - OK + {ok, Socket} -> + Socket end. -bind_to(true) -> - case snmpm_config:system_info(address) of - {ok, Addr} when is_list(Addr) -> - [{ip, list_to_tuple(Addr)}]; - {ok, Addr} -> - [{ip, Addr}]; +socket_params(Domain, {IpAddr, IpPort}, BindTo, CommonSocketOpts) -> + Family = snmp_conf:tdomain_to_family(Domain), + SocketOpts = + case Family of + inet6 -> + [Family, {ipv6_v6only, true} | CommonSocketOpts]; + Family -> + [Family | CommonSocketOpts] + end, + case Family of + inet -> + case init:get_argument(snmp_fd) of + {ok, [[FdStr]]} -> + Fd = list_to_integer(FdStr), + case BindTo of + true -> + {IpPort, [{ip, IpAddr}, {fd, Fd} | SocketOpts]}; + _ -> + {0, [{fd, Fd} | SocketOpts]} + end; + error -> + {IpPort, [{ip, IpAddr} | SocketOpts]} + end; _ -> - [] - end; -bind_to(_) -> - []. - -no_reuse(false) -> - [{reuseaddr, true}]; -no_reuse(_) -> - []. - -recbuf(default) -> - []; -recbuf(Sz) -> - [{recbuf, Sz}]. + case BindTo of + true -> + {IpPort, [{ip, IpAddr} | SocketOpts]}; + _ -> + {IpPort, SocketOpts} + end + end. -sndbuf(default) -> - []; -sndbuf(Sz) -> - [{sndbuf, Sz}]. +common_socket_opts(Opts) -> + [binary + | case get_opt(Opts, sndbuf, default) of + default -> + []; + Sz -> + [{sndbuf, Sz}] + end ++ + case get_opt(Opts, recbuf, default) of + default -> + []; + Sz -> + [{sndbuf, Sz}] + end ++ + case get_opt(Opts, no_reuse, false) of + false -> + [{reuseaddr, true}]; + _ -> + [] + end]. create_filter(Opts) when is_list(Opts) -> @@ -294,6 +385,10 @@ create_filter(BadOpts) -> throw({error, {bad_filter_opts, BadOpts}}). +%% ---------------------------------------------------------------------- +%% Audit Trail Logger +%% ---------------------------------------------------------------------- + %% Open log do_init_log(false) -> ?vtrace("do_init_log(false) -> entry", []), @@ -314,24 +409,69 @@ do_init_log(true) -> Function = increment_counter, Args = [atl_seqno, Initial, Max], SeqNoGen = {Module, Function, Args}, - case snmp_log:create(Name, File, - SeqNoGen, Size, Repair, true) of + case snmp_log:create( + Name, File, SeqNoGen, Size, Repair, true) of {ok, Log} -> ?vdebug("log created: ~w", [Log]), - {Log, Type}; + {Name, Log, Type}; {error, Reason} -> throw({error, {failed_create_audit_log, Reason}}) end; _ -> case snmp_log:create(Name, File, Size, Repair, true) of {ok, Log} -> - {Log, Type}; + ?vdebug("log created: ~w", [Log]), + {Name, Log, Type}; {error, Reason} -> throw({error, {failed_create_audit_log, Reason}}) end end. - +-ifdef(snmpm_net_if_mt). +do_reopen_log(undefined) -> + undefined; +do_reopen_log({Name, Log, Type}) -> + case snmp_log:open(Name, Log) of + {ok, NewLog} -> + {Name, NewLog, Type}; + {error, Reason} -> + warning_msg( + "NetIf worker ~p failed to open ATL:~n" + " ~p", [self(), Reason]), + undefined + end. +-endif. + +%% Close log +do_close_log(undefined) -> + ok; +do_close_log({_Name, Log, _Type}) -> + (catch snmp_log:sync(Log)), + (catch snmp_log:close(Log)), + ok; +do_close_log(_) -> + ok. + +%% Log +logger(undefined, _Type, _Domain, _Addr) -> + fun(_) -> + ok + end; +logger({_Name, Log, Types}, Type, Domain, Addr) -> + case lists:member(Type, Types) of + true -> + AddrString = + iolist_to_binary(snmp_conf:mk_addr_string({Domain, Addr})), + fun(Msg) -> + snmp_log:log(Log, Msg, AddrString) + end; + false -> + fun(_) -> + ok + end + end. + + %%-------------------------------------------------------------------- %% Func: handle_call/3 %% Returns: {reply, Reply, State} | @@ -386,25 +526,24 @@ handle_call(Req, From, State) -> %% {noreply, State, Timeout} | %% {stop, Reason, State} (terminate/2 is called) %%-------------------------------------------------------------------- -handle_cast({send_pdu, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo}, +handle_cast({send_pdu, Pdu, Vsn, MsgData, Domain, Addr, ExtraInfo}, State) -> - ?vlog("received send_pdu message with" - "~n Pdu: ~p" - "~n Vsn: ~p" - "~n MsgData: ~p" - "~n Domain: ~p" - "~n Addr: ~p" - "~n Port: ~p", [Pdu, Vsn, MsgData, Domain, Addr, Port]), - maybe_process_extra_info(ExtraInfo), - maybe_handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, Port, State), + ?vlog("received send_pdu message with~n" + " Pdu: ~p~n" + " Vsn: ~p~n" + " MsgData: ~p~n" + " Domain: ~p~n" + " Addr: ~p", [Pdu, Vsn, MsgData, Domain, Addr]), + maybe_process_extra_info(ExtraInfo), + maybe_handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, State), {noreply, State}; -handle_cast({inform_response, Ref, Addr, Port}, State) -> - ?vlog("received inform_response message with" - "~n Ref: ~p" - "~n Addr: ~p" - "~n Port: ~p", [Ref, Addr, Port]), - handle_inform_response(Ref, Addr, Port, State), +handle_cast({inform_response, Ref, Domain, Addr}, State) -> + ?vlog("received inform_response message with~n" + " Ref: ~p~n" + " Domain: ~p~n" + " Addr: ~p", [Ref, Domain, Addr]), + handle_inform_response(Ref, Domain, Addr, State), {noreply, State}; handle_cast(filter_reset, State) -> @@ -423,10 +562,21 @@ handle_cast(Msg, State) -> %% {noreply, State, Timeout} | %% {stop, Reason, State} (terminate/2 is called) %%-------------------------------------------------------------------- -handle_info({udp, Sock, Ip, Port, Bytes}, #state{sock = Sock} = State) -> - ?vlog("received ~w bytes from ~p:~p [~w]", [size(Bytes), Ip, Port, Sock]), - maybe_handle_recv_msg(Ip, Port, Bytes, State), - {noreply, State}; +handle_info( + {udp, Socket, IpAddr, IpPort, Bytes}, + #state{transports = Transports} = State) -> + Size = byte_size(Bytes), + case lists:keyfind(Socket, #transport.socket, Transports) of + #transport{socket = Socket, domain = Domain} -> + ?vlog("received ~w bytes from ~p:~p [~w]", + [Size, IpAddr, IpPort, Socket]), + maybe_handle_recv_msg(Domain, {IpAddr, IpPort}, Bytes, State), + {noreply, State}; + false -> + warning_msg("Received ~w bytes on unknown port: ~p from ~s", + [Size, Socket, format_address({IpAddr, IpPort})]), + {noreply, State} + end; handle_info(inform_response_gc, State) -> ?vlog("received inform_response_gc message", []), @@ -439,11 +589,42 @@ handle_info({disk_log, _Node, Log, Info}, State) -> State2 = handle_disk_log(Log, Info, State), {noreply, State2}; +handle_info({'DOWN', _, _, _, _} = Info, State) -> + handle_info_down(Info, State); + handle_info(Info, State) -> + handle_info_unknown(Info, State). + + +handle_info_unknown(Info, State) -> warning_msg("received unknown info: ~n~p", [Info]), {noreply, State}. +-ifdef(snmpm_net_if_mt). +handle_info_down( + {'DOWN', _MRef, process, _Pid, + {net_if_worker, _Result}}, + State) -> + ?vdebug("received DOWN message from net_if worker [~w]: " + "~n Result: ~p", [_Pid, _Result]), + {noreply, State}; +handle_info_down( + {'DOWN', _MRef, process, Pid, + {net_if_worker, Failer, Class, Reason, Stacktrace} = _ExitStatus}, + State) -> + ?vdebug("received DOWN message from net_if worker [~w]: " + "~n ExitStatus: ~p", [Pid, _ExitStatus]), + Failer(Pid, Class, Reason, Stacktrace), + {noreply, State}; +handle_info_down(Info, State) -> + handle_info_unknown(Info, State). +-else. +handle_info_down(Info, State) -> + handle_info_unknown(Info, State). +-endif. + + %%-------------------------------------------------------------------- %% Func: terminate/2 %% Purpose: Shutdown the server @@ -457,68 +638,12 @@ terminate(Reason, #state{log = Log, irgc = IrGcRef}) -> ok. -do_close_log({Log, _Type}) -> - (catch snmp_log:sync(Log)), - (catch snmp_log:close(Log)), - ok; -do_close_log(_) -> - ok. - - %%---------------------------------------------------------------------- %% Func: code_change/3 %% Purpose: Convert process state when code is changed %% Returns: {ok, NewState} %%---------------------------------------------------------------------- -code_change({down, _Vsn}, OldState, downgrade_to_pre_4_14) -> - ?d("code_change(down, downgrade_to_pre_4_14) -> entry with" - "~n OldState: ~p", [OldState]), - #state{server = Server, - note_store = NoteStore, - sock = Sock, - mpd_state = MpdState, - log = {OldLog, Type}, - irb = IRB, - irgc = IRGC} = OldState, - NewLog = snmp_log:downgrade(OldLog), - State = - {state, Server, NoteStore, Sock, MpdState, {NewLog, Type}, IRB, IRGC}, - {ok, State}; - -code_change({down, _Vsn}, OldState, downgrade_to_pre_4_16) -> - ?d("code_change(down, downgrade_to_pre_4_16) -> entry with" - "~n OldState: ~p", [OldState]), - {OldLog, Type} = OldState#state.log, - NewLog = snmp_log:downgrade(OldLog), - State = OldState#state{log = {NewLog, Type}}, - {ok, State}; - -% upgrade -code_change(_Vsn, OldState, upgrade_from_pre_4_14) -> - ?d("code_change(up, upgrade_from_pre_4_14) -> entry with" - "~n OldState: ~p", [OldState]), - {state, Server, NoteStore, Sock, MpdState, {OldLog, Type}, IRB, IRGC} = - OldState, - NewLog = snmp_log:upgrade(OldLog), - State = #state{server = Server, - note_store = NoteStore, - sock = Sock, - mpd_state = MpdState, - log = {NewLog, Type}, - irb = IRB, - irgc = IRGC, - filter = ?DEFAULT_FILTER_MODULE}, - {ok, State}; - -code_change(_Vsn, OldState, upgrade_from_pre_4_16) -> - ?d("code_change(up, upgrade_from_pre_4_16) -> entry with" - "~n OldState: ~p", [OldState]), - {OldLog, Type} = OldState#state.log, - NewLog = snmp_log:upgrade(OldLog), - State = OldState#state{log = {NewLog, Type}}, - {ok, State}; - code_change(_Vsn, State, _Extra) -> ?d("code_change -> entry with" "~n Vsn: ~p" @@ -531,139 +656,155 @@ code_change(_Vsn, State, _Extra) -> %%% Internal functions %%%------------------------------------------------------------------- -maybe_handle_recv_msg(Addr, Port, Bytes, #state{filter = FilterMod} = State) -> - case (catch FilterMod:accept_recv(Addr, Port)) of +maybe_handle_recv_msg(Domain, Addr, Bytes, State) -> + ?worker( + S, maybe_handle_recv_msg_mt(Domain, Addr, Bytes, S), + fun (Pid, Class, Reason, Stacktrace) -> + warning_msg( + "Worker process (~p) terminated " + "while processing (incomming) message from %s:~n" + "~w:~w at ~p", + [Pid, snmp_conf:mk_addr_string({Domain, Addr}), + Class, Reason, Stacktrace]) + end, + State). + +maybe_handle_recv_msg_mt( + Domain, Addr, Bytes, + #state{filter = FilterMod, transports = Transports} = State) -> + {Arg1, Arg2} = fix_filter_address(Transports, {Domain, Addr}), + case (catch FilterMod:accept_recv(Arg1, Arg2)) of false -> %% Drop the received packet - inc(netIfMsgInDrops), - ok; + inc(netIfMsgInDrops); _ -> - handle_recv_msg(Addr, Port, Bytes, State) - end. + handle_recv_msg(Domain, Addr, Bytes, State) + end, + ok. -handle_recv_msg(Addr, Port, Bytes, #state{server = Pid}) +handle_recv_msg(Domain, Addr, Bytes, #state{server = Pid}) when is_binary(Bytes) andalso (size(Bytes) =:= 0) -> - Pid ! {snmp_error, {empty_message, Addr, Port}, Addr, Port}, - ok; - -handle_recv_msg(Addr, Port, Bytes, - #state{server = Pid, - note_store = NoteStore, - mpd_state = MpdState, - sock = Sock, - log = Log} = State) -> - Domain = snmp_conf:which_domain(Addr), % What the ****... - Logger = logger(Log, read, Addr, Port), - case (catch snmpm_mpd:process_msg(Bytes, Domain, Addr, Port, - MpdState, NoteStore, Logger)) of + Pid ! {snmp_error, {empty_message, Domain, Addr}, Domain, Addr}; +%% +handle_recv_msg( + Domain, Addr, Bytes, + #state{ + server = Pid, + note_store = NoteStore, + mpd_state = MpdState, + log = Log} = State) -> + Logger = logger(Log, read, Domain, Addr), + case (catch snmpm_mpd:process_msg( + Bytes, Domain, Addr, MpdState, NoteStore, Logger)) of {ok, Vsn, Pdu, MS, ACM} -> - maybe_handle_recv_pdu(Addr, Port, Vsn, Pdu, MS, ACM, - Logger, State); + maybe_handle_recv_pdu( + Domain, Addr, Vsn, Pdu, MS, ACM, Logger, State); {discarded, Reason, Report} -> ?vdebug("discarded: ~p", [Reason]), ErrorInfo = {failed_processing_message, Reason}, - Pid ! {snmp_error, ErrorInfo, Addr, Port}, - maybe_udp_send(State#state.filter, Sock, Addr, Port, Report), - ok; + Pid ! {snmp_error, ErrorInfo, Domain, Addr}, + maybe_udp_send(Domain, Addr, Report, State); {discarded, Reason} -> ?vdebug("discarded: ~p", [Reason]), ErrorInfo = {failed_processing_message, Reason}, - Pid ! {snmp_error, ErrorInfo, Addr, Port}, - ok; + Pid ! {snmp_error, ErrorInfo, Domain, Addr}; Error -> error_msg("processing of received message failed: " - "~n ~p", [Error]), - ok + "~n ~p", [Error]) end. -maybe_handle_recv_pdu(Addr, Port, - Vsn, #pdu{type = Type} = Pdu, PduMS, ACM, - Logger, - #state{filter = FilterMod} = State) -> - case (catch FilterMod:accept_recv_pdu(Addr, Port, Type)) of +maybe_handle_recv_pdu( + Domain, Addr, Vsn, #pdu{type = Type} = Pdu, PduMS, ACM, Logger, + #state{filter = FilterMod, transports = Transports} = State) -> + {Arg1, Arg2} = fix_filter_address(Transports, {Domain, Addr}), + case (catch FilterMod:accept_recv_pdu(Arg1, Arg2, Type)) of false -> - inc(netIfPduInDrops), - ok; + inc(netIfPduInDrops); _ -> - handle_recv_pdu(Addr, Port, Vsn, Pdu, PduMS, ACM, Logger, State) + handle_recv_pdu( + Domain, Addr, Vsn, Pdu, PduMS, ACM, Logger, State) end; -maybe_handle_recv_pdu(Addr, Port, Vsn, Trap, PduMS, ACM, Logger, - #state{filter = FilterMod} = State) +maybe_handle_recv_pdu( + Domain, Addr, Vsn, Trap, PduMS, ACM, Logger, + #state{filter = FilterMod, transports = Transports} = State) when is_record(Trap, trappdu) -> - case (catch FilterMod:accept_recv_pdu(Addr, Port, trappdu)) of + {Arg1, Arg2} = fix_filter_address(Transports, {Domain, Addr}), + case (catch FilterMod:accept_recv_pdu(Arg1, Arg2, trappdu)) of false -> - inc(netIfPduInDrops), - ok; + inc(netIfPduInDrops); _ -> - handle_recv_pdu(Addr, Port, Vsn, Trap, PduMS, ACM, Logger, State) + handle_recv_pdu( + Domain, Addr, Vsn, Trap, PduMS, ACM, Logger, State) end; -maybe_handle_recv_pdu(Addr, Port, Vsn, Pdu, PduMS, ACM, Logger, State) -> - handle_recv_pdu(Addr, Port, Vsn, Pdu, PduMS, ACM, Logger, State). - - -handle_recv_pdu(Addr, Port, - Vsn, #pdu{type = 'inform-request'} = Pdu, _PduMS, ACM, - Logger, #state{server = Pid, irb = IRB} = State) -> - handle_inform_request(IRB, Pid, Vsn, Pdu, ACM, - Addr, Port, Logger, State); -handle_recv_pdu(Addr, Port, - _Vsn, #pdu{type = report} = Pdu, _PduMS, ok, - _Logger, - #state{server = Pid} = _State) -> +maybe_handle_recv_pdu( + Domain, Addr, Vsn, Pdu, PduMS, ACM, Logger, State) -> + handle_recv_pdu(Domain, Addr, Vsn, Pdu, PduMS, ACM, Logger, State). + + +handle_recv_pdu( + Domain, Addr, Vsn, + #pdu{type = 'inform-request'} = Pdu, _PduMS, ACM, Logger, + #state{server = Pid, irb = IRB} = State) -> + handle_inform_request( + IRB, Pid, Vsn, Pdu, ACM, Domain, Addr, Logger, State); +handle_recv_pdu( + Domain, Addr, _Vsn, + #pdu{type = report} = Pdu, _PduMS, ok, _Logger, + #state{server = Pid} = _State) -> ?vtrace("received report - ok", []), - Pid ! {snmp_report, {ok, Pdu}, Addr, Port}; -handle_recv_pdu(Addr, Port, - _Vsn, #pdu{type = report} = Pdu, _PduMS, - {error, ReqId, Reason}, - _Logger, - #state{server = Pid} = _State) -> + Pid ! {snmp_report, {ok, Pdu}, Domain, Addr}; +handle_recv_pdu( + Domain, Addr, _Vsn, + #pdu{type = report} = Pdu, _PduMS, {error, ReqId, Reason}, _Logger, + #state{server = Pid} = _State) -> ?vtrace("received report - error", []), - Pid ! {snmp_report, {error, ReqId, Reason, Pdu}, Addr, Port}; -handle_recv_pdu(Addr, Port, - _Vsn, #pdu{type = 'snmpv2-trap'} = Pdu, _PduMS, _ACM, - _Logger, - #state{server = Pid} = _State) -> + Pid ! {snmp_report, {error, ReqId, Reason, Pdu}, Domain, Addr}; +handle_recv_pdu( + Domain, Addr, _Vsn, + #pdu{type = 'snmpv2-trap'} = Pdu, _PduMS, _ACM, _Logger, + #state{server = Pid} = _State) -> ?vtrace("received snmpv2-trap", []), - Pid ! {snmp_trap, Pdu, Addr, Port}; -handle_recv_pdu(Addr, Port, - _Vsn, Trap, _PduMS, _ACM, - _Logger, - #state{server = Pid} = _State) when is_record(Trap, trappdu) -> + Pid ! {snmp_trap, Pdu, Domain, Addr}; +handle_recv_pdu( + Domain, Addr, _Vsn, Trap, _PduMS, _ACM, _Logger, + #state{server = Pid} = _State) when is_record(Trap, trappdu) -> ?vtrace("received trappdu", []), - Pid ! {snmp_trap, Trap, Addr, Port}; -handle_recv_pdu(Addr, Port, - _Vsn, Pdu, _PduMS, _ACM, - _Logger, - #state{server = Pid} = _State) when is_record(Pdu, pdu) -> + Pid ! {snmp_trap, Trap, Domain, Addr}; +handle_recv_pdu( + Domain, Addr, _Vsn, Pdu, _PduMS, _ACM, _Logger, + #state{server = Pid} = _State) when is_record(Pdu, pdu) -> ?vtrace("received pdu", []), - Pid ! {snmp_pdu, Pdu, Addr, Port}; -handle_recv_pdu(_Addr, _Port, _Vsn, Pdu, _PduMS, ACM, _Logger, _State) -> + Pid ! {snmp_pdu, Pdu, Domain, Addr}; +handle_recv_pdu( + _Domain, _Addr, _Vsn, Pdu, _PduMS, ACM, _Logger, _State) -> ?vlog("received unexpected pdu: " - "~n Pdu: ~p" - "~n ACM: ~p", [Pdu, ACM]). + "~n Pdu: ~p" + "~n ACM: ~p", [Pdu, ACM]). -handle_inform_request(auto, Pid, Vsn, Pdu, ACM, Addr, Port, Logger, State) -> +handle_inform_request( + auto, Pid, Vsn, Pdu, ACM, Domain, Addr, Logger, State) -> ?vtrace("received inform-request (true)", []), - Pid ! {snmp_inform, ignore, Pdu, Addr, Port}, + Pid ! {snmp_inform, ignore, Pdu, Domain, Addr}, RePdu = make_response_pdu(Pdu), - maybe_send_inform_response(RePdu, Vsn, ACM, Addr, Port, Logger, State); -handle_inform_request({user, To}, Pid, Vsn, #pdu{request_id = ReqId} = Pdu, - ACM, Addr, Port, _Logger, _State) -> + maybe_send_inform_response(RePdu, Vsn, ACM, Domain, Addr, Logger, State); +handle_inform_request( + {user, To}, Pid, Vsn, #pdu{request_id = ReqId} = Pdu, + ACM, Domain, Addr, _Logger, _State) -> ?vtrace("received inform-request (false)", []), - Pid ! {snmp_inform, ReqId, Pdu, Addr, Port}, + Pid ! {snmp_inform, ReqId, Pdu, Domain, Addr}, %% Before we go any further, we need to check that we have not %% already received this message (possible resend). - Key = {ReqId, Addr, Port}, + Key = {ReqId, Domain, Addr}, case ets:lookup(snmpm_inform_request_table, Key) of [_] -> %% OK, we already know about this. We assume this @@ -676,40 +817,57 @@ handle_inform_request({user, To}, Pid, Vsn, #pdu{request_id = ReqId} = Pdu, Rec = {Key, Expire, {Vsn, ACM, RePdu}}, ets:insert(snmpm_inform_request_table, Rec) end. - -handle_inform_response(Ref, Addr, Port, State) -> - Key = {Ref, Addr, Port}, + +handle_inform_response(Ref, Domain, Addr, State) -> + ?worker( + S, handle_inform_response_mt(Ref, Domain, Addr, S), + fun (Pid, Class, Reason, Stacktrace) -> + warning_msg( + "Worker process (~p) terminated " + "while processing (outgoing) inform response for %s:~n" + "~w:~w at ~p", + [Pid, snmp_conf:mk_addr_string({Domain, Addr}), + Class, Reason, Stacktrace]) + end, + State). + +handle_inform_response_mt(Ref, Domain, Addr, State) -> + Key = {Ref, Domain, Addr}, case ets:lookup(snmpm_inform_request_table, Key) of [{Key, _, {Vsn, ACM, RePdu}}] -> - Logger = logger(State#state.log, read, Addr, Port), + Logger = logger(State#state.log, read, Domain, Addr), ets:delete(snmpm_inform_request_table, Key), - maybe_send_inform_response(RePdu, Vsn, ACM, Addr, Port, - Logger, State); + maybe_send_inform_response( + RePdu, Vsn, ACM, Domain, Addr, Logger, State); [] -> %% Already acknowledged, or the user was to slow to reply... ok end, ok. -maybe_send_inform_response(RePdu, Vsn, ACM, Addr, Port, Logger, - #state{server = Pid, - sock = Sock, - filter = FilterMod}) -> - case (catch FilterMod:accept_send_pdu(Addr, Port, pdu_type_of(RePdu))) of +maybe_send_inform_response( + RePdu, Vsn, ACM, Domain, Addr, Logger, + #state{ + server = Pid, + filter = FilterMod, + transports = Transports} = State) -> + {Arg1, Arg2} = fix_filter_address(Transports, {Domain, Addr}), + case (catch FilterMod:accept_send_pdu( + Arg1, Arg2, pdu_type_of(RePdu))) + of false -> inc(netIfPduOutDrops), ok; _ -> case snmpm_mpd:generate_response_msg(Vsn, RePdu, ACM, Logger) of {ok, Msg} -> - maybe_udp_send(FilterMod, Sock, Addr, Port, Msg); + maybe_udp_send(Domain, Addr, Msg, State); {discarded, Reason} -> ?vlog("failed generating response message:" "~n Reason: ~p", [Reason]), ReqId = RePdu#pdu.request_id, ErrorInfo = {failed_generating_response, {RePdu, Reason}}, - Pid ! {snmp_error, ReqId, ErrorInfo, Addr, Port}, - ok + Pid ! {snmp_error, ReqId, ErrorInfo, Domain, Addr} end end. @@ -742,64 +900,99 @@ irgc_stop(undefined) -> irgc_stop(Ref) -> (catch erlang:cancel_timer(Ref)). - -maybe_handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, Port, - #state{filter = FilterMod} = State) -> - case (catch FilterMod:accept_send_pdu(Addr, Port, pdu_type_of(Pdu))) of +maybe_handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, State) -> + ?worker( + S, maybe_handle_send_pdu_mt(Pdu, Vsn, MsgData, Domain, Addr, S), + fun (Pid, Class, Reason, Stacktrace) -> + warning_msg( + "Worker process (~p) terminated " + "while processing (outgoing) pdu for %s:~n" + "~w:~w at ~p", + [Pid, snmp_conf:mk_addr_string({Domain, Addr}), + Class, Reason, Stacktrace]) + end, + State). + +maybe_handle_send_pdu_mt( + Pdu, Vsn, MsgData, Domain, Addr, + #state{filter = FilterMod, transports = Transports} = State) -> + {Arg1, Arg2} = fix_filter_address(Transports, {Domain, Addr}), + case (catch FilterMod:accept_send_pdu(Arg1, Arg2, pdu_type_of(Pdu))) of false -> - inc(netIfPduOutDrops), - ok; + inc(netIfPduOutDrops); _ -> - handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, Port, State) - end. + handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, State) + end, + ok. -handle_send_pdu(Pdu, Vsn, MsgData, _Domain, Addr, Port, - #state{server = Pid, - note_store = NoteStore, - sock = Sock, - log = Log, - filter = FilterMod}) -> - Logger = logger(Log, write, Addr, Port), - case (catch snmpm_mpd:generate_msg(Vsn, NoteStore, - Pdu, MsgData, Logger)) of +handle_send_pdu( + Pdu, Vsn, MsgData, Domain, Addr, + #state{ + server = Pid, + note_store = NoteStore, + log = Log} = State) -> + Logger = logger(Log, write, Domain, Addr), + case (catch snmpm_mpd:generate_msg( + Vsn, NoteStore, Pdu, MsgData, Logger)) of {ok, Msg} -> ?vtrace("handle_send_pdu -> message generated", []), - maybe_udp_send(FilterMod, Sock, Addr, Port, Msg); + maybe_udp_send(Domain, Addr, Msg, State); {discarded, Reason} -> ?vlog("PDU not sent: " "~n PDU: ~p" "~n Reason: ~p", [Pdu, Reason]), - Pid ! {snmp_error, Pdu, Reason}, - ok + Pid ! {snmp_error, Pdu, Reason} end. -maybe_udp_send(FilterMod, Sock, Addr, Port, Msg) -> - case (catch FilterMod:accept_send(Addr, Port)) of +maybe_udp_send( + Domain, Addr, Msg, + #state{filter = FilterMod, transports = Transports}) -> + To = {Domain, Addr}, + {Arg1, Arg2} = fix_filter_address(Transports, To), + case (catch FilterMod:accept_send(Arg1, Arg2)) of false -> inc(netIfMsgOutDrops), ok; _ -> - udp_send(Sock, Addr, Port, Msg) + case select_transport_from_domain(Domain, Transports) of + false -> + error_msg( + "Can not find transport~n" + " size: ~p~n" + " to: ~s", + [sz(Msg), format_address(To)]); + #transport{socket = Socket} -> + udp_send(Socket, Addr, Msg) + end end. - - -udp_send(Sock, Addr, Port, Msg) -> - case (catch gen_udp:send(Sock, Addr, Port, Msg)) of + +udp_send(Sock, To, Msg) -> + {IpAddr, IpPort} = + case To of + {Domain, Addr} when is_atom(Domain) -> + Addr; + {_, P} = Addr when is_integer(P) -> + Addr + end, + try gen_udp:send(Sock, IpAddr, IpPort, Msg) of ok -> ?vdebug("sent ~w bytes to ~w:~w [~w]", - [sz(Msg), Addr, Port, Sock]), + [sz(Msg), IpAddr, IpPort, Sock]), ok; {error, Reason} -> - error_msg("failed sending message to ~p:~p: " - "~n ~p",[Addr, Port, Reason]); - Error -> - error_msg("failed sending message to ~p:~p: " - "~n ~p",[Addr, Port, Error]) + error_msg("failed sending message to ~p:~p:~n" + " ~p",[IpAddr, IpPort, Reason]) + catch + error:Error -> + error_msg("failed sending message to ~p:~p:~n" + " error:~p~n" + " ~p", + [IpAddr, IpPort, Error, erlang:get_stacktrace()]) end. sz(B) when is_binary(B) -> - size(B); + byte_size(B); sz(L) when is_list(L) -> length(L); sz(_) -> @@ -989,6 +1182,45 @@ handle_set_log_type(State, _NewType) -> {State, {error, not_enabled}}. +select_transport_from_domain(Domain, Transports) when is_atom(Domain) -> + Pos = #transport.domain, + case lists:keyfind(Domain, Pos, Transports) of + #transport{domain = Domain} = Transport -> + Transport; + false when Domain == snmpUDPDomain -> + lists:keyfind(transportDomainUdpIpv4, Pos, Transports); + false when Domain == transportDomainUdpIpv4 -> + lists:keyfind(snmpUDPDomain, Pos, Transports); + false -> + false + end. + +%% If the manager uses legacy snmpUDPDomain e.g has not set +%% {domain, _}, then make sure snmpm_network_interface_filter +%% gets legacy arguments to not break backwards compatibility. +%% +fix_filter_address(Transports, Address) -> + DefaultDomain = snmpm_config:default_transport_domain(), + case Transports of + [#transport{domain = DefaultDomain}, DefaultDomain] -> + case Address of + {Domain, Addr} when is_atom(Domain) -> + Addr; + {_, IpPort} = Addr when is_integer(IpPort) -> + Addr + end; + _ -> + Address + end. + +address(Domain, Addr) when is_atom(Domain) -> + {Domain, Addr}; +address(Ip, Port) when is_integer(Port) -> + {snmpm_config:default_transport_domain(), {Ip, Port}}. + +format_address(Address) -> + iolist_to_binary(snmp_conf:mk_addr_string(Address)). + %% ------------------------------------------------------------------- make_response_pdu(#pdu{request_id = ReqId, varbinds = Vbs}) -> @@ -1029,25 +1261,6 @@ t() -> %% ------------------------------------------------------------------- -logger(undefined, _Type, _Addr, _Port) -> - fun(_) -> - ok - end; -logger({Log, Types}, Type, Addr, Port) -> - case lists:member(Type, Types) of - true -> - fun(Msg) -> - snmp_log:log(Log, Msg, Addr, Port) - end; - false -> - fun(_) -> - ok - end - end. - - -%% ------------------------------------------------------------------- - %% info_msg(F, A) -> %% ?snmpm_info("NET-IF server: " ++ F, A). @@ -1072,10 +1285,11 @@ get_opt(Opts, Key, Def) -> %% ------------------------------------------------------------------- -get_info(#state{sock = Id}) -> +get_info(#state{transports = Transports}) -> ProcSize = proc_mem(self()), - PortInfo = get_port_info(Id), - [{process_memory, ProcSize}, {port_info, PortInfo}]. + [{process_memory, ProcSize} + | [{port_info, get_port_info(Socket)} + || #transport{socket = Socket} <- Transports]]. proc_mem(P) when is_pid(P) -> case (catch erlang:process_info(P, memory)) of @@ -1190,4 +1404,3 @@ call(Pid, Req, Timeout) -> cast(Pid, Msg) -> gen_server:cast(Pid, Msg). - diff --git a/lib/snmp/src/manager/snmpm_net_if_filter.erl b/lib/snmp/src/manager/snmpm_net_if_filter.erl index eb0c6efb11..d96ae5c145 100644 --- a/lib/snmp/src/manager/snmpm_net_if_filter.erl +++ b/lib/snmp/src/manager/snmpm_net_if_filter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009. All Rights Reserved. +%% Copyright Ericsson AB 2009-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,29 +25,51 @@ -include("snmp_debug.hrl"). -accept_recv(_Addr, _Port) -> - ?d("accept_recv -> entry with" - "~n Addr: ~p" - "~n Port: ~p", [_Addr, _Port]), +accept_recv(Domain, _Address) when is_atom(Domain) -> + ?d("accept_recv -> entry with~n" + " Domain: ~p~n" + " Address: ~p", [Domain, _Address]), + true; +accept_recv(_Addr, Port) when is_integer(Port) -> + ?d("accept_recv -> entry with~n" + " Addr: ~p~n" + " Port: ~p", [_Addr, Port]), true. -accept_send(_Addr, _Port) -> - ?d("accept_send -> entry with" - "~n Addr: ~p" - "~n Port: ~p", [_Addr, _Port]), +accept_send(Domain, _Address) when is_atom(Domain) -> + ?d("accept_send -> entry with~n" + " Domain: ~p~n" + " Address: ~p", [Domain, _Address]), + true; +accept_send(_Addr, Port) when is_integer(Port) -> + ?d("accept_send -> entry with~n" + " Addr: ~p~n" + " Port: ~p", [_Addr, Port]), true. -accept_recv_pdu(_Addr, _Port, _PduType) -> - ?d("accept_recv_pdu -> entry with" - "~n Addr: ~p" - "~n Port: ~p" - "~n PduType: ~p", [_Addr, _Port, _PduType]), +accept_recv_pdu(Domain, _Address, _PduType) when is_atom(Domain) -> + ?d("accept_recv_pdu -> entry with~n" + " Domain: ~p~n" + " Address: ~p~n" + " PduType: ~p", [Domain, _Address, _PduType]), + true; +accept_recv_pdu(_Addr, Port, _PduType) when is_integer(Port) -> + ?d("accept_recv_pdu -> entry with~n" + " Addr: ~p~n" + " Port: ~p~n" + " PduType: ~p", [_Addr, Port, _PduType]), true. -accept_send_pdu(_Addr, _Port, _PduType) -> - ?d("accept_send_pdu -> entry with" - "~n Addr: ~p" - "~n Port: ~p" - "~n PduType: ~p", [_Addr, _Port, _PduType]), +accept_send_pdu(Domain, _Address, _PduType) when is_atom(Domain) -> + ?d("accept_send_pdu -> entry with~n" + " Domain: ~p~n" + " Address: ~p~n" + " PduType: ~p", [Domain, _Address, _PduType]), + true; +accept_send_pdu(_Addr, Port, _PduType) when is_integer(Port) -> + ?d("accept_send_pdu -> entry with~n" + " Addr: ~p~n" + " Port: ~p~n" + " PduType: ~p", [_Addr, Port, _PduType]), true. diff --git a/lib/snmp/src/manager/snmpm_net_if_mt.erl b/lib/snmp/src/manager/snmpm_net_if_mt.erl index 3e87f6a7fb..62f6023657 100644 --- a/lib/snmp/src/manager/snmpm_net_if_mt.erl +++ b/lib/snmp/src/manager/snmpm_net_if_mt.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The 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,1243 +17,7 @@ %% %CopyrightEnd% %% --module(snmpm_net_if_mt). - --behaviour(gen_server). --behaviour(snmpm_network_interface). - - -%% Network Interface callback functions --export([ - start_link/2, - stop/1, - send_pdu/6, % Backward compatibillity - send_pdu/7, % Backward compatibillity - send_pdu/8, - - inform_response/4, - - note_store/2, - - info/1, - verbosity/2, - %% system_info_updated/2, - get_log_type/1, set_log_type/2, - filter_reset/1 - ]). - -%% gen_server callbacks --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - code_change/3, terminate/2]). - --define(SNMP_USE_V3, true). --include("snmp_types.hrl"). --include("snmpm_internal.hrl"). --include("snmpm_atl.hrl"). --include("snmp_debug.hrl"). - -%% -define(VMODULE,"NET_IF"). --include("snmp_verbosity.hrl"). - --record(state, - { - server, - note_store, - sock, - mpd_state, - log, - irb = auto, % auto | {user, integer()} - irgc, - filter - }). - - --define(DEFAULT_FILTER_MODULE, snmpm_net_if_filter). --define(DEFAULT_FILTER_OPTS, [{module, ?DEFAULT_FILTER_MODULE}]). - --ifdef(snmp_debug). --define(GS_START_LINK(Args), - gen_server:start_link(?MODULE, Args, [{debug,[trace]}])). --else. --define(GS_START_LINK(Args), - gen_server:start_link(?MODULE, Args, [])). --endif. - - --define(IRGC_TIMEOUT, timer:minutes(5)). - --define(ATL_SEQNO_INITIAL, 1). --define(ATL_SEQNO_MAX, 2147483647). - - -%%%------------------------------------------------------------------- -%%% API -%%%------------------------------------------------------------------- -start_link(Server, NoteStore) -> - ?d("start_link -> entry with" - "~n Server: ~p" - "~n NoteStore: ~p", [Server, NoteStore]), - Args = [Server, NoteStore], - ?GS_START_LINK(Args). - -stop(Pid) -> - call(Pid, stop). - -send_pdu(Pid, Pdu, Vsn, MsgData, Addr, Port) -> - send_pdu(Pid, Pdu, Vsn, MsgData, Addr, Port, ?DEFAULT_EXTRA_INFO). - -send_pdu(Pid, Pdu, Vsn, MsgData, Addr, Port, ExtraInfo) -> - Domain = snmpm_config:default_transport_domain(), - send_pdu(Pid, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo). - -send_pdu(Pid, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo) - when is_record(Pdu, pdu) -> - ?d("send_pdu -> entry with" - "~n Pid: ~p" - "~n Pdu: ~p" - "~n Vsn: ~p" - "~n MsgData: ~p" - "~n Domain: ~p" - "~n Addr: ~p" - "~n Port: ~p", [Pid, Pdu, Vsn, MsgData, Domain, Addr, Port]), - cast(Pid, {send_pdu, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo}). - -note_store(Pid, NoteStore) -> - call(Pid, {note_store, NoteStore}). - -inform_response(Pid, Ref, Addr, Port) -> - cast(Pid, {inform_response, Ref, Addr, Port}). - -info(Pid) -> - call(Pid, info). - -verbosity(Pid, V) -> - call(Pid, {verbosity, V}). - -%% system_info_updated(Pid, What) -> -%% call(Pid, {system_info_updated, What}). - -get_log_type(Pid) -> - call(Pid, get_log_type). - -set_log_type(Pid, NewType) -> - call(Pid, {set_log_type, NewType}). - -filter_reset(Pid) -> - cast(Pid, filter_reset). - - -%%%------------------------------------------------------------------- -%%% Callback functions from gen_server -%%%------------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% Func: init/1 -%% Returns: {ok, State} | -%% {ok, State, Timeout} | -%% ignore | -%% {stop, Reason} -%%-------------------------------------------------------------------- -init([Server, NoteStore]) -> - ?d("init -> entry with" - "~n Server: ~p" - "~n NoteStore: ~p", [Server, NoteStore]), - case (catch do_init(Server, NoteStore)) of - {error, Reason} -> - {stop, Reason}; - {ok, State} -> - {ok, State} - end. - -do_init(Server, NoteStore) -> - process_flag(trap_exit, true), - - %% -- Prio -- - {ok, Prio} = snmpm_config:system_info(prio), - process_flag(priority, Prio), - - %% -- Create inform request table -- - %% This should really be protected, but it also needs to - %% be writable for the worker processes, so... - ets:new(snmpm_inform_request_table, - [set, public, named_table, {keypos, 1}]), - - %% -- Verbosity -- - {ok, Verbosity} = snmpm_config:system_info(net_if_verbosity), - put(sname, mnif), - put(verbosity, Verbosity), - ?vlog("starting", []), - - %% -- MPD -- - {ok, Vsns} = snmpm_config:system_info(versions), - MpdState = snmpm_mpd:init(Vsns), - ?vdebug("MpdState: ~w", [MpdState]), - - %% -- Module dependent options -- - {ok, Opts} = snmpm_config:system_info(net_if_options), - - %% -- Inform response behaviour -- - {ok, IRB} = snmpm_config:system_info(net_if_irb), - IrGcRef = irgc_start(IRB), - - %% -- Socket -- - SndBuf = get_opt(Opts, sndbuf, default), - RecBuf = get_opt(Opts, recbuf, default), - BindTo = get_opt(Opts, bind_to, false), - NoReuse = get_opt(Opts, no_reuse, false), - {ok, Port} = snmpm_config:system_info(port), - {ok, Sock} = do_open_port(Port, SndBuf, RecBuf, BindTo, NoReuse), - - %% Flow control -- - FilterOpts = get_opt(Opts, filter, []), - FilterMod = create_filter(FilterOpts), - ?vdebug("FilterMod: ~w", [FilterMod]), - - %% -- Audit trail log --- - {ok, ATL} = snmpm_config:system_info(audit_trail_log), - Log = do_init_log(ATL), - ?vdebug("Log: ~w", [Log]), - - %% -- Initiate counters --- - init_counters(), - - %% -- We are done --- - State = #state{server = Server, - note_store = NoteStore, - mpd_state = MpdState, - sock = Sock, - log = Log, - irb = IRB, - irgc = IrGcRef, - filter = FilterMod}, - ?vdebug("started", []), - {ok, State}. - - -%% Open port -do_open_port(Port, SendSz, RecvSz, BindTo, NoReuse) -> - ?vtrace("do_open_port -> entry with" - "~n Port: ~p" - "~n SendSz: ~p" - "~n RecvSz: ~p" - "~n BindTo: ~p" - "~n NoReuse: ~p", [Port, SendSz, RecvSz, BindTo, NoReuse]), - IpOpts1 = bind_to(BindTo), - IpOpts2 = no_reuse(NoReuse), - IpOpts3 = recbuf(RecvSz), - IpOpts4 = sndbuf(SendSz), - IpOpts = [binary | IpOpts1 ++ IpOpts2 ++ IpOpts3 ++ IpOpts4], - OpenRes = - case init:get_argument(snmpm_fd) of - {ok, [[FdStr]]} -> - Fd = list_to_integer(FdStr), - gen_udp:open(0, [{fd, Fd}|IpOpts]); - error -> - gen_udp:open(Port, IpOpts) - end, - case OpenRes of - {error, _} = Error -> - throw(Error); - OK -> - OK - end. - -bind_to(true) -> - case snmpm_config:system_info(address) of - {ok, Addr} when is_list(Addr) -> - [{ip, list_to_tuple(Addr)}]; - {ok, Addr} -> - [{ip, Addr}]; - _ -> - [] - end; -bind_to(_) -> - []. - -no_reuse(false) -> - [{reuseaddr, true}]; -no_reuse(_) -> - []. - -recbuf(default) -> - []; -recbuf(Sz) -> - [{recbuf, Sz}]. - -sndbuf(default) -> - []; -sndbuf(Sz) -> - [{sndbuf, Sz}]. - - -create_filter(Opts) when is_list(Opts) -> - case get_opt(Opts, module, ?DEFAULT_FILTER_MODULE) of - ?DEFAULT_FILTER_MODULE = Mod -> - Mod; - Module -> - snmpm_network_interface_filter:verify(Module), - Module - end; -create_filter(BadOpts) -> - throw({error, {bad_filter_opts, BadOpts}}). - - -%% ---------------------------------------------------------------------- -%% Audit Trail Logger -%% ---------------------------------------------------------------------- - -%% Open log -do_init_log(false) -> - ?vtrace("do_init_log(false) -> entry", []), - undefined; -do_init_log(true) -> - ?vtrace("do_init_log(true) -> entry", []), - {ok, Type} = snmpm_config:system_info(audit_trail_log_type), - {ok, Dir} = snmpm_config:system_info(audit_trail_log_dir), - {ok, Size} = snmpm_config:system_info(audit_trail_log_size), - {ok, Repair} = snmpm_config:system_info(audit_trail_log_repair), - Name = ?audit_trail_log_name, - File = filename:absname(?audit_trail_log_file, Dir), - case snmpm_config:system_info(audit_trail_log_seqno) of - {ok, true} -> - Initial = ?ATL_SEQNO_INITIAL, - Max = ?ATL_SEQNO_MAX, - Module = snmpm_config, - Function = increment_counter, - Args = [atl_seqno, Initial, Max], - SeqNoGen = {Module, Function, Args}, - case snmp_log:create(Name, File, SeqNoGen, Size, Repair, true) of - {ok, Log} -> - ?vdebug("log created: ~w", [Log]), - {Name, Log, Type}; - {error, Reason} -> - throw({error, {failed_create_audit_log, Reason}}) - end; - _ -> - case snmp_log:create(Name, File, Size, Repair, true) of - {ok, Log} -> - ?vdebug("log created: ~w", [Log]), - {Name, Log, Type}; - {error, Reason} -> - throw({error, {failed_create_audit_log, Reason}}) - end - end. - - -%% ---------------------------------------------------------------------- - -%%-------------------------------------------------------------------- -%% Func: handle_call/3 -%% Returns: {reply, Reply, State} | -%% {reply, Reply, State, Timeout} | -%% {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, Reply, State} | (terminate/2 is called) -%% {stop, Reason, State} (terminate/2 is called) -%%-------------------------------------------------------------------- -handle_call({verbosity, Verbosity}, _From, State) -> - ?vlog("received verbosity request", []), - put(verbosity, Verbosity), - {reply, ok, State}; - -%% handle_call({system_info_updated, What}, _From, State) -> -%% ?vlog("received system_info_updated request with What = ~p", [What]), -%% {NewState, Reply} = handle_system_info_updated(State, What), -%% {reply, Reply, NewState}; - -handle_call(get_log_type, _From, State) -> - ?vlog("received get-log-type request", []), - Reply = (catch handle_get_log_type(State)), - {reply, Reply, State}; - -handle_call({set_log_type, NewType}, _From, State) -> - ?vlog("received set-log-type request with NewType = ~p", [NewType]), - {NewState, Reply} = (catch handle_set_log_type(State, NewType)), - {reply, Reply, NewState}; - -handle_call({note_store, Pid}, _From, State) -> - ?vlog("received new note_store: ~w", [Pid]), - {reply, ok, State#state{note_store = Pid}}; - -handle_call(stop, _From, State) -> - ?vlog("received stop request", []), - Reply = ok, - {stop, normal, Reply, State}; - -handle_call(info, _From, State) -> - ?vlog("received info request", []), - Reply = get_info(State), - {reply, Reply, State}; - -handle_call(Req, From, State) -> - warning_msg("received unknown request (from ~p): ~n~p", [Req, From]), - {reply, {error, {invalid_request, Req}}, State}. - - -%%-------------------------------------------------------------------- -%% Func: handle_cast/2 -%% Returns: {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%%-------------------------------------------------------------------- -handle_cast({send_pdu, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo}, - State) -> - ?vlog("received send_pdu message with" - "~n Pdu: ~p" - "~n Vsn: ~p" - "~n MsgData: ~p" - "~n Domain: ~p" - "~n Addr: ~p" - "~n Port: ~p", [Pdu, Vsn, MsgData, Domain, Addr, Port]), - maybe_process_extra_info(ExtraInfo), - handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, Port, State), - {noreply, State}; - -handle_cast({inform_response, Ref, Addr, Port}, State) -> - ?vlog("received inform_response message with" - "~n Ref: ~p" - "~n Addr: ~p" - "~n Port: ~p", [Ref, Addr, Port]), - handle_inform_response(Ref, Addr, Port, State), - {noreply, State}; - -handle_cast(filter_reset, State) -> - ?vlog("received filter_reset message", []), - reset_counters(), - {noreply, State}; - -handle_cast(Msg, State) -> - warning_msg("received unknown message: ~n~p", [Msg]), - {noreply, State}. - - -%%-------------------------------------------------------------------- -%% Func: handle_info/2 -%% Returns: {noreply, State} | -%% {noreply, State, Timeout} | -%% {stop, Reason, State} (terminate/2 is called) -%%-------------------------------------------------------------------- -handle_info({udp, Sock, Ip, Port, Bytes}, #state{sock = Sock} = State) -> - ?vlog("received ~w bytes from ~p:~p", [size(Bytes), Ip, Port]), - handle_udp(Ip, Port, Bytes, State), - {noreply, State}; - -handle_info(inform_response_gc, State) -> - ?vlog("received inform_response_gc message", []), - State2 = handle_inform_response_gc(State), - {noreply, State2}; - -handle_info({disk_log, _Node, Log, Info}, State) -> - ?vlog("received disk_log message: " - "~n Info: ~p", [Info]), - State2 = handle_disk_log(Log, Info, State), - {noreply, State2}; - -handle_info({'DOWN', _MRef, process, Pid, {net_if_worker, ExitStatus}}, - State) -> - ?vdebug("received DOWN message from net_if-worker: " - "~n ExitStatus: ~p", [ExitStatus]), - handle_worker_exit(Pid, ExitStatus), - {noreply, State}; - -handle_info(Info, State) -> - warning_msg("received unknown info: ~n~p", [Info]), - {noreply, State}. - - -%%-------------------------------------------------------------------- -%% Func: terminate/2 -%% Purpose: Shutdown the server -%% Returns: any (ignored by gen_server) -%%-------------------------------------------------------------------- -terminate(Reason, #state{log = Log, irgc = IrGcRef}) -> - ?vdebug("terminate: ~p", [Reason]), - irgc_stop(IrGcRef), - %% Close logs - do_close_log(Log), - ok. - - -do_close_log({Log, _Type}) -> - (catch snmp_log:sync(Log)), - (catch snmp_log:close(Log)), - ok; -do_close_log(_) -> - ok. - - -%%---------------------------------------------------------------------- -%% Func: code_change/3 -%% Purpose: Convert process state when code is changed -%% Returns: {ok, NewState} -%%---------------------------------------------------------------------- - -code_change(_Vsn, State, _Extra) -> - ?d("code_change -> entry with" - "~n Vsn: ~p" - "~n State: ~p" - "~n Extra: ~p", [_Vsn, State, _Extra]), - {ok, State}. - - -%%%------------------------------------------------------------------- -%%% Internal functions -%%%------------------------------------------------------------------- - -handle_udp(Addr, Port, Bytes, State) -> - Verbosity = get(verbosity), - spawn_opt(fun() -> - Log = worker_init(State, Verbosity), - Res = (catch maybe_handle_recv_msg( - Addr, Port, Bytes, - State#state{log = Log})), - worker_exit(udp, {Addr, Port}, Res) - end, - [monitor]). - - -maybe_handle_recv_msg(Addr, Port, Bytes, #state{filter = FilterMod} = State) -> - case (catch FilterMod:accept_recv(Addr, Port)) of - false -> - %% Drop the received packet - inc(netIfMsgInDrops), - ok; - _ -> - handle_recv_msg(Addr, Port, Bytes, State) - end. - - -handle_recv_msg(Addr, Port, Bytes, #state{server = Pid}) - when is_binary(Bytes) andalso (size(Bytes) =:= 0) -> - Pid ! {snmp_error, {empty_message, Addr, Port}, Addr, Port}, - ok; - -handle_recv_msg(Addr, Port, Bytes, - #state{server = Pid, - note_store = NoteStore, - mpd_state = MpdState, - sock = Sock, - log = Log} = State) -> - Domain = snmp_conf:which_domain(Addr), % What the ****... - Logger = logger(Log, read, Addr, Port), - case (catch snmpm_mpd:process_msg(Bytes, Domain, Addr, Port, - MpdState, NoteStore, Logger)) of - - {ok, Vsn, Pdu, MS, ACM} -> - maybe_handle_recv_pdu(Addr, Port, Vsn, Pdu, MS, ACM, - Logger, State); - - {discarded, Reason, Report} -> - ?vdebug("discarded: ~p", [Reason]), - ErrorInfo = {failed_processing_message, Reason}, - Pid ! {snmp_error, ErrorInfo, Addr, Port}, - maybe_udp_send(State#state.filter, Sock, Addr, Port, Report), - ok; - - {discarded, Reason} -> - ?vdebug("discarded: ~p", [Reason]), - ErrorInfo = {failed_processing_message, Reason}, - Pid ! {snmp_error, ErrorInfo, Addr, Port}, - ok; - - Error -> - error_msg("processing of received message failed: " - "~n ~p", [Error]), - ok - end. - - -maybe_handle_recv_pdu(Addr, Port, - Vsn, #pdu{type = Type} = Pdu, PduMS, ACM, - Logger, - #state{filter = FilterMod} = State) -> - case (catch FilterMod:accept_recv_pdu(Addr, Port, Type)) of - false -> - inc(netIfPduInDrops), - ok; - _ -> - handle_recv_pdu(Addr, Port, Vsn, Pdu, PduMS, ACM, Logger, State) - end; -maybe_handle_recv_pdu(Addr, Port, Vsn, Trap, PduMS, ACM, Logger, - #state{filter = FilterMod} = State) - when is_record(Trap, trappdu) -> - case (catch FilterMod:accept_recv_pdu(Addr, Port, trappdu)) of - false -> - inc(netIfPduInDrops), - ok; - _ -> - handle_recv_pdu(Addr, Port, Vsn, Trap, PduMS, ACM, Logger, State) - end; -maybe_handle_recv_pdu(Addr, Port, Vsn, Pdu, PduMS, ACM, Logger, State) -> - handle_recv_pdu(Addr, Port, Vsn, Pdu, PduMS, ACM, Logger, State). - - -handle_recv_pdu(Addr, Port, - Vsn, #pdu{type = 'inform-request'} = Pdu, _PduMS, ACM, - Logger, #state{server = Pid, irb = IRB} = State) -> - handle_inform_request(IRB, Pid, Vsn, Pdu, ACM, - Addr, Port, Logger, State); -handle_recv_pdu(Addr, Port, - _Vsn, #pdu{type = report} = Pdu, _PduMS, ok, - _Logger, - #state{server = Pid} = _State) -> - ?vtrace("received report - ok", []), - Pid ! {snmp_report, {ok, Pdu}, Addr, Port}, - ok; -handle_recv_pdu(Addr, Port, - _Vsn, #pdu{type = report} = Pdu, _PduMS, - {error, ReqId, Reason}, - _Logger, - #state{server = Pid} = _State) -> - ?vtrace("received report - error", []), - Pid ! {snmp_report, {error, ReqId, Reason, Pdu}, Addr, Port}, - ok; -handle_recv_pdu(Addr, Port, - _Vsn, #pdu{type = 'snmpv2-trap'} = Pdu, _PduMS, _ACM, - _Logger, - #state{server = Pid} = _State) -> - ?vtrace("received snmpv2-trap", []), - Pid ! {snmp_trap, Pdu, Addr, Port}, - ok; -handle_recv_pdu(Addr, Port, - _Vsn, Trap, _PduMS, _ACM, - _Logger, - #state{server = Pid} = _State) when is_record(Trap, trappdu) -> - ?vtrace("received trappdu", []), - Pid ! {snmp_trap, Trap, Addr, Port}, - ok; -handle_recv_pdu(Addr, Port, - _Vsn, Pdu, _PduMS, _ACM, - _Logger, - #state{server = Pid} = _State) when is_record(Pdu, pdu) -> - ?vtrace("received pdu", []), - Pid ! {snmp_pdu, Pdu, Addr, Port}, - ok; -handle_recv_pdu(_Addr, _Port, _Vsn, Pdu, _PduMS, ACM, _Logger, _State) -> - ?vlog("received unexpected pdu: " - "~n Pdu: ~p" - "~n ACM: ~p", [Pdu, ACM]), - ok. - - -handle_inform_request(auto, Pid, Vsn, Pdu, ACM, Addr, Port, Logger, State) -> - ?vtrace("received inform-request (true)", []), - Pid ! {snmp_inform, ignore, Pdu, Addr, Port}, - RePdu = make_response_pdu(Pdu), - maybe_send_inform_response(RePdu, Vsn, ACM, Addr, Port, Logger, State); -handle_inform_request({user, To}, Pid, Vsn, #pdu{request_id = ReqId} = Pdu, - ACM, Addr, Port, _Logger, _State) -> - ?vtrace("received inform-request (false)", []), - - Pid ! {snmp_inform, ReqId, Pdu, Addr, Port}, - - %% Before we go any further, we need to check that we have not - %% already received this message (possible resend). - - Key = {ReqId, Addr, Port}, - case ets:lookup(snmpm_inform_request_table, Key) of - [_] -> - %% OK, we already know about this. We assume this - %% is a resend. Either the agent is really eager or - %% the user has not answered yet. Bad user! - ok; - [] -> - RePdu = make_response_pdu(Pdu), - Expire = t() + To, - Rec = {Key, Expire, {Vsn, ACM, RePdu}}, - ets:insert(snmpm_inform_request_table, Rec) - end, - ok. - -handle_inform_response(Ref, Addr, Port, State) -> - Verbosity = get(verbosity), - spawn_opt(fun() -> - Log = worker_init(State, Verbosity), - Res = (catch do_handle_inform_response( - Ref, - Addr, Port, - State#state{log = Log})), - worker_exit(inform_reponse, {Addr, Port}, Res) - end, - [monitor]). - - - -do_handle_inform_response(Ref, Addr, Port, State) -> - Key = {Ref, Addr, Port}, - case ets:lookup(snmpm_inform_request_table, Key) of - [{Key, _, {Vsn, ACM, RePdu}}] -> - Logger = logger(State#state.log, read, Addr, Port), - ets:delete(snmpm_inform_request_table, Key), - maybe_send_inform_response(RePdu, Vsn, ACM, Addr, Port, - Logger, State); - [] -> - %% Already acknowledged, or the user was to slow to reply... - ok - end, - ok. - -maybe_send_inform_response(RePdu, Vsn, ACM, Addr, Port, Logger, - #state{server = Pid, - sock = Sock, - filter = FilterMod}) -> - case (catch FilterMod:accept_send_pdu(Addr, Port, pdu_type_of(RePdu))) of - false -> - inc(netIfPduOutDrops), - ok; - _ -> - case snmpm_mpd:generate_response_msg(Vsn, RePdu, ACM, Logger) of - {ok, Msg} -> - maybe_udp_send(FilterMod, Sock, Addr, Port, Msg); - {discarded, Reason} -> - ?vlog("failed generating response message:" - "~n Reason: ~p", [Reason]), - ReqId = RePdu#pdu.request_id, - ErrorInfo = {failed_generating_response, {RePdu, Reason}}, - Pid ! {snmp_error, ReqId, ErrorInfo, Addr, Port}, - ok - end - end. - -handle_inform_response_gc(#state{irb = IRB} = State) -> - ets:safe_fixtable(snmpm_inform_request_table, true), - do_irgc(ets:first(snmpm_inform_request_table), t()), - ets:safe_fixtable(snmpm_inform_request_table, false), - State#state{irgc = irgc_start(IRB)}. - -%% We are deleting at the same time as we are traversing the table!!! -do_irgc('$end_of_table', _) -> - ok; -do_irgc(Key, Now) -> - Next = ets:next(snmpm_inform_request_table, Key), - case ets:lookup(snmpm_inform_request_table, Key) of - [{Key, BestBefore, _}] when BestBefore < Now -> - ets:delete(snmpm_inform_request_table, Key); - _ -> - ok - end, - do_irgc(Next, Now). - -irgc_start(auto) -> - undefined; -irgc_start(_) -> - erlang:send_after(?IRGC_TIMEOUT, self(), inform_response_gc). - -irgc_stop(undefined) -> - ok; -irgc_stop(Ref) -> - (catch erlang:cancel_timer(Ref)). - - -handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, Port, State) -> - Verbosity = get(verbosity), - spawn_opt(fun() -> - Log = worker_init(State, Verbosity), - Res = (catch maybe_handle_send_pdu( - Pdu, Vsn, MsgData, - Domain, Addr, Port, - State#state{log = Log})), - worker_exit(send_pdu, {Domain, Addr, Port}, Res) - end, - [monitor]). - -maybe_handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, Port, - #state{filter = FilterMod} = State) -> - case (catch FilterMod:accept_send_pdu(Addr, Port, pdu_type_of(Pdu))) of - false -> - inc(netIfPduOutDrops), - ok; - _ -> - do_handle_send_pdu(Pdu, Vsn, MsgData, Domain, Addr, Port, State) - end. - -do_handle_send_pdu(Pdu, Vsn, MsgData, _Domain, Addr, Port, - #state{server = Pid, - note_store = NoteStore, - sock = Sock, - log = Log, - filter = FilterMod}) -> - Logger = logger(Log, write, Addr, Port), - case (catch snmpm_mpd:generate_msg(Vsn, NoteStore, - Pdu, MsgData, Logger)) of - {ok, Msg} -> - ?vtrace("do_handle_send_pdu -> message generated", []), - maybe_udp_send(FilterMod, Sock, Addr, Port, Msg); - {discarded, Reason} -> - ?vlog("PDU not sent: " - "~n PDU: ~p" - "~n Reason: ~p", [Pdu, Reason]), - Pid ! {snmp_error, Pdu, Reason}, - ok - end. - - -maybe_udp_send(FilterMod, Sock, Addr, Port, Msg) -> - case (catch FilterMod:accept_send(Addr, Port)) of - false -> - inc(netIfMsgOutDrops), - ok; - _ -> - udp_send(Sock, Addr, Port, Msg) - end. - - -udp_send(Sock, Addr, Port, Msg) -> - case (catch gen_udp:send(Sock, Addr, Port, Msg)) of - ok -> - ?vdebug("sent ~w bytes to ~w:~w [~w]", - [sz(Msg), Addr, Port, Sock]), - ok; - {error, Reason} -> - error_msg("failed sending message to ~p:~p: " - "~n ~p",[Addr, Port, Reason]), - ok; - Error -> - error_msg("failed sending message to ~p:~p: " - "~n ~p",[Addr, Port, Error]), - ok - end. - -sz(B) when is_binary(B) -> - size(B); -sz(L) when is_list(L) -> - length(L); -sz(_) -> - undefined. - - -handle_disk_log(_Log, {wrap, NoLostItems}, State) -> - ?vlog("Audit Trail Log - wrapped: ~w previously logged items where lost", - [NoLostItems]), - State; -handle_disk_log(_Log, {truncated, NoLostItems}, State) -> - ?vlog("Audit Trail Log - truncated: ~w items where lost when truncating", - [NoLostItems]), - State; -handle_disk_log(_Log, full, State) -> - error_msg("Failed to write to Audit Trail Log (full)", []), - State; -handle_disk_log(_Log, {error_status, ok}, State) -> - State; -handle_disk_log(_Log, {error_status, {error, Reason}}, State) -> - error_msg("Error status received from Audit Trail Log: " - "~n~p", [Reason]), - State; -handle_disk_log(_Log, _Info, State) -> - State. - - -%% mk_discovery_msg('version-3', Pdu, _VsnHdr, UserName) -> -%% ScopedPDU = #scopedPdu{contextEngineID = "", -%% contextName = "", -%% data = Pdu}, -%% Bytes = snmp_pdus:enc_scoped_pdu(ScopedPDU), -%% MsgID = get(msg_id), -%% put(msg_id,MsgID+1), -%% UsmSecParams = -%% #usmSecurityParameters{msgAuthoritativeEngineID = "", -%% msgAuthoritativeEngineBoots = 0, -%% msgAuthoritativeEngineTime = 0, -%% msgUserName = UserName, -%% msgPrivacyParameters = "", -%% msgAuthenticationParameters = ""}, -%% SecBytes = snmp_pdus:enc_usm_security_parameters(UsmSecParams), -%% PduType = Pdu#pdu.type, -%% Hdr = #v3_hdr{msgID = MsgID, -%% msgMaxSize = 1000, -%% msgFlags = snmp_misc:mk_msg_flags(PduType, 0), -%% msgSecurityModel = ?SEC_USM, -%% msgSecurityParameters = SecBytes}, -%% Msg = #message{version = 'version-3', vsn_hdr = Hdr, data = Bytes}, -%% case (catch snmp_pdus:enc_message_only(Msg)) of -%% {'EXIT', Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% L when list(L) -> -%% {Msg, L} -%% end; -%% mk_discovery_msg(Version, Pdu, {Com, _, _, _, _}, UserName) -> -%% Msg = #message{version = Version, vsn_hdr = Com, data = Pdu}, -%% case catch snmp_pdus:enc_message(Msg) of -%% {'EXIT', Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% L when list(L) -> -%% {Msg, L} -%% end. - - -%% mk_msg('version-3', Pdu, {Context, User, EngineID, CtxEngineId, SecLevel}, -%% MsgData) -> -%% %% Code copied from snmp_mpd.erl -%% {MsgId, SecName, SecData} = -%% if -%% tuple(MsgData), Pdu#pdu.type == 'get-response' -> -%% MsgData; -%% true -> -%% Md = get(msg_id), -%% put(msg_id, Md + 1), -%% {Md, User, []} -%% end, -%% ScopedPDU = #scopedPdu{contextEngineID = CtxEngineId, -%% contextName = Context, -%% data = Pdu}, -%% ScopedPDUBytes = snmp_pdus:enc_scoped_pdu(ScopedPDU), - -%% PduType = Pdu#pdu.type, -%% V3Hdr = #v3_hdr{msgID = MsgId, -%% msgMaxSize = 1000, -%% msgFlags = snmp_misc:mk_msg_flags(PduType, SecLevel), -%% msgSecurityModel = ?SEC_USM}, -%% Message = #message{version = 'version-3', vsn_hdr = V3Hdr, -%% data = ScopedPDUBytes}, -%% SecEngineID = case PduType of -%% 'get-response' -> snmp_framework_mib:get_engine_id(); -%% _ -> EngineID -%% end, -%% case catch snmp_usm:generate_outgoing_msg(Message, SecEngineID, -%% SecName, SecData, SecLevel) of -%% {'EXIT', Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% {error, Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% Packet -> -%% Packet -%% end; -%% mk_msg(Version, Pdu, {Com, _User, _EngineID, _Ctx, _SecLevel}, _SecData) -> -%% Msg = #message{version = Version, vsn_hdr = Com, data = Pdu}, -%% case catch snmp_pdus:enc_message(Msg) of -%% {'EXIT', Reason} -> -%% error("Encoding error. Pdu: ~w. Reason: ~w",[Pdu, Reason]), -%% error; -%% B when list(B) -> -%% B -%% end. - - -%% handle_system_info_updated(#state{log = {Log, _OldType}} = State, -%% audit_trail_log_type = _What) -> -%% %% Just to make sure, check that ATL is actually enabled -%% case snmpm_config:system_info(audit_trail_log) of -%% {ok, true} -> -%% {ok, Type} = snmpm_config:system_info(audit_trail_log_type), -%% NewState = State#state{log = {Log, Type}}, -%% {NewState, ok}; -%% _ -> -%% {State, {error, {adt_not_enabled}}} -%% end; -%% handle_system_info_updated(_State, _What) -> -%% ok. - -handle_get_log_type(#state{log = {_Log, Value}} = State) -> - %% Just to make sure, check that ATL is actually enabled - case snmpm_config:system_info(audit_trail_log) of - {ok, true} -> - Type = - case {lists:member(read, Value), lists:member(write, Value)} of - {true, true} -> - read_write; - {true, false} -> - read; - {false, true} -> - write; - {false, false} -> - throw({State, {error, {bad_atl_type, Value}}}) - end, - {ok, Type}; - _ -> - {error, not_enabled} - end; -handle_get_log_type(_State) -> - {error, not_enabled}. - -handle_set_log_type(#state{log = {Log, OldValue}} = State, NewType) -> - %% Just to make sure, check that ATL is actually enabled - case snmpm_config:system_info(audit_trail_log) of - {ok, true} -> - NewValue = - case NewType of - read -> - [read]; - write -> - [write]; - read_write -> - [read,write]; - _ -> - throw({State, {error, {bad_atl_type, NewType}}}) - end, - NewState = State#state{log = {Log, NewValue}}, - OldType = - case {lists:member(read, OldValue), - lists:member(write, OldValue)} of - {true, true} -> - read_write; - {true, false} -> - read; - {false, true} -> - write; - {false, false} -> - throw({State, {error, {bad_atl_type, OldValue}}}) - end, - {NewState, {ok, OldType}}; - _ -> - {State, {error, not_enabled}} - end; -handle_set_log_type(State, _NewType) -> - {State, {error, not_enabled}}. - - -%% ------------------------------------------------------------------- - -worker_init(#state{log = undefined = Log}, Verbosity) -> - worker_init2(Log, Verbosity); -worker_init(#state{log = {Name, Log, Type}}, Verbosity) -> - case snmp_log:open(Name, Log) of - {ok, NewLog} -> - worker_init2({Name, NewLog, Type}, Verbosity); - {error, Reason} -> - warning_msg("NetIf worker ~p failed opening ATL: " - "~n ~p", [self(), Reason]), - NewLog = undefined, - worker_init2({Name, NewLog, Type}, Verbosity) - end; -worker_init(State, Verbosity) -> - ?vinfo("worker_init -> entry with invalid data: " - "~n State: ~p" - "~n Verbosity: ~p", [State, Verbosity]), - exit({worker_init, State, Verbosity}). - -worker_init2(Log, Verbosity) -> - put(sname, mnifw), - put(verbosity, Verbosity), - Log. - - -worker_exit(Tag, Info, Result) -> - exit({net_if_worker, {Tag, Info, Result}}). - -handle_worker_exit(_, {_, _, ok}) -> - ok; -handle_worker_exit(Pid, {udp, {Addr, Port}, ExitStatus}) -> - warning_msg("Worker process (~p) terminated " - "while processing (incomming) message from ~w:~w: " - "~n~p", [Pid, Addr, Port, ExitStatus]), - ok; -handle_worker_exit(Pid, {send_pdu, {Domain, Addr, Port}, ExitStatus}) -> - warning_msg("Worker process (~p) terminated " - "while processing (outgoing) pdu for [~w] ~w:~w: " - "~n~p", [Pid, Domain, Addr, Port, ExitStatus]), - ok; -handle_worker_exit(Pid, {inform_response, {Addr, Port}, ExitStatus}) -> - warning_msg("Worker process (~p) terminated " - "while processing (outgoing) inform response for ~w:~w: " - "~n~p", [Pid, Addr, Port, ExitStatus]), - ok; -handle_worker_exit(_, _) -> - ok. - - -%% ------------------------------------------------------------------- - -make_response_pdu(#pdu{request_id = ReqId, varbinds = Vbs}) -> - #pdu{type = 'get-response', - request_id = ReqId, - error_status = noError, - error_index = 0, - varbinds = Vbs}. - - -%% ---------------------------------------------------------------- - -pdu_type_of(#pdu{type = Type}) -> - Type; -pdu_type_of(TrapPdu) when is_record(TrapPdu, trappdu) -> - trap. - - -%% ------------------------------------------------------------------- - -%% At this point this function is used during testing -maybe_process_extra_info(?DEFAULT_EXTRA_INFO) -> - ok; -maybe_process_extra_info({?SNMPM_EXTRA_INFO_TAG, Fun}) - when is_function(Fun, 0) -> - (catch Fun()), - ok; -maybe_process_extra_info(_ExtraInfo) -> - ok. - - -%% ------------------------------------------------------------------- - -t() -> - {A,B,C} = erlang:now(), - A*1000000000+B*1000+(C div 1000). - - -%% ------------------------------------------------------------------- - -logger(undefined, _Type, _Addr, _Port) -> - fun(_) -> - ok - end; -logger({_Name, Log, Types}, Type, Addr, Port) -> - case lists:member(Type, Types) of - true -> - fun(Msg) -> - snmp_log:log(Log, Msg, Addr, Port) - end; - false -> - fun(_) -> - ok - end - end. - - -%% ------------------------------------------------------------------- - -%% info_msg(F, A) -> -%% ?snmpm_info("NET-IF server: " ++ F, A). - -warning_msg(F, A) -> - ?snmpm_warning("NET-IF server: " ++ F, A). - -error_msg(F, A) -> - ?snmpm_error("NET-IF server: " ++ F, A). - - - -%%%------------------------------------------------------------------- - -% get_opt(Key, Opts) -> -% ?vtrace("get option ~w", [Key]), -% snmp_misc:get_option(Key, Opts). - -get_opt(Opts, Key, Def) -> - ?vtrace("get option ~w with default ~p", [Key, Def]), - snmp_misc:get_option(Key, Opts, Def). - - -%% ------------------------------------------------------------------- - -get_info(#state{sock = Id}) -> - ProcSize = proc_mem(self()), - PortInfo = get_port_info(Id), - [{process_memory, ProcSize}, {port_info, PortInfo}]. - -proc_mem(P) when is_pid(P) -> - case (catch erlang:process_info(P, memory)) of - {memory, Sz} when is_integer(Sz) -> - Sz; - _ -> - undefined - end. -%% proc_mem(_) -> -%% undefined. - - -get_port_info(Id) -> - PortInfo = - case (catch erlang:port_info(Id)) of - PI when is_list(PI) -> - [{port_info, PI}]; - _ -> - [] - end, - PortStatus = - case (catch prim_inet:getstatus(Id)) of - {ok, PS} -> - [{port_status, PS}]; - _ -> - [] - end, - PortAct = - case (catch inet:getopts(Id, [active])) of - {ok, PA} -> - [{port_act, PA}]; - _ -> - [] - end, - PortStats = - case (catch inet:getstat(Id)) of - {ok, Stat} -> - [{port_stats, Stat}]; - _ -> - [] - end, - IfList = - case (catch inet:getif(Id)) of - {ok, IFs} -> - [{interfaces, IFs}]; - _ -> - [] - end, - BufSz = - case (catch inet:getopts(Id, [recbuf, sndbuf, buffer])) of - {ok, Sz} -> - [{buffer_size, Sz}]; - _ -> - [] - end, - [{socket, Id}] ++ - IfList ++ - PortStats ++ - PortInfo ++ - PortStatus ++ - PortAct ++ - BufSz. - - -%%----------------------------------------------------------------- -%% Counter functions -%%----------------------------------------------------------------- -init_counters() -> - F = fun(Counter) -> maybe_create_counter(Counter) end, - lists:map(F, counters()). - -reset_counters() -> - F = fun(Counter) -> snmpm_config:reset_stats_counter(Counter) end, - lists:map(F, counters()). - -maybe_create_counter(Counter) -> - snmpm_config:maybe_cre_stats_counter(Counter, 0). - -counters() -> - [ - netIfMsgOutDrops, - netIfMsgInDrops, - netIfPduOutDrops, - netIfPduInDrops - ]. - -inc(Name) -> inc(Name, 1). -inc(Name, N) -> snmpm_config:incr_stats_counter(Name, N). - -%% get_counters() -> -%% Counters = counters(), -%% get_counters(Counters, []). - -%% get_counters([], Acc) -> -%% lists:reverse(Acc); -%% get_counters([Counter|Counters], Acc) -> -%% case snmpm_config:get_stats_counter(Counter) of -%% {ok, CounterVal} -> -%% get_counters(Counters, [{Counter, CounterVal}|Acc]); -%% _ -> -%% get_counters(Counters, Acc) -%% end. - - -%% ---------------------------------------------------------------- - -call(Pid, Req) -> - call(Pid, Req, infinity). - -call(Pid, Req, Timeout) -> - gen_server:call(Pid, Req, Timeout). - -cast(Pid, Msg) -> - gen_server:cast(Pid, Msg). +-define(snmpm_net_if_mt, true). +-module(snmpm_net_if_mt). +-include("snmpm_net_if.erl"). diff --git a/lib/snmp/src/manager/snmpm_server.erl b/lib/snmp/src/manager/snmpm_server.erl index 9c79df2748..a75122d0bb 100644 --- a/lib/snmp/src/manager/snmpm_server.erl +++ b/lib/snmp/src/manager/snmpm_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -163,8 +163,7 @@ reg_type, target, domain, - addr, - port, + address, type, data, ref, @@ -1033,14 +1032,14 @@ handle_info({snmp_error, Pdu, Reason}, State) -> handle_snmp_error(Pdu, Reason, State), {noreply, State}; -handle_info({snmp_error, Reason, Addr, Port}, State) -> +handle_info({snmp_error, Reason, Domain, Addr}, State) -> ?vlog("received snmp_error message", []), - handle_snmp_error(Addr, Port, -1, Reason, State), + handle_snmp_error(Domain, Addr, -1, Reason, State), {noreply, State}; -handle_info({snmp_error, ReqId, Reason, Addr, Port}, State) -> +handle_info({snmp_error, ReqId, Reason, Domain, Addr}, State) -> ?vlog("received snmp_error message", []), - handle_snmp_error(Addr, Port, ReqId, Reason, State), + handle_snmp_error(Domain, Addr, ReqId, Reason, State), {noreply, State}; %% handle_info({snmp_error, ReqId, Pdu, Reason, Addr, Port}, State) -> @@ -1049,30 +1048,30 @@ handle_info({snmp_error, ReqId, Reason, Addr, Port}, State) -> %% {noreply, State}; -handle_info({snmp_pdu, Pdu, Addr, Port}, State) -> +handle_info({snmp_pdu, Pdu, Domain, Addr}, State) -> ?vlog("received snmp_pdu message", []), - handle_snmp_pdu(Pdu, Addr, Port, State), + handle_snmp_pdu(Pdu, Domain, Addr, State), {noreply, State}; -handle_info({snmp_trap, Trap, Addr, Port}, State) -> +handle_info({snmp_trap, Trap, Domain, Addr}, State) -> ?vlog("received snmp_trap message", []), - handle_snmp_trap(Trap, Addr, Port, State), + handle_snmp_trap(Trap, Domain, Addr, State), {noreply, State}; -handle_info({snmp_inform, Ref, Pdu, Addr, Port}, State) -> +handle_info({snmp_inform, Ref, Pdu, Domain, Addr}, State) -> ?vlog("received snmp_inform message", []), - handle_snmp_inform(Ref, Pdu, Addr, Port, State), + handle_snmp_inform(Ref, Pdu, Domain, Addr, State), {noreply, State}; -handle_info({snmp_report, {ok, Pdu}, Addr, Port}, State) -> - handle_snmp_report(Pdu, Addr, Port, State), +handle_info({snmp_report, {ok, Pdu}, Domain, Addr}, State) -> + handle_snmp_report(Pdu, Domain, Addr, State), {noreply, State}; -handle_info({snmp_report, {error, ReqId, Info, Pdu}, Addr, Port}, State) -> - handle_snmp_report(ReqId, Pdu, Info, Addr, Port, State), +handle_info({snmp_report, {error, ReqId, Info, Pdu}, Domain, Addr}, State) -> + handle_snmp_report(ReqId, Pdu, Info, Domain, Addr, State), {noreply, State}; @@ -1176,11 +1175,11 @@ handle_sync_get(Pid, UserId, TargetName, Oids, SendOpts, From, State) -> "~n From: ~p", [Pid, UserId, TargetName, Oids, SendOpts, From]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Vsn, MsgData} -> ?vtrace("handle_sync_get -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_get_request(Oids, Vsn, MsgData, - Domain, Addr, Port, + Domain, Addr, Extra, State), ?vdebug("handle_sync_get -> ReqId: ~p", [ReqId]), Msg = {sync_timeout, ReqId, From}, @@ -1193,8 +1192,7 @@ handle_sync_get(Pid, UserId, TargetName, Oids, SendOpts, From, State) -> reg_type = RegType, target = TargetName, domain = Domain, - addr = Addr, - port = Port, + address = Addr, type = get, data = MsgData, ref = Ref, @@ -1230,11 +1228,11 @@ handle_sync_get_next(Pid, UserId, TargetName, Oids, SendOpts, "~n From: ~p", [Pid, UserId, TargetName, Oids, SendOpts, From]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Vsn, MsgData} -> ?vtrace("handle_sync_get_next -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_get_next_request(Oids, Vsn, MsgData, - Domain, Addr, Port, + Domain, Addr, Extra, State), ?vdebug("handle_sync_get_next -> ReqId: ~p", [ReqId]), Msg = {sync_timeout, ReqId, From}, @@ -1247,12 +1245,11 @@ handle_sync_get_next(Pid, UserId, TargetName, Oids, SendOpts, reg_type = RegType, target = TargetName, domain = Domain, - addr = Addr, - port = Port, + address = Addr, type = get_next, data = MsgData, ref = Ref, - mon = MonRef, + mon = MonRef, from = From}, ets:insert(snmpm_request_table, Req), ok; @@ -1290,11 +1287,11 @@ handle_sync_get_bulk(Pid, UserId, TargetName, NonRep, MaxRep, Oids, SendOpts, "~n From: ~p", [Pid, UserId, TargetName, NonRep, MaxRep, Oids, SendOpts, From]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Vsn, MsgData} -> ?vtrace("handle_sync_get_bulk -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_get_bulk_request(Oids, Vsn, MsgData, - Domain, Addr, Port, + Domain, Addr, NonRep, MaxRep, Extra, State), ?vdebug("handle_sync_get_bulk -> ReqId: ~p", [ReqId]), Msg = {sync_timeout, ReqId, From}, @@ -1307,8 +1304,7 @@ handle_sync_get_bulk(Pid, UserId, TargetName, NonRep, MaxRep, Oids, SendOpts, reg_type = RegType, target = TargetName, domain = Domain, - addr = Addr, - port = Port, + address = Addr, type = get_bulk, data = MsgData, ref = Ref, @@ -1346,11 +1342,11 @@ handle_sync_set(Pid, UserId, TargetName, VarsAndVals, SendOpts, From, State) -> "~n From: ~p", [Pid, UserId, TargetName, VarsAndVals, From]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Vsn, MsgData} -> ?vtrace("handle_sync_set -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_set_request(VarsAndVals, Vsn, MsgData, - Domain, Addr, Port, + Domain, Addr, Extra, State), ?vdebug("handle_sync_set -> ReqId: ~p", [ReqId]), Msg = {sync_timeout, ReqId, From}, @@ -1363,8 +1359,7 @@ handle_sync_set(Pid, UserId, TargetName, VarsAndVals, SendOpts, From, State) -> reg_type = RegType, target = TargetName, domain = Domain, - addr = Addr, - port = Port, + address = Addr, type = set, data = MsgData, ref = Ref, @@ -1400,11 +1395,11 @@ handle_async_get(Pid, UserId, TargetName, Oids, SendOpts, State) -> "~n SendOpts: ~p", [Pid, UserId, TargetName, Oids, SendOpts]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Vsn, MsgData} -> ?vtrace("handle_async_get -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_get_request(Oids, Vsn, MsgData, - Domain, Addr, Port, + Domain, Addr, Extra, State), ?vdebug("handle_async_get -> ReqId: ~p", [ReqId]), Expire = ?ASYNC_GET_TIMEOUT(SendOpts), @@ -1413,8 +1408,7 @@ handle_async_get(Pid, UserId, TargetName, Oids, SendOpts, State) -> reg_type = RegType, target = TargetName, domain = Domain, - addr = Addr, - port = Port, + address = Addr, type = get, data = MsgData, expire = t() + Expire}, @@ -1450,11 +1444,11 @@ handle_async_get_next(Pid, UserId, TargetName, Oids, SendOpts, State) -> "~n SendOpts: ~p", [Pid, UserId, TargetName, Oids, SendOpts]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Vsn, MsgData} -> ?vtrace("handle_async_get_next -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_get_next_request(Oids, Vsn, MsgData, - Domain, Addr, Port, + Domain, Addr, Extra, State), ?vdebug("handle_async_get_next -> ReqId: ~p", [ReqId]), Expire = ?ASYNC_GET_NEXT_TIMEOUT(SendOpts), @@ -1463,8 +1457,7 @@ handle_async_get_next(Pid, UserId, TargetName, Oids, SendOpts, State) -> reg_type = RegType, target = TargetName, domain = Domain, - addr = Addr, - port = Port, + address = Addr, type = get_next, data = MsgData, expire = t() + Expire}, @@ -1507,11 +1500,11 @@ handle_async_get_bulk(Pid, "~n SendOpts: ~p", [Pid, UserId, TargetName, NonRep, MaxRep, Oids, SendOpts]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Vsn, MsgData} -> ?vtrace("handle_async_get_bulk -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_get_bulk_request(Oids, Vsn, MsgData, - Domain, Addr, Port, + Domain, Addr, NonRep, MaxRep, Extra, State), ?vdebug("handle_async_get_bulk -> ReqId: ~p", [ReqId]), Expire = ?ASYNC_GET_BULK_TIMEOUT(SendOpts), @@ -1520,8 +1513,7 @@ handle_async_get_bulk(Pid, reg_type = RegType, target = TargetName, domain = Domain, - addr = Addr, - port = Port, + address = Addr, type = get_bulk, data = MsgData, expire = t() + Expire}, @@ -1556,11 +1548,11 @@ handle_async_set(Pid, UserId, TargetName, VarsAndVals, SendOpts, State) -> "~n SendOpts: ~p", [Pid, UserId, TargetName, VarsAndVals, SendOpts]), case agent_data(TargetName, SendOpts) of - {ok, RegType, Domain, Addr, Port, Vsn, MsgData} -> + {ok, RegType, Domain, Addr, Vsn, MsgData} -> ?vtrace("handle_async_set -> send a ~p message", [Vsn]), Extra = ?GET_EXTRA(SendOpts), ReqId = send_set_request(VarsAndVals, Vsn, MsgData, - Domain, Addr, Port, + Domain, Addr, Extra, State), ?vdebug("handle_async_set -> ReqId: ~p", [ReqId]), Expire = ?ASYNC_SET_TIMEOUT(SendOpts), @@ -1569,8 +1561,7 @@ handle_async_set(Pid, UserId, TargetName, VarsAndVals, SendOpts, State) -> reg_type = RegType, target = TargetName, domain = Domain, - addr = Addr, - port = Port, + address = Addr, type = set, data = MsgData, expire = t() + Expire}, @@ -1808,15 +1799,15 @@ handle_snmp_error(CrapError, Reason, _State) -> "~n~p~n~p", [CrapError, Reason]), ok. -handle_snmp_error(Addr, Port, ReqId, Reason, State) -> +handle_snmp_error(Domain, Addr, ReqId, Reason, State) -> - ?vtrace("handle_snmp_error -> entry with" - "~n Addr: ~p" - "~n Port: ~p" - "~n ReqId: ~p" - "~n Reason: ~p", [Addr, Port, ReqId, Reason]), + ?vtrace("handle_snmp_error -> entry with~n" + " Domain: ~p~n" + " Addr: ~p~n" + " ReqId: ~p~n" + " Reason: ~p", [Domain, Addr, ReqId, Reason]), - case snmpm_config:get_agent_user_id(Addr, Port) of + case snmpm_config:get_agent_user_id(Domain, Addr) of {ok, UserId} -> case snmpm_config:user_info(UserId) of {ok, UserMod, UserData} -> @@ -1831,7 +1822,7 @@ handle_snmp_error(Addr, Port, ReqId, Reason, State) -> error_msg("failed retreiving the default user " "info handling snmp error " "<~p,~p>: ~n~w~n~w", - [Addr, Port, ReqId, Reason]) + [Domain, Addr, ReqId, Reason]) end end; _Error -> @@ -1843,7 +1834,7 @@ handle_snmp_error(Addr, Port, ReqId, Reason, State) -> error_msg("failed retreiving the default user " "info handling snmp error " "<~p,~p>: ~n~w~n~w", - [Addr, Port, ReqId, Reason]) + [Domain, Addr, ReqId, Reason]) end end. @@ -1867,12 +1858,12 @@ handle_error(_UserId, Mod, Reason, ReqId, Data, _State) -> handle_snmp_pdu(#pdu{type = 'get-response', request_id = ReqId} = Pdu, - Addr, Port, State) -> + Domain, Addr, State) -> - ?vtrace("handle_snmp_pdu(get-response) -> entry with" - "~n Addr: ~p" - "~n Port: ~p" - "~n Pdu: ~p", [Addr, Port, Pdu]), + ?vtrace("handle_snmp_pdu(get-response) -> entry with~n" + " Domain: ~p~n" + " Addr: ~p~n" + " Pdu: ~p", [Domain, Addr, Pdu]), case ets:lookup(snmpm_request_table, ReqId) of @@ -1902,9 +1893,10 @@ handle_snmp_pdu(#pdu{type = 'get-response', request_id = ReqId} = Pdu, SnmpResponse = {EStatus, EIndex, Varbinds2}, case snmpm_config:user_info(UserId) of {ok, UserMod, UserData} -> - handle_pdu(UserId, UserMod, - RegType, Target, Addr, Port, - ReqId, SnmpResponse, UserData, State), + handle_pdu( + UserId, UserMod, + RegType, Target, Domain, Addr, + ReqId, SnmpResponse, UserData, State), maybe_delete(Disco, ReqId); _Error -> %% reply to outstanding request, for which there is no @@ -1912,15 +1904,16 @@ handle_snmp_pdu(#pdu{type = 'get-response', request_id = ReqId} = Pdu, %% Therefor send it to the default user case snmpm_config:user_info() of {ok, DefUserId, DefMod, DefData} -> - handle_pdu(DefUserId, DefMod, - RegType, Target, Addr, Port, - ReqId, SnmpResponse, DefData, State), + handle_pdu( + DefUserId, DefMod, + RegType, Target, Domain, Addr, + ReqId, SnmpResponse, DefData, State), maybe_delete(Disco, ReqId); Error -> error_msg("failed retreiving the default user " "info handling pdu from " "~p <~p,~p>: ~n~w~n~w", - [Target, Addr, Port, Error, Pdu]) + [Target, Domain, Addr, Error, Pdu]) end end; @@ -1974,7 +1967,7 @@ handle_snmp_pdu(#pdu{type = 'get-response', request_id = ReqId} = Pdu, varbinds = Varbinds} = Pdu, Varbinds2 = fix_vbs_BITS(Varbinds), SnmpInfo = {EStatus, EIndex, Varbinds2}, - case snmpm_config:get_agent_user_id(Addr, Port) of + case snmpm_config:get_agent_user_id(Domain, Addr) of {ok, UserId} -> %% A very late reply or a reply to a request %% that has been cancelled. @@ -1999,7 +1992,7 @@ handle_snmp_pdu(#pdu{type = 'get-response', request_id = ReqId} = Pdu, "user info handling (old) " "pdu from " "<~p,~p>: ~n~w~n~w", - [Addr, Port, Error, Pdu]) + [Domain, Addr, Error, Pdu]) end end; @@ -2016,28 +2009,30 @@ handle_snmp_pdu(#pdu{type = 'get-response', request_id = ReqId} = Pdu, "no agent info found", []), case snmpm_config:user_info() of {ok, DefUserId, DefMod, DefData} -> - handle_agent(DefUserId, DefMod, - Addr, Port, - pdu, ignore, - SnmpInfo, DefData, State); + handle_agent( + DefUserId, DefMod, + Domain, Addr, + pdu, ignore, + SnmpInfo, DefData, State); Error -> error_msg("failed retreiving the default user " "info handling (old) pdu when no user " "found from " "<~p,~p>: ~n~w~n~w", - [Addr, Port, Error, Pdu]) + [Domain, Addr, Error, Pdu]) end end end; -handle_snmp_pdu(CrapPdu, Addr, Port, _State) -> +handle_snmp_pdu(CrapPdu, Domain, Addr, _State) -> error_msg("received crap (snmp) Pdu from ~w:~w =>" - "~p", [Addr, Port, CrapPdu]), + "~p", [Domain, Addr, CrapPdu]), ok. -handle_pdu(_UserId, Mod, target_name = _RegType, TargetName, _Addr, _Port, - ReqId, SnmpResponse, Data, _State) -> +handle_pdu( + _UserId, Mod, target_name = _RegType, TargetName, _Domain, _Addr, + ReqId, SnmpResponse, Data, _State) -> ?vtrace("handle_pdu(target_name) -> entry when" "~n Mod: ~p", [Mod]), F = fun() -> @@ -2053,43 +2048,56 @@ handle_pdu(_UserId, Mod, target_name = _RegType, TargetName, _Addr, _Port, end, handle_callback(F), ok; -handle_pdu(_UserId, Mod, addr_port = _RegType, _TargetName, Addr, Port, - ReqId, SnmpResponse, Data, _State) -> +handle_pdu( + _UserId, Mod, addr_port = _RegType, _TargetName, _Domain, Addr, + ReqId, SnmpResponse, Data, _State) -> ?vtrace("handle_pdu(addr_port) -> entry when" "~n Mod: ~p", [Mod]), F = fun() -> - (catch Mod:handle_pdu(Addr, Port, ReqId, SnmpResponse, Data)) + {Ip, Port} = Addr, + (catch Mod:handle_pdu(Ip, Port, ReqId, SnmpResponse, Data)) end, handle_callback(F), ok. -handle_agent(UserId, Mod, Addr, Port, Type, Ref, SnmpInfo, Data, State) -> +handle_agent(UserId, Mod, Domain, Addr, Type, Ref, SnmpInfo, Data, State) -> ?vtrace("handle_agent -> entry when" "~n UserId: ~p" "~n Type: ~p" "~n Mod: ~p", [UserId, Type, Mod]), F = fun() -> - do_handle_agent(UserId, Mod, Addr, Port, + do_handle_agent(UserId, Mod, Domain, Addr, Type, Ref, SnmpInfo, Data, State) end, handle_callback(F), ok. do_handle_agent(DefUserId, DefMod, - Addr, Port, + Domain, Addr, Type, Ref, SnmpInfo, DefData, State) -> ?vdebug("do_handle_agent -> entry when" "~n DefUserId: ~p", [DefUserId]), - try DefMod:handle_agent(Addr, Port, Type, SnmpInfo, DefData) of + {Domain_or_Ip, Addr_or_Port} = + case Domain of + snmpUDPDomain -> + Addr; + _ -> + {Domain, Addr} + end, + try DefMod:handle_agent( + Domain_or_Ip, Addr_or_Port, Type, SnmpInfo, DefData) + of {register, UserId2, TargetName, Config} -> ?vtrace("do_handle_agent -> register: " "~n UserId2: ~p" "~n TargetName: ~p" "~n Config: ~p", [UserId2, TargetName, Config]), - Config2 = ensure_present([{address, Addr}, {port, Port}], Config), + Config2 = + ensure_present( + [{tdomain, Domain}, {taddress, Addr}], Config), Config3 = [{reg_type, target_name} | Config2], case snmpm_config:register_agent(UserId2, TargetName, Config3) of @@ -2099,7 +2107,7 @@ do_handle_agent(DefUserId, DefMod, error_msg("failed registering agent - " "handling agent " "~p <~p,~p>: ~n~w", - [TargetName, Addr, Port, Reason]), + [TargetName, Domain, Addr, Reason]), ok end; @@ -2108,31 +2116,33 @@ do_handle_agent(DefUserId, DefMod, ok; InvalidResult -> - CallbackArgs = [Addr, Port, Type, SnmpInfo, DefData], + CallbackArgs = [Domain, Addr, Type, SnmpInfo, DefData], handle_invalid_result(handle_agent, CallbackArgs, InvalidResult) catch error:{undef, _} when Type =:= pdu -> %% Maybe, still on the old API ?vdebug("do_handle_agent -> maybe still on the old api", []), - case (catch DefMod:handle_agent(Addr, Port, SnmpInfo, DefData)) of + {Ip, Port} = Addr, + case (catch DefMod:handle_agent(Ip, Port, SnmpInfo, DefData)) of {register, UserId2, Config} -> ?vtrace("do_handle_agent -> register: " "~n UserId2: ~p" "~n Config: ~p", [UserId2, Config]), - TargetName = mk_target_name(Addr, Port, Config), - Config2 = [{reg_type, addr_port}, - {address, Addr}, - {port, Port} | Config], - case snmpm_config:register_agent(UserId2, - TargetName, Config2) of + TargetName = mk_target_name(Domain, Addr, Config), + Config2 = + ensure_present( + [{tdomain, Domain}, {taddress, Addr}], Config), + Config3 = [{reg_type, addr_port} | Config2], + case snmpm_config:register_agent( + UserId2, TargetName, Config3) of ok -> ok; {error, Reason} -> error_msg("failed registering agent - " "handling agent " "~p <~p,~p>: ~n~w", - [TargetName, Addr, Port, Reason]), + [TargetName, Domain, Addr, Reason]), ok end; {register, UserId2, TargetName, Config} -> @@ -2141,18 +2151,19 @@ do_handle_agent(DefUserId, DefMod, "~n TargetName: ~p" "~n Config: ~p", [UserId2, TargetName, Config]), - Config2 = ensure_present([{address, Addr}, {port, Port}], - Config), + Config2 = + ensure_present( + [{tdomain, Domain}, {taddress, Addr}], Config), Config3 = [{reg_type, target_name} | Config2], - case snmpm_config:register_agent(UserId2, - TargetName, Config3) of + case snmpm_config:register_agent( + UserId2, TargetName, Config3) of ok -> ok; {error, Reason} -> error_msg("failed registering agent - " "handling agent " "~p <~p,~p>: ~n~w", - [TargetName, Addr, Port, Reason]), + [TargetName, Domain, Addr, Reason]), ok end; _Ignore -> @@ -2170,34 +2181,38 @@ do_handle_agent(DefUserId, DefMod, %% Backward compatibillity crap RegType = target_name, - Target = mk_target_name(Addr, Port, default_agent_config()), + Target = mk_target_name(Domain, Addr, default_agent_config()), case Type of report -> SnmpInform = SnmpInfo, - handle_report(DefUserId, DefMod, - RegType, Target, Addr, Port, - SnmpInform, DefData, State); + handle_report( + DefUserId, DefMod, + RegType, Target, Domain, Addr, + SnmpInform, DefData, State); inform -> SnmpInform = SnmpInfo, - handle_inform(DefUserId, DefMod, Ref, - RegType, Target, Addr, Port, - SnmpInform, DefData, State); + handle_inform( + DefUserId, DefMod, Ref, + RegType, Target, Domain, Addr, + SnmpInform, DefData, State); trap -> SnmpTrapInfo = SnmpInfo, - handle_trap(DefUserId, DefMod, - RegType, Target, Addr, Port, - SnmpTrapInfo, DefData, State); + handle_trap( + DefUserId, DefMod, + RegType, Target, Domain, Addr, + SnmpTrapInfo, DefData, State); _ -> - error_msg("failed delivering ~w info to default user - " - "regarding agent " - "<~p,~p>: ~n~w", [Type, Addr, Port, SnmpInfo]) + error_msg( + "failed delivering ~w info to default user - " + "regarding agent " + "<~p,~p>: ~n~w", [Type, Domain, Addr, SnmpInfo]) end; T:E -> - CallbackArgs = [Addr, Port, Type, SnmpInfo, DefData], + CallbackArgs = [Domain, Addr, Type, SnmpInfo, DefData], handle_invalid_result(handle_agent, CallbackArgs, T, E) end. @@ -2215,50 +2230,51 @@ ensure_present([{Key, _Val} = Elem|Ensure], Config) -> %% Retrieve user info for this agent. %% If this is an unknown agent, then use the default user -handle_snmp_trap(#trappdu{enterprise = Enteprise, - generic_trap = Generic, - specific_trap = Spec, - time_stamp = Timestamp, - varbinds = Varbinds} = Trap, - Addr, Port, State) -> - - ?vtrace("handle_snmp_trap [trappdu] -> entry with" - "~n Addr: ~p" - "~n Port: ~p" - "~n Trap: ~p", [Addr, Port, Trap]), +handle_snmp_trap( + #trappdu{enterprise = Enteprise, + generic_trap = Generic, + specific_trap = Spec, + time_stamp = Timestamp, + varbinds = Varbinds} = Trap, Domain, Addr, State) -> + + ?vtrace("handle_snmp_trap [trappdu] -> entry with~n" + " Domain: ~p~n" + " Addr: ~p~n" + " Trap: ~p", [Domain, Addr, Trap]), Varbinds2 = fix_vbs_BITS(Varbinds), SnmpTrapInfo = {Enteprise, Generic, Spec, Timestamp, Varbinds2}, - do_handle_snmp_trap(SnmpTrapInfo, Addr, Port, State); + do_handle_snmp_trap(SnmpTrapInfo, Domain, Addr, State); handle_snmp_trap(#pdu{error_status = EStatus, error_index = EIndex, varbinds = Varbinds} = Trap, - Addr, Port, State) -> + Domain, Addr, State) -> - ?vtrace("handle_snmp_trap [pdu] -> entry with" - "~n Addr: ~p" - "~n Port: ~p" - "~n Trap: ~p", [Addr, Port, Trap]), + ?vtrace("handle_snmp_trap [pdu] -> entry with~n" + " Domain: ~p~n" + " Addr: ~p~n" + " Trap: ~p", [Domain, Addr, Trap]), Varbinds2 = fix_vbs_BITS(Varbinds), SnmpTrapInfo = {EStatus, EIndex, Varbinds2}, - do_handle_snmp_trap(SnmpTrapInfo, Addr, Port, State); + do_handle_snmp_trap(SnmpTrapInfo, Domain, Addr, State); -handle_snmp_trap(CrapTrap, Addr, Port, _State) -> +handle_snmp_trap(CrapTrap, Domain, Addr, _State) -> error_msg("received crap (snmp) trap from ~w:~w =>" - "~p", [Addr, Port, CrapTrap]), + "~p", [Domain, Addr, CrapTrap]), ok. -do_handle_snmp_trap(SnmpTrapInfo, Addr, Port, State) -> - case snmpm_config:get_agent_user_info(Addr, Port) of +do_handle_snmp_trap(SnmpTrapInfo, Domain, Addr, State) -> + case snmpm_config:get_agent_user_info(Domain, Addr) of {ok, UserId, Target, RegType} -> ?vtrace("handle_snmp_trap -> found user: ~p", [UserId]), case snmpm_config:user_info(UserId) of {ok, Mod, Data} -> - handle_trap(UserId, Mod, - RegType, Target, Addr, Port, - SnmpTrapInfo, Data, State); + handle_trap( + UserId, Mod, + RegType, Target, Domain, Addr, + SnmpTrapInfo, Data, State); Error1 -> %% User no longer exists, unregister agent @@ -2270,66 +2286,72 @@ do_handle_snmp_trap(SnmpTrapInfo, Addr, Port, State) -> %% Try use the default user case snmpm_config:user_info() of {ok, DefUserId, DefMod, DefData} -> - handle_agent(DefUserId, DefMod, - Addr, Port, - trap, ignore, - SnmpTrapInfo, DefData, State); + handle_agent( + DefUserId, DefMod, + Domain, Addr, + trap, ignore, + SnmpTrapInfo, DefData, State); Error2 -> - error_msg("failed retreiving the default " - "user info handling report from " - "~p <~p,~p>: ~n~w~n~w", - [Target, Addr, Port, - Error2, SnmpTrapInfo]) + error_msg( + "failed retreiving the default " + "user info handling report from " + "~p <~p,~p>: ~n~w~n~w", + [Target, Domain, Addr, + Error2, SnmpTrapInfo]) end; Error3 -> %% Failed unregister agent, %% now its getting messy... - warning_msg("failed unregister agent ~p <~p,~p> " - "belonging to non-existing " - "user ~p, handling trap: " - "~n Error: ~w" - "~n Trap info: ~w", - [Target, Addr, Port, UserId, - Error3, SnmpTrapInfo]) + warning_msg( + "failed unregister agent ~p <~p,~p> " + "belonging to non-existing " + "user ~p, handling trap: " + "~n Error: ~w" + "~n Trap info: ~w", + [Target, Domain, Addr, UserId, + Error3, SnmpTrapInfo]) end end; Error4 -> %% Unknown agent, pass it on to the default user ?vlog("[trap] failed retreiving user id for agent <~p,~p>: " - "~n ~p", [Addr, Port, Error4]), + "~n ~p", [Domain, Addr, Error4]), case snmpm_config:user_info() of {ok, DefUserId, DefMod, DefData} -> - handle_agent(DefUserId, DefMod, - Addr, Port, - trap, ignore, - SnmpTrapInfo, DefData, State); + handle_agent( + DefUserId, DefMod, + Domain, Addr, + trap, ignore, + SnmpTrapInfo, DefData, State); Error5 -> - error_msg("failed retreiving " - "the default user info handling trap from " - "<~p,~p>: ~n~w~n~w", - [Addr, Port, Error5, SnmpTrapInfo]) + error_msg( + "failed retreiving " + "the default user info handling trap from " + "<~p,~p>: ~n~w~n~w", + [Domain, Addr, Error5, SnmpTrapInfo]) end end, ok. -handle_trap(UserId, Mod, - RegType, Target, Addr, Port, SnmpTrapInfo, Data, State) -> +handle_trap( + UserId, Mod, RegType, Target, Domain, Addr, SnmpTrapInfo, Data, State) -> ?vtrace("handle_trap -> entry with" "~n UserId: ~p" "~n Mod: ~p", [UserId, Mod]), F = fun() -> - do_handle_trap(UserId, Mod, - RegType, Target, Addr, Port, - SnmpTrapInfo, Data, State) + do_handle_trap( + UserId, Mod, + RegType, Target, Domain, Addr, + SnmpTrapInfo, Data, State) end, handle_callback(F), ok. -do_handle_trap(UserId, Mod, - RegType, Target, Addr, Port, SnmpTrapInfo, Data, _State) -> +do_handle_trap( + UserId, Mod, RegType, Target, Domain, Addr, SnmpTrapInfo, Data, _State) -> ?vdebug("do_handle_trap -> entry with" "~n UserId: ~p", [UserId]), {HandleTrap, CallbackArgs} = @@ -2338,8 +2360,9 @@ do_handle_trap(UserId, Mod, {fun() -> Mod:handle_trap(Target, SnmpTrapInfo, Data) end, [Target, SnmpTrapInfo, Data]}; addr_port -> - {fun() -> Mod:handle_trap(Addr, Port, SnmpTrapInfo, Data) end, - [Addr, Port, SnmpTrapInfo, Data]} + {Ip, Port} = Addr, + {fun() -> Mod:handle_trap(Ip, Port, SnmpTrapInfo, Data) end, + [Ip, Port, SnmpTrapInfo, Data]} end, try HandleTrap() of @@ -2347,9 +2370,10 @@ do_handle_trap(UserId, Mod, ?vtrace("do_handle_trap -> register: " "~n UserId2: ~p" "~n Config: ~p", [UserId2, Config]), - Target2 = mk_target_name(Addr, Port, Config), - Config2 = [{reg_type, target_name}, - {address, Addr}, {port, Port} | Config], + Target2 = mk_target_name(Domain, Addr, Config), + Config2 = + [{reg_type, target_name}, + {tdomain, Domain}, {taddress, Addr} | Config], case snmpm_config:register_agent(UserId2, Target2, Config2) of ok -> ok; @@ -2357,7 +2381,7 @@ do_handle_trap(UserId, Mod, error_msg("failed registering agent " "handling trap " "<~p,~p>: ~n~w", - [Addr, Port, Reason]), + [Domain, Addr, Reason]), ok end; {register, UserId2, Target2, Config} -> @@ -2375,20 +2399,19 @@ do_handle_trap(UserId, Mod, error_msg("failed registering agent " "handling trap " "~p <~p,~p>: ~n~w", - [Target2, Addr, Port, Reason]), + [Target2, Domain, Addr, Reason]), reply end; unregister -> ?vtrace("do_handle_trap -> unregister", []), - case snmpm_config:unregister_agent(UserId, - Addr, Port) of + case snmpm_config:unregister_agent(UserId, Domain, Addr) of ok -> ok; {error, Reason} -> error_msg("failed unregistering agent " "handling trap " "<~p,~p>: ~n~w", - [Addr, Port, Reason]), + [Domain, Addr, Reason]), ok end; ignore -> @@ -2405,28 +2428,30 @@ do_handle_trap(UserId, Mod, end. -handle_snmp_inform(Ref, - #pdu{error_status = EStatus, - error_index = EIndex, - varbinds = Varbinds} = Pdu, Addr, Port, State) -> +handle_snmp_inform( + Ref, + #pdu{error_status = EStatus, + error_index = EIndex, + varbinds = Varbinds} = Pdu, Domain, Addr, State) -> - ?vtrace("handle_snmp_inform -> entry with" - "~n Addr: ~p" - "~n Port: ~p" - "~n Pdu: ~p", [Addr, Port, Pdu]), + ?vtrace("handle_snmp_inform -> entry with~n" + " Domain: ~p~n" + " Addr: ~p~n" + " Pdu: ~p", [Domain, Addr, Pdu]), Varbinds2 = fix_vbs_BITS(Varbinds), SnmpInform = {EStatus, EIndex, Varbinds2}, - case snmpm_config:get_agent_user_info(Addr, Port) of + case snmpm_config:get_agent_user_info(Domain, Addr) of {ok, UserId, Target, RegType} -> case snmpm_config:user_info(UserId) of {ok, Mod, Data} -> ?vdebug("[inform] callback handle_inform with: " "~n UserId: ~p" "~n Mod: ~p", [UserId, Mod]), - handle_inform(UserId, Mod, Ref, - RegType, Target, Addr, Port, - SnmpInform, Data, State); + handle_inform( + UserId, Mod, Ref, + RegType, Target, Domain, Addr, + SnmpInform, Data, State); Error1 -> %% User no longer exists, unregister agent case snmpm_config:unregister_agent(UserId, Target) of @@ -2437,15 +2462,16 @@ handle_snmp_inform(Ref, "~n ~p", [UserId, Error1]), case snmpm_config:user_info() of {ok, DefUserId, DefMod, DefData} -> - handle_agent(DefUserId, DefMod, - Addr, Port, - inform, Ref, - SnmpInform, DefData, State); + handle_agent( + DefUserId, DefMod, + Domain, Addr, + inform, Ref, + SnmpInform, DefData, State); Error2 -> error_msg("failed retreiving the default " "user info handling inform from " "~p <~p,~p>: ~n~w~n~w", - [Target, Addr, Port, + [Target, Domain, Addr, Error2, Pdu]) end; Error3 -> @@ -2456,7 +2482,7 @@ handle_snmp_inform(Ref, "user ~p, handling inform: " "~n Error: ~w" "~n Pdu: ~w", - [Target, Addr, Port, UserId, + [Target, Domain, Addr, UserId, Error3, Pdu]) end end; @@ -2464,42 +2490,46 @@ handle_snmp_inform(Ref, Error4 -> %% Unknown agent, pass it on to the default user ?vlog("[inform] failed retreiving user id for agent <~p,~p>: " - "~n ~p", [Addr, Port, Error4]), + "~n ~p", [Domain, Addr, Error4]), case snmpm_config:user_info() of {ok, DefUserId, DefMod, DefData} -> - handle_agent(DefUserId, DefMod, - Addr, Port, - inform, Ref, - SnmpInform, DefData, State); + handle_agent( + DefUserId, DefMod, + Domain, Addr, + inform, Ref, + SnmpInform, DefData, State); Error5 -> error_msg("failed retreiving " "the default user info handling inform from " "<~p,~p>: ~n~w~n~w", - [Addr, Port, Error5, Pdu]) + [Domain, Addr, Error5, Pdu]) end end, ok; -handle_snmp_inform(_Ref, CrapInform, Addr, Port, _State) -> +handle_snmp_inform(_Ref, CrapInform, Domain, Addr, _State) -> error_msg("received crap (snmp) inform from ~w:~w =>" - "~p", [Addr, Port, CrapInform]), + "~p", [Domain, Addr, CrapInform]), ok. -handle_inform(UserId, Mod, Ref, - RegType, Target, Addr, Port, SnmpInform, Data, State) -> +handle_inform( + UserId, Mod, Ref, + RegType, Target, Domain, Addr, SnmpInform, Data, State) -> ?vtrace("handle_inform -> entry with" "~n UserId: ~p" "~n Mod: ~p", [UserId, Mod]), F = fun() -> - do_handle_inform(UserId, Mod, Ref, - RegType, Target, Addr, Port, SnmpInform, - Data, State) + do_handle_inform( + UserId, Mod, Ref, + RegType, Target, Domain, Addr, SnmpInform, + Data, State) end, handle_callback(F), ok. -do_handle_inform(UserId, Mod, Ref, - RegType, Target, Addr, Port, SnmpInform, Data, State) -> +do_handle_inform( + UserId, Mod, Ref, + RegType, Target, Domain, Addr, SnmpInform, Data, State) -> ?vdebug("do_handle_inform -> entry with" "~n UserId: ~p", [UserId]), {HandleInform, CallbackArgs} = @@ -2508,8 +2538,9 @@ do_handle_inform(UserId, Mod, Ref, {fun() -> Mod:handle_inform(Target, SnmpInform, Data) end, [Target, SnmpInform, Data]}; addr_port -> - {fun() -> Mod:handle_inform(Addr, Port, SnmpInform, Data) end, - [Addr, Port, SnmpInform, Data]} + {Ip, Port} = Addr, + {fun() -> Mod:handle_inform(Ip, Port, SnmpInform, Data) end, + [Ip, Port, SnmpInform, Data]} end, Rep = @@ -2520,9 +2551,11 @@ do_handle_inform(UserId, Mod, Ref, "~n Config: ~p", [UserId2, Config]), %% The only user which would do this is the %% default user - Target2 = mk_target_name(Addr, Port, Config), - Config2 = [{reg_type, target_name}, - {address, Addr}, {port, Port} | Config], + Target2 = mk_target_name(Domain, Addr, Config), + Config2 = + [{reg_type, target_name} | + ensure_present( + [{tdomain, Domain}, {taddress, Addr}], Config)], case snmpm_config:register_agent(UserId2, Target2, Config2) of ok -> reply; @@ -2530,7 +2563,7 @@ do_handle_inform(UserId, Mod, Ref, error_msg("failed registering agent " "handling inform " "~p <~p,~p>: ~n~w", - [Target2, Addr, Port, Reason]), + [Target2, Domain, Addr, Reason]), reply end; @@ -2549,21 +2582,21 @@ do_handle_inform(UserId, Mod, Ref, error_msg("failed registering agent " "handling inform " "~p <~p,~p>: ~n~w", - [Target2, Addr, Port, Reason]), + [Target2, Domain, Addr, Reason]), reply end; unregister -> ?vtrace("do_handle_inform -> unregister", []), - case snmpm_config:unregister_agent(UserId, - Addr, Port) of + case snmpm_config:unregister_agent( + UserId, Domain, Addr) of ok -> reply; {error, Reason} -> error_msg("failed unregistering agent " "handling inform " "<~p,~p>: ~n~w", - [Addr, Port, Reason]), + [Domain, Addr, Reason]), reply end; @@ -2576,8 +2609,8 @@ do_handle_inform(UserId, Mod, Ref, reply; InvalidResult -> - handle_invalid_result(handle_inform, CallbackArgs, - InvalidResult), + handle_invalid_result( + handle_inform, CallbackArgs, InvalidResult), reply catch @@ -2586,31 +2619,34 @@ do_handle_inform(UserId, Mod, Ref, reply end, - handle_inform_response(Rep, Ref, Addr, Port, State), + handle_inform_response(Rep, Ref, Domain, Addr, State), ok. -handle_inform_response(_, ignore, _Addr, _Port, _State) -> +handle_inform_response(_, ignore, _Domain, _Addr, _State) -> ignore; -handle_inform_response(no_reply, _Ref, _Addr, _Port, _State) -> +handle_inform_response(no_reply, _Ref, _Domain, _Addr, _State) -> no_reply; -handle_inform_response(_, Ref, Addr, Port, - #state{net_if = Pid, net_if_mod = Mod}) -> +handle_inform_response( + _, Ref, Domain, Addr, + #state{net_if = Pid, net_if_mod = Mod}) -> ?vdebug("handle_inform -> response", []), - (catch Mod:inform_response(Pid, Ref, Addr, Port)). + (catch Mod:inform_response(Pid, Ref, Domain, Addr)). -handle_snmp_report(#pdu{error_status = EStatus, - error_index = EIndex, - varbinds = Varbinds} = Pdu, Addr, Port, State) -> +handle_snmp_report( + #pdu{error_status = EStatus, + error_index = EIndex, + varbinds = Varbinds} = Pdu, + Domain, Addr, State) -> - ?vtrace("handle_snmp_report -> entry with" - "~n Addr: ~p" - "~n Port: ~p" - "~n Pdu: ~p", [Addr, Port, Pdu]), + ?vtrace("handle_snmp_report -> entry with~n" + " Domain: ~p~n" + " Addr: ~p~n" + " Pdu: ~p", [Domain, Addr, Pdu]), Varbinds2 = fix_vbs_BITS(Varbinds), SnmpReport = {EStatus, EIndex, Varbinds2}, - case snmpm_config:get_agent_user_info(Addr, Port) of + case snmpm_config:get_agent_user_info(Domain, Addr) of {ok, UserId, Target, RegType} -> case snmpm_config:user_info(UserId) of {ok, Mod, Data} -> @@ -2620,7 +2656,7 @@ handle_snmp_report(#pdu{error_status = EStatus, "~n ~p" "~n ~p", [UserId, Mod, Target, SnmpReport]), handle_report(UserId, Mod, - RegType, Target, Addr, Port, + RegType, Target, Domain, Addr, SnmpReport, Data, State); Error1 -> %% User no longer exists, unregister agent @@ -2633,7 +2669,7 @@ handle_snmp_report(#pdu{error_status = EStatus, case snmpm_config:user_info() of {ok, DefUserId, DefMod, DefData} -> handle_agent(DefUserId, DefMod, - Addr, Port, + Domain, Addr, report, ignore, SnmpReport, DefData, State); @@ -2641,7 +2677,7 @@ handle_snmp_report(#pdu{error_status = EStatus, error_msg("failed retreiving the default " "user info handling report from " "~p <~p,~p>: ~n~w~n~w", - [Target, Addr, Port, + [Target, Domain, Addr, Error2, Pdu]) end; Error3 -> @@ -2652,7 +2688,7 @@ handle_snmp_report(#pdu{error_status = EStatus, "user ~p, handling report: " "~n Error: ~w" "~n Report: ~w", - [Target, Addr, Port, UserId, + [Target, Domain, Addr, UserId, Error3, Pdu]) end end; @@ -2660,25 +2696,25 @@ handle_snmp_report(#pdu{error_status = EStatus, Error4 -> %% Unknown agent, pass it on to the default user ?vlog("[report] failed retreiving user id for agent <~p,~p>: " - "~n ~p", [Addr, Port, Error4]), + "~n ~p", [Domain, Addr, Error4]), case snmpm_config:user_info() of {ok, DefUserId, DefMod, DefData} -> handle_agent(DefUserId, DefMod, - Addr, Port, + Domain, Addr, report, ignore, SnmpReport, DefData, State); Error5 -> error_msg("failed retreiving " "the default user info handling report from " "<~p,~p>: ~n~w~n~w", - [Addr, Port, Error5, Pdu]) + [Domain, Addr, Error5, Pdu]) end end, ok; -handle_snmp_report(CrapReport, Addr, Port, _State) -> +handle_snmp_report(CrapReport, Domain, Addr, _State) -> error_msg("received crap (snmp) report from ~w:~w =>" - "~p", [Addr, Port, CrapReport]), + "~p", [Domain, Addr, CrapReport]), ok. %% This could be from a failed get-request, so we might have a user @@ -2686,20 +2722,20 @@ handle_snmp_report(CrapReport, Addr, Port, _State) -> %% get-response (except for tha data which is different). Otherwise, %% we handle it as an error (reported via the handle_error callback %% function). -handle_snmp_report(ReqId, - #pdu{error_status = EStatus, - error_index = EIndex, - varbinds = Varbinds} = Pdu, - {ReportReason, Info} = Rep, - Addr, Port, State) - when is_integer(ReqId) -> - - ?vtrace("handle_snmp_report -> entry with" - "~n Addr: ~p" - "~n Port: ~p" - "~n ReqId: ~p" - "~n Rep: ~p" - "~n Pdu: ~p", [Addr, Port, ReqId, Rep, Pdu]), +handle_snmp_report( + ReqId, + #pdu{error_status = EStatus, + error_index = EIndex, + varbinds = Varbinds} = Pdu, + {ReportReason, Info} = Rep, + Domain, Addr, State) when is_integer(ReqId) -> + + ?vtrace("handle_snmp_report -> entry with~n" + " Domain: ~p~n" + " Addr: ~p~n" + " ReqId: ~p~n" + " Rep: ~p~n" + " Pdu: ~p", [Domain, Addr, ReqId, Rep, Pdu]), Varbinds2 = fix_vbs_BITS(Varbinds), SnmpReport = {EStatus, EIndex, Varbinds2}, @@ -2744,7 +2780,7 @@ handle_snmp_report(ReqId, %% Either not a sync request or no such request. Either %% way, this is error info, so handle it as such. - case snmpm_config:get_agent_user_id(Addr, Port) of + case snmpm_config:get_agent_user_id(Domain, Addr) of {ok, UserId} -> case snmpm_config:user_info(UserId) of {ok, Mod, Data} -> @@ -2768,7 +2804,7 @@ handle_snmp_report(ReqId, "default user " "info handling report from " "<~p,~p>: ~n~w~n~w~n~w", - [Addr, Port, Error, + [Domain, Addr, Error, ReqId, Reason]) end end; @@ -2776,7 +2812,7 @@ handle_snmp_report(ReqId, %% Unknown agent, pass it on to the default user ?vlog("[report] failed retreiving user id for " "agent <~p,~p>: " - "~n ~p", [Addr, Port, Error]), + "~n ~p", [Domain, Addr, Error]), case snmpm_config:user_info() of {ok, DefUserId, DefMod, DefData} -> handle_error(DefUserId, DefMod, Reason, ReqId, @@ -2786,32 +2822,36 @@ handle_snmp_report(ReqId, "the default user info handling " "report from " "<~p,~p>: ~n~w~n~w~n~w", - [Addr, Port, Error, ReqId, Reason]) + [Domain, Addr, Error, ReqId, Reason]) end end end, ok; -handle_snmp_report(CrapReqId, CrapReport, CrapInfo, Addr, Port, _State) -> - error_msg("received crap (snmp) report from ~w:~w =>" - "~n~p~n~p~n~p", [Addr, Port, CrapReqId, CrapReport, CrapInfo]), +handle_snmp_report(CrapReqId, CrapReport, CrapInfo, Domain, Addr, _State) -> + error_msg( + "received crap (snmp) report from ~w:~w =>" + "~n~p~n~p~n~p", + [Domain, Addr, CrapReqId, CrapReport, CrapInfo]), ok. -handle_report(UserId, Mod, RegType, Target, Addr, Port, +handle_report(UserId, Mod, RegType, Target, Domain, Addr, SnmpReport, Data, State) -> ?vtrace("handle_report -> entry with" "~n UserId: ~p" "~n Mod: ~p", [UserId, Mod]), F = fun() -> - do_handle_report(UserId, Mod, RegType, Target, Addr, Port, - SnmpReport, Data, State) + do_handle_report( + UserId, Mod, RegType, Target, Domain, Addr, + SnmpReport, Data, State) end, handle_callback(F), ok. -do_handle_report(UserId, Mod, - RegType, Target, Addr, Port, SnmpReport, Data, _State) -> +do_handle_report( + UserId, Mod, RegType, Target, Domain, Addr, + SnmpReport, Data, _State) -> ?vdebug("do_handle_report -> entry with" "~n UserId: ~p", [UserId]), {HandleReport, CallbackArgs} = @@ -2820,8 +2860,9 @@ do_handle_report(UserId, Mod, {fun() -> Mod:handle_report(Target, SnmpReport, Data) end, [Target, SnmpReport, Data]}; addr_port -> - {fun() -> Mod:handle_report(Addr, Port, SnmpReport, Data) end, - [Addr, Port, SnmpReport, Data]} + {Ip, Port} = Addr, + {fun() -> Mod:handle_report(Ip, Port, SnmpReport, Data) end, + [Ip, Port, SnmpReport, Data]} end, try HandleReport() of @@ -2831,17 +2872,18 @@ do_handle_report(UserId, Mod, "~n Config: ~p", [UserId2, Config]), %% The only user which would do this is the %% default user - Target2 = mk_target_name(Addr, Port, Config), - Config2 = [{reg_type, target_name}, - {address, Addr}, {port, Port} | Config], + Target2 = mk_target_name(Domain, Addr, Config), + Config2 = + [{reg_type, target_name}, + {tdomain, Domain}, {taddress, Addr} | Config], case snmpm_config:register_agent(UserId2, Target2, Config2) of ok -> ok; {error, Reason} -> error_msg("failed registering agent " "handling report " - "<~p,~p>: ~n~w", - [Addr, Port, Reason]), + "<~p,~p>: ~n~w", + [Domain, Addr, Reason]), ok end; @@ -2860,21 +2902,20 @@ do_handle_report(UserId, Mod, error_msg("failed registering agent " "handling report " "~p <~p,~p>: ~n~w", - [Target2, Addr, Port, Reason]), + [Target2, Domain, Addr, Reason]), reply end; unregister -> ?vtrace("do_handle_trap -> unregister", []), - case snmpm_config:unregister_agent(UserId, - Addr, Port) of + case snmpm_config:unregister_agent(UserId, Domain, Addr) of ok -> ok; {error, Reason} -> error_msg("failed unregistering agent " "handling report " "<~p,~p>: ~n~w", - [Addr, Port, Reason]), + [Domain, Addr, Reason]), ok end; @@ -3012,50 +3053,49 @@ do_gc(Key, Now) -> %% %%---------------------------------------------------------------------- -send_get_request(Oids, Vsn, MsgData, Domain, Addr, Port, ExtraInfo, +send_get_request(Oids, Vsn, MsgData, Domain, Addr, ExtraInfo, #state{net_if = NetIf, net_if_mod = Mod, mini_mib = MiniMIB}) -> Pdu = make_pdu(get, Oids, MiniMIB), - ?vtrace("send_get_request -> send get-request:" - "~n Mod: ~p" - "~n NetIf: ~p" - "~n Pdu: ~p" - "~n Vsn: ~p" - "~n MsgData: ~p" - "~n Domain: ~p" - "~n Addr: ~p" - "~n Port: ~p", - [Mod, NetIf, Pdu, Vsn, MsgData, Domain, Addr, Port]), + ?vtrace("send_get_request -> send get-request:~n" + " Mod: ~p~n" + " NetIf: ~p~n" + " Pdu: ~p~n" + " Vsn: ~p~n" + " MsgData: ~p~n" + " Domain: ~p~n" + " Addr: ~p", + [Mod, NetIf, Pdu, Vsn, MsgData, Domain, Addr]), Res = (catch Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, - Domain, Addr, Port, ExtraInfo)), + Domain, Addr, ExtraInfo)), ?vtrace("send_get_request -> send result:" "~n ~p", [Res]), Pdu#pdu.request_id. -send_get_next_request(Oids, Vsn, MsgData, Domain, Addr, Port, ExtraInfo, +send_get_next_request(Oids, Vsn, MsgData, Domain, Addr, ExtraInfo, #state{mini_mib = MiniMIB, net_if = NetIf, net_if_mod = Mod}) -> Pdu = make_pdu(get_next, Oids, MiniMIB), - Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo), + Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Domain, Addr, ExtraInfo), Pdu#pdu.request_id. -send_get_bulk_request(Oids, Vsn, MsgData, Domain, Addr, Port, +send_get_bulk_request(Oids, Vsn, MsgData, Domain, Addr, NonRep, MaxRep, ExtraInfo, #state{mini_mib = MiniMIB, net_if = NetIf, net_if_mod = Mod}) -> Pdu = make_pdu(bulk, {NonRep, MaxRep, Oids}, MiniMIB), - Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo), + Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Domain, Addr, ExtraInfo), Pdu#pdu.request_id. -send_set_request(VarsAndVals, Vsn, MsgData, Domain, Addr, Port, ExtraInfo, +send_set_request(VarsAndVals, Vsn, MsgData, Domain, Addr, ExtraInfo, #state{mini_mib = MiniMIB, net_if = NetIf, net_if_mod = Mod}) -> Pdu = make_pdu(set, VarsAndVals, MiniMIB), - Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Domain, Addr, Port, ExtraInfo), + Mod:send_pdu(NetIf, Pdu, Vsn, MsgData, Domain, Addr, ExtraInfo), Pdu#pdu.request_id. %% send_discovery(Vsn, MsgData, Addr, Port, ExtraInfo, @@ -3291,10 +3331,9 @@ agent_data(TargetName, SendOpts) -> {Comm, SecModel} end, Domain = agent_data_item(tdomain, TargetName), - Addr = agent_data_item(address, TargetName), - Port = agent_data_item(port, TargetName), + Addr = agent_data_item(taddress, TargetName), RegType = agent_data_item(reg_type, TargetName), - {ok, RegType, Domain, Addr, Port, version(Version), MsgData}; + {ok, RegType, Domain, Addr, version(Version), MsgData}; Error -> Error end. @@ -3440,9 +3479,9 @@ maybe_demonitor(MonRef) -> t() -> {A,B,C} = erlang:now(), A*1000000000+B*1000+(C div 1000). - -mk_target_name(Addr, Port, Config) -> - snmpm_config:mk_target_name(Addr, Port, Config). + +mk_target_name(Domain, Addr, Config) -> + snmpm_config:mk_target_name(Domain, Addr, Config). default_agent_config() -> case snmpm_config:agent_info() of diff --git a/lib/snmp/src/manager/snmpm_user.erl b/lib/snmp/src/manager/snmpm_user.erl index e6b0b6943e..8e5a874f77 100644 --- a/lib/snmp/src/manager/snmpm_user.erl +++ b/lib/snmp/src/manager/snmpm_user.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The 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,20 +39,25 @@ %% *** handle_error *** %% An "asynchronous" error has been detected --callback handle_error(ReqId :: integer(), - Reason :: {unexpected_pdu, SnmpInfo :: snmp_gen_info()} | - {invalid_sec_info, SecInfo :: term(), SnmpInfo :: snmp_gen_info()} | - {empty_message, Addr :: ip_address(), Port :: port_number()} | - term(), - UserData :: term()) -> +-callback handle_error( + ReqId :: integer(), + Reason :: {unexpected_pdu, SnmpInfo :: snmp_gen_info()} | + {invalid_sec_info, + SecInfo :: term(), + SnmpInfo :: snmp_gen_info()} | + {empty_message, + TransportDomain :: atom(), + {Addr :: ip_address(), Port :: port_number()}} | + term(), + UserData :: term()) -> snmp:void(). %% *** handle_agent *** %% A message was received from an unknown agent --callback handle_agent(Addr :: term(), - Port :: pos_integer(), +-callback handle_agent(Domain :: atom(), + Address :: term(), Type :: pdu | trap | inform | report, SnmpInfo :: snmp_gen_info() | snmp_v1_trap_info(), UserData :: term()) -> diff --git a/lib/snmp/src/manager/snmpm_user_default.erl b/lib/snmp/src/manager/snmpm_user_default.erl index 015198cb76..b827713f27 100644 --- a/lib/snmp/src/manager/snmpm_user_default.erl +++ b/lib/snmp/src/manager/snmpm_user_default.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -36,13 +36,13 @@ handle_error(ReqId, Reason, UserData) -> ignore. -handle_agent(Addr, Port, Type, SnmpInfo, UserData) -> - info("received handle_agent:" - "~n Addr: ~p" - "~n Port: ~p" - "~n Type: ~p" - "~n SnmpInfo: ~p" - "~n UserData: ~p", [Addr, Port, Type, SnmpInfo, UserData]), +handle_agent(Domain, Address, Type, SnmpInfo, UserData) -> + info("received handle_agent:~n" + " Domain: ~p~n" + " Address: ~p~n" + " Type: ~p~n" + " SnmpInfo: ~p~n" + " UserData: ~p", [Domain, Address, Type, SnmpInfo, UserData]), ignore. diff --git a/lib/snmp/src/misc/snmp_conf.erl b/lib/snmp/src/misc/snmp_conf.erl index 46625989d5..153c8070c2 100644 --- a/lib/snmp/src/misc/snmp_conf.erl +++ b/lib/snmp/src/misc/snmp_conf.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,35 +25,42 @@ %% External exports %% Avoid warning for local function error/1 clashing with autoimported BIF. -compile({no_auto_import,[error/1]}). --export([read_files/2, read/2]). +-export([read_files/2, no_gen/2, no_order/2, no_filter/1, keyorder/4]). +-export([read/2, read/3]). %% Basic (type) check functions -export([check_mandatory/2, check_integer/1, check_integer/2, - + check_string/1, check_string/2, - check_atom/2, + check_atom/2, check_timer/1, - all_domains/0, - check_domain/1, - all_tdomains/0, - check_tdomain/1, - mk_tdomain/1, - which_domain/1, - check_ip/1, check_ip/2, - check_taddress/1, check_taddress/2, - mk_taddress/3, - - check_packet_size/1, + all_domains/0, + check_domain/1, + domain_to_name/1, + all_tdomains/0, + check_tdomain/1, + mk_tdomain/0, mk_tdomain/1, + tdomain_to_family/1, tdomain_to_domain/1, + which_domain/1, + mk_addr_string/1, + check_ip/1, check_ip/2, + check_port/1, +%% ip_port_to_domaddr/2, + check_address/2, check_address/3, + check_taddress/2, + mk_taddress/1, mk_taddress/2, + + check_packet_size/1, check_oid/1, - check_imask/1, check_emask/1, - - check_mp_model/1, - check_sec_model/1, check_sec_model/2, check_sec_model/3, + check_imask/1, check_emask/1, + + check_mp_model/1, + check_sec_model/1, check_sec_model/2, check_sec_model/3, check_sec_level/1, all_integer/1 @@ -70,17 +77,53 @@ -include("snmp_verbosity.hrl"). +-define(is_word(P), (((P) band (bnot 65535)) =:= 0)). +-define(is_word(P0, P1), ((((P0) bor (P1)) band (bnot 255)) =:= 0)). + +mk_word(B0, B1) -> ((B0) bsl 8) bor (B1). +mk_bytes(W) -> [(W) bsr 8,(W) band 255]. + +-define( + is_ipv4_addr(A0, A1, A2, A3), + ((((A0) bor (A1) bor (A2) bor (A3)) band (bnot 255)) =:= 0)). + +-define( + is_ipv6_addr(A0, A1, A2, A3, A4, A5, A6, A7), + ((((A0) bor (A1) bor (A2) bor (A3) bor (A4) bor (A5) bor (A6) bor (A7)) + band (bnot 65535)) =:= 0)). +-define( + is_ipv6_addr( + A0, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13, A14, A15), + ((((A0) bor (A1) bor (A2) bor (A3) bor + (A4) bor (A5) bor (A6) bor (A7) bor + (A8) bor (A9) bor (A10) bor (A11) bor + (A12) bor (A13) bor (A14) bor (A15)) + band (bnot 65535)) =:= 0)). + + %%----------------------------------------------------------------- %% read_files(Dir, Files) -> Configs %% Dir - string() - Full path to the config dir. -%% Files - [{Gen, Filter, Check, FileName}] +%% Files - [{FileName, Gen, Order, Check, Filter}] +%% FileName - string() - Name of the config file. %% Gen - function/2 - In case of failure when reading the config file, %% this function is called to either generate a %% default file or issue the error. -%% Filter - function/1 - Filters all the config entries read from the file -%% Check - function/1 - Check each entry as they are read from the file. -%% FileName - string() - Name of the config file. +%% Returns a generated config list corresponding +%% to the written file. +%% (Dir, Error) -> Configs. +%% Order - function/2 - An ordering function that is used to process +%% the read config entries using lists:sort/2. +%% Returns true if arg 1 compares less than or +%% equal to arg 2, false otherwise. +%% Check - function/2 - Check each entry as they are read from the file. +%% (Entry, State) -> +%% {ok,NewState} | {{ok,NewEntry},NewState} | +%% throw(Error) +%% State =:= 'undefined' the first time. +%% Filter - function/1 - Process all the config entries read from the file +%% (Configs) -> [config_entry()]. %% Configs - [config_entry()] %% config_entry() - term() @@ -89,99 +132,143 @@ read_files(Dir, Files) when is_list(Dir) andalso is_list(Files) -> read_files(_Dir, [], Res) -> lists:reverse(Res); -read_files(Dir, [{Gen, Filter, Check, FileName}|Files], Res) - when is_function(Filter) andalso - is_function(Check) andalso - is_list(FileName) -> - ?vdebug("read_files -> entry with" - "~n FileName: ~p", [FileName]), +read_files(Dir, [{FileName, Gen, Order, Check, Filter}|Files], Res) + when is_list(FileName), + is_function(Gen), + is_function(Order), + is_function(Check), + is_function(Filter) -> + ?vdebug("read_files -> entry with~n" + " FileName: ~p", [FileName]), File = filename:join(Dir, FileName), - case file:read_file_info(File) of - {ok, _} -> - Confs = read(File, Check), - read_files(Dir, Files, [Filter(Confs)|Res]); - {error, R} -> - ?vlog("failed reading file info for ~s: " - "~n ~p", [FileName, R]), - Gen(Dir, R), - read_files(Dir, Files, [Filter([])|Res]) - end. - + Confs = + case file:read_file_info(File) of + {ok,_} -> + read(File, Order, Check); + {error, R} -> + ?vlog("failed reading file info for ~s: ~n" + " ~p", [FileName, R]), + Gen(Dir, R) + end, + read_files(Dir, Files, [Filter(Confs)|Res]). + + + +no_gen(_Dir, _R) -> []. +no_order(_, _) -> true. +no_filter(X) -> X. + +%% Order tuples on element N with Keys first in appearence order. +%% +%% An ordering function (A, B) shall return true iff +%% A is less than or equal to B i.e shall return +%% false iff A is to be ordered after B. +keyorder(N, A, B, _) when element(N, A) == element(N, B) -> + true; +keyorder(N, A, B, [Key | _]) + when tuple_size(A) >= 1, element(N, B) == Key -> + false; +keyorder(N, A, B, [Key | _]) + when element(N, A) == Key, tuple_size(B) >= 1 -> + true; +keyorder(N, A, B, [_ | Keys]) -> + keyorder(N, A, B, Keys); +keyorder(_, A, B, []) when tuple_size(A) >= 1, tuple_size(B) >= 1 -> + %% Do not order other keys + true; +keyorder(N, A, B, sort) -> + %% Order other keys according to standard sort order + element(N, A) =< element(N, B). + + +read(File, Verify) -> + Check = fun (Row, State) -> {Verify(Row), State} end, + read(File, fun no_order/2, Check). %% Ret. Res | exit(Reason) -read(File, Check) when is_function(Check) -> - ?vdebug("read -> entry with" - "~n File: ~p", [File]), - +read(File, Order, Check) when is_function(Order), is_function(Check) -> + ?vdebug("read -> entry with~n" + " File: ~p", [File]), Fd = open_file(File), + read_fd(File, Order, Check, Fd, 1, []). - case loop(Fd, [], Check, 1, File) of - {error, Reason} -> - file:close(Fd), - error(Reason); - {ok, Res} -> - file:close(Fd), - Res +read_fd(File, Order, Check, Fd, StartLine, Res) -> + case do_read(Fd, "", StartLine) of + {ok, Row, EndLine} -> + ?vtrace("read_fd ->~n" + " Row: ~p~n" + " EndLine: ~p", [Row,EndLine]), + read_fd( + File, Order, Check, Fd, EndLine, + [{StartLine, Row, EndLine}|Res]); + {error, Error, EndLine} -> + ?vtrace("read_fd -> read failure:~n" + " Error: ~p~n" + " EndLine: ~p", [Error,EndLine]), + file:close(Fd), + error({failed_reading, File, StartLine, EndLine, Error}); + {eof, _EndLine} -> + Lines = + lists:sort( + fun ({_, RowA, _}, {_, RowB, _}) -> + Order(RowA, RowB) + end, + lists:reverse(Res)), + ?vtrace("read_fd to read_check ->~n" + " Lines: ~p", [Lines]), + read_check(File, Check, Lines, undefined, []) end. -open_file(File) -> - case file:open(File, [read]) of - {ok, Fd} -> - Fd; - {error, Reason} -> - error({failed_open, File, Reason}) +read_check(_, _, [], _, Res) -> + lists:reverse(Res); +read_check(File, Check, [{StartLine, Row, EndLine}|Lines], State, Res) -> + try Check(Row, State) of + {Rows, NewState} when is_list(Rows) -> + ?vtrace("read_check -> ok:~n" + " Rows: ~p~n", [Rows]), + read_check(File, Check, Lines, NewState, Rows ++ Res); + {ok, NewState} -> + ?vtrace("read_check -> ok", []), + read_check(File, Check, Lines, NewState, [Row | Res]); + {{ok, NewRow}, NewState} -> + ?vtrace("read_check -> ok:~n" + " NewRow: ~p~n", [NewRow]), + read_check(File, Check, Lines, NewState, [NewRow | Res]) + catch + {error, Reason} -> + ?vtrace("read_check -> error:~n" + " Reason: ~p", [Reason]), + error({failed_check, File, StartLine, EndLine, Reason}); + Class:Reason -> + Error = {Class,Reason,erlang:get_stacktrace()}, + ?vtrace("read_check -> failure:~n" + " Error: ~p", [Error]), + error({failed_check, File, StartLine, EndLine, Error}) end. -loop(Fd, Res, Check, StartLine, File) -> - case do_read(Fd, "", StartLine) of - {ok, Row, EndLine} -> - ?vtrace("loop -> " - "~n Row: ~p" - "~n EndLine: ~p", [Row, EndLine]), - case (catch Check(Row)) of - ok -> - ?vtrace("loop -> ok", []), - loop(Fd, [Row | Res], Check, EndLine, File); - {ok, NewRow} -> - ?vtrace("loop -> ok: " - "~n NewRow: ~p", [NewRow]), - loop(Fd, [NewRow | Res], Check, EndLine, File); - {error, Reason} -> - ?vtrace("loop -> check error: " - "~n Reason: ~p", [Reason]), - {error, {failed_check, File, StartLine, EndLine, Reason}}; - Error -> - ?vtrace("loop -> check failure: " - "~n Error: ~p", [Error]), - {error, {failed_check, File, StartLine, EndLine, Error}} - end; - {error, EndLine, Error} -> - ?vtrace("loop -> read failure: " - "~n Error: ~p", [Error]), - {error, {failed_reading, File, StartLine, EndLine, Error}}; - eof -> - {ok, Res} +open_file(File) -> + case file:open(File, [read]) of + {ok, Fd} -> + Fd; + {error, Reason} -> + error({failed_open, File, Reason}) end. - do_read(Io, Prompt, StartLine) -> case io:request(Io, {get_until,Prompt,erl_scan,tokens,[StartLine]}) of - {ok, Toks, EndLine} -> - case erl_parse:parse_term(Toks) of - {ok, Term} -> - {ok, Term, EndLine}; - {error, {Line, erl_parse, Error}} -> - {error, Line, {parse_error, Error}} - end; - {error,E,EndLine} -> - {error, EndLine, E}; - {eof, _EndLine} -> - eof; - Other -> - Other + {ok, Toks, EndLine} -> + case erl_parse:parse_term(Toks) of + {ok, Term} -> + {ok, Term, EndLine}; + {error, {Line, erl_parse, Error}} -> + {error, {parse_error, Error}, Line} + end; + Other -> + Other end. + %%----------------------------------------------------------------- @@ -384,7 +471,7 @@ all_tdomains() -> check_tdomain(TDomain) -> SupportedTDomains = [ - ?snmpUDPDomain, + ?snmpUDPDomain, % Legacy ?transportDomainUdpIpv4, ?transportDomainUdpIpv6 ], @@ -404,6 +491,9 @@ check_tdomain(TDomain) -> %% --------- +mk_tdomain() -> + mk_tdomain(snmpUDPDomain). + mk_tdomain(snmpUDPDomain) -> mk_tdomain(transportDomainUdpIpv4); mk_tdomain(transportDomainUdpIpv4) -> @@ -416,40 +506,64 @@ mk_tdomain(BadDomain) -> %% --------- -check_taddress(X) -> - check_taddress(snmpUDPDomain, X). +tdomain_to_family(snmpUDPDomain) -> + inet; +tdomain_to_family(transportDomainUdpIpv4) -> + inet; +tdomain_to_family(transportDomainUdpIpv6) -> + inet6; +tdomain_to_family(?snmpUDPDomain) -> + inet; +tdomain_to_family(?transportDomainUdpIpv4) -> + inet; +tdomain_to_family(?transportDomainUdpIpv6) -> + inet6; +tdomain_to_family(BadDomain) -> + error({bad_domain, BadDomain}). + + +%% --------- + +tdomain_to_domain(?snmpUDPDomain) -> + snmpUDPDomain; +tdomain_to_domain(?transportDomainUdpIpv4) -> + transportDomainUdpIpv4; +tdomain_to_domain(?transportDomainUdpIpv6) -> + transportDomainUdpIpv6; +tdomain_to_domain(BadTDomain) -> + error({bad_tdomain, BadTDomain}). + + +%% --------- check_taddress(?snmpUDPDomain, X) -> check_taddress(transportDomainUdpIpv4, X); check_taddress(snmpUDPDomain, X) -> check_taddress(transportDomainUdpIpv4, X); - +%% check_taddress(?transportDomainUdpIpv4, X) -> check_taddress(transportDomainUdpIpv4, X); -check_taddress(transportDomainUdpIpv4, X) - when is_list(X) andalso (length(X) =:= 6) -> - case (catch all_integer(X)) of - true -> +check_taddress(transportDomainUdpIpv4, X) -> + case X of + [A0,A1,A2,A3,P0,P1] + when ?is_ipv4_addr(A0, A1, A2, A3), ?is_word(P0, P1) -> ok; - false -> + _ -> error({invalid_taddress, X}) end; -check_taddress(transportDomainUdpIpv4, X) -> - error({invalid_taddress, X}); - +%% check_taddress(?transportDomainUdpIpv6, X) -> check_taddress(transportDomainUdpIpv6, X); -check_taddress(transportDomainUdpIpv6, X) - when is_list(X) andalso (length(X) =:= 10) -> - case (catch all_integer(X)) of - true -> +check_taddress(transportDomainUdpIpv6, X) -> + case X of + [A0,A1,A2,A3,A4,A5,A6,A7,P0,P1] + when ?is_ipv6_addr(A0, A1, A2, A3, A4, A5, A6, A7), + ?is_word(P0, P1) -> ok; - false -> + _ -> error({invalid_taddress, X}) end; -check_taddress(transportDomainUdpIpv6, X) -> - error({invalid_taddress, X}); - +%% check_taddress(BadDomain, _X) -> error({invalid_tdomain, BadDomain}). @@ -512,96 +626,359 @@ all_domains() -> transportDomainSctpDns ]. +check_domain(snmpUDPDomain) -> ok; +check_domain(transportDomainUdpIpv4) -> ok; +check_domain(transportDomainUdpIpv6) -> ok; check_domain(Domain) -> - SupportedDomains = - [ - snmpUDPDomain, - transportDomainUdpIpv4, - transportDomainUdpIpv6 - ], - AllDomains = all_domains(), - case lists:member(Domain, SupportedDomains) of + case lists:member(Domain, all_domains()) of true -> - ok; + error({unsupported_domain, Domain}); false -> - case lists:member(Domain, AllDomains) of - true -> - error({unsupported_domain, Domain}); - false -> - error({unknown_domain, Domain}) - end + error({unknown_domain, Domain}) end. - + +domain_to_name(snmpUDPDomain) -> + undefined; +domain_to_name(transportDomainUdpIpv4) -> + udpIpv4; +domain_to_name(transportDomainUdpIpv6) -> + udpIpv6; +domain_to_name(transportDomainUdpIpv4z) -> + udpIpv4z; +domain_to_name(transportDomainUdpIpv6z) -> + udpIpv6z; +domain_to_name(transportDomainTcpIpv4) -> + tcpIpv4; +domain_to_name(transportDomainTcpIpv6) -> + tcpIpv6; +domain_to_name(transportDomainTcpIpv4z) -> + tcpIpv4z; +domain_to_name(transportDomainTcpIpv6z) -> + tcpIpv6z; +domain_to_name(transportDomainSctpIpv4) -> + sctpIpv4; +domain_to_name(transportDomainSctpIpv6) -> + sctpIpv6; +domain_to_name(transportDomainSctpIpv4z) -> + sctpIpv4z; +domain_to_name(transportDomainSctpIpv6z) -> + sctpIpv6z; +domain_to_name(transportDomainLocal) -> + local; +domain_to_name(transportDomainUdpDns) -> + udpDns; +domain_to_name(transportDomainTcpDns) -> + tcpDns; +domain_to_name(transportDomainSctpDns) -> + sctpDns; +domain_to_name(BadDomain) -> + error({bad_domain, BadDomain}). %% --------- -%% The values of Ip and Port has both been checked at this -%% point, so we dont need to do that again. -mk_taddress(snmpUDPDomain, Ip, Port) -> - mk_taddress(transportDomainUdpIpv4, Ip, Port); -mk_taddress(transportDomainUdpIpv4, Ip, Port) when is_list(Ip) -> - Ip ++ [Port div 256, Port rem 256]; -mk_taddress(transportDomainUdpIpv4 = Domain, Ip, Port) when is_tuple(Ip) -> - mk_taddress(Domain, tuple_to_list(Ip), Port); -mk_taddress(transportDomainUdpIpv6, Ip, Port) when is_list(Ip) -> - Ip ++ [Port div 256, Port rem 256]; -mk_taddress(transportDomainUdpIpv6 = Domain, Ip, Port) when is_tuple(Ip) -> - mk_taddress(Domain, tuple_to_list(Ip), Port); +mk_taddress(Address) -> + mk_taddress(snmpUDPDomain, Address). +%% The values of Domain, Ip and Port has both been checked at this +%% point, so we dont need to do that again, but this function is +%% also used on incoming packets from net_if so a little +%% check that net_if does not supply bad arguments is in order. +%% %% These are just for convenience -mk_taddress(?snmpUDPDomain, Ip, Port) -> - mk_taddress(snmpUDPDomain, Ip, Port); -mk_taddress(?transportDomainUdpIpv4, Ip, Port) -> - mk_taddress(transportDomainUdpIpv4, Ip, Port); -mk_taddress(?transportDomainUdpIpv6, Ip, Port) -> - mk_taddress(transportDomainUdpIpv6, Ip, Port); - +mk_taddress(?snmpUDPDomain, Address) -> + mk_taddress(snmpUDPDomain, Address); +mk_taddress(?transportDomainUdpIpv4, Address) -> + mk_taddress(transportDomainUdpIpv4, Address); +mk_taddress(?transportDomainUdpIpv6, Address) -> + mk_taddress(transportDomainUdpIpv6, Address); +%% +mk_taddress(snmpUDPDomain, Address) -> % Legacy + mk_taddress(transportDomainUdpIpv4, Address); +mk_taddress(transportDomainUdpIpv4 = Domain, Address) -> + case Address of + [] -> % Empty mask + []; + {Ip, Port} when tuple_size(Ip) =:= 4, is_integer(Port) -> + tuple_to_list(Ip) ++ mk_bytes(Port); + _ -> + erlang:error(badarg, [Domain,Address]) + end; +mk_taddress(transportDomainUdpIpv6 = Domain, Address) -> + case Address of + [] -> % Empty mask + []; + {{A, B, C, D, E, F, G, H}, Port} -> + [A bsr 8, A band 255, + B bsr 8, B band 255, + C bsr 8, C band 255, + D bsr 8, D band 255, + E bsr 8, E band 255, + F bsr 8, F band 255, + G bsr 8, G band 255, + H bsr 8, H band 255, + Port bsr 8, Port band 255]; + _ -> + erlang:error(badarg, [Domain,Address]) + end; %% Bad domain -mk_taddress(BadDomain, _Ip, _Port) -> +mk_taddress(BadDomain, _) -> error({bad_domain, BadDomain}). - + %% --------- -which_domain(Ip) when is_list(Ip) andalso (length(Ip) =:= 4) -> +%% XXX remove, when net_if handles one socket per transport domain + +which_domain([A0,A1,A2,A3]) + when ?is_ipv4_addr(A0, A1, A2, A3) -> transportDomainUdpIpv4; -which_domain(Ip) when is_tuple(Ip) andalso (size(Ip) =:= 4) -> +which_domain({A0, A1, A2, A3}) + when ?is_ipv4_addr(A0, A1, A2, A3) -> transportDomainUdpIpv4; -which_domain(Ip) when is_list(Ip) andalso (length(Ip) =:= 8) -> +which_domain([A0,A1,A2,A3,A4,A5,A6,A7]) + when ?is_ipv6_addr(A0, A1, A2, A3, A4, A5, A6, A7) -> + transportDomainUdpIpv6; +which_domain([A0,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15]) + when ?is_ipv6_addr( + A0, A1, A2, A3, A4, A5, A6, A7, + A8, A9, A10, A11, A12, A13, A14, A15) -> transportDomainUdpIpv6; -which_domain(Ip) when is_tuple(Ip) andalso (size(Ip) =:= 8) -> +which_domain({A0, A1, A2, A3, A4, A5, A6, A7}) + when ?is_ipv6_addr(A0, A1, A2, A3, A4, A5, A6, A7) -> transportDomainUdpIpv6. - %% --------- +mk_addr_string({Domain, Addr}) when is_atom(Domain) -> + %% XXX There is only code for IP domains here + case check_address_ip(Domain, Addr) of + false -> + case check_address_ip_port(Domain, Addr) of + false -> + error({bad_address, {Domain, Addr}}); + true -> + {IP, Port} = Addr, + mk_addr_string_ntoa(Domain, IP, Port); + {IP, Port} -> + mk_addr_string_ntoa(Domain, IP, Port) + end; + true -> + mk_addr_string_ntoa(Domain, Addr); + IP -> + mk_addr_string_ntoa(Domain, IP) + end; +mk_addr_string({_IP, Port} = Addr) when is_integer(Port) -> + mk_addr_string({snmpUDPDomain, Addr}); +mk_addr_string(Strange) -> + lists:flatten(io_lib:format("~w", [Strange])). + + +mk_addr_string_ntoa({_, _, _, _} = IP) -> + inet:ntoa(IP); +mk_addr_string_ntoa(IP) -> + lists:flatten(io_lib:format("[~s]", [inet:ntoa(IP)])). + +mk_addr_string_ntoa(Domain, IP) -> + case domain_to_name(Domain) of + undefined -> + mk_addr_string_ntoa(IP); + Name -> + lists:flatten( + io_lib:format("~w://~s", [Name, mk_addr_string_ntoa(IP)])) + end. + +mk_addr_string_ntoa(Domain, IP, Port) -> + lists:flatten( + io_lib:format( + "~s:~w", [mk_addr_string_ntoa(Domain, IP), Port])). + +%% --------- + check_ip(X) -> check_ip(snmpUDPDomain, X). -check_ip(snmpUDPDomain, X) -> - check_ip(transportDomainUdpIpv4, X); -check_ip(transportDomainUdpIpv4, X) when is_list(X) andalso (length(X) =:= 4) -> - case (catch all_integer(X)) of - true -> +check_ip(Domain, IP) -> + %% XXX There is only code for IP domains here + case check_address_ip(Domain, IP) of + false -> + error({bad_address, {Domain, IP}}); + true -> ok; - false -> - error({invalid_ip_address, X}) - end; -check_ip(transportDomainUdpIpv4, X) -> - error({invalid_ip_address, X}); + FixedIP -> + {ok, FixedIP} + end. -check_ip(transportDomainUdpIpv6, X) when is_list(X) andalso (length(X) =:= 8) -> - case (catch all_integer(X)) of - true -> + +%% --------- + +check_port(Port) when ?is_word(Port) -> + ok; +check_port(Port) -> + error({bad_port, Port}). + +%% ip_port_to_domaddr(IP, Port) when ?is_word(Port) -> +%% %% XXX There is only code for IP domains here +%% case check_address_ip(transportDomainUdpIpv4, IP) of +%% false -> +%% case check_address_ip(transportDomainUdpIpv6, IP) of +%% false -> +%% error({bad_address, {transportDomainUdpIpv4, {IP, Port}}}); +%% true -> +%% {transportDomainUdpIpv6, {IP, Port}}; +%% FixedIP -> +%% {transportDomainUdpIpv6, {FixedIP, Port}} +%% end; +%% true -> +%% {transportDomainUdpIpv4, {IP, Port}}; +%% FixedIP -> +%% {transportDomainUdpIpv4, {FixedIP, Port}} +%% end; +%% ip_port_to_domaddr(IP, Port) -> +%% error({bad_address, {transportDomainUdpIpv4, {IP, Port}}}). + +%% Check a configuration term field from a file to see if it +%% can be fixed to be fed to mk_taddress/2. + +check_address(Domain, Address, DefaultPort) -> + %% If Address does not contain Port or contains Port =:= 0 + %% create an address containing DefaultPort + %% + %% XXX There is only code for IP domains here + case check_address_ip(Domain, Address) of + false -> + case check_address_ip_port(Domain, Address) of + false -> + error({bad_address, {Domain, Address}}); + true -> + case Address of + {IP, 0} -> + {ok, {IP, DefaultPort}}; + _ -> + ok + end; + {FixedIP, 0} -> + {ok, {FixedIP, DefaultPort}}; + FixedAddress -> + {ok, FixedAddress} + end; + true -> + {ok, {Address, DefaultPort}}; + FixedIP -> + {ok, {FixedIP, DefaultPort}} + end. + +check_address(Domain, Address) -> + %% Address has to contain Port + %% + %% XXX There is only code for IP domains here + case check_address_ip_port(Domain, Address) of + false -> + error({bad_address, {Domain, Address}}); + true -> ok; - false -> - error({invalid_ip_address, X}) + FixedAddress -> + {ok, FixedAddress} + end. + +%% -> IP +check_address_ip(Domain, Address) + when Domain =:= snmpUDPDomain; + Domain =:= transportDomainUdpIpv4 -> + case Address of + %% Erlang native format + {A0, A1, A2, A3} + when ?is_ipv4_addr(A0, A1, A2, A3) -> + true; + %% Erlangish format + [A0,A1,A2,A3] + when ?is_ipv4_addr(A0, A1, A2, A3) -> + {A0, A1, A2, A3}; + _ -> + false + end; +check_address_ip(transportDomainUdpIpv6, Address) -> + case Address of + %% Erlang native format + {A0, A1, A2, A3, A4, A5, A6, A7} + when ?is_ipv6_addr(A0, A1, A2, A3, A4, A5, A6, A7) -> + true; + %% Erlangish format + [A0,A1,A2,A3,A4,A5,A6,A7] + when ?is_ipv6_addr(A0, A1, A2, A3, A4, A5, A6, A7) -> + {A0, A1, A2, A3, A4, A5, A6, A7}; + %% SNMP standards format + [A0,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15] + when ?is_ipv6_addr( + A0, A1, A2, A3, A4, A5, A6, A7, + A8, A9, A10, A11, A12, A13, A14, A15) -> + {mk_word(A0, A1), mk_word(A2, A3), + mk_word(A4, A5), mk_word(A6, A7), + mk_word(A8, A9), mk_word(A10, A11), + mk_word(A12, A13), mk_word(A14, A15)}; + _ -> + false end; -check_ip(transportDomainUdpIpv6, X) -> - error({invalid_ip_address, X}); +check_address_ip(BadDomain, _) -> + error({bad_domain, BadDomain}). -check_ip(BadDomain, _X) -> - error({invalid_domain, BadDomain}). +%% -> {IP, Port} +check_address_ip_port(Domain, Address) + when Domain =:= snmpUDPDomain; + Domain =:= transportDomainUdpIpv4 -> + case Address of + {IP, Port} when ?is_word(Port) -> + case check_address_ip(Domain, IP) of + false -> + false; + true -> + true; + FixedIP -> + {FixedIP, Port} + end; + %% SNMP standards format + [A0,A1,A2,A3,P0,P1] + when ?is_ipv4_addr(A0, A1, A2, A3), ?is_word(P0, P1) -> + {{A0, A1, A2, A3}, mk_word(P0, P1)}; + _ -> + false + end; +check_address_ip_port(transportDomainUdpIpv6 = Domain, Address) -> + case Address of + {IP, Port} when ?is_word(Port) -> + case check_address_ip(Domain, IP) of + false -> + false; + true -> + true; + FixedIP -> + {FixedIP, Port} + end; + %% Erlang friendly list format + [A0,A1,A2,A3,A4,A5,A6,A7,P] + when ?is_ipv6_addr(A0, A1, A2, A3, A4, A5, A6, A7), + ?is_word(P) -> + {{A0, A1, A2, A3, A4, A5, A6, A7}, P}; + %% Strange hybrid format with port as bytes + [A0,A1,A2,A3,A4,A5,A6,A7,P0,P1] + when ?is_ipv6_addr(A0, A1, A2, A3, A4, A5, A6, A7), + ?is_word(P0, P1) -> + {{A0, A1, A2, A3, A4, A5, A6, A7}, mk_word(P0, P1)}; + %% SNMP standards format + [A0,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,P0,P1] + when ?is_ipv6_addr( + A0, A1, A2, A3, A4, A5, A6, A7, + A8, A9, A10, A11, A12, A13, A14, A15), + ?is_word(P0, P1) -> + {{mk_word(A0, A1), mk_word(A2, A3), + mk_word(A4, A5), mk_word(A6, A7), + mk_word(A8, A9), mk_word(A10, A11), + mk_word(A12, A13), mk_word(A14, A15)}, + mk_word(P0, P1)}; + _ -> + false + end; +check_address_ip_port(BadDomain, _) -> + error({bad_domain, BadDomain}). diff --git a/lib/snmp/src/misc/snmp_config.erl b/lib/snmp/src/misc/snmp_config.erl index a222f842e5..17dfcd70b4 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-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The 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,24 +26,29 @@ -compile({no_auto_import,[error/1]}). -export([config/0]). --export([write_config_file/4, append_config_file/4, read_config_file/3]). +%%-export([write_config_file/4, append_config_file/4, read_config_file/4]). + +-export([write_config_file/6, append_config_file/6, read_config_file/4]). -export([write_agent_snmp_files/7, write_agent_snmp_files/12, + write_agent_snmp_files/6, write_agent_snmp_files/11, - write_agent_snmp_conf/5, + write_agent_snmp_conf/4, write_agent_snmp_conf/5, write_agent_snmp_context_conf/1, write_agent_snmp_community_conf/1, write_agent_snmp_standard_conf/2, - write_agent_snmp_target_addr_conf/4, - write_agent_snmp_target_addr_conf/6, + write_agent_snmp_target_addr_conf/3, + write_agent_snmp_target_addr_conf/4, + write_agent_snmp_target_addr_conf/5, + write_agent_snmp_target_addr_conf/6, write_agent_snmp_target_params_conf/2, write_agent_snmp_notify_conf/2, write_agent_snmp_usm_conf/5, write_agent_snmp_vacm_conf/3, write_manager_snmp_files/8, - write_manager_snmp_conf/5, - write_manager_snmp_users_conf/2, + write_manager_snmp_conf/4, write_manager_snmp_conf/5, + write_manager_snmp_users_conf/2, write_manager_snmp_agents_conf/2, write_manager_snmp_usm_conf/2 @@ -90,9 +95,9 @@ ]). --export_type([void/0, - verify_config_entry_function/0, - verify_config_function/0, +-export_type([void/0, + order_config_entry_function/0, + check_config_entry_function/0, write_config_function/0]). @@ -567,11 +572,9 @@ config_agent_snmp(Dir, Vsns) -> end, NT end, - case (catch write_agent_snmp_files(Dir, - Vsns, ManagerIP, TrapUdp, - AgentIP, AgentUDP, - SysName, NotifType, SecType, - Passwd, EngineID, MMS)) of + case (catch write_agent_snmp_files( + Dir, Vsns, ManagerIP, TrapUdp, AgentIP, AgentUDP, SysName, + NotifType, SecType, Passwd, EngineID, MMS)) of ok -> i("~n- - - - - - - - - - - - -"), i("Info: 1. SecurityName \"initial\" has noAuthNoPriv read access~n" @@ -1580,35 +1583,63 @@ remove_newline(Str) -> %% File generation %%====================================================================== +write_agent_snmp_files( + Dir, Vsns, Domain, ManagerAddr, AgentAddr, SysName) + when is_list(Dir), + is_list(Vsns), + is_atom(Domain), + is_list(SysName) -> + write_agent_snmp_files( + Dir, Vsns, Domain, ManagerAddr, AgentAddr, SysName, + trap, none, "", "agentEngine", 484). + %%---------------------------------------------------------------------- %% Dir: string() (ex: "../conf/") %% ManagerIP, AgentIP: [int(),int(),int(),int()] %% TrapUdp, AgentUDP: integer() %% SysName: string() %%---------------------------------------------------------------------- -write_agent_snmp_files(Dir, Vsns, ManagerIP, TrapUdp, - AgentIP, AgentUDP, SysName) - when is_list(Dir) andalso - is_list(Vsns) andalso - is_list(ManagerIP) andalso - is_integer(TrapUdp) andalso - is_list(AgentIP) andalso - is_integer(AgentUDP) andalso +write_agent_snmp_files( + Dir, Vsns, ManagerIP, TrapUDP, AgentIP, AgentUDP, SysName) + when is_list(Dir) andalso + is_list(Vsns) andalso + is_list(ManagerIP) andalso + is_integer(TrapUDP) andalso + is_list(AgentIP) andalso + is_integer(AgentUDP) andalso is_list(SysName) -> - write_agent_snmp_files(Dir, Vsns, ManagerIP, TrapUdp, AgentIP, AgentUDP, - SysName, "trap", none, "", "agentEngine", 484). + write_agent_snmp_files( + Dir, Vsns, ManagerIP, TrapUDP, AgentIP, AgentUDP, SysName, + trap, none, "", "agentEngine", 484). %% %% ----- Agent config files generator functions ----- %% -write_agent_snmp_files(Dir, Vsns, ManagerIP, TrapUdp, AgentIP, AgentUDP, - SysName, NotifType, SecType, Passwd, EngineID, MMS) -> +write_agent_snmp_files( + Dir, Vsns, Domain, ManagerAddr, AgentAddr, SysName, + NotifType, SecType, Passwd, EngineID, MMS) -> + write_agent_snmp_conf(Dir, Domain, AgentAddr, EngineID, MMS), + write_agent_snmp_context_conf(Dir), + write_agent_snmp_community_conf(Dir), + write_agent_snmp_standard_conf(Dir, SysName), + write_agent_snmp_target_addr_conf(Dir, Domain, ManagerAddr, Vsns), + write_agent_snmp_target_params_conf(Dir, Vsns), + write_agent_snmp_notify_conf(Dir, NotifType), + write_agent_snmp_usm_conf(Dir, Vsns, EngineID, SecType, Passwd), + write_agent_snmp_vacm_conf(Dir, Vsns, SecType), + ok. + +write_agent_snmp_files( + Dir, Vsns, ManagerIP, TrapUDP, AgentIP, AgentUDP, SysName, + NotifType, SecType, Passwd, EngineID, MMS) -> + Domain = snmp_target_mib:default_domain(), + ManagerAddr = {ManagerIP, TrapUDP}, write_agent_snmp_conf(Dir, AgentIP, AgentUDP, EngineID, MMS), write_agent_snmp_context_conf(Dir), write_agent_snmp_community_conf(Dir), write_agent_snmp_standard_conf(Dir, SysName), - write_agent_snmp_target_addr_conf(Dir, ManagerIP, TrapUdp, Vsns), + write_agent_snmp_target_addr_conf(Dir, Domain, ManagerAddr, Vsns), write_agent_snmp_target_params_conf(Dir, Vsns), write_agent_snmp_notify_conf(Dir, NotifType), write_agent_snmp_usm_conf(Dir, Vsns, EngineID, SecType, Passwd), @@ -1616,11 +1647,40 @@ write_agent_snmp_files(Dir, Vsns, ManagerIP, TrapUdp, AgentIP, AgentUDP, ok. + %% %% ------ [agent] agent.conf ------ %% -write_agent_snmp_conf(Dir, AgentIP, AgentUDP, EngineID, MMS) -> +write_agent_snmp_conf(Dir, Transports, EngineID, MMS) -> + Conf = + [{intAgentTransports, Transports}, + {snmpEngineID, EngineID}, + {snmpEngineMaxMessageSize, MMS}], + do_write_agent_snmp_conf(Dir, Conf). + +write_agent_snmp_conf(Dir, Domain, AgentAddr, EngineID, MMS) + when is_atom(Domain) -> + {AgentIP, AgentUDP} = AgentAddr, + Conf = + [{intAgentTransportDomain, Domain}, + {intAgentUDPPort, AgentUDP}, + {intAgentIpAddress, AgentIP}, + {snmpEngineID, EngineID}, + {snmpEngineMaxMessageSize, MMS}], + do_write_agent_snmp_conf(Dir, Conf); +write_agent_snmp_conf(Dir, AgentIP, AgentUDP, EngineID, MMS) + when is_integer(AgentUDP) -> + Conf = + [{intAgentUDPPort, AgentUDP}, + {intAgentIpAddress, AgentIP}, + {snmpEngineID, EngineID}, + {snmpEngineMaxMessageSize, MMS}], + do_write_agent_snmp_conf(Dir, Conf); +write_agent_snmp_conf(_Dir, Domain, AgentAddr, _EngineID, _MMS) -> + error({bad_address, {Domain, AgentAddr}}). + +do_write_agent_snmp_conf(Dir, Conf) -> Comment = "%% This file defines the Agent local configuration info\n" "%% The data is inserted into the snmpEngine* variables defined\n" @@ -1635,11 +1695,7 @@ write_agent_snmp_conf(Dir, AgentIP, AgentUDP, EngineID, MMS) -> "%% {snmpEngineID, \"agentEngine\"}.\n" "%% {snmpEngineMaxMessageSize, 484}.\n" "%%\n\n", - Hdr = header() ++ Comment, - Conf = [{intAgentUDPPort, AgentUDP}, - {intAgentIpAddress, AgentIP}, - {snmpEngineID, EngineID}, - {snmpEngineMaxMessageSize, MMS}], + Hdr = header() ++ Comment, write_agent_config(Dir, Hdr, Conf). write_agent_config(Dir, Hdr, Conf) -> @@ -1745,17 +1801,19 @@ update_agent_standard_config(Dir, Conf) -> %% ------ target_addr.conf ------ %% -write_agent_snmp_target_addr_conf(Dir, ManagerIp, UDP, Vsns) -> - Timeout = 1500, - RetryCount = 3, - write_agent_snmp_target_addr_conf(Dir, ManagerIp, UDP, - Timeout, RetryCount, - Vsns). +write_agent_snmp_target_addr_conf(Dir, Addresses, Vsns) -> + Timeout = 1500, + RetryCount = 3, + write_agent_snmp_target_addr_conf( + Dir, Addresses, Timeout, RetryCount, Vsns). -write_agent_snmp_target_addr_conf(Dir, ManagerIp, UDP, - Timeout, RetryCount, - Vsns) -> - Comment = +write_agent_snmp_target_addr_conf(Dir, Domain_or_Ip, Addr_or_Port, Vsns) -> + Addresses = [{Domain_or_Ip, Addr_or_Port}], + write_agent_snmp_target_addr_conf(Dir, Addresses, Vsns). + +write_agent_snmp_target_addr_conf( + Dir, Addresses, Timeout, RetryCount, Vsns) -> + Comment = "%% This file defines the target address parameters.\n" "%% The data is inserted into the snmpTargetAddrTable defined\n" "%% in SNMP-TARGET-MIB, and in the snmpTargetAddrExtTable defined\n" @@ -1774,36 +1832,59 @@ write_agent_snmp_target_addr_conf(Dir, ManagerIp, UDP, "%% [127,0,0,0], 2048}.\n" "%%\n\n", Hdr = header() ++ Comment, - F = fun(v1 = Vsn, Acc) -> - [{mk_ip(ManagerIp, Vsn), - snmp_target_mib:default_domain(), - ManagerIp, UDP, Timeout, RetryCount, - "std_trap", mk_param(Vsn), "", [], 2048}| Acc]; - (v2 = Vsn, Acc) -> - [{mk_ip(ManagerIp, Vsn), - snmp_target_mib:default_domain(), - ManagerIp, UDP, Timeout, RetryCount, - "std_trap", mk_param(Vsn), "", [], 2048}, - {lists:flatten(io_lib:format("~s.2",[mk_ip(ManagerIp, Vsn)])), - ManagerIp, UDP, Timeout, RetryCount, - "std_inform", mk_param(Vsn), "", [], 2048}| Acc]; - (v3 = Vsn, Acc) -> - [{mk_ip(ManagerIp, Vsn), - snmp_target_mib:default_domain(), - ManagerIp, UDP, Timeout, RetryCount, - "std_trap", mk_param(Vsn), "", [], 2048}, - {lists:flatten(io_lib:format("~s.3",[mk_ip(ManagerIp, Vsn)])), - ManagerIp, UDP, Timeout, RetryCount, - "std_inform", mk_param(Vsn), "mgrEngine", [], 2048}| Acc] - end, - Conf = lists:foldl(F, [], Vsns), + Conf = + lists:foldl( + fun ({Domain_or_Ip, Addr_or_Port} = Address, OuterAcc) -> + lists:foldl( + fun(v1 = Vsn, Acc) -> + [{mk_name(Address, Vsn), + Domain_or_Ip, Addr_or_Port, + Timeout, RetryCount, + "std_trap", mk_param(Vsn), "", + [], 2048}| Acc]; + (v2 = Vsn, Acc) -> + [{mk_name(Address, Vsn), + Domain_or_Ip, Addr_or_Port, + Timeout, RetryCount, + "std_trap", mk_param(Vsn), "", + [], 2048}, + {lists:flatten( + io_lib:format( + "~s.2", [mk_name(Address, Vsn)])), + Domain_or_Ip, Addr_or_Port, + Timeout, RetryCount, + "std_inform", mk_param(Vsn), "", + [], 2048}| Acc]; + (v3 = Vsn, Acc) -> + [{mk_name(Address, Vsn), + Domain_or_Ip, Addr_or_Port, + Timeout, RetryCount, + "std_trap", mk_param(Vsn), "", + [], 2048}, + {lists:flatten( + io_lib:format( + "~s.3", [mk_name(Address, Vsn)])), + Domain_or_Ip, Addr_or_Port, + Timeout, RetryCount, + "std_inform", mk_param(Vsn), "mgrEngine", + [], 2048} | Acc] + end, OuterAcc, Vsns) + end, [], Addresses), write_agent_target_addr_config(Dir, Hdr, Conf). +write_agent_snmp_target_addr_conf( + Dir, Domain_or_Ip, Addr_or_Port, Timeout, RetryCount, Vsns) -> + Addresses = [{Domain_or_Ip, Addr_or_Port}], + write_agent_snmp_target_addr_conf( + Dir, Addresses, Timeout, RetryCount, Vsns). + mk_param(Vsn) -> lists:flatten(io_lib:format("target_~w", [Vsn])). -mk_ip([A,B,C,D], Vsn) -> - lists:flatten(io_lib:format("~w.~w.~w.~w ~w", [A,B,C,D,Vsn])). +mk_name(Address, Vsn) -> + lists:flatten( + io_lib:format( + "~s ~w", [snmp_conf:mk_addr_string(Address), Vsn])). write_agent_target_addr_config(Dir, Hdr, Conf) -> snmpa_conf:write_target_addr_config(Dir, Hdr, Conf). @@ -2037,7 +2118,24 @@ write_manager_snmp_files(Dir, IP, Port, MMS, EngineID, %% ------ manager.conf ------ %% -write_manager_snmp_conf(Dir, IP, Port, MMS, EngineID) -> +write_manager_snmp_conf(Dir, Transports, MMS, EngineID) -> + Comment = +"%% This file defines the Manager local configuration info\n" +"%% Each row is a 2-tuple:\n" +"%% {Variable, Value}.\n" +"%% For example\n" +"%% {transports, [{transportDomainUdpIpv4, {{127,42,17,5}, 5000}}]}.\n" +"%% {engine_id, \"managerEngine\"}.\n" +"%% {max_message_size, 484}.\n" +"%%\n\n", + Hdr = header() ++ Comment, + Conf = + [{transports, Transports}, + {engine_id, EngineID}, + {max_message_size, MMS}], + write_manager_config(Dir, Hdr, Conf). + +write_manager_snmp_conf(Dir, Domain_or_IP, Addr_or_Port, MMS, EngineID) -> Comment = "%% This file defines the Manager local configuration info\n" "%% Each row is a 2-tuple:\n" @@ -2049,10 +2147,20 @@ write_manager_snmp_conf(Dir, IP, Port, MMS, EngineID) -> "%% {max_message_size, 484}.\n" "%%\n\n", Hdr = header() ++ Comment, - Conf = [{port, Port}, - {address, IP}, - {engine_id, EngineID}, - {max_message_size, MMS}], + Conf = + case Addr_or_Port of + {IP, Port} when is_integer(Port), is_atom(Domain_or_IP) -> + [{domain, Domain_or_IP}, + {port, Port}, + {address, IP}]; + _ when is_integer(Addr_or_Port) -> + [{port, Addr_or_Port}, + {address, Domain_or_IP}]; + _ -> + error({bad_address, {Domain_or_IP, Addr_or_Port}}) + end ++ + [{engine_id, EngineID}, + {max_message_size, MMS}], write_manager_config(Dir, Hdr, Conf). write_manager_config(Dir, Hdr, Conf) -> @@ -2410,83 +2518,92 @@ header() -> [?MODULE, ?version, Y, Mo, D, H, Mi, S]). -%% *If* these functions are successfull, they successfully return anything -%% (which is ignored), but they fail with either a throw or an exit or -%% something similar. - -%% Verification of one config entry read from a file --type(verify_config_entry_function() :: - fun((Entry :: term()) -> ok | {error, Reason :: term()})). - -%% Verification of config to be written --type(verify_config_function() :: - fun(() -> void())). - -%% Write config to file (as defined by Fd) --type(write_config_function() :: - fun((Fd :: file:io_device()) -> void())). - --spec write_config_file(Dir :: string(), - FileName :: string(), - Verify :: verify_config_function(), - Write :: write_config_function()) -> - ok | {error, Reason :: term()}. - -write_config_file(Dir, FileName, Verify, Write) - when (is_list(Dir) andalso - is_list(FileName) andalso - is_function(Verify) andalso - is_function(Write)) -> +%% *If* these functions are successfull, they successfully return +%% (value is ignored), but they fail preferably with +%% throw({error, Reason}). Other exceptions are also handled. + +%% Sorting order for config entries (see lists:sort/2) +-type(order_config_entry_function() :: + fun((term(), term()) -> boolean())). + +%% Check of config entries. Initial State is 'undefined' +-type(check_config_entry_function() :: + fun((Entry :: term(), State :: undefined | term()) -> + {ok | {ok, NewEntry :: term()}, NewState :: term()})). + +%% Write configuration entries to file descriptor Fd +-type(write_config_function() :: + fun((Fd :: file:io_device(), [Entry :: term()]) -> ok)). + +-spec write_config_file( + Dir :: string(), + FileName :: string(), + Order :: order_config_entry_function(), + Check :: check_config_entry_function(), + Write :: write_config_function(), + Entries :: [term()]) -> + ok | {error, term()}. + +write_config_file(Dir, FileName, Order, Check, Write, Entries) + when is_list(Dir), is_list(FileName), + is_function(Order), is_function(Check), is_function(Write), + is_list(Entries) -> try - begin - do_write_config_file(Dir, FileName, Verify, Write) - end + SortedEntries = lists:sort(Order, Entries), + _ = + lists:foldl( + fun (Entry, State) -> + case Check(Entry, State) of + {Ok, NewState} when is_list(Ok) -> + NewState; + {ok, NewState} -> + NewState; + {{ok, _}, NewState} -> + NewState + end + end, undefined, SortedEntries), + ok + of + _ -> + case file:open(filename:join(Dir, FileName), [write]) of + {ok, Fd} -> + write_config_file(Dir, FileName, Write, Entries, Fd); + Error -> + Error + end catch - throw:Error -> - Error; - T:E -> - {error, {failed_write, Dir, FileName, T, E}} - end. - - -do_write_config_file(Dir, FileName, Verify, Write) -> - Verify(), - case file:open(filename:join(Dir, FileName), [write]) of - {ok, Fd} -> - file_write_and_close(Write, Fd, Dir, FileName); Error -> - Error - end. - -append_config_file(Dir, FileName, Verify, Write) - when (is_list(Dir) andalso - is_list(FileName) andalso - is_function(Verify) andalso - is_function(Write)) -> - try - begin - do_append_config_file(Dir, FileName, Verify, Write) - end - catch - throw:Error -> + S = erlang:get_stacktrace(), + d("File write of ~s throwed: ~p~n ~p~n", + [FileName, Error, S]), Error; - T:E -> - {error, {failed_append, Dir, FileName, T, E}} + C:E -> + S = erlang:get_stacktrace(), + d("File write of ~s exception: ~p:~p~n ~p~n", + [FileName,C,E,S]), + {error, {failed_write, Dir, FileName, {C, E, S}}} end. -do_append_config_file(Dir, FileName, Verify, Write) -> - Verify(), - case file:open(filename:join(Dir, FileName), [read, write]) of - {ok, Fd} -> - file:position(Fd, eof), - file_write_and_close(Write, Fd, Dir, FileName); +write_config_file(Dir, FileName, Write, Entries, Fd) -> + try Write(Fd, Entries) of + ok -> + close_config_file(Dir, FileName, Fd) + catch Error -> - Error + S = erlang:get_stacktrace(), + d("File write of ~s throwed: ~p~n ~p~n", + [FileName, Error, S]), + close_config_file(Dir, FileName, Fd), + Error; + C:E -> + S = erlang:get_stacktrace(), + d("File write of ~s exception: ~p:~p~n ~p~n", + [FileName,C,E,S]), + close_config_file(Dir, FileName, Fd), + {error, {failed_write, Dir, FileName, {C, E, S}}} end. - -file_write_and_close(Write, Fd, Dir, FileName) -> - ok = Write(Fd), +close_config_file(Dir, FileName, Fd) -> case file:sync(Fd) of ok -> case file:close(Fd) of @@ -2496,63 +2613,159 @@ file_write_and_close(Write, Fd, Dir, FileName) -> {error, {failed_closing, Dir, FileName, Reason}} end; {error, Reason} -> + _ = file:close(Fd), {error, {failed_syncing, Dir, FileName, Reason}} end. --spec read_config_file(Dir :: string(), - FileName :: string(), - Verify :: verify_config_entry_function()) -> - {ok, Config :: list()} | {error, Reason :: term()}. -read_config_file(Dir, FileName, Verify) - when is_list(Dir) andalso is_list(FileName) andalso is_function(Verify) -> - (catch do_read_config_file(Dir, FileName, Verify)). +-spec append_config_file( + Dir :: string(), + FileName :: string(), + Order :: order_config_entry_function(), + Check :: check_config_entry_function(), + Write :: write_config_function(), + Entries :: [term()]) -> + ok | {error, term()}. + +append_config_file(Dir, FileName, Order, Check, Write, Entries) + when is_list(Dir), is_list(FileName), + is_function(Order), is_function(Check), is_function(Write), + is_list(Entries) -> + case file:open(filename:join(Dir, FileName), [read, write]) of + {ok, Fd} -> + append_config_file( + Dir, FileName, Order, Check, Write, Entries, Fd); + Error -> + Error + end. + +append_config_file(Dir, FileName, Order, Check, Write, Entries, Fd) -> + try + %% Verify the entries together with the file content + LinesInFileR = read_lines(Fd, [], 1), + StartLine = + case LinesInFileR of + [] -> + 1; + [{_, _, EndLine} | _] -> + EndLine + end, + LinesR = prepend_lines(LinesInFileR, Entries, StartLine), + SortedLines = sort_lines(lists:reverse(LinesR), Order), + _ = verify_lines(SortedLines, Check, undefined, []), + %% Append to the file + Write(Fd, Entries) + of + ok -> + close_config_file(Dir, FileName, Fd) + catch + Error -> + S = erlang:get_stacktrace(), + d("File append of ~s throwed: ~p~n ~p~n", + [FileName, Error, S]), + close_config_file(Dir, FileName, Fd), + Error; + C:E -> + S = erlang:get_stacktrace(), + d("File append of ~s exception: ~p:~p~n ~p~n", + [FileName,C,E,S]), + close_config_file(Dir, FileName, Fd), + {error, {failed_append, Dir, FileName, {C, E, S}}} + end. + +%% Fake line numbers, one per entry +prepend_lines(Lines, [], _) -> + Lines; +prepend_lines(Lines, [Entry | Entries], StartLine) -> + EndLine = StartLine + 1, + prepend_lines([{StartLine, Entry, EndLine} | Lines], Entries, EndLine). + + -do_read_config_file(Dir, FileName, Verify) -> +-spec read_config_file( + Dir :: string(), + FileName :: string(), + Order :: order_config_entry_function(), + Check :: check_config_entry_function()) -> + {ok, Config :: [Entry :: term()]} | + {error, Reason :: term()}. + +read_config_file(Dir, FileName, Order, Check) + when is_list(Dir), is_list(FileName), + is_function(Order), is_function(Check) -> case file:open(filename:join(Dir, FileName), [read]) of {ok, Fd} -> - Result = read_loop(Fd, [], Verify, 1), - file:close(Fd), - Result; + try + Lines = lists:reverse(read_lines(Fd, [], 1)), + SortedLines = sort_lines(Lines, Order), + {ok, verify_lines(SortedLines, Check, undefined, [])} + catch + Error -> + S = erlang:get_stacktrace(), + d("File read of ~s throwed: ~p~n ~p~n", + [FileName, Error, S]), + {error, Error}; + T:E -> + S = erlang:get_stacktrace(), + d("File read of ~s exception: ~p:~p~n ~p~n", + [FileName,T,E,S]), + {error, {failed_read, Dir, FileName, {T, E, S}}} + after + file:close(Fd) + end; {error, Reason} -> {error, {Reason, FileName}} end. -read_loop(Fd, Acc, Check, StartLine) -> - case read_term(Fd, StartLine) of +read_lines(Fd, Acc, StartLine) -> + case read_and_parse_term(Fd, StartLine) of {ok, Term, EndLine} -> - case (catch Check(Term)) of - ok -> - read_loop(Fd, [Term | Acc], Check, EndLine); - {error, Reason} -> - {error, {failed_check, StartLine, EndLine, Reason}}; - Error -> - {error, {failed_check, StartLine, EndLine, Error}} - end; - {error, EndLine, Error} -> - {error, {failed_reading, StartLine, EndLine, Error}}; - eof -> - {ok, lists:reverse(Acc)} + read_lines(Fd, [{StartLine, Term, EndLine}|Acc], EndLine); + {error, Error, EndLine} -> + throw({failed_reading, StartLine, EndLine, Error}); + {eof, _EndLine} -> + Acc end. - -read_term(Fd, StartLine) -> + +read_and_parse_term(Fd, StartLine) -> case io:request(Fd, {get_until, "", erl_scan, tokens, [StartLine]}) of {ok, Tokens, EndLine} -> case erl_parse:parse_term(Tokens) of {ok, Term} -> {ok, Term, EndLine}; {error, {Line, erl_parse, Error}} -> - {error, Line, {parse_error, Error}} + {error, {parse_error, Error}, Line} end; - {error, E, EndLine} -> - {error, EndLine, E}; - {eof, _EndLine} -> - eof; Other -> Other end. +sort_lines(Lines, Order) -> + lists:sort( + fun ({_, T1, _}, {_, T2, _}) -> + Order(T1, T2) + end, Lines). + +verify_lines([], _, _, Acc) -> + lists:reverse(Acc); +verify_lines( + [{StartLine, Term, EndLine}|Lines], Check, State, Acc) -> + try Check(Term, State) of + {Terms, NewState} when is_list(Terms) -> + verify_lines(Lines, Check, NewState, Terms ++ Acc); + {ok, NewState} -> + verify_lines(Lines, Check, NewState, [Term|Acc]); + {{ok, NewTerm}, NewState} -> + verify_lines(Lines, Check, NewState, [NewTerm|Acc]) + catch + {error, Reason} -> + throw({failed_check, StartLine, EndLine, Reason}); + C:R -> + S = erlang:get_stacktrace(), + throw({failed_check, StartLine, EndLine, {C, R, S}}) + end. + agent_snmp_mk_secret(Alg, Passwd, EngineID) -> snmp_usm:passwd2localized_key(Alg, Passwd, EngineID). @@ -2575,8 +2788,8 @@ ensure_started(App) -> %% ------------------------------------------------------------------------- -% d(F, A) -> -% i("DBG: " ++ F, A). +d(F, A) -> + i("DBG: " ++ F, A). i(F) -> i(F, []). diff --git a/lib/snmp/src/misc/snmp_log.erl b/lib/snmp/src/misc/snmp_log.erl index ae28df37fa..4b22281b89 100644 --- a/lib/snmp/src/misc/snmp_log.erl +++ b/lib/snmp/src/misc/snmp_log.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. %% %% The 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 @@ -export([ create/4, create/5, create/6, open/1, open/2, change_size/2, close/1, sync/1, info/1, - log/4, + log/3, log/4, log_to_txt/6, log_to_txt/7, log_to_txt/8, log_to_io/5, log_to_io/6, log_to_io/7 ]). @@ -231,7 +231,20 @@ validate(Log, SeqNoReq) validate_seqno(PrevSN, SeqNo), {Timestamp, SeqNo}; - ({Timestamp, _Packet, _Addr, _Port}, {PrevTS, _PrevSN}) when SeqNoReq =:= true -> + ({Timestamp, SeqNo, _Packet, _AddrStr}, {PrevTS, PrevSN}) + when is_integer(SeqNo) -> + ?vtrace("validating log entry when" + "~n Timestamp: ~p" + "~n SeqNo: ~p" + "~n PrevTS: ~p" + "~n PrevSN: ~p", + [Timestamp, SeqNo, PrevTS, PrevSN]), + validate_timestamp(PrevTS, Timestamp), + validate_seqno(PrevSN, SeqNo), + {Timestamp, SeqNo}; + + ({Timestamp, _Packet, _Addr, _Port}, {PrevTS, _PrevSN}) + when SeqNoReq =:= true -> ?vtrace("validating log entry when" "~n Timestamp: ~p" "~n PrevTS: ~p", @@ -344,12 +357,20 @@ validate_loop(Error, _Log, _Write, _PrevTS, _PrevSN) -> %% log(Log, Packet, Addr, Port) %%----------------------------------------------------------------- -log(#snmp_log{id = Log, seqno = SeqNo}, Packet, Addr, Port) -> +log(#snmp_log{id = Log, seqno = SeqNo}, Packet, AddrStr) -> + ?vtrace( + "log -> entry with~n" + " Log: ~p~n" + " AddrStr: ~s", [Log, AddrStr]), + Entry = make_entry(SeqNo, Packet, AddrStr), + disk_log:alog(Log, Entry). + +log(#snmp_log{id = Log, seqno = SeqNo}, Packet, Ip, Port) -> ?vtrace("log -> entry with" "~n Log: ~p" - "~n Addr: ~p" - "~n Port: ~p", [Log, Addr, Port]), - Entry = make_entry(SeqNo, Packet, Addr, Port), + "~n Ip: ~p" + "~n Port: ~p", [Log, Ip, Port]), + Entry = make_entry(SeqNo, Packet, Ip, Port), %% io:format("log -> " %% "~n Entry: ~p" %% "~n Info: ~p" @@ -361,18 +382,35 @@ log(#snmp_log{id = Log, seqno = SeqNo}, Packet, Addr, Port) -> %% "~n", [Res, disk_log:info(Log)]), %% disk_log:sync(Log), Res. - -make_entry(SeqNoGen, Packet, Addr, Port) -> + +make_entry(SeqNoGen, Packet, AddrStr) + when is_integer(Packet); + is_tuple(AddrStr) -> + erlang:error(badarg, [SeqNoGen, Packet, AddrStr]); +make_entry(SeqNoGen, Packet, AddrStr) -> try next_seqno(SeqNoGen) of disabled -> - {timestamp(), Packet, Addr, Port}; - {ok, NextSeqNo} -> - {timestamp(), NextSeqNo, Packet, Addr, Port} + {timestamp(), Packet, AddrStr}; + {ok, NextSeqNo} when is_integer(NextSeqNo) -> + {timestamp(), NextSeqNo, Packet, AddrStr} catch _:_ -> - {timestamp(), Packet, Addr, Port} + {timestamp(), Packet, AddrStr} + end. + +make_entry(SeqNoGen, Packet, Ip, Port) when is_integer(Packet) -> + erlang:error(badarg, [SeqNoGen, Packet, Ip, Port]); +make_entry(SeqNoGen, Packet, Ip, Port) -> + try next_seqno(SeqNoGen) of + disabled -> + {timestamp(), Packet, Ip, Port}; + {ok, NextSeqNo} when is_integer(NextSeqNo) -> + {timestamp(), NextSeqNo, Packet, Ip, Port} + catch + _:_ -> + {timestamp(), Packet, Ip, Port} end. next_seqno({M, F, A}) -> @@ -674,60 +712,68 @@ format_msg(Entry, Mib, Start, Stop) -> end. %% This is an old-style entry, that never had the sequence-number -do_format_msg({Timestamp, Packet, {Addr, Port}}, Mib) -> - do_format_msg(Timestamp, Packet, Addr, Port, Mib); +do_format_msg({Timestamp, Packet, {Ip, Port}}, Mib) -> + do_format_msg(Timestamp, Packet, ipPort2Str(Ip, Port), Mib); +%% This is the format without sequence-number +do_format_msg({Timestamp, Packet, AddrStr}, Mib) -> + do_format_msg(Timestamp, Packet, AddrStr, Mib); +%% This is the format with sequence-number +do_format_msg({Timestamp, SeqNo, Packet, AddrStr}, Mib) + when is_integer(SeqNo) -> + do_format_msg(Timestamp, Packet, AddrStr, Mib); %% This is the format without sequence-number -do_format_msg({Timestamp, Packet, Addr, Port}, Mib) -> - do_format_msg(Timestamp, Packet, Addr, Port, Mib); +do_format_msg({Timestamp, Packet, Ip, Port}, Mib) -> + do_format_msg(Timestamp, Packet, ipPort2Str(Ip, Port), Mib); %% This is the format with sequence-number -do_format_msg({Timestamp, SeqNo, Packet, Addr, Port}, Mib) -> - do_format_msg(Timestamp, SeqNo, Packet, Addr, Port, Mib); +do_format_msg({Timestamp, SeqNo, Packet, Ip, Port}, Mib) -> + do_format_msg(Timestamp, SeqNo, Packet, ipPort2Str(Ip, Port), Mib); %% This is crap... do_format_msg(_, _) -> format_tab("** unknown entry in log file\n\n", []). -do_format_msg(TimeStamp, {V3Hdr, ScopedPdu}, Addr, Port, Mib) -> +do_format_msg(TimeStamp, {V3Hdr, ScopedPdu}, AddrStr, Mib) -> case (catch snmp_pdus:dec_scoped_pdu(ScopedPdu)) of ScopedPDU when is_record(ScopedPDU, scopedPdu) -> Msg = #message{version = 'version-3', vsn_hdr = V3Hdr, data = ScopedPDU}, - f(ts2str(TimeStamp), "", Msg, Addr, Port, Mib); + f(ts2str(TimeStamp), "", Msg, AddrStr, Mib); {'EXIT', Reason} -> - format_tab("** error in log file at ~s from ~p:~w ~p\n\n", - [ts2str(TimeStamp), ip(Addr), Port, Reason]) + format_tab( + "** error in log file at ~s from ~s ~p\n\n", + [ts2str(TimeStamp), AddrStr, Reason]) end; -do_format_msg(TimeStamp, Packet, Addr, Port, Mib) -> +do_format_msg(TimeStamp, Packet, AddrStr, Mib) -> case (catch snmp_pdus:dec_message(binary_to_list(Packet))) of Msg when is_record(Msg, message) -> - f(ts2str(TimeStamp), "", Msg, Addr, Port, Mib); + f(ts2str(TimeStamp), "", Msg, AddrStr, Mib); {'EXIT', Reason} -> format_tab("** error in log file ~p\n\n", [Reason]) end. -do_format_msg(TimeStamp, SeqNo, {V3Hdr, ScopedPdu}, Addr, Port, Mib) -> +do_format_msg(TimeStamp, SeqNo, {V3Hdr, ScopedPdu}, AddrStr, Mib) -> case (catch snmp_pdus:dec_scoped_pdu(ScopedPdu)) of ScopedPDU when is_record(ScopedPDU, scopedPdu) -> Msg = #message{version = 'version-3', vsn_hdr = V3Hdr, data = ScopedPDU}, - f(ts2str(TimeStamp), sn2str(SeqNo), Msg, Addr, Port, Mib); + f(ts2str(TimeStamp), sn2str(SeqNo), Msg, AddrStr, Mib); {'EXIT', Reason} -> - format_tab("** error in log file at ~s from ~p:~w ~p\n\n", - [ts2str(TimeStamp), sn2str(SeqNo), - ip(Addr), Port, Reason]) + format_tab( + "** error in log file at ~s from ~s ~p\n\n", + [ts2str(TimeStamp), sn2str(SeqNo), AddrStr, Reason]) end; -do_format_msg(TimeStamp, SeqNo, Packet, Addr, Port, Mib) -> +do_format_msg(TimeStamp, SeqNo, Packet, AddrStr, Mib) -> case (catch snmp_pdus:dec_message(binary_to_list(Packet))) of Msg when is_record(Msg, message) -> - f(ts2str(TimeStamp), sn2str(SeqNo), Msg, Addr, Port, Mib); + f(ts2str(TimeStamp), sn2str(SeqNo), Msg, AddrStr, Mib); {'EXIT', Reason} -> - format_tab("** error in log file ~s from ~p:~w ~p\n\n", - [ts2str(TimeStamp), sn2str(SeqNo), - ip(Addr), Port, Reason]) + format_tab( + "** error in log file ~s from ~s ~p\n\n", + [ts2str(TimeStamp), sn2str(SeqNo), AddrStr, Reason]) end. @@ -771,44 +817,71 @@ do_format_msg(TimeStamp, SeqNo, Packet, Addr, Port, Mib) -> f(TimeStamp, SeqNo, #message{version = Vsn, vsn_hdr = VsnHdr, data = Data}, - Addr, Port, Mib) -> + AddrStr, Mib) -> Str = format_pdu(Data, Mib), HdrStr = format_header(Vsn, VsnHdr), - case get_type(Data) of - trappdu -> - f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - 'snmpv2-trap' -> - f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - 'inform-request' -> - f_inform(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - 'get-response' -> - f_response(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - report -> - f_report(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); - _ -> - f_request(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) - end. + Class = + case get_type(Data) of + trappdu -> + trap; + 'snmpv2-trap' -> + trap; + 'inform-request' -> + inform; + 'get-response' -> + response; + report -> + report; + _ -> + request + end, + format_tab( + "~w ~s - ~s [~s]~s ~w\n~s", + [Class, AddrStr, HdrStr, TimeStamp, SeqNo, Vsn, Str]). + +%% f(TimeStamp, SeqNo, +%% #message{version = Vsn, vsn_hdr = VsnHdr, data = Data}, +%% Addr, Port, Mib) -> +%% Str = format_pdu(Data, Mib), +%% HdrStr = format_header(Vsn, VsnHdr), +%% case get_type(Data) of +%% trappdu -> +%% f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); +%% 'snmpv2-trap' -> +%% f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); +%% 'inform-request' -> +%% f_inform(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); +%% 'get-response' -> +%% f_response(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); +%% report -> +%% f_report(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port); +%% _ -> +%% f_request(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) +%% end. -f_request(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> - format_tab("request ~s:~w - ~s [~s]~s ~w\n~s", - [ip(Addr), Port, HdrStr, TimeStamp, SeqNo, Vsn, Str]). +%% f_request(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> +%% format_tab("request ~s:~w - ~s [~s]~s ~w\n~s", +%% [ip(Addr), Port, HdrStr, TimeStamp, SeqNo, Vsn, Str]). -f_response(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> - format_tab("response ~s:~w - ~s [~s]~s ~w\n~s", - [ip(Addr), Port, HdrStr, TimeStamp, SeqNo, Vsn, Str]). +%% f_response(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> +%% format_tab("response ~s:~w - ~s [~s]~s ~w\n~s", +%% [ip(Addr), Port, HdrStr, TimeStamp, SeqNo, Vsn, Str]). -f_report(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> - format_tab("report ~s:~w - ~s [~s]~s ~w\n~s", - [ip(Addr), Port, HdrStr, TimeStamp, SeqNo, Vsn, Str]). +%% f_report(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> +%% format_tab("report ~s:~w - ~s [~s]~s ~w\n~s", +%% [ip(Addr), Port, HdrStr, TimeStamp, SeqNo, Vsn, Str]). -f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> - format_tab("trap ~s:~w - ~s [~s]~s ~w\n~s", - [ip(Addr), Port, HdrStr, TimeStamp, SeqNo, Vsn, Str]). +%% f_trap(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> +%% format_tab("trap ~s:~w - ~s [~s]~s ~w\n~s", +%% [ip(Addr), Port, HdrStr, TimeStamp, SeqNo, Vsn, Str]). -f_inform(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> - format_tab("inform ~s:~w - ~s [~s]~s ~w\n~s", - [ip(Addr), Port, HdrStr, TimeStamp, SeqNo, Vsn, Str]). +%% f_inform(TimeStamp, SeqNo, Vsn, HdrStr, Str, Addr, Port) -> +%% format_tab("inform ~s:~w - ~s [~s]~s ~w\n~s", +%% [ip(Addr), Port, HdrStr, TimeStamp, SeqNo, Vsn, Str]). +ipPort2Str(Ip, Port) -> + snmp_conf:mk_addr_string({Ip, Port}). + %% io_lib:format("~s:~w", [ip(Ip), Port]). %% Convert a timestamp 2-tupple to a printable string %% @@ -909,8 +982,10 @@ get_type(#pdu{type = Type}) -> Type. -ip({A,B,C,D}) -> - io_lib:format("~w.~w.~w.~w", [A,B,C,D]). +%% ip(Domain, Addr) -> +%% snmp_conf:mk_addr_string(Domain, Addr). +%% ip({A,B,C,D}) -> +%% io_lib:format("~w.~w.~w.~w", [A,B,C,D]). diff --git a/lib/snmp/src/misc/snmp_pdus.erl b/lib/snmp/src/misc/snmp_pdus.erl index 15156f7467..90fa4c0dea 100644 --- a/lib/snmp/src/misc/snmp_pdus.erl +++ b/lib/snmp/src/misc/snmp_pdus.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -174,7 +174,7 @@ dec_pdu_tag(168) -> dec_pdu([164 | Bytes]) -> % It's a trap Bytes2 = get_data_bytes(Bytes), {Enterprise, Rest1} = dec_oid_tag(Bytes2), - {{'IpAddress', AgentAddr}, Rest2} = dec_value(Rest1), + {{'IpAddress', [_, _, _, _] = AgentAddr}, Rest2} = dec_value(Rest1), {GenericTrap, Rest3} = dec_int_tag(Rest2), {SpecificTrap, Rest4} = dec_int_tag(Rest3), {{'TimeTicks', TimeStamp}, VBBytes} = dec_value(Rest4), @@ -664,7 +664,9 @@ enc_value('BITS', Val) -> enc_oct_str_tag(bits_to_str(Val)); enc_value('OBJECT IDENTIFIER', Val) -> enc_oid_tag(Val); -enc_value('IpAddress', Val) -> +enc_value('IpAddress', {A, B, C, D}) -> + enc_value('IpAddress', [A,B,C,D]); +enc_value('IpAddress', Val) when is_list(Val) -> Bytes2 = enc_oct_str_notag(Val), Len2 = elength(length(Bytes2)), lists:append([64 | Len2],Bytes2); diff --git a/lib/snmp/test/Makefile b/lib/snmp/test/Makefile index 7bc9dd07d4..a9bbe7fe62 100644 --- a/lib/snmp/test/Makefile +++ b/lib/snmp/test/Makefile @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2012. All Rights Reserved. +# Copyright Ericsson AB 1997-2014. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -36,7 +36,7 @@ VSN = $(SNMP_VSN) include modules.mk SNMP_ROOT = .. -SNMP_SUITE = snmp_SUITE +SNMP_SUITE = snmp_SUITE ERL_FILES = $(MODULES:%=%.erl) @@ -239,6 +239,7 @@ release_tests_spec: opt $(INSTALL_DATA) $(RELTEST_FILES) $(COVER_SPEC_FILE) "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" tar cf - snmp_test_data | (cd "$(RELSYSDIR)"; tar xf -) + tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) release_docs_spec: diff --git a/lib/snmp/test/klas3.erl b/lib/snmp/test/klas3.erl index ec78d19dbb..4cbd852b2d 100644 --- a/lib/snmp/test/klas3.erl +++ b/lib/snmp/test/klas3.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -67,11 +67,15 @@ fname(get) -> end, case snmpa:current_address() of {value, {[_A,_B,_C,_D], E}} when is_integer(E) -> ok; - {value, _} -> throw("bad_ip"); - _ -> throw("bad_adr") + {value, {D, _}} when is_atom(D) -> ok; + {value, Ip} -> + throw(format_string("bad_ip: ~p", [Ip])); + Other -> + throw(format_string("bad_adr: ~p", [Other])) end, case snmpa:current_net_if_data() of {value, []} -> ok; + {value, [{request_ref, R}]} when is_reference(R) -> ok; {value, _} -> throw("bad_nil"); _ -> throw("bad_nid") end, @@ -160,3 +164,6 @@ ftab2(get_next, [9], _Cols) -> % bad return value io:format("** Here comes Error Report get_next 3 bad return~n"), [{[1,5],1},{[2,5],3},{[2,6],3}]. + +format_string(Format, Args) -> + lists:flatten(io_lib:format(Format, Args)). diff --git a/lib/snmp/test/modules.mk b/lib/snmp/test/modules.mk index fd8315ec4d..1bf08a9729 100644 --- a/lib/snmp/test/modules.mk +++ b/lib/snmp/test/modules.mk @@ -19,6 +19,7 @@ SUITE_MODULES = \ snmp_SUITE \ + snmp_to_snmpnet_SUITE \ snmp_app_test \ snmp_appup_test \ snmp_compiler_test \ diff --git a/lib/snmp/test/snmp_SUITE.erl b/lib/snmp/test/snmp_SUITE.erl index 22b9c64588..6fabf6410f 100644 --- a/lib/snmp/test/snmp_SUITE.erl +++ b/lib/snmp/test/snmp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -80,7 +80,8 @@ groups() -> {group, note_store_test}]}, {agent, [], [{group, mibs_test}, {group, nfilter_test}, - {group, agent_test}]}, + {group, agent_test}, + {group, snmpnet_test}]}, {manager, [], [{group, manager_config_test}, {group, manager_user_test}, {group, manager_test}]}, @@ -95,6 +96,7 @@ groups() -> {mibs_test, [], [{snmp_agent_mibs_test, all}]}, {nfilter_test, [], [{snmp_agent_nfilter_test, all}]}, {agent_test, [], [{snmp_agent_test, all}]}, + {snmpnet_test, [], [{snmp_to_snmpnet_SUITE, all}]}, {manager_config_test, [], [{snmp_manager_config_test, all}]}, {manager_user_test, [], [{snmp_manager_user_test, all}]}, {manager_test, [], [{snmp_manager_test, all}]} @@ -107,15 +109,18 @@ init_per_group(GroupName, Config0) -> "~n GroupName: ~p" "~n Config0: ~p", [GroupName, Config0]), - %% Group name is not really the suite name - %% (but it is a good enough approximation), - %% but it does not matter since we only need - %% it to be unique. - snmp_test_lib:init_suite_top_dir(GroupName, Config0). - - + case GroupName of + snmpnet_test -> + Config0; + _ -> + %% Group name is not really the suite name + %% (but it is a good enough approximation), + %% but it does not matter since we only need + %% it to be unique. + snmp_test_lib:init_suite_top_dir(GroupName, Config0) + end. + +end_per_group(snmpnet_test, Config) -> + Config; end_per_group(_GroupName, Config) -> lists:keydelete(snmp_suite_top_dir, 1, Config). - - - diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index 2a9f2e842d..b4770ad0a9 100644 --- a/lib/snmp/test/snmp_agent_test.erl +++ b/lib/snmp/test/snmp_agent_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2014. All Rights Reserved. %% %% The 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,7 @@ v1_processing/1, big/1, big2/1, - loop_mib_1/1, + loop_mib_1/1, api/1, subagent/1, mnesia/1, @@ -298,7 +298,6 @@ %% tickets2 otp8395/1, otp9884/1 - ]). %% Internal exports @@ -390,9 +389,9 @@ usm_read/0, usm_del_user/0, usm_bad/0, - loop_mib_1_test/0, - loop_mib_2_test/0, - loop_mib_3_test/0, + loop_mib_1_test/0, + loop_mib_2_test/0, + loop_mib_3_test/0, otp_1129_i/1, otp_1162_test/0, otp_1131_test/0, @@ -518,9 +517,13 @@ groups() -> {mib_storage_varm_mnesia, [], varm_mib_storage_mnesia_cases()}, {misc, [], misc_cases()}, {test_v1, [], v1_cases()}, + {test_v1_ipv6, [], v1_cases_ipv6()}, {test_v2, [], v2_cases()}, + {test_v2_ipv6, [], v2_cases_ipv6()}, {test_v1_v2, [], v1_v2_cases()}, + {test_v1_v2_ipv6, [], v1_v2_cases()}, {test_v3, [], v3_cases()}, + {test_v3_ipv6, [], v3_cases_ipv6()}, {test_multi_threaded, [], mt_cases()}, {multiple_reqs, [], mul_cases()}, {multiple_reqs_2, [], mul_cases_2()}, @@ -529,6 +532,7 @@ groups() -> {v3_inform, [], v3_inform_cases()}, {v3_security, [], v3_security_cases()}, {standard_mibs, [], standard_mibs_cases()}, + {standard_mibs_ipv6, [], standard_mibs_cases_ipv6()}, {standard_mibs_2, [], standard_mibs2_cases()}, {standard_mibs_3, [], standard_mibs3_cases()}, {reported_bugs, [], reported_bugs_cases()}, @@ -611,6 +615,14 @@ init_per_group(test_v2 = GroupName, Config) -> init_v2(snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(test_v1 = GroupName, Config) -> init_v1(snmp_test_lib:init_group_top_dir(GroupName, Config)); +init_per_group(test_v1_ipv6 = GroupName, Config) -> + init_per_group_ipv6(GroupName, Config, fun init_v1/1); +init_per_group(test_v2_ipv6 = GroupName, Config) -> + init_per_group_ipv6(GroupName, Config, fun init_v2/1); +init_per_group(test_v1_v2_ipv6 = GroupName, Config) -> + init_per_group_ipv6(GroupName, Config, fun init_v1_v2/1); +init_per_group(test_v3_ipv6 = GroupName, Config) -> + init_per_group_ipv6(GroupName, Config, fun init_v3/1); init_per_group(misc = GroupName, Config) -> init_misc(snmp_test_lib:init_group_top_dir(GroupName, Config)); init_per_group(mib_storage_varm_mnesia = GroupName, Config) -> @@ -637,6 +649,25 @@ init_per_group(mib_storage_ets = GroupName, Config) -> init_per_group(GroupName, Config) -> snmp_test_lib:init_group_top_dir(GroupName, Config). +init_per_group_ipv6(GroupName, Config, Init) -> + case ct:require(ipv6_hosts) of + ok -> + case gen_udp:open(0, [inet6]) of + {ok, S} -> + ok = gen_udp:close(S), + Init( + snmp_test_lib:init_group_top_dir( + GroupName, + [{ipfamily, inet6}, + {ip, ?LOCALHOST(inet6)} + | lists:keydelete(ip, 1, Config)])); + {error, _} -> + {skip, "Host seems to not support IPv6"} + end; + _ -> + {skip, "Host does not support IPV6"} + end. + end_per_group(all_tcs, Config) -> finish_all(Config); end_per_group(otp7157, Config) -> @@ -655,31 +686,39 @@ 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) -> +end_per_group(test_v3_ipv6, Config) -> finish_v3(Config); -end_per_group(test_v1_v2, Config) -> +end_per_group(test_v1_v2_ipv6, Config) -> finish_v1_v2(Config); -end_per_group(test_v2, Config) -> +end_per_group(test_v2_ipv6, Config) -> finish_v2(Config); -end_per_group(test_v1, Config) -> +end_per_group(test_v1_ipv6, Config) -> finish_v1(Config); -end_per_group(misc, Config) -> +end_per_group(test_v3, Config) -> + finish_v3(Config); +end_per_group(test_v1_v2, Config) -> + finish_v1_v2(Config); +end_per_group(test_v2, Config) -> + finish_v2(Config); +end_per_group(test_v1, Config) -> + finish_v1(Config); +end_per_group(misc, Config) -> finish_misc(Config); -end_per_group(mib_storage_varm_mnesia, Config) -> +end_per_group(mib_storage_varm_mnesia, Config) -> finish_varm_mib_storage_mnesia(Config); -end_per_group(mib_storage_varm_dets, Config) -> +end_per_group(mib_storage_varm_dets, Config) -> finish_varm_mib_storage_dets(Config); -end_per_group(mib_storage_size_check_mnesia, Config) -> +end_per_group(mib_storage_size_check_mnesia, Config) -> finish_size_check_msm(Config); -end_per_group(mib_storage_size_check_dets, Config) -> +end_per_group(mib_storage_size_check_dets, Config) -> finish_size_check_msd(Config); -end_per_group(mib_storage_size_check_ets, Config) -> +end_per_group(mib_storage_size_check_ets, Config) -> finish_size_check_mse(Config); -end_per_group(mib_storage_mnesia, Config) -> +end_per_group(mib_storage_mnesia, Config) -> finish_mib_storage_mnesia(Config); -end_per_group(mib_storage_dets, Config) -> +end_per_group(mib_storage_dets, Config) -> finish_mib_storage_dets(Config); -end_per_group(mib_storage_ets, Config) -> +end_per_group(mib_storage_ets, Config) -> finish_mib_storage_ets(Config); end_per_group(_GroupName, Config) -> Config. @@ -810,6 +849,10 @@ cases() -> {group, test_v2}, {group, test_v1_v2}, {group, test_v3}, + {group, test_v1_ipv6}, + {group, test_v2_ipv6}, + {group, test_v1_v2_ipv6}, + {group, test_v3_ipv6}, {group, test_multi_threaded}, {group, mib_storage}, {group, tickets1} @@ -865,8 +908,8 @@ start_v2_agent(Config) -> start_v2_agent(Config, Opts) -> snmp_agent_test_lib:start_v2_agent(Config, Opts). -start_v3_agent(Config) -> - snmp_agent_test_lib:start_v3_agent(Config). +%% start_v3_agent(Config) -> +%% snmp_agent_test_lib:start_v3_agent(Config). start_v3_agent(Config, Opts) -> snmp_agent_test_lib:start_v3_agent(Config, Opts). @@ -1636,7 +1679,7 @@ del_dir(Dir, Depth) -> ok end. -%v1_cases() -> [loop_mib]; +%v1_cases() -> [loop_mib_1]; v1_cases() -> [ simple, @@ -1644,7 +1687,7 @@ v1_cases() -> v1_processing, big, big2, - loop_mib_1, + loop_mib_1, api, subagent, mnesia, @@ -1662,14 +1705,40 @@ v1_cases() -> change_target_addr_config ]. +v1_cases_ipv6() -> + [ + simple, + v1_processing, + loop_mib_1, +%% big, +%% big2, + api, + subagent, +%% mnesia, +%% {group, multiple_reqs}, + sa_register, +%% v1_trap, % sends v1 trap +%% sa_error, + next_across_sa, + undo, +%% {group, reported_bugs}, + {group, standard_mibs_ipv6}, + sparse_table, +%% cnt_64, % sends v1 trap + opaque +%% change_target_addr_config % sends v1 trap + ]. + init_v1(Config) when is_list(Config) -> ?line SaNode = ?config(snmp_sa, Config), ?line create_tables(SaNode), ?line AgentConfDir = ?config(agent_conf_dir, Config), ?line MgrDir = ?config(mgr_dir, Config), ?line Ip = ?config(ip, Config), - ?line config([v1], MgrDir, AgentConfDir, - tuple_to_list(Ip), tuple_to_list(Ip)), + ?line IpFamily = config_ipfamily(Config), + ?line config( + [v1], MgrDir, AgentConfDir, + tuple_to_list(Ip), tuple_to_list(Ip), IpFamily), [{vsn, v1} | start_v1_agent(Config)]. finish_v1(Config) when is_list(Config) -> @@ -1706,14 +1775,43 @@ v2_cases() -> v2_caps ]. +v2_cases_ipv6() -> + [ + simple_2, + v2_processing, +%% big_2, +%% big2_2, + loop_mib_2, + api_2, + subagent_2, +%% mnesia_2, +%% {group, multiple_reqs_2}, + sa_register_2, + v2_trap, + {group, v2_inform}, +%% sa_error_2, + next_across_sa_2, + undo_2, +%% {group, reported_bugs_2}, + {group, standard_mibs_2}, + v2_types, + implied, + sparse_table_2, + cnt_64_2, + opaque_2, + v2_caps + ]. + init_v2(Config) when is_list(Config) -> SaNode = ?config(snmp_sa, Config), create_tables(SaNode), AgentConfDir = ?config(agent_conf_dir, Config), MgrDir = ?config(mgr_dir, Config), Ip = ?config(ip, Config), - config([v2], MgrDir, AgentConfDir, - tuple_to_list(Ip), tuple_to_list(Ip)), + IpFamily = config_ipfamily(Config), + config( + [v2], MgrDir, AgentConfDir, + tuple_to_list(Ip), tuple_to_list(Ip), IpFamily), [{vsn, v2} | start_v2_agent(Config)]. finish_v2(Config) when is_list(Config) -> @@ -1732,8 +1830,9 @@ init_v1_v2(Config) when is_list(Config) -> AgentConfDir = ?config(agent_conf_dir, Config), MgrDir = ?config(mgr_dir, Config), Ip = ?config(ip, Config), + IpFamily = config_ipfamily(Config), config([v1,v2], MgrDir, AgentConfDir, - tuple_to_list(Ip), tuple_to_list(Ip)), + tuple_to_list(Ip), tuple_to_list(Ip), IpFamily), [{vsn, bilingual} | start_bilingual_agent(Config)]. finish_v1_v2(Config) when is_list(Config) -> @@ -1771,6 +1870,34 @@ v3_cases() -> v2_caps_3 ]. +v3_cases_ipv6() -> + [ + simple_3, + v3_processing, +%% big_3, +%% big2_3, + api_3, + subagent_3, +%% mnesia_3, + loop_mib_3, +%% {group, multiple_reqs_3}, + sa_register_3, + v3_trap, + {group, v3_inform}, +%% sa_error_3, + next_across_sa_3, + undo_3, +%% {group, reported_bugs_3}, + {group, standard_mibs_3}, + {group, v3_security}, + v2_types_3, + implied_3, + sparse_table_3, + cnt_64_3, + opaque_3, + v2_caps_3 + ]. + init_v3(Config) when is_list(Config) -> %% Make sure crypto works, otherwise start_agent will fail %% and we will be stuck with a bunch of mnesia tables for @@ -1792,9 +1919,16 @@ init_v3(Config) when is_list(Config) -> AgentConfDir = ?config(agent_conf_dir, Config), MgrDir = ?config(mgr_dir, Config), Ip = ?config(ip, Config), - ?line ok = config([v3], MgrDir, AgentConfDir, - tuple_to_list(Ip), tuple_to_list(Ip)), - [{vsn, v3} | start_v3_agent(Config)]. + IpFamily = config_ipfamily(Config), + ?line ok = + config( + [v3], MgrDir, AgentConfDir, + tuple_to_list(Ip), tuple_to_list(Ip), IpFamily), + Opts = + [{master_agent_verbosity, trace}, + {agent_verbosity, trace}, + {net_if_verbosity, trace}], + [{vsn, v3} | start_v3_agent(Config, Opts)]. finish_v3(Config) when is_list(Config) -> delete_tables(), @@ -4710,6 +4844,15 @@ standard_mibs_cases() -> snmp_view_based_acm_mib ]. +standard_mibs_cases_ipv6() -> + [ + %% snmp_standard_mib, % Sending v1 traps does not work over IPv6 + 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. @@ -5546,7 +5689,7 @@ usm_bad() -> %%----------------------------------------------------------------- loop_mib_1(suite) -> []; loop_mib_1(Config) when is_list(Config) -> - ?P(loop_mib_1), + ?P(loop_mib_1), ?LOG("loop_mib_1 -> initiate case",[]), %% snmpa:verbosity(master_agent,debug), %% snmpa:verbosity(mib_server,info), @@ -5554,7 +5697,7 @@ loop_mib_1(Config) when is_list(Config) -> ?DBG("loop_mib_1 -> ~n" "\tSaNode: ~p~n" "\tMgrNode: ~p~n" - "\tMibDir: ~p", [_SaNode, _MgrNode, _MibDir]), + "\tMibDir: ~p",[_SaNode, _MgrNode, _MibDir]), ?DBG("loop_mib_1 -> load mib SNMP-COMMUNITY-MIB",[]), ?line load_master_std("SNMP-COMMUNITY-MIB"), ?DBG("loop_mib_1 -> load mib SNMP-MPD-MIB",[]), @@ -6378,8 +6521,6 @@ otp_4394_config(AgentConfDir, MgrDir, Ip0) -> ?line write_notify_conf(AgentConfDir), ok. - - otp_4394_finish(Config) when is_list(Config) -> ?DBG("finish_otp_4394 -> entry", []), C1 = stop_agent(Config), @@ -6532,6 +6673,7 @@ otp8395({init, Config}) when is_list(Config) -> %% SubAgentHost = ?HPSTNAME(SubAgentNode), ManagerHost = ?HOSTNAME(ManagerNode), + IpFamily = inet, Host = snmp_test_lib:hostname(), Ip = ?LOCALHOST(), {ok, AgentIP0} = snmp_misc:ip(AgentHost), @@ -6549,9 +6691,7 @@ otp8395({init, Config}) when is_list(Config) -> Vsns = [v1], AgentConfDir = ?config(agent_conf_dir, Config), ManagerConfDir = ?config(manager_top_dir, Config), - snmp_agent_test_lib:config(Vsns, - ManagerConfDir, AgentConfDir, - ManagerIP, AgentIP), + config(Vsns, ManagerConfDir, AgentConfDir, ManagerIP, AgentIP, IpFamily), %% -- @@ -6560,6 +6700,7 @@ otp8395({init, Config}) when is_list(Config) -> Config2 = start_agent([{host, Host}, {ip, Ip}, + {ipfamily, IpFamily}, {agent_node, AgentNode}, {agent_host, AgentHost}, {agent_ip, AgentIP}, @@ -6639,6 +6780,7 @@ otp8395(Config) when is_list(Config) -> put(mib_dir, ?config(mib_dir, Config)), put(vsn, v1), put(master_host, ?config(agent_host, Config)), + put(ipfamily, ?config(ipfamily, Config)), try_test(simple_standard_test), ?SLEEP(1000), @@ -6666,126 +6808,12 @@ otp8395(Config) when is_list(Config) -> otp9884({init, Config}) when is_list(Config) -> ?DBG("otp9884(init) -> entry with" "~n Config: ~p", [Config]), - - %% -- - %% Start nodes - %% - - {ok, AgentNode} = start_node(agent), - - %% We don't use a manager in this test but the (common) config - %% function takes an argument that is derived from this - {ok, ManagerNode} = start_node(manager), - - %% -- - %% Mnesia init - %% - - AgentDbDir = ?config(agent_db_dir, Config), - AgentMnesiaDir = join([AgentDbDir, "mnesia"]), - mnesia_init(AgentNode, AgentMnesiaDir), - - mnesia_create_schema(AgentNode, [AgentNode]), - - mnesia_start(AgentNode), - - %% -- - %% Host & IP - %% - - AgentHost = ?HOSTNAME(AgentNode), - ManagerHost = ?HOSTNAME(ManagerNode), - - Host = snmp_test_lib:hostname(), - Ip = ?LOCALHOST(), - {ok, AgentIP0} = snmp_misc:ip(AgentHost), - AgentIP = tuple_to_list(AgentIP0), - {ok, ManagerIP0} = snmp_misc:ip(ManagerHost), - ManagerIP = tuple_to_list(ManagerIP0), - - - %% -- - %% Write agent config - %% - - Vsns = [v1], - ManagerConfDir = ?config(manager_top_dir, Config), - AgentConfDir = ?config(agent_conf_dir, Config), - AgentTopDir = ?config(agent_top_dir, Config), - AgentBkpDir1 = join([AgentTopDir, backup1]), - AgentBkpDir2 = join([AgentTopDir, backup2]), - ok = file:make_dir(AgentBkpDir1), - ok = file:make_dir(AgentBkpDir2), - AgentBkpDirs = [AgentBkpDir1, AgentBkpDir2], - snmp_agent_test_lib:config(Vsns, - ManagerConfDir, AgentConfDir, - ManagerIP, AgentIP), - - - %% -- - %% Start the agent - %% - - Config2 = start_agent([{host, Host}, - {ip, Ip}, - {agent_node, AgentNode}, - {agent_host, AgentHost}, - {agent_ip, AgentIP}, - {agent_backup_dirs, AgentBkpDirs}|Config]), - - %% -- - %% Create watchdog - %% - - Dog = ?WD_START(?MINS(1)), - - [{watchdog, Dog} | Config2]; + init_v1_agent([{ipfamily, inet} | Config]); otp9884({fin, Config}) when is_list(Config) -> ?DBG("otp9884(fin) -> entry with" "~n Config: ~p", [Config]), - - AgentNode = ?config(agent_node, Config), - ManagerNode = ?config(manager_node, Config), - - %% - - %% Stop agent (this is the nice way to do it, - %% so logs and files can be closed in the proper way). - %% - - AgentSup = ?config(agent_sup, Config), - ?DBG("otp9884(fin) -> stop (stand-alone) agent: ~p", [AgentSup]), - stop_stdalone_agent(AgentSup), - - %% - - %% Stop mnesia - %% - ?DBG("otp9884(fin) -> stop mnesia", []), - mnesia_stop(AgentNode), - - - %% - - %% Stop the agent node - %% - - ?DBG("otp9884(fin) -> stop agent node", []), - stop_node(AgentNode), - - - %% SubAgentNode = ?config(sub_agent_node, Config), - %% stop_node(SubAgentNode), - - - %% - - %% Stop the manager node - %% - - ?DBG("otp9884(fin) -> stop manager node", []), - stop_node(ManagerNode), - - Dog = ?config(watchdog, Config), - ?WD_STOP(Dog), - lists:keydelete(watchdog, 1, Config); + fin_v1_agent(Config); otp9884(doc) -> "OTP-9884 - Simlutaneous backup call should not work. "; @@ -6845,8 +6873,6 @@ otp9884_await_backup_completion(First, Second) end; otp9884_await_backup_completion(First, Second) -> throw({error, {bad_completion, First, Second}}). - - %%----------------------------------------------------------------- agent_log_validation(Node) -> @@ -7143,6 +7169,9 @@ delete_files(Config) -> config(Vsns, MgrDir, AgentDir, MIp, AIp) -> snmp_agent_test_lib:config(Vsns, MgrDir, AgentDir, MIp, AIp). +config(Vsns, MgrDir, AgentDir, MIp, AIp, IpFamily) -> + snmp_agent_test_lib:config(Vsns, MgrDir, AgentDir, MIp, AIp, IpFamily). + update_usm(Vsns, Dir) -> snmp_agent_test_lib:update_usm(Vsns, Dir). @@ -7387,3 +7416,124 @@ p(F, A) -> formated_timestamp() -> snmp_test_lib:formated_timestamp(). + +init_v1_agent(Config) -> + %% -- + %% Start nodes + %% + + {ok, AgentNode} = start_node(agent), + + %% We don't use a manager in this test but the (common) config + %% function takes an argument that is derived from this + {ok, ManagerNode} = start_node(manager), + + %% -- + %% Mnesia init + %% + + AgentDbDir = ?config(agent_db_dir, Config), + AgentMnesiaDir = join([AgentDbDir, "mnesia"]), + mnesia_init(AgentNode, AgentMnesiaDir), + + mnesia_create_schema(AgentNode, [AgentNode]), + + mnesia_start(AgentNode), + + %% -- + %% Host & IP + %% + + AgentHost = ?HOSTNAME(AgentNode), + ManagerHost = ?HOSTNAME(ManagerNode), + + Host = snmp_test_lib:hostname(), + IpFamily = config_ipfamily(Config), + Ip = ?LOCALHOST(IpFamily), + {ok, AgentIP0} = snmp_misc:ip(AgentHost, IpFamily), + AgentIP = tuple_to_list(AgentIP0), + {ok, ManagerIP0} = snmp_misc:ip(ManagerHost, IpFamily), + ManagerIP = tuple_to_list(ManagerIP0), + + + %% -- + %% Write agent config + %% + + Vsns = [v1], + ManagerConfDir = ?config(manager_top_dir, Config), + AgentConfDir = ?config(agent_conf_dir, Config), + AgentTopDir = ?config(agent_top_dir, Config), + AgentBkpDir1 = join([AgentTopDir, backup1]), + AgentBkpDir2 = join([AgentTopDir, backup2]), + ok = file:make_dir(AgentBkpDir1), + ok = file:make_dir(AgentBkpDir2), + AgentBkpDirs = [AgentBkpDir1, AgentBkpDir2], + config(Vsns, ManagerConfDir, AgentConfDir, ManagerIP, AgentIP, IpFamily), + + + %% -- + %% Start the agent + %% + + Config2 = start_agent([{host, Host}, + {ip, Ip}, + {agent_node, AgentNode}, + {agent_host, AgentHost}, + {agent_ip, AgentIP}, + {agent_backup_dirs, AgentBkpDirs}|Config]), + + %% -- + %% Create watchdog + %% + + Dog = ?WD_START(?MINS(1)), + + [{watchdog, Dog} | Config2]. + +fin_v1_agent(Config) -> + AgentNode = ?config(agent_node, Config), + ManagerNode = ?config(manager_node, Config), + + %% - + %% Stop agent (this is the nice way to do it, + %% so logs and files can be closed in the proper way). + %% + + AgentSup = ?config(agent_sup, Config), + stop_stdalone_agent(AgentSup), + + %% - + %% Stop mnesia + %% + mnesia_stop(AgentNode), + + + %% - + %% Stop the agent node + %% + stop_node(AgentNode), + + + %% SubAgentNode = ?config(sub_agent_node, Config), + %% stop_node(SubAgentNode), + + + %% - + %% Stop the manager node + %% + stop_node(ManagerNode), + + Dog = ?config(watchdog, Config), + ?WD_STOP(Dog), + lists:keydelete(watchdog, 1, Config). + + + +config_ipfamily(Config) -> + case ?config(ipfamily, Config) of + undefined -> + inet; + Value -> + Value + end. diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl index d7109253f7..333fe6eb66 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-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. All Rights Reserved. %% %% The 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 @@ get_req/2, get_next_req/1, - config/5, + config/5, config/6, delete_files/1, copy_file/2, update_usm/2, @@ -232,13 +232,14 @@ init_case(Config) when is_list(Config) -> MgrNode = ?config(snmp_mgr, Config), MasterNode = ?config(snmp_master, Config), %% MasterNode = node(), - + IpFamily = proplists:get_value(ipfamily, Config, inet), + SaHost = ?HOSTNAME(SaNode), MgrHost = ?HOSTNAME(MgrNode), MasterHost = ?HOSTNAME(MasterNode), - {ok, MasterIP} = snmp_misc:ip(MasterHost), - {ok, MIP} = snmp_misc:ip(MgrHost), - {ok, SIP} = snmp_misc:ip(SaHost), + {ok, MasterIP} = snmp_misc:ip(MasterHost, IpFamily), + {ok, MIP} = snmp_misc:ip(MgrHost, IpFamily), + {ok, SIP} = snmp_misc:ip(SaHost, IpFamily), put(mgr_node, MgrNode), @@ -250,6 +251,7 @@ init_case(Config) when is_list(Config) -> put(mip, tuple_to_list(MIP)), put(masterip, tuple_to_list(MasterIP)), put(sip, tuple_to_list(SIP)), + put(ipfamily, IpFamily), MibDir = ?config(mib_dir, Config), put(mib_dir, MibDir), @@ -358,6 +360,7 @@ run(Mod, Func, Args, Opts) -> {packet_server_debug,true}, {debug,true}, {agent, get(master_host)}, + {ipfamily, get(ipfamily)}, {agent_udp, 4000}, {trap_udp, 5000}, {recbuf,65535}, @@ -1368,16 +1371,35 @@ stop_node(Node) -> %%%----------------------------------------------------------------- config(Vsns, MgrDir, AgentConfDir, MIp, AIp) -> + config(Vsns, MgrDir, AgentConfDir, MIp, AIp, inet). + +config(Vsns, MgrDir, AgentConfDir, MIp, AIp, IpFamily) -> ?LOG("config -> entry with" - "~n Vsns: ~p" - "~n MgrDir: ~p" - "~n AgentConfDir: ~p" - "~n MIp: ~p" - "~n AIp: ~p", - [Vsns, MgrDir, AgentConfDir, MIp, AIp]), - ?line snmp_config:write_agent_snmp_files(AgentConfDir, Vsns, - MIp, ?TRAP_UDP, AIp, 4000, - "test"), + "~n Vsns: ~p" + "~n MgrDir: ~p" + "~n AgentConfDir: ~p" + "~n MIp: ~p" + "~n AIp: ~p" + "~n IpFamily: ~p", + [Vsns, MgrDir, AgentConfDir, MIp, AIp, IpFamily]), + ?line {Domain, ManagerAddr} = + case IpFamily of + inet6 -> + Ipv6Domain = transportDomainUdpIpv6, + AgentIpv6Addr = {AIp, 4000}, + ManagerIpv6Addr = {MIp, ?TRAP_UDP}, + ?line ok = + snmp_config:write_agent_snmp_files( + AgentConfDir, Vsns, + Ipv6Domain, ManagerIpv6Addr, AgentIpv6Addr, "test"), + {Ipv6Domain, ManagerIpv6Addr}; + _ -> + ?line ok = + snmp_config:write_agent_snmp_files( + AgentConfDir, Vsns, MIp, ?TRAP_UDP, AIp, 4000, "test"), + {snmpUDPDomain, {MIp, ?TRAP_UDP}} + end, + ?line case update_usm(Vsns, AgentConfDir) of true -> ?line copy_file(join(AgentConfDir, "usm.conf"), @@ -1388,7 +1410,7 @@ config(Vsns, MgrDir, AgentConfDir, MIp, AIp) -> end, ?line update_community(Vsns, AgentConfDir), ?line update_vacm(Vsns, AgentConfDir), - ?line write_target_addr_conf(AgentConfDir, MIp, ?TRAP_UDP, Vsns), + ?line write_target_addr_conf(AgentConfDir, Domain, ManagerAddr, Vsns), ?line write_target_params_conf(AgentConfDir, Vsns), ?line write_notify_conf(AgentConfDir), ok. @@ -1486,7 +1508,7 @@ rewrite_usm_mgr(Dir, ShaKey, DesKey) -> {"mgrEngine", "newUser", "newUser", zeroDotZero, usmHMACSHAAuthProtocol, "", "", usmDESPrivProtocol, "", "", "", ShaKey, DesKey}], - ok = snmp_config:write_agent_usm_config(Dir, "", Conf). + ?line ok = snmp_config:write_agent_usm_config(Dir, "", Conf). reset_usm_mgr(Dir) -> ?line ok = file:rename(join(Dir,"usm.old"), @@ -1512,13 +1534,15 @@ update_vacm(_Vsn, Dir) -> write_community_conf(Dir, Conf) -> - snmp_config:write_agent_community_config(Dir, "", Conf). + ?line ok = snmp_config:write_agent_community_config(Dir, "", Conf). write_target_addr_conf(Dir, Conf) -> - snmp_config:write_agent_target_addr_config(Dir, "", Conf). + ?line ok = snmp_config:write_agent_target_addr_config(Dir, "", Conf). -write_target_addr_conf(Dir, ManagerIp, UDP, Vsns) -> - snmp_config:write_agent_snmp_target_addr_conf(Dir, ManagerIp, UDP, Vsns). +write_target_addr_conf(Dir, Ip_or_Domain, Port_or_Addr, Vsns) -> + ?line ok = + snmp_config:write_agent_snmp_target_addr_conf( + Dir, Ip_or_Domain, Port_or_Addr, Vsns). rewrite_target_addr_conf(Dir, NewPort) -> ?DBG("rewrite_target_addr_conf -> entry with" @@ -1534,8 +1558,7 @@ rewrite_target_addr_conf(Dir, NewPort) -> end, ?line [TrapAddr|Addrs] = - snmp_conf:read(TAFile, - fun(R) -> rewrite_target_addr_conf_check(R) end), + snmp_conf:read(TAFile, fun rewrite_target_addr_conf_check/1), ?DBG("rewrite_target_addr_conf -> TrapAddr: ~p",[TrapAddr]), @@ -1571,14 +1594,14 @@ write_target_params_conf(Dir, Vsns) -> (v3) -> {"target_v3", v3, usm, "all-rights", noAuthNoPriv} end, Conf = [F(Vsn) || Vsn <- Vsns], - snmp_config:write_agent_target_params_config(Dir, "", Conf). + ?line ok = snmp_config:write_agent_target_params_config(Dir, "", Conf). rewrite_target_params_conf(Dir, SecName, SecLevel) when is_list(SecName) andalso is_atom(SecLevel) -> ?line ok = file:rename(join(Dir,"target_params.conf"), join(Dir,"target_params.old")), Conf = [{"target_v3", v3, usm, SecName, SecLevel}], - snmp_config:write_agent_target_params_config(Dir, "", Conf). + ?line ok = snmp_config:write_agent_target_params_config(Dir, "", Conf). reset_target_params_conf(Dir) -> ?line ok = file:rename(join(Dir,"target_params.old"), @@ -1587,12 +1610,12 @@ reset_target_params_conf(Dir) -> write_notify_conf(Dir) -> Conf = [{"standard trap", "std_trap", trap}, {"standard inform", "std_inform", inform}], - snmp_config:write_agent_notify_config(Dir, "", Conf). + ?line ok = snmp_config:write_agent_notify_config(Dir, "", Conf). write_view_conf(Dir) -> Conf = [{2, [1,3,6], included, null}, {2, ?tDescr_instance, excluded, null}], - snmp_config:write_agent_view_config(Dir, "", Conf). + ?line ok = snmp_config:write_agent_view_config(Dir, "", Conf). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/snmp/test/snmp_conf_test.erl b/lib/snmp/test/snmp_conf_test.erl index c4341d8d7e..7f5d11c0e7 100644 --- a/lib/snmp/test/snmp_conf_test.erl +++ b/lib/snmp/test/snmp_conf_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 2003-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -373,6 +373,8 @@ verify_ip(Val) -> case (catch snmp_conf:check_ip(Val)) of {error, Reason} -> ?FAIL({verify_ip, Val, Reason}); + {ok, _} -> + ok; ok -> ok end. @@ -401,7 +403,7 @@ check_taddress(Config) when is_list(Config) -> ok. verify_taddress(Val) -> - case (catch snmp_conf:check_taddress(Val)) of + case (catch snmp_conf:check_taddress(snmpUDPDomain, Val)) of {error, Reason} -> ?FAIL({verify_taddress, Val, Reason}); ok -> @@ -409,7 +411,7 @@ verify_taddress(Val) -> end. verify_not_taddress(Val) -> - case (catch snmp_conf:check_taddress(Val)) of + case (catch snmp_conf:check_taddress(snmpUDPDomain, Val)) of ok -> ?FAIL({verify_taddress, Val}); {error, _Reason} -> diff --git a/lib/snmp/test/snmp_manager_config_test.erl b/lib/snmp/test/snmp_manager_config_test.erl index 7b9924b83c..f37e957dae 100644 --- a/lib/snmp/test/snmp_manager_config_test.erl +++ b/lib/snmp/test/snmp_manager_config_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -693,7 +693,7 @@ start_with_invalid_manager_conf_file1(Conf) when is_list(Conf) -> "arne_anka", "4001", "500", "\"bmkEngine\""), ?line {error, Reason12} = config_start(Opts), p("start failed (as expected): ~p", [Reason12]), - ?line {failed_check, _, _, 2, {invalid_ip_address, _}} = Reason12, + ?line {failed_check, _, _, 2, {bad_address, _}} = Reason12, await_config_not_running(), %% -- @@ -702,7 +702,7 @@ start_with_invalid_manager_conf_file1(Conf) when is_list(Conf) -> "9999", "4001", "500", "\"bmkEngine\""), ?line {error, Reason13} = config_start(Opts), p("start failed (as expected): ~p", [Reason13]), - ?line {failed_check, _, _, 2, {invalid_ip_address, _}} = Reason13, + ?line {failed_check, _, _, 2, {bad_address, _}} = Reason13, await_config_not_running(), %% -- @@ -720,7 +720,8 @@ start_with_invalid_manager_conf_file1(Conf) when is_list(Conf) -> "[134,138,177,189]", "-1", "500", "\"bmkEngine\""), ?line {error, Reason22} = config_start(Opts), p("start failed (as expected): ~p", [Reason22]), - ?line {failed_check, _, _, 3, {invalid_integer, _}} = Reason22, + io:format("Reason22: ~p~n", [Reason22]), + ?line {failed_check, _, _, 3, {bad_port, _}} = Reason22, await_config_not_running(), %% -- @@ -729,7 +730,7 @@ start_with_invalid_manager_conf_file1(Conf) when is_list(Conf) -> "[134,138,177,189]", "\"kalle-anka\"", "500", "\"bmkEngine\""), ?line {error, Reason23} = config_start(Opts), p("start failed (as expected): ~p", [Reason23]), - ?line {failed_check, _, _, 3, {invalid_integer, _}} = Reason23, + ?line {failed_check, _, _, 3, {bad_port, _}} = Reason23, await_config_not_running(), %% -- @@ -1047,7 +1048,7 @@ start_with_invalid_agents_conf_file1(Conf) when is_list(Conf) -> case config_start(Opts) of {error, Reason51} -> p("start failed (as expected): ~p", [Reason51]), - ?line {failed_check, _, _, _, {bad_address, _}} = Reason51, + ?line {failed_check, _, _, _, {bad_domain, _}} = Reason51, await_config_not_running(); OK_51 -> exit({error, {unexpected_success, "51", OK_51}}) @@ -1073,7 +1074,7 @@ start_with_invalid_agents_conf_file1(Conf) when is_list(Conf) -> case config_start(Opts) of {error, Reason53} -> p("start failed (as expected): ~p", [Reason53]), - ?line {failed_check, _, _, _, {invalid_ip_address, _}} = Reason53, + ?line {failed_check, _, _, _, {bad_address, _}} = Reason53, await_config_not_running(); OK_53 -> exit({error, {unexpected_success, "53", OK_53}}) @@ -1086,7 +1087,7 @@ start_with_invalid_agents_conf_file1(Conf) when is_list(Conf) -> case config_start(Opts) of {error, Reason54} -> p("start failed (as expected): ~p", [Reason54]), - ?line {failed_check, _, _, _, {invalid_ip_address, _}} = Reason54, + ?line {failed_check, _, _, _, {bad_address, _}} = Reason54, await_config_not_running(); OK_54 -> exit({error, {unexpected_success, "54", OK_54}}) @@ -1098,7 +1099,7 @@ start_with_invalid_agents_conf_file1(Conf) when is_list(Conf) -> write_agents_conf(ConfDir, [Agent55]), ?line {error, Reason55} = config_start(Opts), p("start failed (as expected): ~p", [Reason55]), - ?line {failed_check, _, _, _, {invalid_ip_address, _}} = Reason55, + ?line {failed_check, _, _, _, {bad_address, _}} = Reason55, await_config_not_running(), %% -- @@ -1107,7 +1108,7 @@ start_with_invalid_agents_conf_file1(Conf) when is_list(Conf) -> write_agents_conf(ConfDir, [Agent61]), ?line {error, Reason61} = config_start(Opts), p("start failed (as expected): ~p", [Reason61]), - ?line {failed_check, _, _, _, {invalid_integer, _}} = Reason61, + ?line {failed_check, _, _, _, {bad_address, _}} = Reason61, await_config_not_running(), %% -- @@ -1116,7 +1117,7 @@ start_with_invalid_agents_conf_file1(Conf) when is_list(Conf) -> write_agents_conf(ConfDir, [Agent62]), ?line {error, Reason62} = config_start(Opts), p("start failed (as expected): ~p", [Reason62]), - ?line {failed_check, _, _, _, {invalid_integer, _}} = Reason62, + ?line {failed_check, _, _, _, {bad_address, _}} = Reason62, await_config_not_running(), %% -- @@ -1125,7 +1126,7 @@ start_with_invalid_agents_conf_file1(Conf) when is_list(Conf) -> write_agents_conf(ConfDir, [Agent63]), ?line {error, Reason63} = config_start(Opts), p("start failed (as expected): ~p", [Reason63]), - ?line {failed_check, _, _, _, {invalid_integer, _}} = Reason63, + ?line {failed_check, _, _, _, {bad_address, _}} = Reason63, await_config_not_running(), %% -- diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl index 3a654a2805..fa90872172 100644 --- a/lib/snmp/test/snmp_manager_test.erl +++ b/lib/snmp/test/snmp_manager_test.erl @@ -241,8 +241,11 @@ init_per_testcase2(Case, Config) -> AgLogDir = filename:join(AgTopDir, "log/"), ?line ok = file:make_dir(AgLogDir), + Family = proplists:get_value(ipfamily, Config, inet), + Conf = [{watchdog, ?WD_START(?MINS(5))}, - {ip, ?LOCALHOST()}, + {ipfamily, Family}, + {ip, ?LOCALHOST(Family)}, {case_top_dir, CaseTopDir}, {agent_dir, AgTopDir}, {agent_conf_dir, AgConfDir}, @@ -410,7 +413,9 @@ all() -> {group, event_tests}, {group, event_tests_mt}, discovery, - {group, tickets} + {group, tickets}, + {group, ipv6}, + {group, ipv6_mt} ]. groups() -> @@ -545,9 +550,29 @@ groups() -> [ otp8395_1 ] - } + }, + {ipv6, [], ipv6_tests()}, + {ipv6_mt, [], ipv6_tests()} + + ]. + +ipv6_tests() -> + [ + register_agent1, + simple_sync_get_next3, + simple_async_get2, + simple_sync_get3, + simple_async_get_next2, + simple_sync_set3, + simple_async_set2, + simple_sync_get_bulk2, + simple_async_get_bulk3, + misc_async2, + inform1, + inform_swarm ]. + init_per_group(request_tests_mt = GroupName, Config) -> snmp_test_lib:init_group_top_dir( GroupName, @@ -556,10 +581,39 @@ init_per_group(event_tests_mt = GroupName, Config) -> snmp_test_lib:init_group_top_dir( GroupName, [{manager_net_if_module, snmpm_net_if_mt} | Config]); +init_per_group(ipv6_mt = GroupName, Config) -> + case ct:require(ipv6_hosts) of + ok -> + case gen_udp:open(0, [inet6]) of + {ok, S} -> + ok = gen_udp:close(S), + ipv6_init( + snmp_test_lib:init_group_top_dir( + GroupName, + [{manager_net_if_module, snmpm_net_if_mt} + | Config])); + {error, _} -> + {skip, "Host seems to not support IPv6"} + end; + _ -> + {skip, "Host does not support IPV6"} + end; +init_per_group(ipv6 = GroupName, Config) -> + case ct:require(ipv6_hosts) of + ok -> + case gen_udp:open(0, [inet6]) of + {ok, S} -> + ok = gen_udp:close(S), + ipv6_init(snmp_test_lib:init_group_top_dir(GroupName, Config)); + {error, _} -> + {skip, "Host seems to not support IPv6"} + end; + _ -> + {skip, "Host does not support IPV6"} + end; init_per_group(GroupName, Config) -> snmp_test_lib:init_group_top_dir(GroupName, Config). - - + end_per_group(_GroupName, Config) -> %% Do we really need to do this? lists:keydelete(snmp_group_top_dir, 1, Config). @@ -1508,7 +1562,7 @@ register_agent3(Config) when is_list(Config) -> TargetName2 = "agent3", ?line ok = mgr_register_agent(ManagerNode, user_alfa, TargetName2, [{tdomain, transportDomainUdpIpv6}, - {address, LocalHost}, + {address, {0,0,0,0,0,0,0,1}}, {port, 5002}, {engine_id, "agentEngineId-2"}]), TargetName3 = "agent4", @@ -5074,7 +5128,7 @@ inform_swarm_collector(N) -> inform_swarm_collector(N, SentAckCnt, RecvCnt, RespCnt, _) when ((N == SentAckCnt) and (N == RespCnt) and - (N >= RecvCnt)) -> + (N =< RecvCnt)) -> p("inform_swarm_collector -> done when" "~n N: ~w" "~n SentAckCnt: ~w" @@ -5750,12 +5804,24 @@ fin_mgr_user(Conf) -> init_mgr_user_data1(Conf) -> Node = ?config(manager_node, Conf), TargetName = ?config(manager_agent_target_name, Conf), - Addr = ?config(ip, Conf), + IpFamily = ?config(ipfamily, Conf), + Ip = ?config(ip, Conf), Port = ?AGENT_PORT, - ?line ok = mgr_user_register_agent(Node, TargetName, - [{address, Addr}, - {port, Port}, - {engine_id, "agentEngine"}]), + ?line ok = + case IpFamily of + inet -> + mgr_user_register_agent( + Node, TargetName, + [{address, Ip}, + {port, Port}, + {engine_id, "agentEngine"}]); + inet6 -> + mgr_user_register_agent( + Node, TargetName, + [{tdomain, transportDomainUdpIpv6}, + {taddress, {Ip, Port}}, + {engine_id, "agentEngine"}]) + end, _Agents = mgr_user_which_own_agents(Node), ?DBG("Own agents: ~p", [_Agents]), @@ -5780,12 +5846,24 @@ init_mgr_user_data2(Conf) -> "~n Conf: ~p", [Conf]), Node = ?config(manager_node, Conf), TargetName = ?config(manager_agent_target_name, Conf), - Addr = ?config(ip, Conf), + IpFamily = ?config(ipfamily, Conf), + Ip = ?config(ip, Conf), Port = ?AGENT_PORT, - ?line ok = mgr_user_register_agent(Node, TargetName, - [{address, Addr}, - {port, Port}, - {engine_id, "agentEngine"}]), + ?line ok = + case IpFamily of + inet -> + mgr_user_register_agent( + Node, TargetName, + [{address, Ip}, + {port, Port}, + {engine_id, "agentEngine"}]); + inet6 -> + mgr_user_register_agent( + Node, TargetName, + [{tdomain, transportDomainUdpIpv6}, + {taddress, {Ip, Port}}, + {engine_id, "agentEngine"}]) + end, _Agents = mgr_user_which_own_agents(Node), ?DBG("Own agents: ~p", [_Agents]), @@ -6182,10 +6260,16 @@ await_stopped(Node, N) -> write_manager_config(Config) -> Dir = ?config(manager_conf_dir, Config), - Ip = ?config(ip, Config), - Addr = tuple_to_list(Ip), - snmp_config:write_manager_snmp_files(Dir, Addr, ?MGR_PORT, - ?MGR_MMS, ?MGR_ENGINE_ID, [], [], []). + Ip = tuple_to_list(?config(ip, Config)), + {Addr, Port} = + case ?config(ipfamily, Config) of + inet -> + {Ip, ?MGR_PORT}; + inet6 -> + {transportDomainUdpIpv6, {Ip, ?MGR_PORT}} + end, + snmp_config:write_manager_snmp_files( + Dir, Addr, Port, ?MGR_MMS, ?MGR_ENGINE_ID, [], [], []). write_manager_conf(Dir) -> Port = "5000", @@ -6214,25 +6298,27 @@ write_manager_conf(Dir, Str) -> write_agent_config(Vsns, Conf) -> Dir = ?config(agent_conf_dir, Conf), - Ip = ?config(ip, Conf), - ?line Addr = tuple_to_list(Ip), - ?line ok = write_agent_config_files(Dir, Vsns, Addr), + ?line Ip = tuple_to_list(?config(ip, Conf)), + ?line Domain = + case ?config(ipfamily, Conf) of + inet -> + snmpUDPDomain; + inet6 -> + transportDomainUdpIpv6 + end, + ?line ok = write_agent_config_files(Dir, Vsns, Domain, Ip), ?line ok = update_agent_usm(Vsns, Dir), ?line ok = update_agent_community(Vsns, Dir), ?line ok = update_agent_vacm(Vsns, Dir), - ?line ok = write_agent_target_addr_conf(Dir, Addr, Vsns), + ?line ok = write_agent_target_addr_conf(Dir, Domain, Ip, Vsns), ?line ok = write_agent_target_params_conf(Dir, Vsns), ?line ok = write_agent_notify_conf(Dir), ok. -write_agent_config_files(Dir, Vsns, Addr) -> - snmp_config:write_agent_snmp_files(Dir, Vsns, - Addr, ?MGR_PORT, - Addr, ?AGENT_PORT, - "mgr-test", "trap", - none, "", - ?AGENT_ENGINE_ID, - ?AGENT_MMS). +write_agent_config_files(Dir, Vsns, Domain, Ip) -> + snmp_config:write_agent_snmp_files( + Dir, Vsns, Domain, {Ip, ?MGR_PORT}, {Ip, ?AGENT_PORT}, "mgr-test", + trap, none, "", ?AGENT_ENGINE_ID, ?AGENT_MMS). update_agent_usm(Vsns, Dir) -> case lists:member(v3, Vsns) of @@ -6300,9 +6386,9 @@ update_agent_vacm(_Vsns, Dir) -> excluded, null}], snmp_config:update_agent_vacm_config(Dir, Conf). -write_agent_target_addr_conf(Dir, Addr, Vsns) -> - snmp_config:write_agent_snmp_target_addr_conf(Dir, Addr, ?MGR_PORT, - 300, 3, Vsns). +write_agent_target_addr_conf(Dir, Domain, Ip, Vsns) -> + snmp_config:write_agent_snmp_target_addr_conf( + Dir, Domain, {Ip, ?MGR_PORT}, 300, 3, Vsns). write_agent_target_params_conf(Dir, Vsns) -> F = fun(v1) -> {"target_v1", v1, v1, "all-rights", noAuthNoPriv}; @@ -6426,3 +6512,5 @@ formated_timestamp() -> %% p(TName, F, A) -> %% io:format("~w -> " ++ F ++ "~n", [TName|A]). +ipv6_init(Config) when is_list(Config) -> + [{ipfamily, inet6} | Config]. diff --git a/lib/snmp/test/snmp_manager_user.erl b/lib/snmp/test/snmp_manager_user.erl index ddbe156130..46c2b316be 100644 --- a/lib/snmp/test/snmp_manager_user.erl +++ b/lib/snmp/test/snmp_manager_user.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -109,7 +109,18 @@ start_link(Parent, Id) -> proc_lib:start_link(?MODULE, main, [true, Parent, self(), Id]). stop() -> - cast(stop). + MRef = erlang:monitor(process, ?SERVER), + cast(stop), + receive {'DOWN', MRef, _, _, Info} -> + case Info of + noproc -> + ok; + noconnection -> + ok; + normal -> + ok + end + end. info() -> call(info). diff --git a/lib/snmp/test/snmp_test_lib.erl b/lib/snmp/test/snmp_test_lib.erl index fbb891e40d..5e611340a3 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-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-2014. All Rights Reserved. %% %% The 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,7 +22,7 @@ -include_lib("kernel/include/file.hrl"). --export([hostname/0, hostname/1, localhost/0, os_type/0, sz/1, +-export([hostname/0, hostname/1, localhost/0, localhost/1, os_type/0, sz/1, display_suite_info/1]). -export([non_pc_tc_maybe_skip/4, os_based_skip/1]). -export([fix_data_dir/1, @@ -60,6 +60,9 @@ from(_H, []) -> []. localhost() -> {ok, Ip} = snmp_misc:ip(net_adm:localhost()), Ip. +localhost(Family) -> + {ok, Ip} = snmp_misc:ip(net_adm:localhost(), Family), + Ip. sz(L) when is_list(L) -> length(L); diff --git a/lib/snmp/test/snmp_test_lib.hrl b/lib/snmp/test/snmp_test_lib.hrl index 8cc3f75dc5..9b7609b831 100644 --- a/lib/snmp/test/snmp_test_lib.hrl +++ b/lib/snmp/test/snmp_test_lib.hrl @@ -1,5 +1,5 @@ %%<copyright> -%% <year>2002-2008</year> +%% <year>2002-2014</year> %% <holder>Ericsson AB, All Rights Reserved</holder> %%</copyright> %%<legalnotice> @@ -32,14 +32,15 @@ -define(APPLICATION, snmp). -endif. --define(SCONF(K,D,C), snmp_test_lib:set_config(K,D,C)). --define(GCONF(K,C), snmp_test_lib:get_config(K,C)). --define(RCONF(K,C,V), snmp_test_lib:replace_config(K,C,V)). --define(HOSTNAME(N), snmp_test_lib:hostname(N)). --define(LOCALHOST(), snmp_test_lib:localhost()). --define(SZ(X), snmp_test_lib:sz(X)). --define(OSTYPE(), snmp_test_lib:os_type()). --define(DISPLAY_SUITE_INFO(), snmp_test_lib:display_suite_info(?MODULE)). +-define(SCONF(K,D,C), snmp_test_lib:set_config(K,D,C)). +-define(GCONF(K,C), snmp_test_lib:get_config(K,C)). +-define(RCONF(K,C,V), snmp_test_lib:replace_config(K,C,V)). +-define(HOSTNAME(N), snmp_test_lib:hostname(N)). +-define(LOCALHOST(), snmp_test_lib:localhost()). +-define(LOCALHOST(Family), snmp_test_lib:localhost(Family)). +-define(SZ(X), snmp_test_lib:sz(X)). +-define(OSTYPE(), snmp_test_lib:os_type()). +-define(DISPLAY_SUITE_INFO(), snmp_test_lib:display_suite_info(?MODULE)). %% - Test case macros - diff --git a/lib/snmp/test/snmp_test_mgr.erl b/lib/snmp/test/snmp_test_mgr.erl index d4eb00ff91..cf62edba1c 100644 --- a/lib/snmp/test/snmp_test_mgr.erl +++ b/lib/snmp/test/snmp_test_mgr.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The 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,23 @@ init({Options, CallerPid}) -> VsnHdrD = {Com, User, EngineId, CtxEngineId, mk_seclevel(SecLevel)}, io:format("[~w] ~p -> VsnHdrD: ~p~n", [?MODULE, self(), VsnHdrD]), + IpFamily = get_value(ipfamily, Options, inet), + io:format("[~w] ~p -> IpFamily: ~p~n", [?MODULE, self(), IpFamily]), AgIp = case snmp_misc:assq(agent, Options) of {value, Tuple4} when is_tuple(Tuple4) andalso (size(Tuple4) =:= 4) -> Tuple4; {value, Host} when is_list(Host) -> - {ok, Ip} = snmp_misc:ip(Host), + {ok, Ip} = snmp_misc:ip(Host, IpFamily), Ip end, io:format("[~w] ~p -> AgIp: ~p~n", [?MODULE, self(), AgIp]), Quiet = lists:member(quiet, Options), io:format("[~w] ~p -> Quiet: ~p~n", [?MODULE, self(), Quiet]), - PackServ = start_packet_server(Quiet, Options, CallerPid, - AgIp, Udp, TrapUdp, - VsnHdrD, Version, Dir, RecBufSz, - PacksDbg), + PackServ = + start_packet_server( + Quiet, Options, CallerPid, AgIp, Udp, TrapUdp, + VsnHdrD, Version, Dir, RecBufSz, PacksDbg, IpFamily), d("init -> packet server: ~p",[PackServ]), State = #state{parent = CallerPid, quiet = Quiet, @@ -263,23 +265,21 @@ init({Options, CallerPid}) -> end. start_packet_server(false, _Options, _CallerPid, AgIp, Udp, TrapUdp, - VsnHdrD, Version, Dir, RecBufSz, PacksDbg) -> + VsnHdrD, Version, Dir, RecBufSz, PacksDbg, IpFamily) -> d("start_packet_server -> entry", []), - ?PACK_SERV:start_link_packet({msg, self()}, - AgIp, Udp, TrapUdp, - VsnHdrD, Version, Dir, RecBufSz, - PacksDbg); + ?PACK_SERV:start_link_packet( + {msg, self()}, AgIp, Udp, TrapUdp, + VsnHdrD, Version, Dir, RecBufSz, PacksDbg, IpFamily); start_packet_server(true, Options, CallerPid, AgIp, Udp, TrapUdp, - VsnHdrD, Version, Dir, RecBufSz, PacksDbg) -> + VsnHdrD, Version, Dir, RecBufSz, PacksDbg, IpFamily) -> Type = get_value(receive_type, Options, pdu), d("start_packet_server -> entry with" "~n CallerPid: ~p" "~n when" "~n Type: ~p",[CallerPid, Type]), - ?PACK_SERV:start_link_packet({Type, CallerPid}, - AgIp, Udp, TrapUdp, - VsnHdrD, Version, Dir, RecBufSz, - PacksDbg). + ?PACK_SERV:start_link_packet( + {Type, CallerPid}, AgIp, Udp, TrapUdp, + VsnHdrD, Version, Dir, RecBufSz, PacksDbg, IpFamily). is_options_ok([{mibs,List}|Opts]) when is_list(List) -> is_options_ok(Opts); @@ -287,6 +287,10 @@ is_options_ok([quiet|Opts]) -> is_options_ok(Opts); is_options_ok([{agent,_}|Opts]) -> is_options_ok(Opts); +is_options_ok([{ipfamily,IpFamily}|Opts]) + when IpFamily =:= inet; + IpFamily =:= inet6 -> + is_options_ok(Opts); is_options_ok([{agent_udp,Int}|Opts]) when is_integer(Int) -> is_options_ok(Opts); is_options_ok([{trap_udp,Int}|Opts]) when is_integer(Int) -> diff --git a/lib/snmp/test/snmp_test_mgr_misc.erl b/lib/snmp/test/snmp_test_mgr_misc.erl index 5525c5c3ec..5274dcacd9 100644 --- a/lib/snmp/test/snmp_test_mgr_misc.erl +++ b/lib/snmp/test/snmp_test_mgr_misc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The 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 @@ -module(snmp_test_mgr_misc). %% API --export([start_link_packet/8, start_link_packet/9, +-export([start_link_packet/8, start_link_packet/9, start_link_packet/10, stop/1, send_discovery_pdu/2, send_pdu/2, send_msg/4, send_bytes/2, @@ -31,7 +31,7 @@ get_pdu/1, set_pdu/2, format_hdr/1]). %% internal exports --export([init_packet/10]). +-export([init_packet/11]). -compile({no_auto_import, [error/2]}). @@ -42,22 +42,26 @@ %%---------------------------------------------------------------------- %% The InHandler process will receive messages on the form {snmp_pdu, Pdu}. %%---------------------------------------------------------------------- -start_link_packet(InHandler, - AgentIp, UdpPort, TrapUdp, - VsnHdr, Version, Dir, BufSz) -> - start_link_packet(InHandler, - AgentIp, UdpPort, TrapUdp, - VsnHdr, Version, Dir, BufSz, - false). - -start_link_packet(InHandler, - AgentIp, UdpPort, TrapUdp, - VsnHdr, Version, Dir, BufSz, - Dbg) when is_integer(UdpPort) -> - Args = [self(), InHandler, - AgentIp, UdpPort, TrapUdp, - VsnHdr, Version, Dir, BufSz, - Dbg], +start_link_packet( + InHandler, AgentIp, UdpPort, TrapUdp, VsnHdr, Version, Dir, BufSz) -> + start_link_packet( + InHandler, AgentIp, UdpPort, TrapUdp, VsnHdr, Version, Dir, BufSz, + false). + +start_link_packet( + InHandler, AgentIp, UdpPort, TrapUdp, VsnHdr, Version, Dir, BufSz, + Dbg) -> + start_link_packet( + InHandler, AgentIp, UdpPort, TrapUdp, VsnHdr, Version, Dir, BufSz, + Dbg, inet). + +start_link_packet( + InHandler, AgentIp, UdpPort, TrapUdp, VsnHdr, Version, Dir, BufSz, + Dbg, IpFamily) when is_integer(UdpPort) -> + Args = + [self(), + InHandler, AgentIp, UdpPort, TrapUdp, VsnHdr, Version, Dir, BufSz, + Dbg, IpFamily], proc_lib:start_link(?MODULE, init_packet, Args). stop(Pid) -> @@ -90,12 +94,14 @@ send_bytes(Bytes, PacketPid) -> %%-------------------------------------------------- %% The SNMP encode/decode process %%-------------------------------------------------- -init_packet(Parent, SnmpMgr, - AgentIp, UdpPort, TrapUdp, - VsnHdr, Version, Dir, BufSz, DbgOptions) -> +init_packet( + Parent, + SnmpMgr, AgentIp, UdpPort, TrapUdp, VsnHdr, Version, Dir, BufSz, + DbgOptions, IpFamily) -> put(sname, mgr_misc), init_debug(DbgOptions), - {ok, UdpId} = gen_udp:open(TrapUdp, [{recbuf,BufSz},{reuseaddr, true}]), + {ok, UdpId} = + gen_udp:open(TrapUdp, [{recbuf,BufSz}, {reuseaddr, true}, IpFamily]), put(msg_id, 1), proc_lib:init_ack(Parent, self()), init_usm(Version, Dir), diff --git a/lib/snmp/test/snmp_to_snmpnet_SUITE.erl b/lib/snmp/test/snmp_to_snmpnet_SUITE.erl new file mode 100644 index 0000000000..2f96493ac5 --- /dev/null +++ b/lib/snmp/test/snmp_to_snmpnet_SUITE.erl @@ -0,0 +1,559 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2014. All Rights Reserved. +%% +%% The 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% +%% +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% This test suite uses the following external programs: +%% snmpget From packet 'snmp' (in Ubuntu 12.04) +%% snmpd From packet 'snmpd' (in Ubuntu 12.04) +%% snmptrapd From packet 'snmpd' (in Ubuntu 12.04) +%% They originate from the Net-SNMP applications, see: +%% http://net-snmp.sourceforge.net/ + + +-module(snmp_to_snmpnet_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("snmp/include/STANDARD-MIB.hrl"). + +-define(AGENT_ENGINE_ID, "ErlangSnmpAgent"). +-define(MANAGER_ENGINE_ID, "ErlangSnmpManager"). +-define(AGENT_PORT, 4000). +-define(MANAGER_PORT, 8989). +-define(DEFAULT_MAX_MESSAGE_SIZE, 484). + +expected(?sysDescr_instance = Oid, get) -> + OidStr = oid_str(Oid), + iolist_to_binary([OidStr | " = STRING: \"Erlang SNMP agent\""]). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + {group, ipv4}, + {group, ipv6}, + {group, ipv4_ipv6} + ]. + +groups() -> + [{ipv4, [], + [{group, snmpget}, + {group, snmptrapd}, + {group, snmpd_mt}, + {group, snmpd} + ]}, + {ipv6, [], + [{group, snmpget}, + {group, snmptrapd}, + {group, snmpd_mt}, + {group, snmpd} + ]}, + {ipv4_ipv6, [], + [{group, snmpget}, + {group, snmptrapd}, + {group, snmpd_mt}, + {group, snmpd} + ]}, + %% + {snmpget, [], + [erlang_agent_netsnmp_get]}, + {snmptrapd, [], + [erlang_agent_netsnmp_inform]}, + {snmpd_mt, [], + [erlang_manager_netsnmp_get]}, + {snmpd, [], + [erlang_manager_netsnmp_get]} + ]. + +init_per_suite(Config) -> + [{agent_port, ?AGENT_PORT}, {manager_port, ?MANAGER_PORT} | Config]. + +end_per_suite(_Config) -> + ok. + +init_per_group(ipv4, Config) -> + init_per_group_ip([inet], Config); +init_per_group(ipv6, Config) -> + init_per_group_ipv6([inet6], Config); +init_per_group(ipv4_ipv6, Config) -> + init_per_group_ipv6([inet, inet6], Config); +%% +init_per_group(snmpget = Exec, Config) -> + %% From Ubuntu package snmp + init_per_group_agent(Exec, Config); +init_per_group(snmptrapd = Exec, Config) -> + %% From Ubuntu package snmpd + init_per_group_agent(Exec, Config); +init_per_group(snmpd_mt, Config) -> + %% From Ubuntu package snmp + init_per_group_manager( + snmpd, + [{manager_net_if_module, snmpm_net_if_mt} | Config]); +init_per_group(snmpd = Exec, Config) -> + %% From Ubuntu package snmp + init_per_group_manager( + Exec, + [{manager_net_if_module, snmpm_net_if} | Config]); +%% +init_per_group(_, Config) -> + Config. + +init_per_group_ipv6(Families, Config) -> + case ct:require(ipv6_hosts) of + ok -> + case gen_udp:open(0, [inet6]) of + {ok, S} -> + ok = gen_udp:close(S), + init_per_group_ip(Families, Config); + {error, _} -> + {skip, "Host seems to not support IPv6"} + end; + _ -> + {skip, "Test config ipv6_hosts is missing"} + end. + +init_per_group_ip(Families, Config) -> + AgentPort = ?config(agent_port, Config), + ManagerPort = ?config(manager_port, Config), + {ok, Host} = inet:gethostname(), + Transports = + [begin + {ok, Addr} = inet:getaddr(Host, Family), + {domain(Family), {Addr, AgentPort}} + end || Family <- Families], + Targets = + [begin + {ok, Addr} = inet:getaddr(Host, Family), + {domain(Family), {Addr, ManagerPort}} + end || Family <- Families], + [{transports, Transports}, {targets, Targets} | Config]. + +init_per_group_agent(Exec, Config) -> + Versions = [v2], + Dir = ?config(priv_dir, Config), + Transports = ?config(transports, Config), + Targets = ?config(targets, Config), + agent_config(Dir, Transports, Targets, Versions), + find_executable(Exec, [{snmp_versions, Versions} | Config]). + +init_per_group_manager(Exec, Config) -> + Versions = [v2], + Dir = ?config(priv_dir, Config), + Targets = ?config(targets, Config), + manager_config(Dir, Targets), + find_executable(Exec, [{snmp_versions, Versions} | Config]). + + + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(_Case, Config) -> + Dog = ct:timetrap(20000), + application:stop(snmp), + application:unload(snmp), + [{watchdog, Dog} | Config]. + +end_per_testcase(_, Config) -> + case application:stop(snmp) of + ok -> + ok; + E1 -> + ct:pal("application:stop(snmp) -> ~p", [E1]) + end, + case application:unload(snmp) of + ok -> + ok; + E2 -> + ct:pal("application:unload(snmp) -> ~p", [E2]) + end, + Config. + +find_executable(Exec, Config) -> + ExecStr = atom_to_list(Exec), + case os:find_executable(ExecStr) of + false -> + %% The sbin dirs are not in the PATH on all platforms... + find_sys_executable( + Exec, ExecStr, + [["usr", "local", "sbin"], + ["usr", "sbin"], + ["sbin"]], + Config); + Path -> + [{Exec, Path} | Config] + end. + +find_sys_executable(_Exec, ExecStr, [], _Config) -> + {skip, ExecStr ++ " not found"}; +find_sys_executable(Exec, ExecStr, [Dir | Dirs], Config) -> + case os:find_executable(filename:join(["/" | Dir] ++ [ExecStr])) of + false -> + find_sys_executable(Exec, ExecStr, Dirs, Config); + Path -> + [{Exec, Path} | Config] + end. + +start_agent(Config) -> + ok = application:load(snmp), + ok = application:set_env(snmp, agent, agent_app_env(Config)), + ok = application:start(snmp). + +start_manager(Config) -> + ok = application:load(snmp), + ok = application:set_env(snmp, manager, manager_app_env(Config)), + ok = application:start(snmp). + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- +erlang_agent_netsnmp_get() -> + [{doc,"Test that we can access erlang snmp agent " + "from snmpnet manager"}]. + +erlang_agent_netsnmp_get(Config) when is_list(Config) -> + Transports = ?config(transports, Config), + start_agent(Config), + Oid = ?sysDescr_instance, + Expected = expected(Oid, get), + [Expected = snmpget(Oid, Transport, Config) + || Transport <- Transports], + ok. + +%%-------------------------------------------------------------------- +erlang_manager_netsnmp_get() -> + [{doc,"Test that the erlang snmp manager can access snmpnet agent"}]. + +erlang_manager_netsnmp_get(Config) when is_list(Config) -> + Community = "happy-testing", + SysDescr = "Net-SNMP agent", + TargetName = "Target Net-SNMP agent", + Transports = ?config(transports, Config), + ProgHandle = start_snmpd(Community, SysDescr, Config), + start_manager(Config), + snmp_manager_user:start_link(self(), test_user), + [snmp_manager_user:register_agent( + TargetName++domain_suffix(Domain), + [{reg_type, target_name}, + {tdomain, Domain}, {taddress, Addr}, + {community, Community}, {engine_id, "EngineId"}, + {version, v2}, {sec_model, v2c}, {sec_level, noAuthNoPriv}]) + || {Domain, Addr} <- Transports], + Results = + [snmp_manager_user:sync_get( + TargetName++domain_suffix(Domain), + [?sysDescr_instance]) + || {Domain, _} <- Transports], + ct:pal("sync_get -> ~p", [Results]), + snmp_manager_user:stop(), + stop_program(ProgHandle), + [{ok, + {noError, 0, + [{varbind, ?sysDescr_instance, 'OCTET STRING', SysDescr,1}] }, + _} = R || R <- Results], + ok. + +%%-------------------------------------------------------------------- +erlang_agent_netsnmp_inform(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + Mib = "TestTrapv2", + + start_agent(Config), + ok = snmpa:load_mib(snmp_master_agent, filename:join(DataDir, Mib)), + + ProgHandle = start_snmptrapd(Mib, Config), + + snmpa:send_notification( + snmp_master_agent, testTrapv22, {erlang_agent_test, self()}), + + receive + {snmp_targets, erlang_agent_test, Addresses} -> + ct:pal("Notification sent to: ~p~n", [Addresses]), + erlang_agent_netsnmp_inform_responses(Addresses) + end, + stop_program(ProgHandle). + +erlang_agent_netsnmp_inform_responses([]) -> + receive + {snmp_notification, erlang_agent_test, _} = Unexpected -> + ct:pal("Unexpected response: ~p", [Unexpected]), + erlang_agent_netsnmp_inform_responses([]) + after 0 -> + ok + end; +erlang_agent_netsnmp_inform_responses([Address | Addresses]) -> + receive + {snmp_notification, erlang_agent_test, + {got_response, Address}} -> + ct:pal("Got response from: ~p~n", [Address]), + erlang_agent_netsnmp_inform_responses(Addresses); + {snmp_notification, erlang_agent_test, + {no_response, _} = NoResponse} -> + ct:fail(NoResponse) + end. + +%%-------------------------------------------------------------------- +%% Internal functions ------------------------------------------------ +%%-------------------------------------------------------------------- +snmpget(Oid, Transport, Config) -> + Versions = ?config(snmp_versions, Config), + + Args = + ["-c", "public", net_snmp_version(Versions), + "-m", "", + "-Cf", + net_snmp_addr_str(Transport), + oid_str(Oid)], + ProgHandle = start_program(snmpget, Args, none, Config), + {_, line, Line} = get_program_output(ProgHandle), + stop_program(ProgHandle), + Line. + +start_snmptrapd(Mibs, Config) -> + DataDir = ?config(data_dir, Config), + MibDir = filename:join(code:lib_dir(snmp), "mibs"), + Targets = ?config(targets, Config), + SnmptrapdArgs = + ["-f", "-Lo", "-C", + "-m", Mibs, + "-M", MibDir++":"++DataDir, + "--disableAuthorization=yes", + "--snmpTrapdAddr=" ++ net_snmp_addr_str(Targets)], + {ok, StartCheckMP} = re:compile("NET-SNMP version ", [anchored]), + start_program(snmptrapd, SnmptrapdArgs, StartCheckMP, Config). + +start_snmpd(Community, SysDescr, Config) -> + DataDir = ?config(data_dir, Config), + Targets = ?config(targets, Config), + Transports = ?config(transports, Config), + Port = mk_port_number(), + CommunityArgs = + ["--rocommunity"++domain_suffix(Domain)++"=" + ++Community++" "++inet_parse:ntoa(Ip) + || {Domain, {Ip, _}} <- Targets], + SnmpdArgs = + ["-f", "-r", %"-Dverbose", + "-c", filename:join(DataDir, "snmpd.conf"), + "-C", "-Lo", + "-m", "", + "--sysDescr="++SysDescr, + "--agentXSocket=tcp:localhost:"++integer_to_list(Port)] + ++ CommunityArgs + ++ [net_snmp_addr_str(Transports)], + {ok, StartCheckMP} = re:compile("NET-SNMP version ", [anchored]), + start_program(snmpd, SnmpdArgs, StartCheckMP, Config). + +start_program(Prog, Args, StartCheckMP, Config) -> + ct:pal("Starting program: ~w ~p", [Prog, Args]), + Path = ?config(Prog, Config), + DataDir = ?config(data_dir, Config), + StartWrapper = filename:join(DataDir, "start_stop_wrapper"), + Parent = self(), + Pid = + spawn_link( + fun () -> + run_program(Parent, StartWrapper, [Path | Args]) + end), + start_check(Pid, erlang:monitor(process, Pid), StartCheckMP). + +start_check(Pid, Mon, none) -> + {Pid, Mon}; +start_check(Pid, Mon, StartCheckMP) -> + receive + {Pid, line, Line} -> + case re:run(Line, StartCheckMP, [{capture, none}]) of + match -> + {Pid, Mon}; + nomatch -> + start_check(Pid, Mon, StartCheckMP) + end; + {'DOWN', Mon, _, _, Reason} -> + ct:fail("Prog ~p start failed: ~p", [Pid, Reason]) + end. + +get_program_output({Pid, Mon}) -> + receive + {Pid, _, _} = Msg -> + Msg; + {'DOWN', Mon, _, _, Reason} -> + ct:fail("Prog ~p crashed: ~p", [Pid, Reason]) + end. + +stop_program({Pid, _} = Handle) -> + Pid ! {self(), stop}, + wait_program_stop(Handle). + +wait_program_stop({Pid, Mon}) -> + receive + {Pid, exit, ExitStatus} -> + receive + {'DOWN', Mon, _, _, _} -> + ExitStatus + end; + {'DOWN', Mon, _, _, Reason} -> + ct:fail("Prog stop: ~p", [Reason]) + end. + +run_program(Parent, StartWrapper, ProgAndArgs) -> + [Prog | _] = ProgAndArgs, + Port = + open_port( + {spawn_executable, StartWrapper}, + [{args, ProgAndArgs}, binary, stderr_to_stdout, {line, 80}, + exit_status]), + ct:pal("Prog ~p started: ~p", [Port, Prog]), + run_program_loop(Parent, Port, []). + +run_program_loop(Parent, Port, Buf) -> + receive + {Parent, stop} -> + true = port_command(Port, <<"stop\n">>), + ct:pal("Prog ~p stop", [Port]), + run_program_loop(Parent, Port, Buf); + {Port, {data, {Flag, Data}}} -> + case Flag of + eol -> + Line = iolist_to_binary(lists:reverse(Buf, Data)), + ct:pal("Prog ~p output: ~s", [Port, Line]), + Parent ! {self(), line, Line}, + run_program_loop(Parent, Port, []); + noeol -> + run_program_loop(Parent, Port, [Data | Buf]) + end; + {Port, {exit_status,ExitStatus}} -> + ct:pal("Prog ~p exit: ~p", [Port, ExitStatus]), + catch port_close(Port), + Parent ! {self(), exit, ExitStatus}; + Unexpected -> + ct:pal("run_program_loop Unexpected: ~p", [Unexpected]), + run_program_loop(Parent, Port, Buf) + end. + + +agent_app_env(Config) -> + Dir = ?config(priv_dir, Config), + Vsns = ?config(snmp_versions, Config), + [{versions, Vsns}, + {agent_type, master}, + {agent_verbosity, trace}, + {db_dir, Dir}, + {audit_trail_log, [{type, read_write}, + {dir, Dir}, + {size, {10240, 10}}]}, + {config, [{dir, Dir}, + {force_load, true}, + {verbosity, trace}]}, + {local_db, [{repair, true}, + {verbosity, silence}]}, + {mib_server, [{verbosity, silence}]}, + {symbolic_store, [{verbosity, silence}]}, + {note_store, [{verbosity, silence}]}, + {net_if, [{verbosity, trace}]}]. + +manager_app_env(Config) -> + Dir = ?config(priv_dir, Config), + Vsns = ?config(snmp_versions, Config), + NetIfModule = ?config(manager_net_if_module, Config), + [{versions, Vsns}, + {audit_trail_log, [{type, read_write}, + {dir, Dir}, + {size, {10240, 10}}]}, + {net_if, [{module, NetIfModule}]}, + {config, [{dir, Dir}, + {db_dir, Dir}, + {verbosity, trace}]} + ]. + +oid_str([1 | Ints]) -> + "iso." ++ oid_str_tl(Ints); +oid_str(Ints) -> + oid_str_tl(Ints). + +oid_str_tl([]) -> + ""; +oid_str_tl([Int]) -> + integer_to_list(Int); +oid_str_tl([Int | Ints]) -> + integer_to_list(Int) ++ "." ++ oid_str_tl(Ints). + +agent_config(Dir, Transports, Targets, Versions) -> + EngineID = ?AGENT_ENGINE_ID, + MMS = ?DEFAULT_MAX_MESSAGE_SIZE, + ok = snmp_config:write_agent_snmp_conf(Dir, Transports, EngineID, MMS), + ok = snmp_config:write_agent_snmp_context_conf(Dir), + ok = snmp_config:write_agent_snmp_community_conf(Dir), + ok = + snmp_config:write_agent_snmp_standard_conf( + Dir, "snmp_to_snmpnet_SUITE"), + ok = + snmp_config:write_agent_snmp_target_addr_conf( + Dir, Targets, Versions), + ok = snmp_config:write_agent_snmp_target_params_conf(Dir, Versions), + ok = snmp_config:write_agent_snmp_notify_conf(Dir, inform), + ok = snmp_config:write_agent_snmp_vacm_conf(Dir, Versions, none). + +manager_config(Dir, Targets) -> + EngineID = ?MANAGER_ENGINE_ID, + MMS = ?DEFAULT_MAX_MESSAGE_SIZE, + ok = snmp_config:write_manager_snmp_conf(Dir, Targets, MMS, EngineID). + +net_snmp_version([v3 | _]) -> + "-v3"; +net_snmp_version([v2 | _]) -> + "-v2c"; +net_snmp_version([v1 | _]) -> + "-v1". + +domain(inet) -> + transportDomainUdpIpv4; +domain(inet6) -> + transportDomainUdpIpv6. + +net_snmp_addr_str([Target | Targets]) -> + net_snmp_addr_str(Target) ++ + case Targets of + [] -> + []; + [_ | _] -> + "," ++ net_snmp_addr_str(Targets) + end; +net_snmp_addr_str({transportDomainUdpIpv4, {Addr, Port}}) -> + "udp:" ++ + inet_parse:ntoa(Addr) ++ ":" ++ + integer_to_list(Port); +net_snmp_addr_str({transportDomainUdpIpv6, {Addr, Port}}) -> + "udp6:[" ++ + inet_parse:ntoa(Addr) ++ "]:" ++ + integer_to_list(Port). + +domain_suffix(transportDomainUdpIpv4) -> + ""; +domain_suffix(transportDomainUdpIpv6) -> + "6". + +mk_port_number() -> + {ok, Socket} = gen_udp:open(0, [{reuseaddr, true}]), + {ok, PortNum} = inet:port(Socket), + ok = gen_udp:close(Socket), + PortNum. diff --git a/lib/snmp/test/snmp_to_snmpnet_SUITE_data/TestTrapv2.bin b/lib/snmp/test/snmp_to_snmpnet_SUITE_data/TestTrapv2.bin Binary files differnew file mode 100644 index 0000000000..9d0790498d --- /dev/null +++ b/lib/snmp/test/snmp_to_snmpnet_SUITE_data/TestTrapv2.bin diff --git a/lib/snmp/test/snmp_to_snmpnet_SUITE_data/TestTrapv2.mib b/lib/snmp/test/snmp_to_snmpnet_SUITE_data/TestTrapv2.mib new file mode 100644 index 0000000000..679ddc14b0 --- /dev/null +++ b/lib/snmp/test/snmp_to_snmpnet_SUITE_data/TestTrapv2.mib @@ -0,0 +1,71 @@ +TestTrapv2 DEFINITIONS ::= BEGIN + +IMPORTS + MODULE-IDENTITY, OBJECT-TYPE, NOTIFICATION-TYPE, + TimeTicks, Counter32, snmpModules, mib-2, enterprises, IpAddress, + Integer32 + FROM SNMPv2-SMI + DisplayString, TestAndIncr, TimeStamp, RowStatus, TruthValue, + TEXTUAL-CONVENTION + FROM SNMPv2-TC + MODULE-COMPLIANCE, OBJECT-GROUP, NOTIFICATION-GROUP + FROM SNMPv2-CONF + + system, snmp, ifIndex, ifAdminStatus, ifOperStatus + FROM RFC1213-MIB + snmpTraps + FROM SNMPv2-MIB; + +testTrapv2 MODULE-IDENTITY + LAST-UPDATED "9511090000Z" + ORGANIZATION "IETF SNMPv2 Working Group" + CONTACT-INFO + " Marshall T. Rose + + Postal: Dover Beach Consulting, Inc. + 420 Whisman Court + Mountain View, CA 94043-2186 + US + + Tel: +1 415 968 1052 + + E-mail: [email protected]" + DESCRIPTION + "The MIB module for SNMPv2 entities." + REVISION "9304010000Z" + DESCRIPTION + "The initial revision of this MIB module was published as + RFC 1450." + ::= { system 100 } + + +tst OBJECT IDENTIFIER ::= { system 0 } + +testTrapv21 NOTIFICATION-TYPE + STATUS current + DESCRIPTION + "This trap is exactly the v2 correspondance of testTrap1 in + TestTrap mib." + ::= { snmp 1 } + +testTrapv22 NOTIFICATION-TYPE + STATUS current + DESCRIPTION + "This trap is exactly the v2 correspondance of testTrap2 in + TestTrap mib." + ::= { system 0 1 } + +linkUp NOTIFICATION-TYPE + OBJECTS { ifIndex, ifAdminStatus, ifOperStatus } + STATUS current + DESCRIPTION + "A linkUp trap signifies that the SNMPv2 entity, + acting in an agent role, has detected that the + ifOperStatus object for one of its communication links + has transitioned out of the down state." + ::= { snmpTraps 4 } + + + + +END diff --git a/lib/snmp/test/snmp_to_snmpnet_SUITE_data/snmpd.conf b/lib/snmp/test/snmp_to_snmpnet_SUITE_data/snmpd.conf new file mode 100644 index 0000000000..2a5f31680f --- /dev/null +++ b/lib/snmp/test/snmp_to_snmpnet_SUITE_data/snmpd.conf @@ -0,0 +1,12 @@ +sysLocation On the lab network +sysContact otptest <[email protected]> + +createUser myinternaluser SHA dropdead + +agentSecName myinternaluser + +master agentx + +[snmp] +noPersistentLoad yes +noPersistentSave yes diff --git a/lib/snmp/test/snmp_to_snmpnet_SUITE_data/start_stop_wrapper b/lib/snmp/test/snmp_to_snmpnet_SUITE_data/start_stop_wrapper new file mode 100755 index 0000000000..f806ab5c12 --- /dev/null +++ b/lib/snmp/test/snmp_to_snmpnet_SUITE_data/start_stop_wrapper @@ -0,0 +1,47 @@ +#! /bin/sh +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2014-2014. All Rights Reserved. +## +## The 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% +## +# + +## Start the given executable, wait for stop command, +## stop the running executable and wait for exit. + +die () { + r=$? + echo "$0:" "$*" 1>&2 + exit $r +} + +test -x "$1" || die "Not Executable: $1" + +# Redirect stdin to make sure the stop command is read by us below +# and does not go to the executable +"$@" 0< /dev/null & +PID=$! + +# Wait for stop command +while read LINE; do + case :"$LINE" in + :"stop") + break;; + esac +done + +kill $PID +wait $PID diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 04c3cc9392..b436a79076 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 4.25.1 +SNMP_VSN = 5.1 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 0dbec7527a..f3db05192e 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -29,6 +29,174 @@ <file>notes.xml</file> </header> +<section><title>Ssh 3.0.8</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixes of login blocking after port scanning.</p> + <p> + Own Id: OTP-12247 Aux Id: seq12726 </p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 3.0.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Add option sftp_vsn to SFTP</p> + <p> + Own Id: OTP-12227</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix option user_interaction to work as expected. When + password authentication is implemented with ssh + keyboard-interactive method and the password is already + supplied, so that we do not need to query user, then + connections should succeed even though user_interaction + option is set to false.</p> + <p> + Own Id: OTP-11329 Aux Id: seq12420, seq12335 </p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 3.0.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Gracefully handle bad data from the client when expecting + ssh version exchange.</p> + <p> + Own Id: OTP-12157 Aux Id: seq12706 </p> + </item> + <item> + <p> + When restarting an ssh daemon, that was stopped with + ssh:stop_listner/ [1,2] new options given shall replace + old ones.</p> + <p> + Own Id: OTP-12168 Aux Id: seq12711 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + ssh now has a format_status function to avoid printing + sensitive information in error loggs.</p> + <p> + Own Id: OTP-12030</p> + </item> + </list> + </section> + + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + The option <c>parallel_login</c> didn't work with the + value <c>true</c>. All logins were serial.</p> + <p> + Own Id: OTP-12194</p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 3.0.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + When starting an ssh-daemon giving the option + {parallel_login, true}, the timeout for authentication + negotiation ({negotiation_timeout, integer()}) was never + removed.</p> + <p> + This caused the session to always be terminated after the + timeout if parallel_login was set.</p> + <p> + Own Id: OTP-12057 Aux Id: seq12663 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Warning: this is experimental and may disappear or change + without previous warning.</p> + <p> + Experimental support for running Quickcheck and PropEr + tests from common_test suites is added to common_test. + See the reference manual for the new module + <c>ct_property_testing</c>.</p> + <p> + Experimental property tests are added under + <c>lib/{inet,ssh}/test/property_test</c>. They can be run + directly or from the commont_test suites + <c>inet/ftp_property_test_SUITE.erl</c> and + <c>ssh/test/ssh_property_test_SUITE.erl</c>.</p> + <p> + See the code in the <c>test</c> directories and the man + page for details.</p> + <p> + (Thanks to Tuncer Ayaz for a patch adding Triq)</p> + <p> + Own Id: OTP-12119</p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 3.0.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + When starting an ssh-daemon giving the option + {parallel_login, true}, the timeout for authentication + negotiation ({negotiation_timeout, integer()}) was never + removed.</p> + <p> + This caused the session to always be terminated after the + timeout if parallel_login was set.</p> + <p> + Own Id: OTP-12057 Aux Id: seq12663 </p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 3.0.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 876eba598a..9f5d1c003d 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -36,8 +36,8 @@ <list type="bulleted"> <item>SSH requires the crypto and public_key applications.</item> <item>Supported SSH version is 2.0 </item> - <item>Supported MAC algorithms: hmac-sha1</item> - <item>Supported encryption algorithms: aes128-cb and 3des-cbc</item> + <item>Supported MAC algorithms: hmac-sha2-256 and hmac-sha1</item> + <item>Supported encryption algorithms: aes128-ctr, aes128-cb and 3des-cbc</item> <item>Supports unicode filenames if the emulator and the underlaying OS supports it. See the DESCRIPTION section in <seealso marker="kernel:file">file</seealso> for information about this subject</item> <item>Supports unicode in shell and cli</item> </list> diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml index e55d092fe2..f1091e9eca 100644 --- a/lib/ssh/doc/src/ssh_sftp.xml +++ b/lib/ssh/doc/src/ssh_sftp.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2005</year><year>2013</year> + <year>2005</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -81,6 +81,17 @@ <p>The timeout is passed to the ssh_channel start function, and defaults to infinity.</p> </item> + <tag> + <p><c><![CDATA[{sftp_vsn, integer()}]]></c></p> + </tag> + <item> + <p> + Desired SFTP protocol version. + The actual version will be the minimum of + the desired version and the maximum supported + versions by the SFTP server. + </p> + </item> </taglist> <p>All other options are directly passed to <seealso marker="ssh">ssh:connect/3</seealso> or ignored if a diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index 2ef2859fd7..90d71107ad 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -65,6 +65,7 @@ MODULES= \ ssh_cli \ ssh_file \ ssh_io \ + ssh_info \ ssh_math \ ssh_message \ ssh_no_io \ @@ -115,7 +116,7 @@ $(TARGET_FILES): $(BEHAVIOUR_TARGET_FILES) debug opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) clean: - rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) $(BEHAVIOUR_TARGET_FILES) rm -f errs core *~ $(APP_TARGET): $(APP_SRC) ../vsn.mk diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index e0a51b3574..4ad55b34ca 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -23,6 +23,7 @@ sshd_sup, ssh_file, ssh_io, + ssh_info, ssh_math, ssh_no_io, ssh_server_key_api, diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 8269f89e40..600c01454c 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,25 +19,49 @@ {"%VSN%", [ - {"3.0.2", [{load_module, ssh_message, soft_purge, soft_purge, []}, + {"3.0.7", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]}, {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, - {load_module, ssh_io, soft_purge, soft_purge, []}]}, - {"3.0.1", [{load_module, ssh, soft_purge, soft_purge, []}, - {load_module, ssh_acceptor, soft_purge, soft_purge, []}, - {load_module, ssh_message, soft_purge, soft_purge, []}, + {load_module, ssh_info, soft_purge, soft_purge, []}, + {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]}, + {"3.0.6", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]}, {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, - {load_module, ssh_io, soft_purge, soft_purge, []}]}, + {load_module, ssh_info, soft_purge, soft_purge, []}, + {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]}, {<<".*">>, [{restart_application, ssh}]} ], [ - {"3.0.2", [{load_module, ssh_message, soft_purge, soft_purge, []}, + {"3.0.7", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]}, {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, - {load_module, ssh_io, soft_purge, soft_purge, []}]}, - {"3.0.1", [{load_module, ssh, soft_purge, soft_purge, []}, - {load_module, ssh_acceptor, soft_purge, soft_purge, []}, - {load_module, ssh_message, soft_purge, soft_purge, []}, + {load_module, ssh_info, soft_purge, soft_purge, []}, + {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]}, + {"3.0.6", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]}, {load_module, ssh_connection_handler, soft_purge, soft_purge, []}, - {load_module, ssh_io, soft_purge, soft_purge, []}]}, + {load_module, ssh_info, soft_purge, soft_purge, []}, + {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]}, + {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]}, {<<".*">>, [{restart_application, ssh}]} ] }. diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 743c01a42c..de047d3c83 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -234,22 +234,26 @@ do_start_daemon(Host, Port, Options, SocketOptions) -> {port, Port}, {role, server}, {socket_opts, SocketOptions}, {ssh_opts, Options}]) of - {ok, SysSup} -> - {ok, SysSup}; {error, {already_started, _}} -> {error, eaddrinuse}; - {error, R} -> - {error, R} + Result = {Code, _} when (Code == ok) or (Code == error) -> + Result catch exit:{noproc, _} -> {error, ssh_not_started} end; Sup -> - case ssh_system_sup:restart_acceptor(Host, Port) of + AccPid = ssh_system_sup:acceptor_supervisor(Sup), + case ssh_acceptor_sup:start_child(AccPid, [{address, Host}, + {port, Port}, {role, server}, + {socket_opts, SocketOptions}, + {ssh_opts, Options}]) of + {error, {already_started, _}} -> + {error, eaddrinuse}; {ok, _} -> {ok, Sup}; - _ -> - {error, eaddrinuse} + Other -> + Other end end. @@ -392,7 +396,8 @@ handle_ssh_option({compression, Value} = Opt) when is_atom(Value) -> Opt; handle_ssh_option({exec, {Module, Function, _}} = Opt) when is_atom(Module), is_atom(Function) -> - + Opt; +handle_ssh_option({exec, Function} = Opt) when is_function(Function) -> Opt; handle_ssh_option({auth_methods, Value} = Opt) when is_list(Value) -> Opt; diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index 7302196674..6c443eeb9c 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -22,7 +22,8 @@ -module(ssh_acceptor). %% Internal application API --export([start_link/5]). +-export([start_link/5, + number_of_connections/1]). %% spawn export -export([acceptor_init/6, acceptor_loop/6]). @@ -140,5 +141,6 @@ handle_error(Reason) -> number_of_connections(SystemSup) -> length([X || {R,X,supervisor,[ssh_subsystem_sup]} <- supervisor:which_children(SystemSup), + is_pid(X), is_reference(R) ]). diff --git a/lib/ssh/src/ssh_acceptor_sup.erl b/lib/ssh/src/ssh_acceptor_sup.erl index 2be729d305..46fdef07d0 100644 --- a/lib/ssh/src/ssh_acceptor_sup.erl +++ b/lib/ssh/src/ssh_acceptor_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The 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 @@ -module(ssh_acceptor_sup). -behaviour(supervisor). --export([start_link/1, start_child/2, stop_child/2]). +-export([start_link/1, start_child/2, stop_child/3]). %% Supervisor callback -export([init/1]). @@ -45,18 +45,17 @@ start_child(AccSup, ServerOpts) -> {error, already_present} -> Address = proplists:get_value(address, ServerOpts), Port = proplists:get_value(port, ServerOpts), - Name = id(Address, Port), - supervisor:delete_child(?MODULE, Name), + stop_child(AccSup, Address, Port), supervisor:start_child(AccSup, Spec); Reply -> Reply end. -stop_child(Address, Port) -> +stop_child(AccSup, Address, Port) -> Name = id(Address, Port), - case supervisor:terminate_child(?MODULE, Name) of + case supervisor:terminate_child(AccSup, Name) of ok -> - supervisor:delete_child(?MODULE, Name); + supervisor:delete_child(AccSup, Name); Error -> Error end. diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index 45fd907383..45c4d52d7e 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -119,8 +119,7 @@ init_userauth_request_msg(#ssh{opts = Opts} = Ssh) -> false -> FirstAlg = proplists:get_value(public_key_alg, Opts, ?PREFERRED_PK_ALG), SecondAlg = other_alg(FirstAlg), - AllowUserInt = proplists:get_value(user_interaction, Opts, true), - Prefs = method_preference(FirstAlg, SecondAlg, AllowUserInt), + Prefs = method_preference(FirstAlg, SecondAlg), ssh_transport:ssh_packet(Msg, Ssh#ssh{user = User, userauth_preference = Prefs, userauth_methods = none, @@ -130,15 +129,13 @@ init_userauth_request_msg(#ssh{opts = Opts} = Ssh) -> case length(Algs) =:= 2 of true -> SecondAlg = other_alg(FirstAlg), - AllowUserInt = proplists:get_value(user_interaction, Opts, true), - Prefs = method_preference(FirstAlg, SecondAlg, AllowUserInt), + Prefs = method_preference(FirstAlg, SecondAlg), ssh_transport:ssh_packet(Msg, Ssh#ssh{user = User, userauth_preference = Prefs, userauth_methods = none, service = "ssh-connection"}); _ -> - AllowUserInt = proplists:get_value(user_interaction, Opts, true), - Prefs = method_preference(FirstAlg, AllowUserInt), + Prefs = method_preference(FirstAlg), ssh_transport:ssh_packet(Msg, Ssh#ssh{user = User, userauth_preference = Prefs, userauth_methods = none, @@ -187,9 +184,8 @@ handle_userauth_request(#ssh_msg_service_request{name = handle_userauth_request(#ssh_msg_userauth_request{user = User, service = "ssh-connection", method = "password", - data = Data}, _, + data = <<?FALSE, ?UINT32(Sz), BinPwd:Sz/binary>>}, _, #ssh{opts = Opts} = Ssh) -> - <<_:8, ?UINT32(Sz), BinPwd:Sz/binary>> = Data, Password = unicode:characters_to_list(BinPwd), case check_password(User, Password, Opts) of true -> @@ -204,6 +200,27 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User, handle_userauth_request(#ssh_msg_userauth_request{user = User, service = "ssh-connection", + method = "password", + data = <<?TRUE, + _/binary + %% ?UINT32(Sz1), OldBinPwd:Sz1/binary, + %% ?UINT32(Sz2), NewBinPwd:Sz2/binary + >> + }, _, + Ssh) -> + %% Password change without us having sent SSH_MSG_USERAUTH_PASSWD_CHANGEREQ (because we never do) + %% RFC 4252 says: + %% SSH_MSG_USERAUTH_FAILURE without partial success - The password + %% has not been changed. Either password changing was not supported, + %% or the old password was bad. + + {not_authorized, {User, {error,"Password change not supported"}}, + ssh_transport:ssh_packet(#ssh_msg_userauth_failure{ + authentications = "", + partial_success = false}, Ssh)}; + +handle_userauth_request(#ssh_msg_userauth_request{user = User, + service = "ssh-connection", method = "none"}, _, #ssh{userauth_supported_methods = Methods} = Ssh) -> {not_authorized, {User, undefined}, @@ -256,15 +273,12 @@ handle_userauth_info_request( data = Data}, IoCb, #ssh{opts = Opts} = Ssh) -> PromptInfos = decode_keyboard_interactive_prompts(NumPrompts,Data), - Resps = keyboard_interact_get_responses(IoCb, Opts, + Responses = keyboard_interact_get_responses(IoCb, Opts, Name, Instr, PromptInfos), - RespBin = list_to_binary( - lists:map(fun(S) -> <<?STRING(list_to_binary(S))>> end, - Resps)), {ok, ssh_transport:ssh_packet( #ssh_msg_userauth_info_response{num_responses = NumPrompts, - data = RespBin}, Ssh)}. + data = Responses}, Ssh)}. handle_userauth_info_response(#ssh_msg_userauth_info_response{}, _Auth) -> @@ -276,25 +290,16 @@ handle_userauth_info_response(#ssh_msg_userauth_info_response{}, %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -method_preference(Alg1, Alg2, true) -> +method_preference(Alg1, Alg2) -> [{"publickey", ?MODULE, publickey_msg, [Alg1]}, {"publickey", ?MODULE, publickey_msg,[Alg2]}, {"password", ?MODULE, password_msg, []}, {"keyboard-interactive", ?MODULE, keyboard_interactive_msg, []} - ]; -method_preference(Alg1, Alg2, false) -> - [{"publickey", ?MODULE, publickey_msg, [Alg1]}, - {"publickey", ?MODULE, publickey_msg,[Alg2]}, - {"password", ?MODULE, password_msg, []} ]. -method_preference(Alg1, true) -> +method_preference(Alg1) -> [{"publickey", ?MODULE, publickey_msg, [Alg1]}, {"password", ?MODULE, password_msg, []}, {"keyboard-interactive", ?MODULE, keyboard_interactive_msg, []} - ]; -method_preference(Alg1, false) -> - [{"publickey", ?MODULE, publickey_msg, [Alg1]}, - {"password", ?MODULE, password_msg, []} ]. user_name(Opts) -> @@ -362,35 +367,29 @@ build_sig_data(SessionId, User, Service, KeyBlob, Alg) -> algorithm_string('ssh-rsa') -> "ssh-rsa"; algorithm_string('ssh-dss') -> - "ssh-dss". + "ssh-dss". decode_keyboard_interactive_prompts(_NumPrompts, Data) -> ssh_message:decode_keyboard_interactive_prompts(Data, []). keyboard_interact_get_responses(IoCb, Opts, Name, Instr, PromptInfos) -> NumPrompts = length(PromptInfos), - case proplists:get_value(keyboard_interact_fun, Opts) of - undefined when NumPrompts == 1 -> - %% Special case/fallback for just one prompt - %% (assumed to be the password prompt) - case proplists:get_value(password, Opts) of - undefined -> keyboard_interact(IoCb, Name, Instr, PromptInfos, Opts); - PW -> [PW] - end; - undefined -> - keyboard_interact(IoCb, Name, Instr, PromptInfos, Opts); - KbdInteractFun -> - Prompts = lists:map(fun({Prompt, _Echo}) -> Prompt end, - PromptInfos), - case KbdInteractFun(Name, Instr, Prompts) of - Rs when length(Rs) == NumPrompts -> - Rs; - Rs -> - erlang:error({mismatching_number_of_responses, - {got,Rs}, - {expected,NumPrompts}}) - end - end. + keyboard_interact_get_responses(proplists:get_value(user_interaction, Opts, true), + proplists:get_value(keyboard_interact_fun, Opts), + proplists:get_value(password, Opts, undefined), IoCb, Name, + Instr, PromptInfos, Opts, NumPrompts). + +keyboard_interact_get_responses(_, undefined, Password, _, _, _, _, _, + 1) when Password =/= undefined -> + [Password]; %% Password auth implemented with keyboard-interaction and passwd is known +keyboard_interact_get_responses(_, _, _, _, _, _, _, _, 0) -> + [""]; +keyboard_interact_get_responses(false, undefined, undefined, _, _, _, [Prompt|_], Opts, _) -> + ssh_no_io:read_line(Prompt, Opts); %% Throws error as keyboard interaction is not allowed +keyboard_interact_get_responses(true, undefined, _,IoCb, Name, Instr, PromptInfos, Opts, _) -> + keyboard_interact(IoCb, Name, Instr, PromptInfos, Opts); +keyboard_interact_get_responses(true, Fun, _, Name, Instr, PromptInfos, _, _, NumPrompts) -> + keyboard_interact_fun(Fun, Name, Instr, PromptInfos, NumPrompts). keyboard_interact(IoCb, Name, Instr, Prompts, Opts) -> if Name /= "" -> IoCb:format("~s", [Name]); @@ -404,6 +403,21 @@ keyboard_interact(IoCb, Name, Instr, Prompts, Opts) -> end, Prompts). +keyboard_interact_fun(KbdInteractFun, Name, Instr, PromptInfos, NumPrompts) -> + Prompts = lists:map(fun({Prompt, _Echo}) -> Prompt end, + PromptInfos), + case KbdInteractFun(Name, Instr, Prompts) of + Rs when length(Rs) == NumPrompts -> + Rs; + Rs -> + throw({mismatching_number_of_responses, + {got,Rs}, + {expected, NumPrompts}, + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_SERVICE_NOT_AVAILABLE, + description = "User interaction failed", + language = "en"}}) + end. + other_alg('ssh-rsa') -> 'ssh-dss'; other_alg('ssh-dss') -> diff --git a/lib/ssh/src/ssh_channel.erl b/lib/ssh/src/ssh_channel.erl index 508ae637cf..5c24f362b1 100644 --- a/lib/ssh/src/ssh_channel.erl +++ b/lib/ssh/src/ssh_channel.erl @@ -67,7 +67,8 @@ %% Internal application API -export([cache_create/0, cache_lookup/2, cache_update/2, cache_delete/1, cache_delete/2, cache_foldl/3, - cache_find/2]). + cache_find/2, + get_print_info/1]). -record(state, { cm, @@ -190,6 +191,14 @@ init([Options]) -> %% {stop, Reason, State} %% Description: Handling call messages %%-------------------------------------------------------------------- +handle_call(get_print_info, _From, State) -> + Reply = + {{State#state.cm, + State#state.channel_id}, + io_lib:format('CB=~p',[State#state.channel_cb]) + }, + {reply, Reply, State}; + handle_call(Request, From, #state{channel_cb = Module, channel_state = ChannelState} = State) -> try Module:handle_call(Request, From, ChannelState) of @@ -333,6 +342,9 @@ cache_find(ChannelPid, Cache) -> Channel end. +get_print_info(Pid) -> + call(Pid, get_print_info, 1000). + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index 77453e8fd7..de6d246403 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -98,7 +98,7 @@ handle_ssh_msg({ssh_cm, ConnectionHandler, Pty = Pty0#ssh_pty{width = Width, height = Height, pixel_width = PixWidth, pixel_height = PixHeight}, - {Chars, NewBuf} = io_request({window_change, Pty0}, Buf, Pty), + {Chars, NewBuf} = io_request({window_change, Pty0}, Buf, Pty, undefined), write_chars(ConnectionHandler, ChannelId, Chars), {ok, State#state{pty = Pty, buf = NewBuf}}; @@ -188,7 +188,7 @@ handle_msg({Group, tty_geometry}, #state{group = Group, handle_msg({Group, Req}, #state{group = Group, buf = Buf, pty = Pty, cm = ConnectionHandler, channel = ChannelId} = State) -> - {Chars, NewBuf} = io_request(Req, Buf, Pty), + {Chars, NewBuf} = io_request(Req, Buf, Pty, Group), write_chars(ConnectionHandler, ChannelId, Chars), {ok, State#state{buf = NewBuf}}; @@ -263,40 +263,49 @@ eval(Error) -> %%% displaying device... %%% We are *not* really unicode aware yet, we just filter away characters %%% beyond the latin1 range. We however handle the unicode binaries... -io_request({window_change, OldTty}, Buf, Tty) -> +io_request({window_change, OldTty}, Buf, Tty, _Group) -> window_change(Tty, OldTty, Buf); -io_request({put_chars, Cs}, Buf, Tty) -> +io_request({put_chars, Cs}, Buf, Tty, _Group) -> put_chars(bin_to_list(Cs), Buf, Tty); -io_request({put_chars, unicode, Cs}, Buf, Tty) -> +io_request({put_chars, unicode, Cs}, Buf, Tty, _Group) -> put_chars(unicode:characters_to_list(Cs,unicode), Buf, Tty); -io_request({insert_chars, Cs}, Buf, Tty) -> +io_request({insert_chars, Cs}, Buf, Tty, _Group) -> insert_chars(bin_to_list(Cs), Buf, Tty); -io_request({insert_chars, unicode, Cs}, Buf, Tty) -> +io_request({insert_chars, unicode, Cs}, Buf, Tty, _Group) -> insert_chars(unicode:characters_to_list(Cs,unicode), Buf, Tty); -io_request({move_rel, N}, Buf, Tty) -> +io_request({move_rel, N}, Buf, Tty, _Group) -> move_rel(N, Buf, Tty); -io_request({delete_chars,N}, Buf, Tty) -> +io_request({delete_chars,N}, Buf, Tty, _Group) -> delete_chars(N, Buf, Tty); -io_request(beep, Buf, _Tty) -> +io_request(beep, Buf, _Tty, _Group) -> {[7], Buf}; %% New in R12 -io_request({get_geometry,columns},Buf,Tty) -> +io_request({get_geometry,columns},Buf,Tty, _Group) -> {ok, Tty#ssh_pty.width, Buf}; -io_request({get_geometry,rows},Buf,Tty) -> +io_request({get_geometry,rows},Buf,Tty, _Group) -> {ok, Tty#ssh_pty.height, Buf}; -io_request({requests,Rs}, Buf, Tty) -> - io_requests(Rs, Buf, Tty, []); -io_request(tty_geometry, Buf, Tty) -> - io_requests([{move_rel, 0}, {put_chars, unicode, [10]}], Buf, Tty, []); +io_request({requests,Rs}, Buf, Tty, Group) -> + io_requests(Rs, Buf, Tty, [], Group); +io_request(tty_geometry, Buf, Tty, Group) -> + io_requests([{move_rel, 0}, {put_chars, unicode, [10]}], + Buf, Tty, [], Group); %{[], Buf}; -io_request(_R, Buf, _Tty) -> + +%% New in 18 +io_request({put_chars_sync, Class, Cs, Reply}, Buf, Tty, Group) -> + %% We handle these asynchronous for now, if we need output guarantees + %% we have to handle these synchronously + Group ! {reply, Reply}, + io_request({put_chars, Class, Cs}, Buf, Tty, Group); + +io_request(_R, Buf, _Tty, _Group) -> {[], Buf}. -io_requests([R|Rs], Buf, Tty, Acc) -> - {Chars, NewBuf} = io_request(R, Buf, Tty), - io_requests(Rs, NewBuf, Tty, [Acc|Chars]); -io_requests([], Buf, _Tty, Acc) -> +io_requests([R|Rs], Buf, Tty, Acc, Group) -> + {Chars, NewBuf} = io_request(R, Buf, Tty, Group), + io_requests(Rs, NewBuf, Tty, [Acc|Chars], Group); +io_requests([], Buf, _Tty, Acc, _Group) -> {Acc, Buf}. %%% return commands for cursor navigation, assume everything is ansi @@ -457,17 +466,17 @@ bin_to_list(I) when is_integer(I) -> start_shell(ConnectionHandler, State) -> Shell = State#state.shell, - ConnectionInfo = ssh_connection_handler:info(ConnectionHandler, + ConnectionInfo = ssh_connection_handler:connection_info(ConnectionHandler, [peer, user]), ShellFun = case is_function(Shell) of true -> - {ok, User} = + User = proplists:get_value(user, ConnectionInfo), case erlang:fun_info(Shell, arity) of {arity, 1} -> fun() -> Shell(User) end; {arity, 2} -> - [{_, PeerAddr}] = + {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo), fun() -> Shell(User, PeerAddr) end; _ -> @@ -485,9 +494,9 @@ start_shell(_ConnectionHandler, Cmd, #state{exec={M, F, A}} = State) -> State#state{group = Group, buf = empty_buf()}; start_shell(ConnectionHandler, Cmd, #state{exec=Shell} = State) when is_function(Shell) -> - ConnectionInfo = ssh_connection_handler:info(ConnectionHandler, + ConnectionInfo = ssh_connection_handler:connection_info(ConnectionHandler, [peer, user]), - {ok, User} = + User = proplists:get_value(user, ConnectionInfo), ShellFun = case erlang:fun_info(Shell, arity) of @@ -496,7 +505,7 @@ start_shell(ConnectionHandler, Cmd, #state{exec=Shell} = State) when is_function {arity, 2} -> fun() -> Shell(Cmd, User) end; {arity, 3} -> - [{_, PeerAddr}] = + {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo), fun() -> Shell(Cmd, User, PeerAddr) end; _ -> diff --git a/lib/ssh/src/ssh_connect.hrl b/lib/ssh/src/ssh_connect.hrl index 8421b07167..9307dbbad0 100644 --- a/lib/ssh/src/ssh_connect.hrl +++ b/lib/ssh/src/ssh_connect.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. All Rights Reserved. %% %% The 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,6 +26,7 @@ -define(DEFAULT_PACKET_SIZE, 32768). -define(DEFAULT_WINDOW_SIZE, 2*?DEFAULT_PACKET_SIZE). -define(DEFAULT_TIMEOUT, 5000). +-define(MAX_PROTO_VERSION, 255). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index b377614949..f3ff9ae67a 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -107,9 +107,15 @@ shell(ConnectionHandler, ChannelId) -> %% Description: Executes a predefined subsystem. %%-------------------------------------------------------------------- subsystem(ConnectionHandler, ChannelId, SubSystem, TimeOut) -> - ssh_connection_handler:request(ConnectionHandler, self(), - ChannelId, "subsystem", - true, [?string(SubSystem)], TimeOut). + case ssh_connection_handler:request(ConnectionHandler, self(), + ChannelId, "subsystem", + true, [?string(SubSystem)], TimeOut) of + success -> success; + failure -> failure; + {error,timeout} -> {error,timeout}; + _ -> failure + end. + %%-------------------------------------------------------------------- -spec send(pid(), channel_id(), iodata()) -> ok | {error, closed}. @@ -782,9 +788,8 @@ handle_cli_msg(#connection{channel_cache = Cache} = Connection, erlang:monitor(process, Pid), Channel = Channel0#channel{user = Pid}, ssh_channel:cache_update(Cache, Channel), - Reply = {connection_reply, - channel_success_msg(RemoteId)}, - {{replies, [{channel_data, Pid, Reply0}, Reply]}, Connection}; + {Reply, Connection1} = reply_msg(Channel, Connection, Reply0), + {{replies, [Reply]}, Connection1}; _Other -> Reply = {connection_reply, channel_failure_msg(RemoteId)}, diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 06866392da..fa107be1b1 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The 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,14 +41,16 @@ global_request/4, send/5, send_eof/2, info/1, info/2, connection_info/2, channel_info/3, adjust_window/3, close/2, stop/1, renegotiate/1, renegotiate_data/1, - start_connection/4]). + start_connection/4, + get_print_info/1]). %% gen_fsm callbacks -export([hello/2, kexinit/2, key_exchange/2, new_keys/2, - userauth/2, connected/2]). + userauth/2, connected/2, + error/2]). -export([init/1, handle_event/3, - handle_sync_event/4, handle_info/3, terminate/3, code_change/4]). + handle_sync_event/4, handle_info/3, terminate/3, format_status/2, code_change/4]). -record(state, { role, @@ -71,7 +73,8 @@ connection_queue, address, port, - opts + opts, + recbuf }). -type state_name() :: hello | kexinit | key_exchange | new_keys | userauth | connection. @@ -103,22 +106,22 @@ start_connection(client = Role, Socket, Options, Timeout) -> end; start_connection(server = Role, Socket, Options, Timeout) -> + SSH_Opts = proplists:get_value(ssh_opts, Options, []), try - Sups = proplists:get_value(supervisors, Options), - ConnectionSup = proplists:get_value(connection_sup, Sups), - Opts = [{supervisors, Sups}, {user_pid, self()} | proplists:get_value(ssh_opts, Options, [])], - {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Opts]), - {_, Callback, _} = proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), - socket_control(Socket, Pid, Callback), - case proplists:get_value(parallel_login, Opts, false) of + case proplists:get_value(parallel_login, SSH_Opts, false) of true -> - spawn(fun() -> - Ref = erlang:monitor(process, Pid), - handshake(Pid, Ref, Timeout) - end); + HandshakerPid = + spawn_link(fun() -> + receive + {do_handshake, Pid} -> + handshake(Pid, erlang:monitor(process,Pid), Timeout) + end + end), + ChildPid = start_the_connection_child(HandshakerPid, Role, Socket, Options), + HandshakerPid ! {do_handshake, ChildPid}; false -> - Ref = erlang:monitor(process, Pid), - handshake(Pid, Ref, Timeout) + ChildPid = start_the_connection_child(self(), Role, Socket, Options), + handshake(ChildPid, erlang:monitor(process,ChildPid), Timeout) end catch exit:{noproc, _} -> @@ -127,6 +130,16 @@ start_connection(server = Role, Socket, Options, Timeout) -> {error, Error} end. +start_the_connection_child(UserPid, Role, Socket, Options) -> + Sups = proplists:get_value(supervisors, Options), + ConnectionSup = proplists:get_value(connection_sup, Sups), + Opts = [{supervisors, Sups}, {user_pid, UserPid} | proplists:get_value(ssh_opts, Options, [])], + {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Opts]), + {_, Callback, _} = proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), + socket_control(Socket, Pid, Callback), + Pid. + + start_link(Role, Socket, Options) -> {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Socket, Options]])}. @@ -160,9 +173,23 @@ init([Role, Socket, SshOpts]) -> State#state{ssh_params = Ssh}) catch _:Error -> - gen_fsm:enter_loop(?MODULE, [], error, {Error, State0}) + gen_fsm:enter_loop(?MODULE, [], error, {Error, State}) end. +%% Temporary fix for the Nessus error. SYN-> <-SYNACK ACK-> RST-> ? +error(_Event, {Error,State=#state{}}) -> + case Error of + {badmatch,{error,enotconn}} -> + %% {error,enotconn} probably from inet:peername in + %% init_ssh(server,..)/5 called from init/1 + {stop, {shutdown,"TCP connenction to server was prematurely closed by the client"}, State}; + _ -> + {stop, {shutdown,{init,Error}}, State} + end; +error(Event, State) -> + %% State deliberately not checked beeing #state. This is a panic-clause... + {stop, {shutdown,{init,{spurious_error,Event}}}, State}. + %%-------------------------------------------------------------------- -spec open_channel(pid(), string(), iodata(), integer(), integer(), timeout()) -> {open, channel_id()} | {error, term()}. @@ -229,6 +256,9 @@ send_eof(ConnectionHandler, ChannelId) -> %%-------------------------------------------------------------------- -spec connection_info(pid(), [atom()]) -> proplists:proplist(). %%-------------------------------------------------------------------- +get_print_info(ConnectionHandler) -> + sync_send_all_state_event(ConnectionHandler, get_print_info, 1000). + connection_info(ConnectionHandler, Options) -> sync_send_all_state_event(ConnectionHandler, {connection_info, Options}). @@ -291,28 +321,39 @@ info(ConnectionHandler, ChannelProcess) -> hello(socket_control, #state{socket = Socket, ssh_params = Ssh} = State) -> VsnMsg = ssh_transport:hello_version_msg(string_version(Ssh)), send_msg(VsnMsg, State), - inet:setopts(Socket, [{packet, line}, {active, once}]), - {next_state, hello, State}; + {ok, [{recbuf, Size}]} = inet:getopts(Socket, [recbuf]), + inet:setopts(Socket, [{packet, line}, {active, once}, {recbuf, ?MAX_PROTO_VERSION}]), + {next_state, hello, State#state{recbuf = Size}}; -hello({info_line, _Line},#state{socket = Socket} = State) -> +hello({info_line, _Line},#state{role = client, socket = Socket} = State) -> + %% The server may send info lines before the version_exchange inet:setopts(Socket, [{active, once}]), {next_state, hello, State}; +hello({info_line, _Line},#state{role = server} = State) -> + DisconnectMsg = + #ssh_msg_disconnect{code = + ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Did not receive expected protocol version exchange", + language = "en"}, + handle_disconnect(DisconnectMsg, State); + hello({version_exchange, Version}, #state{ssh_params = Ssh0, - socket = Socket} = State) -> + socket = Socket, + recbuf = Size} = State) -> {NumVsn, StrVsn} = ssh_transport:handle_hello_version(Version), case handle_version(NumVsn, StrVsn, Ssh0) of {ok, Ssh1} -> - inet:setopts(Socket, [{packet,0}, {mode,binary}, {active, once}]), + inet:setopts(Socket, [{packet,0}, {mode,binary}, {active, once}, {recbuf, Size}]), {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh1), send_msg(SshPacket, State), {next_state, kexinit, next_packet(State#state{ssh_params = Ssh, key_exchange_init_msg = KeyInitMsg})}; not_supported -> - DisconnectMsg = + DisconnectMsg = #ssh_msg_disconnect{code = - ?SSH_DISCONNECT_PROTOCOL_VERSION_NOT_SUPPORTED, + ?SSH_DISCONNECT_PROTOCOL_VERSION_NOT_SUPPORTED, description = "Protocol version " ++ StrVsn ++ " not supported", language = "en"}, @@ -528,7 +569,7 @@ connected({#ssh_msg_kexinit{}, _Payload} = Event, State) -> %%-------------------------------------------------------------------- handle_event(#ssh_msg_disconnect{description = Desc} = DisconnectMsg, _StateName, #state{} = State) -> - handle_disconnect(DisconnectMsg, State), + handle_disconnect(peer, DisconnectMsg, State), {stop, {shutdown, Desc}, State}; handle_event(#ssh_msg_ignore{}, StateName, State) -> @@ -736,6 +777,20 @@ handle_sync_event({recv_window, ChannelId}, _From, StateName, end, {reply, Reply, StateName, next_packet(State)}; +handle_sync_event(get_print_info, _From, StateName, State) -> + Reply = + try + {inet:sockname(State#state.socket), + inet:peername(State#state.socket) + } + of + {{ok,Local}, {ok,Remote}} -> {{Local,Remote},io_lib:format("statename=~p",[StateName])}; + _ -> {{"-",0},"-"} + catch + _:_ -> {{"?",0},"?"} + end, + {reply, Reply, StateName, State}; + handle_sync_event({connection_info, Options}, _From, StateName, State) -> Info = ssh_info(Options, State, []), {reply, Info, StateName, State}; @@ -914,6 +969,10 @@ terminate(normal, _, #state{transport_cb = Transport, (catch Transport:close(Socket)), ok; +terminate({shutdown,{init,Reason}}, StateName, State) -> + error_logger:info_report(io_lib:format("Erlang ssh in connection handler init: ~p~n",[Reason])), + terminate(normal, StateName, State); + %% Terminated by supervisor terminate(shutdown, StateName, #state{ssh_params = Ssh0} = State) -> DisconnectMsg = @@ -929,8 +988,10 @@ terminate({shutdown, #ssh_msg_disconnect{} = Msg}, StateName, {SshPacket, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), send_msg(SshPacket, State), terminate(normal, StateName, State#state{ssh_params = Ssh}); + terminate({shutdown, _}, StateName, State) -> terminate(normal, StateName, State); + terminate(Reason, StateName, #state{ssh_params = Ssh0, starter = _Pid, connection_state = Connection} = State) -> terminate_subsytem(Connection), @@ -943,12 +1004,43 @@ terminate(Reason, StateName, #state{ssh_params = Ssh0, starter = _Pid, send_msg(SshPacket, State), terminate(normal, StateName, State#state{ssh_params = Ssh}). + terminate_subsytem(#connection{system_supervisor = SysSup, sub_system_supervisor = SubSysSup}) when is_pid(SubSysSup) -> ssh_system_sup:stop_subsystem(SysSup, SubSysSup); terminate_subsytem(_) -> ok. +format_status(normal, [_, State]) -> + [{data, [{"StateData", State}]}]; +format_status(terminate, [_, State]) -> + SshParams0 = (State#state.ssh_params), + SshParams = SshParams0#ssh{c_keyinit = "***", + s_keyinit = "***", + send_mac_key = "***", + send_mac_size = "***", + recv_mac_key = "***", + recv_mac_size = "***", + encrypt_keys = "***", + encrypt_ctx = "***", + decrypt_keys = "***", + decrypt_ctx = "***", + compress_ctx = "***", + decompress_ctx = "***", + shared_secret = "***", + exchanged_hash = "***", + session_id = "***", + keyex_key = "***", + keyex_info = "***", + available_host_keys = "***"}, + [{data, [{"StateData", State#state{decoded_data_buffer = "***", + encoded_data_buffer = "***", + key_exchange_init_msg = "***", + opts = "***", + recbuf = "***", + ssh_params = SshParams + }}]}]. + %%-------------------------------------------------------------------- -spec code_change(OldVsn::term(), state_name(), Oldstate::term(), Extra::term()) -> {ok, state_name(), #state{}}. @@ -1109,7 +1201,10 @@ send_all_state_event(FsmPid, Event) -> gen_fsm:send_all_state_event(FsmPid, Event). sync_send_all_state_event(FsmPid, Event) -> - try gen_fsm:sync_send_all_state_event(FsmPid, Event, infinity) + sync_send_all_state_event(FsmPid, Event, infinity). + +sync_send_all_state_event(FsmPid, Event, Timeout) -> + try gen_fsm:sync_send_all_state_event(FsmPid, Event, Timeout) catch exit:{noproc, _} -> {error, closed}; @@ -1206,13 +1301,23 @@ generate_event(<<?BYTE(Byte), _/binary>> = Msg, StateName, generate_event(Msg, StateName, State0, EncData) -> Event = ssh_message:decode(Msg), State = generate_event_new_state(State0, EncData), - case Event of - #ssh_msg_kexinit{} -> - %% We need payload for verification later. - event({Event, Msg}, StateName, State); - _ -> - event(Event, StateName, State) - end. + try + case Event of + #ssh_msg_kexinit{} -> + %% We need payload for verification later. + event({Event, Msg}, StateName, State); + _ -> + event(Event, StateName, State) + end + catch + _:_ -> + DisconnectMsg = + #ssh_msg_disconnect{code = ?SSH_DISCONNECT_PROTOCOL_ERROR, + description = "Encountered unexpected input", + language = "en"}, + handle_disconnect(DisconnectMsg, State) + end. + handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, @@ -1390,17 +1495,27 @@ handle_ssh_packet(Length, StateName, #state{decoded_data_buffer = DecData0, handle_disconnect(DisconnectMsg, State0) end. -handle_disconnect(#ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, - role = Role} = State0) -> +handle_disconnect(DisconnectMsg, State) -> + handle_disconnect(own, DisconnectMsg, State). + +handle_disconnect(#ssh_msg_disconnect{} = DisconnectMsg, State, Error) -> + handle_disconnect(own, DisconnectMsg, State, Error); +handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, role = Role} = State0) -> {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), - State = send_replies(Replies, State0), + State = send_replies(disconnect_replies(Type, Msg, Replies), State0), {stop, {shutdown, Desc}, State#state{connection_state = Connection}}. -handle_disconnect(#ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, - role = Role} = State0, ErrorMsg) -> + +handle_disconnect(Type, #ssh_msg_disconnect{description = Desc} = Msg, #state{connection_state = Connection0, + role = Role} = State0, ErrorMsg) -> {disconnect, _, {{replies, Replies}, Connection}} = ssh_connection:handle_msg(Msg, Connection0, Role), - State = send_replies(Replies, State0), + State = send_replies(disconnect_replies(Type, Msg, Replies), State0), {stop, {shutdown, {Desc, ErrorMsg}}, State#state{connection_state = Connection}}. +disconnect_replies(own, Msg, Replies) -> + [{connection_reply, Msg} | Replies]; +disconnect_replies(peer, _, Replies) -> + Replies. + counterpart_versions(NumVsn, StrVsn, #ssh{role = server} = Ssh) -> Ssh#ssh{c_vsn = NumVsn , c_version = StrVsn}; counterpart_versions(NumVsn, StrVsn, #ssh{role = client} = Ssh) -> diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl new file mode 100644 index 0000000000..9ed598b3ab --- /dev/null +++ b/lib/ssh/src/ssh_info.erl @@ -0,0 +1,193 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% +%% The 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: Print some info of a running ssh aplication. +%%---------------------------------------------------------------------- + +-module(ssh_info). + +-compile(export_all). + +print() -> + try supervisor:which_children(ssh_sup) + of + _ -> + io:nl(), + print_general(), + io:nl(), + underline("Client part", $=), + print_clients(), + io:nl(), + underline("Server part", $=), + print_servers(), + io:nl(), + %% case os:type() of + %% {unix,_} -> + %% io:nl(), + %% underline("Linux part", $=), + %% underline("Listening"), + %% catch io:format(os:cmd("netstat -tpln")), + %% io:nl(), + %% underline("Other"), + %% catch io:format(os:cmd("netstat -tpn")); + %% _ -> ok + %% end, + underline("Supervisors", $=), + walk_sups(ssh_sup), + io:nl() + catch + _:_ -> + io:format("Ssh not found~n",[]) + end. + +%%%================================================================ +print_general() -> + {_Name, Slogan, Ver} = lists:keyfind(ssh,1,application:which_applications()), + underline(io_lib:format("~s ~s", [Slogan, Ver]), $=), + io:format('This printout is generated ~s. ~n',[datetime()]). + +%%%================================================================ +print_clients() -> + try + lists:foreach(fun print_client/1, supervisor:which_children(sshc_sup)) + catch + C:E -> + io:format('***FAILED: ~p:~p~n',[C,E]) + end. + +print_client({undefined,Pid,supervisor,[ssh_connection_handler]}) -> + {{Local,Remote},_Str} = ssh_connection_handler:get_print_info(Pid), + io:format(" Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]); +print_client(Other) -> + io:format(" [[Other 1: ~p]]~n",[Other]). + + +%%%================================================================ +print_servers() -> + try + lists:foreach(fun print_server/1, supervisor:which_children(sshd_sup)) + catch + C:E -> + io:format('***FAILED: ~p:~p~n',[C,E]) + end. + +print_server({{server,ssh_system_sup,LocalHost,LocalPort},Pid,supervisor,[ssh_system_sup]}) when is_pid(Pid) -> + io:format('Local=~s (~p children)~n',[fmt_host_port({LocalHost,LocalPort}), + ssh_acceptor:number_of_connections(Pid)]), + lists:foreach(fun print_system_sup/1, supervisor:which_children(Pid)); +print_server(Other) -> + io:format(" [[Other 2: ~p]]~n",[Other]). + +print_system_sup({Ref,Pid,supervisor,[ssh_subsystem_sup]}) when is_reference(Ref), + is_pid(Pid) -> + lists:foreach(fun print_channels/1, supervisor:which_children(Pid)); +print_system_sup({{ssh_acceptor_sup,LocalHost,LocalPort}, Pid,supervisor, [ssh_acceptor_sup]}) when is_pid(Pid) -> + io:format(" [Acceptor for ~s]~n",[fmt_host_port({LocalHost,LocalPort})]); +print_system_sup(Other) -> + io:format(" [[Other 3: ~p]]~n",[Other]). + +print_channels({{server,ssh_channel_sup,_,_},Pid,supervisor,[ssh_channel_sup]}) when is_pid(Pid) -> + lists:foreach(fun print_channel/1, supervisor:which_children(Pid)); +print_channels(Other) -> + io:format(" [[Other 4: ~p]]~n",[Other]). + + +print_channel({Ref,Pid,worker,[ssh_channel]}) when is_reference(Ref), + is_pid(Pid) -> + {{ConnManager,ChannelID}, Str} = ssh_channel:get_print_info(Pid), + {{Local,Remote},StrM} = ssh_connection_handler:get_print_info(ConnManager), + io:format(' ch ~p: ~s ~s',[ChannelID, StrM, Str]), + io:format(" Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]); +print_channel(Other) -> + io:format(" [[Other 5: ~p]]~n",[Other]). + +%%%================================================================ +-define(inc(N), (N+4)). + +walk_sups(StartPid) -> + io:format("Start at ~p, ~s.~n",[StartPid,dead_or_alive(StartPid)]), + walk_sups(children(StartPid), _Indent=?inc(0)). + +walk_sups([H={_,Pid,SupOrWorker,_}|T], Indent) -> + indent(Indent), io:format('~200p ~p is ~s~n',[H,Pid,dead_or_alive(Pid)]), + case SupOrWorker of + supervisor -> walk_sups(children(Pid), ?inc(Indent)); + _ -> ok + end, + walk_sups(T, Indent); +walk_sups([], _) -> + ok. + +dead_or_alive(Name) when is_atom(Name) -> + case whereis(Name) of + undefined -> + "**UNDEFINED**"; + Pid -> + dead_or_alive(Pid) + end; +dead_or_alive(Pid) when is_pid(Pid) -> + case process_info(Pid) of + undefined -> "**DEAD**"; + _ -> "alive" + end. + +indent(I) -> io:format('~*c',[I,$ ]). + +children(Pid) -> + Parent = self(), + Helper = spawn(fun() -> + Parent ! {self(),supervisor:which_children(Pid)} + end), + receive + {Helper,L} when is_list(L) -> + L + after + 2000 -> + catch exit(Helper, kill), + [] + end. + +%%%================================================================ +underline(Str) -> + underline(Str, $-). + +underline(Str, LineChar) -> + Len = lists:flatlength(Str), + io:format('~s~n',[Str]), + line(Len,LineChar). + +line(Len, Char) -> + io:format('~*c~n', [Len,Char]). + + +datetime() -> + {{YYYY,MM,DD}, {H,M,S}} = calendar:now_to_universal_time(now()), + lists:flatten(io_lib:format('~4w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w UTC',[YYYY,MM,DD, H,M,S])). + + +fmt_host_port({{A,B,C,D},Port}) -> io_lib:format('~p.~p.~p.~p:~p',[A,B,C,D,Port]); +fmt_host_port({Host,Port}) -> io_lib:format('~s:~p',[Host,Port]). + + + +nyi() -> + io:format('Not yet implemented~n',[]), + nyi. diff --git a/lib/ssh/src/ssh_io.erl b/lib/ssh/src/ssh_io.erl index 35336bce8b..97e2dee27a 100644 --- a/lib/ssh/src/ssh_io.erl +++ b/lib/ssh/src/ssh_io.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -73,7 +73,9 @@ read_password(Prompt, Ssh) -> listify(A) when is_atom(A) -> atom_to_list(A); listify(L) when is_list(L) -> - L. + L; +listify(B) when is_binary(B) -> + binary_to_list(B). format(Fmt, Args) -> io:format(Fmt, Args). diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index 76b57cb995..66e7717095 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2013. All Rights Reserved. +%% Copyright Ericsson AB 2013-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -162,8 +162,15 @@ encode(#ssh_msg_userauth_info_request{ encode(#ssh_msg_userauth_info_response{ num_responses = Num, data = Data}) -> - ssh_bits:encode([?SSH_MSG_USERAUTH_INFO_RESPONSE, Num, Data], - [byte, uint32, '...']); + Responses = lists:map(fun("") -> + <<>>; + (Response) -> + ssh_bits:encode([Response], [string]) + end, Data), + Start = ssh_bits:encode([?SSH_MSG_USERAUTH_INFO_RESPONSE, Num], + [byte, uint32]), + iolist_to_binary([Start, Responses]); + encode(#ssh_msg_disconnect{ code = Code, description = Desc, @@ -498,6 +505,11 @@ erl_boolean(1) -> decode_kex_init(<<?BYTE(Bool), ?UINT32(X)>>, Acc, 0) -> list_to_tuple(lists:reverse([X, erl_boolean(Bool) | Acc])); +decode_kex_init(<<?BYTE(Bool)>>, Acc, 0) -> + %% The mandatory trailing UINT32 is missing. Assume the value it anyhow must have + %% See rfc 4253 7.1 + X = 0, + list_to_tuple(lists:reverse([X, erl_boolean(Bool) | Acc])); decode_kex_init(<<?UINT32(Len), Data:Len/binary, Rest/binary>>, Acc, N) -> Names = string:tokens(unicode:characters_to_list(Data), ","), decode_kex_init(Rest, [Names | Acc], N -1). diff --git a/lib/ssh/src/ssh_sftp.erl b/lib/ssh/src/ssh_sftp.erl index 0ea2366ac7..721146c509 100644 --- a/lib/ssh/src/ssh_sftp.erl +++ b/lib/ssh/src/ssh_sftp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. All Rights Reserved. %% %% The 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,7 +57,8 @@ rep_buf = <<>>, req_id, req_list = [], %% {ReqId, Fun} - inf %% list of fileinf + inf, %% list of fileinf, + opts }). -record(fileinf, @@ -85,10 +86,11 @@ start_channel(Host) when is_list(Host) -> start_channel(Host, []). start_channel(Cm, Opts) when is_pid(Cm) -> Timeout = proplists:get_value(timeout, Opts, infinity), + {_, SftpOpts} = handle_options(Opts, [], []), case ssh_xfer:attach(Cm, []) of {ok, ChannelId, Cm} -> case ssh_channel:start(Cm, ChannelId, - ?MODULE, [Cm, ChannelId, Timeout]) of + ?MODULE, [Cm, ChannelId, SftpOpts]) of {ok, Pid} -> case wait_for_version_negotiation(Pid, Timeout) of ok -> @@ -108,11 +110,12 @@ start_channel(Cm, Opts) when is_pid(Cm) -> start_channel(Host, Opts) -> start_channel(Host, 22, Opts). start_channel(Host, Port, Opts) -> - Timeout = proplists:get_value(timeout, Opts, infinity), - case ssh_xfer:connect(Host, Port, proplists:delete(timeout, Opts)) of + {SshOpts, SftpOpts} = handle_options(Opts, [], []), + Timeout = proplists:get_value(timeout, SftpOpts, infinity), + case ssh_xfer:connect(Host, Port, SshOpts) of {ok, ChannelId, Cm} -> case ssh_channel:start(Cm, ChannelId, ?MODULE, [Cm, - ChannelId, Timeout]) of + ChannelId, SftpOpts]) of {ok, Pid} -> case wait_for_version_negotiation(Pid, Timeout) of ok -> @@ -392,7 +395,8 @@ write_file_loop(Pid, Handle, Pos, Bin, Remain, PacketSz, FileOpTimeout) -> %% %% Description: %%-------------------------------------------------------------------- -init([Cm, ChannelId, Timeout]) -> +init([Cm, ChannelId, Options]) -> + Timeout = proplists:get_value(timeout, Options, infinity), erlang:monitor(process, Cm), case ssh_connection:subsystem(Cm, ChannelId, "sftp", Timeout) of success -> @@ -401,7 +405,8 @@ init([Cm, ChannelId, Timeout]) -> {ok, #state{xf = Xf, req_id = 0, rep_buf = <<>>, - inf = new_inf()}}; + inf = new_inf(), + opts = Options}}; failure -> {stop, "server failed to start sftp subsystem"}; Error -> @@ -707,8 +712,9 @@ handle_ssh_msg({ssh_cm, _, {exit_status, ChannelId, Status}}, State0) -> %% %% Description: Handles channel messages %%-------------------------------------------------------------------- -handle_msg({ssh_channel_up, _, _}, #state{xf = Xf} = State) -> - ssh_xfer:protocol_version_request(Xf), +handle_msg({ssh_channel_up, _, _}, #state{opts = Options, xf = Xf} = State) -> + Version = proplists:get_value(sftp_vsn, Options, ?SSH_SFTP_PROTOCOL_VERSION), + ssh_xfer:protocol_version_request(Xf, Version), {ok, State}; %% Version negotiation timed out @@ -754,6 +760,15 @@ terminate(_Reason, State) -> %%==================================================================== %% Internal functions %%==================================================================== +handle_options([], Sftp, Ssh) -> + {Ssh, Sftp}; +handle_options([{timeout, _} = Opt | Rest], Sftp, Ssh) -> + handle_options(Rest, [Opt | Sftp], Ssh); +handle_options([{sftp_vsn, _} = Opt| Rest], Sftp, Ssh) -> + handle_options(Rest, [Opt | Sftp], Ssh); +handle_options([Opt | Rest], Sftp, Ssh) -> + handle_options(Rest, Sftp, [Opt | Ssh]). + call(Pid, Msg, TimeOut) -> ssh_channel:call(Pid, {{timeout, TimeOut}, Msg}, infinity). diff --git a/lib/ssh/src/ssh_system_sup.erl b/lib/ssh/src/ssh_system_sup.erl index 848133f838..660fe8bb65 100644 --- a/lib/ssh/src/ssh_system_sup.erl +++ b/lib/ssh/src/ssh_system_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -173,8 +173,8 @@ ssh_acceptor_sup([_ | Rest]) -> ssh_acceptor_sup(Rest). stop_acceptor(Sup) -> - [Name] = - [SupName || {SupName, _, _, [ssh_acceptor_sup]} <- + [{Name, AcceptorSup}] = + [{SupName, ASup} || {SupName, ASup, _, [ssh_acceptor_sup]} <- supervisor:which_children(Sup)], - supervisor:terminate_child(Sup, Name). + supervisor:terminate_child(AcceptorSup, Name). diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 27723dc870..76fa776113 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The 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,16 +82,21 @@ format_version({Major,Minor}) -> integer_to_list(Minor) ++ "-Erlang". handle_hello_version(Version) -> - StrVersion = trim_tail(Version), - case string:tokens(Version, "-") of - [_, "2.0" | _] -> - {{2,0}, StrVersion}; - [_, "1.99" | _] -> - {{2,0}, StrVersion}; - [_, "1.3" | _] -> - {{1,3}, StrVersion}; - [_, "1.5" | _] -> - {{1,5}, StrVersion} + try + StrVersion = trim_tail(Version), + case string:tokens(Version, "-") of + [_, "2.0" | _] -> + {{2,0}, StrVersion}; + [_, "1.99" | _] -> + {{2,0}, StrVersion}; + [_, "1.3" | _] -> + {{1,3}, StrVersion}; + [_, "1.5" | _] -> + {{1,5}, StrVersion} + end + catch + error:_ -> + {undefined, "unknown version"} end. key_exchange_init_msg(Ssh0) -> @@ -113,15 +118,28 @@ key_init(client, Ssh, Value) -> key_init(server, Ssh, Value) -> Ssh#ssh{s_keyinit = Value}. +available_ssh_algos() -> + Supports = crypto:supports(), + CipherAlgos = [{aes_ctr, "aes128-ctr"}, {aes_cbc128, "aes128-cbc"}, {des3_cbc, "3des-cbc"}], + Ciphers = [SshAlgo || + {CryptoAlgo, SshAlgo} <- CipherAlgos, + lists:member(CryptoAlgo, proplists:get_value(ciphers, Supports, []))], + HashAlgos = [{sha256, "hmac-sha2-256"}, {sha, "hmac-sha1"}], + Hashs = [SshAlgo || + {CryptoAlgo, SshAlgo} <- HashAlgos, + lists:member(CryptoAlgo, proplists:get_value(hashs, Supports, []))], + {Ciphers, Hashs}. + kexinit_messsage(client, Random, Compression, HostKeyAlgs) -> + {CipherAlgs, HashAlgs} = available_ssh_algos(), #ssh_msg_kexinit{ cookie = Random, kex_algorithms = ["diffie-hellman-group1-sha1"], server_host_key_algorithms = HostKeyAlgs, - encryption_algorithms_client_to_server = ["aes128-cbc","3des-cbc"], - encryption_algorithms_server_to_client = ["aes128-cbc","3des-cbc"], - mac_algorithms_client_to_server = ["hmac-sha1"], - mac_algorithms_server_to_client = ["hmac-sha1"], + encryption_algorithms_client_to_server = CipherAlgs, + encryption_algorithms_server_to_client = CipherAlgs, + mac_algorithms_client_to_server = HashAlgs, + mac_algorithms_server_to_client = HashAlgs, compression_algorithms_client_to_server = Compression, compression_algorithms_server_to_client = Compression, languages_client_to_server = [], @@ -129,14 +147,15 @@ kexinit_messsage(client, Random, Compression, HostKeyAlgs) -> }; kexinit_messsage(server, Random, Compression, HostKeyAlgs) -> + {CipherAlgs, HashAlgs} = available_ssh_algos(), #ssh_msg_kexinit{ cookie = Random, kex_algorithms = ["diffie-hellman-group1-sha1"], server_host_key_algorithms = HostKeyAlgs, - encryption_algorithms_client_to_server = ["aes128-cbc","3des-cbc"], - encryption_algorithms_server_to_client = ["aes128-cbc","3des-cbc"], - mac_algorithms_client_to_server = ["hmac-sha1"], - mac_algorithms_server_to_client = ["hmac-sha1"], + encryption_algorithms_client_to_server = CipherAlgs, + encryption_algorithms_server_to_client = CipherAlgs, + mac_algorithms_client_to_server = HashAlgs, + mac_algorithms_server_to_client = HashAlgs, compression_algorithms_client_to_server = Compression, compression_algorithms_server_to_client = Compression, languages_client_to_server = [], @@ -636,7 +655,21 @@ encrypt_init(#ssh{encrypt = 'aes128-cbc', role = server} = Ssh) -> <<K:16/binary>> = hash(Ssh, "D", 128), {ok, Ssh#ssh{encrypt_keys = K, encrypt_block_size = 16, - encrypt_ctx = IV}}. + encrypt_ctx = IV}}; +encrypt_init(#ssh{encrypt = 'aes128-ctr', role = client} = Ssh) -> + IV = hash(Ssh, "A", 128), + <<K:16/binary>> = hash(Ssh, "C", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{encrypt_keys = K, + encrypt_block_size = 16, + encrypt_ctx = State}}; +encrypt_init(#ssh{encrypt = 'aes128-ctr', role = server} = Ssh) -> + IV = hash(Ssh, "B", 128), + <<K:16/binary>> = hash(Ssh, "D", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{encrypt_keys = K, + encrypt_block_size = 16, + encrypt_ctx = State}}. encrypt_final(Ssh) -> {ok, Ssh#ssh{encrypt = none, @@ -658,7 +691,11 @@ encrypt(#ssh{encrypt = 'aes128-cbc', encrypt_ctx = IV0} = Ssh, Data) -> Enc = crypto:block_encrypt(aes_cbc128, K,IV0,Data), IV = crypto:next_iv(aes_cbc, Enc), - {Ssh#ssh{encrypt_ctx = IV}, Enc}. + {Ssh#ssh{encrypt_ctx = IV}, Enc}; +encrypt(#ssh{encrypt = 'aes128-ctr', + encrypt_ctx = State0} = Ssh, Data) -> + {State, Enc} = crypto:stream_encrypt(State0,Data), + {Ssh#ssh{encrypt_ctx = State}, Enc}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -690,7 +727,21 @@ decrypt_init(#ssh{decrypt = 'aes128-cbc', role = server} = Ssh) -> hash(Ssh, "C", 128)}, <<K:16/binary>> = KD, {ok, Ssh#ssh{decrypt_keys = K, decrypt_ctx = IV, - decrypt_block_size = 16}}. + decrypt_block_size = 16}}; +decrypt_init(#ssh{decrypt = 'aes128-ctr', role = client} = Ssh) -> + IV = hash(Ssh, "B", 128), + <<K:16/binary>> = hash(Ssh, "D", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{decrypt_keys = K, + decrypt_block_size = 16, + decrypt_ctx = State}}; +decrypt_init(#ssh{decrypt = 'aes128-ctr', role = server} = Ssh) -> + IV = hash(Ssh, "A", 128), + <<K:16/binary>> = hash(Ssh, "C", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{decrypt_keys = K, + decrypt_block_size = 16, + decrypt_ctx = State}}. decrypt_final(Ssh) -> @@ -711,7 +762,11 @@ decrypt(#ssh{decrypt = 'aes128-cbc', decrypt_keys = Key, decrypt_ctx = IV0} = Ssh, Data) -> Dec = crypto:block_decrypt(aes_cbc128, Key,IV0,Data), IV = crypto:next_iv(aes_cbc, Data), - {Ssh#ssh{decrypt_ctx = IV}, Dec}. + {Ssh#ssh{decrypt_ctx = IV}, Dec}; +decrypt(#ssh{decrypt = 'aes128-ctr', + decrypt_ctx = State0} = Ssh, Data) -> + {State, Enc} = crypto:stream_decrypt(State0,Data), + {Ssh#ssh{decrypt_ctx = State}, Enc}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Compression @@ -846,7 +901,9 @@ mac('hmac-sha1-96', Key, SeqNum, Data) -> mac('hmac-md5', Key, SeqNum, Data) -> crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data]); mac('hmac-md5-96', Key, SeqNum, Data) -> - crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-md5-96')). + crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-md5-96')); +mac('hmac-sha2-256', Key, SeqNum, Data) -> + crypto:hmac(sha256, Key, [<<?UINT32(SeqNum)>>, Data]). %% return N hash bytes (HASH) hash(SSH, Char, Bits) -> @@ -911,12 +968,14 @@ mac_key_size('hmac-sha1') -> 20*8; mac_key_size('hmac-sha1-96') -> 20*8; mac_key_size('hmac-md5') -> 16*8; mac_key_size('hmac-md5-96') -> 16*8; +mac_key_size('hmac-sha2-256')-> 32*8; mac_key_size(none) -> 0. mac_digest_size('hmac-sha1') -> 20; mac_digest_size('hmac-sha1-96') -> 12; mac_digest_size('hmac-md5') -> 20; mac_digest_size('hmac-md5-96') -> 12; +mac_digest_size('hmac-sha2-256') -> 32; mac_digest_size(none) -> 0. peer_name({Host, _}) -> diff --git a/lib/ssh/src/ssh_xfer.erl b/lib/ssh/src/ssh_xfer.erl index 63d01fd9de..1881392db8 100644 --- a/lib/ssh/src/ssh_xfer.erl +++ b/lib/ssh/src/ssh_xfer.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. All Rights Reserved. %% %% The 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 @@ rename/5, remove/3, mkdir/4, rmdir/3, realpath/3, extended/4, stat/4, fstat/4, lstat/4, setstat/4, readlink/3, fsetstat/4, symlink/4, - protocol_version_request/1, + protocol_version_request/2, xf_reply/2, xf_send_reply/3, xf_send_names/3, xf_send_name/4, xf_send_status/3, xf_send_status/4, xf_send_status/5, @@ -67,8 +67,8 @@ open_xfer(CM, Opts) -> Error end. -protocol_version_request(XF) -> - xf_request(XF, ?SSH_FXP_INIT, <<?UINT32(?SSH_SFTP_PROTOCOL_VERSION)>>). +protocol_version_request(XF, Version) -> + xf_request(XF, ?SSH_FXP_INIT, <<?UINT32(Version)>>). open(XF, ReqID, FileName, Access, Flags, Attrs) -> Vsn = XF#ssh_xfer.vsn, diff --git a/lib/ssh/test/property_test/README b/lib/ssh/test/property_test/README new file mode 100644 index 0000000000..57602bf719 --- /dev/null +++ b/lib/ssh/test/property_test/README @@ -0,0 +1,12 @@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +The test in this directory are written assuming that the user has a QuickCheck license. They are to be run manually. Some may be possible to be run with other tools, e.g. PropEr. + diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server.erl b/lib/ssh/test/property_test/ssh_eqc_client_server.erl new file mode 100644 index 0000000000..123b48412b --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server.erl @@ -0,0 +1,618 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The 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(ssh_eqc_client_server). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +-ifdef(PROPER). +%% Proper is not supported. +-else. +-ifdef(TRIQ). +%% Proper is not supported. +-else. + + +%% Limit the testing time on CI server... this needs to be improved in % from total budget. +-define(TESTINGTIME(Prop), eqc:testing_time(30,Prop)). + + +-include_lib("eqc/include/eqc.hrl"). +-include_lib("eqc/include/eqc_statem.hrl"). +-eqc_group_commands(true). + +-define(SSH_DIR,"ssh_eqc_client_server_dirs"). + +-define(sec, *1000). +-define(min, *60?sec). + +-record(srvr,{ref, + address, + port + }). + +-record(conn,{ref, + srvr_ref + }). + +-record(chan, {ref, + conn_ref, + subsystem, + client_pid + }). + +-record(state,{ + initialized = false, + servers = [], % [#srvr{}] + clients = [], + connections = [], % [#conn{}] + channels = [], % [#chan{}] + data_dir + }). + +%%%=============================================================== +%%% +%%% Specification of addresses, subsystems and such. +%%% + +-define(MAX_NUM_SERVERS, 3). +-define(MAX_NUM_CLIENTS, 3). + +-define(SUBSYSTEMS, ["echo1", "echo2", "echo3", "echo4"]). + +-define(SERVER_ADDRESS, { {127,1,0,choose(1,254)}, % IP + choose(1024,65535) % Port + }). + +-define(SERVER_EXTRA_OPTIONS, [{parallel_login,bool()}] ). + + +%%%================================================================ +%%% +%%% The properties - one sequantial and one parallel with the same model +%%% +%%% Run as +%%% +%%% $ (cd ..; make) +%%% $ erl -pz .. +%%% +%%% eqc:quickcheck( ssh_eqc_client_server:prop_seq() ). +%%% eqc:quickcheck( ssh_eqc_client_server:prop_parallel() ). +%%% eqc:quickcheck( ssh_eqc_client_server:prop_parallel_multi() ). +%%% + + +%% To be called as eqc:quickcheck( ssh_eqc_client_server:prop_seq() ). +prop_seq() -> + ?TESTINGTIME(do_prop_seq(?SSH_DIR)). + +%% To be called from a common_test test suite +prop_seq(CT_Config) -> + do_prop_seq(full_path(?SSH_DIR, CT_Config)). + + +do_prop_seq(DataDir) -> + setup_rsa(DataDir), + ?FORALL(Cmds,commands(?MODULE), + begin + {H,Sf,Result} = run_commands(?MODULE,Cmds,[{data_dir,DataDir}]), + present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) + end). + +full_path(SSHdir, CT_Config) -> + filename:join(proplists:get_value(property_dir, CT_Config), + SSHdir). +%%%---- +prop_parallel() -> + ?TESTINGTIME(do_prop_parallel(?SSH_DIR)). + +%% To be called from a common_test test suite +prop_parallel(CT_Config) -> + do_prop_parallel(full_path(?SSH_DIR, CT_Config)). + +do_prop_parallel(DataDir) -> + setup_rsa(DataDir), + ?FORALL(Cmds,parallel_commands(?MODULE), + begin + {H,Sf,Result} = run_parallel_commands(?MODULE,Cmds,[{data_dir,DataDir}]), + present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) + end). + +%%%---- +prop_parallel_multi() -> + ?TESTINGTIME(do_prop_parallel_multi(?SSH_DIR)). + +%% To be called from a common_test test suite +prop_parallel_multi(CT_Config) -> + do_prop_parallel_multi(full_path(?SSH_DIR, CT_Config)). + +do_prop_parallel_multi(DataDir) -> + setup_rsa(DataDir), + ?FORALL(Repetitions,?SHRINK(1,[10]), + ?FORALL(Cmds,parallel_commands(?MODULE), + ?ALWAYS(Repetitions, + begin + {H,Sf,Result} = run_parallel_commands(?MODULE,Cmds,[{data_dir,DataDir}]), + present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) + end))). + +%%%================================================================ +%%% State machine spec + +%%% called when using commands/1 +initial_state() -> + #state{}. + +%%% called when using commands/2 +initial_state(DataDir) -> + application:stop(ssh), + ssh:start(). + +%%%---------------- +weight(S, ssh_send) -> 5*length([C || C<-S#state.channels, has_subsyst(C)]); +weight(S, ssh_start_subsyst) -> 3*length([C || C<-S#state.channels, no_subsyst(C)]); +weight(S, ssh_close_channel) -> 2*length([C || C<-S#state.channels, has_subsyst(C)]); +weight(S, ssh_open_channel) -> length(S#state.connections); +weight(_S, _) -> 1. + +%%%---------------- +%%% Initialize + +initial_state_pre(S) -> not S#state.initialized. + +initial_state_args(_) -> [{var,data_dir}]. + +initial_state_next(S, _, _) -> S#state{initialized=true}. + +%%%---------------- +%%% Start a new daemon +%%% Precondition: not more than ?MAX_NUM_SERVERS started + +%%% This is a bit funny because we need to pick an IP address and Port to +%%% run the server on, but there is no way to atomically select a free Port! +%%% +%%% Therefore we just grab one IP-Port pair randomly and try to start the ssh server +%%% on that pair. If it fails, we just forget about it and goes on. Yes, it +%%% is a waste of cpu cycles, but at least it works! + +ssh_server_pre(S) -> S#state.initialized andalso + length(S#state.servers) < ?MAX_NUM_SERVERS. + +ssh_server_args(_) -> [?SERVER_ADDRESS, {var,data_dir}, ?SERVER_EXTRA_OPTIONS]. + +ssh_server({IP,Port}, DataDir, ExtraOptions) -> + ok(ssh:daemon(IP, Port, + [ + {system_dir, system_dir(DataDir)}, + {user_dir, user_dir(DataDir)}, + {subsystems, [{SS, {ssh_eqc_subsys, [SS]}} || SS <- ?SUBSYSTEMS]} + | ExtraOptions + ])). + +ssh_server_post(_S, _Args, {error,eaddrinuse}) -> true; +ssh_server_post(_S, _Args, Result) -> is_ok(Result). + +ssh_server_next(S, {error,eaddrinuse}, _) -> S; +ssh_server_next(S, Result, [{IP,Port},_,_]) -> + S#state{servers=[#srvr{ref = Result, + address = IP, + port = Port} + | S#state.servers]}. + +%%%---------------- +%%% Start a new client +%%% Precondition: not more than ?MAX_NUM_CLIENTS started + +ssh_client_pre(S) -> S#state.initialized andalso + length(S#state.clients) < ?MAX_NUM_CLIENTS. + +ssh_client_args(_S) -> []. + +ssh_client() -> spawn(fun client_init/0). + +ssh_client_next(S, Pid, _) -> S#state{clients=[Pid|S#state.clients]}. + + +client_init() -> client_loop(). + +client_loop() -> + receive + {please_do,Fun,Ref,Pid} -> + Pid ! {my_pleasure, catch Fun(), Ref}, + client_loop() + end. + +do(Pid, Fun) -> do(Pid, Fun, 30?sec). + +do(Pid, Fun, Timeout) when is_function(Fun,0) -> + Pid ! {please_do,Fun,Ref=make_ref(),self()}, + receive + {my_pleasure, Result, Ref} -> Result + after + Timeout -> {error,do_timeout} + end. + +%%%---------------- +%%% Start a new connection +%%% Precondition: deamon exists + +ssh_open_connection_pre(S) -> S#state.servers /= []. + +ssh_open_connection_args(S) -> [oneof(S#state.servers), {var,data_dir}]. + +ssh_open_connection(#srvr{address=Ip, port=Port}, DataDir) -> + ok(ssh:connect(ensure_string(Ip), Port, + [ + {silently_accept_hosts, true}, + {user_dir, user_dir(DataDir)}, + {user_interaction, false}, + {connect_timeout, 2000} + ], 2000)). + +ssh_open_connection_post(_S, _Args, Result) -> is_ok(Result). + +ssh_open_connection_next(S, ConnRef, [#srvr{ref=SrvrRef},_]) -> + S#state{connections=[#conn{ref=ConnRef, srvr_ref=SrvrRef}|S#state.connections]}. + +%%%---------------- +%%% Stop a new connection +%%% Precondition: connection exists + +ssh_close_connection_pre(S) -> S#state.connections /= []. + +ssh_close_connection_args(S) -> [oneof(S#state.connections)]. + +ssh_close_connection(#conn{ref=ConnectionRef}) -> ssh:close(ConnectionRef). + +ssh_close_connection_next(S, _, [Conn=#conn{ref=ConnRef}]) -> + S#state{connections = S#state.connections--[Conn], + channels = [C || C <- S#state.channels, + C#chan.conn_ref /= ConnRef] + }. + +%%%---------------- +%%% Start a new channel without a sub system +%%% Precondition: connection exists + +ssh_open_channel_pre(S) -> S#state.connections /= []. + +ssh_open_channel_args(S) -> [oneof(S#state.connections)]. + +%%% For re-arrangement in parallel tests. +ssh_open_channel_pre(S,[C]) -> lists:member(C,S#state.connections). + +ssh_open_channel(#conn{ref=ConnectionRef}) -> + ok(ssh_connection:session_channel(ConnectionRef, 20?sec)). + +ssh_open_channel_post(_S, _Args, Result) -> is_ok(Result). + +ssh_open_channel_next(S, ChannelRef, [#conn{ref=ConnRef}]) -> + S#state{channels=[#chan{ref=ChannelRef, + conn_ref=ConnRef} + | S#state.channels]}. + +%%%---------------- +%%% Stop a channel +%%% Precondition: a channel exists, with or without a subsystem + +ssh_close_channel_pre(S) -> S#state.channels /= []. + +ssh_close_channel_args(S) -> [oneof(S#state.channels)]. + +ssh_close_channel(#chan{ref=ChannelRef, conn_ref=ConnectionRef}) -> + ssh_connection:close(ConnectionRef, ChannelRef). + +ssh_close_channel_next(S, _, [C]) -> + S#state{channels = [Ci || Ci <- S#state.channels, + sig(C) /= sig(Ci)]}. + + +sig(C) -> {C#chan.ref, C#chan.conn_ref}. + + +%%%---------------- +%%% Start a sub system on a channel +%%% Precondition: A channel without subsystem exists + +ssh_start_subsyst_pre(S) -> lists:any(fun no_subsyst/1, S#state.channels) andalso + S#state.clients /= []. + +ssh_start_subsyst_args(S) -> [oneof(lists:filter(fun no_subsyst/1, S#state.channels)), + oneof(?SUBSYSTEMS), + oneof(S#state.clients) + ]. + +%% For re-arrangement in parallel tests. +ssh_start_subsyst_pre(S, [C|_]) -> lists:member(C,S#state.channels) + andalso no_subsyst(C). + +ssh_start_subsyst(#chan{ref=ChannelRef, conn_ref=ConnectionRef}, SubSystem, Pid) -> + do(Pid, fun()->ssh_connection:subsystem(ConnectionRef, ChannelRef, SubSystem, 120?sec) end). + +ssh_start_subsyst_post(_S, _Args, Result) -> Result==success. + +ssh_start_subsyst_next(S, _Result, [C,SS,Pid|_]) -> + S#state{channels = [C#chan{subsystem=SS, + client_pid=Pid}|(S#state.channels--[C])] }. + +%%%---------------- +%%% Send a message on a channel +%%% Precondition: a channel exists with a subsystem connected + +ssh_send_pre(S) -> lists:any(fun has_subsyst/1, S#state.channels). + +ssh_send_args(S) -> [oneof(lists:filter(fun has_subsyst/1, S#state.channels)), + choose(0,1), + message()]. + +%% For re-arrangement in parallel tests. +ssh_send_pre(S, [C|_]) -> lists:member(C, S#state.channels). + +ssh_send(C=#chan{conn_ref=ConnectionRef, ref=ChannelRef, client_pid=Pid}, Type, Msg) -> + do(Pid, + fun() -> + case ssh_connection:send(ConnectionRef, ChannelRef, Type, modify_msg(C,Msg), 10?sec) of + ok -> + receive + {ssh_cm,ConnectionRef,{data,ChannelRef,Type,Answer}} -> Answer + after 15?sec -> + %% receive + %% Other -> {error,{unexpected,Other}} + %% after 0 -> + {error,receive_timeout} + %% end + end; + Other -> + Other + end + end). + +ssh_send_blocking(_S, _Args) -> + true. + +ssh_send_post(_S, [C,_,Msg], Response) when is_binary(Response) -> + Expected = ssh_eqc_subsys:response(modify_msg(C,Msg), C#chan.subsystem), + case Response of + Expected -> true; + _ -> {send_failed, size(Response), size(Expected)} + end; + +ssh_send_post(_S, _Args, Response) -> + {error,Response}. + + +modify_msg(_, <<>>) -> <<>>; +modify_msg(#chan{subsystem=SS}, Msg) -> <<(list_to_binary(SS))/binary,Msg/binary>>. + +%%%================================================================ +%%% Misc functions + +message() -> + resize(500, binary()). + + %% binary(). + + %% oneof([binary(), + %% ?LET(Size, choose(0,10000), binary(Size)) + %% ]). + +has_subsyst(C) -> C#chan.subsystem /= undefined. + +no_subsyst(C) -> not has_subsyst(C). + + +ok({ok,X}) -> X; +ok({error,Err}) -> {error,Err}. + +is_ok({error,_}) -> false; +is_ok(_) -> true. + +ensure_string({A,B,C,D}) -> lists:flatten(io_lib:format("~w.~w.~w.~w",[A,B,C,D])); +ensure_string(X) -> X. + +%%%---------------------------------------------------------------- +present_result(_Module, Cmds, _Triple, true) -> + aggregate(with_title("Distribution sequential/parallel"), sequential_parallel(Cmds), + aggregate(with_title("Function calls"), cmnd_names(Cmds), + aggregate(with_title("Message sizes"), empty_msgs(Cmds), + aggregate(print_frequencies(), message_sizes(Cmds), + aggregate(title("Length of command sequences",print_frequencies()), num_calls(Cmds), + true))))); + +present_result(Module, Cmds, Triple, false) -> + pretty_commands(Module, Cmds, Triple, [{show_states,true}], false). + + + +cmnd_names(Cs) -> traverse_commands(fun cmnd_name/1, Cs). +cmnd_name(L) -> [F || {set,_Var,{call,_Mod,F,_As}} <- L]. + +empty_msgs(Cs) -> traverse_commands(fun empty_msg/1, Cs). +empty_msg(L) -> [empty || {set,_,{call,_,ssh_send,[_,_,Msg]}} <- L, + size(Msg)==0]. + +message_sizes(Cs) -> traverse_commands(fun message_size/1, Cs). +message_size(L) -> [size(Msg) || {set,_,{call,_,ssh_send,[_,_,Msg]}} <- L]. + +num_calls(Cs) -> traverse_commands(fun num_call/1, Cs). +num_call(L) -> [length(L)]. + +sequential_parallel(Cs) -> + traverse_commands(fun(L) -> dup_module(L, sequential) end, + fun(L) -> [dup_module(L1, mkmod("parallel",num(L1,L))) || L1<-L] end, + Cs). +dup_module(L, ModName) -> lists:duplicate(length(L), ModName). +mkmod(PfxStr,N) -> list_to_atom(PfxStr++"_"++integer_to_list(N)). + +%% Meta functions for the aggregate functions +traverse_commands(Fun, L) when is_list(L) -> Fun(L); +traverse_commands(Fun, {Seq, ParLs}) -> Fun(lists:append([Seq|ParLs])). + +traverse_commands(Fseq, _Fpar, L) when is_list(L) -> Fseq(L); +traverse_commands(Fseq, Fpar, {Seq, ParLs}) -> lists:append([Fseq(Seq)|Fpar(ParLs)]). + +%%%---------------- +%% PrintMethod([{term(), int()}]) -> any(). +print_frequencies() -> print_frequencies(10). + +print_frequencies(Ngroups) -> fun([]) -> io:format('Empty list!~n',[]); + (L ) -> print_frequencies(L,Ngroups,0,element(1,lists:last(L))) + end. + +print_frequencies(Ngroups, MaxValue) -> fun(L) -> print_frequencies(L,Ngroups,0,MaxValue) end. + +print_frequencies(L, N, Min, Max) when N>Max -> print_frequencies(L++[{N,0}], N, Min, N); +print_frequencies(L, N, Min, Max) -> +%%io:format('L=~p~n',[L]), + try + IntervalUpperLimits = + lists:reverse( + [Max | tl(lists:reverse(lists:seq(Min,Max,round((Max-Min)/N))))] + ), + {Acc0,_} = lists:mapfoldl(fun(Upper,Lower) -> + {{{Lower,Upper},0}, Upper+1} + end, hd(IntervalUpperLimits), tl(IntervalUpperLimits)), + Fs0 = get_frequencies(L, Acc0), + SumVal = lists:sum([V||{_,V}<-Fs0]), + Fs = with_percentage(Fs0, SumVal), + Mean = mean(L), + Median = median(L), + Npos_value = num_digits(SumVal), + Npos_range = num_digits(Max), + io:format("Range~*s: ~s~n",[2*Npos_range-2,"", "Number in range"]), + io:format("~*c:~*c~n",[2*Npos_range+3,$-, max(16,Npos_value+10),$- ]), + [begin + io:format("~*w - ~*w: ~*w ~5.1f%",[Npos_range,Rlow, + Npos_range,Rhigh, + Npos_value,Val, + Percent]), + [io:format(" <-- mean=~.1f",[Mean]) || in_interval(Mean, Interval)], + [io:format(" <-- median=" ++ + if + is_float(Median) -> "~.1f"; + true -> "~p" + end, [Median]) || in_interval(Median, Interval)], + io:nl() + end + || {Interval={Rlow,Rhigh},Val,Percent} <- Fs], + io:format('~*c ~*c~n',[2*Npos_range,32,Npos_value+2,$-]), + io:format('~*c ~*w~n',[2*Npos_range,32,Npos_value,SumVal]) + %%,io:format('L=~p~n',[L]) + catch + C:E -> + io:format('*** Faild printing (~p:~p) for~n~p~n',[C,E,L]) + end. + +get_frequencies([{I,Num}|T], [{{Lower,Upper},Cnt}|Acc]) when Lower=<I,I=<Upper -> + get_frequencies(T, [{{Lower,Upper},Cnt+Num}|Acc]); +get_frequencies(L=[{I,_Num}|_], [Ah={{_Lower,Upper},_Cnt}|Acc]) when I>Upper -> + [Ah | get_frequencies(L,Acc)]; +get_frequencies([], Acc) -> + Acc. + +with_percentage(Fs, Sum) -> + [{Rng,Val,100*Val/Sum} || {Rng,Val} <- Fs]. + + +title(Str, Fun) -> + fun(L) -> + io:format('~s~n',[Str]), + Fun(L) + end. + +num_digits(I) -> 1+trunc(math:log(I)/math:log(10)). + +num(Elem, List) -> length(lists:takewhile(fun(E) -> E /= Elem end, List)) + 1. + +%%%---- Just for naming an operation for readability +is_odd(I) -> (I rem 2) == 1. + +in_interval(Value, {Rlow,Rhigh}) -> + try + Rlow=<round(Value) andalso round(Value)=<Rhigh + catch + _:_ -> false + end. + +%%%================================================================ +%%% Statistical functions + +%%%---- Mean value +mean(L = [X|_]) when is_number(X) -> + lists:sum(L) / length(L); +mean(L = [{_Value,_Weight}|_]) -> + SumOfWeights = lists:sum([W||{_,W}<-L]), + WeightedSum = lists:sum([W*V||{V,W}<-L]), + WeightedSum / SumOfWeights; +mean(_) -> + undefined. + +%%%---- Median +median(L = [X|_]) when is_number(X) -> + case is_odd(length(L)) of + true -> + hd(lists:nthtail(length(L) div 2, L)); + false -> + %% 1) L has at least on element (the when test). + %% 2) Length is even. + %% => Length >= 2 + [M1,M2|_] = lists:nthtail((length(L) div 2)-1, L), + (M1+M2) / 2 + end; +%% integer Weights... +median(L = [{_Value,_Weight}|_]) -> + median( lists:append([lists:duplicate(W,V) || {V,W} <- L]) ); +median(_) -> + undefined. + +%%%================================================================ +%%% The rest is taken and modified from ssh_test_lib.erl +setup_rsa(Dir) -> + erase_dir(system_dir(Dir)), + erase_dir(user_dir(Dir)), + file:make_dir(system_dir(Dir)), + file:make_dir(user_dir(Dir)), + + file:copy(data_dir(Dir,"id_rsa"), user_dir(Dir,"id_rsa")), + file:copy(data_dir(Dir,"ssh_host_rsa_key"), system_dir(Dir,"ssh_host_rsa_key")), + file:copy(data_dir(Dir,"ssh_host_rsa_key"), system_dir(Dir,"ssh_host_rsa_key.pub")), + ssh_test_lib:setup_rsa_known_host(data_dir(Dir), user_dir(Dir)), + ssh_test_lib:setup_rsa_auth_keys(data_dir(Dir), user_dir(Dir)). + +data_dir(Dir, File) -> filename:join(Dir, File). +system_dir(Dir, File) -> filename:join([Dir, "system", File]). +user_dir(Dir, File) -> filename:join([Dir, "user", File]). + +data_dir(Dir) -> Dir. +system_dir(Dir) -> system_dir(Dir,""). +user_dir(Dir) -> user_dir(Dir,""). + +erase_dir(Dir) -> + case file:list_dir(Dir) of + {ok,Files} -> lists:foreach(fun(F) -> file:delete(filename:join(Dir,F)) end, + Files); + _ -> ok + end, + file:del_dir(Dir). + +-endif. +-endif. diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_dsa b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_rsa b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_rsa @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key.pub b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key.pub b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl new file mode 100644 index 0000000000..57ea2012c1 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl @@ -0,0 +1,395 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The 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(ssh_eqc_encode_decode). + +-compile(export_all). + +-proptest(eqc). +-proptest([triq,proper]). + +-ifndef(EQC). +-ifndef(PROPER). +-ifndef(TRIQ). +-define(EQC,true). +%%-define(PROPER,true). +%%-define(TRIQ,true). +-endif. +-endif. +-endif. + +-ifdef(EQC). +-include_lib("eqc/include/eqc.hrl"). +-define(MOD_eqc,eqc). + +-else. +-ifdef(PROPER). +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc,proper). + +-else. +-ifdef(TRIQ). +-define(MOD_eqc,triq). +-include_lib("triq/include/triq.hrl"). + +-endif. +-endif. +-endif. + + +%%% Properties: + +prop_ssh_decode() -> + ?FORALL(Msg, ssh_msg(), + try ssh_message:decode(Msg) + of + _ -> true + catch + C:E -> io:format('~p:~p~n',[C,E]), + false + end + ). + + +%%% This fails because ssh_message is not symmetric in encode and decode regarding data types +prop_ssh_decode_encode() -> + ?FORALL(Msg, ssh_msg(), + Msg == ssh_message:encode(ssh_message:decode(Msg)) + ). + + +%%%================================================================ +%%% +%%% Scripts to generate message generators +%%% + +%% awk '/^( |\t)+byte( |\t)+SSH/,/^( |\t)*$/{print}' rfc425?.txt | sed 's/^\( \|\\t\)*//' > msgs.txt + +%% awk '/^byte( |\t)+SSH/{print $2","}' < msgs.txt + +%% awk 'BEGIN{print "%%%---- BEGIN GENERATED";prev=0} END{print " >>.\n%%%---- END GENERATED"} /^byte( |\t)+SSH/{if (prev==1) print " >>.\n"; prev=1; printf "%c%s%c",39,$2,39; print "()->\n <<?"$2;next} /^string( |\t)+\"/{print " ,"$2;next} /^string( |\t)+.*address/{print " ,(ssh_string_address())/binary %%",$2,$3,$4,$5,$6;next}/^string( |\t)+.*US-ASCII/{print " ,(ssh_string_US_ASCII())/binary %%",$2,$3,$4,$5,$6;next} /^string( |\t)+.*UTF-8/{print " ,(ssh_string_UTF_8())/binary %% ",$2,$3,$4,$5,$6;next} /^[a-z0-9]+( |\t)/{print " ,(ssh_"$1"())/binary %%",$2,$3,$4,$5,$6;next} /^byte\[16\]( |\t)+/{print" ,(ssh_byte_16())/binary %%",$2,$3,$4,$5,$6;next} /^name-list( |\t)+/{print" ,(ssh_name_list())/binary %%",$2,$3,$4,$5,$6;next} /./{print "?? %%",$0}' < msgs.txt > gen.txt + +%%%================================================================ +%%% +%%% Generators +%%% + +ssh_msg() -> ?LET(M,oneof( +[[msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()], +%%Assym [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )], +%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], +%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], +%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_IGNORE'),gen_string( )], + %% [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()], + %% [msg_code('SSH_MSG_KEXDH_REPLY'),gen_string( ),gen_mpint(),gen_string( )], + %% [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()], + [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()], + [msg_code('SSH_MSG_NEWKEYS')], + [msg_code('SSH_MSG_REQUEST_FAILURE')], + [msg_code('SSH_MSG_REQUEST_SUCCESS')], + [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )], + [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )], + [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()], + [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()], + [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_SUCCESS')] +] + +), list_to_binary(M)). + + +%%%================================================================ +%%% +%%% Generator +%%% + +do() -> + io_lib:format('[~s~n]', + [write_gen( + files(["rfc4254.txt", + "rfc4253.txt", + "rfc4419.txt", + "rfc4252.txt", + "rfc4256.txt"]))]). + + +write_gen(L) when is_list(L) -> + string:join(lists:map(fun write_gen/1, L), ",\n "); +write_gen({MsgName,Args}) -> + lists:flatten(["[",generate_args([MsgName|Args]),"]"]). + +generate_args(As) -> string:join([generate_arg(A) || A <- As], ","). + +generate_arg({<<"string">>, <<"\"",B/binary>>}) -> + S = get_string($",B), + ["gen_string(\"",S,"\")"]; +generate_arg({<<"string">>, _}) -> "gen_string( )"; +generate_arg({<<"byte[",B/binary>>, _}) -> + io_lib:format("gen_byte(~p)",[list_to_integer(get_string($],B))]); +generate_arg({<<"byte">> ,_}) -> "gen_byte()"; +generate_arg({<<"uint16">>,_}) -> "gen_uint16()"; +generate_arg({<<"uint32">>,_}) -> "gen_uint32()"; +generate_arg({<<"uint64">>,_}) -> "gen_uint64()"; +generate_arg({<<"mpint">>,_}) -> "gen_mpint()"; +generate_arg({<<"name-list">>,_}) -> "gen_name_list()"; +generate_arg({<<"boolean">>,<<"FALSE">>}) -> "0"; +generate_arg({<<"boolean">>,<<"TRUE">>}) -> "1"; +generate_arg({<<"boolean">>,_}) -> "gen_boolean()"; +generate_arg({<<"....">>,_}) -> ""; %% FIXME +generate_arg(Name) when is_binary(Name) -> + lists:flatten(["msg_code('",binary_to_list(Name),"')"]). + + +gen_boolean() -> choose(0,1). + +gen_byte() -> choose(0,255). + +gen_uint16() -> gen_byte(2). + +gen_uint32() -> gen_byte(4). + +gen_uint64() -> gen_byte(8). + +gen_byte(N) when N>0 -> [gen_byte() || _ <- lists:seq(1,N)]. + +gen_char() -> choose($a,$z). + +gen_mpint() -> ?LET(Size, choose(1,20), + ?LET(Str, vector(Size, gen_byte()), + gen_string( strip_0s(Str) ) + )). + +strip_0s([0|T]) -> strip_0s(T); +strip_0s(X) -> X. + + +gen_string() -> + ?LET(Size, choose(0,10), + ?LET(Vector,vector(Size, gen_char()), + gen_string(Vector) + )). + +gen_string(S) when is_binary(S) -> gen_string(binary_to_list(S)); +gen_string(S) when is_list(S) -> uint32_to_list(length(S)) ++ S. + +gen_name_list() -> + ?LET(NumNames, choose(0,10), + ?LET(L, [gen_name() || _ <- lists:seq(1,NumNames)], + gen_string( string:join(L,"," ) ) + )). + +gen_name() -> gen_string(). + +uint32_to_list(I) -> binary_to_list(<<I:32/unsigned-big-integer>>). + +%%%---- +get_string(Delim, B) -> + binary_to_list( element(1, split_binary(B, count_string_chars(Delim,B,0))) ). + +count_string_chars(Delim, <<Delim,_/binary>>, Acc) -> Acc; +count_string_chars(Delim, <<_,B/binary>>, Acc) -> count_string_chars(Delim, B, Acc+1). + + +-define(MSG_CODE(Name,Num), +msg_code(Name) -> Num; +msg_code(Num) -> Name +). + +?MSG_CODE('SSH_MSG_USERAUTH_REQUEST', 50); +?MSG_CODE('SSH_MSG_USERAUTH_FAILURE', 51); +?MSG_CODE('SSH_MSG_USERAUTH_SUCCESS', 52); +?MSG_CODE('SSH_MSG_USERAUTH_BANNER', 53); +?MSG_CODE('SSH_MSG_USERAUTH_PK_OK', 60); +?MSG_CODE('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ', 60); +?MSG_CODE('SSH_MSG_DISCONNECT', 1); +?MSG_CODE('SSH_MSG_IGNORE', 2); +?MSG_CODE('SSH_MSG_UNIMPLEMENTED', 3); +?MSG_CODE('SSH_MSG_DEBUG', 4); +?MSG_CODE('SSH_MSG_SERVICE_REQUEST', 5); +?MSG_CODE('SSH_MSG_SERVICE_ACCEPT', 6); +?MSG_CODE('SSH_MSG_KEXINIT', 20); +?MSG_CODE('SSH_MSG_NEWKEYS', 21); +?MSG_CODE('SSH_MSG_GLOBAL_REQUEST', 80); +?MSG_CODE('SSH_MSG_REQUEST_SUCCESS', 81); +?MSG_CODE('SSH_MSG_REQUEST_FAILURE', 82); +?MSG_CODE('SSH_MSG_CHANNEL_OPEN', 90); +?MSG_CODE('SSH_MSG_CHANNEL_OPEN_CONFIRMATION', 91); +?MSG_CODE('SSH_MSG_CHANNEL_OPEN_FAILURE', 92); +?MSG_CODE('SSH_MSG_CHANNEL_WINDOW_ADJUST', 93); +?MSG_CODE('SSH_MSG_CHANNEL_DATA', 94); +?MSG_CODE('SSH_MSG_CHANNEL_EXTENDED_DATA', 95); +?MSG_CODE('SSH_MSG_CHANNEL_EOF', 96); +?MSG_CODE('SSH_MSG_CHANNEL_CLOSE', 97); +?MSG_CODE('SSH_MSG_CHANNEL_REQUEST', 98); +?MSG_CODE('SSH_MSG_CHANNEL_SUCCESS', 99); +?MSG_CODE('SSH_MSG_CHANNEL_FAILURE', 100); +?MSG_CODE('SSH_MSG_USERAUTH_INFO_REQUEST', 60); +?MSG_CODE('SSH_MSG_USERAUTH_INFO_RESPONSE', 61); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST_OLD', 30); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST', 34); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_GROUP', 31); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_INIT', 32); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33). + +%%%============================================================================= +%%%============================================================================= +%%%============================================================================= + +files(Fs) -> + Defs = lists:usort(lists:flatten(lists:map(fun file/1, Fs))), + DefinedIDs = lists:usort([binary_to_list(element(1,D)) || D <- Defs]), + WantedIDs = lists:usort(wanted_messages()), + Missing = WantedIDs -- DefinedIDs, + case Missing of + [] -> ok; + _ -> io:format('%% Warning: missing ~p~n', [Missing]) + end, + Defs. + + +file(F) -> + {ok,B} = file:read_file(F), + hunt_msg_def(B). + + +hunt_msg_def(<<"\n",B/binary>>) -> some_hope(skip_blanks(B)); +hunt_msg_def(<<_, B/binary>>) -> hunt_msg_def(B); +hunt_msg_def(<<>>) -> []. + +some_hope(<<"byte ", B/binary>>) -> try_message(skip_blanks(B)); +some_hope(B) -> hunt_msg_def(B). + +try_message(B = <<"SSH_MSG_",_/binary>>) -> + {ID,Rest} = get_id(B), + case lists:member(binary_to_list(ID), wanted_messages()) of + true -> + {Lines,More} = get_def_lines(skip_blanks(Rest), []), + [{ID,lists:reverse(Lines)} | hunt_msg_def(More)]; + false -> + hunt_msg_def(Rest) + end; +try_message(B) -> hunt_msg_def(B). + + +skip_blanks(<<32, B/binary>>) -> skip_blanks(B); +skip_blanks(<< 9, B/binary>>) -> skip_blanks(B); +skip_blanks(B) -> B. + +get_def_lines(B0 = <<"\n",B/binary>>, Acc) -> + {ID,Rest} = get_id(skip_blanks(B)), + case {size(ID), skip_blanks(Rest)} of + {0,<<"....",More/binary>>} -> + {Text,LineEnd} = get_to_eol(skip_blanks(More)), + get_def_lines(LineEnd, [{<<"....">>,Text}|Acc]); + {0,_} -> + {Acc,B0}; + {_,Rest1} -> + {Text,LineEnd} = get_to_eol(Rest1), + get_def_lines(LineEnd, [{ID,Text}|Acc]) + end; +get_def_lines(B, Acc) -> + {Acc,B}. + + +get_to_eol(B) -> split_binary(B, count_to_eol(B,0)). + +count_to_eol(<<"\n",_/binary>>, Acc) -> Acc; +count_to_eol(<<>>, Acc) -> Acc; +count_to_eol(<<_,B/binary>>, Acc) -> count_to_eol(B,Acc+1). + + +get_id(B) -> split_binary(B, count_id_chars(B,0)). + +count_id_chars(<<C,B/binary>>, Acc) when $A=<C,C=<$Z -> count_id_chars(B,Acc+1); +count_id_chars(<<C,B/binary>>, Acc) when $a=<C,C=<$z -> count_id_chars(B,Acc+1); +count_id_chars(<<C,B/binary>>, Acc) when $0=<C,C=<$9 -> count_id_chars(B,Acc+1); +count_id_chars(<<"_",B/binary>>, Acc) -> count_id_chars(B,Acc+1); +count_id_chars(<<"-",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g name-list +count_id_chars(<<"[",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] +count_id_chars(<<"]",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] +count_id_chars(_, Acc) -> Acc. + +wanted_messages() -> + ["SSH_MSG_CHANNEL_CLOSE", + "SSH_MSG_CHANNEL_DATA", + "SSH_MSG_CHANNEL_EOF", + "SSH_MSG_CHANNEL_EXTENDED_DATA", + "SSH_MSG_CHANNEL_FAILURE", + "SSH_MSG_CHANNEL_OPEN", + "SSH_MSG_CHANNEL_OPEN_CONFIRMATION", + "SSH_MSG_CHANNEL_OPEN_FAILURE", + "SSH_MSG_CHANNEL_REQUEST", + "SSH_MSG_CHANNEL_SUCCESS", + "SSH_MSG_CHANNEL_WINDOW_ADJUST", + "SSH_MSG_DEBUG", + "SSH_MSG_DISCONNECT", + "SSH_MSG_GLOBAL_REQUEST", + "SSH_MSG_IGNORE", + "SSH_MSG_KEXDH_INIT", + "SSH_MSG_KEXDH_REPLY", + "SSH_MSG_KEXINIT", + "SSH_MSG_KEX_DH_GEX_GROUP", + "SSH_MSG_KEX_DH_GEX_REQUEST", + "SSH_MSG_KEX_DH_GEX_REQUEST_OLD", + "SSH_MSG_NEWKEYS", + "SSH_MSG_REQUEST_FAILURE", + "SSH_MSG_REQUEST_SUCCESS", + "SSH_MSG_SERVICE_ACCEPT", + "SSH_MSG_SERVICE_REQUEST", + "SSH_MSG_UNIMPLEMENTED", + "SSH_MSG_USERAUTH_BANNER", + "SSH_MSG_USERAUTH_FAILURE", +%% hard args "SSH_MSG_USERAUTH_INFO_REQUEST", +%% "SSH_MSG_USERAUTH_INFO_RESPONSE", + "SSH_MSG_USERAUTH_PASSWD_CHANGEREQ", + "SSH_MSG_USERAUTH_PK_OK", +%%rfc4252 p12 error "SSH_MSG_USERAUTH_REQUEST", + "SSH_MSG_USERAUTH_SUCCESS"]. + diff --git a/lib/ssh/test/property_test/ssh_eqc_subsys.erl b/lib/ssh/test/property_test/ssh_eqc_subsys.erl new file mode 100644 index 0000000000..e4b6af166f --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_subsys.erl @@ -0,0 +1,63 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The 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(ssh_eqc_subsys). + +-behaviour(ssh_daemon_channel). + +-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]). + +-export([response/2]). + +-record(state, {id, + cm, + subsyst + }). + +init([SS]) -> + {ok, #state{subsyst=SS}}. + +handle_msg({ssh_channel_up, ChannelId, ConnectionManager}, State) -> + {ok, State#state{id = ChannelId, + cm = ConnectionManager}}. + +handle_ssh_msg({ssh_cm, CM, {data, ChannelId, Type, Data}}, S) -> + ssh_connection:send(CM, ChannelId, Type, response(Data,S)), + {ok, S}; + +handle_ssh_msg({ssh_cm, _ConnectionManager, {eof, _ChannelId}}, State) -> + {ok, State}; + +handle_ssh_msg({ssh_cm, _, {signal, _, _}}, State) -> + %% Ignore signals according to RFC 4254 section 6.9. + {ok, State}; + +handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, _Error, _}}, State) -> + {stop, ChannelId, State}; + +handle_ssh_msg({ssh_cm, _, {exit_status, ChannelId, _Status}}, State) -> + {stop, ChannelId, State}. + +terminate(_Reason, _State) -> + ok. + + +response(Msg, #state{subsyst=SS}) -> response(Msg, SS); +response(Msg, SS) -> <<"Resp: ",Msg/binary,(list_to_binary(SS))/binary>>. diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index bf7fb4c73e..415cb9fc9c 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -53,13 +53,21 @@ all() -> {group, hardening_tests} ]. -groups() -> +groups() -> [{dsa_key, [], basic_tests()}, {rsa_key, [], basic_tests()}, {dsa_pass_key, [], [pass_phrase]}, {rsa_pass_key, [], [pass_phrase]}, {internal_error, [], [internal_error]}, - {hardening_tests, [], [max_sessions]} + {hardening_tests, [], [ssh_connect_nonegtimeout_connected_parallel, + ssh_connect_nonegtimeout_connected_sequential, + ssh_connect_negtimeout_parallel, + ssh_connect_negtimeout_sequential, + max_sessions_ssh_connect_parallel, + max_sessions_ssh_connect_sequential, + max_sessions_sftp_start_channel_parallel, + max_sessions_sftp_start_channel_sequential + ]} ]. @@ -743,6 +751,100 @@ ms_passed(N1={_,_,M1}, N2={_,_,M2}) -> 1000 * (Min*60 + Sec + (M2-M1)/1000000). %%-------------------------------------------------------------------- +ssh_connect_negtimeout_parallel(Config) -> ssh_connect_negtimeout(Config,true). +ssh_connect_negtimeout_sequential(Config) -> ssh_connect_negtimeout(Config,false). + +ssh_connect_negtimeout(Config, Parallel) -> + process_flag(trap_exit, true), + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), + NegTimeOut = 2000, % ms + ct:log("Parallel: ~p",[Parallel]), + + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, + {parallel_login, Parallel}, + {negotiation_timeout, NegTimeOut}, + {failfun, fun ssh_test_lib:failfun/2}]), + + {ok,Socket} = gen_tcp:connect(Host, Port, []), + ct:pal("And now sleeping 1.2*NegTimeOut (~p ms)...", [round(1.2 * NegTimeOut)]), + receive after round(1.2 * NegTimeOut) -> ok end, + + case inet:sockname(Socket) of + {ok,_} -> ct:fail("Socket not closed"); + {error,_} -> ok + end. + +%%-------------------------------------------------------------------- +ssh_connect_nonegtimeout_connected_parallel() -> + [{doc, "Test that ssh connection does not timeout if the connection is established (parallel)"}]. +ssh_connect_nonegtimeout_connected_parallel(Config) -> + ssh_connect_nonegtimeout_connected(Config, true). + +ssh_connect_nonegtimeout_connected_sequential() -> + [{doc, "Test that ssh connection does not timeout if the connection is established (non-parallel)"}]. +ssh_connect_nonegtimeout_connected_sequential(Config) -> + ssh_connect_nonegtimeout_connected(Config, false). + + +ssh_connect_nonegtimeout_connected(Config, Parallel) -> + process_flag(trap_exit, true), + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), + NegTimeOut = 20000, % ms + ct:log("Parallel: ~p",[Parallel]), + + {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, + {parallel_login, Parallel}, + {negotiation_timeout, NegTimeOut}, + {failfun, fun ssh_test_lib:failfun/2}]), + ct:pal("~p Listen ~p:~p",[_Pid,_Host,Port]), + ct:sleep(500), + + IO = ssh_test_lib:start_io_server(), + Shell = ssh_test_lib:start_shell(Port, IO, UserDir), + receive + Error = {'EXIT', _, _} -> + ct:pal("~p",[Error]), + ct:fail(no_ssh_connection); + ErlShellStart -> + ct:pal("---Erlang shell start: ~p~n", [ErlShellStart]), + one_shell_op(IO, NegTimeOut), + one_shell_op(IO, NegTimeOut), + ct:pal("And now sleeping 1.2*NegTimeOut (~p ms)...", [round(1.2 * NegTimeOut)]), + receive after round(1.2 * NegTimeOut) -> ok end, + one_shell_op(IO, NegTimeOut) + end, + exit(Shell, kill). + + +one_shell_op(IO, TimeOut) -> + ct:pal("One shell op: Waiting for prompter"), + receive + ErlPrompt0 -> ct:log("Erlang prompt: ~p~n", [ErlPrompt0]) + after TimeOut -> ct:fail("Timeout waiting for promter") + end, + + IO ! {input, self(), "2*3*7.\r\n"}, + receive + Echo0 -> ct:log("Echo: ~p ~n", [Echo0]) + after TimeOut -> ct:fail("Timeout waiting for echo") + end, + + receive + ?NEWLINE -> ct:log("NEWLINE received", []) + after TimeOut -> + receive Any1 -> ct:log("Bad NEWLINE: ~p",[Any1]) + after 0 -> ct:fail("Timeout waiting for NEWLINE") + end + end, + + receive + Result0 -> ct:log("Result: ~p~n", [Result0]) + after TimeOut -> ct:fail("Timeout waiting for result") + end. + +%%-------------------------------------------------------------------- openssh_zlib_basic_test() -> [{doc, "Test basic connection with openssh_zlib"}]. @@ -763,40 +865,92 @@ openssh_zlib_basic_test(Config) -> %%-------------------------------------------------------------------- -max_sessions(Config) -> +max_sessions_ssh_connect_parallel(Config) -> + max_sessions(Config, true, connect_fun(ssh__connect,Config)). +max_sessions_ssh_connect_sequential(Config) -> + max_sessions(Config, false, connect_fun(ssh__connect,Config)). + +max_sessions_sftp_start_channel_parallel(Config) -> + max_sessions(Config, true, connect_fun(ssh_sftp__start_channel, Config)). +max_sessions_sftp_start_channel_sequential(Config) -> + max_sessions(Config, false, connect_fun(ssh_sftp__start_channel, Config)). + + +%%%---- helpers: +connect_fun(ssh__connect, Config) -> + fun(Host,Port) -> + ssh_test_lib:connect(Host, Port, + [{silently_accept_hosts, true}, + {user_dir, ?config(priv_dir,Config)}, + {user_interaction, false}, + {user, "carni"}, + {password, "meat"} + ]) + %% ssh_test_lib returns R when ssh:connect returns {ok,R} + end; +connect_fun(ssh_sftp__start_channel, _Config) -> + fun(Host,Port) -> + {ok,_Pid,ConnRef} = + ssh_sftp:start_channel(Host, Port, + [{silently_accept_hosts, true}, + {user, "carni"}, + {password, "meat"} + ]), + ConnRef + end. + + +max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) -> + Connect = fun(Host,Port) -> + R = Connect0(Host,Port), + ct:pal("Connect(~p,~p) -> ~p",[Host,Port,R]), + R + end, SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), - MaxSessions = 2, - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + MaxSessions = 5, + {Pid, Host, Port} = ssh_test_lib:daemon([ + {system_dir, SystemDir}, {user_dir, UserDir}, {user_passwords, [{"carni", "meat"}]}, - {parallel_login, true}, + {parallel_login, ParallelLogin}, {max_sessions, MaxSessions} ]), - - Connect = fun() -> - R=ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, - {user_dir, UserDir}, - {user_interaction, false}, - {user, "carni"}, - {password, "meat"} - ]), - ct:log("Connection ~p up",[R]) - end, - - try [Connect() || _ <- lists:seq(1,MaxSessions)] + ct:pal("~p Listen ~p:~p for max ~p sessions",[Pid,Host,Port,MaxSessions]), + try [Connect(Host,Port) || _ <- lists:seq(1,MaxSessions)] of - _ -> - ct:pal("Expect Info Report:",[]), - try Connect() + Connections -> + %% Step 1 ok: could set up max_sessions connections + ct:log("Connections up: ~p",[Connections]), + [_|_] = Connections, + + %% Now try one more than alowed: + ct:pal("Info Report might come here...",[]), + try Connect(Host,Port) of - _ConnectionRef -> + _ConnectionRef1 -> ssh:stop_daemon(Pid), {fail,"Too many connections accepted"} catch error:{badmatch,{error,"Connection closed"}} -> - ssh:stop_daemon(Pid), - ok + %% Step 2 ok: could not set up max_sessions+1 connections + %% This is expected + %% Now stop one connection and try to open one more + ok = ssh:close(hd(Connections)), + try Connect(Host,Port) + of + _ConnectionRef1 -> + %% Step 3 ok: could set up one more connection after killing one + %% Thats good. + ssh:stop_daemon(Pid), + ok + catch + error:{badmatch,{error,"Connection closed"}} -> + %% Bad indeed. Could not set up one more connection even after killing + %% one existing. Very bad. + ssh:stop_daemon(Pid), + {fail,"Does not decrease # active sessions"} + end end catch error:{badmatch,{error,"Connection closed"}} -> diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index f4f0682b40..3c537d719c 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The 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,13 +31,22 @@ %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- -suite() -> - [{ct_hooks,[ts_install_cth]}]. +%% suite() -> +%% [{ct_hooks,[ts_install_cth]}]. all() -> [ {group, openssh_payload}, - interrupted_send + start_subsystem_on_closed_channel, + interrupted_send, + start_shell, + start_shell_exec, + start_shell_exec_fun, + gracefull_invalid_version, + gracefull_invalid_start, + gracefull_invalid_long_start, + gracefull_invalid_long_start_no_nl, + stop_listener ]. groups() -> [{openssh_payload, [], [simple_exec, @@ -64,7 +73,7 @@ init_per_group(openssh_payload, _Config) -> {skip,"No openssh deamon"}; {ok, Socket} -> gen_tcp:close(Socket) - end; + end; init_per_group(_, Config) -> Config. @@ -177,10 +186,10 @@ big_cat(Config) when is_list(Config) -> case size(Data) =:= size(Other) of true -> ct:pal("received and sent data are same" - "size but do not match~n",[]); + "size but do not match~n",[]); false -> ct:pal("sent ~p but only received ~p~n", - [size(Data), size(Other)]) + [size(Data), size(Other)]) end, ct:fail(receive_data_mismatch); Else -> @@ -233,6 +242,32 @@ send_after_exit(Config) when is_list(Config) -> end. %%-------------------------------------------------------------------- +start_subsystem_on_closed_channel(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {subsystems, [{"echo_n", {ssh_echo_server, [4000000]}}]}]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, false}, + {user_dir, UserDir}]), + + {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), + + ok = ssh_connection:close(ConnectionRef, ChannelId), + + failure = ssh_connection:subsystem(ConnectionRef, ChannelId, "echo_n", infinity), + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- interrupted_send() -> [{doc, "Use a subsystem that echos n char and then sends eof to cause a channel exit partway through a large send."}]. @@ -247,10 +282,10 @@ interrupted_send(Config) when is_list(Config) -> {subsystems, [{"echo_n", {ssh_echo_server, [4000000]}}]}]), ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, - {user, "foo"}, - {password, "morot"}, - {user_interaction, false}, - {user_dir, UserDir}]), + {user, "foo"}, + {password, "morot"}, + {user_interaction, false}, + {user_dir, UserDir}]), {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), @@ -276,6 +311,253 @@ interrupted_send(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +start_shell() -> + [{doc, "Start a shell"}]. + +start_shell(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {shell, fun(U, H) -> start_our_shell(U, H) end} ]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + ok = ssh_connection:shell(ConnectionRef,ChannelId0), + + receive + {ssh_cm,ConnectionRef, {data, ChannelId0, 0, <<"Enter command\r\n">>}} -> + ok + after 5000 -> + ct:fail("CLI Timeout") + end, + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). +%%-------------------------------------------------------------------- +start_shell_exec() -> + [{doc, "start shell to exec command"}]. + +start_shell_exec(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {exec, {?MODULE,ssh_exec,[]}} ]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + + success = ssh_connection:exec(ConnectionRef, ChannelId0, + "testing", infinity), + receive + {ssh_cm, ConnectionRef, {data, _ChannelId, 0, <<"testing\r\n">>}} -> + ok + after 5000 -> + ct:fail("Exec Timeout") + end, + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- +start_shell_exec_fun() -> + [{doc, "start shell to exec command"}]. + +start_shell_exec_fun(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {exec, fun ssh_exec/1}]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + + success = ssh_connection:exec(ConnectionRef, ChannelId0, + "testing", infinity), + + receive + {ssh_cm, ConnectionRef, {data, _ChannelId, 0, <<"testing\r\n">>}} -> + ok + after 5000 -> + ct:fail("Exec Timeout") + end, + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- + +gracefull_invalid_version(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}]), + + {ok, S} = gen_tcp:connect(Host, Port, []), + ok = gen_tcp:send(S, ["SSH-8.-1","\r\n"]), + receive + Verstring -> + ct:pal("Server version: ~p~n", [Verstring]), + receive + {tcp_closed, S} -> + ok + end + end. + +gracefull_invalid_start(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}]), + + {ok, S} = gen_tcp:connect(Host, Port, []), + ok = gen_tcp:send(S, ["foobar","\r\n"]), + receive + Verstring -> + ct:pal("Server version: ~p~n", [Verstring]), + receive + {tcp_closed, S} -> + ok + end + end. + +gracefull_invalid_long_start(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}]), + + {ok, S} = gen_tcp:connect(Host, Port, []), + ok = gen_tcp:send(S, [lists:duplicate(257, $a), "\r\n"]), + receive + Verstring -> + ct:pal("Server version: ~p~n", [Verstring]), + receive + {tcp_closed, S} -> + ok + end + end. + + +gracefull_invalid_long_start_no_nl(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}]), + + {ok, S} = gen_tcp:connect(Host, Port, []), + ok = gen_tcp:send(S, [lists:duplicate(257, $a), "\r\n"]), + receive + Verstring -> + ct:pal("Server version: ~p~n", [Verstring]), + receive + {tcp_closed, S} -> + ok + end + end. + +stop_listener() -> + [{doc, "start ssh daemon, setup connections, stop listener, restart listner"}]. + +stop_listener(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + + {Pid0, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {exec, fun ssh_exec/1}]), + + ConnectionRef0 = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef0, infinity), + + ssh:stop_listener(Host, Port), + + {error, _} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + success = ssh_connection:exec(ConnectionRef0, ChannelId0, + "testing", infinity), + receive + {ssh_cm, ConnectionRef0, {data, ChannelId0, 0, <<"testing\r\n">>}} -> + ok + after 5000 -> + ct:fail("Exec Timeout") + end, + + {ok, HostAddr} = inet:getaddr(Host, inet), + case ssh_test_lib:daemon(HostAddr, Port, [{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "potatis"}, + {exec, fun ssh_exec/1}]) of + {Pid1, HostAddr, Port} -> + ConnectionRef1 = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "potatis"}, + {user_interaction, true}, + {user_dir, UserDir}]), + {error, _} = ssh:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + ssh:close(ConnectionRef0), + ssh:close(ConnectionRef1), + ssh:stop_daemon(Pid0), + ssh:stop_daemon(Pid1); + Error -> + ct:fail({unexpected, Error}) + end. + +%%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- big_cat_rx(ConnectionRef, ChannelId) -> @@ -308,3 +590,16 @@ collect_data(ConnectionRef, ChannelId, Acc) -> after 5000 -> timeout end. + +%%%------------------------------------------------------------------- +%% This is taken from the ssh example code. +start_our_shell(_User, _Peer) -> + spawn(fun() -> + io:format("Enter command\n") + %% Don't actually loop, just exit + end). + +ssh_exec(Cmd) -> + spawn(fun() -> + io:format(Cmd ++ "\n") + end). diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl new file mode 100644 index 0000000000..ffad8ebbb7 --- /dev/null +++ b/lib/ssh/test/ssh_property_test_SUITE.erl @@ -0,0 +1,107 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The 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% +%% +%% + +%%% Run like this: +%%% ct:run_test([{suite,"ssh_property_test_SUITE"}, {logdir,"/ldisk/OTP/LOG"}]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(ssh_property_test_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +all() -> [{group, messages}, + {group, client_server} + ]. + +groups() -> + [{messages, [], [decode, + decode_encode]}, + {client_server, [], [client_server_sequential, + client_server_parallel, + client_server_parallel_multi]} + ]. + + +%%% First prepare Config and compile the property tests for the found tool: +init_per_suite(Config) -> + ct_property_test:init_per_suite(Config). + +%%% One group in this suite happens to support only QuickCheck, so skip it +%%% if we run proper. +init_per_group(client_server, Config) -> + case ?config(property_test_tool,Config) of + eqc -> Config; + X -> {skip, lists:concat([X," is not supported"])} + end; +init_per_group(_, Config) -> + Config. + +end_per_group(_, Config) -> + Config. + +%%% Always skip the testcase that is not quite in phase with the +%%% ssh_message.erl code +init_per_testcase(decode_encode, _) -> {skip, "Fails - testcase is not ok"}; +init_per_testcase(_TestCase, Config) -> Config. + +end_per_testcase(_TestCase, Config) -> Config. + +%%%================================================================ +%%% Test suites +%%% +decode(Config) -> + ct_property_test:quickcheck( + ssh_eqc_encode_decode:prop_ssh_decode(), + Config + ). + +decode_encode(Config) -> + ct_property_test:quickcheck( + ssh_eqc_encode_decode:prop_ssh_decode_encode(), + Config + ). + +client_server_sequential(Config) -> + ct_property_test:quickcheck( + ssh_eqc_client_server:prop_seq(Config), + Config + ). + +client_server_parallel(Config) -> + ct_property_test:quickcheck( + ssh_eqc_client_server:prop_parallel(Config), + Config + ). + +client_server_parallel_multi(Config) -> + ct_property_test:quickcheck( + ssh_eqc_client_server:prop_parallel_multi(Config), + Config + ). diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index 56b1363b7a..4c46a1b1a8 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. All Rights Reserved. %% %% The 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 @@ groups() -> [{erlang_server, [], [open_close_file, open_close_dir, read_file, read_dir, write_file, rename_file, mk_rm_dir, remove_file, links, retrieve_attributes, set_attributes, async_read, - async_write, position, pos_read, pos_write]}, + async_write, position, pos_read, pos_write, version_option]}, {openssh_server, [], [open_close_file, open_close_dir, read_file, read_dir, write_file, rename_file, mk_rm_dir, remove_file, links, retrieve_attributes, set_attributes, async_read, @@ -111,6 +111,21 @@ init_per_testcase(sftp_nonexistent_subsystem, Config) -> ]), [{sftpd, Sftpd} | Config]; +init_per_testcase(version_option, Config) -> + prep(Config), + TmpConfig0 = lists:keydelete(watchdog, 1, Config), + TmpConfig = lists:keydelete(sftp, 1, TmpConfig0), + Dog = ct:timetrap(?default_timeout), + {_,Host, Port} = ?config(sftpd, Config), + {ok, ChannelPid, Connection} = + ssh_sftp:start_channel(Host, Port, + [{sftp_vsn, 3}, + {user, ?USER}, + {password, ?PASSWD}, + {user_interaction, false}, + {silently_accept_hosts, true}]), + Sftp = {ChannelPid, Connection}, + [{sftp, Sftp}, {watchdog, Dog} | TmpConfig]; init_per_testcase(Case, Config) -> prep(Config), TmpConfig0 = lists:keydelete(watchdog, 1, Config), @@ -447,6 +462,11 @@ sftp_nonexistent_subsystem(Config) when is_list(Config) -> {silently_accept_hosts, true}]). %%-------------------------------------------------------------------- +version_option() -> + [{doc, "Test API option sftp_vsn"}]. +version_option(Config) when is_list(Config) -> + open_close_dir(Config). +%%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- prep(Config) -> diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 00c25bf394..b8abf5e80e 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -113,6 +113,9 @@ io_request({put_chars, Chars}, TestCase, _, _, Buff) -> io_request({put_chars, unicode, Chars}, TestCase, _, _, Buff) when is_binary(Chars) -> reply(TestCase, Chars), {ok, ok, Buff}; +io_request({put_chars, unicode, io_lib, format, [Fmt,Args]}, TestCase, _, _, Buff) -> + reply(TestCase, io_lib:format(Fmt,Args)), + {ok, ok, Buff}; io_request({put_chars, Enc, Chars}, TestCase, _, _, Buff) -> reply(TestCase, unicode:characters_to_binary(Chars,Enc,latin1)), {ok, ok, Buff}; diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 8b5343cecc..41fbd324c4 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -54,7 +54,9 @@ groups() -> ]}, {erlang_server, [], [erlang_server_openssh_client_exec, erlang_server_openssh_client_exec_compressed, - erlang_server_openssh_client_pulic_key_dsa]} + erlang_server_openssh_client_pulic_key_dsa, + erlang_server_openssh_client_cipher_suites, + erlang_server_openssh_client_macs]} ]. init_per_suite(Config) -> @@ -89,6 +91,12 @@ end_per_group(erlang_server, Config) -> end_per_group(_, Config) -> Config. +init_per_testcase(erlang_server_openssh_client_cipher_suites, Config) -> + check_ssh_client_support(Config); + +init_per_testcase(erlang_server_openssh_client_macs, Config) -> + check_ssh_client_support(Config); + init_per_testcase(_TestCase, Config) -> ssh:start(), Config. @@ -111,15 +119,7 @@ erlang_shell_client_openssh_server(Config) when is_list(Config) -> IO ! {input, self(), "echo Hej\n"}, receive_hej(), IO ! {input, self(), "exit\n"}, - receive - <<"logout">> -> - receive - <<"Connection closed">> -> - ok - end; - Other0 -> - ct:fail({unexpected_msg, Other0}) - end, + receive_logout(), receive {'EXIT', Shell, normal} -> ok; @@ -221,6 +221,108 @@ erlang_server_openssh_client_exec(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +erlang_server_openssh_client_cipher_suites() -> + [{doc, "Test that we can connect with different cipher suites."}]. + +erlang_server_openssh_client_cipher_suites(Config) when is_list(Config) -> + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}]), + + + ct:sleep(500), + + Supports = crypto:supports(), + Ciphers = proplists:get_value(ciphers, Supports), + Tests = [ + {"3des-cbc", lists:member(des3_cbc, Ciphers)}, + {"aes128-cbc", lists:member(aes_cbc128, Ciphers)}, + {"aes128-ctr", lists:member(aes_ctr, Ciphers)}, + {"aes256-cbc", false} + ], + lists:foreach(fun({Cipher, Expect}) -> + Cmd = "ssh -p " ++ integer_to_list(Port) ++ + " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " " ++ + " -c " ++ Cipher ++ " 1+1.", + + ct:pal("Cmd: ~p~n", [Cmd]), + + SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), + + case Expect of + true -> + receive + {SshPort,{data, <<"2\n">>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive answer") + end; + false -> + receive + {SshPort,{data, <<"no matching cipher found", _/binary>>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive no matching cipher message") + end + end + end, Tests), + + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- +erlang_server_openssh_client_macs() -> + [{doc, "Test that we can connect with different MACs."}]. + +erlang_server_openssh_client_macs(Config) when is_list(Config) -> + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}]), + + + ct:sleep(500), + + Supports = crypto:supports(), + Hashs = proplists:get_value(hashs, Supports), + MACs = [{"hmac-sha1", lists:member(sha, Hashs)}, + {"hmac-sha2-256", lists:member(sha256, Hashs)}, + {"hmac-md5-96", false}, + {"hmac-ripemd160", false}], + lists:foreach(fun({MAC, Expect}) -> + Cmd = "ssh -p " ++ integer_to_list(Port) ++ + " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " " ++ + " -o MACs=" ++ MAC ++ " 1+1.", + + ct:pal("Cmd: ~p~n", [Cmd]), + + SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), + + case Expect of + true -> + receive + {SshPort,{data, <<"2\n">>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive answer") + end; + false -> + receive + {SshPort,{data, <<"no matching mac found", _/binary>>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive no matching mac message") + end + end + end, MACs), + + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- erlang_server_openssh_client_exec_compressed() -> [{doc, "Test that exec command works."}]. @@ -433,3 +535,43 @@ receive_hej() -> ct:pal("Extra info: ~p~n", [Info]), receive_hej() end. + +receive_logout() -> + receive + <<"logout">> -> + receive + <<"Connection closed">> -> + ok + end; + <<"TERM environment variable not set.\n">> -> %% Windows work around + receive_logout(); + Other0 -> + ct:fail({unexpected_msg, Other0}) + end. + + + +%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- +%% Check if we have a "newer" ssh client that supports these test cases +%%-------------------------------------------------------------------- +check_ssh_client_support(Config) -> + Port = open_port({spawn, "ssh -Q cipher"}, [exit_status, stderr_to_stdout]), + case check_ssh_client_support2(Port) of + 0 -> % exit status from command (0 == ok) + ssh:start(), + Config; + _ -> + {skip, "test case not supported by ssh client"} + end. + +check_ssh_client_support2(P) -> + receive + {P, {data, _A}} -> + check_ssh_client_support2(P); + {P, {exit_status, E}} -> + E + after 5000 -> + ct:pal("Openssh command timed out ~n"), + -1 + end. diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 8d1a7ae54f..68544c1d0e 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 3.0.3 +SSH_VSN = 3.0.8 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index 1b37a2baa2..62e9bd0165 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -25,7 +25,63 @@ <file>notes.xml</file> </header> <p>This document describes the changes made to the SSL application.</p> - <section><title>SSL 5.3.5</title> + <section><title>SSL 5.3.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Handle the fact that servers may send an empty SNI + extension to the client.</p> + <p> + Own Id: OTP-12198</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 5.3.6</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Corrected handling of ECC certificates, there where + several small issues with the handling of such + certificates in the ssl and public_key application. Now + ECC signed ECC certificates shall work and not only RSA + signed ECC certificates.</p> + <p> + Own Id: OTP-12026</p> + </item> + <item> + <p> + Check that the certificate chain ends with a trusted ROOT + CA e.i. a self-signed certificate, but provide an option + partial_chain to enable the application to define an + intermediat CA as trusted.</p> + <p> + Own Id: OTP-12149</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add decode functions for SNI (Server Name Indication)</p> + <p> + Own Id: OTP-12048</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 5.3.5</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index ffee4bd1af..83e5ed82bb 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -136,7 +136,7 @@ </c></p> <p><c>cipher() = rc4_128 | des_cbc | '3des_ede_cbc' - | aes_128_cbc | aes_256_cbc </c></p> + | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm </c></p> <p> <c>hash() = md5 | sha </c></p> @@ -226,7 +226,7 @@ <p>The verification fun should be defined as:</p> <code> -fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | +fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revoked, atom()}} | {extension, #'Extension'{}}, InitialUserState :: term()) -> {valid, UserState :: term()} | {valid_peer, UserState :: term()} | {fail, Reason :: term()} | {unknown, UserState :: term()}. @@ -252,7 +252,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | always returns {valid, UserState}, the TLS/SSL handshake will not be terminated with respect to verification failures and the connection will be established. If called with an - extension unknown to the user application the return value + extension unknown to the user application, the return value {unknown, UserState} should be used.</p> <p>The default verify_fun option in verify_peer mode:</p> @@ -283,9 +283,29 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | end, []} </code> -<p>Possible path validation errors: </p> + <p>Possible path validation errors are given on the form {bad_cert, Reason} where Reason is:</p> -<p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca},{bad_cert, selfsigned_peer}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p> + <taglist> + <tag>unknown_ca</tag> + <item>No trusted CA was found in the trusted store. The trusted CA is + normally a so called ROOT CA that is a self-signed cert. Trust may + be claimed for an intermediat CA (trusted anchor does not have to be self signed + according to X-509) by using the option <c>partial_chain</c></item> + + <tag>selfsigned_peer</tag> + <item>The chain consisted only of one self-signed certificate.</item> + + <tag>PKIX X-509-path validation error</tag> + <item> Possible such reasons see <seealso + marker="public_key:public_key#pkix_path_validation-3"> public_key:pkix_path_validation/3 </seealso></item> + </taglist> + + </item> + + <tag>{partial_chain, fun(Chain::[DerCert]) -> {trusted_ca, DerCert} | unknown_ca </tag> + <item> + Claim an intermediat CA in the chain as trusted. TLS will then perform the public_key:pkix_path_validation/3 + with the selected CA as trusted anchor and the rest of the chain. </item> <tag>{versions, [protocol()]}</tag> diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index 43cb3934f7..c8024548b5 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -75,10 +75,10 @@ </p> </item> - <tag><c><![CDATA[session_cb_init_args = list() <optional>]]></c></tag> + <tag><c><![CDATA[session_cb_init_args = proplist:proplist() <optional>]]></c></tag> <item> <p> - List of arguments to the init function in session cache + List of additional user defined arguments to the init function in session cache callback module, defaults to []. </p> </item> diff --git a/lib/ssl/doc/src/ssl_protocol.xml b/lib/ssl/doc/src/ssl_protocol.xml index cdfafe224b..80d9cc4ee8 100644 --- a/lib/ssl/doc/src/ssl_protocol.xml +++ b/lib/ssl/doc/src/ssl_protocol.xml @@ -83,7 +83,7 @@ <em>subject</em>. The certificate is signed with the private key of the issuer of the certificate. A chain of trust is build by having the issuer in its turn being - certified by an other certificate and so on until you reach the + certified by another certificate and so on until you reach the so called root certificate that is self signed i.e. issued by itself.</p> diff --git a/lib/ssl/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml index 82de1784ca..cb97bbfbb2 100644 --- a/lib/ssl/doc/src/ssl_session_cache_api.xml +++ b/lib/ssl/doc/src/ssl_session_cache_api.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -79,17 +79,25 @@ </func> <func> - <name>init() -> opaque() </name> + <name>init(Args) -> opaque() </name> <fsummary>Return cache reference</fsummary> <type> - <v></v> + <v>Args = proplists:proplist()</v> + <d>Will always include the property {role, client | server}. Currently this + is the only predefined property, there may also be user defined properties. + <seealso marker="ssl_app"> See also application environment variable + session_cb_init_args</seealso> + </d> </type> <desc> <p>Performs possible initializations of the cache and returns a reference to it that will be used as parameter to the other - api functions. Will be called by the cache handling processes - init function, hence putting the same requirements on it as - a normal process init function. + API functions. Will be called by the cache handling processes + init function, hence putting the same requirements on it as a + normal process init function. Note that this function will be + called twice when starting the ssl application, once with the + role client and once with the role server, as the ssl application + must be prepared to take on both roles. </p> </desc> </func> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 7c4c8ec2cc..0c00a650b9 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -118,7 +118,7 @@ $(TARGET_FILES): $(BEHAVIOUR_TARGET_FILES) debug opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) clean: - rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) + rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) $(BEHAVIOUR_TARGET_FILES) rm -f errs core *~ $(APP_TARGET): $(APP_SRC) ../vsn.mk diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index a7bbb6bc40..c0776e822b 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -120,6 +120,26 @@ get_dtls_records_aux(Data, Acc) -> end. encode_plain_text(Type, Version, Data, + #connection_states{current_write = + #connection_state{ + epoch = Epoch, + sequence_number = Seq, + compression_state=CompS0, + security_parameters= + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm=CompAlg} + }= WriteState0} = ConnectionStates) -> + {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), + WriteState1 = WriteState0#connection_state{compression_state = CompS1}, + AAD = calc_aad(Type, Version, Epoch, Seq), + {CipherFragment, WriteState} = ssl_record:cipher_aead(dtls_v1:corresponding_tls_version(Version), + Comp, WriteState1, AAD), + CipherText = encode_tls_cipher_text(Type, Version, Epoch, Seq, CipherFragment), + {CipherText, ConnectionStates#connection_states{current_write = + WriteState#connection_state{sequence_number = Seq +1}}}; + +encode_plain_text(Type, Version, Data, #connection_states{current_write=#connection_state{ epoch = Epoch, sequence_number = Seq, @@ -141,16 +161,44 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, sequence_number = Seq, fragment = CipherFragment} = CipherText, #connection_states{current_read = - #connection_state{compression_state = CompressionS0, - security_parameters = SecParams} = ReadState0} - = ConnnectionStates0) -> - CompressAlg = SecParams#security_parameters.compression_algorithm, + #connection_state{ + compression_state = CompressionS0, + security_parameters= + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm=CompAlg} + } = ReadState0}= ConnnectionStates0) -> + AAD = calc_aad(Type, Version, Epoch, Seq), + case ssl_record:decipher_aead(dtls_v1:corresponding_tls_version(Version), + CipherFragment, ReadState0, AAD) of + {PlainFragment, ReadState1} -> + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, + PlainFragment, CompressionS0), + ConnnectionStates = ConnnectionStates0#connection_states{ + current_read = ReadState1#connection_state{ + compression_state = CompressionS1}}, + {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + #alert{} = Alert -> + Alert + end; + +decode_cipher_text(#ssl_tls{type = Type, version = Version, + epoch = Epoch, + sequence_number = Seq, + fragment = CipherFragment} = CipherText, + #connection_states{current_read = + #connection_state{ + compression_state = CompressionS0, + security_parameters= + #security_parameters{ + compression_algorithm=CompAlg} + } = ReadState0}= ConnnectionStates0) -> {PlainFragment, Mac, ReadState1} = ssl_record:decipher(dtls_v1:corresponding_tls_version(Version), CipherFragment, ReadState0), MacHash = calc_mac_hash(ReadState1, Type, Version, Epoch, Seq, PlainFragment), case ssl_record:is_correct_mac(Mac, MacHash) of true -> - {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg, + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, PlainFragment, CompressionS0), ConnnectionStates = ConnnectionStates0#connection_states{ current_read = ReadState1#connection_state{ @@ -368,3 +416,7 @@ calc_mac_hash(#connection_state{mac_secret = MacSecret, mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> dtls_v1:mac_hash(Version, MacAlg, MacSecret, SeqNo, Type, Length, Fragment). + +calc_aad(Type, {MajVer, MinVer}, Epoch, SeqNo) -> + NewSeq = (Epoch bsl 48) + SeqNo, + <<NewSeq:64/integer, ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index b713f86c1e..9d692379b4 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,12 +1,24 @@ %% -*- erlang -*- {"%VSN%", [ + {"5.3.6", [{load_module, ssl_handshake, soft_purge, soft_purge, [ssl_connection]}]}, + {"5.3.5", [{load_module, ssl, soft_purge, soft_purge, [ssl_connection]}, + {load_module, ssl_handshake, soft_purge, soft_purge, [ssl_certificate]}, + {load_module, ssl_certificate, soft_purge, soft_purge, []}, + {load_module, ssl_connection, soft_purge, soft_purge, [tls_connection]}, + {update, tls_connection, {advanced, {up, "5.3.5", "5.3.6"}}, [ssl_handshake]}]}, {<<"5\\.3\\.[1-4]($|\\..*)">>, [{restart_application, ssl}]}, {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, {<<"4\\..*">>, [{restart_application, ssl}]}, {<<"3\\..*">>, [{restart_application, ssl}]} ], [ + {"5.3.6", [{load_module, ssl_handshake, soft_purge, soft_purge, [ssl_connection]}]}, + {"5.3.5", [{load_module, ssl, soft_purge, soft_purge,[ssl_certificate]}, + {load_module, ssl_handshake, soft_purge, soft_purge,[ssl_certificate]}, + {load_module, ssl_certificate, soft_purge, soft_purge,[]}, + {load_module, ssl_connection, soft_purge, soft_purge,[tls_connection]}, + {update, tls_connection, {advanced, {down, "5.3.6", "5.3.5"}}, [ssl_handshake]}]}, {<<"5\\.3\\.[1-4]($|\\..*)">>, [{restart_application, ssl}]}, {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, {<<"4\\..*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index d741fa63fb..dcba69a65e 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -354,7 +354,7 @@ cipher_suites(openssl) -> cipher_suites(all) -> Version = tls_record:highest_protocol_version([]), Supported = ssl_cipher:all_suites(Version) - ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) ++ ssl_cipher:srp_suites(), ssl_cipher:filter_suites([suite_definition(S) || S <- Supported]). @@ -569,21 +569,24 @@ handle_options(Opts0, #ssl_options{protocol = Protocol, cacerts = CaCerts0, cacertfile = CaCertFile0} = InheritedSslOpts) -> RecordCB = record_cb(Protocol), CaCerts = handle_option(cacerts, Opts0, CaCerts0), - {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = handle_verify_options(Opts0, CaCerts), + {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun, PartialChainHanlder} = handle_verify_options(Opts0, CaCerts), CaCertFile = case proplists:get_value(cacertfile, Opts0, CaCertFile0) of undefined -> CaCertDefault; CAFile -> CAFile end, + NewVerifyOpts = InheritedSslOpts#ssl_options{cacerts = CaCerts, cacertfile = CaCertFile, verify = Verify, verify_fun = VerifyFun, + partial_chain = PartialChainHanlder, fail_if_no_peer_cert = FailIfNoPeerCert}, SslOpts1 = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) - end, Opts0, [cacerts, cacertfile, verify, verify_fun, fail_if_no_peer_cert]), + end, Opts0, [cacerts, cacertfile, verify, verify_fun, partial_chain, + fail_if_no_peer_cert]), case handle_option(versions, SslOpts1, []) of [] -> new_ssl_options(SslOpts1, NewVerifyOpts, RecordCB); @@ -603,10 +606,10 @@ handle_options(Opts0) -> ReuseSessionFun = fun(_, _, _, _) -> true end, CaCerts = handle_option(cacerts, Opts, undefined), - {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun} = handle_verify_options(Opts, CaCerts), + {Verify, FailIfNoPeerCert, CaCertDefault, VerifyFun, PartialChainHanlder} = + handle_verify_options(Opts, CaCerts), CertFile = handle_option(certfile, Opts, <<>>), - RecordCb = record_cb(Opts), Versions = case handle_option(versions, Opts, []) of @@ -620,6 +623,7 @@ handle_options(Opts0) -> versions = Versions, verify = validate_option(verify, Verify), verify_fun = VerifyFun, + partial_chain = PartialChainHanlder, fail_if_no_peer_cert = FailIfNoPeerCert, verify_client_once = handle_option(verify_client_once, Opts, false), depth = handle_option(depth, Opts, 1), @@ -656,7 +660,7 @@ handle_options(Opts0) -> }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), - SslOptions = [protocol, versions, verify, verify_fun, + SslOptions = [protocol, versions, verify, verify_fun, partial_chain, fail_if_no_peer_cert, verify_client_once, depth, cert, certfile, key, keyfile, password, cacerts, cacertfile, dh, dhfile, @@ -708,6 +712,8 @@ validate_option(verify_fun, Fun) when is_function(Fun) -> end, Fun}; validate_option(verify_fun, {Fun, _} = Value) when is_function(Fun) -> Value; +validate_option(partial_chain, Value) when is_function(Value) -> + Value; validate_option(fail_if_no_peer_cert, Value) when is_boolean(Value) -> Value; validate_option(verify_client_once, Value) when is_boolean(Value) -> @@ -947,7 +953,7 @@ binary_cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> All = ssl_cipher:suites(Version) - ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) ++ ssl_cipher:srp_suites(), case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of @@ -1147,25 +1153,32 @@ handle_verify_options(Opts, CaCerts) -> UserFailIfNoPeerCert = handle_option(fail_if_no_peer_cert, Opts, false), UserVerifyFun = handle_option(verify_fun, Opts, undefined), - + PartialChainHanlder = handle_option(partial_chain, Opts, + fun(_) -> unknown_ca end), + %% 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}; + ca_cert_default(verify_none, VerifyNoneFun, CaCerts), + VerifyNoneFun, PartialChainHanlder}; 1 -> {verify_peer, false, - ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), + UserVerifyFun, PartialChainHanlder}; 2 -> {verify_peer, true, - ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; - verify_none -> + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), + UserVerifyFun, PartialChainHanlder}; + verify_none -> {verify_none, false, - ca_cert_default(verify_none, VerifyNoneFun, CaCerts), VerifyNoneFun}; + ca_cert_default(verify_none, VerifyNoneFun, CaCerts), + VerifyNoneFun, PartialChainHanlder}; verify_peer -> {verify_peer, UserFailIfNoPeerCert, - ca_cert_default(verify_peer, UserVerifyFun, CaCerts), UserVerifyFun}; + ca_cert_default(verify_peer, UserVerifyFun, CaCerts), + UserVerifyFun, PartialChainHanlder}; Value -> throw({error, {options, {verify, Value}}}) end. diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index b186a1015a..9c0ed181fe 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014 All Rights Reserved. %% %% The 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,7 +30,7 @@ -include("ssl_internal.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([trusted_cert_and_path/3, +-export([trusted_cert_and_path/4, certificate_chain/3, file_to_certificats/2, validate_extension/3, @@ -46,14 +46,14 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec trusted_cert_and_path([der_cert()], db_handle(), certdb_ref()) -> +-spec trusted_cert_and_path([der_cert()], db_handle(), certdb_ref(), fun()) -> {der_cert() | unknown_ca, [der_cert()]}. %% %% Description: Extracts the root cert (if not presents tries to %% look it up, if not found {bad_cert, unknown_ca} will be added verification %% errors. Returns {RootCert, Path, VerifyErrors} %%-------------------------------------------------------------------- -trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef) -> +trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef, PartialChainHandler) -> Path = [Cert | _] = lists:reverse(CertChain), OtpCert = public_key:pkix_decode_cert(Cert, otp), SignedAndIssuerID = @@ -62,32 +62,23 @@ trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef) -> {ok, IssuerId} = public_key:pkix_issuer_id(OtpCert, self), {self, IssuerId}; false -> - case public_key:pkix_issuer_id(OtpCert, other) of - {ok, IssuerId} -> - {other, IssuerId}; - {error, issuer_not_found} -> - case find_issuer(OtpCert, CertDbHandle) of - {ok, IssuerId} -> - {other, IssuerId}; - Other -> - Other - end - end + other_issuer(OtpCert, CertDbHandle) end, case SignedAndIssuerID of {error, issuer_not_found} -> %% The root CA was not sent and can not be found. - {unknown_ca, Path}; + handle_incomplete_chain(Path, PartialChainHandler); {self, _} when length(Path) == 1 -> {selfsigned_peer, Path}; {_ ,{SerialNr, Issuer}} -> case ssl_manager:lookup_trusted_cert(CertDbHandle, CertDbRef, SerialNr, Issuer) of - {ok, {BinCert,_}} -> - {BinCert, Path}; + {ok, Trusted} -> + %% Trusted must be selfsigned or it is an incomplete chain + handle_path(Trusted, Path, PartialChainHandler); _ -> %% Root CA could not be verified - {unknown_ca, Path} + handle_incomplete_chain(Path, PartialChainHandler) end end. @@ -222,23 +213,27 @@ certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned _ -> %% The trusted cert may be obmitted from the chain as the %% counter part needs to have it anyway to be able to - %% verify it. This will be the normal case for servers - %% that does not verify the clients and hence have not - %% specified the cacertfile. + %% verify it. {ok, lists:reverse(Chain)} end. find_issuer(OtpCert, CertDbHandle) -> - IsIssuerFun = fun({_Key, {_Der, #'OTPCertificate'{} = ErlCertCandidate}}, Acc) -> - case public_key:pkix_is_issuer(OtpCert, ErlCertCandidate) of - true -> - throw(public_key:pkix_issuer_id(ErlCertCandidate, self)); - false -> - Acc - end; - (_, Acc) -> - Acc - end, + IsIssuerFun = + fun({_Key, {_Der, #'OTPCertificate'{} = ErlCertCandidate}}, Acc) -> + case public_key:pkix_is_issuer(OtpCert, ErlCertCandidate) of + true -> + case verify_cert_signer(OtpCert, ErlCertCandidate#'OTPCertificate'.tbsCertificate) of + true -> + throw(public_key:pkix_issuer_id(ErlCertCandidate, self)); + false -> + Acc + end; + false -> + Acc + end; + (_, Acc) -> + Acc + end, try ssl_pkix_db:foldl(IsIssuerFun, issuer_not_found, CertDbHandle) of issuer_not_found -> @@ -254,3 +249,57 @@ is_valid_extkey_usage(KeyUse, client) -> is_valid_extkey_usage(KeyUse, server) -> %% Server wants to verify client is_valid_key_usage(KeyUse, ?'id-kp-clientAuth'). + +verify_cert_signer(OtpCert, SignerTBSCert) -> + PublicKey = public_key(SignerTBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo), + public_key:pkix_verify(public_key:pkix_encode('OTPCertificate', OtpCert, otp), PublicKey). + +public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorithm = ?'id-ecPublicKey', + parameters = Params}, + subjectPublicKey = Point}) -> + {Point, Params}; +public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorithm = ?'rsaEncryption'}, + subjectPublicKey = Key}) -> + Key; +public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorithm = ?'id-dsa', + parameters = {params, Params}}, + subjectPublicKey = Key}) -> + {Key, Params}. + +other_issuer(OtpCert, CertDbHandle) -> + case public_key:pkix_issuer_id(OtpCert, other) of + {ok, IssuerId} -> + {other, IssuerId}; + {error, issuer_not_found} -> + case find_issuer(OtpCert, CertDbHandle) of + {ok, IssuerId} -> + {other, IssuerId}; + Other -> + Other + end + end. + +handle_path({BinCert, OTPCert}, Path, PartialChainHandler) -> + case public_key:pkix_is_self_signed(OTPCert) of + true -> + {BinCert, Path}; + false -> + handle_incomplete_chain(Path, PartialChainHandler) + end. + +handle_incomplete_chain(Chain, Fun) -> + case catch Fun(Chain) of + {trusted_ca, DerCert} -> + new_trusteded_chain(DerCert, Chain); + unknown_ca = Error -> + {Error, Chain}; + _ -> + {unknown_ca, Chain} + end. + +new_trusteded_chain(DerCert, [DerCert | Chain]) -> + {DerCert, Chain}; +new_trusteded_chain(DerCert, [_ | Rest]) -> + new_trusteded_chain(DerCert, Rest); +new_trusteded_chain(_, []) -> + unknown_ca. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 72467ea2a0..e1d89c149e 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -33,9 +33,9 @@ -include_lib("public_key/include/public_key.hrl"). -export([security_parameters/2, security_parameters/3, suite_definition/1, - decipher/5, cipher/5, + cipher_init/3, decipher/5, cipher/5, decipher_aead/6, cipher_aead/6, suite/1, suites/1, all_suites/1, - ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0, + ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]). @@ -44,7 +44,7 @@ key_algo/0]). -type cipher() :: null |rc4_128 | idea_cbc | des40_cbc | des_cbc | '3des_ede_cbc' - | aes_128_cbc | aes_256_cbc. + | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305. -type hash() :: null | sha | md5 | sha224 | sha256 | sha384 | sha512. -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 erl_cipher_suite() :: {key_algo(), cipher(), hash()}. @@ -88,20 +88,32 @@ security_parameters(Version, CipherSuite, SecParams) -> hash_size = hash_size(Hash)}. %%-------------------------------------------------------------------- +-spec cipher_init(cipher_enum(), binary(), binary()) -> #cipher_state{}. +%% +%% Description: Initializes the #cipher_state according to BCA +%%------------------------------------------------------------------- +cipher_init(?RC4, IV, Key) -> + State = crypto:stream_init(rc4, Key), + #cipher_state{iv = IV, key = Key, state = State}; +cipher_init(?AES_GCM, IV, Key) -> + <<Nonce:64>> = ssl:random_bytes(8), + #cipher_state{iv = IV, key = Key, nonce = Nonce}; +cipher_init(_BCA, IV, Key) -> + #cipher_state{iv = IV, key = Key}. + +%%-------------------------------------------------------------------- -spec cipher(cipher_enum(), #cipher_state{}, binary(), iodata(), ssl_record:ssl_version()) -> {binary(), #cipher_state{}}. %% %% Description: Encrypts the data and the MAC using chipher described %% by cipher_enum() and updating the cipher state +%% Used for "MAC then Cipher" suites where first an HMAC of the +%% data is calculated and the data plus the HMAC is ecncrypted. %%------------------------------------------------------------------- cipher(?NULL, CipherState, <<>>, Fragment, _Version) -> GenStreamCipherList = [Fragment, <<>>], {GenStreamCipherList, CipherState}; -cipher(?RC4, CipherState, Mac, Fragment, _Version) -> - State0 = case CipherState#cipher_state.state of - undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key); - S -> S - end, +cipher(?RC4, CipherState = #cipher_state{state = State0}, Mac, Fragment, _Version) -> GenStreamCipherList = [Fragment, Mac], {State1, T} = crypto:stream_encrypt(State0, GenStreamCipherList), {T, CipherState#cipher_state{state = State1}}; @@ -113,13 +125,40 @@ cipher(?'3DES', CipherState, Mac, Fragment, Version) -> block_cipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, 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) -> +cipher(?AES_CBC, CipherState, Mac, Fragment, Version) -> block_cipher(fun(Key, IV, T) when byte_size(Key) =:= 16 -> crypto:block_encrypt(aes_cbc128, Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> crypto:block_encrypt(aes_cbc256, Key, IV, T) end, block_size(aes_128_cbc), CipherState, Mac, Fragment, Version). +%%-------------------------------------------------------------------- +-spec cipher_aead(cipher_enum(), #cipher_state{}, integer(), binary(), iodata(), ssl_record:ssl_version()) -> + {binary(), #cipher_state{}}. +%% +%% Description: Encrypts the data and protects associated data (AAD) using chipher +%% described by cipher_enum() and updating the cipher state +%% Use for suites that use authenticated encryption with associated data (AEAD) +%%------------------------------------------------------------------- +cipher_aead(?AES_GCM, CipherState, SeqNo, AAD, Fragment, Version) -> + aead_cipher(aes_gcm, CipherState, SeqNo, AAD, Fragment, Version); +cipher_aead(?CHACHA20_POLY1305, CipherState, SeqNo, AAD, Fragment, Version) -> + aead_cipher(chacha20_poly1305, CipherState, SeqNo, AAD, Fragment, Version). + +aead_cipher(chacha20_poly1305, #cipher_state{key=Key} = CipherState, SeqNo, AAD0, Fragment, _Version) -> + CipherLen = erlang:iolist_size(Fragment), + AAD = <<AAD0/binary, ?UINT16(CipherLen)>>, + Nonce = <<SeqNo:64/integer>>, + {Content, CipherTag} = crypto:block_encrypt(chacha20_poly1305, Key, Nonce, {AAD, Fragment}), + {<<Content/binary, CipherTag/binary>>, CipherState}; +aead_cipher(Type, #cipher_state{key=Key, iv = IV0, nonce = Nonce} = CipherState, _SeqNo, AAD0, Fragment, _Version) -> + CipherLen = erlang:iolist_size(Fragment), + AAD = <<AAD0/binary, ?UINT16(CipherLen)>>, + <<Salt:4/bytes, _/binary>> = IV0, + IV = <<Salt/binary, Nonce:64/integer>>, + {Content, CipherTag} = crypto:block_encrypt(Type, Key, IV, {AAD, Fragment}), + {<<Nonce:64/integer, Content/binary, CipherTag/binary>>, CipherState#cipher_state{nonce = Nonce + 1}}. + build_cipher_block(BlockSz, Mac, Fragment) -> TotSz = byte_size(Mac) + erlang:iolist_size(Fragment) + 1, {PaddingLength, Padding} = get_padding(TotSz, BlockSz), @@ -148,14 +187,12 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, %% %% Description: Decrypts the data and the MAC using cipher described %% by cipher_enum() and updating the cipher state. +%% Used for "MAC then Cipher" suites where first the data is decrypted +%% and the an HMAC of the decrypted data is checked %%------------------------------------------------------------------- decipher(?NULL, _HashSz, CipherState, Fragment, _) -> {Fragment, <<>>, CipherState}; -decipher(?RC4, HashSz, CipherState, Fragment, _) -> - State0 = case CipherState#cipher_state.state of - undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key); - S -> S - end, +decipher(?RC4, HashSz, CipherState = #cipher_state{state = State0}, Fragment, _) -> try crypto:stream_decrypt(State0, Fragment) of {State, Text} -> GSC = generic_stream_cipher_from_bin(Text, HashSz), @@ -179,13 +216,26 @@ decipher(?'3DES', HashSz, CipherState, Fragment, Version) -> block_decipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> crypto:block_decrypt(des3_cbc, [K1, K2, K3], IV, T) end, CipherState, HashSz, Fragment, Version); -decipher(?AES, HashSz, CipherState, Fragment, Version) -> +decipher(?AES_CBC, HashSz, CipherState, Fragment, Version) -> block_decipher(fun(Key, IV, T) when byte_size(Key) =:= 16 -> crypto:block_decrypt(aes_cbc128, Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> crypto:block_decrypt(aes_cbc256, Key, IV, T) end, CipherState, HashSz, Fragment, Version). +%%-------------------------------------------------------------------- +-spec decipher_aead(cipher_enum(), #cipher_state{}, integer(), binary(), binary(), ssl_record:ssl_version()) -> + {binary(), binary(), #cipher_state{}} | #alert{}. +%% +%% Description: Decrypts the data and checks the associated data (AAD) MAC using +%% cipher described by cipher_enum() and updating the cipher state. +%% Use for suites that use authenticated encryption with associated data (AEAD) +%%------------------------------------------------------------------- +decipher_aead(?AES_GCM, CipherState, SeqNo, AAD, Fragment, Version) -> + aead_decipher(aes_gcm, CipherState, SeqNo, AAD, Fragment, Version); +decipher_aead(?CHACHA20_POLY1305, CipherState, SeqNo, AAD, Fragment, Version) -> + aead_decipher(chacha20_poly1305, CipherState, SeqNo, AAD, Fragment, Version). + block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, HashSz, Fragment, Version) -> try @@ -215,6 +265,35 @@ block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, %% bad_record_mac alert to hide the specific type of the error." ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end. + +aead_ciphertext_to_state(chacha20_poly1305, SeqNo, _IV, AAD0, Fragment, _Version) -> + CipherLen = size(Fragment) - 16, + <<CipherText:CipherLen/bytes, CipherTag:16/bytes>> = Fragment, + AAD = <<AAD0/binary, ?UINT16(CipherLen)>>, + Nonce = <<SeqNo:64/integer>>, + {Nonce, AAD, CipherText, CipherTag}; +aead_ciphertext_to_state(_, _SeqNo, <<Salt:4/bytes, _/binary>>, AAD0, Fragment, _Version) -> + CipherLen = size(Fragment) - 24, + <<ExplicitNonce:8/bytes, CipherText:CipherLen/bytes, CipherTag:16/bytes>> = Fragment, + AAD = <<AAD0/binary, ?UINT16(CipherLen)>>, + Nonce = <<Salt/binary, ExplicitNonce/binary>>, + {Nonce, AAD, CipherText, CipherTag}. + +aead_decipher(Type, #cipher_state{key = Key, iv = IV} = CipherState, + SeqNo, AAD0, Fragment, Version) -> + try + {Nonce, AAD, CipherText, CipherTag} = aead_ciphertext_to_state(Type, SeqNo, IV, AAD0, Fragment, Version), + case crypto:block_decrypt(Type, Key, Nonce, {AAD, CipherText, CipherTag}) of + Content when is_binary(Content) -> + {Content, CipherState}; + _ -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end + catch + _:_ -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end. + %%-------------------------------------------------------------------- -spec suites(ssl_record:ssl_version()) -> [cipher_suite()]. %% @@ -227,16 +306,26 @@ suites({3, N}) -> all_suites(Version) -> suites(Version) - ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) ++ ssl_cipher:srp_suites(). %%-------------------------------------------------------------------- --spec anonymous_suites() -> [cipher_suite()]. +-spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% %% Description: Returns a list of the anonymous cipher suites, only supported %% if explicitly set by user. Intended only for testing. %%-------------------------------------------------------------------- -anonymous_suites() -> + +anonymous_suites({3, N}) -> + anonymous_suites(N); + +anonymous_suites(N) + when N >= 3 -> + [?TLS_DH_anon_WITH_AES_128_GCM_SHA256, + ?TLS_DH_anon_WITH_AES_256_GCM_SHA384 + ] ++ anonymous_suites(0); + +anonymous_suites(_) -> [?TLS_DH_anon_WITH_RC4_128_MD5, ?TLS_DH_anon_WITH_DES_CBC_SHA, ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA, @@ -260,13 +349,20 @@ psk_suites({3, N}) -> psk_suites(N) when N >= 3 -> - psk_suites(0) ++ - [?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384, - ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, - ?TLS_PSK_WITH_AES_256_CBC_SHA384, - ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256, - ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, - ?TLS_PSK_WITH_AES_128_CBC_SHA256]; + [ + ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384, + ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, + ?TLS_PSK_WITH_AES_256_GCM_SHA384, + ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384, + ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, + ?TLS_PSK_WITH_AES_256_CBC_SHA384, + ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256, + ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, + ?TLS_PSK_WITH_AES_128_CBC_SHA256 + ] ++ psk_suites(0); psk_suites(_) -> [?TLS_DHE_PSK_WITH_AES_256_CBC_SHA, @@ -418,6 +514,19 @@ suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) -> %%% TLS 1.2 PSK Cipher Suites RFC 5487 +suite_definition(?TLS_PSK_WITH_AES_128_GCM_SHA256) -> + {psk, aes_128_gcm, null, sha256}; +suite_definition(?TLS_PSK_WITH_AES_256_GCM_SHA384) -> + {psk, aes_256_gcm, null, sha384}; +suite_definition(?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256) -> + {dhe_psk, aes_128_gcm, null, sha256}; +suite_definition(?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384) -> + {dhe_psk, aes_256_gcm, null, sha384}; +suite_definition(?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256) -> + {rsa_psk, aes_128_gcm, null, sha256}; +suite_definition(?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384) -> + {rsa_psk, aes_256_gcm, null, sha384}; + suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA256) -> {psk, aes_128_cbc, sha256, default_prf}; suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA384) -> @@ -537,7 +646,59 @@ suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_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}. + {ecdh_rsa, aes_256_cbc, sha384, sha384}; + +%% RFC 5288 AES-GCM Cipher Suites +suite_definition(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> + {rsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> + {rsa, aes_256_gcm, null, sha384}; +suite_definition(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> + {dhe_rsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> + {dhe_rsa, aes_256_gcm, null, sha384}; +suite_definition(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> + {dh_rsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> + {dh_rsa, aes_256_gcm, null, sha384}; +suite_definition(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> + {dhe_dss, aes_128_gcm, null, sha256}; +suite_definition(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> + {dhe_dss, aes_256_gcm, null, sha384}; +suite_definition(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> + {dh_dss, aes_128_gcm, null, sha256}; +suite_definition(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> + {dh_dss, aes_256_gcm, null, sha384}; +suite_definition(?TLS_DH_anon_WITH_AES_128_GCM_SHA256) -> + {dh_anon, aes_128_gcm, null, sha256}; +suite_definition(?TLS_DH_anon_WITH_AES_256_GCM_SHA384) -> + {dh_anon, aes_256_gcm, null, sha384}; + +%% RFC 5289 ECC AES-GCM Cipher Suites +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> + {ecdhe_ecdsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> + {ecdhe_ecdsa, aes_256_gcm, null, sha384}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> + {ecdh_ecdsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> + {ecdh_ecdsa, aes_256_gcm, null, sha384}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> + {ecdhe_rsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> + {ecdhe_rsa, aes_256_gcm, null, sha384}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> + {ecdh_rsa, aes_128_gcm, null, sha256}; +suite_definition(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> + {ecdh_rsa, aes_256_gcm, null, sha384}; + +%% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites +suite_definition(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> + {ecdhe_rsa, chacha20_poly1305, null, sha256}; +suite_definition(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> + {ecdhe_ecdsa, chacha20_poly1305, null, sha256}; +suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> + {dhe_rsa, chacha20_poly1305, null, sha256}. %%-------------------------------------------------------------------- -spec suite(erl_cipher_suite()) -> cipher_suite(). @@ -641,6 +802,19 @@ suite({rsa_psk, aes_256_cbc,sha}) -> %%% TLS 1.2 PSK Cipher Suites RFC 5487 +suite({psk, aes_128_gcm, null}) -> + ?TLS_PSK_WITH_AES_128_GCM_SHA256; +suite({psk, aes_256_gcm, null}) -> + ?TLS_PSK_WITH_AES_256_GCM_SHA384; +suite({dhe_psk, aes_128_gcm, null}) -> + ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256; +suite({dhe_psk, aes_256_gcm, null}) -> + ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384; +suite({rsa_psk, aes_128_gcm, null}) -> + ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256; +suite({rsa_psk, aes_256_gcm, null}) -> + ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384; + suite({psk, aes_128_cbc, sha256}) -> ?TLS_PSK_WITH_AES_128_CBC_SHA256; suite({psk, aes_256_cbc, sha384}) -> @@ -760,7 +934,60 @@ suite({ecdhe_rsa, 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. + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; + +%% RFC 5288 AES-GCM Cipher Suites +suite({rsa, aes_128_gcm, null}) -> + ?TLS_RSA_WITH_AES_128_GCM_SHA256; +suite({rsa, aes_256_gcm, null}) -> + ?TLS_RSA_WITH_AES_256_GCM_SHA384; +suite({dhe_rsa, aes_128_gcm, null}) -> + ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; +suite({dhe_rsa, aes_256_gcm, null}) -> + ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; +suite({dh_rsa, aes_128_gcm, null}) -> + ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; +suite({dh_rsa, aes_256_gcm, null}) -> + ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; +suite({dhe_dss, aes_128_gcm, null}) -> + ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; +suite({dhe_dss, aes_256_gcm, null}) -> + ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; +suite({dh_dss, aes_128_gcm, null}) -> + ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; +suite({dh_dss, aes_256_gcm, null}) -> + ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; +suite({dh_anon, aes_128_gcm, null}) -> + ?TLS_DH_anon_WITH_AES_128_GCM_SHA256; +suite({dh_anon, aes_256_gcm, null}) -> + ?TLS_DH_anon_WITH_AES_256_GCM_SHA384; + +%% RFC 5289 ECC AES-GCM Cipher Suites +suite({ecdhe_ecdsa, aes_128_gcm, null}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; +suite({ecdhe_ecdsa, aes_256_gcm, null}) -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; +suite({ecdh_ecdsa, aes_128_gcm, null}) -> + ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; +suite({ecdh_ecdsa, aes_256_gcm, null}) -> + ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; +suite({ecdhe_rsa, aes_128_gcm, null}) -> + ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; +suite({ecdhe_rsa, aes_256_gcm, null}) -> + ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; +suite({ecdh_rsa, aes_128_gcm, null}) -> + ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; +suite({ecdh_rsa, aes_256_gcm, null}) -> + ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; + + +%% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites +suite({ecdhe_rsa, chacha20_poly1305, null}) -> + ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256; +suite({ecdhe_ecdsa, chacha20_poly1305, null}) -> + ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256; +suite({dhe_rsa, chacha20_poly1305, null}) -> + ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256. %%-------------------------------------------------------------------- -spec openssl_suite(openssl_cipher_suite()) -> cipher_suite(). @@ -875,7 +1102,47 @@ openssl_suite("ECDHE-RSA-AES256-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. + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; + +%% RFC 5288 AES-GCM Cipher Suites +openssl_suite("AES128-GCM-SHA256") -> + ?TLS_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("AES256-GCM-SHA384") -> + ?TLS_RSA_WITH_AES_256_GCM_SHA384; +openssl_suite("DHE-RSA-AES128-GCM-SHA256") -> + ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("DHE-RSA-AES256-GCM-SHA384") -> + ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; +openssl_suite("DH-RSA-AES128-GCM-SHA256") -> + ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("DH-RSA-AES256-GCM-SHA384") -> + ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; +openssl_suite("DHE-DSS-AES128-GCM-SHA256") -> + ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; +openssl_suite("DHE-DSS-AES256-GCM-SHA384") -> + ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; +openssl_suite("DH-DSS-AES128-GCM-SHA256") -> + ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; +openssl_suite("DH-DSS-AES256-GCM-SHA384") -> + ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; + +%% RFC 5289 ECC AES-GCM Cipher Suites +openssl_suite("ECDHE-ECDSA-AES128-GCM-SHA256") -> + ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; +openssl_suite("ECDHE-ECDSA-AES256-GCM-SHA384") -> + ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; +openssl_suite("ECDH-ECDSA-AES128-GCM-SHA256") -> + ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; +openssl_suite("ECDH-ECDSA-AES256-GCM-SHA384") -> + ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; +openssl_suite("ECDHE-RSA-AES128-GCM-SHA256") -> + ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("ECDHE-RSA-AES256-GCM-SHA384") -> + ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; +openssl_suite("ECDH-RSA-AES128-GCM-SHA256") -> + ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; +openssl_suite("ECDH-RSA-AES256-GCM-SHA384") -> + ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384. %%-------------------------------------------------------------------- -spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite(). @@ -1012,6 +1279,46 @@ openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> "ECDH-RSA-AES256-SHA384"; +%% RFC 5288 AES-GCM Cipher Suites +openssl_suite_name(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> + "AES128-GCM-SHA256"; +openssl_suite_name(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> + "AES256-GCM-SHA384"; +openssl_suite_name(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> + "DHE-RSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> + "DHE-RSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> + "DH-RSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> + "DH-RSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> + "DHE-DSS-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> + "DHE-DSS-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> + "DH-DSS-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> + "DH-DSS-AES256-GCM-SHA384"; + +%% RFC 5289 ECC AES-GCM Cipher Suites +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> + "ECDHE-ECDSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> + "ECDHE-ECDSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> + "ECDH-ECDSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> + "ECDH-ECDSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> + "ECDHE-RSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> + "ECDHE-RSA-AES256-GCM-SHA384"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> + "ECDH-RSA-AES128-GCM-SHA256"; +openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> + "ECDH-RSA-AES256-GCM-SHA384"; + %% No oppenssl name openssl_suite_name(Cipher) -> suite_definition(Cipher). @@ -1095,6 +1402,13 @@ is_acceptable_keyexchange(KeyExchange, Algos) is_acceptable_keyexchange(_, _) -> true. +is_acceptable_cipher(Cipher, Algos) + when Cipher == aes_128_gcm; + Cipher == aes_256_gcm -> + proplists:get_bool(aes_gcm, Algos); +is_acceptable_cipher(Cipher, Algos) + when Cipher == chacha20_poly1305 -> + proplists:get_bool(Cipher, Algos); is_acceptable_cipher(_, _) -> true. @@ -1122,7 +1436,12 @@ bulk_cipher_algorithm('3des_ede_cbc') -> ?'3DES'; bulk_cipher_algorithm(Cipher) when Cipher == aes_128_cbc; Cipher == aes_256_cbc -> - ?AES. + ?AES_CBC; +bulk_cipher_algorithm(Cipher) when Cipher == aes_128_gcm; + Cipher == aes_256_gcm -> + ?AES_GCM; +bulk_cipher_algorithm(chacha20_poly1305) -> + ?CHACHA20_POLY1305. type(Cipher) when Cipher == null; Cipher == rc4_128 -> @@ -1132,7 +1451,11 @@ type(Cipher) when Cipher == des_cbc; Cipher == '3des_ede_cbc'; Cipher == aes_128_cbc; Cipher == aes_256_cbc -> - ?BLOCK. + ?BLOCK; +type(Cipher) when Cipher == aes_128_gcm; + Cipher == aes_256_gcm; + Cipher == chacha20_poly1305 -> + ?AEAD. key_material(null) -> 0; @@ -1145,6 +1468,12 @@ key_material('3des_ede_cbc') -> key_material(aes_128_cbc) -> 16; key_material(aes_256_cbc) -> + 32; +key_material(aes_128_gcm) -> + 16; +key_material(aes_256_gcm) -> + 32; +key_material(chacha20_poly1305) -> 32. expanded_key_material(null) -> @@ -1156,7 +1485,10 @@ expanded_key_material(Cipher) when Cipher == des_cbc -> expanded_key_material('3des_ede_cbc') -> 24; expanded_key_material(Cipher) when Cipher == aes_128_cbc; - Cipher == aes_256_cbc -> + Cipher == aes_256_cbc; + Cipher == aes_128_gcm; + Cipher == aes_256_gcm; + Cipher == chacha20_poly1305 -> unknown. @@ -1165,16 +1497,25 @@ effective_key_bits(null) -> effective_key_bits(des_cbc) -> 56; effective_key_bits(Cipher) when Cipher == rc4_128; - Cipher == aes_128_cbc -> + Cipher == aes_128_cbc; + Cipher == aes_128_gcm -> 128; effective_key_bits('3des_ede_cbc') -> 168; -effective_key_bits(aes_256_cbc) -> +effective_key_bits(Cipher) when Cipher == aes_256_cbc; + Cipher == aes_256_gcm; + Cipher == chacha20_poly1305 -> 256. iv_size(Cipher) when Cipher == null; - Cipher == rc4_128 -> + Cipher == rc4_128; + Cipher == chacha20_poly1305-> 0; + +iv_size(Cipher) when Cipher == aes_128_gcm; + Cipher == aes_256_gcm -> + 4; + iv_size(Cipher) -> block_size(Cipher). @@ -1183,7 +1524,10 @@ block_size(Cipher) when Cipher == des_cbc; 8; block_size(Cipher) when Cipher == aes_128_cbc; - Cipher == aes_256_cbc -> + Cipher == aes_256_cbc; + Cipher == aes_128_gcm; + Cipher == aes_256_gcm; + Cipher == chacha20_poly1305 -> 16. prf_algorithm(default_prf, {3, N}) when N >= 3 -> @@ -1337,10 +1681,15 @@ dhe_rsa_suites() -> ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, - ?TLS_DHE_RSA_WITH_DES_CBC_SHA]. + ?TLS_DHE_RSA_WITH_DES_CBC_SHA, + ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, + ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, + ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256]. psk_rsa_suites() -> - [?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, + [?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, + ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256, ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA, ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA, @@ -1360,7 +1709,9 @@ rsa_suites() -> ?TLS_RSA_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5, - ?TLS_RSA_WITH_DES_CBC_SHA]. + ?TLS_RSA_WITH_DES_CBC_SHA, + ?TLS_RSA_WITH_AES_128_GCM_SHA256, + ?TLS_RSA_WITH_AES_256_GCM_SHA384]. ecdh_rsa_suites() -> [?TLS_ECDH_RSA_WITH_NULL_SHA, @@ -1369,7 +1720,9 @@ ecdh_rsa_suites() -> ?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]. + ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384]. ecdhe_rsa_suites() -> [?TLS_ECDHE_RSA_WITH_NULL_SHA, @@ -1378,7 +1731,10 @@ ecdhe_rsa_suites() -> ?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]. + ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384, + ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256]. dsa_signed_suites() -> dhe_dss_suites() ++ srp_dss_suites(). @@ -1389,7 +1745,9 @@ dhe_dss_suites() -> ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA]. + ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, + ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256, + ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384]. srp_dss_suites() -> [?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA, @@ -1413,7 +1771,9 @@ ecdh_ecdsa_suites() -> ?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]. + ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384]. ecdhe_ecdsa_suites() -> [?TLS_ECDHE_ECDSA_WITH_NULL_SHA, @@ -1422,7 +1782,10 @@ ecdhe_ecdsa_suites() -> ?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]. + ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, + ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256]. filter_keyuse(OtpCert, Ciphers, Suites, SignSuites) -> TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index 3ce9c19aa9..448c2405aa 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -46,7 +46,8 @@ -record(cipher_state, { iv, key, - state + state, + nonce }). %%% TLS_NULL_WITH_NULL_NULL is specified and is the initial state of a @@ -395,6 +396,24 @@ %%% TLS 1.2 PSK Cipher Suites RFC 5487 +%% TLS_PSK_WITH_AES_128_GCM_SHA256 = {0x00,0xA8}; +-define(TLS_PSK_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A8)>>). + +%% TLS_PSK_WITH_AES_256_GCM_SHA384 = {0x00,0xA9}; +-define(TLS_PSK_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A9)>>). + +%% TLS_DHE_PSK_WITH_AES_128_GCM_SHA256 = {0x00,0xAA}; +-define(TLS_DHE_PSK_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#AA)>>). + +%% TLS_DHE_PSK_WITH_AES_256_GCM_SHA384 = {0x00,0xAB}; +-define(TLS_DHE_PSK_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#AB)>>). + +%% TLS_RSA_PSK_WITH_AES_128_GCM_SHA256 = {0x00,0xAC}; +-define(TLS_RSA_PSK_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#AC)>>). + +%% TLS_RSA_PSK_WITH_AES_256_GCM_SHA384 = {0x00,0xAD}; +-define(TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#AD)>>). + %% TLS_PSK_WITH_AES_128_CBC_SHA256 = {0x00,0xAE}; -define(TLS_PSK_WITH_AES_128_CBC_SHA256, <<?BYTE(16#00), ?BYTE(16#AE)>>). @@ -460,4 +479,79 @@ %% TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA = { 0xC0,0x22 }; -define(TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA, <<?BYTE(16#C0), ?BYTE(16#22)>>). +%%% AES-GCM Cipher Suites RFC 5288 + +%% TLS_RSA_WITH_AES_128_GCM_SHA256 = {0x00,0x9C} +-define(TLS_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#9C)>>). + +%% TLS_RSA_WITH_AES_256_GCM_SHA384 = {0x00,0x9D} +-define(TLS_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#9D)>>). + +%% TLS_DHE_RSA_WITH_AES_128_GCM_SHA256 = {0x00,0x9E} +-define(TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#9E)>>). + +%% TLS_DHE_RSA_WITH_AES_256_GCM_SHA384 = {0x00,0x9F} +-define(TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#9F)>>). + +%% TLS_DH_RSA_WITH_AES_128_GCM_SHA256 = {0x00,0xA0} +-define(TLS_DH_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A0)>>). + +%% TLS_DH_RSA_WITH_AES_256_GCM_SHA384 = {0x00,0xA1} +-define(TLS_DH_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A1)>>). + +%% TLS_DHE_DSS_WITH_AES_128_GCM_SHA256 = {0x00,0xA2} +-define(TLS_DHE_DSS_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A2)>>). + +%% TLS_DHE_DSS_WITH_AES_256_GCM_SHA384 = {0x00,0xA3} +-define(TLS_DHE_DSS_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A3)>>). + +%% TLS_DH_DSS_WITH_AES_128_GCM_SHA256 = {0x00,0xA4} +-define(TLS_DH_DSS_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A4)>>). + +%% TLS_DH_DSS_WITH_AES_256_GCM_SHA384 = {0x00,0xA5} +-define(TLS_DH_DSS_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A5)>>). + +%% TLS_DH_anon_WITH_AES_128_GCM_SHA256 = {0x00,0xA6} +-define(TLS_DH_anon_WITH_AES_128_GCM_SHA256, <<?BYTE(16#00), ?BYTE(16#A6)>>). + +%% TLS_DH_anon_WITH_AES_256_GCM_SHA384 = {0x00,0xA7} +-define(TLS_DH_anon_WITH_AES_256_GCM_SHA384, <<?BYTE(16#00), ?BYTE(16#A7)>>). + +%%% ECC AES-GCM Cipher Suites RFC 5289 + +%% TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 = {0xC0,0x2B}; +-define(TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#C0), ?BYTE(16#2B)>>). + +%% TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x2C}; +-define(TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#2C)>>). + +%% TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256 = {0xC0,0x2D}; +-define(TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#C0), ?BYTE(16#2D)>>). + +%% TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x2E}; +-define(TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#2E)>>). + +%% TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256 = {0xC0,0x2F}; +-define(TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#C0), ?BYTE(16#2F)>>). + +%% TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x30}; +-define(TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#30)>>). + +%% TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256 = {0xC0,0x31}; +-define(TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256, <<?BYTE(16#C0), ?BYTE(16#31)>>). + +%% TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384 = {0xC0,0x32}; +-define(TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384, <<?BYTE(16#C0), ?BYTE(16#32)>>). + +%%% Chacha20/Poly1305 Suites draft-agl-tls-chacha20poly1305-04 + +%% TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x13} +-define(TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#13)>>). + +%% TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x14} +-define(TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#14)>>). + +%% TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x15} +-define(TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#15)>>). + -endif. % -ifdef(ssl_cipher). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 4ac4e81d9e..8ff9913cee 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -414,7 +414,9 @@ certify(#certificate{} = Cert, ssl_options = Opts} = State, Connection) -> case ssl_handshake:certify(Cert, CertDbHandle, CertDbRef, Opts#ssl_options.depth, Opts#ssl_options.verify, - Opts#ssl_options.verify_fun, Role) of + Opts#ssl_options.verify_fun, + Opts#ssl_options.partial_chain, + Role) of {PeerCert, PublicKeyInfo} -> handle_peer_cert(Role, PeerCert, PublicKeyInfo, State#state{client_certificate_requested = false}, Connection); diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index b018332df1..07535e79b4 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -49,7 +49,7 @@ finished/5, next_protocol/1]). %% Handle handshake messages --export([certify/7, client_certificate_verify/6, certificate_verify/6, verify_signature/5, +-export([certify/8, client_certificate_verify/6, certificate_verify/6, verify_signature/5, master_secret/5, server_key_exchange_hash/2, verify_connection/6, init_handshake_history/0, update_handshake_history/2, verify_server_key/5 ]). @@ -201,13 +201,13 @@ client_certificate_verify(OwnCert, MasterSecret, Version, end. %%-------------------------------------------------------------------- --spec certificate_request(ssl_cipher:erl_cipher_suite(), db_handle(), certdb_ref(), ssl_record:ssl_version()) -> +-spec certificate_request(ssl_cipher:cipher_suite(), db_handle(), certdb_ref(), ssl_record:ssl_version()) -> #certificate_request{}. %% %% Description: Creates a certificate_request message, called by the server. %%-------------------------------------------------------------------- certificate_request(CipherSuite, CertDbHandle, CertDbRef, Version) -> - Types = certificate_types(CipherSuite), + Types = certificate_types(ssl_cipher:suite_definition(CipherSuite), Version), HashSigns = advertised_hash_signs(Version), Authorities = certificate_authorities(CertDbHandle, CertDbRef), #certificate_request{ @@ -383,13 +383,13 @@ verify_signature(_Version, Hash, {HashAlgo, ecdsa}, Signature, %%-------------------------------------------------------------------- -spec certify(#certificate{}, db_handle(), certdb_ref(), integer() | nolimit, - verify_peer | verify_none, {fun(), term}, + verify_peer | verify_none, {fun(), term}, fun(), client | server) -> {der_cert(), public_key_info()} | #alert{}. %% %% Description: Handles a certificate handshake message %%-------------------------------------------------------------------- certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, - MaxPathLen, _Verify, VerifyFunAndState, Role) -> + MaxPathLen, _Verify, VerifyFunAndState, PartialChain, Role) -> [PeerCert | _] = ASN1Certs, ValidationFunAndState = @@ -421,7 +421,7 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef, try {TrustedErlCert, CertPath} = - ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef), + ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef, PartialChain), case public_key:pkix_path_validation(TrustedErlCert, CertPath, [{max_path_length, @@ -1098,19 +1098,31 @@ supported_ecc(_) -> %%-------------certificate handling -------------------------------- -certificate_types({KeyExchange, _, _, _}) - when KeyExchange == rsa; - KeyExchange == dhe_dss; - KeyExchange == dhe_rsa; - KeyExchange == ecdhe_rsa -> - <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>; +certificate_types(_, {N, M}) when N >= 3 andalso M >= 3 -> + case proplists:get_bool(ecdsa, + proplists:get_value(public_keys, crypto:supports())) of + true -> + <<?BYTE(?ECDSA_SIGN), ?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>; + false -> + <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>> + end; -certificate_types({KeyExchange, _, _, _}) - when KeyExchange == dh_ecdsa; - KeyExchange == dhe_ecdsa -> +certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == rsa; + KeyExchange == dhe_rsa; + KeyExchange == ecdhe_rsa -> + <<?BYTE(?RSA_SIGN)>>; + +certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == dhe_dss; + KeyExchange == srp_dss -> + <<?BYTE(?DSS_SIGN)>>; + +certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == dh_ecdsa; + KeyExchange == dhe_ecdsa; + KeyExchange == ecdh_ecdsa; + KeyExchange == ecdhe_ecdsa -> <<?BYTE(?ECDSA_SIGN)>>; -certificate_types(_) -> +certificate_types(_, _) -> <<?BYTE(?RSA_SIGN)>>. certificate_authorities(CertDbHandle, CertDbRef) -> @@ -1423,6 +1435,7 @@ calc_finished({3, N}, Role, PrfAlgo, MasterSecret, Handshake) -> master_secret(_RecordCB, Version, MasterSecret, #security_parameters{ + bulk_cipher_algorithm = BCA, client_random = ClientRandom, server_random = ServerRandom, hash_size = HashSize, @@ -1441,8 +1454,8 @@ master_secret(_RecordCB, Version, MasterSecret, ssl_record:set_mac_secret(ClientWriteMacSecret, ServerWriteMacSecret, Role, ConnStates1), - ClientCipherState = #cipher_state{iv = ClientIV, key = ClientWriteKey}, - ServerCipherState = #cipher_state{iv = ServerIV, key = ServerWriteKey}, + ClientCipherState = ssl_cipher:cipher_init(BCA, ClientIV, ClientWriteKey), + ServerCipherState = ssl_cipher:cipher_init(BCA, ServerIV, ServerWriteKey), {MasterSecret, ssl_record:set_pending_cipher_state(ConnStates2, ClientCipherState, ServerCipherState, Role)}. @@ -1720,6 +1733,9 @@ dec_hello_extensions(<<?UINT16(?EC_POINT_FORMATS_EXT), ?UINT16(Len), #ec_point_formats{ec_point_format_list = ECPointFormats}}); +dec_hello_extensions(<<?UINT16(?SNI_EXT), ?UINT16(Len), Rest/binary>>, Acc) when Len == 0 -> + dec_hello_extensions(Rest, Acc#hello_extensions{sni = ""}); %% Server may send an empy SNI + dec_hello_extensions(<<?UINT16(?SNI_EXT), ?UINT16(Len), ExtData:Len/binary, Rest/binary>>, Acc) -> <<?UINT16(_), NameList/binary>> = ExtData, diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index fd0d87bd5f..85724de4bd 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -74,6 +74,7 @@ versions :: [ssl_record:ssl_version()], %% ssl_record:atom_version() in API verify :: verify_none | verify_peer, verify_fun, %%:: fun(CertVerifyErrors::term()) -> boolean(), + partial_chain :: fun(), fail_if_no_peer_cert :: boolean(), verify_client_once :: boolean(), %% fun(Extensions, State, Verify, AccError) -> {Extensions, State, AccError} diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index d6e5064c39..5553fc9220 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. All Rights Reserved. %% %% The 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,7 +44,8 @@ -include_lib("kernel/include/file.hrl"). -record(state, { - session_cache, + session_cache_client, + session_cache_server, session_cache_cb, session_lifetime, certificate_db, @@ -209,12 +210,16 @@ init([Name, Opts]) -> SessionLifeTime = proplists:get_value(session_lifetime, Opts, ?'24H_in_sec'), CertDb = ssl_pkix_db:create(), - SessionCache = CacheCb:init(proplists:get_value(session_cb_init_args, Opts, [])), + ClientSessionCache = CacheCb:init([{role, client} | + proplists:get_value(session_cb_init_args, Opts, [])]), + ServerSessionCache = CacheCb:init([{role, server} | + proplists:get_value(session_cb_init_args, Opts, [])]), Timer = erlang:send_after(SessionLifeTime * 1000 + 5000, self(), validate_sessions), erlang:send_after(?CLEAR_PEM_CACHE, self(), clear_pem_cache), {ok, #state{certificate_db = CertDb, - session_cache = SessionCache, + session_cache_client = ClientSessionCache, + session_cache_server = ServerSessionCache, session_cache_cb = CacheCb, session_lifetime = SessionLifeTime, session_validation_timer = Timer}}. @@ -230,15 +235,32 @@ init([Name, Opts]) -> %% %% Description: Handling call messages %%-------------------------------------------------------------------- -handle_call({{connection_init, <<>>, _Role}, _Pid}, _From, +handle_call({{connection_init, <<>>, client}, _Pid}, _From, #state{certificate_db = [CertDb, FileRefDb, PemChace], - session_cache = Cache} = State) -> + session_cache_client = Cache} = State) -> + Result = {ok, make_ref(),CertDb, FileRefDb, PemChace, Cache}, + {reply, Result, State}; +handle_call({{connection_init, <<>>, server}, _Pid}, _From, + #state{certificate_db = [CertDb, FileRefDb, PemChace], + session_cache_server = Cache} = State) -> Result = {ok, make_ref(),CertDb, FileRefDb, PemChace, Cache}, {reply, Result, State}; -handle_call({{connection_init, Trustedcerts, _Role}, Pid}, _From, +handle_call({{connection_init, Trustedcerts, client}, Pid}, _From, + #state{certificate_db = [CertDb, FileRefDb, PemChace] = Db, + session_cache_client = Cache} = State) -> + Result = + try + {ok, Ref} = ssl_pkix_db:add_trusted_certs(Pid, Trustedcerts, Db), + {ok, Ref, CertDb, FileRefDb, PemChace, Cache} + catch + _:Reason -> + {error, Reason} + end, + {reply, Result, State}; +handle_call({{connection_init, Trustedcerts, server}, Pid}, _From, #state{certificate_db = [CertDb, FileRefDb, PemChace] = Db, - session_cache = Cache} = State) -> + session_cache_server = Cache} = State) -> Result = try {ok, Ref} = ssl_pkix_db:add_trusted_certs(Pid, Trustedcerts, Db), @@ -249,9 +271,10 @@ handle_call({{connection_init, Trustedcerts, _Role}, Pid}, _From, end, {reply, Result, State}; + handle_call({{new_session_id,Port}, _}, _, #state{session_cache_cb = CacheCb, - session_cache = Cache} = State) -> + session_cache_server = Cache} = State) -> Id = new_id(Port, ?GEN_UNIQUE_ID_MAX_TRIES, Cache, CacheCb), {reply, Id, State}; @@ -278,16 +301,22 @@ handle_call({unconditionally_clear_pem_cache, _},_, #state{certificate_db = [_,_ %% Description: Handling cast messages %%-------------------------------------------------------------------- handle_cast({register_session, Host, Port, Session}, - #state{session_cache = Cache, + #state{session_cache_client = Cache, session_cache_cb = CacheCb} = State) -> TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), NewSession = Session#session{time_stamp = TimeStamp}, - CacheCb:update(Cache, {{Host, Port}, - NewSession#session.session_id}, NewSession), + + case CacheCb:select_session(Cache, {Host, Port}) of + no_session -> + CacheCb:update(Cache, {{Host, Port}, + NewSession#session.session_id}, NewSession); + Sessions -> + register_unique_session(Sessions, NewSession, CacheCb, Cache, {Host, Port}) + end, {noreply, State}; handle_cast({register_session, Port, Session}, - #state{session_cache = Cache, + #state{session_cache_server = Cache, session_cache_cb = CacheCb} = State) -> TimeStamp = calendar:datetime_to_gregorian_seconds({date(), time()}), NewSession = Session#session{time_stamp = TimeStamp}, @@ -296,12 +325,12 @@ handle_cast({register_session, Port, Session}, handle_cast({invalidate_session, Host, Port, #session{session_id = ID} = Session}, - #state{session_cache = Cache, + #state{session_cache_client = Cache, session_cache_cb = CacheCb} = State) -> invalidate_session(Cache, CacheCb, {{Host, Port}, ID}, Session, State); handle_cast({invalidate_session, Port, #session{session_id = ID} = Session}, - #state{session_cache = Cache, + #state{session_cache_server = Cache, session_cache_cb = CacheCb} = State) -> invalidate_session(Cache, CacheCb, {Port, ID}, Session, State). @@ -314,17 +343,18 @@ handle_cast({invalidate_session, Port, #session{session_id = ID} = Session}, %% Description: Handling all non call/cast messages %%------------------------------------------------------------------- handle_info(validate_sessions, #state{session_cache_cb = CacheCb, - session_cache = Cache, + session_cache_client = ClientCache, + session_cache_server = ServerCache, session_lifetime = LifeTime } = State) -> Timer = erlang:send_after(?SESSION_VALIDATION_INTERVAL, self(), validate_sessions), - start_session_validator(Cache, CacheCb, LifeTime), + start_session_validator(ClientCache, CacheCb, LifeTime), + start_session_validator(ServerCache, CacheCb, LifeTime), {noreply, State#state{session_validation_timer = Timer}}; -handle_info({delayed_clean_session, Key}, #state{session_cache = Cache, - session_cache_cb = CacheCb - } = State) -> +handle_info({delayed_clean_session, Key, Cache}, #state{session_cache_cb = CacheCb + } = State) -> CacheCb:delete(Cache, Key), {noreply, State}; @@ -367,12 +397,14 @@ handle_info(_Info, State) -> %% The return value is ignored. %%-------------------------------------------------------------------- terminate(_Reason, #state{certificate_db = Db, - session_cache = SessionCache, + session_cache_client = ClientSessionCache, + session_cache_server = ServerSessionCache, session_cache_cb = CacheCb, session_validation_timer = Timer}) -> erlang:cancel_timer(Timer), ssl_pkix_db:remove(Db), - CacheCb:terminate(SessionCache), + catch CacheCb:terminate(ClientSessionCache), + catch CacheCb:terminate(ServerSessionCache), ok. %%-------------------------------------------------------------------- @@ -445,7 +477,7 @@ invalidate_session(Cache, CacheCb, Key, Session, #state{last_delay_timer = LastT %% up the session data but new connections should not get to use this session. CacheCb:update(Cache, Key, Session#session{is_resumable = false}), TRef = - erlang:send_after(delay_time(), self(), {delayed_clean_session, Key}), + erlang:send_after(delay_time(), self(), {delayed_clean_session, Key, Cache}), {noreply, State#state{last_delay_timer = last_delay_timer(Key, TRef, LastTimer)}} end. @@ -494,3 +526,34 @@ clean_cert_db(Ref, CertDb, RefDb, PemCache, File) -> _ -> ok end. + +%% Do not let dumb clients create a gigantic session table +%% for itself creating big delays at connection time. +register_unique_session(Sessions, Session, CacheCb, Cache, PartialKey) -> + case exists_equivalent(Session , Sessions) of + true -> + ok; + false -> + CacheCb:update(Cache, {PartialKey, + Session#session.session_id}, Session) + end. + +exists_equivalent(_, []) -> + false; +exists_equivalent(#session{ + peer_certificate = PeerCert, + own_certificate = OwnCert, + compression_method = Compress, + cipher_suite = CipherSuite, + srp_username = SRP, + ecc = ECC} , + [#session{ + peer_certificate = PeerCert, + own_certificate = OwnCert, + compression_method = Compress, + cipher_suite = CipherSuite, + srp_username = SRP, + ecc = ECC} | _]) -> + true; +exists_equivalent(Session, [ _ | Rest]) -> + exists_equivalent(Session, Rest). diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 7337225bc4..63fc57edad 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -48,7 +48,8 @@ -export([compress/3, uncompress/3, compressions/0]). %% Payload encryption/decryption --export([cipher/4, decipher/3, is_correct_mac/2]). +-export([cipher/4, decipher/3, is_correct_mac/2, + cipher_aead/4, decipher_aead/4]). -export_type([ssl_version/0, ssl_atom_version/0]). @@ -377,6 +378,24 @@ cipher(Version, Fragment, ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version), {CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}. %%-------------------------------------------------------------------- +-spec cipher_aead(ssl_version(), iodata(), #connection_state{}, MacHash::binary()) -> + {CipherFragment::binary(), #connection_state{}}. +%% +%% Description: Payload encryption +%%-------------------------------------------------------------------- +cipher_aead(Version, Fragment, + #connection_state{cipher_state = CipherS0, + sequence_number = SeqNo, + security_parameters= + #security_parameters{bulk_cipher_algorithm = + BulkCipherAlgo} + } = WriteState0, AAD) -> + + {CipherFragment, CipherS1} = + ssl_cipher:cipher_aead(BulkCipherAlgo, CipherS0, SeqNo, AAD, Fragment, Version), + {CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}. + +%%-------------------------------------------------------------------- -spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}} | #alert{}. %% %% Description: Payload decryption @@ -396,6 +415,25 @@ decipher(Version, CipherFragment, Alert end. %%-------------------------------------------------------------------- +-spec decipher_aead(ssl_version(), binary(), #connection_state{}, binary()) -> {binary(), binary(), #connection_state{}} | #alert{}. +%% +%% Description: Payload decryption +%%-------------------------------------------------------------------- +decipher_aead(Version, CipherFragment, + #connection_state{sequence_number = SeqNo, + security_parameters = + #security_parameters{bulk_cipher_algorithm = + BulkCipherAlgo}, + cipher_state = CipherS0 + } = ReadState, AAD) -> + case ssl_cipher:decipher_aead(BulkCipherAlgo, CipherS0, SeqNo, AAD, CipherFragment, Version) of + {PlainFragment, CipherS1} -> + CS1 = ReadState#connection_state{cipher_state = CipherS1}, + {PlainFragment, CS1}; + #alert{} = Alert -> + Alert + end. +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- empty_connection_state(ConnectionEnd) -> diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index 6aab35d6da..53b5f2399b 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -90,11 +90,14 @@ -define('3DES', 4). -define(DES40, 5). -define(IDEA, 6). --define(AES, 7). +-define(AES_CBC, 7). +-define(AES_GCM, 8). +-define(CHACHA20_POLY1305, 9). %% CipherType -define(STREAM, 0). -define(BLOCK, 1). +-define(AEAD, 2). %% IsExportable %-define(TRUE, 0). %% Already defined by ssl_internal.hrl diff --git a/lib/ssl/src/ssl_session_cache.erl b/lib/ssl/src/ssl_session_cache.erl index 5c6ee3c54c..b011732f2c 100644 --- a/lib/ssl/src/ssl_session_cache.erl +++ b/lib/ssl/src/ssl_session_cache.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2012. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The 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,8 @@ %%-------------------------------------------------------------------- %% Description: Return table reference. Called by ssl_manager process. %%-------------------------------------------------------------------- -init(_) -> - ets:new(cache_name(), [ordered_set, protected]). +init(Options) -> + ets:new(cache_name(proplists:get_value(role, Options)), [ordered_set, protected]). %%-------------------------------------------------------------------- %% Description: Handles cache table at termination of ssl manager. @@ -87,5 +87,5 @@ select_session(Cache, PartialKey) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -cache_name() -> - ssl_otp_session_cache. +cache_name(Name) -> + list_to_atom(atom_to_list(Name) ++ "_ssl_otp_session_cache"). diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 26de51985a..7df73fb581 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -329,7 +329,10 @@ terminate(Reason, StateName, State) -> %% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState} %% Description: Convert process state when code is changed %%-------------------------------------------------------------------- -code_change(_OldVsn, StateName, State, _Extra) -> +code_change(_OldVsn, StateName, State0, {Direction, From, To}) -> + State = convert_state(State0, Direction, From, To), + {ok, StateName, State}; +code_change(_OldVsn, StateName, State, _) -> {ok, StateName, State}. format_status(Type, Data) -> @@ -958,3 +961,14 @@ workaround_transport_delivery_problems(Socket, gen_tcp = Transport) -> Transport:recv(Socket, 0, 30000); workaround_transport_delivery_problems(Socket, Transport) -> Transport:close(Socket). + +convert_state(#state{ssl_options = Options} = State, up, "5.3.5", "5.3.6") -> + State#state{ssl_options = convert_options_partial_chain(Options, up)}; +convert_state(#state{ssl_options = Options} = State, down, "5.3.6", "5.3.5") -> + State#state{ssl_options = convert_options_partial_chain(Options, down)}. + +convert_options_partial_chain(Options, up) -> + {Head, Tail} = lists:split(5, tuple_to_list(Options)), + list_to_tuple(Head ++ [{partial_chain, fun(_) -> unknown_ca end}] ++ Tail); +convert_options_partial_chain(Options, down) -> + list_to_tuple(proplists:delete(partial_chain, tuple_to_list(Options))). diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index f50ea22f39..544d200f70 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -132,6 +132,23 @@ encode_plain_text(Type, Version, Data, sequence_number = Seq, compression_state=CompS0, security_parameters= + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm=CompAlg} + }= WriteState0} = ConnectionStates) -> + {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), + WriteState1 = WriteState0#connection_state{compression_state = CompS1}, + AAD = calc_aad(Type, Version, WriteState1), + {CipherFragment, WriteState} = ssl_record:cipher_aead(Version, Comp, WriteState1, AAD), + CipherText = encode_tls_cipher_text(Type, Version, CipherFragment), + {CipherText, ConnectionStates#connection_states{current_write = WriteState#connection_state{sequence_number = Seq +1}}}; + +encode_plain_text(Type, Version, Data, + #connection_states{current_write = + #connection_state{ + sequence_number = Seq, + compression_state=CompS0, + security_parameters= #security_parameters{compression_algorithm=CompAlg} }= WriteState0} = ConnectionStates) -> {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0), @@ -148,18 +165,45 @@ encode_plain_text(Type, Version, Data, %% Description: Decode cipher text %%-------------------------------------------------------------------- decode_cipher_text(#ssl_tls{type = Type, version = Version, - fragment = CipherFragment} = CipherText, ConnnectionStates0) -> - ReadState0 = ConnnectionStates0#connection_states.current_read, - #connection_state{compression_state = CompressionS0, - sequence_number = Seq, - security_parameters = SecParams} = ReadState0, - CompressAlg = SecParams#security_parameters.compression_algorithm, + fragment = CipherFragment} = CipherText, + #connection_states{current_read = + #connection_state{ + compression_state = CompressionS0, + sequence_number = Seq, + security_parameters= + #security_parameters{ + cipher_type = ?AEAD, + compression_algorithm=CompAlg} + } = ReadState0} = ConnnectionStates0) -> + AAD = calc_aad(Type, Version, ReadState0), + case ssl_record:decipher_aead(Version, CipherFragment, ReadState0, AAD) of + {PlainFragment, ReadState1} -> + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, + PlainFragment, CompressionS0), + ConnnectionStates = ConnnectionStates0#connection_states{ + current_read = ReadState1#connection_state{ + sequence_number = Seq + 1, + compression_state = CompressionS1}}, + {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates}; + #alert{} = Alert -> + Alert + end; + +decode_cipher_text(#ssl_tls{type = Type, version = Version, + fragment = CipherFragment} = CipherText, + #connection_states{current_read = + #connection_state{ + compression_state = CompressionS0, + sequence_number = Seq, + security_parameters= + #security_parameters{compression_algorithm=CompAlg} + } = ReadState0} = ConnnectionStates0) -> case ssl_record:decipher(Version, CipherFragment, ReadState0) of {PlainFragment, Mac, ReadState1} -> MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1), case ssl_record:is_correct_mac(Mac, MacHash) of true -> - {Plain, CompressionS1} = ssl_record:uncompress(CompressAlg, + {Plain, CompressionS1} = ssl_record:uncompress(CompAlg, PlainFragment, CompressionS0), ConnnectionStates = ConnnectionStates0#connection_states{ current_read = ReadState1#connection_state{ @@ -322,3 +366,7 @@ calc_mac_hash(Type, Version, mac_hash(Version, SecPars#security_parameters.mac_algorithm, MacSecret, SeqNo, Type, Length, PlainFragment). + +calc_aad(Type, {MajVer, MinVer}, + #connection_state{sequence_number = SeqNo}) -> + <<SeqNo:64/integer, ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>. diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 7a5f9c1b38..c4114278a4 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -221,25 +221,50 @@ suites(Minor) when Minor == 1; Minor == 2 -> ]; suites(3) -> [ + ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, + ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, + + ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, + ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384, ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384, + ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384, + ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384, ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384, + ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, + ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, + ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384, ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256, + ?TLS_RSA_WITH_AES_256_GCM_SHA384, ?TLS_RSA_WITH_AES_256_CBC_SHA256, + ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256, ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256, ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256, + ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256, + ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256, ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256, ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256, + ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256, + ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256, + ?TLS_RSA_WITH_AES_128_GCM_SHA256, ?TLS_RSA_WITH_AES_128_CBC_SHA256 + + %% not supported + %% ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384, + %% ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384, + %% ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256, + %% ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256 ] ++ suites(2). + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 2f8ff6f04e..3639c2b2da 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -37,6 +37,7 @@ VSN=$(GS_VSN) MODULES = \ ssl_test_lib \ ssl_basic_SUITE \ + ssl_bench_SUITE \ ssl_cipher_SUITE \ ssl_certificate_verify_SUITE\ ssl_crl_SUITE\ @@ -130,7 +131,7 @@ release_spec: opt release_tests_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)" $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(HRL_FILES_NEEDED_IN_TEST) $(COVER_FILE) "$(RELSYSDIR)" - $(INSTALL_DATA) ssl.spec ssl.cover "$(RELSYSDIR)" + $(INSTALL_DATA) ssl.spec ssl_bench.spec ssl.cover "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl index 22dc951ac1..daf4466f11 100644 --- a/lib/ssl/test/erl_make_certs.erl +++ b/lib/ssl/test/erl_make_certs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -325,14 +325,14 @@ sign_algorithm(#'RSAPrivateKey'{}, Opts) -> {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}}}; -sign_algorithm(#'ECPrivateKey'{}, Opts) -> +sign_algorithm(#'ECPrivateKey'{parameters = Parms}, 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'}. + {Type, Parms}. make_key(rsa, _Opts) -> %% (OBS: for testing only) diff --git a/lib/ssl/test/ssl.spec b/lib/ssl/test/ssl.spec index fc7c1bbb82..86e14c033e 100644 --- a/lib/ssl/test/ssl.spec +++ b/lib/ssl/test/ssl.spec @@ -1 +1,4 @@ {suites,"../ssl_test",all}. +{skip_cases, "../ssl_test", + ssl_bench_SUITE, [setup_sequential, setup_concurrent, payload_simple], + "Benchmarks run separately"}. diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl index 608f2f11c3..3566a8a0a5 100644 --- a/lib/ssl/test/ssl_ECC_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. All Rights Reserved. %% %% The 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,41 +57,51 @@ all_versions_groups ()-> ]. key_cert_combinations() -> - [client_ec_server_ec, - client_rsa_server_ec, - client_ec_server_rsa, - client_rsa_server_rsa]. + [client_ecdh_server_ecdh, + client_rsa_server_ecdh, + client_ecdh_server_rsa, + client_rsa_server_rsa, + client_ecdsa_server_ecdsa, + client_ecdsa_server_rsa, + client_rsa_server_ecdsa + ]. %%-------------------------------------------------------------------- -init_per_suite(Config) -> - catch crypto:stop(), +init_per_suite(Config0) -> + end_per_suite(Config0), try crypto:start() of ok -> - ssl:start(), - Config + %% make rsa certs using oppenssl + Result = + (catch make_certs:all(?config(data_dir, Config0), + ?config(priv_dir, Config0))), + ct:log("Make certs ~p~n", [Result]), + Config1 = ssl_test_lib:make_ecdsa_cert(Config0), + Config2 = ssl_test_lib:make_ecdh_rsa_cert(Config1), + ssl_test_lib:cert_options(Config2) catch _:_ -> {skip, "Crypto did not start"} end. end_per_suite(_Config) -> - ssl:stop(), + application:stop(ssl), application:stop(crypto). %%-------------------------------------------------------------------- -init_per_group(erlang_client, Config) -> +init_per_group(erlang_client = Group, Config) -> case ssl_test_lib:is_sane_ecc(openssl) of true -> - common_init_per_group(erlang_client, [{server_type, openssl}, - {client_type, erlang} | Config]); + common_init_per_group(Group, [{server_type, openssl}, + {client_type, erlang} | Config]); false -> {skip, "Known ECC bug in openssl"} end; -init_per_group(erlang_server, Config) -> +init_per_group(erlang_server = Group, Config) -> case ssl_test_lib:is_sane_ecc(openssl) of true -> - common_init_per_group(erlang_client, [{server_type, erlang}, - {client_type, openssl} | Config]); + common_init_per_group(Group, [{server_type, erlang}, + {client_type, openssl} | Config]); false -> {skip, "Known ECC bug in openssl"} end; @@ -99,11 +109,21 @@ init_per_group(erlang_server, Config) -> init_per_group(erlang = Group, Config) -> case ssl_test_lib:sufficient_crypto_support(Group) of true -> - common_init_per_group(erlang, [{server_type, erlang}, - {client_type, erlang} | Config]); + common_init_per_group(Group, [{server_type, erlang}, + {client_type, erlang} | Config]); + false -> + {skip, "Crypto does not support ECC"} + end; + +init_per_group(openssl = Group, Config) -> + case ssl_test_lib:sufficient_crypto_support(Group) of + true -> + common_init_per_group(Group, [{server_type, openssl}, + {client_type, openssl} | Config]); false -> {skip, "Crypto does not support ECC"} - end; + end; + init_per_group(Group, Config) -> common_init_per_group(Group, Config). @@ -121,76 +141,118 @@ end_per_group(_GroupName, Config) -> %%-------------------------------------------------------------------- -init_per_testcase(_TestCase, Config) -> +init_per_testcase(TestCase, Config) -> ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), ct:log("Ciphers: ~p~n ", [ ssl:cipher_suites()]), + end_per_testcase(TestCase, Config), + ssl:start(), Config. -end_per_testcase(_TestCase, Config) -> +end_per_testcase(_TestCase, Config) -> + application:stop(ssl), Config. %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- -client_ec_server_ec(Config) when is_list(Config) -> - basic_test("ec1.crt", "ec1.key", "ec2.crt", "ec2.key", Config). - -client_ec_server_rsa(Config) when is_list(Config) -> - basic_test("ec1.crt", "ec1.key", "rsa1.crt", "rsa1.key", Config). +client_ecdh_server_ecdh(Config) when is_list(Config) -> + COpts = ?config(client_ecdh_rsa_opts, Config), + SOpts = ?config(server_ecdh_rsa_verify_opts, Config), + basic_test(COpts, SOpts, Config). + +client_ecdh_server_rsa(Config) when is_list(Config) -> + COpts = ?config(client_ecdh_rsa_opts, Config), + SOpts = ?config(server_ecdh_rsa_verify_opts, Config), + basic_test(COpts, SOpts, Config). + +client_rsa_server_ecdh(Config) when is_list(Config) -> + COpts = ?config(client_ecdh_rsa_opts, Config), + SOpts = ?config(server_ecdh_rsa_verify_opts, Config), + basic_test(COpts, SOpts, Config). + +client_rsa_server_rsa(Config) when is_list(Config) -> + COpts = ?config(client_verification_opts, Config), + SOpts = ?config(server_verification_opts, Config), + basic_test(COpts, SOpts, Config). + +client_ecdsa_server_ecdsa(Config) when is_list(Config) -> + COpts = ?config(client_ecdsa_opts, Config), + SOpts = ?config(server_ecdsa_verify_opts, Config), + basic_test(COpts, SOpts, Config). -client_rsa_server_ec(Config) when is_list(Config) -> - basic_test("rsa1.crt", "rsa1.key", "ec2.crt", "ec2.key", Config). +client_ecdsa_server_rsa(Config) when is_list(Config) -> + COpts = ?config(client_ecdsa_opts, Config), + SOpts = ?config(server_ecdsa_verify_opts, Config), + basic_test(COpts, SOpts, Config). -client_rsa_server_rsa(Config) when is_list(Config) -> - basic_test("rsa1.crt", "rsa1.key", "rsa2.crt", "rsa2.key", Config). +client_rsa_server_ecdsa(Config) when is_list(Config) -> + COpts = ?config(client_ecdsa_opts, Config), + SOpts = ?config(server_ecdsa_verify_opts, Config), + basic_test(COpts, SOpts, Config). %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- -basic_test(ClientCert, ClientKey, ServerCert, ServerKey, Config) -> - DataDir = ?config(data_dir, Config), +basic_test(COpts, SOpts, Config) -> + basic_test(proplists:get_value(certfile, COpts), + proplists:get_value(keyfile, COpts), + proplists:get_value(cacertfile, COpts), + proplists:get_value(certfile, SOpts), + proplists:get_value(keyfile, SOpts), + proplists:get_value(cacertfile, SOpts), + Config). + +basic_test(ClientCert, ClientKey, ClientCA, ServerCert, ServerKey, ServerCA, Config) -> SType = ?config(server_type, Config), CType = ?config(client_type, Config), {Server, Port} = start_server(SType, - filename:join(DataDir, "CA.pem"), - filename:join(DataDir, ServerCert), - filename:join(DataDir, ServerKey), + ClientCA, ServerCA, + ServerCert, + ServerKey, Config), - Client = start_client(CType, Port, filename:join(DataDir, "CA.pem"), - filename:join(DataDir, ClientCert), - filename:join(DataDir, ClientKey), Config), - check_result(Server, SType, Client, CType). + Client = start_client(CType, Port, ServerCA, ClientCA, + ClientCert, + ClientKey, Config), + check_result(Server, SType, Client, CType), + close(Server, Client). -start_client(openssl, Port, CA, Cert, Key, _) -> +start_client(openssl, Port, CA, OwnCa, Cert, Key, Config) -> + PrivDir = ?config(priv_dir, Config), + NewCA = new_ca(filename:join(PrivDir, "new_ca.pem"), CA, OwnCa), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ Cert ++ " -CAfile " ++ CA - ++ " -key " ++ Key ++ " -host localhost -msg", + Cmd = "openssl s_client -verify 2 -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ + " -cert " ++ Cert ++ " -CAfile " ++ NewCA + ++ " -key " ++ Key ++ " -host localhost -msg -debug", OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), true = port_command(OpenSslPort, "Hello world"), OpenSslPort; -start_client(erlang, Port, CA, Cert, Key, Config) -> +start_client(erlang, Port, CA, _, Cert, Key, Config) -> {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, {mfa, {ssl_test_lib, send_recv_result_active, []}}, - {options, [{verify, verify_peer}, {cacertfile, CA}, + {options, [{verify, verify_peer}, + {cacertfile, CA}, {certfile, Cert}, {keyfile, Key}]}]). -start_server(openssl, CA, Cert, Key, _) -> +start_server(openssl, CA, OwnCa, Cert, Key, Config) -> + PrivDir = ?config(priv_dir, Config), + NewCA = new_ca(filename:join(PrivDir, "new_ca.pem"), CA, OwnCa), + Port = ssl_test_lib:inet_port(node()), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ Cert ++ " -CAfile " ++ CA - ++ " -key " ++ Key ++ " -Verify 2 -msg", + " -verify 2 -cert " ++ Cert ++ " -CAfile " ++ NewCA + ++ " -key " ++ Key ++ " -msg -debug", OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), ssl_test_lib:wait_for_openssl_server(), true = port_command(OpenSslPort, "Hello world"), {OpenSslPort, Port}; -start_server(erlang, CA, Cert, Key, Config) -> +start_server(erlang, CA, _, Cert, Key, Config) -> + {_, ServerNode, _} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, @@ -217,9 +279,31 @@ openssl_check(_, Config) -> TLSVersion = ?config(tls_version, Config), case ssl_test_lib:check_sane_openssl_version(TLSVersion) of true -> - ssl:start(), Config; false -> {skip, "TLS version not supported by openssl"} end. +close(Port1, Port2) when is_port(Port1), is_port(Port2) -> + ssl_test_lib:close_port(Port1), + ssl_test_lib:close_port(Port2); +close(Port, Pid) when is_port(Port) -> + ssl_test_lib:close_port(Port), + ssl_test_lib:close(Pid); +close(Pid, Port) when is_port(Port) -> + ssl_test_lib:close_port(Port), + ssl_test_lib:close(Pid); +close(Client, Server) -> + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%% Work around OpenSSL bug, apparently the same bug as we had fixed in +%% 11629690ba61f8e0c93ef9b2b6102fd279825977 +new_ca(FileName, CA, OwnCa) -> + {ok, P1} = file:read_file(CA), + E1 = public_key:pem_decode(P1), + {ok, P2} = file:read_file(OwnCa), + E2 = public_key:pem_decode(P2), + Pem = public_key:pem_encode(E2 ++E1), + file:write_file(FileName, Pem), + FileName. diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/CA.pem b/lib/ssl/test/ssl_ECC_SUITE_data/CA.pem deleted file mode 100644 index f82efdefc5..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/CA.pem +++ /dev/null @@ -1,14 +0,0 @@ ------BEGIN CERTIFICATE----- -MIICGjCCAYegAwIBAgIQZIIqq4RXfpBKJXV69Jc4BjAJBgUrDgMCHQUAMB0xGzAZ -BgNVBAMTEklTQSBUZXN0IEF1dGhvcml0eTAeFw0xMjAzMjAxNzEzMjFaFw0zOTEy -MzEyMzU5NTlaMB0xGzAZBgNVBAMTEklTQSBUZXN0IEF1dGhvcml0eTCBnzANBgkq -hkiG9w0BAQEFAAOBjQAwgYkCgYEAqnt6FSyFQVSDyP7mY63IhCzgysTxBEg1qDb8 -nBHj9REReZA5UQ5iyEOdTbdLyOaSk2rJyA2wdTjYkNnLzK49nZFlpf89r3/bakAM -wZv69S3FJi9W2z9m4JPv/5+QCYnFNRSnnHw3maNElwoQyknx96I3W7EuVOvKtKhh -4DaD0WsCAwEAAaNjMGEwDwYDVR0TAQH/BAUwAwEB/zBOBgNVHQEERzBFgBBCHwn2 -8AmbN+cvJl1iJ1bsoR8wHTEbMBkGA1UEAxMSSVNBIFRlc3QgQXV0aG9yaXR5ghBk -giqrhFd+kEoldXr0lzgGMAkGBSsOAwIdBQADgYEAIlVecua5Cr1z/cdwQ8znlgOU -U+y/uzg0nupKkopzVnRYhwV4hxZt3izAz4C/SJZB7eL0bUKlg1ceGjbQsGEm0fzF -LEV3vym4G51bxv03Iecwo96G4NgjJ7+9/7ciBVzfxZyfuCpYG1M2LyrbOyuevtTy -2+vIueT0lv6UftgBfIE= ------END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/ec1.crt b/lib/ssl/test/ssl_ECC_SUITE_data/ec1.crt deleted file mode 100644 index 7d2b9cde9d..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/ec1.crt +++ /dev/null @@ -1,11 +0,0 @@ ------BEGIN CERTIFICATE----- -MIIBhjCB8AIBBjANBgkqhkiG9w0BAQUFADAdMRswGQYDVQQDExJJU0EgVGVzdCBB -dXRob3JpdHkwHhcNMTMwODA4MTAxNDI3WhcNMjMwODA2MTAxNDI3WjBFMQswCQYD -VQQGEwJVUzERMA8GA1UECBMIVmlyZ2luaWExFTATBgNVBAcTDEZvcnQgQmVsdm9p -cjEMMAoGA1UEAxMDZWMxMFYwEAYHKoZIzj0CAQYFK4EEAAoDQgAEpiRIxUCESROR -P8IByg+vBv1fDdAg7yXfAh95GxFtvhBqZs6ATwaRKyLmZYgUm/4NUAyUeqmTBb7s -2msKo5mnNzANBgkqhkiG9w0BAQUFAAOBgQAmwzoB1DVO69FQOUdBVnyups4t0c1c -8h+1z/5P4EtPltk4o3mRn0AZogqdXCpNbuSGbSJh+dep5xW30VLxNHdc+tZSLK6j -pT7A3hymMk8qbi13hxeH/VpEP25y1EjHowow9Wmb6ebtT/v7qFQ9AAHD9ONcIM4I -FCC8vdFo7M5GgQ== ------END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/ec1.key b/lib/ssl/test/ssl_ECC_SUITE_data/ec1.key deleted file mode 100644 index 2dc9508b3c..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/ec1.key +++ /dev/null @@ -1,8 +0,0 @@ ------BEGIN EC PARAMETERS----- -BgUrgQQACg== ------END EC PARAMETERS----- ------BEGIN EC PRIVATE KEY----- -MHQCAQEEIOO0WK8znNzLyZIoGRIlaKnCNr2Wy8uk9i+GGFIhDGNAoAcGBSuBBAAK -oUQDQgAEpiRIxUCESRORP8IByg+vBv1fDdAg7yXfAh95GxFtvhBqZs6ATwaRKyLm -ZYgUm/4NUAyUeqmTBb7s2msKo5mnNw== ------END EC PRIVATE KEY----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/ec2.crt b/lib/ssl/test/ssl_ECC_SUITE_data/ec2.crt deleted file mode 100644 index b0558a0ebc..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/ec2.crt +++ /dev/null @@ -1,11 +0,0 @@ ------BEGIN CERTIFICATE----- -MIIBhjCB8AIBBzANBgkqhkiG9w0BAQUFADAdMRswGQYDVQQDExJJU0EgVGVzdCBB -dXRob3JpdHkwHhcNMTMwODA4MTAxNDM0WhcNMjMwODA2MTAxNDM0WjBFMQswCQYD -VQQGEwJVUzERMA8GA1UECBMIVmlyZ2luaWExFTATBgNVBAcTDEZvcnQgQmVsdm9p -cjEMMAoGA1UEAxMDZWMyMFYwEAYHKoZIzj0CAQYFK4EEAAoDQgAEzXaYReUyvoYl -FwGOe0MJEXWCUncMfr2xG4GMjGYlfZsvLGEokefsJIvW+I+9jgUT2UFjxFXYNAvm -uD1A1iWVWjANBgkqhkiG9w0BAQUFAAOBgQBFa6iIlrT9DWptIdB8uSYvp7qwiHxN -hiVH5YhGIHHqjGZqtRHrSxqNEYMXXrgH9Hxc6gDbk9PsHZyVVoh/HgVWddqW1inh -tStZm420PAKCuH4T6Cfsk76GE2m7FRzJvw9TM1f2A5nIy9abyrpup8lZGcIL4Kmq -1Fix1LRtrmLNTA== ------END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/ec2.key b/lib/ssl/test/ssl_ECC_SUITE_data/ec2.key deleted file mode 100644 index 366d13648b..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/ec2.key +++ /dev/null @@ -1,8 +0,0 @@ ------BEGIN EC PARAMETERS----- -BgUrgQQACg== ------END EC PARAMETERS----- ------BEGIN EC PRIVATE KEY----- -MHQCAQEEIPR3ORUpAFMTQhUJ0jllN38LKWziG8yP2H54Y/9vh1PwoAcGBSuBBAAK -oUQDQgAEzXaYReUyvoYlFwGOe0MJEXWCUncMfr2xG4GMjGYlfZsvLGEokefsJIvW -+I+9jgUT2UFjxFXYNAvmuD1A1iWVWg== ------END EC PRIVATE KEY----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.crt b/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.crt deleted file mode 100644 index ed9beacf68..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.crt +++ /dev/null @@ -1,20 +0,0 @@ ------BEGIN CERTIFICATE----- -MIIDVjCCAr8CAQkwDQYJKoZIhvcNAQEFBQAwHTEbMBkGA1UEAxMSSVNBIFRlc3Qg -QXV0aG9yaXR5MB4XDTEzMDgwODEwMTUzNFoXDTQwMTIyNDEwMTUzNFowRjELMAkG -A1UEBhMCVVMxETAPBgNVBAgTCFZpcmdpbmlhMRUwEwYDVQQHEwxGb3J0IEJlbHZv -aXIxDTALBgNVBAMTBHJzYTEwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoIC -AQC62v40w1AjV3oJuyYC2Fw6XhTOi1il6xZFnB9J1WhCmuxAB/VMhBcNypx38mNk -eQ7a/ERQ5ddhZey29DYeFYU8oqfDURgWx5USHufb90xBen9KPmX3VNuQ8ZFP2q8Q -b01/oRHBJQRBuaCtFHzpGIVBjC6dD5yeQgJsYaF4u+PBbonsIGROXMybcvUzXmjU -dwpy2NhjGQL5sWcOdIeRP43APSyRYvq4tuBUZk2XxWfBcvA8LpcoYPMlRTf6jGL1 -/fAAcCYJ9lh3h92w0NZ/7ZRa/ebTplxK6yqCftuSKui1KdL69m0WZqHl79AUSfs9 -lsOwx9lHkyYvJeMofyeDbZ+3OYLmVqEBG1fza2aV2XVh9zJ8fAwmXy/c2IDhw/oD -HAe/rSg/Sgt03ydIKqtZHbl3v0EexQQRlJRULIzdtON02dJMUd4EFUgQ9OUtEmC2 -Psj9Jdu1g5cevU7Mymu8Ot+fjHiGTcBUsXNuXFCbON3Gw7cIDl4+iv+cpDHHVC9L -HK3PMEq3vu3qOGXSz+LDOoqkfROcLG7BclBuN2zoVSsMHFkB4aJhwy7eHhGz0z2W -c6LTVd+GAApdY80kmjOjT//QxHEsX/n1useHza3OszQqZiArr4ub4rtq+l1DxAS/ -DWrZ/JGsbKL8cjWso6qBF94xTi8WhjkKuUYhsm+qLAbNOQIDAQABMA0GCSqGSIb3 -DQEBBQUAA4GBAIcuzqRkfypV/9Z85ZQCCoejPm5Urhv7dfg1/B3QtazogPBZLgL5 -e60fG1uAw5GmqTViHLvW06z73oQvJrFkrCLVvadDNtrKYKXnXqdkgVyk36F/B737 -A43HGnMfSxCfRhIOuKZB9clP5PiNlhw36yi3DratqT6TUvI69hg8a7jA ------END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.key b/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.key deleted file mode 100644 index 6e0d913d79..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.key +++ /dev/null @@ -1,51 +0,0 @@ ------BEGIN RSA PRIVATE KEY----- -MIIJKAIBAAKCAgEAutr+NMNQI1d6CbsmAthcOl4UzotYpesWRZwfSdVoQprsQAf1 -TIQXDcqcd/JjZHkO2vxEUOXXYWXstvQ2HhWFPKKnw1EYFseVEh7n2/dMQXp/Sj5l -91TbkPGRT9qvEG9Nf6ERwSUEQbmgrRR86RiFQYwunQ+cnkICbGGheLvjwW6J7CBk -TlzMm3L1M15o1HcKctjYYxkC+bFnDnSHkT+NwD0skWL6uLbgVGZNl8VnwXLwPC6X -KGDzJUU3+oxi9f3wAHAmCfZYd4fdsNDWf+2UWv3m06ZcSusqgn7bkirotSnS+vZt -Fmah5e/QFEn7PZbDsMfZR5MmLyXjKH8ng22ftzmC5lahARtX82tmldl1YfcyfHwM -Jl8v3NiA4cP6AxwHv60oP0oLdN8nSCqrWR25d79BHsUEEZSUVCyM3bTjdNnSTFHe -BBVIEPTlLRJgtj7I/SXbtYOXHr1OzMprvDrfn4x4hk3AVLFzblxQmzjdxsO3CA5e -Por/nKQxx1QvSxytzzBKt77t6jhl0s/iwzqKpH0TnCxuwXJQbjds6FUrDBxZAeGi -YcMu3h4Rs9M9lnOi01XfhgAKXWPNJJozo0//0MRxLF/59brHh82tzrM0KmYgK6+L -m+K7avpdQ8QEvw1q2fyRrGyi/HI1rKOqgRfeMU4vFoY5CrlGIbJvqiwGzTkCAwEA -AQKCAgBkXyaWKSRvF5pSh9lPRfGk2MzMdkXUOofoNIkKHDy5KocljiDSTVIk8mVC -eU2ytuSn9UKtQgmEJEAXtu8rEdxUSftcC7+o3OTSqw9ZNWoc8jRWKVaUmVyoa1rn -Tk0jwuYaXOcwnTXAKHqK/qpqe+V45FhVvgEfcc3jcj5OoH8jdMFZubyn62ltRz83 -rMsa9icCskDqWpEil40IUshP2ZfHYBUEs+qCNpoiPCIKGNw3KgqqCUzhP9LcfmYn -jCnMge/eDGAikdXLv4vyYvwWFATRK/pGTuLcy542IvbHeY0vY5wVezH2CoOFBGD9 -xQ/UcZwE5hVtQToNsYhoRIVxL/3Of0qDk1M6W2Plh2MAstyejIHE3ct0pPfW3rsu -j/9Z/H0P9Q5ghSjarwOp2qGrrz6/4LVbbTDY8V1L928l4SqbUMtEQxcxTBN8YFoD -mPV3Jc3zls9wiiEX53RcH8MK5tjrcRwWqurTZvi/pkLfXlGDgKGCOaa3HgWVQyU+ -L6jVZM+u1nwN+jNXQYGeLEro/6tvG8WQbRMHQoxLG+rm4V3/SwH0DcfrVFDTg+i6 -3wMU1GC/aQEdTFWXvHAkpwrf4M9QWvjtheiaSxtBUoAY6l+ixCVHKrIk6glKLEjx -92HxmcJdopQScFETAyg8eVKV0kOGfVeFEpIqwq7hVedmTflpQQKCAQEA44h4dAta -cYeBqBr8eljWcgs79gmgwBEQxQUnwE/zuzLKn5NxAW324Kh25V/n/MupUzBlLPWn -91UHfw9PCXT8/HvgYQ4S5sXbKRbGmuPSsTmz4Rfe2ix6RggVNUOwORVNDyM7SQh7 -USdzZH5dMxKfF5L/b4Byx7eQZaoeKlfaXcqgikNZZ6pkhVCNxUKi9vvjS9r2wwCd -xtgu5MfTpdEci0zH1+uuRisVRcEbcRX9umUTCiZrmEeddZXNiwTAS3FtX7qGzuq9 -LKIeETwcOZrWj0E48UvbSfK4Axn7sf5J0n7/Qo7I089S5QQEI6ZDP501i71dNFhn -qfcY30c1k3TC7QKCAQEA0juuVHExKNLLNmQejNPfuHYoH0Uk2BH/8x96/Mkj6k6K -SUCHDS3iWOljXGw8YtpS8v5mGBGgMhJ+s/vCRM6R9eXYTc8u2ktY/kjyW0PgW8/Z -vb9VrQpn5svTNwj2Q8qYsTqXnQKO7YuL+hnQpQNAcID6FTeOASVLGObEf810qRfN -4y3RqCWUnYXXTyXj+cJdbXTxfF7HVZPIAQKqE7J5Qo9ynYILY62oSmUGC6m8VKyE -rrvDMK1IVi0X4w+Jx4HX0IC2+DBKxCaLWT69bE1IwjB06Q5zoTQPVi6c6qQp7K0H -kqSyLJ/ctwcEubu0DPNmvMlgWtAbAsoESA5GbIit/QKCAQEAxRzp9OYNAUM6AK74 -QOmLRZsT4+6tUxa1p2jy6fiZlnfG731kra9c630mG0n9iJPK6aWIUO20CGGiL+HM -P84YiIaseIgfucp4NV1kyrRJR31MptjuF6Xme5ru/IjaNmmMq2uDJZ7ybfi2T73k -8aTVLDANl8P4K6qLrnc00MvxAcXTVFRKNLN5h8CkQNqcoUjPvVxA3+g9xxBrd4jh -gsnoZ4kpq5WiEWmrcRV8t3gsqfh8CRQFrBOGhmIzgZapG/J0pTTLKqBTKEJ9t8KS -VRkdfVcshGWJ4MMjxJQS5zz7KR8Z9cgKlOwLzRiwmU2k/owr4hY3k2xuyeClrHBd -KpRBdQKCAQBvDk/dE55gbloi9WieBB6eluxC+IeqDHgkunCBsM9kKvEqGQg+kgqL -5V4zqImNvr8q1fCgrk7tpI+CDHBnYKgCOdS15cheUIdGbMp6I7UVSws/DR/5NRIF -/Y4p+HX/Abr/hHAq5PsTyS+8gn6RbNJRnBB/vMUrHcQ5902+JY6G9KgyZjXmmVOU -kutWSDHR8jbgZ3JZvMeYEWUKA5pMpW8hFh35zoStt0K7afpzlsqCAFBm7ZEC2cbo -nxGLRN4HojObVSNSoFAepi3eiyINYBYbXvWjV5sFgTbI0/7YhLgQ6qahdJcas6go -l3CLnPhUDxAqkkZwMpbSNl1kowXYt6sRAoIBAAOWnXgf9Bdb9OWKGgt42gVfC4cz -zj2JoLpbDTtbEdHNn8XQvPhGbpdtgnsuEMijIMy1UTlmv17jbFWdZTDeN31EUJrC -smgKX0OlVFKD90AI0BiIREK0hJUBV0pV4JoUjwnQBHGvranD06/wAtHEqgqF1Ipp -DCAKwxggM7qtB1R1vkrc/aLQej+mlwA8N6q92rnEsg+EnEbhtLDDZQcV/q5cSDCN -MMcnM+QdyjKwEeCVXHaqNfeSqKg/Ab2eZbS9VxA+XZD73+eUY/JeJsg7LfZrRz0T -ij5LCS7A+nVB5/B5tGkk4fcNhk2n356be6l46S98BEgtuwGLC9pqXf7zyp4= ------END RSA PRIVATE KEY----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.crt b/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.crt deleted file mode 100644 index 06ca92dda3..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.crt +++ /dev/null @@ -1,20 +0,0 @@ ------BEGIN CERTIFICATE----- -MIIDVjCCAr8CAQowDQYJKoZIhvcNAQEFBQAwHTEbMBkGA1UEAxMSSVNBIFRlc3Qg -QXV0aG9yaXR5MB4XDTEzMDgwODEwMTYwMloXDTQwMTIyNDEwMTYwMlowRjELMAkG -A1UEBhMCVVMxETAPBgNVBAgTCFZpcmdpbmlhMRUwEwYDVQQHEwxGb3J0IEJlbHZv -aXIxDTALBgNVBAMTBHJzYTIwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoIC -AQCjQUe0BGOpULjOAmLbXM4SSQzJvxJbCFi3tryyd+OARq6Fdp6/fslVhsr0PhWE -X8yRbAugIjseTpLwz+1OC6LavOGV1ixzGTI/9HDXGKbf8qoCrSdh28sqQJnmqGT4 -UCKLn6Rqjg2iyBBcSK3LrtKEPI4C7NaSOZUtANkppvziEMwm+0r16sgHh2Xx6mxd -22q01kq1lJqwEnIDPMSz3+ESUVQQ4T3ka7yFIhc9PYmILIXkZi0x7AiDeRkIILul -GQrduTWSPGY3prXeDAbmQNazxrHp8fcR2AfFSI6HYxMALq9jWxc4xDIkss6BO2Et -riJOIgXFpbyVsYCbkI1kXhEWFDt3uJBIcmtJKGzro4xv+XLG6BbUeTJgSHXMc7Cb -fX87+CBIFR5a/aqkEKh/mcvsDdaV+kpNKdr7q4wAuIQb8g7IyXEDuAm1VZjQs9WC -KFRGSq9sergEw9gna0iThRZjD+dzNzB17XmlAK4wa98a7MntwqpAt/GsCFOiPM8E -c+8gpuo8WqC0kP8OpImyw9cQhlZ3dca1qkr2cyKyAOGxUxyA67FgiHSsxJJ2Xhse -o49qeKTjMZd8zhSokM2TH6qEf7YfOePU51YRfAHUhzRmE31N/MExqDjFjklksEtM -iHhbPo+cOoxV8x1u13umdUvtTaAUSBA/DpvzWdnORvnaqQIDAQABMA0GCSqGSIb3 -DQEBBQUAA4GBAFD+O7h+5R5S1rIN9eC+oEGpvRhMG4v4G3pJp+c7bbtO7ifFx1WP -bta1b5YtiQYcKP0ORABm/3Kcvsb3VbaMH/zkxWEbASZsmIcBY3ml4f2kkn6WT2hD -Wc6VMIAR3N6Mj1b30yI1qYVIid+zIouiykMB+zqllm+Uar0SPNjKxDU/ ------END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.key b/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.key deleted file mode 100644 index d415ef0391..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.key +++ /dev/null @@ -1,51 +0,0 @@ ------BEGIN RSA PRIVATE KEY----- -MIIJJwIBAAKCAgEAo0FHtARjqVC4zgJi21zOEkkMyb8SWwhYt7a8snfjgEauhXae -v37JVYbK9D4VhF/MkWwLoCI7Hk6S8M/tTgui2rzhldYscxkyP/Rw1xim3/KqAq0n -YdvLKkCZ5qhk+FAii5+kao4NosgQXEity67ShDyOAuzWkjmVLQDZKab84hDMJvtK -9erIB4dl8epsXdtqtNZKtZSasBJyAzzEs9/hElFUEOE95Gu8hSIXPT2JiCyF5GYt -MewIg3kZCCC7pRkK3bk1kjxmN6a13gwG5kDWs8ax6fH3EdgHxUiOh2MTAC6vY1sX -OMQyJLLOgTthLa4iTiIFxaW8lbGAm5CNZF4RFhQ7d7iQSHJrSShs66OMb/lyxugW -1HkyYEh1zHOwm31/O/ggSBUeWv2qpBCof5nL7A3WlfpKTSna+6uMALiEG/IOyMlx -A7gJtVWY0LPVgihURkqvbHq4BMPYJ2tIk4UWYw/nczcwde15pQCuMGvfGuzJ7cKq -QLfxrAhTojzPBHPvIKbqPFqgtJD/DqSJssPXEIZWd3XGtapK9nMisgDhsVMcgOux -YIh0rMSSdl4bHqOPanik4zGXfM4UqJDNkx+qhH+2Hznj1OdWEXwB1Ic0ZhN9TfzB -Mag4xY5JZLBLTIh4Wz6PnDqMVfMdbtd7pnVL7U2gFEgQPw6b81nZzkb52qkCAwEA -AQKCAgBORLHXwHL3bdfsDIDQooG5ioQzBQQL2MiP63A0L/5GNZzeJ6ycKnDkLCeJ -SWqPeE5fOemo8EBfm1QfV9BxpmqBbCTK7U+KLv5EYzDmLs9ydqjDd7h11iZlL2uZ -hgpCckjdn7/3xfsLm9ccJ0wLZtlOxKlhBaMpn6nBVbLHoWOEDoGR/tBFbjZQRb2+ -aaFirhtOb56Jx6ER4QYAP1Ye1qrVWWBwZ0yBApXzThDOL36MZqwagFISqRK71YcG -uoq78HGhM3ZXkdV/wNFYj3OPWG6W6h/KBVNqnqO7FbofdoRZhghYHgfYE1fm+ELA -+nLwr5eK1gzmYTs0mVELRBZFlEOkCfYNOnuRgysFezEklS+ICp3HzIhYXza3kyTf -B2ZBwZZVCv/94MKyibyANErmv1a5ugY5Hsn9/WKC8qTto+qLYoyFCvBjzj0PSaVX -/3cty2DY0SK16K1Y4AOPtJMYTXYB3tVX8Akgjz1F6REBtZSOXrSQ3Vhy1ORl3Hzf -WCBYDqL8K0hJiBVgkvneIyIjmFHsdM60Nr7EldBEnJ/UrPzsl2VuWFPZlnasfUaW -x+vq1H4Dfz+bHt8coBRHDjKgUvwkfFeBQOBR5DG3vMrxguVRA1EYYMRR5C3yxk2m -ARAtdh4VxUQDQjjrmr7Dl/y1rU34aInXIrrFWpuvIhl8Ht09sQKCAQEA1pXKK5f0 -HkKfM/qk5xzF+WdHClBrPXi0XwLN6UQ+WWMMNhkGZ+FMPXl/6IJDT91s6DA3tPhr -OZF64n9ZFaGgHNBXNiB+Txjv5vZeSBMFt3hSonqt42aijx6gXfmLnkA+TYpa6Wex -YCeEgdH8LocJa7Gj2vzrYliPYk3deh6SnZZ6N8bI+ciwK3ZGF/pkWaTX83dIFq3w -YyZ+0dEpNGbA9812wNVourPg3OfqG3/CdnTfvY1M9KCC3JalpyzQL4Zm5soXF0wj -36C2yTxA02AyFz3TvUIBrvsN6i0gmGfE79+UIp29JYrFRsIgBDt+ze2vQWUz2MX5 -GeX6/yCBgiTXtwKCAQEAwsNf6k2m5Cw+WtuLzzUfBBJCN+t1lrnYJ6lF0HubW6TZ -vX1kBWyc+Rpo4ljr/+f4R9aC/gTEQOmV/hNVZy1RU2dAI8cH+r6JWG9lgif+8h// -5R81txE7gnuK1Na7PmvnQPPN661zsQZ5e1ENPXS3TJmUW/M01JxAMqEQjvAPa/II -H2KjL5NX28k9Hiw9rP6n+qXAfG/LEwXgoVCcehPwfANqQ1l95UgOdKDmjG94dipI -h2DEK70ZbrsgQbT60Wd8I5h0yhiQsik2/bVkqLmcG4SSg0/5cf2vZMApgoH/adUz -rJFdthm7iGPLhwS6fbhXew17Af96FvzfkifUV+cgnwKCAQBNUlYyFSQKz1jMgxFu -kciokNVhWw75bIgaAEmwNz38OZuJ1sSfI+iz8hbr8hxNJ+15UP6RwD3q1YghG2A/ -Uij+mPgD8ftxhvvTDo10jR4vOTUVhP0phq8mwRNqKWRs1ptcl3Egz5NzoWm22bJ0 -FYaIfs8bNq2el2i7NHGM8n1EOZe6h2+dyfno/0pMk5YbUzHZce7Q9UY8g/+InUSq -tCfuYuPaokuFkxGAqDSMSiIJSx3gEI1dTIU69TGlppkxts1XdhSR+YanqyKSKpr1 -T6FdDJNCjAlNQvuFmVM4d5PYF4kqXApu/60MTSD6RXHwxCe1ecEP6G5VLbCew9jG -y33LAoIBAGsWyC9pwQEm/qYwn4AwYjx32acrtX1J9HtiTLvkqzjJvNu/DXcaEHm7 -tr32TNVp9A9z+JS5hDt49Hs+oC/aMCRe2lqRvmZ1y8kvfy4A1eLGC4stDPj65bDK -QzziURRyejYxmCElPz6wI63VlCUdfwgEThn88SiSPY5ZF2SwxJoC+8peDwJCzwVP -cmabxtHPOAfOibciNRPhoHCyhUdunUVjD1O26k1ewGwKaJoBVMgMWdLuNw8hq9FB -3OukGmF3uD9OPbE9rpn3pX/89Dr9y8MpsvG20J6H8Z/BNVHILus/SmlxiIhvP7kv -viIgTHaCHL/RWrhvg+8N3dRcSBqJQFsCggEAFe2TMEq2AlnBn4gsuAOIuZPYKQCg -2a+tl1grQzmNth6AGGQcIqShadICD6SnVMIS64HHV/m18Cuz7GhJ06ZVjXJsHueG -UpTE9wAmI2LxnNkupkLJu+SVcW3N86PujWmQBFpHkd+IRPLS51xjD9W5zLJ7HL4/ -fnKO+B+ZK6Imxbe5C5vJezkGfeOSyQoVtt6MT/XtSKNEGPBX+M6fLKgUMMg2H2Mt -/SsD7DkOzFteKXzaEg/K8oOTpsOPkVDwNl2KErlEqbJv0k7yEVw50mYmsn/OLjh8 -+9EibISwCODbPxB+PhV6u2ue1IvGLRqtsN60lFOvbGn+kSewy9EUVHHQDQ== ------END RSA PRIVATE KEY----- diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 1da4e88077..dc9e8934e6 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -629,7 +629,7 @@ clear_pem_cache(Config) when is_list(Config) -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), - [_,FilRefDb, _] = element(5, State), + [_,FilRefDb, _] = element(6, State), {Server, Client} = basic_verify_test_no_close(Config), 2 = ets:info(FilRefDb, size), ssl:clear_pem_cache(), @@ -2339,7 +2339,7 @@ der_input(Config) when is_list(Config) -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), - [CADb | _] = element(5, State), + [CADb | _] = element(6, State), [] = ets:tab2list(CADb). %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/ssl_bench.spec b/lib/ssl/test/ssl_bench.spec new file mode 100644 index 0000000000..d2f75b4203 --- /dev/null +++ b/lib/ssl/test/ssl_bench.spec @@ -0,0 +1 @@ +{suites,"../ssl_test",[ssl_bench_SUITE]}. diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl new file mode 100644 index 0000000000..b6b3769922 --- /dev/null +++ b/lib/ssl/test/ssl_bench_SUITE.erl @@ -0,0 +1,366 @@ +%%%------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The 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/.2 +%% +%% 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(ssl_bench_SUITE). +-compile(export_all). +-include_lib("common_test/include/ct_event.hrl"). + +-define(remote_host, "NETMARKS_REMOTE_HOST"). + +suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. + +all() -> [{group, setup}, {group, payload}]. + +groups() -> + [{setup, [{repeat, 3}], [setup_sequential, setup_concurrent]}, + {payload, [{repeat, 3}], [payload_simple]} + ]. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, _Config) -> + ok. + +init_per_suite(Config) -> + try + Server = setup(ssl, node()), + [{server_node, Server}|Config] + catch _:_ -> + {skipped, "Benchmark machines only"} + end. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_Func, Conf) -> + Conf. + +end_per_testcase(_Func, _Conf) -> + ok. + + +-define(COUNT, 400). +-define(TC(Cmd), tc(fun() -> Cmd end, ?MODULE, ?LINE)). + +-define(FPROF_CLIENT, false). +-define(FPROF_SERVER, false). +-define(EPROF_CLIENT, false). +-define(EPROF_SERVER, false). +-define(PERCEPT_SERVER, false). + +%% Current numbers gives roughly a testcase per minute on todays hardware.. + +setup_sequential(Config) -> + Server = proplists:get_value(server_node, Config), + Server =/= undefined orelse error(no_server), + {ok, Result} = do_test(ssl, setup_connection, ?COUNT * 20, 1, Server), + ct_event:notify(#event{name = benchmark_data, + data=[{value, Result}, + {suite, "ssl"}, {name, "Sequential setup"}]}), + ok. + +setup_concurrent(Config) -> + Server = proplists:get_value(server_node, Config), + Server =/= undefined orelse error(no_server), + {ok, Result} = do_test(ssl, setup_connection, ?COUNT, 100, Server), + ct_event:notify(#event{name = benchmark_data, + data=[{value, Result}, + {suite, "ssl"}, {name, "Concurrent setup"}]}), + ok. + +payload_simple(Config) -> + Server = proplists:get_value(server_node, Config), + Server =/= undefined orelse error(no_server), + {ok, Result} = do_test(ssl, payload, ?COUNT*300, 10, Server), + ct_event:notify(#event{name = benchmark_data, + data=[{value, Result}, + {suite, "ssl"}, {name, "Payload simple"}]}), + ok. + + +ssl() -> + test(ssl, ?COUNT, node()). + +test(Type, Count, Host) -> + Server = setup(Type, Host), + (do_test(Type, setup_connection, Count * 20, 1, Server)), + (do_test(Type, setup_connection, Count, 100, Server)), + (do_test(Type, payload, Count*300, 10, Server)), + ok. + +do_test(Type, TC, Loop, ParallellConnections, Server) -> + _ = ssl:stop(), + {ok, _} = ensure_all_started(ssl, []), + + {ok, {SPid, Host, Port}} = rpc:call(Server, ?MODULE, setup_server_init, + [Type, TC, Loop, ParallellConnections]), + link(SPid), + Me = self(), + Test = fun(Id) -> + CData = client_init(Me, Type, TC, Host, Port), + receive + go -> + ?FPROF_CLIENT andalso Id =:= 1 andalso + start_profile(fprof, [self(),new]), + ?EPROF_CLIENT andalso Id =:= 1 andalso + start_profile(eprof, [ssl_connection_sup, ssl_manager]), + ok = ?MODULE:TC(Loop, Type, CData), + ?FPROF_CLIENT andalso Id =:= 1 andalso + stop_profile(fprof, "test_connection_client_res.fprof"), + ?EPROF_CLIENT andalso Id =:= 1 andalso + stop_profile(eprof, "test_connection_client_res.eprof"), + Me ! self() + end + end, + Spawn = fun(Id) -> + Pid = spawn(fun() -> Test(Id) end), + receive {Pid, init} -> Pid end + end, + Pids = [Spawn(Id) || Id <- lists:seq(ParallellConnections, 1, -1)], + Run = fun() -> + [Pid ! go || Pid <- Pids], + [receive Pid -> ok end || Pid <- Pids] + end, + {TimeInMicro, _} = timer:tc(Run), + TotalTests = ParallellConnections * Loop, + TestPerSecond = 1000000 * TotalTests div TimeInMicro, + io:format("TC ~p ~p ~p ~p 1/s~n", [TC, Type, ParallellConnections, TestPerSecond]), + unlink(SPid), + SPid ! quit, + {ok, TestPerSecond}. + +server_init(ssl, setup_connection, _, _, Server) -> + {ok, Socket} = ssl:listen(0, ssl_opts(listen)), + {ok, {_Host, Port}} = ssl:sockname(Socket), + {ok, Host} = inet:gethostname(), + ?FPROF_SERVER andalso start_profile(fprof, [whereis(ssl_manager), new]), + %%?EPROF_SERVER andalso start_profile(eprof, [ssl_connection_sup, ssl_manager]), + ?EPROF_SERVER andalso start_profile(eprof, [ssl_manager]), + ?PERCEPT_SERVER andalso percept:profile("/tmp/ssl_server.percept"), + Server ! {self(), {init, Host, Port}}, + Test = fun(TSocket) -> + ok = ssl:ssl_accept(TSocket), + ssl:close(TSocket) + end, + setup_server_connection(Socket, Test); +server_init(ssl, payload, Loop, _, Server) -> + {ok, Socket} = ssl:listen(0, ssl_opts(listen)), + {ok, {_Host, Port}} = ssl:sockname(Socket), + {ok, Host} = inet:gethostname(), + Server ! {self(), {init, Host, Port}}, + Test = fun(TSocket) -> + ok = ssl:ssl_accept(TSocket), + Size = byte_size(msg()), + server_echo(TSocket, Size, Loop), + ssl:close(TSocket) + end, + setup_server_connection(Socket, Test); + +server_init(Type, Tc, _, _, Server) -> + io:format("No server init code for ~p ~p~n",[Type, Tc]), + Server ! {self(), no_init}. + +client_init(Master, ssl, setup_connection, Host, Port) -> + Master ! {self(), init}, + {Host, Port, ssl_opts(connect)}; +client_init(Master, ssl, payload, Host, Port) -> + {ok, Sock} = ssl:connect(Host, Port, ssl_opts(connect)), + Master ! {self(), init}, + Size = byte_size(msg()), + {Sock, Size}; +client_init(_Me, Type, Tc, Host, Port) -> + io:format("No client init code for ~p ~p~n",[Type, Tc]), + {Host, Port}. + +setup_server_connection(LSocket, Test) -> + receive quit -> + ?FPROF_SERVER andalso stop_profile(fprof, "test_server_res.fprof"), + ?EPROF_SERVER andalso stop_profile(eprof, "test_server_res.eprof"), + ?PERCEPT_SERVER andalso stop_profile(percept, "/tmp/ssl_server.percept"), + ok + after 0 -> + case ssl:transport_accept(LSocket, 2000) of + {ok, TSocket} -> spawn_link(fun() -> Test(TSocket) end); + {error, timeout} -> ok + end, + setup_server_connection(LSocket, Test) + end. + +server_echo(Socket, Size, Loop) when Loop > 0 -> + {ok, Msg} = ssl:recv(Socket, Size), + ok = ssl:send(Socket, Msg), + server_echo(Socket, Size, Loop-1); +server_echo(_, _, _) -> ok. + +setup_connection(N, ssl, Env = {Host, Port, Opts}) when N > 0 -> + case ssl:connect(Host, Port, Opts) of + {ok, Sock} -> + ssl:close(Sock), + setup_connection(N-1, ssl, Env); + {error, Error} -> + io:format("Error: ~p (~p)~n",[Error, length(erlang:ports())]), + setup_connection(N, ssl, Env) + end; +setup_connection(_, _, _) -> + ok. + +payload(Loop, ssl, D = {Socket, Size}) when Loop > 0 -> + ok = ssl:send(Socket, msg()), + {ok, _} = ssl:recv(Socket, Size), + payload(Loop-1, ssl, D); +payload(_, _, {Socket, _}) -> + ssl:close(Socket). + +msg() -> + <<"Hello", + 0:(512*8), + "asdlkjsafsdfoierwlejsdlkfjsdf", + 1:(512*8), + "asdlkjsafsdfoierwlejsdlkfjsdf">>. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +setup(_Type, nonode@nohost) -> + exit(dist_not_enabled); +setup(Type, _This) -> + Host = case os:getenv(?remote_host) of + false -> + {ok, This} = inet:gethostname(), + This; + RemHost -> + RemHost + end, + Node = list_to_atom("perf_server@" ++ Host), + SlaveArgs = case init:get_argument(pa) of + {ok, PaPaths} -> + lists:append([" -pa " ++ P || [P] <- PaPaths]); + _ -> [] + end, + %% io:format("Slave args: ~p~n",[SlaveArgs]), + Prog = + case os:find_executable("erl") of + false -> "erl"; + P -> P + end, + io:format("Prog = ~p~n", [Prog]), + + case net_adm:ping(Node) of + pong -> ok; + pang -> + {ok, Node} = slave:start(Host, perf_server, SlaveArgs, no_link, Prog) + end, + Path = code:get_path(), + true = rpc:call(Node, code, set_path, [Path]), + ok = rpc:call(Node, ?MODULE, setup_server, [Type, node()]), + io:format("Client (~p) using ~s~n",[node(), code:which(ssl)]), + (Node =:= node()) andalso restrict_schedulers(client), + Node. + +setup_server(_Type, ClientNode) -> + (ClientNode =:= node()) andalso restrict_schedulers(server), + io:format("Server (~p) using ~s~n",[node(), code:which(ssl)]), + ok. + + +ensure_all_started(App, Ack) -> + case application:start(App) of + ok -> {ok, [App|Ack]}; + {error, {not_started, Dep}} -> + {ok, Ack1} = ensure_all_started(Dep, Ack), + ensure_all_started(App, Ack1); + {error, {already_started, _}} -> + {ok, Ack} + end. + +setup_server_init(Type, Tc, Loop, PC) -> + _ = ssl:stop(), + {ok, _} = ensure_all_started(ssl, []), + Me = self(), + Pid = spawn_link(fun() -> server_init(Type, Tc, Loop, PC, Me) end), + Res = receive + {Pid, {init, Host, Port}} -> {ok, {Pid, Host, Port}}; + {Pid, Error} -> {error, Error} + end, + unlink(Pid), + Res. + +restrict_schedulers(Type) -> + %% We expect this to run on 8 core machine + Extra0 = 1, + Extra = if (Type =:= server) -> -Extra0; true -> Extra0 end, + Scheds = erlang:system_info(schedulers), + erlang:system_flag(schedulers_online, (Scheds div 2) + Extra). + +tc(Fun, Mod, Line) -> + case timer:tc(Fun) of + {_,{'EXIT',Reason}} -> + io:format("Process EXITED ~p:~p \n", [Mod, Line]), + exit(Reason); + {_T,R={error,_}} -> + io:format("Process Error ~p:~p \n", [Mod, Line]), + R; + {T,R} -> + io:format("~p:~p: Time: ~p\n", [Mod, Line, T]), + R + end. + +start_profile(eprof, Procs) -> + profiling = eprof:start_profiling(Procs), + io:format("(E)Profiling ...",[]); +start_profile(fprof, Procs) -> + fprof:trace([start, {procs, Procs}]), + io:format("(F)Profiling ...",[]). + +stop_profile(percept, File) -> + percept:stop_profile(), + percept:analyze(File), + {started, _Host, Port} = percept:start_webserver(), + wx:new(), + wx_misc:launchDefaultBrowser("http://" ++ net_adm:localhost() ++ ":" ++ integer_to_list(Port)), + ok; +stop_profile(eprof, File) -> + profiling_stopped = eprof:stop_profiling(), + eprof:log(File), + io:format(".analysed => ~s ~n",[File]), + eprof:analyze(total), + eprof:stop(); +stop_profile(fprof, File) -> + fprof:trace(stop), + io:format("..collect..",[]), + fprof:profile(), + fprof:analyse([{dest, File},{totals, true}]), + io:format(".analysed => ~s ~n",[File]), + fprof:stop(), + ok. + +ssl_opts(listen) -> + [{backlog, 500} | ssl_opts("server")]; +ssl_opts(connect) -> + [{verify, verify_peer} + | ssl_opts("client")]; +ssl_opts(Role) -> + Dir = filename:join([code:lib_dir(ssl), "examples", "certs", "etc"]), + [{active, false}, + {depth, 2}, + {reuseaddr, true}, + {mode,binary}, + {nodelay, true}, + {ciphers, [{dhe_rsa,aes_256_cbc,sha}]}, + {cacertfile, filename:join([Dir, Role, "cacerts.pem"])}, + {certfile, filename:join([Dir, Role, "cert.pem"])}, + {keyfile, filename:join([Dir, Role, "key.pem"])}]. diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 14047c6e9c..b7864ba6e7 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2014. All Rights Reserved. %% %% The 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,6 +58,10 @@ tests() -> server_verify_none, server_require_peer_cert_ok, server_require_peer_cert_fail, + server_require_peer_cert_partial_chain, + server_require_peer_cert_allow_partial_chain, + server_require_peer_cert_do_not_allow_partial_chain, + server_require_peer_cert_partial_chain_fun_fail, verify_fun_always_run_client, verify_fun_always_run_server, cert_expired, @@ -143,8 +147,8 @@ server_verify_none() -> [{doc,"Test server option verify_none"}]. server_verify_none(Config) when is_list(Config) -> - ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), Active = ?config(active, Config), ReceiveFunction = ?config(receive_function, Config), @@ -261,6 +265,163 @@ server_require_peer_cert_fail(Config) when is_list(Config) -> end. %%-------------------------------------------------------------------- + +server_require_peer_cert_partial_chain() -> + [{doc, "Client sends an incompleate chain, by default not acceptable."}]. + +server_require_peer_cert_partial_chain(Config) when is_list(Config) -> + ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true} + | ?config(server_verification_opts, Config)], + ClientOpts = ?config(client_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + {ok, ClientCAs} = file:read_file(proplists:get_value(cacertfile, ClientOpts)), + [{_,RootCA,_}, {_, _, _}] = public_key:pem_decode(ClientCAs), + + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, [{active, false} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, [{active, false}, + {cacerts, [RootCA]} | + proplists:delete(cacertfile, ClientOpts)]}]), + receive + {Server, {error, {tls_alert, "unknown ca"}}} -> + receive + {Client, {error, {tls_alert, "unknown ca"}}} -> + ok; + {Client, {error, closed}} -> + ok + end + end. +%%-------------------------------------------------------------------- +server_require_peer_cert_allow_partial_chain() -> + [{doc, "Server trusts intermediat CA and accepts a partial chain. (partial_chain option)"}]. + +server_require_peer_cert_allow_partial_chain(Config) when is_list(Config) -> + ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true} + | ?config(server_verification_opts, Config)], + ClientOpts = ?config(client_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + {ok, ServerCAs} = file:read_file(proplists:get_value(cacertfile, ServerOpts)), + [{_,_,_}, {_, IntermidiateCA, _}] = public_key:pem_decode(ServerCAs), + + PartialChain = fun(CertChain) -> + case lists:member(IntermidiateCA, CertChain) of + true -> + {trusted_ca, IntermidiateCA}; + false -> + unknown_ca + end + end, + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, [{cacerts, [IntermidiateCA]}, + {partial_chain, PartialChain} | + proplists:delete(cacertfile, ServerOpts)]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ClientOpts}]), + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + %%-------------------------------------------------------------------- +server_require_peer_cert_do_not_allow_partial_chain() -> + [{doc, "Server does not accept the chain sent by the client as ROOT CA is unkown, " + "and we do not choose to trust the intermediate CA. (partial_chain option)"}]. + +server_require_peer_cert_do_not_allow_partial_chain(Config) when is_list(Config) -> + ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true} + | ?config(server_verification_opts, Config)], + ClientOpts = ?config(client_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + {ok, ServerCAs} = file:read_file(proplists:get_value(cacertfile, ServerOpts)), + [{_,_,_}, {_, IntermidiateCA, _}] = public_key:pem_decode(ServerCAs), + + PartialChain = fun(_CertChain) -> + unknown_ca + end, + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, [{cacerts, [IntermidiateCA]}, + {partial_chain, PartialChain} | + proplists:delete(cacertfile, ServerOpts)]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ClientOpts}]), + + receive + {Server, {error, {tls_alert, "unknown ca"}}} -> + receive + {Client, {error, {tls_alert, "unknown ca"}}} -> + ok; + {Client, {error, closed}} -> + ok + end + end. + + %%-------------------------------------------------------------------- +server_require_peer_cert_partial_chain_fun_fail() -> + [{doc, "If parial_chain fun crashes, treat it as if it returned unkown_ca"}]. + +server_require_peer_cert_partial_chain_fun_fail(Config) when is_list(Config) -> + ServerOpts = [{verify, verify_peer}, {fail_if_no_peer_cert, true} + | ?config(server_verification_opts, Config)], + ClientOpts = ?config(client_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + {ok, ServerCAs} = file:read_file(proplists:get_value(cacertfile, ServerOpts)), + [{_,_,_}, {_, IntermidiateCA, _}] = public_key:pem_decode(ServerCAs), + + PartialChain = fun(_CertChain) -> + ture = false %% crash on purpose + end, + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, [{cacerts, [IntermidiateCA]}, + {partial_chain, PartialChain} | + proplists:delete(cacertfile, ServerOpts)]}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ClientOpts}]), + + receive + {Server, {error, {tls_alert, "unknown ca"}}} -> + receive + {Client, {error, {tls_alert, "unknown ca"}}} -> + ok; + {Client, {error, closed}} -> + ok + end + end. + +%%-------------------------------------------------------------------- verify_fun_always_run_client() -> [{doc,"Verify that user verify_fun is always run (for valid and valid_peer not only unknown_extension)"}]. @@ -434,10 +595,16 @@ cert_expired(Config) when is_list(Config) -> Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, - {options, [{verify, verify_peer} | ClientOpts]}]), - - ssl_test_lib:check_result(Server, {error, {tls_alert, "certificate expired"}}, - Client, {error, {tls_alert, "certificate expired"}}). + {options, [{verify, verify_peer} | ClientOpts]}]), + receive + {Client, {error, {tls_alert, "certificate expired"}}} -> + receive + {Server, {error, {tls_alert, "certificate expired"}}} -> + ok; + {Server, {error, closed}} -> + ok + end + end. two_digits_str(N) when N < 10 -> lists:flatten(io_lib:format("0~p", [N])); @@ -632,7 +799,7 @@ no_authority_key_identifier() -> no_authority_key_identifier(Config) when is_list(Config) -> ClientOpts = ?config(client_verification_opts, Config), - ServerOpts = ?config(server_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), PrivDir = ?config(priv_dir, Config), KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), @@ -804,7 +971,7 @@ unknown_server_ca_fail() -> [{doc,"Test that the client fails if the ca is unknown in verify_peer mode"}]. unknown_server_ca_fail(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, {from, self()}, @@ -833,11 +1000,11 @@ unknown_server_ca_fail(Config) when is_list(Config) -> {verify_fun, FunAndState} | ClientOpts]}]), receive - {Server, {error, {tls_alert, "unknown ca"}}} -> + {Client, {error, {tls_alert, "unknown ca"}}} -> receive - {Client, {error, {tls_alert, "unknown ca"}}} -> + {Server, {error, {tls_alert, "unknown ca"}}} -> ok; - {Client, {error, closed}} -> + {Server, {error, closed}} -> ok end end. @@ -848,7 +1015,7 @@ unknown_server_ca_accept_verify_none() -> [{doc,"Test that the client succeds if the ca is unknown in verify_none mode"}]. unknown_server_ca_accept_verify_none(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, @@ -873,7 +1040,7 @@ unknown_server_ca_accept_verify_peer() -> " with a verify_fun that accepts the unknown ca error"}]. unknown_server_ca_accept_verify_peer(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, @@ -912,7 +1079,7 @@ unknown_server_ca_accept_backwardscompatibility() -> [{doc,"Test that old style verify_funs will work"}]. unknown_server_ca_accept_backwardscompatibility(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), - ServerOpts = ?config(server_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl index 45e91786d4..f2dc1b52c1 100644 --- a/lib/ssl/test/ssl_cipher_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_SUITE.erl @@ -86,9 +86,9 @@ aes_decipher_good(Config) when is_list(Config) -> Content = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56, "HELLO\n">>, Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, Version = {3,0}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + {Content, Mac, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version), Version1 = {3,1}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), + {Content, Mac, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1), ok. %%-------------------------------------------------------------------- @@ -110,9 +110,9 @@ aes_decipher_good_tls11(Config) when is_list(Config) -> NextIV = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>>, Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, Version = {3,2}, - {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version), Version1 = {3,2}, - {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), + {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1), ok. %%-------------------------------------------------------------------- @@ -130,11 +130,11 @@ aes_decipher_fail(Config) when is_list(Config) -> 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, Version = {3,0}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + {Content, Mac, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version), 32 = byte_size(Content), 32 = byte_size(Mac), Version1 = {3,1}, - {Content1, Mac1, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), + {Content1, Mac1, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1), 32 = byte_size(Content1), 32 = byte_size(Mac1), ok. @@ -156,10 +156,10 @@ aes_decipher_fail_tls11(Config) when is_list(Config) -> 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, Version = {3,2}, #alert{level = ?FATAL, description = ?BAD_RECORD_MAC} = - ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), + ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version), Version1 = {3,3}, #alert{level = ?FATAL, description = ?BAD_RECORD_MAC} = - ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), + ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1), ok. %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index e5e942ce1b..8dca733526 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -39,6 +39,7 @@ all() -> [decode_hello_handshake, decode_unknown_hello_extension_correctly, encode_single_hello_sni_extension_correctly, decode_single_hello_sni_extension_correctly, + decode_empty_server_sni_correctly, select_proper_tls_1_2_rsa_default_hashsign]. %%-------------------------------------------------------------------- @@ -106,6 +107,13 @@ decode_single_hello_sni_extension_correctly(_Config) -> Decoded = ssl_handshake:decode_hello_extensions(SNI), Exts = Decoded. +decode_empty_server_sni_correctly(_Config) -> + Exts = #hello_extensions{sni = ""}, + SNI = <<?UINT16(?SNI_EXT),?UINT16(0)>>, + Decoded = ssl_handshake:decode_hello_extensions(SNI), + Exts = Decoded. + + select_proper_tls_1_2_rsa_default_hashsign(_Config) -> % RFC 5246 section 7.4.1.4.1 tells to use {sha1,rsa} as default signature_algorithm for RSA key exchanges {sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,3}), diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index c31f6c2d7d..06a41f1260 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -108,8 +108,12 @@ init_customized_session_cache(Type, Config0) -> ssl:stop(), application:load(ssl), application:set_env(ssl, session_cb, ?MODULE), - application:set_env(ssl, session_cb_init_args, [Type]), + application:set_env(ssl, session_cb_init_args, [{type, Type}]), ssl:start(), + catch (end_per_testcase(list_to_atom("session_cache_process" ++ atom_to_list(Type)), + Config)), + ets:new(ssl_test, [named_table, public, set]), + ets:insert(ssl_test, {type, Type}), [{watchdog, Dog} | Config]. end_per_testcase(session_cache_process_list, Config) -> @@ -126,7 +130,11 @@ end_per_testcase(session_cleanup, Config) -> application:unset_env(ssl, session_delay_cleanup_time), application:unset_env(ssl, session_lifetime), end_per_testcase(default_action, Config); -end_per_testcase(_TestCase, Config) -> +end_per_testcase(Case, Config) when Case == session_cache_process_list; + Case == session_cache_process_mnesia -> + ets:delete(ssl_test), + Config; +end_per_testcase(_, Config) -> Config. %%-------------------------------------------------------------------- @@ -164,12 +172,13 @@ session_cleanup(Config)when is_list(Config) -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), - Cache = element(2, State), - SessionTimer = element(6, State), + ClientCache = element(2, State), + ServerCache = element(3, State), + SessionTimer = element(7, State), Id = proplists:get_value(session_id, SessionInfo), - CSession = ssl_session_cache:lookup(Cache, {{Hostname, Port}, Id}), - SSession = ssl_session_cache:lookup(Cache, {Port, Id}), + CSession = ssl_session_cache:lookup(ClientCache, {{Hostname, Port}, Id}), + SSession = ssl_session_cache:lookup(ServerCache, {Port, Id}), true = CSession =/= undefined, true = SSession =/= undefined, @@ -185,8 +194,8 @@ session_cleanup(Config)when is_list(Config) -> ct:sleep(?SLEEP), %% Make sure clean has had time to run - undefined = ssl_session_cache:lookup(Cache, {{Hostname, Port}, Id}), - undefined = ssl_session_cache:lookup(Cache, {Port, Id}), + undefined = ssl_session_cache:lookup(ClientCache, {{Hostname, Port}, Id}), + undefined = ssl_session_cache:lookup(ServerCache, {Port, Id}), process_flag(trap_exit, false), ssl_test_lib:close(Server), @@ -208,7 +217,7 @@ get_delay_timers() -> {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), - case element(7, State) of + case element(8, State) of {undefined, undefined} -> ct:sleep(?SLEEP), get_delay_timers(); @@ -236,16 +245,16 @@ session_cache_process_mnesia(Config) when is_list(Config) -> %%% Session cache API callbacks %%-------------------------------------------------------------------- -init([Type]) -> - ets:new(ssl_test, [named_table, public, set]), - ets:insert(ssl_test, {type, Type}), - case Type of +init(Opts) -> + case proplists:get_value(type, Opts) of list -> spawn(fun() -> session_loop([]) end); mnesia -> mnesia:start(), - {atomic,ok} = mnesia:create_table(sess_cache, []), - sess_cache + Name = atom_to_list(proplists:get_value(role, Opts)), + TabName = list_to_atom(Name ++ "sess_cache"), + {atomic,ok} = mnesia:create_table(TabName, []), + TabName end. session_cb() -> @@ -258,7 +267,7 @@ terminate(Cache) -> Cache ! terminate; mnesia -> catch {atomic,ok} = - mnesia:delete_table(sess_cache) + mnesia:delete_table(Cache) end. lookup(Cache, Key) -> @@ -268,10 +277,10 @@ lookup(Cache, Key) -> receive {Cache, Res} -> Res end; mnesia -> case mnesia:transaction(fun() -> - mnesia:read(sess_cache, + mnesia:read(Cache, Key, read) end) of - {atomic, [{sess_cache, Key, Value}]} -> + {atomic, [{Cache, Key, Value}]} -> Value; _ -> undefined @@ -285,8 +294,8 @@ update(Cache, Key, Value) -> mnesia -> {atomic, ok} = mnesia:transaction(fun() -> - mnesia:write(sess_cache, - {sess_cache, Key, Value}, write) + mnesia:write(Cache, + {Cache, Key, Value}, write) end) end. @@ -297,7 +306,7 @@ delete(Cache, Key) -> mnesia -> {atomic, ok} = mnesia:transaction(fun() -> - mnesia:delete(sess_cache, Key) + mnesia:delete(Cache, Key) end) end. @@ -308,7 +317,7 @@ foldl(Fun, Acc, Cache) -> receive {Cache, Res} -> Res end; mnesia -> Foldl = fun() -> - mnesia:foldl(Fun, Acc, sess_cache) + mnesia:foldl(Fun, Acc, Cache) end, {atomic, Res} = mnesia:transaction(Foldl), Res @@ -325,7 +334,7 @@ select_session(Cache, PartialKey) -> mnesia -> Sel = fun() -> mnesia:select(Cache, - [{{sess_cache,{PartialKey,'$1'}, '$2'}, + [{{Cache,{PartialKey,'$1'}, '$2'}, [],['$$']}]) end, {atomic, Res} = mnesia:transaction(Sel), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 150b5037d7..d2e6e41482 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -450,7 +450,7 @@ make_ecdsa_cert(Config) -> {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, {server_ecdsa_verify_opts, [{ssl_imp, new},{reuseaddr, true}, - {cacertfile, ClientCaCertFile}, + {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {verify, verify_peer}]}, {client_ecdsa_opts, [{ssl_imp, new},{reuseaddr, true}, @@ -475,7 +475,7 @@ make_ecdh_rsa_cert(Config) -> {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, {server_ecdh_rsa_verify_opts, [{ssl_imp, new},{reuseaddr, true}, - {cacertfile, ClientCaCertFile}, + {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {verify, verify_peer}]}, {client_ecdh_rsa_opts, [{ssl_imp, new},{reuseaddr, true}, @@ -811,48 +811,34 @@ openssl_rsa_suites(CounterPart) -> false -> "DSS | ECDHE | ECDH" end, - lists:filter(fun(Str) -> - case re:run(Str, Names,[]) of - nomatch -> - false; - _ -> - true - end - end, Ciphers). + lists:filter(fun(Str) -> string_regex_filter(Str, Names) + end, Ciphers). openssl_dsa_suites() -> Ciphers = ssl:cipher_suites(openssl), - lists:filter(fun(Str) -> - case re:run(Str,"DSS",[]) of - nomatch -> - false; - _ -> - true - end + lists:filter(fun(Str) -> string_regex_filter(Str, "DSS") 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 + lists:filter(fun(Str) -> string_regex_filter(Str, "ECDHE-ECDSA") 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 + lists:filter(fun(Str) -> string_regex_filter(Str, "ECDH-RSA") end, Ciphers). +string_regex_filter(Str, Search) when is_list(Str) -> + case re:run(Str, Search, []) of + nomatch -> + false; + _ -> + true + end; +string_regex_filter(Str, _Search) -> + false. + anonymous_suites() -> Suites = [{dh_anon, rc4_128, md5}, @@ -860,6 +846,8 @@ anonymous_suites() -> {dh_anon, '3des_ede_cbc', sha}, {dh_anon, aes_128_cbc, sha}, {dh_anon, aes_256_cbc, sha}, + {dh_anon, aes_128_gcm, null}, + {dh_anon, aes_256_gcm, null}, {ecdh_anon,rc4_128,sha}, {ecdh_anon,'3des_ede_cbc',sha}, {ecdh_anon,aes_128_cbc,sha}, @@ -885,8 +873,13 @@ psk_suites() -> {rsa_psk, aes_128_cbc, sha}, {rsa_psk, aes_256_cbc, sha}, {rsa_psk, aes_128_cbc, sha256}, - {rsa_psk, aes_256_cbc, sha384} -], + {rsa_psk, aes_256_cbc, sha384}, + {psk, aes_128_gcm, null}, + {psk, aes_256_gcm, null}, + {dhe_psk, aes_128_gcm, null}, + {dhe_psk, aes_256_gcm, null}, + {rsa_psk, aes_128_gcm, null}, + {rsa_psk, aes_256_gcm, null}], ssl_cipher:filter_suites(Suites). psk_anon_suites() -> @@ -1130,9 +1123,42 @@ version_flag(sslv3) -> filter_suites(Ciphers0) -> Version = tls_record:highest_protocol_version([]), Supported0 = ssl_cipher:suites(Version) - ++ ssl_cipher:anonymous_suites() + ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) ++ ssl_cipher:srp_suites(), Supported1 = ssl_cipher:filter_suites(Supported0), Supported2 = [ssl:suite_definition(S) || S <- Supported1], [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported2)]. + +-define(OPENSSL_QUIT, "Q\n"). +close_port(Port) -> + catch port_command(Port, ?OPENSSL_QUIT), + close_loop(Port, 500, false). + +close_loop(Port, Time, SentClose) -> + receive + {Port, {data,Debug}} when is_port(Port) -> + ct:log("openssl ~s~n",[Debug]), + close_loop(Port, Time, SentClose); + {ssl,_,Msg} -> + ct:log("ssl Msg ~s~n",[Msg]), + close_loop(Port, Time, SentClose); + {Port, closed} -> + ct:log("Port Closed~n",[]), + ok; + {'EXIT', Port, Reason} -> + ct:log("Port Closed ~p~n",[Reason]), + ok; + Msg -> + ct:log("Port Msg ~p~n",[Msg]), + close_loop(Port, Time, SentClose) + after Time -> + case SentClose of + false -> + ct:log("Closing port ~n",[]), + catch erlang:port_close(Port), + close_loop(Port, Time, true); + true -> + ct:log("Timeout~n",[]) + end + end. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index d36e441c7a..942c446ec4 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -226,7 +226,7 @@ basic_erlang_client_openssl_server(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). @@ -259,7 +259,7 @@ basic_erlang_server_openssl_client(Config) when is_list(Config) -> %% Clean close down! Server needs to be closed first !! ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false), ok. %%-------------------------------------------------------------------- @@ -298,7 +298,7 @@ erlang_client_openssl_server(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). @@ -332,11 +332,9 @@ erlang_server_openssl_client(Config) when is_list(Config) -> %% Clean close down! Server needs to be closed first !! ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). -%%-------------------------------------------------------------------- - erlang_client_openssl_server_dsa_cert() -> [{doc,"Test erlang server with openssl client"}]. erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) -> @@ -376,7 +374,7 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false), ok. @@ -414,7 +412,7 @@ erlang_server_openssl_client_dsa_cert(Config) when is_list(Config) -> %% Clean close down! Server needs to be closed first !! ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). %%-------------------------------------------------------------------- @@ -450,7 +448,7 @@ erlang_server_openssl_client_reuse_session(Config) when is_list(Config) -> %% Clean close down! Server needs to be closed first !! ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false), ok. @@ -496,7 +494,7 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false), ok. @@ -542,7 +540,7 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). %%-------------------------------------------------------------------- @@ -581,7 +579,7 @@ erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) -> %% Clean close down! Server needs to be closed first !! ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). %%-------------------------------------------------------------------- @@ -624,7 +622,7 @@ erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). @@ -666,7 +664,7 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). @@ -708,7 +706,7 @@ erlang_server_openssl_client_client_cert(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), ssl_test_lib:close(Server), process_flag(trap_exit, false). @@ -821,7 +819,7 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> [{versions, [Version]} | ClientOpts]}]), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client1), process_flag(trap_exit, false), ok. @@ -878,7 +876,7 @@ expired_session(Config) when is_list(Config) -> {from, self()}, {options, ClientOpts}]), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client2), process_flag(trap_exit, false). @@ -1089,7 +1087,7 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> Result = ssl_test_lib:wait_for_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), ssl_test_lib:close(Client), Return = case Result of @@ -1136,7 +1134,7 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens Callback(Client, OpensslPort), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). @@ -1175,7 +1173,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac Callback(Client, OpensslPort), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). @@ -1205,7 +1203,7 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). @@ -1234,7 +1232,7 @@ start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenS ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). @@ -1282,39 +1280,6 @@ delayed_send(Socket, [ErlData, OpenSslData]) -> ssl:send(Socket, ErlData), erlang_ssl_receive(Socket, OpenSslData). -close_port(Port) -> - catch port_command(Port, ?OPENSSL_QUIT), - close_loop(Port, 500, false). - -close_loop(Port, Time, SentClose) -> - receive - {Port, {data,Debug}} when is_port(Port) -> - ct:log("openssl ~s~n",[Debug]), - close_loop(Port, Time, SentClose); - {ssl,_,Msg} -> - ct:log("ssl Msg ~s~n",[Msg]), - close_loop(Port, Time, SentClose); - {Port, closed} -> - ct:log("Port Closed~n",[]), - ok; - {'EXIT', Port, Reason} -> - ct:log("Port Closed ~p~n",[Reason]), - ok; - Msg -> - ct:log("Port Msg ~p~n",[Msg]), - close_loop(Port, Time, SentClose) - after Time -> - case SentClose of - false -> - ct:log("Closing port ~n",[]), - catch erlang:port_close(Port), - close_loop(Port, Time, true); - true -> - ct:log("Timeout~n",[]) - end - end. - - server_sent_garbage(Socket) -> receive server_sent_garbage -> diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 004cacf7fc..da20ed8593 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 5.3.5 +SSL_VSN = 5.3.7 diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile index ff77c3eea0..f5d8b2072a 100644 --- a/lib/stdlib/doc/src/Makefile +++ b/lib/stdlib/doc/src/Makefile @@ -76,7 +76,6 @@ XML_REF3_FILES = \ ms_transform.xml \ orddict.xml \ ordsets.xml \ - pg.xml \ pool.xml \ proc_lib.xml \ proplists.xml \ diff --git a/lib/stdlib/doc/src/binary.xml b/lib/stdlib/doc/src/binary.xml index 2410f1f9b8..0fde763bfb 100644 --- a/lib/stdlib/doc/src/binary.xml +++ b/lib/stdlib/doc/src/binary.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2009</year> - <year>2013</year> + <year>2014</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -450,7 +450,7 @@ store(Binary, GBSet) -> </code> <p>In this example, we chose to copy the binary content before - inserting it in the <c>gb_set()</c> if it references a binary more than + inserting it in the <c>gb_sets:set()</c> if it references a binary more than twice the size of the data we're going to keep. Of course different rules for when copying will apply to different programs.</p> diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml index b9dfff833e..5c96d6e576 100644 --- a/lib/stdlib/doc/src/gen_event.xml +++ b/lib/stdlib/doc/src/gen_event.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -44,6 +44,7 @@ <pre> gen_event module Callback module ---------------- --------------- +gen_event:start gen_event:start_link -----> - gen_event:add_handler @@ -177,7 +178,7 @@ gen_event:stop -----> Module:terminate/2 <name>add_handler(EventMgrRef, Handler, Args) -> Result</name> <fsummary>Add an event handler to a generic event manager.</fsummary> <type> - <v>EventMgr = Name | {Name,Node} | {global,GlobalName} + <v>EventMgrRef = Name | {Name,Node} | {global,GlobalName} | {via,Module,ViaName} | pid()</v> <v> Name = Node = atom()</v> <v> GlobalName = ViaName = term()</v> @@ -223,7 +224,7 @@ gen_event:stop -----> Module:terminate/2 <name>add_sup_handler(EventMgrRef, Handler, Args) -> Result</name> <fsummary>Add a supervised event handler to a generic event manager.</fsummary> <type> - <v>EventMgr = Name | {Name,Node} | {global,GlobalName} + <v>EventMgrRef = Name | {Name,Node} | {global,GlobalName} | {via,Module,ViaName} | pid()</v> <v> Name = Node = atom()</v> <v> GlobalName = ViaName = term()</v> @@ -456,19 +457,37 @@ gen_event:stop -----> Module:terminate/2 </func> <func> <name>stop(EventMgrRef) -> ok</name> + <name>stop(EventMgrRef, Reason, Timeout) -> ok</name> <fsummary>Terminate a generic event manager.</fsummary> <type> <v>EventMgrRef = Name | {Name,Node} | {global,GlobalName} | {via,Module,ViaName} | pid()</v> <v>Name = Node = atom()</v> <v>GlobalName = ViaName = term()</v> + <v>Reason = term()</v> + <v>Timeout = int()>0 | infinity</v> </type> <desc> - <p>Terminates the event manager <c>EventMgrRef</c>. Before - terminating, the event manager will call - <c>Module:terminate(stop,...)</c> for each installed event - handler.</p> - <p>See <c>add_handler/3</c> for a description of the argument.</p> + <p>Orders the event manager <c>EventMgrRef</c> to exit with + the given <c>Reason</c> and waits for it to + terminate. Before terminating, the gen_event will call + <seealso marker="#Module:terminate/2">Module:terminate(stop,...)</seealso> + for each installed event handler.</p> + <p>The function returns <c>ok</c> if the event manager terminates + with the expected reason. Any other reason than <c>normal</c>, + <c>shutdown</c>, or <c>{shutdown,Term}</c> will cause an + error report to be issued using + <seealso marker="kernel:error_logger#format/2">error_logger:format/2</seealso>. + The default <c>Reason</c> is <c>normal</c>.</p> + <p><c>Timeout</c> is an integer greater than zero which + specifies how many milliseconds to wait for the event manager to + terminate, or the atom <c>infinity</c> to wait + indefinitely. The default value is <c>infinity</c>. If the + event manager has not terminated within the specified time, a + <c>timeout</c> exception is raised.</p> + <p>If the process does not exist, a <c>noproc</c> exception + is raised.</p> + <p>See <c>add_handler/3</c> for a description of <c>EventMgrRef</c>.</p> </desc> </func> </funcs> diff --git a/lib/stdlib/doc/src/gen_fsm.xml b/lib/stdlib/doc/src/gen_fsm.xml index 848d57f3e6..b1bba3eff0 100644 --- a/lib/stdlib/doc/src/gen_fsm.xml +++ b/lib/stdlib/doc/src/gen_fsm.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -43,8 +43,11 @@ <pre> gen_fsm module Callback module -------------- --------------- +gen_fsm:start gen_fsm:start_link -----> Module:init/1 +gen_fsm:stop -----> Module:terminate/3 + gen_fsm:send_event -----> Module:StateName/2 gen_fsm:send_all_state_event -----> Module:handle_event/3 @@ -187,6 +190,39 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 </desc> </func> <func> + <name>stop(FsmRef) -> ok</name> + <name>stop(FsmRef, Reason, Timeout) -> ok</name> + <fsummary>Synchronously stop a generic FSM.</fsummary> + <type> + <v>FsmRef = Name | {Name,Node} | {global,GlobalName} + | {via,Module,ViaName} | pid()</v> + <v> Node = atom()</v> + <v> GlobalName = ViaName = term()</v> + <v>Reason = term()</v> + <v>Timeout = int()>0 | infinity</v> + </type> + <desc> + <p>Orders a generic FSM to exit with the given <c>Reason</c> + and waits for it to terminate. The gen_fsm will call + <seealso marker="#Module:terminate/3">Module:terminate/3</seealso> + before exiting.</p> + <p>The function returns <c>ok</c> if the generic FSM terminates + with the expected reason. Any other reason than <c>normal</c>, + <c>shutdown</c>, or <c>{shutdown,Term}</c> will cause an + error report to be issued using + <seealso marker="kernel:error_logger#format/2">error_logger:format/2</seealso>. + The default <c>Reason</c> is <c>normal</c>.</p> + <p><c>Timeout</c> is an integer greater than zero which + specifies how many milliseconds to wait for the generic FSM + to terminate, or the atom <c>infinity</c> to wait + indefinitely. The default value is <c>infinity</c>. If the + generic FSM has not terminated within the specified time, a + <c>timeout</c> exception is raised.</p> + <p>If the process does not exist, a <c>noproc</c> exception + is raised.</p> + </desc> + </func> + <func> <name>send_event(FsmRef, Event) -> ok</name> <fsummary>Send an event asynchronously to a generic FSM.</fsummary> <type> @@ -528,7 +564,8 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 <c>Module:init/1</c> for a description of <c>Timeout</c> and <c>hibernate</c>.</p> <p>If the function returns <c>{stop,Reason,NewStateData}</c>, the gen_fsm will call - <c>Module:terminate(Reason,NewStateData)</c> and terminate.</p> + <c>Module:terminate(Reason,StateName,NewStateData)</c> and + terminate.</p> </desc> </func> <func> @@ -614,7 +651,8 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 <c>{stop,Reason,NewStateData}</c>, any reply to <c>From</c> must be given explicitly using <c>gen_fsm:reply/2</c>. The gen_fsm will then call - <c>Module:terminate(Reason,NewStateData)</c> and terminate.</p> + <c>Module:terminate(Reason,StateName,NewStateData)</c> and + terminate.</p> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index 62c0394479..a915e567a5 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -43,8 +43,11 @@ <pre> gen_server module Callback module ----------------- --------------- +gen_server:start gen_server:start_link -----> Module:init/1 +gen_server:stop -----> Module:terminate/2 + gen_server:call gen_server:multi_call -----> Module:handle_call/3 @@ -184,6 +187,40 @@ gen_server:abcast -----> Module:handle_cast/2 </desc> </func> <func> + <name>stop(ServerRef) -> ok</name> + <name>stop(ServerRef, Reason, Timeout) -> ok</name> + <fsummary>Synchronously stop a generic server.</fsummary> + <type> + <v>ServerRef = Name | {Name,Node} | {global,GlobalName} + | {via,Module,ViaName} | pid()</v> + <v> Node = atom()</v> + <v> GlobalName = ViaName = term()</v> + <v>Reason = term()</v> + <v>Timeout = int()>0 | infinity</v> + </type> + <desc> + <p>Orders a generic server to exit with the + given <c>Reason</c> and waits for it to terminate. The + gen_server will call + <seealso marker="#Module:terminate/2">Module:terminate/2</seealso> + before exiting.</p> + <p>The function returns <c>ok</c> if the server terminates + with the expected reason. Any other reason than <c>normal</c>, + <c>shutdown</c>, or <c>{shutdown,Term}</c> will cause an + error report to be issued using + <seealso marker="kernel:error_logger#format/2">error_logger:format/2</seealso>. + The default <c>Reason</c> is <c>normal</c>.</p> + <p><c>Timeout</c> is an integer greater than zero which + specifies how many milliseconds to wait for the server to + terminate, or the atom <c>infinity</c> to wait + indefinitely. The default value is <c>infinity</c>. If the + server has not terminated within the specified time, a + <c>timeout</c> exception is raised.</p> + <p>If the process does not exist, a <c>noproc</c> exception + is raised.</p> + </desc> + </func> + <func> <name>call(ServerRef, Request) -> Reply</name> <name>call(ServerRef, Request, Timeout) -> Reply</name> <fsummary>Make a synchronous call to a generic server.</fsummary> diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml index b37f7fd7fd..64229fa8d3 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -319,6 +319,23 @@ false</code> </func> <func> + <name name="with" arity="2"/> + <fsummary></fsummary> + <desc> + <p> + Returns a new map <c><anno>Map2</anno></c> with the keys <c>K1</c> through <c>Kn</c> and their associated values from map <c><anno>Map1</anno></c>. + Any key in <c><anno>Ks</anno></c> that does not exist in <c><anno>Map1</anno></c> are ignored. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{42 => value_three,1337 => "value two","a" => 1}, + Ks = ["a",42,"other key"], + maps:without(Ks,Map). +#{42 => value_three,"a" => 1}</code> + </desc> + </func> + + <func> <name name="without" arity="2"/> <fsummary></fsummary> <desc> diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index 5e74616099..ebc750a399 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -30,6 +30,79 @@ </header> <p>This document describes the changes made to the STDLIB application.</p> +<section><title>STDLIB 2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The type spec of the FormFunc argument to + sys:handle_debug/4 was erroneously pointing to dbg_fun(). + This is now corrected and the new type is format_fun().</p> + <p> + Own Id: OTP-11800</p> + </item> + <item> + <p> + Behaviors such as gen_fsm and gen_server should always + invoke format_status/2 before printing the state to the + logs.</p> + <p> + Own Id: OTP-11967</p> + </item> + <item> + <p> The documentation of <c>dets:insert_new/2</c> has + been corrected. (Thanks to Alexei Sholik for reporting + the bug.) </p> + <p> + Own Id: OTP-12024</p> + </item> + <item> + <p> + Printing a term with io_lib:format and control sequence + w, precision P and field width F, where F< P would + fail in one of the two following ways:</p> + <p> + 1) If P < printed length of the term, an infinite loop + would be entered, consuming all available memory.</p> + <p> + 2) If P >= printed length of the term, an exception + would be raised.</p> + <p> + These two problems are now corrected.</p> + <p> + Own Id: OTP-12041</p> + </item> + <item> + <p> + The documentation of <c>maps:values/1</c> has been + corrected.</p> + <p> + Own Id: OTP-12055</p> + </item> + <item> + <p> + Expand shell functions in map expressions.</p> + <p> + Own Id: OTP-12063</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add maps:with/2</p> + <p> + Own Id: OTP-12137</p> + </item> + </list> + </section> + +</section> + <section><title>STDLIB 2.1.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/stdlib/doc/src/pg.xml b/lib/stdlib/doc/src/pg.xml deleted file mode 100644 index a3b69884b6..0000000000 --- a/lib/stdlib/doc/src/pg.xml +++ /dev/null @@ -1,114 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>1996</year> - <year>2014</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>pg</title> - <prepared></prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <module>pg</module> - <modulesummary>Distributed, Named Process Groups</modulesummary> - <description> - <warning> - <p>This module is deprecated and will be removed in Erlang/OTP 18.</p> - </warning> - <p>This (experimental) module implements process groups. A process - group is a group of processes that can be accessed by a common - name. For example, a group named <c>foobar</c> can include a set - of processes as members of this group and they can be located on - different nodes.</p> - <p>When messages are sent to the named group, all members of - the group receive the message. The messages are serialized. If - the process <c>P1</c> sends the message <c>M1</c> to the group, - and process <c>P2</c> simultaneously sends message <c>M2</c>, then - all members of the group receive the two messages in the same - order. If members of a group terminate, they are automatically - removed from the group.</p> - <p>This module is not complete. The module is inspired by the ISIS - system and the causal order protocol of the ISIS system should - also be implemented. At the moment, all messages are serialized - by sending them through a group master process.</p> - </description> - <funcs> - <func> - <name name="create" arity="1"/> - <fsummary>Create an empty group</fsummary> - <desc> - <p>Creates an empty group named <c><anno>PgName</anno></c> on the current - node.</p> - </desc> - </func> - <func> - <name name="create" arity="2"/> - <fsummary>Create an empty group on another node</fsummary> - <desc> - <p>Creates an empty group named <c><anno>PgName</anno></c> on the node - <c><anno>Node</anno></c>.</p> - </desc> - </func> - <func> - <name name="join" arity="2"/> - <fsummary>Join a pid to a process group</fsummary> - <desc> - <p>Joins the pid <c><anno>Pid</anno></c> to the process group - <c><anno>PgName</anno></c>. - Returns a list of all old members of the group.</p> - </desc> - </func> - <func> - <name name="send" arity="2"/> - <fsummary>Send a message to all members of a process group</fsummary> - <desc> - <p>Sends the tuple <c>{pg_message, From, PgName, Msg}</c> to - all members of the process group <c><anno>PgName</anno></c>.</p> - <p>Failure: <c>{badarg, {<anno>PgName</anno>, <anno>Msg</anno>}}</c> - if <c><anno>PgName</anno></c> is - not a process group (a globally registered name).</p> - </desc> - </func> - <func> - <name name="esend" arity="2"/> - <fsummary>Send a message to all members of a process group, except ourselves</fsummary> - <desc> - <p>Sends the tuple <c>{pg_message, From, PgName, Msg}</c> to - all members of the process group <c><anno>PgName</anno></c>, except - ourselves.</p> - <p>Failure: <c>{badarg, {<anno>PgName</anno>, <anno>Msg</anno>}}</c> - if <c><anno>PgName</anno></c> is - not a process group (a globally registered name).</p> - </desc> - </func> - <func> - <name name="members" arity="1"/> - <fsummary>Return a list of all members of a process group</fsummary> - <desc> - <p>Returns a list of all members of the process group - <c>PgName</c>.</p> - </desc> - </func> - </funcs> -</erlref> - diff --git a/lib/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml index 5bf5744622..f27a974242 100644 --- a/lib/stdlib/doc/src/proc_lib.xml +++ b/lib/stdlib/doc/src/proc_lib.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -298,6 +298,40 @@ init(Parent) -> <c>proc_lib</c> functions.</p> </desc> </func> + <func> + <name name="stop" arity="1"/> + <fsummary>Terminate a process synchronously.</fsummary> + <type variable="Process"/> + <desc> + <p>Equivalent to <seealso marker="#stop/3">stop(Process, + normal, infinity)</seealso>.</p> + </desc> + </func> + <func> + <name name="stop" arity="3"/> + <fsummary>Terminate a process synchronously.</fsummary> + <type variable="Process"/> + <type variable="Reason"/> + <type variable="Timeout"/> + <desc> + <p>Orders the process to exit with the given <c>Reason</c> and + waits for it to terminate.</p> + <p>The function returns <c>ok</c> if the process exits with + the given <c>Reason</c> within <c>Timeout</c> + milliseconds.</p> + <p>If the call times out, a <c>timeout</c> exception is + raised.</p> + <p>If the process does not exist, a <c>noproc</c> + exception is raised.</p> + <p>The implementation of this function is based on the + <c>terminate</c> system message, and requires that the + process handles system messages correctly. + See <seealso marker="sys">sys(3)</seealso> + and <seealso marker="doc/design_principles:spec_proc">OTP + Design Principles</seealso> for information about system + messages.</p> + </desc> + </func> </funcs> <section> diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml index 6c35578bdf..ea4009dc3e 100644 --- a/lib/stdlib/doc/src/ref_man.xml +++ b/lib/stdlib/doc/src/ref_man.xml @@ -73,7 +73,6 @@ <xi:include href="ms_transform.xml"/> <xi:include href="orddict.xml"/> <xi:include href="ordsets.xml"/> - <xi:include href="pg.xml"/> <xi:include href="pool.xml"/> <xi:include href="proc_lib.xml"/> <xi:include href="proplists.xml"/> diff --git a/lib/stdlib/doc/src/specs.xml b/lib/stdlib/doc/src/specs.xml index 60a04ed5e7..fd77b52da6 100644 --- a/lib/stdlib/doc/src/specs.xml +++ b/lib/stdlib/doc/src/specs.xml @@ -39,7 +39,6 @@ <xi:include href="../specs/specs_ms_transform.xml"/> <xi:include href="../specs/specs_orddict.xml"/> <xi:include href="../specs/specs_ordsets.xml"/> - <xi:include href="../specs/specs_pg.xml"/> <xi:include href="../specs/specs_pool.xml"/> <xi:include href="../specs/specs_proc_lib.xml"/> <xi:include href="../specs/specs_proplists.xml"/> diff --git a/lib/stdlib/doc/src/string.xml b/lib/stdlib/doc/src/string.xml index c96cc95a44..b05d5cbc08 100644 --- a/lib/stdlib/doc/src/string.xml +++ b/lib/stdlib/doc/src/string.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -124,6 +124,10 @@ <code type="none"> > tokens("abc defxxghix jkl", "x "). ["abc", "def", "ghi", "jkl"] </code> + <p>Note that, as shown in the example above, two or more + adjacent separator characters in <c><anno>String</anno></c> + will be treated as one. That is, there will not be any empty + strings in the resulting list of tokens.</p> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml index 19605f325b..cf7df54d1d 100644 --- a/lib/stdlib/doc/src/sys.xml +++ b/lib/stdlib/doc/src/sys.xml @@ -359,6 +359,17 @@ installed.</p> </desc> </func> + <func> + <name name="terminate" arity="2"/> + <name name="terminate" arity="3"/> + <fsummary>Terminate the process</fsummary> + <desc> + <p>This function orders the process to terminate with the + given <c><anno>Reason</anno></c>. The termination is done + asynchronously, so there is no guarantee that the process is + actually terminated when the function returns.</p> + </desc> + </func> </funcs> <section> diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile index 9ab2cd4134..1b3744b6fb 100644 --- a/lib/stdlib/src/Makefile +++ b/lib/stdlib/src/Makefile @@ -97,7 +97,6 @@ MODULES= \ otp_internal \ orddict \ ordsets \ - pg \ re \ pool \ proc_lib \ diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 76e03bbfaa..a4bd45ea19 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -2839,17 +2839,22 @@ fsck_try(Fd, Tab, FH, Fname, SlotNumbers, Version) -> tempfile(Fname) -> Tmp = lists:concat([Fname, ".TMP"]), - tempfile(Tmp, 10). - -tempfile(Tmp, 0) -> - Tmp; -tempfile(Tmp, N) -> case file:delete(Tmp) of - {error, eacces} -> % 'dets_process_died' happened anyway... (W-nd-ws) - timer:sleep(1000), - tempfile(Tmp, N-1); - _ -> - Tmp + {error, _Reason} -> % typically enoent + ok; + ok -> + assure_no_file(Tmp) + end, + Tmp. + +assure_no_file(File) -> + case file:read_file_info(File) of + {ok, _FileInfo} -> + %% Wait for some other process to close the file: + timer:sleep(100), + assure_no_file(File); + {error, _} -> + ok end. %% -> {ok, NewHead} | {try_again, integer()} | Error diff --git a/lib/stdlib/src/dets_server.erl b/lib/stdlib/src/dets_server.erl index 268c201047..3164d40f35 100644 --- a/lib/stdlib/src/dets_server.erl +++ b/lib/stdlib/src/dets_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -171,9 +171,15 @@ handle_info({pending_reply, {Ref, Result0}}, State) -> link(Pid), do_link(Store, FromPid), true = ets:insert(Store, {FromPid, Tab}), - true = ets:insert(?REGISTRY, {Tab, 1, Pid}), - true = ets:insert(?OWNERS, {Pid, Tab}), + %% do_internal_open() has already done the following: + %% true = ets:insert(?REGISTRY, {Tab, 1, Pid}), + %% true = ets:insert(?OWNERS, {Pid, Tab}), {ok, Tab}; + {Reply, internal_open} -> + %% Clean up what do_internal_open() did: + true = ets:delete(?REGISTRY, Tab), + true = ets:delete(?OWNERS, Pid), + Reply; {Reply, _} -> % ok or Error Reply end, @@ -309,6 +315,12 @@ do_internal_open(State, From, Args) -> [T, _, _] -> T; [_, _] -> Ref end, + %% Pretend the table is open. If someone else tries to + %% open the file it will always become a pending + %% 'add_user' request. If someone tries to use the table + %% there will be a delay, but that is OK. + true = ets:insert(?REGISTRY, {Tab, 1, Pid}), + true = ets:insert(?OWNERS, {Pid, Tab}), pending_call(Tab, Pid, Ref, From, Args, internal_open, State); Error -> {Error, State} diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index be9a4f5107..b3bc5f6d92 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -390,7 +390,7 @@ do_op(end_of_line, Bef, [C|Aft], Rs) -> do_op(end_of_line, Bef, [], Rs) -> {{Bef,[]},Rs}; do_op(ctlu, Bef, Aft, Rs) -> - put(kill_buffer, Bef), + put(kill_buffer, reverse(Bef)), {{[], Aft}, [{delete_chars, -length(Bef)} | Rs]}; do_op(beep, Bef, Aft, Rs) -> {{Bef,Aft},[beep|Rs]}; diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 639ddfc214..371573dc23 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1172,7 +1172,7 @@ match_tuple([], _, _, Bs, _BBs) -> match_map([{map_field_exact, _, K, V}|Fs], Map, Bs0, BBs) -> Vm = try - {value, Ke, _} = expr(K, new_bindings()), + {value, Ke, _} = expr(K, Bs0), maps:get(Ke,Map) catch error:_ -> throw(nomatch) diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index edfb097de0..2bf8b86c23 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -51,6 +51,8 @@ type_test/2,new_type_test/2,old_type_test/2,old_bif/2]). -export([arith_op/2,bool_op/2,comp_op/2,list_op/2,send_op/2,op_type/2]). +-export([is_type/2]). + %%--------------------------------------------------------------------------- %% Erlang builtin functions allowed in guards. @@ -293,6 +295,7 @@ bif(garbage_collect, 1) -> true; bif(garbage_collect, 2) -> true; bif(get, 0) -> true; bif(get, 1) -> true; +bif(get_keys, 0) -> true; bif(get_keys, 1) -> true; bif(group_leader, 0) -> true; bif(group_leader, 2) -> true; @@ -530,3 +533,53 @@ old_bif(unlink, 1) -> true; old_bif(unregister, 1) -> true; old_bif(whereis, 1) -> true; old_bif(Name, A) when is_atom(Name), is_integer(A) -> false. + +-spec is_type(Name, NumberOfTypeVariables) -> boolean() when + Name :: atom(), + NumberOfTypeVariables :: non_neg_integer(). +%% Returns true if Name/NumberOfTypeVariables is a predefined type. + +is_type(any, 0) -> true; +is_type(arity, 0) -> true; +is_type(atom, 0) -> true; +is_type(binary, 0) -> true; +is_type(bitstring, 0) -> true; +is_type(bool, 0) -> true; +is_type(boolean, 0) -> true; +is_type(byte, 0) -> true; +is_type(char, 0) -> true; +is_type(float, 0) -> true; +is_type(function, 0) -> true; +is_type(identifier, 0) -> true; +is_type(integer, 0) -> true; +is_type(iodata, 0) -> true; +is_type(iolist, 0) -> true; +is_type(list, 0) -> true; +is_type(list, 1) -> true; +is_type(map, 0) -> true; +is_type(maybe_improper_list, 0) -> true; +is_type(maybe_improper_list, 2) -> true; +is_type(mfa, 0) -> true; +is_type(module, 0) -> true; +is_type(neg_integer, 0) -> true; +is_type(nil, 0) -> true; +is_type(no_return, 0) -> true; +is_type(node, 0) -> true; +is_type(non_neg_integer, 0) -> true; +is_type(none, 0) -> true; +is_type(nonempty_improper_list, 2) -> true; +is_type(nonempty_list, 0) -> true; +is_type(nonempty_list, 1) -> true; +is_type(nonempty_maybe_improper_list, 0) -> true; +is_type(nonempty_maybe_improper_list, 2) -> true; +is_type(nonempty_string, 0) -> true; +is_type(number, 0) -> true; +is_type(pid, 0) -> true; +is_type(port, 0) -> true; +is_type(pos_integer, 0) -> true; +is_type(reference, 0) -> true; +is_type(string, 0) -> true; +is_type(term, 0) -> true; +is_type(timeout, 0) -> true; +is_type(tuple, 0) -> true; +is_type(_, _) -> false. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 39cc03cf7a..39f8a26fe1 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -130,6 +130,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> :: dict:dict(mfa(), line()), callbacks = dict:new() %Callback types :: dict:dict(mfa(), line()), + optional_callbacks = dict:new() %Optional callbacks + :: dict:dict(mfa(), line()), types = dict:new() %Type definitions :: dict:dict(ta(), #typeinfo{}), exp_types=gb_sets:empty() %Exported types @@ -237,10 +239,7 @@ format_error({too_many_arguments,Arity}) -> "maximum allowed is ~w", [Arity,?MAX_ARGUMENTS]); %% --- patterns and guards --- format_error(illegal_pattern) -> "illegal pattern"; -format_error(illegal_map_key) -> - "illegal map key"; -format_error({illegal_map_key_variable,K}) -> - io_lib:format("illegal use of variable ~w in map",[K]); +format_error(illegal_map_key) -> "illegal map key in pattern"; format_error(illegal_bin_pattern) -> "binary patterns cannot be matched in parallel using '='"; format_error(illegal_expr) -> "illegal expression"; @@ -313,13 +312,20 @@ format_error({undefined_behaviour,Behaviour}) -> io_lib:format("behaviour ~w undefined", [Behaviour]); format_error({undefined_behaviour_callbacks,Behaviour}) -> io_lib:format("behaviour ~w callback functions are undefined", - [Behaviour]); + [Behaviour]); format_error({ill_defined_behaviour_callbacks,Behaviour}) -> io_lib:format("behaviour ~w callback functions erroneously defined", [Behaviour]); +format_error({ill_defined_optional_callbacks,Behaviour}) -> + io_lib:format("behaviour ~w optional callback functions erroneously defined", + [Behaviour]); format_error({behaviour_info, {_M,F,A}}) -> io_lib:format("cannot define callback attibute for ~w/~w when " "behaviour_info is defined",[F,A]); +format_error({redefine_optional_callback, {F, A}}) -> + io_lib:format("optional callback ~w/~w duplicated", [F, A]); +format_error({undefined_callback, {_M, F, A}}) -> + io_lib:format("callback ~w/~w is undefined", [F, A]); %% --- types and specs --- format_error({singleton_typevar, Name}) -> io_lib:format("type variable ~w is only used once (is unbound)", [Name]); @@ -331,14 +337,10 @@ format_error({undefined_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s undefined", [TypeName, gen_type_paren(Arity)]); format_error({unused_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s is unused", [TypeName, gen_type_paren(Arity)]); -%% format_error({new_builtin_type, {TypeName, Arity}}) -> -%% io_lib:format("type ~w~s is a new builtin type; " -%% "its (re)definition is allowed only until the next release", -%% [TypeName, gen_type_paren(Arity)]); -format_error({new_var_arity_type, TypeName}) -> - io_lib:format("type ~w is a new builtin type; " +format_error({new_builtin_type, {TypeName, Arity}}) -> + io_lib:format("type ~w~s is a new builtin type; " "its (re)definition is allowed only until the next release", - [TypeName]); + [TypeName, gen_type_paren(Arity)]); format_error({builtin_type, {TypeName, Arity}}) -> io_lib:format("type ~w~s is a builtin type; it cannot be redefined", [TypeName, gen_type_paren(Arity)]); @@ -352,10 +354,14 @@ format_error({type_syntax, Constr}) -> io_lib:format("bad ~w type", [Constr]); format_error({redefine_spec, {M, F, A}}) -> io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]); -format_error({redefine_callback, {M, F, A}}) -> - io_lib:format("callback ~w:~w/~w already defined", [M, F, A]); -format_error({spec_fun_undefined, {M, F, A}}) -> - io_lib:format("spec for undefined function ~w:~w/~w", [M, F, A]); +format_error({redefine_spec, {F, A}}) -> + io_lib:format("spec for ~w/~w already defined", [F, A]); +format_error({redefine_callback, {F, A}}) -> + io_lib:format("callback ~w/~w already defined", [F, A]); +format_error({bad_callback, {M, F, A}}) -> + io_lib:format("explicit module not allowed for callback ~w:~w/~w ", [M, F, A]); +format_error({spec_fun_undefined, {F, A}}) -> + io_lib:format("spec for undefined function ~w/~w", [F, A]); format_error({missing_spec, {F,A}}) -> io_lib:format("missing specification for function ~w/~w", [F, A]); format_error(spec_wrong_arity) -> @@ -727,6 +733,8 @@ attribute_state({attribute,L,spec,{Fun,Types}}, St) -> spec_decl(L, Fun, Types, St); attribute_state({attribute,L,callback,{Fun,Types}}, St) -> callback_decl(L, Fun, Types, St); +attribute_state({attribute,L,optional_callbacks,Es}, St) -> + optional_callbacks(L, Es, St); attribute_state({attribute,L,on_load,Val}, St) -> on_load(L, Val, St); attribute_state({attribute,_L,_Other,_Val}, St) -> % Ignore others @@ -834,57 +842,73 @@ check_behaviour(St0) -> %% Check behaviours for existence and defined functions. behaviour_check(Bs, St0) -> - {AllBfs,St1} = all_behaviour_callbacks(Bs, [], St0), - St = behaviour_missing_callbacks(AllBfs, St1), + {AllBfs0, St1} = all_behaviour_callbacks(Bs, [], St0), + St = behaviour_missing_callbacks(AllBfs0, St1), + Exports = exports(St0), + F = fun(Bfs, OBfs) -> + [B || B <- Bfs, + not lists:member(B, OBfs) + orelse gb_sets:is_member(B, Exports)] + end, + %% After fixing missing callbacks new warnings may be emitted. + AllBfs = [{Item,F(Bfs0, OBfs0)} || {Item,Bfs0,OBfs0} <- AllBfs0], behaviour_conflicting(AllBfs, St). all_behaviour_callbacks([{Line,B}|Bs], Acc, St0) -> - {Bfs0,St} = behaviour_callbacks(Line, B, St0), - all_behaviour_callbacks(Bs, [{{Line,B},Bfs0}|Acc], St); + {Bfs0,OBfs0,St} = behaviour_callbacks(Line, B, St0), + all_behaviour_callbacks(Bs, [{{Line,B},Bfs0,OBfs0}|Acc], St); all_behaviour_callbacks([], Acc, St) -> {reverse(Acc),St}. behaviour_callbacks(Line, B, St0) -> try B:behaviour_info(callbacks) of - Funcs when is_list(Funcs) -> - All = all(fun({FuncName, Arity}) -> - is_atom(FuncName) andalso is_integer(Arity); - ({FuncName, Arity, Spec}) -> - is_atom(FuncName) andalso is_integer(Arity) - andalso is_list(Spec); - (_Other) -> - false - end, - Funcs), - MaybeRemoveSpec = fun({_F,_A}=FA) -> FA; - ({F,A,_S}) -> {F,A}; - (Other) -> Other - end, - if - All =:= true -> - {[MaybeRemoveSpec(F) || F <- Funcs], St0}; + undefined -> + St1 = add_warning(Line, {undefined_behaviour_callbacks, B}, St0), + {[], [], St1}; + Funcs -> + case is_fa_list(Funcs) of true -> + try B:behaviour_info(optional_callbacks) of + undefined -> + {Funcs, [], St0}; + OptFuncs -> + %% OptFuncs should always be OK thanks to + %% sys_pre_expand. + case is_fa_list(OptFuncs) of + true -> + {Funcs, OptFuncs, St0}; + false -> + W = {ill_defined_optional_callbacks, B}, + St1 = add_warning(Line, W, St0), + {Funcs, [], St1} + end + catch + _:_ -> + {Funcs, [], St0} + end; + false -> St1 = add_warning(Line, - {ill_defined_behaviour_callbacks,B}, + {ill_defined_behaviour_callbacks, B}, St0), - {[], St1} - end; - undefined -> - St1 = add_warning(Line, {undefined_behaviour_callbacks,B}, St0), - {[], St1}; - _Other -> - St1 = add_warning(Line, {ill_defined_behaviour_callbacks,B}, St0), - {[], St1} + {[], [], St1} + end catch _:_ -> - St1 = add_warning(Line, {undefined_behaviour,B}, St0), - {[], St1} + St1 = add_warning(Line, {undefined_behaviour, B}, St0), + {[], [], St1} end. -behaviour_missing_callbacks([{{Line,B},Bfs}|T], St0) -> +behaviour_missing_callbacks([{{Line,B},Bfs0,OBfs}|T], St0) -> + Bfs = ordsets:subtract(ordsets:from_list(Bfs0), ordsets:from_list(OBfs)), Exports = gb_sets:to_list(exports(St0)), - Missing = ordsets:subtract(ordsets:from_list(Bfs), Exports), + Missing = ordsets:subtract(Bfs, Exports), St = foldl(fun (F, S0) -> - add_warning(Line, {undefined_behaviour_func,F,B}, S0) + case is_fa(F) of + true -> + M = {undefined_behaviour_func,F,B}, + add_warning(Line, M, S0); + false -> + S0 % ill_defined_behaviour_callbacks + end end, St0, Missing), behaviour_missing_callbacks(T, St); behaviour_missing_callbacks([], St) -> St. @@ -1046,10 +1070,9 @@ 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)} || - {T,_}=TA <- UTAs, + TA <- UTAs, not dict:is_key(TA, Def), - not is_default_type(TA), - not is_newly_introduced_var_arity_type(T)], + not is_default_type(TA)], foldl(fun ({TA,L}, St) -> add_error(L, {undefined_type,TA}, St) end, St0, Undef). @@ -1127,19 +1150,29 @@ check_unused_records(Forms, St0) -> end. check_callback_information(#lint{callbacks = Callbacks, - defined = Defined} = State) -> - case gb_sets:is_member({behaviour_info,1}, Defined) of - false -> State; + optional_callbacks = OptionalCbs, + defined = Defined} = St0) -> + OptFun = fun({MFA, Line}, St) -> + case dict:is_key(MFA, Callbacks) of + true -> + St; + false -> + add_error(Line, {undefined_callback, MFA}, St) + end + end, + St1 = lists:foldl(OptFun, St0, dict:to_list(OptionalCbs)), + case gb_sets:is_member({behaviour_info, 1}, Defined) of + false -> St1; true -> case dict:size(Callbacks) of - 0 -> State; + 0 -> St1; _ -> CallbacksList = dict:to_list(Callbacks), FoldL = - fun({Fa,Line},St) -> + fun({Fa, Line}, St) -> add_error(Line, {behaviour_info, Fa}, St) end, - lists:foldl(FoldL, State, CallbacksList) + lists:foldl(FoldL, St1, CallbacksList) end end. @@ -1404,20 +1437,7 @@ pattern({cons,_Line,H,T}, Vt, Old, Bvt, St0) -> pattern({tuple,_Line,Ps}, Vt, Old, Bvt, St) -> pattern_list(Ps, Vt, Old, Bvt, St); pattern({map,_Line,Ps}, Vt, Old, Bvt, St) -> - foldl(fun - ({map_field_assoc,L,_,_}, {Psvt,Bvt0,St0}) -> - {Psvt,Bvt0,add_error(L, illegal_pattern, St0)}; - ({map_field_exact,L,KP,VP}, {Psvt,Bvt0,St0}) -> - case is_valid_map_key(KP, pattern, St0) of - true -> - {Pvt,Bvt1,St1} = pattern(VP, Vt, Old, Bvt, St0), - {vtmerge_pat(Pvt, Psvt),vtmerge_pat(Bvt0, Bvt1), St1}; - false -> - {Psvt,Bvt0,add_error(L, illegal_map_key, St0)}; - {false,variable,Var} -> - {Psvt,Bvt0,add_error(L, {illegal_map_key_variable,Var}, St0)} - end - end, {[],[],St}, Ps); + pattern_map(Ps, Vt, Old, Bvt, St); %%pattern({struct,_Line,_Tag,Ps}, Vt, Old, Bvt, St) -> %% pattern_list(Ps, Vt, Old, Bvt, St); pattern({record_index,Line,Name,Field}, _Vt, _Old, _Bvt, St) -> @@ -1571,6 +1591,21 @@ is_pattern_expr_1({op,_Line,Op,A1,A2}) -> erl_internal:arith_op(Op, 2) andalso all(fun is_pattern_expr/1, [A1,A2]); is_pattern_expr_1(_Other) -> false. +pattern_map(Ps, Vt, Old, Bvt, St) -> + foldl(fun + ({map_field_assoc,L,_,_}, {Psvt,Bvt0,St0}) -> + {Psvt,Bvt0,add_error(L, illegal_pattern, St0)}; + ({map_field_exact,L,K,V}, {Psvt,Bvt0,St0}) -> + case is_valid_map_key(K) of + true -> + {Kvt,St1} = expr(K, Vt, St0), + {Vvt,Bvt2,St2} = pattern(V, Vt, Old, Bvt, St1), + {vtmerge_pat(vtmerge_pat(Kvt, Vvt), Psvt), vtmerge_pat(Bvt0, Bvt2), St2}; + false -> + {Psvt,Bvt0,add_error(L, illegal_map_key, St0)} + end + end, {[],[],St}, Ps). + %% pattern_bin([Element], VarTable, Old, BinVarTable, State) -> %% {UpdVarTable,UpdBinVarTable,State}. %% Check a pattern group. BinVarTable are used binsize variables. @@ -2085,8 +2120,8 @@ expr({'receive',Line,Cs,To,ToEs}, Vt, St0) -> {Cvt,St3} = icrt_clauses(Cs, Vt, St2), %% Csvts = [vtnew(Tevt, Vt)|Cvt], %This is just NEW variables! Csvts = [Tevt|Cvt], - {Rvt,St4} = icrt_export(Csvts, Vt, {'receive',Line}, St3), - {vtmerge([Tvt,Tevt,Rvt]),St4}; + Rvt = icrt_export(Csvts, Vt, {'receive',Line}), + {vtmerge([Tvt,Tevt,Rvt]),St3}; expr({'fun',Line,Body}, Vt, St) -> %%No one can think funs export! case Body of @@ -2197,21 +2232,20 @@ expr({'try',Line,Es,Scs,Ccs,As}, Vt, St0) -> %% passes cannot handle exports in combination with 'after'. {Evt0,St1} = exprs(Es, Vt, St0), TryLine = {'try',Line}, - Uvt = vtunsafe(vtnames(vtnew(Evt0, Vt)), TryLine, []), - Evt1 = vtupdate(Uvt, vtsubtract(Evt0, Uvt)), + Uvt = vtunsafe(TryLine, Evt0, Vt), + Evt1 = vtupdate(Uvt, Evt0), {Sccs,St2} = icrt_clauses(Scs++Ccs, TryLine, vtupdate(Evt1, Vt), St1), Rvt0 = Sccs, - Rvt1 = vtupdate(vtunsafe(vtnames(vtnew(Rvt0, Vt)), TryLine, []), Rvt0), + Rvt1 = vtupdate(vtunsafe(TryLine, Rvt0, Vt), Rvt0), Evt2 = vtmerge(Evt1, Rvt1), {Avt0,St} = exprs(As, vtupdate(Evt2, Vt), St2), - Avt1 = vtupdate(vtunsafe(vtnames(vtnew(Avt0, Vt)), TryLine, []), Avt0), + Avt1 = vtupdate(vtunsafe(TryLine, Avt0, Vt), Avt0), Avt = vtmerge(Evt2, Avt1), {Avt,St}; expr({'catch',Line,E}, Vt, St0) -> %% No new variables added, flag new variables as unsafe. - {Evt,St1} = expr(E, Vt, St0), - Uvt = vtunsafe(vtnames(vtnew(Evt, Vt)), {'catch',Line}, []), - {vtupdate(Uvt,vtupdate(Evt, Vt)),St1}; + {Evt,St} = expr(E, Vt, St0), + {vtupdate(vtunsafe({'catch',Line}, Evt, Vt), Evt),St}; expr({match,_Line,P,E}, Vt, St0) -> {Evt,St1} = expr(E, Vt, St0), {Pvt,Bvt,St2} = pattern(P, vtupdate(Evt, Vt), St1), @@ -2224,9 +2258,8 @@ expr({op,Line,Op,L,R}, Vt, St0) when Op =:= 'orelse'; Op =:= 'andalso' -> {Evt1,St1} = expr(L, Vt, St0), Vt1 = vtupdate(Evt1, Vt), {Evt2,St2} = expr(R, Vt1, St1), - Vt2 = vtmerge(Evt2, Vt1), - {Vt3,St3} = icrt_export([Vt1,Vt2], Vt1, {Op,Line}, St2), - {vtmerge(Evt1, Vt3),St3}; + Evt3 = vtupdate(vtunsafe({Op,Line}, Evt2, Vt1), Evt2), + {vtmerge(Evt1, Evt3),St2}; expr({op,_Line,_Op,L,R}, Vt, St) -> expr_list([L,R], Vt, St); %They see the same variables %% The following are not allowed to occur anywhere! @@ -2254,14 +2287,9 @@ check_assoc_fields([{map_field_assoc,_,_,_}|Fs], St) -> check_assoc_fields([], St) -> St. -map_fields([{Tag,Line,K,V}|Fs], Vt, St, F) when Tag =:= map_field_assoc; - Tag =:= map_field_exact -> - St1 = case is_valid_map_key(K, St) of - true -> St; - false -> add_error(Line, illegal_map_key, St); - {false,variable,Var} -> add_error(Line, {illegal_map_key_variable,Var}, St) - end, - {Pvt,St2} = F([K,V], Vt, St1), +map_fields([{Tag,_,K,V}|Fs], Vt, St, F) when Tag =:= map_field_assoc; + Tag =:= map_field_exact -> + {Pvt,St2} = F([K,V], Vt, St), {Vts,St3} = map_fields(Fs, Vt, St2, F), {vtupdate(Pvt, Vts),St3}; map_fields([], Vt, St, _) -> @@ -2319,21 +2347,14 @@ is_valid_call(Call) -> _ -> true end. -%% is_valid_map_key(K,St) -> true | false | {false, Var::atom()} -%% check for value expression without variables - -is_valid_map_key(K,St) -> - is_valid_map_key(K,expr,St). -is_valid_map_key(K,Ctx,St) -> - case expr(K,[],St) of - {[],_} -> - is_valid_map_key_value(K,Ctx); - {[Var|_],_} -> - {false,variable,element(1,Var)} - end. +%% is_valid_map_key(K,St) -> true | false +%% variables are allowed for patterns only at the top of the tree -is_valid_map_key_value(K,Ctx) -> +is_valid_map_key({var,_,_}) -> true; +is_valid_map_key(K) -> is_valid_map_key_value(K). +is_valid_map_key_value(K) -> case K of + {var,_,_} -> false; {char,_,_} -> true; {integer,_,_} -> true; {float,_,_} -> true; @@ -2341,36 +2362,36 @@ is_valid_map_key_value(K,Ctx) -> {nil,_} -> true; {atom,_,_} -> true; {cons,_,H,T} -> - is_valid_map_key_value(H,Ctx) andalso - is_valid_map_key_value(T,Ctx); + is_valid_map_key_value(H) andalso + is_valid_map_key_value(T); {tuple,_,Es} -> foldl(fun(E,B) -> - B andalso is_valid_map_key_value(E,Ctx) + B andalso is_valid_map_key_value(E) end,true,Es); {map,_,Arg,Ps} -> % only check for value expressions to be valid % invalid map expressions are later checked in % core and kernel - is_valid_map_key_value(Arg,Ctx) andalso foldl(fun + is_valid_map_key_value(Arg) andalso foldl(fun ({Tag,_,Ke,Ve},B) when Tag =:= map_field_assoc; - Tag =:= map_field_exact, Ctx =:= expr -> - B andalso is_valid_map_key_value(Ke,Ctx) - andalso is_valid_map_key_value(Ve,Ctx); + Tag =:= map_field_exact -> + B andalso is_valid_map_key_value(Ke) + andalso is_valid_map_key_value(Ve); (_,_) -> false end,true,Ps); {map,_,Ps} -> foldl(fun ({Tag,_,Ke,Ve},B) when Tag =:= map_field_assoc; - Tag =:= map_field_exact, Ctx =:= expr -> - B andalso is_valid_map_key_value(Ke,Ctx) - andalso is_valid_map_key_value(Ve,Ctx); + Tag =:= map_field_exact -> + B andalso is_valid_map_key_value(Ke) + andalso is_valid_map_key_value(Ve); (_,_) -> false end, true, Ps); {record,_,_,Fs} -> foldl(fun ({record_field,_,Ke,Ve},B) -> - B andalso is_valid_map_key_value(Ke,Ctx) - andalso is_valid_map_key_value(Ve,Ctx) + B andalso is_valid_map_key_value(Ke) + andalso is_valid_map_key_value(Ve) end,true,Fs); {bin,_,Es} -> % only check for value expressions to be valid @@ -2378,9 +2399,9 @@ is_valid_map_key_value(K,Ctx) -> % core and kernel foldl(fun ({bin_element,_,E,_,_},B) -> - B andalso is_valid_map_key_value(E,Ctx) + B andalso is_valid_map_key_value(E) end,true,Es); - _ -> false + Val -> is_pattern_expr(Val) end. %% record_def(Line, RecordName, [RecField], State) -> State. @@ -2615,30 +2636,21 @@ type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> true -> case is_obsolete_builtin_type(TypePair) of true -> StoreType(St0); - false -> add_error(Line, {builtin_type, TypePair}, St0) -%% case is_newly_introduced_builtin_type(TypePair) of -%% %% allow some types just for bootstrapping -%% true -> -%% Warn = {new_builtin_type, TypePair}, -%% St1 = add_warning(Line, Warn, St0), -%% StoreType(St1); -%% false -> -%% add_error(Line, {builtin_type, TypePair}, St0) -%% end + false -> + case is_newly_introduced_builtin_type(TypePair) of + %% allow some types just for bootstrapping + true -> + Warn = {new_builtin_type, TypePair}, + St1 = add_warning(Line, Warn, St0), + StoreType(St1); + false -> + add_error(Line, {builtin_type, TypePair}, St0) + end end; false -> - case - dict:is_key(TypePair, TypeDefs) orelse - is_var_arity_type(TypeName) - of + case dict:is_key(TypePair, TypeDefs) of true -> - case is_newly_introduced_var_arity_type(TypeName) of - true -> - Warn = {new_var_arity_type, TypeName}, - add_warning(Line, Warn, St0); - false -> - add_error(Line, {redefine_type, TypePair}, St0) - end; + add_error(Line, {redefine_type, TypePair}, St0); false -> St1 = case Attr =:= opaque andalso @@ -2675,7 +2687,7 @@ check_type({paren_type, _L, [Type]}, SeenVars, St) -> check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]}, SeenVars, #lint{module=CurrentMod} = St) -> case Mod =:= CurrentMod of - true -> check_type({type, L, Name, Args}, SeenVars, St); + true -> check_type({user_type, L, Name, Args}, SeenVars, St); false -> lists:foldl(fun(T, {AccSeenVars, AccSt}) -> check_type(T, AccSeenVars, AccSt) @@ -2709,12 +2721,15 @@ check_type({type, L, range, [From, To]}, SeenVars, St) -> _ -> add_error(L, {type_syntax, range}, St) end, {SeenVars, St1}; -check_type({type, _L, map, any}, SeenVars, St) -> {SeenVars, St}; +check_type({type, L, map, any}, SeenVars, St) -> + %% To get usage right while map/0 is a newly_introduced_builtin_type. + St1 = used_type({map, 0}, L, St), + {SeenVars, St1}; check_type({type, _L, map, Pairs}, SeenVars, St) -> lists:foldl(fun(Pair, {AccSeenVars, AccSt}) -> check_type(Pair, AccSeenVars, AccSt) end, {SeenVars, St}, Pairs); -check_type({type, _L, map_field_assoc, Dom, Range}, SeenVars, St) -> +check_type({type, _L, map_field_assoc, [Dom, Range]}, SeenVars, St) -> check_type({type, -1, product, [Dom, Range]}, SeenVars, St); check_type({type, _L, tuple, any}, SeenVars, St) -> {SeenVars, St}; check_type({type, _L, any}, SeenVars, St) -> {SeenVars, St}; @@ -2733,41 +2748,39 @@ check_type({type, L, record, [Name|Fields]}, SeenVars, St) -> check_record_types(L, Atom, Fields, SeenVars, St1); _ -> {SeenVars, add_error(L, {type_syntax, record}, St)} end; -check_type({type, _L, product, Args}, SeenVars, St) -> +check_type({type, _L, Tag, Args}, SeenVars, St) when Tag =:= product; + Tag =:= union; + Tag =:= tuple -> lists:foldl(fun(T, {AccSeenVars, AccSt}) -> check_type(T, AccSeenVars, AccSt) end, {SeenVars, St}, Args); check_type({type, La, TypeName, Args}, SeenVars, St) -> - #lint{usage=Usage, module = Module, types=Types} = St, + #lint{module = Module, types=Types} = St, Arity = length(Args), TypePair = {TypeName, Arity}, - St1 = case is_var_arity_type(TypeName) of - true -> St; - false -> - Obsolete = (is_warn_enabled(deprecated_type, St) - andalso obsolete_builtin_type(TypePair)), - IsObsolete = - case Obsolete of - {deprecated, Repl, _} when element(1, Repl) =/= Module -> - case dict:find(TypePair, Types) of - {ok, _} -> false; - error -> true - end; - _ -> false - end, - case IsObsolete of - true -> + Obsolete = (is_warn_enabled(deprecated_type, St) + andalso obsolete_builtin_type(TypePair)), + St1 = case Obsolete of + {deprecated, Repl, _} when element(1, Repl) =/= Module -> + case dict:find(TypePair, Types) of + {ok, _} -> + used_type(TypePair, La, St); + error -> {deprecated, Replacement, Rel} = Obsolete, Tag = deprecated_builtin_type, W = {Tag, TypePair, Replacement, Rel}, - add_warning(La, W, St); - false -> - OldUsed = Usage#usage.used_types, - UsedTypes = dict:store(TypePair, La, OldUsed), - St#lint{usage=Usage#usage{used_types=UsedTypes}} - end - end, + add_warning(La, W, St) + end; + _ -> St + end, check_type({type, -1, product, Args}, SeenVars, St1); +check_type({user_type, L, TypeName, Args}, SeenVars, St) -> + Arity = length(Args), + TypePair = {TypeName, Arity}, + St1 = used_type(TypePair, L, St), + lists:foldl(fun(T, {AccSeenVars, AccSt}) -> + check_type(T, AccSeenVars, AccSt) + end, {SeenVars, St1}, Args); check_type(I, SeenVars, St) -> case erl_eval:partial_eval(I) of {integer,_ILn,_Integer} -> {SeenVars, St}; @@ -2809,95 +2822,24 @@ check_record_types([{type, _, field_type, [{atom, AL, FName}, Type]}|Left], check_record_types([], _Name, _DefFields, SeenVars, St, _SeenFields) -> {SeenVars, St}. -is_var_arity_type(tuple) -> true; -is_var_arity_type(map) -> true; -is_var_arity_type(product) -> true; -is_var_arity_type(union) -> true; -is_var_arity_type(record) -> true; -is_var_arity_type(_) -> false. - -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. - -is_newly_introduced_var_arity_type(map) -> true; -is_newly_introduced_var_arity_type(_) -> false. - -%% is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false. +used_type(TypePair, L, St) -> + Usage = St#lint.usage, + OldUsed = Usage#usage.used_types, + UsedTypes = dict:store(TypePair, L, OldUsed), + St#lint{usage=Usage#usage{used_types=UsedTypes}}. + +is_default_type({Name, NumberOfTypeVariables}) -> + erl_internal:is_type(Name, NumberOfTypeVariables). + +is_newly_introduced_builtin_type({map, 0}) -> true; +is_newly_introduced_builtin_type({Name, _}) when is_atom(Name) -> false. is_obsolete_builtin_type(TypePair) -> obsolete_builtin_type(TypePair) =/= no. -%% Obsolete in OTP 17.0. -obsolete_builtin_type({array, 0}) -> - {deprecated, {array, array, 1}, "OTP 18.0"}; -obsolete_builtin_type({dict, 0}) -> - {deprecated, {dict, dict, 2}, "OTP 18.0"}; -obsolete_builtin_type({digraph, 0}) -> - {deprecated, {digraph, graph}, "OTP 18.0"}; -obsolete_builtin_type({gb_set, 0}) -> - {deprecated, {gb_sets, set, 1}, "OTP 18.0"}; -obsolete_builtin_type({gb_tree, 0}) -> - {deprecated, {gb_trees, tree, 2}, "OTP 18.0"}; -obsolete_builtin_type({queue, 0}) -> - {deprecated, {queue, queue, 1}, "OTP 18.0"}; -obsolete_builtin_type({set, 0}) -> - {deprecated, {sets, set, 1}, "OTP 18.0"}; -obsolete_builtin_type({tid, 0}) -> - {deprecated, {ets, tid}, "OTP 18.0"}; +%% To keep Dialyzer silent... +obsolete_builtin_type({1, 255}) -> + {deprecated, {2, 255}, ""}; obsolete_builtin_type({Name, A}) when is_atom(Name), is_integer(A) -> no. %% spec_decl(Line, Fun, Types, State) -> State. @@ -2909,7 +2851,7 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> end, St1 = St0#lint{specs = dict:store(MFA, Line, Specs)}, case dict:is_key(MFA, Specs) of - true -> add_error(Line, {redefine_spec, MFA}, St1); + true -> add_error(Line, {redefine_spec, MFA0}, St1); false -> check_specs(TypeSpecs, Arity, St1) end. @@ -2917,16 +2859,50 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) -> callback_decl(Line, MFA0, TypeSpecs, St0 = #lint{callbacks = Callbacks, module = Mod}) -> - MFA = case MFA0 of - {F, Arity} -> {Mod, F, Arity}; - {_M, _F, Arity} -> MFA0 - end, - St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, - case dict:is_key(MFA, Callbacks) of - true -> add_error(Line, {redefine_callback, MFA}, St1); - false -> check_specs(TypeSpecs, Arity, St1) + case MFA0 of + {_M, _F, _A} -> add_error(Line, {bad_callback, MFA0}, St0); + {F, Arity} -> + MFA = {Mod, F, Arity}, + St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)}, + case dict:is_key(MFA, Callbacks) of + true -> add_error(Line, {redefine_callback, MFA0}, St1); + false -> check_specs(TypeSpecs, Arity, St1) + end + end. + +%% optional_callbacks(Line, FAs, State) -> State. + +optional_callbacks(Line, Term, St0) -> + try true = is_fa_list(Term), Term of + FAs -> + optional_cbs(Line, FAs, St0) + catch + _:_ -> + St0 % ignore others end. +optional_cbs(_Line, [], St) -> + St; +optional_cbs(Line, [{F,A}|FAs], St0) -> + #lint{optional_callbacks = OptionalCbs, module = Mod} = St0, + MFA = {Mod, F, A}, + St1 = St0#lint{optional_callbacks = dict:store(MFA, Line, OptionalCbs)}, + St2 = case dict:is_key(MFA, OptionalCbs) of + true -> + add_error(Line, {redefine_optional_callback, {F,A}}, St1); + false -> + St1 + end, + optional_cbs(Line, FAs, St2). + +is_fa_list([E|L]) -> is_fa(E) andalso is_fa_list(L); +is_fa_list([]) -> true; +is_fa_list(_) -> false. + +is_fa({FuncName, Arity}) + when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> true; +is_fa(_) -> false. + check_specs([FunType|Left], Arity, St0) -> {FunType1, CTypes} = case FunType of @@ -2950,10 +2926,11 @@ check_specs([], _Arity, St) -> St. check_specs_without_function(#lint{module=Mod,defined=Funcs,specs=Specs}=St) -> - Fun = fun({M, F, A} = MFA, Line, AccSt) when M =:= Mod -> - case gb_sets:is_element({F, A}, Funcs) of + Fun = fun({M, F, A}, Line, AccSt) when M =:= Mod -> + FA = {F, A}, + case gb_sets:is_element(FA, Funcs) of true -> AccSt; - false -> add_error(Line, {spec_fun_undefined, MFA}, AccSt) + false -> add_error(Line, {spec_fun_undefined, FA}, AccSt) end; ({_M, _F, _A}, _Line, AccSt) -> AccSt end, @@ -3032,11 +3009,12 @@ check_local_opaque_types(St) -> dict:fold(FoldFun, St, Ts). %% icrt_clauses(Clauses, In, ImportVarTable, State) -> -%% {NewVts,State}. +%% {UpdVt,State}. icrt_clauses(Cs, In, Vt, St0) -> {Csvt,St1} = icrt_clauses(Cs, Vt, St0), - icrt_export(Csvt, Vt, In, St1). + UpdVt = icrt_export(Csvt, Vt, In), + {UpdVt,St1}. %% icrt_clauses(Clauses, ImportVarTable, State) -> %% {NewVts,State}. @@ -3046,26 +3024,73 @@ icrt_clauses(Cs, Vt, St) -> icrt_clause({clause,_Line,H,G,B}, Vt0, St0) -> {Hvt,Binvt,St1} = head(H, Vt0, St0), - Vt1 = vtupdate(Hvt, vtupdate(Binvt, Vt0)), - {Gvt,St2} = guard(G, Vt1, St1), + Vt1 = vtupdate(Hvt, Binvt), + {Gvt,St2} = guard(G, vtupdate(Vt1, Vt0), St1), Vt2 = vtupdate(Gvt, Vt1), - {Bvt,St3} = exprs(B, Vt2, St2), + {Bvt,St3} = exprs(B, vtupdate(Vt2, Vt0), St2), {vtupdate(Bvt, Vt2),St3}. -icrt_export(Csvt, Vt, In, St) -> - Vt1 = vtmerge(Csvt), - All = ordsets:subtract(vintersection(Csvt), vtnames(Vt)), - Some = ordsets:subtract(vtnames(Vt1), vtnames(Vt)), - Xvt = vtexport(All, In, []), - Evt = vtunsafe(ordsets:subtract(Some, All), In, Xvt), - Unused = vtmerge([unused_vars(Vt0, Vt, St) || Vt0 <- Csvt]), - %% Exported and unsafe variables may be unused: - Uvt = vtmerge(Evt, Unused), - %% Make exported and unsafe unused variables unused in subsequent code: - Vt2 = vtmerge(Uvt, vtsubtract(Vt1, Uvt)), - %% Forget about old variables which were not used: - Vt3 = vtmerge(vtnew(Vt2, Vt), vt_no_unused(vtold(Vt2, Vt))), - {Vt3,St}. +icrt_export(Vts, Vt, {Tag,Attrs}) -> + {_File,Loc} = loc(Attrs), + icrt_export(lists:merge(Vts), Vt, {Tag,Loc}, length(Vts), []). + +icrt_export([{V,{{export,_},_,_}}|Vs0], [{V,{{export,_}=S0,_,Ls}}|Vt], + In, I, Acc) -> + %% V was an exported variable and has been used in an expression in at least + %% one clause. Its state needs to be merged from all clauses to silence any + %% exported var warning already emitted. + {VVs,Vs} = lists:partition(fun ({K,_}) -> K =:= V end, Vs0), + S = foldl(fun ({_,{S1,_,_}}, AccS) -> merge_state(AccS, S1) end, S0, VVs), + icrt_export(Vs, Vt, In, I, [{V,{S,used,Ls}}|Acc]); +icrt_export([{V,_}|Vs0], [{V,{_,_,Ls}}|Vt], In, I, Acc) -> + %% V was either unsafe or bound and has now been reused. It may also have + %% been an export but as it was not matched by the previous clause, it means + %% it has been changed to 'bound' in at least one clause because it was used + %% in a pattern. + Vs = lists:dropwhile(fun ({K,_}) -> K =:= V end, Vs0), + icrt_export(Vs, Vt, In, I, [{V,{bound,used,Ls}}|Acc]); +icrt_export([{V1,_}|_]=Vs, [{V2,_}|Vt], In, I, Acc) when V1 > V2 -> + %% V2 was already in scope and has not been reused in any clause. + icrt_export(Vs, Vt, In, I, Acc); +icrt_export([{V,_}|_]=Vs0, Vt, In, I, Acc) -> + %% V is a new variable. + {VVs,Vs} = lists:partition(fun ({K,_}) -> K =:= V end, Vs0), + F = fun ({_,{S,U,Ls}}, {AccI,AccS0,AccLs0}) -> + AccS = case {S,AccS0} of + {{unsafe,_},{unsafe,_}} -> + %% V was found unsafe in a previous clause, mark + %% it as unsafe for the whole parent expression. + {unsafe,In}; + {{unsafe,_},_} -> + %% V was unsafe in a clause, keep that state and + %% generalize it to the whole expression if it + %% is found unsafe in another one. + S; + _ -> + %% V is either bound or exported, keep original + %% state. + AccS0 + end, + AccLs = case U of + used -> AccLs0; + unused -> merge_lines(AccLs0, Ls) + end, + {AccI + 1,AccS,AccLs} + end, + %% Initial state is exported from the current expression. + {Count,S1,Ls} = foldl(F, {0,{export,In},[]}, VVs), + S = case Count of + I -> + %% V was found in all clauses, keep computed state. + S1; + _ -> + %% V was not bound in some clauses, mark as unsafe. + {unsafe,In} + end, + U = case Ls of [] -> used; _ -> unused end, + icrt_export(Vs, Vt, In, I, [{V,{S,U,Ls}}|Acc]); +icrt_export([], _, _, _, Acc) -> + reverse(Acc). handle_comprehension(E, Qs, Vt0, St0) -> {Vt1, Uvt, St1} = lc_quals(Qs, Vt0, St0), @@ -3163,7 +3188,8 @@ fun_clauses(Cs, Vt, St) -> {Cvt,St1} = fun_clause(C, Vt, St0), {vtmerge(Cvt, Bvt0),St1} end, {[],St#lint{recdef_top = false}}, Cs), - {vt_no_unused(vtold(Bvt, Vt)),St2#lint{recdef_top = OldRecDef}}. + Uvt = vt_no_unsafe(vt_no_unused(vtold(Bvt, Vt))), + {Uvt,St2#lint{recdef_top = OldRecDef}}. fun_clause({clause,_Line,H,G,B}, Vt0, St0) -> {Hvt,Binvt,St1} = head(H, Vt0, [], St0), % No imported pattern variables @@ -3277,19 +3303,24 @@ pat_binsize_var(V, Line, Vt, Bvt, St) -> %% exported vars are probably safe, warn only if warn_export_vars is %% set. -expr_var(V, Line, Vt, St0) -> +expr_var(V, Line, Vt, St) -> case orddict:find(V, Vt) of {ok,{bound,_Usage,Ls}} -> - {[{V,{bound,used,Ls}}],St0}; + {[{V,{bound,used,Ls}}],St}; {ok,{{unsafe,In},_Usage,Ls}} -> {[{V,{bound,used,Ls}}], - add_error(Line, {unsafe_var,V,In}, St0)}; + add_error(Line, {unsafe_var,V,In}, St)}; {ok,{{export,From},_Usage,Ls}} -> - {[{V,{bound,used,Ls}}], - exported_var(Line, V, From, St0)}; + case is_warn_enabled(export_vars, St) of + true -> + {[{V,{bound,used,Ls}}], + add_warning(Line, {exported_var,V,From}, St)}; + false -> + {[{V,{{export,From},used,Ls}}],St} + end; error -> {[{V,{bound,used,[Line]}}], - add_error(Line, {unbound_var,V}, St0)} + add_error(Line, {unbound_var,V}, St)} end. exported_var(Line, V, From, St) -> @@ -3353,17 +3384,12 @@ vtupdate(Uvt, Vt0) -> {S, merge_used(U1, U2), merge_lines(L1, L2)} end, Uvt, Vt0). -%% vtexport([Variable], From, VarTable) -> VarTable. -%% vtunsafe([Variable], From, VarTable) -> VarTable. -%% Add the variables to VarTable either as exported from From or as unsafe. +%% vtunsafe(From, UpdVarTable, VarTable) -> UnsafeVarTable. +%% Return all new variables in UpdVarTable as unsafe. -vtexport(Vs, {InTag,FileLine}, Vt0) -> +vtunsafe({Tag,FileLine}, Uvt, Vt) -> {_File,Line} = loc(FileLine), - vtupdate([{V,{{export,{InTag,Line}},unused,[]}} || V <- Vs], Vt0). - -vtunsafe(Vs, {InTag,FileLine}, Vt0) -> - {_File,Line} = loc(FileLine), - vtupdate([{V,{{unsafe,{InTag,Line}},unused,[]}} || V <- Vs], Vt0). + [{V,{{unsafe,{Tag,Line}},U,Ls}} || {V,{_,U,Ls}} <- vtnew(Uvt, Vt)]. %% vtmerge(VarTable, VarTable) -> VarTable. %% Merge two variables tables generating a new vartable. Give priority to @@ -3416,8 +3442,6 @@ vtsubtract(New, Old) -> vtold(New, Old) -> orddict:filter(fun (V, _How) -> orddict:is_key(V, Old) end, New). -vtnames(Vt) -> [ V || {V,_How} <- Vt ]. - vt_no_unsafe(Vt) -> [V || {_,{S,_U,_L}}=V <- Vt, case S of {unsafe,_} -> false; @@ -3426,29 +3450,6 @@ vt_no_unsafe(Vt) -> [V || {_,{S,_U,_L}}=V <- Vt, vt_no_unused(Vt) -> [V || {_,{_,U,_L}}=V <- Vt, U =/= unused]. -%% vunion(VarTable1, VarTable2) -> [VarName]. -%% vunion([VarTable]) -> [VarName]. -%% vintersection(VarTable1, VarTable2) -> [VarName]. -%% vintersection([VarTable]) -> [VarName]. -%% Union/intersection of names of vars in VarTable. - --ifdef(NOTUSED). -vunion(Vs1, Vs2) -> ordsets:union(vtnames(Vs1), vtnames(Vs2)). - -vunion(Vss) -> foldl(fun (Vs, Uvs) -> - ordsets:union(vtnames(Vs), Uvs) - end, [], Vss). - -vintersection(Vs1, Vs2) -> ordsets:intersection(vtnames(Vs1), vtnames(Vs2)). --endif. - -vintersection([Vs]) -> - vtnames(Vs); %Boundary conditions!!! -vintersection([Vs|Vss]) -> - ordsets:intersection(vtnames(Vs), vintersection(Vss)); -vintersection([]) -> - []. - %% copy_expr(Expr, Line) -> Expr. %% Make a copy of Expr converting all line numbers to Line. diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index e1ae3b7aea..767b620871 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -146,8 +146,7 @@ type -> '(' top_type ')' : {paren_type, ?line('$2'), ['$2']}. type -> var : '$1'. type -> atom : '$1'. type -> atom '(' ')' : build_gen_type('$1'). -type -> atom '(' top_types ')' : {type, ?line('$1'), - normalise('$1'), '$3'}. +type -> atom '(' top_types ')' : build_type('$1', '$3'). type -> atom ':' atom '(' ')' : {remote_type, ?line('$1'), ['$1', '$3', []]}. type -> atom ':' atom '(' top_types ')' : {remote_type, ?line('$1'), @@ -181,7 +180,7 @@ fun_type -> '(' top_types ')' '->' top_type map_pair_types -> map_pair_type : ['$1']. map_pair_types -> map_pair_type ',' map_pair_types : ['$1'|'$3']. -map_pair_type -> top_type '=>' top_type : {type, ?line('$2'), map_field_assoc,'$1','$3'}. +map_pair_type -> top_type '=>' top_type : {type, ?line('$2'), map_field_assoc,['$1','$3']}. field_types -> field_type : ['$1']. field_types -> field_type ',' field_types : ['$1'|'$3']. @@ -665,6 +664,8 @@ find_arity_from_specs([Spec|_]) -> {type, _, 'fun', [{type, _, product, Args},_]} = Fun, length(Args). +build_def({var, L, '_'}, _Types) -> + ret_err(L, "bad type variable"); build_def(LHS, Types) -> IsSubType = {atom, ?line(LHS), is_subtype}, {type, ?line(LHS), constraint, [IsSubType, [LHS, Types]]}. @@ -684,7 +685,8 @@ build_gen_type({atom, La, tuple}) -> build_gen_type({atom, La, map}) -> {type, La, map, any}; build_gen_type({atom, La, Name}) -> - {type, La, Name, []}. + Tag = type_tag(Name, 0), + {Tag, La, Name, []}. build_bin_type([{var, _, '_'}|Left], Int) -> build_bin_type(Left, Int); @@ -693,6 +695,16 @@ build_bin_type([], Int) -> build_bin_type([{var, La, _}|_], _) -> ret_err(La, "Bad binary type"). +build_type({atom, L, Name}, Types) -> + Tag = type_tag(Name, length(Types)), + {Tag, L, Name, Types}. + +type_tag(TypeName, NumberOfTypeVariables) -> + case erl_internal:is_type(TypeName, NumberOfTypeVariables) of + true -> type; + false -> user_type + end. + %% build_attribute(AttrName, AttrValue) -> %% {attribute,Line,module,Module} %% {attribute,Line,export,Exports} @@ -753,6 +765,9 @@ attribute_farity({cons,L,H,T}) -> attribute_farity({tuple,L,Args0}) -> Args = attribute_farity_list(Args0), {tuple,L,Args}; +attribute_farity({map,L,Args0}) -> + Args = attribute_farity_map(Args0), + {map,L,Args}; attribute_farity({op,L,'/',{atom,_,_}=Name,{integer,_,_}=Arity}) -> {tuple,L,[Name,Arity]}; attribute_farity(Other) -> Other. @@ -760,6 +775,10 @@ attribute_farity(Other) -> Other. attribute_farity_list(Args) -> [attribute_farity(A) || A <- Args]. +%% It is not meaningful to have farity keys. +attribute_farity_map(Args) -> + [{Op,L,K,attribute_farity(V)} || {Op,L,K,V} <- Args]. + -spec error_bad_decl(integer(), attributes()) -> no_return(). error_bad_decl(L, S) -> @@ -954,7 +973,9 @@ abstract([H|T], L, none=E) -> abstract(List, L, E) when is_list(List) -> abstract_list(List, [], L, E); abstract(Tuple, L, E) when is_tuple(Tuple) -> - {tuple,L,abstract_tuple_list(tuple_to_list(Tuple), L, E)}. + {tuple,L,abstract_tuple_list(tuple_to_list(Tuple), L, E)}; +abstract(Map, L, E) when is_map(Map) -> + {map,L,abstract_map_fields(maps:to_list(Map),L,E)}. abstract_list([H|T], String, L, E) -> case is_integer(H) andalso H >= 0 andalso E(H) of @@ -979,6 +1000,9 @@ abstract_tuple_list([H|T], L, E) -> abstract_tuple_list([], _L, _E) -> []. +abstract_map_fields(Fs,L,E) -> + [{map_field_assoc,L,abstract(K,L,E),abstract(V,L,E)}||{K,V}<-Fs]. + abstract_byte(Byte, L) when is_integer(Byte) -> {bin_element, L, {integer, L, Byte}, default, default}; abstract_byte(Bits, L) -> diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 82bc2c1460..17a758ff58 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -232,13 +232,21 @@ lattribute(import, Name, _Opts, _State) when is_list(Name) -> attr("import", [{var,0,pname(Name)}]); lattribute(import, {From,Falist}, _Opts, _State) -> attr("import",[{var,0,pname(From)},falist(Falist)]); +lattribute(optional_callbacks, Falist, Opts, _State) -> + ArgL = try falist(Falist) + catch _:_ -> abstract(Falist, Opts) + end, + call({var,0,"-optional_callbacks"}, [ArgL], 0, options(none)); lattribute(file, {Name,Line}, _Opts, State) -> attr("file", [{var,0,(State#pp.string_fun)(Name)},{integer,0,Line}]); lattribute(record, {Name,Is}, Opts, _State) -> Nl = leaf(format("-record(~w,", [Name])), [{first,Nl,record_fields(Is, Opts)},$)]; -lattribute(Name, Arg, #options{encoding = Encoding}, _State) -> - attr(write(Name), [erl_parse:abstract(Arg, [{encoding,Encoding}])]). +lattribute(Name, Arg, Options, _State) -> + attr(write(Name), [abstract(Arg, Options)]). + +abstract(Arg, #options{encoding = Encoding}) -> + erl_parse:abstract(Arg, [{encoding,Encoding}]). typeattr(Tag, {TypeName,Type,Args}, _Opts) -> {first,leaf("-"++atom_to_list(Tag)++" "), @@ -277,6 +285,9 @@ ltype({type,_,'fun',[{type,_,any},_]}=FunType) -> ltype({type,_Line,'fun',[{type,_,product,_},_]}=FunType) -> [fun_type(['fun',$(], FunType),$)]; ltype({type,Line,T,Ts}) -> + %% Compatibility. Before 18.0. + simple_type({atom,Line,T}, Ts); +ltype({user_type,Line,T,Ts}) -> simple_type({atom,Line,T}, Ts); ltype({remote_type,Line,[M,F,Ts]}) -> simple_type({remote,Line,M,F}, Ts); @@ -299,8 +310,16 @@ map_type(Fs) -> map_pair_types(Fs) -> tuple_type(Fs, fun map_pair_type/1). -map_pair_type({type,_Line,map_field_assoc,Ktype,Vtype}) -> - {seq,[],[]," =>",[ltype(Ktype),ltype(Vtype)]}. +map_pair_type({type,_Line,map_field_assoc,[Ktype,Vtype]}) -> + map_assoc_typed(ltype(Ktype), Vtype). + +map_assoc_typed(B, {type,_,union,Ts}) -> + {first,[B,$\s],{seq,[],[],[],map_assoc_union_type(Ts)}}; +map_assoc_typed(B, Type) -> + {list,[{cstep,[B," =>"],ltype(Type)}]}. + +map_assoc_union_type([T|Ts]) -> + [[leaf("=> "),ltype(T)] | ltypes(Ts, fun union_elem/1)]. record_type(Name, Fields) -> {first,[record_name(Name)],field_types(Fields)}. diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index ae59d5f44f..6fd6bb888b 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -1075,7 +1075,7 @@ scan_number([$#|Cs]=Cs0, St, Line, Col, Toks, Ncs0) -> Ncs = lists:reverse(Ncs0), case catch list_to_integer(Ncs) of B when B >= 2, B =< 1+$Z-$A+10 -> - Bcs = ?STR(St, Ncs++[$#]), + Bcs = Ncs++[$#], scan_based_int(Cs, St, Line, Col, Toks, {B,[],Bcs}); B -> Len = length(Ncs), @@ -1108,7 +1108,7 @@ scan_based_int(Cs, St, Line, Col, Toks, {B,Ncs0,Bcs}) -> Ncs = lists:reverse(Ncs0), case catch erlang:list_to_integer(Ncs, B) of N when is_integer(N) -> - tok3(Cs, St, Line, Col, Toks, integer, ?STR(St, Bcs++Ncs), N); + tok3(Cs, St, Line, Col, Toks, integer, Bcs++Ncs, N); _ -> Len = length(Bcs)+length(Ncs), Ncol = incr_column(Col, Len), diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index 9efbe8da20..daae1fd2d2 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -371,7 +371,7 @@ compile_wildcard(Pattern, Cwd0) -> [Root|Rest] = filename:split(Pattern), case filename:pathtype(Root) of relative -> - Cwd = filename:join([Cwd0]), + Cwd = prepare_base(Cwd0), compile_wildcard_2([Root|Rest], {cwd,Cwd}); _ -> compile_wildcard_2(Rest, {root,0,Root}) diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index e6bde5673c..632af17e2a 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -444,6 +444,8 @@ join1([], RelativeName, [$:|Rest], win32) -> join1(RelativeName, [], [$:|Rest], win32); join1([], RelativeName, [$/|Result], OsType) -> join1(RelativeName, [], [$/|Result], OsType); +join1([], RelativeName, [$., $/|Result], OsType) -> + join1(RelativeName, [], [$/|Result], OsType); join1([], RelativeName, Result, OsType) -> join1(RelativeName, [], [$/|Result], OsType); join1([[_|_]=List|Rest], RelativeName, Result, OsType) -> @@ -470,6 +472,8 @@ join1b(<<>>, RelativeName, [$:|Rest], win32) -> join1b(RelativeName, <<>>, [$:|Rest], win32); join1b(<<>>, RelativeName, [$/|Result], OsType) -> join1b(RelativeName, <<>>, [$/|Result], OsType); +join1b(<<>>, RelativeName, [$., $/|Result], OsType) -> + join1b(RelativeName, <<>>, [$/|Result], OsType); join1b(<<>>, RelativeName, Result, OsType) -> join1b(RelativeName, <<>>, [$/|Result], OsType); join1b(<<Char,Rest/binary>>, RelativeName, Result, OsType) when is_integer(Char) -> diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 63116fa16e..6d7ca3d75c 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -26,7 +26,7 @@ %%% The standard behaviour should export init_it/6. %%%----------------------------------------------------------------- -export([start/5, start/6, debug_options/1, - call/3, call/4, reply/2]). + call/3, call/4, reply/2, stop/1, stop/3]). -export([init_it/6, init_it/7]). @@ -145,56 +145,10 @@ init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) -> call(Process, Label, Request) -> call(Process, Label, Request, ?default_timeout). -%% Local or remote by pid -call(Pid, Label, Request, Timeout) - when is_pid(Pid), Timeout =:= infinity; - is_pid(Pid), is_integer(Timeout), Timeout >= 0 -> - do_call(Pid, Label, Request, Timeout); -%% Local by name -call(Name, Label, Request, Timeout) - when is_atom(Name), Timeout =:= infinity; - is_atom(Name), is_integer(Timeout), Timeout >= 0 -> - case whereis(Name) of - Pid when is_pid(Pid) -> - do_call(Pid, Label, Request, Timeout); - undefined -> - exit(noproc) - end; -%% Global by name call(Process, Label, Request, Timeout) - when ((tuple_size(Process) == 2 andalso element(1, Process) == global) - orelse - (tuple_size(Process) == 3 andalso element(1, Process) == via)) - andalso - (Timeout =:= infinity orelse (is_integer(Timeout) andalso Timeout >= 0)) -> - case where(Process) of - Pid when is_pid(Pid) -> - Node = node(Pid), - try do_call(Pid, Label, Request, Timeout) - catch - exit:{nodedown, Node} -> - %% A nodedown not yet detected by global, - %% pretend that it was. - exit(noproc) - end; - undefined -> - exit(noproc) - end; -%% Local by name in disguise -call({Name, Node}, Label, Request, Timeout) - when Node =:= node(), Timeout =:= infinity; - Node =:= node(), is_integer(Timeout), Timeout >= 0 -> - call(Name, Label, Request, Timeout); -%% Remote by name -call({_Name, Node}=Process, Label, Request, Timeout) - when is_atom(Node), Timeout =:= infinity; - is_atom(Node), is_integer(Timeout), Timeout >= 0 -> - if - node() =:= nonode@nohost -> - exit({nodedown, Node}); - true -> - do_call(Process, Label, Request, Timeout) - end. + when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 -> + Fun = fun(Pid) -> do_call(Pid, Label, Request, Timeout) end, + do_for_proc(Process, Fun). do_call(Process, Label, Request, Timeout) -> try erlang:monitor(process, Process) of @@ -276,6 +230,65 @@ reply({To, Tag}, Reply) -> Msg = {Tag, Reply}, try To ! Msg catch _:_ -> Msg end. +%%----------------------------------------------------------------- +%% Syncronously stop a generic process +%%----------------------------------------------------------------- +stop(Process) -> + stop(Process, normal, infinity). + +stop(Process, Reason, Timeout) + when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 -> + Fun = fun(Pid) -> proc_lib:stop(Pid, Reason, Timeout) end, + do_for_proc(Process, Fun). + +%%----------------------------------------------------------------- +%% Map different specifications of a process to either Pid or +%% {Name,Node}. Execute the given Fun with the process as only +%% argument. +%% ----------------------------------------------------------------- + +%% Local or remote by pid +do_for_proc(Pid, Fun) when is_pid(Pid) -> + Fun(Pid); +%% Local by name +do_for_proc(Name, Fun) when is_atom(Name) -> + case whereis(Name) of + Pid when is_pid(Pid) -> + Fun(Pid); + undefined -> + exit(noproc) + end; +%% Global by name +do_for_proc(Process, Fun) + when ((tuple_size(Process) == 2 andalso element(1, Process) == global) + orelse + (tuple_size(Process) == 3 andalso element(1, Process) == via)) -> + case where(Process) of + Pid when is_pid(Pid) -> + Node = node(Pid), + try Fun(Pid) + catch + exit:{nodedown, Node} -> + %% A nodedown not yet detected by global, + %% pretend that it was. + exit(noproc) + end; + undefined -> + exit(noproc) + end; +%% Local by name in disguise +do_for_proc({Name, Node}, Fun) when Node =:= node() -> + do_for_proc(Name, Fun); +%% Remote by name +do_for_proc({_Name, Node} = Process, Fun) when is_atom(Node) -> + if + node() =:= nonode@nohost -> + exit({nodedown, Node}); + true -> + Fun(Process) + end. + + %%%----------------------------------------------------------------- %%% Misc. functions. %%%----------------------------------------------------------------- diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index d39dd89d3a..5a1fff3a9c 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The 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,8 @@ %%% Modified by Martin - uses proc_lib, sys and gen! --export([start/0, start/1, start_link/0, start_link/1, stop/1, notify/2, - sync_notify/2, +-export([start/0, start/1, start_link/0, start_link/1, stop/1, stop/3, + notify/2, sync_notify/2, add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3, swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]). @@ -49,8 +49,6 @@ -import(error_logger, [error_msg/2]). --define(reply(X), From ! {element(2,Tag), X}). - -record(handler, {module :: atom(), id = false, state, @@ -101,6 +99,14 @@ -callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), Extra :: term()) -> {ok, NewState :: term()}. +-callback format_status(Opt, StatusData) -> Status when + Opt :: 'normal' | 'terminate', + StatusData :: [PDict | State], + PDict :: [{Key :: term(), Value :: term()}], + State :: term(), + Status :: term(). + +-optional_callbacks([format_status/2]). %%--------------------------------------------------------------------------- @@ -185,7 +191,11 @@ swap_sup_handler(M, {H1, A1}, {H2, A2}) -> which_handlers(M) -> rpc(M, which_handlers). -spec stop(emgr_ref()) -> 'ok'. -stop(M) -> rpc(M, stop). +stop(M) -> + gen:stop(M). + +stop(M, Reason, Timeout) -> + gen:stop(M, Reason, Timeout). rpc(M, Cmd) -> {ok, Reply} = gen:call(M, self(), Cmd, infinity), @@ -249,49 +259,49 @@ handle_msg(Msg, Parent, ServerName, MSL, Debug) -> {notify, Event} -> {Hib,MSL1} = server_notify(Event, handle_event, MSL, ServerName), loop(Parent, ServerName, MSL1, Debug, Hib); - {From, Tag, {sync_notify, Event}} -> + {_From, Tag, {sync_notify, Event}} -> {Hib, MSL1} = server_notify(Event, handle_event, MSL, ServerName), - ?reply(ok), + reply(Tag, ok), loop(Parent, ServerName, MSL1, Debug, Hib); {'EXIT', From, Reason} -> MSL1 = handle_exit(From, Reason, MSL, ServerName), loop(Parent, ServerName, MSL1, Debug, false); - {From, Tag, {call, Handler, Query}} -> + {_From, Tag, {call, Handler, Query}} -> {Hib, Reply, MSL1} = server_call(Handler, Query, MSL, ServerName), - ?reply(Reply), + reply(Tag, Reply), loop(Parent, ServerName, MSL1, Debug, Hib); - {From, Tag, {add_handler, Handler, Args}} -> + {_From, Tag, {add_handler, Handler, Args}} -> {Hib, Reply, MSL1} = server_add_handler(Handler, Args, MSL), - ?reply(Reply), + reply(Tag, Reply), loop(Parent, ServerName, MSL1, Debug, Hib); - {From, Tag, {add_sup_handler, Handler, Args, SupP}} -> + {_From, Tag, {add_sup_handler, Handler, Args, SupP}} -> {Hib, Reply, MSL1} = server_add_sup_handler(Handler, Args, MSL, SupP), - ?reply(Reply), + reply(Tag, Reply), loop(Parent, ServerName, MSL1, Debug, Hib); - {From, Tag, {delete_handler, Handler, Args}} -> + {_From, Tag, {delete_handler, Handler, Args}} -> {Reply, MSL1} = server_delete_handler(Handler, Args, MSL, ServerName), - ?reply(Reply), + reply(Tag, Reply), loop(Parent, ServerName, MSL1, Debug, false); - {From, Tag, {swap_handler, Handler1, Args1, Handler2, Args2}} -> + {_From, Tag, {swap_handler, Handler1, Args1, Handler2, Args2}} -> {Hib, Reply, MSL1} = server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, ServerName), - ?reply(Reply), + reply(Tag, Reply), loop(Parent, ServerName, MSL1, Debug, Hib); - {From, Tag, {swap_sup_handler, Handler1, Args1, Handler2, Args2, + {_From, Tag, {swap_sup_handler, Handler1, Args1, Handler2, Args2, Sup}} -> {Hib, Reply, MSL1} = server_swap_handler(Handler1, Args1, Handler2, Args2, MSL, Sup, ServerName), - ?reply(Reply), + reply(Tag, Reply), loop(Parent, ServerName, MSL1, Debug, Hib); - {From, Tag, stop} -> + {_From, Tag, stop} -> catch terminate_server(normal, Parent, MSL, ServerName), - ?reply(ok); - {From, Tag, which_handlers} -> - ?reply(the_handlers(MSL)), + reply(Tag, ok); + {_From, Tag, which_handlers} -> + reply(Tag, the_handlers(MSL)), loop(Parent, ServerName, MSL, Debug, false); - {From, Tag, get_modules} -> - ?reply(get_modules(MSL)), + {_From, Tag, get_modules} -> + reply(Tag, get_modules(MSL)), loop(Parent, ServerName, MSL, Debug, false); Other -> {Hib, MSL1} = server_notify(Other, handle_info, MSL, ServerName), @@ -303,6 +313,10 @@ terminate_server(Reason, Parent, MSL, ServerName) -> do_unlink(Parent, MSL), exit(Reason). +reply({From, Ref}, Msg) -> + From ! {Ref, Msg}, + ok. + %% unlink the supervisor process of all supervised handlers. %% We do not want a handler supervisor to EXIT due to the %% termination of the event manager (server). diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index e914f7d0b2..89825a6a57 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -106,6 +106,7 @@ -export([start/3, start/4, start_link/3, start_link/4, + stop/1, stop/3, send_event/2, sync_send_event/2, sync_send_event/3, send_all_state_event/2, sync_send_all_state_event/2, sync_send_all_state_event/3, @@ -160,6 +161,14 @@ -callback code_change(OldVsn :: term() | {down, term()}, StateName :: atom(), StateData :: term(), Extra :: term()) -> {ok, NextStateName :: atom(), NewStateData :: term()}. +-callback format_status(Opt, StatusData) -> Status when + Opt :: 'normal' | 'terminate', + StatusData :: [PDict | State], + PDict :: [{Key :: term(), Value :: term()}], + State :: term(), + Status :: term(). + +-optional_callbacks([format_status/2]). %%% --------------------------------------------------- %%% Starts a generic state machine. @@ -189,6 +198,11 @@ start_link(Mod, Args, Options) -> start_link(Name, Mod, Args, Options) -> gen:start(?MODULE, link, Name, Mod, Args, Options). +stop(Name) -> + gen:stop(Name). + +stop(Name, Reason, Timeout) -> + gen:stop(Name, Reason, Timeout). send_event({global, Name}, Event) -> catch global:send(Name, {'$gen_event', Event}), @@ -594,7 +608,8 @@ reply(Name, {To, Tag}, Reply, Debug, StateName) -> terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> case catch Mod:terminate(Reason, StateName, StateData) of {'EXIT', R} -> - error_info(R, Name, Msg, StateName, StateData, Debug), + FmtStateData = format_status(terminate, Mod, get(), StateData), + error_info(R, Name, Msg, StateName, FmtStateData, Debug), exit(R); _ -> case Reason of @@ -605,17 +620,7 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - FmtStateData = - case erlang:function_exported(Mod, format_status, 2) of - true -> - Args = [get(), StateData], - case catch Mod:format_status(terminate, Args) of - {'EXIT', _} -> StateData; - Else -> Else - end; - _ -> - StateData - end, + FmtStateData = format_status(terminate, Mod, get(), StateData), error_info(Reason,Name,Msg,StateName,FmtStateData,Debug), exit(Reason) end @@ -680,21 +685,29 @@ format_status(Opt, StatusData) -> Header = gen:format_status_header("Status for state machine", Name), Log = sys:get_debug(log, Debug, []), - DefaultStatus = [{data, [{"StateData", StateData}]}], - Specfic = - case erlang:function_exported(Mod, format_status, 2) of - true -> - case catch Mod:format_status(Opt,[PDict,StateData]) of - {'EXIT', _} -> DefaultStatus; - StatusList when is_list(StatusList) -> StatusList; - Else -> [Else] - end; - _ -> - DefaultStatus - end, + Specfic = format_status(Opt, Mod, PDict, StateData), + Specfic = case format_status(Opt, Mod, PDict, StateData) of + S when is_list(S) -> S; + S -> [S] + end, [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}, {"Logged events", Log}, {"StateName", StateName}]} | Specfic]. + +format_status(Opt, Mod, PDict, State) -> + DefStatus = case Opt of + terminate -> State; + _ -> [{data, [{"StateData", State}]}] + end, + case erlang:function_exported(Mod, format_status, 2) of + true -> + case catch Mod:format_status(Opt, [PDict, State]) of + {'EXIT', _} -> DefStatus; + Else -> Else + end; + _ -> + DefStatus + end. diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 202a931fae..2d8d7f6233 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -88,6 +88,7 @@ %% API -export([start/3, start/4, start_link/3, start_link/4, + stop/1, stop/3, call/2, call/3, cast/2, reply/2, abcast/2, abcast/3, @@ -137,6 +138,15 @@ -callback code_change(OldVsn :: (term() | {down, term()}), State :: term(), Extra :: term()) -> {ok, NewState :: term()} | {error, Reason :: term()}. +-callback format_status(Opt, StatusData) -> Status when + Opt :: 'normal' | 'terminate', + StatusData :: [PDict | State], + PDict :: [{Key :: term(), Value :: term()}], + State :: term(), + Status :: term(). + +-optional_callbacks([format_status/2]). + %%% ----------------------------------------------------------------- %%% Starts a generic server. @@ -168,6 +178,17 @@ start_link(Name, Mod, Args, Options) -> %% ----------------------------------------------------------------- +%% Stop a generic server and wait for it to terminate. +%% If the server is located at another node, that node will +%% be monitored. +%% ----------------------------------------------------------------- +stop(Name) -> + gen:stop(Name). + +stop(Name, Reason, Timeout) -> + gen:stop(Name, Reason, Timeout). + +%% ----------------------------------------------------------------- %% Make a call to a generic server. %% If the server is located at another node, that node will %% be monitored. @@ -720,7 +741,8 @@ print_event(Dev, Event, Name) -> terminate(Reason, Name, Msg, Mod, State, Debug) -> case catch Mod:terminate(Reason, State) of {'EXIT', R} -> - error_info(R, Name, Msg, State, Debug), + FmtState = format_status(terminate, Mod, get(), State), + error_info(R, Name, Msg, FmtState, Debug), exit(R); _ -> case Reason of @@ -731,17 +753,7 @@ terminate(Reason, Name, Msg, Mod, State, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - FmtState = - case erlang:function_exported(Mod, format_status, 2) of - true -> - Args = [get(), State], - case catch Mod:format_status(terminate, Args) of - {'EXIT', _} -> State; - Else -> Else - end; - _ -> - State - end, + FmtState = format_status(terminate, Mod, get(), State), error_info(Reason, Name, Msg, FmtState, Debug), exit(Reason) end @@ -791,22 +803,10 @@ opt(_, []) -> debug_options(Name, Opts) -> case opt(debug, Opts) of - {ok, Options} -> dbg_options(Name, Options); - _ -> dbg_options(Name, []) + {ok, Options} -> dbg_opts(Name, Options); + _ -> [] end. -dbg_options(Name, []) -> - Opts = - case init:get_argument(generic_debug) of - error -> - []; - _ -> - [log, statistics] - end, - dbg_opts(Name, Opts); -dbg_options(Name, Opts) -> - dbg_opts(Name, Opts). - dbg_opts(Name, Opts) -> case catch sys:debug_options(Opts) of {'EXIT',_} -> @@ -875,23 +875,29 @@ name_to_pid(Name) -> %%----------------------------------------------------------------- format_status(Opt, StatusData) -> [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData, - Header = gen:format_status_header("Status for generic server", - Name), + Header = gen:format_status_header("Status for generic server", Name), Log = sys:get_debug(log, Debug, []), - DefaultStatus = [{data, [{"State", State}]}], - Specfic = - case erlang:function_exported(Mod, format_status, 2) of - true -> - case catch Mod:format_status(Opt, [PDict, State]) of - {'EXIT', _} -> DefaultStatus; - StatusList when is_list(StatusList) -> StatusList; - Else -> [Else] - end; - _ -> - DefaultStatus - end, + Specfic = case format_status(Opt, Mod, PDict, State) of + S when is_list(S) -> S; + S -> [S] + end, [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}, {"Logged events", Log}]} | Specfic]. + +format_status(Opt, Mod, PDict, State) -> + DefStatus = case Opt of + terminate -> State; + _ -> [{data, [{"State", State}]}] + end, + case erlang:function_exported(Mod, format_status, 2) of + true -> + case catch Mod:format_status(Opt, [PDict, State]) of + {'EXIT', _} -> DefStatus; + Else -> Else + end; + _ -> + DefStatus + end. diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index 3f019aa35a..ba4d6a5c87 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -24,6 +24,7 @@ map/2, size/1, without/2, + with/2, get/3 ]). @@ -201,3 +202,13 @@ size(Map) when is_map(Map) -> without(Ks, M) when is_list(Ks), is_map(M) -> maps:from_list([{K,V}||{K,V} <- maps:to_list(M), not lists:member(K, Ks)]). + + +-spec with(Ks, Map1) -> Map2 when + Ks :: [K], + Map1 :: map(), + Map2 :: map(), + K :: term(). + +with(Ks, M) when is_list(Ks), is_map(M) -> + maps:from_list([{K,V}||{K,V} <- maps:to_list(M), lists:member(K, Ks)]). diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index c0ee8799c8..0ace87ef5c 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -421,13 +421,13 @@ obsolete_1(ssh_cm, stop_listener, 1) -> obsolete_1(ssh_cm, session_open, A) when A =:= 2; A =:= 4 -> {removed,{ssh_connection,session_channel,A},"R14B"}; obsolete_1(ssh_cm, direct_tcpip, A) when A =:= 6; A =:= 8 -> - {removed,{ssh_connection,direct_tcpip,A}}; + {removed,{ssh_connection,direct_tcpip,A},"R14B"}; obsolete_1(ssh_cm, tcpip_forward, 3) -> {removed,{ssh_connection,tcpip_forward,3},"R14B"}; obsolete_1(ssh_cm, cancel_tcpip_forward, 3) -> {removed,{ssh_connection,cancel_tcpip_forward,3},"R14B"}; obsolete_1(ssh_cm, open_pty, A) when A =:= 3; A =:= 7; A =:= 9 -> - {removed,{ssh_connection,open_pty,A},"R14"}; + {removed,{ssh_connection,open_pty,A},"R14B"}; obsolete_1(ssh_cm, setenv, 5) -> {removed,{ssh_connection,setenv,5},"R14B"}; obsolete_1(ssh_cm, shell, 2) -> @@ -441,11 +441,11 @@ obsolete_1(ssh_cm, winch, A) when A =:= 4; A =:= 6 -> obsolete_1(ssh_cm, signal, 3) -> {removed,{ssh_connection,signal,3},"R14B"}; obsolete_1(ssh_cm, attach, A) when A =:= 2; A =:= 3 -> - {removed,{ssh,attach,A}}; + {removed,"no longer useful; removed in R14B"}; obsolete_1(ssh_cm, detach, 2) -> - {removed,"no longer useful; will be removed in R14B"}; + {removed,"no longer useful; removed in R14B"}; obsolete_1(ssh_cm, set_user_ack, 4) -> - {removed,"no longer useful; will be removed in R14B"}; + {removed,"no longer useful; removed in R14B"}; obsolete_1(ssh_cm, adjust_window, 3) -> {removed,{ssh_connection,adjust_window,3},"R14B"}; obsolete_1(ssh_cm, close, 2) -> @@ -461,9 +461,9 @@ obsolete_1(ssh_cm, send_ack, A) when 3 =< A, A =< 5 -> obsolete_1(ssh_ssh, connect, A) when 1 =< A, A =< 3 -> {removed,{ssh,shell,A},"R14B"}; obsolete_1(ssh_sshd, listen, A) when 0 =< A, A =< 3 -> - {removed,{ssh,daemon,[1,2,3]},"R14"}; + {removed,{ssh,daemon,[1,2,3]},"R14B"}; obsolete_1(ssh_sshd, stop, 1) -> - {removed,{ssh,stop_listener,1}}; + {removed,{ssh,stop_listener,1},"R14B"}; %% Added in R13A. obsolete_1(regexp, _, _) -> @@ -577,8 +577,6 @@ obsolete_1(asn1rt, utf8_binary_to_list, 1) -> {deprecated,{unicode,characters_to_list,1}}; obsolete_1(asn1rt, utf8_list_to_binary, 1) -> {deprecated,{unicode,characters_to_binary,1}}; -obsolete_1(pg, _, _) -> - {deprecated,"deprecated; will be removed in OTP 18"}; obsolete_1(_, _, _) -> no. diff --git a/lib/stdlib/src/pg.erl b/lib/stdlib/src/pg.erl deleted file mode 100644 index a41fd329c2..0000000000 --- a/lib/stdlib/src/pg.erl +++ /dev/null @@ -1,187 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. -%% -%% The 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(pg). --deprecated(module). - -%% pg provides a process group facility. Messages -%% can be multicasted to all members in the group - --export([create/1, - create/2, - standby/2, - join/2, - send/2, - esend/2, - members/1, - name_to_pid/1, - master/1]). - - -%% Create a brand new empty process group with the master residing -%% at the local node - --spec create(PgName) -> 'ok' | {'error', Reason} when - PgName :: term(), - Reason :: 'already_created' | term(). - -create(PgName) -> - catch begin check(PgName), - Pid = spawn(pg,master,[PgName]), - global:register_name(PgName,Pid), - ok end. - -%% Create a brand new empty process group with the master -%% residing at Node - --spec create(PgName, Node) -> 'ok' | {'error', Reason} when - PgName :: term(), - Node :: node(), - Reason :: 'already_created' | term(). - -create(PgName, Node) -> - catch begin check(PgName), - Pid = spawn(Node,pg,master,[PgName]), - global:register_name(PgName,Pid), - ok end. - -%% Have a process on Node that will act as a standby for the process -%% group manager. So if the node where the manager runs fails, the -%% process group will continue to function. - --spec standby(term(), node()) -> 'ok'. - -standby(_PgName, _Node) -> - ok. - -%% Tell process group PgName that Pid is a new member of the group -%% synchronously return a list of all old members in the group - --spec join(PgName, Pid) -> Members when - PgName :: term(), - Pid :: pid(), - Members :: [pid()]. - -join(PgName, Pid) when is_atom(PgName) -> - global:send(PgName, {join,self(),Pid}), - receive - {_P,{members,Members}} -> - Members - end. - -%% Multi cast Mess to all members in the group - --spec send(PgName, Msg) -> 'ok' when - PgName :: term(), - Msg :: term(). - -send(PgName, Mess) when is_atom(PgName) -> - global:send(PgName, {send, self(), Mess}), - ok; -send(Pg, Mess) when is_pid(Pg) -> - Pg ! {send,self(),Mess}, - ok. - -%% multi cast a message to all members in the group but ourselves -%% If we are a member - --spec esend(PgName, Msg) -> 'ok' when - PgName :: term(), - Msg :: term(). - -esend(PgName, Mess) when is_atom(PgName) -> - global:send(PgName, {esend,self(),Mess}), - ok; -esend(Pg, Mess) when is_pid(Pg) -> - Pg ! {esend,self(),Mess}, - ok. - -%% Return the members of the group - --spec members(PgName) -> Members when - PgName :: term(), - Members :: [pid()]. - -members(PgName) when is_atom(PgName) -> - global:send(PgName, {self() ,members}), - receive - {_P,{members,Members}} -> - Members - end; -members(Pg) when is_pid(Pg) -> - Pg ! {self,members}, - receive - {_P,{members,Members}} -> - Members - end. - --spec name_to_pid(atom()) -> pid() | 'undefined'. - -name_to_pid(PgName) when is_atom(PgName) -> - global:whereis_name(PgName). - --spec master(term()) -> no_return(). - -master(PgName) -> - process_flag(trap_exit, true), - master_loop(PgName, []). - -master_loop(PgName,Members) -> - receive - {send,From,Message} -> - send_all(Members,{pg_message,From,PgName,Message}), - master_loop(PgName,Members); - {esend,From,Message} -> - send_all(lists:delete(From,Members), - {pg_message,From,PgName,Message}), - master_loop(PgName,Members); - {join,From,Pid} -> - link(Pid), - send_all(Members,{new_member,PgName,Pid}), - From ! {self(),{members,Members}}, - master_loop(PgName,[Pid|Members]); - {From,members} -> - From ! {self(),{members,Members}}, - master_loop(PgName,Members); - {'EXIT',From,_} -> - L = - case lists:member(From,Members) of - true -> - NewMembers = lists:delete(From,Members), - send_all(NewMembers, {crashed_member,PgName,From}), - NewMembers; - false -> - Members - end, - master_loop(PgName,L) - end. - -send_all([], _) -> ok; -send_all([P|Ps], M) -> - P ! M, - send_all(Ps, M). - -%% Check if the process group already exists - -check(PgName) -> - case global:whereis_name(PgName) of - Pid when is_pid(Pid) -> - throw({error,already_created}); - undefined -> - ok - end. diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 1eb6fc2e86..8792ff44d3 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The 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,7 +30,8 @@ hibernate/3, init_ack/1, init_ack/2, init_p/3,init_p/5,format/1,format/2,initial_call/1, - translate_initial_call/1]). + translate_initial_call/1, + stop/1, stop/3]). %% Internal exports. -export([wake_up/3]). @@ -216,10 +217,8 @@ ensure_link(SpawnOpts) -> init_p(Parent, Ancestors, Fun) when is_function(Fun) -> put('$ancestors', [Parent|Ancestors]), - {module,Mod} = erlang:fun_info(Fun, module), - {name,Name} = erlang:fun_info(Fun, name), - {arity,Arity} = erlang:fun_info(Fun, arity), - put('$initial_call', {Mod,Name,Arity}), + Mfa = erlang:fun_info_mfa(Fun), + put('$initial_call', Mfa), try Fun() catch @@ -750,3 +749,50 @@ format_tag(Tag, Data) -> modifier(latin1) -> ""; modifier(_) -> "t". + + +%%% ----------------------------------------------------------- +%%% Stop a process and wait for it to terminate +%%% ----------------------------------------------------------- +-spec stop(Process) -> 'ok' when + Process :: pid() | RegName | {RegName,node()}, + RegName :: atom(). +stop(Process) -> + stop(Process, normal, infinity). + +-spec stop(Process, Reason, Timeout) -> 'ok' when + Process :: pid() | RegName | {RegName,node()}, + RegName :: atom(), + Reason :: term(), + Timeout :: timeout(). +stop(Process, Reason, Timeout) -> + {Pid, Mref} = erlang:spawn_monitor(do_stop(Process, Reason)), + receive + {'DOWN', Mref, _, _, Reason} -> + ok; + {'DOWN', Mref, _, _, {noproc,{sys,terminate,_}}} -> + exit(noproc); + {'DOWN', Mref, _, _, CrashReason} -> + exit(CrashReason) + after Timeout -> + exit(Pid, kill), + receive + {'DOWN', Mref, _, _, _} -> + exit(timeout) + end + end. + +-spec do_stop(Process, Reason) -> Fun when + Process :: pid() | RegName | {RegName,node()}, + RegName :: atom(), + Reason :: term(), + Fun :: fun(() -> no_return()). +do_stop(Process, Reason) -> + fun() -> + Mref = erlang:monitor(process, Process), + ok = sys:terminate(Process, Reason, infinity), + receive + {'DOWN', Mref, _, _, ExitReason} -> + exit(ExitReason) + end + end. diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 3585eec342..f134c75869 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -77,7 +77,6 @@ orddict, ordsets, otp_internal, - pg, pool, proc_lib, proplists, @@ -103,7 +102,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.4","kernel-3.0.2","erts-6.1.2","crypto-3.3", + {runtime_dependencies, ["sasl-2.4","kernel-3.0.2","erts-6.2","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index 99d9b8b431..5900fd3ff3 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -17,11 +17,9 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"2\\.1(\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1 - {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.0 - {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 + [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 + {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0 %% Down to - max one major revision back - [{<<"2\\.1(\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1 - {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.0 - {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 + [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 + {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] %% 17.0 }. diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index d3ba09ce82..7e4bfa1fdd 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -24,6 +24,7 @@ get_state/1, get_state/2, replace_state/2, replace_state/3, change_code/4, change_code/5, + terminate/2, terminate/3, log/2, log/3, trace/2, trace/3, statistics/2, statistics/3, log_to_file/2, log_to_file/3, no_debug/1, no_debug/2, install/2, install/3, remove/2, remove/3]). @@ -163,6 +164,19 @@ change_code(Name, Mod, Vsn, Extra) -> change_code(Name, Mod, Vsn, Extra, Timeout) -> send_system_msg(Name, {change_code, Mod, Vsn, Extra}, Timeout). +-spec terminate(Name, Reason) -> 'ok' when + Name :: name(), + Reason :: term(). +terminate(Name, Reason) -> + send_system_msg(Name, {terminate, Reason}). + +-spec terminate(Name, Reason, Timeout) -> 'ok' when + Name :: name(), + Reason :: term(), + Timeout :: timeout(). +terminate(Name, Reason, Timeout) -> + send_system_msg(Name, {terminate, Reason}, Timeout). + %%----------------------------------------------------------------- %% Debug commands %%----------------------------------------------------------------- @@ -298,6 +312,8 @@ mfa(Name, {debug, {Func, Arg2}}) -> {sys, Func, [Name, Arg2]}; mfa(Name, {change_code, Mod, Vsn, Extra}) -> {sys, change_code, [Name, Mod, Vsn, Extra]}; +mfa(Name, {terminate, Reason}) -> + {sys, terminate, [Name, Reason]}; mfa(Name, Atom) -> {sys, Atom, [Name]}. @@ -313,7 +329,7 @@ mfa(Name, Req, Timeout) -> %% Returns: This function *never* returns! It calls the function %% Module:system_continue(Parent, NDebug, Misc) %% there the process continues the execution or -%% Module:system_terminate(Raeson, Parent, Debug, Misc) if +%% Module:system_terminate(Reason, Parent, Debug, Misc) if %% the process should terminate. %% The Module must export system_continue/3, system_terminate/4 %% and format_status/2 for status information. @@ -339,7 +355,10 @@ handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc, Hib) -> suspend_loop(suspended, Parent, Mod, NDebug, NMisc, Hib); {running, Reply, NDebug, NMisc} -> _ = gen:reply(From, Reply), - Mod:system_continue(Parent, NDebug, NMisc) + Mod:system_continue(Parent, NDebug, NMisc); + {{terminating, Reason}, Reply, NDebug, NMisc} -> + _ = gen:reply(From, Reply), + Mod:system_terminate(Reason, Parent, NDebug, NMisc) end. %%----------------------------------------------------------------- @@ -419,6 +438,8 @@ do_cmd(SysState, get_status, Parent, Mod, Debug, Misc) -> do_cmd(SysState, {debug, What}, _Parent, _Mod, Debug, Misc) -> {Res, NDebug} = debug_cmd(What, Debug), {SysState, Res, NDebug, Misc}; +do_cmd(_, {terminate, Reason}, _Parent, _Mod, Debug, Misc) -> + {{terminating, Reason}, ok, Debug, Misc}; do_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent, Mod, Debug, Misc) -> {Res, NMisc} = do_change_code(Mod, Module, Vsn, Extra, Misc), diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index 119b4dc7cb..3b08ac165e 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -223,8 +223,7 @@ open(Config, Version) -> ?format("Crashing dets server \n", []), process_flag(trap_exit, true), - Procs = [whereis(?DETS_SERVER) | map(fun(Tab) -> dets:info(Tab, pid) end, - Tabs)], + Procs = [whereis(?DETS_SERVER) | [dets:info(Tab, pid) || Tab <- Tabs]], foreach(fun(Pid) -> exit(Pid, kill) end, Procs), timer:sleep(100), c:flush(), %% flush all the EXIT sigs @@ -235,18 +234,32 @@ open(Config, Version) -> open_files(1, All, Version), ?format("Checking contents of repaired files \n", []), check(Tabs, Data), - - close_all(Tabs), + close_all(Tabs), delete_files(All), - P1 = pps(), + {Ports0, Procs0} = P0, - {Ports1, Procs1} = P1, - true = Ports1 =:= Ports0, - %% The dets_server process has been restarted: - [_] = Procs0 -- Procs1, - [_] = Procs1 -- Procs0, - ok. + Test = fun() -> + P1 = pps(), + {Ports1, Procs1} = P1, + show("Old port", Ports0 -- Ports1), + show("New port", Ports1 -- Ports0), + show("Old procs", Procs0 -- Procs1), + show("New procs", Procs1 -- Procs0), + io:format("Remaining Dets-pids (should be nil): ~p~n", + [find_dets_pids()]), + true = Ports1 =:= Ports0, + %% The dets_server process has been restarted: + [_] = Procs0 -- Procs1, + [_] = Procs1 -- Procs0, + ok + end, + case catch Test() of + ok -> ok; + _ -> + timer:sleep(500), + ok = Test() + end. check(Tabs, Data) -> foreach(fun(Tab) -> @@ -3275,12 +3288,22 @@ simultaneous_open(Config) -> File = filename(Tab, Config), ok = monit(Tab, File), - ok = kill_while_repairing(Tab, File), - ok = kill_while_init(Tab, File), - ok = open_ro(Tab, File), - ok = open_w(Tab, File, 0, Config), - ok = open_w(Tab, File, 100, Config), - ok. + case feasible() of + false -> {comment, "OK, but did not run all of the test"}; + true -> + ok = kill_while_repairing(Tab, File), + ok = kill_while_init(Tab, File), + ok = open_ro(Tab, File), + ok = open_w(Tab, File, 0, Config), + ok = open_w(Tab, File, 100, Config) + end. + +feasible() -> + LP = erlang:system_info(logical_processors), + (is_integer(LP) + andalso LP >= erlang:system_info(schedulers_online) + andalso not erlang:system_info(debug_compiled) + andalso not erlang:system_info(lock_checking)). %% One process logs and another process closes the log. Before %% monitors were used, this would make the client never return. @@ -3307,7 +3330,6 @@ kill_while_repairing(Tab, File) -> Delay = 1000, dets:start(), Parent = self(), - Ps = processes(), F = fun() -> R = (catch dets:open_file(Tab, [{file,File}])), timer:sleep(Delay), @@ -3318,7 +3340,7 @@ kill_while_repairing(Tab, File) -> P1 = spawn(F), P2 = spawn(F), P3 = spawn(F), - DetsPid = find_dets_pid([P1, P2, P3 | Ps]), + DetsPid = find_dets_pid(), exit(DetsPid, kill), receive {P1,R1} -> R1 end, @@ -3342,12 +3364,6 @@ kill_while_repairing(Tab, File) -> file:delete(File), ok. -find_dets_pid(P0) -> - case lists:sort(processes() -- P0) of - [P, _] -> P; - _ -> timer:sleep(100), find_dets_pid(P0) - end. - find_dets_pid() -> case find_dets_pids() of [] -> @@ -3421,6 +3437,13 @@ open_ro(Tab, File) -> open_w(Tab, File, Delay, Config) -> create_opened_log(File), + + Tab2 = t2, + File2 = filename(Tab2, Config), + file:delete(File2), + {ok,Tab2} = dets:open_file(Tab2, [{file,File2}]), + ok = dets:close(Tab2), + Parent = self(), F = fun() -> R = dets:open_file(Tab, [{file,File}]), @@ -3430,16 +3453,16 @@ open_w(Tab, File, Delay, Config) -> Pid1 = spawn(F), Pid2 = spawn(F), Pid3 = spawn(F), - undefined = dets:info(Tab), % is repairing now - 0 = qlen(), - Tab2 = t2, - File2 = filename(Tab2, Config), - file:delete(File2), + ok = wait_for_repair_to_start(Tab), + + %% It is assumed that it takes some time to repair the file. {ok,Tab2} = dets:open_file(Tab2, [{file,File2}]), + %% The Dets server managed to handle to open_file request. + 0 = qlen(), % still repairing + ok = dets:close(Tab2), file:delete(File2), - 0 = qlen(), % still repairing receive {Pid1,R1} -> {ok, Tab} = R1 end, receive {Pid2,R2} -> {ok, Tab} = R2 end, @@ -3456,6 +3479,15 @@ open_w(Tab, File, Delay, Config) -> file:delete(File), ok. +wait_for_repair_to_start(Tab) -> + case catch dets_server:get_pid(Tab) of + {'EXIT', _} -> + timer:sleep(1), + wait_for_repair_to_start(Tab); + Pid when is_pid(Pid) -> + ok + end. + qlen() -> {_, {_, N}} = lists:keysearch(message_queue_len, 1, process_info(self())), N. @@ -4350,6 +4382,7 @@ check_badarg({'EXIT', {badarg, [{M,F,A,_} | _]}}, M, F, Args) -> true = test_server:is_native(M) andalso length(Args) =:= A. check_pps({Ports0,Procs0} = P0) -> + ok = check_dets_tables(), case pps() of P0 -> ok; @@ -4375,13 +4408,45 @@ check_pps({Ports0,Procs0} = P0) -> end end. +%% Copied from dets_server.erl: +-define(REGISTRY, dets_registry). +-define(OWNERS, dets_owners). +-define(STORE, dets). + +check_dets_tables() -> + Store = [T || + T <- ets:all(), + ets:info(T, name) =:= ?STORE, + owner(T) =:= dets], + S = case Store of + [Tab] -> ets:tab2list(Tab); + [] -> [] + end, + case {ets:tab2list(?REGISTRY), ets:tab2list(?OWNERS), S} of + {[], [], []} -> ok; + {R, O, _} -> + io:format("Registry: ~p~n", [R]), + io:format("Owners: ~p~n", [O]), + io:format("Store: ~p~n", [S]), + not_ok + end. + +owner(Tab) -> + Owner = ets:info(Tab, owner), + case process_info(Owner, registered_name) of + {registered_name, Name} -> Name; + _ -> Owner + end. + show(_S, []) -> ok; -show(S, [Pid|Pids]) when is_pid(Pid) -> - io:format("~s: ~p~n", [S, erlang:process_info(Pid)]), +show(S, [{Pid, Name, InitCall}|Pids]) when is_pid(Pid) -> + io:format("~s: ~w (~w), ~w: ~p~n", + [S, Pid, proc_reg_name(Name), InitCall, + erlang:process_info(Pid)]), show(S, Pids); -show(S, [Port|Ports]) when is_port(Port)-> - io:format("~s: ~p~n", [S, erlang:port_info(Port)]), +show(S, [{Port, _}|Ports]) when is_port(Port)-> + io:format("~s: ~w: ~p~n", [S, Port, erlang:port_info(Port)]), show(S, Ports). pps() -> @@ -4397,5 +4462,8 @@ process_list() -> safe_second_element(process_info(P, initial_call))} || P <- processes()]. +proc_reg_name({registered_name, Name}) -> Name; +proc_reg_name([]) -> no_reg_name. + safe_second_element({_,Info}) -> Info; safe_second_element(Other) -> Other. diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index b55324161b..3427f431c5 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1458,6 +1458,30 @@ eep43(Config) when is_list(Config) -> "lists:map(fun (X) -> X#{price := 0} end, [#{hello => 0, price => nil}]).", [#{hello => 0, price => 0}]), + check(fun () -> + Map = #{ <<33:333>> => "wat" }, + #{ <<33:333>> := "wat" } = Map + end, + "begin " + " Map = #{ <<33:333>> => \"wat\" }, " + " #{ <<33:333>> := \"wat\" } = Map " + "end.", + #{ <<33:333>> => "wat" }), + check(fun () -> + K1 = 1, + K2 = <<42:301>>, + K3 = {3,K2}, + Map = #{ K1 => 1, K2 => 2, K3 => 3, {2,2} => 4}, + #{ K1 := 1, K2 := 2, K3 := 3, {2,2} := 4} = Map + end, + "begin " + " K1 = 1, " + " K2 = <<42:301>>, " + " K3 = {3,K2}, " + " Map = #{ K1 => 1, K2 => 2, K3 => 3, {2,2} => 4}, " + " #{ K1 := 1, K2 := 2, K3 := 3, {2,2} := 4} = Map " + "end.", + #{ 1 => 1, <<42:301>> => 2, {3,<<42:301>>} => 3, {2,2} => 4}), error_check("[camembert]#{}.", {badarg,[camembert]}), error_check("#{} = 1.", {badmatch,1}), ok. diff --git a/lib/stdlib/test/erl_internal_SUITE.erl b/lib/stdlib/test/erl_internal_SUITE.erl index b6b3c004ea..197a7a33eb 100644 --- a/lib/stdlib/test/erl_internal_SUITE.erl +++ b/lib/stdlib/test/erl_internal_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -51,7 +51,7 @@ end_per_group(_GroupName, Config) -> -define(default_timeout, ?t:minutes(2)). init_per_testcase(_Case, Config) -> - ?line Dog = test_server:timetrap(?default_timeout), + Dog = test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -63,27 +63,50 @@ behav(suite) -> []; behav(doc) -> ["Check that the behaviour callbacks are correctly defined"]; behav(_) -> - ?line check_behav_list([{start,2}, {stop,1}], - application:behaviour_info(callbacks)), - ?line check_behav_list([{init,1}, {handle_call,3}, {handle_cast,2}, - {handle_info,2}, {terminate,2}, {code_change,3}], - gen_server:behaviour_info(callbacks)), - ?line check_behav_list([{init,1}, {handle_event,3}, {handle_sync_event,4}, - {handle_info,3}, {terminate,3}, {code_change,4}], - gen_fsm:behaviour_info(callbacks)), - ?line check_behav_list([{init,1}, {handle_event,2}, {handle_call,2}, - {handle_info,2}, {terminate,2}, {code_change,3}], - gen_event:behaviour_info(callbacks)), - ?line check_behav_list( [{init,1}, {terminate,2}], - supervisor_bridge:behaviour_info(callbacks)), - ?line check_behav_list([{init,1}], - supervisor:behaviour_info(callbacks)), - ok. + Modules = [application, gen_server, gen_fsm, gen_event, + supervisor_bridge, supervisor], + lists:foreach(fun check_behav/1, Modules). + +check_behav(Module) -> + Callbacks = callbacks(Module), + Optional = optional_callbacks(Module), + check_behav_list(Callbacks, Module:behaviour_info(callbacks)), + check_behav_list(Optional, Module:behaviour_info(optional_callbacks)). check_behav_list([], []) -> ok; check_behav_list([L | L1], L2) -> - ?line true = lists:member(L, L2), - ?line L3 = lists:delete(L, L2), + true = lists:member(L, L2), + L3 = lists:delete(L, L2), check_behav_list(L1, L3). - +callbacks(application) -> + [{start,2}, {stop,1}]; +callbacks(gen_server) -> + [{init,1}, {handle_call,3}, {handle_cast,2}, + {handle_info,2}, {terminate,2}, {code_change,3}, + {format_status,2}]; +callbacks(gen_fsm) -> + [{init,1}, {handle_event,3}, {handle_sync_event,4}, + {handle_info,3}, {terminate,3}, {code_change,4}, + {format_status,2}]; +callbacks(gen_event) -> + [{init,1}, {handle_event,2}, {handle_call,2}, + {handle_info,2}, {terminate,2}, {code_change,3}, + {format_status,2}]; +callbacks(supervisor_bridge) -> + [{init,1}, {terminate,2}]; +callbacks(supervisor) -> + [{init,1}]. + +optional_callbacks(application) -> + []; +optional_callbacks(gen_server) -> + [{format_status,2}]; +optional_callbacks(gen_fsm) -> + [{format_status,2}]; +optional_callbacks(gen_event) -> + [{format_status,2}]; +optional_callbacks(supervisor_bridge) -> + []; +optional_callbacks(supervisor) -> + []. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index ea61b2082b..f8a99f653a 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -42,6 +42,7 @@ unused_vars_warn_rec/1, unused_vars_warn_fun/1, unused_vars_OTP_4858/1, + unused_unsafe_vars_warn/1, export_vars_warn/1, shadow_vars/1, unused_import/1, @@ -55,7 +56,7 @@ otp_11772/1, otp_11771/1, otp_11872/1, export_all/1, bif_clash/1, - behaviour_basic/1, behaviour_multiple/1, + behaviour_basic/1, behaviour_multiple/1, otp_11861/1, otp_7550/1, otp_8051/1, format_warn/1, @@ -63,7 +64,7 @@ too_many_arguments/1, basic_errors/1,bin_syntax_errors/1, predef/1, - maps/1,maps_type/1 + maps/1,maps_type/1,otp_11851/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -89,16 +90,16 @@ all() -> otp_5362, otp_5371, otp_7227, otp_5494, otp_5644, otp_5878, otp_5917, otp_6585, otp_6885, otp_10436, otp_11254, otp_11772, otp_11771, otp_11872, export_all, - bif_clash, behaviour_basic, behaviour_multiple, + bif_clash, behaviour_basic, behaviour_multiple, otp_11861, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, - maps, maps_type]. + maps, maps_type, otp_11851]. groups() -> [{unused_vars_warn, [], [unused_vars_warn_basic, unused_vars_warn_lc, unused_vars_warn_rec, unused_vars_warn_fun, - unused_vars_OTP_4858]}, + unused_vars_OTP_4858, unused_unsafe_vars_warn]}, {on_load, [], [on_load_successful, on_load_failing]}]. init_per_suite(Config) -> @@ -730,6 +731,48 @@ unused_vars_OTP_4858(Config) when is_list(Config) -> ?line [] = run(Config, Ts), ok. +unused_unsafe_vars_warn(Config) when is_list(Config) -> + Ts = [{unused_unsafe1, + <<"t1() -> + UnusedVar1 = unused1, + try + UnusedVar2 = unused2 + catch + _:_ -> + ok + end, + ok. + ">>, + [warn_unused_vars], + {warnings,[{2,erl_lint,{unused_var,'UnusedVar1'}}, + {4,erl_lint,{unused_var,'UnusedVar2'}}]}}, + {unused_unsafe2, + <<"t2() -> + try + X = 1 + catch + _:_ -> ok + end. + ">>, + [warn_unused_vars], + {warnings,[{3,erl_lint,{unused_var,'X'}}]}}, + {unused_unsafe2, + <<"t3(X, Y) -> + X andalso Y. + ">>, + [warn_unused_vars], + []}, + {unused_unsafe4, + <<"t4() -> + _ = (catch X = X = 1), + _ = case ok of _ -> fun() -> ok end end, + fun (X) -> X end. + ">>, + [warn_unused_vars], + []}], + run(Config, Ts), + ok. + export_vars_warn(doc) -> "Warnings for exported variables"; export_vars_warn(suite) -> []; @@ -808,7 +851,19 @@ export_vars_warn(Config) when is_list(Config) -> [], {error,[{9,erl_lint,{unbound_var,'B'}}], [{9,erl_lint,{exported_var,'Y',{'receive',2}}}, - {10,erl_lint,{shadowed_var,'B',generate}}]}} + {10,erl_lint,{shadowed_var,'B',generate}}]}}, + + {exp4, + <<"t(X) -> + if true -> Z = X end, + case X of + 1 -> Z; + 2 -> X + end, + Z = X. + ">>, + [], + {warnings,[{7,erl_lint,{exported_var,'Z',{'if',2}}}]}} ], ?line [] = run(Config, Ts), ok. @@ -832,8 +887,15 @@ shadow_vars(Config) when is_list(Config) -> ">>, [nowarn_shadow_vars], {error,[{9,erl_lint,{unbound_var,'B'}}], - [{9,erl_lint,{exported_var,'Y',{'receive',2}}}]}}], - + [{9,erl_lint,{exported_var,'Y',{'receive',2}}}]}}, + {shadow2, + <<"t() -> + _ = (catch MS = MS = 1), % MS used unsafe + _ = case ok of _ -> fun() -> ok end end, + fun (MS) -> MS end. % MS not shadowed here + ">>, + [], + []}], ?line [] = run(Config, Ts), ok. @@ -958,6 +1020,45 @@ unsafe_vars(Config) when is_list(Config) -> [warn_unused_vars], {errors,[{3,erl_lint,{unsafe_var,'X',{'if',2}}}, {4,erl_lint,{unsafe_var,'X',{'if',2}}}], + []}}, + {unsafe8, + <<"t8(X) -> + case X of _ -> catch _Y = 1 end, + _Y." + >>, + [], + {errors,[{3,erl_lint,{unsafe_var,'_Y',{'catch',2}}}], + []}}, + {unsafe9, + <<"t9(X) -> + case X of + 1 -> + catch A = 1, % unsafe only here + B = 1, + C = 1, + D = 1; + 2 -> + A = 2, + % B not bound here + C = 2, + catch D = 2; % unsafe in two clauses + 3 -> + A = 3, + B = 3, + C = 3, + catch D = 3; % unsafe in two clauses + 4 -> + A = 4, + B = 4, + C = 4, + D = 4 + end, + {A,B,C,D}." + >>, + [], + {errors,[{24,erl_lint,{unsafe_var,'A',{'catch',4}}}, + {24,erl_lint,{unsafe_var,'B',{'case',2}}}, + {24,erl_lint,{unsafe_var,'D',{'case',2}}}], []}} ], ?line [] = run(Config, Ts), @@ -2648,8 +2749,9 @@ otp_11872(Config) when is_list(Config) -> t() -> 1. ">>, - {error,[{6,erl_lint,{undefined_type,{product,0}}}], - [{8,erl_lint,{new_var_arity_type,map}}]} = + {error,[{6,erl_lint,{undefined_type,{product,0}}}, + {8,erl_lint,{undefined_type,{dict,0}}}], + [{8,erl_lint,{new_builtin_type,{map,0}}}]} = run_test2(Config, Ts, []), ok. @@ -3080,6 +3182,193 @@ behaviour_multiple(Config) when is_list(Config) -> ?line [] = run(Config, Ts), ok. +otp_11861(doc) -> + "OTP-11861. behaviour_info() and -callback."; +otp_11861(suite) -> []; +otp_11861(Conf) when is_list(Conf) -> + CallbackFiles = [callback1, callback2, callback3, + bad_behaviour1, bad_behaviour2], + lists:foreach(fun(M) -> + F = filename:join(?datadir, M), + Opts = [{outdir,?privdir}, return], + {ok, M, []} = compile:file(F, Opts) + end, CallbackFiles), + CodePath = code:get_path(), + true = code:add_path(?privdir), + Ts = [{otp_11861_1, + <<" + -export([b1/1]). + -behaviour(callback1). + -behaviour(callback2). + + -spec b1(atom()) -> integer(). + b1(A) when is_atom(A)-> + 3. + ">>, + [], + %% b2/1 is optional in both modules + {warnings,[{4,erl_lint, + {conflicting_behaviours,{b1,1},callback2,3,callback1}}]}}, + {otp_11861_2, + <<" + -export([b2/1]). + -behaviour(callback1). + -behaviour(callback2). + + -spec b2(integer()) -> atom(). + b2(I) when is_integer(I)-> + a. + ">>, + [], + %% b2/1 is optional in callback2, but not in callback1 + {warnings,[{3,erl_lint,{undefined_behaviour_func,{b1,1},callback1}}, + {4,erl_lint, + {conflicting_behaviours,{b2,1},callback2,3,callback1}}]}}, + {otp_11861_3, + <<" + -callback b(_) -> atom(). + -optional_callbacks({b1,1}). % non-existing and ignored + ">>, + [], + []}, + {otp_11861_4, + <<" + -callback b(_) -> atom(). + -optional_callbacks([{b1,1}]). % non-existing + ">>, + [], + %% No behaviour-info(), but callback. + {errors,[{3,erl_lint,{undefined_callback,{lint_test,b1,1}}}],[]}}, + {otp_11861_5, + <<" + -optional_callbacks([{b1,1}]). % non-existing + ">>, + [], + %% No behaviour-info() and no callback: warning anyway + {errors,[{2,erl_lint,{undefined_callback,{lint_test,b1,1}}}],[]}}, + {otp_11861_6, + <<" + -optional_callbacks([b1/1]). % non-existing + behaviour_info(callbacks) -> [{b1,1}]. + ">>, + [], + %% behaviour-info() and no callback: warning anyway + {errors,[{2,erl_lint,{undefined_callback,{lint_test,b1,1}}}],[]}}, + {otp_11861_7, + <<" + -optional_callbacks([b1/1]). % non-existing + -callback b(_) -> atom(). + behaviour_info(callbacks) -> [{b1,1}]. + ">>, + [], + %% behaviour-info() callback: warning + {errors,[{2,erl_lint,{undefined_callback,{lint_test,b1,1}}}, + {3,erl_lint,{behaviour_info,{lint_test,b,1}}}], + []}}, + {otp_11861_8, + <<" + -callback b(_) -> atom(). + -optional_callbacks([b/1, {b, 1}]). + ">>, + [], + {errors,[{3,erl_lint,{redefine_optional_callback,{b,1}}}],[]}}, + {otp_11861_9, + <<" + -behaviour(gen_server). + -export([handle_call/3,handle_cast/2,handle_info/2, + code_change/3, init/1, terminate/2]). + handle_call(_, _, _) -> ok. + handle_cast(_, _) -> ok. + handle_info(_, _) -> ok. + code_change(_, _, _) -> ok. + init(_) -> ok. + terminate(_, _) -> ok. + ">>, + [], + []}, + {otp_11861_9, + <<" + -behaviour(gen_server). + -export([handle_call/3,handle_cast/2,handle_info/2, + code_change/3, init/1, terminate/2, format_status/2]). + handle_call(_, _, _) -> ok. + handle_cast(_, _) -> ok. + handle_info(_, _) -> ok. + code_change(_, _, _) -> ok. + init(_) -> ok. + terminate(_, _) -> ok. + format_status(_, _) -> ok. % optional callback + ">>, + [], + %% Nothing... + []}, + {otp_11861_10, + <<" + -optional_callbacks([{b1,1,bad}]). % badly formed and ignored + behaviour_info(callbacks) -> [{b1,1}]. + ">>, + [], + []}, + {otp_11861_11, + <<" + -behaviour(bad_behaviour1). + ">>, + [], + {warnings,[{2,erl_lint, + {ill_defined_behaviour_callbacks,bad_behaviour1}}]}}, + {otp_11861_12, + <<" + -behaviour(non_existing_behaviour). + ">>, + [], + {warnings,[{2,erl_lint, + {undefined_behaviour,non_existing_behaviour}}]}}, + {otp_11861_13, + <<" + -behaviour(bad_behaviour_none). + ">>, + [], + {warnings,[{2,erl_lint,{undefined_behaviour,bad_behaviour_none}}]}}, + {otp_11861_14, + <<" + -callback b(_) -> atom(). + ">>, + [], + []}, + {otp_11861_15, + <<" + -optional_callbacks([{b1,1,bad}]). % badly formed + -callback b(_) -> atom(). + ">>, + [], + []}, + {otp_11861_16, + <<" + -callback b(_) -> atom(). + -callback b(_) -> atom(). + ">>, + [], + {errors,[{3,erl_lint,{redefine_callback,{b,1}}}],[]}}, + {otp_11861_17, + <<" + -behaviour(bad_behaviour2). + ">>, + [], + {warnings,[{2,erl_lint,{undefined_behaviour_callbacks, + bad_behaviour2}}]}}, + {otp_11861_18, + <<" + -export([f1/1]). + -behaviour(callback3). + f1(_) -> ok. + ">>, + [], + []} + ], + ?line [] = run(Conf, Ts), + true = code:set_path(CodePath), + ok. + otp_7550(doc) -> "Test that the new utf8/utf16/utf32 types do not allow size or unit specifiers."; otp_7550(Config) when is_list(Config) -> @@ -3145,8 +3434,8 @@ format_warn(Config) when is_list(Config) -> ok. format_level(Level, Count, Config) -> - ?line W = get_compilation_warnings(Config, "format", - [{warn_format, Level}]), + ?line W = get_compilation_result(Config, "format", + [{warn_format, Level}]), %% Pick out the 'format' warnings. ?line FW = lists:filter(fun({_Line, erl_lint, {format_error, _}}) -> true; (_) -> false @@ -3330,42 +3619,22 @@ bin_syntax_errors(Config) -> ok. predef(doc) -> - "OTP-10342: Predefined types: array(), digraph(), and so on"; + "OTP-10342: No longer predefined types: array(), digraph(), and so on"; predef(suite) -> []; predef(Config) when is_list(Config) -> - W = get_compilation_warnings(Config, "predef", []), + W = get_compilation_result(Config, "predef", []), [] = W, - W2 = get_compilation_warnings(Config, "predef2", []), - Tag = deprecated_builtin_type, - [{7,erl_lint,{Tag,{array,0},{array,array,1},"OTP 18.0"}}, - {12,erl_lint,{Tag,{dict,0},{dict,dict,2},"OTP 18.0"}}, - {17,erl_lint,{Tag,{digraph,0},{digraph,graph},"OTP 18.0"}}, - {27,erl_lint,{Tag,{gb_set,0},{gb_sets,set,1},"OTP 18.0"}}, - {32,erl_lint,{Tag,{gb_tree,0},{gb_trees,tree,2},"OTP 18.0"}}, - {37,erl_lint,{Tag,{queue,0},{queue,queue,1},"OTP 18.0"}}, - {42,erl_lint,{Tag,{set,0},{sets,set,1},"OTP 18.0"}}, - {47,erl_lint,{Tag,{tid,0},{ets,tid},"OTP 18.0"}}] = W2, - Ts = [{otp_10342_1, - <<"-compile(nowarn_deprecated_type). - - -spec t(dict()) -> non_neg_integer(). - - t(D) -> - erlang:phash2(D, 3000). - ">>, - {[nowarn_unused_function]}, - []}, - {otp_10342_2, - <<"-spec t(dict()) -> non_neg_integer(). - - t(D) -> - erlang:phash2(D, 3000). - ">>, - {[nowarn_unused_function]}, - {warnings,[{1,erl_lint, - {deprecated_builtin_type,{dict,0},{dict,dict,2}, - "OTP 18.0"}}]}}], - [] = run(Config, Ts), + %% dict(), digraph() and so on were removed in Erlang/OTP 18.0. + E2 = get_compilation_result(Config, "predef2", []), + Tag = undefined_type, + {[{7,erl_lint,{Tag,{array,0}}}, + {12,erl_lint,{Tag,{dict,0}}}, + {17,erl_lint,{Tag,{digraph,0}}}, + {27,erl_lint,{Tag,{gb_set,0}}}, + {32,erl_lint,{Tag,{gb_tree,0}}}, + {37,erl_lint,{Tag,{queue,0}}}, + {42,erl_lint,{Tag,{set,0}}}, + {47,erl_lint,{Tag,{tid,0}}}],[]} = E2, ok. maps(Config) -> @@ -3398,7 +3667,8 @@ maps(Config) -> g := 1 + 1, h := _, i := (_X = _Y), - j := (x ! y) }) -> + j := (x ! y), + <<0:300>> := 33}) -> {A,F}. ">>, [], @@ -3411,9 +3681,10 @@ maps(Config) -> {errors,[{1,erl_lint,illegal_map_construction}, {1,erl_lint,{unbound_var,'X'}}], []}}, - {errors_in_map_keys, + {legal_map_construction, <<"t(V) -> #{ a => 1, #{a=>V} => 2, + #{{a,V}=>V} => 2, #{ \"hi\" => wazzup, hi => ho } => yep, [try a catch _:_ -> b end] => nope, ok => 1.0, @@ -3425,11 +3696,7 @@ maps(Config) -> }. ">>, [], - {errors,[{2,erl_lint,{illegal_map_key_variable,'V'}}, - {4,erl_lint,illegal_map_key}, - {6,erl_lint,illegal_map_key}, - {8,erl_lint,illegal_map_key}, - {10,erl_lint,illegal_map_key}],[]}}, + []}, {errors_in_map_keys_pattern, <<"t(#{ a := 2, #{} := A, @@ -3440,8 +3707,8 @@ maps(Config) -> A. ">>, [], - {errors,[{4,erl_lint,illegal_map_key}, - {6,erl_lint,{illegal_map_key_variable,'V'}}],[]}}], + {errors,[{4,erl_lint,illegal_map_construction}, + {6,erl_lint,illegal_map_key}],[]}}], [] = run(Config, Ts), ok. @@ -3470,7 +3737,94 @@ maps_type(Config) when is_list(Config) -> t(M) -> M. ">>, [], - {warnings,[{3,erl_lint,{new_var_arity_type,map}}]}}], + {warnings,[{3,erl_lint,{new_builtin_type,{map,0}}}]}}], + [] = run(Config, Ts), + ok. + +otp_11851(doc) -> + "OTP-11851: More atoms can be used as type names + bug fixes."; +otp_11851(Config) when is_list(Config) -> + Ts = [ + {otp_11851_1, + <<"-export([t/0]). + -type range(A, B) :: A | B. + + -type union(A) :: A. + + -type product() :: integer(). + + -type tuple(A) :: A. + + -type map(A) :: A. + + -type record() :: a | b. + + -type integer(A) :: A. + + -type atom(A) :: A. + + -type binary(A, B) :: A | B. + + -type 'fun'() :: integer(). + + -type 'fun'(X) :: X. + + -type 'fun'(X, Y) :: X | Y. + + -type all() :: range(atom(), integer()) | union(pid()) | product() + | tuple(reference()) | map(function()) | record() + | integer(atom()) | atom(integer()) + | binary(pid(), tuple()) | 'fun'(port()) + | 'fun'() | 'fun'(<<>>, 'none'). + + -spec t() -> all(). + + t() -> + a. + ">>, + [], + []}, + {otp_11851_2, + <<"-export([a/1, b/1, t/0]). + + -callback b(_) -> integer(). + + -callback ?MODULE:a(_) -> integer(). + + a(_) -> 3. + + b(_) -> a. + + t()-> a. + ">>, + [], + {errors,[{5,erl_lint,{bad_callback,{lint_test,a,1}}}],[]}}, + {otp_11851_3, + <<"-export([a/1]). + + -spec a(_A) -> boolean() when + _ :: atom(), + _A :: integer(). + + a(_) -> true. + ">>, + [], + {errors,[{4,erl_parse,"bad type variable"}],[]}}, + {otp_11851_4, + <<" + -spec a(_) -> ok. + -spec a(_) -> ok. + + -spec ?MODULE:a(_) -> ok. + -spec ?MODULE:a(_) -> ok. + ">>, + [], + {errors,[{3,erl_lint,{redefine_spec,{a,1}}}, + {5,erl_lint,{redefine_spec,{lint_test,a,1}}}, + {6,erl_lint,{redefine_spec,{lint_test,a,1}}}, + {6,erl_lint,{spec_fun_undefined,{a,1}}}], + []}} + ], [] = run(Config, Ts), ok. @@ -3487,9 +3841,9 @@ run(Config, Tests) -> end, lists:foldl(F, [], Tests). -%% Compiles a test file and returns the list of warnings. +%% Compiles a test file and returns the list of warnings/errors. -get_compilation_warnings(Conf, Filename, Warnings) -> +get_compilation_result(Conf, Filename, Warnings) -> ?line DataDir = ?datadir, ?line File = filename:join(DataDir, Filename), {ok,Bin} = file:read_file(File++".erl"), @@ -3498,6 +3852,7 @@ get_compilation_warnings(Conf, Filename, Warnings) -> Test = lists:nthtail(Start+Length, FileS), case run_test(Conf, Test, Warnings) of {warnings, Ws} -> Ws; + {errors,Es,Ws} -> {Es,Ws}; [] -> [] end. diff --git a/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl new file mode 100644 index 0000000000..230f4b4519 --- /dev/null +++ b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl @@ -0,0 +1,6 @@ +-module(bad_behaviour1). + +-export([behaviour_info/1]). + +behaviour_info(callbacks) -> + [{a,1,bad}]. diff --git a/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour2.erl b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour2.erl new file mode 100644 index 0000000000..bb755ce18b --- /dev/null +++ b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour2.erl @@ -0,0 +1,6 @@ +-module(bad_behaviour2). + +-export([behaviour_info/1]). + +behaviour_info(callbacks) -> + undefined. diff --git a/lib/stdlib/test/erl_lint_SUITE_data/callback1.erl b/lib/stdlib/test/erl_lint_SUITE_data/callback1.erl new file mode 100644 index 0000000000..3cc5b51879 --- /dev/null +++ b/lib/stdlib/test/erl_lint_SUITE_data/callback1.erl @@ -0,0 +1,6 @@ +-module(callback1). + +-callback b1(I :: integer()) -> atom(). +-callback b2(A :: atom()) -> integer(). + +-optional_callbacks([{b2,1}]). diff --git a/lib/stdlib/test/erl_lint_SUITE_data/callback2.erl b/lib/stdlib/test/erl_lint_SUITE_data/callback2.erl new file mode 100644 index 0000000000..211cf9f115 --- /dev/null +++ b/lib/stdlib/test/erl_lint_SUITE_data/callback2.erl @@ -0,0 +1,6 @@ +-module(callback2). + +-callback b1(I :: integer()) -> atom(). +-callback b2(A :: atom()) -> integer(). + +-optional_callbacks([b1/1, b2/1]). diff --git a/lib/stdlib/test/erl_lint_SUITE_data/callback3.erl b/lib/stdlib/test/erl_lint_SUITE_data/callback3.erl new file mode 100644 index 0000000000..97b3ecb860 --- /dev/null +++ b/lib/stdlib/test/erl_lint_SUITE_data/callback3.erl @@ -0,0 +1,8 @@ +-module(callback3). + +-export([behaviour_info/1]). + +behaviour_info(callbacks) -> + [{f1, 1}]; +behaviour_info(_) -> + undefined. diff --git a/lib/stdlib/test/erl_lint_SUITE_data/predef.erl b/lib/stdlib/test/erl_lint_SUITE_data/predef.erl index ee9073aa67..3cb7bf40f1 100644 --- a/lib/stdlib/test/erl_lint_SUITE_data/predef.erl +++ b/lib/stdlib/test/erl_lint_SUITE_data/predef.erl @@ -5,8 +5,8 @@ -export_type([array/0, digraph/0, gb_set/0]). -%% Before Erlang/OTP 17.0 local re-definitions of pre-defined opaque -%% types were ignored but did not generate any warning. +%% Since Erlang/OTP 18.0 array() and so on are no longer pre-defined, +%% so there is nothing special about them at all. -opaque array() :: atom(). -opaque digraph() :: atom(). -opaque gb_set() :: atom(). diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index babf3a49eb..046b5cf330 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -50,7 +50,7 @@ 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_11100/1]). + otp_10302/1, otp_10820/1, otp_11100/1, otp_11861/1]). %% Internal export. -export([ehook/6]). @@ -83,7 +83,7 @@ groups() -> {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_11100]}]. + otp_10302, otp_10820, otp_11100, otp_11861]}]. init_per_suite(Config) -> Config. @@ -604,20 +604,20 @@ import_export(Config) when is_list(Config) -> misc_attrs(suite) -> []; misc_attrs(Config) when is_list(Config) -> - ?line ok = pp_forms(<<"-module(m). ">>), - ?line ok = pp_forms(<<"-module(m, [Aafjlksfjdlsjflsdfjlsdjflkdsfjlk," - "Blsjfdlslfjsdf]). ">>), - ?line ok = pp_forms(<<"-export([]). ">>), - ?line ok = pp_forms(<<"-export([foo/2, bar/0]). ">>), - ?line ok = pp_forms(<<"-export([bar/0]). ">>), - ?line ok = pp_forms(<<"-import(lists, []). ">>), - ?line ok = pp_forms(<<"-import(lists, [map/2]). ">>), - ?line ok = pp_forms(<<"-import(lists, [map/2, foreach/2]). ">>), - ?line ok = pp_forms(<<"-'wild '({attr2,3}). ">>), - ?line ok = pp_forms(<<"-record(a, {b,c}). ">>), - ?line ok = pp_forms(<<"-record(' a ', {}). ">>), - ?line ok = pp_forms(<<"-record(' a ', {foo = foo:bar()}). ">>), - + ok = pp_forms(<<"-module(m). ">>), + ok = pp_forms(<<"-module(m, [Aafjlksfjdlsjflsdfjlsdjflkdsfjlk," + "Blsjfdlslfjsdf]). ">>), + ok = pp_forms(<<"-export([]). ">>), + ok = pp_forms(<<"-export([foo/2, bar/0]). ">>), + ok = pp_forms(<<"-export([bar/0]). ">>), + ok = pp_forms(<<"-import(lists, []). ">>), + ok = pp_forms(<<"-import(lists, [map/2]). ">>), + ok = pp_forms(<<"-import(lists, [map/2, foreach/2]). ">>), + ok = pp_forms(<<"-'wild '({attr2,3}). ">>), + ok = pp_forms(<<"-record(a, {b,c}). ">>), + ok = pp_forms(<<"-record(' a ', {}). ">>), + ok = pp_forms(<<"-record(' a ', {foo = foo:bar()}). ">>), + ok = pp_forms(<<"-custom1(#{test1 => init/2, test2 => [val/1, val/2]}). ">>), ok. dialyzer_attrs(suite) -> @@ -874,6 +874,7 @@ type_examples() -> {ex3,<<"-type paren() :: (ann2()). ">>}, {ex4,<<"-type t1() :: atom(). ">>}, {ex5,<<"-type t2() :: [t1()]. ">>}, + {ex56,<<"-type integer(A) :: A. ">>}, {ex6,<<"-type t3(Atom) :: integer(Atom). ">>}, {ex7,<<"-type '\\'t::4'() :: t3('\\'foobar'). ">>}, {ex8,<<"-type t5() :: {t1(), t3(foo)}. ">>}, @@ -1204,8 +1205,18 @@ otp_11100(Config) when is_list(Config) -> []}}), ok. +otp_11861(doc) -> + "OTP-11861. behaviour_info() and -callback."; +otp_11861(suite) -> []; +otp_11861(Config) when is_list(Config) -> + "-optional_callbacks([bar/0]).\n" = + pf({attribute,3,optional_callbacks,[{bar,0}]}), + "-optional_callbacks([{bar,1,bad}]).\n" = + pf({attribute,4,optional_callbacks,[{bar,1,bad}]}), + ok. + pf(Form) -> - lists:flatten(erl_pp:form(Form,none)). + lists:flatten(erl_pp:form(Form, none)). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 35067e8116..9be9f641c8 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -204,20 +204,20 @@ reserved_words() -> [begin ?line {RW, true} = {RW, erl_scan:reserved_word(RW)}, S = atom_to_list(RW), - Ts = [{RW,1}], + Ts = [{RW,{1,1}}], ?line test_string(S, Ts) end || RW <- L], ok. atoms() -> - ?line test_string("a - b", [{atom,1,a},{atom,2,b}]), - ?line test_string("'a b'", [{atom,1,'a b'}]), - ?line test_string("a", [{atom,1,a}]), - ?line test_string("a@2", [{atom,1,a@2}]), - ?line test_string([39,65,200,39], [{atom,1,'AÈ'}]), - ?line test_string("ärlig östen", [{atom,1,ärlig},{atom,1,östen}]), + test_string("a + b", [{atom,{1,1},a},{atom,{2,18},b}]), + test_string("'a b'", [{atom,{1,1},'a b'}]), + test_string("a", [{atom,{1,1},a}]), + test_string("a@2", [{atom,{1,1},a@2}]), + test_string([39,65,200,39], [{atom,{1,1},'AÈ'}]), + test_string("ärlig östen", [{atom,{1,1},ärlig},{atom,{1,7},östen}]), ?line {ok,[{atom,_,'$a'}],{1,6}} = erl_scan:string("'$\\a'", {1,1}), ?line test("'$\\a'"), @@ -230,7 +230,7 @@ punctuations() -> %% One token at a time: [begin W = list_to_atom(S), - Ts = [{W,1}], + Ts = [{W,{1,1}}], ?line test_string(S, Ts) end || S <- L], Three = ["/=:=", "<=:=", "==:=", ">=:="], % three tokens... @@ -246,53 +246,60 @@ punctuations() -> [begin W1 = list_to_atom(S1), W2 = list_to_atom(S2), - Ts = [{W1,1},{W2,1}], + Ts = [{W1,{1,1}},{W2,{1,-L2+1}}], ?line test_string(S, Ts) - end || {S,[{_,S1,S2}|_]} <- SL], + end || {S,[{L2,S1,S2}|_]} <- SL], - PTs1 = [{'!',1},{'(',1},{')',1},{',',1},{';',1},{'=',1},{'[',1}, - {']',1},{'{',1},{'|',1},{'}',1}], + PTs1 = [{'!',{1,1}},{'(',{1,2}},{')',{1,3}},{',',{1,4}},{';',{1,5}}, + {'=',{1,6}},{'[',{1,7}},{']',{1,8}},{'{',{1,9}},{'|',{1,10}}, + {'}',{1,11}}], ?line test_string("!(),;=[]{|}", PTs1), - PTs2 = [{'#',1},{'&',1},{'*',1},{'+',1},{'/',1}, - {':',1},{'<',1},{'>',1},{'?',1},{'@',1}, - {'\\',1},{'^',1},{'`',1},{'~',1}], + PTs2 = [{'#',{1,1}},{'&',{1,2}},{'*',{1,3}},{'+',{1,4}},{'/',{1,5}}, + {':',{1,6}},{'<',{1,7}},{'>',{1,8}},{'?',{1,9}},{'@',{1,10}}, + {'\\',{1,11}},{'^',{1,12}},{'`',{1,13}},{'~',{1,14}}], ?line test_string("#&*+/:<>?@\\^`~", PTs2), - ?line test_string(".. ", [{'..',1}]), - ?line test("1 .. 2"), - ?line test_string("...", [{'...',1}]), + test_string(".. ", [{'..',{1,1}}]), + test_string("1 .. 2", + [{integer,{1,1},1},{'..',{1,3}},{integer,{1,6},2}]), + test_string("...", [{'...',{1,1}}]), ok. comments() -> ?line test("a %%\n b"), ?line {ok,[],1} = erl_scan:string("%"), ?line test("a %%\n b"), - ?line {ok,[{atom,_,a},{atom,_,b}],{2,3}} = + {ok,[{atom,{1,1},a},{atom,{2,2},b}],{2,3}} = erl_scan:string("a %%\n b",{1,1}), - ?line {ok,[{atom,_,a},{comment,_,"%%"},{atom,_,b}],{2,3}} = + {ok,[{atom,{1,1},a},{comment,{1,3},"%%"},{atom,{2,2},b}],{2,3}} = erl_scan:string("a %%\n b",{1,1}, [return_comments]), - ?line {ok,[{atom,_,a}, - {white_space,_," "}, - {white_space,_,"\n "}, - {atom,_,b}], - {2,3}} = + {ok,[{atom,{1,1},a}, + {white_space,{1,2}," "}, + {white_space,{1,5},"\n "}, + {atom,{2,2},b}], + {2,3}} = erl_scan:string("a %%\n b",{1,1},[return_white_spaces]), - ?line {ok,[{atom,_,a}, - {white_space,_," "}, - {comment,_,"%%"}, - {white_space,_,"\n "}, - {atom,_,b}], - {2,3}} = erl_scan:string("a %%\n b",{1,1},[return]), + {ok,[{atom,{1,1},a}, + {white_space,{1,2}," "}, + {comment,{1,3},"%%"}, + {white_space,{1,5},"\n "}, + {atom,{2,2},b}], + {2,3}} = erl_scan:string("a %%\n b",{1,1},[return]), ok. errors() -> ?line {error,{1,erl_scan,{string,$',"qa"}},1} = erl_scan:string("'qa"), %' + {error,{{1,1},erl_scan,{string,$',"qa"}},{1,4}} = %' + erl_scan:string("'qa", {1,1}, []), %' ?line {error,{1,erl_scan,{string,$","str"}},1} = %" erl_scan:string("\"str"), %" + {error,{{1,1},erl_scan,{string,$","str"}},{1,5}} = %" + erl_scan:string("\"str", {1,1}, []), %" ?line {error,{1,erl_scan,char},1} = erl_scan:string("$"), - ?line test_string([34,65,200,34], [{string,1,"AÈ"}]), - ?line test_string("\\", [{'\\',1}]), + {error,{{1,1},erl_scan,char},{1,2}} = erl_scan:string("$", {1,1}, []), + test_string([34,65,200,34], [{string,{1,1},"AÈ"}]), + test_string("\\", [{'\\',{1,1}}]), ?line {'EXIT',_} = (catch {foo, erl_scan:string('$\\a', {1,1})}), % type error ?line {'EXIT',_} = @@ -304,7 +311,7 @@ errors() -> integers() -> [begin I = list_to_integer(S), - Ts = [{integer,1,I}], + Ts = [{integer,{1,1},I}], ?line test_string(S, Ts) end || S <- [[N] || N <- lists:seq($0, $9)] ++ ["2323","000"] ], ok. @@ -313,14 +320,16 @@ base_integers() -> [begin B = list_to_integer(BS), I = erlang:list_to_integer(S, B), - Ts = [{integer,1,I}], + Ts = [{integer,{1,1},I}], ?line test_string(BS++"#"++S, Ts) end || {BS,S} <- [{"2","11"}, {"5","23234"}, {"12","05a"}, {"16","abcdef"}, {"16","ABCDEF"}] ], ?line {error,{1,erl_scan,{base,1}},1} = erl_scan:string("1#000"), + {error,{{1,1},erl_scan,{base,1}},{1,2}} = + erl_scan:string("1#000", {1,1}, []), - ?line test_string("12#bc", [{integer,1,11},{atom,1,c}]), + test_string("12#bc", [{integer,{1,1},11},{atom,{1,5},c}]), [begin Str = BS ++ "#" ++ S, @@ -329,40 +338,53 @@ base_integers() -> end || {BS,S} <- [{"3","3"},{"15","f"}, {"12","c"}] ], ?line {ok,[{integer,1,239},{'@',1}],1} = erl_scan:string("16#ef@"), - ?line {ok,[{integer,1,14},{atom,1,g@}],1} = erl_scan:string("16#eg@"), + {ok,[{integer,{1,1},239},{'@',{1,6}}],{1,7}} = + erl_scan:string("16#ef@", {1,1}, []), + {ok,[{integer,{1,1},14},{atom,{1,5},g@}],{1,7}} = + erl_scan:string("16#eg@", {1,1}, []), ok. floats() -> [begin F = list_to_float(FS), - Ts = [{float,1,F}], + Ts = [{float,{1,1},F}], ?line test_string(FS, Ts) end || FS <- ["1.0","001.17","3.31200","1.0e0","1.0E17", "34.21E-18", "17.0E+14"]], - ?line test_string("1.e2", [{integer,1,1},{'.',1},{atom,1,e2}]), + test_string("1.e2", [{integer,{1,1},1},{'.',{1,2}},{atom,{1,3},e2}]), ?line {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string("1.0e400"), + {error,{{1,1},erl_scan,{illegal,float}},{1,8}} = + erl_scan:string("1.0e400", {1,1}, []), [begin - ?line {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string(S) + {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string(S), + {error,{{1,1},erl_scan,{illegal,float}},{1,_}} = + erl_scan:string(S, {1,1}, []) end || S <- ["1.14Ea"]], ok. dots() -> - Dot = [{".", {ok,[{dot,1}],1}}, - {". ", {ok,[{dot,1}],1}}, - {".\n", {ok,[{dot,1}],2}}, - {".%", {ok,[{dot,1}],1}}, - {".\210",{ok,[{dot,1}],1}}, - {".% öh",{ok,[{dot,1}],1}}, - {".%\n", {ok,[{dot,1}],2}}, - {".$", {error,{1,erl_scan,char},1}}, - {".$\\", {error,{1,erl_scan,char},1}}, - {".a", {ok,[{'.',1},{atom,1,a}],1}} + Dot = [{".", {ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,2}}}, + {". ", {ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,3}}}, + {".\n", {ok,[{dot,1}],2}, {ok,[{dot,{1,1}}],{2,1}}}, + {".%", {ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,3}}}, + {".\210",{ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,3}}}, + {".% öh",{ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,6}}}, + {".%\n", {ok,[{dot,1}],2}, {ok,[{dot,{1,1}}],{2,1}}}, + {".$", {error,{1,erl_scan,char},1}, + {error,{{1,2},erl_scan,char},{1,3}}}, + {".$\\", {error,{1,erl_scan,char},1}, + {error,{{1,2},erl_scan,char},{1,4}}}, + {".a", {ok,[{'.',1},{atom,1,a}],1}, + {ok,[{'.',{1,1}},{atom,{1,2},a}],{1,3}}} ], - ?line [R = erl_scan:string(S) || {S, R} <- Dot], + [begin + R = erl_scan:string(S), + R2 = erl_scan:string(S, {1,1}, []) + end || {S, R, R2} <- Dot], ?line {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text), ?line [{column,1},{length,1},{line,1},{text,"."}] = @@ -379,55 +401,55 @@ dots() -> ?line {error,{{1,2},erl_scan,char},{1,4}} = erl_scan:string(".$\\", {1,1}), - ?line test(". "), - ?line test(". "), - ?line test(".\n"), - ?line test(".\n\n"), - ?line test(".\n\r"), - ?line test(".\n\n\n"), - ?line test(".\210"), - ?line test(".%\n"), - ?line test(".a"), - - ?line test("%. \n. "), + test_string(". ", [{dot,{1,1}}]), + test_string(". ", [{dot,{1,1}}]), + test_string(".\n", [{dot,{1,1}}]), + test_string(".\n\n", [{dot,{1,1}}]), + test_string(".\n\r", [{dot,{1,1}}]), + test_string(".\n\n\n", [{dot,{1,1}}]), + test_string(".\210", [{dot,{1,1}}]), + test_string(".%\n", [{dot,{1,1}}]), + test_string(".a", [{'.',{1,1}},{atom,{1,2},a}]), + + test_string("%. \n. ", [{dot,{2,1}}]), ?line {more,C} = erl_scan:tokens([], "%. ",{1,1}, return), - ?line {done,{ok,[{comment,_,"%. "}, - {white_space,_,"\n"}, - {dot,_}], - {2,3}}, ""} = + {done,{ok,[{comment,{1,1},"%. "}, + {white_space,{1,4},"\n"}, + {dot,{2,1}}], + {2,3}}, ""} = erl_scan:tokens(C, "\n. ", {1,1}, return), % any loc, any options ?line [test_string(S, R) || - {S, R} <- [{".$\n", [{'.',1},{char,1,$\n}]}, - {"$\\\n", [{char,1,$\n}]}, - {"'\\\n'", [{atom,1,'\n'}]}, - {"$\n", [{char,1,$\n}]}] ], + {S, R} <- [{".$\n", [{'.',{1,1}},{char,{1,2},$\n}]}, + {"$\\\n", [{char,{1,1},$\n}]}, + {"'\\\n'", [{atom,{1,1},'\n'}]}, + {"$\n", [{char,{1,1},$\n}]}] ], ok. chars() -> [begin L = lists:flatten(io_lib:format("$\\~.8b", [C])), - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], %% Leading zeroes... [begin L = lists:flatten(io_lib:format("$\\~3.8.0b", [C])), - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], %% $\^\n now increments the line... [begin L = "$\\^" ++ [C], - Ts = [{char,1,C band 2#11111}], + Ts = [{char,{1,1},C band 2#11111}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], [begin L = "$\\" ++ [C], - Ts = [{char,1,V}], + Ts = [{char,{1,1},V}], ?line test_string(L, Ts) end || {C,V} <- [{$n,$\n}, {$r,$\r}, {$t,$\t}, {$v,$\v}, {$b,$\b}, {$f,$\f}, {$e,$\e}, {$s,$\s}, @@ -440,45 +462,45 @@ chars() -> No = EC ++ Ds ++ X ++ New, [begin L = "$\\" ++ [C], - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255) -- No], [begin L = "'$\\" ++ [C] ++ "'", - Ts = [{atom,1,list_to_atom("$"++[C])}], + Ts = [{atom,{1,1},list_to_atom("$"++[C])}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255) -- No], - ?line test_string("\"\\013a\\\n\"", [{string,1,"\va\n"}]), + test_string("\"\\013a\\\n\"", [{string,{1,1},"\va\n"}]), - ?line test_string("'\n'", [{atom,1,'\n'}]), - ?line test_string("\"\n\a\"", [{string,1,"\na"}]), + test_string("'\n'", [{atom,{1,1},'\n'}]), + test_string("\"\n\a\"", [{string,{1,1},"\na"}]), %% No escape [begin L = "$" ++ [C], - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255) -- (No ++ [$\\])], - ?line test_string("$\n", [{char,1,$\n}]), + test_string("$\n", [{char,{1,1},$\n}]), ?line {error,{{1,1},erl_scan,char},{1,4}} = erl_scan:string("$\\^",{1,1}), - ?line test_string("$\\\n", [{char,1,$\n}]), + test_string("$\\\n", [{char,{1,1},$\n}]), %% Robert's scanner returns line 1: - ?line test_string("$\\\n", [{char,1,$\n}]), - ?line test_string("$\n\n", [{char,1,$\n}]), + test_string("$\\\n", [{char,{1,1},$\n}]), + test_string("$\n\n", [{char,{1,1},$\n}]), ?line test("$\n\n"), ok. variables() -> - ?line test_string(" \237_Aouåeiyäö", [{var,1,'_Aouåeiyäö'}]), - ?line test_string("A_b_c@", [{var,1,'A_b_c@'}]), - ?line test_string("V@2", [{var,1,'V@2'}]), - ?line test_string("ABDÀ", [{var,1,'ABDÀ'}]), - ?line test_string("Ärlig Östen", [{var,1,'Ärlig'},{var,1,'Östen'}]), + test_string(" \237_Aouåeiyäö", [{var,{1,7},'_Aouåeiyäö'}]), + test_string("A_b_c@", [{var,{1,1},'A_b_c@'}]), + test_string("V@2", [{var,{1,1},'V@2'}]), + test_string("ABDÀ", [{var,{1,1},'ABDÀ'}]), + test_string("Ärlig Östen", [{var,{1,1},'Ärlig'},{var,{1,7},'Östen'}]), ok. eof() -> @@ -508,11 +530,25 @@ eof() -> ?line {done,{ok,[{atom,1,a}],1},eof} = erl_scan:tokens(C5,eof,1), + %% With column. + {more, C6} = erl_scan:tokens([], "a", {1,1}), + %% An error before R13A. + %% {done,{error,{1,erl_scan,scan},1},eof} = + {done,{ok,[{atom,{1,1},a}],{1,2}},eof} = + erl_scan:tokens(C6,eof,1), + %% A dot followed by eof is special: ?line {more, C} = erl_scan:tokens([], "a.", 1), ?line {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan:tokens(C,eof,1), ?line {ok,[{atom,1,foo},{dot,1}],1} = erl_scan:string("foo."), + %% With column. + {more, CCol} = erl_scan:tokens([], "a.", {1,1}), + {done,{ok,[{atom,{1,1},a},{dot,{1,2}}],{1,3}},eof} = + erl_scan:tokens(CCol,eof,1), + {ok,[{atom,{1,1},foo},{dot,{1,4}}],{1,5}} = + erl_scan:string("foo.", {1,1}, []), + ok. illegal() -> @@ -816,34 +852,34 @@ unicode() -> erl_scan:string([1089]), ?line {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = erl_scan:string([1089], {1,1}), - ?line {error,{1,erl_scan,{illegal,atom}},1} = + {error,{1,erl_scan,{illegal,atom}},1} = erl_scan:string("'a"++[1089]++"b'", 1), - ?line {error,{{1,1},erl_scan,{illegal,atom}},{1,6}} = + {error,{{1,1},erl_scan,{illegal,atom}},{1,6}} = erl_scan:string("'a"++[1089]++"b'", {1,1}), ?line test("\"a"++[1089]++"b\""), - ?line {ok,[{char,1,1}],1} = + {ok,[{char,1,1}],1} = erl_scan:string([$$,$\\,$^,1089], 1), - ?line {error,{1,erl_scan,Error},1} = + {error,{1,erl_scan,Error},1} = erl_scan:string("\"qa\x{aaa}", 1), - ?line "unterminated string starting with \"qa"++[2730]++"\"" = + "unterminated string starting with \"qa"++[2730]++"\"" = erl_scan:format_error(Error), ?line {error,{{1,1},erl_scan,_},{1,11}} = erl_scan:string("\"qa\\x{aaa}",{1,1}), - ?line {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = + {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = erl_scan:string("'qa\\x{aaa}'",{1,1}), - ?line {ok,[{char,1,1089}],1} = + {ok,[{char,1,1089}],1} = erl_scan:string([$$,1089], 1), - ?line {ok,[{char,1,1089}],1} = + {ok,[{char,1,1089}],1} = erl_scan:string([$$,$\\,1089], 1), Qs = "$\\x{aaa}", - ?line {ok,[{char,1,$\x{aaa}}],1} = + {ok,[{char,1,$\x{aaa}}],1} = erl_scan:string(Qs, 1), - ?line {ok,[Q2],{1,9}} = + {ok,[Q2],{1,9}} = erl_scan:string("$\\x{aaa}", {1,1}, [text]), - ?line [{category,char},{column,1},{length,8}, + [{category,char},{column,1},{length,8}, {line,1},{symbol,16#aaa},{text,Qs}] = erl_scan:token_info(Q2), @@ -1164,7 +1200,13 @@ otp_11807(Config) when is_list(Config) -> (catch erl_parse:abstract("string", [{encoding,bad}])), ok. -test_string(String, Expected) -> +test_string(String, ExpectedWithCol) -> + {ok, ExpectedWithCol, _EndWithCol} = erl_scan:string(String, {1, 1}, []), + Expected = [ begin + {L,_C} = element(2, T), + setelement(2, T, L) + end + || T <- ExpectedWithCol ], {ok, Expected, _End} = erl_scan:string(String), test(String). diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 040ae1effc..146d810189 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -77,7 +77,8 @@ wildcard_one(Config) when is_list(Config) -> L = filelib:wildcard(Wc), L = filelib:wildcard(Wc, erl_prim_loader), L = filelib:wildcard(Wc, "."), - L = filelib:wildcard(Wc, Dir) + L = filelib:wildcard(Wc, Dir), + L = filelib:wildcard(Wc, Dir++"/.") end), ?line file:set_cwd(OldCwd), ?line ok = file:del_dir(Dir), @@ -88,6 +89,7 @@ wildcard_two(Config) when is_list(Config) -> ?line ok = file:make_dir(Dir), ?line do_wildcard_1(Dir, fun(Wc) -> io:format("~p~n",[{Wc,Dir, X = filelib:wildcard(Wc, Dir)}]),X end), ?line do_wildcard_1(Dir, fun(Wc) -> filelib:wildcard(Wc, Dir++"/") end), + ?line do_wildcard_1(Dir, fun(Wc) -> filelib:wildcard(Wc, Dir++"/.") end), case os:type() of {win32,_} -> ok; diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index ecd9cff9f9..6f1d1a891d 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -287,38 +287,66 @@ extension(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% join(Config) when is_list(Config) -> + %% Whenever joining two elements, test the equivalence between + %% join/1 and join/2 (OTP-12158) by using help function + %% filename_join/2. ?line "/" = filename:join(["/"]), ?line "/" = filename:join(["//"]), - ?line "usr/foo.erl" = filename:join("usr","foo.erl"), - ?line "/src/foo.erl" = filename:join(usr, "/src/foo.erl"), - ?line "/src/foo.erl" = filename:join(["/src/",'foo.erl']), - ?line "/src/foo.erl" = filename:join(usr, ["/sr", 'c/foo.erl']), - ?line "/src/foo.erl" = filename:join("usr", "/src/foo.erl"), + "usr/foo.erl" = filename_join("usr","foo.erl"), + "/src/foo.erl" = filename_join(usr, "/src/foo.erl"), + "/src/foo.erl" = filename_join("/src/",'foo.erl'), + "/src/foo.erl" = filename_join(usr, ["/sr", 'c/foo.erl']), + "/src/foo.erl" = filename_join("usr", "/src/foo.erl"), %% Make sure that redundant slashes work too. ?line "a/b/c/d/e/f/g" = filename:join(["a//b/c/////d//e/f/g"]), - ?line "a/b/c/d/e/f/g" = filename:join(["a//b/c/", "d//e/f/g"]), - ?line "a/b/c/d/e/f/g" = filename:join(["a//b/c", "d//e/f/g"]), - ?line "/d/e/f/g" = filename:join(["a//b/c", "/d//e/f/g"]), - ?line "/d/e/f/g" = filename:join(["a//b/c", "//d//e/f/g"]), - - ?line "foo/bar" = filename:join([$f,$o,$o,$/,[]], "bar"), + "a/b/c/d/e/f/g" = filename_join("a//b/c/", "d//e/f/g"), + "a/b/c/d/e/f/g" = filename_join("a//b/c", "d//e/f/g"), + "/d/e/f/g" = filename_join("a//b/c", "/d//e/f/g"), + "/d/e/f/g" = filename:join("a//b/c", "//d//e/f/g"), + + "foo/bar" = filename_join([$f,$o,$o,$/,[]], "bar"), + + %% Single dots - should be removed if in the middle of the path, + %% but not at the end of the path. + "/." = filename:join(["/."]), + "/" = filename:join(["/./"]), + "/." = filename:join(["/./."]), + "./." = filename:join(["./."]), + + "/a/b" = filename_join("/a/.","b"), + "/a/b/." = filename_join("/a/.","b/."), + "/a/." = filename_join("/a/.","."), + "/a/." = filename_join("/a","."), + "/a/." = filename_join("/a/.",""), + "./." = filename_join("./.","."), + "./." = filename_join("./","."), + "./." = filename_join("./.",""), + "." = filename_join(".",""), + "./." = filename_join(".","."), + + %% Trailing slash shall be removed - except the root + "/" = filename:join(["/"]), + "/" = filename:join(["/./"]), + "/a" = filename:join(["/a/"]), + "/b" = filename_join("/a/","/b/"), + "/a/b" = filename_join("/a/","b/"), ?line case os:type() of {win32, _} -> ?line "d:/" = filename:join(["D:/"]), ?line "d:/" = filename:join(["D:\\"]), - ?line "d:/abc" = filename:join(["D:/", "abc"]), - ?line "d:abc" = filename:join(["D:", "abc"]), + "d:/abc" = filename_join("D:/", "abc"), + "d:abc" = filename_join("D:", "abc"), ?line "a/b/c/d/e/f/g" = filename:join(["a//b\\c//\\/\\d/\\e/f\\g"]), ?line "a:usr/foo.erl" = filename:join(["A:","usr","foo.erl"]), ?line "/usr/foo.erl" = filename:join(["A:","/usr","foo.erl"]), - ?line "c:usr" = filename:join("A:","C:usr"), - ?line "a:usr" = filename:join("A:","usr"), - ?line "c:/usr" = filename:join("A:", "C:/usr"), + "c:usr" = filename_join("A:","C:usr"), + "a:usr" = filename_join("A:","usr"), + "c:/usr" = filename_join("A:", "C:/usr"), ?line "c:/usr/foo.erl" = filename:join(["A:","C:/usr","foo.erl"]), ?line "c:usr/foo.erl" = @@ -329,6 +357,11 @@ join(Config) when is_list(Config) -> ok end. +%% Make sure join([A,B]) is equivalent to join(A,B) (OTP-12158) +filename_join(A,B) -> + Res = filename:join(A,B), + Res = filename:join([A,B]). + pathtype(Config) when is_list(Config) -> ?line relative = filename:pathtype(".."), ?line relative = filename:pathtype("foo"), @@ -633,6 +666,53 @@ join_bin(Config) when is_list(Config) -> ?line <<"foo/bar">> = filename:join([$f,$o,$o,$/,[]], <<"bar">>), + %% Single dots - should be removed if in the middle of the path, + %% but not at the end of the path. + %% Also test equivalence between join/1 and join/2 (OTP-12158) + <<"/.">> = filename:join([<<"/.">>]), + <<"/">> = filename:join([<<"/./">>]), + <<"/.">> = filename:join([<<"/./.">>]), + <<"./.">> = filename:join([<<"./.">>]), + + <<"/a/b">> = filename:join([<<"/a/.">>,<<"b">>]), + <<"/a/b">> = filename:join(<<"/a/.">>,<<"b">>), + + <<"/a/b/.">> = filename:join([<<"/a/.">>,<<"b/.">>]), + <<"/a/b/.">> = filename:join(<<"/a/.">>,<<"b/.">>), + + <<"/a/.">> = filename:join([<<"/a/.">>,<<".">>]), + <<"/a/.">> = filename:join(<<"/a/.">>,<<".">>), + + <<"/a/.">> = filename:join([<<"/a">>,<<".">>]), + <<"/a/.">> = filename:join(<<"/a">>,<<".">>), + + <<"/a/.">> = filename:join([<<"/a/.">>,<<"">>]), + <<"/a/.">> = filename:join(<<"/a/.">>,<<"">>), + + <<"./.">> = filename:join([<<"./.">>,<<".">>]), + <<"./.">> = filename:join(<<"./.">>,<<".">>), + + <<"./.">> = filename:join([<<"./">>,<<".">>]), + <<"./.">> = filename:join(<<"./">>,<<".">>), + + <<"./.">> = filename:join([<<"./.">>,<<"">>]), + <<"./.">> = filename:join(<<"./.">>,<<"">>), + + <<".">> = filename:join([<<".">>,<<"">>]), + <<".">> = filename:join(<<".">>,<<"">>), + + <<"./.">> = filename:join([<<".">>,<<".">>]), + <<"./.">> = filename:join(<<".">>,<<".">>), + + %% Trailing slash shall be removed - except the root + <<"/">> = filename:join([<<"/">>]), + <<"/">> = filename:join([<<"/./">>]), + <<"/a">> = filename:join([<<"/a/">>]), + <<"/b">> = filename:join([<<"/a/">>,<<"/b/">>]), + <<"/b">> = filename:join(<<"/a/">>,<<"/b/">>), + <<"/a/b">> = filename:join([<<"/a/">>,<<"b/">>]), + <<"/a/b">> = filename:join(<<"/a/">>,<<"b/">>), + ?line case os:type() of {win32, _} -> ?line <<"d:/">> = filename:join([<<"D:/">>]), diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 60a1ba8c60..576a5adfce 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-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -106,7 +106,7 @@ start(Config) when is_list(Config) -> ?line {error, {already_started, _}} = gen_event:start({global, my_dummy_name}), - exit(Pid6, shutdown), + ok = gen_event:stop({global, my_dummy_name}, shutdown, 10000), receive {'EXIT', Pid6, shutdown} -> ok after 10000 -> diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index 8aeec07ae8..75796ab1b6 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The 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,11 +27,16 @@ -export([start1/1, start2/1, start3/1, start4/1, start5/1, start6/1, start7/1, start8/1, start9/1, start10/1, start11/1, start12/1]). +-export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1, + stop8/1, stop9/1, stop10/1]). + -export([ abnormal1/1, abnormal2/1]). -export([shutdown/1]). --export([ sys1/1, call_format_status/1, error_format_status/1, get_state/1, replace_state/1]). +-export([ sys1/1, + call_format_status/1, error_format_status/1, terminate_crash_format/1, + get_state/1, replace_state/1]). -export([hibernate/1,hiber_idle/3,hiber_wakeup/3,hiber_idle/2,hiber_wakeup/2]). @@ -64,9 +69,12 @@ groups() -> [{start, [], [start1, start2, start3, start4, start5, start6, start7, start8, start9, start10, start11, start12]}, + {stop, [], + [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]}, {abnormal, [], [abnormal1, abnormal2]}, {sys, [], - [sys1, call_format_status, error_format_status, get_state, replace_state]}]. + [sys1, call_format_status, error_format_status, terminate_crash_format, + get_state, replace_state]}]. init_per_suite(Config) -> Config. @@ -278,6 +286,105 @@ start12(Config) when is_list(Config) -> ok. +%% Anonymous, reason 'normal' +stop1(_Config) -> + {ok, Pid} = gen_fsm:start(?MODULE, [], []), + ok = gen_fsm:stop(Pid), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_fsm:stop(Pid)), + ok. + +%% Anonymous, other reason +stop2(_Config) -> + {ok,Pid} = gen_fsm:start(?MODULE, [], []), + ok = gen_fsm:stop(Pid, other_reason, infinity), + false = erlang:is_process_alive(Pid), + ok. + +%% Anonymous, invalid timeout +stop3(_Config) -> + {ok,Pid} = gen_fsm:start(?MODULE, [], []), + {'EXIT',_} = (catch gen_fsm:stop(Pid, other_reason, invalid_timeout)), + true = erlang:is_process_alive(Pid), + ok = gen_fsm:stop(Pid), + false = erlang:is_process_alive(Pid), + ok. + +%% Registered name +stop4(_Config) -> + {ok,Pid} = gen_fsm:start({local,to_stop},?MODULE, [], []), + ok = gen_fsm:stop(to_stop), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_fsm:stop(to_stop)), + ok. + +%% Registered name and local node +stop5(_Config) -> + {ok,Pid} = gen_fsm:start({local,to_stop},?MODULE, [], []), + ok = gen_fsm:stop({to_stop,node()}), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_fsm:stop({to_stop,node()})), + ok. + +%% Globally registered name +stop6(_Config) -> + {ok, Pid} = gen_fsm:start({global, to_stop}, ?MODULE, [], []), + ok = gen_fsm:stop({global,to_stop}), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})), + ok. + +%% 'via' registered name +stop7(_Config) -> + dummy_via:reset(), + {ok, Pid} = gen_fsm:start({via, dummy_via, to_stop}, + ?MODULE, [], []), + ok = gen_fsm:stop({via, dummy_via, to_stop}), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_fsm:stop({via, dummy_via, to_stop})), + ok. + +%% Anonymous on remote node +stop8(_Config) -> + {ok,Node} = test_server:start_node(gen_fsm_SUITE_stop8,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok, Pid} = rpc:call(Node,gen_fsm,start,[?MODULE,[],[]]), + ok = gen_fsm:stop(Pid), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + {'EXIT',noproc} = (catch gen_fsm:stop(Pid)), + true = test_server:stop_node(Node), + {'EXIT',{{nodedown,Node},_}} = (catch gen_fsm:stop(Pid)), + ok. + +%% Registered name on remote node +stop9(_Config) -> + {ok,Node} = test_server:start_node(gen_fsm_SUITE_stop9,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok, Pid} = rpc:call(Node,gen_fsm,start,[{local,to_stop},?MODULE,[],[]]), + ok = gen_fsm:stop({to_stop,Node}), + undefined = rpc:call(Node,erlang,whereis,[to_stop]), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + {'EXIT',noproc} = (catch gen_fsm:stop({to_stop,Node})), + true = test_server:stop_node(Node), + {'EXIT',{{nodedown,Node},_}} = (catch gen_fsm:stop({to_stop,Node})), + ok. + +%% Globally registered name on remote node +stop10(_Config) -> + {ok,Node} = test_server:start_node(gen_fsm_SUITE_stop10,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok, Pid} = rpc:call(Node,gen_fsm,start,[{global,to_stop},?MODULE,[],[]]), + global:sync(), + ok = gen_fsm:stop({global,to_stop}), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})), + true = test_server:stop_node(Node), + {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})), + ok. + %% Check that time outs in calls work abnormal1(suite) -> []; abnormal1(Config) when is_list(Config) -> @@ -403,7 +510,7 @@ error_format_status(Config) when is_list(Config) -> receive {error,_GroupLeader,{Pid, "** State machine"++_, - [Pid,{_,_,badreturn},idle,StateData,_]}} -> + [Pid,{_,_,badreturn},idle,{formatted,StateData},_]}} -> ok; Other -> ?line io:format("Unexpected: ~p", [Other]), @@ -413,6 +520,29 @@ error_format_status(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +terminate_crash_format(Config) when is_list(Config) -> + error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + StateData = crash_terminate, + {ok, Pid} = gen_fsm:start(gen_fsm_SUITE, {state_data, StateData}, []), + stop_it(Pid), + receive + {error,_GroupLeader,{Pid, + "** State machine"++_, + [Pid,{_,_,_},idle,{formatted, StateData},_]}} -> + ok; + Other -> + io:format("Unexpected: ~p", [Other]), + ?t:fail() + after 5000 -> + io:format("Timeout: expected error logger msg", []), + ?t:fail() + end, + [] = ?t:messages_get(), + process_flag(trap_exit, OldFl), + ok. + + get_state(Config) when is_list(Config) -> State = self(), {ok, Pid} = gen_fsm:start(?MODULE, {state_data, State}, []), @@ -867,7 +997,8 @@ init({state_data, StateData}) -> init(_) -> {ok, idle, state_data}. - +terminate(_, _State, crash_terminate) -> + exit({crash, terminate}); terminate({From, stopped}, State, _Data) -> From ! {self(), {stopped, State}}, ok; @@ -1005,6 +1136,6 @@ handle_sync_event({get, _Pid}, _From, State, Data) -> {reply, {state, State, Data}, State, Data}. format_status(terminate, [_Pdict, StateData]) -> - StateData; + {formatted, StateData}; format_status(normal, [_Pdict, _StateData]) -> [format_status_called]. diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 960e7f60e7..8b6654dd5e 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-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The 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,9 +32,13 @@ spec_init_local_registered_parent/1, spec_init_global_registered_parent/1, otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1, - error_format_status/1, get_state/1, replace_state/1, call_with_huge_message_queue/1 + error_format_status/1, terminate_crash_format/1, + get_state/1, replace_state/1, call_with_huge_message_queue/1 ]). +-export([stop1/1, stop2/1, stop3/1, stop4/1, stop5/1, stop6/1, stop7/1, + stop8/1, stop9/1, stop10/1]). + % spawn export -export([spec_init_local/2, spec_init_global/2, spec_init_via/2, spec_init_default_timeout/2, spec_init_global_default_timeout/2, @@ -50,18 +54,20 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [start, crash, call, cast, cast_fast, info, abcast, + [start, {group,stop}, crash, call, cast, cast_fast, info, abcast, multicall, multicall_down, call_remote1, call_remote2, call_remote3, call_remote_n1, call_remote_n2, call_remote_n3, spec_init, spec_init_local_registered_parent, spec_init_global_registered_parent, otp_5854, hibernate, - otp_7669, call_format_status, error_format_status, + otp_7669, + call_format_status, error_format_status, terminate_crash_format, get_state, replace_state, call_with_huge_message_queue]. groups() -> - []. + [{stop, [], + [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10]}]. init_per_suite(Config) -> Config. @@ -235,6 +241,105 @@ start(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +%% Anonymous, reason 'normal' +stop1(_Config) -> + {ok, Pid} = gen_server:start(?MODULE, [], []), + ok = gen_server:stop(Pid), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_server:stop(Pid)), + ok. + +%% Anonymous, other reason +stop2(_Config) -> + {ok,Pid} = gen_server:start(?MODULE, [], []), + ok = gen_server:stop(Pid, other_reason, infinity), + false = erlang:is_process_alive(Pid), + ok. + +%% Anonymous, invalid timeout +stop3(_Config) -> + {ok,Pid} = gen_server:start(?MODULE, [], []), + {'EXIT',_} = (catch gen_server:stop(Pid, other_reason, invalid_timeout)), + true = erlang:is_process_alive(Pid), + ok = gen_server:stop(Pid), + false = erlang:is_process_alive(Pid), + ok. + +%% Registered name +stop4(_Config) -> + {ok,Pid} = gen_server:start({local,to_stop},?MODULE, [], []), + ok = gen_server:stop(to_stop), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_server:stop(to_stop)), + ok. + +%% Registered name and local node +stop5(_Config) -> + {ok,Pid} = gen_server:start({local,to_stop},?MODULE, [], []), + ok = gen_server:stop({to_stop,node()}), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_server:stop({to_stop,node()})), + ok. + +%% Globally registered name +stop6(_Config) -> + {ok, Pid} = gen_server:start({global, to_stop}, ?MODULE, [], []), + ok = gen_server:stop({global,to_stop}), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})), + ok. + +%% 'via' registered name +stop7(_Config) -> + dummy_via:reset(), + {ok, Pid} = gen_server:start({via, dummy_via, to_stop}, + ?MODULE, [], []), + ok = gen_server:stop({via, dummy_via, to_stop}), + false = erlang:is_process_alive(Pid), + {'EXIT',noproc} = (catch gen_server:stop({via, dummy_via, to_stop})), + ok. + +%% Anonymous on remote node +stop8(_Config) -> + {ok,Node} = test_server:start_node(gen_server_SUITE_stop8,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok, Pid} = rpc:call(Node,gen_server,start,[?MODULE,[],[]]), + ok = gen_server:stop(Pid), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + {'EXIT',noproc} = (catch gen_server:stop(Pid)), + true = test_server:stop_node(Node), + {'EXIT',{{nodedown,Node},_}} = (catch gen_server:stop(Pid)), + ok. + +%% Registered name on remote node +stop9(_Config) -> + {ok,Node} = test_server:start_node(gen_server_SUITE_stop9,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok, Pid} = rpc:call(Node,gen_server,start,[{local,to_stop},?MODULE,[],[]]), + ok = gen_server:stop({to_stop,Node}), + undefined = rpc:call(Node,erlang,whereis,[to_stop]), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + {'EXIT',noproc} = (catch gen_server:stop({to_stop,Node})), + true = test_server:stop_node(Node), + {'EXIT',{{nodedown,Node},_}} = (catch gen_server:stop({to_stop,Node})), + ok. + +%% Globally registered name on remote node +stop10(_Config) -> + {ok,Node} = test_server:start_node(gen_server_SUITE_stop10,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + {ok, Pid} = rpc:call(Node,gen_server,start,[{global,to_stop},?MODULE,[],[]]), + global:sync(), + ok = gen_server:stop({global,to_stop}), + false = rpc:call(Node,erlang,is_process_alive,[Pid]), + {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})), + true = test_server:stop_node(Node), + {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})), + ok. + crash(Config) when is_list(Config) -> ?line error_logger_forwarder:register(), @@ -273,7 +378,7 @@ crash(Config) when is_list(Config) -> receive {error,_GroupLeader4,{Pid4, "** Generic server"++_, - [Pid4,crash,state4,crashed]}} -> + [Pid4,crash,{formatted, state4},crashed]}} -> ok; Other4a -> ?line io:format("Unexpected: ~p", [Other4a]), @@ -1024,7 +1129,7 @@ error_format_status(Config) when is_list(Config) -> receive {error,_GroupLeader,{Pid, "** Generic server"++_, - [Pid,crash,State,crashed]}} -> + [Pid,crash,{formatted, State},crashed]}} -> ok; Other -> ?line io:format("Unexpected: ~p", [Other]), @@ -1034,6 +1139,31 @@ error_format_status(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +%% Verify that error when terminating correctly calls our format_status/2 fun +%% +terminate_crash_format(Config) when is_list(Config) -> + error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + State = crash_terminate, + {ok, Pid} = gen_server:start_link(?MODULE, {state, State}, []), + gen_server:call(Pid, stop), + receive {'EXIT', Pid, {crash, terminate}} -> ok end, + receive + {error,_GroupLeader,{Pid, + "** Generic server"++_, + [Pid,stop, {formatted, State},{crash, terminate}]}} -> + ok; + Other -> + io:format("Unexpected: ~p", [Other]), + ?t:fail() + after 5000 -> + io:format("Timeout: expected error logger msg", []), + ?t:fail() + end, + ?t:messages_get(), + process_flag(trap_exit, OldFl), + ok. + %% Verify that sys:get_state correctly returns gen_server state %% get_state(suite) -> @@ -1323,10 +1453,12 @@ terminate({From, stopped}, _State) -> terminate({From, stopped_info}, _State) -> From ! {self(), stopped_info}, ok; +terminate(_, crash_terminate) -> + exit({crash, terminate}); terminate(_Reason, _State) -> ok. format_status(terminate, [_PDict, State]) -> - State; + {formatted, State}; format_status(normal, [_PDict, _State]) -> format_status_called. diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl index c826ee731a..dda20a615b 100644 --- a/lib/stdlib/test/maps_SUITE.erl +++ b/lib/stdlib/test/maps_SUITE.erl @@ -24,10 +24,7 @@ -include_lib("test_server/include/test_server.hrl"). -% Default timetrap timeout (set in init_per_testcase). -% This should be set relatively high (10-15 times the expected -% max testcasetime). --define(default_timeout, ?t:minutes(4)). +-define(default_timeout, ?t:minutes(1)). % Test server specific exports -export([all/0]). @@ -37,13 +34,13 @@ -export([init_per_testcase/2]). -export([end_per_testcase/2]). --export([get3/1]). +-export([t_get_3/1,t_with_2/1,t_without_2/1]). suite() -> [{ct_hooks, [ts_install_cth]}]. all() -> - [get3]. + [t_get_3,t_with_2,t_without_2]. init_per_suite(Config) -> Config. @@ -52,7 +49,7 @@ end_per_suite(_Config) -> ok. init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(?default_timeout), + Dog=test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -60,10 +57,24 @@ end_per_testcase(_Case, Config) -> test_server:timetrap_cancel(Dog), ok. -get3(Config) when is_list(Config) -> +t_get_3(Config) when is_list(Config) -> Map = #{ key1 => value1, key2 => value2 }, DefaultValue = "Default value", - ?line value1 = maps:get(key1, Map, DefaultValue), - ?line value2 = maps:get(key2, Map, DefaultValue), - ?line DefaultValue = maps:get(key3, Map, DefaultValue), + value1 = maps:get(key1, Map, DefaultValue), + value2 = maps:get(key2, Map, DefaultValue), + DefaultValue = maps:get(key3, Map, DefaultValue), + ok. + +t_without_2(_Config) -> + Ki = [11,22,33,44,55,66,77,88,99], + M0 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100)]), + M1 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100) -- Ki]), + M1 = maps:without([{k,I}||I <- Ki],M0), + ok. + +t_with_2(_Config) -> + Ki = [11,22,33,44,55,66,77,88,99], + M0 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100)]), + M1 = maps:from_list([{{k,I},{v,I}}||I<-Ki]), + M1 = maps:with([{k,I}||I <- Ki],M0), ok. diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl index 8dca69bac4..b6f1973a05 100644 --- a/lib/stdlib/test/proc_lib_SUITE.erl +++ b/lib/stdlib/test/proc_lib_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The 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,7 +27,7 @@ init_per_group/2,end_per_group/2, crash/1, sync_start_nolink/1, sync_start_link/1, spawn_opt/1, sp1/0, sp2/0, sp3/1, sp4/2, sp5/1, - hibernate/1]). + hibernate/1, stop/1]). -export([ otp_6345/1, init_dont_hang/1]). -export([hib_loop/1, awaken/1]). @@ -38,6 +38,7 @@ -export([otp_6345_init/1, init_dont_hang_init/1]). +-export([system_terminate/4]). -ifdef(STANDALONE). -define(line, noop, ). @@ -49,7 +50,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [crash, {group, sync_start}, spawn_opt, hibernate, - {group, tickets}]. + {group, tickets}, stop]. groups() -> [{tickets, [], [otp_6345, init_dont_hang]}, @@ -361,10 +362,94 @@ init_dont_hang(Config) when is_list(Config) -> exit(Error) end. -init_dont_hang_init(Parent) -> +init_dont_hang_init(_Parent) -> 1 = 2. +%% Test proc_lib:stop/1,3 +stop(_Config) -> + Parent = self(), + SysMsgProc = + fun() -> + receive + {system,From,Request} -> + sys:handle_system_msg(Request,From,Parent,?MODULE,[],[]) + end + end, + + %% Normal case: + %% Process handles system message and terminated with given reason + Pid1 = proc_lib:spawn(SysMsgProc), + ok = proc_lib:stop(Pid1), + false = erlang:is_process_alive(Pid1), + + %% Process does not exit + {'EXIT',noproc} = (catch proc_lib:stop(Pid1)), + + %% Badly handled system message + DieProc = + fun() -> + receive + {system,_From,_Request} -> + exit(die) + end + end, + Pid2 = proc_lib:spawn(DieProc), + {'EXIT',{die,_}} = (catch proc_lib:stop(Pid2)), + + %% Hanging process => timeout + HangProc = + fun() -> + receive + {system,_From,_Request} -> + timer:sleep(5000) + end + end, + Pid3 = proc_lib:spawn(HangProc), + {'EXIT',timeout} = (catch proc_lib:stop(Pid3,normal,1000)), + + %% Success case with other reason than 'normal' + Pid4 = proc_lib:spawn(SysMsgProc), + ok = proc_lib:stop(Pid4,other_reason,infinity), + false = erlang:is_process_alive(Pid4), + + %% System message is handled, but process dies with other reason + %% than the given (in system_terminate/4 below) + Pid5 = proc_lib:spawn(SysMsgProc), + {'EXIT',{badmatch,2}} = (catch proc_lib:stop(Pid5,crash,infinity)), + false = erlang:is_process_alive(Pid5), + + %% Local registered name + Pid6 = proc_lib:spawn(SysMsgProc), + register(to_stop,Pid6), + ok = proc_lib:stop(to_stop), + undefined = whereis(to_stop), + false = erlang:is_process_alive(Pid6), + + %% Remote registered name + {ok,Node} = test_server:start_node(proc_lib_SUITE_stop,slave,[]), + Dir = filename:dirname(code:which(?MODULE)), + rpc:call(Node,code,add_path,[Dir]), + Pid7 = spawn(Node,SysMsgProc), + true = rpc:call(Node,erlang,register,[to_stop,Pid7]), + Pid7 = rpc:call(Node,erlang,whereis,[to_stop]), + ok = proc_lib:stop({to_stop,Node}), + undefined = rpc:call(Node,erlang,whereis,[to_stop]), + false = rpc:call(Node,erlang,is_process_alive,[Pid7]), + + %% Local and remote registered name, but non-existing + {'EXIT',noproc} = (catch proc_lib:stop(to_stop)), + {'EXIT',noproc} = (catch proc_lib:stop({to_stop,Node})), + + true = test_server:stop_node(Node), + + %% Remote registered name, but non-existing node + {'EXIT',{{nodedown,Node},_}} = (catch proc_lib:stop({to_stop,Node})), + ok. +system_terminate(crash,_Parent,_Deb,_State) -> + 1 = 2; +system_terminate(Reason,_Parent,_Deb,_State) -> + exit(Reason). %%----------------------------------------------------------------- %% The error_logger handler used. diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl index 59821220b4..6669a21b9c 100644 --- a/lib/stdlib/test/stdlib_SUITE.erl +++ b/lib/stdlib/test/stdlib_SUITE.erl @@ -22,14 +22,7 @@ -module(stdlib_SUITE). -include_lib("test_server/include/test_server.hrl"). - -% Test server specific exports --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). --export([init_per_testcase/2, end_per_testcase/2]). - -% Test cases must be exported. --export([app_test/1, appup_test/1]). +-compile(export_all). %% %% all/1 @@ -37,10 +30,10 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_test, appup_test]. + [app_test, appup_test, {group,upgrade}]. groups() -> - []. + [{upgrade,[minor_upgrade,major_upgrade]}]. init_per_suite(Config) -> Config. @@ -48,9 +41,13 @@ init_per_suite(Config) -> end_per_suite(_Config) -> ok. +init_per_group(upgrade, Config) -> + ct_release_test:init(Config); init_per_group(_GroupName, Config) -> Config. +end_per_group(upgrade, Config) -> + ct_release_test:cleanup(Config); end_per_group(_GroupName, Config) -> Config. @@ -78,17 +75,29 @@ appup_test(_Config) -> appup_tests(_App,{[],[]}) -> {skip,"no previous releases available"}; -appup_tests(App,{OkVsns,NokVsns}) -> +appup_tests(App,{OkVsns0,NokVsns}) -> application:load(App), {_,_,Vsn} = lists:keyfind(App,1,application:loaded_applications()), AppupFileName = atom_to_list(App) ++ ".appup", AppupFile = filename:join([code:lib_dir(App),ebin,AppupFileName]), {ok,[{Vsn,UpFrom,DownTo}=AppupScript]} = file:consult(AppupFile), ct:log("~p~n",[AppupScript]), - ct:log("Testing ok versions: ~p~n",[OkVsns]), + OkVsns = + case OkVsns0 -- [Vsn] of + OkVsns0 -> + OkVsns0; + Ok -> + ct:log("Current version, ~p, is same as in previous release.~n" + "Removing this from the list of ok versions.", + [Vsn]), + Ok + end, + ct:log("Testing that appup allows upgrade from these versions: ~p~n", + [OkVsns]), check_appup(OkVsns,UpFrom,{ok,[restart_new_emulator]}), check_appup(OkVsns,DownTo,{ok,[restart_new_emulator]}), - ct:log("Testing not ok versions: ~p~n",[NokVsns]), + ct:log("Testing that appup does not allow upgrade from these versions: ~p~n", + [NokVsns]), check_appup(NokVsns,UpFrom,error), check_appup(NokVsns,DownTo,error), ok. @@ -153,3 +162,19 @@ check_appup([Vsn|Vsns],Instrs,Expected) -> end; check_appup([],_,_) -> ok. + + +minor_upgrade(Config) -> + ct_release_test:upgrade(stdlib,minor,{?MODULE,[]},Config). + +major_upgrade(Config) -> + ct_release_test:upgrade(stdlib,major,{?MODULE,[]},Config). + +%% Version numbers are checked by ct_release_test, so there is nothing +%% more to check here... +upgrade_init(State) -> + State. +upgrade_upgraded(State) -> + State. +upgrade_downgraded(State) -> + State. diff --git a/lib/stdlib/test/sys_SUITE.erl b/lib/stdlib/test/sys_SUITE.erl index f38bc87ae5..047ee9f1fa 100644 --- a/lib/stdlib/test/sys_SUITE.erl +++ b/lib/stdlib/test/sys_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -202,14 +202,7 @@ spec_proc(Mod) -> {Mod,system_get_state},{throw,fail}},_}} -> ok end, - Mod:stop(), - WaitForUnregister = fun W() -> - case whereis(Mod) of - undefined -> ok; - _ -> timer:sleep(10), W() - end - end, - WaitForUnregister(), + ok = sys:terminate(Mod, normal), {ok,_} = Mod:start_link(4), ok = case catch sys:replace_state(Mod, fun(_) -> {} end) of {} -> @@ -218,8 +211,7 @@ spec_proc(Mod) -> {Mod,system_replace_state},{throw,fail}},_}} -> ok end, - Mod:stop(), - WaitForUnregister(), + ok = sys:terminate(Mod, normal), {ok,_} = Mod:start_link(4), StateFun = fun(_) -> error(fail) end, ok = case catch sys:replace_state(Mod, StateFun) of @@ -231,7 +223,7 @@ spec_proc(Mod) -> {'EXIT',{{callback_failed,StateFun,{error,fail}},_}} -> ok end, - Mod:stop(). + ok = sys:terminate(Mod, normal). %%%%%%%%%%%%%%%%%%%% %% Dummy server diff --git a/lib/stdlib/test/sys_sp1.erl b/lib/stdlib/test/sys_sp1.erl index e84ffcfa12..0fb288991f 100644 --- a/lib/stdlib/test/sys_sp1.erl +++ b/lib/stdlib/test/sys_sp1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The 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,7 +17,7 @@ %% %CopyrightEnd% %% -module(sys_sp1). --export([start_link/1, stop/0]). +-export([start_link/1]). -export([alloc/0, free/1]). -export([init/1]). -export([system_continue/3, system_terminate/4, @@ -31,10 +31,6 @@ start_link(NumCh) -> proc_lib:start_link(?MODULE, init, [[self(),NumCh]]). -stop() -> - ?MODULE ! stop, - ok. - alloc() -> ?MODULE ! {self(), alloc}, receive @@ -70,11 +66,7 @@ loop(Chs, Parent, Deb) -> loop(Chs2, Parent, Deb2); {system, From, Request} -> sys:handle_system_msg(Request, From, Parent, - ?MODULE, Deb, Chs); - stop -> - sys:handle_debug(Deb, fun write_debug/3, - ?MODULE, {in, stop}), - ok + ?MODULE, Deb, Chs) end. system_continue(Parent, Deb, Chs) -> diff --git a/lib/stdlib/test/sys_sp2.erl b/lib/stdlib/test/sys_sp2.erl index 56a5e4d071..a0847b5838 100644 --- a/lib/stdlib/test/sys_sp2.erl +++ b/lib/stdlib/test/sys_sp2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The 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,7 +17,7 @@ %% %CopyrightEnd% %% -module(sys_sp2). --export([start_link/1, stop/0]). +-export([start_link/1]). -export([alloc/0, free/1]). -export([init/1]). -export([system_continue/3, system_terminate/4, @@ -30,10 +30,6 @@ start_link(NumCh) -> proc_lib:start_link(?MODULE, init, [[self(),NumCh]]). -stop() -> - ?MODULE ! stop, - ok. - alloc() -> ?MODULE ! {self(), alloc}, receive @@ -45,11 +41,6 @@ free(Ch) -> ?MODULE ! {free, Ch}, ok. -%% can't use 2-tuple for state here as we do in sys_sp1, since the 2-tuple -%% is not compatible with the backward compatibility handling for -%% sys:get_state in sys.erl --record(state, {alloc,free}). - init([Parent,NumCh]) -> register(?MODULE, self()), Chs = channels(NumCh), @@ -74,11 +65,7 @@ loop(Chs, Parent, Deb) -> loop(Chs2, Parent, Deb2); {system, From, Request} -> sys:handle_system_msg(Request, From, Parent, - ?MODULE, Deb, Chs); - stop -> - sys:handle_debug(Deb, fun write_debug/3, - ?MODULE, {in, stop}), - ok + ?MODULE, Deb, Chs) end. system_continue(Parent, Deb, Chs) -> @@ -91,17 +78,17 @@ write_debug(Dev, Event, Name) -> io:format(Dev, "~p event = ~p~n", [Name, Event]). channels(NumCh) -> - #state{alloc=[], free=lists:seq(1,NumCh)}. + {_Allocated=[], _Free=lists:seq(1,NumCh)}. -alloc(#state{free=[]}=Channels) -> - {{error, "no channels available"}, Channels}; -alloc(#state{alloc=Allocated, free=[H|T]}) -> - {H, #state{alloc=[H|Allocated], free=T}}. +alloc({_, []}) -> + {error, "no channels available"}; +alloc({Allocated, [H|T]}) -> + {H, {[H|Allocated], T}}. -free(Ch, #state{alloc=Alloc, free=Free}=Channels) -> +free(Ch, {Alloc, Free}=Channels) -> case lists:member(Ch, Alloc) of true -> - #state{alloc=lists:delete(Ch, Alloc), free=[Ch|Free]}; + {lists:delete(Ch, Alloc), [Ch|Free]}; false -> Channels end. diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk index 9881ab040e..b522c3ea3c 100644 --- a/lib/stdlib/vsn.mk +++ b/lib/stdlib/vsn.mk @@ -1 +1 @@ -STDLIB_VSN = 2.1.1 +STDLIB_VSN = 2.2 diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 46a5ca48df..de271d7f2f 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -669,6 +669,9 @@ is_leaf(Node) -> operator -> true; % nonstandard type string -> true; text -> true; % nonstandard type + map_expr -> + map_expr_fields(Node) =:= [] andalso + map_expr_argument(Node) =:= none; tuple -> tuple_elements(Node) =:= []; underscore -> true; variable -> true; @@ -3320,6 +3323,11 @@ attribute_arguments(Node) -> [set_pos( list(unfold_function_names(Data, Pos)), Pos)]; + optional_callbacks -> + D = try list(unfold_function_names(Data, Pos)) + catch _:_ -> abstract(Data) + end, + [set_pos(D, Pos)]; import -> {Module, Imports} = Data, [set_pos(atom(Module), Pos), @@ -6093,6 +6101,9 @@ abstract([]) -> nil(); abstract(T) when is_tuple(T) -> tuple(abstract_list(tuple_to_list(T))); +abstract(T) when is_map(T) -> + map_expr([map_field_assoc(abstract(Key),abstract(Value)) + || {Key,Value} <- maps:to_list(T)]); abstract(T) when is_binary(T) -> binary([binary_field(integer(B)) || B <- binary_to_list(T)]); abstract(T) -> @@ -6129,6 +6140,13 @@ abstract_tail(H, T) -> %% {@link char/1} function to explicitly create an abstract %% character.) %% +%% Note: `arity_qualifier' nodes are recognized. This is to follow The +%% Erlang Parser when it comes to wild attributes: both {F, A} and F/A +%% are recognized, which makes it possible to turn wild attributes +%% into recognized attributes without at the same time making it +%% impossible to compile files using the new syntax with the old +%% version of the Erlang Compiler. +%% %% @see abstract/1 %% @see is_literal/1 %% @see char/1 @@ -6154,6 +6172,14 @@ concrete(Node) -> | concrete(list_tail(Node))]; tuple -> list_to_tuple(concrete_list(tuple_elements(Node))); + map_expr -> + As = [tuple([map_field_assoc_name(F), + map_field_assoc_value(F)]) || F <- map_expr_fields(Node)], + M0 = maps:from_list(concrete_list(As)), + case map_expr_argument(Node) of + none -> M0; + Node0 -> maps:merge(concrete(Node0),M0) + end; binary -> Fs = [revert_binary_field( binary_field(binary_field_body(F), @@ -6170,6 +6196,20 @@ concrete(Node) -> {value, concrete(F), []} end, [], true), B; + arity_qualifier -> + A = erl_syntax:arity_qualifier_argument(Node), + case erl_syntax:type(A) of + integer -> + F = erl_syntax:arity_qualifier_body(Node), + case erl_syntax:type(F) of + atom -> + {F, A}; + _ -> + erlang:error({badarg, Node}) + end; + _ -> + erlang:error({badarg, Node}) + end; _ -> erlang:error({badarg, Node}) end. @@ -6209,10 +6249,31 @@ is_literal(T) -> is_literal(list_head(T)) andalso is_literal(list_tail(T)); tuple -> lists:all(fun is_literal/1, tuple_elements(T)); + map_expr -> + case map_expr_argument(T) of + none -> true; + Arg -> is_literal(Arg) + end andalso lists:all(fun is_literal_map_field/1, map_expr_fields(T)); + binary -> + lists:all(fun is_literal_binary_field/1, binary_fields(T)); _ -> false end. +is_literal_binary_field(F) -> + case binary_field_types(F) of + [] -> is_literal(binary_field_body(F)); + _ -> false + end. + +is_literal_map_field(F) -> + case type(F) of + map_field_assoc -> + is_literal(map_field_assoc_name(F)) andalso + is_literal(map_field_assoc_value(F)); + map_field_exact -> + false + end. %% ===================================================================== %% @doc Returns an `erl_parse'-compatible representation of a diff --git a/lib/syntax_tools/test/Makefile b/lib/syntax_tools/test/Makefile index d4733b9a42..f67e3f8984 100644 --- a/lib/syntax_tools/test/Makefile +++ b/lib/syntax_tools/test/Makefile @@ -61,5 +61,6 @@ release_tests_spec: make_emakefile $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) syntax_tools.spec syntax_tools.cover "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" + @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) release_docs_spec: diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index 6fb3e5ccfb..3c6b33f459 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -24,12 +24,16 @@ init_per_group/2,end_per_group/2]). %% Test cases --export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1]). +-export([app_test/1,appup_test/1,smoke_test/1,revert/1,revert_map/1, + t_abstract_type/1,t_erl_parse_type/1,t_epp_dodger/1, + t_comment_scan/1,t_igor/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_test,appup_test,smoke_test,revert,revert_map]. + [app_test,appup_test,smoke_test,revert,revert_map, + t_abstract_type,t_erl_parse_type,t_epp_dodger, + t_comment_scan,t_igor]. groups() -> []. @@ -54,15 +58,15 @@ appup_test(Config) when is_list(Config) -> %% Read and parse all source in the OTP release. smoke_test(Config) when is_list(Config) -> - ?line Dog = ?t:timetrap(?t:minutes(12)), - ?line Wc = filename:join([code:lib_dir(),"*","src","*.erl"]), - ?line Fs = filelib:wildcard(Wc), - ?line io:format("~p files\n", [length(Fs)]), - ?line case p_run(fun smoke_test_file/1, Fs) of - 0 -> ok; - N -> ?line ?t:fail({N,errors}) - end, - ?line ?t:timetrap_cancel(Dog). + Dog = ?t:timetrap(?t:minutes(12)), + Wc = filename:join([code:lib_dir(),"*","src","*.erl"]), + Fs = filelib:wildcard(Wc), + io:format("~p files\n", [length(Fs)]), + case p_run(fun smoke_test_file/1, Fs) of + 0 -> ok; + N -> ?t:fail({N,errors}) + end, + ?t:timetrap_cancel(Dog). smoke_test_file(File) -> case epp_dodger:parse_file(File) of @@ -94,9 +98,9 @@ revert(Config) when is_list(Config) -> io:format("~p files\n", [length(Fs)]), case p_run(fun (File) -> revert_file(File, Path) end, Fs) of 0 -> ok; - N -> ?line ?t:fail({N,errors}) + N -> ?t:fail({N,errors}) end, - ?line ?t:timetrap_cancel(Dog). + ?t:timetrap_cancel(Dog). revert_file(File, Path) -> case epp:parse_file(File, Path, []) of @@ -110,14 +114,298 @@ revert_file(File, Path) -> end. %% Testing bug fix for reverting map_field_assoc -revert_map(Config) -> +revert_map(Config) when is_list(Config) -> Dog = ?t:timetrap(?t:minutes(1)), - ?line [{map_field_assoc,16,{atom,17,name},{var,18,'Value'}}] = - erl_syntax:revert_forms([{tree,map_field_assoc, - {attr,16,[],none}, - {map_field_assoc, - {atom,17,name},{var,18,'Value'}}}]), - ?line ?t:timetrap_cancel(Dog). + [{map_field_assoc,16,{atom,17,name},{var,18,'Value'}}] = + erl_syntax:revert_forms([{tree,map_field_assoc, + {attr,16,[],none}, + {map_field_assoc,{atom,17,name},{var,18,'Value'}}}]), + ?t:timetrap_cancel(Dog). + + + +%% api tests + +t_abstract_type(Config) when is_list(Config) -> + F = fun validate_abstract_type/1, + ok = validate(F,[{hi,atom}, + {1,integer}, + {1.0,float}, + {$a,integer}, + {[],nil}, + {[<<1,2>>,a,b],list}, + {[2,3,<<1,2>>,a,b],list}, + {[$a,$b,$c],string}, + {"hello world",string}, + {<<1,2,3>>,binary}, + {#{a=>1,"b"=>2},map_expr}, + {#{#{i=>1}=>1,"b"=>#{v=>2}},map_expr}, + {{a,b,c},tuple}]), + ok. + +t_erl_parse_type(Config) when is_list(Config) -> + F = fun validate_erl_parse_type/1, + %% leaf types + ok = validate(F,[{"1",integer,true}, + {"123456789",integer,true}, + {"$h", char,true}, + {"3.1415", float,true}, + {"1.33e36", float,true}, + {"\"1.33e36: hello\"", string,true}, + {"Var1", variable,true}, + {"_", underscore,true}, + {"[]", nil,true}, + {"{}", tuple,true}, + {"#{}",map_expr,true}, + {"'some atom'", atom, true}]), + %% composite types + ok = validate(F,[{"case X of t -> t; f -> f end", case_expr,false}, + {"try X of t -> t catch C:R -> error end", try_expr,false}, + {"receive X -> X end", receive_expr,false}, + {"receive M -> X1 after T -> X2 end", receive_expr,false}, + {"catch (X)", catch_expr,false}, + {"fun(X) -> X end", fun_expr,false}, + {"fun Foo(X) -> X end", named_fun_expr,false}, + {"fun foo/2", implicit_fun,false}, + {"fun bar:foo/2", implicit_fun,false}, + {"if X -> t; true -> f end", if_expr,false}, + {"<<1,2,3,4>>", binary,false}, + {"<<1,2,3,4:5>>", binary,false}, + {"<<V1:63,V2:22/binary, V3/bits>>", binary,false}, + {"begin X end", block_expr,false}, + {"foo(X1,X2)", application,false}, + {"bar:foo(X1,X2)", application,false}, + {"[1,2,3,4]", list,false}, + {"[1|4]", list, false}, + {"[<<1>>,<<2>>,-2,<<>>,[more,list]]", list,false}, + {"[1|[2|[3|[4|[]]]]]", list,false}, + {"#{ a=>1, b=>2 }", map_expr,false}, + {"#{3=>3}#{ a=>1, b=>2 }", map_expr,false}, + {"#{ a:=1, b:=2 }", map_expr,false}, + {"M#{ a=>1, b=>2 }", map_expr,false}, + {"[V||V <- Vs]", list_comp,false}, + {"<< <<B>> || <<B>> <= Bs>>", binary_comp,false}, + {"#state{ a = A, b = B}", record_expr,false}, + {"#state{}", record_expr,false}, + {"#s{ a = #def{ a=A }, b = B}", record_expr,false}, + {"State#state{ a = A, b = B}", record_expr,false}, + {"State#state.a", record_access,false}, + {"#state.a", record_index_expr,false}, + {"-X", prefix_expr,false}, + {"X1 + X2", infix_expr,false}, + {"(X1 + X2) * X3", infix_expr,false}, + {"X1 = X2", match_expr,false}, + {"{a,b,c}", tuple,false}]), + ok. + +%% the macro ?MODULE seems faulty +t_epp_dodger(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + Filenames = ["syntax_tools_SUITE_test_module.erl", + "syntax_tools_test.erl"], + ok = test_epp_dodger(Filenames,DataDir,PrivDir), + ok. + +t_comment_scan(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + Filenames = ["syntax_tools_SUITE_test_module.erl", + "syntax_tools_test.erl"], + ok = test_comment_scan(Filenames,DataDir), + ok. + +t_igor(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + FileM1 = filename:join(DataDir,"m1.erl"), + FileM2 = filename:join(DataDir,"m2.erl"), + ["m.erl",_]=R = igor:merge(m,[FileM1,FileM2],[{outdir,PrivDir}]), + io:format("igor:merge/3 = ~p~n", [R]), + ok. + +test_comment_scan([],_) -> ok; +test_comment_scan([File|Files],DataDir) -> + Filename = filename:join(DataDir,File), + {ok, Fs0} = epp:parse_file(Filename, [], []), + Comments = erl_comment_scan:file(Filename), + Fun = fun(Node) -> + case erl_syntax:is_form(Node) of + true -> + C1 = erl_syntax:comment(2,[" This is a form."]), + Node1 = erl_syntax:add_precomments([C1],Node), + Node1; + false -> + Node + end + end, + Fs1 = erl_recomment:recomment_forms(Fs0, Comments), + Fs2 = erl_syntax_lib:map(Fun, Fs1), + io:format("File: ~s~n", [Filename]), + io:put_chars(erl_prettypr:format(Fs2, [{paper, 120}, + {ribbon, 110}])), + test_comment_scan(Files,DataDir). + + +test_epp_dodger([], _, _) -> ok; +test_epp_dodger([Filename|Files],DataDir,PrivDir) -> + io:format("Parsing ~p~n", [Filename]), + InFile = filename:join(DataDir, Filename), + Parsers = [{fun epp_dodger:parse_file/1,parse_file}, + {fun epp_dodger:quick_parse_file/1,quick_parse_file}, + {fun (File) -> + {ok,Dev} = file:open(File,[read]), + Res = epp_dodger:parse(Dev), + file:close(File), + Res + end, parse}, + {fun (File) -> + {ok,Dev} = file:open(File,[read]), + Res = epp_dodger:quick_parse(Dev), + file:close(File), + Res + end, quick_parse}], + FsForms = parse_with(Parsers, InFile), + ok = pretty_print_parse_forms(FsForms,PrivDir,Filename), + test_epp_dodger(Files,DataDir,PrivDir). + +parse_with([],_) -> []; +parse_with([{Fun,ParserType}|Funs],File) -> + {ok, Fs} = Fun(File), + [{Fs,ParserType}|parse_with(Funs,File)]. + +pretty_print_parse_forms([],_,_) -> ok; +pretty_print_parse_forms([{Fs0,Type}|FsForms],PrivDir,Filename) -> + Parser = atom_to_list(Type), + OutFile = filename:join(PrivDir, Parser ++"_" ++ Filename), + io:format("Pretty print ~p (~w) to ~p~n", [Filename,Type,OutFile]), + Comment = fun (Node,{CntCase,CntTry}=Cnt) -> + case erl_syntax:type(Node) of + case_expr -> + C1 = erl_syntax:comment(2,["Before a case expression"]), + Node1 = erl_syntax:add_precomments([C1],Node), + C2 = erl_syntax:comment(2,["After a case expression"]), + Node2 = erl_syntax:add_postcomments([C2],Node1), + {Node2,{CntCase+1,CntTry}}; + try_expr -> + C1 = erl_syntax:comment(2,["Before a try expression"]), + Node1 = erl_syntax:set_precomments(Node, + erl_syntax:get_precomments(Node) ++ [C1]), + C2 = erl_syntax:comment(2,["After a try expression"]), + Node2 = erl_syntax:set_postcomments(Node1, + erl_syntax:get_postcomments(Node1) ++ [C2]), + {Node2,{CntCase,CntTry+1}}; + _ -> + {Node,Cnt} + end + end, + Fs1 = erl_syntax:form_list(Fs0), + {Fs2,{CC,CT}} = erl_syntax_lib:mapfold(Comment,{0,0}, Fs1), + io:format("Commented on ~w cases and ~w tries~n", [CC,CT]), + PP = erl_prettypr:format(Fs2), + ok = file:write_file(OutFile,iolist_to_binary(PP)), + pretty_print_parse_forms(FsForms,PrivDir,Filename). + + +validate(_,[]) -> ok; +validate(F,[V|Vs]) -> + ok = F(V), + validate(F,Vs). + + +validate_abstract_type({Lit,Type}) -> + Tree = erl_syntax:abstract(Lit), + ok = validate_special_type(Type,Tree), + Type = erl_syntax:type(Tree), + true = erl_syntax:is_literal(Tree), + ErlT = erl_syntax:revert(Tree), + Type = erl_syntax:type(ErlT), + ok = validate_special_type(Type,ErlT), + Conc = erl_syntax:concrete(Tree), + Lit = Conc, + ok. + +validate_erl_parse_type({String,Type,Leaf}) -> + ErlT = string_to_expr(String), + ok = validate_special_type(Type,ErlT), + Type = erl_syntax:type(ErlT), + Leaf = erl_syntax:is_leaf(ErlT), + Tree = erl_syntax_lib:map(fun(Node) -> Node end, ErlT), + Type = erl_syntax:type(Tree), + _ = erl_syntax:meta(Tree), + ok = validate_special_type(Type,Tree), + RevT = erl_syntax:revert(Tree), + ok = validate_special_type(Type,RevT), + Type = erl_syntax:type(RevT), + ok. + +validate_special_type(string,Node) -> + Val = erl_syntax:string_value(Node), + true = erl_syntax:is_string(Node,Val), + _ = erl_syntax:string_literal(Node), + ok; +validate_special_type(variable,Node) -> + _ = erl_syntax:variable_literal(Node), + ok; +validate_special_type(fun_expr,Node) -> + A = erl_syntax:fun_expr_arity(Node), + true = is_integer(A), + ok; +validate_special_type(named_fun_expr,Node) -> + A = erl_syntax:named_fun_expr_arity(Node), + true = is_integer(A), + ok; +validate_special_type(tuple,Node) -> + Size = erl_syntax:tuple_size(Node), + true = is_integer(Size), + ok; +validate_special_type(float,Node) -> + Str = erl_syntax:float_literal(Node), + Val = list_to_float(Str), + Val = erl_syntax:float_value(Node), + false = erl_syntax:is_proper_list(Node), + false = erl_syntax:is_list_skeleton(Node), + ok; +validate_special_type(integer,Node) -> + Str = erl_syntax:integer_literal(Node), + Val = list_to_integer(Str), + true = erl_syntax:is_integer(Node,Val), + Val = erl_syntax:integer_value(Node), + false = erl_syntax:is_proper_list(Node), + ok; +validate_special_type(nil,Node) -> + true = erl_syntax:is_proper_list(Node), + ok; +validate_special_type(list,Node) -> + true = erl_syntax:is_list_skeleton(Node), + _ = erl_syntax:list_tail(Node), + ErrV = erl_syntax:list_head(Node), + false = erl_syntax:is_string(Node,ErrV), + Norm = erl_syntax:normalize_list(Node), + list = erl_syntax:type(Norm), + case erl_syntax:is_proper_list(Node) of + true -> + true = erl_syntax:is_list_skeleton(Node), + Compact = erl_syntax:compact_list(Node), + list = erl_syntax:type(Compact), + [_|_] = erl_syntax:list_elements(Node), + _ = erl_syntax:list_elements(Node), + N = erl_syntax:list_length(Node), + true = N > 0, + ok; + false -> + ok + end; +validate_special_type(_,_) -> + ok. + +%%% scan_and_parse + +string_to_expr(String) -> + io:format("Str: ~p~n", [String]), + {ok, Ts, _} = erl_scan:string(String++"."), + {ok,[Expr]} = erl_parse:parse_exprs(Ts), + Expr. + p_run(Test, List) -> N = erlang:system_info(schedulers), @@ -138,4 +426,3 @@ p_run_loop(Test, List, N, Refs0, Errors0) -> Refs = Refs0 -- [Ref], p_run_loop(Test, List, N, Refs, Errors) end. - diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/m1.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/m1.erl new file mode 100644 index 0000000000..d0d1911199 --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/m1.erl @@ -0,0 +1,22 @@ +%% +%% File: m1.erl +%% Author: Björn-Egil Dahlberg +%% Created: 2014-10-24 +%% + +-module(m1). + +-export([foo/0,bar/1,baz/2]). + +foo() -> + [m2:foo(), + m2:bar()]. + +bar(A) -> + [m2:foo(A), + m2:bar(A), + m2:record_update(3,m2:record())]. + +baz(A,B) -> + [m2:foo(A,B), + m2:bar(A,B)]. diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/m2.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/m2.erl new file mode 100644 index 0000000000..781139317d --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/m2.erl @@ -0,0 +1,26 @@ +%% +%% File: m2.erl +%% Author: Björn-Egil Dahlberg +%% Created: 2014-10-24 +%% + +-module(m2). + + +-export([foo/0,foo/1,foo/2, + bar/0,bar/1,bar/2, + record_update/2, record/0]). + +foo() -> ok. +foo(A) -> [item,A]. +foo(A,B) -> A + B. + +bar() -> true. +bar(A) -> {element,A}. +bar(A,B) -> A*B. + +-record(rec, {a,b}). + +record() -> #rec{a=3,b=0}. +record_update(V,#rec{a=V0}=R) -> + R#rec{a=V0+V,b=V0}. diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/syntax_tools_SUITE_test_module.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/syntax_tools_SUITE_test_module.erl new file mode 100644 index 0000000000..07c419b4b7 --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/syntax_tools_SUITE_test_module.erl @@ -0,0 +1,540 @@ +-module(syntax_tools_SUITE_test_module). + +-export([foo1/1,foo2/3,start_child/2]). + +-export([len/1,equal/2,concat/2,chr/2,rchr/2,str/2,rstr/2, + span/2,cspan/2,substr/2,substr/3,tokens/2,chars/2,chars/3]). +-export([copies/2,words/1,words/2,strip/1,strip/2,strip/3, + sub_word/2,sub_word/3,left/2,left/3,right/2,right/3, + sub_string/2,sub_string/3,centre/2,centre/3, join/2]). +-export([to_upper/1, to_lower/1]). + +-import(lists,[reverse/1,member/2]). + + +%% @type some_type() = map() +%% @type some_other_type() = {a, #{ list() => term()}} + +-type some_type() :: map(). +-type some_other_type() :: {'a', #{ list() => term()} }. + +-spec foo1(Map :: #{ 'a' => integer(), 'b' => term()}) -> term(). + +%% @doc Gets value from map. + +foo1(#{ a:= 1, b := V}) -> V. + +%% @spec foo2(some_type(), Type2 :: some_other_type(), map()) -> Value +%% @doc Gets value from map. + +-spec foo2( + Type1 :: some_type(), + Type2 :: some_other_type(), + Map :: #{ get => 'value', 'value' => binary()}) -> binary(). + +foo2(Type1, {a,#{ "a" := _}}, #{get := value, value := B}) when is_map(Type1) -> B. + +%% from supervisor 18.0 + +-type child() :: 'undefined' | pid(). +-type child_id() :: term(). +-type mfargs() :: {M :: module(), F :: atom(), A :: [term()] | undefined}. +-type modules() :: [module()] | 'dynamic'. +-type restart() :: 'permanent' | 'transient' | 'temporary'. +-type shutdown() :: 'brutal_kill' | timeout(). +-type worker() :: 'worker' | 'supervisor'. +-type sup_ref() :: (Name :: atom()) + | {Name :: atom(), Node :: node()} + | {'global', Name :: atom()} + | {'via', Module :: module(), Name :: any()} + | pid(). +-type child_spec() :: #{name => child_id(), % mandatory + start => mfargs(), % mandatory + restart => restart(), % optional + shutdown => shutdown(), % optional + type => worker(), % optional + modules => modules()} % optional + | {Id :: child_id(), + StartFunc :: mfargs(), + Restart :: restart(), + Shutdown :: shutdown(), + Type :: worker(), + Modules :: modules()}. + +-type startchild_err() :: 'already_present' + | {'already_started', Child :: child()} | term(). +-type startchild_ret() :: {'ok', Child :: child()} + | {'ok', Child :: child(), Info :: term()} + | {'error', startchild_err()}. + + +-spec start_child(SupRef, ChildSpec) -> startchild_ret() when + SupRef :: sup_ref(), + ChildSpec :: child_spec() | (List :: [term()]). +start_child(Supervisor, ChildSpec) -> + {Supervisor,ChildSpec}. + + +%% From string.erl +%% Robert's bit + +%% len(String) +%% Return the length of a string. + +-spec len(String) -> Length when + String :: string(), + Length :: non_neg_integer(). + +len(S) -> length(S). + +%% equal(String1, String2) +%% Test if 2 strings are equal. + +-spec equal(String1, String2) -> boolean() when + String1 :: string(), + String2 :: string(). + +equal(S, S) -> true; +equal(_, _) -> false. + +%% concat(String1, String2) +%% Concatenate 2 strings. + +-spec concat(String1, String2) -> String3 when + String1 :: string(), + String2 :: string(), + String3 :: string(). + +concat(S1, S2) -> S1 ++ S2. + +%% chr(String, Char) +%% rchr(String, Char) +%% Return the first/last index of the character in a string. + +-spec chr(String, Character) -> Index when + String :: string(), + Character :: char(), + Index :: non_neg_integer(). + +chr(S, C) when is_integer(C) -> chr(S, C, 1). + +chr([C|_Cs], C, I) -> I; +chr([_|Cs], C, I) -> chr(Cs, C, I+1); +chr([], _C, _I) -> 0. + +-spec rchr(String, Character) -> Index when + String :: string(), + Character :: char(), + Index :: non_neg_integer(). + +rchr(S, C) when is_integer(C) -> rchr(S, C, 1, 0). + +rchr([C|Cs], C, I, _L) -> %Found one, now find next! + rchr(Cs, C, I+1, I); +rchr([_|Cs], C, I, L) -> + rchr(Cs, C, I+1, L); +rchr([], _C, _I, L) -> L. + +%% str(String, SubString) +%% rstr(String, SubString) +%% index(String, SubString) +%% Return the first/last index of the sub-string in a string. +%% index/2 is kept for backwards compatibility. + +-spec str(String, SubString) -> Index when + String :: string(), + SubString :: string(), + Index :: non_neg_integer(). + +str(S, Sub) when is_list(Sub) -> str(S, Sub, 1). + +str([C|S], [C|Sub], I) -> + case prefix(Sub, S) of + true -> I; + false -> str(S, [C|Sub], I+1) + end; +str([_|S], Sub, I) -> str(S, Sub, I+1); +str([], _Sub, _I) -> 0. + +-spec rstr(String, SubString) -> Index when + String :: string(), + SubString :: string(), + Index :: non_neg_integer(). + +rstr(S, Sub) when is_list(Sub) -> rstr(S, Sub, 1, 0). + +rstr([C|S], [C|Sub], I, L) -> + case prefix(Sub, S) of + true -> rstr(S, [C|Sub], I+1, I); + false -> rstr(S, [C|Sub], I+1, L) + end; +rstr([_|S], Sub, I, L) -> rstr(S, Sub, I+1, L); +rstr([], _Sub, _I, L) -> L. + +prefix([C|Pre], [C|String]) -> prefix(Pre, String); +prefix([], String) when is_list(String) -> true; +prefix(Pre, String) when is_list(Pre), is_list(String) -> false. + +%% span(String, Chars) -> Length. +%% cspan(String, Chars) -> Length. + +-spec span(String, Chars) -> Length when + String :: string(), + Chars :: string(), + Length :: non_neg_integer(). + +span(S, Cs) when is_list(Cs) -> span(S, Cs, 0). + +span([C|S], Cs, I) -> + case member(C, Cs) of + true -> span(S, Cs, I+1); + false -> I + end; +span([], _Cs, I) -> I. + +-spec cspan(String, Chars) -> Length when + String :: string(), + Chars :: string(), + Length :: non_neg_integer(). + +cspan(S, Cs) when is_list(Cs) -> cspan(S, Cs, 0). + +cspan([C|S], Cs, I) -> + case member(C, Cs) of + true -> I; + false -> cspan(S, Cs, I+1) + end; +cspan([], _Cs, I) -> I. + +%% substr(String, Start) +%% substr(String, Start, Length) +%% Extract a sub-string from String. + +-spec substr(String, Start) -> SubString when + String :: string(), + SubString :: string(), + Start :: pos_integer(). + +substr(String, 1) when is_list(String) -> + String; +substr(String, S) when is_integer(S), S > 1 -> + substr2(String, S). + +-spec substr(String, Start, Length) -> SubString when + String :: string(), + SubString :: string(), + Start :: pos_integer(), + Length :: non_neg_integer(). + +substr(String, S, L) when is_integer(S), S >= 1, is_integer(L), L >= 0 -> + substr1(substr2(String, S), L). + +substr1([C|String], L) when L > 0 -> [C|substr1(String, L-1)]; +substr1(String, _L) when is_list(String) -> []. %Be nice! + +substr2(String, 1) when is_list(String) -> String; +substr2([_|String], S) -> substr2(String, S-1). + +%% tokens(String, Seperators). +%% Return a list of tokens seperated by characters in Seperators. + +-spec tokens(String, SeparatorList) -> Tokens when + String :: string(), + SeparatorList :: string(), + Tokens :: [Token :: nonempty_string()]. + +tokens(S, Seps) -> + tokens1(S, Seps, []). + +tokens1([C|S], Seps, Toks) -> + case member(C, Seps) of + true -> tokens1(S, Seps, Toks); + false -> tokens2(S, Seps, Toks, [C]) + end; +tokens1([], _Seps, Toks) -> + reverse(Toks). + +tokens2([C|S], Seps, Toks, Cs) -> + case member(C, Seps) of + true -> tokens1(S, Seps, [reverse(Cs)|Toks]); + false -> tokens2(S, Seps, Toks, [C|Cs]) + end; +tokens2([], _Seps, Toks, Cs) -> + reverse([reverse(Cs)|Toks]). + +-spec chars(Character, Number) -> String when + Character :: char(), + Number :: non_neg_integer(), + String :: string(). + +chars(C, N) -> chars(C, N, []). + +-spec chars(Character, Number, Tail) -> String when + Character :: char(), + Number :: non_neg_integer(), + Tail :: string(), + String :: string(). + +chars(C, N, Tail) when N > 0 -> + chars(C, N-1, [C|Tail]); +chars(C, 0, Tail) when is_integer(C) -> + Tail. + +%% Torbjörn's bit. + +%%% COPIES %%% + +-spec copies(String, Number) -> Copies when + String :: string(), + Copies :: string(), + Number :: non_neg_integer(). + +copies(CharList, Num) when is_list(CharList), is_integer(Num), Num >= 0 -> + copies(CharList, Num, []). + +copies(_CharList, 0, R) -> + R; +copies(CharList, Num, R) -> + copies(CharList, Num-1, CharList++R). + +%%% WORDS %%% + +-spec words(String) -> Count when + String :: string(), + Count :: pos_integer(). + +words(String) -> words(String, $\s). + +-spec words(String, Character) -> Count when + String :: string(), + Character :: char(), + Count :: pos_integer(). + +words(String, Char) when is_integer(Char) -> + w_count(strip(String, both, Char), Char, 0). + +w_count([], _, Num) -> Num+1; +w_count([H|T], H, Num) -> w_count(strip(T, left, H), H, Num+1); +w_count([_H|T], Char, Num) -> w_count(T, Char, Num). + +%%% SUB_WORDS %%% + +-spec sub_word(String, Number) -> Word when + String :: string(), + Word :: string(), + Number :: integer(). + +sub_word(String, Index) -> sub_word(String, Index, $\s). + +-spec sub_word(String, Number, Character) -> Word when + String :: string(), + Word :: string(), + Number :: integer(), + Character :: char(). + +sub_word(String, Index, Char) when is_integer(Index), is_integer(Char) -> + case words(String, Char) of + Num when Num < Index -> + []; + _Num -> + s_word(strip(String, left, Char), Index, Char, 1, []) + end. + +s_word([], _, _, _,Res) -> reverse(Res); +s_word([Char|_],Index,Char,Index,Res) -> reverse(Res); +s_word([H|T],Index,Char,Index,Res) -> s_word(T,Index,Char,Index,[H|Res]); +s_word([Char|T],Stop,Char,Index,Res) when Index < Stop -> + s_word(strip(T,left,Char),Stop,Char,Index+1,Res); +s_word([_|T],Stop,Char,Index,Res) when Index < Stop -> + s_word(T,Stop,Char,Index,Res). + +%%% STRIP %%% + +-spec strip(string()) -> string(). + +strip(String) -> strip(String, both). + +-spec strip(String, Direction) -> Stripped when + String :: string(), + Stripped :: string(), + Direction :: left | right | both. + +strip(String, left) -> strip_left(String, $\s); +strip(String, right) -> strip_right(String, $\s); +strip(String, both) -> + strip_right(strip_left(String, $\s), $\s). + +-spec strip(String, Direction, Character) -> Stripped when + String :: string(), + Stripped :: string(), + Direction :: left | right | both, + Character :: char(). + +strip(String, right, Char) -> strip_right(String, Char); +strip(String, left, Char) -> strip_left(String, Char); +strip(String, both, Char) -> + strip_right(strip_left(String, Char), Char). + +strip_left([Sc|S], Sc) -> + strip_left(S, Sc); +strip_left([_|_]=S, Sc) when is_integer(Sc) -> S; +strip_left([], Sc) when is_integer(Sc) -> []. + +strip_right([Sc|S], Sc) -> + case strip_right(S, Sc) of + [] -> []; + T -> [Sc|T] + end; +strip_right([C|S], Sc) -> + [C|strip_right(S, Sc)]; +strip_right([], Sc) when is_integer(Sc) -> + []. + +%%% LEFT %%% + +-spec left(String, Number) -> Left when + String :: string(), + Left :: string(), + Number :: non_neg_integer(). + +left(String, Len) when is_integer(Len) -> left(String, Len, $\s). + +-spec left(String, Number, Character) -> Left when + String :: string(), + Left :: string(), + Number :: non_neg_integer(), + Character :: char(). + +left(String, Len, Char) when is_integer(Char) -> + Slen = length(String), + if + Slen > Len -> substr(String, 1, Len); + Slen < Len -> l_pad(String, Len-Slen, Char); + Slen =:= Len -> String + end. + +l_pad(String, Num, Char) -> String ++ chars(Char, Num). + +%%% RIGHT %%% + +-spec right(String, Number) -> Right when + String :: string(), + Right :: string(), + Number :: non_neg_integer(). + +right(String, Len) when is_integer(Len) -> right(String, Len, $\s). + +-spec right(String, Number, Character) -> Right when + String :: string(), + Right :: string(), + Number :: non_neg_integer(), + Character :: char(). + +right(String, Len, Char) when is_integer(Char) -> + Slen = length(String), + if + Slen > Len -> substr(String, Slen-Len+1); + Slen < Len -> r_pad(String, Len-Slen, Char); + Slen =:= Len -> String + end. + +r_pad(String, Num, Char) -> chars(Char, Num, String). + +%%% CENTRE %%% + +-spec centre(String, Number) -> Centered when + String :: string(), + Centered :: string(), + Number :: non_neg_integer(). + +centre(String, Len) when is_integer(Len) -> centre(String, Len, $\s). + +-spec centre(String, Number, Character) -> Centered when + String :: string(), + Centered :: string(), + Number :: non_neg_integer(), + Character :: char(). + +centre(String, 0, Char) when is_list(String), is_integer(Char) -> + []; % Strange cases to centre string +centre(String, Len, Char) when is_integer(Char) -> + Slen = length(String), + if + Slen > Len -> substr(String, (Slen-Len) div 2 + 1, Len); + Slen < Len -> + N = (Len-Slen) div 2, + r_pad(l_pad(String, Len-(Slen+N), Char), N, Char); + Slen =:= Len -> String + end. + +%%% SUB_STRING %%% + +-spec sub_string(String, Start) -> SubString when + String :: string(), + SubString :: string(), + Start :: pos_integer(). + +sub_string(String, Start) -> substr(String, Start). + +-spec sub_string(String, Start, Stop) -> SubString when + String :: string(), + SubString :: string(), + Start :: pos_integer(), + Stop :: pos_integer(). + +sub_string(String, Start, Stop) -> substr(String, Start, Stop - Start + 1). + +%% ISO/IEC 8859-1 (latin1) letters are converted, others are ignored +%% + +to_lower_char(C) when is_integer(C), $A =< C, C =< $Z -> + C + 32; +to_lower_char(C) when is_integer(C), 16#C0 =< C, C =< 16#D6 -> + C + 32; +to_lower_char(C) when is_integer(C), 16#D8 =< C, C =< 16#DE -> + C + 32; +to_lower_char(C) -> + C. + +to_upper_char(C) when is_integer(C), $a =< C, C =< $z -> + C - 32; +to_upper_char(C) when is_integer(C), 16#E0 =< C, C =< 16#F6 -> + C - 32; +to_upper_char(C) when is_integer(C), 16#F8 =< C, C =< 16#FE -> + C - 32; +to_upper_char(C) -> + C. + +-spec to_lower(String) -> Result when + String :: io_lib:latin1_string(), + Result :: io_lib:latin1_string() + ; (Char) -> CharResult when + Char :: char(), + CharResult :: char(). + +to_lower(S) when is_list(S) -> + [to_lower_char(C) || C <- S]; +to_lower(C) when is_integer(C) -> + to_lower_char(C). + +-spec to_upper(String) -> Result when + String :: io_lib:latin1_string(), + Result :: io_lib:latin1_string() + ; (Char) -> CharResult when + Char :: char(), + CharResult :: char(). + +to_upper(S) when is_list(S) -> + [to_upper_char(C) || C <- S]; +to_upper(C) when is_integer(C) -> + to_upper_char(C). + +-spec join(StringList, Separator) -> String when + StringList :: [string()], + Separator :: string(), + String :: string(). + +join([], Sep) when is_list(Sep) -> + []; +join([H|T], Sep) -> + H ++ lists:append([Sep ++ X || X <- T]). diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/syntax_tools_test.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/syntax_tools_test.erl new file mode 100644 index 0000000000..dd3f88d7a8 --- /dev/null +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/syntax_tools_test.erl @@ -0,0 +1,115 @@ +%% +%% File: syntax_tools_test.erl +%% Author: Björn-Egil Dahlberg +%% Created: 2014-10-23 +%% + +-module(syntax_tools_test). + +-export([foo1/0,foo2/2,foo3/0,foo4/3,foo5/1]). + +-include_lib("kernel/include/file.hrl"). +-record(state, { a, b, c, d}). +-attribute([foo/0]). + +-define(attrib, some_attrib). + +-?attrib([foo2/2]). + +-define(macro_simple1, ok). +-define(MACRO_SIMPLE2, (other)). +-define(macro_simple3, ?MODULE). +-define(macro_simple4, [?macro_simple3,?MODULE,?MACRO_SIMPLE2]). +-define(macro_simple5, (process_info)). +-define(macro_string, "hello world"). +-define(macro_argument1(X), (X + 3)). +-define(macro_argument2(X,Y), (X + 3 * Y)). +-define(macro_block(X), begin X end). +-define(macro_if(X1,X2), if X1 -> X2; true -> none end). + + +-ifdef(macro_def1). +-define(macro_cond1, yep). +-else. +-define(macro_cond1, nope). +-endif. +-ifndef(macro_def2). +-define(macro_cond2, nope). +-else. +-define(macro_cond2, yep). +-endif. +-undef(macro_def1). +-undef(macro_def2). + +%% basic test +foo1() -> + ok. + +%% macro test +foo2(A,B) -> + % string combining ? + [?macro_string, ?macro_string + ?macro_string, + "hello world " + "more hello", + [?macro_simple1, + ?MACRO_SIMPLE2, + ?macro_simple3, + ?macro_simple4, + ?macro_simple5, + ?macro_string, + ?macro_cond1, + ?macro_cond2, + ?macro_block(A), + ?macro_if(A,B), + ?macro_argument1(A), + ?macro_argument1(begin A end), + ?macro_block(<<"hello">>), + ?macro_block("hello"), + ?macro_block([$h,$e,$l,$l,$0]), + ?macro_argument1(id(<<"hello">>)), + ?macro_argument1(if A -> B; true -> 3.14 end), + ?macro_argument1(case A of ok -> B; C -> C end), + ?macro_argument1(receive M -> M after 100 -> 3 end), + ?macro_argument1(try foo5(A) catch C:?macro_simple5 -> {C,B} end), + ?macro_argument2(A,B)], + A,B,ok]. + +id(I) -> I. +%% basic terms + +foo3() -> + [atom, + 'some other atom', + {tuple,1,2,3}, + 1,2,3,3333, + 3,3333,2,1, + [$a,$b,$c], + "hello world", + <<"hello world">>, + <<1,2,3,4,5:6>>, + 3.1415, + 1.03e33]. + +%% application and records + +foo4(A,B,#state{c = C}=S) -> + Ls = foo3(), + S1 = #state{ a = 1, b = 2 }, + [foo2(A,Ls),B,C, + B(3,C), + erlang:process_info(self()), + erlang:?macro_simple5(self()), + A:?MACRO_SIMPLE2(), + A:?macro_simple1(), + A:process_info(self()), + A:B(3), + S#state{ a = 2, b = B, d = S1 }]. + +foo5(A) -> + try foo2(A,A) of + R -> R + catch + error:?macro_simple5 -> + nope + end. diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile index ab4dd4d95d..35bbad3c22 100644 --- a/lib/test_server/src/Makefile +++ b/lib/test_server/src/Makefile @@ -124,7 +124,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)/src" $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src" + $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(TS_HRL_FILES) "$(RELSYSDIR)/src" $(INSTALL_DIR) "$(RELSYSDIR)/include" $(INSTALL_DATA) $(HRL_FILES) "$(RELSYSDIR)/include" $(INSTALL_DIR) "$(RELSYSDIR)/ebin" diff --git a/lib/test_server/src/configure.in b/lib/test_server/src/configure.in index cd723bcd4d..8398825d95 100644 --- a/lib/test_server/src/configure.in +++ b/lib/test_server/src/configure.in @@ -357,7 +357,23 @@ AC_CHECK_FUNCS(usleep) # First check if the library is available, then if we can choose between # two versions of gethostbyname AC_HAVE_LIBRARY(resolv) -AC_CHECK_LIB(resolv, res_gethostbyname,[DEFS="$DEFS -DHAVE_RES_GETHOSTBYNAME=1"]) +AC_CHECK_LIB(resolv, res_gethostbyname,[AC_DEFINE(HAVE_RES_GETHOSTBYNAME,1)]) + +#-------------------------------------------------------------------- +# Check for isfinite +#-------------------------------------------------------------------- + +AC_MSG_CHECKING([for isfinite]) +AC_TRY_LINK([#include <math.h>], + [isfinite(0);], have_isfinite=yes, have_isfinite=no) + +if test $have_isfinite = yes; then + AC_DEFINE(HAVE_ISFINITE,1) + AC_MSG_RESULT(yes) +else + AC_DEFINE(HAVE_FINITE,1) + AC_MSG_RESULT(no) +fi #-------------------------------------------------------------------- # Emulator compatible flags (for drivers) diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml index 1ba2514977..faee5efd43 100644 --- a/lib/tools/doc/src/notes.xml +++ b/lib/tools/doc/src/notes.xml @@ -30,6 +30,21 @@ </header> <p>This document describes the changes made to the Tools application.</p> +<section><title>Tools 2.7</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Add log2 histogram to lcnt for lock wait time</p> + <p> + Own Id: OTP-12059</p> + </item> + </list> + </section> + +</section> + <section><title>Tools 2.6.15</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/tools/emacs/erlang-skels.el b/lib/tools/emacs/erlang-skels.el index 7379215d68..b37d08e767 100644 --- a/lib/tools/emacs/erlang-skels.el +++ b/lib/tools/emacs/erlang-skels.el @@ -577,7 +577,7 @@ Please see the function `tempo-define-template'.") "-record(state, {})." n n (erlang-skel-double-separator-start 3) - "%%% gen_event callbacks" n + "%%% API" n (erlang-skel-double-separator-end 3) n (erlang-skel-separator-start 2) "%% @doc" n diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 4e3c49c717..c56759ebb9 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -7,7 +7,7 @@ ;; %CopyrightBegin% ;; -;; Copyright Ericsson AB 1996-2013. All Rights Reserved. +;; Copyright Ericsson AB 1996-2014. All Rights Reserved. ;; ;; The contents of this file are subject to the Erlang Public License, ;; Version 1.1, (the "License"); you may not use this file except in @@ -886,6 +886,7 @@ resulting regexp is surrounded by \\_< and \\_>." "flush_monitor_message" "format_cpu_topology" "fun_info" + "fun_info_mfa" "fun_to_list" "function_exported" "garbage_collect_message_area" diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk index 54dc4ec91d..3acb8d38e2 100644 --- a/lib/tools/vsn.mk +++ b/lib/tools/vsn.mk @@ -1 +1 @@ -TOOLS_VSN = 2.6.15 +TOOLS_VSN = 2.7 diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl index 572bf24ca4..cbad05081e 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -405,7 +405,7 @@ get_type({{M, F, A} = MFA, Range, Arg}, CodeServer, Records) -> case dialyzer_codeserver:lookup_mfa_contract(MFA, CodeServer) of error -> {{F, A}, {Range, Arg}}; - {ok, {_FileLine, Contract}} -> + {ok, {_FileLine, Contract, _Xtra}} -> Sig = erl_types:t_fun(Arg, Range), case dialyzer_contracts:check_contract(Contract, Sig) of ok -> {{F, A}, {contract, Contract}}; diff --git a/lib/wx/configure.in b/lib/wx/configure.in index a96f1f2632..4c4d4f41a8 100644 --- a/lib/wx/configure.in +++ b/lib/wx/configure.in @@ -677,6 +677,27 @@ if test "x$GCC" = xyes; then LM_TRY_ENABLE_CFLAG([-Werror=return-type], [CXXFLAGS]) fi +dnl ---------------------------------------------------------------------- +dnl Enable -fsanitize= flags. +dnl ---------------------------------------------------------------------- + +m4_define(DEFAULT_SANITIZERS, [address,undefined]) +AC_ARG_ENABLE( + sanitizers, + AS_HELP_STRING( + [--enable-sanitizers@<:@=comma-separated list of sanitizers@:>@], + [Default=DEFAULT_SANITIZERS]), +[ +case "$enableval" in + no) sanitizers= ;; + yes) sanitizers="-fsanitize=DEFAULT_SANITIZERS" ;; + *) sanitizers="-fsanitize=$enableval" ;; +esac +CFLAGS="$CFLAGS $sanitizers" +CXXFLAGS="$CXXFLAGS $sanitizers" +LDFLAGS="$LDFLAGS $sanitizers" +]) + ############################################################################# dnl diff --git a/lib/wx/doc/src/notes.xml b/lib/wx/doc/src/notes.xml index 63eb047caa..5a9c53e3b6 100644 --- a/lib/wx/doc/src/notes.xml +++ b/lib/wx/doc/src/notes.xml @@ -31,6 +31,23 @@ <p>This document describes the changes made to the wxErlang application.</p> +<section><title>Wx 1.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Implement --enable-sanitizers[=sanitizers]. Similar to + debugging with Valgrind, it's very useful to enable + -fsanitize= switches to catch bugs at runtime.</p> + <p> + Own Id: OTP-12153</p> + </item> + </list> + </section> + +</section> + <section><title>Wx 1.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/wx/examples/demo/ex_graphicsContext.erl b/lib/wx/examples/demo/ex_graphicsContext.erl index 59bfe7ff64..9047f1d135 100644 --- a/lib/wx/examples/demo/ex_graphicsContext.erl +++ b/lib/wx/examples/demo/ex_graphicsContext.erl @@ -54,7 +54,7 @@ do_init(Config) -> %% Setup sizers MainSizer = wxBoxSizer:new(?wxVERTICAL), Sizer = wxStaticBoxSizer:new(?wxVERTICAL, Panel, - [{label, "wxGrapicsContext"}]), + [{label, "wxGraphicsContext"}]), Win = wxPanel:new(Panel, []), Pen = ?wxBLACK_PEN, diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl index 80f8937656..2c016e7951 100644 --- a/lib/wx/src/wx_object.erl +++ b/lib/wx/src/wx_object.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2011. All Rights Reserved. +%% Copyright Ericsson AB 2008-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -102,6 +102,7 @@ %% API -export([start/3, start/4, start_link/3, start_link/4, + stop/1, stop/3, call/2, call/3, cast/2, reply/2, @@ -215,6 +216,42 @@ gen_response({ok, Pid}) -> gen_response(Reply) -> Reply. +%% @spec (Ref::wxObject()|atom()|pid()) -> ok +%% @doc Stops a generic wx_object server with reason 'normal'. +%% Invokes terminate(Reason,State) in the server. The call waits until +%% the process is terminated. If the process does not exist, an +%% exception is raised. +stop(Ref = #wx_ref{state=Pid}) when is_pid(Pid) -> + try + gen:stop(Pid) + catch _:ExitReason -> + erlang:error({ExitReason, {?MODULE, stop, [Ref]}}) + end; +stop(Name) when is_atom(Name) orelse is_pid(Name) -> + try + gen:stop(Name) + catch _:ExitReason -> + erlang:error({ExitReason, {?MODULE, stop, [Name]}}) + end. + +%% @spec (Ref::wxObject()|atom()|pid(), Reason::term(), Timeout::timeout()) -> ok +%% @doc Stops a generic wx_object server with the given Reason. +%% Invokes terminate(Reason,State) in the server. The call waits until +%% the process is terminated. If the call times out, or if the process +%% does not exist, an exception is raised. +stop(Ref = #wx_ref{state=Pid}, Reason, Timeout) when is_pid(Pid) -> + try + gen:stop(Pid, Reason, Timeout) + catch _:ExitReason -> + erlang:error({ExitReason, {?MODULE, stop, [Ref, Reason, Timeout]}}) + end; +stop(Name, Reason, Timeout) when is_atom(Name) orelse is_pid(Name) -> + try + gen:stop(Name, Reason, Timeout) + catch _:ExitReason -> + erlang:error({ExitReason, {?MODULE, stop, [Name, Reason, Timeout]}}) + end. + %% @spec (Ref::wxObject()|atom()|pid(), Request::term()) -> term() %% @doc Make a call to a wx_object server. %% The call waits until it gets a result. @@ -563,22 +600,10 @@ opt(_, []) -> %% @hidden debug_options(Name, Opts) -> case opt(debug, Opts) of - {ok, Options} -> dbg_options(Name, Options); - _ -> dbg_options(Name, []) + {ok, Options} -> dbg_opts(Name, Options); + _ -> [] end. %% @hidden -dbg_options(Name, []) -> - Opts = - case init:get_argument(generic_debug) of - error -> - []; - _ -> - [log, statistics] - end, - dbg_opts(Name, Opts); -dbg_options(Name, Opts) -> - dbg_opts(Name, Opts). -%% @hidden dbg_opts(Name, Opts) -> case catch sys:debug_options(Opts) of {'EXIT',_} -> diff --git a/lib/wx/test/wx_event_SUITE.erl b/lib/wx/test/wx_event_SUITE.erl index 076f16ba16..2c6c59bb55 100644 --- a/lib/wx/test/wx_event_SUITE.erl +++ b/lib/wx/test/wx_event_SUITE.erl @@ -542,13 +542,14 @@ handler_clean(_Config) -> ?mt(wxFrame, Frame1), wxWindow:show(Frame1), ?m([_|_], lists:sort(wx_test_lib:flush())), - ?m({stop,_}, wx_obj_test:stop(Frame1, fun(_) -> normal end)), + ?m(ok, wx_obj_test:stop(Frame1)), ?m([{terminate,normal}], lists:sort(wx_test_lib:flush())), - Frame2 = wx_obj_test:start([{init, Init}]), + Terminate = fun({Frame,_}) -> wxWindow:destroy(Frame) end, + Frame2 = wx_obj_test:start([{init, Init}, {terminate, Terminate}]), wxWindow:show(Frame2), ?m([_|_], lists:sort(wx_test_lib:flush())), - ?m({stop,_}, wx_obj_test:stop(Frame2, fun(_) -> wxWindow:destroy(Frame2), normal end)), + ?m(ok, wx_obj_test:stop(Frame2)), ?m([{terminate,normal}], lists:sort(wx_test_lib:flush())), timer:sleep(104), ?m({[],[],[]}, white_box_check_event_handlers()), diff --git a/lib/wx/test/wx_obj_test.erl b/lib/wx/test/wx_obj_test.erl index f47f2fbc46..6c648c65f8 100644 --- a/lib/wx/test/wx_obj_test.erl +++ b/lib/wx/test/wx_obj_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-2014. All Rights Reserved. %% %% The 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 @@ -module(wx_obj_test). -include_lib("wx/include/wx.hrl"). --export([start/1, stop/2]). +-export([start/1, stop/1]). %% wx_object callbacks -export([init/1, handle_info/2, terminate/2, code_change/3, handle_call/3, @@ -29,8 +29,8 @@ start(Opts) -> wx_object:start_link(?MODULE, [{parent, self()}| Opts], []). -stop(Object, Fun) -> - wx_object:call(Object, {stop, Fun}). +stop(Object) -> + wx_object:stop(Object). init(Opts) -> Parent = proplists:get_value(parent, Opts), @@ -61,8 +61,6 @@ handle_event(Event, State = #state{parent=Parent}) -> handle_call(What, From, State = #state{user_state=US}) when is_function(What) -> Result = What(US), {reply, {call, Result, From}, State}; -handle_call({stop, Fun}, From, State = #state{user_state=US}) -> - {stop, Fun(US), {stop, From}, State}; handle_call(What, From, State) -> {reply, {call, What, From}, State}. @@ -79,7 +77,13 @@ handle_info(What, State = #state{parent=Pid}) -> Pid ! {info, What}, {noreply, State}. -terminate(What, #state{parent=Pid}) -> +terminate(What, #state{parent=Pid, opts=Opts, user_state=US}) -> + case proplists:get_value(terminate, Opts) of + undefined -> + ok; + Terminate -> + Terminate(US) + end, Pid ! {terminate, What}, ok. diff --git a/lib/wx/vsn.mk b/lib/wx/vsn.mk index ee3d247553..24e8c2ed11 100644 --- a/lib/wx/vsn.mk +++ b/lib/wx/vsn.mk @@ -1 +1 @@ -WX_VSN = 1.3 +WX_VSN = 1.3.1 diff --git a/make/run_make.mk b/make/run_make.mk index 01ab257006..9570113861 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 frmptr: +opt debug purify quantify purecov valgrind gcov gprof lcnt frmptr icount: $(make_verbose)$(MAKE) -f $(TARGET)/Makefile TYPE=$@ plain smp frag smp_frag: diff --git a/otp_versions.table b/otp_versions.table index 472680f16f..4da3e13559 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,10 @@ +OTP-17.3.3 : ssh-3.0.8 # asn1-3.0.2 common_test-1.8.2 compiler-5.0.2 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4.1 debugger-4.0.1 dialyzer-2.7.2 diameter-1.7.1 edoc-0.7.15 eldap-1.0.4 erl_docgen-0.3.6 erl_interface-3.7.19 erts-6.2 et-1.5 eunit-2.2.8 gs-1.5.16 hipe-3.11.1 ic-4.3.6 inets-5.10.3 jinterface-1.5.11 kernel-3.0.3 megaco-3.17.2 mnesia-4.12.3 observer-2.0.2 odbc-2.10.21 orber-3.7.1 os_mon-2.3 ose-1.0.2 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22.1 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4.1 snmp-5.1 ssl-5.3.7 stdlib-2.2 syntax_tools-1.6.16 test_server-3.7.1 tools-2.7 typer-0.9.8 webtool-0.8.10 wx-1.3.1 xmerl-1.3.7 : +OTP-17.3.2 : ssh-3.0.7 ssl-5.3.7 # asn1-3.0.2 common_test-1.8.2 compiler-5.0.2 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4.1 debugger-4.0.1 dialyzer-2.7.2 diameter-1.7.1 edoc-0.7.15 eldap-1.0.4 erl_docgen-0.3.6 erl_interface-3.7.19 erts-6.2 et-1.5 eunit-2.2.8 gs-1.5.16 hipe-3.11.1 ic-4.3.6 inets-5.10.3 jinterface-1.5.11 kernel-3.0.3 megaco-3.17.2 mnesia-4.12.3 observer-2.0.2 odbc-2.10.21 orber-3.7.1 os_mon-2.3 ose-1.0.2 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22.1 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4.1 snmp-5.1 stdlib-2.2 syntax_tools-1.6.16 test_server-3.7.1 tools-2.7 typer-0.9.8 webtool-0.8.10 wx-1.3.1 xmerl-1.3.7 : +OTP-17.3.1 : eldap-1.0.4 erl_interface-3.7.19 jinterface-1.5.11 orber-3.7.1 ose-1.0.2 ssh-3.0.6 # asn1-3.0.2 common_test-1.8.2 compiler-5.0.2 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4.1 debugger-4.0.1 dialyzer-2.7.2 diameter-1.7.1 edoc-0.7.15 erl_docgen-0.3.6 erts-6.2 et-1.5 eunit-2.2.8 gs-1.5.16 hipe-3.11.1 ic-4.3.6 inets-5.10.3 kernel-3.0.3 megaco-3.17.2 mnesia-4.12.3 observer-2.0.2 odbc-2.10.21 os_mon-2.3 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22.1 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4.1 snmp-5.1 ssl-5.3.6 stdlib-2.2 syntax_tools-1.6.16 test_server-3.7.1 tools-2.7 typer-0.9.8 webtool-0.8.10 wx-1.3.1 xmerl-1.3.7 : +OTP-17.3 : asn1-3.0.2 common_test-1.8.2 compiler-5.0.2 crypto-3.4.1 dialyzer-2.7.2 diameter-1.7.1 edoc-0.7.15 erl_docgen-0.3.6 erl_interface-3.7.18 erts-6.2 eunit-2.2.8 hipe-3.11.1 ic-4.3.6 inets-5.10.3 jinterface-1.5.10 kernel-3.0.3 megaco-3.17.2 mnesia-4.12.3 observer-2.0.2 odbc-2.10.21 os_mon-2.3 ose-1.0.1 public_key-0.22.1 sasl-2.4.1 snmp-5.1 ssh-3.0.5 ssl-5.3.6 stdlib-2.2 tools-2.7 wx-1.3.1 # cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 debugger-4.0.1 eldap-1.0.3 et-1.5 gs-1.5.16 orber-3.7 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 reltool-0.6.6 runtime_tools-1.8.14 syntax_tools-1.6.16 test_server-3.7.1 typer-0.9.8 webtool-0.8.10 xmerl-1.3.7 : +OTP-17.2.2 : mnesia-4.12.2 # asn1-3.0.1 common_test-1.8.1 compiler-5.0.1 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4 debugger-4.0.1 dialyzer-2.7.1 diameter-1.7 edoc-0.7.14 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.17 erts-6.1.2 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.11 ic-4.3.5 inets-5.10.2 jinterface-1.5.9 kernel-3.0.2 megaco-3.17.1 observer-2.0.1 odbc-2.10.20 orber-3.7 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4 snmp-5.0 ssh-3.0.4 ssl-5.3.5 stdlib-2.1.1 syntax_tools-1.6.16 test_server-3.7.1 tools-2.6.15 typer-0.9.8 webtool-0.8.10 wx-1.3 xmerl-1.3.7 : +OTP-17.2.1 : ssh-3.0.4 # asn1-3.0.1 common_test-1.8.1 compiler-5.0.1 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4 debugger-4.0.1 dialyzer-2.7.1 diameter-1.7 edoc-0.7.14 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.17 erts-6.1.2 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.11 ic-4.3.5 inets-5.10.2 jinterface-1.5.9 kernel-3.0.2 megaco-3.17.1 mnesia-4.12.1 observer-2.0.1 odbc-2.10.20 orber-3.7 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4 snmp-5.0 ssl-5.3.5 stdlib-2.1.1 syntax_tools-1.6.16 test_server-3.7.1 tools-2.6.15 typer-0.9.8 webtool-0.8.10 wx-1.3 xmerl-1.3.7 : +OTP-17.2 : orber-3.7 snmp-5.0 # asn1-3.0.1 common_test-1.8.1 compiler-5.0.1 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4 debugger-4.0.1 dialyzer-2.7.1 diameter-1.7 edoc-0.7.14 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.17 erts-6.1.2 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.11 ic-4.3.5 inets-5.10.2 jinterface-1.5.9 kernel-3.0.2 megaco-3.17.1 mnesia-4.12.1 observer-2.0.1 odbc-2.10.20 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4 ssh-3.0.3 ssl-5.3.5 stdlib-2.1.1 syntax_tools-1.6.16 test_server-3.7.1 tools-2.6.15 typer-0.9.8 webtool-0.8.10 wx-1.3 xmerl-1.3.7 : OTP-17.1.2 : erts-6.1.2 kernel-3.0.2 stdlib-2.1.1 # asn1-3.0.1 common_test-1.8.1 compiler-5.0.1 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4 debugger-4.0.1 dialyzer-2.7.1 diameter-1.7 edoc-0.7.14 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.17 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.11 ic-4.3.5 inets-5.10.2 jinterface-1.5.9 megaco-3.17.1 mnesia-4.12.1 observer-2.0.1 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssh-3.0.3 ssl-5.3.5 syntax_tools-1.6.16 test_server-3.7.1 tools-2.6.15 typer-0.9.8 webtool-0.8.10 wx-1.3 xmerl-1.3.7 : OTP-17.1.1 : edoc-0.7.14 erts-6.1.1 syntax_tools-1.6.16 # asn1-3.0.1 common_test-1.8.1 compiler-5.0.1 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4 debugger-4.0.1 dialyzer-2.7.1 diameter-1.7 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.17 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.11 ic-4.3.5 inets-5.10.2 jinterface-1.5.9 kernel-3.0.1 megaco-3.17.1 mnesia-4.12.1 observer-2.0.1 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssh-3.0.3 ssl-5.3.5 stdlib-2.1 test_server-3.7.1 tools-2.6.15 typer-0.9.8 webtool-0.8.10 wx-1.3 xmerl-1.3.7 : OTP-17.1 : asn1-3.0.1 common_test-1.8.1 compiler-5.0.1 crypto-3.4 debugger-4.0.1 dialyzer-2.7.1 diameter-1.7 erl_interface-3.7.17 erts-6.1 hipe-3.11 inets-5.10.2 kernel-3.0.1 mnesia-4.12.1 observer-2.0.1 reltool-0.6.6 ssh-3.0.3 ssl-5.3.5 stdlib-2.1 syntax_tools-1.6.15 test_server-3.7.1 tools-2.6.15 typer-0.9.8 wx-1.3 # cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 edoc-0.7.13 eldap-1.0.3 erl_docgen-0.3.5 et-1.5 eunit-2.2.7 gs-1.5.16 ic-4.3.5 jinterface-1.5.9 megaco-3.17.1 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 webtool-0.8.10 xmerl-1.3.7 : diff --git a/system/doc/design_principles/distributed_applications.xml b/system/doc/design_principles/distributed_applications.xml index 2886f06b53..4d4ba3136e 100644 --- a/system/doc/design_principles/distributed_applications.xml +++ b/system/doc/design_principles/distributed_applications.xml @@ -43,7 +43,7 @@ addressing mechanism is required to ensure that it can be addressed by other applications, regardless on which node it currently executes. This issue is not addressed here, but the - Kernel module <c>global</c> or STDLIB module <c>pg</c> can be + Kernel modules <c>global</c> or <c>pg2</c> can be used for this purpose.</p> </section> diff --git a/system/doc/design_principles/spec_proc.xml b/system/doc/design_principles/spec_proc.xml index e4fb5fdca7..e849388a38 100644 --- a/system/doc/design_principles/spec_proc.xml +++ b/system/doc/design_principles/spec_proc.xml @@ -431,43 +431,79 @@ loop(...) -> <section> <title>User-Defined Behaviours</title> - <p><marker id="behaviours"/>To implement a user-defined behaviour, write code similar to - code for a special process but calling functions in a callback - module for handling specific tasks.</p> - <p>If it is desired that the compiler should warn for missing callback - functions, as it does for the OTP behaviours, add <c>-callback</c> attributes in the - behaviour module to describe the expected callbacks:</p> + + <p><marker id="behaviours"/>To implement a user-defined behaviour, + write code similar to code for a special process but calling + functions in a callback module for handling specific tasks.</p> + <p>If it is desired that the compiler should warn for missing + callback functions, as it does for the OTP behaviours, add + <c>-callback</c> attributes in the behaviour module to describe + the expected callback functions:</p> + <code type="none"> -callback Name1(Arg1_1, Arg1_2, ..., Arg1_N1) -> Res1. -callback Name2(Arg2_1, Arg2_2, ..., Arg2_N2) -> Res2. ... -callback NameM(ArgM_1, ArgM_2, ..., ArgM_NM) -> ResM.</code> - <p>where <c>NameX</c> are the names of the expected callbacks and - <c>ArgX_Y</c>, <c>ResX</c> are types as they are described in Specifications - for functions in <seealso marker="../reference_manual/typespec">Types and - Function Specifications</seealso>. The whole syntax of <c>-spec</c> attribute is - supported by <c>-callback</c> attribute.</p> - <p>Alternatively you may directly implement and export the function:</p> + + <p>where each <c>Name</c> is the name of a callback function and + <c>Arg</c> and <c>Res</c> are types as described in + Specifications for functions in <seealso + marker="../reference_manual/typespec">Types and Function + Specifications</seealso>. The whole syntax of the + <c>-spec</c> attribute is supported by <c>-callback</c> + attribute.</p> + <p>Callback functions that are optional for the user of the + behaviour to implement are specified by use of the + <c>-optional_callbacks</c> attribute:</p> + +<code type="none"> +-optional_callbacks([OptName1/OptArity1, ..., OptNameK/OptArityK]).</code> + + <p>where each <c>OptName/OptArity</c> specifies the name and arity + of a callback function. Note that the <c>-optional_callbacks</c> + attribute is to be used together with the <c>-callback</c> + attribute; it cannot be combined with the + <c>behaviour_info()</c> function described below.</p> + <p>Tools that need to know about optional callback functions can + call <c>Behaviour:behaviour_info(optional_callbacks)</c> to get + a list of all optional callback functions.</p> + + <note><p>We recommend using the <c>-callback</c> attribute rather + than the <c>behaviour_info()</c> function. The reason is that + the extra type information can be used by tools to produce + documentation or find discrepancies.</p></note> + + <p>As an alternative to the <c>-callback</c> and + <c>-optional_callbacks</c> attributes you may directly implement + and export <c>behaviour_info()</c>:</p> + <code type="none"> behaviour_info(callbacks) -> [{Name1, Arity1},...,{NameN, ArityN}].</code> - <p>where each <c>{Name, Arity}</c> specifies the name and arity of a callback - function. This function is otherwise automatically generated by the compiler - using the <c>-callback</c> attributes.</p> + + <p>where each <c>{Name, Arity}</c> specifies the name and arity of + a callback function. This function is otherwise automatically + generated by the compiler using the <c>-callback</c> + attributes.</p> <p>When the compiler encounters the module attribute - <c>-behaviour(Behaviour).</c> in a module <c>Mod</c>, it will call - <c>Behaviour:behaviour_info(callbacks)</c> and compare the result with the - set of functions actually exported from <c>Mod</c>, and issue a warning if - any callback function is missing.</p> + <c>-behaviour(Behaviour).</c> in a module <c>Mod</c>, it will + call <c>Behaviour:behaviour_info(callbacks)</c> and compare the + result with the set of functions actually exported from + <c>Mod</c>, and issue a warning if any callback function is + missing.</p> <p>Example:</p> <code type="none"> %% User-defined behaviour module -module(simple_server). --export([start_link/2,...]). +-export([start_link/2, init/3, ...]). -callback init(State :: term()) -> 'ok'. -callback handle_req(Req :: term(), State :: term()) -> {'ok', Reply :: term()}. -callback terminate() -> 'ok'. +-callback format_state(State :: term()) -> term(). + +-optional_callbacks([format_state/1]). %% Alternatively you may define: %% diff --git a/system/doc/efficiency_guide/binaryhandling.xml b/system/doc/efficiency_guide/binaryhandling.xml index 6b0df49011..4ba1378059 100644 --- a/system/doc/efficiency_guide/binaryhandling.xml +++ b/system/doc/efficiency_guide/binaryhandling.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2007</year> - <year>2013</year> + <year>2014</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -237,8 +237,9 @@ Bin = <<Bin1,...>> %% Bin1 will be COPIED <p><c>Bin1</c> will be copied in the third line.</p> <p>The same thing happens if you insert a binary into an <em>ets</em> - table or send it to a port using <c>erlang:port_command/2</c>.</p> - + table or send it to a port using <c>erlang:port_command/2</c> or pass it to + <seealso marker="erts:erl_nif#enif_inspect_binary">enif_inspect_binary</seealso> + in a NIF.</p> <p>Matching a binary will also cause it to shrink and the next append operation will copy the binary data:</p> diff --git a/system/doc/reference_manual/modules.xml b/system/doc/reference_manual/modules.xml index f0ec7ef165..5fc8b363f8 100644 --- a/system/doc/reference_manual/modules.xml +++ b/system/doc/reference_manual/modules.xml @@ -229,13 +229,9 @@ behaviour_info(callbacks) -> Callbacks.</pre> <p>The <c>module_info/0</c> function in each module returns a list of <c>{Key,Value}</c> tuples with information about the module. Currently, the list contain tuples with the following - <c>Key</c>s: <c>attributes</c>, <c>compile</c>, - <c>exports</c>, and <c>imports</c>. The order and number of tuples + <c>Key</c>s: <c>module</c>, <c>attributes</c>, <c>compile</c>, + <c>exports</c> and <c>md5</c>. The order and number of tuples may change without prior notice.</p> - - <warning><p>The <c>{imports,Value}</c> tuple may be removed in a future - release because <c>Value</c> is always an empty list. - Do not write code that depends on it being present.</p></warning> </section> <section> @@ -246,6 +242,11 @@ behaviour_info(callbacks) -> Callbacks.</pre> <p>The following values are allowed for <c>Key</c>:</p> <taglist> + <tag><c>module</c></tag> + <item> + <p>Return an atom representing the module name.</p> + </item> + <tag><c>attributes</c></tag> <item> <p>Return a list of <c>{AttributeName,ValueList}</c> tuples, @@ -267,10 +268,9 @@ behaviour_info(callbacks) -> Callbacks.</pre> <seealso marker="stdlib:beam_lib#strip/1">beam_lib(3)</seealso>.</p> </item> - <tag><c>imports</c></tag> + <tag><c>md5</c></tag> <item> - <p>Always return an empty list. The <c>imports</c> key may not - be supported in future release.</p> + <p>Return a binary representing the MD5 checksum of the module.</p> </item> <tag><c>exports</c></tag> diff --git a/system/doc/system_architecture_intro/sys_arch_intro.xml b/system/doc/system_architecture_intro/sys_arch_intro.xml index 62add510ca..3e88548861 100644 --- a/system/doc/system_architecture_intro/sys_arch_intro.xml +++ b/system/doc/system_architecture_intro/sys_arch_intro.xml @@ -150,7 +150,7 @@ <item>Chapter 8: "Operation and Management Principles" describes the model for operation and maintenance of sub-systems.</item> <item>Chapter 9: "Tutorial" gives an orientation of the different interoperability mechanism, which can be used when integrating an - Erlang program with a program written in an other programming language.</item> + Erlang program with a program written in another programming language.</item> </list> </section> diff --git a/system/doc/tutorial/distribution.xml b/system/doc/tutorial/distribution.xml index 6a0ea759c4..ced8e4a545 100644 --- a/system/doc/tutorial/distribution.xml +++ b/system/doc/tutorial/distribution.xml @@ -58,7 +58,6 @@ <item>global_group - Grouping nodes to global name registration groups.</item> <item>net_adm - Various net administration routines.</item> <item>net_kernel - Networking kernel.</item> - <item>pg - Distributed named process groups, experimental implementation.</item> <item>pg2 - Distributed named process groups.</item> <item>pool - Load distribution facility.</item> <item>slave - Functions for starting and controlling slave nodes.</item> |