diff options
491 files changed, 25575 insertions, 11573 deletions
diff --git a/.gitignore b/.gitignore index bd0e9615f7..789d08fdb0 100644 --- a/.gitignore +++ b/.gitignore @@ -7,6 +7,9 @@ TAGS # vim .*.sw[a-z] +# vscode +.vscode + autom4te.cache *.beam *.asn1db diff --git a/Makefile.in b/Makefile.in index 6cbd92a55b..25003f47a9 100644 --- a/Makefile.in +++ b/Makefile.in @@ -485,11 +485,11 @@ libs: ifeq ($(OTP_SMALL_BUILD),true) $(make_verbose)cd lib && \ ERL_TOP=$(ERL_TOP) PATH=$(BOOT_PREFIX)"$${PATH}" \ - $(MAKE) opt + $(MAKE) $(TYPE) else $(make_verbose)cd lib && \ ERL_TOP=$(ERL_TOP) PATH=$(BOOT_PREFIX)"$${PATH}" \ - $(MAKE) opt BUILD_ALL=true + $(MAKE) $(TYPE) BUILD_ALL=true $(V_at)test -f $(ERL_TOP)/make/otp_built || echo "OTP built" > $(ERL_TOP)/make/otp_built endif @@ -498,7 +498,7 @@ APPS=$(patsubst $(ERL_TOP)/lib/%/doc,%,$(wildcard $(ERL_TOP)/lib/*/doc)) $(APPS): $(make_verbose)cd lib/$@ && \ ERL_TOP=$(ERL_TOP) PATH=$(BOOT_PREFIX)"$${PATH}" \ - $(MAKE) opt BUILD_ALL=true + $(MAKE) $(TYPE) BUILD_ALL=true preloaded: $(make_verbose)cd erts/preloaded/src && \ diff --git a/OTP_VERSION b/OTP_VERSION index a5a30a3cfe..9664138791 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -22.0-rc2 +22.0-rc3 diff --git a/bootstrap/bin/no_dot_erlang.boot b/bootstrap/bin/no_dot_erlang.boot Binary files differindex 5428e202e7..9a2412e1f0 100644 --- a/bootstrap/bin/no_dot_erlang.boot +++ b/bootstrap/bin/no_dot_erlang.boot diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex 5428e202e7..9a2412e1f0 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 5428e202e7..9a2412e1f0 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 5dafb89f68..f6e7f0d68e 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_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam Binary files differindex 6b6b6d0f3f..3fe71cfe1b 100644 --- a/bootstrap/lib/compiler/ebin/beam_disasm.beam +++ b/bootstrap/lib/compiler/ebin/beam_disasm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_except.beam b/bootstrap/lib/compiler/ebin/beam_except.beam Binary files differindex 0fb15b1422..5daead0cab 100644 --- a/bootstrap/lib/compiler/ebin/beam_except.beam +++ b/bootstrap/lib/compiler/ebin/beam_except.beam diff --git a/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam b/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam Binary files differindex a6b54314f6..96362c8cdd 100644 --- a/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam +++ b/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam b/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam Binary files differindex 50737c66b1..afba2693b4 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam b/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam Binary files differindex 322653dfc7..e0a43057fc 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam b/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam Binary files differindex b1bd549a8a..c9838883ef 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam b/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam Binary files differindex 8481429a30..329f31f546 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_type.beam b/bootstrap/lib/compiler/ebin/beam_ssa_type.beam Binary files differindex 52bdbf6937..029de3d4a5 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_type.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_type.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex 71186a12cd..07daf4ed81 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex dd2874bbe0..d4746e3664 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/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 06a5b9973a..243b911ac6 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 54b2f1f0ad..6ce6777e55 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_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam Binary files differindex c33895a44e..b5d6545ca7 100644 --- a/bootstrap/lib/kernel/ebin/application_controller.beam +++ b/bootstrap/lib/kernel/ebin/application_controller.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex 6cbda0c9bb..637e40f5d8 100644 --- a/bootstrap/lib/kernel/ebin/code_server.beam +++ b/bootstrap/lib/kernel/ebin/code_server.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log_1.beam b/bootstrap/lib/kernel/ebin/disk_log_1.beam Binary files differindex 350b66d1fb..36beba1f57 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_1.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_1.beam diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam Binary files differindex fd21dd47f5..8fa128dd23 100644 --- a/bootstrap/lib/kernel/ebin/dist_util.beam +++ b/bootstrap/lib/kernel/ebin/dist_util.beam diff --git a/bootstrap/lib/kernel/ebin/erl_boot_server.beam b/bootstrap/lib/kernel/ebin/erl_boot_server.beam Binary files differindex 81f6779c20..801e3d8b88 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/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam Binary files differindex 5336f4ae6c..e0b759eee3 100644 --- a/bootstrap/lib/kernel/ebin/erts_debug.beam +++ b/bootstrap/lib/kernel/ebin/erts_debug.beam diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam Binary files differindex f4ca5b8620..aadb5bf080 100644 --- a/bootstrap/lib/kernel/ebin/global.beam +++ b/bootstrap/lib/kernel/ebin/global.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex 9270358896..023d0bda6d 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_hosts.beam b/bootstrap/lib/kernel/ebin/inet_hosts.beam Binary files differindex 8fb47e84eb..6797eecb29 100644 --- a/bootstrap/lib/kernel/ebin/inet_hosts.beam +++ b/bootstrap/lib/kernel/ebin/inet_hosts.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index c3f4e2b892..5ec7c41dbe 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -22,7 +22,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "6.3"}, + {vsn, "6.3.1"}, {modules, [application, application_controller, application_master, diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index e126f18b35..5f6d9d3988 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -26,7 +26,7 @@ %% versions that have branched off from the above %% stated previous versions. %% -{"6.3", +{"6.3.1", [{<<"^5\\.3$">>,[restart_new_emulator]}, {<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -43,7 +43,9 @@ {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^6\\.2$">>,[restart_new_emulator]}, {<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], + {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.3$">>,[restart_new_emulator]}, + {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}], [{<<"^5\\.3$">>,[restart_new_emulator]}, {<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -60,4 +62,6 @@ {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^6\\.2$">>,[restart_new_emulator]}, {<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. + {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.3$">>,[restart_new_emulator]}, + {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}. diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam b/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam Binary files differindex bd0064ebf2..7c47f2cf10 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam diff --git a/bootstrap/lib/stdlib/ebin/binary.beam b/bootstrap/lib/stdlib/ebin/binary.beam Binary files differindex 0cedd64883..fc1bbe163a 100644 --- a/bootstrap/lib/stdlib/ebin/binary.beam +++ b/bootstrap/lib/stdlib/ebin/binary.beam diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam Binary files differindex a92506125d..2eadde21ff 100644 --- a/bootstrap/lib/stdlib/ebin/dets.beam +++ b/bootstrap/lib/stdlib/ebin/dets.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam Binary files differindex 16c6f1aba5..25bb217db1 100644 --- a/bootstrap/lib/stdlib/ebin/dets_utils.beam +++ b/bootstrap/lib/stdlib/ebin/dets_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam Binary files differindex 2f82423bac..1532c51f8e 100644 --- a/bootstrap/lib/stdlib/ebin/dets_v9.beam +++ b/bootstrap/lib/stdlib/ebin/dets_v9.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex 2618efb7d2..a507106263 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_error.beam b/bootstrap/lib/stdlib/ebin/erl_error.beam Binary files differindex db9d45a0d2..5d1b91aeef 100644 --- a/bootstrap/lib/stdlib/ebin/erl_error.beam +++ b/bootstrap/lib/stdlib/ebin/erl_error.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam Binary files differindex 3a631e24bc..e527f98776 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 35e02b9595..c5ea3ee70f 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex 64e558e272..be2fe2c4c0 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_tar.beam b/bootstrap/lib/stdlib/ebin/erl_tar.beam Binary files differindex 97ddc7d703..526d151a12 100644 --- a/bootstrap/lib/stdlib/ebin/erl_tar.beam +++ b/bootstrap/lib/stdlib/ebin/erl_tar.beam diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam Binary files differindex 7685b4a49a..e846ca420e 100644 --- a/bootstrap/lib/stdlib/ebin/escript.beam +++ b/bootstrap/lib/stdlib/ebin/escript.beam diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam Binary files differindex cb7c957719..b1cf286cea 100644 --- a/bootstrap/lib/stdlib/ebin/ets.beam +++ b/bootstrap/lib/stdlib/ebin/ets.beam diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam Binary files differindex f24f6cfbe8..0a42a40d7e 100644 --- a/bootstrap/lib/stdlib/ebin/file_sorter.beam +++ b/bootstrap/lib/stdlib/ebin/file_sorter.beam diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam Binary files differindex 9981a33a4e..2b76d5bce8 100644 --- a/bootstrap/lib/stdlib/ebin/filename.beam +++ b/bootstrap/lib/stdlib/ebin/filename.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam Binary files differindex b56a9e3eb7..22690ce685 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex a975a43c00..26d495af72 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex 4b7a3b5278..cca174e3cd 100644 --- a/bootstrap/lib/stdlib/ebin/qlc.beam +++ b/bootstrap/lib/stdlib/ebin/qlc.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam Binary files differindex 22c0e2ef95..4d86fdfec2 100644 --- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam +++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam diff --git a/bootstrap/lib/stdlib/ebin/queue.beam b/bootstrap/lib/stdlib/ebin/queue.beam Binary files differindex 571d4a13a5..24b8582188 100644 --- a/bootstrap/lib/stdlib/ebin/queue.beam +++ b/bootstrap/lib/stdlib/ebin/queue.beam diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam Binary files differindex 9636f4fbbf..f4d803b1ee 100644 --- a/bootstrap/lib/stdlib/ebin/rand.beam +++ b/bootstrap/lib/stdlib/ebin/rand.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 9f6ff2942b..ffb56f8306 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -20,7 +20,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "3.8"}, + {vsn, "3.8.1"}, {modules, [array, base64, beam_lib, diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index 76372566d5..cf693f332c 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -26,7 +26,7 @@ %% versions that have branched off from the above %% stated previous versions. %% -{"3.8", +{"3.8.1", [{<<"^3\\.4$">>,[restart_new_emulator]}, {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -41,7 +41,9 @@ {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.7$">>,[restart_new_emulator]}, {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], + {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.8$">>,[restart_new_emulator]}, + {<<"^3\\.8\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}], [{<<"^3\\.4$">>,[restart_new_emulator]}, {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -56,4 +58,6 @@ {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.7$">>,[restart_new_emulator]}, {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. + {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.8$">>,[restart_new_emulator]}, + {<<"^3\\.8\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}. diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam Binary files differindex 2b4906508a..a46ade8602 100644 --- a/bootstrap/lib/stdlib/ebin/sys.beam +++ b/bootstrap/lib/stdlib/ebin/sys.beam diff --git a/erts/autoconf/configure.vxworks b/erts/autoconf/configure.vxworks index 1893f3f7e0..c3bdfd0095 100755 --- a/erts/autoconf/configure.vxworks +++ b/erts/autoconf/configure.vxworks @@ -135,6 +135,7 @@ for file in $CONFIG_FILES; do -e "s,@HOST_TYPE@,$HOST_TYPE,g" \ -e "s,@WIND_BASE@,$WIND_BASE,g" \ -e "s,@TARGET@,$target,g" \ + -e "s,@ENV_CFLAGS@,$CFLAGS,g" \ $in_file > $new_name done diff --git a/erts/autoconf/vxworks/sed.general b/erts/autoconf/vxworks/sed.general index d32fbdc5c0..ffd5a8133c 100644 --- a/erts/autoconf/vxworks/sed.general +++ b/erts/autoconf/vxworks/sed.general @@ -111,7 +111,7 @@ s|@erlexec@|erl.exec| s|@EMU_LIBOBJS@|| # General CFLAGS -s|@GENERAL_CFLAGS@|-DHAVE_LOCALTIME_R -DHAVE_GMTIME_R -DENABLE_ELIB_MALLOC -DELIB_HEAP_USER -DELIB_SORTED_BLOCKS -DWORDS_BIGENDIAN -DELIB_DONT_INITIALIZE -DSIZEOF_CHAR=1 -DSIZEOF_SHORT=2 -DSIZEOF_INT=4 -DSIZEOF_LONG=4 -DSIZEOF_LONG_LONG=8 -DSIZEOF_VOID_P=4 -DERTS_USE_PORT_TASKS=1|g +s|@GENERAL_CFLAGS@|@ENV_CFLAGS@ -DHAVE_LOCALTIME_R -DHAVE_GMTIME_R -DENABLE_ELIB_MALLOC -DELIB_HEAP_USER -DELIB_SORTED_BLOCKS -DWORDS_BIGENDIAN -DELIB_DONT_INITIALIZE -DSIZEOF_CHAR=1 -DSIZEOF_SHORT=2 -DSIZEOF_INT=4 -DSIZEOF_LONG=4 -DSIZEOF_LONG_LONG=8 -DSIZEOF_VOID_P=4 -DERTS_USE_PORT_TASKS=1|g s|@WFLAGS@|| # Thread flags for eidefs.mk (erl_interface) diff --git a/erts/configure.in b/erts/configure.in index 5f969a0a8b..506ce0d0fb 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script. -*-m4-*- dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1997-2018. All Rights Reserved. +dnl Copyright Ericsson AB 1997-2019. All Rights Reserved. dnl dnl Licensed under the Apache License, Version 2.0 (the "License"); dnl you may not use this file except in compliance with the License. @@ -590,6 +590,22 @@ AC_SUBST(WERRORFLAGS) ## Check if we can do profile guided optimization of beam_emu LM_CHECK_ENABLE_CFLAG([-fprofile-generate -Werror],[PROFILE_GENERATE]) LM_CHECK_ENABLE_CFLAG([-fprofile-use -Werror],[PROFILE_USE]) +LM_CHECK_ENABLE_CFLAG([-fprofile-use -fprofile-correction -Werror],[PROFILE_CORRECTION]) + +if test "X$PROFILE_CORRECTION" = "Xtrue"; then + saved_CFLAGS=$CFLAGS + saved_LDFLAGS=$LDFLAGS + CFLAGS="-fprofile-generate $saved_CFLAGS" + LDFLAGS="-fprofile-generate $saved_LDFLAGS" + AC_MSG_CHECKING([whether $CC links with -fprofile-generate]) + AC_LINK_IFELSE([AC_LANG_PROGRAM([],[return 0;])], + [AC_MSG_RESULT([yes]) + PROFILE_GENERATE=true], + [AC_MSG_RESULT([no]) + PROFILE_GENERATE=false]) + CFLAGS=$saved_CFLAGS + LDFLAGS=$saved_LDFLAGS +fi ## Check if this is clang LM_CHECK_ENABLE_CFLAG([-fprofile-instr-generate -Werror],[PROFILE_INSTR_GENERATE]) @@ -614,8 +630,8 @@ if test "X$PROFILE_INSTR_GENERATE" = "Xtrue"; then if test "X$LLVM_PROFDATA" != "X"; then CFLAGS="-fprofile-instr-use=default.profdata -Werror $saved_CFLAGS"; $LLVM_PROFDATA merge -output=default.profdata *.profraw; - AC_MSG_CHECKING([whether gcc accepts -fprofile-instr-use=default.profdata -Werror]) - AC_COMPILE_IFELSE([], + AC_MSG_CHECKING([whether $CC accepts -fprofile-instr-use=default.profdata -Werror]) + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([],[return 0;])], [AC_MSG_RESULT([yes]) PROFILE_INSTR_USE=true], [AC_MSG_RESULT([no]) @@ -637,8 +653,6 @@ AS_HELP_STRING([--enable-pgo], esac ],enable_pgo=default) -LM_CHECK_ENABLE_CFLAG([-fprofile-use -fprofile-correction -Werror],[PROFILE_CORRECTION]) - USE_PGO=false AC_MSG_CHECKING([whether to do PGO of erts]) if test $enable_pgo = no; then @@ -1329,6 +1343,28 @@ LIBS=$zlib_save_LIBS fi AC_SUBST(Z_LIB) + +dnl ------------- +dnl esock +dnl ------------- + +AC_ARG_ENABLE(esock, +AS_HELP_STRING([--enable-esock], [enable builtin experimental socket (as a nif) support (default)]) +AS_HELP_STRING([--disable-esock], [disable builtin experimental socket (as a nif) support])) + +dnl Default value +USE_ESOCK=yes + +if test "x$enable_esock" = "xyes"; then + USE_ESOCK=yes +else + if test "x$enable_esock" = "xno"; then + USE_ESOCK=no + fi +fi +AC_SUBST(USE_ESOCK) + + dnl dnl This test kindly borrowed from Tcl dnl diff --git a/erts/doc/src/Makefile b/erts/doc/src/Makefile index 06a8691c0e..bc01919da1 100644 --- a/erts/doc/src/Makefile +++ b/erts/doc/src/Makefile @@ -67,7 +67,22 @@ XML_REF3_FILES = \ erts_alloc.xml XML_PART_FILES = \ - part.xml + part.xml internal.xml + +XML_INTERNAL_FILES = \ + CarrierMigration.xml \ + ThreadProgress.xml \ + CodeLoading.xml \ + Tracing.xml \ + DelayedDealloc.xml \ + beam_makeops.xml \ + GarbageCollection.xml \ + PTables.xml \ + PortSignals.xml \ + ProcessManagementOptimizations.xml \ + SuperCarrier.xml \ + CountingInstructions.xml + XML_CHAPTER_FILES = \ introduction.xml \ @@ -97,6 +112,8 @@ XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF1_FILES) $(XML_APPLICATION_FILES) +XML_GEN_FILES = $(XML_INTERNAL_FILES:%=$(XMLDIR)/%) + # ---------------------------------------------------- HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -116,6 +133,12 @@ SPECS_FILES = $(XML_REF3_EFILES:%.xml=$(SPECDIR)/specs_%.xml) TOP_SPECS_FILE = specs.xml +XML_FIGURE_DIR = $(XMLDIR)/figures + +INTERNAL_DOC_PNG_FILES = $(wildcard ../../emulator/internal_doc/figures/*.png) +PNG_FILES = $(notdir $(INTERNAL_DOC_PNG_FILES)) +XMLDIR_PNG_FILES = $(PNG_FILES:%=$(XML_FIGURE_DIR)/%) + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -128,10 +151,15 @@ SPECS_FLAGS = -I$(KERNEL_SRC) -I$(KERNEL_INCLUDE) # ---------------------------------------------------- # Targets # ---------------------------------------------------- +_create_dirs := $(shell mkdir -p $(XML_FIGURE_DIR)) + $(HTMLDIR)/%.gif: %.gif $(INSTALL_DATA) $< $@ -docs: man pdf html $(INFO_FILE) +$(XML_FIGURE_DIR)/%.png: ../../emulator/internal_doc/figures/%.png + $(INSTALL_DATA) $< $@ + +docs: figures man pdf html $(INFO_FILE) $(TOP_PDF_FILE): $(XML_FILES) @@ -146,6 +174,7 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%) $(INFO_FILE): $(INFO_FILE_SRC) $(ERL_TOP)/make/$(TARGET)/otp.mk sed -e 's;%RELEASE%;$(SYSTEM_VSN);' $(INFO_FILE_SRC) > $(INFO_FILE) +figures: $(XMLDIR_PNG_FILES) debug opt: @@ -164,6 +193,9 @@ $(SPECDIR)/specs_%.xml: $(gen_verbose)escript $(SPECS_EXTRACTOR) $(SPECS_FLAGS) \ -o$(dir $@) -module $(patsubst $(SPECDIR)/specs_%.xml,%,$@) +$(XMLDIR)/%.xml: ../../emulator/internal_doc/%.md $(ERL_TOP)/make/emd2exml + $(ERL_TOP)/make/emd2exml $< $@ + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -173,8 +205,11 @@ release_docs_spec: docs $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" + $(INSTALL_DIR) "$(RELSYSDIR)/doc/html/figures" $(INSTALL_DATA) $(HTMLDIR)/* \ "$(RELSYSDIR)/doc/html" + $(INSTALL_DATA) $(XMLDIR)/figures/* \ + "$(RELSYSDIR)/doc/html/figures" $(INSTALL_DATA) $(ERL_TOP)/erts/example/time_compat.erl \ "$(RELSYSDIR)/doc/html" $(INSTALL_DATA) $(ERL_TOP)/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl \ diff --git a/erts/doc/src/alt_disco.xml b/erts/doc/src/alt_disco.xml index d04221b9b3..148d6f549e 100644 --- a/erts/doc/src/alt_disco.xml +++ b/erts/doc/src/alt_disco.xml @@ -63,7 +63,7 @@ <seealso marker="kernel:erl_epmd">EPMD module</seealso>. However, instead of communicating with EPMD you can connect to any service to find out connection details of other nodes. A discovery module is enabled - by setting <seealso marker="erts:erl#epmd_module">-epmd_module</seealso> + by setting <seealso marker="erts:erl">-epmd_module</seealso> when starting erlang. The discovery module must implement the following callbacks:</p> diff --git a/erts/doc/src/book.xml b/erts/doc/src/book.xml index a0780c91d9..d79da1e4f7 100644 --- a/erts/doc/src/book.xml +++ b/erts/doc/src/book.xml @@ -41,6 +41,9 @@ <applications> <xi:include href="ref_man.xml"/> </applications> + <internals> + <xi:include href="internal.xml"/> + </internals> <releasenotes> <xi:include href="notes.xml"/> </releasenotes> diff --git a/erts/doc/src/communication.xml b/erts/doc/src/communication.xml index 7e18a73aa8..251b52dc65 100644 --- a/erts/doc/src/communication.xml +++ b/erts/doc/src/communication.xml @@ -64,7 +64,7 @@ a synchronous communication operation consists of two asynchronous signals; one request signal and one reply signal. An example of such a synchronous communication is a call to - <seealso marker="erlang:process_info/2"> + <seealso marker="erlang#process_info/2"> <c>erlang:process_info/2</c></seealso> when the first argument is not <c>self()</c>. The caller sends an asynchronous signal requesting information, and then diff --git a/erts/doc/src/crash_dump.xml b/erts/doc/src/crash_dump.xml index a9aeb1888c..33d0903622 100644 --- a/erts/doc/src/crash_dump.xml +++ b/erts/doc/src/crash_dump.xml @@ -290,7 +290,7 @@ Slogan: <reason></pre> <title>Memory Information</title> <p>Under the tag <em>=memory</em> is shown information similar to what can be obtainted on a living node with - <seealso marker="erts:erlang#erlang:memory/0"> + <seealso marker="erts:erlang#memory/0"> <c>erlang:memory()</c></seealso>.</p> </section> diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index bfd4dd8fe9..ed1b0880b4 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -639,6 +639,29 @@ produces a crash dump. On Unix systems, sending an emulator process a <c>SIGUSR1</c> signal also forces a crash dump.</p> </item> + <tag><marker id="+dcg"/><c><![CDATA[+rg DecentralizedCounterGroupsLimit]]></c></tag> + <item> + <p>Limits the number of decentralized counter groups used by + decentralized counters optimized for update operations in the + Erlang runtime system. By default, the limit is 256.</p> + <p>When the number of schedulers is less than or equal to the + limit, each scheduler has its own group. When the + number of schedulers is larger than the groups limit, + schedulers share groups. Shared groups degrade + the performance for updating counters while many reader groups + degrade the performance for reading counters. So, the limit is a tradeoff + between performance for update operations and performance for + read operations. Each group consumes 64 bytes in each + counter.</p> + <p>Notice that a runtime system using decentralized + counter groups benefits from <seealso marker="#+sbt">binding + schedulers to logical processors</seealso>, as the groups are + distributed better between schedulers with this option.</p> + <p>This option only affects decentralized counters used for + the counters that are keeping track of the memory consumption + and the number of terms in ETS tables of type ordered_set with + the write_concurrency option activated.</p> + </item> <tag><marker id="+e"/><c><![CDATA[+e Number]]></c></tag> <item> <p>Sets the maximum number of ETS tables. This limit is diff --git a/erts/doc/src/erl_dist_protocol.xml b/erts/doc/src/erl_dist_protocol.xml index 185c75fe84..f924c8a70b 100644 --- a/erts/doc/src/erl_dist_protocol.xml +++ b/erts/doc/src/erl_dist_protocol.xml @@ -850,10 +850,15 @@ DiB == gen_digest(ChA, ICA)? <tag><c>-define(DFLAG_EXIT_PAYLOAD, 16#400000).</c></tag> <item> <p>Use the <c>PAYLOAD_EXIT</c>, <c>PAYLOAD_EXIT_TT</c>, - <c>PAYLOAD_EXIT2</c>, <c>PAYLOAD_EXIT2_TT</c> - and <c>PAYLOAD_MONITOR_P_EXIT</c> - <seealso marker="#control_message">control message</seealso>s - instead of the non-PAYLOAD variants.</p> + <c>PAYLOAD_EXIT2</c>, <c>PAYLOAD_EXIT2_TT</c> + and <c>PAYLOAD_MONITOR_P_EXIT</c> + <seealso marker="#control_message">control message</seealso>s + instead of the non-PAYLOAD variants.</p> + </item> + <tag><c>-define(DFLAG_FRAGMENTS, 16#800000).</c></tag> + <item> + <p>Use <seealso marker="erl_ext_dist#fragments">fragmented</seealso> + distribution messages to send large messages.</p> </item> </taglist> <p> diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml index 58678f2393..3e2d3bb447 100644 --- a/erts/doc/src/erl_driver.xml +++ b/erts/doc/src/erl_driver.xml @@ -230,7 +230,7 @@ <item> <p>With these functions, the driver sends data back to the emulator. The data is received as messages by the port owner process, see - <seealso marker="erlang:open_port/2"> + <seealso marker="erlang#open_port/2"> <c>erlang:open_port/2</c></seealso>. The vector function and the function taking a driver binary are faster, as they avoid copying the data buffer. There is also a fast way of sending @@ -1154,27 +1154,27 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> <taglist> <tag><seealso marker="driver_entry#start"> <c>start</c></seealso></tag> - <item>Called from <seealso marker="erlang:open_port/2"> + <item>Called from <seealso marker="erlang#open_port/2"> <c>erlang:open_port/2</c></seealso>.</item> <tag><seealso marker="driver_entry#output"> <c>output</c></seealso></tag> - <item>Called from <seealso marker="erlang:send/2"> + <item>Called from <seealso marker="erlang#send/2"> <c>erlang:send/2</c></seealso> and - <seealso marker="erlang:port_command/2"> + <seealso marker="erlang#port_command/2"> <c>erlang:port_command/2</c></seealso>.</item> <tag><seealso marker="driver_entry#outputv"> <c>outputv</c></seealso></tag> - <item>Called from <seealso marker="erlang:send/2"> + <item>Called from <seealso marker="erlang#send/2"> <c>erlang:send/2</c></seealso> and - <seealso marker="erlang:port_command/2"> + <seealso marker="erlang#port_command/2"> <c>erlang:port_command/2</c></seealso>.</item> <tag><seealso marker="driver_entry#control"> <c>control</c></seealso></tag> - <item>Called from <seealso marker="erlang:port_control/3"> + <item>Called from <seealso marker="erlang#port_control/3"> <c>erlang:port_control/3</c></seealso>.</item> <tag><seealso marker="driver_entry#call"> <c>call</c></seealso></tag> - <item>Called from <seealso marker="erlang:port_call/3"> + <item>Called from <seealso marker="erlang#port_call/3"> <c>erlang:port_call/3</c></seealso>.</item> </taglist> <p>Notice that this function is <em>not</em> thread-safe, not @@ -2305,7 +2305,7 @@ r = driver_async(myPort, &myKey, myData, myFunc); ]]></code> <c>*value_size</c> has been set to the buffer size needed.</p> <warning> <p>This function reads the emulated environment used by - <seealso marker="os:getenv/1"><c>os:getenv/1</c></seealso> and not + <seealso marker="kernel:os#getenv/1"><c>os:getenv/1</c></seealso> and not the environment used by libc's <c>getenv(3)</c> or similar. Drivers that <em>require</em> that these are in sync will need to do so themselves, but keep in mind that they are segregated for a reason; @@ -2656,7 +2656,7 @@ erl_drv_output_term(driver_mk_port(drvport), spec, sizeof(spec) / sizeof(spec[0] </note> <warning> <p>This function modifies the emulated environment used by - <seealso marker="os:putenv/2"><c>os:putenv/2</c></seealso> and not + <seealso marker="kernel:os#putenv/2"><c>os:putenv/2</c></seealso> and not the environment used by libc's <c>putenv(3)</c> or similar. Drivers that <em>require</em> that these are in sync will need to do so themselves, but keep in mind that they are segregated for a reason; @@ -2849,7 +2849,7 @@ erl_drv_output_term(driver_mk_port(drvport), spec, sizeof(spec) / sizeof(spec[0] <desc> <marker id="erl_drv_set_os_pid"></marker> <p>Sets the <c>os_pid</c> seen when doing - <seealso marker="erlang:port_info/2"> + <seealso marker="erlang#port_info/2"> <c>erlang:port_info/2</c></seealso> on this port.</p> <p><c>port</c> is the port handle of the port (driver instance) to set the pid on. <c>pid</c>is the pid to set.</p> @@ -3204,7 +3204,7 @@ erl_drv_output_term(driver_mk_port(drvport), spec, sizeof(spec) / sizeof(spec[0] <c>control</c></seealso> driver entry function will return data to the port owner process. (The <c>control</c> function is called from - <seealso marker="erlang:port_control/3"> + <seealso marker="erlang#port_control/3"> <c>erlang:port_control/3</c></seealso>.)</p> <p>Currently there are only two meaningful values for <c>flags</c>: <c>0</c> means that data is returned in a list, diff --git a/erts/doc/src/erl_ext_dist.xml b/erts/doc/src/erl_ext_dist.xml index 4721747097..3730f0e8ac 100644 --- a/erts/doc/src/erl_ext_dist.xml +++ b/erts/doc/src/erl_ext_dist.xml @@ -140,162 +140,366 @@ <marker id="distribution_header"/> <title>Distribution Header</title> <p> - The distribution header only contains an atom cache - reference section, but can in the future contain more - information. The distribution header precedes one or more Erlang - terms on the external format. For more information, see the - documentation of the + The distribution header is sent by the erlang distribution to + carry metadata about the coming + <seealso marker="erl_dist_protocol#control_message">control message</seealso> + and potential payload. It is primarily used to handle the atom cache + in the Erlang distribution. Since OTP-22 it is also used to fragment + large distribution messages into multiple smaller fragments. + For more information about how the distribution uses the distribution header, + see the documentation of the <seealso marker="erl_dist_protocol#connected_nodes">protocol between connected nodes</seealso> in the <seealso marker="erl_dist_protocol">distribution protocol</seealso> documentation. </p> <p> - <seealso marker="#ATOM_CACHE_REF">ATOM_CACHE_REF</seealso> + Any <seealso marker="#ATOM_CACHE_REF">ATOM_CACHE_REF</seealso> entries with corresponding <c>AtomCacheReferenceIndex</c> in terms encoded on the external format following a distribution header refer to the atom cache references made in the distribution header. The range is 0 <= <c>AtomCacheReferenceIndex</c> < 255, that is, at most 255 different atom cache references from the following terms can be made. </p> - <p> - The distribution header format is as follows: - </p> - <table align="left"> - <row> - <cell align="center">1</cell> - <cell align="center">1</cell> - <cell align="center">1</cell> - <cell align="center">NumberOfAtomCacheRefs/2+1 | 0</cell> - <cell align="center">N | 0</cell> - </row> - <row> - <cell align="center"><c>131</c></cell> - <cell align="center"><c>68</c></cell> - <cell align="center"><c>NumberOfAtomCacheRefs</c></cell> - <cell align="center"><c>Flags</c></cell> - <cell align="center"><c>AtomCacheRefs</c></cell> - </row> - <tcaption>Distribution Header Format</tcaption></table> - <p> - <c>Flags</c> consist of <c>NumberOfAtomCacheRefs/2+1</c> bytes, - unless <c>NumberOfAtomCacheRefs</c> is <c>0</c>. If - <c>NumberOfAtomCacheRefs</c> is <c>0</c>, <c>Flags</c> and - <c>AtomCacheRefs</c> are omitted. Each atom cache reference has - a half byte flag field. Flags corresponding to a specific - <c>AtomCacheReferenceIndex</c> are located in flag byte number - <c>AtomCacheReferenceIndex/2</c>. Flag byte 0 is the first byte - after the <c>NumberOfAtomCacheRefs</c> byte. Flags for an even - <c>AtomCacheReferenceIndex</c> are located in the least significant - half byte and flags for an odd <c>AtomCacheReferenceIndex</c> are - located in the most significant half byte. - </p> - <p> - The flag field of an atom cache reference has the following - format: - </p> - <table align="left"> - <row> - <cell align="center">1 bit</cell> - <cell align="center">3 bits</cell> - </row> - <row> - <cell align="center"><c>NewCacheEntryFlag</c></cell> - <cell align="center"><c>SegmentIndex</c></cell> - </row> - <tcaption></tcaption></table> - <p> - The most significant bit is the <c>NewCacheEntryFlag</c>. If set, - the corresponding cache reference is new. The three least - significant bits are the <c>SegmentIndex</c> of the corresponding - atom cache entry. An atom cache consists of 8 segments, each of size - 256, that is, an atom cache can contain 2048 entries. - </p> - <p> - After flag fields for atom cache references, another half byte flag - field is located with the following format: - </p> - <table align="left"> - <row> - <cell align="center">3 bits</cell> - <cell align="center">1 bit</cell> - </row> - <row> - <cell align="center"><c>CurrentlyUnused</c></cell> - <cell align="center"><c>LongAtoms</c></cell> - </row> - <tcaption></tcaption></table> - <p> - The least significant bit in that half byte is flag <c>LongAtoms</c>. - If it is set, 2 bytes are used for atom lengths instead of - 1 byte in the distribution header. - </p> - <p> - After the <c>Flags</c> field follow the <c>AtomCacheRefs</c>. The - first <c>AtomCacheRef</c> is the one corresponding to - <c>AtomCacheReferenceIndex</c> 0. Higher indices follow - in sequence up to index <c>NumberOfAtomCacheRefs - 1</c>. - </p> - <p> - If the <c>NewCacheEntryFlag</c> for the next <c>AtomCacheRef</c> has - been set, a <c>NewAtomCacheRef</c> on the following format follows: - </p> - <table align="left"> - <row> - <cell align="center">1</cell> - <cell align="center">1 | 2</cell> - <cell align="center">Length</cell> - </row> - <row> - <cell align="center"><c>InternalSegmentIndex</c></cell> - <cell align="center"><c>Length</c></cell> - <cell align="center"><c>AtomText</c></cell> - </row> - <tcaption></tcaption></table> - <p> - <c>InternalSegmentIndex</c> together with the <c>SegmentIndex</c> - completely identify the location of an atom cache entry in the - atom cache. <c>Length</c> is the number of bytes that <c>AtomText</c> - consists of. Length is a 2 byte big-endian integer - if flag <c>LongAtoms</c> has been set, otherwise a 1 byte - integer. When distribution flag - <seealso marker="erl_dist_protocol#dflags"> - <c>DFLAG_UTF8_ATOMS</c></seealso> - has been exchanged between both nodes in the - <seealso marker="erl_dist_protocol#distribution_handshake"> - distribution handshake</seealso>, - characters in <c>AtomText</c> are encoded in UTF-8, otherwise - in Latin-1. The following <c>CachedAtomRef</c>s with the same - <c>SegmentIndex</c> and <c>InternalSegmentIndex</c> as this - <c>NewAtomCacheRef</c> refer to this atom until a new - <c>NewAtomCacheRef</c> with the same <c>SegmentIndex</c> - and <c>InternalSegmentIndex</c> appear. - </p> - <p> - For more information on encoding of atoms, see the - <seealso marker="#utf8_atoms">note on UTF-8 encoded atoms</seealso> - in the beginning of this section. - </p> - <p> - If the <c>NewCacheEntryFlag</c> for the next <c>AtomCacheRef</c> - has not been set, a <c>CachedAtomRef</c> on the following format - follows: - </p> - <table align="left"> - <row> - <cell align="center">1</cell> - </row> - <row> - <cell align="center"><c>InternalSegmentIndex</c></cell> - </row> - <tcaption></tcaption></table> - <p> - <c>InternalSegmentIndex</c> together with the <c>SegmentIndex</c> - identify the location of the atom cache entry in the atom cache. - The atom corresponding to this <c>CachedAtomRef</c> is the - latest <c>NewAtomCacheRef</c> preceding this <c>CachedAtomRef</c> - in another previously passed distribution header. - </p> + <section> + <title>Normal Distribution Header</title> + <p> + The non-fragmented distribution header format is as follows: + </p> + <table align="left"> + <row> + <cell align="center">1</cell> + <cell align="center">1</cell> + <cell align="center">1</cell> + <cell align="center">NumberOfAtomCacheRefs/2+1 | 0</cell> + <cell align="center">N | 0</cell> + </row> + <row> + <cell align="center"><c>131</c></cell> + <cell align="center"><c>68</c></cell> + <cell align="center"><c>NumberOfAtomCacheRefs</c></cell> + <cell align="center"><c>Flags</c></cell> + <cell align="center"><c>AtomCacheRefs</c></cell> + </row> + <tcaption>Normal Distribution Header Format</tcaption></table> + <p> + <c>Flags</c> consist of <c>NumberOfAtomCacheRefs/2+1</c> bytes, + unless <c>NumberOfAtomCacheRefs</c> is <c>0</c>. If + <c>NumberOfAtomCacheRefs</c> is <c>0</c>, <c>Flags</c> and + <c>AtomCacheRefs</c> are omitted. Each atom cache reference has + a half byte flag field. Flags corresponding to a specific + <c>AtomCacheReferenceIndex</c> are located in flag byte number + <c>AtomCacheReferenceIndex/2</c>. Flag byte 0 is the first byte + after the <c>NumberOfAtomCacheRefs</c> byte. Flags for an even + <c>AtomCacheReferenceIndex</c> are located in the least significant + half byte and flags for an odd <c>AtomCacheReferenceIndex</c> are + located in the most significant half byte. + </p> + <p> + The flag field of an atom cache reference has the following + format: + </p> + <table align="left"> + <row> + <cell align="center">1 bit</cell> + <cell align="center">3 bits</cell> + </row> + <row> + <cell align="center"><c>NewCacheEntryFlag</c></cell> + <cell align="center"><c>SegmentIndex</c></cell> + </row> + <tcaption></tcaption></table> + <p> + The most significant bit is the <c>NewCacheEntryFlag</c>. If set, + the corresponding cache reference is new. The three least + significant bits are the <c>SegmentIndex</c> of the corresponding + atom cache entry. An atom cache consists of 8 segments, each of size + 256, that is, an atom cache can contain 2048 entries. + </p> + <p> + After flag fields for atom cache references, another half byte flag + field is located with the following format: + </p> + <table align="left"> + <row> + <cell align="center">3 bits</cell> + <cell align="center">1 bit</cell> + </row> + <row> + <cell align="center"><c>CurrentlyUnused</c></cell> + <cell align="center"><c>LongAtoms</c></cell> + </row> + <tcaption></tcaption></table> + <p> + The least significant bit in that half byte is flag <c>LongAtoms</c>. + If it is set, 2 bytes are used for atom lengths instead of + 1 byte in the distribution header. + </p> + <p> + After the <c>Flags</c> field follow the <c>AtomCacheRefs</c>. The + first <c>AtomCacheRef</c> is the one corresponding to + <c>AtomCacheReferenceIndex</c> 0. Higher indices follow + in sequence up to index <c>NumberOfAtomCacheRefs - 1</c>. + </p> + <p> + If the <c>NewCacheEntryFlag</c> for the next <c>AtomCacheRef</c> has + been set, a <c>NewAtomCacheRef</c> on the following format follows: + </p> + <table align="left"> + <row> + <cell align="center">1</cell> + <cell align="center">1 | 2</cell> + <cell align="center">Length</cell> + </row> + <row> + <cell align="center"><c>InternalSegmentIndex</c></cell> + <cell align="center"><c>Length</c></cell> + <cell align="center"><c>AtomText</c></cell> + </row> + <tcaption></tcaption></table> + <p> + <c>InternalSegmentIndex</c> together with the <c>SegmentIndex</c> + completely identify the location of an atom cache entry in the + atom cache. <c>Length</c> is the number of bytes that <c>AtomText</c> + consists of. Length is a 2 byte big-endian integer + if flag <c>LongAtoms</c> has been set, otherwise a 1 byte + integer. When distribution flag + <seealso marker="erl_dist_protocol#dflags"> + <c>DFLAG_UTF8_ATOMS</c></seealso> + has been exchanged between both nodes in the + <seealso marker="erl_dist_protocol#distribution_handshake"> + distribution handshake</seealso>, + characters in <c>AtomText</c> are encoded in UTF-8, otherwise + in Latin-1. The following <c>CachedAtomRef</c>s with the same + <c>SegmentIndex</c> and <c>InternalSegmentIndex</c> as this + <c>NewAtomCacheRef</c> refer to this atom until a new + <c>NewAtomCacheRef</c> with the same <c>SegmentIndex</c> + and <c>InternalSegmentIndex</c> appear. + </p> + <p> + For more information on encoding of atoms, see the + <seealso marker="#utf8_atoms">note on UTF-8 encoded atoms</seealso> + in the beginning of this section. + </p> + <p> + If the <c>NewCacheEntryFlag</c> for the next <c>AtomCacheRef</c> + has not been set, a <c>CachedAtomRef</c> on the following format + follows: + </p> + <table align="left"> + <row> + <cell align="center">1</cell> + </row> + <row> + <cell align="center"><c>InternalSegmentIndex</c></cell> + </row> + <tcaption></tcaption></table> + <p> + <c>InternalSegmentIndex</c> together with the <c>SegmentIndex</c> + identify the location of the atom cache entry in the atom cache. + The atom corresponding to this <c>CachedAtomRef</c> is the + latest <c>NewAtomCacheRef</c> preceding this <c>CachedAtomRef</c> + in another previously passed distribution header. + </p> + </section> + <section> + <marker id="fragments"/> + <title>Distribution Header for fragmented messages</title> + <p>Messages sent between Erlang nodes can sometimes be + quite large. Since OTP-22 it is possible to split large messages + into smaller fragments in order to allow smaller messages to be interleaved + between larges messages. It is only the <c>message</c> part of each + <seealso marker="erl_dist_protocol#connected_nodes">distributed message</seealso> + that may be split using fragmentation. Therefore it is recommended to use the + <seealso marker="erl_dist_protocol#new-ctrlmessages-for-erlang-otp-22"> + PAYLOAD control messages</seealso> introduced in OTP-22. + </p> + <p>Fragmented distribution messages are only used if the receiving node + signals that it supports them via the + <seealso marker="erl_dist_protocol#dflags">DFLAG_FRAGMENTS</seealso> distribution + flag.</p> + <p>A process must complete the sending of a fragmented message before it + can start sending any other message on the same distribution channel.</p> + + <p>The start of a sequence of fragmented messages looks like this:</p> + <table align="left"> + <row> + <cell align="center">1</cell> + <cell align="center">1</cell> + <cell align="center">8</cell> + <cell align="center">8</cell> + <cell align="center">1</cell> + <cell align="center">NumberOfAtomCacheRefs/2+1 | 0</cell> + <cell align="center">N | 0</cell> + </row> + <row> + <cell align="center"><c>131</c></cell> + <cell align="center"><c>69</c></cell> + <cell align="center"><c>SequenceId</c></cell> + <cell align="center"><c>FragmentId</c></cell> + <cell align="center"><c>NumberOfAtomCacheRefs</c></cell> + <cell align="center"><c>Flags</c></cell> + <cell align="center"><c>AtomCacheRefs</c></cell> + </row> + <tcaption>Starting Fragmented Distribution Header Format</tcaption> + </table> + + <p>The continuation of a sequence of fragmented messages looks like this:</p> + <table align="left"> + <row> + <cell align="center">1</cell> + <cell align="center">1</cell> + <cell align="center">8</cell> + <cell align="center">8</cell> + </row> + <row> + <cell align="center"><c>131</c></cell> + <cell align="center"><c>70</c></cell> + <cell align="center"><c>SequenceId</c></cell> + <cell align="center"><c>FragmentId</c></cell> + </row> + <tcaption>Continuing Fragmented Distribution Header Format</tcaption> + </table> + + <p> + The starting distribution header is very similar to a non-fragmented distribution + header. The atom cache works the same as for normal distribution header and + is the same for the entire sequence. The additional fields added are the + sequence id and fragment id. + </p> + + <taglist> + <tag>Sequence ID</tag> + <item> + <p> + The sequence id is used to uniquely identify a fragmented message sent + from one process to another on the same distributed connection. This is used + to identify which sequence a fragment is a part of as the same process can + be in the process of receiving multiple sequences at the same time. + </p> + <p> + As one process can only be sending one fragmented message at once, + it can be convenient to use the local PID as the sequence id. + </p> + </item> + <tag>Fragments ID</tag> + <item> + <p> + The Fragment ID is used to number the fragments in a sequence. + The id starts at the total number of fragments and then decrements to 1 + (which is the final fragment). So if a sequence consists of 3 fragments + the fragment id in the starting header will be 3, and then fragments 2 and 1 + are sent. + </p> + <p> + The fragments must be delivered in the correct order, so if an unordered + distribution carrier is used, they must be ordered before delivered to the + Erlang run-time. + </p> + </item> + </taglist> + + <section> + <title>Example:</title> + <p> + As an example, let say that we want to send + <c>{call, <0.245.2>, {set_get_state, <<0:1024>>}}</c> to + registered process <c>reg</c> using a fragment size of 128. To send + this message we need a distribution header, atom cache updates, + the control message (which would be <c>{6, <0.245.2>, [], reg}</c> in this case) + and finally the actual message. This would all be encoded into: + </p> + + <code> +131,69,0,0,2,168,0,0,5,83,0,0,0,0,0,0,0,2, %% Header with seq and frag id +5,4,137,9,10,5,236,3,114,101,103,9,4,99,97,108,108, %% Atom cache updates +238,13,115,101,116,95,103,101,116,95,115,116,97,116,101, +104,4,97,6,103,82,0,0,0,0,85,0,0,0,0,2,82,1,82,2, %% Control message +104,3,82,3,103,82,0,0,0,0,245,0,0,0,2,2, %% Actual message using cached atoms +104,2,82,4,109,0,0,0,128,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 + +131,70,0,0,2,168,0,0,5,83,0,0,0,0,0,0,0,1, %% Cont Header with seq and frag id +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, %% Rest of payload +0,0,0,0</code> + + <p> + Let us break that apart into its components. First we have the + distribution header tags together with the sequence id and + a fragment id of 2. + </p> + <code> +131,69, %% Start fragment header +0,0,2,168,0,0,5,83, %% The sequence ID +0,0,0,0,0,0,0,2, %% The fragment ID +</code> + <p>Then we have the updates to the atom cache:</p> + <code> +5,4,137,9, %% 5 atoms and their flags +10,5, %% The already cached atom ids +236,3,114,101,103, %% The atom 'reg' +9,4,99,97,108,108, %% The atom 'call' +238,13,115,101,116,95,103,101,116,95,115,116,97,116,101, %% The atom 'set_get_state' + </code> + <p> + The first byte says that we have 5 atoms that are part + of the cache. Then follows three bytes that are the + atom cache ref flags. Each of the flags uses 4 bits so + they are a bit hard to read in decimal byte form. In + binary half-byte form they look like this: + </p> + <code>0000, 0100, 1000, 1001, 1001</code> + <p> + As the high bit of the first two atoms in the + cache are not set we know that they are already in the cache, + so they do not have to be sent again (this is the node name of the + receiving and sending node). Then follows the atoms that have to be sent, + together with their segment ids. + </p> + <p> + Then the listing of the atoms comes, starting with 10 and 5 + which are the atom refs of the already cached atoms. Then the + new atoms are sent. + </p> + <p> + When the atom cache is setup correctly the control message is sent. + </p> + <code>104,4,97,6,103,82,0,0,0,0,85,0,0,0,0,2,82,1,82,2,</code> + <p> + Note that up until here it is not allowed to fragments the message. + The entire atom cache and control message has to be part of the + starting fragment. After the control message the payload of the message + is sent using 128 bytes: + </p> + <code> +104,3,82,3,103,82,0,0,0,0,245,0,0,0,2,2, +104,2,82,4,109,0,0,0,128,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 + </code> + <p> + Since the payload is larger than 128-bytes it is split into two + fragments. The second fragment does not have any atom cache update + instructions so it is a lot simpler: + </p> + <code> +131,70,0,0,2,168,0,0,5,83,0,0,0,0,0,0,0,1, %% Continuation dist header 70 with seq and frag id +0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, %% remaining payload +0,0,0,0 + </code> + <note> + <p> + The fragment size of 128 is only used as an example. + Any fragments size may be used when sending fragmented messages. + </p> + </note> + </section> + </section> </section> <section> @@ -381,44 +585,6 @@ </section> <section> - <marker id="REFERENCE_EXT"/> - <title>REFERENCE_EXT</title> - <table align="left"> - <row> - <cell align="center">1</cell> - <cell align="center">N</cell> - <cell align="center">4</cell> - <cell align="center">1</cell> - </row> - <row> - <cell align="center"><c>101</c></cell> - <cell align="center"><c>Node</c></cell> - <cell align="center"><c>ID</c></cell> - <cell align="center"><c>Creation</c></cell> - </row> - <tcaption>REFERENCE_EXT</tcaption></table> - <p> - Encodes a reference object (an object generated with - <seealso marker="erlang:make_ref/0">erlang:make_ref/0</seealso>). - The <c>Node</c> term is an encoded atom, that is, - <seealso marker="#ATOM_UTF8_EXT"><c>ATOM_UTF8_EXT</c></seealso>, - <seealso marker="#SMALL_ATOM_UTF8_EXT"><c>SMALL_ATOM_UTF8_EXT</c></seealso>, or - <seealso marker="#ATOM_CACHE_REF"><c>ATOM_CACHE_REF</c></seealso>. - The <c>ID</c> field contains a big-endian unsigned integer, - but <em>is to be regarded as uninterpreted data</em>, - as this field is node-specific. - <c>Creation</c> is a byte containing a node serial number, which - makes it possible to separate old (crashed) nodes from a new one. - </p> - <p> - In <c>ID</c>, only 18 bits are significant; the rest are to be 0. - In <c>Creation</c>, only two bits are significant; the rest are to be 0. - See <seealso marker="#NEW_REFERENCE_EXT"> - <c>NEW_REFERENCE_EXT</c></seealso>. - </p> - </section> - - <section> <marker id="PORT_EXT"/> <title>PORT_EXT</title> <table align="left"> @@ -436,13 +602,46 @@ </row> <tcaption>PORT_EXT</tcaption></table> <p> - Encodes a port object (obtained from - <seealso marker="erlang:open_port/2"> - <c>erlang:open_port/2</c></seealso>). - The <c>ID</c> is a node-specific identifier for a local port. + Same as <seealso marker="#NEW_PORT_EXT"><c>NEW_PORT_EXT</c></seealso> + except the <c>Creation</c> field is only one byte and only two + bits are significant, the rest are to be 0. + </p> + </section> + + <section> + <marker id="NEW_PORT_EXT"/> + <title>NEW_PORT_EXT</title> + <table align="left"> + <row> + <cell align="center">1</cell> + <cell align="center">N</cell> + <cell align="center">4</cell> + <cell align="center">4</cell> + </row> + <row> + <cell align="center"><c>89</c></cell> + <cell align="center"><c>Node</c></cell> + <cell align="center"><c>ID</c></cell> + <cell align="center"><c>Creation</c></cell> + </row> + <tcaption>NEW_PORT_EXT</tcaption></table> + <p> + Encodes a port identifier (obtained from + <seealso marker="erlang#open_port/2"><c>erlang:open_port/2</c></seealso>). + <c>Node</c> is an encoded atom, that is, + <seealso marker="#ATOM_UTF8_EXT"><c>ATOM_UTF8_EXT</c></seealso>, + <seealso marker="#SMALL_ATOM_UTF8_EXT"><c>SMALL_ATOM_UTF8_EXT</c></seealso> + or <seealso marker="#ATOM_CACHE_REF"><c>ATOM_CACHE_REF</c></seealso>. + <c>ID</c> is a 32-bit big endian unsigned integer. Only 28 bits are + significant; the rest are to be 0. The <c>Creation</c> works just like in + <seealso marker="#NEW_PID_EXT"><c>NEW_PID_EXT</c></seealso>. Port operations are not allowed across node boundaries. - The <c>Creation</c> works just like in - <seealso marker="#REFERENCE_EXT"><c>REFERENCE_EXT</c></seealso>. + </p> + <p>Introduced in OTP 19, but only to be decoded and echoed back. Not + encoded for local ports. Planned to supersede <seealso marker="#PORT_EXT"> + <c>PORT_EXT</c></seealso> in OTP 23 when + <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_BIG_CREATON</c></seealso> + becomes mandatory. </p> </section> @@ -466,12 +665,65 @@ </row> <tcaption>PID_EXT</tcaption></table> <p> - Encodes a process identifier object (obtained from - <seealso marker="erlang:spawn/3"><c>erlang:spawn/3</c></seealso> or - friends). The <c>ID</c> and <c>Creation</c> fields works just like in - <seealso marker="#REFERENCE_EXT"><c>REFERENCE_EXT</c></seealso>, while - the <c>Serial</c> field is used to improve safety. - In <c>ID</c>, only 15 bits are significant; the rest are to be 0. + Same as <seealso marker="#NEW_PID_EXT"><c>NEW_PID_EXT</c></seealso> + except the <c>Creation</c> field is only one byte and only two + bits are significant, the rest are to be 0. + </p> + </section> + + <section> + <marker id="NEW_PID_EXT"/> + <title>NEW_PID_EXT</title> + <table align="left"> + <row> + <cell align="center">1</cell> + <cell align="center">N</cell> + <cell align="center">4</cell> + <cell align="center">4</cell> + <cell align="center">4</cell> + </row> + <row> + <cell align="center"><c>88</c></cell> + <cell align="center"><c>Node</c></cell> + <cell align="center"><c>ID</c></cell> + <cell align="center"><c>Serial</c></cell> + <cell align="center"><c>Creation</c></cell> + </row> + <tcaption>NEW_PID_EXT</tcaption></table> + <p> + Encodes an Erlang process identifier object. + </p> + <taglist> + <tag><c>Node</c></tag> + <item><p>The name of the originating node, encoded using + <seealso marker="#ATOM_UTF8_EXT"><c>ATOM_UTF8_EXT</c></seealso>, + <seealso marker="#SMALL_ATOM_UTF8_EXT"><c>SMALL_ATOM_UTF8_EXT</c></seealso> + or <seealso + marker="#ATOM_CACHE_REF"><c>ATOM_CACHE_REF</c></seealso>.</p> + </item> + <tag><c>ID</c></tag> + <item><p>A 32-bit big endian unsigned integer. Only 15 bits are + significant; the rest are to be 0.</p> + </item> + <tag><c>Serial</c></tag> + <item><p>A 32-bit big endian unsigned integer. Only 13 bits are + significant; the rest are to be 0.</p> + </item> + <tag><c>Creation</c></tag> + <item><p>A 32-bit big endian unsigned integer. All identifiers + originating from the same node incarnation must have identical <c>Creation</c> + values. This makes it possible to separate identifiers from old + (crashed) nodes from a new one. The value zero should be avoided for + normal operations as it is used as a wild card for debug purpose + (like a pid returned by <seealso marker="erts:erlang#list_to_pid/1"> + erlang:list_to_pid/1</seealso>).</p> + </item> + </taglist> + <p>Introduced in OTP 19, but only to be decoded and echoed back. Not + encoded for local processes. Planned to supersede <seealso marker="#PID_EXT"> + <c>PID_EXT</c></seealso> in OTP 23 when + <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_BIG_CREATON</c></seealso> + becomes mandatory. </p> </section> @@ -695,6 +947,30 @@ </section> <section> + <marker id="REFERENCE_EXT"/> + <title>REFERENCE_EXT (deprecated)</title> + <table align="left"> + <row> + <cell align="center">1</cell> + <cell align="center">N</cell> + <cell align="center">4</cell> + <cell align="center">1</cell> + </row> + <row> + <cell align="center"><c>101</c></cell> + <cell align="center"><c>Node</c></cell> + <cell align="center"><c>ID</c></cell> + <cell align="center"><c>Creation</c></cell> + </row> + <tcaption>REFERENCE_EXT</tcaption></table> + <p> + The same as <seealso marker="#NEW_REFERENCE_EXT"> + <c>NEW_REFERENCE_EXT</c></seealso> except <c>ID</c> is only one word + (<c>Len</c> = 1). + </p> + </section> + + <section> <marker id="NEW_REFERENCE_EXT"/> <title>NEW_REFERENCE_EXT</title> <table align="left"> @@ -714,29 +990,68 @@ </row> <tcaption>NEW_REFERENCE_EXT</tcaption></table> <p> - <c>Node</c> and <c>Creation</c> are as in - <seealso marker="#REFERENCE_EXT"><c>REFERENCE_EXT</c></seealso>. - </p> - <p> - <c>ID</c> contains a sequence of big-endian unsigned integers - (4 bytes each, so <c>N'</c> is a multiple of 4), - but is to be regarded as uninterpreted data. - </p> - <p> - <c>N'</c> = 4 * <c>Len</c>. - </p> - <p> - In the first word (4 bytes) of <c>ID</c>, only 18 bits are - significant, the rest are to be 0. - In <c>Creation</c>, only two bits are significant, - the rest are to be 0. + The same as <seealso marker="#NEWER_REFERENCE_EXT"> + <c>NEWER_REFERENCE_EXT</c></seealso> <em>except</em>: </p> + <taglist> + <tag><c>ID</c></tag> + <item><p>In the first word (4 bytes) of <c>ID</c>, only 18 bits are + significant, the rest must be 0.</p> + </item> + <tag><c>Creation</c></tag> + <item><p>Only one byte long and only two bits are significant, the rest must be 0.</p> + </item> + </taglist> + </section> + + <section> + <marker id="NEWER_REFERENCE_EXT"/> + <title>NEWER_REFERENCE_EXT</title> + <table align="left"> + <row> + <cell align="center">1</cell> + <cell align="center">2</cell> + <cell align="center">N</cell> + <cell align="center">4</cell> + <cell align="center">N'</cell> + </row> + <row> + <cell align="center"><c>90</c></cell> + <cell align="center"><c>Len</c></cell> + <cell align="center"><c>Node</c></cell> + <cell align="center"><c>Creation</c></cell> + <cell align="center"><c>ID ...</c></cell> + </row> + <tcaption>NEWER_REFERENCE_EXT</tcaption></table> <p> - <c>NEW_REFERENCE_EXT</c> was introduced with distribution version 4. - In version 4, <c>N'</c> is to be at most 12. + Encodes a reference term generated with + <seealso marker="erts:erlang#make_ref/0">erlang:make_ref/0</seealso>. </p> - <p> - See <seealso marker="#REFERENCE_EXT"><c>REFERENCE_EXT</c></seealso>. + <taglist> + <tag><c>Node</c></tag> + <item><p>The name of the originating node, encoded using + <seealso marker="#ATOM_UTF8_EXT"><c>ATOM_UTF8_EXT</c></seealso>, + <seealso marker="#SMALL_ATOM_UTF8_EXT"><c>SMALL_ATOM_UTF8_EXT</c></seealso> + or <seealso marker="#ATOM_CACHE_REF"><c>ATOM_CACHE_REF</c></seealso>.</p> + </item> + <tag><c>Len</c></tag> + <item><p>A 16-bit big endian unsigned integer not larger than 3.</p> + </item> + <tag><c>ID</c></tag> + <item><p>A sequence of <c>Len</c> big-endian unsigned integers + (4 bytes each, so <c>N'</c> = 4 * <c>Len</c>), + but is to be regarded as uninterpreted data.</p> + </item> + <tag><c>Creation</c></tag> + <item><p>Works just like in + <seealso marker="#NEW_PID_EXT"><c>NEW_PID_EXT</c></seealso>.</p> + </item> + </taglist> + <p>Introduced in OTP 19, but only to be decoded and echoed back. Not + encoded for local references. Planned to supersede <seealso marker="#NEW_REFERENCE_EXT"> + <c>NEW_REFERENCE_EXT</c></seealso> in OTP 23 when + <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_BIG_CREATON</c></seealso> + becomes mandatory. </p> </section> diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index cf1994887a..c0be715678 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -546,8 +546,8 @@ int writeiovec(ErlNifEnv *env, ERL_NIF_TERM term, ERL_NIF_TERM *tail, <p>Many operations communicating with a process executing a dirty NIF can, however, complete while it executes the dirty NIF. For example, retrieving information about it through - <seealso marker="erlang:process_info/1"> - <c>erlang:process_info</c></seealso>, setting its group leader, + <seealso marker="erlang#process_info/1"> + <c>process_info</c></seealso>, setting its group leader, register/unregister its name, and so on.</p> <p>Termination of a process executing a dirty NIF can only be completed up to a certain point while it executes the dirty NIF. diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 0d94f83493..2b444ccf01 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -126,7 +126,7 @@ instance.</p> <p>One can get an approximation of the <c>native</c> time unit by calling - <seealso marker="erlang:convert_time_unit/3"> + <seealso marker="#convert_time_unit/3"> <c>erlang:convert_time_unit(1, second, native)</c></seealso>. The result equals the number of whole <c>native</c> time units per second. If @@ -4663,6 +4663,7 @@ RealSystem = system + MissedSystem</code> <name name="port_info" arity="2" clause_i="6" since="OTP R16B"/> <fsummary>Information about the memory size of a port.</fsummary> <desc> + <marker id="port_info_memory"/> <p><c><anno>Bytes</anno></c> is the total number of bytes allocated for this port by the runtime system. The port itself can have allocated memory that is not @@ -5387,6 +5388,7 @@ RealSystem = system + MissedSystem</code> </item> <tag><c>{memory, <anno>Size</anno>}</c></tag> <item> + <marker id="process_info_memory"/> <p><c><anno>Size</anno></c> is the size in bytes of the process. This includes call stack, heap, and internal structures.</p> </item> @@ -6676,7 +6678,7 @@ lists:map( <tag><c>async</c></tag> <item>Async threads are used by various linked-in drivers (mainly the file drivers) do offload non-CPU intensive work. See - <seealso marker="erts:erl#+async_thread_pool_size">erl +A</seealso> for more details.</item> + <seealso marker="erts:erl#async_thread_pool_size">erl +A</seealso> for more details.</item> <tag><c>aux</c></tag> <item>Takes care of any work that is not specifically assigned to a scheduler.</item> diff --git a/erts/doc/src/internal.xml b/erts/doc/src/internal.xml new file mode 100644 index 0000000000..88609d492a --- /dev/null +++ b/erts/doc/src/internal.xml @@ -0,0 +1,44 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<internal xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>2018</year><year>2018</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>ERTS Internal Documentation</title> + <prepared>Lukas Larsson</prepared> + <docno></docno> + <date>2018-07-07</date> + <rev>4.5.2</rev> + <file>internal.xml</file> + </header> + <xi:include href="CarrierMigration.xml"/> + <xi:include href="ThreadProgress.xml"/> + <xi:include href="CodeLoading.xml"/> + <xi:include href="Tracing.xml"/> + <xi:include href="DelayedDealloc.xml"/> + <xi:include href="beam_makeops.xml"/> + <xi:include href="CountingInstructions.xml"/> + <xi:include href="GarbageCollection.xml"/> + <xi:include href="PTables.xml"/> + <xi:include href="PortSignals.xml"/> + <xi:include href="ProcessManagementOptimizations.xml"/> + <xi:include href="SuperCarrier.xml"/> +</internal> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 248b871ca0..da470b51ec 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -31,6 +31,68 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 10.3.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Add missing documentation of new external tags + <c>NEW_PID</c>, <c>NEW_PORT</c> and + <c>NEWER_REFERENCE</c> introduced in OTP 19.</p> <p>These + new tags are planned to be "activated" in OTP 23 when + distribution capability flag <c>DFLAG_BIG_CREATION</c> + becomes mandatory. Older nodes (>= 19) are able to decode + these new tags and send them back to the new node. Nodes + older than OTP 23 will however never encode their own + local pids, ports and references using the new tags.</p> + <p> + Own Id: OTP-15766</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix <c>erlang:open_port/2</c> with the <c>fd</c> option + to correctly cleanup the pollset when the port is closed. + Before this fix there would be error printouts sent to + logger when the same fd was reused in a new port.</p> + <p> + Own Id: OTP-15753 Aux Id: ERL-900 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 10.3.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a bug in <c>seq_trace:reset_trace/0</c> that + could crash the emulator.</p> + <p> + Own Id: OTP-15704</p> + </item> + <item> + <p> + Fixed bug in <c>process_info(reductions)</c> causing it + to sometimes return invalid results.</p> + <p> + Own Id: OTP-15709 Aux Id: ERIERL-337 </p> + </item> + </list> + </section> + +</section> + <section><title>Erts 10.3.1</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -1960,6 +2022,62 @@ </section> +<section><title>Erts 9.3.3.10</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixes of install/release phase in build system.</p> + <list> <item>The source tree was modified when + installing/releasing and/or applying a patch.</item> + <item>Some files were installed with wrong access + rights.</item> <item>If applying a patch (using + <c>otp_patch_apply</c>) as another user (except root) + than the user that built the source, the documentation + was not properly updated.</item> </list> + <p> + Own Id: OTP-15551</p> + </item> + <item> + <p> + Minor fixes for <c>make clean</c>.</p> + <p> + Own Id: OTP-15657</p> + </item> + <item> + <p> + Fixed a bug in all <c>ets:select*</c> and + <c>ets:match*</c> functions that could in some rare cases + lead to very poor performance.</p> + <p> + Own Id: OTP-15660 Aux Id: ERL-869 </p> + </item> + <item> + <p> + Fix a possible deadlock when terminating the ERTS caused + by a dirty scheduler not releasing it's run-queue lock + when terminating.</p> + <p> + Own Id: OTP-15690 Aux Id: PR-2172 </p> + </item> + <item> + <p>Add missing documentation of new external tags + <c>NEW_PID</c>, <c>NEW_PORT</c> and + <c>NEWER_REFERENCE</c> introduced in OTP 19.</p> <p>These + new tags are planned to be "activated" in OTP 23 when + distribution capability flag <c>DFLAG_BIG_CREATION</c> + becomes mandatory. Older nodes (>= 19) are able to decode + these new tags and send them back to the new node. Nodes + older than OTP 23 will however never encode their own + local pids, ports and references using the new tags.</p> + <p> + Own Id: OTP-15766</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 9.3.3.9</title> <section><title>Improvements and New Features</title> @@ -8341,8 +8459,7 @@ 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> + see the User's Guide in the <em>ose</em> application.</p> <p> Note that not all parts of Erlang/OTP has been ported. </p> <p> @@ -9448,9 +9565,9 @@ <c>fix_alloc</c> allocator, a different strategy for management of fix blocks will be used.</item> <item>The information returned from <seealso - marker="erlang:system_info_allocator_tuple"><c>erlang:system_info({allocator, + marker="erlang#system_info_allocator_tuple"><c>erlang:system_info({allocator, A})</c></seealso>, and <seealso - marker="erlang:system_info_allocator_sizes"><c>erlang:system_info({allocator_sizes, + marker="erlang#system_info_allocator_sizes"><c>erlang:system_info({allocator_sizes, A})</c></seealso> will be slightly different when this feature has been enabled. An <c>mbcs_pool</c> tuple will be present giving information about abandoned carriers, @@ -10259,8 +10376,7 @@ information about signal ordering guarantees, see the chapter on <seealso marker="erts:communication">communication</seealso> in - the ERTS user's guide. The <seealso - marker="erts:erl#+n">+n</seealso> command line flag of + the ERTS user's guide. The <c>+n</c> command line flag of <seealso marker="erts:erl">erl(1)</seealso> can be helpful when trying to find signaling order bugs in Erlang code that have been exposed by these diff --git a/erts/doc/src/persistent_term.xml b/erts/doc/src/persistent_term.xml index 9d3c9afd80..672b00a83a 100644 --- a/erts/doc/src/persistent_term.xml +++ b/erts/doc/src/persistent_term.xml @@ -121,19 +121,6 @@ </section> <section> - <title>Warning For Many Persistent Terms</title> - <p>The runtime system will send a warning report to the - error logger if more than 20000 persistent terms have been - created. It will look like this:</p> - -<pre> -More than 20000 persistent terms have been created. -It is recommended to avoid creating an excessive number of -persistent terms, as creation and deletion of persistent terms -will be slower as the number of persistent terms increases.</pre> - </section> - - <section> <title>Best Practices for Using Persistent Terms</title> <p>It is recommended to use keys like <c>?MODULE</c> or diff --git a/erts/doc/src/tty.xml b/erts/doc/src/tty.xml index 51db1ba8e2..c33e082f4f 100644 --- a/erts/doc/src/tty.xml +++ b/erts/doc/src/tty.xml @@ -165,6 +165,10 @@ erl</pre> <cell align="left" valign="middle">C-y</cell> <cell align="left" valign="middle">Insert previously killed text</cell> </row> + <row> + <cell align="left" valign="middle">C-]</cell> + <cell align="left" valign="middle">Insert matching closing bracket</cell> + </row> <tcaption>tty Text Editing</tcaption> </table> </section> diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 21351df656..a9f3bb8e89 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -633,6 +633,15 @@ GENERATE += $(TTF_DIR)/driver_tab.c # This list must be consistent with PRE_LOADED_MODULES in # erts/preloaded/src/Makefile. +ifeq ($(USE_ESOCK), yes) +ESOCK_PRELOAD_BEAM = \ + $(ERL_TOP)/erts/preloaded/ebin/socket.beam \ + $(ERL_TOP)/erts/preloaded/ebin/net.beam +else +ESOCK_PRELOAD_BEAM = \ + $(ERL_TOP)/erts/preloaded/ebin/net.beam +endif + PRELOAD_BEAM = $(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \ $(ERL_TOP)/erts/preloaded/ebin/erl_init.beam \ $(ERL_TOP)/erts/preloaded/ebin/init.beam \ @@ -641,8 +650,7 @@ PRELOAD_BEAM = $(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \ $(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \ $(ERL_TOP)/erts/preloaded/ebin/zlib.beam \ - $(ERL_TOP)/erts/preloaded/ebin/socket.beam \ - $(ERL_TOP)/erts/preloaded/ebin/net.beam \ + $(ESOCK_PRELOAD_BEAM) \ $(ERL_TOP)/erts/preloaded/ebin/prim_zip.beam \ $(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \ $(ERL_TOP)/erts/preloaded/ebin/erlang.beam \ @@ -835,6 +843,15 @@ EMU_OBJS = \ $(OBJDIR)/beam_catches.o $(OBJDIR)/code_ix.o \ $(OBJDIR)/beam_ranges.o + +ifeq ($(USE_ESOCK), yes) + +# WE ARE USING ESOCK + +ESOCK_NIF_OBJS = \ + $(OBJDIR)/socket_nif.o \ + $(OBJDIR)/net_nif.o + ifneq ($(TARGET), win32) # These are *currently* only needed for non-win32, # since the nif-functions for socket and net are basically @@ -847,6 +864,16 @@ else ESOCK_RUN_OBJS = endif +else + +# WE ARE *NOT* USING ESOCK + +ESOCK_NIF_OBJS = +ESOCK_RUN_OBJS = + +endif + + RUN_OBJS += \ $(OBJDIR)/erl_alloc.o $(OBJDIR)/erl_mtrace.o \ $(OBJDIR)/erl_alloc_util.o $(OBJDIR)/erl_goodfit_alloc.o \ @@ -894,7 +921,7 @@ RUN_OBJS += \ $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o \ $(OBJDIR)/erl_msacc.o $(OBJDIR)/erl_lock_flags.o \ $(OBJDIR)/erl_io_queue.o $(OBJDIR)/erl_db_catree.o \ - $(ESOCK_RUN_OBJS) + $(ESOCK_RUN_OBJS) $(OBJDIR)/erl_flxctr.o LTTNG_OBJS = $(OBJDIR)/erlang_lttng.o @@ -903,8 +930,7 @@ NIF_OBJS = \ $(OBJDIR)/prim_buffer_nif.o \ $(OBJDIR)/prim_file_nif.o \ $(OBJDIR)/zlib_nif.o \ - $(OBJDIR)/socket_nif.o \ - $(OBJDIR)/net_nif.o + $(ESOCK_NIF_OBJS) ifeq ($(TARGET),win32) DRV_OBJS = \ diff --git a/erts/emulator/beam/arith_instrs.tab b/erts/emulator/beam/arith_instrs.tab index 5f23b2c168..f14b376419 100644 --- a/erts/emulator/beam/arith_instrs.tab +++ b/erts/emulator/beam/arith_instrs.tab @@ -51,11 +51,50 @@ plus.fetch(Op1, Op2) { plus.execute(Fail, Dst) { if (ERTS_LIKELY(is_both_small(PlusOp1, PlusOp2))) { +#ifdef HAVE_OVERFLOW_CHECK_BUILTINS + Sint lhs_tagged, rhs_untagged, res; + + /* The value part of immediate integers start right after the tag and + * occupy the rest of the word, so if you squint a bit they look like + * fixed-point integers; as long as you mask the tag away you will get + * correct results from addition/subtraction since they share the same + * notion of zero. It's fairly easy to see that the following holds + * when (a + b) is in range: + * + * (a >> s) + (b >> s) == ((a & ~m) + (b & ~m)) >> s + * + * Where 's' is the tag size and 'm' is the tag mask. + * + * The left-hand side is our fallback in the #else clause and is the + * fastest way to do this safely in plain C. The actual addition will + * never overflow since `Sint` has a much greater range than our + * smalls, so we can use the IS_SSMALL macro to see if the result is + * within range. + * + * What we're doing below is an extension of the right-hand side. By + * treating `a` and `b` as fixed-point integers, all additions whose + * result is out of range will also overflow `Sint` and we can use the + * compiler's overflow intrinsics to check for this condition. + * + * In addition, since the tag lives in the lowest bits we can further + * optimize this by only stripping the tag from either side. The higher + * bits can't influence the tag bits since we bail on overflow, so the + * tag bits from the tagged side will simply appear in the result. */ + lhs_tagged = PlusOp1; + rhs_untagged = PlusOp2 & ~_TAG_IMMED1_MASK; + + if (ERTS_LIKELY(!__builtin_add_overflow(lhs_tagged, rhs_untagged, &res))) { + ASSERT(is_small(res)); + $Dst = res; + $NEXT0(); + } +#else Sint i = signed_val(PlusOp1) + signed_val(PlusOp2); if (ERTS_LIKELY(IS_SSMALL(i))) { $Dst = make_small(i); $NEXT0(); } +#endif } $OUTLINED_ARITH_2($Fail, mixed_plus, BIF_splus_2, PlusOp1, PlusOp2, $Dst); } @@ -73,11 +112,26 @@ minus.fetch(Op1, Op2) { minus.execute(Fail, Dst) { if (ERTS_LIKELY(is_both_small(MinusOp1, MinusOp2))) { +#ifdef HAVE_OVERFLOW_CHECK_BUILTINS + Sint lhs_tagged, rhs_untagged, res; + + /* See plus.execute */ + lhs_tagged = MinusOp1; + rhs_untagged = MinusOp2 & ~_TAG_IMMED1_MASK; + + if (ERTS_LIKELY(!__builtin_sub_overflow(lhs_tagged, rhs_untagged, &res))) { + ASSERT(is_small(res)); + $Dst = res; + $NEXT0(); + } +#else Sint i = signed_val(MinusOp1) - signed_val(MinusOp2); + if (ERTS_LIKELY(IS_SSMALL(i))) { $Dst = make_small(i); $NEXT0(); } +#endif } $OUTLINED_ARITH_2($Fail, mixed_minus, BIF_sminus_2, MinusOp1, MinusOp2, $Dst); } @@ -97,12 +151,27 @@ increment.execute(IncrementVal, Dst) { Eterm result; if (ERTS_LIKELY(is_small(increment_reg_val))) { +#ifdef HAVE_OVERFLOW_CHECK_BUILTINS + Sint lhs_tagged, rhs_untagged, res; + + /* See plus.execute */ + lhs_tagged = increment_reg_val; + rhs_untagged = (Sint)increment_val << _TAG_IMMED1_SIZE; + + if (ERTS_LIKELY(!__builtin_add_overflow(lhs_tagged, rhs_untagged, &res))) { + ASSERT(is_small(res)); + $Dst = res; + $NEXT0(); + } +#else Sint i = signed_val(increment_reg_val) + increment_val; if (ERTS_LIKELY(IS_SSMALL(i))) { $Dst = make_small(i); $NEXT0(); } +#endif } + result = erts_mixed_plus(c_p, increment_reg_val, make_small(increment_val)); ERTS_HOLE_CHECK(c_p); if (ERTS_LIKELY(is_value(result))) { @@ -118,11 +187,15 @@ i_times(Fail, Op1, Op2, Dst) { Eterm op2 = $Op2; #ifdef HAVE_OVERFLOW_CHECK_BUILTINS if (ERTS_LIKELY(is_both_small(op1, op2))) { - Sint a = signed_val(op1); - Sint b = signed_val(op2); - Sint res; - if (ERTS_LIKELY(!__builtin_mul_overflow(a, b, &res) && IS_SSMALL(res))) { - $Dst = make_small(res); + /* See plus.execute */ + Sint lhs_untagged, rhs_actual, res; + + lhs_untagged = op1 & ~_TAG_IMMED1_MASK; + rhs_actual = signed_val(op2); + + if (ERTS_LIKELY(!__builtin_mul_overflow(lhs_untagged, rhs_actual, &res))) { + ASSERT(!(res & _TAG_IMMED1_MASK)); + $Dst = res | _TAG_IMMED1_SMALL; $NEXT0(); } } diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 762c5da9be..4d52435139 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -353,6 +353,22 @@ erts_debug_disassemble_1(BIF_ALIST_1) return TUPLE3(hp, addr, bin, mfa); } +BIF_RETTYPE +erts_debug_interpreter_size_0(BIF_ALIST_0) +{ + int i; + BeamInstr low, high; + + low = high = (BeamInstr) process_main; + for (i = 0; i < NUM_SPECIFIC_OPS; i++) { + BeamInstr a = BeamOpCodeAddr(i); + if (a > high) { + high = a; + } + } + return erts_make_integer(high - low, BIF_P); +} + void dbg_bt(Process* p, Eterm* sp) { diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index f1d8609066..8e93e53003 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -375,44 +375,33 @@ do { \ /* * process_main() is already huge, so we want to avoid inlining - * into it. Especially functions that are seldom used. + * seldom used functions into it. */ -#ifdef __GNUC__ -# define NOINLINE __attribute__((__noinline__)) -#else -# define NOINLINE -#endif - - -/* - * The following functions are called directly by process_main(). - * Don't inline them. - */ -static void init_emulator_finish(void) NOINLINE; -static ErtsCodeMFA *ubif2mfa(void* uf) NOINLINE; +static void init_emulator_finish(void) ERTS_NOINLINE; +static ErtsCodeMFA *ubif2mfa(void* uf) ERTS_NOINLINE; static BeamInstr* handle_error(Process* c_p, BeamInstr* pc, - Eterm* reg, ErtsCodeMFA* bif_mfa) NOINLINE; + Eterm* reg, ErtsCodeMFA* bif_mfa) ERTS_NOINLINE; static BeamInstr* call_error_handler(Process* p, ErtsCodeMFA* mfa, - Eterm* reg, Eterm func) NOINLINE; + Eterm* reg, Eterm func) ERTS_NOINLINE; static BeamInstr* fixed_apply(Process* p, Eterm* reg, Uint arity, - BeamInstr *I, Uint offs) NOINLINE; + BeamInstr *I, Uint offs) ERTS_NOINLINE; static BeamInstr* apply(Process* p, Eterm* reg, - BeamInstr *I, Uint offs) NOINLINE; + BeamInstr *I, Uint offs) ERTS_NOINLINE; static BeamInstr* call_fun(Process* p, int arity, - Eterm* reg, Eterm args) NOINLINE; + Eterm* reg, Eterm args) ERTS_NOINLINE; static BeamInstr* apply_fun(Process* p, Eterm fun, - Eterm args, Eterm* reg) NOINLINE; + Eterm args, Eterm* reg) ERTS_NOINLINE; static Eterm new_fun(Process* p, Eterm* reg, - ErlFunEntry* fe, int num_free) NOINLINE; + ErlFunEntry* fe, int num_free) ERTS_NOINLINE; static int is_function2(Eterm Term, Uint arity); static Eterm erts_gc_new_map(Process* p, Eterm* reg, Uint live, - Uint n, BeamInstr* ptr) NOINLINE; + Uint n, BeamInstr* ptr) ERTS_NOINLINE; static Eterm erts_gc_new_small_map_lit(Process* p, Eterm* reg, Eterm keys_literal, - Uint live, BeamInstr* ptr) NOINLINE; + Uint live, BeamInstr* ptr) ERTS_NOINLINE; static Eterm erts_gc_update_map_assoc(Process* p, Eterm* reg, Uint live, - Uint n, BeamInstr* new_p) NOINLINE; + Uint n, BeamInstr* new_p) ERTS_NOINLINE; static Eterm erts_gc_update_map_exact(Process* p, Eterm* reg, Uint live, - Uint n, Eterm* new_p) NOINLINE; + Uint n, Eterm* new_p) ERTS_NOINLINE; static Eterm get_map_element(Eterm map, Eterm key); static Eterm get_map_element_hash(Eterm map, Eterm key, Uint32 hx); @@ -3267,20 +3256,23 @@ erts_is_builtin(Eterm Mod, Eterm Name, int arity) /* - * Return the current number of reductions for the given process. + * Return the current number of reductions consumed by the given process. * To get the total number of reductions, p->reds must be added. */ Uint -erts_current_reductions(Process *current, Process *p) +erts_current_reductions(Process *c_p, Process *p) { - if (current != p) { + Sint reds_left; + if (c_p != p || !(erts_atomic32_read_nob(&c_p->state) + & ERTS_PSFLG_RUNNING)) { return 0; - } else if (current->fcalls < 0 && ERTS_PROC_GET_SAVED_CALLS_BUF(current)) { - return current->fcalls + CONTEXT_REDS; + } else if (c_p->fcalls < 0 && ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { + reds_left = c_p->fcalls + CONTEXT_REDS; } else { - return REDS_IN(current) - current->fcalls; + reds_left = c_p->fcalls; } + return REDS_IN(c_p) - reds_left; } int diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 69e49e97f3..941c3ebbbe 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -3354,19 +3354,12 @@ gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, NATIVE_ENDIAN(Flags); if (Size.type == TAG_a && Size.val == am_all) { - if (Ms.type == Dst.type && Ms.val == Dst.val) { - GENOP_NAME_ARITY(op, i_bs_get_binary_all_reuse, 3); - op->a[0] = Ms; - op->a[1] = Fail; - op->a[2] = Unit; - } else { - GENOP_NAME_ARITY(op, i_bs_get_binary_all2, 5); - op->a[0] = Ms; - op->a[1] = Fail; - op->a[2] = Live; - op->a[3] = Unit; - op->a[4] = Dst; - } + GENOP_NAME_ARITY(op, i_bs_get_binary_all2, 5); + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Live; + op->a[3] = Unit; + op->a[4] = Dst; } else if (Size.type == TAG_i) { GENOP_NAME_ARITY(op, i_bs_get_binary_imm2, 6); op->a[0] = Ms; diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index d0e2d9afc2..b81056c774 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1915,7 +1915,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm return_term, Eterm *refp, erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "Discarding message %T from %T to %T in an old " - "incarnation (%u) of this node (%u)\n", + "incarnation (%d) of this node (%d)\n", msg, p->common.id, to, @@ -1959,7 +1959,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm return_term, Eterm *refp, erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "Discarding message %T from %T to %T in an old " - "incarnation (%u) of this node (%u)\n", + "incarnation (%d) of this node (%d)\n", msg, p->common.id, to, diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 34a0be4f2d..db9c258cb7 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -437,6 +437,7 @@ bif erts_debug:set_internal_state/2 bif erts_debug:display/1 bif erts_debug:dist_ext_to_term/2 bif erts_debug:instructions/0 +bif erts_debug:interpreter_size/0 bif erts_debug:dirty_cpu/2 bif erts_debug:dirty_io/2 bif erts_debug:dirty/3 diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 7666f23a4f..522f50287a 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -2176,24 +2176,6 @@ term_to_Uint64(Eterm term, Uint64 *up) #endif } -int -term_to_Uint32(Eterm term, Uint32 *up) -{ -#if ERTS_SIZEOF_ETERM == 4 - return term_to_Uint(term,up); -#else - if (is_small(term)) { - Sint i = signed_val(term); - if (i >= 0) { - *up = (Uint32) i; - return 1; - } - } - *up = BADARG; - return 0; -#endif -} - int term_to_Sint(Eterm term, Sint *sp) { diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index 3fed076419..ad19cce395 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -168,8 +168,6 @@ Eterm erts_uint64_array_to_big(Uint **, int, int, Uint64 *); int term_to_Uint64(Eterm, Uint64*); int term_to_Sint64(Eterm, Sint64*); #endif -int term_to_Uint32(Eterm, Uint32*); - Uint32 big_to_uint32(Eterm b); int term_equals_2pow32(Eterm); diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 06d8c7cda8..80e871aaf6 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -394,8 +394,12 @@ print_process_info(fmtfn_t to, void *to_arg, Process *p, ErtsProcLocks orig_lock erts_print(to, to_arg, "OldBinVHeap: %b64u\n", BIN_OLD_VHEAP(p)); erts_print(to, to_arg, "BinVHeap unused: %b64u\n", BIN_VHEAP_SZ(p) - p->off_heap.overhead); - erts_print(to, to_arg, "OldBinVHeap unused: %b64u\n", - BIN_OLD_VHEAP_SZ(p) - BIN_OLD_VHEAP(p)); + if (BIN_OLD_VHEAP_SZ(p) >= BIN_OLD_VHEAP(p)) { + erts_print(to, to_arg, "OldBinVHeap unused: %b64u\n", + BIN_OLD_VHEAP_SZ(p) - BIN_OLD_VHEAP(p)); + } else { + erts_print(to, to_arg, "OldBinVHeap unused: overflow\n"); + } erts_print(to, to_arg, "Memory: %beu\n", erts_process_memory(p, !0)); if (garbing) { diff --git a/erts/emulator/beam/bs_instrs.tab b/erts/emulator/beam/bs_instrs.tab index 652460a66d..bd1ad91e45 100644 --- a/erts/emulator/beam/bs_instrs.tab +++ b/erts/emulator/beam/bs_instrs.tab @@ -125,7 +125,7 @@ BS_GET_UNCHECKED_FIELD_SIZE(Bits, Unit, Fail, Dst) { TEST_BIN_VHEAP(VNh, Nh, Live) { Uint need = $Nh; if (E - HTOP < need || MSO(c_p).overhead + $VNh >= BIN_VHEAP_SZ(c_p)) { - SWAPOUT; + $GC_SWAPOUT(); PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live, FCALLS); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -1136,7 +1136,6 @@ i_bs_get_utf16.execute(Fail, Flags, Dst) { } bs_context_to_binary := ctx_to_bin.fetch.execute; -i_bs_get_binary_all_reuse := ctx_to_bin.fetch_bin.execute; ctx_to_bin.head() { Eterm context; @@ -1159,16 +1158,6 @@ ctx_to_bin.fetch(Src) { } } -ctx_to_bin.fetch_bin(Src, Fail, Unit) { - context = $Src; - mb = ms_matchbuffer(context); - size = mb->size - mb->offset; - if (size % $Unit != 0) { - $FAIL($Fail); - } - offs = mb->offset; -} - ctx_to_bin.execute() { Uint hole_size; Uint orig = mb->orig; diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 8bbe6450eb..ff19ef018e 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -55,7 +55,6 @@ */ #if 0 #define ERTS_DIST_MSG_DBG -FILE *dbg_file; #endif #if 0 /* Enable this to print the dist debug messages to a file instead */ @@ -67,6 +66,7 @@ FILE *dbg_file; #endif #if defined(ERTS_DIST_MSG_DBG) || defined(ERTS_RAW_DIST_MSG_DBG) +FILE *dbg_file; static void bw(byte *buf, ErlDrvSizeT sz) { bin_write(ERTS_PRINT_FILE, dbg_file, buf, sz); @@ -743,7 +743,7 @@ void init_dist(void) sprintf(buff, ERTS_DIST_MSG_DBG_FILE, getpid()); dbg_file = fopen(buff,"w+"); } -#elif defined (ERTS_DIST_MSG_DBG) +#elif defined(ERTS_DIST_MSG_DBG) || defined(ERTS_RAW_DIST_MSG_DBG) dbg_file = stderr; #endif @@ -775,19 +775,25 @@ void init_dist(void) static ERTS_INLINE ErtsDistOutputBuf * alloc_dist_obuf(Uint size, Uint headers) { - int i; + Uint obuf_size = sizeof(ErtsDistOutputBuf)*(headers); ErtsDistOutputBuf *obuf; - Uint obuf_size = sizeof(ErtsDistOutputBuf)*(headers) + - sizeof(byte)*size; - Binary *bin = erts_bin_drv_alloc(obuf_size); - obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[size]; + Binary *bin; + byte *extp; + int i; + + bin = erts_bin_drv_alloc(obuf_size + size); erts_refc_add(&bin->intern.refc, headers - 1, 1); + + obuf = (ErtsDistOutputBuf *)&bin->orig_bytes[0]; + extp = (byte *)&bin->orig_bytes[obuf_size]; + for (i = 0; i < headers; i++) { obuf[i].bin = bin; - obuf[i].extp = (byte *)&bin->orig_bytes[0]; + obuf[i].extp = extp; #ifdef DEBUG obuf[i].dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN; - obuf[i].alloc_endp = obuf->extp + size; + obuf[i].ext_startp = extp; + obuf[i].alloc_endp = &extp[size]; ASSERT(bin == ErtsDistOutputBuf2Binary(obuf)); #endif } @@ -1360,7 +1366,7 @@ erts_dist_seq_tree_foreach_delete_yielding(DistSeqNode **root, limit); if (res > 0) { if (ysp != &ys) - erts_free(ERTS_ALC_T_ML_YIELD_STATE, ysp); + erts_free(ERTS_ALC_T_SEQ_YIELD_STATE, ysp); *vyspp = NULL; } else { @@ -1838,7 +1844,7 @@ int erts_net_message(Port *prt, if (locks) erts_proc_unlock(rp, locks); - } else if (ede_hfrag) { + } else if (ede_hfrag != NULL) { erts_free_dist_ext_copy(erts_get_dist_ext(ede_hfrag)); free_message_buffer(ede_hfrag); } @@ -1880,16 +1886,18 @@ int erts_net_message(Port *prt, goto invalid_message; } rp = erts_proc_lookup(to); + if (rp) { ErtsProcLocks locks = 0; erts_queue_dist_message(rp, locks, edep, ede_hfrag, token, am_Empty); if (locks) erts_proc_unlock(rp, locks); - } else if (ede_hfrag) { + } else if (ede_hfrag != NULL) { erts_free_dist_ext_copy(erts_get_dist_ext(ede_hfrag)); free_message_buffer(ede_hfrag); } + break; } @@ -1930,15 +1938,19 @@ int erts_net_message(Port *prt, goto invalid_message; } - if (!erts_proc_lookup(watcher)) break; /* Process not alive */ - - if (reason == THE_NON_VALUE) { + if (!erts_proc_lookup(watcher)) { + if (ede_hfrag != NULL) { + erts_free_dist_ext_copy(erts_get_dist_ext(ede_hfrag)); + free_message_buffer(ede_hfrag); + } + break; /* Process not alive */ + } #ifdef ERTS_DIST_MSG_DBG + if (reason == THE_NON_VALUE) { dist_msg_dbg(edep, "MSG", buf, orig_len); -#endif - } +#endif erts_proc_sig_send_dist_monitor_down( dep, ref, watched, watcher, edep, ede_hfrag, reason); @@ -1987,13 +1999,19 @@ int erts_net_message(Port *prt, goto invalid_message; } - if (!erts_proc_lookup(to)) break; /* Process not alive */ + if (!erts_proc_lookup(to)) { + if (ede_hfrag != NULL) { + erts_free_dist_ext_copy(erts_get_dist_ext(ede_hfrag)); + free_message_buffer(ede_hfrag); + } + break; /* Process not alive */ + } - if (reason == THE_NON_VALUE) { #ifdef ERTS_DIST_MSG_DBG + if (reason == THE_NON_VALUE) { dist_msg_dbg(edep, "MSG", buf, orig_len); -#endif } +#endif erts_proc_sig_send_dist_link_exit(dep, from, to, edep, ede_hfrag, @@ -2042,13 +2060,19 @@ int erts_net_message(Port *prt, goto invalid_message; } - if (!erts_proc_lookup(to)) break; /* Process not alive */ + if (!erts_proc_lookup(to)) { + if (ede_hfrag != NULL) { + erts_free_dist_ext_copy(erts_get_dist_ext(ede_hfrag)); + free_message_buffer(ede_hfrag); + } + break; /* Process not alive */ + } - if (reason == THE_NON_VALUE) { #ifdef ERTS_DIST_MSG_DBG + if (reason == THE_NON_VALUE) { dist_msg_dbg(edep, "MSG", buf, orig_len); -#endif } +#endif erts_proc_sig_send_dist_exit(dep, from, to, edep, ede_hfrag, reason, token); break; @@ -2301,8 +2325,18 @@ erts_dsig_send(ErtsDSigSendContext *ctx) ctx->data_size = ctx->max_finalize_prepend; erts_reset_atom_cache_map(ctx->acmp); - erts_encode_dist_ext_size(ctx->ctl, ctx->flags, ctx->acmp, &ctx->data_size); + switch (erts_encode_dist_ext_size(ctx->ctl, ctx->flags, + ctx->acmp, &ctx->data_size)) { + case ERTS_EXT_SZ_OK: + break; + case ERTS_EXT_SZ_SYSTEM_LIMIT: + retval = ERTS_DSIG_SEND_TOO_LRG; + goto done; + case ERTS_EXT_SZ_YIELD: + ERTS_INTERNAL_ERROR("Unexpected yield result"); + break; + } if (is_non_value(ctx->msg)) { ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC; break; @@ -2312,17 +2346,31 @@ erts_dsig_send(ErtsDSigSendContext *ctx) ctx->u.sc.level = 0; ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_SIZE; - case ERTS_DSIG_SEND_PHASE_MSG_SIZE: - if (!ctx->no_trap) { - if (erts_encode_dist_ext_size_int(ctx->msg, ctx, &ctx->data_size)) { - retval = ERTS_DSIG_SEND_CONTINUE; - goto done; - } - } else { - erts_encode_dist_ext_size(ctx->msg, ctx->flags, ctx->acmp, &ctx->data_size); + case ERTS_DSIG_SEND_PHASE_MSG_SIZE: { + ErtsExtSzRes sz_res; + sz_res = (!ctx->no_trap + ? erts_encode_dist_ext_size_ctx(ctx->msg, + ctx, + &ctx->data_size) + : erts_encode_dist_ext_size(ctx->msg, + ctx->flags, + ctx->acmp, + &ctx->data_size)); + switch (sz_res) { + case ERTS_EXT_SZ_OK: + break; + case ERTS_EXT_SZ_SYSTEM_LIMIT: + retval = ERTS_DSIG_SEND_TOO_LRG; + goto done; + case ERTS_EXT_SZ_YIELD: + if (ctx->no_trap) + ERTS_INTERNAL_ERROR("Unexpected yield result"); + retval = ERTS_DSIG_SEND_CONTINUE; + goto done; } ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC; + } case ERTS_DSIG_SEND_PHASE_ALLOC: erts_finalize_atom_cache_map(ctx->acmp, ctx->flags); @@ -2341,7 +2389,8 @@ erts_dsig_send(ErtsDSigSendContext *ctx) (ctx->fragments-1) * ERTS_DIST_FRAGMENT_HEADER_SIZE, ctx->fragments); ctx->obuf->ext_start = &ctx->obuf->extp[0]; - ctx->obuf->ext_endp = &ctx->obuf->extp[0] + ctx->max_finalize_prepend + ctx->dhdr_ext_size; + ctx->obuf->ext_endp = &ctx->obuf->extp[0] + ctx->max_finalize_prepend + + ctx->dhdr_ext_size; /* Encode internal version of dist header */ ctx->obuf->extp = erts_encode_ext_dist_header_setup( @@ -2380,8 +2429,8 @@ erts_dsig_send(ErtsDSigSendContext *ctx) case ERTS_DSIG_SEND_PHASE_FIN: { ASSERT(ctx->obuf->extp < ctx->obuf->ext_endp); - ASSERT(((byte*)&ctx->obuf->bin->orig_bytes[0]) <= ctx->obuf->extp - ctx->max_finalize_prepend); - ASSERT(ctx->obuf->ext_endp <= ((byte*)ctx->obuf->bin->orig_bytes) + ctx->data_size + ctx->dhdr_ext_size); + ASSERT(ctx->obuf->ext_startp <= ctx->obuf->extp - ctx->max_finalize_prepend); + ASSERT(ctx->obuf->ext_endp <= (byte*)ctx->obuf->ext_startp + ctx->data_size + ctx->dhdr_ext_size); ctx->data_size = ctx->obuf->ext_endp - ctx->obuf->extp; @@ -3424,6 +3473,8 @@ dist_ctrl_get_data_1(BIF_ALIST_1) obufsize -= size_obuf(obuf); if (reds < 0) { erts_de_runlock(dep); + if (obufsize) + erts_atomic_add_nob(&dep->qsize, (erts_aint_t) -obufsize); ERTS_BIF_YIELD1(bif_export[BIF_dist_ctrl_get_data_1], BIF_P, BIF_ARG_1); } @@ -3457,6 +3508,7 @@ dist_ctrl_get_data_1(BIF_ALIST_1) pb->bytes = (byte*) obuf->extp; pb->flags = 0; res = make_binary(pb); + hp += PROC_BIN_SIZE; } else { hp = HAlloc(BIF_P, PROC_BIN_SIZE * 2 + 4 + hsz); pb = (ProcBin *) (char *) hp; @@ -3748,10 +3800,12 @@ int distribution_info(fmtfn_t to, void *arg) /* Called by break handler */ BIF_RETTYPE setnode_2(BIF_ALIST_2) { Process *net_kernel; - Uint32 creation; + Uint creation; /* valid creation ? */ - if(!term_to_Uint32(BIF_ARG_2, &creation)) + if(!term_to_Uint(BIF_ARG_2, &creation)) + goto error; + if(creation > 3) goto error; /* valid node name ? */ @@ -3795,7 +3849,7 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2) erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_thr_progress_block(); inc_no_nodes(); - erts_set_this_node(BIF_ARG_1, creation); + erts_set_this_node(BIF_ARG_1, (Uint32) creation); erts_is_alive = 1; send_nodes_mon_msgs(NULL, am_nodeup, BIF_ARG_1, am_visible, NIL); erts_thr_progress_unblock(); diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index f953a2ab8c..067028634b 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -54,12 +54,11 @@ #define DFLAG_DIST_MANDATORY (DFLAG_EXTENDED_REFERENCES \ | DFLAG_EXTENDED_PIDS_PORTS \ | DFLAG_UTF8_ATOMS \ - | DFLAG_NEW_FUN_TAGS \ - | DFLAG_BIG_CREATION) + | DFLAG_NEW_FUN_TAGS) /* * Additional optimistic flags when encoding toward pending connection. - * If remote node (erl_interface) does not support these then we may need + * If remote node (erl_interface) does not supporting these then we may need * to transcode messages enqueued before connection setup was finished. */ #define DFLAG_DIST_HOPEFULLY (DFLAG_EXPORT_PTR_TAG \ @@ -76,6 +75,7 @@ | DFLAG_SMALL_ATOM_TAGS \ | DFLAG_UTF8_ATOMS \ | DFLAG_MAP_TAG \ + | DFLAG_BIG_CREATION \ | DFLAG_SEND_SENDER \ | DFLAG_BIG_SEQTRACE_LABELS \ | DFLAG_EXIT_PAYLOAD \ diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index e6169ebeaa..b9f0334172 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -3904,7 +3904,7 @@ check_memory_fence(void *ptr, Uint *size, ErtsAlcType_t n, int func) { Uint sz; Uint found_type; - UWord pre_pattern; + UWord pre_pattern, expected_pattern; UWord post_pattern; UWord *ui_ptr; #ifdef HARD_DEBUG @@ -3914,6 +3914,8 @@ check_memory_fence(void *ptr, Uint *size, ErtsAlcType_t n, int func) if (!ptr) return NULL; + expected_pattern = MK_PATTERN(n); + ui_ptr = (UWord *) ptr; pre_pattern = *(--ui_ptr); *size = sz = *(--ui_ptr); @@ -3922,7 +3924,13 @@ check_memory_fence(void *ptr, Uint *size, ErtsAlcType_t n, int func) #endif found_type = GET_TYPE_OF_PATTERN(pre_pattern); - if (pre_pattern != MK_PATTERN(n)) { + + if (found_type != n) { + erts_exit(ERTS_ABORT_EXIT, "ERROR: Miss matching allocator types" + " used in alloc and free\n"); + } + + if (pre_pattern != expected_pattern) { if ((FIXED_FENCE_PATTERN_MASK & pre_pattern) != FIXED_FENCE_PATTERN) erts_exit(ERTS_ABORT_EXIT, "ERROR: Fence at beginning of memory block (p=0x%u) " @@ -3932,8 +3940,7 @@ check_memory_fence(void *ptr, Uint *size, ErtsAlcType_t n, int func) sys_memcpy((void *) &post_pattern, (void *) (((char *)ptr)+sz), sizeof(UWord)); - if (post_pattern != MK_PATTERN(n) - || pre_pattern != post_pattern) { + if (post_pattern != expected_pattern || pre_pattern != post_pattern) { char fbuf[10]; char obuf[10]; char *ftype; diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index e7329daa2d..92e5069c71 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -282,6 +282,7 @@ type ENVIRONMENT SYSTEM SYSTEM environment type PERSISTENT_TERM LONG_LIVED CODE persisten_term type PERSISTENT_LOCK_Q SHORT_LIVED SYSTEM persistent_lock_q +type PERSISTENT_TERM_TMP SHORT_LIVED SYSTEM persistent_term_tmp_table # # Types used for special emulators diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 8d4464969a..25ac3bc5af 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -6567,6 +6567,14 @@ erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) __FILE__, __LINE__); } + /* The various fields packed into the header word must not overlap */ + ERTS_CT_ASSERT(!(MBC_ABLK_OFFSET_MASK & MBC_ABLK_SZ_MASK)); + ERTS_CT_ASSERT(!(MBC_ABLK_OFFSET_MASK & BLK_FLG_MASK)); + ERTS_CT_ASSERT(!(MBC_ABLK_SZ_MASK & BLK_FLG_MASK)); + ERTS_CT_ASSERT(!(MBC_FBLK_SZ_MASK & BLK_FLG_MASK)); + ERTS_CT_ASSERT(!(SBC_BLK_SZ_MASK & BLK_FLG_MASK)); + ERTS_CT_ASSERT(!(CRR_SZ_MASK & CRR_FLG_MASK)); + if (!initialized) goto error; diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index ea1afe8f58..b46b311c59 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -334,8 +334,11 @@ void erts_alcu_sched_spec_data_init(struct ErtsSchedulerData_ *esdp); #endif #if MBC_ABLK_OFFSET_BITS -# define MBC_ABLK_OFFSET_SHIFT (sizeof(UWord)*8 - MBC_ABLK_OFFSET_BITS) -# define MBC_ABLK_OFFSET_MASK ((~((UWord)0) << MBC_ABLK_OFFSET_SHIFT) & ~BLK_FLG_MASK) +/* The shift is reduced by 1 since the highest bit is used for a flag. */ +# define MBC_ABLK_OFFSET_SHIFT (sizeof(UWord)*8 - 1 - MBC_ABLK_OFFSET_BITS) +# define MBC_ABLK_OFFSET_MASK \ + (((UWORD_CONSTANT(1) << MBC_ABLK_OFFSET_BITS) - UWORD_CONSTANT(1)) \ + << MBC_ABLK_OFFSET_SHIFT) # define MBC_ABLK_SZ_MASK (~MBC_ABLK_OFFSET_MASK & ~BLK_FLG_MASK) #else # define MBC_ABLK_SZ_MASK (~BLK_FLG_MASK) diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index a7424bbcb8..0339589b79 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -2579,6 +2579,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) /* Need to be the only thread running... */ erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_P->scheduler_data->current_process = NULL; erts_thr_progress_block(); if (BIF_ARG_1 == am_info) @@ -2592,6 +2593,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) erts_thr_progress_unblock(); erts_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_P->scheduler_data->current_process = BIF_P; ASSERT(dsbufp && dsbufp->str); res = new_binary(BIF_P, (byte *) dsbufp->str, dsbufp->str_len); @@ -2797,10 +2799,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) } else if (BIF_ARG_1 == am_threads) { return am_true; } else if (BIF_ARG_1 == am_creation) { - Uint hsz = 0; - erts_bld_uint(NULL, &hsz, erts_this_node->creation); - hp = hsz ? HAlloc(BIF_P, hsz) : NULL; - BIF_RET(erts_bld_uint(&hp, NULL, erts_this_node->creation)); + return make_small(erts_this_node->creation); } else if (BIF_ARG_1 == am_break_ignored) { extern int ignore_break; if (ignore_break) @@ -3026,6 +3025,8 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) BIF_RET(erts_nif_taints(BIF_P)); } else if (ERTS_IS_ATOM_STR("reader_groups_map", BIF_ARG_1)) { BIF_RET(erts_get_reader_groups_map(BIF_P)); + } else if (ERTS_IS_ATOM_STR("decentralized_counter_groups_map", BIF_ARG_1)) { + BIF_RET(erts_get_decentralized_counter_groups_map(BIF_P)); } else if (ERTS_IS_ATOM_STR("dist_buf_busy_limit", BIF_ARG_1)) { Uint hsz = 0; @@ -4235,7 +4236,10 @@ BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) Uint dflags = (TERM_TO_BINARY_DFLAGS & ~DFLAG_EXPORT_PTR_TAG & ~DFLAG_BIT_BINARIES); - BIF_RET(erts_term_to_binary(BIF_P, tp[2], 0, dflags)); + Eterm res = erts_term_to_binary(BIF_P, tp[2], 0, dflags); + if (is_value(res)) + BIF_RET(res); + BIF_ERROR(BIF_P, SYSTEM_LIMIT); } else if (ERTS_IS_ATOM_STR("dist_ctrl", tp[1])) { Eterm res = am_undefined; @@ -4692,6 +4696,14 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) BIF_RET(am_ok); } } + else if (ERTS_IS_ATOM_STR("ets_debug_random_split_join", BIF_ARG_1)) { + if (is_tuple(BIF_ARG_2)) { + Eterm* tpl = tuple_val(BIF_ARG_2); + + if (erts_ets_debug_random_split_join(tpl[1], tpl[2] == am_true)) + BIF_RET(am_ok); + } + } else if (ERTS_IS_ATOM_STR("mbuf", BIF_ARG_1)) { Uint sz = size_object(BIF_ARG_2); ErlHeapFragment* frag = new_message_buffer(sz); diff --git a/erts/emulator/beam/erl_bif_persistent.c b/erts/emulator/beam/erl_bif_persistent.c index 5a78a043ce..f38e0cc5cb 100644 --- a/erts/emulator/beam/erl_bif_persistent.c +++ b/erts/emulator/beam/erl_bif_persistent.c @@ -37,15 +37,6 @@ #include "erl_binary.h" /* - * The limit for the number of persistent terms before - * a warning is issued. - */ - -#define WARNING_LIMIT 20000 -#define XSTR(s) STR(s) -#define STR(s) #s - -/* * Parameters for the hash table. */ #define INITIAL_SIZE 8 @@ -73,14 +64,69 @@ typedef struct trap_data { Uint memory; /* Used by info/0 to count used memory */ } TrapData; +typedef enum { + ERTS_PERSISTENT_TERM_CPY_PLACE_START, + ERTS_PERSISTENT_TERM_CPY_PLACE_1, + ERTS_PERSISTENT_TERM_CPY_PLACE_2, + ERTS_PERSISTENT_TERM_CPY_PLACE_3 +} ErtsPersistentTermCpyTableLocation; + +typedef enum { + ERTS_PERSISTENT_TERM_CPY_NO_REHASH = 0, + ERTS_PERSISTENT_TERM_CPY_REHASH = 1, + ERTS_PERSISTENT_TERM_CPY_TEMP = 2 +} ErtsPersistentTermCpyTableType; + +typedef struct { + HashTable* old_table; /* in param */ + Uint new_size; /* in param */ + ErtsPersistentTermCpyTableType copy_type; /* in param */ + Uint max_iterations; /* in param */ + ErtsPersistentTermCpyTableLocation location; /* in/out param */ + Uint iterations_done; /* in/out param */ + Uint total_iterations_done; /* in/out param */ + HashTable* new_table; /* out param */ +} ErtsPersistentTermCpyTableCtx; + +typedef enum { + PUT2_TRAP_LOCATION_NEW_KEY, + PUT2_TRAP_LOCATION_REPLACE_VALUE +} ErtsPersistentTermPut2TrapLocation; + +typedef struct { + ErtsPersistentTermPut2TrapLocation trap_location; + Eterm key; + Eterm term; + Uint entry_index; + HashTable* hash_table; + Eterm heap[3]; + Eterm tuple; + ErtsPersistentTermCpyTableCtx cpy_ctx; +} ErtsPersistentTermPut2Context; + +typedef enum { + ERASE1_TRAP_LOCATION_TMP_COPY, + ERASE1_TRAP_LOCATION_FINAL_COPY +} ErtsPersistentTermErase1TrapLocation; + +typedef struct { + ErtsPersistentTermErase1TrapLocation trap_location; + Eterm key; + HashTable* old_table; + HashTable* new_table; + Uint entry_index; + Eterm old_term; + HashTable* tmp_table; + ErtsPersistentTermCpyTableCtx cpy_ctx; +} ErtsPersistentTermErase1Context; + /* * Declarations of local functions. */ static HashTable* create_initial_table(void); static Uint lookup(HashTable* hash_table, Eterm key); -static HashTable* copy_table(HashTable* old_table, Uint new_size, int rehash); -static HashTable* tmp_table_copy(HashTable* old_table); +static HashTable* copy_table(ErtsPersistentTermCpyTableCtx* ctx); static int try_seize_update_permission(Process* c_p); static void release_update_permission(int release_updater); static void table_updater(void* table); @@ -127,7 +173,6 @@ static Process* updater_process = NULL; /* Protected by update_table_permission_mtx */ static ErtsThrPrgrLaterOp thr_prog_op; -static int issued_warning = 0; /* * Queue of hash tables to be deleted. @@ -139,7 +184,7 @@ static HashTable** delete_queue_tail = &delete_queue_head; /* * The following variables are only used during crash dumping. They - * are intialized by erts_init_persistent_dumping(). + * are initialized by erts_init_persistent_dumping(). */ ErtsLiteralArea** erts_persistent_areas; @@ -188,101 +233,181 @@ void erts_init_bif_persistent_term(void) &persistent_term_info_trap); } +/* + * Macro used for trapping in persistent_term_put_2 and + * persistent_term_erase_1 + */ +#define TRAPPING_COPY_TABLE(TABLE_DEST, OLD_TABLE, NEW_SIZE, COPY_TYPE, LOC_NAME, TRAP_CODE) \ + do { \ + ctx->cpy_ctx = (ErtsPersistentTermCpyTableCtx){ \ + .old_table = OLD_TABLE, \ + .new_size = NEW_SIZE, \ + .copy_type = COPY_TYPE, \ + .location = ERTS_PERSISTENT_TERM_CPY_PLACE_START \ + }; \ + L_ ## LOC_NAME: \ + ctx->cpy_ctx.max_iterations = MAX(1, max_iterations); \ + TABLE_DEST = copy_table(&ctx->cpy_ctx); \ + iterations_until_trap -= ctx->cpy_ctx.total_iterations_done; \ + if (TABLE_DEST == NULL) { \ + ctx->trap_location = LOC_NAME; \ + erts_set_gc_state(BIF_P, 0); \ + BUMP_ALL_REDS(BIF_P); \ + TRAP_CODE; \ + } \ + } while (0) + +static int persistent_term_put_2_ctx_bin_dtor(Binary *context_bin) +{ + ErtsPersistentTermPut2Context* ctx = ERTS_MAGIC_BIN_DATA(context_bin); + if (ctx->cpy_ctx.new_table != NULL) { + erts_free(ERTS_ALC_T_PERSISTENT_TERM, ctx->cpy_ctx.new_table); + release_update_permission(0); + } + return 1; +} +/* + * A linear congruential generator that is used in the debug emulator + * to trap after a random number of iterations in + * persistent_term_put_2 and persistent_term_erase_1. + * + * https://en.wikipedia.org/wiki/Linear_congruential_generator + */ +#define GET_SMALL_RANDOM_INT(SEED) \ + (1103515245 * (SEED) + 12345) % 227 + BIF_RETTYPE persistent_term_put_2(BIF_ALIST_2) { - Eterm key; - Eterm term; - Eterm heap[3]; - Eterm tuple; - HashTable* hash_table; - Uint term_size; - Uint lit_area_size; - ErlOffHeap code_off_heap; - ErtsLiteralArea* literal_area; - erts_shcopy_t info; - Eterm* ptr; - Uint entry_index; + static const Uint ITERATIONS_PER_RED = 32; + ErtsPersistentTermPut2Context* ctx; + Eterm state_mref = THE_NON_VALUE; + long iterations_until_trap; + long max_iterations; +#define PUT_TRAP_CODE \ + BIF_TRAP2(bif_export[BIF_persistent_term_put_2], BIF_P, state_mref, BIF_ARG_2) +#define TRAPPING_COPY_TABLE_PUT(TABLE_DEST, OLD_TABLE, NEW_SIZE, COPY_TYPE, LOC_NAME) \ + TRAPPING_COPY_TABLE(TABLE_DEST, OLD_TABLE, NEW_SIZE, COPY_TYPE, LOC_NAME, PUT_TRAP_CODE) + +#ifdef DEBUG + (void)ITERATIONS_PER_RED; + iterations_until_trap = max_iterations = + GET_SMALL_RANDOM_INT(ERTS_BIF_REDS_LEFT(BIF_P) + (Uint)&ctx); +#else + iterations_until_trap = max_iterations = + ITERATIONS_PER_RED * ERTS_BIF_REDS_LEFT(BIF_P); +#endif + if (is_internal_magic_ref(BIF_ARG_1) && + (ERTS_MAGIC_BIN_DESTRUCTOR(erts_magic_ref2bin(BIF_ARG_1)) == + persistent_term_put_2_ctx_bin_dtor)) { + /* Restore state after a trap */ + Binary* state_bin; + state_mref = BIF_ARG_1; + state_bin = erts_magic_ref2bin(state_mref); + ctx = ERTS_MAGIC_BIN_DATA(state_bin); + ASSERT(BIF_P->flags & F_DISABLE_GC); + erts_set_gc_state(BIF_P, 1); + switch (ctx->trap_location) { + case PUT2_TRAP_LOCATION_NEW_KEY: + goto L_PUT2_TRAP_LOCATION_NEW_KEY; + case PUT2_TRAP_LOCATION_REPLACE_VALUE: + goto L_PUT2_TRAP_LOCATION_REPLACE_VALUE; + } + } else { + /* Save state in magic bin in case trapping is necessary */ + Eterm* hp; + Binary* state_bin = erts_create_magic_binary(sizeof(ErtsPersistentTermPut2Context), + persistent_term_put_2_ctx_bin_dtor); + hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE); + state_mref = erts_mk_magic_ref(&hp, &MSO(BIF_P), state_bin); + ctx = ERTS_MAGIC_BIN_DATA(state_bin); + /* + * IMPORTANT: The following field is used to detect if + * persistent_term_put_2_ctx_bin_dtor needs to free memory + */ + ctx->cpy_ctx.new_table = NULL; + } + if (!try_seize_update_permission(BIF_P)) { ERTS_BIF_YIELD2(bif_export[BIF_persistent_term_put_2], BIF_P, BIF_ARG_1, BIF_ARG_2); } + ctx->hash_table = (HashTable *) erts_atomic_read_nob(&the_hash_table); - hash_table = (HashTable *) erts_atomic_read_nob(&the_hash_table); + ctx->key = BIF_ARG_1; + ctx->term = BIF_ARG_2; - key = BIF_ARG_1; - term = BIF_ARG_2; + ctx->entry_index = lookup(ctx->hash_table, ctx->key); - entry_index = lookup(hash_table, key); - - heap[0] = make_arityval(2); - heap[1] = key; - heap[2] = term; - tuple = make_tuple(heap); + ctx->heap[0] = make_arityval(2); + ctx->heap[1] = ctx->key; + ctx->heap[2] = ctx->term; + ctx->tuple = make_tuple(ctx->heap); - if (is_nil(hash_table->term[entry_index])) { - Uint size = hash_table->allocated; - if (MUST_GROW(hash_table)) { - size *= 2; + if (is_nil(ctx->hash_table->term[ctx->entry_index])) { + Uint new_size = ctx->hash_table->allocated; + if (MUST_GROW(ctx->hash_table)) { + new_size *= 2; } - hash_table = copy_table(hash_table, size, 0); - entry_index = lookup(hash_table, key); - hash_table->num_entries++; + TRAPPING_COPY_TABLE_PUT(ctx->hash_table, + ctx->hash_table, + new_size, + ERTS_PERSISTENT_TERM_CPY_NO_REHASH, + PUT2_TRAP_LOCATION_NEW_KEY); + ctx->entry_index = lookup(ctx->hash_table, ctx->key); + ctx->hash_table->num_entries++; } else { - Eterm tuple = hash_table->term[entry_index]; + Eterm tuple = ctx->hash_table->term[ctx->entry_index]; Eterm old_term; ASSERT(is_tuple_arity(tuple, 2)); old_term = boxed_val(tuple)[2]; - if (EQ(term, old_term)) { + if (EQ(ctx->term, old_term)) { /* Same value. No need to update anything. */ release_update_permission(0); BIF_RET(am_ok); } else { /* Mark the old term for deletion. */ - mark_for_deletion(hash_table, entry_index); - hash_table = copy_table(hash_table, hash_table->allocated, 0); + mark_for_deletion(ctx->hash_table, ctx->entry_index); + TRAPPING_COPY_TABLE_PUT(ctx->hash_table, + ctx->hash_table, + ctx->hash_table->allocated, + ERTS_PERSISTENT_TERM_CPY_NO_REHASH, + PUT2_TRAP_LOCATION_REPLACE_VALUE); } } - /* - * Preserve internal sharing in the term by using the - * sharing-preserving functions. However, literals must - * be copied in case the module holding them are unloaded. - */ - INITIALIZE_SHCOPY(info); - info.copy_literals = 1; - term_size = copy_shared_calculate(tuple, &info); - ERTS_INIT_OFF_HEAP(&code_off_heap); - lit_area_size = ERTS_LITERAL_AREA_ALLOC_SIZE(term_size); - literal_area = erts_alloc(ERTS_ALC_T_LITERAL, lit_area_size); - ptr = &literal_area->start[0]; - literal_area->end = ptr + term_size; - tuple = copy_shared_perform(tuple, term_size, &info, &ptr, &code_off_heap); - ASSERT(tuple_val(tuple) == literal_area->start); - literal_area->off_heap = code_off_heap.first; - DESTROY_SHCOPY(info); - erts_set_literal_tag(&tuple, literal_area->start, term_size); - hash_table->term[entry_index] = tuple; - - erts_schedule_thr_prgr_later_op(table_updater, hash_table, &thr_prog_op); - suspend_updater(BIF_P); - - /* - * Issue a warning once if the warning limit has been exceeded. - */ - - if (hash_table->num_entries > WARNING_LIMIT && issued_warning == 0) { - static char w[] = - "More than " XSTR(WARNING_LIMIT) " persistent terms " - "have been created.\n" - "It is recommended to avoid creating an excessive number of\n" - "persistent terms, as creation and deletion of persistent terms\n" - "will be slower as the number of persistent terms increases.\n"; - issued_warning = 1; - erts_send_warning_to_logger_str(BIF_P->group_leader, w); + { + Uint term_size; + Uint lit_area_size; + ErlOffHeap code_off_heap; + ErtsLiteralArea* literal_area; + erts_shcopy_t info; + Eterm* ptr; + /* + * Preserve internal sharing in the term by using the + * sharing-preserving functions. However, literals must + * be copied in case the module holding them are unloaded. + */ + INITIALIZE_SHCOPY(info); + info.copy_literals = 1; + term_size = copy_shared_calculate(ctx->tuple, &info); + ERTS_INIT_OFF_HEAP(&code_off_heap); + lit_area_size = ERTS_LITERAL_AREA_ALLOC_SIZE(term_size); + literal_area = erts_alloc(ERTS_ALC_T_LITERAL, lit_area_size); + ptr = &literal_area->start[0]; + literal_area->end = ptr + term_size; + ctx->tuple = copy_shared_perform(ctx->tuple, term_size, &info, &ptr, &code_off_heap); + ASSERT(tuple_val(ctx->tuple) == literal_area->start); + literal_area->off_heap = code_off_heap.first; + DESTROY_SHCOPY(info); + erts_set_literal_tag(&ctx->tuple, literal_area->start, term_size); + ctx->hash_table->term[ctx->entry_index] = ctx->tuple; + + erts_schedule_thr_prgr_later_op(table_updater, ctx->hash_table, &thr_prog_op); + suspend_updater(BIF_P); } - + BUMP_REDS(BIF_P, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED); ERTS_BIF_YIELD_RETURN(BIF_P, am_ok); } @@ -349,26 +474,84 @@ BIF_RETTYPE persistent_term_get_2(BIF_ALIST_2) BIF_RET(result); } -BIF_RETTYPE persistent_term_erase_1(BIF_ALIST_1) +static int persistent_term_erase_1_ctx_bin_dtor(Binary *context_bin) { - Eterm key = BIF_ARG_1; - HashTable* old_table; - HashTable* new_table; - Uint entry_index; - Eterm old_term; + ErtsPersistentTermErase1Context* ctx = ERTS_MAGIC_BIN_DATA(context_bin); + if (ctx->cpy_ctx.new_table != NULL) { + if (ctx->cpy_ctx.copy_type == ERTS_PERSISTENT_TERM_CPY_TEMP) { + erts_free(ERTS_ALC_T_PERSISTENT_TERM_TMP, ctx->cpy_ctx.new_table); + } else { + erts_free(ERTS_ALC_T_PERSISTENT_TERM, ctx->cpy_ctx.new_table); + } + if (ctx->tmp_table != NULL) { + erts_free(ERTS_ALC_T_PERSISTENT_TERM_TMP, ctx->tmp_table); + } + release_update_permission(0); + } + return 1; +} +BIF_RETTYPE persistent_term_erase_1(BIF_ALIST_1) +{ + static const Uint ITERATIONS_PER_RED = 32; + ErtsPersistentTermErase1Context* ctx; + Eterm state_mref = THE_NON_VALUE; + long iterations_until_trap; + long max_iterations; +#ifdef DEBUG + (void)ITERATIONS_PER_RED; + iterations_until_trap = max_iterations = + GET_SMALL_RANDOM_INT(ERTS_BIF_REDS_LEFT(BIF_P) + (Uint)&ctx); +#else + iterations_until_trap = max_iterations = + ITERATIONS_PER_RED * ERTS_BIF_REDS_LEFT(BIF_P); +#endif +#define ERASE_TRAP_CODE \ + BIF_TRAP1(bif_export[BIF_persistent_term_erase_1], BIF_P, state_mref); +#define TRAPPING_COPY_TABLE_ERASE(TABLE_DEST, OLD_TABLE, NEW_SIZE, REHASH, LOC_NAME) \ + TRAPPING_COPY_TABLE(TABLE_DEST, OLD_TABLE, NEW_SIZE, REHASH, LOC_NAME, ERASE_TRAP_CODE) + if (is_internal_magic_ref(BIF_ARG_1) && + (ERTS_MAGIC_BIN_DESTRUCTOR(erts_magic_ref2bin(BIF_ARG_1)) == + persistent_term_erase_1_ctx_bin_dtor)) { + /* Restore the state after a trap */ + Binary* state_bin; + state_mref = BIF_ARG_1; + state_bin = erts_magic_ref2bin(state_mref); + ctx = ERTS_MAGIC_BIN_DATA(state_bin); + ASSERT(BIF_P->flags & F_DISABLE_GC); + erts_set_gc_state(BIF_P, 1); + switch (ctx->trap_location) { + case ERASE1_TRAP_LOCATION_TMP_COPY: + goto L_ERASE1_TRAP_LOCATION_TMP_COPY; + case ERASE1_TRAP_LOCATION_FINAL_COPY: + goto L_ERASE1_TRAP_LOCATION_FINAL_COPY; + } + } else { + /* Save state in magic bin in case trapping is necessary */ + Eterm* hp; + Binary* state_bin = erts_create_magic_binary(sizeof(ErtsPersistentTermErase1Context), + persistent_term_erase_1_ctx_bin_dtor); + hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE); + state_mref = erts_mk_magic_ref(&hp, &MSO(BIF_P), state_bin); + ctx = ERTS_MAGIC_BIN_DATA(state_bin); + /* + * IMPORTANT: The following two fields are used to detect if + * persistent_term_erase_1_ctx_bin_dtor needs to free memory + */ + ctx->cpy_ctx.new_table = NULL; + ctx->tmp_table = NULL; + } if (!try_seize_update_permission(BIF_P)) { ERTS_BIF_YIELD1(bif_export[BIF_persistent_term_erase_1], BIF_P, BIF_ARG_1); } - old_table = (HashTable *) erts_atomic_read_nob(&the_hash_table); - entry_index = lookup(old_table, key); - old_term = old_table->term[entry_index]; - if (is_boxed(old_term)) { + ctx->key = BIF_ARG_1; + ctx->old_table = (HashTable *) erts_atomic_read_nob(&the_hash_table); + ctx->entry_index = lookup(ctx->old_table, ctx->key); + ctx->old_term = ctx->old_table->term[ctx->entry_index]; + if (is_boxed(ctx->old_term)) { Uint new_size; - HashTable* tmp_table; - /* * Since we don't use any delete markers, we must rehash * the table when deleting terms to ensure that all terms @@ -378,8 +561,12 @@ BIF_RETTYPE persistent_term_erase_1(BIF_ALIST_1) * temporary table copy of the same size as the old one. */ - ASSERT(is_tuple_arity(old_term, 2)); - tmp_table = tmp_table_copy(old_table); + ASSERT(is_tuple_arity(ctx->old_term, 2)); + TRAPPING_COPY_TABLE_ERASE(ctx->tmp_table, + ctx->old_table, + ctx->old_table->allocated, + ERTS_PERSISTENT_TERM_CPY_TEMP, + ERASE1_TRAP_LOCATION_TMP_COPY); /* * Delete the term from the temporary table. Then copy the @@ -387,18 +574,28 @@ BIF_RETTYPE persistent_term_erase_1(BIF_ALIST_1) * while copying. */ - tmp_table->term[entry_index] = NIL; - tmp_table->num_entries--; - new_size = tmp_table->allocated; - if (MUST_SHRINK(tmp_table)) { + ctx->tmp_table->term[ctx->entry_index] = NIL; + ctx->tmp_table->num_entries--; + new_size = ctx->tmp_table->allocated; + if (MUST_SHRINK(ctx->tmp_table)) { new_size /= 2; } - new_table = copy_table(tmp_table, new_size, 1); - erts_free(ERTS_ALC_T_TMP, tmp_table); + TRAPPING_COPY_TABLE_ERASE(ctx->new_table, + ctx->tmp_table, + new_size, + ERTS_PERSISTENT_TERM_CPY_REHASH, + ERASE1_TRAP_LOCATION_FINAL_COPY); + erts_free(ERTS_ALC_T_PERSISTENT_TERM_TMP, ctx->tmp_table); + /* + * IMPORTANT: Memory management depends on that ctx->tmp_table + * is set to NULL on the line below + */ + ctx->tmp_table = NULL; - mark_for_deletion(old_table, entry_index); - erts_schedule_thr_prgr_later_op(table_updater, new_table, &thr_prog_op); + mark_for_deletion(ctx->old_table, ctx->entry_index); + erts_schedule_thr_prgr_later_op(table_updater, ctx->new_table, &thr_prog_op); suspend_updater(BIF_P); + BUMP_REDS(BIF_P, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED); ERTS_BIF_YIELD_RETURN(BIF_P, am_true); } @@ -406,7 +603,7 @@ BIF_RETTYPE persistent_term_erase_1(BIF_ALIST_1) * Key is not present. Nothing to do. */ - ASSERT(is_nil(old_term)); + ASSERT(is_nil(ctx->old_term)); release_update_permission(0); BIF_RET(am_false); } @@ -740,65 +937,104 @@ lookup(HashTable* hash_table, Eterm key) } static HashTable* -tmp_table_copy(HashTable* old_table) +copy_table(ErtsPersistentTermCpyTableCtx* ctx) { - Uint size = old_table->allocated; - HashTable* tmp_table; + Uint old_size = ctx->old_table->allocated; Uint i; - - tmp_table = (HashTable *) erts_alloc(ERTS_ALC_T_TMP, - sizeof(HashTable) + - sizeof(Eterm) * (size-1)); - *tmp_table = *old_table; - for (i = 0; i < size; i++) { - tmp_table->term[i] = old_table->term[i]; + ErtsAlcType_t alloc_type; + ctx->total_iterations_done = 0; + switch(ctx->location) { + case ERTS_PERSISTENT_TERM_CPY_PLACE_1: goto L_copy_table_place_1; + case ERTS_PERSISTENT_TERM_CPY_PLACE_2: goto L_copy_table_place_2; + case ERTS_PERSISTENT_TERM_CPY_PLACE_3: goto L_copy_table_place_3; + case ERTS_PERSISTENT_TERM_CPY_PLACE_START: + ctx->iterations_done = 0; } - return tmp_table; -} - -static HashTable* -copy_table(HashTable* old_table, Uint new_size, int rehash) -{ - HashTable* new_table; - Uint old_size = old_table->allocated; - Uint i; - - new_table = (HashTable *) erts_alloc(ERTS_ALC_T_PERSISTENT_TERM, - sizeof(HashTable) + - sizeof(Eterm) * (new_size-1)); - if (old_table->allocated == new_size && !rehash) { + if (ctx->copy_type == ERTS_PERSISTENT_TERM_CPY_TEMP) { + alloc_type = ERTS_ALC_T_PERSISTENT_TERM_TMP; + } else { + alloc_type = ERTS_ALC_T_PERSISTENT_TERM; + } + ctx->new_table = (HashTable *) erts_alloc(alloc_type, + sizeof(HashTable) + + sizeof(Eterm) * (ctx->new_size-1)); + if (ctx->old_table->allocated == ctx->new_size && + (ctx->copy_type == ERTS_PERSISTENT_TERM_CPY_NO_REHASH || + ctx->copy_type == ERTS_PERSISTENT_TERM_CPY_TEMP)) { /* * Same size and no key deleted. Make an exact copy of the table. */ - *new_table = *old_table; - for (i = 0; i < new_size; i++) { - new_table->term[i] = old_table->term[i]; + *ctx->new_table = *ctx->old_table; + L_copy_table_place_1: + for (i = ctx->iterations_done; + i < MIN(ctx->iterations_done + ctx->max_iterations, + ctx->new_size); + i++) { + ctx->new_table->term[i] = ctx->old_table->term[i]; } + ctx->total_iterations_done = (i - ctx->iterations_done); + if (i < ctx->new_size) { + ctx->iterations_done = i; + ctx->location = ERTS_PERSISTENT_TERM_CPY_PLACE_1; + return NULL; + } + ctx->iterations_done = 0; } else { /* * The size of the table has changed or an element has been * deleted. Must rehash, by inserting all old terms into the * new (empty) table. */ - new_table->allocated = new_size; - new_table->num_entries = old_table->num_entries; - new_table->mask = new_size - 1; - for (i = 0; i < new_size; i++) { - new_table->term[i] = NIL; + ctx->new_table->allocated = ctx->new_size; + ctx->new_table->num_entries = ctx->old_table->num_entries; + ctx->new_table->mask = ctx->new_size - 1; + L_copy_table_place_2: + for (i = ctx->iterations_done; + i < MIN(ctx->iterations_done + ctx->max_iterations, + ctx->new_size); + i++) { + ctx->new_table->term[i] = NIL; + } + ctx->total_iterations_done = (i - ctx->iterations_done); + ctx->max_iterations -= ctx->total_iterations_done; + if (i < ctx->new_size) { + ctx->iterations_done = i; + ctx->location = ERTS_PERSISTENT_TERM_CPY_PLACE_2; + return NULL; } - for (i = 0; i < old_size; i++) { - if (is_tuple(old_table->term[i])) { - Eterm key = tuple_val(old_table->term[i])[1]; - Uint entry_index = lookup(new_table, key); - ASSERT(is_nil(new_table->term[entry_index])); - new_table->term[entry_index] = old_table->term[i]; + ctx->iterations_done = 0; + L_copy_table_place_3: + for (i = ctx->iterations_done; + i < MIN(ctx->iterations_done + ctx->max_iterations, + old_size); + i++) { + if (is_tuple(ctx->old_table->term[i])) { + Eterm key = tuple_val(ctx->old_table->term[i])[1]; + Uint entry_index = lookup(ctx->new_table, key); + ASSERT(is_nil(ctx->new_table->term[entry_index])); + ctx->new_table->term[entry_index] = ctx->old_table->term[i]; } } + ctx->total_iterations_done += (i - ctx->iterations_done); + if (i < old_size) { + ctx->iterations_done = i; + ctx->location = ERTS_PERSISTENT_TERM_CPY_PLACE_3; + return NULL; + } + ctx->iterations_done = 0; + } + ctx->new_table->first_to_delete = 0; + ctx->new_table->num_to_delete = 0; + erts_atomic_init_nob(&ctx->new_table->refc, (erts_aint_t)1); + { + HashTable* new_table = ctx->new_table; + /* + * IMPORTANT: Memory management depends on that ctx->new_table is + * set to NULL on the line below + */ + ctx->new_table = NULL; + return new_table; } - new_table->first_to_delete = 0; - new_table->num_to_delete = 0; - erts_atomic_init_nob(&new_table->refc, (erts_aint_t)1); - return new_table; } static void diff --git a/erts/emulator/beam/erl_cpu_topology.c b/erts/emulator/beam/erl_cpu_topology.c index 6f8d2f8c35..6a4f43297e 100644 --- a/erts/emulator/beam/erl_cpu_topology.c +++ b/erts/emulator/beam/erl_cpu_topology.c @@ -34,6 +34,7 @@ #include "error.h" #include "bif.h" #include "erl_cpu_topology.h" +#include "erl_flxctr.h" #define ERTS_MAX_READER_GROUPS 64 @@ -58,6 +59,7 @@ static erts_cpu_info_t *cpuinfo; static int max_main_threads; static int reader_groups; +static int decentralized_counter_groups; static ErtsCpuBindData *scheduler2cpu_map; static erts_rwmtx_t cpuinfo_rwmtx; @@ -127,6 +129,8 @@ static erts_cpu_groups_map_t *cpu_groups_maps; static erts_cpu_groups_map_t *reader_groups_map; +static erts_cpu_groups_map_t *decentralized_counter_groups_map; + #define ERTS_TOPOLOGY_CG ERTS_TOPOLOGY_MAX_DEPTH #define ERTS_MAX_CPU_TOPOLOGY_ID ((int) 0xffff) @@ -138,6 +142,7 @@ static void cpu_bind_order_sort(erts_cpu_topology_t *cpudata, static void write_schedulers_bind_change(erts_cpu_topology_t *cpudata, int size); static void reader_groups_callback(int, ErtsSchedulerData *, int, void *); +static void flxctr_groups_callback(int, ErtsSchedulerData *, int, void *); static erts_cpu_groups_map_t *add_cpu_groups(int groups, erts_cpu_groups_callback_t callback, void *arg); @@ -1646,7 +1651,8 @@ erts_get_logical_processors(int *conf, int *onln, int *avail) } void -erts_pre_early_init_cpu_topology(int *max_rg_p, +erts_pre_early_init_cpu_topology(int *max_dcg_p, + int *max_rg_p, int *conf_p, int *onln_p, int *avail_p) @@ -1654,6 +1660,7 @@ erts_pre_early_init_cpu_topology(int *max_rg_p, cpu_groups_maps = NULL; no_cpu_groups_callbacks = 0; *max_rg_p = ERTS_MAX_READER_GROUPS; + *max_dcg_p = ERTS_MAX_FLXCTR_GROUPS; cpuinfo = erts_cpu_info_create(); get_logical_processors(conf_p, onln_p, avail_p); } @@ -1662,7 +1669,9 @@ void erts_early_init_cpu_topology(int no_schedulers, int *max_main_threads_p, int max_reader_groups, - int *reader_groups_p) + int *reader_groups_p, + int max_decentralized_counter_groups, + int *decentralized_counter_groups_p) { user_cpudata = NULL; user_cpudata_size = 0; @@ -1687,6 +1696,12 @@ erts_early_init_cpu_topology(int no_schedulers, max_main_threads = no_schedulers; *max_main_threads_p = max_main_threads; + decentralized_counter_groups = max_main_threads; + if (decentralized_counter_groups <= 1 || max_decentralized_counter_groups <= 1) + decentralized_counter_groups = 1; + if (decentralized_counter_groups > max_decentralized_counter_groups) + decentralized_counter_groups = max_decentralized_counter_groups; + *decentralized_counter_groups_p = decentralized_counter_groups; reader_groups = max_main_threads; if (reader_groups <= 1 || max_reader_groups <= 1) reader_groups = 0; @@ -1718,6 +1733,9 @@ erts_init_cpu_topology(void) reader_groups_map = add_cpu_groups(reader_groups, reader_groups_callback, NULL); + decentralized_counter_groups_map = add_cpu_groups(decentralized_counter_groups, + flxctr_groups_callback, + NULL); if (cpu_bind_order == ERTS_CPU_BIND_NONE) erts_rwmtx_rwunlock(&cpuinfo_rwmtx); @@ -1789,6 +1807,15 @@ reader_groups_callback(int suspending, erts_rwmtx_set_reader_group(suspending ? 0 : group+1); } +void +flxctr_groups_callback(int suspending, + ErtsSchedulerData *esdp, + int group, + void *unused) +{ + erts_flxctr_set_slot(suspending ? 0 : group+1); +} + static Eterm get_cpu_groups_map(Process *c_p, erts_cpu_groups_map_t *map, int offset); @@ -1821,6 +1848,16 @@ erts_get_reader_groups_map(Process *c_p) return res; } +Eterm +erts_get_decentralized_counter_groups_map(Process *c_p) +{ + Eterm res; + erts_rwmtx_rlock(&cpuinfo_rwmtx); + res = get_cpu_groups_map(c_p, decentralized_counter_groups_map, 1); + erts_rwmtx_runlock(&cpuinfo_rwmtx); + return res; +} + /* * CPU groups */ diff --git a/erts/emulator/beam/erl_cpu_topology.h b/erts/emulator/beam/erl_cpu_topology.h index 88bcad79ab..4a428d7972 100644 --- a/erts/emulator/beam/erl_cpu_topology.h +++ b/erts/emulator/beam/erl_cpu_topology.h @@ -27,14 +27,19 @@ #ifndef ERL_CPU_TOPOLOGY_H__ #define ERL_CPU_TOPOLOGY_H__ -void erts_pre_early_init_cpu_topology(int *max_rg_p, - int *conf_p, - int *onln_p, - int *avail_p); -void erts_early_init_cpu_topology(int no_schedulers, - int *max_main_threads_p, - int max_reader_groups, - int *reader_groups_p); +void +erts_pre_early_init_cpu_topology(int *max_dcg_p, + int *max_rg_p, + int *conf_p, + int *onln_p, + int *avail_p); +void +erts_early_init_cpu_topology(int no_schedulers, + int *max_main_threads_p, + int max_reader_groups, + int *reader_groups_p, + int max_decentralized_counter_groups, + int *decentralized_counter_groups_p); void erts_init_cpu_topology(void); @@ -70,6 +75,7 @@ Eterm erts_bind_schedulers(Process *c_p, Eterm how); Eterm erts_get_schedulers_binds(Process *c_p); Eterm erts_get_reader_groups_map(Process *c_p); +Eterm erts_get_decentralized_counter_groups_map(Process *c_p); Eterm erts_set_cpu_topology(Process *c_p, Eterm term); Eterm erts_get_cpu_topology_term(Process *c_p, Eterm which); diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 0a50af4d1a..d24f30f126 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -42,6 +42,7 @@ #include "bif.h" #include "big.h" #include "erl_binary.h" +#include "bif.h" erts_atomic_t erts_ets_misc_mem_size; @@ -64,6 +65,11 @@ do { \ } \ }while(0) +#define DB_GET_APPROX_NITEMS(DB) \ + erts_flxctr_read_approx(&(DB)->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID) +#define DB_GET_APPROX_MEM_CONSUMED(DB) \ + erts_flxctr_read_approx(&(DB)->common.counters, ERTS_DB_TABLE_MEM_COUNTER_ID) + static BIF_RETTYPE db_bif_fail(Process* p, Uint freason, Uint bif_ix, Export* bif_exp) { @@ -398,8 +404,9 @@ static void free_dbtable(void *vtb) { DbTable *tb = (DbTable *) vtb; - - ASSERT(erts_atomic_read_nob(&tb->common.memory_size) == sizeof(DbTable)); + ASSERT(erts_flxctr_is_snapshot_ongoing(&tb->common.counters) || + sizeof(DbTable) == erts_flxctr_read_approx(&tb->common.counters, + ERTS_DB_TABLE_MEM_COUNTER_ID)); erts_rwmtx_destroy(&tb->common.rwlock); erts_mtx_destroy(&tb->common.fixlock); @@ -408,7 +415,8 @@ free_dbtable(void *vtb) if (tb->common.btid) erts_bin_release(tb->common.btid); - erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable)); + erts_flxctr_destroy(&tb->common.counters, ERTS_ALC_T_DB_TABLE); + erts_free(ERTS_ALC_T_DB_TABLE, tb); } static void schedule_free_dbtable(DbTable* tb) @@ -1731,12 +1739,16 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) */ { DbTable init_tb; - - erts_atomic_init_nob(&init_tb.common.memory_size, 0); + erts_flxctr_init(&init_tb.common.counters, 0, 2, ERTS_ALC_T_DB_TABLE); tb = (DbTable*) erts_db_alloc(ERTS_ALC_T_DB_TABLE, &init_tb, sizeof(DbTable)); - erts_atomic_init_nob(&tb->common.memory_size, - erts_atomic_read_nob(&init_tb.common.memory_size)); + erts_flxctr_init(&tb->common.counters, + status & DB_CA_ORDERED_SET, + 2, + ERTS_ALC_T_DB_TABLE); + erts_flxctr_add(&tb->common.counters, + ERTS_DB_TABLE_MEM_COUNTER_ID, + DB_GET_APPROX_MEM_CONSUMED(&init_tb)); } tb->common.meth = meth; @@ -1750,8 +1762,6 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) tb->common.owner = BIF_P->common.id; set_heir(BIF_P, tb, heir, heir_data); - erts_atomic_init_nob(&tb->common.nitems, 0); - tb->common.fixing_procs = NULL; tb->common.compress = is_compressed; #ifdef ETS_DBG_FORCE_TRAP @@ -2128,19 +2138,18 @@ BIF_RETTYPE ets_internal_delete_all_2(BIF_ALIST_2) { SWord initial_reds = ERTS_BIF_REDS_LEFT(BIF_P); SWord reds = initial_reds; - Eterm nitems; + Eterm nitems_holder = THE_NON_VALUE; DbTable* tb; - CHECK_TABLES(); DB_BIF_GET_TABLE(tb, DB_WRITE, LCK_WRITE, BIF_ets_internal_delete_all_2); if (BIF_ARG_2 == am_undefined) { - nitems = erts_make_integer(erts_atomic_read_nob(&tb->common.nitems), - BIF_P); - - reds = tb->common.meth->db_delete_all_objects(BIF_P, tb, reds); - + reds = tb->common.meth->db_delete_all_objects(BIF_P, + tb, + reds, + &nitems_holder); + ASSERT(nitems_holder != THE_NON_VALUE); ASSERT(!(tb->common.status & DB_BUSY)); if (reds < 0) { @@ -2159,7 +2168,7 @@ BIF_RETTYPE ets_internal_delete_all_2(BIF_ALIST_2) db_unlock(tb, LCK_WRITE); BUMP_ALL_REDS(BIF_P); BIF_TRAP2(bif_export[BIF_ets_internal_delete_all_2], BIF_P, - BIF_ARG_1, nitems); + BIF_ARG_1, nitems_holder); } else { /* Done, no trapping needed */ @@ -2169,15 +2178,19 @@ BIF_RETTYPE ets_internal_delete_all_2(BIF_ALIST_2) } else { /* - * The table lookup succeeded and second argument is nitems + * The table lookup succeeded and second argument is nitems_holder * and not 'undefined', which means we have trapped at least once * and are now done. */ - nitems = BIF_ARG_2; + nitems_holder = BIF_ARG_2; } - db_unlock(tb, LCK_WRITE); + { + Eterm nitems = + tb->common.meth->db_delete_all_objects_get_nitems_from_holder(BIF_P, + nitems_holder); BIF_RET(nitems); + } } static void delete_all_objects_continue(Process* p, DbTable* tb) @@ -2190,7 +2203,7 @@ static void delete_all_objects_continue(Process* p, DbTable* tb) if ((tb->common.status & (DB_DELETE|DB_BUSY)) != DB_BUSY) return; - reds = tb->common.meth->db_delete_all_objects(p, tb, reds); + reds = tb->common.meth->db_delete_all_objects(p, tb, reds, NULL); if (reds < 0) { BUMP_ALL_REDS(p); @@ -3277,13 +3290,29 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1) int i; Eterm* hp; Uint freason; + Sint size = -1; + Sint memory = -1; + Eterm table; + int is_ctrs_read_result_set = 0; /*Process* rp = NULL;*/ /* If/when we implement lockless private tables: Eterm owner; */ - - if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ, &freason)) == NULL) { - if (freason == BADARG && (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1))) + if(is_tuple(BIF_ARG_1) && + is_tuple_arity(BIF_ARG_1, 2) && + erts_flxctr_is_snapshot_result(tuple_val(BIF_ARG_1)[1])) { + Eterm counter_read_result = tuple_val(BIF_ARG_1)[1]; + table = tuple_val(BIF_ARG_1)[2]; + size = erts_flxctr_get_snapshot_result_after_trap(counter_read_result, + ERTS_DB_TABLE_NITEMS_COUNTER_ID); + memory = erts_flxctr_get_snapshot_result_after_trap(counter_read_result, + ERTS_DB_TABLE_MEM_COUNTER_ID); + is_ctrs_read_result_set = 1; + } else { + table = BIF_ARG_1; + } + if ((tb = db_get_table(BIF_P, table, DB_INFO, LCK_READ, &freason)) == NULL) { + if (freason == BADARG && (is_atom(table) || is_ref(table))) BIF_RET(am_undefined); else return db_bif_fail(BIF_P, freason, BIF_ets_info_1, NULL); @@ -3314,9 +3343,35 @@ BIF_RETTYPE ets_info_1(BIF_ALIST_1) BIF_ERROR(BIF_P, BADARG); } }*/ + + if (!is_ctrs_read_result_set) { + ErtsFlxCtrSnapshotResult res = + erts_flxctr_snapshot(&tb->common.counters, ERTS_ALC_T_DB_TABLE, BIF_P); + if (ERTS_FLXCTR_GET_RESULT_AFTER_TRAP == res.type) { + Eterm tuple; + db_unlock(tb, LCK_READ); + hp = HAlloc(BIF_P, 3); + tuple = TUPLE2(hp, res.trap_resume_state, table); + BIF_TRAP1(bif_export[BIF_ets_info_1], BIF_P, tuple); + } else if (res.type == ERTS_FLXCTR_TRY_AGAIN_AFTER_TRAP) { + db_unlock(tb, LCK_READ); + BIF_TRAP1(bif_export[BIF_ets_info_1], BIF_P, table); + } else { + size = res.result[ERTS_DB_TABLE_NITEMS_COUNTER_ID]; + memory = res.result[ERTS_DB_TABLE_MEM_COUNTER_ID]; + is_ctrs_read_result_set = 1; + } + } for (i = 0; i < sizeof(fields)/sizeof(Eterm); i++) { - results[i] = table_info(BIF_P, tb, fields[i]); - ASSERT(is_value(results[i])); + if (is_ctrs_read_result_set && am_size == fields[i]) { + results[i] = erts_make_integer(size, BIF_P); + } else if (is_ctrs_read_result_set && am_memory == fields[i]) { + Sint words = (Sint) ((memory + sizeof(Sint) - 1) / sizeof(Sint)); + results[i] = erts_make_integer(words, BIF_P); + } else { + results[i] = table_info(BIF_P, tb, fields[i]); + ASSERT(is_value(results[i])); + } } db_unlock(tb, LCK_READ); @@ -3344,14 +3399,43 @@ BIF_RETTYPE ets_info_2(BIF_ALIST_2) DbTable* tb; Eterm ret = THE_NON_VALUE; Uint freason; - + if (erts_flxctr_is_snapshot_result(BIF_ARG_1)) { + Sint res; + if (am_memory == BIF_ARG_2) { + res = erts_flxctr_get_snapshot_result_after_trap(BIF_ARG_1, + ERTS_DB_TABLE_MEM_COUNTER_ID); + res = (Sint) ((res + sizeof(Sint) - 1) / sizeof(Sint)); + } else { + res = erts_flxctr_get_snapshot_result_after_trap(BIF_ARG_1, + ERTS_DB_TABLE_NITEMS_COUNTER_ID); + } + BIF_RET(erts_make_integer(res, BIF_P)); + } if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ, &freason)) == NULL) { if (freason == BADARG && (is_atom(BIF_ARG_1) || is_ref(BIF_ARG_1))) BIF_RET(am_undefined); else return db_bif_fail(BIF_P, freason, BIF_ets_info_2, NULL); } - ret = table_info(BIF_P, tb, BIF_ARG_2); + if (BIF_ARG_2 == am_size || BIF_ARG_2 == am_memory) { + ErtsFlxCtrSnapshotResult res = + erts_flxctr_snapshot(&tb->common.counters, ERTS_ALC_T_DB_TABLE, BIF_P); + if (ERTS_FLXCTR_GET_RESULT_AFTER_TRAP == res.type) { + db_unlock(tb, LCK_READ); + BIF_TRAP2(bif_export[BIF_ets_info_2], BIF_P, res.trap_resume_state, BIF_ARG_2); + } else if (res.type == ERTS_FLXCTR_TRY_AGAIN_AFTER_TRAP) { + db_unlock(tb, LCK_READ); + BIF_TRAP2(bif_export[BIF_ets_info_2], BIF_P, BIF_ARG_1, BIF_ARG_2); + } else if (BIF_ARG_2 == am_size) { + ret = erts_make_integer(res.result[ERTS_DB_TABLE_NITEMS_COUNTER_ID], BIF_P); + } else { /* BIF_ARG_2 == am_memory */ + Sint r = res.result[ERTS_DB_TABLE_MEM_COUNTER_ID]; + r = (Sint) ((r + sizeof(Sint) - 1) / sizeof(Sint)); + ret = erts_make_integer(r, BIF_P); + } + } else { + ret = table_info(BIF_P, tb, BIF_ARG_2); + } db_unlock(tb, LCK_READ); if (is_non_value(ret)) { BIF_ERROR(BIF_P, BADARG); @@ -4121,7 +4205,8 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What) int use_monotonic; if (What == am_size) { - ret = make_small(erts_atomic_read_nob(&tb->common.nitems)); + Uint size = (Uint) (DB_GET_APPROX_NITEMS(tb)); + ret = erts_make_integer(size, p); } else if (What == am_type) { if (tb->common.status & DB_SET) { ret = am_set; @@ -4136,7 +4221,7 @@ static Eterm table_info(Process* p, DbTable* tb, Eterm What) ret = am_bag; } } else if (What == am_memory) { - Uint words = (Uint) ((erts_atomic_read_nob(&tb->common.memory_size) + Uint words = (Uint) ((DB_GET_APPROX_MEM_CONSUMED(tb) + sizeof(Uint) - 1) / sizeof(Uint)); @@ -4294,9 +4379,9 @@ static void print_table(fmtfn_t to, void *to_arg, int show, DbTable* tb) tb->common.meth->db_print(to, to_arg, show, tb); - erts_print(to, to_arg, "Objects: %d\n", (int)erts_atomic_read_nob(&tb->common.nitems)); + erts_print(to, to_arg, "Objects: %d\n", (int)DB_GET_APPROX_NITEMS(tb)); erts_print(to, to_arg, "Words: %bpu\n", - (Uint) ((erts_atomic_read_nob(&tb->common.memory_size) + (Uint) ((DB_GET_APPROX_MEM_CONSUMED(tb) + sizeof(Uint) - 1) / sizeof(Uint))); @@ -4488,3 +4573,16 @@ int erts_ets_force_split(Eterm tid, int on) db_unlock(tb, LCK_WRITE); return 1; } + +int erts_ets_debug_random_split_join(Eterm tid, int on) +{ + DbTable* tb = tid2tab(tid); + if (!tb || !IS_CATREE_TABLE(tb->common.type)) + return 0; + + db_lock(tb, LCK_WRITE); + if (!(tb->common.status & DB_DELETE)) + db_catree_debug_random_split_join(&tb->catree, on); + db_unlock(tb, LCK_WRITE); + return 1; +} diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h index dc77fbb60c..b3dc1b9ba3 100644 --- a/erts/emulator/beam/erl_db.h +++ b/erts/emulator/beam/erl_db.h @@ -131,6 +131,7 @@ extern erts_atomic_t erts_ets_misc_mem_size; Eterm erts_ets_colliding_names(Process*, Eterm name, Uint cnt); int erts_ets_force_split(Eterm tid, int on); +int erts_ets_debug_random_split_join(Eterm tid, int on); Uint erts_db_get_max_tabs(void); Eterm erts_db_make_tid(Process *c_p, DbTableCommon *tb); @@ -160,7 +161,9 @@ do { \ erts_aint_t sz__ = (((erts_aint_t) (ALLOC_SZ)) \ - ((erts_aint_t) (FREE_SZ))); \ ASSERT((TAB)); \ - erts_atomic_add_nob(&(TAB)->common.memory_size, sz__); \ + erts_flxctr_add(&(TAB)->common.counters, \ + ERTS_DB_TABLE_MEM_COUNTER_ID, \ + sz__); \ } while (0) #define ERTS_ETS_MISC_MEM_ADD(SZ) \ @@ -305,10 +308,10 @@ erts_db_free(ErtsAlcType_t type, DbTable *tab, void *ptr, Uint size) ASSERT(ptr != 0); ASSERT(size == ERTS_ALC_DBG_BLK_SZ(ptr)); ERTS_DB_ALC_MEM_UPDATE_(tab, size, 0); - - ASSERT(((void *) tab) != ptr - || erts_atomic_read_nob(&tab->common.memory_size) == 0); - + ASSERT(((void *) tab) != ptr || + tab->common.counters.is_decentralized || + 0 == erts_flxctr_read_centralized(&tab->common.counters, + ERTS_DB_TABLE_MEM_COUNTER_ID)); erts_free(type, ptr); } diff --git a/erts/emulator/beam/erl_db_catree.c b/erts/emulator/beam/erl_db_catree.c index 0402c6b7b4..e0d5e44f58 100644 --- a/erts/emulator/beam/erl_db_catree.c +++ b/erts/emulator/beam/erl_db_catree.c @@ -149,7 +149,12 @@ static SWord db_free_table_continue_catree(DbTable *tbl, SWord); static void db_foreach_offheap_catree(DbTable *, void (*)(ErlOffHeap *, void *), void *); -static SWord db_delete_all_objects_catree(Process* p, DbTable* tbl, SWord reds); +static SWord db_delete_all_objects_catree(Process* p, + DbTable* tbl, + SWord reds, + Eterm* nitems_holder_wb); +static Eterm db_delete_all_objects_get_nitems_from_holder_catree(Process* p, + Eterm nitems_holder); static int db_lookup_dbterm_catree(Process *, DbTable *, Eterm key, Eterm obj, DbUpdateHandle*); @@ -191,6 +196,7 @@ DbTableMethod db_catree = db_select_replace_continue_catree, db_take_catree, db_delete_all_objects_catree, + db_delete_all_objects_get_nitems_from_holder_catree, db_free_table_catree, db_free_table_continue_catree, db_print_catree, @@ -641,7 +647,8 @@ static int dbg_fastrand(void) static void dbg_provoke_random_splitjoin(DbTableCATree* tb, DbTableCATreeNode* base_node) { - if (tb->common.status & DB_CATREE_FORCE_SPLIT) + if (tb->common.status & DB_CATREE_FORCE_SPLIT || + !(tb->common.status & DB_CATREE_DEBUG_RANDOM_SPLIT_JOIN)) return; switch (dbg_fastrand() % 8) { @@ -1357,6 +1364,8 @@ static SWord do_free_base_node_cont(DbTableCATree *tb, SWord num_left) PUSH_NODE(&tb->free_stack_elems, root); root = p; } else { + DEC_NITEMS((DbTable*)tb); + tb->nr_of_deleted_items++; free_term((DbTable*)tb, root); if (--num_left >= 0) { break; @@ -1397,6 +1406,10 @@ int db_create_catree(Process *p, DbTable *tbl) root = create_base_node(tb, NULL); tb->deletion = 0; tb->base_nodes_to_free_list = NULL; + tb->nr_of_deleted_items = 0; +#ifdef DEBUG + tbl->common.status |= DB_CATREE_DEBUG_RANDOM_SPLIT_JOIN; +#endif erts_atomic_init_relb(&(tb->root), (erts_aint_t)root); return DB_ERROR_NONE; } @@ -2050,6 +2063,7 @@ static SWord db_free_table_continue_catree(DbTable *tbl, SWord reds) PUSH_NODE(&tb->free_stack_rnodes, GET_ROOT(tb)); tb->is_routing_nodes_freed = 0; tb->base_nodes_to_free_list = NULL; + tb->nr_of_deleted_items = 0; } if ( ! tb->is_routing_nodes_freed ) { reds = do_free_routing_nodes_catree_cont(tb, reds); @@ -2079,13 +2093,57 @@ static SWord db_free_table_continue_catree(DbTable *tbl, SWord reds) return 1; } -static SWord db_delete_all_objects_catree(Process* p, DbTable* tbl, SWord reds) +static +int db_catree_nr_of_items_deleted_wb_dtor(Binary *context_bin) { + (void)context_bin; + return 1; +} + +typedef struct { + Uint nr_of_deleted_items; +} DbCATreeNrOfItemsDeletedWb; + +static Eterm +create_and_install_num_of_deleted_items_wb_bin(Process *p, DbTableCATree *tb) +{ + Binary* bin = + erts_create_magic_binary(sizeof(DbCATreeNrOfItemsDeletedWb), + db_catree_nr_of_items_deleted_wb_dtor); + DbCATreeNrOfItemsDeletedWb* data = ERTS_MAGIC_BIN_DATA(bin); + Eterm* hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + Eterm mref = erts_mk_magic_ref(&hp, &MSO(p), bin); + data->nr_of_deleted_items = 0; + tb->nr_of_deleted_items_wb = bin; + erts_refc_inctest(&bin->intern.refc, 2); + return mref; +} + +static Eterm db_delete_all_objects_get_nitems_from_holder_catree(Process* p, + Eterm mref) +{ + Binary* bin = erts_magic_ref2bin(mref); + DbCATreeNrOfItemsDeletedWb* data = ERTS_MAGIC_BIN_DATA(bin); + return erts_make_integer(data->nr_of_deleted_items, p); +} + +static SWord db_delete_all_objects_catree(Process* p, + DbTable* tbl, + SWord reds, + Eterm* nitems_holder_wb) { + DbTableCATree *tb = &tbl->catree; + DbCATreeNrOfItemsDeletedWb* data; + if (!tb->deletion) { + *nitems_holder_wb = + create_and_install_num_of_deleted_items_wb_bin(p, tb); + } reds = db_free_table_continue_catree(tbl, reds); if (reds < 0) return reds; + data = ERTS_MAGIC_BIN_DATA(tb->nr_of_deleted_items_wb); + data->nr_of_deleted_items = tb->nr_of_deleted_items; + erts_bin_release(tb->nr_of_deleted_items_wb); db_create_catree(p, tbl); - erts_atomic_set_nob(&tbl->catree.common.nitems, 0); return reds; } @@ -2203,6 +2261,14 @@ void db_catree_force_split(DbTableCATree* tb, int on) tb->common.status &= ~DB_CATREE_FORCE_SPLIT; } +void db_catree_debug_random_split_join(DbTableCATree* tb, int on) +{ + if (on) + tb->common.status |= DB_CATREE_DEBUG_RANDOM_SPLIT_JOIN; + else + tb->common.status &= ~DB_CATREE_DEBUG_RANDOM_SPLIT_JOIN; +} + void db_calc_stats_catree(DbTableCATree* tb, DbCATreeStats* stats) { DbTableCATreeNode* stack[ERL_DB_CATREE_MAX_ROUTE_NODE_LAYER_HEIGHT]; diff --git a/erts/emulator/beam/erl_db_catree.h b/erts/emulator/beam/erl_db_catree.h index 418837be8e..cf3498dabb 100644 --- a/erts/emulator/beam/erl_db_catree.h +++ b/erts/emulator/beam/erl_db_catree.h @@ -87,6 +87,10 @@ typedef struct db_table_catree { CATreeNodeStack free_stack_rnodes; DbTableCATreeNode *base_nodes_to_free_list; int is_routing_nodes_freed; + /* The fields below are used by delete_all_objects and + select_delete(DeleteAll)*/ + Uint nr_of_deleted_items; + Binary* nr_of_deleted_items_wb; } DbTableCATree; typedef struct { @@ -104,7 +108,6 @@ void db_initialize_catree(void); int db_create_catree(Process *p, DbTable *tbl); - TreeDbTerm** catree_find_root(Eterm key, CATreeRootIterator*); TreeDbTerm** catree_find_next_from_pb_key_root(Eterm key, CATreeRootIterator*); @@ -121,6 +124,7 @@ void erts_lcnt_enable_db_catree_lock_count(DbTableCATree *tb, int enable); #endif void db_catree_force_split(DbTableCATree*, int on); +void db_catree_debug_random_split_join(DbTableCATree*, int on); typedef struct { Uint route_nodes; diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index f225730029..ceaccf7e44 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -85,6 +85,14 @@ #include "erl_db_hash.h" +#define ADD_NITEMS(DB, TO_ADD) \ + erts_flxctr_add(&(DB)->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID, TO_ADD) +#define INC_NITEMS(DB) \ + erts_flxctr_inc_read_centralized(&(DB)->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID) +#define DEC_NITEMS(DB) \ + erts_flxctr_dec_read_centralized(&(DB)->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID) +#define RESET_NITEMS(DB) \ + erts_flxctr_reset(&(DB)->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID) /* * The following symbols can be manipulated to "tune" the linear hash array */ @@ -121,7 +129,9 @@ : ((struct segment**) erts_atomic_read_nob(&(tb)->segtab))) #endif #define NACTIVE(tb) ((int)erts_atomic_read_nob(&(tb)->nactive)) -#define NITEMS(tb) ((int)erts_atomic_read_nob(&(tb)->common.nitems)) +#define NITEMS(tb) \ + ((Sint)erts_flxctr_read_centralized(&(tb)->common.counters, \ + ERTS_DB_TABLE_NITEMS_COUNTER_ID)) #define SLOT_IX_TO_SEG_IX(i) (((i)+(EXT_SEGSZ-FIRST_SEGSZ)) >> EXT_SEGSZ_EXP) @@ -444,7 +454,12 @@ static void db_foreach_offheap_hash(DbTable *, void (*)(ErlOffHeap *, void *), void *); -static SWord db_delete_all_objects_hash(Process* p, DbTable* tbl, SWord reds); +static SWord db_delete_all_objects_hash(Process* p, + DbTable* tbl, + SWord reds, + Eterm* nitems_holder_wb); +static Eterm db_delete_all_objects_get_nitems_from_holder_hash(Process* p, + Eterm nitems_holder); #ifdef HARDDEBUG static void db_check_table_hash(DbTableHash *tb); #endif @@ -548,6 +563,7 @@ DbTableMethod db_hash = db_select_replace_continue_hash, db_take_hash, db_delete_all_objects_hash, + db_delete_all_objects_get_nitems_from_holder_hash, db_free_empty_table_hash, db_free_table_continue_hash, db_print_hash, @@ -806,7 +822,7 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail) if (tb->common.status & DB_SET) { HashDbTerm* bnext = b->next; if (is_pseudo_deleted(b)) { - erts_atomic_inc_nob(&tb->common.nitems); + INC_NITEMS(tb); b->pseudo_deleted = 0; } else if (key_clash_fail) { @@ -835,7 +851,7 @@ int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail) do { if (db_eq(&tb->common,obj,&q->dbterm)) { if (is_pseudo_deleted(q)) { - erts_atomic_inc_nob(&tb->common.nitems); + INC_NITEMS(tb); q->pseudo_deleted = 0; ASSERT(q->hvalue == hval); if (q != b) { /* must move to preserve key insertion order */ @@ -858,7 +874,7 @@ Lnew: q->pseudo_deleted = 0; q->next = b; *bp = q; - nitems = erts_atomic_inc_read_nob(&tb->common.nitems); + nitems = INC_NITEMS(tb); WUNLOCK_HASH(lck); { int nactive = NACTIVE(tb); @@ -1056,7 +1072,7 @@ int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret) } WUNLOCK_HASH(lck); if (nitems_diff) { - erts_atomic_add_nob(&tb->common.nitems, nitems_diff); + ADD_NITEMS(tb, nitems_diff); try_shrink(tb); } free_term_list(tb, free_us); @@ -1117,7 +1133,7 @@ static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret) } WUNLOCK_HASH(lck); if (nitems_diff) { - erts_atomic_add_nob(&tb->common.nitems, nitems_diff); + ADD_NITEMS(tb, nitems_diff); try_shrink(tb); } free_term_list(tb, free_us); @@ -2023,7 +2039,7 @@ static int select_delete_on_match_res(traverse_context_t* ctx_base, Sint slot_ix del->next = ctx->free_us; ctx->free_us = del; } - erts_atomic_dec_nob(&ctx->base.tb->common.nitems); + DEC_NITEMS(ctx->base.tb); return 1; } @@ -2300,7 +2316,7 @@ static int db_take_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) } WUNLOCK_HASH(lck); if (nitems_diff) { - erts_atomic_add_nob(&tb->common.nitems, nitems_diff); + ADD_NITEMS(tb, nitems_diff); try_shrink(tb); } free_term_list(tb, free_us); @@ -2360,7 +2376,7 @@ static SWord db_mark_all_deleted_hash(DbTable *tbl, SWord reds) fixdel->slot = NACTIVE(tb) - 1; fixdel->all = 1; fixdel->trap = 0; - erts_atomic_set_nob(&tb->common.nitems, 0); + RESET_NITEMS(tb); return loops < 0 ? 0 : loops / LOOPS_PER_REDUCTION; } @@ -2468,7 +2484,8 @@ static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds) (void*)tb->locks, sizeof(DbTableHashFineLocks)); tb->locks = NULL; } - ASSERT(erts_atomic_read_nob(&tb->common.memory_size) == sizeof(DbTable)); + ASSERT(sizeof(DbTable) == erts_flxctr_read_approx(&tb->common.counters, + ERTS_DB_TABLE_MEM_COUNTER_ID)); return reds; /* Done */ } @@ -3080,7 +3097,7 @@ db_lookup_dbterm_hash(Process *p, DbTable *tbl, Eterm key, Eterm obj, ASSERT(q->hvalue == hval); q->pseudo_deleted = 0; *bp = b = q; - erts_atomic_inc_nob(&tb->common.nitems); + INC_NITEMS(tb); } HRelease(p, hend, htop); @@ -3123,7 +3140,7 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle) } WUNLOCK_HASH(lck); - erts_atomic_dec_nob(&tb->common.nitems); + DEC_NITEMS(tb); try_shrink(tb); } else { if (handle->flags & DB_MUST_RESIZE) { @@ -3132,7 +3149,7 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle) } if (handle->flags & DB_INC_TRY_GROW) { int nactive; - int nitems = erts_atomic_inc_read_nob(&tb->common.nitems); + int nitems = INC_NITEMS(tb); WUNLOCK_HASH(lck); nactive = NACTIVE(tb); @@ -3153,8 +3170,17 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle) return; } -static SWord db_delete_all_objects_hash(Process* p, DbTable* tbl, SWord reds) +static SWord db_delete_all_objects_hash(Process* p, + DbTable* tbl, + SWord reds, + Eterm* nitems_holder_wb) { + if (nitems_holder_wb != NULL) { + Uint nr_of_items = + erts_flxctr_read_centralized(&tbl->common.counters, + ERTS_DB_TABLE_NITEMS_COUNTER_ID); + *nitems_holder_wb = erts_make_integer(nr_of_items, p); + } if (IS_FIXED(tbl)) { reds = db_mark_all_deleted_hash(tbl, reds); } else { @@ -3163,11 +3189,16 @@ static SWord db_delete_all_objects_hash(Process* p, DbTable* tbl, SWord reds) return reds; db_create_hash(p, tbl); - erts_atomic_set_nob(&tbl->hash.common.nitems, 0); + RESET_NITEMS(tbl); } return reds; } +static Eterm db_delete_all_objects_get_nitems_from_holder_hash(Process* p, + Eterm nitems_holder){ + return nitems_holder; +} + void db_foreach_offheap_hash(DbTable *tbl, void (*func)(ErlOffHeap *, void *), void * arg) diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index f9ba04f399..492ea81b63 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -51,9 +51,20 @@ #include "erl_db_tree_util.h" #define GETKEY_WITH_POS(Keypos, Tplp) (*((Tplp) + Keypos)) -#define NITEMS(tb) ((int)erts_atomic_read_nob(&(tb)->common.nitems)) -#define TREE_MAX_ELEMENTS 0xFFFFFFFFUL +#define NITEMS_CENTRALIZED(tb) \ + ((Sint)erts_flxctr_read_centralized(&(tb)->common.counters, \ + ERTS_DB_TABLE_NITEMS_COUNTER_ID)) +#define ADD_NITEMS(DB, TO_ADD) \ + erts_flxctr_add(&(DB)->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID, TO_ADD) +#define INC_NITEMS(DB) \ + erts_flxctr_inc(&(DB)->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID) +#define INC_NITEMS_CENTRALIZED(DB) \ + erts_flxctr_inc_read_centralized(&(DB)->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID) +#define RESET_NITEMS(DB) \ + erts_flxctr_reset(&(DB)->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID) +#define IS_CENTRALIZED_CTR(tb) (!(tb)->common.counters.is_decentralized) +#define APPROX_MEM_CONSUMED(tb) erts_flxctr_read_approx(&(tb)->common.counters, ERTS_DB_TABLE_MEM_COUNTER_ID) #define TOPN_NODE(Dtt, Pos) \ (((Pos) < Dtt->pos) ? \ @@ -296,7 +307,7 @@ int tree_balance_right(TreeDbTerm **this); static int delsub(TreeDbTerm **this); static TreeDbTerm *slot_search(Process *p, TreeDbTerm *root, Sint slot, DbTable *tb, DbTableTree *stack_container, - CATreeRootIterator *iter); + CATreeRootIterator *iter, int* is_EOT); static TreeDbTerm *find_node(DbTableCommon *tb, TreeDbTerm *root, Eterm key, DbTableTree *stack_container); static TreeDbTerm **find_node2(DbTableCommon *tb, TreeDbTerm **root, Eterm key); @@ -433,8 +444,12 @@ static void db_foreach_offheap_tree(DbTable *, void (*)(ErlOffHeap *, void *), void *); -static SWord db_delete_all_objects_tree(Process* p, DbTable* tbl, SWord reds); - +static SWord db_delete_all_objects_tree(Process* p, + DbTable* tbl, + SWord reds, + Eterm* nitems_holder_wb); +static Eterm db_delete_all_objects_get_nitems_from_holder_tree(Process* p, + Eterm nitems_holder); #ifdef HARDDEBUG static void db_check_table_tree(DbTable *tbl); #endif @@ -478,6 +493,7 @@ DbTableMethod db_tree = db_select_replace_continue_tree, db_take_tree, db_delete_all_objects_tree, + db_delete_all_objects_get_nitems_from_holder_tree, db_free_empty_table_tree, db_free_table_continue_tree, db_print_tree, @@ -595,7 +611,8 @@ int db_last_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root, } if (stack) { PUSH_NODE(stack, this); - stack->slot = NITEMS(tbl); + /* Always centralized counters when static stack is used */ + stack->slot = NITEMS_CENTRALIZED(tbl); release_stack(tbl,stack_container,stack); } *ret = db_copy_key(p, tbl, &this->dbterm); @@ -661,10 +678,7 @@ int db_put_tree_common(DbTableCommon *tb, TreeDbTerm **root, Eterm obj, for (;;) if (!*this) { /* Found our place */ state = 1; - if (erts_atomic_inc_read_nob(&tb->nitems) >= TREE_MAX_ELEMENTS) { - erts_atomic_dec_nob(&tb->nitems); - return DB_ERROR_SYSRES; - } + INC_NITEMS(((DbTable*)tb)); *this = new_dbterm(tb, obj); (*this)->balance = 0; (*this)->left = (*this)->right = NULL; @@ -888,7 +902,7 @@ int db_slot_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root, TreeDbTerm *st; Eterm *hp, *hend; Eterm copy; - + int is_EOT = 0; /* * The notion of a "slot" is not natural in a tree, but we try to * simulate it by giving the n'th node in the tree instead. @@ -899,10 +913,10 @@ int db_slot_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root, if (is_not_small(slot_term) || ((slot = signed_val(slot_term)) < 0) || - (slot > NITEMS(tbl))) + (IS_CENTRALIZED_CTR(tbl) && slot > NITEMS_CENTRALIZED(tbl))) return DB_ERROR_BADPARAM; - if (slot == NITEMS(tbl)) { + if (IS_CENTRALIZED_CTR(tbl) && slot == NITEMS_CENTRALIZED(tbl)) { *ret = am_EOT; return DB_ERROR_NONE; } @@ -912,7 +926,11 @@ int db_slot_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root, * are counted from 1 and up. */ ++slot; - st = slot_search(p, root, slot, tbl, stack_container, iter); + st = slot_search(p, root, slot, tbl, stack_container, iter, &is_EOT); + if (is_EOT) { + *ret = am_EOT; + return DB_ERROR_NONE; + } if (st == NULL) { *ret = am_false; return DB_ERROR_UNSPEC; @@ -2244,7 +2262,8 @@ void db_print_tree_common(fmtfn_t to, void *to_arg, erts_print(to, to_arg, "\n" "------------------------------------------------\n"); #else - erts_print(to, to_arg, "Ordered set (AVL tree), Elements: %d\n", NITEMS(tbl)); + erts_print(to, to_arg, "Ordered set (AVL tree), Elements: %d\n", + erts_flxctr_read_approx(&tbl->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID)); #endif } @@ -2281,24 +2300,41 @@ static SWord db_free_table_continue_tree(DbTable *tbl, SWord reds) (DbTable *) tb, (void *) tb->static_stack.array, sizeof(TreeDbTerm *) * STACK_NEED); - ASSERT((erts_atomic_read_nob(&tb->common.memory_size) - == sizeof(DbTable)) || - (erts_atomic_read_nob(&tb->common.memory_size) - == (sizeof(DbTable) + sizeof(DbFixation)))); + ASSERT(erts_flxctr_is_snapshot_ongoing(&tb->common.counters) || + ((APPROX_MEM_CONSUMED(tb) + == sizeof(DbTable)) || + (APPROX_MEM_CONSUMED(tb) + == (sizeof(DbTable) + sizeof(DbFixation))))); } return reds; } -static SWord db_delete_all_objects_tree(Process* p, DbTable* tbl, SWord reds) +static SWord db_delete_all_objects_tree(Process* p, + DbTable* tbl, + SWord reds, + Eterm* nitems_holder_wb) { + if (nitems_holder_wb != NULL) { + Uint nr_of_items = + erts_flxctr_read_centralized(&tbl->common.counters, + ERTS_DB_TABLE_NITEMS_COUNTER_ID); + *nitems_holder_wb = erts_make_integer(nr_of_items, p); + } reds = db_free_table_continue_tree(tbl, reds); if (reds < 0) return reds; db_create_tree(p, tbl); - erts_atomic_set_nob(&tbl->tree.common.nitems, 0); + RESET_NITEMS(tbl); return reds; } +static Eterm db_delete_all_objects_get_nitems_from_holder_tree(Process* p, + Eterm holder) +{ + (void)p; + return holder; +} + static void do_db_tree_foreach_offheap(TreeDbTerm *, void (*)(ErlOffHeap *, void *), void *); @@ -2383,7 +2419,7 @@ static TreeDbTerm *linkout_tree(DbTableCommon *tb, TreeDbTerm **root, tstack[tpos++] = this; state = delsub(this); } - erts_atomic_dec_nob(&tb->nitems); + DEC_NITEMS(((DbTable*)tb)); break; } } @@ -2450,7 +2486,7 @@ static TreeDbTerm *linkout_object_tree(DbTableCommon *tb, TreeDbTerm **root, tstack[tpos++] = this; state = delsub(this); } - erts_atomic_dec_nob(&tb->nitems); + DEC_NITEMS(((DbTable*)tb)); break; } } @@ -2745,7 +2781,8 @@ static int delsub(TreeDbTerm **this) static TreeDbTerm *slot_search(Process *p, TreeDbTerm *root, Sint slot, DbTable *tb, DbTableTree *stack_container, - CATreeRootIterator *iter) + CATreeRootIterator *iter, + int* is_EOT) { TreeDbTerm *this; TreeDbTerm *tmp; @@ -2837,8 +2874,12 @@ static TreeDbTerm *slot_search(Process *p, TreeDbTerm *root, break; next_root: - if (!iter) + if (!iter) { + if (stack->slot == (slot-1)) { + *is_EOT = 1; + } break; /* EOT */ + } ASSERT(slot > stack->slot); if (lastobj) { @@ -2846,8 +2887,12 @@ next_root: lastobj = NULL; } pp = catree_find_next_root(iter, &lastkey); - if (!pp) + if (!pp) { + if (stack->slot == (slot-1)) { + *is_EOT = 1; + } break; /* EOT */ + } root = *pp; stack->pos = 0; find_next(&tb->common, root, stack, lastkey); diff --git a/erts/emulator/beam/erl_db_tree_util.h b/erts/emulator/beam/erl_db_tree_util.h index 02df74678d..ba4a8f79e5 100644 --- a/erts/emulator/beam/erl_db_tree_util.h +++ b/erts/emulator/beam/erl_db_tree_util.h @@ -25,6 +25,8 @@ ** Internal functions and macros used by both the CA tree and the AVL tree */ + +#if defined(ARCH_32) /* ** A stack of this size is enough for an AVL tree with more than ** 0xFFFFFFFF elements. May be subject to change if @@ -34,8 +36,19 @@ ** Where n denotes the number of nodes, h(n) the height of the tree ** with n nodes and log is the binary logarithm. */ - #define STACK_NEED 50 +#elif defined(ARCH_64) +/* +** A stack of this size is enough for an AVL tree with more than +** 2^61 elements. +** The Maximal height of an AVL tree is calculated as above. +*/ +#define STACK_NEED 90 +#else +#error "Unsported architecture" +#endif + + #define PUSH_NODE(Dtt, Tdt) \ ((Dtt)->array[(Dtt)->pos++] = Tdt) @@ -50,6 +63,9 @@ #define EMPTY_NODE(Dtt) (TOP_NODE(Dtt) == NULL) +#define DEC_NITEMS(DB) \ + erts_flxctr_dec(&(DB)->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID) + static ERTS_INLINE void free_term(DbTable *tb, TreeDbTerm* p) { db_free_term(tb, p, offsetof(TreeDbTerm, dbterm)); diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h index e3d3c0e804..02d4dd6c9a 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -21,6 +21,7 @@ #ifndef _DB_UTIL_H #define _DB_UTIL_H +#include "erl_flxctr.h" #include "global.h" #include "erl_message.h" #include "erl_bif_unique.h" @@ -207,8 +208,12 @@ typedef struct db_table_method enum DbIterSafety*); int (*db_take)(Process *, DbTable *, Eterm, Eterm *); - SWord (*db_delete_all_objects)(Process* p, DbTable* db, SWord reds); - + SWord (*db_delete_all_objects)(Process* p, + DbTable* db, + SWord reds, + Eterm* nitems_holder_wb); + Eterm (*db_delete_all_objects_get_nitems_from_holder)(Process* p, + Eterm nitems_holder); int (*db_free_empty_table)(DbTable* db); SWord (*db_free_table_continue)(DbTable* db, SWord reds); @@ -257,6 +262,9 @@ typedef struct { DbTable *prev; } DbTableList; +#define ERTS_DB_TABLE_NITEMS_COUNTER_ID 0 +#define ERTS_DB_TABLE_MEM_COUNTER_ID 1 + /* * This structure contains data for all different types of database * tables. Note that these fields must match the same fields @@ -281,8 +289,11 @@ typedef struct db_table_common { Eterm the_name; /* an atom */ Binary *btid; DbTableMethod* meth; /* table methods */ - erts_atomic_t nitems; /* Total number of items in table */ - erts_atomic_t memory_size;/* Total memory size. NOTE: in bytes! */ + /* The ErtsFlxCtr below contains: + * - Total number of items in table + * - Total memory size (NOTE: in bytes!) */ + ErtsFlxCtr counters; + char extra_for_flxctr[ERTS_FLXCTR_NR_OF_EXTRA_BYTES(2)]; struct { /* Last fixation time */ ErtsMonotonicTime monotonic; ErtsMonotonicTime offset; @@ -315,6 +326,7 @@ typedef struct db_table_common { #define DB_BUSY (1 << 12) #define DB_CATREE_FORCE_SPLIT (1 << 31) /* erts_debug */ +#define DB_CATREE_DEBUG_RANDOM_SPLIT_JOIN (1 << 30) /* erts_debug */ #define IS_HASH_TABLE(Status) (!!((Status) & \ (DB_BAG | DB_SET | DB_DUPLICATE_BAG))) diff --git a/erts/emulator/beam/erl_flxctr.c b/erts/emulator/beam/erl_flxctr.c new file mode 100644 index 0000000000..35f4a21508 --- /dev/null +++ b/erts/emulator/beam/erl_flxctr.c @@ -0,0 +1,370 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2019. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +/* + * Author: Kjell Winblad + */ + +#include "erl_flxctr.h" + +static int reader_groups_array_size = 0; +#define ERTS_FLXCTR_DECENTRALIZED_NO_SLOTS (reader_groups_array_size) + +static int erts_flxctr_read_ctx_bin_dtor(Binary *context_bin); +static int erts_flxctr_wait_dtor(Binary *context_bin); + +typedef struct { + ErtsThrPrgrLaterOp later_op; + Process* process; + ErtsFlxCtrDecentralizedCtrArray* array; + ErtsFlxCtrDecentralizedCtrArray* next_array; + ErtsAlcType_t alloc_type; + int nr_of_counters; + Sint result[ERTS_FLXCTR_ATOMICS_PER_CACHE_LINE]; +} DecentralizedReadSnapshotInfo; + +typedef enum { + ERTS_FLXCTR_SNAPSHOT_NOT_ONGOING = 0, + ERTS_FLXCTR_SNAPSHOT_ONGOING = 1, + ERTS_FLXCTR_SNAPSHOT_ONGOING_TP_THREAD_DO_FREE = 2 +} erts_flxctr_snapshot_status; + +static void +thr_prg_wake_up_and_count(void* bin_p) +{ + Binary* bin = bin_p; + DecentralizedReadSnapshotInfo* info = ERTS_MAGIC_BIN_DATA(bin); + Process* p = info->process; + ErtsFlxCtrDecentralizedCtrArray* array = info->array; + ErtsFlxCtrDecentralizedCtrArray* next = info->next_array; + int i, sched; + /* Reset result array */ + for (i = 0; i < info->nr_of_counters; i++) { + info->result[i] = 0; + } + /* Read result from snapshot */ + for (sched = 0; sched < ERTS_FLXCTR_DECENTRALIZED_NO_SLOTS; sched++) { + for (i = 0; i < info->nr_of_counters; i++) { + info->result[i] = info->result[i] + + erts_atomic_read_nob(&array->array[sched].counters[i]); + } + } + /* Update the next decentralized counter array */ + for (i = 0; i < info->nr_of_counters; i++) { + erts_atomic_add_nob(&next->array[0].counters[i], info->result[i]); + } + /* Announce that the snapshot is done */ + { + Sint expected = ERTS_FLXCTR_SNAPSHOT_ONGOING; + if (expected != erts_atomic_cmpxchg_mb(&next->snapshot_status, + ERTS_FLXCTR_SNAPSHOT_NOT_ONGOING, + expected)) { + /* The CAS failed which means that this thread need to free the next array. */ + erts_free(info->alloc_type, next->block_start); + } + } + /* Resume the process that requested the snapshot */ + erts_proc_lock(p, ERTS_PROC_LOCK_STATUS); + if (!ERTS_PROC_IS_EXITING(p)) { + erts_resume(p, ERTS_PROC_LOCK_STATUS); + } + /* Free the memory that is no longer needed */ + erts_free(info->alloc_type, array->block_start); + erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_proc_dec_refc(p); + erts_bin_release(bin); +} + +typedef struct { + ErtsThrPrgrLaterOp later_op; + Process* process; +} ErtsFlxCtrWakeUpLaterInfo; + +static void +thr_prg_wake_up_later(void* bin_p) +{ + Binary* bin = bin_p; + ErtsFlxCtrWakeUpLaterInfo* info = ERTS_MAGIC_BIN_DATA(bin); + Process* p = info->process; + /* Resume the requesting process */ + erts_proc_lock(p, ERTS_PROC_LOCK_STATUS); + if (!ERTS_PROC_IS_EXITING(p)) { + erts_resume(p, ERTS_PROC_LOCK_STATUS); + } + erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + /* Free data */ + erts_proc_dec_refc(p); + erts_bin_release(bin); +} + +static +int erts_flxctr_read_ctx_bin_dtor(Binary *context_bin) { + (void)context_bin; + return 1; +} + +static +int erts_flxctr_wait_dtor(Binary *context_bin) { + (void)context_bin; + return 1; +} + +static void suspend_until_thr_prg(Process* p) +{ + Binary* state_bin; + ErtsFlxCtrWakeUpLaterInfo* info; + state_bin = erts_create_magic_binary(sizeof(ErtsFlxCtrWakeUpLaterInfo), + erts_flxctr_wait_dtor); + info = ERTS_MAGIC_BIN_DATA(state_bin); + info->process = p; + erts_refc_inctest(&state_bin->intern.refc, 1); + erts_suspend(p, ERTS_PROC_LOCK_MAIN, NULL); + erts_proc_inc_refc(p); + ERTS_VBUMP_ALL_REDS(p); + erts_schedule_thr_prgr_later_op(thr_prg_wake_up_later, state_bin, &info->later_op); +} + + +static ErtsFlxCtrDecentralizedCtrArray* +create_decentralized_ctr_array(ErtsAlcType_t alloc_type, Uint nr_of_counters) { + /* Allocate an ErtsFlxCtrDecentralizedCtrArray and make sure that + the array field is located at the start of a cache line */ + char* bytes = + erts_alloc(alloc_type, + sizeof(ErtsFlxCtrDecentralizedCtrArray) + + (sizeof(ErtsFlxCtrDecentralizedCtrArrayElem) * + ERTS_FLXCTR_DECENTRALIZED_NO_SLOTS) + + ERTS_CACHE_LINE_SIZE); + void* block_start = bytes; + int bytes_to_next_cacheline_border; + ErtsFlxCtrDecentralizedCtrArray* array; + int i, sched; + bytes = &bytes[offsetof(ErtsFlxCtrDecentralizedCtrArray, array)]; + bytes_to_next_cacheline_border = + ERTS_CACHE_LINE_SIZE - (((Uint)bytes) % ERTS_CACHE_LINE_SIZE); + array = (ErtsFlxCtrDecentralizedCtrArray*) + (&bytes[bytes_to_next_cacheline_border - + (int)offsetof(ErtsFlxCtrDecentralizedCtrArray, array)]); + ASSERT(((Uint)array->array) % ERTS_CACHE_LINE_SIZE == 0); + ASSERT(((Uint)array - (Uint)block_start) <= ERTS_CACHE_LINE_SIZE); + /* Initialize fields */ + erts_atomic_init_nob(&array->snapshot_status, ERTS_FLXCTR_SNAPSHOT_ONGOING); + for (sched = 0; sched < ERTS_FLXCTR_DECENTRALIZED_NO_SLOTS; sched++) { + for (i = 0; i < nr_of_counters; i++) { + erts_atomic_init_nob(&array->array[sched].counters[i], 0); + } + } + array->block_start = block_start; + return array; +} + +void erts_flxctr_setup(int decentralized_counter_groups) +{ + reader_groups_array_size = decentralized_counter_groups+1; +} + +void erts_flxctr_init(ErtsFlxCtr* c, + int is_decentralized, + Uint nr_of_counters, + ErtsAlcType_t alloc_type) +{ + ASSERT(nr_of_counters <= ERTS_FLXCTR_ATOMICS_PER_CACHE_LINE); + c->is_decentralized = is_decentralized; + c->nr_of_counters = nr_of_counters; + if (c->is_decentralized) { + ErtsFlxCtrDecentralizedCtrArray* array = + create_decentralized_ctr_array(alloc_type, nr_of_counters); + erts_atomic_set_nob(&array->snapshot_status, + ERTS_FLXCTR_SNAPSHOT_NOT_ONGOING); + erts_atomic_init_nob(&c->u.counters_ptr, (Sint)array); + ASSERT(((Uint)array->array) % ERTS_CACHE_LINE_SIZE == 0); + } else { + int i; + for (i = 0; i < nr_of_counters; i++) { + erts_atomic_init_nob(&c->u.counters[i], 0); + } + } +} + +void erts_flxctr_destroy(ErtsFlxCtr* c, ErtsAlcType_t type) +{ + if (c->is_decentralized) { + if (erts_flxctr_is_snapshot_ongoing(c)) { + ErtsFlxCtrDecentralizedCtrArray* array = + ERTS_FLXCTR_GET_CTR_ARRAY_PTR(c); + /* Try to delegate the resposibilty of freeing to + thr_prg_wake_up_and_count */ + Sint expected = ERTS_FLXCTR_SNAPSHOT_ONGOING; + if (expected != + erts_atomic_cmpxchg_mb(&array->snapshot_status, + ERTS_FLXCTR_SNAPSHOT_ONGOING_TP_THREAD_DO_FREE, + expected)) { + /* The delegation was unsuccessful which means that no + snapshot is ongoing anymore and the freeing needs + to be done here */ + ERTS_ASSERT(!erts_flxctr_is_snapshot_ongoing(c)); + erts_free(type, array->block_start); + } + } else { + erts_free(type, ERTS_FLXCTR_GET_CTR_ARRAY_PTR(c)->block_start); + } + } +} + +ErtsFlxCtrSnapshotResult +erts_flxctr_snapshot(ErtsFlxCtr* c, + ErtsAlcType_t alloc_type, + Process* p) +{ + if (c->is_decentralized) { + ErtsFlxCtrDecentralizedCtrArray* array = ERTS_FLXCTR_GET_CTR_ARRAY_PTR(c); + if (erts_flxctr_is_snapshot_ongoing(c)) { + /* Let the caller try again later */ + ErtsFlxCtrSnapshotResult res = + {.type = ERTS_FLXCTR_TRY_AGAIN_AFTER_TRAP}; + suspend_until_thr_prg(p); + return res; + } else { + Eterm* hp; + Binary* state_bin; + Eterm state_mref; + DecentralizedReadSnapshotInfo* info; + ErtsFlxCtrDecentralizedCtrArray* new_array = + create_decentralized_ctr_array(alloc_type, c->nr_of_counters); + int success = + ((Sint)array) == erts_atomic_cmpxchg_mb(&c->u.counters_ptr, + (Sint)new_array, + (Sint)array); + if (!success) { + /* Let the caller try again later */ + ErtsFlxCtrSnapshotResult res = + {.type = ERTS_FLXCTR_TRY_AGAIN_AFTER_TRAP}; + suspend_until_thr_prg(p); + erts_free(alloc_type, new_array->block_start); + return res; + } + /* Create binary with info about the operation that can be + sent to the caller and to a thread progress function */ + state_bin = + erts_create_magic_binary(sizeof(DecentralizedReadSnapshotInfo), + erts_flxctr_read_ctx_bin_dtor); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + state_mref = erts_mk_magic_ref(&hp, &MSO(p), state_bin); + info = ERTS_MAGIC_BIN_DATA(state_bin); + info->alloc_type = alloc_type; + info->array = array; + info->next_array = new_array; + info->process = p; + info->nr_of_counters = c->nr_of_counters; + erts_proc_inc_refc(p); + erts_refc_inctest(&state_bin->intern.refc, 2); + erts_suspend(p, ERTS_PROC_LOCK_MAIN, NULL); + ERTS_VBUMP_ALL_REDS(p); + erts_schedule_thr_prgr_later_op(thr_prg_wake_up_and_count, + state_bin, + &info->later_op); + { + ErtsFlxCtrSnapshotResult res = { + .type = ERTS_FLXCTR_GET_RESULT_AFTER_TRAP, + .trap_resume_state = state_mref}; + return res; + } + } + } else { + ErtsFlxCtrSnapshotResult res; + int i; + res.type = ERTS_FLXCTR_DONE; + for (i = 0; i < c->nr_of_counters; i++){ + res.result[i] = erts_flxctr_read_centralized(c, i); + } + return res; + } +} + + +Sint erts_flxctr_get_snapshot_result_after_trap(Eterm result_holder, + Uint counter_nr) +{ + Binary* bin = erts_magic_ref2bin(result_holder); + DecentralizedReadSnapshotInfo* data = ERTS_MAGIC_BIN_DATA(bin);; + return data->result[counter_nr]; +} + +int erts_flxctr_is_snapshot_result(Eterm term) +{ + if (is_internal_magic_ref(term)) { + Binary* bin = erts_magic_ref2bin(term); + return ERTS_MAGIC_BIN_DESTRUCTOR(bin) == erts_flxctr_read_ctx_bin_dtor; + } else return 0; +} + +Sint erts_flxctr_read_approx(ErtsFlxCtr* c, + Uint counter_nr) +{ + if (c->is_decentralized) { + ErtsFlxCtrDecentralizedCtrArray* counter = ERTS_FLXCTR_GET_CTR_ARRAY_PTR(c); + Sint sum = 0; + int sched; + for (sched = 0; sched < ERTS_FLXCTR_DECENTRALIZED_NO_SLOTS; sched++) { + sum = sum + erts_atomic_read_nob(&counter->array[sched].counters[counter_nr]); + } + return sum; + } else { + return erts_flxctr_read_centralized(c, counter_nr); + } +} + +int erts_flxctr_is_snapshot_ongoing(ErtsFlxCtr* c) +{ + return c->is_decentralized && + (ERTS_FLXCTR_SNAPSHOT_NOT_ONGOING != + erts_atomic_read_acqb(&ERTS_FLXCTR_GET_CTR_ARRAY_PTR(c)->snapshot_status)); +} + +int erts_flxctr_suspend_until_thr_prg_if_snapshot_ongoing(ErtsFlxCtr* c, Process* p) +{ + if (erts_flxctr_is_snapshot_ongoing(c)) { + suspend_until_thr_prg(p); + return 1; + } else { + return 0; + } +} + +void erts_flxctr_reset(ErtsFlxCtr* c, + Uint counter_nr) +{ + if (c->is_decentralized) { + int sched; + ErtsFlxCtrDecentralizedCtrArray* counter = + ERTS_FLXCTR_GET_CTR_ARRAY_PTR(c); + for (sched = 0; sched < ERTS_FLXCTR_DECENTRALIZED_NO_SLOTS; sched++) { + erts_atomic_set_nob(&counter->array[sched].counters[counter_nr], 0); + } + } else { + erts_atomic_set_nob(&c->u.counters[counter_nr], 0); + } +} + + +void erts_flxctr_set_slot(int group) { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + esdp->flxctr_slot_no = group; +} diff --git a/erts/emulator/beam/erl_flxctr.h b/erts/emulator/beam/erl_flxctr.h new file mode 100644 index 0000000000..5cab02b9eb --- /dev/null +++ b/erts/emulator/beam/erl_flxctr.h @@ -0,0 +1,406 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2019. All Rights Reserved. + * + * Licensed under the Apache License, Version 2.0 (the "License"); + * you may not use this file except in compliance with the License. + * You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + * + * %CopyrightEnd% + */ + +/** + * @file erl_flxctr.h + * + * @brief This file contains the API of a flexible counter. The + * counter can be configured during its initialization to be + * centralized or decentralized. The centralized configuration makes + * it possible to read the counter value extremely efficiently, but + * updates of the counter value can easily cause contention. The + * decentralized configuration has the reverse trade-off (i.e., + * updates are efficient and scalable but reading the counter value is + * slow and may cause contention). + * + * @author Kjell Winblad + */ + +#ifndef ERL_FLXCTR_H__ +#define ERL_FLXCTR_H__ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "error.h" +#include "bif.h" +#include "big.h" +#include "erl_binary.h" +#include "bif.h" +#include <stddef.h> + +/* Public Interface */ + +#define ERTS_MAX_FLXCTR_GROUPS 256 +#define ERTS_FLXCTR_ATOMICS_PER_CACHE_LINE (ERTS_CACHE_LINE_SIZE / sizeof(erts_atomic_t)) + +typedef struct { + int nr_of_counters; + int is_decentralized; + union { + erts_atomic_t counters_ptr; + erts_atomic_t counters[1]; + } u; +} ErtsFlxCtr; + +#define ERTS_FLXCTR_NR_OF_EXTRA_BYTES(NR_OF_COUNTERS) \ + ((NR_OF_COUNTERS-1) * sizeof(erts_atomic_t)) + +/* Called by early_init */ +void erts_flxctr_setup(int decentralized_counter_groups); + +/** + * @brief Initializes an ErtsFlxCtr. The macro + * ERTS_FLXCTR_NR_OF_EXTRA_BYTES should be used to determine how much + * extra space that needs to be allocated directly after the + * ErtsFlxCtr when is_decentralized is set to zero. Each ErtsFlxCtr + * instance may contain up to ERTS_FLXCTR_ATOMICS_PER_CACHE_LINE + * counters. These counters are numbered from zero to + * (ERTS_FLXCTR_ATOMICS_PER_CACHE_LINE-1). Most of the functions in + * this module take a parameter named counter_nr that controls which + * of the ERTS_FLXCTR_ATOMICS_PER_CACHE_LINE counters in the given + * ErtsFlxCtr that should be operated on. + * + * @param c The counter to initialize + * @param is_decentralized Non-zero value to make c decentralized + * @param nr_of_counters The number of counters included in c + * (max ERTS_FLXCTR_ATOMICS_PER_CACHE_LINE) + * @param alloc_type + */ +void erts_flxctr_init(ErtsFlxCtr* c, + int is_decentralized, + Uint nr_of_counters, + ErtsAlcType_t alloc_type); + +/** + * @brief Destroys an initialized counter. + * + * @param c The counter that should be destroyed + * @param alloc_type The allocation type (needs to be the same as the + * one passed to erts_flxctr_init when c was + * initialized) + */ +void erts_flxctr_destroy(ErtsFlxCtr* c, ErtsAlcType_t alloc_type); + +/** + * @brief Adds to_add to the counter with counter_nr in c + * + * @param c the ErtsFlxCtr to operate on + * @param counter_nr The number of the counter in c to modify + * @param to_add The amount that should be added to the specified counter + */ +ERTS_GLB_INLINE +void erts_flxctr_add(ErtsFlxCtr* c, + Uint counter_nr, + int to_add); + +/** + * @brief Increases the specified counter by 1 + * + * @param c The ErtsFlxCtr instance to operate on + * @param counter_nr The number of the counter within c to operate on + */ +ERTS_GLB_INLINE +void erts_flxctr_inc(ErtsFlxCtr* c, + Uint counter_nr); + +/** + * @brief Decreases the specified counter by 1 + */ +ERTS_GLB_INLINE +void erts_flxctr_dec(ErtsFlxCtr* c, + Uint counter_nr); + +/** + * @brief This function tries to return the current value of the + * specified counter but may return an incorrect result if the counter + * is decentralized and other threads are accessing the counter + * concurrently. + * + * @param c The ErtsFlxCtr instance to operate on + * @param counter_nr The number of the counter within c to operate on + * + * @return A snapshot of the specifed counter if c is centralized or a + * possibly incorrect estimate of the counter value if c is + * decentralized + */ +Sint erts_flxctr_read_approx(ErtsFlxCtr* c, + Uint counter_nr); + +/** + * @brief This function can only be used together with an ErtsFlxCtr + * that is configured to be centralized. The function increments the + * specified counter by 1 and returns the value of the counter after + * the increment. + */ +ERTS_GLB_INLINE +Sint erts_flxctr_inc_read_centralized(ErtsFlxCtr* c, + Uint counter_nr); + +/** + * @brief This function can only be used together with a ErtsFlxCtr + * that is configured to be centralized. The function decrements the + * specified counter by 1 and returns the value of the counter after + * the operation. + */ +ERTS_GLB_INLINE +Sint erts_flxctr_dec_read_centralized(ErtsFlxCtr* c, + Uint counter_nr); + +/** + * @brief This function can only be used together with an ErtsFlxCtr + * that is configured to be centralized. The function returns the + * current value of the specified counter. + */ +ERTS_GLB_INLINE +Sint erts_flxctr_read_centralized(ErtsFlxCtr* c, + Uint counter_nr); + + +typedef enum { + ERTS_FLXCTR_TRY_AGAIN_AFTER_TRAP, + ERTS_FLXCTR_DONE, + ERTS_FLXCTR_GET_RESULT_AFTER_TRAP +} ErtsFlxctrSnapshotResultType; + +typedef struct { + ErtsFlxctrSnapshotResultType type; + Eterm trap_resume_state; + Sint result[ERTS_FLXCTR_ATOMICS_PER_CACHE_LINE]; +} ErtsFlxCtrSnapshotResult; + +/** + * @brief This function initiates an atomic snapshot of an ErtsFlxCtr + * to read out the values of one or more of the counters that are + * stored in the given ErtsFlxCtr. The caller needs to perform + * different actions after the return of this function depending on + * the value of the type field in the returned struct: + * + * - The caller needs to trap and try again after the trap if the + * return value has the type ERTS_FLXCTR_TRY_AGAIN_AFTER_TRAP. + * + * - The caller can get the result directly from the result field of + * the returned struct if the return value has the type + * ERTS_FLXCTR_DONE. The value at index i in the result field + * correspond to counter number i. + * + * - Finally, if the return value has the type + * ERTS_FLXCTR_GET_RESULT_AFTER_TRAP, then the caller needs to save + * the value of the field trap_resume_state from the returned struct + * and trap. After the trap, the values of the counters can be + * obtained by using the function + * erts_flxctr_get_snapshot_result_after_trap. Note that the + * function erts_flxctr_is_snapshot_result can be used to check if a + * value is obtained from the trap_resume_state field in the + * returned struct (this can be useful when the calling function + * wakes up again after the trap). + * + * The snapshot operation that is initiated by this function should be + * considered to be ongoing from the issuing of this function until a + * struct with the type field set to ERTS_FLXCTR_DONE has been + * returned from the function or until the caller of this function has + * woken up after trapping. + * + * @param c The ErtsFlxCtr that the snapshot shall be taken from + * @param alloc_type The allocation type (needs to be the same as the + * type passed to erts_flxctr_init when c was + * initialized) + * @param p The Erlang process that is doing the call + * + * @return See the description above + * + */ +ErtsFlxCtrSnapshotResult +erts_flxctr_snapshot(ErtsFlxCtr* c, + ErtsAlcType_t alloc_type, + Process* p); + +/** + * @brief Checks if the parameter term is a snapshot result (i.e., + * something obtained from the trap_resume_state field of an + * ErtsFlxCtrSnapshotResult struct that has been returned from + * erts_flxctr_snapshot). + * + * @param term The term to check + * + * @return A nonzero value iff the term is a snapshot result + */ +int erts_flxctr_is_snapshot_result(Eterm term); + +/** + * @brief Returns the result of a snapshot for a counter given a + * snapshot result returned by a call to erts_flxctr_snapshot (i.e., + * the value stored in the trap_resume_state field of a struct + * returned by erts_flxctr_snapshot). The caller needs to trap between + * the return of erts_flxctr_snapshot and the call to this function. + */ +Sint erts_flxctr_get_snapshot_result_after_trap(Eterm trap_resume_state, + Uint counter_nr); + +/** + * @brief Resets the specified counter to 0. This function is unsafe + * to call while a snapshot operation may be active (initiated with + * the erts_flxctr_snapshot function). + */ +void erts_flxctr_reset(ErtsFlxCtr* c, + Uint counter_nr); + +/** + * @brief Checks if a snapshot operation is active (snapshots are + * initiated with the erts_flxctr_snapshot function). + * + * @return nonzero value iff a snapshot was active at some point + * between the invocation and return of the function + */ +int erts_flxctr_is_snapshot_ongoing(ErtsFlxCtr* c); + +/** + * @brief This function checks if a snapshot operation is ongoing + * (snapshots are initiated with the erts_flxctr_snapshot function) + * and suspend the given process until thread progress has happened if + * it detected an ongoing snapshot operation. The caller needs to trap + * if a non-zero value is returned. + * + * @param c The ErtsFlxCtr to check + * @param p The calling process + * + * @return nonzero value if the given process has got suspended + */ +int erts_flxctr_suspend_until_thr_prg_if_snapshot_ongoing(ErtsFlxCtr* c, Process* p); + +/* End: Public Interface */ + +/* Internal Declarations */ + +#define ERTS_FLXCTR_GET_CTR_ARRAY_PTR(C) \ + ((ErtsFlxCtrDecentralizedCtrArray*) erts_atomic_read_acqb(&(C)->u.counters_ptr)) +#define ERTS_FLXCTR_GET_CTR_PTR(C, SCHEDULER_ID, COUNTER_ID) \ + &(ERTS_FLXCTR_GET_CTR_ARRAY_PTR(C))->array[SCHEDULER_ID].counters[COUNTER_ID] + + +typedef union { + erts_atomic_t counters[ERTS_FLXCTR_ATOMICS_PER_CACHE_LINE]; + char pad[ERTS_CACHE_LINE_SIZE]; +} ErtsFlxCtrDecentralizedCtrArrayElem; + +typedef struct ErtsFlxCtrDecentralizedCtrArray { + void* block_start; + erts_atomic_t snapshot_status; + ErtsFlxCtrDecentralizedCtrArrayElem array[]; +} ErtsFlxCtrDecentralizedCtrArray; + +void erts_flxctr_set_slot(int group); + +ERTS_GLB_INLINE +int erts_flxctr_get_slot_index(void); + +/* End: Internal Declarations */ + + +/* Implementation of inlined functions */ + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE +int erts_flxctr_get_slot_index(void) +{ + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + ASSERT(esdp && !ERTS_SCHEDULER_IS_DIRTY(esdp)); + ASSERT(esdp->flxctr_slot_no > 0); + return esdp->flxctr_slot_no; +} + +ERTS_GLB_INLINE +void erts_flxctr_add(ErtsFlxCtr* c, + Uint counter_nr, + int to_add) +{ + ASSERT(counter_nr < c->nr_of_counters); + if (c->is_decentralized) { + erts_atomic_add_nob(ERTS_FLXCTR_GET_CTR_PTR(c, + erts_flxctr_get_slot_index(), + counter_nr), + to_add); + } else { + erts_atomic_add_nob(&c->u.counters[counter_nr], to_add); + } +} + +ERTS_GLB_INLINE +void erts_flxctr_inc(ErtsFlxCtr* c, + Uint counter_nr) +{ + ASSERT(counter_nr < c->nr_of_counters); + if (c->is_decentralized) { + erts_atomic_inc_nob(ERTS_FLXCTR_GET_CTR_PTR(c, + erts_flxctr_get_slot_index(), + counter_nr)); + } else { + erts_atomic_inc_read_nob(&c->u.counters[counter_nr]); + } +} + +ERTS_GLB_INLINE +void erts_flxctr_dec(ErtsFlxCtr* c, + Uint counter_nr) +{ + ASSERT(counter_nr < c->nr_of_counters); + if (c->is_decentralized) { + erts_atomic_dec_nob(ERTS_FLXCTR_GET_CTR_PTR(c, + erts_flxctr_get_slot_index(), + counter_nr)); + } else { + erts_atomic_dec_nob(&c->u.counters[counter_nr]); + } +} + +ERTS_GLB_INLINE +Sint erts_flxctr_inc_read_centralized(ErtsFlxCtr* c, + Uint counter_nr) +{ + ASSERT(counter_nr < c->nr_of_counters); + ASSERT(!c->is_decentralized); + return erts_atomic_inc_read_nob(&c->u.counters[counter_nr]); +} + +ERTS_GLB_INLINE +Sint erts_flxctr_dec_read_centralized(ErtsFlxCtr* c, + Uint counter_nr) +{ + ASSERT(counter_nr < c->nr_of_counters); + ASSERT(!c->is_decentralized); + return erts_atomic_dec_read_nob(&c->u.counters[counter_nr]); +} + +ERTS_GLB_INLINE +Sint erts_flxctr_read_centralized(ErtsFlxCtr* c, + Uint counter_nr) +{ + ASSERT(counter_nr < c->nr_of_counters); + ASSERT(!c->is_decentralized); + return erts_atomic_read_nob(&((erts_atomic_t*)(c->u.counters))[counter_nr]); +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* ERL_FLXCTR_H__ */ diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 12750b9aa6..547e4064a2 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -593,6 +593,7 @@ void erts_usage(void) erts_fprintf(stderr, " no_time_warp|single_time_warp|multi_time_warp\n"); erts_fprintf(stderr, "-d don't write a crash dump for internally detected errors\n"); erts_fprintf(stderr, " (halt(String) will still produce a crash dump)\n"); + erts_fprintf(stderr, "-dcg set the limit for the number of decentralized counter groups\n"); erts_fprintf(stderr, "-fn[u|a|l] Control how filenames are interpreted\n"); erts_fprintf(stderr, "-hms size set minimum heap size in words (default %d)\n", H_DEFAULT_SIZE); @@ -785,6 +786,8 @@ early_init(int *argc, char **argv) /* int dirty_io_scheds; int max_reader_groups; int reader_groups; + int max_decentralized_counter_groups; + int decentralized_counter_groups; char envbuf[21]; /* enough for any 64-bit integer */ size_t envbufsz; @@ -804,7 +807,8 @@ early_init(int *argc, char **argv) /* erts_initialized = 0; - erts_pre_early_init_cpu_topology(&max_reader_groups, + erts_pre_early_init_cpu_topology(&max_decentralized_counter_groups, + &max_reader_groups, &ncpu, &ncpuonln, &ncpuavail); @@ -865,6 +869,24 @@ early_init(int *argc, char **argv) /* } if (argv[i][0] == '-') { switch (argv[i][1]) { + case 'd': { + char *sub_param = argv[i]+2; + if (has_prefix("cg", sub_param)) { + char *arg = get_arg(sub_param+2, argv[i+1], &i); + if (sscanf(arg, "%d", &max_decentralized_counter_groups) != 1) { + erts_fprintf(stderr, + "bad decentralized counter groups limit: %s\n", arg); + erts_usage(); + } + if (max_decentralized_counter_groups < 0) { + erts_fprintf(stderr, + "bad decentralized counter groups limit: %d\n", + max_decentralized_counter_groups); + erts_usage(); + } + } + break; + } case 'r': { char *sub_param = argv[i]+2; if (has_prefix("g", sub_param)) { @@ -1186,8 +1208,10 @@ early_init(int *argc, char **argv) /* erts_early_init_cpu_topology(no_schedulers, &max_main_threads, max_reader_groups, - &reader_groups); - + &reader_groups, + max_decentralized_counter_groups, + &decentralized_counter_groups); + erts_flxctr_setup(decentralized_counter_groups); { erts_thr_late_init_data_t elid = ERTS_THR_LATE_INIT_DATA_DEF_INITER; elid.mem.std.alloc = ethr_std_alloc; diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 2a0fb9e2aa..6645341512 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -1590,6 +1590,9 @@ void erts_factory_undo(ErtsHeapFactory* factory) factory->message->hfrag.next = factory->heap_frags; else factory->message->data.heap_frag = factory->heap_frags; + /* Set the message to NIL in order for this message not to be + treated as a distributed message by the cleanup_messages logic */ + factory->message->m[0] = NIL; erts_cleanup_messages(factory->message); break; case FACTORY_TMP: diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index deaf35c2a1..1fbe362330 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1344,11 +1344,18 @@ unsigned char* enif_make_new_binary(ErlNifEnv* env, size_t size, int enif_term_to_binary(ErlNifEnv *dst_env, ERL_NIF_TERM term, ErlNifBinary *bin) { - Sint size; + Uint size; byte *bp; Binary* refbin; - size = erts_encode_ext_size(term); + switch (erts_encode_ext_size(term, &size)) { + case ERTS_EXT_SZ_SYSTEM_LIMIT: + return 0; /* system limit */ + case ERTS_EXT_SZ_YIELD: + ERTS_INTERNAL_ERROR("Unexpected yield"); + case ERTS_EXT_SZ_OK: + break; + } if (!enif_alloc_binary(size, bin)) return 0; diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 49dea8919b..4eb6c3e214 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -805,8 +805,7 @@ static int node_table_cmp(void *venp1, void *venp2) { return ((((ErlNode *) venp1)->sysname == ((ErlNode *) venp2)->sysname) && - ((((ErlNode *) venp1)->creation == ((ErlNode *) venp2)->creation) || - (((ErlNode *) venp1)->creation == 0 || ((ErlNode *) venp2)->creation == 0)) + ((((ErlNode *) venp1)->creation == ((ErlNode *) venp2)->creation)) ? 0 : 1); } @@ -977,7 +976,7 @@ static void print_node(void *venp, void *vpndp) if(pndp->sysname == NIL) { erts_print(pndp->to, pndp->to_arg, "Name: %T ", enp->sysname); } - erts_print(pndp->to, pndp->to_arg, " %u", enp->creation); + erts_print(pndp->to, pndp->to_arg, " %d", enp->creation); #ifdef DEBUG erts_print(pndp->to, pndp->to_arg, " (refc=%ld)", erts_refc_read(&enp->refc, 0)); @@ -1020,7 +1019,7 @@ void erts_print_node_info(fmtfn_t to, /* ----------------------------------------------------------------------- */ void -erts_set_this_node(Eterm sysname, Uint32 creation) +erts_set_this_node(Eterm sysname, Uint creation) { ERTS_LC_ASSERT(erts_thr_progress_is_blocking()); ASSERT(2 <= de_refc_read(erts_this_dist_entry, 2)); diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index c434926142..aa8af12555 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -95,6 +95,7 @@ enum dist_entry_state { struct ErtsDistOutputBuf_ { #ifdef DEBUG Uint dbg_pattern; + byte *ext_startp; byte *alloc_endp; #endif ErtsDistOutputBuf *next; @@ -258,7 +259,7 @@ void erts_set_dist_entry_pending(DistEntry *); void erts_set_dist_entry_connected(DistEntry *, Eterm, Uint); ErlNode *erts_find_or_insert_node(Eterm, Uint32, Eterm); void erts_schedule_delete_node(ErlNode *); -void erts_set_this_node(Eterm, Uint32); +void erts_set_this_node(Eterm, Uint); Uint erts_node_table_size(void); void erts_init_node_tables(int); void erts_node_table_info(fmtfn_t, void *); diff --git a/erts/emulator/beam/erl_posix_str.c b/erts/emulator/beam/erl_posix_str.c index 7b3e640d3f..5b515d6e78 100644 --- a/erts/emulator/beam/erl_posix_str.c +++ b/erts/emulator/beam/erl_posix_str.c @@ -171,6 +171,9 @@ erl_errno_id(error) #if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS)) case EIDRM: return "eidrm"; #endif +#ifdef EILSEQ + case EILSEQ: return "eilseq"; +#endif #ifdef EINIT case EINIT: return "einit"; #endif diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c index 4e9f177e51..f58a606d57 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.c +++ b/erts/emulator/beam/erl_proc_sig_queue.c @@ -1019,6 +1019,8 @@ send_gen_exit_signal(Process *c_p, Eterm from_tag, ref_sz = size_object(ref); hsz += ref_sz; + reason_sz = 0; /* Set to silence gcc warning */ + /* The reason was part of the control message, just use copy it into the xsigd */ if (is_value(reason)) { diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 9e662632b4..1f6adb98ef 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -12095,6 +12095,7 @@ erts_proc_exit_handle_dist_monitor(ErtsMonitor *mon, void *vctxt, Sint reds) Eterm watched; Uint watcher_sz, ref_sz; ErtsHeapFactory factory; + Sint reds_consumed = 0; ASSERT(erts_monitor_is_target(mon) && mon->type == ERTS_MON_TYPE_DIST_PROC); @@ -12139,16 +12140,18 @@ erts_proc_exit_handle_dist_monitor(ErtsMonitor *mon, void *vctxt, Sint reds) watched, ref, reason); + reds_consumed = reds - (ctx.reds / TERM_TO_BINARY_LOOP_FACTOR); switch (code) { case ERTS_DSIG_SEND_CONTINUE: + case ERTS_DSIG_SEND_YIELD: erts_set_gc_state(c_p, 0); ctxt->dist_state = erts_dsend_export_trap_context(c_p, &ctx); - /* fall-through */ - case ERTS_DSIG_SEND_YIELD: + reds_consumed = reds; /* force yield */ break; case ERTS_DSIG_SEND_OK: break; case ERTS_DSIG_SEND_TOO_LRG: + erts_kill_dist_connection(dep, dist->connection_id); erts_set_gc_state(c_p, 1); break; default: @@ -12164,7 +12167,7 @@ erts_proc_exit_handle_dist_monitor(ErtsMonitor *mon, void *vctxt, Sint reds) erts_monitor_release(mon); else erts_monitor_release_both(mdp); - return reds - (ctx.reds / TERM_TO_BINARY_LOOP_FACTOR); + return reds_consumed; } int @@ -12351,6 +12354,7 @@ erts_proc_exit_handle_dist_link(ErtsLink *lnk, void *vctxt, Sint reds) ErtsLink *dlnk; ErtsLinkData *ldp = NULL; ErtsHeapFactory factory; + Sint reds_consumed = 0; ASSERT(lnk->type == ERTS_LNK_TYPE_DIST_PROC); dlnk = erts_link_to_other(lnk, &ldp); @@ -12387,16 +12391,18 @@ erts_proc_exit_handle_dist_link(ErtsLink *lnk, void *vctxt, Sint reds) item, reason, SEQ_TRACE_TOKEN(c_p)); + reds_consumed = reds - (ctx.reds / TERM_TO_BINARY_LOOP_FACTOR); switch (code) { + case ERTS_DSIG_SEND_YIELD: case ERTS_DSIG_SEND_CONTINUE: erts_set_gc_state(c_p, 0); ctxt->dist_state = erts_dsend_export_trap_context(c_p, &ctx); - /* fall-through */ - case ERTS_DSIG_SEND_YIELD: + reds_consumed = reds; /* force yield */ break; case ERTS_DSIG_SEND_OK: break; case ERTS_DSIG_SEND_TOO_LRG: + erts_kill_dist_connection(dep, dist->connection_id); erts_set_gc_state(c_p, 1); break; default: @@ -12412,7 +12418,7 @@ erts_proc_exit_handle_dist_link(ErtsLink *lnk, void *vctxt, Sint reds) erts_link_release_both(ldp); else if (lnk) erts_link_release(lnk); - return reds - (ctx.reds / TERM_TO_BINARY_LOOP_FACTOR); + return reds_consumed; } int @@ -12893,7 +12899,9 @@ restart: switch (result) { case ERTS_DSIG_SEND_OK: + break; case ERTS_DSIG_SEND_TOO_LRG: /*SEND_SYSTEM_LIMIT*/ + erts_kill_dist_connection(ctx->dep, ctx->connection_id); break; case ERTS_DSIG_SEND_YIELD: /*SEND_YIELD_RETURN*/ case ERTS_DSIG_SEND_CONTINUE: { /*SEND_YIELD_CONTINUE*/ diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 711b73417d..6118c671ee 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -641,6 +641,7 @@ struct ErtsSchedulerData_ { ErtsSchedType type; Uint no; /* Scheduler number for normal schedulers */ Uint dirty_no; /* Scheduler number for dirty schedulers */ + int flxctr_slot_no; /* slot nr when a flxctr is used */ struct enif_environment_t *current_nif; Process *dirty_shadow_process; Port *current_port; @@ -1847,6 +1848,7 @@ int erts_resume_processes(ErtsProcList *); void erts_deep_process_dump(fmtfn_t, void *); Eterm erts_get_reader_groups_map(Process *c_p); +Eterm erts_get_decentralized_counter_groups_map(Process *c_p); Eterm erts_debug_reader_groups_map(Process *c_p, int groups); Uint erts_debug_nbalance(void); diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index ae7084b7f4..c85a7df5ec 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -635,9 +635,11 @@ write_sys_msg_to_port(Eterm unused_to, Eterm message) { byte *buffer; byte *ptr; - unsigned size; + Uint size; + + if (erts_encode_ext_size(message, &size) != ERTS_EXT_SZ_OK) + erts_exit(ERTS_ERROR_EXIT, "Internal error: System limit\n"); - size = erts_encode_ext_size(message); buffer = (byte *) erts_alloc(ERTS_ALC_T_TMP, size); ptr = buffer; diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index 880febba8b..430ac305c5 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -69,7 +69,6 @@ int erts_fit_in_bits_int32(Sint32); int erts_fit_in_bits_uint(Uint); Sint erts_list_length(Eterm); int erts_is_builtin(Eterm, Eterm, int); -Uint32 block_hash(byte *, unsigned, Uint32); Uint32 make_hash2(Eterm); Uint32 make_hash(Eterm); Uint32 make_internal_hash(Eterm, Uint32 salt); diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 471c1c3938..ec67ab2aed 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -51,17 +51,18 @@ #define MAX_STRING_LEN 0xffff -/* - * MAX value for the creation field in pid, port and reference - * for the old PID_EXT, PORT_EXT, REFERENCE_EXT and NEW_REFERENCE_EXT. - * Older nodes (OTP 19-21) will send us these so we must be able to decode them. - * - * From OTP 22 DFLAG_BIG_CREATION is mandatory so this node will always - * encode with new big 32-bit creations using NEW_PID_EXT, NEW_PORT_EXT - * and NEWER_REFERENCE_EXT. +/* MAX value for the creation field in pid, port and reference + for the local node and for the current external format. + + Larger creation values than this are allowed in external pid, port and refs + encoded with NEW_PID_EXT, NEW_PORT_EXT and NEWER_REFERENCE_EXT. + The point here is to prepare for future upgrade to 32-bit creation. + OTP-19 (erts-8.0) can handle big creation values from other (newer) nodes, + but do not use big creation values for the local node yet, + as we still may have to communicate with older nodes. */ -#define ERTS_MAX_TINY_CREATION (3) -#define is_tiny_creation(Cre) ((unsigned)(Cre) <= ERTS_MAX_TINY_CREATION) +#define ERTS_MAX_LOCAL_CREATION (3) +#define is_valid_creation(Cre) ((unsigned)(Cre) <= ERTS_MAX_LOCAL_CREATION) #undef ERTS_DEBUG_USE_DIST_SEP #ifdef DEBUG @@ -111,13 +112,13 @@ static byte* dec_pid(ErtsDistExternal *, ErtsHeapFactory*, byte*, Eterm*, byte t static Sint decoded_size(byte *ep, byte* endp, int internal_tags, struct B2TContext_t*); static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1); -static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint flags, - Binary *context_b); +static Eterm erts_term_to_binary_int(Process* p, Eterm Term, Eterm opts, int level, + Uint flags, Binary *context_b); static Uint encode_size_struct2(ErtsAtomCacheMap *, Eterm, unsigned); struct TTBSizeContext_; -static int encode_size_struct_int(struct TTBSizeContext_*, ErtsAtomCacheMap *acmp, Eterm obj, - unsigned dflags, Sint *reds, Uint *res); +static ErtsExtSzRes encode_size_struct_int(struct TTBSizeContext_*, ErtsAtomCacheMap *acmp, + Eterm obj, unsigned dflags, Sint *reds, Uint *res); static Export binary_to_term_trap_export; static BIF_RETTYPE binary_to_term_trap_1(BIF_ALIST_1); @@ -602,49 +603,50 @@ done: return reds < 0 ? 0 : reds; } -int erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp, - Uint* szp) +ErtsExtSzRes +erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp, Uint* szp) { Uint sz; - if (encode_size_struct_int(NULL, acmp, term, flags, NULL, &sz)) { - return -1; - } else { + ErtsExtSzRes res = encode_size_struct_int(NULL, acmp, term, flags, NULL, &sz); + if (res == ERTS_EXT_SZ_OK) { #ifndef ERTS_DEBUG_USE_DIST_SEP if (!(flags & (DFLAG_DIST_HDR_ATOM_CACHE | DFLAG_NO_MAGIC))) #endif sz++ /* VERSION_MAGIC */; *szp += sz; - return 0; } + return res; } -int erts_encode_dist_ext_size_int(Eterm term, ErtsDSigSendContext *ctx, Uint* szp) +ErtsExtSzRes +erts_encode_dist_ext_size_ctx(Eterm term, ErtsDSigSendContext *ctx, Uint* szp) { Uint sz; - if (encode_size_struct_int(&ctx->u.sc, ctx->acmp, term, ctx->flags, &ctx->reds, &sz)) { - return -1; - } else { + ErtsExtSzRes res = encode_size_struct_int(&ctx->u.sc, ctx->acmp, term, + ctx->flags, &ctx->reds, &sz); + if (res == ERTS_EXT_SZ_OK) { #ifndef ERTS_DEBUG_USE_DIST_SEP if (!(ctx->flags & (DFLAG_DIST_HDR_ATOM_CACHE | DFLAG_NO_MAGIC))) #endif sz++ /* VERSION_MAGIC */; *szp += sz; - return 0; } + return res; } -Uint erts_encode_ext_size(Eterm term) +ErtsExtSzRes erts_encode_ext_size_2(Eterm term, unsigned dflags, Uint *szp) { - return encode_size_struct2(NULL, term, TERM_TO_BINARY_DFLAGS) - + 1 /* VERSION_MAGIC */; + ErtsExtSzRes res = encode_size_struct_int(NULL, NULL, term, dflags, + NULL, szp); + (*szp)++ /* VERSION_MAGIC */; + return res; } -Uint erts_encode_ext_size_2(Eterm term, unsigned dflags) +ErtsExtSzRes erts_encode_ext_size(Eterm term, Uint *szp) { - return encode_size_struct2(NULL, term, dflags) - + 1 /* VERSION_MAGIC */; + return erts_encode_ext_size_2(term, TERM_TO_BINARY_DFLAGS, szp); } Uint erts_encode_ext_size_ets(Eterm term) @@ -699,6 +701,7 @@ dist_ext_size(ErtsDistExternal *edep) } else { sz -= sizeof(ErtsAtomTranslationTable); } + ASSERT(sz % 4 == 0); return sz; } @@ -706,8 +709,9 @@ Uint erts_dist_ext_size(ErtsDistExternal *edep) { Uint sz = dist_ext_size(edep); + sz += 4; /* may need to pad to 8-byte-align ErtsDistExternalData */ sz += edep->data[0].frag_id * sizeof(ErtsDistExternalData); - return sz + ERTS_EXTRA_DATA_ALIGN_SZ(sz); + return sz; } Uint @@ -749,6 +753,8 @@ erts_make_dist_ext_copy(ErtsDistExternal *edep, ErtsDistExternal *new_edep) erts_ref_dist_entry(new_edep->dep); ep += dist_ext_sz; + ep += (UWord)ep & 4; /* 8-byte alignment for ErtsDistExternalData */ + ASSERT((UWord)ep % 8 == 0); new_edep->data = (ErtsDistExternalData*)ep; sys_memzero(new_edep->data, sizeof(ErtsDistExternalData) * edep->data->frag_id); @@ -1248,9 +1254,22 @@ static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1) { Eterm *tp = tuple_val(BIF_ARG_1); Eterm Term = tp[1]; - Eterm bt = tp[2]; + Eterm Opts = tp[2]; + Eterm bt = tp[3]; Binary *bin = erts_magic_ref2bin(bt); - Eterm res = erts_term_to_binary_int(BIF_P, Term, 0, 0,bin); + Eterm res = erts_term_to_binary_int(BIF_P, Term, Opts, 0, 0,bin); + if (is_non_value(res)) { + if (erts_set_gc_state(BIF_P, 1) + || MSO(BIF_P).overhead > BIN_VHEAP_SZ(BIF_P)) { + ERTS_VBUMP_ALL_REDS(BIF_P); + } + if (Opts == am_undefined) + ERTS_BIF_ERROR_TRAPPED1(BIF_P, SYSTEM_LIMIT, + bif_export[BIF_term_to_binary_1], Term); + else + ERTS_BIF_ERROR_TRAPPED2(BIF_P, SYSTEM_LIMIT, + bif_export[BIF_term_to_binary_2], Term, Opts); + } if (is_tuple(res)) { ASSERT(BIF_P->flags & F_DISABLE_GC); BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res); @@ -1267,7 +1286,12 @@ HIPE_WRAPPER_BIF_DISABLE_GC(term_to_binary, 1) BIF_RETTYPE term_to_binary_1(BIF_ALIST_1) { - Eterm res = erts_term_to_binary_int(BIF_P, BIF_ARG_1, 0, TERM_TO_BINARY_DFLAGS, NULL); + Eterm res = erts_term_to_binary_int(BIF_P, BIF_ARG_1, am_undefined, + 0, TERM_TO_BINARY_DFLAGS, NULL); + if (is_non_value(res)) { + ASSERT(!(BIF_P->flags & F_DISABLE_GC)); + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + } if (is_tuple(res)) { erts_set_gc_state(BIF_P, 0); BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res); @@ -1326,7 +1350,12 @@ BIF_RETTYPE term_to_binary_2(BIF_ALIST_2) goto error; } - res = erts_term_to_binary_int(p, Term, level, flags, NULL); + res = erts_term_to_binary_int(p, Term, BIF_ARG_2, + level, flags, NULL); + if (is_non_value(res)) { + ASSERT(!(BIF_P->flags & F_DISABLE_GC)); + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + } if (is_tuple(res)) { erts_set_gc_state(p, 0); BIF_TRAP1(&term_to_binary_trap_export,BIF_P,res); @@ -1875,8 +1904,17 @@ external_size_1(BIF_ALIST_1) { Process* p = BIF_P; Eterm Term = BIF_ARG_1; + Uint size; + + switch (erts_encode_ext_size(Term, &size)) { + case ERTS_EXT_SZ_SYSTEM_LIMIT: + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + case ERTS_EXT_SZ_YIELD: + ERTS_INTERNAL_ERROR("Unexpected yield"); + case ERTS_EXT_SZ_OK: + break; + } - Uint size = erts_encode_ext_size(Term); if (IS_USMALL(0, size)) { BIF_RET(make_small(size)); } else { @@ -1919,7 +1957,15 @@ external_size_2(BIF_ALIST_2) goto error; } - size = erts_encode_ext_size_2(BIF_ARG_1, flags); + switch (erts_encode_ext_size_2(BIF_ARG_1, flags, &size)) { + case ERTS_EXT_SZ_SYSTEM_LIMIT: + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + case ERTS_EXT_SZ_YIELD: + ERTS_INTERNAL_ERROR("Unexpected yield"); + case ERTS_EXT_SZ_OK: + break; + } + if (IS_USMALL(0, size)) { BIF_RET(make_small(size)); } else { @@ -2007,7 +2053,15 @@ erts_term_to_binary_simple(Process* p, Eterm Term, Uint size, int level, Uint fl Eterm erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) { Uint size; - size = encode_size_struct2(NULL, Term, flags) + 1 /* VERSION_MAGIC */; + switch (encode_size_struct_int(NULL, NULL, Term, flags, NULL, &size)) { + case ERTS_EXT_SZ_SYSTEM_LIMIT: + return THE_NON_VALUE; + case ERTS_EXT_SZ_YIELD: + ERTS_INTERNAL_ERROR("Unexpected yield"); + case ERTS_EXT_SZ_OK: + break; + } + size++; /* VERSION_MAGIC */; return erts_term_to_binary_simple(p, Term, size, level, flags); } @@ -2057,8 +2111,8 @@ static int ttb_context_destructor(Binary *context_bin) return 1; } -static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint flags, - Binary *context_b) +static Eterm erts_term_to_binary_int(Process* p, Eterm Term, Eterm opts, int level, + Uint flags, Binary *context_b) { Eterm *hp; Eterm res; @@ -2076,18 +2130,17 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla do { \ if (context_b == NULL) { \ context_b = erts_create_magic_binary(sizeof(TTBContext), \ - ttb_context_destructor); \ + ttb_context_destructor);\ context = ERTS_MAGIC_BIN_DATA(context_b); \ - sys_memcpy(context,&c_buff,sizeof(TTBContext)); \ + sys_memcpy(context,&c_buff,sizeof(TTBContext)); \ } \ } while (0) #define RETURN_STATE() \ do { \ - static const int TUPLE2_SIZE = 2 + 1; \ - hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE + TUPLE2_SIZE); \ + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE + 1 + 3); \ c_term = erts_mk_magic_ref(&hp, &MSO(p), context_b); \ - res = TUPLE2(hp, Term, c_term); \ + res = TUPLE3(hp, Term, opts, c_term); \ BUMP_ALL_REDS(p); \ return res; \ } while (0); @@ -2113,11 +2166,17 @@ static Eterm erts_term_to_binary_int(Process* p, Eterm Term, int level, Uint fla int level; Uint flags; /* Try for fast path */ - if (encode_size_struct_int(&context->s.sc, NULL, Term, - context->s.sc.flags, &reds, &size) < 0) { + switch (encode_size_struct_int(&context->s.sc, NULL, Term, + context->s.sc.flags, &reds, &size)) { + case ERTS_EXT_SZ_SYSTEM_LIMIT: + BUMP_REDS(p, (initial_reds - reds) / TERM_TO_BINARY_LOOP_FACTOR); + return THE_NON_VALUE; + case ERTS_EXT_SZ_YIELD: EXPORT_CONTEXT(); /* Same state */ RETURN_STATE(); + case ERTS_EXT_SZ_OK: + break; } ++size; /* VERSION_MAGIC */ /* Move these to next state */ @@ -2379,8 +2438,7 @@ enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags) Eterm sysname = ((is_internal_pid(pid) && (dflags & DFLAG_INTERNAL_TAGS)) ? INTERNAL_LOCAL_SYSNAME : pid_node_name(pid)); Uint32 creation = pid_creation(pid); - - *ep++ = NEW_PID_EXT; + byte* tagp = ep++; /* insert atom here containing host and sysname */ ep = enc_atom(acmp, sysname, ep, dflags); @@ -2392,8 +2450,15 @@ enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags) ep += 4; put_int32(os, ep); ep += 4; - put_int32(creation, ep); - ep += 4; + if (creation <= ERTS_MAX_LOCAL_CREATION) { + *tagp = PID_EXT; + *ep++ = creation; + } else { + ASSERT(is_external_pid(pid)); + *tagp = NEW_PID_EXT; + put_int32(creation, ep); + ep += 4; + } return ep; } @@ -2513,7 +2578,7 @@ dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, byte* ep, if (tag == PID_EXT) { cre = get_int8(ep); ep += 1; - if (!is_tiny_creation(cre)) { + if (!is_valid_creation(cre)) { return NULL; } } else { @@ -2774,18 +2839,25 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Eterm sysname = (((dflags & DFLAG_INTERNAL_TAGS) && is_internal_ref(obj)) ? INTERNAL_LOCAL_SYSNAME : ref_node_name(obj)); Uint32 creation = ref_creation(obj); + byte* tagp = ep++; ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); erts_magic_ref_save_bin(obj); - *ep++ = NEWER_REFERENCE_EXT; i = ref_no_numbers(obj); put_int16(i, ep); ep += 2; ep = enc_atom(acmp, sysname, ep, dflags); - put_int32(creation, ep); - ep += 4; + if (creation <= ERTS_MAX_LOCAL_CREATION) { + *tagp = NEW_REFERENCE_EXT; + *ep++ = creation; + } else { + ASSERT(is_external_ref(obj)); + *tagp = NEWER_REFERENCE_EXT; + put_int32(creation, ep); + ep += 4; + } ref_num = ref_numbers(obj); for (j = 0; j < i; j++) { put_int32(ref_num[j], ep); @@ -2798,14 +2870,21 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Eterm sysname = (((dflags & DFLAG_INTERNAL_TAGS) && is_internal_port(obj)) ? INTERNAL_LOCAL_SYSNAME : port_node_name(obj)); Uint32 creation = port_creation(obj); + byte* tagp = ep++; - *ep++ = NEW_PORT_EXT; ep = enc_atom(acmp, sysname, ep, dflags); j = port_number(obj); put_int32(j, ep); ep += 4; - put_int32(creation, ep); - ep += 4; + if (creation <= ERTS_MAX_LOCAL_CREATION) { + *tagp = PORT_EXT; + *ep++ = creation; + } else { + ASSERT(is_external_port(obj)); + *tagp = NEW_PORT_EXT; + put_int32(creation, ep); + ep += 4; + } break; } case LIST_DEF: @@ -3500,7 +3579,7 @@ dec_term_atom_common: if (tag == PORT_EXT) { cre = get_int8(ep); ep++; - if (!is_tiny_creation(cre)) { + if (!is_valid_creation(cre)) { goto error; } } @@ -3547,7 +3626,7 @@ dec_term_atom_common: cre = get_int8(ep); ep += 1; - if (!is_tiny_creation(cre)) { + if (!is_valid_creation(cre)) { goto error; } goto ref_ext_common; @@ -3561,7 +3640,7 @@ dec_term_atom_common: cre = get_int8(ep); ep += 1; - if (!is_tiny_creation(cre)) { + if (!is_valid_creation(cre)) { goto error; } r0 = get_int32(ep); @@ -4159,13 +4238,21 @@ error_hamt: to a sequence of bytes N.B. That this must agree with to_external2() above!!! (except for cached atoms) */ -static Uint encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) { - Uint res; - (void) encode_size_struct_int(NULL, acmp, obj, dflags, NULL, &res); - return res; +static Uint encode_size_struct2(ErtsAtomCacheMap *acmp, + Eterm obj, + unsigned dflags) { + Uint size; + ErtsExtSzRes res = encode_size_struct_int(NULL, acmp, obj, + dflags, NULL, &size); + /* + * encode_size_struct2() only allowed when + * we know the result will always be OK! + */ + ASSERT(res == ERTS_EXT_SZ_OK); (void) res; + return (Uint) size; } -static int +static ErtsExtSzRes encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags, Sint *reds, Uint *res) { @@ -4198,7 +4285,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, ctx->obj = obj; ctx->result = result; WSTACK_SAVE(s, &ctx->wstack); - return -1; + return ERTS_EXT_SZ_YIELD; } switch (tag_val_def(obj)) { case NIL_DEF: @@ -4259,21 +4346,30 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, result += 1 + 4 + 1 + i; /* tag,size,sign,digits */ break; case EXTERNAL_PID_DEF: + if (external_pid_creation(obj) > ERTS_MAX_LOCAL_CREATION) + result += 3; + /*fall through*/ case PID_DEF: result += (1 + encode_size_struct2(acmp, pid_node_name(obj), dflags) + - 4 + 4 + 4); + 4 + 4 + 1); break; case EXTERNAL_REF_DEF: + if (external_ref_creation(obj) > ERTS_MAX_LOCAL_CREATION) + result += 3; + /*fall through*/ case REF_DEF: ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); i = ref_no_numbers(obj); result += (1 + 2 + encode_size_struct2(acmp, ref_node_name(obj), dflags) + - 4 + 4*i); + 1 + 4*i); break; case EXTERNAL_PORT_DEF: + if (external_port_creation(obj) > ERTS_MAX_LOCAL_CREATION) + result += 3; + /*fall through*/ case PORT_DEF: result += (1 + encode_size_struct2(acmp, port_node_name(obj), dflags) + - 4 + 4); + 4 + 1); break; case LIST_DEF: { int is_str = is_external_string(obj, &m); @@ -4365,11 +4461,26 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, result += 32; /* Yes, including the tag */ } break; - case BINARY_DEF: - if (dflags & DFLAG_INTERNAL_TAGS) { + case BINARY_DEF: { + ProcBin* pb = (ProcBin*) binary_val(obj); + Uint tot_bytes = pb->size; + if (!(dflags & DFLAG_INTERNAL_TAGS)) { +#ifdef ARCH_64 + if (tot_bytes >= (Uint) 0xffffffff) { + if (pb->thing_word == HEADER_SUB_BIN) { + ErlSubBin* sub = (ErlSubBin*) pb; + tot_bytes += (sub->bitoffs + sub->bitsize+ 7) / 8; + } + if (tot_bytes > (Uint) 0xffffffff) { + WSTACK_DESTROY(s); + return ERTS_EXT_SZ_SYSTEM_LIMIT; + } + } +#endif + } + else { ProcBin* pb = (ProcBin*) binary_val(obj); Uint sub_extra = 0; - Uint tot_bytes = pb->size; if (pb->thing_word == HEADER_SUB_BIN) { ErlSubBin* sub = (ErlSubBin*) pb; pb = (ProcBin*) binary_val(sub->orig); @@ -4386,6 +4497,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, result += 1 + 4 + binary_size(obj) + 5; /* For unaligned binary */ break; + } case FUN_DEF: { ErlFunThing* funp = (ErlFunThing *) fun_val(obj); @@ -4418,7 +4530,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, break; default: - erts_exit(ERTS_ERROR_EXIT,"Internal data structure error (in encode_size_struct2)%x\n", + erts_exit(ERTS_ERROR_EXIT,"Internal data structure error (in encode_size_struct_int) %x\n", obj); } @@ -4458,7 +4570,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, *reds = r < 0 ? 0 : r; } *res = result; - return 0; + return ERTS_EXT_SZ_OK; } diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index 396cd9f802..b556c9076c 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -144,14 +144,6 @@ typedef struct erl_dist_external { ErtsAtomTranslationTable attab; } ErtsDistExternal; -#define ERTS_DIST_EXT_SIZE(EDEP) \ - (sizeof(ErtsDistExternal) \ - - (((EDEP)->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB) \ - ? (ASSERT(0 <= (EDEP)->attab.size \ - && (EDEP)->attab.size <= ERTS_ATOM_CACHE_SIZE), \ - sizeof(Eterm)*(ERTS_ATOM_CACHE_SIZE - (EDEP)->attab.size)) \ - : sizeof(ErtsAtomTranslationTable))) - typedef struct { byte *extp; int exttmp; @@ -172,14 +164,21 @@ byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *, Uint, Eterm) byte *erts_encode_ext_dist_header_fragment(byte **, Uint, Eterm); Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf*, DistEntry *, Uint32 dflags, Sint reds); struct erts_dsig_send_context; -int erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap*, Uint* szp); -int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx, Uint* szp); + +typedef enum { + ERTS_EXT_SZ_OK, + ERTS_EXT_SZ_YIELD, + ERTS_EXT_SZ_SYSTEM_LIMIT +} ErtsExtSzRes; + +ErtsExtSzRes erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap*, Uint* szp); +ErtsExtSzRes erts_encode_dist_ext_size_ctx(Eterm term, struct erts_dsig_send_context* ctx, Uint* szp); struct TTBEncodeContext_; int erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *, struct TTBEncodeContext_ *, Sint* reds); -Uint erts_encode_ext_size(Eterm); -Uint erts_encode_ext_size_2(Eterm, unsigned); +ErtsExtSzRes erts_encode_ext_size(Eterm, Uint *szp); +ErtsExtSzRes erts_encode_ext_size_2(Eterm, unsigned, Uint *szp); Uint erts_encode_ext_size_ets(Eterm); void erts_encode_ext(Eterm, byte **); byte* erts_encode_ext_ets(Eterm, byte *, struct erl_off_heap_header** ext_off_heap); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index f9bbe4167f..4c8d3d3dbe 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1216,10 +1216,11 @@ Uint64 erts_timestamp_millis(void); Export* erts_find_function(Eterm, Eterm, unsigned int, ErtsCodeIndex); -void *erts_calc_stacklimit(char *prev_c, UWord stacksize); -int erts_check_below_limit(char *ptr, char *limit); -int erts_check_above_limit(char *ptr, char *limit); -void *erts_ptr_id(void *ptr); +/* ERTS_NOINLINE prevents link-time optimization across modules */ +void *erts_calc_stacklimit(char *prev_c, UWord stacksize) ERTS_NOINLINE; +int erts_check_below_limit(char *ptr, char *limit) ERTS_NOINLINE; +int erts_check_above_limit(char *ptr, char *limit) ERTS_NOINLINE; +void *erts_ptr_id(void *ptr) ERTS_NOINLINE; Eterm store_external_or_ref_in_proc_(Process *, Eterm); Eterm store_external_or_ref_(Uint **, ErlOffHeap*, Eterm); diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab index 692408e212..462ee77e6f 100644 --- a/erts/emulator/beam/instrs.tab +++ b/erts/emulator/beam/instrs.tab @@ -1001,7 +1001,7 @@ catch_end(Y) { } /* only x(2) is included in the rootset here */ if (E - HTOP < 3) { - SWAPOUT; + $GC_SWAPOUT(); PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect_nobump(c_p, 3, reg+2, 1, FCALLS); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index b961c639f5..45fef0c0e5 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -4450,6 +4450,7 @@ erts_port_call(Process* c_p, char input_buf[256]; char *bufp; byte *endp; + Uint uintsz; ErlDrvSizeT size; int try_call; erts_aint32_t sched_flags; @@ -4462,7 +4463,9 @@ erts_port_call(Process* c_p, try_call = !(sched_flags & ERTS_PTS_FLGS_FORCE_SCHEDULE_OP); - size = erts_encode_ext_size(data); + if (erts_encode_ext_size(data, &uintsz) != ERTS_EXT_SZ_OK) + return ERTS_PORT_OP_BADARG; + size = (ErlDrvSizeT) uintsz; if (!try_call) bufp = erts_alloc(ERTS_ALC_T_DRV_CALL_DATA, size); @@ -5295,44 +5298,31 @@ erts_get_port_names(Eterm id, ErlDrvPort drv_port) pnp->driver_name = NULL; } else { - int do_realloc = 1; - int len = -1; - size_t pnp_len = sizeof(ErtsPortNames); -#ifndef DEBUG - pnp_len += 100; /* In most cases 100 characters will be enough... */ - ASSERT(prt->common.id == id); -#endif - pnp = erts_alloc(ERTS_ALC_T_PORT_NAMES, pnp_len); - do { - int nlen; - char *name, *driver_name; - if (len > 0) { - erts_free(ERTS_ALC_T_PORT_NAMES, pnp); - pnp_len = sizeof(ErtsPortNames) + len; - pnp = erts_alloc(ERTS_ALC_T_PORT_NAMES, pnp_len); - } - name = prt->name; - len = nlen = name ? sys_strlen(name) + 1 : 0; - driver_name = (prt->drv_ptr ? prt->drv_ptr->name : NULL); - len += driver_name ? sys_strlen(driver_name) + 1 : 0; - if (len <= pnp_len - sizeof(ErtsPortNames)) { - if (!name) - pnp->name = NULL; - else { - pnp->name = ((char *) pnp) + sizeof(ErtsPortNames); - sys_strcpy(pnp->name, name); - } - if (!driver_name) - pnp->driver_name = NULL; - else { - pnp->driver_name = (((char *) pnp) - + sizeof(ErtsPortNames) - + nlen); - sys_strcpy(pnp->driver_name, driver_name); - } - do_realloc = 0; - } - } while (do_realloc); + int len; + int nlen; + char *driver_name; + + len = nlen = prt->name ? sys_strlen(prt->name) + 1 : 0; + driver_name = (prt->drv_ptr ? prt->drv_ptr->name : NULL); + len += driver_name ? sys_strlen(driver_name) + 1 : 0; + + pnp = erts_alloc(ERTS_ALC_T_PORT_NAMES, + sizeof(ErtsPortNames) + len); + + if (!prt->name) + pnp->name = NULL; + else { + pnp->name = ((char *) pnp) + sizeof(ErtsPortNames); + sys_strcpy(pnp->name, prt->name); + } + if (!driver_name) + pnp->driver_name = NULL; + else { + pnp->driver_name = (((char *) pnp) + + sizeof(ErtsPortNames) + + nlen); + sys_strcpy(pnp->driver_name, driver_name); + } } return pnp; } diff --git a/erts/emulator/beam/macros.tab b/erts/emulator/beam/macros.tab index 494fe8961e..1b5e5f66b0 100644 --- a/erts/emulator/beam/macros.tab +++ b/erts/emulator/beam/macros.tab @@ -63,10 +63,21 @@ JUMP(Fail) { Goto(*I); } +GC_SWAPOUT() { + // + // Since a garbage collection is expensive anyway, we can afford + // to save the instruction counter so that the correct function will + // be pointed in the crash dump if the garbage collection fails + // because of insufficient memory. + // + SWAPOUT; + c_p->i = I; +} + GC_TEST(Ns, Nh, Live) { Uint need = $Nh + $Ns; if (ERTS_UNLIKELY(E - HTOP < need)) { - SWAPOUT; + $GC_SWAPOUT(); PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live, FCALLS); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); @@ -79,7 +90,7 @@ GC_TEST(Ns, Nh, Live) { GC_TEST_PRESERVE(NeedHeap, Live, PreserveTerm) { Uint need = $NeedHeap; if (ERTS_UNLIKELY(E - HTOP < need)) { - SWAPOUT; + $GC_SWAPOUT(); reg[$Live] = $PreserveTerm; PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect_nobump(c_p, need, reg, $Live+1, FCALLS); diff --git a/erts/emulator/beam/msg_instrs.tab b/erts/emulator/beam/msg_instrs.tab index 6f8d1469ef..b08466c830 100644 --- a/erts/emulator/beam/msg_instrs.tab +++ b/erts/emulator/beam/msg_instrs.tab @@ -105,6 +105,7 @@ i_loop_rec(Dest) { $SET_CP_I_ABS(I); c_p->arity = 0; c_p->current = NULL; + c_p->fcalls = FCALLS; FCALLS -= erts_proc_sig_receive_helper(c_p, FCALLS, neg_o_reds, &msgp, &get_out); SWAPIN; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 3a95b1a37e..10ca74cd60 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1262,7 +1262,6 @@ bs_get_binary2 Fail=f Ms=xy Live=u Sz=sq Unit=u Flags=u Dst=d => \ i_bs_get_binary_imm2 xy f? t W t d i_bs_get_binary2 xy f t? s t d i_bs_get_binary_all2 xy f? t t d -i_bs_get_binary_all_reuse xy f? t # Fetching float from binaries. bs_get_float2 Fail=f Ms=xy Live=u Sz=s Unit=u Flags=u Dst=d => \ @@ -1691,9 +1690,14 @@ i_plus S1=c S2=c Fail Dst => move S1 x | i_plus x S2 Fail Dst i_plus xy xyc j? d -i_minus x x j? d -i_minus c x j? d -i_minus s s j? d +# A minus instruction with a constant right operand will be +# converted to an i_increment instruction, except in guards or +# when the negated value of the constant won't fit in a guard. +# Therefore, it very rare. +i_minus S1 S2=c Fail Dst => move S2 x | i_minus S1 x Fail Dst + +i_minus xy xy j? d +i_minus c xy j? d i_times j? s s d diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index a6312293cc..c261c8e117 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -63,6 +63,14 @@ # endif #endif +#ifndef ERTS_NOINLINE +# if ERTS_AT_LEAST_GCC_VSN__(3,1,1) +# define ERTS_NOINLINE __attribute__((__noinline__)) +# else +# define ERTS_NOINLINE +# endif +#endif + #if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK) # undef ERTS_CAN_INLINE # define ERTS_CAN_INLINE 0 diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c index a3069e419a..9eb020d070 100644 --- a/erts/emulator/beam/time.c +++ b/erts/emulator/beam/time.c @@ -316,7 +316,7 @@ struct ErtsTimerWheel_ { #define ERTS_TW_SLOT_AT_ONCE (-1) #define ERTS_TW_BUMP_LATER_WHEEL(TIW) \ - ((tiw)->pos + ERTS_TW_LATER_WHEEL_SLOT_SIZE >= (TIW)->later.pos) + ((TIW)->pos + ERTS_TW_LATER_WHEEL_SLOT_SIZE >= (TIW)->later.pos) static int bump_later_wheel(ErtsTimerWheel *tiw, int *yield_count_p); @@ -701,7 +701,8 @@ remove_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p) if (slot < ERTS_TW_SOON_WHEEL_END_SLOT) { if (empty_slot && tiw->true_next_timeout_time - && p->timeout_pos == tiw->next_timeout_pos) { + && p->timeout_pos == tiw->next_timeout_pos + && tiw->yield_slot == ERTS_TW_SLOT_INACTIVE) { tiw->true_next_timeout_time = 0; } if (--tiw->soon.nto == 0) @@ -714,7 +715,8 @@ remove_timer(ErtsTimerWheel *tiw, ErtsTWheelTimer *p) ErtsMonotonicTime tpos = tiw->later.min_tpos; tpos &= ERTS_TW_LATER_WHEEL_POS_MASK; tpos -= ERTS_TW_LATER_WHEEL_SLOT_SIZE; - if (tpos == tiw->next_timeout_pos) + if (tpos == tiw->next_timeout_pos + && tiw->yield_slot == ERTS_TW_SLOT_INACTIVE) tiw->true_next_timeout_time = 0; } if (--tiw->later.nto == 0) { @@ -908,7 +910,6 @@ erts_bump_timers(ErtsTimerWheel *tiw, ErtsMonotonicTime curr_time) { ErtsMonotonicTime tmp_slots = bump_to - tiw->pos; - tmp_slots = (bump_to - tiw->pos); if (tmp_slots < ERTS_TW_SOON_WHEEL_SIZE) slots = (int) tmp_slots; else diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 36cfe0548e..0bbae65e28 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -1069,11 +1069,11 @@ do { \ #define HCONST 0x9e3779b9UL /* the golden ratio; an arbitrary value */ -Uint32 -block_hash(byte *k, unsigned length, Uint32 initval) +static Uint32 +block_hash(byte *k, Uint length, Uint32 initval) { Uint32 a,b,c; - unsigned len; + Uint len; /* Set up the internal state */ len = length; @@ -1749,7 +1749,7 @@ make_internal_hash(Eterm term, Uint32 salt) case SUB_BINARY_SUBTAG: { byte* bptr; - unsigned sz = binary_size(term); + Uint sz = binary_size(term); Uint32 con = HCONST_13 + hash; Uint bitoffs; Uint bitsize; diff --git a/erts/emulator/internal_doc/CarrierMigration.md b/erts/emulator/internal_doc/CarrierMigration.md index bb3d8aac28..40f6031ca8 100644 --- a/erts/emulator/internal_doc/CarrierMigration.md +++ b/erts/emulator/internal_doc/CarrierMigration.md @@ -1,6 +1,9 @@ Carrier Migration ================= +Introduction +------------ + The ERTS memory allocators manage memory blocks in two types of raw memory chunks. We call these chunks of raw memory *carriers*. Single-block carriers which only contain one large block, @@ -141,11 +144,11 @@ Since the carrier has been unlinked from the data structure of available free blocks, no more allocations will be made in the carrier. -The allocator instance that created a carrier is called its **owner**. +The allocator instance that created a carrier is called its *owner*. Ownership never changes. The allocator instance that has the responsibility to perform deallocations in a -carrier is called its **employer**. The employer may also perform allocations if +carrier is called its *employer*. The employer may also perform allocations if the carrier is not in the pool. Employment may change when a carrier is fetched from or inserted into the pool. @@ -153,14 +156,14 @@ Deallocations in a carrier, while it remains in the pool, is always performed the owner. That is, all pooled carriers are employed by their owners. Each carrier has an atomic word containing a pointer to the employing allocator -instance and three bit flags; IN_POOL, BUSY and HOMECOMING. +instance and three bit flags; IN\_POOL, BUSY and HOMECOMING. When fetching a carrier from the pool, employment may change and further deallocations in the carrier will be redirected to the new employer using the delayed dealloc functionality. When a foreign allocator instance abandons a carrier back into the pool, it will -also pass it back to its **owner** using the delayed dealloc queue. When doing +also pass it back to its *owner* using the delayed dealloc queue. When doing this it will set the HOMECOMING bit flag to mark it as "enqueued". The owner will later clear the HOMECOMING bit when the carrier is dequeued. This mechanism prevents a carrier from being enqueued again before it has been dequeued. @@ -180,14 +183,14 @@ back to the owner for deallocation using the delayed dealloc functionality. In short: -* The allocator instance that created a carrier **owns** it. -* An empty carrier is always deallocated by its **owner**. -* **Ownership** never changes. -* The allocator instance that uses a carrier **employs** it. -* An **employer** can abandon a carrier into the pool. +* The allocator instance that created a carrier *owns* it. +* An empty carrier is always deallocated by its *owner*. +* *Ownership* never changes. +* The allocator instance that uses a carrier *employs* it. +* An *employer* can abandon a carrier into the pool. * Pooled carriers are not allocated from. -* Pooled carriers are always **employed** by their **owner**. -* **Employment** can only change from **owner** to a foreign allocator +* Pooled carriers are always *employed* by their *owner*. +* *Employment* can only change from *owner* to a foreign allocator when a carrier is fetched from the pool. @@ -229,7 +232,7 @@ carrier. When the cluster gets to the same size as the search limit, all searches will essentially fail. To counter the "bad cluster" problem and also ease the contention, the -search will now always start by first looking at the allocators **own** +search will now always start by first looking at the allocators *own* carriers. That is, carriers that were initially created by the allocator itself and later had been abandoned to the pool. If none of our own abandoned carrier would do, then the search continues into the diff --git a/erts/emulator/internal_doc/CodeLoading.md b/erts/emulator/internal_doc/CodeLoading.md index 151b9cd57c..0b2e3070e7 100644 --- a/erts/emulator/internal_doc/CodeLoading.md +++ b/erts/emulator/internal_doc/CodeLoading.md @@ -45,7 +45,7 @@ free to schedule other work while the second loader is waiting. (See `erts_release_code_write_permission`). The ability to prepare several modules in parallel is not currently -used as almost all code loading is serialized by the code_server +used as almost all code loading is serialized by the code\_server process. The BIF interface is however prepared for this. erlang:prepare_loading(Module, Code) -> LoaderState @@ -71,8 +71,8 @@ structures. These *code access structures* are * Export table. One entry for every exported function. * Module table. One entry for each loaded module. -* "beam_catches". Identifies jump destinations for catch instructions. -* "beam_ranges". Map code address to function and line in source file. +* "beam\_catches". Identifies jump destinations for catch instructions. +* "beam\_ranges". Map code address to function and line in source file. The most frequently used of these structures is the export table that is accessed in run time for every executed external function call to diff --git a/erts/emulator/internal_doc/GarbageCollection.md b/erts/emulator/internal_doc/GarbageCollection.md index 1d9e3f4160..a1627b3233 100644 --- a/erts/emulator/internal_doc/GarbageCollection.md +++ b/erts/emulator/internal_doc/GarbageCollection.md @@ -1,6 +1,6 @@ # Erlang Garbage Collector -Erlang manages dynamic memory with a [tracing garbage collector](https://en.wikipedia.org/wiki/Tracing_garbage_collection). More precisely a per process generational semi-space copying collector using [Cheney's](#cheney) copy collection algorithm together with a global large object space. +Erlang manages dynamic memory with a [tracing garbage collector](https://en.wikipedia.org/wiki/Tracing_garbage_collection). More precisely a per process generational semi-space copying collector using Cheney's copy collection algorithm together with a global large object space. (See C. J. Cheney in [References](#references).) ## Overview @@ -12,12 +12,11 @@ Terms are created on the heap by evaluating expressions. There are two major typ Let's look at an example that returns a tuple with the newly created data. -```erlang -data(Foo) -> - Cons = [42|Foo], - Literal = {text, "hello world!"}, - {tag, Cons, Literal}. -``` + + data(Foo) -> + Cons = [42|Foo], + Literal = {text, "hello world!"}, + {tag, Cons, Literal}. In this example we first create a new cons cell with an integer and a tuple with some text. Then a tuple of size three wrapping the other values with an atom tag is created and returned. @@ -25,7 +24,6 @@ On the heap tuples require a word size for each of its elements as well as for t Compiling this code to beam assembly (`erlc -S`) shows exactly what is happening. -```erlang ... {test_heap,6,1}. {put_list,{integer,42},{x,0},{x,1}}. @@ -34,9 +32,8 @@ Compiling this code to beam assembly (`erlc -S`) shows exactly what is happening {put,{x,1}}. {put,{literal,{text,"hello world!"}}}. return. -``` -Looking at the assembler code we can see three things; The heap requirement in this function turns out to be only six words, as seen by the `{test_heap,6,1}` instruction. All the allocations are combined to a single instruction. The bulk of the data `{text, "hello world!"}` is a *literal*. Literals, sometimes referred to as constants, are not allocated in the function since they are a part of the module and allocated at load time. +Looking at the assembler code we can see three things: The heap requirement in this function turns out to be only six words, as seen by the `{test_heap,6,1}` instruction. All the allocations are combined to a single instruction. The bulk of the data `{text, "hello world!"}` is a *literal*. Literals, sometimes referred to as constants, are not allocated in the function since they are a part of the module and allocated at load time. If there is not enough space available on the heap to satisfy the `test_heap` instructions request for memory, then a garbage collection is initiated. It may happen immediately in the `test_heap` instruction, or it can be delayed until a later time depending on what state the process is in. If the garbage collection is delayed, any memory needed will be allocated in heap fragments. Heap fragments are extra memory blocks that are a part of the young heap, but are not allocated in the contigious area where terms normally reside. See [The young heap](#the-young-heap) for more details. @@ -50,11 +47,9 @@ It follows all the pointers from the root-set to the heap and copies each term w After the header word has been copied a [*move marker*](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.h#L45-L46) is destructively placed in it pointing to the term in the *to space*. Any other term that points to the already moved term will [see this move marker](https://github.com/erlang/otp/blob/OTP-18.0/erts/emulator/beam/erl_gc.c#L1125) and copy the referring pointer instead. For example, if the have the following Erlang code: -```erlang -foo(Arg) -> - T = {test, Arg}, - {wrapper, T, T, T}. -``` + foo(Arg) -> + T = {test, Arg}, + {wrapper, T, T, T}. Only one copy of T exists on the heap and during the garbage collection only the first time T is encountered will it be copied. @@ -86,15 +81,15 @@ In the next garbage collection, any pointers to the old heap will be ignored and Generational garbage collection aims to increase performance at the expense of memory. This is achieved because only the young, smaller, heap is considered in most garbage collections. -The generational [hypothesis](#ungar) predicts that most terms tend to die young, and for an immutable language such as Erlang, young terms die even faster than in other languages. So for most usage patterns the data in the new heap will die very soon after it is allocated. This is good because it limits the amount of data copied to the old heap and also because the garbage collection algorithm used is proportional to the amount of live data on the heap. +The generational hypothesis predicts that most terms tend to die young (see D. Ungar in [References](#references)), and for an immutable language such as Erlang, young terms die even faster than in other languages. So for most usage patterns the data in the new heap will die very soon after it is allocated. This is good because it limits the amount of data copied to the old heap and also because the garbage collection algorithm used is proportional to the amount of live data on the heap. One critical issue to note here is that any term on the young heap can reference terms on the old heap but *no* term on the old heap may refer to a term on the young heap. This is due to the nature of the copy algorithm. Anything referenced by an old heap term is not included in the reference tree, root-set and its followers, and hence is not copied. If it was, the data would be lost, fire and brimstone would rise to cover the earth. Fortunately, this comes naturally for Erlang because the terms are immutable and thus there can be no pointers modified on the old heap to point to the young heap. -To reclaim data from the old heap, both young and old heaps are included during the collection and copied to a common *to space*. Both the *from space* of the young and old heap are then deallocated and the procedure will start over from the beginning. This type of garbage collection is called a full sweep and is triggered when the size of the area under the high-watermark is larger than the size of the free area of the old heap. It can also be triggered by doing a manual call to [erlang:garbage_collect()](http://erlang.org/doc/man/erlang.html#garbage_collect-0), or by running into the young garbage collection limit set by [spawn_opt(fun(),[{fullsweep_after, N}])](http://erlang.org/doc/man/erlang.html#spawn_opt-4) where N is the number of young garbage collections to do before forcing a garbage collection of both young and old heap. +To reclaim data from the old heap, both young and old heaps are included during the collection and copied to a common *to space*. Both the *from space* of the young and old heap are then deallocated and the procedure will start over from the beginning. This type of garbage collection is called a full sweep and is triggered when the size of the area under the high-watermark is larger than the size of the free area of the old heap. It can also be triggered by doing a manual call to [erlang:garbage_collect()](http://erlang.org/doc/man/erlang.html#garbage_collect-0), or by running into the young garbage collection limit set by [spawn\_opt(fun(),[{fullsweep\_after, N}\])](http://erlang.org/doc/man/erlang.html#spawn_opt-4) where N is the number of young garbage collections to do before forcing a garbage collection of both young and old heap. ## The young heap -The young heap, or the allocation heap, consists of the stack and heap as described in the Overview. However, it also includes any heap fragments that are attached to the heap. All of the heap fragments are considered to be above the high-watermark and part of the young generation. Heap fragments contain terms that either did not fit on the heap, or were created by another process and then attached to the heap. For instance if the bif binary_to_term created a term which does not fit on the current heap without doing a garbage collection, it will create a heap-fragment for the term and then schedule a garbage collection for later. Also if a message is sent to the process, the payload may be placed in a heap-fragment and that fragment is added to young heap when the message is matched in a receive clause. +The young heap, or the allocation heap, consists of the stack and heap as described in the Overview. However, it also includes any heap fragments that are attached to the heap. All of the heap fragments are considered to be above the high-watermark and part of the young generation. Heap fragments contain terms that either did not fit on the heap, or were created by another process and then attached to the heap. For instance if the bif `binary_to_term/1` created a term which does not fit on the current heap without doing a garbage collection, it will create a heap-fragment for the term and then schedule a garbage collection for later. Also if a message is sent to the process, the payload may be placed in a heap-fragment and that fragment is added to young heap when the message is matched in a receive clause. This procedure differs from how it worked prior to Erlang/OTP 19.0. Before 19.0, only a contiguous memory block where the young heap and stack resided was considered to be part of the young heap. Heap fragments and messages were immediately copied into the young heap before they could be inspected by the Erlang program. The behaviour introduced in 19.0 is superior in many ways - most significantly it reduces the number of necessary copy operations and the root set for garbage collection. @@ -118,21 +113,19 @@ The old heap is always one step ahead in the heap growth stages than the young h When garbage collecting a heap (young or old) all literals are left in place and not copied. To figure out if a term should be copied or not when doing a garbage collection the following pseudo code is used: -```c -if (erts_is_literal(ptr) || (on_old_heap(ptr) && !fullsweep)) { - /* literal or non fullsweep - do not copy */ -} else { - copy(ptr); -} -``` + if (erts_is_literal(ptr) || (on_old_heap(ptr) && !fullsweep)) { + /* literal or non fullsweep - do not copy */ + } else { + copy(ptr); + } The [`erts_is_literal`](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/global.h#L1452-L1465) check works differently on different architectures and operating systems. -On 64 bit systems that allow mapping of unreserved virtual memory areas (most operating systems except Windows), an area of size 1 GB (by default) is mapped and then all literals are placed within that area. Then all that has to be done to determine if something is a literal or not is [two quick pointer checks](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_alloc.h#L322-L324). This system relies on the fact that a memory page that has not been touched yet does not take any actual space. So even if 1 GB of virtual memory is mapped, only the memory which is actually needed for literals is allocated in ram. The size of the literal area is configurable through the +MIscs erts_alloc option. +On 64 bit systems that allow mapping of unreserved virtual memory areas (most operating systems except Windows), an area of size 1 GB (by default) is mapped and then all literals are placed within that area. Then all that has to be done to determine if something is a literal or not is [two quick pointer checks](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_alloc.h#L322-L324). This system relies on the fact that a memory page that has not been touched yet does not take any actual space. So even if 1 GB of virtual memory is mapped, only the memory which is actually needed for literals is allocated in ram. The size of the literal area is configurable through the +MIscs erts\_alloc option. On 32 bit systems, there is not enough virtual memory space to allocate 1 GB for just literals, so instead small 256 KB sized literal regions are created on demand and a card mark bit-array of the entire 32 bit memory space is then used to determine if a term is a literal or not. Since the total memory space is only 32 bits, the card mark bit-array is only 256 words large. On a 64 bit system the same bit-array would have to be 1 tera words large, so this technique is only viable on 32 bit systems. Doing [lookups in the array](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_alloc.h#L316-L319) is a little more expensive then just doing the pointer checks that can be done in 64 bit systems, but not extremely so. -On 64 bit windows, on which erts_alloc cannot do unreserved virtual memory mappings, a [special tag](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_term.h#L59) within the Erlang term object is used to determine if something [is a literal or not](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_term.h#L248-L252). This is very cheap, however, the tag is only available on 64 bit machines, and it is possible to do a great deal of other nice optimizations with this tag in the future (like for instance a more compact list implementation) so it is not used on operating systems where it is not needed. +On 64 bit windows, on which erts\_alloc cannot do unreserved virtual memory mappings, a [special tag](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_term.h#L59) within the Erlang term object is used to determine if something [is a literal or not](https://github.com/erlang/otp/blob/OTP-19.0/erts/emulator/beam/erl_term.h#L248-L252). This is very cheap, however, the tag is only available on 64 bit machines, and it is possible to do a great deal of other nice optimizations with this tag in the future (like for instance a more compact list implementation) so it is not used on operating systems where it is not needed. This behaviour is different from how it worked prior to Erlang/OTP 19.0. Before 19.0 the literal check was done by checking if the pointer pointed to the young or old heap block. If it did not, then it was considered a literal. This lead to considerable overhead and strange memory usage scenarios, so it was removed in 19.0. @@ -182,6 +175,8 @@ Using `on_heap` will force all messages to be part of on the young heap which wi Which one of these strategies is best depends a lot on what the process is doing and how it interacts with other processes. So, as always, profile the application and see how it behaves with the different options. - <a name="cheney">[1]</a>: C. J. Cheney. A nonrecursive list compacting algorithm. Commun. ACM, 13(11):677–678, Nov. 1970. +## References + +C. J. Cheney. A nonrecursive list compacting algorithm. Commun. ACM, 13(11):677–678, Nov. 1970. - <a name="ungar">[2]</a>: D. Ungar. Generation scavenging: A non-disruptive high performance storage reclamation algorithm. SIGSOFT Softw. Eng. Notes, 9(3):157–167, Apr. 1984. +D. Ungar. Generation scavenging: A non-disruptive high performance storage reclamation algorithm. SIGSOFT Softw. Eng. Notes, 9(3):157–167, Apr. 1984. diff --git a/erts/emulator/internal_doc/PTables.md b/erts/emulator/internal_doc/PTables.md index 6fe0e7665d..ef61963a40 100644 --- a/erts/emulator/internal_doc/PTables.md +++ b/erts/emulator/internal_doc/PTables.md @@ -85,13 +85,13 @@ following: 3. Depending on use, issue appropriate memory barrier. A common barrier used is a barrier with acquire semantics. On - x86/x86_64 this maps to a compiler barrier preventing the compiler + x86/x86\_64 this maps to a compiler barrier preventing the compiler to reorder instructions, but on other hardware often some kind of light weight hardware memory barrier is also needed. When comparing with a locked approach, at least one heavy weight memory barrier will be issued when locking the lock on most, if - not all, hardware architectures (including x86/x86_64), and often + not all, hardware architectures (including x86/x86\_64), and often some kind of light weight memory barrier will be issued when unlocking the lock. diff --git a/erts/emulator/internal_doc/SuperCarrier.md b/erts/emulator/internal_doc/SuperCarrier.md index acf722ea37..f52c6613d5 100644 --- a/erts/emulator/internal_doc/SuperCarrier.md +++ b/erts/emulator/internal_doc/SuperCarrier.md @@ -5,7 +5,7 @@ A super carrier is large memory area, allocated at VM start, which can be used during runtime to allocate normal carriers from. The super carrier feature was introduced in OTP R16B03. It is -enabled with command line option +MMscs <size in Mb> +enabled with command line option +MMscs <size in Mb> and can be configured with other options. Problem @@ -65,7 +65,7 @@ carrier is full. ### Implementation ### -The entire super carrier implementation is kept in erl_mmap.c. The +The entire super carrier implementation is kept in erl\_mmap.c. The name suggest that it can be viewed as our own mmap implementation. A super carrier needs to satisfy two slightly different kinds of @@ -98,8 +98,8 @@ other. ### Data structures ### -The MBC area is called **sa** as in super aligned and the SBC area is -called **sua** as in super un-aligned. +The MBC area is called *sa* as in super aligned and the SBC area is +called *sua* as in super un-aligned. Note that the "super" in super alignment and the "super" in super carrier has nothing to do with each other. We could have choosen @@ -128,7 +128,7 @@ down or up. We need to keep track of all the free segments in order to reuse them for new carrier allocations. One initial idea was to use the same mechanism that is used to keep track of free blocks within MBCs -(alloc_util and the different strategies). However, that would not be +(alloc\_util and the different strategies). However, that would not be as straight forward as one can think and can also waste quite a lot of memory as it uses prepended block headers. The granularity of the super carrier is one memory page (usually 4kb). We want to allocate diff --git a/erts/emulator/internal_doc/Tracing.md b/erts/emulator/internal_doc/Tracing.md index 7f97f64765..196ae0dd4e 100644 --- a/erts/emulator/internal_doc/Tracing.md +++ b/erts/emulator/internal_doc/Tracing.md @@ -37,6 +37,7 @@ what different type of break actions that are enabled. Same Same but Different ----------------------- + Even though `trace_pattern` use the same technique as the non-blocking code loading with replicated generations of data structures and an atomic switch, the implementations are quite separate from each @@ -72,6 +73,7 @@ aligned write operation on all hardware architectures we use. Adding a new Breakpoint ----------------------- + This is a simplified sequence describing what `trace_pattern` goes through when adding a new breakpoint. @@ -82,7 +84,7 @@ through when adding a new breakpoint. instruction word in the breakpoint. 3. Write a pointer to the breakpoint at offset -4 from the first - instruction "func_info" header. + instruction "func\_info" header. 4. Set the staging part of the breakpoint as enabled with specified breakpoint data. @@ -139,7 +141,7 @@ and removing breakpoints. 2. Allocate new breakpoint structures with a disabled active part and the original beam instruction. Write a pointer to the breakpoint in - "func_info" header at offset -4. + "func\_info" header at offset -4. 3. Update the staging part of all affected breakpoints. Disable breakpoints that are to be removed. diff --git a/erts/emulator/internal_doc/beam_makeops.md b/erts/emulator/internal_doc/beam_makeops.md index 1da8d2ab05..2880099b70 100644 --- a/erts/emulator/internal_doc/beam_makeops.md +++ b/erts/emulator/internal_doc/beam_makeops.md @@ -403,7 +403,7 @@ A line with `//` is also a comment. It is recommended to only use this style of comments in files that define implementations of instructions. -A long line can be broken into shorter lines by a placing a`\` before +A long line can be broken into shorter lines by a placing a `\` before the newline. ### Variable definitions ### @@ -1159,7 +1159,6 @@ implementation of `gen_element()`: return op; } -} ### Defining the implementation ### @@ -1452,7 +1451,7 @@ optionally additional heap space. ##### The NEXT_INSTRUCTION pre-bound variable ##### -The NEXT_INSTRUCTION is a pre-bound variable that is available in +The NEXT\_INSTRUCTION is a pre-bound variable that is available in all instructions. It expands to the address of the next instruction. Here is an example: @@ -1545,7 +1544,7 @@ register, the pointer will no longer be valid. (Y registers are stored on the stack.) In those circumstances, `$REFRESH_GEN_DEST()` must be invoked -to set up the pointer again. **beam\_makeops** will notice +to set up the pointer again. **beam\_makeops** will notice if there is a call to a function that does a garbage collection and `$REFRESH_GEN_DEST()` is not called. diff --git a/erts/emulator/nifs/common/net_nif.c b/erts/emulator/nifs/common/net_nif.c index 252aa3c835..8a69052935 100644 --- a/erts/emulator/nifs/common/net_nif.c +++ b/erts/emulator/nifs/common/net_nif.c @@ -274,10 +274,10 @@ ENET_NIF_FUNCS static ERL_NIF_TERM ncommand(ErlNifEnv* env, ERL_NIF_TERM cmd); static ERL_NIF_TERM ngethostname(ErlNifEnv* env); -static ERL_NIF_TERM ngetnameinfo(ErlNifEnv* env, - const SocketAddress* saP, - SOCKLEN_T saLen, - int flags); +static ERL_NIF_TERM ngetnameinfo(ErlNifEnv* env, + const ESockAddress* saP, + SOCKLEN_T saLen, + int flags); static ERL_NIF_TERM ngetaddrinfo(ErlNifEnv* env, char* host, char* serv); @@ -627,12 +627,12 @@ ERL_NIF_TERM nif_getnameinfo(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - ERL_NIF_TERM result; - ERL_NIF_TERM eSockAddr, eFlags; - int flags = 0; // Just in case... - SocketAddress sa; - SOCKLEN_T saLen = 0; // Just in case... - char* xres; + ERL_NIF_TERM result; + ERL_NIF_TERM eSockAddr, eFlags; + int flags = 0; // Just in case... + ESockAddress sa; + SOCKLEN_T saLen = 0; // Just in case... + char* xres; NDBG( ("NET", "nif_getnameinfo -> entry (%d)\r\n", argc) ); @@ -674,10 +674,10 @@ ERL_NIF_TERM nif_getnameinfo(ErlNifEnv* env, */ #if !defined(__WIN32__) static -ERL_NIF_TERM ngetnameinfo(ErlNifEnv* env, - const SocketAddress* saP, - SOCKLEN_T saLen, - int flags) +ERL_NIF_TERM ngetnameinfo(ErlNifEnv* env, + const ESockAddress* saP, + SOCKLEN_T saLen, + int flags) { ERL_NIF_TERM result; char host[HOSTNAME_LEN]; @@ -1429,7 +1429,7 @@ ERL_NIF_TERM encode_address_info(ErlNifEnv* env, type = encode_address_info_type(env, addrInfoP->ai_socktype); proto = encode_address_info_proto(env, addrInfoP->ai_protocol); esock_encode_sockaddr(env, - (SocketAddress*) addrInfoP->ai_addr, + (ESockAddress*) addrInfoP->ai_addr, addrInfoP->ai_addrlen, &addr); diff --git a/erts/emulator/nifs/common/socket_int.h b/erts/emulator/nifs/common/socket_int.h index 043303a60d..38c28a6de5 100644 --- a/erts/emulator/nifs/common/socket_int.h +++ b/erts/emulator/nifs/common/socket_int.h @@ -82,7 +82,7 @@ typedef union { struct sockaddr_un un; #endif -} SocketAddress; +} ESockAddress; /* *** Boolean *type* stuff... *** */ @@ -388,5 +388,7 @@ GLOBAL_ERROR_REASON_ATOM_DEFS #define REALLOC_BIN(SZ, BP) enif_realloc_binary((SZ), (BP)) #define FREE_BIN(BP) enif_release_binary((BP)) +/* Copy term T into environment E */ +#define CP_TERM(E, T) enif_make_copy((E), (T)) #endif // SOCKET_INT_H__ diff --git a/erts/emulator/nifs/common/socket_nif.c b/erts/emulator/nifs/common/socket_nif.c index 870ab63bdf..ee3b9f2a98 100644 --- a/erts/emulator/nifs/common/socket_nif.c +++ b/erts/emulator/nifs/common/socket_nif.c @@ -32,7 +32,7 @@ * * esock_dbg_printf("DEMONP", "[%d] %s: %T\r\n", * descP->sock, slogan, - * MON2T(env, &monP->mon)); + * esock_make_monitor_term(env, &mon)); * */ @@ -119,7 +119,6 @@ - /* AND HERE WE MAY HAVE A BUNCH OF DEFINES....SEE INET DRIVER.... */ @@ -332,6 +331,20 @@ static void (*esock_sctp_freepaddrs)(struct sockaddr *addrs) = NULL; #include "socket_int.h" #include "socket_util.h" + +#if defined(ERTS_INLINE) +# define ESOCK_INLINE ERTS_INLINE +#else +# if defined(__GNUC__) +# define ESOCK_INLINE __inline__ +# elif defined(__WIN32__) +# define ESOCK_INLINE __inline +# else +# define ESOCK_INLINE +# endif +#endif + + #if defined(SOL_IPV6) || defined(IPPROTO_IPV6) #define HAVE_IPV6 #endif @@ -654,7 +667,9 @@ typedef union { * * * =================================================================== */ +/* Global socket debug */ #define SGDBG( proto ) ESOCK_DBG_PRINTF( data.dbg , proto ) +/* Socket specific debug */ #define SSDBG( __D__ , proto ) ESOCK_DBG_PRINTF( (__D__)->dbg , proto ) @@ -759,25 +774,32 @@ static unsigned long one_value = 1; typedef struct { - int is_active; ErlNifMonitor mon; + BOOLEAN_T isActive; } ESockMonitor; typedef struct { - ErlNifPid pid; // PID of the requesting process - ESockMonitor mon; // Monitor to the requesting process - ERL_NIF_TERM ref; // The (unique) reference (ID) of the request -} SocketRequestor; + ErlNifPid pid; // PID of the requesting process + ESockMonitor mon; // Monitor to the requesting process -typedef struct socket_request_queue_element { - struct socket_request_queue_element* nextP; - SocketRequestor data; -} SocketRequestQueueElement; + /* We need an environment for the copy of the ref we store here. + * We will also use this environment for any messages we send + * (with the ref in it). Such as the select message (used in the + * select call) or the abort message. + */ + ErlNifEnv* env; + ERL_NIF_TERM ref; // The (unique) reference (ID) of the request +} ESockRequestor; + +typedef struct esock_request_queue_element { + struct esock_request_queue_element* nextP; + ESockRequestor data; +} ESockRequestQueueElement; typedef struct { - SocketRequestQueueElement* first; - SocketRequestQueueElement* last; -} SocketRequestQueue; + ESockRequestQueueElement* first; + ESockRequestQueueElement* last; +} ESockRequestQueue; typedef struct { @@ -791,21 +813,18 @@ typedef struct { int protocol; unsigned int state; - SocketAddress remote; + ESockAddress remote; unsigned int addrLen; - ErlNifEnv* env; - /* +++ Controller (owner) process +++ */ ErlNifPid ctrlPid; - // ErlNifMonitor ctrlMon; ESockMonitor ctrlMon; /* +++ Write stuff +++ */ ErlNifMutex* writeMtx; - SocketRequestor currentWriter; - SocketRequestor* currentWriterP; // NULL or points to currentWriter - SocketRequestQueue writersQ; + ESockRequestor currentWriter; + ESockRequestor* currentWriterP; // NULL or points to currentWriter + ESockRequestQueue writersQ; BOOLEAN_T isWritable; Uint32 writePkgCnt; Uint32 writeByteCnt; @@ -815,9 +834,9 @@ typedef struct { /* +++ Read stuff +++ */ ErlNifMutex* readMtx; - SocketRequestor currentReader; - SocketRequestor* currentReaderP; // NULL or points to currentReader - SocketRequestQueue readersQ; + ESockRequestor currentReader; + ESockRequestor* currentReaderP; // NULL or points to currentReader + ESockRequestQueue readersQ; BOOLEAN_T isReadable; ErlNifBinary rbuffer; // DO WE NEED THIS Uint32 readCapacity; // DO WE NEED THIS @@ -828,11 +847,12 @@ typedef struct { /* +++ Accept stuff +++ */ ErlNifMutex* accMtx; - SocketRequestor currentAcceptor; - SocketRequestor* currentAcceptorP; // NULL or points to currentAcceptor - SocketRequestQueue acceptorsQ; + ESockRequestor currentAcceptor; + ESockRequestor* currentAcceptorP; // NULL or points to currentAcceptor + ESockRequestQueue acceptorsQ; /* +++ Config & Misc stuff +++ */ + ErlNifMutex* cfgMtx; size_t rBufSz; // Read buffer size (when data length = 0) /* rNum and rNumCnt are used (together with rBufSz) when calling the recv * function with the Length argument set to 0 (zero). @@ -856,7 +876,7 @@ typedef struct { ERL_NIF_TERM closeRef; BOOLEAN_T closeLocal; -} SocketDescriptor; +} ESockDescriptor; /* Global stuff. @@ -880,7 +900,7 @@ typedef struct { Uint32 numProtoTCP; Uint32 numProtoUDP; Uint32 numProtoSCTP; -} SocketData; +} ESockData; /* ---------------------------------------------------------------------- @@ -980,122 +1000,131 @@ static ERL_NIF_TERM nopen(ErlNifEnv* env, int type, int protocol, char* netns); -static ERL_NIF_TERM nbind(ErlNifEnv* env, - SocketDescriptor* descP, - SocketAddress* sockAddrP, - unsigned int addrLen); -static ERL_NIF_TERM nconnect(ErlNifEnv* env, - SocketDescriptor* descP); -static ERL_NIF_TERM nlisten(ErlNifEnv* env, - SocketDescriptor* descP, - int backlog); -static ERL_NIF_TERM naccept(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM ref); -static ERL_NIF_TERM naccept_listening(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref); -static ERL_NIF_TERM naccept_listening_error(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref, - ErlNifPid caller, - int save_errno); -static ERL_NIF_TERM naccept_listening_accept(ErlNifEnv* env, - SocketDescriptor* descP, - SOCKET accSock, - ErlNifPid caller, - SocketAddress* remote); -static ERL_NIF_TERM naccept_accepting(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM ref); -static ERL_NIF_TERM naccept_accepting_current(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM ref); -static ERL_NIF_TERM naccept_accepting_current_accept(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - SOCKET accSock, - SocketAddress* remote); -static ERL_NIF_TERM naccept_accepting_current_error(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM opRef, - int save_errno); -static ERL_NIF_TERM naccept_accepting_other(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref, - ErlNifPid caller); -static ERL_NIF_TERM naccept_busy_retry(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref, - ErlNifPid* pid, - unsigned int nextState); -static BOOLEAN_T naccept_accepted(ErlNifEnv* env, - SocketDescriptor* descP, - SOCKET accSock, - ErlNifPid pid, - SocketAddress* remote, - ERL_NIF_TERM* result); -static ERL_NIF_TERM nsend(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM sendRef, - ErlNifBinary* dataP, - int flags); -static ERL_NIF_TERM nsendto(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM sendRef, - ErlNifBinary* dataP, - int flags, - SocketAddress* toAddrP, - unsigned int toAddrLen); -static ERL_NIF_TERM nsendmsg(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM sendRef, - ERL_NIF_TERM eMsgHdr, - int flags); -static ERL_NIF_TERM nrecv(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sendRef, - ERL_NIF_TERM recvRef, - int len, - int flags); -static ERL_NIF_TERM nrecvfrom(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM recvRef, - Uint16 bufSz, - int flags); -static ERL_NIF_TERM nrecvmsg(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM recvRef, - Uint16 bufLen, - Uint16 ctrlLen, - int flags); -static ERL_NIF_TERM nclose(ErlNifEnv* env, - SocketDescriptor* descP); -static ERL_NIF_TERM nshutdown(ErlNifEnv* env, - SocketDescriptor* descP, - int how); -static ERL_NIF_TERM nsetopt(ErlNifEnv* env, - SocketDescriptor* descP, - BOOLEAN_T isEncoded, - BOOLEAN_T isOTP, - int level, - int eOpt, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nbind(ErlNifEnv* env, + ESockDescriptor* descP, + ESockAddress* sockAddrP, + unsigned int addrLen); +static ERL_NIF_TERM nconnect(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef); +static ERL_NIF_TERM nlisten(ErlNifEnv* env, + ESockDescriptor* descP, + int backlog); +static ERL_NIF_TERM naccept(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM ref); +static ERL_NIF_TERM naccept_listening(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM ref); +static ERL_NIF_TERM naccept_listening_error(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM accRef, + ErlNifPid caller, + int save_errno); +static ERL_NIF_TERM naccept_listening_accept(ErlNifEnv* env, + ESockDescriptor* descP, + SOCKET accSock, + ErlNifPid caller, + ESockAddress* remote); +static ERL_NIF_TERM naccept_accepting(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM ref); +static ERL_NIF_TERM naccept_accepting_current(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM ref); +static ERL_NIF_TERM naccept_accepting_current_accept(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + SOCKET accSock, + ESockAddress* remote); +static ERL_NIF_TERM naccept_accepting_current_error(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef, + int save_errno); +static ERL_NIF_TERM naccept_accepting_other(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM ref, + ErlNifPid caller); +static ERL_NIF_TERM naccept_busy_retry(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM accRef, + ErlNifPid* pid, + unsigned int nextState); +static BOOLEAN_T naccept_accepted(ErlNifEnv* env, + ESockDescriptor* descP, + SOCKET accSock, + ErlNifPid pid, + ESockAddress* remote, + ERL_NIF_TERM* result); +static ERL_NIF_TERM nsend(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM sendRef, + ErlNifBinary* dataP, + int flags); +static ERL_NIF_TERM nsendto(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM sendRef, + ErlNifBinary* dataP, + int flags, + ESockAddress* toAddrP, + unsigned int toAddrLen); +static ERL_NIF_TERM nsendmsg(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM sendRef, + ERL_NIF_TERM eMsgHdr, + int flags); +static ERL_NIF_TERM nrecv(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sendRef, + ERL_NIF_TERM recvRef, + int len, + int flags); +static ERL_NIF_TERM nrecvfrom(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef, + Uint16 bufSz, + int flags); +static ERL_NIF_TERM nrecvmsg(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef, + Uint16 bufLen, + Uint16 ctrlLen, + int flags); +static ERL_NIF_TERM nclose(ErlNifEnv* env, + ESockDescriptor* descP); +static BOOLEAN_T nclose_check(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM* reason); +static ERL_NIF_TERM nclose_do(ErlNifEnv* env, + ESockDescriptor* descP); +static ERL_NIF_TERM nshutdown(ErlNifEnv* env, + ESockDescriptor* descP, + int how); +static ERL_NIF_TERM nsetopt(ErlNifEnv* env, + ESockDescriptor* descP, + BOOLEAN_T isEncoded, + BOOLEAN_T isOTP, + int level, + int eOpt, + ERL_NIF_TERM eVal); /* Set OTP level options */ -static ERL_NIF_TERM nsetopt_otp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_otp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal); /* *** nsetopt_otp_debug *** * *** nsetopt_otp_iow *** * *** nsetopt_otp_ctrl_proc *** @@ -1111,171 +1140,171 @@ static ERL_NIF_TERM nsetopt_otp(ErlNifEnv* env, NSETOPT_OTP_FUNC_DEF(rcvctrlbuf); \ NSETOPT_OTP_FUNC_DEF(sndctrlbuf); #define NSETOPT_OTP_FUNC_DEF(F) \ - static ERL_NIF_TERM nsetopt_otp_##F(ErlNifEnv* env, \ - SocketDescriptor* descP, \ - ERL_NIF_TERM eVal) + static ERL_NIF_TERM nsetopt_otp_##F(ErlNifEnv* env, \ + ESockDescriptor* descP, \ + ERL_NIF_TERM eVal) NSETOPT_OTP_FUNCS #undef NSETOPT_OTP_FUNC_DEF /* Set native options */ -static ERL_NIF_TERM nsetopt_native(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int eOpt, - ERL_NIF_TERM eVal); -static ERL_NIF_TERM nsetopt_level(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int eOpt, - ERL_NIF_TERM eVal); -static ERL_NIF_TERM nsetopt_lvl_socket(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_native(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int eOpt, + ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_level(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int eOpt, + ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_socket(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal); /* *** Handling set of socket options for level = socket *** */ #if defined(SO_BINDTODEVICE) -static ERL_NIF_TERM nsetopt_lvl_sock_bindtodevice(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_bindtodevice(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_BROADCAST) -static ERL_NIF_TERM nsetopt_lvl_sock_broadcast(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_broadcast(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_DEBUG) -static ERL_NIF_TERM nsetopt_lvl_sock_debug(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_debug(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_DONTROUTE) -static ERL_NIF_TERM nsetopt_lvl_sock_dontroute(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_dontroute(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_KEEPALIVE) -static ERL_NIF_TERM nsetopt_lvl_sock_keepalive(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_keepalive(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_LINGER) -static ERL_NIF_TERM nsetopt_lvl_sock_linger(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_linger(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_OOBINLINE) -static ERL_NIF_TERM nsetopt_lvl_sock_oobinline(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_oobinline(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_PEEK_OFF) -static ERL_NIF_TERM nsetopt_lvl_sock_peek_off(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_peek_off(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_PRIORITY) -static ERL_NIF_TERM nsetopt_lvl_sock_priority(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_priority(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_RCVBUF) -static ERL_NIF_TERM nsetopt_lvl_sock_rcvbuf(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_rcvbuf(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_RCVLOWAT) -static ERL_NIF_TERM nsetopt_lvl_sock_rcvlowat(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_rcvlowat(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_RCVTIMEO) -static ERL_NIF_TERM nsetopt_lvl_sock_rcvtimeo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_rcvtimeo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_REUSEADDR) -static ERL_NIF_TERM nsetopt_lvl_sock_reuseaddr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_reuseaddr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_REUSEPORT) -static ERL_NIF_TERM nsetopt_lvl_sock_reuseport(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_reuseport(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_SNDBUF) -static ERL_NIF_TERM nsetopt_lvl_sock_sndbuf(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_sndbuf(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_SNDLOWAT) -static ERL_NIF_TERM nsetopt_lvl_sock_sndlowat(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_sndlowat(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_SNDTIMEO) -static ERL_NIF_TERM nsetopt_lvl_sock_sndtimeo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_sndtimeo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SO_TIMESTAMP) -static ERL_NIF_TERM nsetopt_lvl_sock_timestamp(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sock_timestamp(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif -static ERL_NIF_TERM nsetopt_lvl_ip(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal); /* *** Handling set of socket options for level = ip *** */ #if defined(IP_ADD_MEMBERSHIP) -static ERL_NIF_TERM nsetopt_lvl_ip_add_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_add_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_ADD_SOURCE_MEMBERSHIP) -static ERL_NIF_TERM nsetopt_lvl_ip_add_source_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_add_source_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_BLOCK_SOURCE) -static ERL_NIF_TERM nsetopt_lvl_ip_block_source(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_block_source(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_DROP_MEMBERSHIP) -static ERL_NIF_TERM nsetopt_lvl_ip_drop_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_drop_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_DROP_SOURCE_MEMBERSHIP) -static ERL_NIF_TERM nsetopt_lvl_ip_drop_source_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_drop_source_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_FREEBIND) -static ERL_NIF_TERM nsetopt_lvl_ip_freebind(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_freebind(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_HDRINCL) -static ERL_NIF_TERM nsetopt_lvl_ip_hdrincl(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_hdrincl(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_MINTTL) -static ERL_NIF_TERM nsetopt_lvl_ip_minttl(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_minttl(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_MSFILTER) && defined(IP_MSFILTER_SIZE) -static ERL_NIF_TERM nsetopt_lvl_ip_msfilter(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_msfilter(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); static BOOLEAN_T decode_ip_msfilter_mode(ErlNifEnv* env, ERL_NIF_TERM eVal, Uint32* mode); @@ -1285,322 +1314,322 @@ static ERL_NIF_TERM nsetopt_lvl_ip_msfilter_set(ErlNifEnv* env, SOCKLEN_T optLen); #endif #if defined(IP_MTU_DISCOVER) -static ERL_NIF_TERM nsetopt_lvl_ip_mtu_discover(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_mtu_discover(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_MULTICAST_ALL) -static ERL_NIF_TERM nsetopt_lvl_ip_multicast_all(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_multicast_all(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_MULTICAST_IF) -static ERL_NIF_TERM nsetopt_lvl_ip_multicast_if(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_multicast_if(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_MULTICAST_LOOP) -static ERL_NIF_TERM nsetopt_lvl_ip_multicast_loop(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_multicast_loop(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_MULTICAST_TTL) -static ERL_NIF_TERM nsetopt_lvl_ip_multicast_ttl(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_multicast_ttl(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_NODEFRAG) -static ERL_NIF_TERM nsetopt_lvl_ip_nodefrag(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_nodefrag(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_PKTINFO) -static ERL_NIF_TERM nsetopt_lvl_ip_pktinfo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_pktinfo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_RECVDSTADDR) -static ERL_NIF_TERM nsetopt_lvl_ip_recvdstaddr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_recvdstaddr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_RECVERR) -static ERL_NIF_TERM nsetopt_lvl_ip_recverr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_recverr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_RECVIF) -static ERL_NIF_TERM nsetopt_lvl_ip_recvif(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_recvif(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_RECVOPTS) -static ERL_NIF_TERM nsetopt_lvl_ip_recvopts(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_recvopts(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_RECVORIGDSTADDR) -static ERL_NIF_TERM nsetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_RECVTOS) -static ERL_NIF_TERM nsetopt_lvl_ip_recvtos(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_recvtos(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_RECVTTL) -static ERL_NIF_TERM nsetopt_lvl_ip_recvttl(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_recvttl(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_RETOPTS) -static ERL_NIF_TERM nsetopt_lvl_ip_retopts(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_retopts(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_ROUTER_ALERT) -static ERL_NIF_TERM nsetopt_lvl_ip_router_alert(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_router_alert(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_SENDSRCADDR) -static ERL_NIF_TERM nsetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_TOS) -static ERL_NIF_TERM nsetopt_lvl_ip_tos(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_tos(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_TRANSPARENT) -static ERL_NIF_TERM nsetopt_lvl_ip_transparent(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_transparent(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_TTL) -static ERL_NIF_TERM nsetopt_lvl_ip_ttl(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_ttl(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_UNBLOCK_SOURCE) -static ERL_NIF_TERM nsetopt_lvl_ip_unblock_source(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ip_unblock_source(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IP_DROP_MEMBERSHIP) || defined(IP_ADD_MEMBERSHIP) static -ERL_NIF_TERM nsetopt_lvl_ip_update_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal, - int opt); +ERL_NIF_TERM nsetopt_lvl_ip_update_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal, + int opt); #endif #if defined(IP_ADD_SOURCE_MEMBERSHIP) || defined(IP_DROP_SOURCE_MEMBERSHIP) || defined(IP_BLOCK_SOURCE) || defined(IP_UNBLOCK_SOURCE) static -ERL_NIF_TERM nsetopt_lvl_ip_update_source(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal, - int opt); +ERL_NIF_TERM nsetopt_lvl_ip_update_source(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal, + int opt); #endif /* *** Handling set of socket options for level = ipv6 *** */ #if defined(HAVE_IPV6) -static ERL_NIF_TERM nsetopt_lvl_ipv6(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal); #if defined(IPV6_ADDRFORM) -static ERL_NIF_TERM nsetopt_lvl_ipv6_addrform(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_addrform(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_ADD_MEMBERSHIP) -static ERL_NIF_TERM nsetopt_lvl_ipv6_add_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_add_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_AUTHHDR) -static ERL_NIF_TERM nsetopt_lvl_ipv6_authhdr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_authhdr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_DROP_MEMBERSHIP) -static ERL_NIF_TERM nsetopt_lvl_ipv6_drop_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_drop_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_DSTOPTS) -static ERL_NIF_TERM nsetopt_lvl_ipv6_dstopts(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_dstopts(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_FLOWINFO) -static ERL_NIF_TERM nsetopt_lvl_ipv6_flowinfo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_flowinfo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_HOPLIMIT) -static ERL_NIF_TERM nsetopt_lvl_ipv6_hoplimit(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_hoplimit(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_HOPOPTS) -static ERL_NIF_TERM nsetopt_lvl_ipv6_hopopts(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_hopopts(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_MTU) -static ERL_NIF_TERM nsetopt_lvl_ipv6_mtu(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_mtu(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_MTU_DISCOVER) -static ERL_NIF_TERM nsetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_MULTICAST_HOPS) -static ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_MULTICAST_IF) -static ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_if(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_if(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_MULTICAST_LOOP) -static ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_RECVERR) -static ERL_NIF_TERM nsetopt_lvl_ipv6_recverr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_recverr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_RECVPKTINFO) || defined(IPV6_PKTINFO) -static ERL_NIF_TERM nsetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_ROUTER_ALERT) -static ERL_NIF_TERM nsetopt_lvl_ipv6_router_alert(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_router_alert(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_RTHDR) -static ERL_NIF_TERM nsetopt_lvl_ipv6_rthdr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_rthdr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_UNICAST_HOPS) -static ERL_NIF_TERM nsetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_V6ONLY) -static ERL_NIF_TERM nsetopt_lvl_ipv6_v6only(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_ipv6_v6only(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(IPV6_ADD_MEMBERSHIP) || defined(IPV6_DROP_MEMBERSHIP) -static ERL_NIF_TERM nsetopt_lvl_ipv6_update_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal, - int opt); +static ERL_NIF_TERM nsetopt_lvl_ipv6_update_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal, + int opt); #endif #endif // defined(HAVE_IPV6) -static ERL_NIF_TERM nsetopt_lvl_tcp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_tcp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal); #if defined(TCP_CONGESTION) -static ERL_NIF_TERM nsetopt_lvl_tcp_congestion(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_tcp_congestion(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(TCP_MAXSEG) -static ERL_NIF_TERM nsetopt_lvl_tcp_maxseg(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_tcp_maxseg(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(TCP_NODELAY) -static ERL_NIF_TERM nsetopt_lvl_tcp_nodelay(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); -#endif -static ERL_NIF_TERM nsetopt_lvl_udp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_tcp_nodelay(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); +#endif +static ERL_NIF_TERM nsetopt_lvl_udp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal); #if defined(UDP_CORK) -static ERL_NIF_TERM nsetopt_lvl_udp_cork(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_udp_cork(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(HAVE_SCTP) -static ERL_NIF_TERM nsetopt_lvl_sctp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sctp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal); #if defined(SCTP_ASSOCINFO) -static ERL_NIF_TERM nsetopt_lvl_sctp_associnfo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sctp_associnfo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SCTP_AUTOCLOSE) -static ERL_NIF_TERM nsetopt_lvl_sctp_autoclose(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sctp_autoclose(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SCTP_DISABLE_FRAGMENTS) -static ERL_NIF_TERM nsetopt_lvl_sctp_disable_fragments(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sctp_disable_fragments(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SCTP_EVENTS) -static ERL_NIF_TERM nsetopt_lvl_sctp_events(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sctp_events(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SCTP_INITMSG) -static ERL_NIF_TERM nsetopt_lvl_sctp_initmsg(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sctp_initmsg(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SCTP_MAXSEG) -static ERL_NIF_TERM nsetopt_lvl_sctp_maxseg(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sctp_maxseg(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SCTP_NODELAY) -static ERL_NIF_TERM nsetopt_lvl_sctp_nodelay(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sctp_nodelay(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #if defined(SCTP_RTOINFO) -static ERL_NIF_TERM nsetopt_lvl_sctp_rtoinfo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_lvl_sctp_rtoinfo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal); #endif #endif // defined(HAVE_SCTP) -static ERL_NIF_TERM ngetopt(ErlNifEnv* env, - SocketDescriptor* descP, - BOOLEAN_T isEncoded, - BOOLEAN_T isOTP, - int level, - ERL_NIF_TERM eOpt); +static ERL_NIF_TERM ngetopt(ErlNifEnv* env, + ESockDescriptor* descP, + BOOLEAN_T isEncoded, + BOOLEAN_T isOTP, + int level, + ERL_NIF_TERM eOpt); -static ERL_NIF_TERM ngetopt_otp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt); +static ERL_NIF_TERM ngetopt_otp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt); /* *** ngetopt_otp_debug *** * *** ngetopt_otp_iow *** * *** ngetopt_otp_ctrl_proc *** @@ -1625,518 +1654,595 @@ static ERL_NIF_TERM ngetopt_otp(ErlNifEnv* env, NGETOPT_OTP_FUNC_DEF(protocol); #define NGETOPT_OTP_FUNC_DEF(F) \ static ERL_NIF_TERM ngetopt_otp_##F(ErlNifEnv* env, \ - SocketDescriptor* descP) + ESockDescriptor* descP) NGETOPT_OTP_FUNCS #undef NGETOPT_OTP_FUNC_DEF -static ERL_NIF_TERM ngetopt_native(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - ERL_NIF_TERM eOpt); -static ERL_NIF_TERM ngetopt_native_unspec(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - SOCKOPTLEN_T valueSz); -static ERL_NIF_TERM ngetopt_level(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int eOpt); -static ERL_NIF_TERM ngetopt_lvl_socket(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt); +static ERL_NIF_TERM ngetopt_native(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + ERL_NIF_TERM eOpt); +static ERL_NIF_TERM ngetopt_native_unspec(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + SOCKOPTLEN_T valueSz); +static ERL_NIF_TERM ngetopt_level(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int eOpt); +static ERL_NIF_TERM ngetopt_lvl_socket(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt); #if defined(SO_ACCEPTCONN) -static ERL_NIF_TERM ngetopt_lvl_sock_acceptconn(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_acceptconn(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_BINDTODEVICE) -static ERL_NIF_TERM ngetopt_lvl_sock_bindtodevice(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_bindtodevice(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_BROADCAST) -static ERL_NIF_TERM ngetopt_lvl_sock_broadcast(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_broadcast(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_DEBUG) -static ERL_NIF_TERM ngetopt_lvl_sock_debug(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_debug(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_DOMAIN) -static ERL_NIF_TERM ngetopt_lvl_sock_domain(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_domain(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_DONTROUTE) -static ERL_NIF_TERM ngetopt_lvl_sock_dontroute(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_dontroute(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_KEEPALIVE) -static ERL_NIF_TERM ngetopt_lvl_sock_keepalive(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_keepalive(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_LINGER) -static ERL_NIF_TERM ngetopt_lvl_sock_linger(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_linger(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_OOBINLINE) -static ERL_NIF_TERM ngetopt_lvl_sock_oobinline(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_oobinline(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_PEEK_OFF) -static ERL_NIF_TERM ngetopt_lvl_sock_peek_off(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_peek_off(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_PRIORITY) -static ERL_NIF_TERM ngetopt_lvl_sock_priority(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_priority(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_PROTOCOL) -static ERL_NIF_TERM ngetopt_lvl_sock_protocol(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_protocol(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_RCVBUF) -static ERL_NIF_TERM ngetopt_lvl_sock_rcvbuf(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_rcvbuf(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_RCVLOWAT) -static ERL_NIF_TERM ngetopt_lvl_sock_rcvlowat(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_rcvlowat(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_RCVTIMEO) -static ERL_NIF_TERM ngetopt_lvl_sock_rcvtimeo(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_rcvtimeo(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_REUSEADDR) -static ERL_NIF_TERM ngetopt_lvl_sock_reuseaddr(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_reuseaddr(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_REUSEPORT) -static ERL_NIF_TERM ngetopt_lvl_sock_reuseport(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_reuseport(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_SNDBUF) -static ERL_NIF_TERM ngetopt_lvl_sock_sndbuf(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_sndbuf(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_SNDLOWAT) -static ERL_NIF_TERM ngetopt_lvl_sock_sndlowat(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_sndlowat(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_SNDTIMEO) -static ERL_NIF_TERM ngetopt_lvl_sock_sndtimeo(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_sndtimeo(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_TIMESTAMP) -static ERL_NIF_TERM ngetopt_lvl_sock_timestamp(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_timestamp(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SO_TYPE) -static ERL_NIF_TERM ngetopt_lvl_sock_type(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sock_type(ErlNifEnv* env, + ESockDescriptor* descP); #endif -static ERL_NIF_TERM ngetopt_lvl_ip(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt); +static ERL_NIF_TERM ngetopt_lvl_ip(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt); #if defined(IP_FREEBIND) -static ERL_NIF_TERM ngetopt_lvl_ip_freebind(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_freebind(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_HDRINCL) -static ERL_NIF_TERM ngetopt_lvl_ip_hdrincl(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_hdrincl(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_MINTTL) -static ERL_NIF_TERM ngetopt_lvl_ip_minttl(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_minttl(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_MTU) -static ERL_NIF_TERM ngetopt_lvl_ip_mtu(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_mtu(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_MTU_DISCOVER) -static ERL_NIF_TERM ngetopt_lvl_ip_mtu_discover(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_mtu_discover(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_MULTICAST_ALL) -static ERL_NIF_TERM ngetopt_lvl_ip_multicast_all(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_multicast_all(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_MULTICAST_IF) -static ERL_NIF_TERM ngetopt_lvl_ip_multicast_if(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_multicast_if(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_MULTICAST_LOOP) -static ERL_NIF_TERM ngetopt_lvl_ip_multicast_loop(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_multicast_loop(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_MULTICAST_TTL) -static ERL_NIF_TERM ngetopt_lvl_ip_multicast_ttl(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_multicast_ttl(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_NODEFRAG) -static ERL_NIF_TERM ngetopt_lvl_ip_nodefrag(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_nodefrag(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_PKTINFO) -static ERL_NIF_TERM ngetopt_lvl_ip_pktinfo(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_pktinfo(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_RECVDSTADDR) -static ERL_NIF_TERM ngetopt_lvl_ip_recvdstaddr(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_recvdstaddr(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_RECVERR) -static ERL_NIF_TERM ngetopt_lvl_ip_recverr(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_recverr(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_RECVIF) -static ERL_NIF_TERM ngetopt_lvl_ip_recvif(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_recvif(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_RECVOPTS) -static ERL_NIF_TERM ngetopt_lvl_ip_recvopts(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_recvopts(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_RECVORIGDSTADDR) -static ERL_NIF_TERM ngetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_RECVTOS) -static ERL_NIF_TERM ngetopt_lvl_ip_recvtos(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_recvtos(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_RECVTTL) -static ERL_NIF_TERM ngetopt_lvl_ip_recvttl(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_recvttl(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_RETOPTS) -static ERL_NIF_TERM ngetopt_lvl_ip_retopts(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_retopts(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_ROUTER_ALERT) -static ERL_NIF_TERM ngetopt_lvl_ip_router_alert(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_router_alert(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_SENDSRCADDR) -static ERL_NIF_TERM ngetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_TOS) -static ERL_NIF_TERM ngetopt_lvl_ip_tos(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_tos(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_TRANSPARENT) -static ERL_NIF_TERM ngetopt_lvl_ip_transparent(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_transparent(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IP_TTL) -static ERL_NIF_TERM ngetopt_lvl_ip_ttl(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ip_ttl(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(HAVE_IPV6) -static ERL_NIF_TERM ngetopt_lvl_ipv6(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt); +static ERL_NIF_TERM ngetopt_lvl_ipv6(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt); #if defined(IPV6_AUTHHDR) -static ERL_NIF_TERM ngetopt_lvl_ipv6_authhdr(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_authhdr(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_DSTOPTS) -static ERL_NIF_TERM ngetopt_lvl_ipv6_dstopts(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_dstopts(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_FLOWINFO) -static ERL_NIF_TERM ngetopt_lvl_ipv6_flowinfo(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_flowinfo(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_HOPLIMIT) -static ERL_NIF_TERM ngetopt_lvl_ipv6_hoplimit(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_hoplimit(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_HOPOPTS) -static ERL_NIF_TERM ngetopt_lvl_ipv6_hopopts(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_hopopts(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_MTU) -static ERL_NIF_TERM ngetopt_lvl_ipv6_mtu(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_mtu(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_MTU_DISCOVER) -static ERL_NIF_TERM ngetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_MULTICAST_HOPS) -static ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_MULTICAST_IF) -static ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_if(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_if(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_MULTICAST_LOOP) -static ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_RECVERR) -static ERL_NIF_TERM ngetopt_lvl_ipv6_recverr(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_recverr(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_RECVPKTINFO) || defined(IPV6_PKTINFO) -static ERL_NIF_TERM ngetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_ROUTER_ALERT) -static ERL_NIF_TERM ngetopt_lvl_ipv6_router_alert(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_router_alert(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_RTHDR) -static ERL_NIF_TERM ngetopt_lvl_ipv6_rthdr(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_rthdr(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_UNICAST_HOPS) -static ERL_NIF_TERM ngetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(IPV6_V6ONLY) -static ERL_NIF_TERM ngetopt_lvl_ipv6_v6only(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_ipv6_v6only(ErlNifEnv* env, + ESockDescriptor* descP); #endif #endif // defined(HAVE_IPV6) -static ERL_NIF_TERM ngetopt_lvl_tcp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt); +static ERL_NIF_TERM ngetopt_lvl_tcp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt); #if defined(TCP_CONGESTION) -static ERL_NIF_TERM ngetopt_lvl_tcp_congestion(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_tcp_congestion(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(TCP_MAXSEG) -static ERL_NIF_TERM ngetopt_lvl_tcp_maxseg(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_tcp_maxseg(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(TCP_NODELAY) -static ERL_NIF_TERM ngetopt_lvl_tcp_nodelay(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_tcp_nodelay(ErlNifEnv* env, + ESockDescriptor* descP); #endif -static ERL_NIF_TERM ngetopt_lvl_udp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt); +static ERL_NIF_TERM ngetopt_lvl_udp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt); #if defined(UDP_CORK) -static ERL_NIF_TERM ngetopt_lvl_udp_cork(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_udp_cork(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(HAVE_SCTP) -static ERL_NIF_TERM ngetopt_lvl_sctp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt); +static ERL_NIF_TERM ngetopt_lvl_sctp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt); #if defined(SCTP_ASSOCINFO) -static ERL_NIF_TERM ngetopt_lvl_sctp_associnfo(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sctp_associnfo(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SCTP_AUTOCLOSE) -static ERL_NIF_TERM ngetopt_lvl_sctp_autoclose(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sctp_autoclose(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SCTP_DISABLE_FRAGMENTS) -static ERL_NIF_TERM ngetopt_lvl_sctp_disable_fragments(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sctp_disable_fragments(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SCTP_MAXSEG) -static ERL_NIF_TERM ngetopt_lvl_sctp_maxseg(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sctp_maxseg(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SCTP_INITMSG) -static ERL_NIF_TERM ngetopt_lvl_sctp_initmsg(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sctp_initmsg(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SCTP_NODELAY) -static ERL_NIF_TERM ngetopt_lvl_sctp_nodelay(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sctp_nodelay(ErlNifEnv* env, + ESockDescriptor* descP); #endif #if defined(SCTP_RTOINFO) -static ERL_NIF_TERM ngetopt_lvl_sctp_rtoinfo(ErlNifEnv* env, - SocketDescriptor* descP); +static ERL_NIF_TERM ngetopt_lvl_sctp_rtoinfo(ErlNifEnv* env, + ESockDescriptor* descP); #endif #endif // defined(HAVE_SCTP) -static ERL_NIF_TERM nsockname(ErlNifEnv* env, - SocketDescriptor* descP); -static ERL_NIF_TERM npeername(ErlNifEnv* env, - SocketDescriptor* descP); -static ERL_NIF_TERM ncancel(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM op, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM opRef); -static ERL_NIF_TERM ncancel_connect(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef); -static ERL_NIF_TERM ncancel_accept(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM opRef); -static ERL_NIF_TERM ncancel_accept_current(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef); -static ERL_NIF_TERM ncancel_accept_waiting(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef); -static ERL_NIF_TERM ncancel_send(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM opRef); -static ERL_NIF_TERM ncancel_send_current(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef); -static ERL_NIF_TERM ncancel_send_waiting(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef); -static ERL_NIF_TERM ncancel_recv(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM opRef); -static ERL_NIF_TERM ncancel_recv_current(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef); -static ERL_NIF_TERM ncancel_recv_waiting(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef); -static ERL_NIF_TERM ncancel_read_select(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef); -static ERL_NIF_TERM ncancel_write_select(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef); -static ERL_NIF_TERM ncancel_mode_select(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef, - int smode, - int rmode); +static ERL_NIF_TERM nsockname(ErlNifEnv* env, + ESockDescriptor* descP); +static ERL_NIF_TERM npeername(ErlNifEnv* env, + ESockDescriptor* descP); +static ERL_NIF_TERM ncancel(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM op, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef); +static ERL_NIF_TERM ncancel_connect(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef); +static ERL_NIF_TERM ncancel_accept(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef); +static ERL_NIF_TERM ncancel_accept_current(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef); +static ERL_NIF_TERM ncancel_accept_waiting(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef); +static ERL_NIF_TERM ncancel_send(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef); +static ERL_NIF_TERM ncancel_send_current(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef); +static ERL_NIF_TERM ncancel_send_waiting(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef); +static ERL_NIF_TERM ncancel_recv(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef); +static ERL_NIF_TERM ncancel_recv_current(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef); +static ERL_NIF_TERM ncancel_recv_waiting(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef); +static ERL_NIF_TERM ncancel_read_select(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef); +static ERL_NIF_TERM ncancel_write_select(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef); +static ERL_NIF_TERM ncancel_mode_select(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef, + int smode, + int rmode); #if defined(USE_SETOPT_STR_OPT) -static ERL_NIF_TERM nsetopt_str_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - int max, - ERL_NIF_TERM eVal); -#endif -static ERL_NIF_TERM nsetopt_bool_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - ERL_NIF_TERM eVal); -static ERL_NIF_TERM nsetopt_int_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - ERL_NIF_TERM eVal); -static ERL_NIF_TERM nsetopt_timeval_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_str_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + int max, + ERL_NIF_TERM eVal); +#endif +static ERL_NIF_TERM nsetopt_bool_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_int_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + ERL_NIF_TERM eVal); +static ERL_NIF_TERM nsetopt_timeval_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + ERL_NIF_TERM eVal); #if defined(USE_GETOPT_STR_OPT) -static ERL_NIF_TERM ngetopt_str_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - int max); -#endif -static ERL_NIF_TERM ngetopt_bool_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt); -static ERL_NIF_TERM ngetopt_int_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt); -static ERL_NIF_TERM ngetopt_timeval_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt); - -static BOOLEAN_T send_check_writer(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref, - ERL_NIF_TERM* checkResult); -static ERL_NIF_TERM send_check_result(ErlNifEnv* env, - SocketDescriptor* descP, - ssize_t written, - ssize_t dataSize, - int saveErrno, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM sendRef); -static BOOLEAN_T recv_check_reader(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref, - ERL_NIF_TERM* checkResult); -static char* recv_init_current_reader(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref); -static ERL_NIF_TERM recv_update_current_reader(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef); -static void recv_error_current_reader(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM reason); -static ERL_NIF_TERM recv_check_result(ErlNifEnv* env, - SocketDescriptor* descP, - int read, - int toRead, - int saveErrno, - ErlNifBinary* bufP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM recvRef); -static ERL_NIF_TERM recvfrom_check_result(ErlNifEnv* env, - SocketDescriptor* descP, - int read, - int saveErrno, - ErlNifBinary* bufP, - SocketAddress* fromAddrP, - unsigned int fromAddrLen, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM recvRef); -static ERL_NIF_TERM recvmsg_check_result(ErlNifEnv* env, - SocketDescriptor* descP, - int read, - int saveErrno, - struct msghdr* msgHdrP, - ErlNifBinary* dataBufP, - ErlNifBinary* ctrlBufP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM recvRef); - -static ERL_NIF_TERM nfinalize_connection(ErlNifEnv* env, - SocketDescriptor* descP); -static ERL_NIF_TERM nfinalize_close(ErlNifEnv* env, - SocketDescriptor* descP); - -extern char* encode_msghdr(ErlNifEnv* env, - SocketDescriptor* descP, - int read, - struct msghdr* msgHdrP, - ErlNifBinary* dataBufP, - ErlNifBinary* ctrlBufP, - ERL_NIF_TERM* eSockAddr); -extern char* encode_cmsghdrs(ErlNifEnv* env, - SocketDescriptor* descP, - ErlNifBinary* cmsgBinP, - struct msghdr* msgHdrP, - ERL_NIF_TERM* eCMsgHdr); -extern char* decode_cmsghdrs(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eCMsgHdr, - char* cmsgHdrBufP, - size_t cmsgHdrBufLen, - size_t* cmsgHdrBufUsed); -extern char* decode_cmsghdr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eCMsgHdr, - char* bufP, - size_t rem, - size_t* used); +static ERL_NIF_TERM ngetopt_str_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + int max); +#endif +static ERL_NIF_TERM ngetopt_bool_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt); +static ERL_NIF_TERM ngetopt_int_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt); +static ERL_NIF_TERM ngetopt_timeval_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt); + +static BOOLEAN_T send_check_writer(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM ref, + ERL_NIF_TERM* checkResult); +static ERL_NIF_TERM send_check_result(ErlNifEnv* env, + ESockDescriptor* descP, + ssize_t written, + ssize_t dataSize, + int saveErrno, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM sendRef); +static ERL_NIF_TERM send_check_ok(ErlNifEnv* env, + ESockDescriptor* descP, + ssize_t written, + ssize_t dataSize, + ERL_NIF_TERM sockRef); +static ERL_NIF_TERM send_check_fail(ErlNifEnv* env, + ESockDescriptor* descP, + int saveErrno, + ERL_NIF_TERM sockRef); +static ERL_NIF_TERM send_check_retry(ErlNifEnv* env, + ESockDescriptor* descP, + ssize_t written, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM sendRef); +static BOOLEAN_T recv_check_reader(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM ref, + ERL_NIF_TERM* checkResult); +static char* recv_init_current_reader(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM ref); +static ERL_NIF_TERM recv_update_current_reader(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef); +static void recv_error_current_reader(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM reason); +static ERL_NIF_TERM recv_check_result(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + int toRead, + int saveErrno, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef); +static ERL_NIF_TERM recv_check_full(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + int toRead, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef); +static ERL_NIF_TERM recv_check_full_maybe_done(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + int toRead, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef); +static ERL_NIF_TERM recv_check_full_done(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef); +static ERL_NIF_TERM recv_check_fail(ErlNifEnv* env, + ESockDescriptor* descP, + int saveErrno, + ErlNifBinary* buf1P, + ErlNifBinary* buf2P, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef); +static ERL_NIF_TERM recv_check_fail_closed(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef); +static ERL_NIF_TERM recv_check_partial(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + int toRead, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef); +static ERL_NIF_TERM recv_check_partial_done(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef); +static ERL_NIF_TERM recv_check_partial_part(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef); +static ERL_NIF_TERM recv_check_retry(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef); +static ERL_NIF_TERM recv_check_fail_gen(ErlNifEnv* env, + ESockDescriptor* descP, + int saveErrno, + ERL_NIF_TERM sockRef); +static ERL_NIF_TERM recvfrom_check_result(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + int saveErrno, + ErlNifBinary* bufP, + ESockAddress* fromAddrP, + unsigned int fromAddrLen, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef); +static ERL_NIF_TERM recvmsg_check_result(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + int saveErrno, + struct msghdr* msgHdrP, + ErlNifBinary* dataBufP, + ErlNifBinary* ctrlBufP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef); +static ERL_NIF_TERM recvmsg_check_msg(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + struct msghdr* msgHdrP, + ErlNifBinary* dataBufP, + ErlNifBinary* ctrlBufP, + ERL_NIF_TERM sockRef); + +static ERL_NIF_TERM nfinalize_connection(ErlNifEnv* env, + ESockDescriptor* descP); +static ERL_NIF_TERM nfinalize_close(ErlNifEnv* env, + ESockDescriptor* descP); + +extern char* encode_msghdr(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + struct msghdr* msgHdrP, + ErlNifBinary* dataBufP, + ErlNifBinary* ctrlBufP, + ERL_NIF_TERM* eSockAddr); +extern char* encode_cmsghdrs(ErlNifEnv* env, + ESockDescriptor* descP, + ErlNifBinary* cmsgBinP, + struct msghdr* msgHdrP, + ERL_NIF_TERM* eCMsgHdr); +extern char* decode_cmsghdrs(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eCMsgHdr, + char* cmsgHdrBufP, + size_t cmsgHdrBufLen, + size_t* cmsgHdrBufUsed); +extern char* decode_cmsghdr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eCMsgHdr, + char* bufP, + size_t rem, + size_t* used); static char* encode_cmsghdr_level(ErlNifEnv* env, int level, ERL_NIF_TERM* eLevel); @@ -2182,26 +2288,26 @@ static char* encode_cmsghdr_data_ipv6(ErlNifEnv* env, size_t dataLen, ERL_NIF_TERM* eCMsgHdrData); #endif -extern char* encode_msghdr_flags(ErlNifEnv* env, - SocketDescriptor* descP, - int msgFlags, - ERL_NIF_TERM* flags); -static char* decode_cmsghdr_data(ErlNifEnv* env, - SocketDescriptor* descP, - char* bufP, - size_t rem, - int level, - int type, - ERL_NIF_TERM eData, - size_t* used); -static char* decode_cmsghdr_final(SocketDescriptor* descP, - char* bufP, - size_t rem, - int level, - int type, - char* data, - int sz, - size_t* used); +extern char* encode_msghdr_flags(ErlNifEnv* env, + ESockDescriptor* descP, + int msgFlags, + ERL_NIF_TERM* flags); +static char* decode_cmsghdr_data(ErlNifEnv* env, + ESockDescriptor* descP, + char* bufP, + size_t rem, + int level, + int type, + ERL_NIF_TERM eData, + size_t* used); +static char* decode_cmsghdr_final(ESockDescriptor* descP, + char* bufP, + size_t rem, + int level, + int type, + char* data, + int sz, + size_t* used); static BOOLEAN_T decode_sock_linger(ErlNifEnv* env, ERL_NIF_TERM eVal, struct linger* valP); @@ -2244,12 +2350,18 @@ static BOOLEAN_T decode_native_get_opt(ErlNifEnv* env, // static void encode_bool(BOOLEAN_T val, ERL_NIF_TERM* eVal); static ERL_NIF_TERM encode_ip_tos(ErlNifEnv* env, int val); -static void inform_waiting_procs(ErlNifEnv* env, - char* role, - SocketDescriptor* descP, - SocketRequestQueue* q, - BOOLEAN_T free, - ERL_NIF_TERM reason); +static void socket_stop_handle_current(ErlNifEnv* env, + const char* role, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ESockRequestor* reqP); +static void inform_waiting_procs(ErlNifEnv* env, + const char* role, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ESockRequestQueue* q, + BOOLEAN_T free, + ERL_NIF_TERM reason); static int socket_setopt(int sock, int level, @@ -2257,9 +2369,9 @@ static int socket_setopt(int sock, const void* optVal, const socklen_t optLen); -static BOOLEAN_T verify_is_connected(SocketDescriptor* descP, int* err); +static BOOLEAN_T verify_is_connected(ESockDescriptor* descP, int* err); -static SocketDescriptor* alloc_descriptor(SOCKET sock, HANDLE event); +static ESockDescriptor* alloc_descriptor(SOCKET sock, HANDLE event); static BOOLEAN_T edomain2domain(int edomain, int* domain); @@ -2303,21 +2415,13 @@ static void dec_socket(int domain, int type, int protocol); ACTIVATE_NEXT_FUNC_DEF(writer) \ ACTIVATE_NEXT_FUNC_DEF(reader) -#define ACTIVATE_NEXT_FUNC_DEF(F) \ - static BOOLEAN_T activate_next_##F(ErlNifEnv* env, \ - SocketDescriptor* descP, \ - ERL_NIF_TERM sockRef); +#define ACTIVATE_NEXT_FUNC_DEF(F) \ + static BOOLEAN_T activate_next_##F(ErlNifEnv* env, \ + ESockDescriptor* descP, \ + ERL_NIF_TERM sockRef); ACTIVATE_NEXT_FUNCS_DEFS #undef ACTIVATE_NEXT_FUNC_DEF - -/* -static BOOLEAN_T activate_next(ErlNifEnv* env, - SocketDescriptor* descP, - SocketRequestor* reqP, - SocketRequestQueue* q, - ERL_NIF_TERM sockRef); -*/ - + /* *** acceptor_search4pid | writer_search4pid | reader_search4pid *** * *** acceptor_push | writer_push | reader_push *** * *** acceptor_pop | writer_pop | reader_pop *** @@ -2333,48 +2437,51 @@ static BOOLEAN_T activate_next(ErlNifEnv* env, ESOCK_OPERATOR_FUNCS_DEF(writer) \ ESOCK_OPERATOR_FUNCS_DEF(reader) -#define ESOCK_OPERATOR_FUNCS_DEF(O) \ - static BOOLEAN_T O##_search4pid(ErlNifEnv* env, \ - SocketDescriptor* descP, \ - ErlNifPid* pid); \ - static ERL_NIF_TERM O##_push(ErlNifEnv* env, \ - SocketDescriptor* descP, \ - ErlNifPid pid, \ - ERL_NIF_TERM ref); \ - static BOOLEAN_T O##_pop(ErlNifEnv* env, \ - SocketDescriptor* descP, \ - SocketRequestor* reqP); \ - static BOOLEAN_T O##_unqueue(ErlNifEnv* env, \ - SocketDescriptor* descP, \ - const ErlNifPid* pid); +#define ESOCK_OPERATOR_FUNCS_DEF(O) \ + static BOOLEAN_T O##_search4pid(ErlNifEnv* env, \ + ESockDescriptor* descP, \ + ErlNifPid* pid); \ + static ERL_NIF_TERM O##_push(ErlNifEnv* env, \ + ESockDescriptor* descP, \ + ErlNifPid pid, \ + ERL_NIF_TERM ref); \ + static BOOLEAN_T O##_pop(ErlNifEnv* env, \ + ESockDescriptor* descP, \ + ESockRequestor* reqP); \ + static BOOLEAN_T O##_unqueue(ErlNifEnv* env, \ + ESockDescriptor* descP, \ + const ErlNifPid* pid); ESOCK_OPERATOR_FUNCS_DEFS #undef ESOCK_OPERATOR_FUNCS_DEF -static BOOLEAN_T requestor_pop(SocketRequestQueue* q, - SocketRequestor* reqP); - -static BOOLEAN_T qsearch4pid(ErlNifEnv* env, - SocketRequestQueue* q, - ErlNifPid* pid); -static void qpush(SocketRequestQueue* q, - SocketRequestQueueElement* e); -static SocketRequestQueueElement* qpop(SocketRequestQueue* q); -static BOOLEAN_T qunqueue(ErlNifEnv* env, - SocketDescriptor* descP, - const char* slogan, - SocketRequestQueue* q, - const ErlNifPid* pid); - -static int esock_monitor(const char* slogan, - ErlNifEnv* env, - SocketDescriptor* descP, - const ErlNifPid* pid, - ESockMonitor* mon); -static int esock_demonitor(const char* slogan, - ErlNifEnv* env, - SocketDescriptor* descP, - ESockMonitor* monP); +static BOOLEAN_T requestor_pop(ESockRequestQueue* q, + ESockRequestor* reqP); + +static BOOLEAN_T qsearch4pid(ErlNifEnv* env, + ESockRequestQueue* q, + ErlNifPid* pid); +static void qpush(ESockRequestQueue* q, + ESockRequestQueueElement* e); +static ESockRequestQueueElement* qpop(ESockRequestQueue* q); +static BOOLEAN_T qunqueue(ErlNifEnv* env, + ESockDescriptor* descP, + const char* slogan, + ESockRequestQueue* q, + const ErlNifPid* pid); + +static int esock_monitor(const char* slogan, + ErlNifEnv* env, + ESockDescriptor* descP, + const ErlNifPid* pid, + ESockMonitor* mon); +static int esock_demonitor(const char* slogan, + ErlNifEnv* env, + ESockDescriptor* descP, + ESockMonitor* monP); static void esock_monitor_init(ESockMonitor* mon); +static ERL_NIF_TERM esock_make_monitor_term(ErlNifEnv* env, + const ESockMonitor* monP); + #endif // if defined(__WIN32__) @@ -2396,48 +2503,62 @@ static void socket_down(ErlNifEnv* env, #if !defined(__WIN32__) -static void socket_down_acceptor(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - const ErlNifPid* pid); -static void socket_down_writer(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - const ErlNifPid* pid); -static void socket_down_reader(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - const ErlNifPid* pid); - -static char* esock_send_close_msg(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef); +static void socket_down_acceptor(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + const ErlNifPid* pid); +static void socket_down_writer(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + const ErlNifPid* pid); +static void socket_down_reader(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + const ErlNifPid* pid); + +static char* esock_send_close_msg(ErlNifEnv* env, + ESockDescriptor* descP, + ErlNifPid* pid); static char* esock_send_abort_msg(ErlNifEnv* env, ERL_NIF_TERM sockRef, ERL_NIF_TERM recvRef, + ErlNifEnv* msgEnv, ERL_NIF_TERM reason, ErlNifPid* pid); -static char* esock_send_socket_msg(ErlNifEnv* env, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM tag, - ERL_NIF_TERM info, - ErlNifPid* pid, - ErlNifEnv* msg_env); static char* esock_send_msg(ErlNifEnv* env, - ERL_NIF_TERM msg, ErlNifPid* pid, - ErlNifEnv* msg_env); + ERL_NIF_TERM msg, + ErlNifEnv* msgEnv); + +static ERL_NIF_TERM mk_abort_msg(ErlNifEnv* env, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef, + ERL_NIF_TERM reason); +static ERL_NIF_TERM mk_close_msg(ErlNifEnv* env, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM closeRef); +static ERL_NIF_TERM mk_select_msg(ErlNifEnv* env, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM selectRef); +static ERL_NIF_TERM mk_socket_msg(ErlNifEnv* env, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM tag, + ERL_NIF_TERM info); +static ERL_NIF_TERM mk_socket(ErlNifEnv* env, + ERL_NIF_TERM sockRef); static int esock_select_read(ErlNifEnv* env, ErlNifEvent event, void* obj, const ErlNifPid* pid, - ERL_NIF_TERM ref); + ERL_NIF_TERM sockRef, + ERL_NIF_TERM selectRef); static int esock_select_write(ErlNifEnv* env, ErlNifEvent event, void* obj, const ErlNifPid* pid, - ERL_NIF_TERM ref); + ERL_NIF_TERM sockRef, + ERL_NIF_TERM selectRef); static int esock_select_stop(ErlNifEnv* env, ErlNifEvent event, void* obj); @@ -2786,7 +2907,30 @@ static ErlNifResourceTypeInit socketInit = { }; // Initiated when the nif is loaded -static SocketData data; +static ESockData data; + + +/* These two (inline) functions are primarily intended for debugging, + * that is, to make it easy to add debug printouts. + */ +static ESOCK_INLINE void esock_free_env(const char* slogan, ErlNifEnv* env) +{ + SGDBG( ("SOCKET", "env free - %s: 0x%lX\r\n", slogan, env) ); + // esock_dbg_printf("SOCK ENV", "free - %s: 0x%lX\r\n", slogan, env); + + if (env != NULL) enif_free_env(env); +} + + +static ESOCK_INLINE ErlNifEnv* esock_alloc_env(const char* slogan) +{ + ErlNifEnv* env = enif_alloc_env(); + + SGDBG( ("SOCKET", "env alloc - %s: 0x%lX\r\n", slogan, env) ); + // esock_dbg_printf("SOCK ENV", "alloc - %s: 0x%lX\r\n", slogan, env); + + return env; +} /* ---------------------------------------------------------------------- @@ -4282,13 +4426,13 @@ ERL_NIF_TERM nopen(ErlNifEnv* env, int domain, int type, int protocol, char* netns) { - SocketDescriptor* descP; - ERL_NIF_TERM res; - int save_errno = 0; - SOCKET sock; - HANDLE event; + ESockDescriptor* descP; + ERL_NIF_TERM res; + int save_errno = 0; + SOCKET sock; + HANDLE event; #ifdef HAVE_SETNS - int current_ns = 0; + int current_ns = 0; #endif SGDBG( ("SOCKET", "nopen -> entry with" @@ -4502,11 +4646,11 @@ ERL_NIF_TERM nif_bind(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - ERL_NIF_TERM eSockAddr; - SocketAddress sockAddr; - unsigned int addrLen; - char* xres; + ESockDescriptor* descP; + ERL_NIF_TERM eSockAddr; + ESockAddress sockAddr; + unsigned int addrLen; + char* xres; SGDBG( ("SOCKET", "nif_bind -> entry with argc: %d\r\n", argc) ); @@ -4544,10 +4688,10 @@ ERL_NIF_TERM nif_bind(ErlNifEnv* env, #if !defined(__WIN32__) static -ERL_NIF_TERM nbind(ErlNifEnv* env, - SocketDescriptor* descP, - SocketAddress* sockAddrP, - unsigned int addrLen) +ERL_NIF_TERM nbind(ErlNifEnv* env, + ESockDescriptor* descP, + ESockAddress* sockAddrP, + unsigned int addrLen) { int port, ntohs_port; @@ -4563,7 +4707,7 @@ ERL_NIF_TERM nbind(ErlNifEnv* env, port = which_address_port(sockAddrP); SSDBG( descP, ("SOCKET", "nbind -> port: %d\r\n", port) ); if (port == 0) { - SOCKLEN_T len = sizeof(SocketAddress); + SOCKLEN_T len = sizeof(ESockAddress); sys_memzero((char *) sockAddrP, len); sock_name(descP->sock, &sockAddrP->sa, &len); port = which_address_port(sockAddrP); @@ -4603,16 +4747,17 @@ ERL_NIF_TERM nif_connect(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - ERL_NIF_TERM res, eSockAddr; - char* xres; + ESockDescriptor* descP; + ERL_NIF_TERM res, eSockAddr, sockRef; + char* xres; SGDBG( ("SOCKET", "nif_connect -> entry with argc: %d\r\n", argc) ); /* Extract arguments and perform preliminary validation */ + sockRef = argv[0]; if ((argc != 2) || - !enif_get_resource(env, argv[0], sockets, (void**) &descP)) { + !enif_get_resource(env, sockRef, sockets, (void**) &descP)) { return enif_make_badarg(env); } eSockAddr = argv[1]; @@ -4624,16 +4769,24 @@ ERL_NIF_TERM nif_connect(ErlNifEnv* env, "\r\n", descP->sock, argv[0], eSockAddr) ); if ((xres = esock_decode_sockaddr(env, eSockAddr, - &descP->remote, &descP->addrLen)) != NULL) { + &descP->remote, + &descP->addrLen)) != NULL) { return esock_make_error_str(env, xres); } + /* Only a *!%&$*# would send an opened but non-connected socket + * somewhere (before its actually usable), but just to be on the + * safe side we do the best we can to avoid complications... + */ + MLOCK(descP->readMtx); MLOCK(descP->writeMtx); + MLOCK(descP->cfgMtx); - res = nconnect(env, descP); + res = nconnect(env, descP, sockRef); + MUNLOCK(descP->cfgMtx); MUNLOCK(descP->writeMtx); MUNLOCK(descP->readMtx); @@ -4645,8 +4798,9 @@ ERL_NIF_TERM nif_connect(ErlNifEnv* env, #if !defined(__WIN32__) static -ERL_NIF_TERM nconnect(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM nconnect(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef) { ERL_NIF_TERM res, ref; int code, sres, save_errno = 0; @@ -4691,7 +4845,8 @@ ERL_NIF_TERM nconnect(ErlNifEnv* env, (save_errno == EINPROGRESS))) { /* Unix & OSE!! */ ref = MKREF(env); descP->state = SOCKET_STATE_CONNECTING; - if ((sres = esock_select_write(env, descP->sock, descP, NULL, ref)) < 0) { + if ((sres = esock_select_write(env, descP->sock, descP, NULL, + sockRef, ref)) < 0) { res = esock_make_error(env, MKT2(env, esock_atom_select_failed, @@ -4721,6 +4876,9 @@ ERL_NIF_TERM nconnect(ErlNifEnv* env, * * Description: * Make socket ready for input and output. + * This function is called if we where made to wait when we called the + * nif_connect function (we made a select, and the select message has + * now been received). * * Arguments: * Socket (ref) - Points to the socket descriptor. @@ -4733,7 +4891,7 @@ ERL_NIF_TERM nif_finalize_connection(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; + ESockDescriptor* descP; /* Extract arguments and perform preliminary validation */ @@ -4753,8 +4911,8 @@ ERL_NIF_TERM nif_finalize_connection(ErlNifEnv* env, */ #if !defined(__WIN32__) static -ERL_NIF_TERM nfinalize_connection(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM nfinalize_connection(ErlNifEnv* env, + ESockDescriptor* descP) { int error; @@ -4780,7 +4938,7 @@ ERL_NIF_TERM nfinalize_connection(ErlNifEnv* env, */ #if !defined(__WIN32__) static -BOOLEAN_T verify_is_connected(SocketDescriptor* descP, int* err) +BOOLEAN_T verify_is_connected(ESockDescriptor* descP, int* err) { /* * *** This is strange *** @@ -4848,8 +5006,8 @@ ERL_NIF_TERM nif_listen(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - int backlog; + ESockDescriptor* descP; + int backlog; SGDBG( ("SOCKET", "nif_listen -> entry with argc: %d\r\n", argc) ); @@ -4876,9 +5034,9 @@ ERL_NIF_TERM nif_listen(ErlNifEnv* env, #if !defined(__WIN32__) static -ERL_NIF_TERM nlisten(ErlNifEnv* env, - SocketDescriptor* descP, - int backlog) +ERL_NIF_TERM nlisten(ErlNifEnv* env, + ESockDescriptor* descP, + int backlog) { /* @@ -4930,8 +5088,8 @@ ERL_NIF_TERM nif_accept(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - ERL_NIF_TERM sockRef, ref, res; + ESockDescriptor* descP; + ERL_NIF_TERM sockRef, ref, res; SGDBG( ("SOCKET", "nif_accept -> entry with argc: %d\r\n", argc) ); @@ -4944,13 +5102,29 @@ ERL_NIF_TERM nif_accept(ErlNifEnv* env, } ref = argv[1]; + MLOCK(descP->accMtx); + SSDBG( descP, ("SOCKET", "nif_accept -> args when sock = %d:" - "\r\n Socket: %T" - "\r\n ReqRef: %T" - "\r\n", descP->sock, argv[0], ref) ); - - MLOCK(descP->accMtx); + "\r\n Socket: %T" + "\r\n ReqRef: %T" + "\r\nwhen" + "\r\n State: %s" + "\r\n Current Acceptor Addr: 0x%lX" + "\r\n Current Acceptor pid: %T" + "\r\n Current Acceptor mon: %T" + "\r\n Current Acceptor env: 0x%lX" + "\r\n Current Acceptor ref: %T" + "\r\n", + descP->sock, + sockRef, ref, + ((descP->state == SOCKET_STATE_LISTENING) ? "listening" : + ((descP->state == SOCKET_STATE_ACCEPTING) ? "accepting" : "other")), + descP->currentAcceptorP, + descP->currentAcceptor.pid, + esock_make_monitor_term(env, &descP->currentAcceptor.mon), + descP->currentAcceptor.env, + descP->currentAcceptor.ref) ); res = naccept(env, descP, sockRef, ref); @@ -4964,10 +5138,10 @@ ERL_NIF_TERM nif_accept(ErlNifEnv* env, #if !defined(__WIN32__) static -ERL_NIF_TERM naccept(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM ref) +ERL_NIF_TERM naccept(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM ref) { ERL_NIF_TERM res; @@ -4976,7 +5150,7 @@ ERL_NIF_TERM naccept(ErlNifEnv* env, switch (descP->state) { case SOCKET_STATE_LISTENING: - res = naccept_listening(env, descP, ref); + res = naccept_listening(env, descP, sockRef, ref); break; case SOCKET_STATE_ACCEPTING: @@ -4994,15 +5168,17 @@ ERL_NIF_TERM naccept(ErlNifEnv* env, /* *** naccept_listening *** - * We have no active acceptor (and no acceptors in queue). + * + * We have no active acceptor (and therefor no acceptors in queue). */ #if !defined(__WIN32__) static -ERL_NIF_TERM naccept_listening(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref) +ERL_NIF_TERM naccept_listening(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM accRef) { - SocketAddress remote; + ESockAddress remote; unsigned int n; SOCKET accSock; int save_errno; @@ -5026,7 +5202,8 @@ ERL_NIF_TERM naccept_listening(ErlNifEnv* env, ("SOCKET", "naccept_listening -> accept failed (%d)\r\n", save_errno) ); - res = naccept_listening_error(env, descP, ref, caller, save_errno); + res = naccept_listening_error(env, descP, sockRef, accRef, + caller, save_errno); } else { @@ -5045,38 +5222,45 @@ ERL_NIF_TERM naccept_listening(ErlNifEnv* env, /* *** naccept_listening_error *** + * * The accept call resultet in an error - handle it. * There are only two cases: * 1) BLOCK => Attempt a "retry" * 2) Other => Return the value (converted to an atom) */ static -ERL_NIF_TERM naccept_listening_error(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref, - ErlNifPid caller, - int save_errno) +ERL_NIF_TERM naccept_listening_error(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM accRef, + ErlNifPid caller, + int save_errno) { ERL_NIF_TERM res; if (save_errno == ERRNO_BLOCK) { /* *** Try again later *** */ - SSDBG( descP, ("SOCKET", "naccept_listening_error -> would block\r\n") ); + + SSDBG( descP, + ("SOCKET", "naccept_listening_error -> would block\r\n") ); descP->currentAcceptor.pid = caller; if (MONP("naccept_listening -> current acceptor", env, descP, &descP->currentAcceptor.pid, - &descP->currentAcceptor.mon) != 0) - return esock_make_error(env, atom_exmon); - - descP->currentAcceptor.ref = enif_make_copy(descP->env, ref); - descP->currentAcceptorP = &descP->currentAcceptor; - - res = naccept_busy_retry(env, descP, ref, NULL, SOCKET_STATE_ACCEPTING); - - + &descP->currentAcceptor.mon) != 0) { + enif_set_pid_undefined(&descP->currentAcceptor.pid); + res = esock_make_error(env, atom_exmon); + } else { + descP->currentAcceptor.env = esock_alloc_env("current acceptor"); + descP->currentAcceptor.ref = CP_TERM(descP->currentAcceptor.env, + accRef); + descP->currentAcceptorP = &descP->currentAcceptor; + res = naccept_busy_retry(env, descP, + sockRef, accRef, + NULL, SOCKET_STATE_ACCEPTING); + } } else { SSDBG( descP, ("SOCKET", @@ -5089,14 +5273,15 @@ ERL_NIF_TERM naccept_listening_error(ErlNifEnv* env, /* *** naccept_listening_accept *** + * * The accept call was successful (accepted) - handle the new connection. */ static -ERL_NIF_TERM naccept_listening_accept(ErlNifEnv* env, - SocketDescriptor* descP, - SOCKET accSock, - ErlNifPid caller, - SocketAddress* remote) +ERL_NIF_TERM naccept_listening_accept(ErlNifEnv* env, + ESockDescriptor* descP, + SOCKET accSock, + ErlNifPid caller, + ESockAddress* remote) { ERL_NIF_TERM res; @@ -5109,16 +5294,17 @@ ERL_NIF_TERM naccept_listening_accept(ErlNifEnv* env, /* *** naccept_accepting *** + * * We have an active acceptor and possibly acceptors waiting in queue. * If the pid of the calling process is not the pid of the "current process", * push the requester onto the (acceptor) queue. */ #if !defined(__WIN32__) static -ERL_NIF_TERM naccept_accepting(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM ref) +ERL_NIF_TERM naccept_accepting(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM ref) { ErlNifPid caller; ERL_NIF_TERM res; @@ -5162,12 +5348,12 @@ ERL_NIF_TERM naccept_accepting(ErlNifEnv* env, * Handles when the current acceptor makes another attempt. */ static -ERL_NIF_TERM naccept_accepting_current(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM accRef) +ERL_NIF_TERM naccept_accepting_current(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM accRef) { - SocketAddress remote; + ESockAddress remote; unsigned int n; SOCKET accSock; int save_errno; @@ -5207,24 +5393,24 @@ ERL_NIF_TERM naccept_accepting_current(ErlNifEnv* env, * handle the new connection. */ static -ERL_NIF_TERM naccept_accepting_current_accept(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - SOCKET accSock, - SocketAddress* remote) +ERL_NIF_TERM naccept_accepting_current_accept(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + SOCKET accSock, + ESockAddress* remote) { ERL_NIF_TERM res; if (naccept_accepted(env, descP, accSock, descP->currentAcceptor.pid, remote, &res)) { - /* We should really go through the queue until we succeed to activate - * a waiting acceptor. For now we just pop once and hope for the best... - * This will leave any remaining acceptors *hanging*... - * - * We need a "activate-next" function. - * - */ + /* Clean out the old cobweb's before trying to invite a new spider */ + + descP->currentAcceptor.ref = esock_atom_undefined; + enif_set_pid_undefined(&descP->currentAcceptor.pid); + esock_free_env("naccept_accepting_current_accept - " + "current-accept-env", + descP->currentAcceptor.env); if (!activate_next_acceptor(env, descP, sockRef)) { @@ -5236,9 +5422,8 @@ ERL_NIF_TERM naccept_accepting_current_accept(ErlNifEnv* env, descP->state = SOCKET_STATE_LISTENING; descP->currentAcceptorP = NULL; - descP->currentAcceptor.ref = esock_atom_undefined; - enif_set_pid_undefined(&descP->currentAcceptor.pid); - esock_monitor_init(&descP->currentAcceptor.mon); + descP->currentAcceptor.env = NULL; + MON_INIT(&descP->currentAcceptor.mon); } } @@ -5254,14 +5439,14 @@ ERL_NIF_TERM naccept_accepting_current_accept(ErlNifEnv* env, * 2) Other => Return the value (converted to an atom) */ static -ERL_NIF_TERM naccept_accepting_current_error(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM opRef, - int save_errno) +ERL_NIF_TERM naccept_accepting_current_error(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef, + int save_errno) { - SocketRequestor req; - ERL_NIF_TERM res, reason; + ESockRequestor req; + ERL_NIF_TERM res, reason; if (save_errno == ERRNO_BLOCK) { @@ -5274,7 +5459,8 @@ ERL_NIF_TERM naccept_accepting_current_error(ErlNifEnv* env, "naccept_accepting_current_error -> " "would block: try again\r\n") ); - res = naccept_busy_retry(env, descP, opRef, &descP->currentAcceptor.pid, + res = naccept_busy_retry(env, descP, sockRef, opRef, + &descP->currentAcceptor.pid, /* No state change */ descP->state); @@ -5287,7 +5473,8 @@ ERL_NIF_TERM naccept_accepting_current_error(ErlNifEnv* env, SSDBG( descP, ("SOCKET", "naccept_accepting_current_error -> abort %T\r\n", req.pid) ); - esock_send_abort_msg(env, sockRef, req.ref, reason, &req.pid); + esock_send_abort_msg(env, sockRef, req.ref, req.env, + reason, &req.pid); DEMONP("naccept_accepting_current_error -> pop'ed writer", env, descP, &req.mon); } @@ -5304,10 +5491,10 @@ ERL_NIF_TERM naccept_accepting_current_error(ErlNifEnv* env, * acceptor queue. */ static -ERL_NIF_TERM naccept_accepting_other(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref, - ErlNifPid caller) +ERL_NIF_TERM naccept_accepting_other(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM ref, + ErlNifPid caller) { ERL_NIF_TERM result; @@ -5323,25 +5510,28 @@ ERL_NIF_TERM naccept_accepting_other(ErlNifEnv* env, /* *** naccept_busy_retry *** + * * Perform a retry select. If successful, set nextState. */ #if !defined(__WIN32__) static -ERL_NIF_TERM naccept_busy_retry(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref, - ErlNifPid* pid, - unsigned int nextState) +ERL_NIF_TERM naccept_busy_retry(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM accRef, + ErlNifPid* pid, + unsigned int nextState) { int sres; ERL_NIF_TERM res, reason; - if ((sres = esock_select_read(env, descP->sock, descP, pid, ref)) < 0) { + if ((sres = esock_select_read(env, descP->sock, descP, pid, + sockRef, accRef)) < 0) { reason = MKT2(env, esock_atom_select_failed, MKI(env, sres)); res = esock_make_error(env, reason); } else { descP->state = nextState; - res = esock_make_error(env, esock_atom_eagain); + res = esock_make_error(env, esock_atom_eagain); // OK!! } return res; @@ -5350,20 +5540,21 @@ ERL_NIF_TERM naccept_busy_retry(ErlNifEnv* env, /* *** naccept_accepted *** + * * Generic function handling a successful accept. */ static -BOOLEAN_T naccept_accepted(ErlNifEnv* env, - SocketDescriptor* descP, - SOCKET accSock, - ErlNifPid pid, - SocketAddress* remote, - ERL_NIF_TERM* result) +BOOLEAN_T naccept_accepted(ErlNifEnv* env, + ESockDescriptor* descP, + SOCKET accSock, + ErlNifPid pid, + ESockAddress* remote, + ERL_NIF_TERM* result) { - SocketDescriptor* accDescP; - HANDLE accEvent; - ERL_NIF_TERM accRef; - int save_errno; + ESockDescriptor* accDescP; + HANDLE accEvent; + ERL_NIF_TERM accRef; + int save_errno; /* * We got one @@ -5389,7 +5580,7 @@ BOOLEAN_T naccept_accepted(ErlNifEnv* env, accDescP->rBufSz = descP->rBufSz; // Inherit buffer size accDescP->rNum = descP->rNum; // Inherit buffer uses accDescP->rNumCnt = 0; - accDescP->rCtrlSz = descP->rCtrlSz; // Inherit buffer siez + accDescP->rCtrlSz = descP->rCtrlSz; // Inherit buffer size accDescP->wCtrlSz = descP->wCtrlSz; // Inherit buffer size accRef = enif_make_resource(env, accDescP); @@ -5401,6 +5592,7 @@ BOOLEAN_T naccept_accepted(ErlNifEnv* env, &accDescP->ctrlPid, &accDescP->ctrlMon) != 0) { sock_close(accSock); + enif_set_pid_undefined(&descP->ctrlPid); *result = esock_make_error(env, atom_exmon); return FALSE; } @@ -5442,12 +5634,12 @@ ERL_NIF_TERM nif_send(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - ERL_NIF_TERM sockRef, sendRef; - ErlNifBinary sndData; - unsigned int eflags; - int flags; - ERL_NIF_TERM res; + ESockDescriptor* descP; + ERL_NIF_TERM sockRef, sendRef; + ErlNifBinary sndData; + unsigned int eflags; + int flags; + ERL_NIF_TERM res; SGDBG( ("SOCKET", "nif_send -> entry with argc: %d\r\n", argc) ); @@ -5484,11 +5676,6 @@ ERL_NIF_TERM nif_send(ErlNifEnv* env, * this time (resulting in an select). The write of the * other process must be made to wait until current * is done! - * Basically, we need a write queue! - * - * A 'writing' field (boolean), which is set if we did - * not manage to write the entire message and reset every - * time we do. */ res = nsend(env, descP, sockRef, sendRef, &sndData, flags); @@ -5496,6 +5683,7 @@ ERL_NIF_TERM nif_send(ErlNifEnv* env, MUNLOCK(descP->writeMtx); return res; + #endif // if defined(__WIN32__) } @@ -5510,12 +5698,12 @@ ERL_NIF_TERM nif_send(ErlNifEnv* env, */ #if !defined(__WIN32__) static -ERL_NIF_TERM nsend(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM sendRef, - ErlNifBinary* sndDataP, - int flags) +ERL_NIF_TERM nsend(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM sendRef, + ErlNifBinary* sndDataP, + int flags) { int save_errno; ssize_t written; @@ -5570,16 +5758,16 @@ ERL_NIF_TERM nif_sendto(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - ERL_NIF_TERM sockRef, sendRef; - ErlNifBinary sndData; - unsigned int eflags; - int flags; - ERL_NIF_TERM eSockAddr; - SocketAddress remoteAddr; - unsigned int remoteAddrLen; - char* xres; - ERL_NIF_TERM res; + ESockDescriptor* descP; + ERL_NIF_TERM sockRef, sendRef; + ErlNifBinary sndData; + unsigned int eflags; + int flags; + ERL_NIF_TERM eSockAddr; + ESockAddress remoteAddr; + unsigned int remoteAddrLen; + char* xres; + ERL_NIF_TERM res; SGDBG( ("SOCKET", "nif_sendto -> entry with argc: %d\r\n", argc) ); @@ -5617,7 +5805,8 @@ ERL_NIF_TERM nif_sendto(ErlNifEnv* env, if ((xres = esock_decode_sockaddr(env, eSockAddr, &remoteAddr, &remoteAddrLen)) != NULL) { - SSDBG( descP, ("SOCKET", "nif_sendto -> sockaddr decode: %s\r\n", xres) ); + SSDBG( descP, + ("SOCKET", "nif_sendto -> sockaddr decode: %s\r\n", xres) ); return esock_make_error_str(env, xres); } @@ -5633,20 +5822,21 @@ ERL_NIF_TERM nif_sendto(ErlNifEnv* env, "\r\n", res) ); return res; + #endif // if defined(__WIN32__) } #if !defined(__WIN32__) static -ERL_NIF_TERM nsendto(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM sendRef, - ErlNifBinary* dataP, - int flags, - SocketAddress* toAddrP, - unsigned int toAddrLen) +ERL_NIF_TERM nsendto(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM sendRef, + ErlNifBinary* dataP, + int flags, + ESockAddress* toAddrP, + unsigned int toAddrLen) { int save_errno; ssize_t written; @@ -5706,10 +5896,10 @@ ERL_NIF_TERM nif_sendmsg(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - ERL_NIF_TERM res, sockRef, sendRef, eMsgHdr; - SocketDescriptor* descP; - unsigned int eflags; - int flags; + ERL_NIF_TERM res, sockRef, sendRef, eMsgHdr; + ESockDescriptor* descP; + unsigned int eflags; + int flags; SGDBG( ("SOCKET", "nif_sendmsg -> entry with argc: %d\r\n", argc) ); @@ -5751,21 +5941,22 @@ ERL_NIF_TERM nif_sendmsg(ErlNifEnv* env, "\r\n", res) ); return res; + #endif // if defined(__WIN32__) } #if !defined(__WIN32__) static -ERL_NIF_TERM nsendmsg(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM sendRef, - ERL_NIF_TERM eMsgHdr, - int flags) +ERL_NIF_TERM nsendmsg(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM sendRef, + ERL_NIF_TERM eMsgHdr, + int flags) { ERL_NIF_TERM res, eAddr, eIOV, eCtrl; - SocketAddress addr; + ESockAddress addr; struct msghdr msgHdr; ErlNifBinary* iovBins; struct iovec* iov; @@ -5908,6 +6099,7 @@ ERL_NIF_TERM nsendmsg(ErlNifEnv* env, if (ctrlBuf != NULL) FREE(ctrlBuf); return res; + } #endif // if !defined(__WIN32__) @@ -5928,10 +6120,10 @@ ERL_NIF_TERM nsendmsg(ErlNifEnv* env, #ifdef FOBAR static -ERL_NIF_TERM nwritev(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sendRef, - ERL_NIF_TERM data) +ERL_NIF_TERM nwritev(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sendRef, + ERL_NIF_TERM data) { ERL_NIF_TERM tail; ErlNifIOVec vec; @@ -6006,12 +6198,12 @@ ERL_NIF_TERM nif_recv(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - ERL_NIF_TERM sockRef, recvRef; - int len; - unsigned int eflags; - int flags; - ERL_NIF_TERM res; + ESockDescriptor* descP; + ERL_NIF_TERM sockRef, recvRef; + int len; + unsigned int eflags; + int flags; + ERL_NIF_TERM res; if ((argc != 4) || !GET_INT(env, argv[2], &len) || @@ -6036,11 +6228,6 @@ ERL_NIF_TERM nif_recv(ErlNifEnv* env, * this time (resulting in an select). The read of the * other process must be made to wait until current * is done! - * Basically, we need a read queue! - * - * A 'reading' field (boolean), which is set if we did - * not manage to read the entire message and reset every - * time we do. */ res = nrecv(env, descP, sockRef, recvRef, len, flags); @@ -6048,23 +6235,24 @@ ERL_NIF_TERM nif_recv(ErlNifEnv* env, MUNLOCK(descP->readMtx); return res; + #endif // if defined(__WIN32__) } -/* The (read) buffer handling *must* be optimized! +/* The (read) buffer handling should be optimized! * But for now we make it easy for ourselves by * allocating a binary (of the specified or default * size) and then throwing it away... */ #if !defined(__WIN32__) static -ERL_NIF_TERM nrecv(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM recvRef, - int len, - int flags) +ERL_NIF_TERM nrecv(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef, + int len, + int flags) { ssize_t read; ErlNifBinary buf; @@ -6150,12 +6338,12 @@ ERL_NIF_TERM nif_recvfrom(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - ERL_NIF_TERM sockRef, recvRef; - unsigned int bufSz; - unsigned int eflags; - int flags; - ERL_NIF_TERM res; + ESockDescriptor* descP; + ERL_NIF_TERM sockRef, recvRef; + unsigned int bufSz; + unsigned int eflags; + int flags; + ERL_NIF_TERM res; SGDBG( ("SOCKET", "nif_recvfrom -> entry with argc: %d\r\n", argc) ); @@ -6222,14 +6410,14 @@ ERL_NIF_TERM nif_recvfrom(ErlNifEnv* env, */ #if !defined(__WIN32__) static -ERL_NIF_TERM nrecvfrom(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM recvRef, - Uint16 len, - int flags) +ERL_NIF_TERM nrecvfrom(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef, + Uint16 len, + int flags) { - SocketAddress fromAddr; + ESockAddress fromAddr; unsigned int addrLen; ssize_t read; int save_errno; @@ -6319,13 +6507,13 @@ ERL_NIF_TERM nif_recvmsg(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - ERL_NIF_TERM sockRef, recvRef; - unsigned int bufSz; - unsigned int ctrlSz; - unsigned int eflags; - int flags; - ERL_NIF_TERM res; + ESockDescriptor* descP; + ERL_NIF_TERM sockRef, recvRef; + unsigned int bufSz; + unsigned int ctrlSz; + unsigned int eflags; + int flags; + ERL_NIF_TERM res; SGDBG( ("SOCKET", "nif_recvmsg -> entry with argc: %d\r\n", argc) ); @@ -6394,13 +6582,13 @@ ERL_NIF_TERM nif_recvmsg(ErlNifEnv* env, */ #if !defined(__WIN32__) static -ERL_NIF_TERM nrecvmsg(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM recvRef, - Uint16 bufLen, - Uint16 ctrlLen, - int flags) +ERL_NIF_TERM nrecvmsg(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef, + Uint16 bufLen, + Uint16 ctrlLen, + int flags) { unsigned int addrLen; ssize_t read; @@ -6412,7 +6600,7 @@ ERL_NIF_TERM nrecvmsg(ErlNifEnv* env, ErlNifBinary data[1]; // Shall we always use 1? ErlNifBinary ctrl; ERL_NIF_TERM readerCheck; - SocketAddress addr; + ESockAddress addr; SSDBG( descP, ("SOCKET", "nrecvmsg -> entry with" "\r\n bufSz: %d (%d)" @@ -6502,7 +6690,7 @@ ERL_NIF_TERM nif_close(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; + ESockDescriptor* descP; if ((argc != 1) || !enif_get_resource(env, argv[0], sockets, (void**) &descP)) { @@ -6519,15 +6707,11 @@ ERL_NIF_TERM nif_close(ErlNifEnv* env, #if !defined(__WIN32__) static -ERL_NIF_TERM nclose(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM nclose(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM reply, reason; BOOLEAN_T doClose; - int selectRes; - int domain = descP->domain; - int type = descP->type; - int protocol = descP->protocol; SSDBG( descP, ("SOCKET", "nclose -> [%d] entry (0x%lX, 0x%lX, 0x%lX, 0x%lX)\r\n", @@ -6539,12 +6723,48 @@ ERL_NIF_TERM nclose(ErlNifEnv* env, MLOCK(descP->closeMtx); + doClose = nclose_check(env, descP, &reason); + + if (doClose) { + reply = nclose_do(env, descP); + } else { + reply = esock_make_error(env, reason); + } + + MUNLOCK(descP->closeMtx); + + SSDBG( descP, + ("SOCKET", "nclose -> [%d] done when: " + "\r\n state: 0x%lX" + "\r\n reply: %T" + "\r\n", descP->sock, descP->state, reply) ); + + return reply; +} + + + +/* *** nclose_check *** + * + * Check if we should try to perform the first stage close. + */ +static +BOOLEAN_T nclose_check(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM* reason) +{ + BOOLEAN_T doClose; + if (descP->state == SOCKET_STATE_CLOSED) { - reason = atom_closed; + doClose = FALSE; + *reason = atom_closed; + } else if (descP->state == SOCKET_STATE_CLOSING) { - reason = atom_closing; + doClose = FALSE; + *reason = atom_closing; + } else { /* Store the PID of the caller, @@ -6554,90 +6774,116 @@ ERL_NIF_TERM nclose(ErlNifEnv* env, */ if (enif_self(env, &descP->closerPid) == NULL) { - MUNLOCK(descP->closeMtx); - return esock_make_error(env, atom_exself); - } - /* Monitor the caller, since we should complete this operation even if - * the caller dies (for whatever reason). - * - * <KOLLA> - * - * Can we actiually use this for anything? - * - * </KOLLA> - */ - - if (MONP("nclose -> closer", - env, descP, - &descP->closerPid, - &descP->closerMon) != 0) { - MUNLOCK(descP->closeMtx); - return esock_make_error(env, atom_exmon); - } - - descP->closeLocal = TRUE; - descP->state = SOCKET_STATE_CLOSING; - descP->isReadable = FALSE; - descP->isWritable = FALSE; - doClose = TRUE; - } + doClose = FALSE; + *reason = atom_exself; - if (doClose) { - descP->closeEnv = enif_alloc_env(); - descP->closeRef = MKREF(descP->closeEnv); - selectRes = esock_select_stop(env, descP->sock, descP); - if (selectRes & ERL_NIF_SELECT_STOP_CALLED) { - /* Prep done - inform the caller it can finalize (close) directly */ - SSDBG( descP, - ("SOCKET", "nclose -> [%d] stop was called\r\n", descP->sock) ); - dec_socket(domain, type, protocol); - reply = esock_atom_ok; - } else if (selectRes & ERL_NIF_SELECT_STOP_SCHEDULED) { - /* The stop callback function has been *scheduled* which means that we - * have to wait for it to complete. */ - SSDBG( descP, - ("SOCKET", "nclose -> [%d] stop was scheduled\r\n", - descP->sock) ); - dec_socket(domain, type, protocol); // SHALL WE DO THIS AT finalize? - reply = esock_make_ok2(env, descP->closeRef); } else { - SSDBG( descP, - ("SOCKET", "nclose -> [%d] stop failed: %d\r\n", - descP->sock, selectRes) ); - - /* <KOLLA> + /* Monitor the caller, since we should complete this + * operation even if the caller dies (for whatever reason). + * + * <KOLLA> * - * WE SHOULD REALLY HAVE A WAY TO CLOBBER THE SOCKET, - * SO WE DON'T LET STUFF LEAK. - * NOW, BECAUSE WE FAILED TO SELECT, WE CANNOT FINISH - * THE CLOSE, WHAT TO DO? ABORT? + * Can we actually use this for anything? * * </KOLLA> */ - // No point in having this? - DEMONP("nclose -> closer", env, descP, &descP->closerMon); + if (MONP("nclose_check -> closer", + env, descP, + &descP->closerPid, + &descP->closerMon) != 0) { + + doClose = FALSE; + *reason = atom_exmon; + + } else { - reason = MKT2(env, atom_select, MKI(env, selectRes)); - reply = esock_make_error(env, reason); + descP->closeLocal = TRUE; + descP->state = SOCKET_STATE_CLOSING; + descP->isReadable = FALSE; + descP->isWritable = FALSE; + doClose = TRUE; + *reason = esock_atom_undefined; // NOT used !! + + } } + } + + return doClose; + +} + + + +/* *** nclose_do *** + * + * Perform (do) the first stage close. + */ +static +ERL_NIF_TERM nclose_do(ErlNifEnv* env, + ESockDescriptor* descP) +{ + int domain = descP->domain; + int type = descP->type; + int protocol = descP->protocol; + int sres; + ERL_NIF_TERM reply, reason; + + descP->closeEnv = esock_alloc_env("nclose-do - close-env"); + descP->closeRef = MKREF(descP->closeEnv); + + sres = esock_select_stop(env, descP->sock, descP); + + if (sres & ERL_NIF_SELECT_STOP_CALLED) { + + /* Prep done - inform the caller it can finalize (close) directly */ + SSDBG( descP, + ("SOCKET", "nclose -> [%d] stop was called\r\n", descP->sock) ); + + dec_socket(domain, type, protocol); + reply = esock_atom_ok; + + } else if (sres & ERL_NIF_SELECT_STOP_SCHEDULED) { + + /* The stop callback function has been *scheduled* which means that we + * have to wait for it to complete. */ + SSDBG( descP, + ("SOCKET", "nclose -> [%d] stop was scheduled\r\n", + descP->sock) ); + + dec_socket(domain, type, protocol); // SHALL WE DO THIS AT finalize? + reply = esock_make_ok2(env, enif_make_copy(env, descP->closeRef)); } else { - reply = esock_make_error(env, reason); - } - MUNLOCK(descP->closeMtx); + SSDBG( descP, + ("SOCKET", "nclose -> [%d] stop failed: %d\r\n", + descP->sock, sres) ); - SSDBG( descP, - ("SOCKET", "nclose -> [%d] done when: " - "\r\n state: 0x%lX" - "\r\n reply: %T" - "\r\n", descP->sock, descP->state, reply) ); + /* <KOLLA> + * + * WE SHOULD REALLY HAVE A WAY TO CLOBBER THE SOCKET, + * SO WE DON'T LET STUFF LEAK. + * NOW, BECAUSE WE FAILED TO SELECT, WE CANNOT FINISH + * THE CLOSE, WHAT TO DO? ABORT? + * + * </KOLLA> + */ + + // Do we need this? + DEMONP("nclose_do -> closer", env, descP, &descP->closerMon); + + reason = MKT2(env, esock_atom_select_failed, MKI(env, sres)); + reply = esock_make_error(env, reason); + } return reply; } + + + #endif // if !defined(__WIN32__) @@ -6660,7 +6906,7 @@ ERL_NIF_TERM nif_finalize_close(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; + ESockDescriptor* descP; /* Extract arguments and perform preliminary validation */ @@ -6679,8 +6925,8 @@ ERL_NIF_TERM nif_finalize_close(ErlNifEnv* env, */ #if !defined(__WIN32__) static -ERL_NIF_TERM nfinalize_close(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM nfinalize_close(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM reply; @@ -6744,9 +6990,9 @@ ERL_NIF_TERM nif_shutdown(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - unsigned int ehow; - int how; + ESockDescriptor* descP; + unsigned int ehow; + int how; if ((argc != 2) || !enif_get_resource(env, argv[0], sockets, (void**) &descP) || @@ -6768,9 +7014,9 @@ ERL_NIF_TERM nif_shutdown(ErlNifEnv* env, #if !defined(__WIN32__) static -ERL_NIF_TERM nshutdown(ErlNifEnv* env, - SocketDescriptor* descP, - int how) +ERL_NIF_TERM nshutdown(ErlNifEnv* env, + ESockDescriptor* descP, + int how) { ERL_NIF_TERM reply; @@ -6825,13 +7071,13 @@ ERL_NIF_TERM nif_setopt(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP = NULL; - int eLevel, level = -1; - int eOpt; - ERL_NIF_TERM eIsEncoded; - ERL_NIF_TERM eVal; - BOOLEAN_T isEncoded, isOTP; - ERL_NIF_TERM result; + ESockDescriptor* descP = NULL; + int eLevel, level = -1; + int eOpt; + ERL_NIF_TERM eIsEncoded; + ERL_NIF_TERM eVal; + BOOLEAN_T isEncoded, isOTP; + ERL_NIF_TERM result; SGDBG( ("SOCKET", "nif_setopt -> entry with argc: %d\r\n", argc) ); @@ -6873,27 +7119,32 @@ ERL_NIF_TERM nif_setopt(ErlNifEnv* env, level, eLevel, eOpt, eVal) ); + MLOCK(descP->cfgMtx); + result = nsetopt(env, descP, isEncoded, isOTP, level, eOpt, eVal); + MUNLOCK(descP->cfgMtx); + SSDBG( descP, ("SOCKET", "nif_setopt -> done when" "\r\n result: %T" "\r\n", result) ); return result; + #endif // if defined(__WIN32__) } #if !defined(__WIN32__) static -ERL_NIF_TERM nsetopt(ErlNifEnv* env, - SocketDescriptor* descP, - BOOLEAN_T isEncoded, - BOOLEAN_T isOTP, - int level, - int eOpt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt(ErlNifEnv* env, + ESockDescriptor* descP, + BOOLEAN_T isEncoded, + BOOLEAN_T isOTP, + int level, + int eOpt, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; @@ -6916,10 +7167,10 @@ ERL_NIF_TERM nsetopt(ErlNifEnv* env, /* nsetopt_otp - Handle OTP (level) options */ static -ERL_NIF_TERM nsetopt_otp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_otp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; @@ -6966,9 +7217,9 @@ ERL_NIF_TERM nsetopt_otp(ErlNifEnv* env, /* nsetopt_otp_debug - Handle the OTP (level) debug options */ static -ERL_NIF_TERM nsetopt_otp_debug(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_otp_debug(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { descP->dbg = esock_decode_bool(eVal); @@ -6979,9 +7230,9 @@ ERL_NIF_TERM nsetopt_otp_debug(ErlNifEnv* env, /* nsetopt_otp_iow - Handle the OTP (level) iow options */ static -ERL_NIF_TERM nsetopt_otp_iow(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_otp_iow(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { descP->iow = esock_decode_bool(eVal); @@ -6993,12 +7244,11 @@ ERL_NIF_TERM nsetopt_otp_iow(ErlNifEnv* env, /* nsetopt_otp_ctrl_proc - Handle the OTP (level) controlling_process options */ static -ERL_NIF_TERM nsetopt_otp_ctrl_proc(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_otp_ctrl_proc(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { ErlNifPid caller, newCtrlPid; - // ErlNifMonitor newCtrlMon; ESockMonitor newCtrlMon; int xres; @@ -7053,9 +7303,9 @@ ERL_NIF_TERM nsetopt_otp_ctrl_proc(ErlNifEnv* env, * Where N is the max number of reads. */ static -ERL_NIF_TERM nsetopt_otp_rcvbuf(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_otp_rcvbuf(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { const ERL_NIF_TERM* t; // The array of the elements of the tuple int tsz; // The size of the tuple - should be 2 @@ -7108,9 +7358,9 @@ ERL_NIF_TERM nsetopt_otp_rcvbuf(ErlNifEnv* env, /* nsetopt_otp_rcvctrlbuf - Handle the OTP (level) rcvctrlbuf option */ static -ERL_NIF_TERM nsetopt_otp_rcvctrlbuf(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_otp_rcvctrlbuf(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { size_t val; char* xres; @@ -7131,9 +7381,9 @@ ERL_NIF_TERM nsetopt_otp_rcvctrlbuf(ErlNifEnv* env, /* nsetopt_otp_sndctrlbuf - Handle the OTP (level) sndctrlbuf option */ static -ERL_NIF_TERM nsetopt_otp_sndctrlbuf(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_otp_sndctrlbuf(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { size_t val; char* xres; @@ -7155,11 +7405,11 @@ ERL_NIF_TERM nsetopt_otp_sndctrlbuf(ErlNifEnv* env, * in "native mode" (option is provided as is and value as a binary). */ static -ERL_NIF_TERM nsetopt_native(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_native(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + ERL_NIF_TERM eVal) { ErlNifBinary val; ERL_NIF_TERM result; @@ -7195,11 +7445,11 @@ ERL_NIF_TERM nsetopt_native(ErlNifEnv* env, /* nsetopt_level - A "proper" level (option) has been specified */ static -ERL_NIF_TERM nsetopt_level(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int eOpt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_level(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int eOpt, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; @@ -7265,10 +7515,10 @@ ERL_NIF_TERM nsetopt_level(ErlNifEnv* env, /* nsetopt_lvl_socket - Level *SOCKET* option */ static -ERL_NIF_TERM nsetopt_lvl_socket(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_socket(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; @@ -7404,9 +7654,9 @@ ERL_NIF_TERM nsetopt_lvl_socket(ErlNifEnv* env, #if defined(SO_BINDTODEVICE) static -ERL_NIF_TERM nsetopt_lvl_sock_bindtodevice(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_bindtodevice(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_str_opt(env, descP, SOL_SOCKET, SO_BROADCAST, @@ -7417,9 +7667,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_bindtodevice(ErlNifEnv* env, #if defined(SO_BROADCAST) static -ERL_NIF_TERM nsetopt_lvl_sock_broadcast(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_broadcast(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_BROADCAST, eVal); } @@ -7428,9 +7678,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_broadcast(ErlNifEnv* env, #if defined(SO_DEBUG) static -ERL_NIF_TERM nsetopt_lvl_sock_debug(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_debug(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_DEBUG, eVal); } @@ -7439,9 +7689,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_debug(ErlNifEnv* env, #if defined(SO_DONTROUTE) static -ERL_NIF_TERM nsetopt_lvl_sock_dontroute(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_dontroute(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_DONTROUTE, eVal); } @@ -7450,9 +7700,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_dontroute(ErlNifEnv* env, #if defined(SO_KEEPALIVE) static -ERL_NIF_TERM nsetopt_lvl_sock_keepalive(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_keepalive(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_KEEPALIVE, eVal); } @@ -7461,9 +7711,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_keepalive(ErlNifEnv* env, #if defined(SO_LINGER) static -ERL_NIF_TERM nsetopt_lvl_sock_linger(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_linger(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; struct linger val; @@ -7487,9 +7737,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_linger(ErlNifEnv* env, #if defined(SO_OOBINLINE) static -ERL_NIF_TERM nsetopt_lvl_sock_oobinline(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_oobinline(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_OOBINLINE, eVal); } @@ -7498,9 +7748,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_oobinline(ErlNifEnv* env, #if defined(SO_PEEK_OFF) static -ERL_NIF_TERM nsetopt_lvl_sock_peek_off(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_peek_off(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_PEEK_OFF, eVal); } @@ -7509,9 +7759,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_peek_off(ErlNifEnv* env, #if defined(SO_PRIORITY) static -ERL_NIF_TERM nsetopt_lvl_sock_priority(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_priority(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_PRIORITY, eVal); } @@ -7520,9 +7770,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_priority(ErlNifEnv* env, #if defined(SO_RCVBUF) static -ERL_NIF_TERM nsetopt_lvl_sock_rcvbuf(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_rcvbuf(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_RCVBUF, eVal); } @@ -7531,9 +7781,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_rcvbuf(ErlNifEnv* env, #if defined(SO_RCVLOWAT) static -ERL_NIF_TERM nsetopt_lvl_sock_rcvlowat(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_rcvlowat(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_RCVLOWAT, eVal); } @@ -7542,9 +7792,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_rcvlowat(ErlNifEnv* env, #if defined(SO_RCVTIMEO) static -ERL_NIF_TERM nsetopt_lvl_sock_rcvtimeo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_rcvtimeo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_timeval_opt(env, descP, SOL_SOCKET, SO_RCVTIMEO, eVal); } @@ -7553,9 +7803,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_rcvtimeo(ErlNifEnv* env, #if defined(SO_REUSEADDR) static -ERL_NIF_TERM nsetopt_lvl_sock_reuseaddr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_reuseaddr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_REUSEADDR, eVal); } @@ -7564,9 +7814,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_reuseaddr(ErlNifEnv* env, #if defined(SO_REUSEPORT) static -ERL_NIF_TERM nsetopt_lvl_sock_reuseport(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_reuseport(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_REUSEPORT, eVal); } @@ -7575,9 +7825,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_reuseport(ErlNifEnv* env, #if defined(SO_SNDBUF) static -ERL_NIF_TERM nsetopt_lvl_sock_sndbuf(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_sndbuf(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_SNDBUF, eVal); } @@ -7586,9 +7836,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_sndbuf(ErlNifEnv* env, #if defined(SO_SNDLOWAT) static -ERL_NIF_TERM nsetopt_lvl_sock_sndlowat(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_sndlowat(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_SNDLOWAT, eVal); } @@ -7597,9 +7847,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_sndlowat(ErlNifEnv* env, #if defined(SO_SNDTIMEO) static -ERL_NIF_TERM nsetopt_lvl_sock_sndtimeo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_sndtimeo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { SSDBG( descP, ("SOCKET", "nsetopt_lvl_sock_sndtimeo -> entry with" @@ -7613,9 +7863,9 @@ ERL_NIF_TERM nsetopt_lvl_sock_sndtimeo(ErlNifEnv* env, #if defined(SO_TIMESTAMP) static -ERL_NIF_TERM nsetopt_lvl_sock_timestamp(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sock_timestamp(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_TIMESTAMP, eVal); } @@ -7626,10 +7876,10 @@ ERL_NIF_TERM nsetopt_lvl_sock_timestamp(ErlNifEnv* env, /* nsetopt_lvl_ip - Level *IP* option(s) */ static -ERL_NIF_TERM nsetopt_lvl_ip(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; @@ -7843,9 +8093,9 @@ ERL_NIF_TERM nsetopt_lvl_ip(ErlNifEnv* env, */ #if defined(IP_ADD_MEMBERSHIP) static -ERL_NIF_TERM nsetopt_lvl_ip_add_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_add_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_lvl_ip_update_membership(env, descP, eVal, IP_ADD_MEMBERSHIP); } @@ -7863,9 +8113,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_add_membership(ErlNifEnv* env, */ #if defined(IP_ADD_SOURCE_MEMBERSHIP) static -ERL_NIF_TERM nsetopt_lvl_ip_add_source_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_add_source_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_lvl_ip_update_source(env, descP, eVal, IP_ADD_SOURCE_MEMBERSHIP); @@ -7884,9 +8134,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_add_source_membership(ErlNifEnv* env, */ #if defined(IP_BLOCK_SOURCE) static -ERL_NIF_TERM nsetopt_lvl_ip_block_source(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_block_source(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_lvl_ip_update_source(env, descP, eVal, IP_BLOCK_SOURCE); } @@ -7906,9 +8156,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_block_source(ErlNifEnv* env, */ #if defined(IP_DROP_MEMBERSHIP) static -ERL_NIF_TERM nsetopt_lvl_ip_drop_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_drop_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_lvl_ip_update_membership(env, descP, eVal, IP_DROP_MEMBERSHIP); @@ -7928,9 +8178,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_drop_membership(ErlNifEnv* env, */ #if defined(IP_DROP_SOURCE_MEMBERSHIP) static -ERL_NIF_TERM nsetopt_lvl_ip_drop_source_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_drop_source_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_lvl_ip_update_source(env, descP, eVal, IP_DROP_SOURCE_MEMBERSHIP); @@ -7943,9 +8193,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_drop_source_membership(ErlNifEnv* env, */ #if defined(IP_FREEBIND) static -ERL_NIF_TERM nsetopt_lvl_ip_freebind(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_freebind(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -7963,9 +8213,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_freebind(ErlNifEnv* env, */ #if defined(IP_HDRINCL) static -ERL_NIF_TERM nsetopt_lvl_ip_hdrincl(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_hdrincl(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -7983,9 +8233,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_hdrincl(ErlNifEnv* env, */ #if defined(IP_MINTTL) static -ERL_NIF_TERM nsetopt_lvl_ip_minttl(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_minttl(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8005,9 +8255,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_minttl(ErlNifEnv* env, */ #if defined(IP_MSFILTER) && defined(IP_MSFILTER_SIZE) static -ERL_NIF_TERM nsetopt_lvl_ip_msfilter(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_msfilter(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; @@ -8058,7 +8308,7 @@ ERL_NIF_TERM nsetopt_lvl_ip_msfilter(ErlNifEnv* env, return esock_make_error(env, esock_atom_einval); } - if (!decode_ip_msfilter_mode(env, eFMode, &msfP->imsf_fmode)) { + if (!decode_ip_msfilter_mode(env, eFMode, (Uint32*) &msfP->imsf_fmode)) { FREE(msfP); return esock_make_error(env, esock_atom_einval); } @@ -8138,9 +8388,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_msfilter_set(ErlNifEnv* env, */ #if defined(IP_MTU_DISCOVER) static -ERL_NIF_TERM nsetopt_lvl_ip_mtu_discover(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_mtu_discover(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; int val; @@ -8177,9 +8427,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_mtu_discover(ErlNifEnv* env, */ #if defined(IP_MULTICAST_ALL) static -ERL_NIF_TERM nsetopt_lvl_ip_multicast_all(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_multicast_all(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8198,9 +8448,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_multicast_all(ErlNifEnv* env, */ #if defined(IP_MULTICAST_IF) static -ERL_NIF_TERM nsetopt_lvl_ip_multicast_if(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_multicast_if(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; struct in_addr ifAddr; @@ -8235,9 +8485,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_multicast_if(ErlNifEnv* env, */ #if defined(IP_MULTICAST_LOOP) static -ERL_NIF_TERM nsetopt_lvl_ip_multicast_loop(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_multicast_loop(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8254,9 +8504,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_multicast_loop(ErlNifEnv* env, */ #if defined(IP_MULTICAST_TTL) static -ERL_NIF_TERM nsetopt_lvl_ip_multicast_ttl(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_multicast_ttl(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8273,9 +8523,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_multicast_ttl(ErlNifEnv* env, */ #if defined(IP_NODEFRAG) static -ERL_NIF_TERM nsetopt_lvl_ip_nodefrag(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_nodefrag(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8292,9 +8542,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_nodefrag(ErlNifEnv* env, */ #if defined(IP_PKTINFO) static -ERL_NIF_TERM nsetopt_lvl_ip_pktinfo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_pktinfo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8311,9 +8561,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_pktinfo(ErlNifEnv* env, */ #if defined(IP_RECVDSTADDR) static -ERL_NIF_TERM nsetopt_lvl_ip_recvdstaddr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_recvdstaddr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8330,9 +8580,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_recvdstaddr(ErlNifEnv* env, */ #if defined(IP_RECVERR) static -ERL_NIF_TERM nsetopt_lvl_ip_recverr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_recverr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8349,9 +8599,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_recverr(ErlNifEnv* env, */ #if defined(IP_RECVIF) static -ERL_NIF_TERM nsetopt_lvl_ip_recvif(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_recvif(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8368,9 +8618,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_recvif(ErlNifEnv* env, */ #if defined(IP_RECVOPTS) static -ERL_NIF_TERM nsetopt_lvl_ip_recvopts(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_recvopts(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8387,9 +8637,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_recvopts(ErlNifEnv* env, */ #if defined(IP_RECVORIGDSTADDR) static -ERL_NIF_TERM nsetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8406,9 +8656,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env, */ #if defined(IP_RECVTOS) static -ERL_NIF_TERM nsetopt_lvl_ip_recvtos(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_recvtos(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8425,9 +8675,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_recvtos(ErlNifEnv* env, */ #if defined(IP_RECVTTL) static -ERL_NIF_TERM nsetopt_lvl_ip_recvttl(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_recvttl(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8444,9 +8694,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_recvttl(ErlNifEnv* env, */ #if defined(IP_RETOPTS) static -ERL_NIF_TERM nsetopt_lvl_ip_retopts(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_retopts(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8463,9 +8713,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_retopts(ErlNifEnv* env, */ #if defined(IP_ROUTER_ALERT) static -ERL_NIF_TERM nsetopt_lvl_ip_router_alert(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_router_alert(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8482,9 +8732,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_router_alert(ErlNifEnv* env, */ #if defined(IP_SENDSRCADDR) static -ERL_NIF_TERM nsetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8501,9 +8751,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env, */ #if defined(IP_TOS) static -ERL_NIF_TERM nsetopt_lvl_ip_tos(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_tos(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8534,9 +8784,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_tos(ErlNifEnv* env, */ #if defined(IP_TRANSPARENT) static -ERL_NIF_TERM nsetopt_lvl_ip_transparent(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_transparent(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8554,9 +8804,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_transparent(ErlNifEnv* env, */ #if defined(IP_TTL) static -ERL_NIF_TERM nsetopt_lvl_ip_ttl(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_ttl(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IP) int level = SOL_IP; @@ -8581,9 +8831,9 @@ ERL_NIF_TERM nsetopt_lvl_ip_ttl(ErlNifEnv* env, */ #if defined(IP_UNBLOCK_SOURCE) static -ERL_NIF_TERM nsetopt_lvl_ip_unblock_source(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ip_unblock_source(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_lvl_ip_update_source(env, descP, eVal, IP_UNBLOCK_SOURCE); } @@ -8593,10 +8843,10 @@ ERL_NIF_TERM nsetopt_lvl_ip_unblock_source(ErlNifEnv* env, #if defined(IP_ADD_MEMBERSHIP) || defined(IP_DROP_MEMBERSHIP) static -ERL_NIF_TERM nsetopt_lvl_ip_update_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal, - int opt) +ERL_NIF_TERM nsetopt_lvl_ip_update_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal, + int opt) { ERL_NIF_TERM result, eMultiAddr, eInterface; struct ip_mreq mreq; @@ -8647,10 +8897,10 @@ ERL_NIF_TERM nsetopt_lvl_ip_update_membership(ErlNifEnv* env, #if defined(IP_ADD_SOURCE_MEMBERSHIP) || defined(IP_DROP_SOURCE_MEMBERSHIP) || defined(IP_BLOCK_SOURCE) || defined(IP_UNBLOCK_SOURCE) static -ERL_NIF_TERM nsetopt_lvl_ip_update_source(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal, - int opt) +ERL_NIF_TERM nsetopt_lvl_ip_update_source(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal, + int opt) { ERL_NIF_TERM result, eMultiAddr, eInterface, eSourceAddr; struct ip_mreq_source mreq; @@ -8714,10 +8964,10 @@ ERL_NIF_TERM nsetopt_lvl_ip_update_source(ErlNifEnv* env, */ #if defined(HAVE_IPV6) static -ERL_NIF_TERM nsetopt_lvl_ipv6(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; @@ -8859,9 +9109,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6(ErlNifEnv* env, #if defined(IPV6_ADDRFORM) static -ERL_NIF_TERM nsetopt_lvl_ipv6_addrform(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_addrform(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; int res, edomain, domain; @@ -8901,9 +9151,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_addrform(ErlNifEnv* env, #if defined(IPV6_ADD_MEMBERSHIP) static -ERL_NIF_TERM nsetopt_lvl_ipv6_add_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_add_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_lvl_ipv6_update_membership(env, descP, eVal, IPV6_ADD_MEMBERSHIP); @@ -8913,9 +9163,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_add_membership(ErlNifEnv* env, #if defined(IPV6_AUTHHDR) static -ERL_NIF_TERM nsetopt_lvl_ipv6_authhdr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_authhdr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_bool_opt(env, descP, SOL_IPV6, IPV6_AUTHHDR, eVal); } @@ -8924,9 +9174,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_authhdr(ErlNifEnv* env, #if defined(IPV6_DROP_MEMBERSHIP) static -ERL_NIF_TERM nsetopt_lvl_ipv6_drop_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_drop_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_lvl_ipv6_update_membership(env, descP, eVal, IPV6_DROP_MEMBERSHIP); @@ -8936,9 +9186,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_drop_membership(ErlNifEnv* env, #if defined(IPV6_DSTOPTS) static -ERL_NIF_TERM nsetopt_lvl_ipv6_dstopts(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_dstopts(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -8953,9 +9203,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_dstopts(ErlNifEnv* env, #if defined(IPV6_FLOWINFO) static -ERL_NIF_TERM nsetopt_lvl_ipv6_flowinfo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_flowinfo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -8970,9 +9220,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_flowinfo(ErlNifEnv* env, #if defined(IPV6_HOPLIMIT) static -ERL_NIF_TERM nsetopt_lvl_ipv6_hoplimit(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_hoplimit(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -8987,9 +9237,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_hoplimit(ErlNifEnv* env, #if defined(IPV6_HOPOPTS) static -ERL_NIF_TERM nsetopt_lvl_ipv6_hopopts(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_hopopts(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -9004,9 +9254,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_hopopts(ErlNifEnv* env, #if defined(IPV6_MTU) static -ERL_NIF_TERM nsetopt_lvl_ipv6_mtu(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_mtu(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -9025,9 +9275,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_mtu(ErlNifEnv* env, */ #if defined(IPV6_MTU_DISCOVER) static -ERL_NIF_TERM nsetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; int val; @@ -9063,9 +9313,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env, #if defined(IPV6_MULTICAST_HOPS) static -ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -9081,9 +9331,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env, #if defined(IPV6_MULTICAST_IF) static -ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_if(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_if(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -9099,9 +9349,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_if(ErlNifEnv* env, #if defined(IPV6_MULTICAST_LOOP) static -ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -9116,9 +9366,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env, #if defined(IPV6_RECVERR) static -ERL_NIF_TERM nsetopt_lvl_ipv6_recverr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_recverr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -9133,9 +9383,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_recverr(ErlNifEnv* env, #if defined(IPV6_RECVPKTINFO) || defined(IPV6_PKTINFO) static -ERL_NIF_TERM nsetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -9155,9 +9405,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env, #if defined(IPV6_ROUTER_ALERT) static -ERL_NIF_TERM nsetopt_lvl_ipv6_router_alert(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_router_alert(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -9173,9 +9423,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_router_alert(ErlNifEnv* env, #if defined(IPV6_RTHDR) static -ERL_NIF_TERM nsetopt_lvl_ipv6_rthdr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_rthdr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -9190,9 +9440,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_rthdr(ErlNifEnv* env, #if defined(IPV6_UNICAST_HOPS) static -ERL_NIF_TERM nsetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -9208,9 +9458,9 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env, #if defined(IPV6_V6ONLY) static -ERL_NIF_TERM nsetopt_lvl_ipv6_v6only(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_ipv6_v6only(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -9225,10 +9475,10 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_v6only(ErlNifEnv* env, #if defined(IPV6_ADD_MEMBERSHIP) || defined(IPV6_DROP_MEMBERSHIP) static -ERL_NIF_TERM nsetopt_lvl_ipv6_update_membership(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal, - int opt) +ERL_NIF_TERM nsetopt_lvl_ipv6_update_membership(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal, + int opt) { ERL_NIF_TERM result, eMultiAddr, eInterface; struct ipv6_mreq mreq; @@ -9283,10 +9533,10 @@ ERL_NIF_TERM nsetopt_lvl_ipv6_update_membership(ErlNifEnv* env, /* nsetopt_lvl_tcp - Level *TCP* option(s) */ static -ERL_NIF_TERM nsetopt_lvl_tcp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_tcp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; @@ -9327,9 +9577,9 @@ ERL_NIF_TERM nsetopt_lvl_tcp(ErlNifEnv* env, */ #if defined(TCP_CONGESTION) static -ERL_NIF_TERM nsetopt_lvl_tcp_congestion(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_tcp_congestion(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { int max = SOCKET_OPT_TCP_CONGESTION_NAME_MAX+1; @@ -9342,9 +9592,9 @@ ERL_NIF_TERM nsetopt_lvl_tcp_congestion(ErlNifEnv* env, */ #if defined(TCP_MAXSEG) static -ERL_NIF_TERM nsetopt_lvl_tcp_maxseg(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_tcp_maxseg(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_int_opt(env, descP, IPPROTO_TCP, TCP_MAXSEG, eVal); } @@ -9355,9 +9605,9 @@ ERL_NIF_TERM nsetopt_lvl_tcp_maxseg(ErlNifEnv* env, */ #if defined(TCP_NODELAY) static -ERL_NIF_TERM nsetopt_lvl_tcp_nodelay(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_tcp_nodelay(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_bool_opt(env, descP, IPPROTO_TCP, TCP_NODELAY, eVal); } @@ -9368,10 +9618,10 @@ ERL_NIF_TERM nsetopt_lvl_tcp_nodelay(ErlNifEnv* env, /* nsetopt_lvl_udp - Level *UDP* option(s) */ static -ERL_NIF_TERM nsetopt_lvl_udp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_udp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; @@ -9400,9 +9650,9 @@ ERL_NIF_TERM nsetopt_lvl_udp(ErlNifEnv* env, */ #if defined(UDP_CORK) static -ERL_NIF_TERM nsetopt_lvl_udp_cork(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_udp_cork(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_bool_opt(env, descP, IPPROTO_UDP, UDP_CORK, eVal); } @@ -9415,10 +9665,10 @@ ERL_NIF_TERM nsetopt_lvl_udp_cork(ErlNifEnv* env, */ #if defined(HAVE_SCTP) static -ERL_NIF_TERM nsetopt_lvl_sctp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sctp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; @@ -9489,9 +9739,9 @@ ERL_NIF_TERM nsetopt_lvl_sctp(ErlNifEnv* env, */ #if defined(SCTP_ASSOCINFO) static -ERL_NIF_TERM nsetopt_lvl_sctp_associnfo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sctp_associnfo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; ERL_NIF_TERM eAssocId, eMaxRxt, eNumPeerDests; @@ -9614,9 +9864,9 @@ ERL_NIF_TERM nsetopt_lvl_sctp_associnfo(ErlNifEnv* env, */ #if defined(SCTP_AUTOCLOSE) static -ERL_NIF_TERM nsetopt_lvl_sctp_autoclose(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sctp_autoclose(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_int_opt(env, descP, IPPROTO_SCTP, SCTP_AUTOCLOSE, eVal); } @@ -9627,9 +9877,9 @@ ERL_NIF_TERM nsetopt_lvl_sctp_autoclose(ErlNifEnv* env, */ #if defined(SCTP_DISABLE_FRAGMENTS) static -ERL_NIF_TERM nsetopt_lvl_sctp_disable_fragments(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sctp_disable_fragments(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_bool_opt(env, descP, IPPROTO_SCTP, SCTP_DISABLE_FRAGMENTS, eVal); } @@ -9640,9 +9890,9 @@ ERL_NIF_TERM nsetopt_lvl_sctp_disable_fragments(ErlNifEnv* env, */ #if defined(SCTP_EVENTS) static -ERL_NIF_TERM nsetopt_lvl_sctp_events(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sctp_events(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; ERL_NIF_TERM eDataIn, eAssoc, eAddr, eSndFailure; @@ -9752,9 +10002,9 @@ ERL_NIF_TERM nsetopt_lvl_sctp_events(ErlNifEnv* env, */ #if defined(SCTP_INITMSG) static -ERL_NIF_TERM nsetopt_lvl_sctp_initmsg(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sctp_initmsg(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; ERL_NIF_TERM eNumOut, eMaxIn, eMaxAttempts, eMaxInitTO; @@ -9836,9 +10086,9 @@ ERL_NIF_TERM nsetopt_lvl_sctp_initmsg(ErlNifEnv* env, */ #if defined(SCTP_MAXSEG) static -ERL_NIF_TERM nsetopt_lvl_sctp_maxseg(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sctp_maxseg(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_int_opt(env, descP, IPPROTO_SCTP, SCTP_MAXSEG, eVal); } @@ -9849,9 +10099,9 @@ ERL_NIF_TERM nsetopt_lvl_sctp_maxseg(ErlNifEnv* env, */ #if defined(SCTP_NODELAY) static -ERL_NIF_TERM nsetopt_lvl_sctp_nodelay(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sctp_nodelay(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { return nsetopt_bool_opt(env, descP, IPPROTO_SCTP, SCTP_NODELAY, eVal); } @@ -9862,9 +10112,9 @@ ERL_NIF_TERM nsetopt_lvl_sctp_nodelay(ErlNifEnv* env, */ #if defined(SCTP_RTOINFO) static -ERL_NIF_TERM nsetopt_lvl_sctp_rtoinfo(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_lvl_sctp_rtoinfo(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; ERL_NIF_TERM eAssocId, eInitial, eMax, eMin; @@ -9925,11 +10175,6 @@ ERL_NIF_TERM nsetopt_lvl_sctp_rtoinfo(ErlNifEnv* env, #else SIZE CHECK FOR ASSOC ID FAILED #endif - /* - if (!GET_INT(env, eAssocId, &tmpAssocId)) - return esock_make_error(env, esock_atom_einval); - rtoInfo.srto_assoc_id = (typeof(rtoInfo.srto_assoc_id)) tmpAssocId; - */ if (!GET_UINT(env, eInitial, &rtoInfo.srto_initial)) return esock_make_error(env, esock_atom_einval); @@ -9971,11 +10216,11 @@ ERL_NIF_TERM nsetopt_lvl_sctp_rtoinfo(ErlNifEnv* env, /* nsetopt_bool_opt - set an option that has an (integer) bool value */ static -ERL_NIF_TERM nsetopt_bool_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_bool_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; BOOLEAN_T val; @@ -9998,11 +10243,11 @@ ERL_NIF_TERM nsetopt_bool_opt(ErlNifEnv* env, /* nsetopt_int_opt - set an option that has an integer value */ static -ERL_NIF_TERM nsetopt_int_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_int_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; int val; @@ -10037,12 +10282,12 @@ ERL_NIF_TERM nsetopt_int_opt(ErlNifEnv* env, */ #if defined(USE_SETOPT_STR_OPT) static -ERL_NIF_TERM nsetopt_str_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - int max, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_str_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + int max, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; char* val = MALLOC(max); @@ -10070,11 +10315,11 @@ ERL_NIF_TERM nsetopt_str_opt(ErlNifEnv* env, /* nsetopt_timeval_opt - set an option that has an (timeval) bool value */ static -ERL_NIF_TERM nsetopt_timeval_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - ERL_NIF_TERM eVal) +ERL_NIF_TERM nsetopt_timeval_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + ERL_NIF_TERM eVal) { ERL_NIF_TERM result; struct timeval timeVal; @@ -10303,10 +10548,11 @@ ERL_NIF_TERM nif_getopt(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - int eLevel, level = -1; - ERL_NIF_TERM eIsEncoded, eOpt; - BOOLEAN_T isEncoded, isOTP; + ESockDescriptor* descP; + int eLevel, level = -1; + ERL_NIF_TERM eIsEncoded, eOpt; + BOOLEAN_T isEncoded, isOTP; + ERL_NIF_TERM result; SGDBG( ("SOCKET", "nif_getopt -> entry with argc: %d\r\n", argc) ); @@ -10335,7 +10581,14 @@ ERL_NIF_TERM nif_getopt(ErlNifEnv* env, if (!elevel2level(isEncoded, eLevel, &isOTP, &level)) return esock_make_error(env, esock_atom_einval); - return ngetopt(env, descP, isEncoded, isOTP, level, eOpt); + MLOCK(descP->cfgMtx); + + result = ngetopt(env, descP, isEncoded, isOTP, level, eOpt); + + MUNLOCK(descP->cfgMtx); + + return result; + #endif // if defined(__WIN32__) } @@ -10343,12 +10596,12 @@ ERL_NIF_TERM nif_getopt(ErlNifEnv* env, #if !defined(__WIN32__) static -ERL_NIF_TERM ngetopt(ErlNifEnv* env, - SocketDescriptor* descP, - BOOLEAN_T isEncoded, - BOOLEAN_T isOTP, - int level, - ERL_NIF_TERM eOpt) +ERL_NIF_TERM ngetopt(ErlNifEnv* env, + ESockDescriptor* descP, + BOOLEAN_T isEncoded, + BOOLEAN_T isOTP, + int level, + ERL_NIF_TERM eOpt) { ERL_NIF_TERM result; int opt; @@ -10391,9 +10644,9 @@ ERL_NIF_TERM ngetopt(ErlNifEnv* env, /* ngetopt_otp - Handle OTP (level) options */ static -ERL_NIF_TERM ngetopt_otp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt) +ERL_NIF_TERM ngetopt_otp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt) { ERL_NIF_TERM result; @@ -10461,8 +10714,8 @@ ERL_NIF_TERM ngetopt_otp(ErlNifEnv* env, /* ngetopt_otp_debug - Handle the OTP (level) debug option */ static -ERL_NIF_TERM ngetopt_otp_debug(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_otp_debug(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM eVal = esock_encode_bool(descP->dbg); @@ -10473,8 +10726,8 @@ ERL_NIF_TERM ngetopt_otp_debug(ErlNifEnv* env, /* ngetopt_otp_iow - Handle the OTP (level) iow option */ static -ERL_NIF_TERM ngetopt_otp_iow(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_otp_iow(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM eVal = esock_encode_bool(descP->iow); @@ -10485,8 +10738,8 @@ ERL_NIF_TERM ngetopt_otp_iow(ErlNifEnv* env, /* ngetopt_otp_ctrl_proc - Handle the OTP (level) controlling_process option */ static -ERL_NIF_TERM ngetopt_otp_ctrl_proc(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_otp_ctrl_proc(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM eVal = MKPID(env, &descP->ctrlPid); @@ -10498,8 +10751,8 @@ ERL_NIF_TERM ngetopt_otp_ctrl_proc(ErlNifEnv* env, /* ngetopt_otp_rcvbuf - Handle the OTP (level) rcvbuf option */ static -ERL_NIF_TERM ngetopt_otp_rcvbuf(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_otp_rcvbuf(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM eVal; @@ -10516,8 +10769,8 @@ ERL_NIF_TERM ngetopt_otp_rcvbuf(ErlNifEnv* env, /* ngetopt_otp_rcvctrlbuf - Handle the OTP (level) rcvctrlbuf option */ static -ERL_NIF_TERM ngetopt_otp_rcvctrlbuf(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_otp_rcvctrlbuf(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM eVal = MKI(env, descP->rCtrlSz); @@ -10528,8 +10781,8 @@ ERL_NIF_TERM ngetopt_otp_rcvctrlbuf(ErlNifEnv* env, /* ngetopt_otp_sndctrlbuf - Handle the OTP (level) sndctrlbuf option */ static -ERL_NIF_TERM ngetopt_otp_sndctrlbuf(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_otp_sndctrlbuf(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM eVal = MKI(env, descP->wCtrlSz); @@ -10540,8 +10793,8 @@ ERL_NIF_TERM ngetopt_otp_sndctrlbuf(ErlNifEnv* env, /* ngetopt_otp_fd - Handle the OTP (level) fd option */ static -ERL_NIF_TERM ngetopt_otp_fd(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_otp_fd(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM eVal = MKI(env, descP->sock); @@ -10552,8 +10805,8 @@ ERL_NIF_TERM ngetopt_otp_fd(ErlNifEnv* env, /* ngetopt_otp_domain - Handle the OTP (level) domain option */ static -ERL_NIF_TERM ngetopt_otp_domain(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_otp_domain(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result, reason; int val = descP->domain; @@ -10588,8 +10841,8 @@ ERL_NIF_TERM ngetopt_otp_domain(ErlNifEnv* env, /* ngetopt_otp_type - Handle the OTP (level) type options. */ static -ERL_NIF_TERM ngetopt_otp_type(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_otp_type(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result, reason; int val = descP->type; @@ -10629,8 +10882,8 @@ ERL_NIF_TERM ngetopt_otp_type(ErlNifEnv* env, /* ngetopt_otp_protocol - Handle the OTP (level) protocol options. */ static -ERL_NIF_TERM ngetopt_otp_protocol(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_otp_protocol(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result, reason; int val = descP->protocol; @@ -10670,10 +10923,10 @@ ERL_NIF_TERM ngetopt_otp_protocol(ErlNifEnv* env, * format: {NativeOpt :: integer(), ValueSize :: non_neg_integer()} */ static -ERL_NIF_TERM ngetopt_native(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - ERL_NIF_TERM eOpt) +ERL_NIF_TERM ngetopt_native(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + ERL_NIF_TERM eOpt) { ERL_NIF_TERM result = enif_make_badarg(env); int opt; @@ -10728,11 +10981,11 @@ ERL_NIF_TERM ngetopt_native(ErlNifEnv* env, static -ERL_NIF_TERM ngetopt_native_unspec(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - SOCKOPTLEN_T valueSz) +ERL_NIF_TERM ngetopt_native_unspec(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + SOCKOPTLEN_T valueSz) { ERL_NIF_TERM result = esock_make_error(env, esock_atom_einval); int res; @@ -10798,10 +11051,10 @@ ERL_NIF_TERM ngetopt_native_unspec(ErlNifEnv* env, /* ngetopt_level - A "proper" level (option) has been specified */ static -ERL_NIF_TERM ngetopt_level(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int eOpt) +ERL_NIF_TERM ngetopt_level(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int eOpt) { ERL_NIF_TERM result; @@ -10865,9 +11118,9 @@ ERL_NIF_TERM ngetopt_level(ErlNifEnv* env, /* ngetopt_lvl_socket - Level *SOCKET* option */ static -ERL_NIF_TERM ngetopt_lvl_socket(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt) +ERL_NIF_TERM ngetopt_lvl_socket(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt) { ERL_NIF_TERM result; @@ -11025,8 +11278,8 @@ ERL_NIF_TERM ngetopt_lvl_socket(ErlNifEnv* env, #if defined(SO_ACCEPTCONN) static -ERL_NIF_TERM ngetopt_lvl_sock_acceptconn(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_acceptconn(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_ACCEPTCONN); } @@ -11035,8 +11288,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_acceptconn(ErlNifEnv* env, #if defined(SO_BINDTODEVICE) static -ERL_NIF_TERM ngetopt_lvl_sock_bindtodevice(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_bindtodevice(ErlNifEnv* env, + ESockDescriptor* descP) { SSDBG( descP, ("SOCKET", "ngetopt_lvl_sock_bindtodevice -> entry with\r\n") ); @@ -11048,8 +11301,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_bindtodevice(ErlNifEnv* env, #if defined(SO_BROADCAST) static -ERL_NIF_TERM ngetopt_lvl_sock_broadcast(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_broadcast(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_BROADCAST); } @@ -11058,8 +11311,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_broadcast(ErlNifEnv* env, #if defined(SO_DEBUG) static -ERL_NIF_TERM ngetopt_lvl_sock_debug(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_debug(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_DEBUG); } @@ -11068,8 +11321,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_debug(ErlNifEnv* env, #if defined(SO_DOMAIN) static -ERL_NIF_TERM ngetopt_lvl_sock_domain(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_domain(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result, reason; int val; @@ -11113,8 +11366,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_domain(ErlNifEnv* env, #if defined(SO_DONTROUTE) static -ERL_NIF_TERM ngetopt_lvl_sock_dontroute(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_dontroute(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_DONTROUTE); } @@ -11123,8 +11376,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_dontroute(ErlNifEnv* env, #if defined(SO_KEEPALIVE) static -ERL_NIF_TERM ngetopt_lvl_sock_keepalive(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_keepalive(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_KEEPALIVE); } @@ -11133,8 +11386,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_keepalive(ErlNifEnv* env, #if defined(SO_LINGER) static -ERL_NIF_TERM ngetopt_lvl_sock_linger(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_linger(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result; struct linger val; @@ -11163,8 +11416,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_linger(ErlNifEnv* env, #if defined(SO_OOBINLINE) static -ERL_NIF_TERM ngetopt_lvl_sock_oobinline(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_oobinline(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_OOBINLINE); } @@ -11173,8 +11426,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_oobinline(ErlNifEnv* env, #if defined(SO_PEEK_OFF) static -ERL_NIF_TERM ngetopt_lvl_sock_peek_off(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_peek_off(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_PEEK_OFF); } @@ -11183,8 +11436,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_peek_off(ErlNifEnv* env, #if defined(SO_PRIORITY) static -ERL_NIF_TERM ngetopt_lvl_sock_priority(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_priority(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_PRIORITY); } @@ -11193,8 +11446,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_priority(ErlNifEnv* env, #if defined(SO_PROTOCOL) static -ERL_NIF_TERM ngetopt_lvl_sock_protocol(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_protocol(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result, reason; int val; @@ -11240,8 +11493,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_protocol(ErlNifEnv* env, #if defined(SO_RCVBUF) static -ERL_NIF_TERM ngetopt_lvl_sock_rcvbuf(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_rcvbuf(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_RCVBUF); } @@ -11250,8 +11503,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_rcvbuf(ErlNifEnv* env, #if defined(SO_RCVLOWAT) static -ERL_NIF_TERM ngetopt_lvl_sock_rcvlowat(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_rcvlowat(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_RCVLOWAT); } @@ -11260,8 +11513,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_rcvlowat(ErlNifEnv* env, #if defined(SO_RCVTIMEO) static -ERL_NIF_TERM ngetopt_lvl_sock_rcvtimeo(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_rcvtimeo(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_timeval_opt(env, descP, SOL_SOCKET, SO_RCVTIMEO); } @@ -11270,8 +11523,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_rcvtimeo(ErlNifEnv* env, #if defined(SO_REUSEADDR) static -ERL_NIF_TERM ngetopt_lvl_sock_reuseaddr(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_reuseaddr(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_REUSEADDR); } @@ -11280,8 +11533,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_reuseaddr(ErlNifEnv* env, #if defined(SO_REUSEPORT) static -ERL_NIF_TERM ngetopt_lvl_sock_reuseport(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_reuseport(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_REUSEPORT); } @@ -11290,8 +11543,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_reuseport(ErlNifEnv* env, #if defined(SO_SNDBUF) static -ERL_NIF_TERM ngetopt_lvl_sock_sndbuf(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_sndbuf(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_SNDBUF); } @@ -11300,8 +11553,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_sndbuf(ErlNifEnv* env, #if defined(SO_SNDLOWAT) static -ERL_NIF_TERM ngetopt_lvl_sock_sndlowat(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_sndlowat(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_SNDLOWAT); } @@ -11310,8 +11563,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_sndlowat(ErlNifEnv* env, #if defined(SO_SNDTIMEO) static -ERL_NIF_TERM ngetopt_lvl_sock_sndtimeo(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_sndtimeo(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_timeval_opt(env, descP, SOL_SOCKET, SO_SNDTIMEO); } @@ -11320,8 +11573,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_sndtimeo(ErlNifEnv* env, #if defined(SO_TIMESTAMP) static -ERL_NIF_TERM ngetopt_lvl_sock_timestamp(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_timestamp(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_TIMESTAMP); } @@ -11330,8 +11583,8 @@ ERL_NIF_TERM ngetopt_lvl_sock_timestamp(ErlNifEnv* env, #if defined(SO_TYPE) static -ERL_NIF_TERM ngetopt_lvl_sock_type(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sock_type(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result, reason; int val; @@ -11376,9 +11629,9 @@ ERL_NIF_TERM ngetopt_lvl_sock_type(ErlNifEnv* env, /* ngetopt_lvl_ip - Level *IP* option(s) */ static -ERL_NIF_TERM ngetopt_lvl_ip(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt) +ERL_NIF_TERM ngetopt_lvl_ip(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt) { ERL_NIF_TERM result; @@ -11552,8 +11805,8 @@ ERL_NIF_TERM ngetopt_lvl_ip(ErlNifEnv* env, */ #if defined(IP_MINTTL) static -ERL_NIF_TERM ngetopt_lvl_ip_minttl(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_minttl(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11570,8 +11823,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_minttl(ErlNifEnv* env, */ #if defined(IP_FREEBIND) static -ERL_NIF_TERM ngetopt_lvl_ip_freebind(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_freebind(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11588,8 +11841,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_freebind(ErlNifEnv* env, */ #if defined(IP_HDRINCL) static -ERL_NIF_TERM ngetopt_lvl_ip_hdrincl(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_hdrincl(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11606,8 +11859,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_hdrincl(ErlNifEnv* env, */ #if defined(IP_MTU) static -ERL_NIF_TERM ngetopt_lvl_ip_mtu(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_mtu(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11624,8 +11877,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_mtu(ErlNifEnv* env, */ #if defined(IP_MTU_DISCOVER) static -ERL_NIF_TERM ngetopt_lvl_ip_mtu_discover(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_mtu_discover(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result; ERL_NIF_TERM eMtuDisc; @@ -11658,8 +11911,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_mtu_discover(ErlNifEnv* env, */ #if defined(IP_MULTICAST_ALL) static -ERL_NIF_TERM ngetopt_lvl_ip_multicast_all(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_multicast_all(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11676,8 +11929,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_multicast_all(ErlNifEnv* env, */ #if defined(IP_MULTICAST_IF) static -ERL_NIF_TERM ngetopt_lvl_ip_multicast_if(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_multicast_if(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result; ERL_NIF_TERM eAddr; @@ -11713,8 +11966,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_multicast_if(ErlNifEnv* env, */ #if defined(IP_MULTICAST_LOOP) static -ERL_NIF_TERM ngetopt_lvl_ip_multicast_loop(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_multicast_loop(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11731,8 +11984,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_multicast_loop(ErlNifEnv* env, */ #if defined(IP_MULTICAST_TTL) static -ERL_NIF_TERM ngetopt_lvl_ip_multicast_ttl(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_multicast_ttl(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11749,8 +12002,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_multicast_ttl(ErlNifEnv* env, */ #if defined(IP_NODEFRAG) static -ERL_NIF_TERM ngetopt_lvl_ip_nodefrag(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_nodefrag(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11767,8 +12020,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_nodefrag(ErlNifEnv* env, */ #if defined(IP_PKTINFO) static -ERL_NIF_TERM ngetopt_lvl_ip_pktinfo(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_pktinfo(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11785,8 +12038,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_pktinfo(ErlNifEnv* env, */ #if defined(IP_RECVTOS) static -ERL_NIF_TERM ngetopt_lvl_ip_recvtos(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_recvtos(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11803,8 +12056,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_recvtos(ErlNifEnv* env, */ #if defined(IP_RECVDSTADDR) static -ERL_NIF_TERM ngetopt_lvl_ip_recvdstaddr(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_recvdstaddr(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11821,8 +12074,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_recvdstaddr(ErlNifEnv* env, */ #if defined(IP_RECVERR) static -ERL_NIF_TERM ngetopt_lvl_ip_recverr(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_recverr(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11839,8 +12092,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_recverr(ErlNifEnv* env, */ #if defined(IP_RECVIF) static -ERL_NIF_TERM ngetopt_lvl_ip_recvif(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_recvif(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11857,8 +12110,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_recvif(ErlNifEnv* env, */ #if defined(IP_RECVOPTS) static -ERL_NIF_TERM ngetopt_lvl_ip_recvopts(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_recvopts(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11875,8 +12128,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_recvopts(ErlNifEnv* env, */ #if defined(IP_RECVORIGDSTADDR) static -ERL_NIF_TERM ngetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11893,8 +12146,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env, */ #if defined(IP_RECVTTL) static -ERL_NIF_TERM ngetopt_lvl_ip_recvttl(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_recvttl(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11911,8 +12164,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_recvttl(ErlNifEnv* env, */ #if defined(IP_RETOPTS) static -ERL_NIF_TERM ngetopt_lvl_ip_retopts(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_retopts(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11929,8 +12182,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_retopts(ErlNifEnv* env, */ #if defined(IP_ROUTER_ALERT) static -ERL_NIF_TERM ngetopt_lvl_ip_router_alert(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_router_alert(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11947,8 +12200,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_router_alert(ErlNifEnv* env, */ #if defined(IP_SENDSRCADDR) static -ERL_NIF_TERM ngetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11965,8 +12218,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env, */ #if defined(IP_TOS) static -ERL_NIF_TERM ngetopt_lvl_ip_tos(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_tos(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -11995,8 +12248,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_tos(ErlNifEnv* env, */ #if defined(IP_TRANSPARENT) static -ERL_NIF_TERM ngetopt_lvl_ip_transparent(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_transparent(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -12014,8 +12267,8 @@ ERL_NIF_TERM ngetopt_lvl_ip_transparent(ErlNifEnv* env, */ #if defined(IP_TTL) static -ERL_NIF_TERM ngetopt_lvl_ip_ttl(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ip_ttl(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IP) int level = SOL_IP; @@ -12033,9 +12286,9 @@ ERL_NIF_TERM ngetopt_lvl_ip_ttl(ErlNifEnv* env, */ #if defined(HAVE_IPV6) static -ERL_NIF_TERM ngetopt_lvl_ipv6(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt) +ERL_NIF_TERM ngetopt_lvl_ipv6(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt) { ERL_NIF_TERM result; @@ -12157,8 +12410,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6(ErlNifEnv* env, #if defined(IPV6_AUTHHDR) static -ERL_NIF_TERM ngetopt_lvl_ipv6_authhdr(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_authhdr(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, SOL_IPV6, IPV6_AUTHHDR); } @@ -12167,8 +12420,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_authhdr(ErlNifEnv* env, #if defined(IPV6_DSTOPTS) static -ERL_NIF_TERM ngetopt_lvl_ipv6_dstopts(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_dstopts(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12182,8 +12435,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_dstopts(ErlNifEnv* env, #if defined(IPV6_FLOWINFO) static -ERL_NIF_TERM ngetopt_lvl_ipv6_flowinfo(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_flowinfo(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12198,8 +12451,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_flowinfo(ErlNifEnv* env, #if defined(IPV6_HOPLIMIT) static -ERL_NIF_TERM ngetopt_lvl_ipv6_hoplimit(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_hoplimit(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12214,8 +12467,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_hoplimit(ErlNifEnv* env, #if defined(IPV6_HOPOPTS) static -ERL_NIF_TERM ngetopt_lvl_ipv6_hopopts(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_hopopts(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12230,8 +12483,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_hopopts(ErlNifEnv* env, #if defined(IPV6_MTU) static -ERL_NIF_TERM ngetopt_lvl_ipv6_mtu(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_mtu(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12248,8 +12501,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_mtu(ErlNifEnv* env, */ #if defined(IPV6_MTU_DISCOVER) static -ERL_NIF_TERM ngetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result; ERL_NIF_TERM eMtuDisc; @@ -12280,8 +12533,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env, #if defined(IPV6_MULTICAST_HOPS) static -ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12296,8 +12549,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env, #if defined(IPV6_MULTICAST_IF) static -ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_if(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_if(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12312,8 +12565,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_if(ErlNifEnv* env, #if defined(IPV6_MULTICAST_LOOP) static -ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12328,8 +12581,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env, #if defined(IPV6_RECVERR) static -ERL_NIF_TERM ngetopt_lvl_ipv6_recverr(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_recverr(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12344,8 +12597,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_recverr(ErlNifEnv* env, #if defined(IPV6_RECVPKTINFO) || defined(IPV6_PKTINFO) static -ERL_NIF_TERM ngetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12365,8 +12618,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env, #if defined(IPV6_ROUTER_ALERT) static -ERL_NIF_TERM ngetopt_lvl_ipv6_router_alert(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_router_alert(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12381,8 +12634,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_router_alert(ErlNifEnv* env, #if defined(IPV6_RTHDR) static -ERL_NIF_TERM ngetopt_lvl_ipv6_rthdr(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_rthdr(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12397,8 +12650,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_rthdr(ErlNifEnv* env, #if defined(IPV6_UNICAST_HOPS) static -ERL_NIF_TERM ngetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12413,8 +12666,8 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env, #if defined(IPV6_V6ONLY) static -ERL_NIF_TERM ngetopt_lvl_ipv6_v6only(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_ipv6_v6only(ErlNifEnv* env, + ESockDescriptor* descP) { #if defined(SOL_IPV6) int level = SOL_IPV6; @@ -12434,9 +12687,9 @@ ERL_NIF_TERM ngetopt_lvl_ipv6_v6only(ErlNifEnv* env, /* ngetopt_lvl_tcp - Level *TCP* option(s) */ static -ERL_NIF_TERM ngetopt_lvl_tcp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt) +ERL_NIF_TERM ngetopt_lvl_tcp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt) { ERL_NIF_TERM result; @@ -12472,8 +12725,8 @@ ERL_NIF_TERM ngetopt_lvl_tcp(ErlNifEnv* env, */ #if defined(TCP_CONGESTION) static -ERL_NIF_TERM ngetopt_lvl_tcp_congestion(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_tcp_congestion(ErlNifEnv* env, + ESockDescriptor* descP) { int max = SOCKET_OPT_TCP_CONGESTION_NAME_MAX+1; @@ -12486,8 +12739,8 @@ ERL_NIF_TERM ngetopt_lvl_tcp_congestion(ErlNifEnv* env, */ #if defined(TCP_MAXSEG) static -ERL_NIF_TERM ngetopt_lvl_tcp_maxseg(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_tcp_maxseg(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_int_opt(env, descP, IPPROTO_TCP, TCP_MAXSEG); } @@ -12498,8 +12751,8 @@ ERL_NIF_TERM ngetopt_lvl_tcp_maxseg(ErlNifEnv* env, */ #if defined(TCP_NODELAY) static -ERL_NIF_TERM ngetopt_lvl_tcp_nodelay(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_tcp_nodelay(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, IPPROTO_TCP, TCP_NODELAY); } @@ -12510,9 +12763,9 @@ ERL_NIF_TERM ngetopt_lvl_tcp_nodelay(ErlNifEnv* env, /* ngetopt_lvl_udp - Level *UDP* option(s) */ static -ERL_NIF_TERM ngetopt_lvl_udp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt) +ERL_NIF_TERM ngetopt_lvl_udp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt) { ERL_NIF_TERM result; @@ -12536,8 +12789,8 @@ ERL_NIF_TERM ngetopt_lvl_udp(ErlNifEnv* env, */ #if defined(UDP_CORK) static -ERL_NIF_TERM ngetopt_lvl_udp_cork(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_udp_cork(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, IPPROTO_UDP, UDP_CORK); } @@ -12549,9 +12802,9 @@ ERL_NIF_TERM ngetopt_lvl_udp_cork(ErlNifEnv* env, */ #if defined(HAVE_SCTP) static -ERL_NIF_TERM ngetopt_lvl_sctp(ErlNifEnv* env, - SocketDescriptor* descP, - int eOpt) +ERL_NIF_TERM ngetopt_lvl_sctp(ErlNifEnv* env, + ESockDescriptor* descP, + int eOpt) { ERL_NIF_TERM result; @@ -12632,8 +12885,8 @@ ERL_NIF_TERM ngetopt_lvl_sctp(ErlNifEnv* env, */ #if defined(SCTP_ASSOCINFO) static -ERL_NIF_TERM ngetopt_lvl_sctp_associnfo(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sctp_associnfo(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result; struct sctp_assocparams val; @@ -12683,8 +12936,8 @@ ERL_NIF_TERM ngetopt_lvl_sctp_associnfo(ErlNifEnv* env, */ #if defined(SCTP_AUTOCLOSE) static -ERL_NIF_TERM ngetopt_lvl_sctp_autoclose(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sctp_autoclose(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_int_opt(env, descP, IPPROTO_SCTP, SCTP_AUTOCLOSE); } @@ -12695,8 +12948,8 @@ ERL_NIF_TERM ngetopt_lvl_sctp_autoclose(ErlNifEnv* env, */ #if defined(SCTP_DISABLE_FRAGMENTS) static -ERL_NIF_TERM ngetopt_lvl_sctp_disable_fragments(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sctp_disable_fragments(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, IPPROTO_SCTP, SCTP_DISABLE_FRAGMENTS); } @@ -12708,8 +12961,8 @@ ERL_NIF_TERM ngetopt_lvl_sctp_disable_fragments(ErlNifEnv* env, */ #if defined(SCTP_INITMSG) static -ERL_NIF_TERM ngetopt_lvl_sctp_initmsg(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sctp_initmsg(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result; struct sctp_initmsg val; @@ -12757,8 +13010,8 @@ ERL_NIF_TERM ngetopt_lvl_sctp_initmsg(ErlNifEnv* env, */ #if defined(SCTP_MAXSEG) static -ERL_NIF_TERM ngetopt_lvl_sctp_maxseg(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sctp_maxseg(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_int_opt(env, descP, IPPROTO_SCTP, SCTP_MAXSEG); } @@ -12769,8 +13022,8 @@ ERL_NIF_TERM ngetopt_lvl_sctp_maxseg(ErlNifEnv* env, */ #if defined(SCTP_NODELAY) static -ERL_NIF_TERM ngetopt_lvl_sctp_nodelay(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sctp_nodelay(ErlNifEnv* env, + ESockDescriptor* descP) { return ngetopt_bool_opt(env, descP, IPPROTO_SCTP, SCTP_NODELAY); } @@ -12792,8 +13045,8 @@ ERL_NIF_TERM ngetopt_lvl_sctp_nodelay(ErlNifEnv* env, */ #if defined(SCTP_RTOINFO) static -ERL_NIF_TERM ngetopt_lvl_sctp_rtoinfo(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM ngetopt_lvl_sctp_rtoinfo(ErlNifEnv* env, + ESockDescriptor* descP) { ERL_NIF_TERM result; struct sctp_rtoinfo val; @@ -12844,10 +13097,10 @@ ERL_NIF_TERM ngetopt_lvl_sctp_rtoinfo(ErlNifEnv* env, /* ngetopt_bool_opt - get an (integer) bool option */ static -ERL_NIF_TERM ngetopt_bool_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt) +ERL_NIF_TERM ngetopt_bool_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt) { ERL_NIF_TERM result; int val; @@ -12885,10 +13138,10 @@ ERL_NIF_TERM ngetopt_bool_opt(ErlNifEnv* env, /* ngetopt_int_opt - get an integer option */ static -ERL_NIF_TERM ngetopt_int_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt) +ERL_NIF_TERM ngetopt_int_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt) { ERL_NIF_TERM result; int val; @@ -12911,10 +13164,10 @@ ERL_NIF_TERM ngetopt_int_opt(ErlNifEnv* env, /* ngetopt_timeval_opt - get an timeval option */ static -ERL_NIF_TERM ngetopt_timeval_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt) +ERL_NIF_TERM ngetopt_timeval_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt) { ERL_NIF_TERM result; struct timeval val; @@ -12961,11 +13214,11 @@ ERL_NIF_TERM ngetopt_timeval_opt(ErlNifEnv* env, */ #if defined(USE_GETOPT_STR_OPT) static -ERL_NIF_TERM ngetopt_str_opt(ErlNifEnv* env, - SocketDescriptor* descP, - int level, - int opt, - int max) +ERL_NIF_TERM ngetopt_str_opt(ErlNifEnv* env, + ESockDescriptor* descP, + int level, + int opt, + int max) { ERL_NIF_TERM result; char* val = MALLOC(max); @@ -13021,8 +13274,8 @@ ERL_NIF_TERM nif_sockname(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - ERL_NIF_TERM res; + ESockDescriptor* descP; + ERL_NIF_TERM res; SGDBG( ("SOCKET", "nif_sockname -> entry with argc: %d\r\n", argc) ); @@ -13053,12 +13306,12 @@ ERL_NIF_TERM nif_sockname(ErlNifEnv* env, #if !defined(__WIN32__) static -ERL_NIF_TERM nsockname(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM nsockname(ErlNifEnv* env, + ESockDescriptor* descP) { - SocketAddress sa; - SocketAddress* saP = &sa; - unsigned int sz = sizeof(SocketAddress); + ESockAddress sa; + ESockAddress* saP = &sa; + unsigned int sz = sizeof(ESockAddress); sys_memzero((char*) saP, sz); if (IS_SOCKET_ERROR(sock_name(descP->sock, (struct sockaddr*) saP, &sz))) { @@ -13095,8 +13348,8 @@ ERL_NIF_TERM nif_peername(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - ERL_NIF_TERM res; + ESockDescriptor* descP; + ERL_NIF_TERM res; SGDBG( ("SOCKET", "nif_peername -> entry with argc: %d\r\n", argc) ); @@ -13127,12 +13380,12 @@ ERL_NIF_TERM nif_peername(ErlNifEnv* env, #if !defined(__WIN32__) static -ERL_NIF_TERM npeername(ErlNifEnv* env, - SocketDescriptor* descP) +ERL_NIF_TERM npeername(ErlNifEnv* env, + ESockDescriptor* descP) { - SocketAddress sa; - SocketAddress* saP = &sa; - unsigned int sz = sizeof(SocketAddress); + ESockAddress sa; + ESockAddress* saP = &sa; + unsigned int sz = sizeof(ESockAddress); sys_memzero((char*) saP, sz); if (IS_SOCKET_ERROR(sock_peer(descP->sock, (struct sockaddr*) saP, &sz))) { @@ -13170,8 +13423,8 @@ ERL_NIF_TERM nif_cancel(ErlNifEnv* env, #if defined(__WIN32__) return enif_raise_exception(env, MKA(env, "notsup")); #else - SocketDescriptor* descP; - ERL_NIF_TERM op, sockRef, opRef, result; + ESockDescriptor* descP; + ERL_NIF_TERM op, sockRef, opRef, result; SGDBG( ("SOCKET", "nif_cancel -> entry with argc: %d\r\n", argc) ); @@ -13208,11 +13461,11 @@ ERL_NIF_TERM nif_cancel(ErlNifEnv* env, #if !defined(__WIN32__) static -ERL_NIF_TERM ncancel(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM op, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM opRef) +ERL_NIF_TERM ncancel(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM op, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef) { /* <KOLLA> * @@ -13250,9 +13503,9 @@ ERL_NIF_TERM ncancel(ErlNifEnv* env, * */ static -ERL_NIF_TERM ncancel_connect(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef) +ERL_NIF_TERM ncancel_connect(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef) { return ncancel_write_select(env, descP, opRef); } @@ -13269,10 +13522,10 @@ ERL_NIF_TERM ncancel_connect(ErlNifEnv* env, * */ static -ERL_NIF_TERM ncancel_accept(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM opRef) +ERL_NIF_TERM ncancel_accept(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef) { ERL_NIF_TERM res; @@ -13312,9 +13565,9 @@ ERL_NIF_TERM ncancel_accept(ErlNifEnv* env, * in the acceptor queue). */ static -ERL_NIF_TERM ncancel_accept_current(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef) +ERL_NIF_TERM ncancel_accept_current(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef) { ERL_NIF_TERM res; @@ -13352,9 +13605,9 @@ ERL_NIF_TERM ncancel_accept_current(ErlNifEnv* env, * remove them from the acceptor queue. */ static -ERL_NIF_TERM ncancel_accept_waiting(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef) +ERL_NIF_TERM ncancel_accept_waiting(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef) { ErlNifPid caller; @@ -13379,10 +13632,10 @@ ERL_NIF_TERM ncancel_accept_waiting(ErlNifEnv* env, * Its either the current writer or one of the waiting writers. */ static -ERL_NIF_TERM ncancel_send(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM opRef) +ERL_NIF_TERM ncancel_send(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef) { ERL_NIF_TERM res; @@ -13423,9 +13676,9 @@ ERL_NIF_TERM ncancel_send(ErlNifEnv* env, * in the writer queue). */ static -ERL_NIF_TERM ncancel_send_current(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef) +ERL_NIF_TERM ncancel_send_current(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef) { ERL_NIF_TERM res; @@ -13459,9 +13712,9 @@ ERL_NIF_TERM ncancel_send_current(ErlNifEnv* env, * remove them from the writer queue. */ static -ERL_NIF_TERM ncancel_send_waiting(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef) +ERL_NIF_TERM ncancel_send_waiting(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef) { ErlNifPid caller; @@ -13486,10 +13739,10 @@ ERL_NIF_TERM ncancel_send_waiting(ErlNifEnv* env, * Its either the current reader or one of the waiting readers. */ static -ERL_NIF_TERM ncancel_recv(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM opRef) +ERL_NIF_TERM ncancel_recv(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef) { ERL_NIF_TERM res; @@ -13529,9 +13782,9 @@ ERL_NIF_TERM ncancel_recv(ErlNifEnv* env, * in the reader queue). */ static -ERL_NIF_TERM ncancel_recv_current(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef) +ERL_NIF_TERM ncancel_recv_current(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef) { ERL_NIF_TERM res; @@ -13565,9 +13818,9 @@ ERL_NIF_TERM ncancel_recv_current(ErlNifEnv* env, * remove them from the reader queue. */ static -ERL_NIF_TERM ncancel_recv_waiting(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef) +ERL_NIF_TERM ncancel_recv_waiting(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef) { ErlNifPid caller; @@ -13587,9 +13840,9 @@ ERL_NIF_TERM ncancel_recv_waiting(ErlNifEnv* env, static -ERL_NIF_TERM ncancel_read_select(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef) +ERL_NIF_TERM ncancel_read_select(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef) { return ncancel_mode_select(env, descP, opRef, ERL_NIF_SELECT_READ, @@ -13598,9 +13851,9 @@ ERL_NIF_TERM ncancel_read_select(ErlNifEnv* env, static -ERL_NIF_TERM ncancel_write_select(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef) +ERL_NIF_TERM ncancel_write_select(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef) { return ncancel_mode_select(env, descP, opRef, ERL_NIF_SELECT_WRITE, @@ -13609,11 +13862,11 @@ ERL_NIF_TERM ncancel_write_select(ErlNifEnv* env, static -ERL_NIF_TERM ncancel_mode_select(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM opRef, - int smode, - int rmode) +ERL_NIF_TERM ncancel_mode_select(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM opRef, + int smode, + int rmode) { int selectRes = esock_select_cancel(env, descP->sock, smode, descP); @@ -13643,15 +13896,16 @@ ERL_NIF_TERM ncancel_mode_select(ErlNifEnv* env, /* *** send_check_writer *** * - * Checks if we have a current writer and if that is us. If not, then we must - * be made to wait for our turn. This is done by pushing us unto the writer queue. + * Checks if we have a current writer and if that is us. + * If not (current writer), then we must be made to wait + * for our turn. This is done by pushing us unto the writer queue. */ #if !defined(__WIN32__) static -BOOLEAN_T send_check_writer(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref, - ERL_NIF_TERM* checkResult) +BOOLEAN_T send_check_writer(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM ref, + ERL_NIF_TERM* checkResult) { if (descP->currentWriterP != NULL) { ErlNifPid caller; @@ -13665,7 +13919,8 @@ BOOLEAN_T send_check_writer(ErlNifEnv* env, /* Not the "current writer", so (maybe) push onto queue */ SSDBG( descP, - ("SOCKET", "send_check_writer -> not (current) writer\r\n") ); + ("SOCKET", + "send_check_writer -> not (current) writer\r\n") ); if (!writer_search4pid(env, descP, &caller)) *checkResult = writer_push(env, descP, caller, ref); @@ -13683,7 +13938,8 @@ BOOLEAN_T send_check_writer(ErlNifEnv* env, } - *checkResult = esock_atom_ok; // Does not actually matter in this case, but ... + // Does not actually matter in this case, but ... + *checkResult = esock_atom_ok; return TRUE; } @@ -13702,17 +13958,18 @@ BOOLEAN_T send_check_writer(ErlNifEnv* env, * If the write fail, we give up and return with the appropriate error code. * * What about the remaining writers!! + * */ static -ERL_NIF_TERM send_check_result(ErlNifEnv* env, - SocketDescriptor* descP, - ssize_t written, - ssize_t dataSize, - int saveErrno, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM sendRef) +ERL_NIF_TERM send_check_result(ErlNifEnv* env, + ESockDescriptor* descP, + ssize_t written, + ssize_t dataSize, + int saveErrno, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM sendRef) { - int sres; + ERL_NIF_TERM res; SSDBG( descP, ("SOCKET", "send_check_result -> entry with" @@ -13723,143 +13980,219 @@ ERL_NIF_TERM send_check_result(ErlNifEnv* env, if (written >= dataSize) { - cnt_inc(&descP->writePkgCnt, 1); - cnt_inc(&descP->writeByteCnt, written); - if (descP->currentWriterP != NULL) - DEMONP("send_check_result -> current writer", - env, descP, &descP->currentWriter.mon); + res = send_check_ok(env, descP, written, dataSize, sockRef); + + } else if (written < 0) { + + /* Some kind of send failure - check what kind */ + + if ((saveErrno != EAGAIN) && (saveErrno != EINTR)) { + + res = send_check_fail(env, descP, saveErrno, sockRef); + + } else { + + /* Ok, try again later */ + + SSDBG( descP, ("SOCKET", "send_check_result -> try again\r\n") ); + + res = send_check_retry(env, descP, written, sockRef, sendRef); + + } + + } else { + + /* Not the entire package */ SSDBG( descP, ("SOCKET", "send_check_result -> " - "everything written (%d,%d) - done\r\n", dataSize, written) ); + "not entire package written (%d of %d)\r\n", + written, dataSize) ); - /* Ok, this write is done maybe activate the next (if any) */ + res = send_check_retry(env, descP, written, sockRef, sendRef); - if (!activate_next_writer(env, descP, sockRef)) { - descP->currentWriterP = NULL; - descP->currentWriter.ref = esock_atom_undefined; - enif_set_pid_undefined(&descP->currentWriter.pid); - esock_monitor_init(&descP->currentWriter.mon); - } + } - return esock_atom_ok; + SSDBG( descP, ("SOCKET", "send_check_result -> done: %T\r\n", res) ); - } else if (written < 0) { + return res; +} - /* Some kind of send failure - check what kind */ - if ((saveErrno != EAGAIN) && (saveErrno != EINTR)) { - SocketRequestor req; - ERL_NIF_TERM res, reason; +/* *** send_check_ok *** + * + * Processing done upon successful send. + */ +static +ERL_NIF_TERM send_check_ok(ErlNifEnv* env, + ESockDescriptor* descP, + ssize_t written, + ssize_t dataSize, + ERL_NIF_TERM sockRef) +{ + cnt_inc(&descP->writePkgCnt, 1); + cnt_inc(&descP->writeByteCnt, written); - /* - * An actual failure - we (and everyone waiting) give up - */ + if (descP->currentWriterP != NULL) { + DEMONP("send_check_ok -> current writer", + env, descP, &descP->currentWriter.mon); + esock_free_env("send_check_ok", descP->currentWriter.env); + } - cnt_inc(&descP->writeFails, 1); + SSDBG( descP, + ("SOCKET", "send_check_ok -> " + "everything written (%d,%d) - done\r\n", dataSize, written) ); - SSDBG( descP, - ("SOCKET", - "send_check_result -> error: %d\r\n", saveErrno) ); + /* + * Ok, this write is done maybe activate the next (if any) + */ - reason = MKA(env, erl_errno_id(saveErrno)); - res = esock_make_error(env, reason); + if (!activate_next_writer(env, descP, sockRef)) { + descP->currentWriterP = NULL; + descP->currentWriter.env = NULL; + descP->currentWriter.ref = esock_atom_undefined; + enif_set_pid_undefined(&descP->currentWriter.pid); + esock_monitor_init(&descP->currentWriter.mon); + } - if (descP->currentWriterP != NULL) { + return esock_atom_ok; +} - DEMONP("send_check_result -> current writer", - env, descP, &descP->currentWriter.mon); - while (writer_pop(env, descP, &req)) { - SSDBG( descP, - ("SOCKET", "send_check_result -> abort %T\r\n", - req.pid) ); - esock_send_abort_msg(env, sockRef, req.ref, - reason, &req.pid); - DEMONP("send_check_result -> pop'ed writer", - env, descP, &req.mon); - } - } - - return res; - } else { - /* Ok, try again later */ +/* *** send_check_failure *** + * + * Processing done upon failed send. + * An actual failure - we (and everyone waiting) give up. + */ +static +ERL_NIF_TERM send_check_fail(ErlNifEnv* env, + ESockDescriptor* descP, + int saveErrno, + ERL_NIF_TERM sockRef) +{ + ESockRequestor req; + ERL_NIF_TERM reason; - SSDBG( descP, ("SOCKET", "send_check_result -> try again\r\n") ); - } + cnt_inc(&descP->writeFails, 1); - } - else { - SSDBG( descP, - ("SOCKET", "send_check_result -> " - "not entire package written (%d of %d)\r\n", written, dataSize) ); + SSDBG( descP, ("SOCKET", "send_check_fail -> error: %d\r\n", saveErrno) ); + + reason = MKA(env, erl_errno_id(saveErrno)); + + if (descP->currentWriterP != NULL) { + + DEMONP("send_check_fail -> current writer", + env, descP, &descP->currentWriter.mon); + + while (writer_pop(env, descP, &req)) { + SSDBG( descP, + ("SOCKET", "send_check_fail -> abort %T\r\n", req.pid) ); + esock_send_abort_msg(env, sockRef, req.ref, req.env, + reason, &req.pid); + DEMONP("send_check_fail -> pop'ed writer", env, descP, &req.mon); + } } - /* We failed to write the *entire* packet (anything less then size - * of the packet, which is 0 <= written < sizeof packet), - * so schedule the rest for later. - */ + return esock_make_error(env, reason); +} + + + +/* *** send_check_retry *** + * + * Processing done upon uncomplete or blocked send. + * + * We failed to write the *entire* packet (anything less + * then size of the packet, which is 0 <= written < sizeof + * packet, so schedule the rest for later. + */ +static +ERL_NIF_TERM send_check_retry(ErlNifEnv* env, + ESockDescriptor* descP, + ssize_t written, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM sendRef) +{ + int sres; + ErlNifPid caller; + ERL_NIF_TERM res; if (descP->currentWriterP == NULL) { - ErlNifPid caller; if (enif_self(env, &caller) == NULL) return esock_make_error(env, atom_exself); descP->currentWriter.pid = caller; - if (MONP("send_check_result -> current writer", + + if (MONP("send_check_retry -> current writer", env, descP, &descP->currentWriter.pid, - &descP->currentWriter.mon) != 0) + &descP->currentWriter.mon) != 0) { + enif_set_pid_undefined(&descP->currentWriter.pid); return esock_make_error(env, atom_exmon); - descP->currentWriter.ref = enif_make_copy(descP->env, sendRef); - descP->currentWriterP = &descP->currentWriter; + } else { + descP->currentWriter.env = esock_alloc_env("current-writer"); + descP->currentWriter.ref = CP_TERM(descP->currentWriter.env, sendRef); + descP->currentWriterP = &descP->currentWriter; + } } cnt_inc(&descP->writeWaits, 1); - sres = esock_select_write(env, descP->sock, descP, NULL, sendRef); - + sres = esock_select_write(env, descP->sock, descP, NULL, sockRef, sendRef); + if (written >= 0) { + + /* Partial *write* success */ + if (sres < 0) { /* Returned: {error, Reason} * Reason: {select_failed, sres, written} */ - return esock_make_error(env, - MKT3(env, - esock_atom_select_failed, - MKI(env, sres), - MKI(env, written))); + res = esock_make_error(env, + MKT3(env, + esock_atom_select_failed, + MKI(env, sres), + MKI(env, written))); } else { - return esock_make_ok2(env, MKI(env, written)); + res = esock_make_ok2(env, MKI(env, written)); } + } else { + if (sres < 0) { /* Returned: {error, Reason} * Reason: {select_failed, sres} */ - return esock_make_error(env, - MKT2(env, - esock_atom_select_failed, - MKI(env, sres))); + res = esock_make_error(env, + MKT2(env, + esock_atom_select_failed, + MKI(env, sres))); } else { - return esock_make_error(env, esock_atom_eagain); + res = esock_make_error(env, esock_atom_eagain); } } + + return res; } + /* *** recv_check_reader *** * - * Checks if we have a current reader and if that is us. If not, then we must - * be made to wait for our turn. This is done by pushing us unto the reader queue. + * Checks if we have a current reader and if that is us. If not, + * then we must be made to wait for our turn. This is done by pushing + * us unto the reader queue. + * Note that we do *not* actually initiate the currentReader structure + * here, since we do not actually know yet if we need to! We do that in + * the [recv|recvfrom|recvmsg]_check_result function. */ static -BOOLEAN_T recv_check_reader(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM ref, - ERL_NIF_TERM* checkResult) +BOOLEAN_T recv_check_reader(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM ref, + ERL_NIF_TERM* checkResult) { if (descP->currentReaderP != NULL) { ErlNifPid caller; @@ -13875,7 +14208,8 @@ BOOLEAN_T recv_check_reader(ErlNifEnv* env, /* Not the "current reader", so (maybe) push onto queue */ SSDBG( descP, - ("SOCKET", "recv_check_reader -> not (current) reader\r\n") ); + ("SOCKET", + "recv_check_reader -> not (current) reader\r\n") ); if (!reader_search4pid(env, descP, &caller)) tmp = reader_push(env, descP, caller, ref); @@ -13894,7 +14228,8 @@ BOOLEAN_T recv_check_reader(ErlNifEnv* env, } - *checkResult = esock_atom_ok; // Does not actually matter in this case, but ... + // Does not actually matter in this case, but ... + *checkResult = esock_atom_ok; return TRUE; } @@ -13907,9 +14242,9 @@ BOOLEAN_T recv_check_reader(ErlNifEnv* env, * Including monitoring the calling process. */ static -char* recv_init_current_reader(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM recvRef) +char* recv_init_current_reader(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM recvRef) { if (descP->currentReaderP == NULL) { ErlNifPid caller; @@ -13922,10 +14257,26 @@ char* recv_init_current_reader(ErlNifEnv* env, env, descP, &descP->currentReader.pid, &descP->currentReader.mon) != 0) { + enif_set_pid_undefined(&descP->currentReader.pid); return str_exmon; + } else { + + descP->currentReader.env = esock_alloc_env("current-reader"); + descP->currentReader.ref = CP_TERM(descP->currentReader.env, + recvRef); + descP->currentReaderP = &descP->currentReader; } - descP->currentReader.ref = enif_make_copy(descP->env, recvRef); - descP->currentReaderP = &descP->currentReader; + } else { + + /* + * This is a retry: + * We have done, for instance, recv(Sock, X), but only received Y < X. + * We then call recv again with size = X-Y. So, we then get a new ref. + * + * Make use of the existing environment + */ + + descP->currentReader.ref = CP_TERM(descP->currentReader.env, recvRef); } return NULL; @@ -13941,17 +14292,21 @@ char* recv_init_current_reader(ErlNifEnv* env, */ static -ERL_NIF_TERM recv_update_current_reader(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef) +ERL_NIF_TERM recv_update_current_reader(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef) { ERL_NIF_TERM res = esock_atom_ok; if (descP->currentReaderP != NULL) { - DEMONP("recv_update_current_reader -> current reader", + DEMONP("recv_update_current_reader", env, descP, &descP->currentReader.mon); - + + esock_free_env("recv_update_current_reader - current-read-env", + descP->currentReader.env); + descP->currentReader.env = NULL; + if (!activate_next_reader(env, descP, sockRef)) { SSDBG( descP, @@ -13979,12 +14334,12 @@ ERL_NIF_TERM recv_update_current_reader(ErlNifEnv* env, * nif_abort message will be sent (with reaf and reason). */ static -void recv_error_current_reader(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM reason) +void recv_error_current_reader(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM reason) { - SocketRequestor req; + ESockRequestor req; if (descP->currentReaderP != NULL) { @@ -13995,7 +14350,8 @@ void recv_error_current_reader(ErlNifEnv* env, SSDBG( descP, ("SOCKET", "recv_error_current_reader -> abort %T\r\n", req.pid) ); - esock_send_abort_msg(env, sockRef, req.ref, reason, &req.pid); + esock_send_abort_msg(env, sockRef, req.ref, req.env, + reason, &req.pid); DEMONP("recv_error_current_reader -> pop'ed reader", env, descP, &req.mon); } @@ -14009,18 +14365,16 @@ void recv_error_current_reader(ErlNifEnv* env, * Process the result of a call to recv. */ static -ERL_NIF_TERM recv_check_result(ErlNifEnv* env, - SocketDescriptor* descP, - int read, - int toRead, - int saveErrno, - ErlNifBinary* bufP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM recvRef) +ERL_NIF_TERM recv_check_result(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + int toRead, + int saveErrno, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef) { - char* xres; - int sres; - ERL_NIF_TERM res, data; + ERL_NIF_TERM res; SSDBG( descP, ("SOCKET", "recv_check_result -> entry with" @@ -14044,8 +14398,8 @@ ERL_NIF_TERM recv_check_result(ErlNifEnv* env, res = esock_make_error(env, atom_closed); /* - * When a stream socket peer has performed an orderly shutdown, the return - * value will be 0 (the traditional "end-of-file" return). + * When a stream socket peer has performed an orderly shutdown, + * the return value will be 0 (the traditional "end-of-file" return). * * *We* do never actually try to read 0 bytes from a stream socket! * @@ -14056,381 +14410,515 @@ ERL_NIF_TERM recv_check_result(ErlNifEnv* env, FREE_BIN(bufP); - return res; + } else { + + /* There is a special case: If the provided 'to read' value is + * zero (0) (only for type =/= stream). + * That means that we reads as much as we can, using the default + * read buffer size. + */ + + if (bufP->size == read) { + + /* +++ We filled the buffer +++ */ + + SSDBG( descP, + ("SOCKET", + "recv_check_result -> [%d] filled the buffer\r\n", + toRead) ); + + res = recv_check_full(env, descP, read, toRead, bufP, + sockRef, recvRef); + + } else if (read < 0) { + + /* +++ Error handling +++ */ + res = recv_check_fail(env, descP, saveErrno, bufP, NULL, + sockRef, recvRef); + + } else { + + /* +++ We did not fill the buffer +++ */ + + SSDBG( descP, + ("SOCKET", + "recv_check_result -> [%d] " + "did not fill the buffer (%d of %d)\r\n", + toRead, read, bufP->size) ); + + res = recv_check_partial(env, descP, read, toRead, bufP, + sockRef, recvRef); + + } } - - /* There is a special case: If the provided 'to read' value is - * zero (0) (only for type =/= stream). - * That means that we reads as much as we can, using the default - * read buffer size. - */ - if (bufP->size == read) { + return res; +} + + + +/* *** recv_check_full *** + * + * This function is called if we filled the allocated buffer. + * But are we done yet? + * + * toRead = 0 means: Give me everything you have => maybe + * toRead > 0 means: Yes + */ +static +ERL_NIF_TERM recv_check_full(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + int toRead, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef) +{ + ERL_NIF_TERM res; - /* +++ We filled the buffer +++ */ + if (toRead == 0) { + + /* +++ Give us everything you have got => * + * (maybe) needs to continue +++ */ + + /* Send up each chunk of data for each of the read + * and let the erlang code assemble it: {ok, false, Bin} + * (when complete it should return {ok, true, Bin}). + * We need to read atleast one more time to be sure if its + * done... + * + * Also, we need to check if the rNumCnt has reached its max (rNum), + * in which case we will assume the read to be done! + */ SSDBG( descP, - ("SOCKET", - "recv_check_result -> [%d] filled the buffer\r\n", toRead) ); - - if (toRead == 0) { - - /* +++ Give us everything you have got => * - * (maybe) needs to continue +++ */ - - /* How do we do this? - * Either: - * 1) Send up each chunk of data for each of the read - * and let the erlang code assemble it: {ok, false, Bin} - * (when complete it should return {ok, true, Bin}). - * We need to read atleast one more time to be sure if its - * done... - * 2) Or put it in a buffer here, and then let the erlang code - * know that it should call again (special return value) - * (continuous binary realloc "here"). - * - * => We choose alt 1 for now. - * - * Also, we need to check if the rNumCnt has reached its max (rNum), - * in which case we will assume the read to be done! - */ + ("SOCKET", "recv_check_full -> shall we continue reading" + "\r\n read: %d" + "\r\n rNum: %d" + "\r\n rNumCnt: %d" + "\r\n", read, descP->rNum, descP->rNumCnt) ); - cnt_inc(&descP->readByteCnt, read); + res = recv_check_full_maybe_done(env, descP, read, toRead, bufP, + sockRef, recvRef); - SSDBG( descP, - ("SOCKET", "recv_check_result -> shall we continue reading" - "\r\n read: %d" - "\r\n rNum: %d" - "\r\n rNumCnt: %d" - "\r\n", read, descP->rNum, descP->rNumCnt) ); + } else { - if (descP->rNum > 0) { + /* +++ We got exactly as much as we requested => We are done +++ */ - descP->rNumCnt++; - if (descP->rNumCnt >= descP->rNum) { + SSDBG( descP, + ("SOCKET", + "recv_check_full -> [%d] " + "we got exactly what we could fit\r\n", toRead) ); - descP->rNumCnt = 0; + res = recv_check_full_done(env, descP, read, bufP, sockRef); - cnt_inc(&descP->readPkgCnt, 1); - - recv_update_current_reader(env, descP, sockRef); - - /* This transfers "ownership" of the *allocated* binary to an - * erlang term (no need for an explicit free). - */ - data = MKBIN(env, bufP); - - return esock_make_ok3(env, atom_true, data); + } - } - } + return res; - /* Yes, we *do* need to continue reading */ +} - if ((xres = recv_init_current_reader(env, - descP, recvRef)) != NULL) { - descP->rNumCnt = 0; - FREE_BIN(bufP); - return esock_make_error_str(env, xres); - } - /* This transfers "ownership" of the *allocated* binary to an - * erlang term (no need for an explicit free). - */ - data = MKBIN(env, bufP); - SSDBG( descP, - ("SOCKET", - "recv_check_result -> [%d] " - "we are done for now - read more\r\n", toRead) ); +/* *** recv_check_full_maybe_done *** + * + * Send up each chunk of data for each of the read + * and let the erlang code assemble it: {ok, false, Bin} + * (when complete it should return {ok, true, Bin}). + * We need to read atleast one more time to be sure if its + * done... + * + * Also, we need to check if the rNumCnt has reached its max (rNum), + * in which case we will assume the read to be done! + */ +static +ERL_NIF_TERM recv_check_full_maybe_done(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + int toRead, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef) +{ + char* xres; - return esock_make_ok3(env, atom_false, data); + cnt_inc(&descP->readByteCnt, read); - } else { + if (descP->rNum > 0) { - /* +++ We got exactly as much as we requested => We are done +++ */ + descP->rNumCnt++; + if (descP->rNumCnt >= descP->rNum) { - cnt_inc(&descP->readPkgCnt, 1); - cnt_inc(&descP->readByteCnt, read); + descP->rNumCnt = 0; - SSDBG( descP, - ("SOCKET", - "recv_check_result -> [%d] " - "we got exactly what we could fit\r\n", toRead) ); + cnt_inc(&descP->readPkgCnt, 1); recv_update_current_reader(env, descP, sockRef); /* This transfers "ownership" of the *allocated* binary to an * erlang term (no need for an explicit free). */ - data = MKBIN(env, bufP); - return esock_make_ok3(env, atom_true, data); + return esock_make_ok3(env, atom_true, MKBIN(env, bufP)); } + } - } else if (read < 0) { - - /* +++ Error handling +++ */ + /* Yes, we *do* need to continue reading */ + if ((xres = recv_init_current_reader(env, descP, recvRef)) != NULL) { + descP->rNumCnt = 0; FREE_BIN(bufP); + return esock_make_error_str(env, xres); + } - if (saveErrno == ECONNRESET) { + /* This transfers "ownership" of the *allocated* binary to an + * erlang term (no need for an explicit free). + */ - res = esock_make_error(env, atom_closed); + SSDBG( descP, + ("SOCKET", + "recv_check_full_maybe_done -> [%d] " + "we are done for now - read more\r\n", toRead) ); - /* +++ Oups - closed +++ */ + return esock_make_ok3(env, atom_false, MKBIN(env, bufP)); +} - SSDBG( descP, ("SOCKET", - "recv_check_result -> [%d] closed\r\n", toRead) ); - /* <KOLLA> - * - * IF THE CURRENT PROCESS IS *NOT* THE CONTROLLING - * PROCESS, WE NEED TO INFORM IT!!! - * - * ALL WAITING PROCESSES MUST ALSO GET THE ERROR!! - * HANDLED BY THE STOP (CALLBACK) FUNCTION? - * - * SINCE THIS IS A REMOTE CLOSE, WE DON'T NEED TO WAIT - * FOR OUTPUT TO BE WRITTEN (NO ONE WILL READ), JUST - * ABORT THE SOCKET REGARDLESS OF LINGER??? - * - * </KOLLA> - */ - descP->closeLocal = FALSE; - descP->state = SOCKET_STATE_CLOSING; +/* *** recv_check_full_done *** + * + * A successful recv and we filled the buffer. + */ +static +ERL_NIF_TERM recv_check_full_done(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef) +{ + ERL_NIF_TERM data; - recv_error_current_reader(env, descP, sockRef, res); + cnt_inc(&descP->readPkgCnt, 1); + cnt_inc(&descP->readByteCnt, read); - if ((sres = esock_select_stop(env, descP->sock, descP)) < 0) { - esock_warning_msg("Failed stop select (closed) " - "for current reader (%T): %d\r\n", - recvRef, sres); - } + recv_update_current_reader(env, descP, sockRef); - return res; + /* This transfers "ownership" of the *allocated* binary to an + * erlang term (no need for an explicit free). + */ + data = MKBIN(env, bufP); - } else if ((saveErrno == ERRNO_BLOCK) || - (saveErrno == EAGAIN)) { + return esock_make_ok3(env, atom_true, data); +} - SSDBG( descP, ("SOCKET", - "recv_check_result -> [%d] eagain\r\n", toRead) ); - descP->rNumCnt = 0; - if ((xres = recv_init_current_reader(env, descP, recvRef)) != NULL) - return esock_make_error_str(env, xres); - - SSDBG( descP, ("SOCKET", "recv_check_result -> SELECT for more\r\n") ); - - if ((sres = esock_select_read(env, descP->sock, descP, - NULL, recvRef)) < 0) { - res = esock_make_error(env, - MKT2(env, - esock_atom_select_failed, - MKI(env, sres))); - } else { - res = esock_make_error(env, esock_atom_eagain); - } - return res; - } else { - ERL_NIF_TERM res = esock_make_error_errno(env, saveErrno); +/* *** recv_check_fail *** + * + * Handle recv failure. + */ +static +ERL_NIF_TERM recv_check_fail(ErlNifEnv* env, + ESockDescriptor* descP, + int saveErrno, + ErlNifBinary* buf1P, + ErlNifBinary* buf2P, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef) +{ + ERL_NIF_TERM res; - SSDBG( descP, ("SOCKET", "recv_check_result -> [%d] errno: %d\r\n", - toRead, saveErrno) ); + FREE_BIN(buf1P); if (buf2P != NULL) FREE_BIN(buf2P); - recv_error_current_reader(env, descP, sockRef, res); + if (saveErrno == ECONNRESET) { - return res; - } + /* +++ Oups - closed +++ */ + + SSDBG( descP, ("SOCKET", "recv_check_fail -> closed\r\n") ); + + res = recv_check_fail_closed(env, descP, sockRef, recvRef); + + } else if ((saveErrno == ERRNO_BLOCK) || + (saveErrno == EAGAIN)) { + + SSDBG( descP, ("SOCKET", "recv_check_fail -> eagain\r\n") ); + + res = recv_check_retry(env, descP, sockRef, recvRef); } else { - /* +++ We did not fill the buffer +++ */ + SSDBG( descP, ("SOCKET", "recv_check_fail -> errno: %d\r\n", + saveErrno) ); - SSDBG( descP, - ("SOCKET", - "recv_check_result -> [%d] " - "did not fill the buffer (%d of %d)\r\n", - toRead, read, bufP->size) ); + res = recv_check_fail_gen(env, descP, saveErrno, sockRef); + } - if (toRead == 0) { + return res; +} - /* +++ We got it all, but since we +++ - * +++ did not fill the buffer, we +++ - * +++ must split it into a sub-binary. +++ - */ - SSDBG( descP, ("SOCKET", - "recv_check_result -> [%d] split buffer\r\n", toRead) ); - descP->rNumCnt = 0; - cnt_inc(&descP->readPkgCnt, 1); - cnt_inc(&descP->readByteCnt, read); +/* *** recv_check_fail_closed *** + * + * We detected that the socket was closed wile reading. + * Inform current and waiting readers. + */ +static +ERL_NIF_TERM recv_check_fail_closed(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef) +{ + ERL_NIF_TERM res = esock_make_error(env, atom_closed); + int sres; - recv_update_current_reader(env, descP, sockRef); + /* <KOLLA> + * + * IF THE CURRENT PROCESS IS *NOT* THE CONTROLLING + * PROCESS, WE NEED TO INFORM IT!!! + * + * ALL WAITING PROCESSES MUST ALSO GET THE ERROR!! + * HANDLED BY THE STOP (CALLBACK) FUNCTION? + * + * SINCE THIS IS A REMOTE CLOSE, WE DON'T NEED TO WAIT + * FOR OUTPUT TO BE WRITTEN (NO ONE WILL READ), JUST + * ABORT THE SOCKET REGARDLESS OF LINGER??? + * + * </KOLLA> + */ - /* This transfers "ownership" of the *allocated* binary to an - * erlang term (no need for an explicit free). - */ - data = MKBIN(env, bufP); - data = MKSBIN(env, data, 0, read); + descP->closeLocal = FALSE; + descP->state = SOCKET_STATE_CLOSING; - SSDBG( descP, - ("SOCKET", "recv_check_result -> [%d] done\r\n", toRead) ); + recv_error_current_reader(env, descP, sockRef, res); - return esock_make_ok3(env, atom_true, data); + if ((sres = esock_select_stop(env, descP->sock, descP)) < 0) { + esock_warning_msg("Failed stop select (closed) " + "for current reader (%T): %d\r\n", + recvRef, sres); + } - } else { + return res; +} - /* +++ We got only a part of what was expected +++ - * +++ => select for more more later and +++ - * +++ deliver what we got. +++ */ - SSDBG( descP, ("SOCKET", "recv_check_result -> [%d] " - "only part of message - expect more\r\n", toRead) ); - if ((xres = recv_init_current_reader(env, descP, recvRef)) != NULL) { - FREE_BIN(bufP); - return esock_make_error_str(env, xres); - } +/* *** recv_check_retry *** + * + * The recv call would have blocked, so retry. + */ +static +ERL_NIF_TERM recv_check_retry(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef) +{ + int sres; + char* xres; + ERL_NIF_TERM reason; - data = MKBIN(env, bufP); - data = MKSBIN(env, data, 0, read); + descP->rNumCnt = 0; + if ((xres = recv_init_current_reader(env, descP, recvRef)) != NULL) + return esock_make_error_str(env, xres); + + SSDBG( descP, ("SOCKET", "recv_check_retry -> SELECT for more\r\n") ); + + if ((sres = esock_select_read(env, descP->sock, descP, NULL, + sockRef, recvRef)) < 0) { + /* Ouch + * Now what? We have copied ref into *its own* environment! + */ + reason = MKT2(env, esock_atom_select_failed, MKI(env, sres)); + } else { + reason = esock_atom_eagain; + } - cnt_inc(&descP->readByteCnt, read); + return esock_make_error(env, reason); - /* SELECT for more data */ +} - if ((sres = esock_select_read(env, descP->sock, descP, - NULL, recvRef)) < 0) { - /* Result: {error, Reason} - * Reason: {select_failed, sres, data} - */ - res = esock_make_error(env, - MKT3(env, - esock_atom_select_failed, - MKI(env, sres), - data)); - } else { - res = esock_make_ok3(env, atom_false, data); - } - - /* This transfers "ownership" of the *allocated* binary to an - * erlang term (no need for an explicit free). - */ - return res; - } + + +/* *** recv_check_fail_gen *** + * + * The recv call had a "general" failure. + */ +static +ERL_NIF_TERM recv_check_fail_gen(ErlNifEnv* env, + ESockDescriptor* descP, + int saveErrno, + ERL_NIF_TERM sockRef) +{ + ERL_NIF_TERM res = esock_make_error_errno(env, saveErrno); + + recv_error_current_reader(env, descP, sockRef, res); + + return res; +} + + + +/* *** recv_check_partial *** + * + * Handle a sucessful recv which only partly filled the specified buffer. + */ +static +ERL_NIF_TERM recv_check_partial(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + int toRead, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef) +{ + ERL_NIF_TERM res; + + if (toRead == 0) { + + /* +++ We got it all, but since we +++ + * +++ did not fill the buffer, we +++ + * +++ must split it into a sub-binary. +++ + */ + + SSDBG( descP, + ("SOCKET", + "recv_check_partial -> [%d] split buffer\r\n", toRead) ); + + res = recv_check_partial_done(env, descP, read, bufP, sockRef); + + } else { + + SSDBG( descP, ("SOCKET", "recv_check_partial -> [%d] " + "only part of message - expect more\r\n", toRead) ); + + res = recv_check_partial_part(env, descP, read, bufP, sockRef, recvRef); } + + return res; } -/* The recvfrom function delivers one (1) message. If our buffer - * is to small, the message will be truncated. So, regardless - * if we filled the buffer or not, we have got what we are going - * to get regarding this message. + +/* *** recv_check_partial_done *** + * + * A successful but only partial recv, which fulfilled the required read. */ static -ERL_NIF_TERM recvfrom_check_result(ErlNifEnv* env, - SocketDescriptor* descP, - int read, - int saveErrno, - ErlNifBinary* bufP, - SocketAddress* fromAddrP, - unsigned int fromAddrLen, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM recvRef) +ERL_NIF_TERM recv_check_partial_done(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef) { - char* xres; - int sres; - ERL_NIF_TERM data, res; + ERL_NIF_TERM data; - SSDBG( descP, - ("SOCKET", "recvfrom_check_result -> entry with" - "\r\n read: %d" - "\r\n saveErrno: %d" - "\r\n recvRef: %T" - "\r\n", read, saveErrno, recvRef) ); + descP->rNumCnt = 0; + cnt_inc(&descP->readPkgCnt, 1); + cnt_inc(&descP->readByteCnt, read); + recv_update_current_reader(env, descP, sockRef); - /* There is a special case: If the provided 'to read' value is - * zero (0). That means that we reads as much as we can, using - * the default read buffer size. + /* This transfers "ownership" of the *allocated* binary to an + * erlang term (no need for an explicit free). */ + data = MKBIN(env, bufP); + data = MKSBIN(env, data, 0, read); - if (read < 0) { + SSDBG( descP, + ("SOCKET", "recv_check_partial_done -> [%d] done\r\n", read) ); - /* +++ Error handling +++ */ + return esock_make_ok3(env, atom_true, data); +} - if (saveErrno == ECONNRESET) { - res = esock_make_error(env, atom_closed); - /* +++ Oups - closed +++ */ - SSDBG( descP, ("SOCKET", "recvfrom_check_result -> closed\r\n") ); +/* *** recv_check_partial_part *** + * + * A successful but only partial recv, which only partly fulfilled + * the required read. + */ +static +ERL_NIF_TERM recv_check_partial_part(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + ErlNifBinary* bufP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef) +{ + ERL_NIF_TERM res, reason, data; + char* xres; + int sres; - /* <KOLLA> - * IF THE CURRENT PROCESS IS *NOT* THE CONTROLLING - * PROCESS, WE NEED TO INFORM IT!!! - * - * ALL WAITING PROCESSES MUST ALSO GET THE ERROR!! - * - * </KOLLA> - */ + if ((xres = recv_init_current_reader(env, descP, recvRef)) != NULL) { + FREE_BIN(bufP); + return esock_make_error_str(env, xres); + } - descP->closeLocal = FALSE; - descP->state = SOCKET_STATE_CLOSING; + data = MKBIN(env, bufP); + data = MKSBIN(env, data, 0, read); - recv_error_current_reader(env, descP, sockRef, res); + cnt_inc(&descP->readByteCnt, read); - if ((sres = esock_select_stop(env, descP->sock, descP)) < 0) { - esock_warning_msg("Failed stop select (closed) " - "for current reader (%T): %d\r\n", - recvRef, sres); - } + /* SELECT for more data */ - FREE_BIN(bufP); + sres = esock_select_read(env, descP->sock, descP, NULL, + sockRef, recvRef); + if (sres < 0) { + /* Result: {error, Reason} + * Reason: {select_failed, sres, data} + */ + reason = MKT3(env, esock_atom_select_failed, MKI(env, sres), data); + res = esock_make_error(env, reason); - return res; + } else { - } else if ((saveErrno == ERRNO_BLOCK) || - (saveErrno == EAGAIN)) { + res = esock_make_ok3(env, atom_false, data); - SSDBG( descP, ("SOCKET", "recvfrom_check_result -> eagain\r\n") ); + } - FREE_BIN(bufP); + /* This transfers "ownership" of the *allocated* binary to an + * erlang term (no need for an explicit free). + */ + return res; +} - if ((xres = recv_init_current_reader(env, descP, recvRef)) != NULL) - return esock_make_error_str(env, xres); - - if ((sres = esock_select_read(env, descP->sock, descP, - NULL, recvRef)) < 0) { - res = esock_make_error(env, - MKT2(env, - esock_atom_select_failed, - MKI(env, sres))); - } else { - res = esock_make_error(env, esock_atom_eagain); - } - return res; - } else { - res = esock_make_error_errno(env, saveErrno); - SSDBG( descP, - ("SOCKET", - "recvfrom_check_result -> errno: %d\r\n", saveErrno) ); - - recv_error_current_reader(env, descP, sockRef, res); - FREE_BIN(bufP); +/* The recvfrom function delivers one (1) message. If our buffer + * is to small, the message will be truncated. So, regardless + * if we filled the buffer or not, we have got what we are going + * to get regarding this message. + */ +static +ERL_NIF_TERM recvfrom_check_result(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + int saveErrno, + ErlNifBinary* bufP, + ESockAddress* fromAddrP, + unsigned int fromAddrLen, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef) +{ + ERL_NIF_TERM data, res; - return res; - } + SSDBG( descP, + ("SOCKET", "recvfrom_check_result -> entry with" + "\r\n read: %d" + "\r\n saveErrno: %d" + "\r\n recvRef: %T" + "\r\n", read, saveErrno, recvRef) ); + + if (read < 0) { + + /* +++ Error handling +++ */ + + res = recv_check_fail(env, descP, saveErrno, bufP, NULL, + sockRef, recvRef); } else { @@ -14443,7 +14931,9 @@ ERL_NIF_TERM recvfrom_check_result(ErlNifEnv* env, &eSockAddr); if (read == bufP->size) { + data = MKBIN(env, bufP); + } else { /* +++ We got a chunk of data but +++ @@ -14458,30 +14948,34 @@ ERL_NIF_TERM recvfrom_check_result(ErlNifEnv* env, recv_update_current_reader(env, descP, sockRef); - return esock_make_ok2(env, MKT2(env, eSockAddr, data)); + res = esock_make_ok2(env, MKT2(env, eSockAddr, data)); } + + return res; + } -/* The recvmsg function delivers one (1) message. If our buffer +/* *** recvmsg_check_result *** + * + * The recvmsg function delivers one (1) message. If our buffer * is to small, the message will be truncated. So, regardless * if we filled the buffer or not, we have got what we are going * to get regarding this message. */ static -ERL_NIF_TERM recvmsg_check_result(ErlNifEnv* env, - SocketDescriptor* descP, - int read, - int saveErrno, - struct msghdr* msgHdrP, - ErlNifBinary* dataBufP, - ErlNifBinary* ctrlBufP, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM recvRef) +ERL_NIF_TERM recvmsg_check_result(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + int saveErrno, + struct msghdr* msgHdrP, + ErlNifBinary* dataBufP, + ErlNifBinary* ctrlBufP, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM recvRef) { - int sres; ERL_NIF_TERM res; SSDBG( descP, @@ -14503,8 +14997,8 @@ ERL_NIF_TERM recvmsg_check_result(ErlNifEnv* env, if ((read == 0) && (descP->type == SOCK_STREAM)) { /* - * When a stream socket peer has performed an orderly shutdown, the return - * value will be 0 (the traditional "end-of-file" return). + * When a stream socket peer has performed an orderly shutdown, + * the return value will be 0 (the traditional "end-of-file" return). * * *We* do never actually try to read 0 bytes from a stream socket! */ @@ -14526,119 +15020,76 @@ ERL_NIF_TERM recvmsg_check_result(ErlNifEnv* env, /* +++ Error handling +++ */ - if (saveErrno == ECONNRESET) { + res = recv_check_fail(env, descP, saveErrno, dataBufP, ctrlBufP, + sockRef, recvRef); - /* +++ Oups - closed +++ */ + } else { - SSDBG( descP, ("SOCKET", "recvmsg_check_result -> closed\r\n") ); + /* +++ We sucessfully got a message - time to encode it +++ */ - /* <KOLLA> - * IF THE CURRENT PROCESS IS *NOT* THE CONTROLLING - * PROCESS, WE NEED TO INFORM IT!!! - * - * ALL WAITING PROCESSES MUST ALSO GET THE ERROR!! - * - * </KOLLA> - */ + res = recvmsg_check_msg(env, descP, read, msgHdrP, + dataBufP, ctrlBufP, sockRef); - res = esock_make_error(env, atom_closed); - descP->closeLocal = FALSE; - descP->state = SOCKET_STATE_CLOSING; - - recv_error_current_reader(env, descP, sockRef, res); + } - if ((sres = esock_select_stop(env, descP->sock, descP)) < 0) { - esock_warning_msg("Failed stop select (closed) " - "for current reader (%T): %d\r\n", - recvRef, sres); - } + return res; - FREE_BIN(dataBufP); FREE_BIN(ctrlBufP); +} - return res;; - } else if ((saveErrno == ERRNO_BLOCK) || - (saveErrno == EAGAIN)) { - char* xres; - SSDBG( descP, ("SOCKET", "recvmsg_check_result -> eagain\r\n") ); - - FREE_BIN(dataBufP); FREE_BIN(ctrlBufP); - - if ((xres = recv_init_current_reader(env, descP, recvRef)) != NULL) - return esock_make_error_str(env, xres); - - if ((sres = esock_select_read(env, descP->sock, descP, - NULL, recvRef)) < 0) { - res = esock_make_error(env, - MKT2(env, - esock_atom_select_failed, - MKI(env, sres))); - } else { - res = esock_make_error(env, esock_atom_eagain); - } +/* *** recvmsg_check_msg *** + * + * We successfully read one message. Time to process. + */ +static +ERL_NIF_TERM recvmsg_check_msg(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + struct msghdr* msgHdrP, + ErlNifBinary* dataBufP, + ErlNifBinary* ctrlBufP, + ERL_NIF_TERM sockRef) +{ + ERL_NIF_TERM res, eMsgHdr; + char* xres; - return res; + /* + * <KOLLA> + * + * The return value of recvmsg is the *total* number of bytes + * that where successfully read. This data has been put into + * the *IO vector*. + * + * </KOLLA> + */ - } else { + if ((xres = encode_msghdr(env, descP, + read, msgHdrP, dataBufP, ctrlBufP, + &eMsgHdr)) != NULL) { - res = esock_make_error_errno(env, saveErrno); + SSDBG( descP, + ("SOCKET", + "recvmsg_check_result -> " + "(msghdr) encode failed: %s\r\n", xres) ); - SSDBG( descP, - ("SOCKET", - "recvmsg_check_result -> errno: %d\r\n", saveErrno) ); - - recv_error_current_reader(env, descP, sockRef, res); + recv_update_current_reader(env, descP, sockRef); - FREE_BIN(dataBufP); FREE_BIN(ctrlBufP); + FREE_BIN(dataBufP); FREE_BIN(ctrlBufP); - return res; - } + res = esock_make_error_str(env, xres); } else { - /* +++ We sucessfully got a message - time to encode it +++ */ - - ERL_NIF_TERM eMsgHdr; - char* xres; - - /* - * <KOLLA> - * - * The return value of recvmsg is the *total* number of bytes - * that where successfully read. This data has been put into - * the *IO vector*. - * - * </KOLLA> - */ - - if ((xres = encode_msghdr(env, descP, - read, msgHdrP, dataBufP, ctrlBufP, - &eMsgHdr)) != NULL) { - - SSDBG( descP, - ("SOCKET", - "recvmsg_check_result -> " - "(msghdr) encode failed: %s\r\n", xres) ); - - recv_update_current_reader(env, descP, sockRef); - - FREE_BIN(dataBufP); FREE_BIN(ctrlBufP); - - return esock_make_error_str(env, xres); - } else { - - SSDBG( descP, - ("SOCKET", - "recvmsg_check_result -> " - "(msghdr) encode ok: %T\r\n", eMsgHdr) ); - - recv_update_current_reader(env, descP, sockRef); + SSDBG( descP, + ("SOCKET", "recvmsg_check_result -> (msghdr) encode ok\r\n") ); - return esock_make_ok2(env, eMsgHdr); - } + recv_update_current_reader(env, descP, sockRef); + res = esock_make_ok2(env, eMsgHdr); } + + return res; } @@ -14656,13 +15107,13 @@ ERL_NIF_TERM recvmsg_check_result(ErlNifEnv* env, */ extern -char* encode_msghdr(ErlNifEnv* env, - SocketDescriptor* descP, - int read, - struct msghdr* msgHdrP, - ErlNifBinary* dataBufP, - ErlNifBinary* ctrlBufP, - ERL_NIF_TERM* eSockAddr) +char* encode_msghdr(ErlNifEnv* env, + ESockDescriptor* descP, + int read, + struct msghdr* msgHdrP, + ErlNifBinary* dataBufP, + ErlNifBinary* ctrlBufP, + ERL_NIF_TERM* eSockAddr) { char* xres; ERL_NIF_TERM addr, iov, ctrl, flags; @@ -14677,7 +15128,7 @@ char* encode_msghdr(ErlNifEnv* env, */ if (msgHdrP->msg_namelen != 0) { if ((xres = esock_encode_sockaddr(env, - (SocketAddress*) msgHdrP->msg_name, + (ESockAddress*) msgHdrP->msg_name, msgHdrP->msg_namelen, &addr)) != NULL) return xres; @@ -14705,10 +15156,9 @@ char* encode_msghdr(ErlNifEnv* env, SSDBG( descP, ("SOCKET", "encode_msghdr -> components encoded:" "\r\n addr: %T" - "\r\n iov: %T" "\r\n ctrl: %T" "\r\n flags: %T" - "\r\n", addr, iov, ctrl, flags) ); + "\r\n", addr, ctrl, flags) ); { ERL_NIF_TERM keys[] = {esock_atom_addr, esock_atom_iov, @@ -14725,9 +15175,7 @@ char* encode_msghdr(ErlNifEnv* env, if (!MKMA(env, keys, vals, numKeys, &tmp)) return ESOCK_STR_EINVAL; - SSDBG( descP, ("SOCKET", "encode_msghdr -> msghdr: " - "\r\n %T" - "\r\n", tmp) ); + SSDBG( descP, ("SOCKET", "encode_msghdr -> msghdr encoded\r\n") ); *eSockAddr = tmp; } @@ -14761,21 +15209,35 @@ char* encode_msghdr(ErlNifEnv* env, */ extern -char* encode_cmsghdrs(ErlNifEnv* env, - SocketDescriptor* descP, - ErlNifBinary* cmsgBinP, - struct msghdr* msgHdrP, - ERL_NIF_TERM* eCMsgHdr) +char* encode_cmsghdrs(ErlNifEnv* env, + ESockDescriptor* descP, + ErlNifBinary* cmsgBinP, + struct msghdr* msgHdrP, + ERL_NIF_TERM* eCMsgHdr) { ERL_NIF_TERM ctrlBuf = MKBIN(env, cmsgBinP); // The *entire* binary SocketTArray cmsghdrs = TARRAY_CREATE(128); struct cmsghdr* firstP = CMSG_FIRSTHDR(msgHdrP); struct cmsghdr* currentP; - SSDBG( descP, ("SOCKET", "encode_cmsghdrs -> entry\r\n") ); + SSDBG( descP, ("SOCKET", "encode_cmsghdrs -> entry when" + "\r\n msg ctrl len: %d" + "\r\n (ctrl) firstP: 0x%lX" + "\r\n", + msgHdrP->msg_controllen, firstP) ); for (currentP = firstP; - currentP != NULL; + /* + * In *old* versions of darwin, the CMSG_FIRSTHDR does not + * check the msg_controllen, so we do it here. + * We should really test this stuff during configure, + * but for now, this will have to do. + */ +#if defined(__DARWIN__) + (msgHdrP->msg_controllen >= sizeof(struct cmsghdr)) && (currentP != NULL); +#else + (currentP != NULL); +#endif currentP = CMSG_NXTHDR(msgHdrP, currentP)) { SSDBG( descP, @@ -14788,9 +15250,23 @@ char* encode_cmsghdrs(ErlNifEnv* env, */ if (((CHARP(currentP) + currentP->cmsg_len) - CHARP(firstP)) > msgHdrP->msg_controllen) { + /* Ouch, fatal error - give up * We assume we cannot trust any data if this is wrong. */ + + SSDBG( descP, + ("SOCKET", "encode_cmsghdrs -> check failed when: " + "\r\n currentP: 0x%lX" + "\r\n (current) cmsg_len: %d" + "\r\n firstP: 0x%lX" + "\r\n => %d" + "\r\n msg ctrl len: %d" + "\r\n", + CHARP(currentP), currentP->cmsg_len, CHARP(firstP), + (CHARP(currentP) + currentP->cmsg_len) - CHARP(firstP), + msgHdrP->msg_controllen) ); + TARRAY_DELETE(cmsghdrs); return ESOCK_STR_EINVAL; } else { @@ -14883,12 +15359,12 @@ char* encode_cmsghdrs(ErlNifEnv* env, */ extern -char* decode_cmsghdrs(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eCMsgHdr, - char* cmsgHdrBufP, - size_t cmsgHdrBufLen, - size_t* cmsgHdrBufUsed) +char* decode_cmsghdrs(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eCMsgHdr, + char* cmsgHdrBufP, + size_t cmsgHdrBufLen, + size_t* cmsgHdrBufUsed) { ERL_NIF_TERM elem, tail, list; char* bufP; @@ -14966,12 +15442,12 @@ char* decode_cmsghdrs(ErlNifEnv* env, * which means that the data is already coded. */ extern -char* decode_cmsghdr(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM eCMsgHdr, - char* bufP, - size_t rem, - size_t* used) +char* decode_cmsghdr(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM eCMsgHdr, + char* bufP, + size_t rem, + size_t* used) { SSDBG( descP, ("SOCKET", "decode_cmsghdr -> entry with" "\r\n eCMsgHdr: %T" @@ -15038,14 +15514,14 @@ char* decode_cmsghdr(ErlNifEnv* env, * an integer and ip_tos() respectively. */ static -char* decode_cmsghdr_data(ErlNifEnv* env, - SocketDescriptor* descP, - char* bufP, - size_t rem, - int level, - int type, - ERL_NIF_TERM eData, - size_t* used) +char* decode_cmsghdr_data(ErlNifEnv* env, + ESockDescriptor* descP, + char* bufP, + size_t rem, + int level, + int type, + ERL_NIF_TERM eData, + size_t* used) { char* xres; @@ -15137,14 +15613,14 @@ char* decode_cmsghdr_data(ErlNifEnv* env, * This does the final create of the cmsghdr (including the data copy). */ static -char* decode_cmsghdr_final(SocketDescriptor* descP, - char* bufP, - size_t rem, - int level, - int type, - char* data, - int sz, - size_t* used) +char* decode_cmsghdr_final(ESockDescriptor* descP, + char* bufP, + size_t rem, + int level, + int type, + char* data, + int sz, + size_t* used) { int len = CMSG_LEN(sz); int space = CMSG_SPACE(sz); @@ -15823,10 +16299,10 @@ char* encode_cmsghdr_data_ipv6(ErlNifEnv* env, */ extern -char* encode_msghdr_flags(ErlNifEnv* env, - SocketDescriptor* descP, - int msgFlags, - ERL_NIF_TERM* flags) +char* encode_msghdr_flags(ErlNifEnv* env, + ESockDescriptor* descP, + int msgFlags, + ERL_NIF_TERM* flags) { SSDBG( descP, ("SOCKET", "encode_cmsghdrs_flags -> entry with" @@ -16281,18 +16757,22 @@ ERL_NIF_TERM encode_ip_tos(ErlNifEnv* env, int val) * */ static -SocketDescriptor* alloc_descriptor(SOCKET sock, HANDLE event) +ESockDescriptor* alloc_descriptor(SOCKET sock, HANDLE event) { - SocketDescriptor* descP; + ESockDescriptor* descP; - if ((descP = enif_alloc_resource(sockets, sizeof(SocketDescriptor))) != NULL) { + if ((descP = enif_alloc_resource(sockets, sizeof(ESockDescriptor))) != NULL) { char buf[64]; /* Buffer used for building the mutex name */ // This needs to be released when the socket is closed! - descP->env = enif_alloc_env(); + // descP->env = enif_alloc_env(); - sprintf(buf, "socket[w,%d]", sock); + sprintf(buf, "esock[w,%d]", sock); descP->writeMtx = MCREATE(buf); + enif_set_pid_undefined(&descP->currentWriter.pid); + MON_INIT(&descP->currentWriter.mon); + descP->currentWriter.env = NULL; + descP->currentWriter.ref = esock_atom_undefined; descP->currentWriterP = NULL; // currentWriter not used descP->writersQ.first = NULL; descP->writersQ.last = NULL; @@ -16303,8 +16783,12 @@ SocketDescriptor* alloc_descriptor(SOCKET sock, HANDLE event) descP->writeWaits = 0; descP->writeFails = 0; - sprintf(buf, "socket[r,%d]", sock); + sprintf(buf, "esock[r,%d]", sock); descP->readMtx = MCREATE(buf); + enif_set_pid_undefined(&descP->currentReader.pid); + MON_INIT(&descP->currentReader.mon); + descP->currentReader.env = NULL; + descP->currentReader.ref = esock_atom_undefined; descP->currentReaderP = NULL; // currentReader not used descP->readersQ.first = NULL; descP->readersQ.last = NULL; @@ -16314,17 +16798,25 @@ SocketDescriptor* alloc_descriptor(SOCKET sock, HANDLE event) descP->readTries = 0; descP->readWaits = 0; - sprintf(buf, "socket[acc,%d]", sock); + sprintf(buf, "esock[acc,%d]", sock); descP->accMtx = MCREATE(buf); + enif_set_pid_undefined(&descP->currentAcceptor.pid); + MON_INIT(&descP->currentAcceptor.mon); + descP->currentAcceptor.env = NULL; + descP->currentAcceptor.ref = esock_atom_undefined; descP->currentAcceptorP = NULL; // currentAcceptor not used descP->acceptorsQ.first = NULL; descP->acceptorsQ.last = NULL; - sprintf(buf, "socket[close,%d]", sock); + sprintf(buf, "esock[close,%d]", sock); descP->closeMtx = MCREATE(buf); descP->closeEnv = NULL; descP->closeRef = esock_atom_undefined; + enif_set_pid_undefined(&descP->closerPid); + MON_INIT(&descP->closerMon); + sprintf(buf, "esock[cfg,%d]", sock); + descP->cfgMtx = MCREATE(buf); descP->rBufSz = SOCKET_RECV_BUFFER_SIZE_DEFAULT; descP->rNum = 0; descP->rNumCnt = 0; @@ -16336,11 +16828,9 @@ SocketDescriptor* alloc_descriptor(SOCKET sock, HANDLE event) descP->sock = sock; descP->event = event; - MON_INIT(&descP->currentWriter.mon); - MON_INIT(&descP->currentReader.mon); - MON_INIT(&descP->currentAcceptor.mon); + enif_set_pid_undefined(&descP->ctrlPid); MON_INIT(&descP->ctrlMon); - MON_INIT(&descP->closerMon); + } return descP; @@ -16851,176 +17341,226 @@ size_t my_strnlen(const char *s, size_t maxlen) #endif -/* Send an error closed message to the specified process: +/* Send an close message to the specified process: + * A message in the form: * - * This message is for processes that are waiting in the - * erlang API functions for a select message. + * {'$socket', Socket, close, CloseRef} + * + * This message is for processes that is waiting in the + * erlang API (close-) function for the socket to be "closed" + * (actually that the 'stop' callback function has been called). */ -/* static -char* send_msg_error_closed(ErlNifEnv* env, - ErlNifPid* pid) +char* esock_send_close_msg(ErlNifEnv* env, + ESockDescriptor* descP, + ErlNifPid* pid) { - return send_msg_error(env, atom_closed, pid); + ERL_NIF_TERM sockRef, msg; + ErlNifEnv* menv; + + if (descP->closeEnv != NULL) { + sockRef = enif_make_resource(descP->closeEnv, descP); + msg = mk_close_msg(descP->closeEnv, sockRef, descP->closeRef); + menv = descP->closeEnv; + } else { + sockRef = enif_make_resource(env, descP); + msg = mk_close_msg(env, sockRef, descP->closeRef); + menv = NULL; // This has the effect that the message will be copied + } + + return esock_send_msg(env, pid, msg, menv); } -*/ -/* Send an error message to the specified process: + +/* Send an abort message to the specified process: * A message in the form: * - * {error, Reason} + * {'$socket', Socket, abort, {RecvRef, Reason}} * - * This message is for processes that are waiting in the + * This message is for processes that is waiting in the * erlang API functions for a select message. */ -/* static -char* send_msg_error(ErlNifEnv* env, - ERL_NIF_TERM reason, - ErlNifPid* pid) +char* esock_send_abort_msg(ErlNifEnv* env, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef, + ErlNifEnv* msgEnv, + ERL_NIF_TERM reason, + ErlNifPid* pid) { - ERL_NIF_TERM msg = enif_make_tuple2(env, atom_error, reason); + ERL_NIF_TERM msg = mk_abort_msg(msgEnv, + /* sockRef not in msgEnv so copy */ + CP_TERM(msgEnv, sockRef), + opRef, reason); - return send_msg(env, msg, pid); + return esock_send_msg(env, pid, msg, msgEnv); } -*/ -/* Send an close message to the specified process: - * A message in the form: +/* Send a message to the specified process. + */ +static +char* esock_send_msg(ErlNifEnv* env, + ErlNifPid* pid, + ERL_NIF_TERM msg, + ErlNifEnv* msgEnv) +{ + int res = enif_send(env, pid, msgEnv, msg); + if (msgEnv) + esock_free_env("esock_msg_send - msg-env", msgEnv); + + if (!res) + return str_exsend; + else + return NULL; +} + + + +/* *** mk_abort_msg *** * - * {'$socket', SockRef, close, CloseRef} + * Create the abort message, which has the following form: * - * This message is for processes that is waiting in the - * erlang API (close-) function for the socket to be "closed" - * (actually that the 'stop' callback function has been called). + * {'$socket', Socket, abort, {OpRef, Reason}} + * + * This message is for processes that are waiting in the + * erlang API functions for a select (or this) message. */ static -char* esock_send_close_msg(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef) +ERL_NIF_TERM mk_abort_msg(ErlNifEnv* env, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM opRef, + ERL_NIF_TERM reason) { - ERL_NIF_TERM sr = ((descP->closeEnv != NULL) ? - enif_make_copy(descP->closeEnv, sockRef) : - sockRef); - char* res = esock_send_socket_msg(env, - sr, - esock_atom_close, - descP->closeRef, - &descP->closerPid, - descP->closeEnv); + ERL_NIF_TERM info = MKT2(env, opRef, reason); + + return mk_socket_msg(env, sockRef, esock_atom_abort, info); +} - descP->closeEnv = NULL; - return res; +/* *** mk_close_msg *** + * + * Construct a close (socket) message. It has the form: + * + * {'$socket', Socket, close, closeRef} + * + */ +static +ERL_NIF_TERM mk_close_msg(ErlNifEnv* env, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM closeRef) +{ + return mk_socket_msg(env, sockRef, esock_atom_close, closeRef); } -/* Send an abort message to the specified process: - * A message in the form: +/* *** mk_select_msg *** * - * {'$socket', SockRef, abort, {RecvRef, Reason}} + * Construct a select (socket) message. It has the form: + * + * {'$socket', Socket, select, selectRef} * - * This message is for processes that is waiting in the - * erlang API functions for a select message. */ static -char* esock_send_abort_msg(ErlNifEnv* env, +ERL_NIF_TERM mk_select_msg(ErlNifEnv* env, ERL_NIF_TERM sockRef, - ERL_NIF_TERM recvRef, - ERL_NIF_TERM reason, - ErlNifPid* pid) + ERL_NIF_TERM selectRef) { - ErlNifEnv* msg_env = enif_alloc_env(); - ERL_NIF_TERM info = MKT2(msg_env, - enif_make_copy(msg_env, recvRef), - enif_make_copy(msg_env, reason)); - - return esock_send_socket_msg(env, sockRef, esock_atom_abort, info, pid, - msg_env); + return mk_socket_msg(env, sockRef, atom_select, selectRef); } -/* *** esock_send_socket_msg *** - * - * This function sends a general purpose socket message to an erlang - * process. A general 'socket' message has the ("erlang") form: +/* *** mk_socket_msg *** * - * {'$socket', SockRef, Tag, Info} + * Construct the socket message: * - * Where + * {'$socket', Socket, Tag, Info} * - * SockRef: reference() - * Tag: atom() - * Info: term() + * Socket :: socket() (#socket{}) + * Tag :: atom() + * Info :: term() * */ - static -char* esock_send_socket_msg(ErlNifEnv* env, - ERL_NIF_TERM sockRef, - ERL_NIF_TERM tag, - ERL_NIF_TERM info, - ErlNifPid* pid, - ErlNifEnv* msg_env) -{ - ERL_NIF_TERM msg; - if (!msg_env) { - msg_env = enif_alloc_env(); - sockRef = enif_make_copy(msg_env, sockRef); - tag = enif_make_copy(msg_env, tag); - info = enif_make_copy(msg_env, info); - } - msg = MKT4(msg_env, esock_atom_socket_tag, sockRef, tag, info); +ERL_NIF_TERM mk_socket_msg(ErlNifEnv* env, + ERL_NIF_TERM sockRef, + ERL_NIF_TERM tag, + ERL_NIF_TERM info) +{ + ERL_NIF_TERM socket = mk_socket(env, sockRef); - return esock_send_msg(env, msg, pid, msg_env); + return MKT4(env, esock_atom_socket_tag, socket, tag, info); } -/* Send a message to the specified process. +/* *** mk_socket *** + * + * Simple utility function that construct the socket resord: + * + * #socket{ref = SockRef} => {socket, SockRef :: reference()} */ static -char* esock_send_msg(ErlNifEnv* env, - ERL_NIF_TERM msg, - ErlNifPid* pid, - ErlNifEnv* msg_env) +ERL_NIF_TERM mk_socket(ErlNifEnv* env, + ERL_NIF_TERM sockRef) { - int res = enif_send(env, pid, msg_env, msg); - if (msg_env) - enif_free_env(msg_env); - - if (!res) - return str_exsend; - else - return NULL; + return MKT2(env, esock_atom_socket, sockRef); } -#endif // #if defined(__WIN32__) +#endif // #if defined(__WIN32__) + /* ---------------------------------------------------------------------- * S e l e c t W r a p p e r F u n c t i o n s * ---------------------------------------------------------------------- */ +/* *** esock_select_read *** + * + * Perform a read select. When the select is triggered, a 'select' + * message (see mk_select_msg) will be sent. + * + * There are two ways to handle the select message: + * 1) Create "your own" environment and create the message using it + * and then pass it on to the select function. + * 2) Or, to create the message using any available environment, + * and then pass a NULL pointer to the select function. + * This will have the effect that the select function will + * create its own environment and then copy the message to it. + * We choose the second alternative. + */ static int esock_select_read(ErlNifEnv* env, - ErlNifEvent event, - void* obj, - const ErlNifPid* pid, - ERL_NIF_TERM ref) + ErlNifEvent event, // The file descriptor + void* obj, // The socket descriptor object + const ErlNifPid* pid, // Destination + ERL_NIF_TERM sockRef, // Socket + ERL_NIF_TERM selectRef) // "ID" of the operation { - return enif_select(env, event, (ERL_NIF_SELECT_READ), obj, pid, ref); + ERL_NIF_TERM selectMsg = mk_select_msg(env, sockRef, selectRef); + + return enif_select_read(env, event, obj, pid, selectMsg, NULL); + } +/* *** esock_select_write *** + * + * Perform a write select. When the select is triggered, a 'select' + * message (see mk_select_msg) will be sent. + * The sockRef is copied to the msgEnv when the socket message is created, + * so no need to do that here, but the selectRef needs to be copied. + */ static int esock_select_write(ErlNifEnv* env, - ErlNifEvent event, - void* obj, - const ErlNifPid* pid, - ERL_NIF_TERM ref) + ErlNifEvent event, // The file descriptor + void* obj, // The socket descriptor + const ErlNifPid* pid, // Destination + ERL_NIF_TERM sockRef, // Socket + ERL_NIF_TERM selectRef) // "ID" of the operation { - return enif_select(env, event, (ERL_NIF_SELECT_WRITE), obj, pid, ref); + ERL_NIF_TERM selectMsg = mk_select_msg(env, sockRef, selectRef); + + return enif_select_write(env, event, obj, pid, selectMsg, NULL); } @@ -17058,6 +17598,8 @@ int esock_select_cancel(ErlNifEnv* env, * Return value indicates if a new requestor was activated or not. */ +#if !defined(__WIN32__) + #define ACTIVATE_NEXT_FUNCS \ ACTIVATE_NEXT_FUNC_DECL(acceptor, read, currentAcceptor, acceptorsQ) \ ACTIVATE_NEXT_FUNC_DECL(writer, write, currentWriter, writersQ) \ @@ -17065,14 +17607,15 @@ int esock_select_cancel(ErlNifEnv* env, #define ACTIVATE_NEXT_FUNC_DECL(F, S, R, Q) \ static \ - BOOLEAN_T activate_next_##F(ErlNifEnv* env, \ - SocketDescriptor* descP, \ - ERL_NIF_TERM sockRef) \ + BOOLEAN_T activate_next_##F(ErlNifEnv* env, \ + ESockDescriptor* descP, \ + ERL_NIF_TERM sockRef) \ { \ - BOOLEAN_T popped, activated; \ - int sres; \ - SocketRequestor* reqP = &descP->R; \ - SocketRequestQueue* q = &descP->Q; \ + BOOLEAN_T popped, activated; \ + int sres; \ + ERL_NIF_TERM reason; \ + ESockRequestor* reqP = &descP->R; \ + ESockRequestQueue* q = &descP->Q; \ \ popped = FALSE; \ do { \ @@ -17088,15 +17631,22 @@ int esock_select_cancel(ErlNifEnv* env, "\r\n ref: %T" \ "\r\n", reqP->pid, reqP->ref) ); \ \ + /* We need to copy req ref to 'env' */ \ if ((sres = esock_select_##S(env, descP->sock, descP, \ - &reqP->pid, reqP->ref)) < 0) { \ + &reqP->pid, sockRef, \ + CP_TERM(env, reqP->ref))) < 0) { \ + \ /* We need to inform this process, reqP->pid, */ \ /* that we failed to select, so we don't leave */ \ /* it hanging. */ \ /* => send abort */ \ \ - esock_send_abort_msg(env, sockRef, reqP->ref, \ - sres, &reqP->pid); \ + reason = MKT2(env, \ + esock_atom_select_failed, \ + MKI(env, sres)); \ + esock_send_abort_msg(env, sockRef, \ + reqP->ref, reqP->env, \ + reason, &reqP->pid); \ \ } else { \ \ @@ -17128,6 +17678,7 @@ ACTIVATE_NEXT_FUNCS #undef ACTIVATE_NEXT_FUNC_DECL +#endif // if !defined(__WIN32__) /* ---------------------------------------------------------------------- @@ -17154,13 +17705,13 @@ ACTIVATE_NEXT_FUNCS REQ_SEARCH4PID_FUNC_DECL(writer, writersQ) \ REQ_SEARCH4PID_FUNC_DECL(reader, readersQ) -#define REQ_SEARCH4PID_FUNC_DECL(F, Q) \ - static \ - BOOLEAN_T F##_search4pid(ErlNifEnv* env, \ - SocketDescriptor* descP, \ - ErlNifPid* pid) \ - { \ - return qsearch4pid(env, &descP->Q, pid); \ +#define REQ_SEARCH4PID_FUNC_DECL(F, Q) \ + static \ + BOOLEAN_T F##_search4pid(ErlNifEnv* env, \ + ESockDescriptor* descP, \ + ErlNifPid* pid) \ + { \ + return qsearch4pid(env, &descP->Q, pid); \ } REQ_SEARCH4PID_FUNCS #undef REQ_SEARCH4PID_FUNC_DECL @@ -17181,28 +17732,28 @@ REQ_SEARCH4PID_FUNCS REQ_PUSH_FUNC_DECL(writer, writersQ) \ REQ_PUSH_FUNC_DECL(reader, readersQ) -#define REQ_PUSH_FUNC_DECL(F, Q) \ - static \ - ERL_NIF_TERM F##_push(ErlNifEnv* env, \ - SocketDescriptor* descP, \ - ErlNifPid pid, \ - ERL_NIF_TERM ref) \ - { \ - SocketRequestQueueElement* e = MALLOC(sizeof(SocketRequestQueueElement)); \ - SocketRequestor* reqP = &e->data; \ - \ - reqP->pid = pid; \ - reqP->ref = enif_make_copy(descP->env, ref); \ - \ - if (MONP("reader_push -> " #F " request", \ - env, descP, &pid, &reqP->mon) != 0) { \ - FREE(reqP); \ - return esock_make_error(env, atom_exmon); \ - } \ - \ - qpush(&descP->Q, e); \ - \ - return esock_make_error(env, esock_atom_eagain); \ +#define REQ_PUSH_FUNC_DECL(F, Q) \ + static \ + ERL_NIF_TERM F##_push(ErlNifEnv* env, \ + ESockDescriptor* descP, \ + ErlNifPid pid, \ + ERL_NIF_TERM ref) \ + { \ + ESockRequestQueueElement* e = MALLOC(sizeof(ESockRequestQueueElement)); \ + ESockRequestor* reqP = &e->data; \ + \ + reqP->pid = pid; \ + if (MONP("reader_push -> " #F " request", \ + env, descP, &pid, &reqP->mon) != 0) { \ + FREE(reqP); \ + return esock_make_error(env, atom_exmon); \ + } \ + reqP->env = esock_alloc_env(#F "_push"); \ + reqP->ref = enif_make_copy(reqP->env, ref); \ + \ + qpush(&descP->Q, e); \ + \ + return esock_make_error(env, esock_atom_eagain); \ } REQ_PUSH_FUNCS #undef REQ_PUSH_FUNC_DECL @@ -17221,13 +17772,13 @@ REQ_PUSH_FUNCS REQ_POP_FUNC_DECL(writer, writersQ) \ REQ_POP_FUNC_DECL(reader, readersQ) -#define REQ_POP_FUNC_DECL(F, Q) \ - static \ - BOOLEAN_T F##_pop(ErlNifEnv* env, \ - SocketDescriptor* descP, \ - SocketRequestor* reqP) \ - { \ - return requestor_pop(&descP->Q, reqP); \ +#define REQ_POP_FUNC_DECL(F, Q) \ + static \ + BOOLEAN_T F##_pop(ErlNifEnv* env, \ + ESockDescriptor* descP, \ + ESockRequestor* reqP) \ + { \ + return requestor_pop(&descP->Q, reqP); \ } REQ_POP_FUNCS #undef REQ_POP_FUNC_DECL @@ -17247,14 +17798,14 @@ REQ_POP_FUNCS REQ_UNQUEUE_FUNC_DECL(writer, writersQ) \ REQ_UNQUEUE_FUNC_DECL(reader, readersQ) -#define REQ_UNQUEUE_FUNC_DECL(F, Q) \ - static \ - BOOLEAN_T F##_unqueue(ErlNifEnv* env, \ - SocketDescriptor* descP, \ - const ErlNifPid* pid) \ - { \ - return qunqueue(env, descP, "qunqueue -> waiting " #F, \ - &descP->Q, pid); \ +#define REQ_UNQUEUE_FUNC_DECL(F, Q) \ + static \ + BOOLEAN_T F##_unqueue(ErlNifEnv* env, \ + ESockDescriptor* descP, \ + const ErlNifPid* pid) \ + { \ + return qunqueue(env, descP, "qunqueue -> waiting " #F, \ + &descP->Q, pid); \ } REQ_UNQUEUE_FUNCS #undef REQ_UNQUEUE_FUNC_DECL @@ -17266,21 +17817,23 @@ REQ_UNQUEUE_FUNCS * Pop an requestor from its queue. */ static -BOOLEAN_T requestor_pop(SocketRequestQueue* q, - SocketRequestor* reqP) +BOOLEAN_T requestor_pop(ESockRequestQueue* q, + ESockRequestor* reqP) { - SocketRequestQueueElement* e = qpop(q); + ESockRequestQueueElement* e = qpop(q); if (e != NULL) { reqP->pid = e->data.pid; reqP->mon = e->data.mon; + reqP->env = e->data.env; reqP->ref = e->data.ref; FREE(e); return TRUE; } else { - /* (writers) Queue was empty */ + /* Queue was empty */ enif_set_pid_undefined(&reqP->pid); - // *reqP->mon = NULL; we have no null value for monitors + MON_INIT(&reqP->mon); + reqP->env = NULL; reqP->ref = esock_atom_undefined; // Just in case return FALSE; } @@ -17289,11 +17842,11 @@ BOOLEAN_T requestor_pop(SocketRequestQueue* q, static -BOOLEAN_T qsearch4pid(ErlNifEnv* env, - SocketRequestQueue* q, - ErlNifPid* pid) +BOOLEAN_T qsearch4pid(ErlNifEnv* env, + ESockRequestQueue* q, + ErlNifPid* pid) { - SocketRequestQueueElement* tmp = q->first; + ESockRequestQueueElement* tmp = q->first; while (tmp != NULL) { if (COMPARE_PIDS(&tmp->data.pid, pid) == 0) @@ -17307,8 +17860,8 @@ BOOLEAN_T qsearch4pid(ErlNifEnv* env, static -void qpush(SocketRequestQueue* q, - SocketRequestQueueElement* e) +void qpush(ESockRequestQueue* q, + ESockRequestQueueElement* e) { if (q->first != NULL) { q->last->nextP = e; @@ -17323,9 +17876,9 @@ void qpush(SocketRequestQueue* q, static -SocketRequestQueueElement* qpop(SocketRequestQueue* q) +ESockRequestQueueElement* qpop(ESockRequestQueue* q) { - SocketRequestQueueElement* e = q->first; + ESockRequestQueueElement* e = q->first; if (e != NULL) { /* Atleast one element in the queue */ @@ -17344,14 +17897,14 @@ SocketRequestQueueElement* qpop(SocketRequestQueue* q) static -BOOLEAN_T qunqueue(ErlNifEnv* env, - SocketDescriptor* descP, - const char* slogan, - SocketRequestQueue* q, - const ErlNifPid* pid) +BOOLEAN_T qunqueue(ErlNifEnv* env, + ESockDescriptor* descP, + const char* slogan, + ESockRequestQueue* q, + const ErlNifPid* pid) { - SocketRequestQueueElement* e = q->first; - SocketRequestQueueElement* p = NULL; + ESockRequestQueueElement* e = q->first; + ESockRequestQueueElement* p = NULL; /* Check if it was one of the waiting acceptor processes */ while (e != NULL) { @@ -17446,11 +17999,11 @@ void cnt_dec(Uint32* cnt, Uint32 dec) #if !defined(__WIN32__) static -int esock_monitor(const char* slogan, - ErlNifEnv* env, - SocketDescriptor* descP, - const ErlNifPid* pid, - ESockMonitor* monP) +int esock_monitor(const char* slogan, + ErlNifEnv* env, + ESockDescriptor* descP, + const ErlNifPid* pid, + ESockMonitor* monP) { int res; @@ -17458,10 +18011,10 @@ int esock_monitor(const char* slogan, res = enif_monitor_process(env, descP, pid, &monP->mon); if (res != 0) { - monP->is_active = 0; + monP->isActive = FALSE; SSDBG( descP, ("SOCKET", "[%d] monitor failed: %d\r\n", descP->sock, res) ); } else { - monP->is_active = 1; + monP->isActive = TRUE; } return res; @@ -17469,14 +18022,14 @@ int esock_monitor(const char* slogan, static -int esock_demonitor(const char* slogan, - ErlNifEnv* env, - SocketDescriptor* descP, - ESockMonitor* monP) +int esock_demonitor(const char* slogan, + ErlNifEnv* env, + ESockDescriptor* descP, + ESockMonitor* monP) { int res; - if (!monP->is_active) + if (!monP->isActive) return 1; SSDBG( descP, ("SOCKET", "[%d] %s: try demonitor\r\n", descP->sock, slogan) ); @@ -17497,20 +18050,23 @@ int esock_demonitor(const char* slogan, static void esock_monitor_init(ESockMonitor* monP) { - monP->is_active = 0; + monP->isActive = FALSE; } -#endif // if !defined(__WIN32__) - -/* static -int esock_monitor_compare(const ErlNifMonitor* mon1, - const ESockMonitor* mon2) +ERL_NIF_TERM esock_make_monitor_term(ErlNifEnv* env, const ESockMonitor* monP) { - return enif_compare_monitors(mon1, &mon2->mon); + if (monP->isActive) + return enif_make_monitor_term(env, &monP->mon); + else + return esock_atom_undefined; } -*/ + + + +#endif // if !defined(__WIN32__) + /* ---------------------------------------------------------------------- @@ -17526,16 +18082,13 @@ static void socket_dtor(ErlNifEnv* env, void* obj) { #if !defined(__WIN32__) - SocketDescriptor* descP = (SocketDescriptor*) obj; - - enif_clear_env(descP->env); - enif_free_env(descP->env); - descP->env = NULL; + ESockDescriptor* descP = (ESockDescriptor*) obj; MDESTROY(descP->writeMtx); MDESTROY(descP->readMtx); MDESTROY(descP->accMtx); MDESTROY(descP->closeMtx); + MDESTROY(descP->cfgMtx); #endif } @@ -17559,8 +18112,8 @@ static void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call) { #if !defined(__WIN32__) - SocketDescriptor* descP = (SocketDescriptor*) obj; - ERL_NIF_TERM sockRef; + ESockDescriptor* descP = (ESockDescriptor*) obj; + ERL_NIF_TERM sockRef; SSDBG( descP, ("SOCKET", "socket_stop -> entry when %s" @@ -17573,6 +18126,7 @@ void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call) MLOCK(descP->writeMtx); MLOCK(descP->readMtx); MLOCK(descP->accMtx); + MLOCK(descP->cfgMtx); if (!is_direct_call) MLOCK(descP->closeMtx); SSDBG( descP, ("SOCKET", "socket_stop -> " @@ -17622,37 +18176,19 @@ void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call) */ if (descP->currentWriterP != NULL) { + /* We have a (current) writer and *may* therefor also have * writers waiting. */ - DEMONP("socket_stop -> current writer", - env, descP, &descP->currentWriter.mon); + socket_stop_handle_current(env, + "writer", + descP, sockRef, &descP->currentWriter); - SSDBG( descP, ("SOCKET", "socket_stop -> handle current writer\r\n") ); - if (COMPARE_PIDS(&descP->closerPid, &descP->currentWriter.pid) != 0) { - SSDBG( descP, ("SOCKET", "socket_stop -> " - "send abort message to current writer %T\r\n", - descP->currentWriter.pid) ); - if (esock_send_abort_msg(env, - sockRef, - descP->currentWriter.ref, - atom_closed, - &descP->currentWriter.pid) != NULL) { - /* Shall we really do this? - * This happens if the controlling process has been killed! - */ - esock_warning_msg("Failed sending abort (%T) message to " - "current writer %T\r\n", - descP->currentWriter.ref, - descP->currentWriter.pid); - } - } - /* And also deal with the waiting writers (in the same way) */ SSDBG( descP, ("SOCKET", "socket_stop -> handle waiting writer(s)\r\n") ); inform_waiting_procs(env, "writer", - descP, &descP->writersQ, TRUE, atom_closed); + descP, sockRef, &descP->writersQ, TRUE, atom_closed); } @@ -17669,38 +18205,14 @@ void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call) * readers waiting. */ - DEMONP("socket_stop -> current reader", - env, descP, &descP->currentReader.mon); + socket_stop_handle_current(env, + "reader", + descP, sockRef, &descP->currentReader); - SSDBG( descP, ("SOCKET", "socket_stop -> handle current reader\r\n") ); - if (COMPARE_PIDS(&descP->closerPid, &descP->currentReader.pid) != 0) { - SSDBG( descP, ("SOCKET", "socket_stop -> " - "send abort message to current reader %T\r\n", - descP->currentReader.pid) ); - /* - esock_dbg_printf("SOCKET", "socket_stop -> " - "send abort message to current reader %T\r\n", - descP->currentReader.pid); - */ - if (esock_send_abort_msg(env, - sockRef, - descP->currentReader.ref, - atom_closed, - &descP->currentReader.pid) != NULL) { - /* Shall we really do this? - * This happens if the controlling process has been killed! - */ - esock_warning_msg("Failed sending abort (%T) message to " - "current reader %T\r\n", - descP->currentReader.ref, - descP->currentReader.pid); - } - } - /* And also deal with the waiting readers (in the same way) */ SSDBG( descP, ("SOCKET", "socket_stop -> handle waiting reader(s)\r\n") ); inform_waiting_procs(env, "reader", - descP, &descP->readersQ, TRUE, atom_closed); + descP, sockRef, &descP->readersQ, TRUE, atom_closed); } @@ -17713,37 +18225,19 @@ void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call) */ if (descP->currentAcceptorP != NULL) { + /* We have a (current) acceptor and *may* therefor also have * acceptors waiting. */ - - DEMONP("socket_stop -> current acceptor", - env, descP, &descP->currentAcceptor.mon); - - SSDBG( descP, ("SOCKET", "socket_stop -> handle current acceptor\r\n") ); - if (COMPARE_PIDS(&descP->closerPid, &descP->currentAcceptor.pid) != 0) { - SSDBG( descP, ("SOCKET", "socket_stop -> " - "send abort message to current acceptor %T\r\n", - descP->currentAcceptor.pid) ); - if (esock_send_abort_msg(env, - sockRef, - descP->currentAcceptor.ref, - atom_closed, - &descP->currentAcceptor.pid) != NULL) { - /* Shall we really do this? - * This happens if the controlling process has been killed! - */ - esock_warning_msg("Failed sending abort (%T) message to " - "current acceptor %T\r\n", - descP->currentAcceptor.ref, - descP->currentAcceptor.pid); - } - } - + + socket_stop_handle_current(env, + "acceptor", + descP, sockRef, &descP->currentAcceptor); + /* And also deal with the waiting acceptors (in the same way) */ SSDBG( descP, ("SOCKET", "socket_stop -> handle waiting acceptor(s)\r\n") ); inform_waiting_procs(env, "acceptor", - descP, &descP->acceptorsQ, TRUE, atom_closed); + descP, sockRef, &descP->acceptorsQ, TRUE, atom_closed); } @@ -17756,15 +18250,15 @@ void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call) */ if (descP->sock != INVALID_SOCKET) { - + if (descP->closeLocal) { if (!is_direct_call) { /* +++ send close message to the waiting process +++ */ - esock_send_close_msg(env, descP, sockRef); - + esock_send_close_msg(env, descP, &descP->closerPid); + DEMONP("socket_stop -> closer", env, descP, &descP->closerMon); } else { @@ -17773,11 +18267,8 @@ void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call) * since the message send takes care of it if scheduled. */ - if (descP->closeEnv != NULL) { - enif_clear_env(descP->closeEnv); - enif_free_env(descP->closeEnv); - descP->closeEnv = NULL; - } + if (descP->closeEnv != NULL) + esock_free_env("socket_stop - close-env", descP->closeEnv); } } @@ -17787,6 +18278,7 @@ void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call) SSDBG( descP, ("SOCKET", "socket_stop -> unlock all mutex(s)\r\n") ); if (!is_direct_call) MUNLOCK(descP->closeMtx); + MUNLOCK(descP->cfgMtx); MUNLOCK(descP->accMtx); MUNLOCK(descP->readMtx); MUNLOCK(descP->writeMtx); @@ -17799,29 +18291,60 @@ void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call) +/* *** socket_stop_handle_current *** + * + * Handle current requestor (reader, writer or acceptor) during + * socket stop. + */ +#if !defined(__WIN32__) +static +void socket_stop_handle_current(ErlNifEnv* env, + const char* role, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ESockRequestor* reqP) +{ + SSDBG( descP, ("SOCKET", "socket_stop -> handle current %s\r\n", role) ); + + DEMONP("socket_stop_handle_current", env, descP, &reqP->mon); + + if (COMPARE_PIDS(&descP->closerPid, &reqP->pid) != 0) { + + SSDBG( descP, ("SOCKET", "socket_stop_handle_current -> " + "send abort message to current %s %T\r\n", + role, reqP->pid) ); + + if (esock_send_abort_msg(env, sockRef, reqP->ref, reqP->env, + atom_closed, &reqP->pid) != NULL) { + + esock_warning_msg("Failed sending abort (%T) message to " + "current %s %T\r\n", + reqP->ref, role, reqP->pid); + } + } +} + + + /* This function traverse the queue and sends the specified * nif_abort message with the specified reason to each member, * and if the 'free' argument is TRUE, the queue will be emptied. */ -#if !defined(__WIN32__) -static void inform_waiting_procs(ErlNifEnv* env, - char* role, - SocketDescriptor* descP, - SocketRequestQueue* q, - BOOLEAN_T free, - ERL_NIF_TERM reason) +static +void inform_waiting_procs(ErlNifEnv* env, + const char* role, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + ESockRequestQueue* q, + BOOLEAN_T free, + ERL_NIF_TERM reason) { - SocketRequestQueueElement* currentP = q->first; - SocketRequestQueueElement* nextP; - ERL_NIF_TERM sockRef = enif_make_resource(env, descP); + ESockRequestQueueElement* currentP = q->first; + ESockRequestQueueElement* nextP; - /* - esock_dbg_printf("SOCKET", "inform_waiting_procs -> entry with: " - "\r\n role: %s" - "\r\n free: %s" - "\r\n reason: %T" - "\r\n", role, B2S(free), reason); - */ + SSDBG( descP, + ("SOCKET", + "inform_waiting_procs -> handle waiting %s(s)\r\n", role) ); while (currentP != NULL) { @@ -17835,18 +18358,14 @@ static void inform_waiting_procs(ErlNifEnv* env, */ SSDBG( descP, - ("SOCKET", "inform_waiting_procs -> abort request %T (from %T)\r\n", + ("SOCKET", + "inform_waiting_procs -> abort request %T (from %T)\r\n", currentP->data.ref, currentP->data.pid) ); - /* - esock_dbg_printf("SOCKET", "inform_waiting_procs -> " - "try sending abort to %s %T " - "\r\n", role, currentP->data.pid); - */ - if (esock_send_abort_msg(env, sockRef, currentP->data.ref, + currentP->data.env, reason, ¤tP->data.pid) != NULL) { @@ -17884,9 +18403,9 @@ void socket_down(ErlNifEnv* env, const ErlNifMonitor* mon) { #if !defined(__WIN32__) - SocketDescriptor* descP = (SocketDescriptor*) obj; - int sres; - ERL_NIF_TERM sockRef; + ESockDescriptor* descP = (ESockDescriptor*) obj; + int sres; + ERL_NIF_TERM sockRef; SSDBG( descP, ("SOCKET", "socket_down -> entry with" "\r\n sock: %d" @@ -17912,7 +18431,7 @@ void socket_down(ErlNifEnv* env, descP->closeLocal = TRUE; descP->closerPid = *pid; MON_INIT(&descP->closerMon); - + sres = esock_select_stop(env, descP->sock, descP); if (sres & ERL_NIF_SELECT_STOP_CALLED) { @@ -18035,10 +18554,10 @@ void socket_down(ErlNifEnv* env, */ #if !defined(__WIN32__) static -void socket_down_acceptor(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - const ErlNifPid* pid) +void socket_down_acceptor(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + const ErlNifPid* pid) { if (COMPARE_PIDS(&descP->currentAcceptor.pid, pid) == 0) { @@ -18080,10 +18599,10 @@ void socket_down_acceptor(ErlNifEnv* env, * */ static -void socket_down_writer(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - const ErlNifPid* pid) +void socket_down_writer(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + const ErlNifPid* pid) { if (COMPARE_PIDS(&descP->currentWriter.pid, pid) == 0) { @@ -18121,10 +18640,10 @@ void socket_down_writer(ErlNifEnv* env, * */ static -void socket_down_reader(ErlNifEnv* env, - SocketDescriptor* descP, - ERL_NIF_TERM sockRef, - const ErlNifPid* pid) +void socket_down_reader(ErlNifEnv* env, + ESockDescriptor* descP, + ERL_NIF_TERM sockRef, + const ErlNifPid* pid) { if (COMPARE_PIDS(&descP->currentReader.pid, pid) == 0) { diff --git a/erts/emulator/nifs/common/socket_util.c b/erts/emulator/nifs/common/socket_util.c index 5e18355308..8ad95cb6b7 100644 --- a/erts/emulator/nifs/common/socket_util.c +++ b/erts/emulator/nifs/common/socket_util.c @@ -213,10 +213,10 @@ char* esock_decode_iov(ErlNifEnv* env, */ extern -char* esock_decode_sockaddr(ErlNifEnv* env, - ERL_NIF_TERM eSockAddr, - SocketAddress* sockAddrP, - unsigned int* addrLen) +char* esock_decode_sockaddr(ErlNifEnv* env, + ERL_NIF_TERM eSockAddr, + ESockAddress* sockAddrP, + unsigned int* addrLen) { ERL_NIF_TERM efam; int fam; @@ -279,10 +279,10 @@ char* esock_decode_sockaddr(ErlNifEnv* env, */ extern -char* esock_encode_sockaddr(ErlNifEnv* env, - SocketAddress* sockAddrP, - unsigned int addrLen, - ERL_NIF_TERM* eSockAddr) +char* esock_encode_sockaddr(ErlNifEnv* env, + ESockAddress* sockAddrP, + unsigned int addrLen, + ERL_NIF_TERM* eSockAddr) { char* xres; diff --git a/erts/emulator/nifs/common/socket_util.h b/erts/emulator/nifs/common/socket_util.h index 1b5d003155..84b1c8085f 100644 --- a/erts/emulator/nifs/common/socket_util.h +++ b/erts/emulator/nifs/common/socket_util.h @@ -57,15 +57,15 @@ char* esock_decode_iov(ErlNifEnv* env, size_t len, ssize_t* totSize); extern -char* esock_decode_sockaddr(ErlNifEnv* env, - ERL_NIF_TERM eSockAddr, - SocketAddress* sockAddrP, - unsigned int* addrLen); -extern -char* esock_encode_sockaddr(ErlNifEnv* env, - SocketAddress* sockAddrP, - unsigned int addrLen, - ERL_NIF_TERM* eSockAddr); +char* esock_decode_sockaddr(ErlNifEnv* env, + ERL_NIF_TERM eSockAddr, + ESockAddress* sockAddrP, + unsigned int* addrLen); +extern +char* esock_encode_sockaddr(ErlNifEnv* env, + ESockAddress* sockAddrP, + unsigned int addrLen, + ERL_NIF_TERM* eSockAddr); extern char* esock_decode_sockaddr_in4(ErlNifEnv* env, diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index 80e8030d74..fb18c837ab 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -534,6 +534,7 @@ erts_io_notify_port_task_executed(ErtsPortTaskType type, if (state->active_events & ERTS_POLL_EV_OUT) oready(state->driver.select->outport, state); state->active_events = 0; + active_events = 0; } } @@ -842,6 +843,8 @@ driver_select(ErlDrvPort ix, ErlDrvEvent e, int mode, int on) ret = 0; goto done_unknown; } + /* For some reason (don't know why), we do not clean all + events when doing ERL_DRV_USE_NO_CALLBACK. */ else if ((mode&ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { mode |= (ERL_DRV_READ | ERL_DRV_WRITE); } @@ -2491,6 +2494,10 @@ drvmode2str(int mode) { case ERL_DRV_WRITE|ERL_DRV_USE: return "WRITE|USE"; case ERL_DRV_READ|ERL_DRV_WRITE|ERL_DRV_USE: return "READ|WRITE|USE"; case ERL_DRV_USE: return "USE"; + case ERL_DRV_READ|ERL_DRV_USE_NO_CALLBACK: return "READ|USE_NO_CB"; + case ERL_DRV_WRITE|ERL_DRV_USE_NO_CALLBACK: return "WRITE|USE_NO_CB"; + case ERL_DRV_READ|ERL_DRV_WRITE|ERL_DRV_USE_NO_CALLBACK: return "READ|WRITE|USE_NO_CB"; + case ERL_DRV_USE_NO_CALLBACK: return "USE_NO_CB"; case ERL_DRV_READ: return "READ"; case ERL_DRV_WRITE: return "WRITE"; case ERL_DRV_READ|ERL_DRV_WRITE: return "READ|WRITE"; diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index 9662996039..1b125056f5 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -924,7 +924,7 @@ update_pollset(ErtsPollSet *ps, int fd, ErtsPollOp op, ErtsPollEvents events) ERTS_EV_SET(&evts[len++], fd, EVFILT_WRITE, flags, (void *) ERTS_POLL_EV_OUT); } #else - uint32_t flags = EV_ADD; + uint32_t flags = EV_ADD|EV_ENABLE; if (ps->oneshot) flags |= EV_ONESHOT; @@ -932,9 +932,27 @@ update_pollset(ErtsPollSet *ps, int fd, ErtsPollOp op, ErtsPollEvents events) erts_atomic_dec_nob(&ps->no_of_user_fds); /* We don't do anything when a delete is issued. The fds will be removed when they are triggered, or when they are closed. */ - events = 0; + if (ps->oneshot) + events = 0; + else { + flags = EV_DELETE; + events = ERTS_POLL_EV_IN; + } } else if (op == ERTS_POLL_OP_ADD) { erts_atomic_inc_nob(&ps->no_of_user_fds); + /* Only allow EV_IN in non-oneshot poll-sets */ + ASSERT(ps->oneshot || events == ERTS_POLL_EV_IN); + } else if (!ps->oneshot) { + ASSERT(op == ERTS_POLL_OP_MOD); + /* If we are not oneshot and do a mod we should disable the FD. + We assume that it is only the read side that is active as + currently only read is selected upon in the non-oneshot + poll-sets. */ + if (!events) + flags = EV_DISABLE; + else + flags = EV_ENABLE; + events = ERTS_POLL_EV_IN; } if (events & ERTS_POLL_EV_IN) { @@ -961,16 +979,15 @@ update_pollset(ErtsPollSet *ps, int fd, ErtsPollOp op, ErtsPollEvents events) for (i = 0; i < len; i++) { const char *flags = "UNKNOWN"; if (evts[i].flags == (EV_DELETE)) flags = "EV_DELETE"; - if (evts[i].flags == (EV_ADD|EV_ONESHOT)) flags = "EV_ADD|EV_ONESHOT"; if (evts[i].flags == (EV_ADD)) flags = "EV_ADD"; + if (evts[i].flags == (EV_ADD|EV_ONESHOT)) flags = "EV_ADD|EV_ONESHOT"; + if (evts[i].flags == (EV_ENABLE)) flags = "EV_ENABLE"; + if (evts[i].flags == (EV_DISABLE)) flags = "EV_DISABLE"; + if (evts[i].flags == (EV_ADD|EV_DISABLE)) flags = "EV_ADD|EV_DISABLE"; #ifdef EV_DISPATCH if (evts[i].flags == (EV_ADD|EV_DISPATCH)) flags = "EV_ADD|EV_DISPATCH"; - if (evts[i].flags == (EV_ADD|EV_DISABLE)) flags = "EV_ADD|EV_DISABLE"; if (evts[i].flags == (EV_ENABLE|EV_DISPATCH)) flags = "EV_ENABLE|EV_DISPATCH"; - if (evts[i].flags == (EV_ENABLE)) flags = "EV_ENABLE"; - if (evts[i].flags == (EV_DISABLE)) flags = "EV_DISABLE"; if (evts[i].flags == (EV_DISABLE|EV_DISPATCH)) flags = "EV_DISABLE|EV_DISABLE"; - if (evts[i].flags == (EV_DISABLE)) flags = "EV_DISABLE"; #endif keventbp += sprintf(keventbp, "%s{%lu, %s, %s}",i > 0 ? ", " : "", diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c index 042a091db1..664d677ebd 100644 --- a/erts/emulator/sys/unix/sys_drivers.c +++ b/erts/emulator/sys/unix/sys_drivers.c @@ -1006,10 +1006,8 @@ static void clear_fd_data(ErtsSysFdData *fdd) static void nbio_stop_fd(ErlDrvPort prt, ErtsSysFdData *fdd, int use) { - driver_select(prt, abs(fdd->fd), use ? ERL_DRV_USE_NO_CALLBACK : 0|DO_READ|DO_WRITE, 0); clear_fd_data(fdd); SET_BLOCKING(abs(fdd->fd)); - } static void fd_stop(ErlDrvData ev) /* Does not close the fds */ @@ -1026,10 +1024,12 @@ static void fd_stop(ErlDrvData ev) /* Does not close the fds */ if (dd->ifd) { sz += sizeof(ErtsSysFdData); + driver_select(prt, abs(dd->ifd->fd), ERL_DRV_USE_NO_CALLBACK|DO_READ|DO_WRITE, 0); nbio_stop_fd(prt, dd->ifd, 1); } if (dd->ofd && dd->ofd != dd->ifd) { sz += sizeof(ErtsSysFdData); + driver_select(prt, abs(dd->ofd->fd), ERL_DRV_USE_NO_CALLBACK|DO_WRITE, 0); nbio_stop_fd(prt, dd->ofd, 1); } diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 8c2054cb51..019af2162f 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -124,6 +124,7 @@ MODULES= \ send_term_SUITE \ sensitive_SUITE \ signal_SUITE \ + small_SUITE \ smoke_test_SUITE \ $(SOCKET_MODULES) \ statistics_SUITE \ @@ -206,14 +207,10 @@ ERL_COMPILE_FLAGS += # ---------------------------------------------------- make_emakefile: $(NO_OPT_ERL_FILES) $(NATIVE_ERL_FILES) - # This special rule can be removed when communication with R7B nodes - # is no longer supported. - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) +compressed -o$(EBIN) \ - '*_SUITE_make' > $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) +compressed -o$(EBIN) \ $(MODULES) >> $(EMAKEFILE) - $(ERL_TOP)/make/make_emakefile +no_copt +no_postopt $(ERL_COMPILE_FLAGS) \ - -o$(EBIN) $(NO_OPT_MODULES) >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile +no_copt +no_postopt +no_ssa_opt +no_bsm_opt \ + $(ERL_COMPILE_FLAGS) -o$(EBIN) $(NO_OPT_MODULES) >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +native $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(NATIVE_MODULES) >> $(EMAKEFILE) diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 563d60cc3f..4fb339926e 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -71,7 +71,8 @@ term2bin_tuple_fallbacks/1, robustness/1,otp_8117/1, otp_8180/1, trapping/1, large/1, - error_after_yield/1, cmp_old_impl/1]). + error_after_yield/1, cmp_old_impl/1, + t2b_system_limit/1]). %% Internal exports. -export([sleeper/0,trapping_loop/4]). @@ -79,7 +80,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,4}}]. -all() -> +all() -> [copy_terms, conversions, deep_lists, deep_bitstr_lists, t_split_binary, bad_split, bad_list_to_binary, bad_binary_to_list, terms, @@ -90,7 +91,8 @@ all() -> b2t_used_big, bad_binary_to_term_2, safe_binary_to_term2, bad_binary_to_term, bad_terms, t_hash, bad_size, - bad_term_to_binary, more_bad_terms, otp_5484, otp_5933, + bad_term_to_binary, t2b_system_limit, more_bad_terms, + otp_5484, otp_5933, ordering, unaligned_order, gc_test, bit_sized_binary_sizes, otp_6817, otp_8117, deep, term2bin_tuple_fallbacks, @@ -462,6 +464,54 @@ bad_term_to_binary(Config) when is_list(Config) -> ok. +t2b_system_limit(Config) when is_list(Config) -> + case erlang:system_info(wordsize) of + 8 -> + case proplists:get_value(system_total_memory, + memsup:get_system_memory_data()) of + Memory when is_integer(Memory), + Memory > 6*1024*1024*1024 -> + test_t2b_system_limit(), + garbage_collect(), + ok; + _ -> + {skipped, "Not enough memory on this machine"} + end; + 4 -> + {skipped, "Only interesting on 64-bit builds"} + end. + +test_t2b_system_limit() -> + io:format("Creating HugeBin~n", []), + Bits = ((1 bsl 32)+1)*8, + HugeBin = <<0:Bits>>, + + io:format("Testing term_to_binary(HugeBin)~n", []), + {'EXIT',{system_limit,[{erlang,term_to_binary, + [HugeBin], + _} |_]}} = (catch term_to_binary(HugeBin)), + + io:format("Testing term_to_binary(HugeBin, [compressed])~n", []), + {'EXIT',{system_limit,[{erlang,term_to_binary, + [HugeBin, [compressed]], + _} |_]}} = (catch term_to_binary(HugeBin, [compressed])), + + %% Check that it works also after we have trapped... + io:format("Creating HugeListBin~n", []), + HugeListBin = [lists:duplicate(2000000,2000000), HugeBin], + + io:format("Testing term_to_binary(HugeListBin)~n", []), + {'EXIT',{system_limit,[{erlang,term_to_binary, + [HugeListBin], + _} |_]}} = (catch term_to_binary(HugeListBin)), + + io:format("Testing term_to_binary(HugeListBin, [compressed])~n", []), + {'EXIT',{system_limit,[{erlang,term_to_binary, + [HugeListBin, [compressed]], + _} |_]}} = (catch term_to_binary(HugeListBin, [compressed])), + + ok. + %% Tests binary_to_term/1 and term_to_binary/1. terms(Config) when is_list(Config) -> diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl index ad05cb3689..8fab4f5bc4 100644 --- a/erts/emulator/test/bs_construct_SUITE.erl +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -16,8 +16,6 @@ %% limitations under the License. %% %% %CopyrightEnd% -%% -%% Purpose : Common utilities used by several optimization passes. %% -module(bs_construct_SUITE). @@ -27,9 +25,9 @@ test1/1, test2/1, test3/1, test4/1, test5/1, testf/1, not_used/1, in_guard/1, mem_leak/1, coerce_to_float/1, bjorn/1, append_empty_is_same/1, - huge_float_field/1, huge_binary/1, system_limit/1, badarg/1, + huge_float_field/1, system_limit/1, badarg/1, copy_writable_binary/1, kostis/1, dynamic/1, bs_add/1, - otp_7422/1, zero_width/1, bad_append/1, bs_add_overflow/1]). + otp_7422/1, zero_width/1, bad_append/1, bs_append_overflow/1]). -include_lib("common_test/include/ct.hrl"). @@ -40,9 +38,9 @@ suite() -> all() -> [test1, test2, test3, test4, test5, testf, not_used, in_guard, mem_leak, coerce_to_float, bjorn, append_empty_is_same, - huge_float_field, huge_binary, system_limit, badarg, + huge_float_field, system_limit, badarg, copy_writable_binary, kostis, dynamic, bs_add, otp_7422, zero_width, - bad_append, bs_add_overflow]. + bad_append, bs_append_overflow]. init_per_suite(Config) -> Config. @@ -543,56 +541,6 @@ huge_float_field(Config) when is_list(Config) -> huge_float_check({'EXIT',{system_limit,_}}) -> ok; huge_float_check({'EXIT',{badarg,_}}) -> ok. -huge_binary(Config) when is_list(Config) -> - ct:timetrap({seconds, 60}), - 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), - garbage_collect(), - FreeMem = free_mem(), - io:format("Free memory (Mb): ~p\n", [FreeMem]), - {Shift,Return} = case free_mem() of - undefined -> - %% This test has to be inlined inside the case to - %% use a literal Shift - garbage_collect(), - id(<<0:((1 bsl 32)-1)>>), - {32,ok}; - Mb when Mb > 600 -> - garbage_collect(), - id(<<0:((1 bsl 32)-1)>>), - {32,ok}; - Mb when Mb > 300 -> - garbage_collect(), - id(<<0:((1 bsl 31)-1)>>), - {31,"Limit huge binaries to 256 Mb"}; - Mb when Mb > 200 -> - garbage_collect(), - id(<<0:((1 bsl 30)-1)>>), - {30,"Limit huge binary to 128 Mb"}; - _ -> - garbage_collect(), - id(<<0:((1 bsl 29)-1)>>), - {29,"Limit huge binary to 64 Mb"} - end, - garbage_collect(), - id(<<0:((1 bsl Shift)-1)>>), - garbage_collect(), - id(<<0:(id((1 bsl Shift)-1))>>), - garbage_collect(), - case Return of - ok -> ok; - Comment -> {comment, Comment} - end. - -%% Return the amount of free memory in Mb. -free_mem() -> - {ok,Apps} = application:ensure_all_started(os_mon), - Mem = memsup:get_system_memory_data(), - [ok = application:stop(App)||App <- Apps], - case proplists:get_value(free_memory,Mem) of - undefined -> undefined; - Val -> Val div (1024*1024) - end. - system_limit(Config) when is_list(Config) -> WordSize = erlang:system_info(wordsize), BitsPerWord = WordSize * 8, @@ -904,33 +852,37 @@ append_unit_8(Bin) -> append_unit_16(Bin) -> <<Bin/binary-unit:16,0:1>>. -%% Produce a large result of bs_add that, if cast to signed int, would overflow -%% into a negative number that fits a smallnum. -bs_add_overflow(_Config) -> +%% Test that the bs_append instruction will correctly check for +%% overflow by producing a binary whose total size would exceed the +%% maximum allowed size for a binary on a 32-bit computer. + +bs_append_overflow(_Config) -> Memsize = memsize(), io:format("Memsize = ~w Bytes~n", [Memsize]), case erlang:system_info(wordsize) of 8 -> + %% Not possible to test on a 64-bit computer. {skip, "64-bit architecture"}; _ when Memsize < (2 bsl 30) -> - {skip, "Less then 2 GB of memory"}; + {skip, "Less than 2 GB of memory"}; 4 -> - {'EXIT', {system_limit, _}} = (catch bs_add_overflow_signed()), - {'EXIT', {system_limit, _}} = (catch bs_add_overflow_unsigned()), + {'EXIT', {system_limit, _}} = (catch bs_append_overflow_signed()), + erlang:garbage_collect(), + {'EXIT', {system_limit, _}} = (catch bs_append_overflow_unsigned()), + erlang:garbage_collect(), ok end. -bs_add_overflow_signed() -> - %% Produce a large result of bs_add that, if cast to signed int, would +bs_append_overflow_signed() -> + %% Produce a large binary that, if cast to signed int, would %% overflow into a negative number that fits a smallnum. Large = <<0:((1 bsl 30)-1)>>, <<Large/bits, Large/bits, Large/bits, Large/bits, Large/bits, Large/bits, Large/bits, Large/bits, Large/bits>>. -bs_add_overflow_unsigned() -> - %% Produce a large result of bs_add that goes beyond the limit of an - %% unsigned word. This used to succeed but produced an incorrect result +bs_append_overflow_unsigned() -> + %% The following would succeed but would produce an incorrect result %% where B =:= C! A = <<0:((1 bsl 32)-8)>>, B = <<2, 3>>, diff --git a/erts/emulator/test/bs_match_int_SUITE.erl b/erts/emulator/test/bs_match_int_SUITE.erl index e913dc98b0..454e55d017 100644 --- a/erts/emulator/test/bs_match_int_SUITE.erl +++ b/erts/emulator/test/bs_match_int_SUITE.erl @@ -234,34 +234,49 @@ mml_choose(<<_A:8>>) -> single_byte_binary; mml_choose(<<_A:8,_T/binary>>) -> multi_byte_binary. match_huge_int(Config) when is_list(Config) -> - Sz = 1 bsl 27, - Bin = <<0:Sz,13:8>>, - skip_huge_int_1(Sz, Bin), - 0 = match_huge_int_1(Sz, Bin), - - %% Test overflowing the size of an integer field. - nomatch = overflow_huge_int_skip_32(Bin), - case erlang:system_info(wordsize) of - 4 -> - nomatch = overflow_huge_int_32(Bin); - 8 -> - %% An attempt will be made to allocate heap space for - %% the bignum (which will probably fail); only if the - %% allocation succeeds will the matching fail because - %% the binary is too small. - ok - end, - nomatch = overflow_huge_int_skip_64(Bin), - nomatch = overflow_huge_int_64(Bin), - - %% Test overflowing the size of an integer field using variables as sizes. - Sizes = case erlang:system_info(wordsize) of - 4 -> lists:seq(25, 32); - 8 -> [] - end ++ lists:seq(50, 64), - ok = overflow_huge_int_unit128(Bin, Sizes), - - ok. + case ?MODULE of + bs_match_int_no_opt_SUITE -> + %% This test case is written with the assumption that + %% bs_skip2 instructions are used when the value of the + %% extracted segment will not be used. In OTP 21 and earlier, that + %% assumption was always true, because the bs_skip optimization + %% was included in v3_codegen and could not be disabled. + %% In OTP 22, the bs_skip optimization is done by beam_ssa_opt + %% and is disabled. + %% + %% On memory-constrained computers, using bs_get_integer2 + %% instructions may cause the runtime system to terminate + %% because of insufficient memory. + {skip, "unoptimized code would use too much memory"}; + bs_match_int_SUITE -> + Sz = 1 bsl 27, + Bin = <<0:Sz,13:8>>, + skip_huge_int_1(Sz, Bin), + 0 = match_huge_int_1(Sz, Bin), + + %% Test overflowing the size of an integer field. + nomatch = overflow_huge_int_skip_32(Bin), + case erlang:system_info(wordsize) of + 4 -> + nomatch = overflow_huge_int_32(Bin); + 8 -> + %% An attempt will be made to allocate heap space for + %% the bignum (which will probably fail); only if the + %% allocation succeeds will the matching fail because + %% the binary is too small. + ok + end, + nomatch = overflow_huge_int_skip_64(Bin), + nomatch = overflow_huge_int_64(Bin), + + %% Test overflowing the size of an integer field using + %% variables as sizes. + Sizes = case erlang:system_info(wordsize) of + 4 -> lists:seq(25, 32); + 8 -> [] + end ++ lists:seq(50, 64), + ok = overflow_huge_int_unit128(Bin, Sizes) + end. overflow_huge_int_unit128(Bin, [Sz0|Sizes]) -> Sz = id(1 bsl Sz0), diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl index 17759d78f3..cae4eb54d2 100644 --- a/erts/emulator/test/bs_match_misc_SUITE.erl +++ b/erts/emulator/test/bs_match_misc_SUITE.erl @@ -24,7 +24,7 @@ kenneth/1,encode_binary/1,native/1,happi/1, size_var/1,wiger/1,x0_context/1,huge_float_field/1, writable_binary_matched/1,otp_7198/1,unordered_bindings/1, - float_middle_endian/1]). + float_middle_endian/1,unsafe_get_binary_reuse/1]). -include_lib("common_test/include/ct.hrl"). @@ -36,7 +36,8 @@ all() -> [bound_var, bound_tail, t_float, little_float, sean, kenneth, encode_binary, native, happi, size_var, wiger, x0_context, huge_float_field, writable_binary_matched, - otp_7198, unordered_bindings, float_middle_endian]. + otp_7198, unordered_bindings, float_middle_endian, + unsafe_get_binary_reuse]. %% Test matching of bound variables. @@ -556,5 +557,21 @@ unordered_bindings(CompressedLength, HashSize, PadLength, T) -> Padding:PadLength/binary,PadLength>> = T, {Content,Mac,Padding}. +%% ERL-901: A load-time optimization assumed that match contexts had no further +%% uses when a bs_get_binary2 overwrote the match context's register, and +%% figured it would be safe to reuse the match context's memory for the +%% resulting binary. +%% +%% This is no longer safe as of OTP 22, as a match context may be reused after +%% being passed to another function. +unsafe_get_binary_reuse(Config) when is_list(Config) -> + <<_First, Rest/binary>> = <<"hello">>, + ubgr_1(Rest), + <<Second,_/bits>> = Rest, + $e = Second, + ok. + +ubgr_1(<<_CP/utf8, Rest/binary>>) -> id(Rest); +ubgr_1(_) -> false. id(I) -> I. diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index 449821e5ad..7885d35d9d 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -19,7 +19,6 @@ %% -module(distribution_SUITE). --compile(r16). -define(VERSION_MAGIC, 131). @@ -39,6 +38,8 @@ -define(Line,). -export([all/0, suite/0, groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2, ping/1, bulk_send_small/1, group_leader/1, optimistic_dflags/1, @@ -53,7 +54,6 @@ dist_parallel_send/1, atom_roundtrip/1, unicode_atom_roundtrip/1, - atom_roundtrip_r16b/1, contended_atom_cache_entry/1, contended_unicode_atom_cache_entry/1, bad_dist_structure/1, @@ -67,7 +67,8 @@ message_latency_large_message/1, message_latency_large_link_exit/1, message_latency_large_monitor_exit/1, - message_latency_large_exit2/1]). + message_latency_large_exit2/1, + system_limit/1]). %% Internal exports. -export([sender/3, receiver2/2, dummy_waiter/0, dead_process/0, @@ -75,7 +76,7 @@ optimistic_dflags_echo/0, optimistic_dflags_sender/1, roundtrip/1, bounce/1, do_dist_auto_connect/1, inet_rpc_server/1, dist_parallel_sender/3, dist_parallel_receiver/0, - dist_evil_parallel_receiver/0]). + dist_evil_parallel_receiver/0, make_busy/2]). %% epmd_module exports -export([start_link/0, register_node/2, register_node/3, port_please/2, address_please/3]). @@ -93,11 +94,10 @@ all() -> ref_port_roundtrip, nil_roundtrip, stop_dist, {group, trap_bif}, {group, dist_auto_connect}, dist_parallel_send, atom_roundtrip, unicode_atom_roundtrip, - atom_roundtrip_r16b, contended_atom_cache_entry, contended_unicode_atom_cache_entry, {group, message_latency}, {group, bad_dist}, {group, bad_dist_ext}, - start_epmd_false, epmd_module]. + start_epmd_false, epmd_module, system_limit]. groups() -> [{bulk_send, [], [bulk_send_small, bulk_send_big, bulk_send_bigbig]}, @@ -119,6 +119,28 @@ groups() -> message_latency_large_exit2]} ]. +init_per_suite(Config) -> + {ok, Apps} = application:ensure_all_started(os_mon), + [{started_apps, Apps} | Config]. + +end_per_suite(Config) -> + Apps = proplists:get_value(started_apps, Config), + [application:stop(App) || App <- lists:reverse(Apps)], + Config. + +init_per_group(message_latency, Config) -> + Free = free_memory(), + if Free < 2048 -> + {skip, "Not enough memory"}; + true -> + Config + end; +init_per_group(_, Config) -> + Config. + +end_per_group(_, Config) -> + Config. + %% Tests pinging a node in different ways. ping(Config) when is_list(Config) -> Times = 1024, @@ -1134,23 +1156,6 @@ atom_roundtrip(Config) when is_list(Config) -> stop_node(Node), ok. -atom_roundtrip_r16b(Config) when is_list(Config) -> - case test_server:is_release_available("r16b") of - true -> - ct:timetrap({minutes, 6}), - AtomData = unicode_atom_data(), - verify_atom_data(AtomData), - case start_node(Config, [], "r16b") of - {ok, Node} -> - do_atom_roundtrip(Node, AtomData), - stop_node(Node); - {error, timeout} -> - {skip,"Unable to start OTP R16B release"} - end; - false -> - {skip,"No OTP R16B available"} - end. - unicode_atom_roundtrip(Config) when is_list(Config) -> AtomData = unicode_atom_data(), verify_atom_data(AtomData), @@ -1456,11 +1461,14 @@ measure_latency_large_message(Nodename, DataFun) -> Echo = spawn(N, fun F() -> receive {From, Msg} -> From ! Msg, F() end end), - case erlang:system_info(build_type) of - debug -> + BuildType = erlang:system_info(build_type), + WordSize = erlang:system_info(wordsize), + + if + BuildType =/= opt; WordSize =:= 4 -> %% Test 3.2 MB and 32 MB and test the latency difference of sent messages Payloads = [{I, <<0:(I * 32 * 1024 * 8)>>} || I <- [1,10]]; - _ -> + true -> %% Test 32 MB and 320 MB and test the latency difference of sent messages Payloads = [{I, <<0:(I * 32 * 1024 * 1024 * 8)>>} || I <- [1,10]] end, @@ -1475,7 +1483,7 @@ measure_latency_large_message(Nodename, DataFun) -> stop_node(N), case {lists:max(Times), lists:min(Times)} of - {Max, Min} when Max * 0.25 > Min -> + {Max, Min} when Max * 0.25 > Min, BuildType =:= opt -> ct:fail({incorrect_latency, IndexTimes}); _ -> ok @@ -1500,13 +1508,19 @@ measure_latency(DataFun, Dropper, Echo, Payload) -> ok end || _ <- lists:seq(1,10)], - {TS, _} = + {TS, Times} = timer:tc(fun() -> [begin + T0 = erlang:monotonic_time(), Echo ! {self(), hello}, - receive hello -> ok end + receive hello -> ok end, + (erlang:monotonic_time() - T0) / 1000000 end || _ <- lists:seq(1,100)] end), + Avg = lists:sum(Times) / length(Times), + StdDev = math:sqrt(lists:sum([math:pow(V - Avg,2) || V <- Times]) / length(Times)), + ct:pal("Times: Avg: ~p Max: ~p Min: ~p Var: ~p", + [Avg, lists:max(Times), lists:min(Times), StdDev]), [begin Sender ! die, receive @@ -1524,6 +1538,144 @@ flush() -> ok end. +system_limit(Config) when is_list(Config) -> + case erlang:system_info(wordsize) of + 8 -> + case proplists:get_value(system_total_memory, + memsup:get_system_memory_data()) of + Memory when is_integer(Memory), + Memory > 6*1024*1024*1024 -> + test_system_limit(Config), + garbage_collect(), + ok; + _ -> + {skipped, "Not enough memory on this machine"} + end; + 4 -> + {skipped, "Only interesting on 64-bit builds"} + end. + +test_system_limit(Config) when is_list(Config) -> + Bits = ((1 bsl 32)+1)*8, + HugeBin = <<0:Bits>>, + HugeListBin = [lists:duplicate(2000000,2000000), HugeBin], + {ok, N1} = start_node(Config), + monitor_node(N1, true), + receive + {nodedown, N1} -> + ct:fail({unexpected_nodedown, N1}) + after 0 -> + ok + end, + P1 = spawn(N1, + fun () -> + receive after infinity -> ok end + end), + + io:format("~n** distributed send **~n~n", []), + try + P1 ! HugeBin, + exit(oops1) + catch + error:system_limit -> ok + end, + try + P1 ! HugeListBin, + exit(oops2) + catch + error:system_limit -> ok + end, + + io:format("~n** distributed exit **~n~n", []), + try + exit(P1, HugeBin), + exit(oops3) + catch + error:system_limit -> ok + end, + try + exit(P1, HugeListBin), + exit(oops4) + catch + error:system_limit -> ok + end, + + io:format("~n** distributed registered send **~n~n", []), + try + {missing_proc, N1} ! HugeBin, + exit(oops5) + catch + error:system_limit -> ok + end, + try + {missing_proc, N1} ! HugeListBin, + exit(oops6) + catch + error:system_limit -> ok + end, + receive + {nodedown, N1} -> + ct:fail({unexpected_nodedown, N1}) + after 0 -> + ok + end, + + %% + %% system_limit in exit reasons brings the + %% connection down... + %% + + io:format("~n** distributed link exit **~n~n", []), + spawn(fun () -> + link(P1), + exit(HugeBin) + end), + receive {nodedown, N1} -> ok end, + + {ok, N2} = start_node(Config), + monitor_node(N2, true), + P2 = spawn(N2, + fun () -> + receive after infinity -> ok end + end), + spawn(fun () -> + link(P2), + exit(HugeListBin) + end), + receive {nodedown, N2} -> ok end, + + io:format("~n** distributed monitor down **~n~n", []), + {ok, N3} = start_node(Config), + monitor_node(N3, true), + Go1 = make_ref(), + LP1 = spawn(fun () -> + receive Go1 -> ok end, + exit(HugeBin) + end), + _ = spawn(N3, + fun () -> + _ = erlang:monitor(process, LP1), + LP1 ! Go1, + receive after infinity -> ok end + end), + receive {nodedown, N3} -> ok end, + + {ok, N4} = start_node(Config), + monitor_node(N4, true), + Go2 = make_ref(), + LP2 = spawn(fun () -> + receive Go2 -> ok end, + exit(HugeListBin) + end), + _ = spawn(N4, + fun () -> + _ = erlang:monitor(process, LP2), + LP2 ! Go2, + receive after infinity -> ok end + end), + receive {nodedown, N4} -> ok end, + ok. + -define(COOKIE, ''). -define(DOP_LINK, 1). -define(DOP_SEND, 2). @@ -2845,3 +2997,23 @@ uint8(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 8 -> Uint band 16#ff; uint8(Uint) -> exit({badarg, uint8, [Uint]}). + +free_memory() -> + %% Free memory in MB. + try + SMD = memsup:get_system_memory_data(), + {value, {free_memory, Free}} = lists:keysearch(free_memory, 1, SMD), + TotFree = (Free + + case lists:keysearch(cached_memory, 1, SMD) of + {value, {cached_memory, Cached}} -> Cached; + false -> 0 + end + + case lists:keysearch(buffered_memory, 1, SMD) of + {value, {buffered_memory, Buffed}} -> Buffed; + false -> 0 + end), + TotFree div (1024*1024) + catch + error : undef -> + ct:fail({"os_mon not built"}) + end. diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index bb0f3498ab..f6d7c55017 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -120,29 +120,6 @@ -define(heap_binary_size, 64). -init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> - CIOD = rpc(Config, - fun() -> - case catch erts_debug:get_internal_state(available_internal_state) of - true -> ok; - _ -> erts_debug:set_internal_state(available_internal_state, true) - end, - erts_debug:get_internal_state(check_io_debug) - end), - erlang:display({init_per_testcase, Case}), - 0 = element(1, CIOD), - [{testcase, Case}|Config]. - -end_per_testcase(Case, Config) -> - erlang:display({end_per_testcase, Case}), - CIOD = rpc(Config, - fun() -> - get_stable_check_io_info(), - erts_debug:get_internal_state(check_io_debug) - end), - 0 = element(1, CIOD), - ok. - suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {minutes, 1}}]. @@ -219,6 +196,48 @@ end_per_group(_GroupName, Config) -> end, Config. +init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + CIOD = rpc(Config, + fun() -> + case catch erts_debug:get_internal_state(available_internal_state) of + true -> ok; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end, + erts_debug:get_internal_state(check_io_debug) + end), + erlang:display({init_per_testcase, Case}), + 0 = element(1, CIOD), + [{testcase, Case}|Config]. + +end_per_testcase(Case, Config) -> + erlang:display({end_per_testcase, Case}), + try rpc(Config, fun() -> + get_stable_check_io_info(), + erts_debug:get_internal_state(check_io_debug) + end) of + CIOD -> + 0 = element(1, CIOD) + catch _E:_R:_ST -> + %% Logs some info about the system + ct_os_cmd("epmd -names"), + ct_os_cmd("ps aux"), + %% Restart the node + case proplists:get_value(node, Config) of + undefined -> + ok; + Node -> + timer:sleep(1000), %% Give the node time to die + [NodeName, _] = string:lexemes(atom_to_list(Node),"@"), + {ok, Node} = start_node_final( + list_to_atom(NodeName), + proplists:get_value(node_args, Config)) + end + end, + ok. + +ct_os_cmd(Cmd) -> + ct:log("~s: ~s",[Cmd,os:cmd(Cmd)]). + %% Test sending bad types to port with an outputv-capable driver. outputv_errors(Config) when is_list(Config) -> Path = proplists:get_value(data_dir, Config), @@ -998,7 +1017,9 @@ chkio_test({erts_poll_info, Before}, During = get_check_io_total(erlang:system_info(check_io)), erlang:display(During), - 0 = element(1, erts_debug:get_internal_state(check_io_debug)), + [0 = element(1, erts_debug:get_internal_state(check_io_debug)) || + %% The pollset is not stable when running the fallback testcase + Test /= ?CHKIO_USE_FALLBACK_POLLSET], io:format("During test: ~p~n", [During]), chk_chkio_port(Port), case erlang:port_control(Port, ?CHKIO_STOP, "") of @@ -2642,7 +2663,6 @@ start_node(Config) when is_list(Config) -> start_node(Name) -> start_node(Name, ""). start_node(NodeName, Args) -> - Pa = filename:dirname(code:which(?MODULE)), Name = list_to_atom(atom_to_list(?MODULE) ++ "-" ++ atom_to_list(NodeName) @@ -2650,7 +2670,17 @@ start_node(NodeName, Args) -> ++ integer_to_list(erlang:system_time(second)) ++ "-" ++ integer_to_list(erlang:unique_integer([positive]))), - test_server:start_node(Name, slave, [{args, Args ++ " -pa "++Pa}]). + start_node_final(Name, Args). +start_node_final(Name, Args) -> + {ok, Pwd} = file:get_cwd(), + FinalArgs = [Args, " -pa ", filename:dirname(code:which(?MODULE))], + {ok, Node} = test_server:start_node(Name, slave, [{args, FinalArgs}]), + LogPath = Pwd ++ "/error_log." ++ atom_to_list(Name), + ct:pal("Logging to: ~s", [LogPath]), + rpc:call(Node, logger, add_handler, [file_handler, logger_std_h, + #{formatter => {logger_formatter,#{ single_line => false }}, + config => #{file => LogPath }}]), + {ok, Node}. stop_node(Node) -> test_server:stop_node(Node). diff --git a/erts/emulator/test/dump_SUITE.erl b/erts/emulator/test/dump_SUITE.erl index 3b860ebdf6..9f8ac42fa9 100644 --- a/erts/emulator/test/dump_SUITE.erl +++ b/erts/emulator/test/dump_SUITE.erl @@ -137,26 +137,43 @@ exiting_dump(Config) when is_list(Config) -> free_dump(Config) when is_list(Config) -> Dump = filename:join(proplists:get_value(priv_dir, Config),"signal_abort.dump"), - {ok, Node} = start_node(Config), - - Self = self(), - - Pid = spawn_link(Node, - fun() -> - Self ! ready, - receive - ok -> - unlink(Self), - exit(lists:duplicate(1000,1000)) - end - end), + {ok, NodeA} = start_node(Config), + {ok, NodeB} = start_node(Config), - true = rpc:call(Node, os, putenv, ["ERL_CRASH_DUMP",Dump]), - [erlang:monitor(process, Pid) || _ <- lists:seq(1,10000)], - receive ready -> unlink(Pid), Pid ! ok end, + Self = self(), - rpc:call(Node, erlang, halt, ["dump"]), + PidA = spawn_link( + NodeA, + fun() -> + Self ! ready, + receive + ok -> + spawn(fun() -> + erlang:system_monitor(self(), [busy_dist_port]), + timer:sleep(5), + receive + M -> + io:format("~p",[M]), + erlang:halt("dump") + end + end), + exit(lists:duplicate(1000000,100)) + end + end), + + spawn_link(NodeB, + fun() -> + [erlang:monitor(process, PidA) || _ <- lists:seq(1,10000)], + Self ! done, + receive _ -> ok end + end), + + receive done -> ok end, + true = rpc:call(NodeA, os, putenv, ["ERL_CRASH_DUMP",Dump]), + ct:pal("~p",[rpc:call(NodeA, distribution_SUITE, make_busy, [NodeB, 1000])]), + + receive ready -> unlink(PidA), PidA ! ok end, {ok, Bin} = get_dump_when_done(Dump), diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl index 55c5343739..045b351e02 100644 --- a/erts/emulator/test/efile_SUITE.erl +++ b/erts/emulator/test/efile_SUITE.erl @@ -105,34 +105,27 @@ open_files(Name) -> %% a /proc directory), let's read some zero sized files 500 times each, while %% ensuring that response isn't empty << >> proc_zero_sized_files(Config) when is_list(Config) -> - {Type, Flavor} = os:type(), - %% Some files which exist on Linux but might be missing on other systems - Inputs = ["/proc/cpuinfo", - "/proc/meminfo", - "/proc/partitions", - "/proc/swaps", - "/proc/version", - "/proc/uptime", - %% curproc is present on freebsd - "/proc/curproc/cmdline"], - case filelib:is_dir("/proc") of - false -> {skip, "/proc not found"}; % skip the test if no /proc - _ when Type =:= unix andalso Flavor =:= sunos -> - %% SunOS has a /proc, but no zero sized special files - {skip, "sunos does not have any zero sized special files"}; - true -> - %% Take away files which do not exist in proc - Inputs1 = lists:filter(fun filelib:is_file/1, Inputs), - - %% Fail if none of mentioned files exist in /proc, did we just get - %% a normal /proc directory without any special files? - ?assertNotEqual([], Inputs1), - + TestFiles0 = [%% Some files which exist on Linux but might be missing on + %% other systems + "/proc/cpuinfo", + "/proc/meminfo", + "/proc/partitions", + "/proc/swaps", + "/proc/version", + "/proc/uptime", + %% curproc is present on FreeBSD + "/proc/curproc/cmdline"], + + TestFiles = [F || F <- TestFiles0, filelib:is_file(F)], + + case TestFiles of + [_|_] -> %% For 6 inputs and 500 attempts each this do run anywhere %% between 500 and 3000 function calls. - lists:foreach( - fun(Filename) -> do_proc_zero_sized(Filename, 500) end, - Inputs1) + [do_proc_zero_sized(F, 500) || F <- TestFiles], + ok; + [] -> + {skip, "Failed to find any known zero-sized files"} end. %% @doc Test one file N times to also trigger possible leaking fds and memory diff --git a/erts/emulator/test/emulator_bench.spec b/erts/emulator/test/emulator_bench.spec index 2a180b440c..03638bfa23 100644 --- a/erts/emulator/test/emulator_bench.spec +++ b/erts/emulator/test/emulator_bench.spec @@ -1,2 +1,3 @@ {groups,"../emulator_test",estone_SUITE,[estone_bench]}. {groups,"../emulator_test",binary_SUITE,[iolist_size_benchmarks]}. +{groups,"../emulator_test",erts_debug_SUITE,[interpreter_size_bench]}. diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl index f39dbedd8f..6798e3bf25 100644 --- a/erts/emulator/test/erts_debug_SUITE.erl +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -20,10 +20,12 @@ -module(erts_debug_SUITE). -include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). --export([all/0, suite/0, +-export([all/0, suite/0, groups/0, test_size/1,flat_size_big/1,df/1,term_type/1, - instructions/1, stack_check/1, alloc_blocks_size/1]). + instructions/1, stack_check/1, alloc_blocks_size/1, + interpreter_size_bench/1]). -export([do_alloc_blocks_size/0]). @@ -35,6 +37,15 @@ all() -> [test_size, flat_size_big, df, instructions, term_type, stack_check, alloc_blocks_size]. +groups() -> + [{interpreter_size_bench, [], [interpreter_size_bench]}]. + +interpreter_size_bench(_Config) -> + Size = erts_debug:interpreter_size(), + ct_event:notify(#event{name=benchmark_data, + data=[{value,Size}]}), + {comment,integer_to_list(Size)++" bytes"}. + test_size(Config) when is_list(Config) -> ConsCell1 = id([a|b]), ConsCell2 = id(ConsCell1), diff --git a/erts/emulator/test/erts_test_utils.erl b/erts/emulator/test/erts_test_utils.erl index e4e00a0a16..9c9eaa70ed 100644 --- a/erts/emulator/test/erts_test_utils.erl +++ b/erts/emulator/test/erts_test_utils.erl @@ -19,7 +19,7 @@ %% -module(erts_test_utils). --compile(r16). +-compile(r20). %% %% THIS MODULE IS ALSO USED BY *OTHER* APPLICATIONS TEST CODE diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl index 7f6caa08f1..2cbde621ce 100644 --- a/erts/emulator/test/fun_SUITE.erl +++ b/erts/emulator/test/fun_SUITE.erl @@ -513,6 +513,8 @@ refc(Config) when is_list(Config) -> Other -> ct:fail({unexpected,Other}) end, process_flag(trap_exit, false), + %% Wait to make sure that the process has terminated completely. + receive after 1 -> ok end, {refc,3} = erlang:fun_info(F1, refc), %% Garbage collect. Only the F2 fun will be left. diff --git a/erts/emulator/test/lcnt_SUITE.erl b/erts/emulator/test/lcnt_SUITE.erl index 87b97037d6..2dbaec9942 100644 --- a/erts/emulator/test/lcnt_SUITE.erl +++ b/erts/emulator/test/lcnt_SUITE.erl @@ -187,5 +187,8 @@ remove_untoggleable_locks([]) -> []; remove_untoggleable_locks([{resource_monitors, _, _, _} | T]) -> remove_untoggleable_locks(T); +remove_untoggleable_locks([{'socket[gcnt]', _, _, _} | T]) -> + %% Global lock used by socket NIF + remove_untoggleable_locks(T); remove_untoggleable_locks([H | T]) -> [H | remove_untoggleable_locks(T)]. diff --git a/erts/emulator/test/map_SUITE.erl b/erts/emulator/test/map_SUITE.erl index d0a6763fe5..9ea59e1084 100644 --- a/erts/emulator/test/map_SUITE.erl +++ b/erts/emulator/test/map_SUITE.erl @@ -17,7 +17,7 @@ %% %CopyrightEnd% %% -module(map_SUITE). --export([all/0, suite/0]). +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]). -export([t_build_and_match_literals/1, t_build_and_match_literals_large/1, t_update_literals/1, t_update_literals_large/1, @@ -84,7 +84,10 @@ %% instruction-level tests t_has_map_fields/1, y_regs/1, - badmap_17/1]). + badmap_17/1, + + %%Bugs + t_large_unequal_bins_same_hash_bug/1]). -include_lib("stdlib/include/ms_transform.hrl"). @@ -149,7 +152,26 @@ all() -> [t_build_and_match_literals, t_build_and_match_literals_large, %% instruction-level tests t_has_map_fields, y_regs, - badmap_17]. + badmap_17, + + %% Bugs + t_large_unequal_bins_same_hash_bug]. + +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 = proplists:get_value(started_apps, Config), + lists:foreach(fun (A) -> application:stop(A) end, As), + Config. %% tests @@ -3374,3 +3396,67 @@ fannerl() -> 104,2,97,9,97,16,70,63,184,100,97,32,0,0,0,104,2,97,10,97,16,70,63,169,174, 254,64,0,0,0,104,2,97,11,97,16,70,191,119,121,234,0,0,0,0,104,2,97,12,97, 16,70,63,149,12,170,128,0,0,0,104,2,97,13,97,16,70,191,144,193,191,0,0,0,0>>. + +%% This test case checks that the bug with ticket number OTP-15707 is +%% fixed. The bug could cause a crash or memory usage to grow until +%% the machine ran out of memory. +t_large_unequal_bins_same_hash_bug(Config) when is_list(Config) -> + run_when_enough_resources( + fun() -> + K1 = get_4GB_bin(1), + K2 = get_4GB_bin(2), + Map = make_map(500), + Map2 = maps:put(K1, 42, Map), + %% The map needed to contain at least 32 key-value pairs + %% at this point to get the crash or out of memory + %% problem on the next line + Map3 = maps:put(K2, 43, Map2), + %% The following line should avoid that the compiler + %% optimizes away the above + io:format("~p ~p~n", [erlang:phash2(Map3), maps:size(Map3)]) + end). + +make_map(0) -> + #{}; +make_map(Size) -> + maps:put(Size, Size, make_map(Size-1)). + +get_4GB_bin(Value) -> + List = lists:duplicate(65536, Value), + Bin = erlang:iolist_to_binary(List), + IOList4GB = duplicate_iolist(Bin, 16), + Bin4GB = erlang:iolist_to_binary(IOList4GB), + 4294967296 = size(Bin4GB), + Bin4GB. + +duplicate_iolist(IOList, 0) -> + IOList; +duplicate_iolist(IOList, NrOfTimes) -> + duplicate_iolist([IOList, IOList], NrOfTimes - 1). + +run_when_enough_resources(Fun) -> + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem >= 31 -> + Fun(); + {Mem, WordSize} -> + {skipped, + io_lib:format("Not enough resources (System Memory >= ~p, Word Size = ~p)", + [Mem, WordSize])} + end. + +total_memory() -> + %% Total memory in GB. + try + MemoryData = memsup:get_system_memory_data(), + case lists:keysearch(total_memory, 1, MemoryData) of + {value, {total_memory, TM}} -> + TM div (1024*1024*1024); + false -> + {value, {system_total_memory, STM}} = + lists:keysearch(system_total_memory, 1, MemoryData), + STM div (1024*1024*1024) + end + catch + _ : _ -> + undefined + end. diff --git a/erts/emulator/test/net_SUITE.erl b/erts/emulator/test/net_SUITE.erl index 1a973cacb2..6111fc76a5 100644 --- a/erts/emulator/test/net_SUITE.erl +++ b/erts/emulator/test/net_SUITE.erl @@ -127,12 +127,17 @@ api_basic_cases() -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% init_per_suite(Config) -> - case os:type() of - {win32, _} -> - not_yet_implemented(); - _ -> - %% ?LOGGER:start(), - Config + case lists:member(socket, erlang:loaded()) of + true -> + case os:type() of + {win32, _} -> + not_yet_implemented(); + _ -> + %% ?LOGGER:start(), + Config + end; + false -> + {skip, "esock disabled"} end. end_per_suite(_) -> diff --git a/erts/emulator/test/persistent_term_SUITE.erl b/erts/emulator/test/persistent_term_SUITE.erl index 93eb026ced..c9874e5679 100644 --- a/erts/emulator/test/persistent_term_SUITE.erl +++ b/erts/emulator/test/persistent_term_SUITE.erl @@ -25,7 +25,9 @@ basic/1,purging/1,sharing/1,get_trapping/1, info/1,info_trapping/1,killed_while_trapping/1, off_heap_values/1,keys/1,collisions/1, - init_restart/1]). + init_restart/1, put_erase_trapping/1, + killed_while_trapping_put/1, + killed_while_trapping_erase/1]). %% -export([test_init_restart_cmd/1]). @@ -37,7 +39,8 @@ suite() -> all() -> [basic,purging,sharing,get_trapping,info,info_trapping, killed_while_trapping,off_heap_values,keys,collisions, - init_restart]. + init_restart, put_erase_trapping, killed_while_trapping_put, + killed_while_trapping_erase]. init_per_suite(Config) -> %% Put a term in the dict so that we know that the testcases handle @@ -627,3 +630,69 @@ chk_not_stuck(Term) -> pget({_, Initial}) -> persistent_term:get() -- Initial. + + +killed_while_trapping_put(_Config) -> + erts_debug:set_internal_state(available_internal_state, true), + repeat( + fun() -> + NrOfPutsInChild = 10000, + do_puts(2500, my_value), + Pid = + spawn(fun() -> + do_puts(NrOfPutsInChild, my_value2) + end), + timer:sleep(1), + erlang:exit(Pid, kill), + do_erases(NrOfPutsInChild) + end, + 10), + erts_debug:set_internal_state(available_internal_state, false). + +killed_while_trapping_erase(_Config) -> + erts_debug:set_internal_state(available_internal_state, true), + repeat( + fun() -> + NrOfErases = 2500, + do_puts(NrOfErases, my_value), + Pid = + spawn(fun() -> + do_erases(NrOfErases) + end), + timer:sleep(1), + erlang:exit(Pid, kill), + do_erases(NrOfErases) + end, + 10), + erts_debug:set_internal_state(available_internal_state, false). + +put_erase_trapping(_Config) -> + NrOfItems = 5000, + erts_debug:set_internal_state(available_internal_state, true), + do_puts(NrOfItems, first), + do_puts(NrOfItems, second), + do_erases(NrOfItems), + erts_debug:set_internal_state(available_internal_state, false). + +do_puts(0, _) -> ok; +do_puts(NrOfPuts, ValuePrefix) -> + Key = {?MODULE, NrOfPuts}, + Value = {ValuePrefix, NrOfPuts}, + erts_debug:set_internal_state(reds_left, rand:uniform(250)), + persistent_term:put(Key, Value), + Value = persistent_term:get(Key), + do_puts(NrOfPuts - 1, ValuePrefix). + +do_erases(0) -> ok; +do_erases(NrOfErases) -> + Key = {?MODULE,NrOfErases}, + erts_debug:set_internal_state(reds_left, rand:uniform(500)), + persistent_term:erase(Key), + not_found = persistent_term:get(Key, not_found), + do_erases(NrOfErases - 1). + +repeat(_Fun, 0) -> + ok; +repeat(Fun, N) -> + Fun(), + repeat(Fun, N-1). diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index c698220013..b530ced566 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -44,6 +44,7 @@ process_info_garbage_collection/1, process_info_smoke_all/1, process_info_status_handled_signal/1, + process_info_reductions/1, bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1, otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1, process_info_messages/1, process_flag_badarg/1, process_flag_heap_size/1, @@ -84,6 +85,7 @@ all() -> process_info_garbage_collection, process_info_smoke_all, process_info_status_handled_signal, + process_info_reductions, bump_reductions, low_prio, yield, yield2, otp_4725, bad_register, garbage_collect, process_info_messages, process_flag_badarg, process_flag_heap_size, @@ -1093,6 +1095,46 @@ process_info_status_handled_signal(Config) when is_list(Config) -> false = erlang:is_process_alive(P), ok. +%% OTP-15709 +%% Provoke a bug where process_info(reductions) returned wrong result +%% because REDS_IN (def_arg_reg[5]) is read when the process in not running. +process_info_reductions(Config) when is_list(Config) -> + pi_reductions_tester(spawn_link(fun() -> pi_reductions_spinnloop() end)), + pi_reductions_tester(spawn_link(fun() -> pi_reductions_recvloop() end)), + ok. + +pi_reductions_tester(Pid) -> + {_, DiffList} = + lists:foldl(fun(_, {Prev, Acc}) -> + %% Add another item that force sending the request + %% as a signal, like 'current_function'. + PI = process_info(Pid, [reductions, current_function]), + [{reductions,Reds}, {current_function,_}] = PI, + Diff = Reds - Prev, + {Diff, true} = {Diff, (Diff >= 0)}, + {Diff, true} = {Diff, (Diff =< 1000*1000)}, + {Reds, [Diff | Acc]} + end, + {0, []}, + lists:seq(1,10)), + unlink(Pid), + exit(Pid,kill), + io:format("Reduction diffs: ~p\n", [DiffList]), + ok. + +pi_reductions_spinnloop() -> + %% 6 args to make use of def_arg_reg[5] which is also used as REDS_IN + pi_reductions_spinnloop(1, atom, "hej", self(), make_ref(), 3.14). + +pi_reductions_spinnloop(A,B,C,D,E,F) -> + pi_reductions_spinnloop(B,C,D,E,F,A). + +pi_reductions_recvloop() -> + receive + "a free lunch" -> false + end. + + %% Tests erlang:bump_reductions/1. bump_reductions(Config) when is_list(Config) -> erlang:garbage_collect(), diff --git a/erts/emulator/test/small_SUITE.erl b/erts/emulator/test/small_SUITE.erl new file mode 100644 index 0000000000..00a02e5560 --- /dev/null +++ b/erts/emulator/test/small_SUITE.erl @@ -0,0 +1,115 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(small_SUITE). + +-export([all/0, suite/0]). +-export([edge_cases/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. + +all() -> + [edge_cases]. + +edge_cases(Config) when is_list(Config) -> + {MinSmall, MaxSmall} = Limits = determine_small_limits(0), + ct:pal("Limits = ~p", [Limits]), + + true = (MaxSmall + 1) =:= MaxSmall + id(1), + true = (MinSmall - 1) =:= MinSmall - id(1), + true = (MaxSmall + 1) > id(MaxSmall), + true = (MinSmall - 1) < id(MinSmall), + -1 = MinSmall + id(MaxSmall), + -1 = MaxSmall + id(MinSmall), + + false = is_small(MinSmall * -1), + false = is_small(MinSmall - id(1)), + false = is_small(MinSmall - 1), + false = is_small(MaxSmall + id(1)), + + Lower = lists:seq(MinSmall, MinSmall + 128), + Upper = lists:seq(MaxSmall, MaxSmall - 128, -1), + Pow2 = seq_pow2(MinSmall, MaxSmall), + NearZero = lists:seq(-128, 128), + + ok = test_combinations([Lower, Upper, Pow2, NearZero], MinSmall, MaxSmall), + + ok. + +test_combinations([As | Rest]=TestVectors, MinS, MaxS) -> + [begin + _ = [arith_test(A, B, MinS, MaxS) || B <- Bs] + end || A <- As, Bs <- TestVectors], + test_combinations(Rest, MinS, MaxS); +test_combinations([], _MinS, _MaxS) -> + ok. + +%% Builds a sequence of all powers of 2 between MinSmall and MaxSmall +seq_pow2(MinSmall, MaxSmall) -> + sp2_1(MinSmall, MinSmall, MaxSmall). + +sp2_1(N, _MinS, MaxS) when N >= MaxS -> + []; +sp2_1(-1, MinS, MaxS) -> + [-1 | sp2_1(1, MinS, MaxS)]; +sp2_1(N, MinS, MaxS) when N < 0 -> + [N | sp2_1(N bsr 1, MinS, MaxS)]; +sp2_1(N, MinS, MaxS) when N > 0 -> + [N | sp2_1(N bsl 1, MinS, MaxS)]. + +arith_test(A, B, MinS, MaxS) -> + verify_kind(A + B, MinS, MaxS), + verify_kind(B + A, MinS, MaxS), + verify_kind(A - B, MinS, MaxS), + verify_kind(B - A, MinS, MaxS), + verify_kind(A * B, MinS, MaxS), + verify_kind(B * A, MinS, MaxS), + + true = A + B =:= apply(erlang, id('+'), [A, B]), + true = A - B =:= apply(erlang, id('-'), [A, B]), + true = A * B =:= apply(erlang, id('*'), [A, B]), + + true = A + B =:= B + id(A), + true = A - B =:= A + id(-B), + true = B - A =:= B + id(-A), + true = A * B =:= B * id(A), + + true = B =:= 0 orelse ((A * B) div id(B) =:= A), + true = A =:= 0 orelse ((B * A) div id(A) =:= B), + + ok. + +%% Verifies that N is a small when it should be +verify_kind(N, MinS, MaxS) -> + true = is_small(N) =:= (N >= MinS andalso N =< MaxS). + +is_small(N) when is_integer(N) -> + 0 =:= erts_debug:flat_size(N). + +determine_small_limits(N) -> + case is_small(-1 bsl N) of + true -> determine_small_limits(N + 1); + false -> {-1 bsl (N - 1), (1 bsl (N - 1)) - 1} + end. + +id(I) -> I. diff --git a/erts/emulator/test/socket_SUITE.erl b/erts/emulator/test/socket_SUITE.erl index 2e3f40a350..e3545ccbf9 100644 --- a/erts/emulator/test/socket_SUITE.erl +++ b/erts/emulator/test/socket_SUITE.erl @@ -28,10 +28,14 @@ %% ESOCK_TEST_TRAFFIC: include %% ESOCK_TEST_TTEST: exclude %% +%% Variable that controls "verbosity" of the test case(s): +%% +%% ESOCK_TEST_QUIET: true (default) | false +%% %% Defines the runtime of the ttest cases %% (This is the time during which "measurement" is performed. %% the actual time it takes for the test case to complete -%% will be longer) +%% will be longer; setup, completion, ...) %% %% ESOCK_TEST_TTEST_RUNTIME: 10 seconds %% Format of values: <integer>[<unit>] @@ -1381,22 +1385,27 @@ ttest_ssockt_csockt_cases() -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% init_per_suite(Config) -> - case os:type() of - {win32, _} -> - not_yet_implemented(); - _ -> - case quiet_mode(Config) of - default -> - ?LOGGER:start(), - Config; - Quiet -> - ?LOGGER:start(Quiet), - [{esock_test_quiet, Quiet}|Config] - end + case lists:member(socket, erlang:loaded()) of + true -> + case os:type() of + {win32, _} -> + (catch not_yet_implemented()); + _ -> + case quiet_mode(Config) of + default -> + ?LOGGER:start(), + Config; + Quiet -> + ?LOGGER:start(Quiet), + [{esock_test_quiet, Quiet}|Config] + end + end; + false -> + {skip, "esock disabled"} end. end_per_suite(_) -> - ?LOGGER:stop(), + (catch ?LOGGER:stop()), ok. @@ -1643,6 +1652,8 @@ api_b_sendmsg_and_recvmsg_udp4(_Config) when is_list(_Config) -> tc_try(api_b_sendmsg_and_recvmsg_udp4, fun() -> Send = fun(Sock, Data, Dest) -> + %% We need tests for this, + %% but this is not the place it. %% CMsgHdr = #{level => ip, %% type => tos, %% data => reliability}, @@ -1653,9 +1664,12 @@ api_b_sendmsg_and_recvmsg_udp4(_Config) when is_list(_Config) -> socket:sendmsg(Sock, MsgHdr) end, Recv = fun(Sock) -> + %% We have some issues on old darwing... + socket:setopt(Sock, otp, debug, true), case socket:recvmsg(Sock) of {ok, #{addr := Source, iov := [Data]}} -> + socket:setopt(Sock, otp, debug, false), {ok, {Source, Data}}; {error, _} = ERROR -> ERROR @@ -1714,21 +1728,37 @@ api_b_send_and_recv_udp(InitState) -> end}, #{desc => "send req (to dst)", cmd => fun(#{sock_src := Sock, sa_dst := Dst, send := Send}) -> - ok = Send(Sock, ?BASIC_REQ, Dst) + Send(Sock, ?BASIC_REQ, Dst) end}, #{desc => "recv req (from src)", cmd => fun(#{sock_dst := Sock, sa_src := Src, recv := Recv}) -> - {ok, {Src, ?BASIC_REQ}} = Recv(Sock), - ok + case Recv(Sock) of + {ok, {Src, ?BASIC_REQ}} -> + ok; + {ok, UnexpData} -> + {error, {unexpected_data, UnexpData}}; + {error, _} = ERROR -> + %% At the moment there is no way to get + %% status or state for the socket... + ERROR + end end}, #{desc => "send rep (to src)", cmd => fun(#{sock_dst := Sock, sa_src := Src, send := Send}) -> - ok = Send(Sock, ?BASIC_REP, Src) + Send(Sock, ?BASIC_REP, Src) end}, #{desc => "recv rep (from dst)", cmd => fun(#{sock_src := Sock, sa_dst := Dst, recv := Recv}) -> - {ok, {Dst, ?BASIC_REP}} = Recv(Sock), - ok + case Recv(Sock) of + {ok, {Dst, ?BASIC_REP}} -> + ok; + {ok, UnexpData} -> + {error, {unexpected_data, UnexpData}}; + {error, _} = ERROR -> + %% At the moment there is no way to get + %% status or state for the socket... + ERROR + end end}, #{desc => "close src socket", cmd => fun(#{sock_src := Sock}) -> @@ -3585,8 +3615,8 @@ api_to_connect_tcp(InitState) -> ?SEV_IPRINT("client node ~p started", [Node]), {ok, State#{node => Node}}; - {error, Reason, _} -> - {error, Reason} + {error, Reason} -> + {skip, Reason} end end}, #{desc => "monitor client node", @@ -3921,7 +3951,7 @@ api_to_connect_tcp_await_timeout2(_ID, To, ServerSA, NewSock) -> case socket:connect(Sock, ServerSA, To) of {error, timeout} -> Stop = t(), - TDiff = tdiff(Start, Stop), + TDiff = Stop - Start, if (TDiff >= To) -> (catch socket:close(Sock)), @@ -4033,7 +4063,7 @@ api_to_accept_tcp(InitState) -> end}, #{desc => "validate timeout time", cmd => fun(#{start := Start, stop := Stop, timeout := To} = _State) -> - TDiff = tdiff(Start, Stop), + TDiff = Stop - Start, if (TDiff >= To) -> ok; @@ -4169,7 +4199,7 @@ api_to_maccept_tcp(InitState) -> end}, #{desc => "validate timeout time", cmd => fun(#{start := Start, stop := Stop, timeout := To} = _State) -> - TDiff = tdiff(Start, Stop), + TDiff = Stop - Start, if (TDiff >= To) -> ok; @@ -4242,7 +4272,7 @@ api_to_maccept_tcp(InitState) -> end}, #{desc => "validate timeout time", cmd => fun(#{start := Start, stop := Stop, timeout := To} = State) -> - TDiff = tdiff(Start, Stop), + TDiff = Stop - Start, if (TDiff >= To) -> State1 = maps:remove(start, State), @@ -4693,7 +4723,7 @@ api_to_receive_tcp(InitState) -> end}, #{desc => "validate timeout time", cmd => fun(#{start := Start, stop := Stop, timeout := To} = State) -> - TDiff = tdiff(Start, Stop), + TDiff = Stop - Start, if (TDiff >= To) -> State1 = maps:remove(start, State), @@ -5000,7 +5030,8 @@ api_to_receive_udp(InitState) -> Start = t(), case Recv(Sock, To) of {error, timeout} -> - {ok, State#{start => Start, stop => t()}}; + {ok, State#{start => Start, + stop => t()}}; {ok, _} -> {error, unexpected_sucsess}; {error, _} = ERROR -> @@ -5009,7 +5040,7 @@ api_to_receive_udp(InitState) -> end}, #{desc => "validate timeout time", cmd => fun(#{start := Start, stop := Stop, timeout := To} = _State) -> - TDiff = tdiff(Start, Stop), + TDiff = Stop - Start, if (TDiff >= To) -> ok; @@ -5021,7 +5052,7 @@ api_to_receive_udp(InitState) -> %% *** Termination *** #{desc => "close socket", cmd => fun(#{sock := Sock} = _State) -> - socket:setopt(Sock, otp, debug, true), + %% socket:setopt(Sock, otp, debug, true), sock_close(Sock), ok end}, @@ -5591,7 +5622,7 @@ sc_lc_receive_response_tcp(InitState) -> State1 = maps:remove(sock, State), {ok, State1}; {error, Reason} = ERROR -> - ?SEV_EPRINT("Unexpected read faulure: " + ?SEV_EPRINT("Unexpected read failure: " "~n ~p", [Reason]), ERROR end @@ -7218,8 +7249,8 @@ sc_rc_receive_response_tcp(InitState) -> {ok, Node} -> ?SEV_IPRINT("client node ~p started", [Node]), {ok, State#{node => Node}}; - {error, Reason, _} -> - {error, Reason} + {error, Reason} -> + {skip, Reason} end end}, #{desc => "monitor client node 1", @@ -8095,8 +8126,8 @@ sc_rs_send_shutdown_receive_tcp(InitState) -> ?SEV_IPRINT("client node ~p started", [Node]), {ok, State#{node => Node}}; - {error, Reason, _} -> - {error, Reason} + {error, Reason} -> + {skip, Reason} end end}, #{desc => "monitor client node", @@ -8987,6 +9018,7 @@ traffic_send_and_recv_chunks_tcp(InitState) -> end}, #{desc => "recv (one big)", cmd => fun(#{tester := Tester, csock := Sock, size := Size} = _State) -> + %% socket:setopt(Sock, otp, debug, true), case socket:recv(Sock, Size) of {ok, Data} -> ?SEV_ANNOUNCE_READY(Tester, @@ -9045,8 +9077,8 @@ traffic_send_and_recv_chunks_tcp(InitState) -> ?SEV_IPRINT("(remote) client node ~p started", [Node]), {ok, State#{node => Node}}; - {error, Reason, _} -> - {error, Reason} + {error, Reason} -> + {skip, Reason} end end}, #{desc => "monitor client node", @@ -10169,7 +10201,7 @@ traffic_ping_pong_small_sendmsg_and_recvmsg_udp4(_Config) when is_list(_Config) Num = ?TPP_SMALL_NUM, tc_try(traffic_ping_pong_small_sendmsg_and_recvmsg_udp4, fun() -> - ?TT(?SECS(20)), + ?TT(?SECS(60)), InitState = #{domain => inet, msg => Msg, num => Num}, @@ -10196,7 +10228,7 @@ traffic_ping_pong_small_sendmsg_and_recvmsg_udp6(_Config) when is_list(_Config) tc_try(traffic_ping_pong_small_sendmsg_and_recvmsg_udp6, fun() -> has_support_ipv6() end, fun() -> - ?TT(?SECS(20)), + ?TT(?SECS(30)), InitState = #{domain => inet, msg => Msg, num => Num}, @@ -10523,8 +10555,8 @@ traffic_ping_pong_send_and_receive_tcp2(InitState) -> ?SEV_IPRINT("(remote) client node ~p started", [Node]), {ok, State#{node => Node}}; - {error, Reason, _} -> - {error, Reason} + {error, Reason} -> + {skip, Reason} end end}, #{desc => "monitor client node", @@ -11044,7 +11076,7 @@ tpp_tcp_client_msg_exchange_loop(Sock, _Send, _Recv, _Msg, end; tpp_tcp_client_msg_exchange_loop(Sock, Send, Recv, Data, Num, N, Sent, Received, Start) -> - %% d("tpp_tcp_client_msg_exchange_loop(~w,~w) try send", [Num,N]), + %% d("tpp_tcp_client_msg_exchange_loop(~w,~w) try send ~w", [Num,N,size(Data)]), case tpp_tcp_send_req(Sock, Send, Data) of {ok, SendSz} -> %% d("tpp_tcp_client_msg_exchange_loop(~w,~w) sent - " @@ -11057,11 +11089,13 @@ tpp_tcp_client_msg_exchange_loop(Sock, Send, Recv, Data, Received+RecvSz, Start); {error, RReason} -> - ?SEV_EPRINT("recv (~w of ~w): ~p", [N, Num, RReason]), + ?SEV_EPRINT("recv (~w of ~w): ~p: " + "~n ~p", [N, Num, RReason, mq()]), exit({recv, RReason, N}) end; {error, SReason} -> - ?SEV_EPRINT("send (~w of ~w): ~p", [N, Num, SReason]), + ?SEV_EPRINT("send (~w of ~w): ~p" + "~n ~p", [N, Num, SReason, mq()]), exit({send, SReason, N}) end. @@ -11121,7 +11155,7 @@ tpp_tcp_recv(Sock, Recv, Tag) -> tpp_tcp_recv(Sock, Recv, Tag, Remains, size(Msg), [Data]); {ok, <<Tag:32/integer, _/binary>>} -> {error, {invalid_msg_tag, Tag}}; - {error, _} = ERROR -> + {error, _R} = ERROR -> ERROR end. @@ -11135,7 +11169,7 @@ tpp_tcp_recv(Sock, Recv, Tag, Remaining, AccSz, Acc) -> tpp_tcp_recv(Sock, Recv, Tag, Remaining - size(Data), AccSz + size(Data), [Data | Acc]); - {error, _} = ERROR -> + {error, _R} = ERROR -> ERROR end. @@ -11173,6 +11207,14 @@ tpp_tcp_send_msg(Sock, Send, Msg, AccSz) when is_binary(Msg) -> %% size_of_iovec([B|IOVec], Sz) -> %% size_of_iovec(IOVec, Sz+size(B)). +mq() -> + mq(self()). + +mq(Pid) when is_pid(Pid) -> + Tag = messages, + {Tag, Msgs} = process_info(Pid, Tag), + Msgs. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -11198,7 +11240,7 @@ traffic_ping_pong_sendmsg_and_recvmsg_udp(InitState) -> MsgHdr = #{addr => Dest, iov => Data}, socket:sendmsg(Sock, MsgHdr) end, - Recv = fun(Sock, Sz) -> + Recv = fun(Sock, Sz) -> case socket:recvmsg(Sock, Sz, 0) of {ok, #{addr := Source, iov := [Data]}} -> @@ -11329,7 +11371,9 @@ traffic_ping_pong_send_and_receive_udp2(InitState) -> [{handler, Handler}]) end}, #{desc => "order handler to recv", - cmd => fun(#{handler := Handler} = _State) -> + cmd => fun(#{handler := Handler, + sock := _Sock} = _State) -> + %% socket:setopt(Sock, otp, debug, true), ?SEV_ANNOUNCE_CONTINUE(Handler, recv), ok end}, @@ -11425,8 +11469,8 @@ traffic_ping_pong_send_and_receive_udp2(InitState) -> ?SEV_IPRINT("(remote) client node ~p started", [Node]), {ok, State#{node => Node}}; - {error, Reason, _} -> - {error, Reason} + {error, Reason} -> + {skip, Reason} end end}, #{desc => "monitor client node", @@ -17272,8 +17316,8 @@ ttest_tcp(InitState) -> case start_node(Host, server) of {ok, Node} -> {ok, State#{node => Node}}; - {error, Reason, _} -> - {error, Reason} + {error, Reason} -> + {skip, Reason} end end}, #{desc => "monitor server node", @@ -17369,8 +17413,8 @@ ttest_tcp(InitState) -> case start_node(Host, client) of {ok, Node} -> {ok, State#{node => Node}}; - {error, Reason, _} -> - {error, Reason} + {error, Reason} -> + {skip, Reason} end end}, #{desc => "monitor client node", @@ -17686,7 +17730,28 @@ ttest_tcp_client_start(Node, %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% This mechanism has only one purpose: So that we are able to kill +%% the node-starter process if it takes to long. The node-starter +%% runs on the local node. +%% This crapola is hopefully temporary, but we have seen that on +%% some platforms the ct_slave:start simply hangs. +-define(NODE_START_TIMEOUT, 10000). start_node(Host, NodeName) -> + start_node(Host, NodeName, ?NODE_START_TIMEOUT). + +start_node(Host, NodeName, Timeout) -> + {NodeStarter, _} = + spawn_monitor(fun() -> exit(start_unique_node(Host, NodeName)) end), + receive + {'DOWN', _, process, NodeStarter, Result} -> + %% i("Node Starter (~p) reported: ~p", [NodeStarter, Result]), + Result + after Timeout -> + exit(NodeStarter, kill), + {error, {failed_starting_node, NodeName, timeout}} + end. + +start_unique_node(Host, NodeName) -> UniqueNodeName = f("~w_~w", [NodeName, erlang:system_time(millisecond)]), case do_start_node(Host, UniqueNodeName) of {ok, _} = OK -> @@ -17720,7 +17785,7 @@ stop_node(Node) -> ERROR end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -17877,9 +17942,15 @@ which_addr2(Domain, [_|IFO]) -> %% Here are all the *general* test vase condition functions. %% The idea is that this function shall test if the test host has -%% support for IPv6. If not there is no point in running IPv6 tests. +%% support for IPv6. If not, there is no point in running IPv6 tests. %% Currently we just skip. has_support_ipv6() -> + %% case socket:supports(ipv6) of + %% true -> + %% ok; + %% false -> + %% {error, not_supported} + %% end. not_yet_implemented(). @@ -17896,8 +17967,10 @@ skip(Reason) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% t() -> - os:timestamp(). + ts(ms). +ts(ms) -> + erlang:monotonic_time(milli_seconds). tdiff({A1, B1, C1} = _T1x, {A2, B2, C2} = _T2x) -> T1 = A1*1000000000+B1*1000+(C1 div 1000), @@ -17930,11 +18003,15 @@ set_tc_name(N) when is_list(N) -> %% get(tc_name). tc_begin(TC) -> + OldVal = process_flag(trap_exit, true), + put(old_trap_exit, OldVal), set_tc_name(TC), tc_print("begin ***", "~n----------------------------------------------------~n", ""). tc_end(Result) when is_list(Result) -> + OldVal = erase(old_trap_exit), + process_flag(trap_exit, OldVal), tc_print("done: ~s", [Result], "", "----------------------------------------------------~n~n"), ok. @@ -17965,26 +18042,44 @@ tc_try(Case, TCCondFun, TCFun) tc_end("ok") end catch - throw:{skip, _} = SKIP -> - tc_end("skipping"), + C:{skip, _} = SKIP when ((C =:= throw) orelse (C =:= exit)) -> + %% i("catched[tc] (skip): " + %% "~n C: ~p" + %% "~n SKIP: ~p" + %% "~n", [C, SKIP]), + tc_end( f("skipping(catched,~w,tc)", [C]) ), SKIP; - Class:Error:Stack -> - tc_end("failed"), - erlang:raise(Class, Error, Stack) + C:E:S -> + %% i("catched[tc]: " + %% "~n C: ~p" + %% "~n E: ~p" + %% "~n S: ~p" + %% "~n", [C, E, S]), + tc_end( f("failed(catched,~w,tc)", [C]) ), + erlang:raise(C, E, S) end; {skip, _} = SKIP -> - tc_end("skipping"), + tc_end("skipping(tc)"), SKIP; {error, Reason} -> - tc_end("failed"), + tc_end("failed(tc)"), exit({tc_cond_failed, Reason}) catch - throw:{skip, _} = SKIP -> - tc_end("skipping"), + C:{skip, _} = SKIP when ((C =:= throw) orelse (C =:= exit)) -> + %% i("catched[cond] (skip): " + %% "~n C: ~p" + %% "~n SKIP: ~p" + %% "~n", [C, SKIP]), + tc_end( f("skipping(catched,~w,cond)", [C]) ), SKIP; - Class:Error:Stack -> - tc_end("failed"), - erlang:raise(Class, Error, Stack) + C:E:S -> + %% i("catched[cond]: " + %% "~n C: ~p" + %% "~n E: ~p" + %% "~n S: ~p" + %% "~n", [C, E, S]), + tc_end( f("failed(catched,~w,cond)", [C]) ), + erlang:raise(C, E, S) end. diff --git a/erts/emulator/test/socket_test_evaluator.erl b/erts/emulator/test/socket_test_evaluator.erl index c5748ac21b..694f0d5f1e 100644 --- a/erts/emulator/test/socket_test_evaluator.erl +++ b/erts/emulator/test/socket_test_evaluator.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018-2018. All Rights Reserved. +%% Copyright Ericsson AB 2018-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -106,12 +106,13 @@ start(Name, Seq, InitState) InitState2 = InitState#{parent => self()}, Pid = erlang:spawn_link( fun() -> init(Name, Seq, InitState2) end), - MRef = erlang:monitor(process, Pid), - #ev{name = Name, pid = Pid, mref = MRef} + %% MRef = erlang:monitor(process, Pid), + #ev{name = Name, pid = Pid}%, mref = MRef} end. init(Name, Seq, Init) -> put(sname, Name), + process_flag(trap_exit, true), loop(1, Seq, Init). loop(_ID, [], FinalState) -> @@ -125,21 +126,26 @@ loop(ID, [#{desc := Desc, {ok, NewState} -> loop(ID + 1, Cmds, NewState); {skip, Reason} -> + ?SEV_IPRINT("command ~w skip: " + "~n ~p", [ID, Reason]), exit({skip, Reason}); {error, Reason} -> - eprint("command ~w failed: " - "~n Reason: ~p", [ID, Reason]), + ?SEV_EPRINT("command ~w failed: " + "~n ~p", [ID, Reason]), exit({command_failed, ID, Reason, State}) catch - throw:{skip, R} = E:_ -> - eprint("command ~w skip: " - "~n Skip Reason: ~p", [ID, R]), + C:{skip, command} = E:_ when ((C =:= throw) orelse (C =:= exit)) -> + %% Secondary skip + exit(E); + C:{skip, R} = E:_ when ((C =:= throw) orelse (C =:= exit)) -> + ?SEV_IPRINT("command ~w skip catched(~w): " + "~n Reason: ~p", [ID, C, R]), exit(E); C:E:S -> - eprint("command ~w crashed: " - "~n Class: ~p" - "~n Error: ~p" - "~n Call Stack: ~p", [ID, C, E, S]), + ?SEV_EPRINT("command ~w crashed: " + "~n Class: ~p" + "~n Error: ~p" + "~n Call Stack: ~p", [ID, C, E, S]), exit({command_crashed, ID, {C,E,S}, State}) end. @@ -168,18 +174,32 @@ await_finish(Evs, OK, Fails) -> {Evs2, OK2, Fails2} = await_finish_normal(Pid, Evs, OK, Fails), await_finish(Evs2, OK2, Fails2); - %% The evaluator can skip the teat case: + %% The evaluator can skip the test case: {'DOWN', _MRef, process, Pid, {skip, Reason}} -> + %% ?SEV_IPRINT("await_finish -> skip (down) received: " + %% "~n Pid: ~p" + %% "~n Reason: ~p", [Pid, Reason]), await_finish_skip(Pid, Reason, Evs, OK); {'EXIT', Pid, {skip, Reason}} -> + %% ?SEV_IPRINT("await_finish -> skip (exit) received: " + %% "~n Pid: ~p" + %% "~n Reason: ~p", [Pid, Reason]), await_finish_skip(Pid, Reason, Evs, OK); %% Evaluator failed {'DOWN', _MRef, process, Pid, Reason} -> - {Evs2, OK2, Fails2} = await_finish_fail(Pid, Reason, Evs, OK, Fails), + %% ?SEV_IPRINT("await_finish -> fail (down) received: " + %% "~n Pid: ~p" + %% "~n Reason: ~p", [Pid, Reason]), + {Evs2, OK2, Fails2} = + await_finish_fail(Pid, Reason, Evs, OK, Fails), await_finish(Evs2, OK2, Fails2); {'EXIT', Pid, Reason} -> - {Evs2, OK2, Fails2} = await_finish_fail(Pid, Reason, Evs, OK, Fails), + %% ?SEV_IPRINT("await_finish -> fail (exit) received: " + %% "~n Pid: ~p" + %% "~n Reason: ~p", [Pid, Reason]), + {Evs2, OK2, Fails2} = + await_finish_fail(Pid, Reason, Evs, OK, Fails), await_finish(Evs2, OK2, Fails2) end. @@ -202,22 +222,83 @@ await_finish_normal(Pid, Evs, OK, Fails) -> end. await_finish_skip(Pid, Reason, Evs, OK) -> - case lists:keysearch(Pid, #ev.pid, Evs) of - {value, #ev{name = Name}} -> - iprint("evaluator '~s' (~p) issued SKIP: " - "~n ~p", [Name, Pid, Reason]); - false -> - case lists:member(Pid, OK) of - true -> - ok; - false -> - iprint("unknown process ~p issued SKIP: " - "~n ~p", [Pid, Reason]) - end - end, + Evs2 = + case lists:keysearch(Pid, #ev.pid, Evs) of + {value, #ev{name = Name}} -> + ?SEV_IPRINT("evaluator '~s' (~p) issued SKIP: " + "~n ~p", [Name, Pid, Reason]), + lists:keydelete(Pid, #ev.pid, Evs); + false -> + case lists:member(Pid, OK) of + true -> + ?SEV_IPRINT("already terminated (ok) process ~p skip" + "~n ~p", [Pid]), + ok; + false -> + ?SEV_IPRINT("unknown process ~p issued SKIP: " + "~n ~p", [Pid, Reason]), + iprint("unknown process ~p issued SKIP: " + "~n ~p", [Pid, Reason]) + end, + Evs + end, + await_evs_terminated(Evs2), ?LIB:skip(Reason). +await_evs_terminated(Evs) -> + Instructions = + [ + %% Just wait for the evaluators to die on their own + {fun() -> ?SEV_IPRINT("await (no action) evs termination") end, + fun(_) -> ok end}, + + %% Send them a skip message, causing the evaluators to + %% die with a skip reason. + {fun() -> ?SEV_IPRINT("await (send skip message) evs termination") end, + fun(#ev{pid = Pid}) -> Pid ! skip end}, + %% And if nothing else works, try to kill the remaining evaluators + {fun() -> ?SEV_IPRINT("await (issue exit kill) evs termination") end, + fun(#ev{pid = Pid}) -> exit(Pid, kill) end}], + + await_evs_terminated(Evs, Instructions). + +await_evs_terminated([], _) -> + ok; +await_evs_terminated(Evs, []) -> + {error, {failed_terminated, [P||#ev{pid=P} <- Evs]}}; +await_evs_terminated(Evs, [{Inform, Command}|Instructions]) -> + Inform(), + lists:foreach(Command, Evs), + RemEvs = await_evs_termination(Evs), + await_evs_terminated(RemEvs, Instructions). + +await_evs_termination(Evs) -> + await_evs_termination(Evs, 2000). + +await_evs_termination([], _Timeout) -> + []; +await_evs_termination(Evs, Timeout) -> + T = t(), + receive + {'DOWN', _MRef, process, Pid, _Reason} -> + %% ?SEV_IPRINT("await_evs_termination -> DOWN: " + %% "~n Pid: ~p" + %% "~n Reason: ~p", [Pid, Reason]), + Evs2 = lists:keydelete(Pid, #ev.pid, Evs), + await_evs_termination(Evs2, tdiff(T, t())); + {'EXIT', Pid, _Reason} -> + %% ?SEV_IPRINT("await_evs_termination -> EXIT: " + %% "~n Pid: ~p" + %% "~n Reason: ~p", [Pid, Reason]), + Evs2 = lists:keydelete(Pid, #ev.pid, Evs), + await_evs_termination(Evs2, tdiff(T, t())) + + after Timeout -> + Evs + end. + + await_finish_fail(Pid, Reason, Evs, OK, Fails) -> case lists:keysearch(Pid, #ev.pid, Evs) of {value, #ev{name = Name}} -> @@ -454,7 +535,7 @@ await_termination(Pid, ExpReason) -> {'DOWN', _, process, Pid, Reason} when (ExpReason =:= Reason) -> ok; {'DOWN', _, process, Pid, Reason} -> - {error, {unexpected_exit, ExpReason, Reason}} + {error, {unexpected_reason, ExpReason, Reason}} end. @@ -480,6 +561,10 @@ await(ExpPid, Name, Announcement, Slogan, OtherPids) is_atom(Slogan) andalso is_list(OtherPids) -> receive + skip -> + %% This means that another evaluator has issued a skip, + %% and we have been instructed to terminate as a result. + ?LIB:skip(command); {Announcement, Pid, Slogan, ?EXTRA_NOTHING} when (ExpPid =:= any) -> {ok, Pid}; {Announcement, Pid, Slogan, Extra} when (ExpPid =:= any) -> @@ -495,12 +580,15 @@ await(ExpPid, Name, Announcement, Slogan, OtherPids) {'DOWN', _, process, Pid, Reason} when (Pid =:= ExpPid) -> eprint("Unexpected DOWN from ~w (~p): " "~n ~p", [Name, Pid, Reason]), - {error, {unexpected_exit, Name}}; + {error, {unexpected_exit, Name, Reason}}; {'DOWN', _, process, OtherPid, Reason} -> case check_down(OtherPid, Reason, OtherPids) of ok -> iprint("DOWN from unknown process ~p: " - "~n ~p", [OtherPid, Reason]), + "~n ~p" + "~n when" + "~n OtherPids: " + "~n ~p", [OtherPid, Reason, OtherPids]), await(ExpPid, Name, Announcement, Slogan, OtherPids); {error, _} = ERROR -> ERROR @@ -527,7 +615,7 @@ check_down(Pid, DownReason, Pids) -> {value, {_, Name}} -> eprint("Unexpected DOWN from ~w (~p): " "~n ~p", [Name, Pid, DownReason]), - {error, {unexpected_exit, Name}}; + {error, {unexpected_exit, Name, DownReason}}; false -> ok end. @@ -561,3 +649,16 @@ print(Prefix, F, A) -> end, ?LOGGER:format("[~s]~s ~s" ++ F, [?LIB:formated_timestamp(), IDStr, Prefix | A]). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +t() -> + os:timestamp(). + + +tdiff({A1, B1, C1} = _T1x, {A2, B2, C2} = _T2x) -> + T1 = A1*1000000000+B1*1000+(C1 div 1000), + T2 = A2*1000000000+B2*1000+(C2 div 1000), + T2 - T1. + diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl index ae3099633a..d278ac86c7 100644 --- a/erts/emulator/test/statistics_SUITE.erl +++ b/erts/emulator/test/statistics_SUITE.erl @@ -93,25 +93,34 @@ wall_clock_zero_diff1(0) -> %% statistics(wall_clock) are compatible, and are within a small number %% of ms of the amount of real time we waited for. wall_clock_update(Config) when is_list(Config) -> - wall_clock_update1(6). + N = 10, + Inc = 200, + TotalTime = wall_clock_update1(N, Inc, 0), + Overhead = TotalTime - N * Inc, + IsDebug = test_server:is_debug(), -wall_clock_update1(N) when N > 0 -> - {T1_wc_time, _} = statistics(wall_clock), - receive after 1000 -> ok end, - {T2_wc_time, Wc_Diff} = statistics(wall_clock), - - Wc_Diff = T2_wc_time - T1_wc_time, - io:format("Wall clock diff = ~p; should be = 1000..1040~n", [Wc_Diff]), - case test_server:is_debug() of - false -> - true = Wc_Diff =< 1040; + %% Check that the average overhead is reasonable. + if + Overhead < N * 100 -> + ok; + IsDebug, Overhead < N * 1000 -> + ok; true -> - true = Wc_Diff =< 2000 %Be more tolerant in debug-compiled emulator. - end, - true = Wc_Diff >= 1000, - wall_clock_update1(N-1); -wall_clock_update1(0) -> - ok. + io:format("There was an overhead of ~p ms during ~p rounds.", + [Overhead,N]), + ct:fail(too_much_overhead) + end. + +wall_clock_update1(N, Inc, Total) when N > 0 -> + {Time1, _} = statistics(wall_clock), + receive after Inc -> ok end, + {Time2, WcDiff} = statistics(wall_clock), + WcDiff = Time2 - Time1, + io:format("Wall clock diff = ~p (expected at least ~p)\n", [WcDiff,Inc]), + true = WcDiff >= Inc, + wall_clock_update1(N-1, Inc, Total + WcDiff); +wall_clock_update1(0, _, Total) -> + Total. %%% Test statistics(runtime). diff --git a/erts/epmd/epmd.mk b/erts/epmd/epmd.mk index f6889a7ff1..b1fd04dc04 100644 --- a/erts/epmd/epmd.mk +++ b/erts/epmd/epmd.mk @@ -67,5 +67,5 @@ EPMD_NODE_TYPE=110 # Distribution format 5 contains the new md5 based handshake. EPMD_DIST_LOW=5 -EPMD_DIST_HIGH=6 +EPMD_DIST_HIGH=5 diff --git a/erts/epmd/src/epmd.h b/erts/epmd/src/epmd.h index 7332294d3d..cffcd4ae7a 100644 --- a/erts/epmd/src/epmd.h +++ b/erts/epmd/src/epmd.h @@ -26,7 +26,6 @@ #define EPMD_ALIVE2_REQ 'x' #define EPMD_PORT2_REQ 'z' #define EPMD_ALIVE2_RESP 'y' -#define EPMD_ALIVE2_X_RESP 'v' #define EPMD_PORT2_RESP 'w' #define EPMD_NAMES_REQ 'n' diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h index a5156a142e..ed9bbdb8cd 100644 --- a/erts/epmd/src/epmd_int.h +++ b/erts/epmd/src/epmd_int.h @@ -277,12 +277,6 @@ static const struct in6_addr in6addr_loopback = #define put_int16(i, s) {((unsigned char*)(s))[0] = ((i) >> 8) & 0xff; \ ((unsigned char*)(s))[1] = (i) & 0xff;} -#define put_int32(i, s) do {((char*)(s))[0] = (char)((i) >> 24) & 0xff; \ - ((char*)(s))[1] = (char)((i) >> 16) & 0xff; \ - ((char*)(s))[2] = (char)((i) >> 8) & 0xff; \ - ((char*)(s))[3] = (char)(i) & 0xff;} \ - while (0) - #if defined(__GNUC__) # define EPMD_INLINE __inline__ #elif defined(__WIN32__) @@ -313,10 +307,10 @@ struct enode { int fd; /* The socket in use */ unsigned short port; /* Port number of Erlang node */ char symname[MAXSYMLEN+1]; /* Name of the Erlang node */ - unsigned int cr_counter; /* Used to generate 'creation' numbers */ + short creation; /* Started as a random number 1..3 */ char nodetype; /* 77 = normal erlang node 72 = hidden (c-node */ char protocol; /* 0 = tcp/ipv4 */ - unsigned short highvsn; /* 5: creation=1..3, 6: creation=1..(2^32-1)*/ + unsigned short highvsn; /* 0 = OTP-R3 erts-4.6.x, 1 = OTP-R4 erts-4.7.x*/ unsigned short lowvsn; int extralen; char extra[MAXSYMLEN+1]; diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 633ec71e5f..3c6f1fbdf4 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -665,21 +665,6 @@ static int do_accept(EpmdVars *g,int listensock) return conn_open(g,msgsock); } -static void bump_creation(Node* node) -{ - if (++node->cr_counter == 0) - node->cr_counter = 1; -} -static unsigned int get_creation(Node* node) -{ - if (node->highvsn >= 6) { - return node->cr_counter; /* 1..(2^32-1)*/ - } - else { - return (node->cr_counter - 1) % 3 + 1; /* 1..3 */ - } -} - /* buf is actually one byte larger than bsize, giving place for null termination */ static void do_request(g, fd, s, buf, bsize) @@ -721,10 +706,8 @@ static void do_request(g, fd, s, buf, bsize) unsigned char protocol; unsigned short highvsn; unsigned short lowvsn; - unsigned int creation; int namelen; int extralen; - int replylen; char *name; char *extra; eport = get_int16(&buf[1]); @@ -754,22 +737,17 @@ static void do_request(g, fd, s, buf, bsize) extra = &buf[11+namelen+2]; extra[extralen]='\000'; - node = node_reg2(g, namelen, name, fd, eport, nodetype, protocol, - highvsn, lowvsn, extralen, extra); - creation = node ? get_creation(node) : 99; - wbuf[1] = node ? 0 : 1; /* ok | error */ - if (highvsn >= 6) { - wbuf[0] = EPMD_ALIVE2_X_RESP; - put_int32(creation, wbuf+2); - replylen = 6; - } - else { - wbuf[0] = EPMD_ALIVE2_RESP; - put_int16(creation, wbuf+2); - replylen = 4; - } + wbuf[0] = EPMD_ALIVE2_RESP; + if ((node = node_reg2(g, namelen, name, fd, eport, nodetype, protocol, + highvsn, lowvsn, extralen, extra)) == NULL) { + wbuf[1] = 1; /* error */ + put_int16(99, wbuf+2); + } else { + wbuf[1] = 0; /* ok */ + put_int16(node->creation, wbuf+2); + } - if (!reply(g, fd, wbuf, replylen)) + if (!reply(g, fd, wbuf, 4)) { node_unreg(g, name); dbg_tty_printf(g,1,"** failed to send ALIVE2_RESP for \"%s\"", @@ -1222,8 +1200,8 @@ static int node_unreg(EpmdVars *g,char *name) for (; node; prev = &node->next, node = node->next) if (is_same_str(node->symname, name)) { - dbg_tty_printf(g,1,"unregistering '%s:%u', port %d", - node->symname, get_creation(node), node->port); + dbg_tty_printf(g,1,"unregistering '%s:%d', port %d", + node->symname, node->creation, node->port); *prev = node->next; /* Link out from "reg" list */ @@ -1257,8 +1235,8 @@ static int node_unreg_sock(EpmdVars *g,int fd) for (; node; prev = &node->next, node = node->next) if (node->fd == fd) { - dbg_tty_printf(g,1,"unregistering '%s:%u', port %d", - node->symname, get_creation(node), node->port); + dbg_tty_printf(g,1,"unregistering '%s:%d', port %d", + node->symname, node->creation, node->port); *prev = node->next; /* Link out from "reg" list */ @@ -1286,8 +1264,19 @@ static int node_unreg_sock(EpmdVars *g,int fd) } /* - * Register a new node + * Finding a node slot and a (name,creation) name is a bit tricky. + * We try in order + * + * 1. If the name was used before and we can reuse that slot but use + * a new "creation" digit in the range 1..3. + * + * 2. We try to find a new unused slot. + * + * 3. We try to use an used slot this isn't used any longer. + * FIXME: The criteria for *what* slot to steal should be improved. + * Perhaps use the oldest or something. */ + static Node *node_reg2(EpmdVars *g, int namelen, char* name, @@ -1357,7 +1346,7 @@ static Node *node_reg2(EpmdVars *g, } /* Try to find the name in the used queue so that we - can change "creation" number */ + can change "creation" number 1..3 */ prev = NULL; @@ -1386,8 +1375,9 @@ static Node *node_reg2(EpmdVars *g, g->nodes.unreg_count--; - /* When reusing we change the "creation" number */ - bump_creation(node); + /* When reusing we change the "creation" number 1..3 */ + + node->creation = node->creation % 3 + 1; break; } @@ -1414,8 +1404,7 @@ static Node *node_reg2(EpmdVars *g, exit(1); } - node->cr_counter = current_time(g); /* "random" */ - bump_creation(node); + node->creation = (current_time(g) % 3) + 1; /* "random" 1-3 */ } } @@ -1434,11 +1423,11 @@ static Node *node_reg2(EpmdVars *g, select_fd_set(g, fd); if (highvsn == 0) { - dbg_tty_printf(g,1,"registering '%s:%u', port %d", - node->symname, get_creation(node), node->port); + dbg_tty_printf(g,1,"registering '%s:%d', port %d", + node->symname, node->creation, node->port); } else { - dbg_tty_printf(g,1,"registering '%s:%u', port %d", - node->symname, get_creation(node), node->port); + dbg_tty_printf(g,1,"registering '%s:%d', port %d", + node->symname, node->creation, node->port); dbg_tty_printf(g,1,"type %d proto %d highvsn %d lowvsn %d", nodetype, protocol, highvsn, lowvsn); } @@ -1572,8 +1561,8 @@ static void print_names(EpmdVars *g) for (node = g->nodes.reg; node; node = node->next) { - fprintf(stderr,"***** active name \"%s#%u\" at port %d, fd = %d\r\n", - node->symname, get_creation(node), node->port, node->fd); + fprintf(stderr,"***** active name \"%s#%d\" at port %d, fd = %d\r\n", + node->symname, node->creation, node->port, node->fd); count ++; } @@ -1583,8 +1572,8 @@ static void print_names(EpmdVars *g) for (node = g->nodes.unreg; node; node = node->next) { - fprintf(stderr,"***** old/unused name \"%s#%u\"\r\n", - node->symname, get_creation(node)); + fprintf(stderr,"***** old/unused name \"%s#%d\"\r\n", + node->symname, node->creation); count ++; } diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index ec4a4ead23..8203c46a39 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -408,7 +408,6 @@ int main(int argc, char **argv) int process_args = 1; int print_args_exit = 0; int print_qouted_cmd_exit = 0; - erts_cpu_info_t *cpuinfo = NULL; char* emu_name; #ifdef __WIN32__ @@ -467,8 +466,6 @@ int main(int argc, char **argv) /* * Construct the path of the executable. */ - cpuinfo = erts_cpu_info_create(); - #if defined(__WIN32__) && defined(WIN32_ALWAYS_DEBUG) emu_type = "debug"; #endif @@ -526,9 +523,6 @@ int main(int argc, char **argv) i++; } - erts_cpu_info_destroy(cpuinfo); - cpuinfo = NULL; - if (malloc_lib) { if (strcmp(malloc_lib, "libc") != 0) usage("+MYm"); @@ -662,15 +656,6 @@ int main(int argc, char **argv) } break; - case 'i': - if (strcmp(argv[i], "-instr") == 0) { - add_Eargs("-Mim"); - add_Eargs("true"); - } - else - add_arg(argv[i]); - break; - case 'e': if (strcmp(argv[i], "-extra") == 0) { process_args = 0; diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index bcd64d242e..8cfc2d549e 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -320,7 +320,7 @@ if [ "x$GDB" = "x" ]; then if [ "$1" = "-p" ]; then echo 'set $etp_rr_run_until_beam = 1' >> $cmdfile fi - cat $ROOTDIR/erts/etc/unix/etp-commands.in >> $cmdfile + cat $ROOTDIR/erts/etc/unix/etp-commands >> $cmdfile exec rr replay -x $cmdfile $* elif [ $1 = ps ]; then shift diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in index dc28107ef5..66d6d20c4e 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -2090,7 +2090,7 @@ define etp-process-info-int etp-pid2proc-1 $etp_proc->common.id etp-process-info $proc else - if (*(((Uint32 *) &($etp_proc->state))) & 0x4) == 0 + if (*(((Uint32 *) &($etp_proc->state))) & 0x800) == 0 if ($etp_proc->common.u.alive.reg) printf " Registered name: " etp-1 $etp_proc->common.u.alive.reg->name @@ -2176,8 +2176,8 @@ end define etp-processes-free-de-int set $de_ix = 0 - while $de_ix < ($arg1) - set $de = ($arg0)+$de_ix + set $de = ($arg0) + while $de set $susp = $de->suspended set $susp_curr = $susp set $first_loop = 1 @@ -2191,7 +2191,7 @@ define etp-processes-free-de-int set $first_loop = 0 set $susp_curr = $susp_curr->next end - set $de_ix++ + set $de = $de->next end end @@ -4124,14 +4124,6 @@ define etp-block-size-1 set $etp_blk_sz = ($arg0)->bhdr & ~7 else # Allocated block - if !$etp_MBC_ABLK_SZ_MASK - if etp_arch_bits == 64 - set $etp_MBC_ABLK_OFFSET_SHIFT = (64 - 24) - else - set $etp_MBC_ABLK_OFFSET_SHIFT = (32 - 9) - end - set $etp_MBC_ABLK_SZ_MASK = ((UWord)1 << $etp_MBC_ABLK_OFFSET_SHIFT) - 1 - 7 - end set $etp_blk_sz = ($arg0)->bhdr & $etp_MBC_ABLK_SZ_MASK end end @@ -4146,14 +4138,7 @@ define etp-block2mbc-1 set $etp_mbc = ($arg0)->u.carrier else # Allocated block - if !$etp_MBC_ABLK_OFFSET_SHIFT - if etp_arch_bits == 64 - set $etp_MBC_ABLK_OFFSET_SHIFT = (64 - 24) - else - set $etp_MBC_ABLK_OFFSET_SHIFT = (32 - 9) - end - end - set $etp_mbc = (Carrier_t*) ((((UWord)($arg0) >> 18) - (($arg0)->bhdr >> $etp_MBC_ABLK_OFFSET_SHIFT)) << 18) + set $etp_mbc = (Carrier_t*) ((((UWord)($arg0) >> 18) - ((($arg0)->bhdr & $etp_MBC_ABLK_OFFSET_MASK) >> $etp_MBC_ABLK_OFFSET_SHIFT)) << 18) end end @@ -4197,7 +4182,7 @@ document etp-smp-atomic %--------------------------------------------------------------------------- end -define etp-carrier-blocks +define etp-carrier-blocks-1 set $etp_crr = (Carrier_t*) $arg0 etp-smp-atomic $etp_crr->allctr $etp_alc set $etp_alc = (Allctr_t*)($etp_alc & ~7) @@ -4209,12 +4194,6 @@ define etp-carrier-blocks set $etp_fblk_cnt = 0 set $etp_aborted = 0 - if $argc == 2 - set $etp_be_silent = $arg1 - else - set $etp_be_silent = 0 - end - while 1 if !$etp_be_silent etp-block $etp_blk @@ -4237,6 +4216,12 @@ define etp-carrier-blocks printf "ERROR: Missing PREV_FREE_BLK_HDR_FLG (2) in block at %#lx\n", $etp_blk set $etp_error_cnt = $etp_error_cnt + 1 end + else + # Prev is ALLOCATED + if ($etp_blk->bhdr & 2) + printf "ERROR: Invalid PREV_FREE_BLK_HDR_FLG (2) set in block at %#lx\n", $etp_blk + set $etp_error_cnt = $etp_error_cnt + 1 + end end end if $etp_blk->bhdr & 1 @@ -4274,13 +4259,31 @@ define etp-carrier-blocks end end -document etp-carrier-blocks +define etp-carrier-print + set $etp_be_silent = 0 + etp-carrier-blocks-1 $arg0 +end + +document etp-carrier-print +%--------------------------------------------------------------------------- +% Print all memory blocks in carrier +% Args: (Carrier_t*) +%--------------------------------------------------------------------------- +end + +define etp-carrier-check + set $etp_be_silent = 1 + etp-carrier-blocks-1 $arg0 +end + +document etp-carrier-check %--------------------------------------------------------------------------- -% Check and (maybe) print all memory blocks in carrier -% Args: (Carrier_t*) [1=be_silent] +% Check all memory blocks in carrier +% Args: (Carrier_t*) %--------------------------------------------------------------------------- end + define etp-address-to-beam-opcode set $etp_i = 0 set $etp_min_diff = ((UWord)1 << (sizeof(UWord)*8 - 1)) @@ -4412,9 +4415,14 @@ define etp-init set $etp_arch64 = (sizeof(void *) == 8) if $etp_arch64 set $etp_nil = 0xfffffffffffffffb + set $etp_MBC_ABLK_OFFSET_BITS = 23 else set $etp_nil = 0xfffffffb + set $etp_MBC_ABLK_OFFSET_BITS = 8 end + set $etp_MBC_ABLK_OFFSET_SHIFT = (sizeof(UWord)*8 - 1 - $etp_MBC_ABLK_OFFSET_BITS) + set $etp_MBC_ABLK_OFFSET_MASK = ((((UWord)1 << $etp_MBC_ABLK_OFFSET_BITS) - 1) << $etp_MBC_ABLK_OFFSET_SHIFT) + set $etp_MBC_ABLK_SZ_MASK = ((UWord)1 << $etp_MBC_ABLK_OFFSET_SHIFT) - 1 - 7 set $etp_flat = 0 set $etp_chart_id = 0 set $etp_chart = 0 diff --git a/erts/etc/unix/to_erl.c b/erts/etc/unix/to_erl.c index ed4fe12e8b..1448980f77 100644 --- a/erts/etc/unix/to_erl.c +++ b/erts/etc/unix/to_erl.c @@ -415,7 +415,7 @@ int main(int argc, char **argv) if (len) { #ifdef DEBUG - (void)write(1, buf, len); + write_all(1, buf, len); #endif if (write_all(wfd, buf, len) != len) { fprintf(stderr, "Error in writing to FIFO.\n"); diff --git a/erts/include/internal/ethr_internal.h b/erts/include/internal/ethr_internal.h index ac27ff2ed0..17ec84c52b 100644 --- a/erts/include/internal/ethr_internal.h +++ b/erts/include/internal/ethr_internal.h @@ -90,7 +90,7 @@ int ethr_init_common__(ethr_init_data *id); int ethr_late_init_common__(ethr_late_init_data *lid); void ethr_run_exit_handlers__(void); void ethr_ts_event_destructor__(void *vtsep); -void ethr_set_stacklimit__(char *prev_c, size_t stacksize); +void ethr_set_stacklimit__(char *prev_c, size_t stacksize) ETHR_NOINLINE; #if defined(ETHR_X86_RUNTIME_CONF__) void ethr_x86_cpuid__(int *eax, int *ebx, int *ecx, int *edx); diff --git a/erts/include/internal/ethread_inline.h b/erts/include/internal/ethread_inline.h index 8e6bcfc4a8..791d7fa0ff 100644 --- a/erts/include/internal/ethread_inline.h +++ b/erts/include/internal/ethread_inline.h @@ -62,12 +62,15 @@ # define ETHR_INLINE __inline__ # if ETHR_AT_LEAST_GCC_VSN__(3, 1, 1) # define ETHR_FORCE_INLINE __inline__ __attribute__((__always_inline__)) +# define ETHR_NOINLINE __attribute__((__noinline__)) # else # define ETHR_FORCE_INLINE __inline__ +# define ETHR_NOINLINE # endif #elif defined(__WIN32__) # define ETHR_INLINE __forceinline # define ETHR_FORCE_INLINE __forceinline +# define ETHR_NOINLINE #endif #endif /* #ifndef ETHREAD_INLINE_H__ */ diff --git a/erts/preloaded/ebin/erl_init.beam b/erts/preloaded/ebin/erl_init.beam Binary files differindex 81be5b021a..0313988e3e 100644 --- a/erts/preloaded/ebin/erl_init.beam +++ b/erts/preloaded/ebin/erl_init.beam diff --git a/erts/preloaded/ebin/net.beam b/erts/preloaded/ebin/net.beam Binary files differindex ebb1296b95..f61b2b4a69 100644 --- a/erts/preloaded/ebin/net.beam +++ b/erts/preloaded/ebin/net.beam diff --git a/erts/preloaded/ebin/socket.beam b/erts/preloaded/ebin/socket.beam Binary files differindex e44dff8475..558a886565 100644 --- a/erts/preloaded/ebin/socket.beam +++ b/erts/preloaded/ebin/socket.beam diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile index efeb92dce9..27d450c873 100644 --- a/erts/preloaded/src/Makefile +++ b/erts/preloaded/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2008-2018. All Rights Reserved. +# Copyright Ericsson AB 2008-2019. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -33,14 +33,22 @@ STATIC_EBIN=../ebin include $(ERL_TOP)/erts/vsn.mk include $(ERL_TOP)/lib/kernel/vsn.mk +ifeq ($(USE_ESOCK), yes) +PRE_LOADED_ERL_ESOCK_MODULES = \ + socket \ + net +else +PRE_LOADED_ERL_ESOCK_MODULES = \ + net +endif + PRE_LOADED_ERL_MODULES = \ erl_prim_loader \ init \ prim_buffer \ prim_file \ prim_inet \ - socket \ - net \ + $(PRE_LOADED_ERL_ESOCK_MODULES) \ zlib \ prim_zip \ erl_init \ @@ -73,6 +81,11 @@ STATIC_TARGET_FILES = $(PRE_LOADED_MODULES:%=$(STATIC_EBIN)/%.$(EMULATOR)) APP_FILE= erts.app APP_SRC= $(APP_FILE).src APP_TARGET= $(STATIC_EBIN)/$(APP_FILE) +ifeq ($(USE_ESOCK), yes) +APP_ESOCK_MODS= net, socket +else +APP_ESOCK_MODS= net +endif KERNEL_SRC=$(ERL_TOP)/lib/kernel/src @@ -94,7 +107,7 @@ copy: cp *.beam $(STATIC_EBIN) $(APP_TARGET): $(APP_SRC) $(ERL_TOP)/erts/vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ + $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' -e 's;%ESOCK_MODS%;$(APP_ESOCK_MODS);' $< > $@ include $(ERL_TOP)/make/otp_release_targets.mk diff --git a/erts/preloaded/src/erl_init.erl b/erts/preloaded/src/erl_init.erl index 6edead362c..d209c4033b 100644 --- a/erts/preloaded/src/erl_init.erl +++ b/erts/preloaded/src/erl_init.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. +%% Copyright Ericsson AB 2000-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -35,8 +35,7 @@ start(Mod, BootArgs) -> erl_tracer:on_load(), prim_buffer:on_load(), prim_file:on_load(), - socket:on_load(), - net:on_load(), + conditional_load(socket, [socket, net]), % socket:on_load(), net:on_load(), %% Proceed to the specified boot module run(Mod, boot, BootArgs). @@ -48,3 +47,24 @@ run(M, F, A) -> true -> M:F(A) end. + +conditional_load(CondMod, Mods2Load) -> + conditional_load(CondMod, erlang:loaded(), Mods2Load). + +conditional_load(_CondMod, [], _Mods2LOad) -> + ok; +conditional_load(CondMod, [CondMod|_], Mods2Load) -> + on_load(Mods2Load); +conditional_load(CondMod, [_|T], Mods2Load) -> + conditional_load(CondMod, T, Mods2Load). + +on_load([]) -> + ok; +on_load([Mod|Mods]) -> + Mod:on_load(), + on_load(Mods). + + + + + diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src index c2a8511b6d..132397b478 100644 --- a/erts/preloaded/src/erts.app.src +++ b/erts/preloaded/src/erts.app.src @@ -36,8 +36,7 @@ atomics, counters, zlib, - net, - socket + %ESOCK_MODS% ]}, {registered, []}, {applications, []}, diff --git a/erts/preloaded/src/net.erl b/erts/preloaded/src/net.erl index a24b5c8ce3..13d2e3a117 100644 --- a/erts/preloaded/src/net.erl +++ b/erts/preloaded/src/net.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018-2018. All Rights Reserved. +%% Copyright Ericsson AB 2018-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -178,12 +178,28 @@ getnameinfo(SockAddr, [] = _Flags) -> getnameinfo(#{family := Fam, addr := _Addr} = SockAddr, Flags) when ((Fam =:= inet) orelse (Fam =:= inet6)) andalso (is_list(Flags) orelse (Flags =:= undefined)) -> - nif_getnameinfo(socket:ensure_sockaddr(SockAddr), Flags); + nif_getnameinfo((catch ensure_sockaddr(SockAddr)), Flags); getnameinfo(#{family := Fam, path := _Path} = SockAddr, Flags) when (Fam =:= local) andalso (is_list(Flags) orelse (Flags =:= undefined)) -> nif_getnameinfo(SockAddr, Flags). +%% This function is intended to "handle" the case when the user +%% has built their (OTP) system with "--disable-esock". +%% That means the socket module does not exist. This is not really +%% a problem since the nif_getnameinfo won't work either (since +%% the nif file is not part of the system). The result of calling +%% getnameinfo will be a undef exception (erlang:nif_error(undef)). +%% +%% The only functions in this module that actually work in this case +%% (--disable-esock) is the depricated stuff (call, cast, ...). +%% +ensure_sockaddr(SockAddr) -> + try socket:ensure_sockaddr(SockAddr) + catch + error:undef:_ -> + undefined + end. %% =========================================================================== %% @@ -334,3 +350,4 @@ nif_if_index2name(_Id) -> nif_if_names() -> erlang:nif_error(undef). + diff --git a/erts/preloaded/src/socket.erl b/erts/preloaded/src/socket.erl index 5c1647290d..126db66cdd 100644 --- a/erts/preloaded/src/socket.erl +++ b/erts/preloaded/src/socket.erl @@ -520,7 +520,7 @@ %% necessary adapt (increase) the buffer size until all of %% it fits. %% -%% Note that not all of these flags is useful for every recv function! +%% Note that not all of these flags are useful for every recv function! %% -type recv_flags() :: [recv_flag()]. -type recv_flag() :: cmsg_cloexec | @@ -531,7 +531,6 @@ -type shutdown_how() :: read | write | read_write. -%% These are just place-holder(s) - used by the sendmsg/recvmsg functions... -type msghdr_flag() :: ctrunc | eor | errqueue | oob | trunc. -type msghdr_flags() :: [msghdr_flag()]. -type msghdr() :: #{ @@ -586,6 +585,12 @@ #{level := integer(), type := integer(), data := binary()}. +%% This is used in messages sent from the nif-code to erlang processes: +%% +%% {?SOCKET_TAG, Socket :: socket(), Tag :: atom(), Info :: term()} +%% +-define(SOCKET_TAG, '$socket'). + -define(SOCKET_DOMAIN_LOCAL, 1). -define(SOCKET_DOMAIN_UNIX, ?SOCKET_DOMAIN_LOCAL). -define(SOCKET_DOMAIN_INET, 2). @@ -949,77 +954,50 @@ supports(_Key1, _Key2, _Key3) -> %% =========================================================================== %% -%% open - create an endpoint for communication -%% -%% Extra: netns -%% %% <KOLLA> %% %% How do we handle the case when an fd has been created (somehow) %% and we shall create a socket "from it". %% Can we figure out Domain, Type and Protocol from fd? -%% Yes we can: SO_DOMAIN, SO_PROTOCOL, SO_TYPE -%% But does that work on all platforms? Or shall we require that the -%% caller provide this explicitly? -%% +%% No we can't: For instance, its not possible to 'get' domain on FreeBSD. +%% +%% Instead, require: open(Domain, Stream, Proto, #{fd => FD}). +%% The last argument, Extra, is used to provide the fd. +%% %% </KOLLA> %% %% %% <KOLLA> %% -%% Start a controller process here, *before* the nif_open call. -%% If that call is successful, update with owner process (controlling -%% process) and SockRef. If the open fails, kill the process. -%% "Register" the process on success: -%% -%% nif_register(SockRef, self()). -%% -%% <ALSO> -%% -%% Maybe register the process under a name? -%% Something like: -%% -%% list_to_atom(lists:flatten(io_lib:format("socket-~p", [SockRef]))). -%% -%% </ALSO> +%% Possibly add a "registry" in the nif, allowing the user processes to +%% "register" themselves. +%% The point of this would be to ensure that these processes are +%% informed if the socket "terminates". Could possibly be used for +%% other things? If gen_tcp implements the active feature using +%% a reader process, the nif may need to know about this process, +%% since its probably "hidden" from the socket "owner" (someone +%% needs to handle it if it dies). +%% Register under a name? %% %% The nif sets up a monitor to this process, and if it dies the socket %% is closed. It is also used if someone wants to monitor the socket. %% -%% We therefor need monitor function(s): +%% We may therefor need monitor function(s): %% %% socket:monitor(Socket) %% socket:demonitor(Socket) %% -%% These are basically used to monitor the controller process. -%% Should the socket record therefor contain the pid of the controller process? -%% %% </KOLLA> %% -%% -spec open(FD) -> {ok, Socket} | {error, Reason} when -%% Socket :: socket(), -%% Reason :: term(). - -%% open(FD) -> -%% try -%% begin -%% case nif_open(FD) of -%% {ok, {SockRef, Domain, Type, Protocol}} -> -%% SocketInfo = #{domain => Domain, -%% type => Type, -%% protocol => Protocol}, -%% Socket = #socket{info = SocketInfo, -%% ref = SockRef}, -%% {ok, Socket}; -%% {error, _} = ERROR -> -%% ERROR -%% end -%% end -%% catch -%% _:_ -> % This must be improved!! -%% {error, einval} -%% end. + + +%% =========================================================================== +%% +%% open - create an endpoint for communication +%% +%% Extra: Currently only used for netns +%% -spec open(Domain, Type) -> {ok, Socket} | {error, Reason} when Domain :: domain(), @@ -1245,21 +1223,7 @@ connect(#socket{ref = SockRef}, #{family := Fam} = SockAddr, Timeout) %% Connecting... NewTimeout = next_timeout(TS, Timeout), receive - {select, SockRef, Ref, ready_output} -> - %% <KOLLA> - %% - %% See open above!! - %% - %% * Here we should start and *register* the reader process - %% (This will cause the nif code to create a monitor to - %% the process) - %% * The reader is basically used to implement the active-X - %% feature! - %% * If the reader dies for whatever reason, then the socket - %% (resource) closes and the owner (controlling) process - %% is informed (closed message). - %% - %% </KOLLA> + {?SOCKET_TAG, #socket{ref = SockRef}, select, Ref} -> nif_finalize_connection(SockRef) after NewTimeout -> cancel(SockRef, connect, Ref), @@ -1325,16 +1289,6 @@ do_accept(LSockRef, Timeout) -> AccRef = make_ref(), case nif_accept(LSockRef, AccRef) of {ok, SockRef} -> - %% <KOLLA> - %% - %% * Here we should start and *register* the reader process - %% (This will cause the nif code to create a monitor to the process) - %% * The reader is basically used to implement the active-X feature! - %% * If the reader dies for whatever reason, then the socket (resource) - %% closes and the owner (controlling) process is informed (closed - %% message). - %% - %% </KOLLA> Socket = #socket{ref = SockRef}, {ok, Socket}; @@ -1344,10 +1298,10 @@ do_accept(LSockRef, Timeout) -> %% the receive. NewTimeout = next_timeout(TS, Timeout), receive - {select, LSockRef, AccRef, ready_input} -> + {?SOCKET_TAG, #socket{ref = LSockRef}, select, AccRef} -> do_accept(LSockRef, next_timeout(TS, Timeout)); - {'$socket', _, abort, {AccRef, Reason}} -> + {?SOCKET_TAG, _Socket, abort, {AccRef, Reason}} -> {error, Reason} after NewTimeout -> @@ -1416,15 +1370,17 @@ do_send(SockRef, Data, EFlags, Timeout) -> NewTimeout = next_timeout(TS, Timeout), %% We are partially done, wait for continuation receive - {select, SockRef, SendRef, ready_output} when (Written > 0) -> + {?SOCKET_TAG, #socket{ref = SockRef}, select, SendRef} + when (Written > 0) -> <<_:Written/binary, Rest/binary>> = Data, do_send(SockRef, Rest, EFlags, next_timeout(TS, Timeout)); - {select, SockRef, SendRef, ready_output} -> + + {?SOCKET_TAG, #socket{ref = SockRef}, select, SendRef} -> do_send(SockRef, Data, EFlags, next_timeout(TS, Timeout)); - {'$socket', _, abort, {SendRef, Reason}} -> + {?SOCKET_TAG, _Socket, abort, {SendRef, Reason}} -> {error, Reason} after NewTimeout -> @@ -1433,11 +1389,11 @@ do_send(SockRef, Data, EFlags, Timeout) -> end; {error, eagain} -> receive - {select, SockRef, SendRef, ready_output} -> + {?SOCKET_TAG, #socket{ref = SockRef}, select, SendRef} -> do_send(SockRef, Data, EFlags, next_timeout(TS, Timeout)); - {'$socket', _, abort, {SendRef, Reason}} -> + {?SOCKET_TAG, _Socket, abort, {SendRef, Reason}} -> {error, Reason} after Timeout -> @@ -1521,15 +1477,17 @@ do_sendto(SockRef, Data, Dest, EFlags, Timeout) -> {ok, Written} -> %% We are partially done, wait for continuation receive - {select, SockRef, SendRef, ready_output} when (Written > 0) -> + {?SOCKET_TAG, #socket{ref = SockRef}, select, SendRef} + when (Written > 0) -> <<_:Written/binary, Rest/binary>> = Data, do_sendto(SockRef, Rest, Dest, EFlags, next_timeout(TS, Timeout)); - {select, SockRef, SendRef, ready_output} -> + + {?SOCKET_TAG, #socket{ref = SockRef}, select, SendRef} -> do_sendto(SockRef, Data, Dest, EFlags, next_timeout(TS, Timeout)); - {'$socket', _, abort, {SendRef, Reason}} -> + {?SOCKET_TAG, _Socket, abort, {SendRef, Reason}} -> {error, Reason} after Timeout -> @@ -1539,11 +1497,11 @@ do_sendto(SockRef, Data, Dest, EFlags, Timeout) -> {error, eagain} -> receive - {select, SockRef, SendRef, ready_output} -> + {?SOCKET_TAG, #socket{ref = SockRef}, select, SendRef} -> do_sendto(SockRef, Data, Dest, EFlags, next_timeout(TS, Timeout)); - {'$socket', _, abort, {SendRef, Reason}} -> + {?SOCKET_TAG, _Socket, abort, {SendRef, Reason}} -> {error, Reason} after Timeout -> @@ -1593,7 +1551,8 @@ sendmsg(Socket, MsgHdr, Timeout) sendmsg(Socket, MsgHdr, ?SOCKET_SENDMSG_FLAGS_DEFAULT, Timeout). --spec sendmsg(Socket, MsgHdr, Flags, Timeout) -> ok | {ok, Remaining} | {error, Reason} when +-spec sendmsg(Socket, MsgHdr, Flags, Timeout) -> + ok | {ok, Remaining} | {error, Reason} when Socket :: socket(), MsgHdr :: msghdr(), Flags :: send_flags(), @@ -1625,7 +1584,6 @@ do_sendmsg(SockRef, MsgHdr, EFlags, Timeout) -> ok; {ok, Written} when is_integer(Written) andalso (Written > 0) -> - %% We should not retry here since the protocol may not %% be able to handle a message being split. Leave it to %% the caller to figure out (call again with the rest). @@ -1638,9 +1596,10 @@ do_sendmsg(SockRef, MsgHdr, EFlags, Timeout) -> {error, eagain} -> receive - {select, SockRef, SendRef, ready_output} -> + {?SOCKET_TAG, #socket{ref = SockRef}, select, SendRef} -> do_sendmsg(SockRef, MsgHdr, EFlags, next_timeout(TS, Timeout)) + after Timeout -> cancel(SockRef, sendmsg, SendRef), {error, timeout} @@ -1668,13 +1627,6 @@ ensure_msghdr(_) -> %% =========================================================================== %% -%% writev - write data into multiple buffers -%% - - - -%% =========================================================================== -%% %% recv, recvfrom, recvmsg - receive a message from a socket %% %% Description: @@ -1757,14 +1709,10 @@ do_recv(SockRef, _OldRef, Length, EFlags, Acc, Timeout) (is_integer(Timeout) andalso (Timeout > 0)) -> TS = timestamp(Timeout), RecvRef = make_ref(), - %% p("do_recv -> try read with" - %% "~n Length: ~p", [Length]), case nif_recv(SockRef, RecvRef, Length, EFlags) of {ok, true = _Complete, Bin} when (size(Acc) =:= 0) -> - %% p("do_recv -> complete success: ~w", [size(Bin)]), {ok, Bin}; {ok, true = _Complete, Bin} -> - %% p("do_recv -> completed success: ~w (~w)", [size(Bin), size(Acc)]), {ok, <<Acc/binary, Bin/binary>>}; %% It depends on the amount of bytes we tried to read: @@ -1773,7 +1721,6 @@ do_recv(SockRef, _OldRef, Length, EFlags, Acc, Timeout) %% > 0 - We got a part of the message and we will be notified %% when there is more to read (a select message) {ok, false = _Complete, Bin} when (Length =:= 0) -> - %% p("do_recv -> partial success: ~w", [size(Bin)]), do_recv(SockRef, RecvRef, Length, EFlags, <<Acc/binary, Bin/binary>>, @@ -1783,17 +1730,15 @@ do_recv(SockRef, _OldRef, Length, EFlags, Acc, Timeout) %% We got the first chunk of it. %% We will be notified (select message) when there %% is more to read. - %% p("do_recv -> partial success(~w): ~w" - %% "~n ~p", [Length, size(Bin), Bin]), NewTimeout = next_timeout(TS, Timeout), receive - {select, SockRef, RecvRef, ready_input} -> + {?SOCKET_TAG, #socket{ref = SockRef}, select, RecvRef} -> do_recv(SockRef, RecvRef, Length-size(Bin), EFlags, Bin, next_timeout(TS, Timeout)); - {'$socket', _, abort, {RecvRef, Reason}} -> + {?SOCKET_TAG, _Socket, abort, {RecvRef, Reason}} -> {error, Reason} after NewTimeout -> @@ -1803,17 +1748,15 @@ do_recv(SockRef, _OldRef, Length, EFlags, Acc, Timeout) {ok, false = _Completed, Bin} -> %% We got a chunk of it! - %% p("do_recv -> partial success(~w): ~w (~w)", - %% [Length, size(Bin), size(Acc)]), NewTimeout = next_timeout(TS, Timeout), receive - {select, SockRef, RecvRef, ready_input} -> + {?SOCKET_TAG, #socket{ref = SockRef}, select, RecvRef} -> do_recv(SockRef, RecvRef, Length-size(Bin), EFlags, <<Acc/binary, Bin/binary>>, next_timeout(TS, Timeout)); - {'$socket', _, abort, {RecvRef, Reason}} -> + {?SOCKET_TAG, _Socket, abort, {RecvRef, Reason}} -> {error, Reason} after NewTimeout -> @@ -1829,16 +1772,15 @@ do_recv(SockRef, _OldRef, Length, EFlags, Acc, Timeout) {error, eagain} -> %% There is nothing just now, but we will be notified when there %% is something to read (a select message). - %% p("do_recv -> eagain(~w): ~w", [Length, size(Acc)]), NewTimeout = next_timeout(TS, Timeout), receive - {select, SockRef, RecvRef, ready_input} -> + {?SOCKET_TAG, #socket{ref = SockRef}, select, RecvRef} -> do_recv(SockRef, RecvRef, Length, EFlags, Acc, next_timeout(TS, Timeout)); - {'$socket', _, abort, {RecvRef, Reason}} -> + {?SOCKET_TAG, _Socket, abort, {RecvRef, Reason}} -> {error, Reason} after NewTimeout -> @@ -1887,7 +1829,7 @@ do_recv(_SockRef, _RecvRef, _Length, _EFlags, _Acc, _Timeout) -> %% It may be impossible to know what (buffer) size is appropriate %% "in advance", and in those cases it may be convenient to use the %% (recv) 'peek' flag. When this flag is provided the message is *not* -%% "consumed" from the underlying buffers, so another recvfrom call +%% "consumed" from the underlying (OS) buffers, so another recvfrom call %% is needed, possibly with a then adjusted buffer size. %% @@ -1973,11 +1915,11 @@ do_recvfrom(SockRef, BufSz, EFlags, Timeout) -> %% is something to read (a select message). NewTimeout = next_timeout(TS, Timeout), receive - {select, SockRef, RecvRef, ready_input} -> + {?SOCKET_TAG, #socket{ref = SockRef}, select, RecvRef} -> do_recvfrom(SockRef, BufSz, EFlags, next_timeout(TS, Timeout)); - {'$socket', _, abort, {RecvRef, Reason}} -> + {?SOCKET_TAG, _Socket, abort, {RecvRef, Reason}} -> {error, Reason} after NewTimeout -> @@ -1990,13 +1932,6 @@ do_recvfrom(SockRef, BufSz, EFlags, Timeout) -> end. -%% pi(Item) -> -%% pi(self(), Item). - -%% pi(Pid, Item) -> -%% {Item, Info} = process_info(Pid, Item), -%% Info. - %% --------------------------------------------------------------------------- %% @@ -2077,11 +2012,11 @@ do_recvmsg(SockRef, BufSz, CtrlSz, EFlags, Timeout) -> %% is something to read (a select message). NewTimeout = next_timeout(TS, Timeout), receive - {select, SockRef, RecvRef, ready_input} -> + {?SOCKET_TAG, #socket{ref = SockRef}, select, RecvRef} -> do_recvmsg(SockRef, BufSz, CtrlSz, EFlags, next_timeout(TS, Timeout)); - {'$socket', _, abort, {RecvRef, Reason}} -> + {?SOCKET_TAG, _Socket, abort, {RecvRef, Reason}} -> {error, Reason} after NewTimeout -> @@ -2100,12 +2035,6 @@ do_recvmsg(SockRef, BufSz, CtrlSz, EFlags, Timeout) -> -%% =========================================================================== -%% -%% readv - read data into multiple buffers -%% - - %% =========================================================================== %% @@ -2118,10 +2047,9 @@ do_recvmsg(SockRef, BufSz, CtrlSz, EFlags, Timeout) -> %% 1) nif_close + the socket_stop (nif) callback function %% This is for everything that can be done safely NON-BLOCKING. %% 2) nif_finalize_close which is executed by a *dirty* scheduler -%% Before we call the socket close function, we se the socket +%% Before we call the socket close function, we set the socket %% BLOCKING. Thereby linger is handled properly. - -spec close(Socket) -> ok | {error, Reason} when Socket :: socket(), Reason :: term(). @@ -2137,7 +2065,7 @@ do_close(SockRef) -> %% We must wait for the socket_stop callback function to %% complete its work receive - {'$socket', SockRef, close, CloseRef} -> + {?SOCKET_TAG, #socket{ref = SockRef}, close, CloseRef} -> nif_finalize_close(SockRef) end; {error, _} = ERROR -> @@ -2381,6 +2309,8 @@ which_protocol(SockRef) -> end. + + %% =========================================================================== %% %% sockname - return the current address of the socket. @@ -3499,7 +3429,7 @@ cancel(SockRef, Op, OpRef) -> flush_select_msgs(SockRef, Ref) -> receive - {select, SockRef, Ref, _} -> + {?SOCKET_TAG, #socket{ref = SockRef}, select, Ref} -> flush_select_msgs(SockRef, Ref) after 0 -> ok @@ -3568,8 +3498,9 @@ tdiff(T1, T2) -> %% p(undefined, F, A) -> %% p("***", F, A); %% p(SName, F, A) -> -%% io:format(user,"[~s,~p] " ++ F ++ "~n", [SName, self()|A]), -%% io:format("[~s,~p] " ++ F ++ "~n", [SName, self()|A]). +%% TS = formated_timestamp(), +%% io:format(user,"[~s][~s,~p] " ++ F ++ "~n", [TS, SName, self()|A]), +%% io:format("[~s][~s,~p] " ++ F ++ "~n", [TS, SName, self()|A]). diff --git a/erts/test/erl_print_SUITE.erl b/erts/test/erl_print_SUITE.erl index 0a5987df88..463d890688 100644 --- a/erts/test/erl_print_SUITE.erl +++ b/erts/test/erl_print_SUITE.erl @@ -324,9 +324,6 @@ run_case(Config, TestArgs, Fun) -> -define(PORT_EXT, 102). -define(PID_EXT, 103). -define(NEW_REFERENCE_EXT, 114). --define(NEW_PID_EXT, $X). --define(NEW_PORT_EXT, $Y). --define(NEWER_REFERENCE_EXT, $Z). uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 -> [(Uint bsr 24) band 16#ff, @@ -354,13 +351,13 @@ mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> mk_pid({atom_to_list(NodeName), Creation}, Number, Serial); mk_pid({NodeName, Creation}, Number, Serial) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?NEW_PID_EXT, + ?PID_EXT, ?ATOM_EXT, uint16_be(length(NodeName)), NodeName, uint32_be(Number), uint32_be(Serial), - uint32_be(Creation)])) of + uint8(Creation)])) of Pid when is_pid(Pid) -> Pid; {'EXIT', {badarg, _}} -> @@ -373,12 +370,12 @@ mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> mk_port({atom_to_list(NodeName), Creation}, Number); mk_port({NodeName, Creation}, Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?NEW_PORT_EXT, + ?PORT_EXT, ?ATOM_EXT, uint16_be(length(NodeName)), NodeName, uint32_be(Number), - uint32_be(Creation)])) of + uint8(Creation)])) of Port when is_port(Port) -> Port; {'EXIT', {badarg, _}} -> @@ -391,16 +388,33 @@ mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), is_integer(Creation), is_list(Numbers) -> mk_ref({atom_to_list(NodeName), Creation}, Numbers); +mk_ref({NodeName, Creation}, [Number]) when is_list(NodeName), + is_integer(Creation), + is_integer(Number) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?REFERENCE_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint8(Creation)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end; mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), is_integer(Creation), is_list(Numbers) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?NEWER_REFERENCE_EXT, + ?NEW_REFERENCE_EXT, uint16_be(length(Numbers)), ?ATOM_EXT, uint16_be(length(NodeName)), NodeName, - uint32_be(Creation), + uint8(Creation), lists:map(fun (N) -> uint32_be(N) end, @@ -415,10 +429,11 @@ mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), my_cre() -> erlang:system_info(creation). -oth_cre(N) when N >= 0, N < (1 bsl 32) -> - (N rem ((1 bsl 32) - 1)) + 1; -oth_cre(N) -> - exit({invalid_creation, N}). +oth_cre(0) -> 1; +oth_cre(1) -> 2; +oth_cre(2) -> 3; +oth_cre(3) -> 1; +oth_cre(N) -> exit({invalid_creation, N}). str_1_bsl_10000() -> "19950631168807583848837421626835850838234968318861924548520089498529438830221946631919961684036194597899331129423209124271556491349413781117593785932096323957855730046793794526765246551266059895520550086918193311542508608460618104685509074866089624888090489894838009253941633257850621568309473902556912388065225096643874441046759871626985453222868538161694315775629640762836880760732228535091641476183956381458969463899410840960536267821064621427333394036525565649530603142680234969400335934316651459297773279665775606172582031407994198179607378245683762280037302885487251900834464581454650557929601414833921615734588139257095379769119277800826957735674444123062018757836325502728323789270710373802866393031428133241401624195671690574061419654342324638801248856147305207431992259611796250130992860241708340807605932320161268492288496255841312844061536738951487114256315111089745514203313820202931640957596464756010405845841566072044962867016515061920631004186422275908670900574606417856951911456055068251250406007519842261898059237118054444788072906395242548339221982707404473162376760846613033778706039803413197133493654622700563169937455508241780972810983291314403571877524768509857276937926433221599399876886660808368837838027643282775172273657572744784112294389733810861607423253291974813120197604178281965697475898164531258434135959862784130128185406283476649088690521047580882615823961985770122407044330583075869039319604603404973156583208672105913300903752823415539745394397715257455290510212310947321610753474825740775273986348298498340756937955646638621874569499279016572103701364433135817214311791398222983845847334440270964182851005072927748364550578634501100852987812389473928699540834346158807043959118985815145779177143619698728131459483783202081474982171858011389071228250905826817436220577475921417653715687725614904582904992461028630081535583308130101987675856234343538955409175623400844887526162643568648833519463720377293240094456246923254350400678027273837755376406726898636241037491410966718557050759098100246789880178271925953381282421954028302759408448955014676668389697996886241636313376393903373455801407636741877711055384225739499110186468219696581651485130494222369947714763069155468217682876200362777257723781365331611196811280792669481887201298643660768551639860534602297871557517947385246369446923087894265948217008051120322365496288169035739121368338393591756418733850510970271613915439590991598154654417336311656936031122249937969999226781732358023111862644575299135758175008199839236284615249881088960232244362173771618086357015468484058622329792853875623486556440536962622018963571028812361567512543338303270029097668650568557157505516727518899194129711337690149916181315171544007728650573189557450920330185304847113818315407324053319038462084036421763703911550639789000742853672196280903477974533320468368795868580237952218629120080742819551317948157624448298518461509704888027274721574688131594750409732115080498190455803416826949787141316063210686391511681774304792596709376". diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl index 6a34299dd2..536212af2e 100644 --- a/erts/test/z_SUITE.erl +++ b/erts/test/z_SUITE.erl @@ -88,10 +88,10 @@ find_cerl(DBTop) -> [Cerl | _ ] -> case filelib:is_regular(Cerl) of true -> Cerl; - _ -> false + _ -> find_cerl(false) end; _ -> - false + find_cerl(false) end. is_dir(false) -> diff --git a/erts/vsn.mk b/erts/vsn.mk index 3942af7f78..fafcdf3b28 100644 --- a/erts/vsn.mk +++ b/erts/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% # -VSN = 10.3.1 +VSN = 10.3.4 # Port number 4365 in 4.2 # Port number 4366 in 4.3 diff --git a/lib/common_test/doc/src/common_test_app.xml b/lib/common_test/doc/src/common_test_app.xml index 7887a2c3ea..081adeaec7 100644 --- a/lib/common_test/doc/src/common_test_app.xml +++ b/lib/common_test/doc/src/common_test_app.xml @@ -72,14 +72,15 @@ <fsummary>Returns the list of all test case groups and test cases in the module.</fsummary> <type> - <v>Tests = [TestCase | {group,GroupName} | {group,GroupName,Properties} | {group,GroupName,Properties,SubGroups}]</v> + <v>Tests = [TestCase | {testcase,TestCase,TCRepeatProps} | {group,GroupName} | {group,GroupName,Properties} | {group,GroupName,Properties,SubGroups}]</v> <v>TestCase = atom()</v> + <v>TCRepeatProps = [{repeat,N} | {repeat_until_ok,N} | {repeat_until_fail,N}]</v> <v>GroupName = atom()</v> - <v>Properties = [parallel | sequence | Shuffle | {RepeatType,N}] | default</v> + <v>Properties = [parallel | sequence | Shuffle | {GroupRepeatType,N}] | default</v> <v>SubGroups = [{GroupName,Properties} | {GroupName,Properties,SubGroups}]</v> <v>Shuffle = shuffle | {shuffle,Seed}</v> <v>Seed = {integer(),integer(),integer()}</v> - <v>RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | repeat_until_any_ok | repeat_until_any_fail</v> + <v>GroupRepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | repeat_until_any_ok | repeat_until_any_fail</v> <v>N = integer() | forever</v> <v>Reason = term()</v> </type> @@ -91,7 +92,8 @@ test suite module to be executed. This list also specifies the order the cases and groups are executed by <c>Common Test</c>. A test case is represented by an atom, - the name of the test case function. A test case group is + the name of the test case function, or a <c>testcase</c> tuple + indicating that the test case shall be repeated. A test case group is represented by a <c>group</c> tuple, where <c>GroupName</c>, an atom, is the name of the group (defined in <seealso marker="#Module:groups-0"><c>groups/0</c></seealso>). @@ -121,12 +123,13 @@ <v>GroupDefs = [Group]</v> <v>Group = {GroupName,Properties,GroupsAndTestCases}</v> <v>GroupName = atom()</v> - <v>Properties = [parallel | sequence | Shuffle | {RepeatType,N}]</v> - <v>GroupsAndTestCases = [Group | {group,GroupName} | TestCase]</v> + <v>Properties = [parallel | sequence | Shuffle | {GroupRepeatType,N}]</v> + <v>GroupsAndTestCases = [Group | {group,GroupName} | TestCase | {testcase,TestCase,TCRepeatProps}]</v> <v>TestCase = atom()</v> + <v>TCRepeatProps = [{repeat,N} | {repeat_until_ok,N} | {repeat_until_fail,N}]</v> <v>Shuffle = shuffle | {shuffle,Seed}</v> <v>Seed = {integer(),integer(),integer()}</v> - <v>RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | repeat_until_any_ok | repeat_until_any_fail</v> + <v>GroupRepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | repeat_until_any_ok | repeat_until_any_fail</v> <v>N = integer() | forever</v> </type> diff --git a/lib/common_test/doc/src/ct_hooks.xml b/lib/common_test/doc/src/ct_hooks.xml index ff0d0117cd..ff9969ebc3 100644 --- a/lib/common_test/doc/src/ct_hooks.xml +++ b/lib/common_test/doc/src/ct_hooks.xml @@ -109,6 +109,131 @@ </func> <func> + <name since="OTP @OTP-14746@">Module:post_groups(SuiteName, GroupDefs) -> NewGroupDefs</name> + <fsummary>Called after groups/0.</fsummary> + <type> + <v>SuiteName = atom()</v> + <v>GroupDefs = NewGroupDefs = [Group]</v> + <v>Group = {GroupName,Properties,GroupsAndTestCases}</v> + <v>GroupName = atom()</v> + <v>Properties = [parallel | sequence | Shuffle | {GroupRepeatType,N}]</v> + <v>GroupsAndTestCases = [Group | {group,GroupName} | TestCase | {testcase,TestCase,TCRepeatProps}]</v> + <v>TestCase = atom()</v> + <v>TCRepeatProps = [{repeat,N} | {repeat_until_ok,N} | {repeat_until_fail,N}]</v> + <v>Shuffle = shuffle | {shuffle,Seed}</v> + <v>Seed = {integer(),integer(),integer()}</v> + <v>GroupRepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | repeat_until_any_ok | repeat_until_any_fail</v> + <v>N = integer() | forever</v> + </type> + <desc> + <p>OPTIONAL</p> + + <p>This function is called after + <seealso marker="common_test#Module:groups-0"><c>groups/0</c></seealso>. + It is used to modify the test group definitions, for + instance to add or remove groups or change group properties.</p> + + <p><c>GroupDefs</c> is what + <seealso marker="common_test#Module:groups-0"><c>groups/0</c></seealso> + returned, that is, a list of group definitions.</p> + + <p><c>NewGroupDefs</c> is the possibly modified version of this list.</p> + + <p>This function is called only if the CTH is added before + <c>init_per_suite</c> is run. For details, see section + <seealso marker="ct_hooks_chapter#scope">CTH Scope</seealso> + in the User's Guide.</p> + + <p>Notice that for CTHs that are installed by means of the + <seealso marker="common_test#Module:suite-0"><c>suite/0</c></seealso> + function, <c>post_groups/2</c> is called before + the <seealso marker="#Module:init-2"><c>init/2</c></seealso> + hook function. However, for CTHs that are installed by means + of the CT start flag, + the <seealso marker="#Module:init-2"><c>init/2</c></seealso> + function is called first.</p> + + <note> + <p>Prior to each test execution, Common Test does a + simulated test run in order to count test suites, groups + and cases for logging purposes. This causes + the <c>post_groups/2</c> hook function to always be called + twice. For this reason, side effects are best avoided in + this callback.</p> + </note> + </desc> + </func> + + <func> + <name since="OTP @OTP-14746@">Module:post_all(SuiteName, Return, GroupDefs) -> NewReturn</name> + <fsummary>Called after all/0.</fsummary> + <type> + <v>SuiteName = atom()</v> + <v>Return = NewReturn = Tests | {skip,Reason}</v> + <v>Tests = [TestCase | {testcase,TestCase,TCRepeatProps} | {group,GroupName} | {group,GroupName,Properties} | {group,GroupName,Properties,SubGroups}]</v> + <v>TestCase = atom()</v> + <v>TCRepeatProps = [{repeat,N} | {repeat_until_ok,N} | {repeat_until_fail,N}]</v> + <v>GroupName = atom()</v> + <v>Properties = GroupProperties | default</v> + <v>SubGroups = [{GroupName,Properties} | {GroupName,Properties,SubGroups}]</v> + <v>Shuffle = shuffle | {shuffle,Seed}</v> + <v>Seed = {integer(),integer(),integer()}</v> + <v>GroupRepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | repeat_until_any_ok | repeat_until_any_fail</v> + <v>N = integer() | forever</v> + <v>GroupDefs = NewGroupDefs = [Group]</v> + <v>Group = {GroupName,GroupProperties,GroupsAndTestCases}</v> + <v>GroupProperties = [parallel | sequence | Shuffle | {GroupRepeatType,N}]</v> + <v>GroupsAndTestCases = [Group | {group,GroupName} | TestCase]</v> + <v>Reason = term()</v> + </type> + <desc> + <p>OPTIONAL</p> + + <p>This function is called after + <seealso marker="common_test#Module:all-0"><c>all/0</c></seealso>. + It is used to modify the set of test cases and test group to + be executed, for instance to add or remove test cases and + groups, change group properties, or even skip all tests in + the suite.</p> + + <p><c>Return</c> is what + <seealso marker="common_test#Module:all-0"><c>all/0</c></seealso> + returned, that is, a list of test cases and groups to be + executed, or a tuple <c>{skip,Reason}</c>.</p> + + <p><c>GroupDefs</c> is what + <seealso marker="common_test#Module:groups-0"><c>groups/0</c></seealso> + or the <c>post_groups/2</c> hook returned, that is, a list + of group definitions.</p> + + <p><c>NewReturn</c> is the possibly modified version of <c>Return</c>.</p> + + <p>This function is called only if the CTH is added before + <c>init_per_suite</c> is run. For details, see section + <seealso marker="ct_hooks_chapter#scope">CTH Scope</seealso> + in the User's Guide.</p> + + <p>Notice that for CTHs that are installed by means of the + <seealso marker="common_test#Module:suite-0"><c>suite/0</c></seealso> + function, <c>post_all/2</c> is called before + the <seealso marker="#Module:init-2"><c>init/2</c></seealso> + hook function. However, for CTHs that are installed by means + of the CT start flag, + the <seealso marker="#Module:init-2"><c>init/2</c></seealso> + function is called first.</p> + + <note> + <p>Prior to each test execution, Common Test does a + simulated test run in order to count test suites, groups + and cases for logging purposes. This causes + the <c>post_all/3</c> hook function to always be called + twice. For this reason, side effects are best avoided in + this callback.</p> + </note> + </desc> + </func> + + <func> <name since="OTP R14B02">Module:pre_init_per_suite(SuiteName, InitData, CTHState) -> Result</name> <fsummary>Called before init_per_suite.</fsummary> <type> diff --git a/lib/common_test/doc/src/ct_master.xml b/lib/common_test/doc/src/ct_master.xml index 2ab421fe9e..f003b7de11 100644 --- a/lib/common_test/doc/src/ct_master.xml +++ b/lib/common_test/doc/src/ct_master.xml @@ -210,7 +210,7 @@ </type> <desc><marker id="run_test-2"/> <p>Tests are spawned on <c>Node</c> using - <seealso marker="ct:run_test-1"><c>ct:run_test/1</c></seealso></p> + <seealso marker="ct#run_test-1"><c>ct:run_test/1</c></seealso></p> </desc> </func> </funcs> diff --git a/lib/common_test/doc/src/event_handler_chapter.xml b/lib/common_test/doc/src/event_handler_chapter.xml index bd9ed21cb4..182abba7ca 100644 --- a/lib/common_test/doc/src/event_handler_chapter.xml +++ b/lib/common_test/doc/src/event_handler_chapter.xml @@ -378,7 +378,7 @@ <note><p>To ensure that printouts to <c>stdout</c> (or printouts made with <seealso marker="ct#log-2"><c>ct:log/2,3</c></seealso> or - <seealso marker="ct:pal-2"><c>ct:pal,2,3</c></seealso>) get written to the test case log + <seealso marker="ct#pal-2"><c>ct:pal,2,3</c></seealso>) get written to the test case log file, and not to the <c>Common Test</c> framework log, you can synchronize with the <c>Common Test</c> server by matching on evvents <c>tc_start</c> and <c>tc_done</c>. In the period between these events, all I/O is directed to the diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index c8e0722a0f..a68cc3cca7 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -33,6 +33,21 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.17.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + OTP internal test improvements.</p> + <p> + Own Id: OTP-15716</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.17</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -135,6 +150,72 @@ </section> +<section><title>Common_Test 1.15.4.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The test result when a hook function fails is in general + the same as if the function that the hook is associated + with fails. For example, if <c>post_init_per_testcase</c> + fails the result is that the test case is skipped, as is + the case when <c>init_per_testcase</c> fails.This, + however, was earlier not true for timetrap timeouts or + other error situations where the process running the hook + function was killed. This is now corrected, so the error + handling should be the same no matter how the hook + function fails.</p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-15717 Aux Id: ERIERL-334 </p> + </item> + <item> + <p> + In some rare cases, when two common_test nodes used the + same log directory, a timing problem could occur which + caused common_test to crash because it's log cache file + was unexpectedly empty. This is now corrected.</p> + <p> + Own Id: OTP-15758 Aux Id: ERIERL-342 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Two new common_test hook functions are introduced:</p> + <p> + <c>post_groups/2</c>, which is called after + <c>Suite:groups/0</c><br/> <c>post_all/3</c>, which is + called after <c>Suite:all/0</c></p> + <p> + These functions allow modifying the return values from + the <c>groups/0</c> and <c>all/0</c> functions, + respectively.</p> + <p> + A new term, <c>{testcase,TestCase,RepeatProperties}</c> + is now also allowed in the return from <c>all/0</c>. This + can be used for repeating a single test case a specific + number of times, or until it fails or succeeds once.</p> + <p> + Own Id: OTP-14746 Aux Id: ERIERL-143 </p> + </item> + <item> + <p> + OTP internal test improvements.</p> + <p> + Own Id: OTP-15716</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.15.4.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/common_test/doc/src/run_test_chapter.xml b/lib/common_test/doc/src/run_test_chapter.xml index 56f6f7bcc4..2695e597cf 100644 --- a/lib/common_test/doc/src/run_test_chapter.xml +++ b/lib/common_test/doc/src/run_test_chapter.xml @@ -1297,7 +1297,7 @@ </taglist> <p>For example, if a test is started with:</p> - <p><c>$ ct_run -suite my_SUITE -logopts no_src</c></p> + <p><c>$ ct_run -suite my_SUITE -logopts no_nl</c></p> <p>then printouts during the test made by successive calls to <c>io:format("x")</c>, appears in the test case log as:</p> <p><c>xxx</c></p> diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml index 82dc06834f..5eed748b08 100644 --- a/lib/common_test/doc/src/write_test_chapter.xml +++ b/lib/common_test/doc/src/write_test_chapter.xml @@ -455,8 +455,10 @@ GroupDefs = [GroupDef] GroupDef = {GroupName,Properties,GroupsAndTestCases} GroupName = atom() - GroupsAndTestCases = [GroupDef | {group,GroupName} | TestCase] - TestCase = atom()</pre> + GroupsAndTestCases = [GroupDef | {group,GroupName} | TestCase | + {testcase,TestCase,TCRepeatProps}] + TestCase = atom() + TCRepeatProps = [{repeat,N} | {repeat_until_ok,N} | {repeat_until_fail,N}]</pre> <p><c>GroupName</c> is the name of the group and must be unique within the test suite module. Groups can be nested, by including a group definition @@ -464,11 +466,11 @@ <c>Properties</c> is the list of execution properties for the group. The possible values are as follows:</p> <pre> - Properties = [parallel | sequence | Shuffle | {RepeatType,N}] + Properties = [parallel | sequence | Shuffle | {GroupRepeatType,N}] Shuffle = shuffle | {shuffle,Seed} Seed = {integer(),integer(),integer()} - RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | - repeat_until_any_ok | repeat_until_any_fail + GroupRepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | + repeat_until_any_ok | repeat_until_any_fail N = integer() | forever</pre> <p><em>Explanations:</em></p> @@ -481,8 +483,8 @@ Dependencies Between Test Cases and Suites.</p></item> <tag><c>shuffle</c></tag> <item><p>The cases in the group are executed in random order.</p></item> - <tag><c>repeat</c></tag> - <item><p>Orders <c>Common Test</c> to repeat execution of the cases in the + <tag><c>repeat, repeat_until_*</c></tag> + <item><p>Orders <c>Common Test</c> to repeat execution of all the cases in the group a given number of times, or until any, or all, cases fail or succeed.</p></item> </taglist> @@ -496,7 +498,7 @@ <c>{group,GroupName}</c> to the <c>all/0</c> list.</p> <p><em>Example:</em></p> <pre> - all() -> [testcase1, {group,group1}, testcase2, {group,group2}].</pre> + all() -> [testcase1, {group,group1}, {testcase,testcase2,[{repeat,10}]}, {group,group2}].</pre> <p>Execution properties with a group tuple in <c>all/0</c>: <c>{group,GroupName,Properties}</c> can also be specified. diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 506147474f..bce6420042 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -696,9 +696,16 @@ end_tc(Mod,IPTC={init_per_testcase,_Func},_TCPid,Result,Args,Return) -> end end; -end_tc(Mod,Func0,TCPid,Result,Args,Return) -> +end_tc(Mod,Func00,TCPid,Result,Args,Return) -> %% in case Mod == ct_framework, lookup the suite name Suite = get_suite_name(Mod, Args), + {OnlyCleanup,Func0} = + case Func00 of + {cleanup,F0} -> + {true,F0}; + _ -> + {false,Func00} + end, {Func,FuncSpec,HookFunc} = case Func0 of {end_per_testcase_not_run,F} -> @@ -742,6 +749,8 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) -> case HookFunc of undefined -> {ok,Result}; + _ when OnlyCleanup -> + {ok,Result}; _ -> case ct_hooks:end_tc(Suite,HookFunc,Args,Result,Return) of '$ct_no_change' -> @@ -752,6 +761,8 @@ end_tc(Mod,Func0,TCPid,Result,Args,Return) -> end, FinalResult = case get('$test_server_framework_test') of + _ when OnlyCleanup -> + Result1; undefined -> %% send sync notification so that event handlers may print %% in the log file before it gets closed @@ -1056,21 +1067,40 @@ group_or_func(Func, _Config) -> %%% should be returned. get_suite(Mod, all) -> - case catch apply(Mod, groups, []) of - {'EXIT',_} -> - get_all(Mod, []); - GroupDefs when is_list(GroupDefs) -> - case catch ct_groups:find_groups(Mod, all, all, GroupDefs) of - {error,_} = Error -> - %% this makes test_server call error_in_suite as first - %% (and only) test case so we can report Error properly - [{?MODULE,error_in_suite,[[Error]]}]; - ConfTests -> - get_all(Mod, ConfTests) - end; - _ -> + case safe_apply_groups_0(Mod,{ok,[]}) of + {ok,GroupDefs} -> + try ct_groups:find_groups(Mod, all, all, GroupDefs) of + ConfTests when is_list(ConfTests) -> + get_all(Mod, ConfTests) + catch + throw:{error,Error} -> + [{?MODULE,error_in_suite,[[{error,Error}]]}]; + _:Error:S -> + [{?MODULE,error_in_suite,[[{error,{Error,S}}]]}] + end; + {error,{bad_return,_Bad}} -> E = "Bad return value from "++atom_to_list(Mod)++":groups/0", - [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}] + [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}]; + {error,{bad_hook_return,Bad}} -> + E = "Bad return value from post_groups/2 hook function", + [{?MODULE,error_in_suite,[[{error,{list_to_atom(E),Bad}}]]}]; + {error,{failed,ExitReason}} -> + case ct_util:get_testdata({error_in_suite,Mod}) of + undefined -> + ErrStr = io_lib:format("~n*** ERROR *** " + "~w:groups/0 failed: ~p~n", + [Mod,ExitReason]), + io:format(?def_gl, ErrStr, []), + %% save the error info so it doesn't get printed twice + ct_util:set_testdata_async({{error_in_suite,Mod}, + ExitReason}); + _ExitReason -> + ct_util:delete_testdata({error_in_suite,Mod}) + end, + Reason = list_to_atom(atom_to_list(Mod)++":groups/0 failed"), + [{?MODULE,error_in_suite,[[{error,Reason}]]}]; + {error,What} -> + [{?MODULE,error_in_suite,[[{error,What}]]}] end; %%!============================================================ @@ -1080,54 +1110,74 @@ get_suite(Mod, all) -> %% group get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) -> - Name = ?val(name, Props), - case catch apply(Mod, groups, []) of - {'EXIT',_} -> - [Group]; - GroupDefs when is_list(GroupDefs) -> - case catch ct_groups:find_groups(Mod, Name, TCs, GroupDefs) of - {error,_} = Error -> - %% this makes test_server call error_in_suite as first - %% (and only) test case so we can report Error properly - [{?MODULE,error_in_suite,[[Error]]}]; - [] -> - []; - ConfTests -> - case lists:member(skipped, Props) of - true -> - %% a *subgroup* specified *only* as skipped (and not - %% as an explicit test) should not be returned, or - %% init/end functions for top groups will be executed - case catch ?val(name, element(2, hd(ConfTests))) of - Name -> % top group - ct_groups:delete_subs(ConfTests, ConfTests); - _ -> - [] - end; - false -> - ConfTests1 = ct_groups:delete_subs(ConfTests, - ConfTests), - case ?val(override, Props) of - undefined -> - ConfTests1; - [] -> - ConfTests1; - ORSpec -> - ORSpec1 = if is_tuple(ORSpec) -> [ORSpec]; - true -> ORSpec end, - ct_groups:search_and_override(ConfTests1, - ORSpec1, Mod) - end - end - end; - _ -> + case safe_apply_groups_0(Mod,{ok,[Group]}) of + {ok,GroupDefs} -> + Name = ?val(name, Props), + try ct_groups:find_groups(Mod, Name, TCs, GroupDefs) of + [] -> + []; + ConfTests when is_list(ConfTests) -> + case lists:member(skipped, Props) of + true -> + %% a *subgroup* specified *only* as skipped (and not + %% as an explicit test) should not be returned, or + %% init/end functions for top groups will be executed + try ?val(name, element(2, hd(ConfTests))) of + Name -> % top group + ct_groups:delete_subs(ConfTests, ConfTests); + _ -> [] + catch + _:_ -> [] + end; + false -> + ConfTests1 = ct_groups:delete_subs(ConfTests, + ConfTests), + case ?val(override, Props) of + undefined -> + ConfTests1; + [] -> + ConfTests1; + ORSpec -> + ORSpec1 = if is_tuple(ORSpec) -> [ORSpec]; + true -> ORSpec end, + ct_groups:search_and_override(ConfTests1, + ORSpec1, Mod) + end + end + catch + throw:{error,Error} -> + [{?MODULE,error_in_suite,[[{error,Error}]]}]; + _:Error:S -> + [{?MODULE,error_in_suite,[[{error,{Error,S}}]]}] + end; + {error,{bad_return,_Bad}} -> E = "Bad return value from "++atom_to_list(Mod)++":groups/0", - [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}] + [{?MODULE,error_in_suite,[[{error,list_to_atom(E)}]]}]; + {error,{bad_hook_return,Bad}} -> + E = "Bad return value from post_groups/2 hook function", + [{?MODULE,error_in_suite,[[{error,{list_to_atom(E),Bad}}]]}]; + {error,{failed,ExitReason}} -> + case ct_util:get_testdata({error_in_suite,Mod}) of + undefined -> + ErrStr = io_lib:format("~n*** ERROR *** " + "~w:groups/0 failed: ~p~n", + [Mod,ExitReason]), + io:format(?def_gl, ErrStr, []), + %% save the error info so it doesn't get printed twice + ct_util:set_testdata_async({{error_in_suite,Mod}, + ExitReason}); + _ExitReason -> + ct_util:delete_testdata({error_in_suite,Mod}) + end, + Reason = list_to_atom(atom_to_list(Mod)++":groups/0 failed"), + [{?MODULE,error_in_suite,[[{error,Reason}]]}]; + {error,What} -> + [{?MODULE,error_in_suite,[[{error,What}]]}] end; %% testcase get_suite(Mod, Name) -> - get_seq(Mod, Name). + get_seq(Mod, Name). %%%----------------------------------------------------------------- @@ -1161,21 +1211,48 @@ get_all_cases1(_, []) -> %%%----------------------------------------------------------------- -get_all(Mod, ConfTests) -> - case catch apply(Mod, all, []) of - {'EXIT',{undef,[{Mod,all,[],_} | _]}} -> +get_all(Mod, ConfTests) -> + case safe_apply_all_0(Mod) of + {ok,AllTCs} -> + %% expand group references using ConfTests + try ct_groups:expand_groups(AllTCs, ConfTests, Mod) of + {error,_} = Error -> + [{?MODULE,error_in_suite,[[Error]]}]; + Tests0 -> + Tests = ct_groups:delete_subs(Tests0, Tests0), + expand_tests(Mod, Tests) + catch + throw:{error,Error} -> + [{?MODULE,error_in_suite,[[{error,Error}]]}]; + _:Error:S -> + [{?MODULE,error_in_suite,[[{error,{Error,S}}]]}] + end; + Skip = {skip,_Reason} -> + Skip; + {error,undef} -> + Reason = + case code:which(Mod) of + non_existing -> + list_to_atom( + atom_to_list(Mod)++ + " cannot be compiled or loaded"); + _ -> + list_to_atom( + atom_to_list(Mod)++":all/0 is missing") + end, + %% this makes test_server call error_in_suite as first + %% (and only) test case so we can report Reason properly + [{?MODULE,error_in_suite,[[{error,Reason}]]}]; + {error,{bad_return,_Bad}} -> Reason = - case code:which(Mod) of - non_existing -> - list_to_atom(atom_to_list(Mod)++ - " cannot be compiled or loaded"); - _ -> - list_to_atom(atom_to_list(Mod)++":all/0 is missing") - end, - %% this makes test_server call error_in_suite as first - %% (and only) test case so we can report Reason properly + list_to_atom("Bad return value from "++ + atom_to_list(Mod)++":all/0"), [{?MODULE,error_in_suite,[[{error,Reason}]]}]; - {'EXIT',ExitReason} -> + {error,{bad_hook_return,Bad}} -> + Reason = + list_to_atom("Bad return value from post_all/3 hook function"), + [{?MODULE,error_in_suite,[[{error,{Reason,Bad}}]]}]; + {error,{failed,ExitReason}} -> case ct_util:get_testdata({error_in_suite,Mod}) of undefined -> ErrStr = io_lib:format("~n*** ERROR *** " @@ -1192,28 +1269,8 @@ get_all(Mod, ConfTests) -> %% this makes test_server call error_in_suite as first %% (and only) test case so we can report Reason properly [{?MODULE,error_in_suite,[[{error,Reason}]]}]; - AllTCs when is_list(AllTCs) -> - case catch save_seqs(Mod,AllTCs) of - {error,What} -> - [{?MODULE,error_in_suite,[[{error,What}]]}]; - SeqsAndTCs -> - %% expand group references in all() using ConfTests - case catch ct_groups:expand_groups(SeqsAndTCs, - ConfTests, - Mod) of - {error,_} = Error -> - [{?MODULE,error_in_suite,[[Error]]}]; - Tests -> - ct_groups:delete_subs(Tests, Tests) - end - end; - Skip = {skip,_Reason} -> - Skip; - _ -> - Reason = - list_to_atom("Bad return value from "++ - atom_to_list(Mod)++":all/0"), - [{?MODULE,error_in_suite,[[{error,Reason}]]}] + {error,What} -> + [{?MODULE,error_in_suite,[[{error,What}]]}] end. %%!============================================================ @@ -1571,3 +1628,74 @@ get_html_wrapper(TestName, PrintLabel, Cwd, TableCols, Encoding) -> %%% -spec get_log_dir() -> {ok,LogDir} get_log_dir() -> ct_logs:get_log_dir(true). + +%%%----------------------------------------------------------------- +%%% Call all and group callbacks and post_* hooks with error handling +safe_apply_all_0(Mod) -> + try apply(Mod, all, []) of + AllTCs0 when is_list(AllTCs0) -> + try save_seqs(Mod,AllTCs0) of + SeqsAndTCs when is_list(SeqsAndTCs) -> + all_hook(Mod,SeqsAndTCs) + catch throw:{error,What} -> + {error,What} + end; + {skip,_}=Skip -> + all_hook(Mod,Skip); + Bad -> + {error,{bad_return,Bad}} + catch + _:Reason:Stacktrace -> + handle_callback_crash(Reason,Stacktrace,Mod,all,{error,undef}) + end. + +all_hook(Mod, All) -> + case ct_hooks:all(Mod, All) of + AllTCs when is_list(AllTCs) -> + {ok,AllTCs}; + {skip,_}=Skip -> + Skip; + {fail,Reason} -> + {error,Reason}; + Bad -> + {error,{bad_hook_return,Bad}} + end. + +safe_apply_groups_0(Mod,Default) -> + try apply(Mod, groups, []) of + GroupDefs when is_list(GroupDefs) -> + case ct_hooks:groups(Mod, GroupDefs) of + GroupDefs1 when is_list(GroupDefs1) -> + {ok,GroupDefs1}; + {fail,Reason} -> + {error,Reason}; + Bad -> + {error,{bad_hook_return,Bad}} + end; + Bad -> + {error,{bad_return,Bad}} + catch + _:Reason:Stacktrace -> + handle_callback_crash(Reason,Stacktrace,Mod,groups,Default) + end. + +handle_callback_crash(undef,[{Mod,Func,[],_}|_],Mod,Func,Default) -> + case ct_hooks:Func(Mod, []) of + [] -> + Default; + List when is_list(List) -> + {ok,List}; + {fail,Reason} -> + {error,Reason}; + Bad -> + {error,{bad_hook_return,Bad}} + end; +handle_callback_crash(Reason,Stacktrace,_Mod,_Func,_Default) -> + {error,{failed,{Reason,Stacktrace}}}. + +expand_tests(Mod, [{testcase,Case,[Prop]}|Tests]) -> + [{repeat,{Mod,Case},Prop}|expand_tests(Mod,Tests)]; +expand_tests(Mod,[Test|Tests]) -> + [Test|expand_tests(Mod,Tests)]; +expand_tests(_Mod,[]) -> + []. diff --git a/lib/common_test/src/ct_groups.erl b/lib/common_test/src/ct_groups.erl index d867069dce..f4b12c41c0 100644 --- a/lib/common_test/src/ct_groups.erl +++ b/lib/common_test/src/ct_groups.erl @@ -101,23 +101,34 @@ find(Mod, [], TCs, Tests, _Known, _Defs, false) -> [{Mod,TC}]; ({group,_}) -> []; + ({testcase,TC,[Prop]}) when is_atom(TC), TC ==all -> + [{repeat,{Mod,TC},Prop}]; ({_,_}=TC) when TCs == all -> [TC]; - (TC) -> - if is_atom(TC) -> - Tuple = {Mod,TC}, - case lists:member(Tuple, TCs) of - true -> - [Tuple]; - false -> - case lists:member(TC, TCs) of - true -> [{Mod,TC}]; - false -> [] - end - end; - true -> - [] - end + (TC) when is_atom(TC) -> + Tuple = {Mod,TC}, + case lists:member(Tuple, TCs) of + true -> + [Tuple]; + false -> + case lists:member(TC, TCs) of + true -> [Tuple]; + false -> [] + end + end; + ({testcase,TC,[Prop]}) when is_atom(TC) -> + Tuple = {Mod,TC}, + case lists:member(Tuple, TCs) of + true -> + [{repeat,Tuple,Prop}]; + false -> + case lists:member(TC, TCs) of + true -> [{repeat,Tuple,Prop}]; + false -> [] + end + end; + (_) -> + [] end, Tests), if Cases == [] -> ['NOMATCH']; true -> Cases @@ -172,12 +183,19 @@ find(Mod, GrNames, all, [{M,TC} | Gs], Known, Defs, FindAll) when is_atom(M), M /= group, is_atom(TC) -> [{M,TC} | find(Mod, GrNames, all, Gs, Known, Defs, FindAll)]; +%% Save test case +find(Mod, GrNames, all, [{testcase,TC,[Prop]} | Gs], Known, + Defs, FindAll) when is_atom(TC) -> + [{repeat,{Mod,TC},Prop} | find(Mod, GrNames, all, Gs, Known, Defs, FindAll)]; + %% Check if test case should be saved -find(Mod, GrNames, TCs, [TC | Gs], Known, - Defs, FindAll) when is_atom(TC) orelse - ((size(TC) == 2) and (element(1,TC) /= group)) -> +find(Mod, GrNames, TCs, [TC | Gs], Known, Defs, FindAll) + when is_atom(TC) orelse + ((size(TC) == 3) andalso (element(1,TC) == testcase)) orelse + ((size(TC) == 2) and (element(1,TC) /= group)) -> Case = - if is_atom(TC) -> + case TC of + _ when is_atom(TC) -> Tuple = {Mod,TC}, case lists:member(Tuple, TCs) of true -> @@ -188,7 +206,18 @@ find(Mod, GrNames, TCs, [TC | Gs], Known, false -> [] end end; - true -> + {testcase,TC0,[Prop]} when is_atom(TC0) -> + Tuple = {Mod,TC0}, + case lists:member(Tuple, TCs) of + true -> + {repeat,Tuple,Prop}; + false -> + case lists:member(TC0, TCs) of + true -> {repeat,{Mod,TC0},Prop}; + false -> [] + end + end; + _ -> case lists:member(TC, TCs) of true -> {Mod,TC}; false -> [] @@ -289,12 +318,22 @@ modify_tc_list(GrSpecTs, TSCs, []) -> modify_tc_list1(GrSpecTs, TSCs); modify_tc_list(GrSpecTs, _TSCs, _) -> - [Test || Test <- GrSpecTs, not is_atom(Test)]. + [Test || Test <- GrSpecTs, not is_atom(Test), element(1,Test)=/=testcase]. modify_tc_list1(GrSpecTs, TSCs) -> %% remove all cases in group tc list that should not be executed GrSpecTs1 = - lists:flatmap(fun(Test) when is_tuple(Test), + lists:flatmap(fun(Test={testcase,TC,_}) -> + case lists:keysearch(TC, 2, TSCs) of + {value,_} -> + [Test]; + _ -> + case lists:member(TC, TSCs) of + true -> [Test]; + false -> [] + end + end; + (Test) when is_tuple(Test), (size(Test) > 2) -> [Test]; (Test={group,_}) -> diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index 49587b3edd..97c349578f 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -22,6 +22,8 @@ %% API Exports -export([init/1]). +-export([groups/2]). +-export([all/2]). -export([init_tc/3]). -export([end_tc/5]). -export([terminate/1]). @@ -37,7 +39,8 @@ opts = [], prio = ctfirst }]). --record(ct_hook_config, {id, module, prio, scope, opts = [], state = []}). +-record(ct_hook_config, {id, module, prio, scope, opts = [], + state = [], groups = []}). %% ------------------------------------------------------------------------- %% API Functions @@ -49,6 +52,48 @@ init(Opts) -> call(get_builtin_hooks(Opts) ++ get_new_hooks(Opts, undefined), ok, init, []). +%% Call the post_groups/2 hook callback +groups(Mod, Groups) -> + Info = try proplists:get_value(ct_hooks, Mod:suite(), []) of + CTHooks when is_list(CTHooks) -> + [{?config_name,CTHooks}]; + CTHook when is_atom(CTHook) -> + [{?config_name,[CTHook]}] + catch _:_ -> + %% since this might be the first time Mod:suite() + %% is called, and it might just fail or return + %% something bad, we allow any failure here - it + %% will be catched later if there is something + %% really wrong. + [{?config_name,[]}] + end, + case call(fun call_generic/3, Info ++ [{'$ct_groups',Groups}], [post_groups, Mod]) of + [{'$ct_groups',NewGroups}] -> + NewGroups; + Other -> + Other + end. + +%% Call the post_all/3 hook callback +all(Mod, Tests) -> + Info = try proplists:get_value(ct_hooks, Mod:suite(), []) of + CTHooks when is_list(CTHooks) -> + [{?config_name,CTHooks}]; + CTHook when is_atom(CTHook) -> + [{?config_name,[CTHook]}] + catch _:_ -> + %% just allow any failure here - it will be catched + %% later if there is something really wrong. + [{?config_name,[]}] + end, + case call(fun call_generic/3, Info ++ [{'$ct_all',Tests}], [post_all, Mod]) of + [{'$ct_all',NewTests}] -> + NewTests; + Other -> + Other + end. + +%% Called after all suites are done. -spec terminate(Hooks :: term()) -> ok. terminate(Hooks) -> @@ -80,6 +125,7 @@ init_tc(Mod, init_per_suite, Config) -> [{?config_name,[]}] end, call(fun call_generic/3, Config ++ Info, [pre_init_per_suite, Mod]); + init_tc(Mod, end_per_suite, Config) -> call(fun call_generic/3, Config, [pre_end_per_suite, Mod]); init_tc(Mod, {init_per_group, GroupName, Properties}, Config) -> @@ -153,7 +199,7 @@ call_id(#ct_hook_config{ module = Mod, opts = Opts} = Hook, Config, Scope) -> {Config, Hook#ct_hook_config{ id = Id, scope = scope(Scope)}}. call_init(#ct_hook_config{ module = Mod, opts = Opts, id = Id, prio = P} = Hook, - Config,_Meta) -> + Config, _Meta) -> case Mod:init(Id, Opts) of {ok, NewState} when P =:= undefined -> {Config, Hook#ct_hook_config{ state = NewState, prio = 0 } }; @@ -184,6 +230,18 @@ call_generic(Hook, Value, Meta) -> call_generic_fallback(Hook, Value, Meta) -> do_call_generic(Hook, Value, Meta, true). +do_call_generic(#ct_hook_config{ module = Mod} = Hook, + [{'$ct_groups',Groups}], [post_groups | Args], Fallback) -> + NewGroups = catch_apply(Mod, post_groups, Args ++ [Groups], + Groups, Fallback), + {[{'$ct_groups',NewGroups}], Hook#ct_hook_config{ groups = NewGroups } }; + +do_call_generic(#ct_hook_config{ module = Mod, groups = Groups} = Hook, + [{'$ct_all',Tests}], [post_all | Args], Fallback) -> + NewTests = catch_apply(Mod, post_all, Args ++ [Tests, Groups], + Tests, Fallback), + {[{'$ct_all',NewTests}], Hook}; + do_call_generic(#ct_hook_config{ module = Mod, state = State} = Hook, Value, [Function | Args], Fallback) -> {NewValue, NewState} = catch_apply(Mod, Function, Args ++ [Value, State], @@ -218,6 +276,12 @@ call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) -> Rest ++ [{NewId, call_init}]}; ExistingHook when is_tuple(ExistingHook) -> {Hooks, Rest}; + _ when hd(Meta)=:=post_groups; hd(Meta)=:=post_all -> + %% If CTH is started because of a call from + %% groups/2 or all/2, CTH:init/1 must not be + %% called (the suite scope should be used). + {Hooks ++ [NewHook], + Rest ++ [{NewId,NextFun}]}; _ -> {Hooks ++ [NewHook], Rest ++ [{NewId, call_init}, {NewId,NextFun}]} @@ -226,8 +290,8 @@ call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) -> catch Error:Reason:Trace -> ct_logs:log("Suite Hook","Failed to start a CTH: ~tp:~tp", [Error,{Reason,Trace}]), - call([], {fail,"Failed to start CTH" - ", see the CT Log for details"}, Meta, Hooks) + call([], {fail,"Failed to start CTH, " + "see the CT Log for details"}, Meta, Hooks) end; call([{HookId, call_init} | Rest], Config, Meta, Hooks) -> call([{HookId, fun call_init/3} | Rest], Config, Meta, Hooks); @@ -267,6 +331,10 @@ scope([pre_init_per_suite, SuiteName|_]) -> [post_end_per_suite, SuiteName]; scope([post_init_per_suite, SuiteName|_]) -> [post_end_per_suite, SuiteName]; +scope([post_groups, SuiteName|_]) -> + [post_groups, SuiteName]; +scope([post_all, SuiteName|_]) -> + [post_all, SuiteName]; scope(init) -> none. @@ -353,6 +421,7 @@ resort(Calls,Hooks,[F|_R]) when F == pre_end_per_testcase; F == pre_end_per_suite; F == post_end_per_suite -> lists:reverse(resort(Calls,Hooks)); + resort(Calls,Hooks,_Meta) -> resort(Calls,Hooks). diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 814b80b8bd..ca262b350f 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -149,7 +149,7 @@ close(Info, StartDir) -> ok; CacheBin -> %% save final version of the log cache to file - _ = file:write_file(?log_cache_name,CacheBin), + write_log_cache(CacheBin), put(ct_log_cache,undefined) end end, @@ -2022,7 +2022,7 @@ update_all_runs_in_cache(AllRunsData) -> %% read from file as long as this logger process is alive put(ct_log_cache,term_to_binary(LogCache)); _ -> - file:write_file(?log_cache_name,term_to_binary(LogCache)) + write_log_cache(term_to_binary(LogCache)) end; SavedLogCache -> update_all_runs_in_cache(AllRunsData,binary_to_term(SavedLogCache)) @@ -2036,7 +2036,7 @@ update_all_runs_in_cache(AllRunsData, LogCache) -> %% read from file as long as this logger process is alive put(ct_log_cache,term_to_binary(LogCache1)); _ -> - file:write_file(?log_cache_name,term_to_binary(LogCache1)) + write_log_cache(term_to_binary(LogCache1)) end. sort_all_runs(Dirs) -> @@ -2668,7 +2668,7 @@ update_tests_in_cache(TempData,LogCache=#log_cache{tests=Tests}) -> {_Pid,_Pid} -> put(ct_log_cache,CacheBin); _ -> - file:write_file(?log_cache_name,CacheBin) + write_log_cache(CacheBin) end. %% @@ -3400,3 +3400,9 @@ unexpected_io(Pid, _Category, _Importance, Content, CtLogFd, EscChars) -> Data = io_lib:format("~ts", [lists:foldl(IoFun, [], Content)]), test_server_io:print_unexpected(Data), ok. + +write_log_cache(LogCacheBin) when is_binary(LogCacheBin) -> + TmpFile = ?log_cache_name++".tmp", + _ = file:write_file(TmpFile,LogCacheBin), + _ = file:rename(TmpFile,?log_cache_name), + ok. diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl index 9eda3f2152..756cd4d692 100644 --- a/lib/common_test/src/test_server.erl +++ b/lib/common_test/src/test_server.erl @@ -384,8 +384,8 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit,TimetrapData}) -> {Result,DetFail,ProcBef,ProcAft}. -type tc_status() :: 'starting' | 'running' | 'init_per_testcase' | - 'end_per_testcase' | {'framework',atom(),atom()} | - 'tc'. + 'end_per_testcase' | {'framework',{atom(),atom(),list}} | + 'tc'. -record(st, { ref :: reference(), @@ -653,8 +653,8 @@ handle_tc_exit({testcase_aborted,{user_timetrap_error,_}=Msg,_}, St) -> #st{config=Config,mf={Mod,Func},pid=Pid} = St, spawn_fw_call(Mod, Func, Config, Pid, Msg, unknown, self()), St; -handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc}, - config=Config,pid=Pid}=St) -> +handle_tc_exit(Reason, #st{status={framework,{FwMod,FwFunc,_}=FwMFA}, + config=Config,mf={Mod,Func},pid=Pid}=St) -> R = case Reason of {timetrap_timeout,TVal,_} -> {timetrap,TVal}; @@ -666,7 +666,7 @@ handle_tc_exit(Reason, #st{status={framework,FwMod,FwFunc}, Other end, Error = {framework_error,R}, - spawn_fw_call(FwMod, FwFunc, Config, Pid, Error, unknown, self()), + spawn_fw_call(Mod, Func, Config, Pid, {Error,FwMFA}, unknown, self()), St; handle_tc_exit(Reason, #st{status=tc,config=Config0,mf={Mod,Func},pid=Pid}=St) when is_list(Config0) -> @@ -870,22 +870,48 @@ spawn_fw_call(Mod,EPTC={end_per_testcase,Func},EndConf,Pid, end, spawn_link(FwCall); -spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) -> +spawn_fw_call(Mod,Func,Conf,Pid,{{framework_error,FwError}, + {FwMod,FwFunc,[A1,A2|_]}=FwMFA},_,SendTo) -> FwCall = fun() -> ct_util:mark_process(), - test_server_sup:framework_call(report, [framework_error, - {{FwMod,FwFunc}, - FwError}]), + Time = + case FwError of + {timetrap,TVal} -> + TVal/1000; + _ -> + died + end, + {Ret,Loc,WarnOrError} = + cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,FwMFA), Comment = - lists:flatten( - io_lib:format("<font color=\"red\">" - "WARNING! ~w:~tw failed!</font>", - [FwMod,FwFunc])), + case WarnOrError of + warn -> + group_leader() ! + {printout,12, + "WARNING! ~w:~tw(~w,~tw,...) failed!\n" + " Reason: ~tp\n", + [FwMod,FwFunc,A1,A2,FwError]}, + lists:flatten( + io_lib:format("<font color=\"red\">" + "WARNING! ~w:~tw(~w,~tw,...) " + "failed!</font>", + [FwMod,FwFunc,A1,A2])); + error -> + group_leader() ! + {printout,12, + "Error! ~w:~tw(~w,~tw,...) failed!\n" + " Reason: ~tp\n", + [FwMod,FwFunc,A1,A2,FwError]}, + lists:flatten( + io_lib:format("<font color=\"red\">" + "ERROR! ~w:~tw(~w,~tw,...) " + "failed!</font>", + [FwMod,FwFunc,A1,A2])) + end, %% finished, report back SendTo ! {self(),fw_notify_done, - {died,{error,{FwMod,FwFunc,FwError}}, - {FwMod,FwFunc},[],Comment}} + {Time,Ret,Loc,[],Comment}} end, spawn_link(FwCall); @@ -930,6 +956,163 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> end, spawn_link(FwCall). +cleanup_after_fw_error(_Mod,_Func,Conf,Pid,FwError, + {FwMod,FwFunc=init_tc, + [Mod,{init_per_testcase,Func}=IPTC|_]}) -> + %% Failed during pre_init_per_testcase, the test must be skipped + Skip = {auto_skip,{failed,{FwMod,FwFunc,FwError}}}, + try begin do_end_tc_call(Mod,IPTC, {Pid,Skip,[Conf]}, FwError), + do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, + [Conf],{ok,[Conf]}), + do_end_tc_call(Mod,{end_per_testcase_not_run,Func}, + {Pid,Skip,[Conf]}, FwError) end of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + {Skip,{FwMod,FwFunc},error}; +cleanup_after_fw_error(_Mod,_Func,Conf,Pid,FwError, + {FwMod,FwFunc=end_tc,[Mod,{init_per_testcase,Func}|_]}) -> + %% Failed during post_init_per_testcase, the test must be skipped + Skip = {auto_skip,{failed,{FwMod,FwFunc,FwError}}}, + try begin do_init_tc_call(Mod,{end_per_testcase_not_run,Func}, + [Conf],{ok,[Conf]}), + do_end_tc_call(Mod,{end_per_testcase_not_run,Func}, + {Pid,Skip,[Conf]}, FwError) end of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + {Skip,{FwMod,FwFunc},error}; +cleanup_after_fw_error(_Mod,_Func,Conf,Pid,FwError, + {FwMod,FwFunc=init_tc,[Mod,{end_per_testcase,Func}|_]}) -> + %% Failed during pre_end_per_testcase. Warn about it. + {RetVal,Loc} = + case {proplists:get_value(tc_status, Conf), + proplists:get_value(tc_fail_loc, Conf, unknown)} of + {undefined,_} -> + {{failed,{FwMod,FwFunc,FwError}},{FwMod,FwFunc}}; + {E = {failed,_Reason},unknown} -> + {E,[{Mod,Func}]}; + {Result,FailLoc} -> + {Result,FailLoc} + end, + try begin do_end_tc_call(Mod,{end_per_testcase_not_run,Func}, + {Pid,RetVal,[Conf]}, FwError) end of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + {RetVal,Loc,warn}; +cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError, + {FwMod,FwFunc=end_tc,[Mod,{end_per_testcase,Func}|_]}) -> + %% Failed during post_end_per_testcase. Warn about it. + {RetVal,Report,Loc} = + case {proplists:get_value(tc_status, Conf), + proplists:get_value(tc_fail_loc, Conf, unknown)} of + {undefined,_} -> + {{failed,{FwMod,FwFunc,FwError}}, + {{FwMod,FwError},FwError}, + {FwMod,FwFunc}}; + {E = {failed,_Reason},unknown} -> + {E,{Mod,Func,E},[{Mod,Func}]}; + {Result,FailLoc} -> + {Result,{Mod,Func,Result},FailLoc} + end, + try begin do_end_tc_call(Mod,{cleanup,{end_per_testcase_not_run,Func}}, + {Pid,RetVal,[Conf]}, FwError) end of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + test_server_sup:framework_call(report,[framework_error,Report]), + {RetVal,Loc,warn}; +cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=init_tc,_}) + when Func =:= init_per_suite; Func =:=init_per_group -> + %% Failed during pre_init_per_suite or pre_init_per_group + RetVal = {failed,{FwMod,FwFunc,FwError}}, + try do_end_tc_call(Mod,Func,{Pid,RetVal,[Conf]},FwError) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + {RetVal,{FwMod,FwFunc},error}; +cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=end_tc,_}) + when Func =:= init_per_suite; Func =:=init_per_group -> + %% Failed during post_init_per_suite or post_init_per_group + RetVal = {failed,{FwMod,FwFunc,FwError}}, + try do_end_tc_call(Mod,{cleanup,Func},{Pid,RetVal,[Conf]},FwError) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + ReportFunc = + case Func of + init_per_group -> + case proplists:get_value(tc_group_properties,Conf) of + undefined -> + {Func,unknown,[]}; + GProps -> + Name = proplists:get_value(name,GProps), + {Func,Name,proplists:delete(name,GProps)} + end; + _ -> + Func + end, + test_server_sup:framework_call(report,[framework_error, + {Mod,ReportFunc,RetVal}]), + {RetVal,{FwMod,FwFunc},error}; +cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=init_tc,_}) + when Func =:= end_per_suite; Func =:=end_per_group -> + %% Failed during pre_end_per_suite or pre_end_per_group + RetVal = {failed,{FwMod,FwFunc,FwError}}, + try do_end_tc_call(Mod,Func,{Pid,RetVal,[Conf]},FwError) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + {RetVal,{FwMod,FwFunc},error}; +cleanup_after_fw_error(Mod,Func,Conf,Pid,FwError,{FwMod,FwFunc=end_tc,_}) + when Func =:= end_per_suite; Func =:=end_per_group -> + %% Failed during post_end_per_suite or post_end_per_group + RetVal = {failed,{FwMod,FwFunc,FwError}}, + try do_end_tc_call(Mod,{cleanup,Func},{Pid,RetVal,[Conf]},FwError) of + _ -> ok + catch + _:FwEndTCErr -> + exit({fw_notify_done,end_tc,FwEndTCErr}) + end, + ReportFunc = + case Func of + end_per_group -> + case proplists:get_value(tc_group_properties,Conf) of + undefined -> + {Func,unknown,[]}; + GProps -> + Name = proplists:get_value(name,GProps), + {Func,Name,proplists:delete(name,GProps)} + end; + _ -> + Func + end, + test_server_sup:framework_call(report,[framework_error, + {Mod,ReportFunc,RetVal}]), + {RetVal,{FwMod,FwFunc},error}; +cleanup_after_fw_error(_Mod,_Func,_Conf,_Pid,FwError,{FwMod,FwFunc,_}) -> + %% This is unexpected + test_server_sup:framework_call(report, + [framework_error, + {{FwMod,FwFunc}, + FwError}]), + {FwError,{FwMod,FwFunc},error}. + %% The job proxy process forwards messages between the test case %% process on a shielded node (and its descendants) and the job process. %% @@ -1105,6 +1288,9 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> EndConf1 = user_callback(TCCallback, Mod, Func, 'end', EndConf), + %% save updated config in controller loop + set_tc_state(tc, EndConf1), + %% We can't handle fails or skips here EndConf2 = case do_init_tc_call(Mod,{end_per_testcase,Func}, diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index 1518c6e8d6..003d08d70d 100644 --- a/lib/common_test/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -1443,6 +1443,8 @@ remove_conf([C={Mod,error_in_suite,_}|Cases], NoConf, Repeats) -> true -> remove_conf(Cases, [C|NoConf], Repeats) end; +remove_conf([C={repeat,_,_}|Cases], NoConf, _Repeats) -> + remove_conf(Cases, [C|NoConf], true); remove_conf([C|Cases], NoConf, Repeats) -> remove_conf(Cases, [C|NoConf], Repeats); remove_conf([], NoConf, true) -> @@ -2061,6 +2063,14 @@ add_init_and_end_per_suite([SkipCase|Cases], LastMod, LastRef, FwMod) [SkipCase|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]; add_init_and_end_per_suite([{conf,_,_,_}=Case|Cases], LastMod, LastRef, FwMod) -> [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]; +add_init_and_end_per_suite([{repeat,{Mod,_},_}=Case|Cases], LastMod, LastRef, FwMod) + when Mod =/= LastMod, Mod =/= FwMod -> + {PreCases, NextMod, NextRef} = + do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod), + PreCases ++ [Case|add_init_and_end_per_suite(Cases, NextMod, + NextRef, FwMod)]; +add_init_and_end_per_suite([{repeat,_,_}=Case|Cases], LastMod, LastRef, FwMod) -> + [Case|add_init_and_end_per_suite(Cases, LastMod, LastRef, FwMod)]; add_init_and_end_per_suite([{Mod,_}=Case|Cases], LastMod, LastRef, FwMod) when Mod =/= LastMod, Mod =/= FwMod -> {PreCases, NextMod, NextRef} = @@ -2138,7 +2148,7 @@ do_add_init_and_end_per_suite(LastMod, LastRef, Mod, FwMod) -> %% let's call a "fake" end_per_suite if it exists case erlang:function_exported(FwMod, end_per_suite, 1) of true -> - [{conf,LastRef,[{suite,Mod}], + [{conf,LastRef,[{suite,LastMod}], {FwMod,end_per_suite}}|Init]; false -> [{conf,LastRef,[],{LastMod,end_per_suite}}|Init] @@ -2926,6 +2936,29 @@ run_test_cases_loop([{conf,_Ref,_Props,_X}=Conf|_Cases0], Config, _TimetrapData, _Mode, _Status) -> erlang:error(badarg, [Conf,Config]); +run_test_cases_loop([{repeat,Case,{RepeatType,N}}|Cases0], Config, + TimeTrapData, Mode, Status) -> + Ref = make_ref(), + Parallel = check_prop(parallel, Mode) =/= false, + Sequence = check_prop(sequence, Mode) =/= false, + RepeatStop = RepeatType=:=repeat_until_fail + orelse RepeatType=:=repeat_until_ok, + + if Parallel andalso RepeatStop -> + %% Cannot check results of test case during parallal + %% execution, so only RepeatType=:=repeat is allowed in + %% combination with parallel groups. + erlang:error({illegal_combination,{parallel,RepeatType}}); + Sequence andalso RepeatStop -> + %% Sequence is stop on fail + skip rest, so only + %% RepeatType=:=repeat makes sense inside a sequence. + erlang:error({illegal_combination,{sequence,RepeatType}}); + true -> + Mode1 = [{Ref,[{repeat,{RepeatType,1,N}}],?now}|Mode], + run_test_cases_loop([Case | Cases0], Config, TimeTrapData, + Mode1, Status) + end; + run_test_cases_loop([{Mod,Case}|Cases], Config, TimetrapData, Mode, Status) -> ActualCfg = case get(test_server_create_priv_dir) of @@ -2938,7 +2971,7 @@ run_test_cases_loop([{Mod,Case}|Cases], Config, TimetrapData, Mode, Status) -> run_test_cases_loop([{Mod,Case,[ActualCfg]}|Cases], Config, TimetrapData, Mode, Status); -run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) -> +run_test_cases_loop([{Mod,Func,Args}=Case|Cases], Config, TimetrapData, Mode0, Status) -> {Num,RunInit} = case FwMod = get_fw_mod(?MODULE) of Mod when Func == error_in_suite -> @@ -2948,6 +2981,14 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) run_init} end, + Mode = + case Mode0 of + [{_,[{repeat,{_,_,_}}],_}|RestMode] -> + RestMode; + _ -> + Mode0 + end, + %% check the current execution mode and save info about the case if %% detected that printouts to common log files is handled later @@ -2975,36 +3016,42 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) if is_tuple(RetVal) -> element(1,RetVal); true -> undefined end, - {Failed,Status1} = + {Result,Failed,Status1} = case RetTag of Skip when Skip==skip; Skip==skipped -> - {false,update_status(skipped, Mod, Func, Status)}; + {skipped,false,update_status(skipped, Mod, Func, Status)}; Fail when Fail=='EXIT'; Fail==failed -> - {true,update_status(failed, Mod, Func, Status)}; + {failed,true,update_status(failed, Mod, Func, Status)}; _ when Time==died, RetVal=/=ok -> - {true,update_status(failed, Mod, Func, Status)}; + {failed,true,update_status(failed, Mod, Func, Status)}; _ -> - {false,update_status(ok, Mod, Func, Status)} + {ok,false,update_status(ok, Mod, Func, Status)} end, case check_prop(sequence, Mode) of false -> + {Cases1,Mode1} = + check_repeat_testcase(Case,Result,Cases,Mode0), stop_minor_log_file(), - run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1); + run_test_cases_loop(Cases1, Config, TimetrapData, Mode1, Status1); Ref -> %% the case is in a sequence; we must check the result and %% determine if the following cases should run or be skipped if not Failed -> % proceed with next case + {Cases1,Mode1} = + check_repeat_testcase(Case,Result,Cases,Mode0), stop_minor_log_file(), - run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1); + run_test_cases_loop(Cases1, Config, TimetrapData, Mode1, Status1); true -> % skip rest of cases in sequence print(minor, "~n*** ~tw failed.~n" " Skipping all other cases in sequence.", [Func]), + {Cases1,Mode1} = + check_repeat_testcase(Case,Result,Cases,Mode0), Reason = {failed,{Mod,Func}}, - Cases2 = skip_cases_upto(Ref, Cases, Reason, tc, + Cases2 = skip_cases_upto(Ref, Cases1, Reason, tc, Mode, auto_skip_case), stop_minor_log_file(), - run_test_cases_loop(Cases2, Config, TimetrapData, Mode, Status1) + run_test_cases_loop(Cases2, Config, TimetrapData, Mode1, Status1) end end; %% the test case is being executed in parallel with the main process (and @@ -3013,7 +3060,8 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) %% io from Pid will be buffered by the test_server_io process and %% handled later, so we have to save info about the case queue_test_case_io(undefined, Pid, Num+1, Mod, Func), - run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status) + {Cases1,Mode1} = check_repeat_testcase(Case,ok,Cases,Mode0), + run_test_cases_loop(Cases1, Config, TimetrapData, Mode1, Status) end; %% TestSpec processing finished @@ -3452,9 +3500,19 @@ modify_cases_upto1(Ref, {skip,Reason,FType,Mode,SkipType}, T, Orig, Alt) end; -%% next is some other case, ignore or copy -modify_cases_upto1(Ref, {skip,_,_,_,_}=Op, [_Other|T], Orig, Alt) -> +%% next is a repeated test case +modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType}=Op, + [{repeat,{_M,_F}=MF,_Repeat}|T], Orig, Alt) -> + modify_cases_upto1(Ref, Op, T, Orig, [{SkipType,{MF,Reason},Mode}|Alt]); + +%% next is an already skipped case, ignore or copy +modify_cases_upto1(Ref, {skip,_,_,_,_}=Op, [{SkipType,_,_}|T], Orig, Alt) + when SkipType=:=skip_case; SkipType=:=auto_skip_case -> modify_cases_upto1(Ref, Op, T, Orig, Alt); + +%% next is some other case, mark as skipped or copy +modify_cases_upto1(Ref, {skip,Reason,_,Mode,SkipType}=Op, [Other|T], Orig, Alt) -> + modify_cases_upto1(Ref, Op, T, Orig, [{SkipType,{Other,Reason},Mode}|Alt]); modify_cases_upto1(Ref, CopyOp, [C|T], Orig, Alt) -> modify_cases_upto1(Ref, CopyOp, T, [C|Orig], [C|Alt]). @@ -3842,6 +3900,10 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, {died,{timetrap_timeout,TimetrapTimeout}} -> progress(failed, Num, Mod, Func, GrName, Loc, timetrap_timeout, TimetrapTimeout, Comment, Style); + {died,Reason={auto_skip,_Why}} -> + %% died in init_per_testcase or in a hook in this context + progress(skip, Num, Mod, Func, GrName, Loc, Reason, + Time, Comment, Style); {died,{Skip,Reason}} when Skip==skip; Skip==skipped -> %% died in init_per_testcase progress(skip, Num, Mod, Func, GrName, Loc, Reason, @@ -4800,6 +4862,14 @@ collect_cases({make,InitMFA,CaseList,FinMFA}, St0, Mode) -> {error,_Reason} = Error -> Error end; +collect_cases({repeat,{Module, Case}, Repeat}, St, Mode) -> + case catch collect_case([Case], St#cc{mod=Module}, [], Mode) of + {ok, [{Module,Case}], _} -> + {ok, [{repeat,{Module, Case}, Repeat}], St}; + Other -> + {error,Other} + end; + collect_cases({Module, Cases}, St, Mode) when is_list(Cases) -> case (catch collect_case(Cases, St#cc{mod=Module}, [], Mode)) of Result = {ok,_,_} -> @@ -5763,3 +5833,42 @@ encoding(File) -> E -> E end. + +check_repeat_testcase(Case,Result,Cases, + [{Ref,[{repeat,RepeatData0}],StartTime}|Mode0]) -> + case do_update_repeat_data(Result,RepeatData0) of + false -> + {Cases,Mode0}; + RepeatData -> + {[Case|Cases],[{Ref,[{repeat,RepeatData}],StartTime}|Mode0]} + end; +check_repeat_testcase(_,_,Cases,Mode) -> + {Cases,Mode}. + +do_update_repeat_data(_,{RT,N,N}) when is_integer(N) -> + report_repeat_testcase(N,N), + report_stop_repeat_testcase(done,{RT,N}), + false; +do_update_repeat_data(ok,{repeat_until_ok=RT,M,N}) -> + report_repeat_testcase(M,N), + report_stop_repeat_testcase(RT,{RT,N}), + false; +do_update_repeat_data(failed,{repeat_until_fail=RT,M,N}) -> + report_repeat_testcase(M,N), + report_stop_repeat_testcase(RT,{RT,N}), + false; +do_update_repeat_data(_,{RT,M,N}) when is_integer(M) -> + report_repeat_testcase(M,N), + {RT,M+1,N}; +do_update_repeat_data(_,{_,M,N}=RepeatData) -> + report_repeat_testcase(M,N), + RepeatData. + +report_stop_repeat_testcase(Reason,RepVal) -> + print(minor, "~n*** Stopping test case repeat operation: ~w", [Reason]), + print(1, "Stopping test case repeat operation: ~w", [RepVal]). + +report_repeat_testcase(M,forever) -> + print(minor, "~n=== Repeated test case: ~w of infinity", [M]); +report_repeat_testcase(M,N) -> + print(minor, "~n=== Repeated test case: ~w of ~w", [M,N]). diff --git a/lib/common_test/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl index ea7ad8538e..f77d5a4966 100644 --- a/lib/common_test/src/test_server_node.erl +++ b/lib/common_test/src/test_server_node.erl @@ -18,7 +18,7 @@ %% %CopyrightEnd% %% -module(test_server_node). --compile(r16). +-compile(r20). %%% %%% The same compiled code for this module must be possible to load @@ -598,11 +598,20 @@ pick_erl_program(L) -> {prog, S} -> S; {release, S} -> + clear_erl_aflags(), find_release(S); this -> ct:get_progname() end. +clear_erl_aflags() -> + %% When starting a node with a previous release, options in + %% ERL_AFLAGS could prevent the node from starting. For example, + %% if ERL_AFLAGS is set to "-emu_type lcnt", the node will only + %% start if the previous release happens to also have a lock + %% counter emulator installed (unlikely). + os:unsetenv("ERL_AFLAGS"). + %% This is an attempt to distinguish between spaces in the program %% path and spaces that separate arguments. The program is quoted to %% allow spaces in the path. @@ -656,9 +665,19 @@ find_release({unix,linux}, Rel) -> find_release(_, _) -> none. find_rel_linux(Rel) -> - case suse_release() of - none -> []; - SuseRel -> find_rel_suse(Rel, SuseRel) + try + case ubuntu_release() of + none -> none; + [UbuntuRel |_] -> throw(find_rel_ubuntu(Rel, UbuntuRel)) + end, + case suse_release() of + none -> none; + SuseRel -> throw(find_rel_suse(Rel, SuseRel)) + end, + [] + catch + throw:Result -> + Result end. find_rel_suse(Rel, SuseRel) -> @@ -735,6 +754,93 @@ suse_release(Fd) -> end end. +find_rel_ubuntu(_Rel, UbuntuRel) when is_integer(UbuntuRel), UbuntuRel < 16 -> + []; +find_rel_ubuntu(Rel, UbuntuRel) when is_integer(UbuntuRel) -> + Root = "/usr/local/otp/releases/ubuntu", + lists:foldl(fun (ChkUbuntuRel, Acc) -> + find_rel_ubuntu_aux1(Rel, Root++integer_to_list(ChkUbuntuRel)) + ++ Acc + end, + [], + lists:seq(16, UbuntuRel)). + +find_rel_ubuntu_aux1(Rel, RootWc) -> + case erlang:system_info(wordsize) of + 4 -> + find_rel_ubuntu_aux2(Rel, RootWc++"_32"); + 8 -> + find_rel_ubuntu_aux2(Rel, RootWc++"_64") ++ + find_rel_ubuntu_aux2(Rel, RootWc++"_32") + end. + +find_rel_ubuntu_aux2(Rel, RootWc) -> + RelDir = filename:dirname(RootWc), + Pat = filename:basename(RootWc ++ "_" ++ Rel) ++ ".*", + case file:list_dir(RelDir) of + {ok,Dirs} -> + case lists:filter(fun(Dir) -> + case re:run(Dir, Pat, [unicode]) of + nomatch -> false; + _ -> true + end + end, Dirs) of + [] -> + []; + [R|_] -> + [filename:join([RelDir,R,"bin","erl"])] + end; + _ -> + [] + end. + +ubuntu_release() -> + case file:open("/etc/lsb-release", [read]) of + {ok,Fd} -> + try + ubuntu_release(Fd, undefined, undefined) + after + file:close(Fd) + end; + {error,_} -> none + end. + +ubuntu_release(_Fd, DistrId, Rel) when DistrId /= undefined, + Rel /= undefined -> + Ubuntu = case DistrId of + "Ubuntu" -> true; + "ubuntu" -> true; + _ -> false + end, + case Ubuntu of + false -> none; + true -> Rel + end; +ubuntu_release(Fd, DistroId, Rel) -> + case io:get_line(Fd, '') of + eof -> + none; + Line when is_list(Line) -> + case re:run(Line, "^DISTRIB_ID=(\\w+)$", + [{capture,all_but_first,list}]) of + {match,[NewDistroId]} -> + ubuntu_release(Fd, NewDistroId, Rel); + nomatch -> + case re:run(Line, "^DISTRIB_RELEASE=(\\d+(?:\\.\\d+)*)$", + [{capture,all_but_first,list}]) of + {match,[RelList]} -> + NewRel = lists:map(fun (N) -> + list_to_integer(N) + end, + string:lexemes(RelList, ".")), + ubuntu_release(Fd, DistroId, NewRel); + nomatch -> + ubuntu_release(Fd, DistroId, Rel) + end + end + end. + + unpack(Bin) -> {One,Term} = split_binary(Bin, 1), case binary_to_list(One) of diff --git a/lib/common_test/src/test_server_sup.erl b/lib/common_test/src/test_server_sup.erl index 26e7534c6c..ab8066a88d 100644 --- a/lib/common_test/src/test_server_sup.erl +++ b/lib/common_test/src/test_server_sup.erl @@ -770,7 +770,7 @@ framework_call(Callback,Func,Args,DefaultReturn) -> end, case SetTcState of true -> - test_server:set_tc_state({framework,Mod,Func}); + test_server:set_tc_state({framework,{Mod,Func,Args}}); false -> ok end, diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index ecd1f727a2..e510b74d6a 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -74,7 +74,9 @@ MODULES= \ ct_SUITE \ ct_keep_logs_SUITE \ ct_unicode_SUITE \ - ct_auto_clean_SUITE + ct_auto_clean_SUITE \ + ct_util_SUITE \ + ct_tc_repeat_SUITE ERL_FILES= $(MODULES:%=%.erl) HRL_FILES= test_server_test_lib.hrl diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index 7468ebe9d9..d31bd26273 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -648,33 +648,35 @@ test_events(cfg_error) -> {?eh,tc_start,{cfg_error_11_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_11_SUITE,end_per_suite,ok}}, {?eh,tc_start,{cfg_error_12_SUITE,tc1}}, - {?eh,tc_done,{ct_framework,init_tc,{framework_error,{timetrap,500}}}}, - {?eh,test_stats,{13,8,{0,19}}}, + {?eh,tc_done,{cfg_error_12_SUITE,tc1, + {auto_skipped, + {failed,{ct_framework,init_tc,{timetrap,500}}}}}}, + {?eh,test_stats,{13,7,{0,20}}}, {?eh,tc_start,{cfg_error_12_SUITE,tc2}}, {?eh,tc_done,{cfg_error_12_SUITE,tc2,{failed, {cfg_error_12_SUITE,end_per_testcase, {timetrap_timeout,500}}}}}, - {?eh,test_stats,{14,8,{0,19}}}, + {?eh,test_stats,{14,7,{0,20}}}, {?eh,tc_start,{cfg_error_12_SUITE,tc3}}, {?eh,tc_done,{cfg_error_12_SUITE,tc3,ok}}, - {?eh,test_stats,{15,8,{0,19}}}, + {?eh,test_stats,{15,7,{0,20}}}, {?eh,tc_start,{cfg_error_12_SUITE,tc4}}, {?eh,tc_done,{cfg_error_12_SUITE,tc4,{failed, {cfg_error_12_SUITE,end_per_testcase, {timetrap_timeout,500}}}}}, - {?eh,test_stats,{16,8,{0,19}}}, + {?eh,test_stats,{16,7,{0,20}}}, {?eh,tc_start,{cfg_error_13_SUITE,init_per_suite}}, {?eh,tc_done,{cfg_error_13_SUITE,init_per_suite,ok}}, {?eh,tc_start,{cfg_error_13_SUITE,tc1}}, {?eh,tc_done,{cfg_error_13_SUITE,tc1,ok}}, - {?eh,test_stats,{17,8,{0,19}}}, + {?eh,test_stats,{17,7,{0,20}}}, {?eh,tc_start,{cfg_error_13_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_13_SUITE,end_per_suite,ok}}, {?eh,tc_start,{cfg_error_14_SUITE,init_per_suite}}, {?eh,tc_done,{cfg_error_14_SUITE,init_per_suite,ok}}, {?eh,tc_start,{cfg_error_14_SUITE,tc1}}, {?eh,tc_done,{cfg_error_14_SUITE,tc1,ok}}, - {?eh,test_stats,{18,8,{0,19}}}, + {?eh,test_stats,{18,7,{0,20}}}, {?eh,tc_start,{cfg_error_14_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_14_SUITE,end_per_suite, {comment, @@ -728,25 +730,30 @@ test_events(lib_error) -> {lib_error_1_SUITE,no_lines_throw,{failed,{error,{thrown,catch_me_if_u_can}}}}}, {?eh,test_stats,{0,8,{0,0}}}, {?eh,tc_start,{lib_error_1_SUITE,init_tc_error}}, - {?eh,tc_done,{ct_framework,init_tc, - {framework_error,{{badmatch,[1,2]},'_'}}}}, - {?eh,test_stats,{0,9,{0,0}}}, + {?eh,tc_done,{lib_error_1_SUITE,init_tc_error, + {auto_skipped, + {failed, + {ct_framework,init_tc, + {{badmatch,[1,2]},'_'}}}}}}, + {?eh,test_stats,{0,8,{0,1}}}, {?eh,tc_start,{lib_error_1_SUITE,init_tc_exit}}, - {?eh,tc_done,{ct_framework,init_tc,{framework_error,byebye}}}, - {?eh,test_stats,{0,10,{0,0}}}, + {?eh,tc_done,{lib_error_1_SUITE,init_tc_exit, + {auto_skipped,{failed,{ct_framework,init_tc,byebye}}}}}, + {?eh,test_stats,{0,8,{0,2}}}, {?eh,tc_start,{lib_error_1_SUITE,init_tc_throw}}, - {?eh,tc_done,{ct_framework,init_tc,{framework_error,catch_me_if_u_can}}}, - {?eh,test_stats,{0,11,{0,0}}}, + {?eh,tc_done,{lib_error_1_SUITE,init_tc_throw, + {auto_skipped,{failed,{ct_framework,init_tc, + catch_me_if_u_can}}}}}, + {?eh,test_stats,{0,8,{0,3}}}, {?eh,tc_start,{lib_error_1_SUITE,end_tc_error}}, - {?eh,tc_done,{ct_framework,end_tc, - {framework_error,{{badmatch,[1,2]},'_'}}}}, - {?eh,test_stats,{0,12,{0,0}}}, + {?eh,tc_done,{lib_error_1_SUITE,end_tc_error,ok}}, % warning in comment + {?eh,test_stats,{1,8,{0,3}}}, {?eh,tc_start,{lib_error_1_SUITE,end_tc_exit}}, - {?eh,tc_done,{ct_framework,end_tc,{framework_error,byebye}}}, - {?eh,test_stats,{0,13,{0,0}}}, + {?eh,tc_done,{lib_error_1_SUITE,end_tc_exit,ok}}, % warning in comment + {?eh,test_stats,{2,8,{0,3}}}, {?eh,tc_start,{lib_error_1_SUITE,end_tc_throw}}, - {?eh,tc_done,{ct_framework,end_tc,{framework_error,catch_me_if_u_can}}}, - {?eh,test_stats,{0,14,{0,0}}}, + {?eh,tc_done,{lib_error_1_SUITE,end_tc_throw,ok}}, % warning in comment + {?eh,test_stats,{3,8,{0,3}}}, {?eh,tc_start,{lib_error_1_SUITE,end_per_suite}}, {?eh,tc_done,{lib_error_1_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 44b86b1dfe..340b8f3d52 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -73,11 +73,15 @@ all() -> all(suite) -> lists:reverse( [ + crash_groups, crash_all, bad_return_groups, bad_return_all, + illegal_values_groups, illegal_values_all, alter_groups, alter_all, + alter_all_to_skip, alter_all_from_skip, one_cth, two_cth, faulty_cth_no_init, faulty_cth_id_no_init, faulty_cth_exit_in_init, faulty_cth_exit_in_id, faulty_cth_exit_in_init_scope_suite, minimal_cth, minimal_and_maximal_cth, faulty_cth_undef, scope_per_suite_cth, scope_per_group_cth, scope_suite_cth, + scope_suite_group_only_cth, scope_per_suite_state_cth, scope_per_group_state_cth, scope_suite_state_cth, fail_pre_suite_cth, double_fail_pre_suite_cth, @@ -152,6 +156,11 @@ scope_suite_cth(Config) when is_list(Config) -> do_test(scope_suite_cth, "ct_scope_suite_cth_SUITE.erl", [],Config). +scope_suite_group_only_cth(Config) when is_list(Config) -> + do_test(scope_suite_group_only_cth, + "ct_scope_suite_group_only_cth_SUITE.erl", + [],Config,ok,2,[{group,g1}]). + scope_per_group_cth(Config) when is_list(Config) -> do_test(scope_per_group_cth, "ct_scope_per_group_cth_SUITE.erl", [],Config). @@ -304,10 +313,74 @@ repeat_force_stop(Config) -> [{force_stop,skip_rest},{duration,"000009"}]). %% Test that expected callbacks, and only those, are called when a test -%% are fails due to clash in config alias names +%% fails due to clash in config alias names config_clash(Config) -> do_test(config_clash, "config_clash_SUITE.erl", [skip_cth], Config). +%% Test post_groups and post_all hook callbacks, introduced by OTP-14746 +alter_groups(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_groups_return,[{new_group,[tc1,tc2]}]}, + {post_all_return,[{group,new_group}]}],Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +alter_all(Config) -> + CfgFile = gen_config(?FUNCTION_NAME,[{post_all_return,[tc2]}],Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +alter_all_from_skip(Config) -> + CfgFile = gen_config(?FUNCTION_NAME,[{all_return,{skip,"skipped by all/0"}}, + {post_all_return,[tc2]}],Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +alter_all_to_skip(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_all_return,{skip,"skipped by post_all/3"}}], + Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +bad_return_groups(Config) -> + CfgFile = gen_config(?FUNCTION_NAME,[{post_groups_return,not_a_list}], + Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +bad_return_all(Config) -> + CfgFile = gen_config(?FUNCTION_NAME,[{post_all_return,not_a_list}], + Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +illegal_values_groups(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_groups_return,[{new_group,[this_test_does_not_exist]}, + this_is_not_a_group_def]}], + Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +illegal_values_all(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_all_return,[{group,this_group_does_not_exist}, + {this_is_not_a_valid_term}]}], + Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +crash_groups(Config) -> + CfgFile = gen_config(?FUNCTION_NAME,[{post_groups_return,crash}],Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + +crash_all(Config) -> + CfgFile = gen_config(?FUNCTION_NAME,[{post_all_return,crash}],Config), + do_test(?FUNCTION_NAME, "all_and_groups_SUITE.erl", [all_and_groups_cth], + Config, ok, 2, [{config,CfgFile}]). + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -327,6 +400,7 @@ do_test(Tag, {WhatTag,Wildcard}, CTHs, Config, Res, EC, ExtraOpts) -> filename:join([DataDir,"cth/tests",Wildcard])), {Opts,ERPid} = setup([{WhatTag,Files},{ct_hooks,CTHs},{label,Tag}|ExtraOpts], Config), + Res = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), @@ -352,6 +426,13 @@ reformat(Events, EH) -> %reformat(Events, _EH) -> % Events. +gen_config(Name,KeyVals,Config) -> + PrivDir = ?config(priv_dir,Config), + File = filename:join(PrivDir,atom_to_list(Name)++".cfg"), + ok = file:write_file(File,[io_lib:format("~p.~n",[{Key,Value}]) + || {Key,Value} <- KeyVals]), + File. + %%%----------------------------------------------------------------- %%% TEST EVENTS %%%----------------------------------------------------------------- @@ -370,13 +451,16 @@ test_events(one_empty_cth) -> {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{empty_cth,id,[[]]}}, {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + %% check that post_groups and post_all comes after init when hook + %% is installed with start flag/option. + {?eh,cth,{empty_cth,post_groups,[ct_cth_empty_SUITE,[]]}}, + {?eh,cth,{empty_cth,post_all,[ct_cth_empty_SUITE,[test_case],[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{empty_cth,pre_init_per_suite, [ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_init_per_suite, [ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, - {?eh,tc_start,{ct_cth_empty_SUITE,test_case}}, {?eh,cth,{empty_cth,pre_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist',[]]}}, {?eh,cth,{empty_cth,post_init_per_testcase,[ct_cth_empty_SUITE,test_case,'$proplist','_',[]]}}, @@ -585,6 +669,10 @@ test_events(scope_suite_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + %% check that post_groups and post_all comes before init when hook + %% is installed in suite/0 + {?eh,cth,{'_',post_groups,['_',[]]}}, + {?eh,cth,{'_',post_all,['_','_',[]]}}, {?eh,tc_start,{ct_scope_suite_cth_SUITE,init_per_suite}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, @@ -606,6 +694,34 @@ test_events(scope_suite_cth) -> {?eh,stop_logging,[]} ]; +test_events(scope_suite_group_only_cth) -> + Suite = ct_scope_suite_group_only_cth_SUITE, + CTH = empty_cth, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,1}}, + %% check that post_groups and post_all comes before init when hook + %% is installed in suite/0 + {?eh,cth,{CTH,post_groups,['_',['_']]}}, + {negative, + {?eh,cth,{CTH,post_all,['_','_','_']}}, + {?eh,tc_start,{Suite,init_per_suite}}}, + {?eh,cth,{CTH,id,[[]]}}, + {?eh,cth,{CTH,init,['_',[]]}}, + {?eh,cth,{CTH,pre_init_per_suite,[Suite,'$proplist',mystate]}}, + {?eh,cth,{CTH,post_init_per_suite,[Suite,'$proplist','$proplist',mystate]}}, + {?eh,tc_done,{Suite,init_per_suite,ok}}, + + {?eh,tc_start,{Suite,end_per_suite}}, + {?eh,cth,{CTH,pre_end_per_suite,[Suite,'$proplist',mystate]}}, + {?eh,cth,{CTH,post_end_per_suite,[Suite,'$proplist','_',mystate]}}, + {?eh,cth,{CTH,terminate,[mystate]}}, + {?eh,tc_done,{Suite,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + test_events(scope_per_group_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, @@ -665,6 +781,8 @@ test_events(scope_suite_state_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',post_groups,['_',[]]}}, + {?eh,cth,{'_',post_all,['_','_',[]]}}, {?eh,tc_start,{ct_scope_suite_state_cth_SUITE,init_per_suite}}, {?eh,cth,{'_',id,[[test]]}}, {?eh,cth,{'_',init,['_',[test]]}}, @@ -2313,6 +2431,229 @@ test_events(config_clash) -> %% Make sure no 'cth_error' events are received! [{negative,{?eh,cth_error,'_'},E} || E <- Events]; +test_events(alter_groups) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE, + [{new_group,[tc1,tc2]}]]}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,[{group,new_group}], + [{new_group,[tc1,tc2]}]]}}, + {?eh,start_info,{1,1,2}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE, + [{new_group,[tc1,tc2]}]]}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,[{group,new_group}], + [{new_group,[tc1,tc2]}]]}}, + {?eh,tc_start,{all_and_groups_SUITE,{init_per_group,new_group,[]}}}, + {?eh,tc_done,{all_and_groups_SUITE, + {init_per_group,new_group,'$proplist'},ok}}, + {?eh,tc_start,{all_and_groups_SUITE,tc1}}, + {?eh,tc_done,{all_and_groups_SUITE,tc1,ok}}, + {?eh,tc_start,{all_and_groups_SUITE,tc2}}, + {?eh,tc_done,{all_and_groups_SUITE,tc2,ok}}, + {?eh,tc_start,{all_and_groups_SUITE,{end_per_group,new_group,[]}}}, + {?eh,tc_done,{all_and_groups_SUITE, + {end_per_group,new_group,'$proplist'},ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(alter_all) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE, + [{test_group,[tc1]}]]}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,[tc2], + [{test_group,[tc1]}]]}}, + {?eh,start_info,{1,1,1}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,[tc2],'_']}}, + {?eh,tc_start,{all_and_groups_SUITE,tc2}}, + {?eh,tc_done,{all_and_groups_SUITE,tc2,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(alter_all_from_skip) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE, + [{test_group,[tc1]}]]}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,[tc2], + [{test_group,[tc1]}]]}}, + {?eh,start_info,{1,1,1}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,[tc2],'_']}}, + {?eh,tc_start,{all_and_groups_SUITE,tc2}}, + {?eh,tc_done,{all_and_groups_SUITE,tc2,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(alter_all_to_skip) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE, + [{test_group,[tc1]}]]}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE, + {skip,"skipped by post_all/3"}, + [{test_group,[tc1]}]]}}, + {?eh,start_info,{1,1,0}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE, + {skip,"skipped by post_all/3"}, + '_']}}, + {?eh,tc_user_skip,{all_and_groups_SUITE,all,"skipped by post_all/3"}}, + {?eh,cth,{'_',on_tc_skip,[all_and_groups_SUITE,all, + {tc_user_skip,"skipped by post_all/3"}, + []]}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(illegal_values_groups) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups, + [all_and_groups_SUITE, + [{new_group,[this_test_does_not_exist]}, + this_is_not_a_group_def]]}}, + {?eh,start_info,{1,0,0}}, + {?eh,cth,{empty_cth,post_groups, + [all_and_groups_SUITE, + [{new_group,[this_test_does_not_exist]}, + this_is_not_a_group_def]]}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done,{ct_framework,error_in_suite,{failed,{error,'_'}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(illegal_values_all) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all, + [all_and_groups_SUITE, + [{group,this_group_does_not_exist}, + {this_is_not_a_valid_term}],'_']}}, + {?eh,start_info,{1,0,0}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all, + [all_and_groups_SUITE, + [{group,this_group_does_not_exist}, + {this_is_not_a_valid_term}],'_']}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done, + {ct_framework,error_in_suite, + {failed, + {error,'Invalid reference to group this_group_does_not_exist in all_and_groups_SUITE:all/0'}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(bad_return_groups) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,not_a_list]}}, + {?eh,start_info,{1,0,0}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,not_a_list]}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done, + {ct_framework,error_in_suite, + {failed, + {error, + {'Bad return value from post_groups/2 hook function',not_a_list}}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(bad_return_all) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,not_a_list,'_']}}, + {?eh,start_info,{1,0,0}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,not_a_list,'_']}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done, + {ct_framework,error_in_suite, + {failed, + {error,{'Bad return value from post_all/3 hook function',not_a_list}}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(crash_groups) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,crash]}}, + {?eh,start_info,{1,0,0}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,crash]}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done,{ct_framework,error_in_suite, + {failed, + {error,"all_and_groups_cth:post_groups/2 CTH call failed"}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(crash_all) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, + {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,crash,'_']}}, + {?eh,start_info,{1,0,0}}, + {?eh,cth,{empty_cth,post_groups,[all_and_groups_SUITE,'_']}}, + {?eh,cth,{empty_cth,post_all,[all_and_groups_SUITE,crash,'_']}}, + {?eh,tc_start,{ct_framework,error_in_suite}}, + {?eh,tc_done,{ct_framework,error_in_suite, + {failed, + {error,"all_and_groups_cth:post_all/3 CTH call failed"}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,cth,{empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + test_events(ok) -> ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_and_groups_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_and_groups_SUITE.erl new file mode 100644 index 0000000000..adc86005f9 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_and_groups_SUITE.erl @@ -0,0 +1,47 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(all_and_groups_SUITE). + +-suite_defaults([{timetrap, {minutes, 10}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +init_per_group(_Group,Config) -> + Config. + +end_per_group(_Group,Config) -> + ok. + +all() -> + ct:get_config(all_return,[{group,test_group}]). + +groups() -> + [{test_group,[tc1]}]. + +%% Test cases starts here. +tc1(Config) -> + ok. + +tc2(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_and_groups_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_and_groups_cth.erl new file mode 100644 index 0000000000..9ebc00e9de --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/all_and_groups_cth.erl @@ -0,0 +1,100 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + + +-module(all_and_groups_cth). + + +-include_lib("common_test/src/ct_util.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +%% Send a cth_error event if a callback is called with unexpected arguments +-define(fail(Info), + gen_event:notify( + ?CT_EVMGR_REF, + #event{ name = cth_error, + node = node(), + data = {illegal_hook_callback,{?MODULE,?FUNCTION_NAME,Info}}})). + +%% CT Hooks +-compile(export_all). + +id(Opts) -> + empty_cth:id(Opts). + +post_groups(Suite,Groups) -> + case empty_cth:post_groups(Suite,ct:get_config(post_groups_return,Groups)) of + crash -> error(crash_in_post_groups); + R -> R + end. + +post_all(Suite,Tests,Groups) -> + case empty_cth:post_all(Suite,ct:get_config(post_all_return,Tests),Groups) of + crash -> error(crash_in_post_all); + R -> R + end. + +init(Id, Opts) -> + empty_cth:init(Id, Opts). + +pre_init_per_suite(Suite, Config, State) -> + empty_cth:pre_init_per_suite(Suite,Config,State). + +post_init_per_suite(Suite,Config,Return,State) -> + empty_cth:post_init_per_suite(Suite,Config,Return,State). + +pre_end_per_suite(Suite,Config,State) -> + empty_cth:pre_end_per_suite(Suite,Config,State). + +post_end_per_suite(Suite,Config,Return,State) -> + empty_cth:post_end_per_suite(Suite,Config,Return,State). + +pre_init_per_group(Suite,Group,Config,State) -> + empty_cth:pre_init_per_group(Suite,Group,Config,State). + +post_init_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_init_per_group(Suite,Group,Config,Return,State). + +pre_end_per_group(Suite,Group,Config,State) -> + empty_cth:pre_end_per_group(Suite,Group,Config,State). + +post_end_per_group(Suite,Group,Config,Return,State) -> + empty_cth:post_end_per_group(Suite,Group,Config,Return,State). + +pre_init_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_init_per_testcase(Suite,TC,Config,State). + +post_init_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_init_per_testcase(Suite,TC,Config,Return,State). + +pre_end_per_testcase(Suite,TC,Config,State) -> + empty_cth:pre_end_per_testcase(Suite,TC,Config,State). + +post_end_per_testcase(Suite,TC,Config,Return,State) -> + empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State). + +on_tc_fail(Suite,TC,Reason,State) -> + empty_cth:on_tc_fail(Suite,TC,Reason,State). + +on_tc_skip(Suite,TC,Reason,State) -> + empty_cth:on_tc_skip(Suite,TC,Reason,State). + +terminate(State) -> + empty_cth:terminate(State). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_match_state_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_match_state_cth.erl new file mode 100644 index 0000000000..38c9da903d --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_match_state_cth.erl @@ -0,0 +1,58 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + + +-module(ct_match_state_cth). + + +-include_lib("common_test/src/ct_util.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +-compile(export_all). + +id(Opts) -> + empty_cth:id(Opts). + +post_groups(Suite, Groups) -> + empty_cth:post_groups(Suite, Groups). + +post_all(Suite, Tests, Groups) -> + empty_cth:post_all(Suite, Tests, Groups). + +init(Id, Opts) -> + empty_cth:init(Id, Opts), + {ok,mystate}. + +%% In the following, always match against the state value, to ensure +%% that init has indeed been called before the rest of the hooks. +pre_init_per_suite(Suite,Config,mystate) -> + empty_cth:pre_init_per_suite(Suite,Config,mystate). + +post_init_per_suite(Suite,Config,Return,mystate) -> + empty_cth:post_init_per_suite(Suite,Config,Return,mystate). + +pre_end_per_suite(Suite,Config,mystate) -> + empty_cth:pre_end_per_suite(Suite,Config,mystate). + +post_end_per_suite(Suite,Config,Return,mystate) -> + empty_cth:post_end_per_suite(Suite,Config,Return,mystate). + +terminate(mystate) -> + empty_cth:terminate(mystate). diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_scope_suite_group_only_cth_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_scope_suite_group_only_cth_SUITE.erl new file mode 100644 index 0000000000..537c97d3f0 --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_scope_suite_group_only_cth_SUITE.erl @@ -0,0 +1,54 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ct_scope_suite_group_only_cth_SUITE). + +-suite_defaults([{timetrap, {minutes, 10}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +%% Test server callback functions +suite() -> + [{ct_hooks,[ct_match_state_cth]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(_TestCase, _Config) -> + ok. + +all() -> + [test_case]. + +groups() -> + [{g1,[test_case]}]. + +%% Test cases starts here. +test_case(Config) when is_list(Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl index c648367838..60488e84c6 100644 --- a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/empty_cth.erl @@ -39,6 +39,9 @@ -export([id/1]). -export([init/2]). +-export([post_all/3]). +-export([post_groups/2]). + -export([pre_init_per_suite/3]). -export([post_init_per_suite/4]). -export([pre_end_per_suite/3]). @@ -71,6 +74,31 @@ -record(state, { id = ?MODULE :: term()}). +%% Called after groups/0. +%% You can change the return value in this function. +-spec post_groups(Suite :: atom(), Groups :: list()) -> list(). +post_groups(Suite,Groups) -> + gen_event:notify( + ?CT_EVMGR_REF, #event{ name = cth, node = node(), + data = {?MODULE, post_groups, + [Suite,Groups]}}), + ct:log("~w:post_groups(~w) called", [?MODULE,Suite]), + Groups. + +%% Called after all/0. +%% You can change the return value in this function. +-spec post_all(Suite :: atom(), + Tests :: list(), + Groups :: term()) -> + list(). +post_all(Suite,Tests,Groups) -> + gen_event:notify( + ?CT_EVMGR_REF, #event{ name = cth, node = node(), + data = {?MODULE, post_all, + [Suite,Tests,Groups]}}), + ct:log("~w:post_all(~w) called", [?MODULE,Suite]), + Tests. + %% Always called before any other callback function. Use this to initiate %% any common state. It should return an state for this CTH. -spec init(Id :: term(), Opts :: proplists:proplist()) -> 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 7aaf33839f..69a7de1431 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 @@ -271,7 +271,7 @@ no_client_hello(Config) -> %% Tell server to receive a get request and then die without %% replying since no hello has been received. (is this correct - %% behavoiur??) + %% behaviour??) ?NS:expect_do(get,close), {error,closed} = ct_netconfc:get(Client,whatever), ok. diff --git a/lib/common_test/test/ct_tc_repeat_SUITE.erl b/lib/common_test/test/ct_tc_repeat_SUITE.erl new file mode 100644 index 0000000000..433b5456fe --- /dev/null +++ b/lib/common_test/test/ct_tc_repeat_SUITE.erl @@ -0,0 +1,438 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(ct_tc_repeat_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +-define(eh, ct_test_support_eh). + +%%-------------------------------------------------------------------- +%% TEST SERVER CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% Description: Since Common Test starts another Test Server +%% instance, the tests need to be performed on a separate node (or +%% there will be clashes with logging processes etc). +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + DataDir = ?config(data_dir, Config), + ct_test_support:init_per_suite([{path_dirs,[DataDir]} | Config]). + +end_per_suite(Config) -> + ct_test_support:end_per_suite(Config). + +init_per_testcase(TestCase, Config) -> + ct_test_support:init_per_testcase(TestCase, Config). + +end_per_testcase(TestCase, Config) -> + ct_test_support:end_per_testcase(TestCase, Config). + + +suite() -> + [{timetrap,{minutes,1}}]. + +all() -> + all(suite). + +all(suite) -> + [ + repeat, + repeat_parallel_until_ok, + repeat_parallel_until_fail, + repeat_sequence_until_ok, + repeat_sequence_until_fail, + pick_one_test_from_group, + pick_one_test_from_subgroup + ]. + + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +%%%----------------------------------------------------------------- +%%% +%% Test post_groups and post_all hook callbacks, introduced by OTP-14746 +repeat(Config) -> + ok = do_test(?FUNCTION_NAME, "tc_repeat_SUITE", [], [], Config). + +repeat_parallel_until_ok(Config) -> + {error,{{illegal_combination,{parallel,repeat_until_ok}},_}} = + do_test(?FUNCTION_NAME, "tc_repeat_SUITE", [{group,g_parallel_until_ok}], + [], Config, 1, []). + +repeat_parallel_until_fail(Config) -> + {error,{{illegal_combination,{parallel,repeat_until_fail}},_}} = + do_test(?FUNCTION_NAME, "tc_repeat_SUITE", [{group,g_parallel_until_fail}], + [], Config, 1, []). + +repeat_sequence_until_ok(Config) -> + {error,{{illegal_combination,{sequence,repeat_until_ok}},_}} = + do_test(?FUNCTION_NAME, "tc_repeat_SUITE", [{group,g_sequence_until_ok}], + [], Config, 1, []). + +repeat_sequence_until_fail(Config) -> + {error,{{illegal_combination,{sequence,repeat_until_fail}},_}} = + do_test(?FUNCTION_NAME, "tc_repeat_SUITE", [{group,g_sequence_until_fail}], + [], Config, 1, []). + +pick_one_test_from_group(Config) -> + do_test(?FUNCTION_NAME, "tc_repeat_SUITE", [{group,g_mixed},{testcase,tc2}], + [], Config, 1, []). + +pick_one_test_from_subgroup(Config) -> + do_test(?FUNCTION_NAME, "tc_repeat_SUITE", + [{group,[[g_mixed,subgroup]]},{testcase,tc2}], + [], Config, 1, []). + + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- + +do_test(Tag, Suite, WTT, CTHs, Config) -> + do_test(Tag, Suite, WTT, CTHs, Config, 2, []). + +do_test(Tag, Suite0, WTT, CTHs, Config, EC, ExtraOpts) -> + DataDir = ?config(data_dir, Config), + Suite = filename:join([DataDir,Suite0]), + {Opts,ERPid} = + setup([{suite,Suite}|WTT]++[{ct_hooks,CTHs},{label,Tag}|ExtraOpts], + Config), + Res = ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + %% io:format("~p~n",[Events]), + + ct_test_support:log_events(Tag, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + + TestEvents = events_to_check(Tag, EC), + ok = ct_test_support:verify_events(TestEvents, Events, Config), + Res. + +setup(Test, Config) -> + Opts0 = ct_test_support:get_opts(Config), + Level = ?config(trace_level, Config), + EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + ERPid = ct_test_support:start_event_receiver(Config), + {Opts,ERPid}. + +reformat(Events, EH) -> + ct_test_support:reformat(Events, EH). + +gen_config(Name,KeyVals,Config) -> + PrivDir = ?config(priv_dir,Config), + File = filename:join(PrivDir,atom_to_list(Name)++".cfg"), + ok = file:write_file(File,[io_lib:format("~p.~n",[{Key,Value}]) + || {Key,Value} <- KeyVals]), + File. + +%%%----------------------------------------------------------------- +%%% TEST EVENTS +%%%----------------------------------------------------------------- +events_to_check(Test) -> + %% 2 tests (ct:run_test + script_start) is default + events_to_check(Test, 2). + +events_to_check(_, 0) -> + []; +events_to_check(Test, N) -> + test_events(Test) ++ events_to_check(Test, N-1). + +test_events(repeat) -> + S = tc_repeat_SUITE, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,unknown}}, + + %% tc1, {repeat,2} + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + %% tc2, {repeat_until_ok,3} + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{3,0,{0,0}}}, + %% tc3, {repeat_until_ok,3} + {?eh,tc_start,{S,tc3}}, + {?eh,tc_done,{tc_repeat_SUITE,tc3, + {failed,{error,{test_case_failed,always_fail}}}}}, + {?eh,test_stats,{3,1,{0,0}}}, + {?eh,tc_start,{S,tc3}}, + {?eh,tc_done,{S,tc3,{failed,{error,{test_case_failed,always_fail}}}}}, + {?eh,test_stats,{3,2,{0,0}}}, + {?eh,tc_start,{S,tc3}}, + {?eh,tc_done,{S,tc3,{failed,{error,{test_case_failed,always_fail}}}}}, + {?eh,test_stats,{3,3,{0,0}}}, + %% tc4, {repeat_until_fail,3} + {?eh,tc_start,{S,tc4}}, + {?eh,tc_done,{S,tc4,ok}}, + {?eh,test_stats,{4,3,{0,0}}}, + {?eh,tc_start,{S,tc4}}, + {?eh,tc_done,{S,tc4,{failed,{error,{test_case_failed,second_time_fail}}}}}, + {?eh,test_stats,{4,4,{0,0}}}, + %% g, tc1, {repeat,2} + {?eh,tc_start,{S,{init_per_group,g,[]}}}, + {?eh,tc_done,{S,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{5,4,{0,0}}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{6,4,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g,[]}}}, + {?eh,tc_done,{S,{end_per_group,g,[]},ok}}, + %% g_until_ok, tc2, {repeat_until_ok,3} + {?eh,tc_start,{S,{init_per_group,g_until_ok,[]}}}, + {?eh,tc_done,{S,{init_per_group,g_until_ok,[]},ok}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{7,4,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g_until_ok,[]}}}, + {?eh,tc_done,{S,{end_per_group,g_until_ok,[]},ok}}, + %% g_until_fail, tc4, {repeat_until_fail,3} + {?eh,tc_start,{S,{init_per_group,g_until_fail,[]}}}, + {?eh,tc_done,{S,{init_per_group,g_until_fail,[]},ok}}, + {?eh,tc_start,{S,tc4}}, + {?eh,tc_done,{S,tc4,ok}}, + {?eh,test_stats,{8,4,{0,0}}}, + {?eh,tc_start,{S,tc4}}, + {?eh,tc_done,{S,tc4,{failed,{error,{test_case_failed,second_time_fail}}}}}, + {?eh,test_stats,{8,5,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g_until_fail,[]}}}, + {?eh,tc_done,{S,{end_per_group,g_until_fail,[]},ok}}, + %% g, parallel, tc1, {repeat,2} + {parallel, + [{?eh,tc_start,{S,{init_per_group,g,[parallel]}}}, + {?eh,tc_done,{S,{init_per_group,g,[parallel]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{9,5,{0,0}}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{10,5,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g,[parallel]}}}, + {?eh,tc_done,{S,{end_per_group,g,[parallel]},ok}}]}, + %% g, sequence, tc1, {repeat,2} + {?eh,tc_start,{S,{init_per_group,g,[sequence]}}}, + {?eh,tc_done,{S,{init_per_group,g,[sequence]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{11,5,{0,0}}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{12,5,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g,[sequence]}}}, + {?eh,tc_done,{S,{end_per_group,g,[sequence]},ok}}, + %% g_sequence_skip_rest, + {?eh,tc_start,{S,{init_per_group,g_mixed,[sequence]}}}, + {?eh,tc_done,{S,{init_per_group,g_mixed,[sequence]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{13,5,{0,0}}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{14,5,{0,0}}}, + {?eh,tc_start,{S,tc4}}, + {?eh,tc_done,{S,tc4,ok}}, + {?eh,test_stats,{15,5,{0,0}}}, + {?eh,tc_start,{S,tc4}}, + {?eh,tc_done,{S,tc4,{failed,{error,{test_case_failed,second_time_fail}}}}}, + {?eh,test_stats,{15,6,{0,0}}}, + %% ----> fail in sequence, so skip rest + {?eh,tc_auto_skip,{S,{tc4,g_mixed}, % last of current repeat tc4 + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,1}}}, + {?eh,tc_auto_skip,{S,{tc1,g_mixed}, % single tc1 + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,2}}}, + {?eh,tc_auto_skip,{S,{tc1,g}, % group g, tc1, {repeat,2} + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,3}}}, + {?eh,tc_auto_skip,{S,{tc1,subgroup}, % subgroup, single tc1 + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,4}}}, + {?eh,tc_auto_skip,{S,{tc2,subgroup}, % subgroup, tc2, {repeat,2} + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,5}}}, + {?eh,tc_auto_skip,{S,{tc2,g_mixed}, % tc2, {repeat,2} + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,6}}}, + {?eh,tc_auto_skip,{S,{tc2,g_mixed}, % single tc2 + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,7}}}, + {?eh,tc_auto_skip,{S,{tc1,g_mixed}, % tc1, {repeat,2} + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,8}}}, + {?eh,tc_auto_skip,{S,{tc1,g_mixed}, % single tc1 + {failed,{tc_repeat_SUITE,tc4}}}}, + {?eh,test_stats,{15,6,{0,9}}}, + {?eh,tc_start,{S,{end_per_group,g_mixed,'_'}}}, + {?eh,tc_done,{S,{end_per_group,g_mixed,'_'},ok}}, + %% done + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(repeat_parallel_until_ok) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',{init_per_group,g_parallel_until_ok,[parallel]}}}, + {?eh,tc_done,{'_',{init_per_group,g_parallel_until_ok,[parallel]},ok}}, + {?eh,severe_error,{{illegal_combination,{parallel,repeat_until_ok}},'_'}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(repeat_parallel_until_fail) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',{init_per_group,g_parallel_until_fail,[parallel]}}}, + {?eh,tc_done,{'_',{init_per_group,g_parallel_until_fail,[parallel]},ok}}, + {?eh,severe_error,{{illegal_combination,{parallel,repeat_until_fail}},'_'}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(repeat_sequence_until_ok) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',{init_per_group,g_sequence_until_ok,[sequence]}}}, + {?eh,tc_done,{'_',{init_per_group,g_sequence_until_ok,[sequence]},ok}}, + {?eh,severe_error,{{illegal_combination,{sequence,repeat_until_ok}},'_'}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(repeat_sequence_until_fail) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',{init_per_group,g_sequence_until_fail,[sequence]}}}, + {?eh,tc_done,{'_',{init_per_group,g_sequence_until_fail,[sequence]},ok}}, + {?eh,severe_error,{{illegal_combination,{sequence,repeat_until_fail}},'_'}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(pick_one_test_from_group) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',{init_per_group,g_mixed,[]}}}, + {?eh,tc_done,{'_',{init_per_group,g_mixed,[]},ok}}, + {negative, + {?eh,tc_start,{'_',tc1}}, + {?eh,tc_start,{'_',tc2}}}, % single tc2 + {?eh,tc_done,{'_',tc2,ok}}, + {?eh,tc_start,{'_',tc2}}, % tc2, {repeat,2} + {?eh,tc_done,{'_',tc2,ok}}, + {?eh,tc_start,{'_',tc2}}, + {?eh,tc_done,{'_',tc2,ok}}, + {negative, + {?eh,tc_start,{'_',tc1}}, + {?eh,tc_start,{'_',{end_per_group,g_mixed,[]}}}}, + {?eh,tc_done,{'_',{end_per_group,g_mixed,[]},ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(pick_one_test_from_subgroup) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',{init_per_group,g_mixed,[]}}}, + {?eh,tc_done,{'_',{init_per_group,g_mixed,[]},ok}}, + {negative, + {?eh,tc_start,{'_',tc2}}, + {?eh,tc_start,{'_',{init_per_group,subgroup,[]}}}}, + {?eh,tc_done,{'_',{init_per_group,subgroup,[]},ok}}, + {negative, + {?eh,tc_start,{'_',tc1}}, + {?eh,tc_start,{'_',tc2}}}, % tc2, {repeat,2} + {?eh,tc_done,{'_',tc2,ok}}, + {?eh,tc_start,{'_',tc2}}, + {?eh,tc_done,{'_',tc2,ok}}, + {negative, + {?eh,tc_start,{'_',tc1}}, + {?eh,tc_start,{'_',{end_per_group,subgroup,[]}}}}, + {?eh,tc_done,{'_',{end_per_group,subgroup,[]},ok}}, + {negative, + {?eh,tc_start,{'_',tc2}}, + {?eh,tc_start,{'_',{end_per_group,g_mixed,[]}}}}, + {?eh,tc_done,{'_',{end_per_group,g_mixed,[]},ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(ok) -> + ok. + +%% test events help functions +contains(List) -> + fun(Proplist) when is_list(Proplist) -> + contains(List,Proplist) + end. + +contains([{not_in_order,List}|T],Rest) -> + contains_parallel(List,Rest), + contains(T,Rest); +contains([{Ele,Pos}|T] = L,[H|T2]) -> + case element(Pos,H) of + Ele -> + contains(T,T2); + _ -> + contains(L,T2) + end; +contains([Ele|T],[{Ele,_}|T2])-> + contains(T,T2); +contains([Ele|T],[Ele|T2])-> + contains(T,T2); +contains(List,[_|T]) -> + contains(List,T); +contains([],_) -> + match. + +contains_parallel([Key | T], Elems) -> + contains([Key],Elems), + contains_parallel(T,Elems); +contains_parallel([],_Elems) -> + match. + +not_contains(List) -> + fun(Proplist) when is_list(Proplist) -> + [] = [Ele || {Ele,_} <- Proplist, + Test <- List, + Test =:= Ele] + end. diff --git a/lib/common_test/test/ct_tc_repeat_SUITE_data/tc_repeat_SUITE.erl b/lib/common_test/test/ct_tc_repeat_SUITE_data/tc_repeat_SUITE.erl new file mode 100644 index 0000000000..f5d960d12f --- /dev/null +++ b/lib/common_test/test/ct_tc_repeat_SUITE_data/tc_repeat_SUITE.erl @@ -0,0 +1,85 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(tc_repeat_SUITE). + +-suite_defaults([{timetrap, {minutes, 10}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +init_per_group(_Group,Config) -> + Config. + +end_per_group(_Group,Config) -> + ok. + +all() -> + [{testcase,tc1,[{repeat,2}]}, + {testcase,tc2,[{repeat_until_ok,3}]}, + {testcase,tc3,[{repeat_until_ok,3}]}, + {testcase,tc4,[{repeat_until_fail,3}]}, + {group,g}, + {group,g_until_ok}, + {group,g_until_fail}, + {group,g,[parallel]}, + {group,g,[sequence]}, + {group,g_mixed,[sequence]}]. + +groups() -> + [{g,[{testcase,tc1,[{repeat,2}]}]}, + {g_until_ok,[{testcase,tc2,[{repeat_until_ok,3}]}]}, + {g_until_fail,[{testcase,tc4,[{repeat_until_fail,3}]}]}, + {g_parallel_until_ok,[parallel],[{testcase,tc2,[{repeat_until_ok,3}]}]}, + {g_parallel_until_fail,[parallel],[{testcase,tc1,[{repeat_until_fail,2}]}]}, + {g_sequence_until_ok,[sequence],[{testcase,tc2,[{repeat_until_ok,3}]}]}, + {g_sequence_until_fail,[sequence],[{testcase,tc1,[{repeat_until_fail,2}]}]}, + {g_mixed,[{testcase,tc1,[{repeat,2}]}, + {testcase,tc4,[{repeat,3}]}, + tc1, + {group,g}, + {subgroup,[tc1,{testcase,tc2,[{repeat,2}]}]}, + {testcase,tc2,[{repeat,2}]}, + tc2, + {testcase,tc1,[{repeat,2}]}, + tc1]}]. + +%% Test cases starts here. +tc1(_Config) -> + ok. + +tc2(_Config) -> + ok. + +tc3(_Config) -> + ct:fail(always_fail). + +tc4(Config) -> + case ?config(saved_config,Config) of + {tc4,_} -> + ct:fail(second_time_fail); + undefined -> + {save_config,Config} + end. + +tc5(_Config) -> + {skip,"just skip this"}. diff --git a/lib/common_test/test/ct_util_SUITE.erl b/lib/common_test/test/ct_util_SUITE.erl new file mode 100644 index 0000000000..1d773855da --- /dev/null +++ b/lib/common_test/test/ct_util_SUITE.erl @@ -0,0 +1,490 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(ct_util_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +-define(eh, ct_test_support_eh). + +%%-------------------------------------------------------------------- +%% TEST SERVER CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% Description: Since Common Test starts another Test Server +%% instance, the tests need to be performed on a separate node (or +%% there will be clashes with logging processes etc). +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + DataDir = ?config(data_dir, Config), + CTHs = filelib:wildcard(filename:join(DataDir,"*_cth.erl")), + io:format("CTHs: ~p",[CTHs]), + [io:format("Compiling ~p: ~p", + [FileName,compile:file(FileName,[{outdir,DataDir},debug_info])]) || + FileName <- CTHs], + ct_test_support:init_per_suite([{path_dirs,[DataDir]} | Config]). + +end_per_suite(Config) -> + ct_test_support:end_per_suite(Config). + +init_per_testcase(TestCase, Config) -> + ct_test_support:init_per_testcase(TestCase, Config). + +end_per_testcase(TestCase, Config) -> + ct_test_support:end_per_testcase(TestCase, Config). + + +suite() -> + [{timetrap,{minutes,1}}]. + +all() -> + all(suite). + +all(suite) -> + [ + pre_init_per_suite, + post_init_per_suite, + pre_end_per_suite, + post_end_per_suite, + pre_init_per_group, + post_init_per_group, + pre_end_per_group, + post_end_per_group, + pre_init_per_testcase, + post_init_per_testcase, + pre_end_per_testcase, + post_end_per_testcase + ]. + + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +%%%----------------------------------------------------------------- +%%% +pre_init_per_suite(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{pre_init_per_suite, + {curr_tc_SUITE,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +post_init_per_suite(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_init_per_suite, + {curr_tc_SUITE,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +pre_end_per_suite(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{pre_end_per_suite, + {curr_tc_SUITE,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +post_end_per_suite(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_end_per_suite, + {curr_tc_SUITE,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + + +pre_init_per_group(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{pre_init_per_group, + {curr_tc_SUITE,g,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +post_init_per_group(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_init_per_group, + {curr_tc_SUITE,g,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +pre_end_per_group(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{pre_end_per_group, + {curr_tc_SUITE,g,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +post_end_per_group(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_end_per_group, + {curr_tc_SUITE,g,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +pre_init_per_testcase(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{pre_init_per_testcase, + {curr_tc_SUITE,tc1,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +post_init_per_testcase(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_init_per_testcase, + {curr_tc_SUITE,tc1,{timeout,5000}}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +pre_end_per_testcase(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{pre_end_per_testcase, + {curr_tc_SUITE,tc1,{timeout,5000}}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +post_end_per_testcase(Config) -> + CfgFile = gen_config(?FUNCTION_NAME, + [{post_end_per_testcase, + {curr_tc_SUITE,tc1,kill}}], + Config), + ok = do_test(?FUNCTION_NAME, + "curr_tc_SUITE.erl", + [{ct_hooks,[ct_util_cth]},{config,CfgFile}], + Config). + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- + +do_test(Tag, Suite, RunTestArgs, Config) -> + do_test(Tag, Suite, RunTestArgs, Config, 2). + +do_test(Tag, Suite0, RunTestArgs, Config, EC) -> + DataDir = ?config(data_dir, Config), + Suite = filename:join([DataDir,Suite0]), + {Opts,ERPid} = setup([{suite,Suite}]++[{label,Tag}|RunTestArgs],Config), + Res = ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + %% io:format("~p~n",[Events]), + + ct_test_support:log_events(Tag, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + + TestEvents = events_to_check(Tag, EC), + ok = ct_test_support:verify_events(TestEvents, Events, Config), + Res. + +setup(Test, Config) -> + Opts0 = ct_test_support:get_opts(Config), + Level = ?config(trace_level, Config), + EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + ERPid = ct_test_support:start_event_receiver(Config), + {Opts,ERPid}. + +reformat(Events, EH) -> + ct_test_support:reformat(Events, EH). + +gen_config(Name,KeyVals,Config) -> + PrivDir = ?config(priv_dir,Config), + File = filename:join(PrivDir,atom_to_list(Name)++".cfg"), + ok = file:write_file(File,[io_lib:format("~p.~n",[{Key,Value}]) + || {Key,Value} <- KeyVals]), + File. + +%%%----------------------------------------------------------------- +%%% TEST EVENTS +%%%----------------------------------------------------------------- +events_to_check(Test) -> + %% 2 tests (ct:run_test + script_start) is default + events_to_check(Test, 2). + +events_to_check(_, 0) -> + []; +events_to_check(Test, N) -> + test_events(Test) ++ events_to_check(Test, N-1). + +test_events(IPS) when IPS=:=pre_init_per_suite; IPS=:=post_init_per_suite -> + S = curr_tc_SUITE, + FwFunc = + case IPS of + pre_init_per_suite -> init_tc; + post_init_per_suite -> end_tc + end, + E = {failed,{ct_framework,FwFunc,{test_case_failed,hahahahahah}}}, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,4}}, + {?eh,tc_start,{S,init_per_suite}}, + {?eh,tc_done,{S,init_per_suite,E}}, + {?eh,tc_auto_skip,{S,tc1,{failed,{S,init_per_suite,E}}}}, + {?eh,tc_auto_skip,{S,tc2,{failed,{S,init_per_suite,E}}}}, + {?eh,tc_auto_skip,{S,{tc1,g},{failed,{S,init_per_suite,E}}}}, + {?eh,tc_auto_skip,{S,{tc2,g},{failed,{S,init_per_suite,E}}}}, + {?eh,test_stats,{0,0,{0,4}}}, + {?eh,tc_auto_skip,{S,end_per_suite,{failed,{S,init_per_suite,E}}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(EPS) when EPS=:=pre_end_per_suite; EPS=:=post_end_per_suite -> + S = curr_tc_SUITE, + FwFunc = + case EPS of + pre_end_per_suite -> init_tc; + post_end_per_suite -> end_tc + end, + E = {failed,{ct_framework,FwFunc,{test_case_failed,hahahahahah}}}, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,4}}, + {?eh,tc_start,{S,init_per_suite}}, + {?eh,tc_done,{S,init_per_suite,ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + [{?eh,tc_start,{S,{init_per_group,g,[]}}}, + {?eh,tc_done,{S,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{3,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{4,0,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g,[]}}}, + {?eh,tc_done,{S,{end_per_group,g,[]},ok}}], + {?eh,tc_start,{S,end_per_suite}}, + {?eh,tc_done,{S,end_per_suite,E}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(IPG) when IPG=:=pre_init_per_group; IPG=:=post_init_per_group -> + S = curr_tc_SUITE, + FwFunc = + case IPG of + pre_init_per_group -> init_tc; + post_init_per_group -> end_tc + end, + E = {failed,{ct_framework,FwFunc,{test_case_failed,hahahahahah}}}, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,4}}, + {?eh,tc_start,{S,init_per_suite}}, + {?eh,tc_done,{S,init_per_suite,ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + [{?eh,tc_start,{S,{init_per_group,g,[]}}}, + {?eh,tc_done,{S,{init_per_group,g,[]},E}}, + {?eh,tc_auto_skip,{S,{tc1,g},{failed,{S,init_per_group,E}}}}, + {?eh,tc_auto_skip,{S,{tc2,g},{failed,{S,init_per_group,E}}}}, + {?eh,test_stats,{2,0,{0,2}}}, + {?eh,tc_auto_skip,{S,{end_per_group,g},{failed,{S,init_per_group,E}}}}], + {?eh,tc_start,{S,end_per_suite}}, + {?eh,tc_done,{S,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(EPG) when EPG=:=pre_end_per_group; EPG=:=post_end_per_group -> + S = curr_tc_SUITE, + FwFunc = + case EPG of + pre_end_per_group -> init_tc; + post_end_per_group -> end_tc + end, + E = {failed,{ct_framework,FwFunc,{test_case_failed,hahahahahah}}}, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,4}}, + {?eh,tc_start,{S,init_per_suite}}, + {?eh,tc_done,{S,init_per_suite,ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + [{?eh,tc_start,{S,{init_per_group,g,[]}}}, + {?eh,tc_done,{S,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{3,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{4,0,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g,[]}}}, + {?eh,tc_done,{S,{end_per_group,g,[]},E}}], + {?eh,tc_start,{S,end_per_suite}}, + {?eh,tc_done,{S,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(IPTC) when IPTC=:=pre_init_per_testcase; + IPTC=:=post_init_per_testcase -> + S = curr_tc_SUITE, + E = case IPTC of + pre_init_per_testcase -> + {failed,{ct_framework,init_tc,{test_case_failed,hahahahahah}}}; + post_init_per_testcase -> + {failed,{ct_framework,end_tc,{timetrap,3000}}} + end, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,4}}, + {?eh,tc_start,{S,init_per_suite}}, + {?eh,tc_done,{S,init_per_suite,ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,{auto_skipped,E}}}, + {?eh,test_stats,{0,0,{0,1}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{1,0,{0,1}}}, + [{?eh,tc_start,{S,{init_per_group,g,[]}}}, + {?eh,tc_done,{S,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,{auto_skipped,E}}}, + {?eh,test_stats,{1,0,{0,2}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{2,0,{0,2}}}, + {?eh,tc_start,{S,{end_per_group,g,[]}}}, + {?eh,tc_done,{S,{end_per_group,g,[]},ok}}], + {?eh,tc_start,{S,end_per_suite}}, + {?eh,tc_done,{S,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]; + +test_events(EPTC) when EPTC=:=pre_end_per_testcase; EPTC=:=post_end_per_testcase-> + S = curr_tc_SUITE, + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,4}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{2,0,{0,0}}}, + [{?eh,tc_start,{S,{init_per_group,g,[]}}}, + {?eh,tc_done,{S,{init_per_group,g,[]},ok}}, + {?eh,tc_start,{S,tc1}}, + {?eh,tc_done,{S,tc1,ok}}, + {?eh,test_stats,{3,0,{0,0}}}, + {?eh,tc_start,{S,tc2}}, + {?eh,tc_done,{S,tc2,ok}}, + {?eh,test_stats,{4,0,{0,0}}}, + {?eh,tc_start,{S,{end_per_group,g,[]}}}, + {?eh,tc_done,{S,{end_per_group,g,[]},ok}}], + {?eh,tc_start,{S,end_per_suite}}, + {?eh,tc_done,{S,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]. + +%% test events help functions +contains(List) -> + fun(Proplist) when is_list(Proplist) -> + contains(List,Proplist) + end. + +contains([{not_in_order,List}|T],Rest) -> + contains_parallel(List,Rest), + contains(T,Rest); +contains([{Ele,Pos}|T] = L,[H|T2]) -> + case element(Pos,H) of + Ele -> + contains(T,T2); + _ -> + contains(L,T2) + end; +contains([Ele|T],[{Ele,_}|T2])-> + contains(T,T2); +contains([Ele|T],[Ele|T2])-> + contains(T,T2); +contains(List,[_|T]) -> + contains(List,T); +contains([],_) -> + match. + +contains_parallel([Key | T], Elems) -> + contains([Key],Elems), + contains_parallel(T,Elems); +contains_parallel([],_Elems) -> + match. + +not_contains(List) -> + fun(Proplist) when is_list(Proplist) -> + [] = [Ele || {Ele,_} <- Proplist, + Test <- List, + Test =:= Ele] + end. diff --git a/lib/common_test/test/ct_util_SUITE_data/ct_util_cth.erl b/lib/common_test/test/ct_util_SUITE_data/ct_util_cth.erl new file mode 100644 index 0000000000..34c1568a87 --- /dev/null +++ b/lib/common_test/test/ct_util_SUITE_data/ct_util_cth.erl @@ -0,0 +1,105 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + + +-module(ct_util_cth). + + +-include_lib("common_test/src/ct_util.hrl"). +-include_lib("common_test/include/ct_event.hrl"). + +%% Send a cth_error event if a callback is called with unexpected arguments + +%% CT Hooks +-compile(export_all). + +id(Opts) -> + erlang:system_time(second). + +init(Id, Opts) -> + {ok,ok}. + +pre_init_per_suite(Suite,Config,State) -> + maybe_sleep(?FUNCTION_NAME,Suite), + {Config, State}. + +post_init_per_suite(Suite,Config,Return,State) -> + maybe_sleep(?FUNCTION_NAME,Suite), + {Return, State}. + +pre_end_per_suite(Suite,Config,State) -> + maybe_sleep(?FUNCTION_NAME,Suite), + {Config, State}. + +post_end_per_suite(Suite,Config,Return,State) -> + maybe_sleep(?FUNCTION_NAME,Suite), + {Return, State}. + +pre_init_per_group(Suite, Group, Config, State) -> + maybe_sleep(?FUNCTION_NAME,Suite,Group), + {Config,State}. + +post_init_per_group(Suite, Group, Config,Return,State) -> + maybe_sleep(?FUNCTION_NAME,Suite,Group), + {Return,State}. + +pre_end_per_group(Suite, Group, Config, State) -> + maybe_sleep(?FUNCTION_NAME,Suite,Group), + {Config,State}. + +post_end_per_group(Suite, Group, Config,Return,State) -> + maybe_sleep(?FUNCTION_NAME,Suite,Group), + {Return,State}. + +pre_init_per_testcase(Suite, TC, Config, State) -> + maybe_sleep(?FUNCTION_NAME,Suite,TC), + {Config,State}. + +post_init_per_testcase(Suite, TC, Config,Return,State) -> + maybe_sleep(?FUNCTION_NAME,Suite,TC), + {Return,State}. + +pre_end_per_testcase(Suite, TC, Config, State) -> + maybe_sleep(?FUNCTION_NAME,Suite,TC), + {Config,State}. + +post_end_per_testcase(Suite, TC, Config,Return,State) -> + maybe_sleep(?FUNCTION_NAME,Suite,TC), + {Return,State}. + +%%%----------------------------------------------------------------- +maybe_sleep(FuncName,Suite) -> + maybe_sleep(FuncName,Suite,undefined). +maybe_sleep(FuncName,Suite,GroupOrTC) -> + case ct:get_config(FuncName) of + {Suite,GroupOrTC,Fail} -> + fail(Fail); + {Suite,Fail} when GroupOrTC=:=undefined -> + fail(Fail); + _ -> + ok + end. + +fail({timeout,T}) -> + timer:sleep(T); +fail(kill) -> + spawn_link(fun() -> ct:fail(hahahahahah) end), + timer:sleep(10000). + diff --git a/lib/common_test/test/ct_util_SUITE_data/curr_tc_SUITE.erl b/lib/common_test/test/ct_util_SUITE_data/curr_tc_SUITE.erl new file mode 100644 index 0000000000..b48ba4d24e --- /dev/null +++ b/lib/common_test/test/ct_util_SUITE_data/curr_tc_SUITE.erl @@ -0,0 +1,59 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(curr_tc_SUITE). + +-suite_defaults([{timetrap, {seconds, 3}}]). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include("ct.hrl"). + +init_per_suite(Config) -> + [{?MODULE,?FUNCTION_NAME}] = ct_util:get_testdata(curr_tc), + Config. + +end_per_suite(Config) -> + [{?MODULE,?FUNCTION_NAME}] = ct_util:get_testdata(curr_tc), + ok. + +init_per_group(_Group,Config) -> + [{?MODULE,?FUNCTION_NAME}] = ct_util:get_testdata(curr_tc), + Config. + +end_per_group(_Group,Config) -> + [{?MODULE,?FUNCTION_NAME}] = ct_util:get_testdata(curr_tc), + ok. + +all() -> + [tc1,tc2,{group,g}]. + +groups() -> + [{g,[tc1,tc2]}]. + +%% Test cases starts here. +tc1(_Config) -> + [{?MODULE,?FUNCTION_NAME}] = ct_util:get_testdata(curr_tc), + ok. + +tc2(_Config) -> + [{?MODULE,?FUNCTION_NAME}] = ct_util:get_testdata(curr_tc), + ok. diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index 23eb8d9656..14a3622a00 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.17 +COMMON_TEST_VSN = 1.17.1 diff --git a/lib/compiler/doc/src/Makefile b/lib/compiler/doc/src/Makefile index 32f150eef8..2fb163b9e7 100644 --- a/lib/compiler/doc/src/Makefile +++ b/lib/compiler/doc/src/Makefile @@ -31,6 +31,7 @@ APPLICATION=compiler # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) +COMPILER_DIR = $(ERL_TOP)/lib/compiler/src # ---------------------------------------------------- # Target Specs @@ -38,7 +39,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = compile.xml -XML_PART_FILES = +XML_PART_FILES = internal.xml XML_CHAPTER_FILES = notes.xml BOOK_FILES = book.xml @@ -49,6 +50,9 @@ XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) +XML_INTERNAL_FILES = \ + cerl.xml cerl_trees.xml cerl_clauses.xml + # ---------------------------------------------------- HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -62,6 +66,8 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +XML_GEN_FILES = $(XML_INTERNAL_FILES:%=$(XMLDIR)/%) + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -85,6 +91,9 @@ man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) +$(XML_INTERNAL_FILES:%=$(XMLDIR)/%): $(COMPILER_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) + $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(COMPILER_VSN) -dir $(XMLDIR) $(COMPILER_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) + debug opt: clean clean_docs: diff --git a/lib/compiler/doc/src/book.xml b/lib/compiler/doc/src/book.xml index af6b4cf47a..d101d40cb4 100644 --- a/lib/compiler/doc/src/book.xml +++ b/lib/compiler/doc/src/book.xml @@ -38,6 +38,9 @@ <applications> <xi:include href="ref_man.xml"/> </applications> + <internals> + <xi:include href="internal.xml"/> + </internals> <releasenotes> <xi:include href="notes.xml"/> </releasenotes> diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 5219ba0f5d..549b1049d8 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -632,6 +632,22 @@ module.beam: module.erl \ to be deprecated.</p> </item> + <tag><c>nowarn_removed</c></tag> + <item> + <p>Turns off warnings for calls to functions that have + been removed. Default is to emit warnings for every call + to a function known by the compiler to have been recently + removed from Erlang/OTP.</p> + </item> + + <tag><c>{nowarn_removed, ModulesOrMFAs}</c></tag> + <item> + <p>Turns off warnings for calls to modules or functions + that have been removed. Default is to emit warnings for + every call to a function known by the compiler to have + been recently removed from Erlang/OTP.</p> + </item> + <tag><c>nowarn_obsolete_guard</c></tag> <item> <p>Turns off warnings for calls to old type testing BIFs, diff --git a/lib/compiler/doc/src/internal.xml b/lib/compiler/doc/src/internal.xml new file mode 100644 index 0000000000..f24b363c1c --- /dev/null +++ b/lib/compiler/doc/src/internal.xml @@ -0,0 +1,38 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<internal xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>2018</year><year>2018</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>Compiler Internal Documentation</title> + <prepared>Lukas Larsson</prepared> + <docno></docno> + <date>2018-07-07</date> + <rev>1.0.0</rev> + <file>internal.xml</file> + </header> + <description> + </description> + <xi:include href="cerl.xml"/> + <xi:include href="cerl_trees.xml"/> + <xi:include href="cerl_clauses.xml"/> +</internal> + diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 9f8d63baa1..87b0d345f2 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -194,13 +194,16 @@ $(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl $(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl beam_ssa.hrl $(EBIN)/beam_kernel_to_ssa.beam: v3_kernel.hrl beam_ssa.hrl $(EBIN)/beam_ssa.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_bsm.beam: beam_ssa.hrl $(EBIN)/beam_ssa_codegen.beam: beam_ssa.hrl $(EBIN)/beam_ssa_dead.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_funs.beam: beam_ssa.hrl $(EBIN)/beam_ssa_lint.beam: beam_ssa.hrl $(EBIN)/beam_ssa_opt.beam: beam_ssa.hrl $(EBIN)/beam_ssa_pp.beam: beam_ssa.hrl $(EBIN)/beam_ssa_pre_codegen.beam: beam_ssa.hrl $(EBIN)/beam_ssa_recv.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_share.beam: beam_ssa.hrl $(EBIN)/beam_ssa_type.beam: beam_ssa.hrl $(EBIN)/cerl.beam: core_parse.hrl $(EBIN)/compile.beam: core_parse.hrl ../../stdlib/include/erl_compile.hrl diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index bc1290f6fd..df09dcb06c 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -407,14 +407,14 @@ encode_arg({atom, Atom}, Dict0) when is_atom(Atom) -> {Index, Dict} = beam_dict:atom(Atom, Dict0), {encode(?tag_a, Index), Dict}; encode_arg({integer, N}, Dict) -> - %% Conservatily assume that all integers whose absolute + %% Conservatively assume that all integers whose absolute %% value is greater than 1 bsl 128 will be bignums in %% the runtime system. if N >= 1 bsl 128 -> - encode_arg({literal, N}, Dict); + encode_literal(N, Dict); N =< -(1 bsl 128) -> - encode_arg({literal, N}, Dict); + encode_literal(N, Dict); true -> {encode(?tag_i, N), Dict} end; @@ -434,7 +434,7 @@ encode_arg({list, List}, Dict0) -> {L, Dict} = encode_list(List, Dict0, []), {[encode(?tag_z, 1), encode(?tag_u, length(List))|L], Dict}; encode_arg({float, Float}, Dict) when is_float(Float) -> - encode_arg({literal,Float}, Dict); + encode_literal(Float, Dict); encode_arg({fr,Fr}, Dict) -> {[encode(?tag_z, 2),encode(?tag_u, Fr)], Dict}; encode_arg({field_flags,Flags0}, Dict) -> @@ -442,12 +442,24 @@ encode_arg({field_flags,Flags0}, Dict) -> {encode(?tag_u, Flags), Dict}; encode_arg({alloc,List}, Dict) -> encode_alloc_list(List, Dict); -encode_arg({literal,Lit}, Dict0) -> - {Index,Dict} = beam_dict:literal(Lit, Dict0), - {[encode(?tag_z, 4),encode(?tag_u, Index)],Dict}; +encode_arg({literal,Lit}, Dict) -> + if + Lit =:= [] -> + encode_arg(nil, Dict); + is_atom(Lit) -> + encode_arg({atom,Lit}, Dict); + is_integer(Lit) -> + encode_arg({integer,Lit}, Dict); + true -> + encode_literal(Lit, Dict) + end; encode_arg(Int, Dict) when is_integer(Int) -> {encode(?tag_u, Int),Dict}. +encode_literal(Literal, Dict0) -> + {Index,Dict} = beam_dict:literal(Literal, Dict0), + {[encode(?tag_z, 4),encode(?tag_u, Index)],Dict}. + %%flag_to_bit(aligned) -> 16#01; %% No longer useful. flag_to_bit(little) -> 16#02; flag_to_bit(big) -> 16#00; diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl index bad43a9c4e..bf99e8fc26 100644 --- a/lib/compiler/src/beam_ssa_pre_codegen.erl +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -342,21 +342,22 @@ make_save_point_dict_1([], Ctx, I, Acc) -> [{Ctx,I}|Acc]. bs_restores([{L,#b_blk{is=Is,last=Last}}|Bs], CtxChain, D0, Rs0) -> - FPos = case D0 of - #{L:=Pos0} -> Pos0; - #{} -> #{} - end, - {SPos,Rs} = bs_restores_is(Is, CtxChain, FPos, Rs0), - D = bs_update_successors(Last, SPos, FPos, D0), + InPos = maps:get(L, D0, #{}), + {SuccPos, FailPos, Rs} = bs_restores_is(Is, CtxChain, InPos, InPos, Rs0), + + D = bs_update_successors(Last, SuccPos, FailPos, D0), bs_restores(Bs, CtxChain, D, Rs); bs_restores([], _, _, Rs) -> Rs. bs_update_successors(#b_br{succ=Succ,fail=Fail}, SPos, FPos, D) -> join_positions([{Succ,SPos},{Fail,FPos}], D); -bs_update_successors(#b_switch{fail=Fail,list=List}, SPos, _FPos, D) -> +bs_update_successors(#b_switch{fail=Fail,list=List}, SPos, FPos, D) -> + SPos = FPos, %Assertion. Update = [{L,SPos} || {_,L} <- List] ++ [{Fail,SPos}], join_positions(Update, D); -bs_update_successors(#b_ret{}, _, _, D) -> D. +bs_update_successors(#b_ret{}, SPos, FPos, D) -> + SPos = FPos, %Assertion. + D. join_positions([{L,MapPos0}|T], D) -> case D of @@ -382,75 +383,91 @@ join_positions_1(MapPos0, MapPos1) -> end, MapPos1), maps:merge(MapPos0, MapPos2). +%% +%% Updates the restore and position maps according to the given instructions. +%% +%% Note that positions may be updated even when a match fails; if a match +%% requires a restore, the position at the fail block will be the position +%% we've *restored to* and not the one we entered the current block with. +%% + bs_restores_is([#b_set{op=bs_start_match,dst=Start}|Is], - CtxChain, PosMap0, Rs) -> - PosMap = PosMap0#{Start=>Start}, - bs_restores_is(Is, CtxChain, PosMap, Rs); + CtxChain, SPos0, FPos, Rs) -> + %% We only allow one match per block. + SPos0 = FPos, %Assertion. + SPos = SPos0#{Start=>Start}, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); bs_restores_is([#b_set{op=bs_match,dst=NewPos,args=Args}=I|Is], - CtxChain, PosMap0, Rs0) -> + CtxChain, SPos0, FPos0, Rs0) -> + SPos0 = FPos0, %Assertion. Start = bs_subst_ctx(NewPos, CtxChain), [_,FromPos|_] = Args, - case PosMap0 of + case SPos0 of #{Start:=FromPos} -> %% Same position, no restore needed. - PosMap = case bs_match_type(I) of + SPos = case bs_match_type(I) of plain -> %% Update position to new position. - PosMap0#{Start:=NewPos}; + SPos0#{Start:=NewPos}; _ -> %% Position will not change (test_unit %% instruction or no instruction at %% all). - PosMap0#{Start:=FromPos} + SPos0#{Start:=FromPos} end, - bs_restores_is(Is, CtxChain, PosMap, Rs0); + bs_restores_is(Is, CtxChain, SPos, FPos0, Rs0); #{Start:=_} -> %% Different positions, might need a restore instruction. case bs_match_type(I) of none -> - %% The tail test will be optimized away. - %% No need to do a restore. - PosMap = PosMap0#{Start:=FromPos}, - bs_restores_is(Is, CtxChain, PosMap, Rs0); + %% This is a tail test that will be optimized away. + %% There's no need to do a restore, and all + %% positions are unchanged. + bs_restores_is(Is, CtxChain, SPos0, FPos0, Rs0); test_unit -> %% This match instruction will be replaced by %% a test_unit instruction. We will need a %% restore. The new position will be the position %% restored to (NOT NewPos). - PosMap = PosMap0#{Start:=FromPos}, + SPos = SPos0#{Start:=FromPos}, + FPos = FPos0#{Start:=FromPos}, Rs = Rs0#{NewPos=>{Start,FromPos}}, - bs_restores_is(Is, CtxChain, PosMap, Rs); + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); plain -> %% Match or skip. Position will be changed. - PosMap = PosMap0#{Start:=NewPos}, + SPos = SPos0#{Start:=NewPos}, + FPos = FPos0#{Start:=FromPos}, Rs = Rs0#{NewPos=>{Start,FromPos}}, - bs_restores_is(Is, CtxChain, PosMap, Rs) + bs_restores_is(Is, CtxChain, SPos, FPos, Rs) end end; bs_restores_is([#b_set{op=bs_extract,args=[FromPos|_]}|Is], - CtxChain, PosMap, Rs) -> + CtxChain, SPos, FPos, Rs) -> Start = bs_subst_ctx(FromPos, CtxChain), - #{Start:=FromPos} = PosMap, %Assertion. - bs_restores_is(Is, CtxChain, PosMap, Rs); + #{Start:=FromPos} = SPos, %Assertion. + #{Start:=FromPos} = FPos, %Assertion. + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); bs_restores_is([#b_set{op=call,dst=Dst,args=Args}|Is], - CtxChain, PosMap0, Rs0) -> - {Rs,PosMap1} = bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0), - PosMap = bs_invalidate_pos(Args, PosMap1, CtxChain), - bs_restores_is(Is, CtxChain, PosMap, Rs); -bs_restores_is([#b_set{op=landingpad}|Is], CtxChain, PosMap0, Rs) -> + CtxChain, SPos0, FPos0, Rs0) -> + {Rs, SPos1, FPos1} = bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0), + {SPos, FPos} = bs_invalidate_pos(Args, SPos1, FPos1, CtxChain), + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); +bs_restores_is([#b_set{op=landingpad}|Is], CtxChain, SPos0, FPos0, Rs) -> %% We can land here from any point, so all positions are invalid. - PosMap = maps:map(fun(_Start,_Pos) -> unknown end, PosMap0), - bs_restores_is(Is, CtxChain, PosMap, Rs); + Invalidate = fun(_Start,_Pos) -> unknown end, + SPos = maps:map(Invalidate, SPos0), + FPos = maps:map(Invalidate, FPos0), + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); bs_restores_is([#b_set{op=Op,dst=Dst,args=Args}|Is], - CtxChain, PosMap0, Rs0) + CtxChain, SPos0, FPos0, Rs0) when Op =:= bs_test_tail; Op =:= bs_get_tail -> - {Rs,PosMap} = bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0), - bs_restores_is(Is, CtxChain, PosMap, Rs); -bs_restores_is([_|Is], CtxChain, PosMap, Rs) -> - bs_restores_is(Is, CtxChain, PosMap, Rs); -bs_restores_is([], _CtxChain, PosMap, Rs) -> - {PosMap,Rs}. + {Rs, SPos, FPos} = bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0), + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); +bs_restores_is([_|Is], CtxChain, SPos, FPos, Rs) -> + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); +bs_restores_is([], _CtxChain, SPos, FPos, Rs) -> + {SPos, FPos, Rs}. bs_match_type(#b_set{args=[#b_literal{val=skip},_Ctx, #b_literal{val=binary},_Flags, @@ -464,40 +481,42 @@ bs_match_type(_) -> %% Call instructions leave the match position in an undefined state, %% requiring us to invalidate each affected argument. -bs_invalidate_pos([#b_var{}=Arg|Args], PosMap0, CtxChain) -> +bs_invalidate_pos([#b_var{}=Arg|Args], SPos0, FPos0, CtxChain) -> Start = bs_subst_ctx(Arg, CtxChain), - case PosMap0 of + case SPos0 of #{Start:=_} -> - PosMap = PosMap0#{Start:=unknown}, - bs_invalidate_pos(Args, PosMap, CtxChain); + SPos = SPos0#{Start:=unknown}, + FPos = FPos0#{Start:=unknown}, + bs_invalidate_pos(Args, SPos, FPos, CtxChain); #{} -> %% Not a match context. - bs_invalidate_pos(Args, PosMap0, CtxChain) + bs_invalidate_pos(Args, SPos0, FPos0, CtxChain) end; -bs_invalidate_pos([_|Args], PosMap, CtxChain) -> - bs_invalidate_pos(Args, PosMap, CtxChain); -bs_invalidate_pos([], PosMap, _CtxChain) -> - PosMap. +bs_invalidate_pos([_|Args], SPos, FPos, CtxChain) -> + bs_invalidate_pos(Args, SPos, FPos, CtxChain); +bs_invalidate_pos([], SPos, FPos, _CtxChain) -> + {SPos, FPos}. -bs_restore_args([#b_var{}=Arg|Args], PosMap0, CtxChain, Dst, Rs0) -> +bs_restore_args([#b_var{}=Arg|Args], SPos0, FPos0, CtxChain, Dst, Rs0) -> Start = bs_subst_ctx(Arg, CtxChain), - case PosMap0 of + case SPos0 of #{Start:=Arg} -> %% Same position, no restore needed. - bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0); + bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0); #{Start:=_} -> %% Different positions, need a restore instruction. - PosMap = PosMap0#{Start:=Arg}, + SPos = SPos0#{Start:=Arg}, + FPos = FPos0#{Start:=Arg}, Rs = Rs0#{Dst=>{Start,Arg}}, - bs_restore_args(Args, PosMap, CtxChain, Dst, Rs); + bs_restore_args(Args, SPos, FPos, CtxChain, Dst, Rs); #{} -> %% Not a match context. - bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0) + bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0) end; -bs_restore_args([_|Args], PosMap, CtxChain, Dst, Rs) -> - bs_restore_args(Args, PosMap, CtxChain, Dst, Rs); -bs_restore_args([], PosMap, _CtxChain, _Dst, Rs) -> - {Rs,PosMap}. +bs_restore_args([_|Args], SPos, FPos, CtxChain, Dst, Rs) -> + bs_restore_args(Args, SPos, FPos, CtxChain, Dst, Rs); +bs_restore_args([], SPos, FPos, _CtxChain, _Dst, Rs) -> + {Rs,SPos,FPos}. %% Insert all bs_save and bs_restore instructions. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index efd2be94cb..09a5a6c104 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1604,8 +1604,13 @@ infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}) -> end; infer_types_1(#value{op={bif,element},args=[{integer,Index}=Key,Tuple]}) -> fun(Val, S) -> - Type = get_term_type(Val, S), - update_type(fun meet/2,{tuple,[Index],#{ Key => Type }}, Tuple, S) + case is_value_alive(Tuple, S) of + true -> + Type = {tuple,[Index], #{ Key => get_term_type(Val, S) }}, + update_type(fun meet/2, Type, Tuple, S); + false -> + S + end end; infer_types_1(#value{op={bif,is_atom},args=[Src]}) -> infer_type_test_bif({atom,[]}, Src); @@ -1629,7 +1634,10 @@ infer_types_1(#value{op={bif,is_tuple},args=[Src]}) -> infer_type_test_bif({tuple,[0],#{}}, Src); infer_types_1(#value{op={bif,tuple_size}, args=[Tuple]}) -> fun({integer,Arity}, S) -> - update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); + case is_value_alive(Tuple, S) of + true -> update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); + false -> S + end; (_, S) -> S end; infer_types_1(_) -> @@ -1637,7 +1645,10 @@ infer_types_1(_) -> infer_type_test_bif(Type, Src) -> fun({atom,true}, S) -> - update_type(fun meet/2, Type, Src, S); + case is_value_alive(Src, S) of + true -> update_type(fun meet/2, Type, Src, S); + false -> S + end; (_, S) -> S end. @@ -2274,6 +2285,9 @@ get_raw_type(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> get_raw_type(Src, #vst{}) -> get_literal_type(Src). +is_value_alive(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> + is_map_key(Ref, Vs). + get_literal_type(nil=T) -> T; get_literal_type({atom,A}=T) when is_atom(A) -> T; get_literal_type({float,F}=T) when is_float(F) -> T; diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index fce23bfd68..62cd5b5120 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -2157,12 +2157,16 @@ values_arity(Node) -> %% @spec c_binary(Segments::[cerl()]) -> cerl() %% -%% @doc Creates an abstract binary-template. A binary object is a -%% sequence of 8-bit bytes. It is specified by zero or more bit-string -%% template <em>segments</em> of arbitrary lengths (in number of bits), -%% such that the sum of the lengths is evenly divisible by 8. If -%% <code>Segments</code> is <code>[S1, ..., Sn]</code>, the result -%% represents "<code>#{<em>S1</em>, ..., <em>Sn</em>}#</code>". All the + +%% @doc Creates an abstract binary-template. A binary object is in +%% this context a sequence of an arbitrary number of bits. (The number +%% of bits used to be evenly divisible by 8, but after the +%% introduction of bit strings in the Erlang language, the choice was +%% made to use the binary template for all bit strings.) It is +%% specified by zero or more bit-string template <em>segments</em> of +%% arbitrary lengths (in number of bits). If <code>Segments</code> is +%% <code>[S1, ..., Sn]</code>, the result represents +%% "<code>#{<em>S1</em>, ..., <em>Sn</em>}#</code>". All the %% <code>Si</code> must have type <code>bitstr</code>. %% %% @see ann_c_binary/2 diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl index fa5104c01b..3fd7ddd181 100644 --- a/lib/compiler/src/cerl_clauses.erl +++ b/lib/compiler/src/cerl_clauses.erl @@ -14,8 +14,8 @@ %% @author Richard Carlsson <[email protected]> %% @doc Utility functions for Core Erlang case/receive clauses. %% -%% <p>Syntax trees are defined in the module <a -%% href=""><code>cerl</code></a>.</p> +%% <p>Syntax trees are defined in the module +%% <a href="cerl"><code>cerl</code></a>.</p> %% %% @type cerl() = cerl:cerl() diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl index 83a6f0179c..90c796d3d9 100644 --- a/lib/compiler/src/core_parse.hrl +++ b/lib/compiler/src/core_parse.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -29,81 +29,82 @@ %% The record definitions appear alphabetically --record(c_alias, {anno=[], var, % var :: Tree, - pat}). % pat :: Tree +-record(c_alias, {anno=[] :: list(), var :: cerl:cerl(), + pat :: cerl:cerl()}). --record(c_apply, {anno=[], op, % op :: Tree, - args}). % args :: [Tree] +-record(c_apply, {anno=[] :: list(), op :: cerl:cerl(), + args :: [cerl:cerl()]}). --record(c_binary, {anno=[], segments :: [cerl:c_bitstr()]}). +-record(c_binary, {anno=[] :: list(), segments :: [cerl:c_bitstr()]}). --record(c_bitstr, {anno=[], val, % val :: Tree, - size, % size :: Tree, - unit, % unit :: Tree, - type, % type :: Tree, - flags}). % flags :: Tree +-record(c_bitstr, {anno=[] :: list(), val :: cerl:cerl(), + size :: cerl:cerl(), + unit :: cerl:cerl(), + type :: cerl:cerl(), + flags :: cerl:cerl()}). --record(c_call, {anno=[], module, % module :: Tree, - name, % name :: Tree, - args}). % args :: [Tree] +-record(c_call, {anno=[] :: list(), module :: cerl:cerl(), + name :: cerl:cerl(), + args :: [cerl:cerl()]}). --record(c_case, {anno=[], arg, % arg :: Tree, - clauses}). % clauses :: [Tree] +-record(c_case, {anno=[] :: list(), arg :: cerl:cerl(), + clauses :: [cerl:cerl()]}). --record(c_catch, {anno=[], body}). % body :: Tree +-record(c_catch, {anno=[] :: list(), body :: cerl:cerl()}). --record(c_clause, {anno=[], pats, % pats :: [Tree], - guard, % guard :: Tree, - body}). % body :: Tree +-record(c_clause, {anno=[] :: list(), pats :: [cerl:cerl()], + guard :: cerl:cerl(), + body :: cerl:cerl() | any()}). % TODO --record(c_cons, {anno=[], hd, % hd :: Tree, - tl}). % tl :: Tree +-record(c_cons, {anno=[] :: list(), hd :: cerl:cerl(), + tl :: cerl:cerl()}). --record(c_fun, {anno=[], vars, % vars :: [Tree], - body}). % body :: Tree +-record(c_fun, {anno=[] :: list(), vars :: [cerl:cerl()], + body :: cerl:cerl()}). --record(c_let, {anno=[], vars, % vars :: [Tree], - arg, % arg :: Tree, - body}). % body :: Tree +-record(c_let, {anno=[] :: list(), vars :: [cerl:cerl()], + arg :: cerl:cerl(), + body :: cerl:cerl()}). --record(c_letrec, {anno=[], defs, % defs :: [#c_def{}], - body}). % body :: Tree +-record(c_letrec, {anno=[] :: list(), + defs :: [{cerl:cerl(), cerl:cerl()}], + body :: cerl:cerl()}). --record(c_literal, {anno=[], val}). % val :: literal() +-record(c_literal, {anno=[] :: list(), val :: any()}). --record(c_map, {anno=[], +-record(c_map, {anno=[] :: list(), arg=#c_literal{val=#{}} :: cerl:c_var() | cerl:c_literal(), es :: [cerl:c_map_pair()], is_pat=false :: boolean()}). --record(c_map_pair, {anno=[], +-record(c_map_pair, {anno=[] :: list(), op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}, - key, - val}). + key :: any(), % TODO + val :: any()}). % TODO --record(c_module, {anno=[], name, % name :: Tree, - exports, % exports :: [Tree], - attrs, % attrs :: [#c_def{}], - defs}). % defs :: [#c_def{}] +-record(c_module, {anno=[] :: list(), name :: cerl:cerl(), + exports :: [cerl:cerl()], + attrs :: [{cerl:cerl(), cerl:cerl()}], + defs :: [{cerl:cerl(), cerl:cerl()}]}). --record(c_primop, {anno=[], name, % name :: Tree, - args}). % args :: [Tree] +-record(c_primop, {anno=[] :: list(), name :: cerl:cerl(), + args :: [cerl:cerl()]}). --record(c_receive, {anno=[], clauses, % clauses :: [Tree], - timeout, % timeout :: Tree, - action}). % action :: Tree +-record(c_receive, {anno=[] :: list(), clauses :: [cerl:cerl()], + timeout :: cerl:cerl(), + action :: cerl:cerl()}). --record(c_seq, {anno=[], arg, % arg :: Tree, - body}). % body :: Tree +-record(c_seq, {anno=[] :: list(), arg :: cerl:cerl() | any(), % TODO + body :: cerl:cerl()}). --record(c_try, {anno=[], arg, % arg :: Tree, - vars, % vars :: [Tree], - body, % body :: Tree - evars, % evars :: [Tree], - handler}). % handler :: Tree +-record(c_try, {anno=[] :: list(), arg :: cerl:cerl(), + vars :: [cerl:cerl()], + body :: cerl:cerl(), + evars :: [cerl:cerl()], + handler :: cerl:cerl()}). --record(c_tuple, {anno=[], es}). % es :: [Tree] +-record(c_tuple, {anno=[] :: list(), es :: [cerl:cerl()]}). --record(c_values, {anno=[], es}). % es :: [Tree] +-record(c_values, {anno=[] :: list(), es :: [cerl:cerl()]}). --record(c_var, {anno=[], name :: cerl:var_name()}). +-record(c_var, {anno=[] :: list(), name :: cerl:var_name()}). diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index de5a3c2873..6b1438abdd 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -35,7 +35,7 @@ map_field_lists/1,cover_bin_opt/1, val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1, receive_stacked/1,aliased_types/1,type_conflict/1, - infer_on_eq/1]). + infer_on_eq/1,infer_dead_value/1]). -include_lib("common_test/include/ct.hrl"). @@ -65,7 +65,7 @@ groups() -> map_field_lists,cover_bin_opt,val_dsetel, bad_tuples,bad_try_catch_nesting, receive_stacked,aliased_types,type_conflict, - infer_on_eq]}]. + infer_on_eq,infer_dead_value]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -679,6 +679,27 @@ infer_on_eq_4(T) -> true = erlang:tuple_size(T) =:= 1, {ok, erlang:element(1, T)}. +%% ERIERL-348; types were inferred for dead values, causing validation to fail. + +infer_dead_value(Config) when is_list(Config) -> + a = idv_1({a, b, c, d, e, f, g}, {0, 0, 0, 0, 0, 0, 0}), + b = idv_1({a, b, c, d, 0, 0, 0}, {a, b, c, d, 0, 0, 0}), + c = idv_1({0, 0, 0, 0, 0, f, g}, {0, 0, 0, 0, 0, f, g}), + error = idv_1(gurka, gaffel), + ok. + +idv_1({_A, _B, _C, _D, _E, _F, _G}, + {0, 0, 0, 0, 0, 0, 0}) -> + a; +idv_1({A, B, C, D,_E, _F, _G}=_Tuple1, + {A, B, C, D, 0, 0, 0}=_Tuple2) -> + b; +idv_1({_A, _B, _C, _D, _E, F, G}, + {0, 0, 0, 0, 0, F, G}) -> + c; +idv_1(_A, _B) -> + error. + %%%------------------------------------------------------------------------- transform_remove(Remove, Module) -> diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 41e4918b1e..d97f49c56e 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -1891,15 +1891,37 @@ expression_before_match_1(R) -> %% Make sure that context positions are updated on calls. restore_on_call(Config) when is_list(Config) -> - ok = restore_on_call_1(<<0, 1, 2>>). + ok = restore_on_call_plain(<<0, 1, 2>>), + <<"x">> = restore_on_call_match(<<0, "x">>), + ok. -restore_on_call_1(<<0, Rest/binary>>) -> - <<2>> = restore_on_call_2(Rest), - <<2>> = restore_on_call_2(Rest), %% {badmatch, <<>>} on missing restore. +restore_on_call_plain(<<0, Rest/binary>>) -> + <<2>> = restore_on_call_plain_1(Rest), + %% {badmatch, <<>>} on missing restore. + <<2>> = restore_on_call_plain_1(Rest), ok. -restore_on_call_2(<<1, Rest/binary>>) -> Rest; -restore_on_call_2(Other) -> Other. +restore_on_call_plain_1(<<1, Rest/binary>>) -> Rest; +restore_on_call_plain_1(Other) -> Other. + +%% Calls a function that moves the match context passed to it, and then matches +%% on its result to confuse the reposition algorithm's success/fail logic. +restore_on_call_match(<<0, Bin/binary>>) -> + case skip_until_zero(Bin) of + {skipped, Rest} -> + Rest; + not_found -> + %% The match context did not get repositioned before the + %% bs_get_tail instruction here. + Bin + end. + +skip_until_zero(<<0,Rest/binary>>) -> + {skipped, Rest}; +skip_until_zero(<<_C,Rest/binary>>) -> + skip_until_zero(Rest); +skip_until_zero(_) -> + not_found. %% 'catch' must invalidate positions. restore_after_catch(Config) when is_list(Config) -> @@ -1983,5 +2005,4 @@ do_matching_meets_apply(_Bin, {Handler, State}) -> %% Another case of the above. Handler:abs(State). - id(I) -> I. diff --git a/lib/crypto/c_src/aead.c b/lib/crypto/c_src/aead.c index 4ed16615a5..ab0e609130 100644 --- a/lib/crypto/c_src/aead.c +++ b/lib/crypto/c_src/aead.c @@ -22,36 +22,65 @@ #include "aes.h" #include "cipher.h" -ERL_NIF_TERM aead_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type,Key,Iv,AAD,In) */ + + +ERL_NIF_TERM aead_cipher(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* + (Type,Key,Iv,AAD,In,TagLen,true) + (Type,Key,Iv,AAD,In,Tag,false) + */ #if defined(HAVE_AEAD) const struct cipher_type_t *cipherp; EVP_CIPHER_CTX *ctx = NULL; const EVP_CIPHER *cipher = NULL; - ErlNifBinary key, iv, aad, in; + ErlNifBinary key, iv, aad, in, tag; unsigned int tag_len; - unsigned char *outp, *tagp; - ERL_NIF_TERM type, out, out_tag, ret; - int len, ctx_ctrl_set_ivlen, ctx_ctrl_get_tag, ctx_ctrl_set_tag; + unsigned char *outp, *tagp, *tag_data; + ERL_NIF_TERM type, out, out_tag, ret, encflg_arg; + int len, encflg; + + encflg_arg = argv[6]; + + /* Fetch the flag telling if we are going to encrypt (=true) or decrypt (=false) */ + if (encflg_arg == atom_true) + encflg = 1; + else if (encflg_arg == atom_false) + encflg = 0; + else if (encflg_arg == atom_undefined) + /* For compat funcs in crypto.erl */ + encflg = -1; + else + { + ret = EXCP_BADARG(env, "Bad enc flag"); + goto done; + } type = argv[0]; - ASSERT(argc == 6); - if (!enif_is_atom(env, type)) {ret = EXCP_BADARG(env, "non-atom cipher type"); goto done;} if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) {ret = EXCP_BADARG(env, "non-binary key"); goto done;} - if (!enif_inspect_binary(env, argv[2], &iv)) + if (!enif_inspect_iolist_as_binary(env, argv[2], &iv)) {ret = EXCP_BADARG(env, "non-binary iv"); goto done;} - if (!enif_inspect_iolist_as_binary(env, argv[3], &aad)) - {ret = EXCP_BADARG(env, "non-binary AAD"); goto done;} - if (!enif_inspect_iolist_as_binary(env, argv[4], &in)) + if (!enif_inspect_iolist_as_binary(env, argv[3], &in)) {ret = EXCP_BADARG(env, "non-binary text"); goto done;} - if (!enif_get_uint(env, argv[5], &tag_len)) - {ret = EXCP_BADARG(env, ""); goto done;} + if (!enif_inspect_iolist_as_binary(env, argv[4], &aad)) + {ret = EXCP_BADARG(env, "non-binary AAD"); goto done;} + + if (encflg) { + if (!enif_get_uint(env, argv[5], &tag_len)) + {ret = EXCP_BADARG(env, "Bad Tag length"); goto done;} + tag_data = NULL; + } else { + if (!enif_inspect_iolist_as_binary(env, argv[5], &tag)) + {ret = EXCP_BADARG(env, "non-binary Tag"); goto done;} + tag_len = tag.size; + tag_data = tag.data; + } if (tag_len > INT_MAX + || key.size > INT_MAX || iv.size > INT_MAX || in.size > INT_MAX || aad.size > INT_MAX) @@ -66,167 +95,88 @@ ERL_NIF_TERM aead_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) if ((cipher = cipherp->cipher.p) == NULL) {ret = EXCP_NOTSUP(env, "Cipher not supported in this libcrypto version"); goto done;} - ctx_ctrl_set_ivlen = cipherp->extra.aead.ctx_ctrl_set_ivlen; - ctx_ctrl_get_tag = cipherp->extra.aead.ctx_ctrl_get_tag; - ctx_ctrl_set_tag = cipherp->extra.aead.ctx_ctrl_set_tag; - +#if defined(HAVE_GCM_EVP_DECRYPT_BUG) + if ( !encflg && (cipherp->flags & GCM_MODE)) + return aes_gcm_decrypt_NO_EVP(env, argc, argv); +#endif + if ((ctx = EVP_CIPHER_CTX_new()) == NULL) - {ret = EXCP_ERROR(env, ""); goto done;} + {ret = EXCP_ERROR(env, "Can't allocate ctx"); goto done;} - if (EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_ivlen, (int)iv.size, NULL) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} + if (EVP_CipherInit_ex(ctx, cipher, NULL, NULL, NULL, encflg) != 1) + {ret = EXCP_ERROR(env, "CipherInit failed"); goto done;} + if (EVP_CIPHER_CTX_ctrl(ctx, cipherp->extra.aead.ctx_ctrl_set_ivlen, (int)iv.size, NULL) != 1) + {ret = EXCP_BADARG(env, "Bad IV length"); goto done;} #if defined(HAVE_CCM) - if (type == atom_aes_ccm) { - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_tag, (int)tag_len, NULL) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_EncryptUpdate(ctx, NULL, &len, NULL, (int)in.size) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} + if (cipherp->flags & CCM_MODE) { + if (EVP_CIPHER_CTX_ctrl(ctx, cipherp->extra.aead.ctx_ctrl_set_tag, (int)tag_len, tag_data) != 1) + {ret = EXCP_BADARG(env, "Can't set tag"); goto done;} + if (EVP_CipherInit_ex(ctx, NULL, NULL, key.data, iv.data, -1) != 1) + {ret = EXCP_BADARG(env, "Can't set key or iv"); goto done;} + if (EVP_CipherUpdate(ctx, NULL, &len, NULL, (int)in.size) != 1) + {ret = EXCP_BADARG(env, "Can't set text size"); goto done;} } else #endif { - if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} + if (EVP_CipherInit_ex(ctx, NULL, NULL, key.data, iv.data, -1) != 1) + {ret = EXCP_BADARG(env, "Can't set key or iv"); goto done;} } - if (EVP_EncryptUpdate(ctx, NULL, &len, aad.data, (int)aad.size) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} + if (EVP_CipherUpdate(ctx, NULL, &len, aad.data, (int)aad.size) != 1) + {ret = EXCP_BADARG(env, "Can't set AAD"); goto done;} if ((outp = enif_make_new_binary(env, in.size, &out)) == NULL) - {ret = EXCP_ERROR(env, ""); goto done;} - - if (EVP_EncryptUpdate(ctx, outp, &len, in.data, (int)in.size) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_EncryptFinal_ex(ctx, outp/*+len*/, &len) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - - if ((tagp = enif_make_new_binary(env, tag_len, &out_tag)) == NULL) - {ret = EXCP_ERROR(env, ""); goto done;} + {ret = EXCP_ERROR(env, "Can't make 'Out' binary"); goto done;} - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_get_tag, (int)tag_len, tagp) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - - CONSUME_REDS(env, in); - ret = enif_make_tuple2(env, out, out_tag); - - done: - if (ctx) - EVP_CIPHER_CTX_free(ctx); - return ret; - -#else - return EXCP_NOTSUP(env, ""); -#endif -} - -ERL_NIF_TERM aead_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Type,Key,Iv,AAD,In,Tag) */ -#if defined(HAVE_AEAD) - const struct cipher_type_t *cipherp; - EVP_CIPHER_CTX *ctx = NULL; - const EVP_CIPHER *cipher = NULL; - ErlNifBinary key, iv, aad, in, tag; - unsigned char *outp; - ERL_NIF_TERM type, out, ret; - int len, ctx_ctrl_set_ivlen, ctx_ctrl_set_tag; - - ASSERT(argc == 6); - - type = argv[0]; -#if defined(HAVE_GCM_EVP_DECRYPT_BUG) - if (type == atom_aes_gcm) - return aes_gcm_decrypt_NO_EVP(env, argc, argv); -#endif - - if (!enif_is_atom(env, type)) - {ret = EXCP_BADARG(env, "non-atom cipher type"); goto done;} - if (!enif_inspect_iolist_as_binary(env, argv[1], &key)) - {ret = EXCP_BADARG(env, "non-binary key"); goto done;} - if (!enif_inspect_binary(env, argv[2], &iv)) - {ret = EXCP_BADARG(env, "non-binary iv"); goto done;} - if (!enif_inspect_iolist_as_binary(env, argv[3], &aad)) - {ret = EXCP_BADARG(env, "non-binary AAD"); goto done;} - if (!enif_inspect_iolist_as_binary(env, argv[4], &in)) - {ret = EXCP_BADARG(env, ""); goto done;} - if (!enif_inspect_iolist_as_binary(env, argv[5], &tag)) - {ret = EXCP_BADARG(env, "non-binary text"); goto done;} - - if (tag.size > INT_MAX - || key.size > INT_MAX - || iv.size > INT_MAX - || in.size > INT_MAX - || aad.size > INT_MAX) - {ret = EXCP_BADARG(env, "binary too long"); goto done;} - - if ((cipherp = get_cipher_type(type, key.size)) == NULL) - {ret = EXCP_BADARG(env, "Unknown cipher"); goto done;} - if (cipherp->flags & NON_EVP_CIPHER) - {ret = EXCP_BADARG(env, "Bad cipher"); goto done;} - if ( !(cipherp->flags & AEAD_CIPHER) ) - {ret = EXCP_BADARG(env, "Not aead cipher"); goto done;} - if ((cipher = cipherp->cipher.p) == NULL) - {ret = EXCP_NOTSUP(env, "Cipher not supported in this libcrypto version"); goto done;} + if (EVP_CipherUpdate(ctx, outp, &len, in.data, (int)in.size) != 1) + { + if (encflg) + ret = EXCP_BADARG(env, "Can't set in-text"); + else + /* Decrypt error */ + ret = atom_error; + goto done; + } - ctx_ctrl_set_ivlen = cipherp->extra.aead.ctx_ctrl_set_ivlen; - ctx_ctrl_set_tag = cipherp->extra.aead.ctx_ctrl_set_tag; + if (encflg) + { + if (EVP_CipherFinal_ex(ctx, outp/*+len*/, &len) != 1) + {ret = EXCP_ERROR(env, "Encrypt error"); goto done;} - if ((outp = enif_make_new_binary(env, in.size, &out)) == NULL) - {ret = EXCP_ERROR(env, ""); goto done;} + if ((tagp = enif_make_new_binary(env, tag_len, &out_tag)) == NULL) + {ret = EXCP_ERROR(env, "Can't make 'Out' binary"); goto done;} - if ((ctx = EVP_CIPHER_CTX_new()) == NULL) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_DecryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_ivlen, (int)iv.size, NULL) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} + if (EVP_CIPHER_CTX_ctrl(ctx, cipherp->extra.aead.ctx_ctrl_get_tag, (int)tag_len, tagp) != 1) + {ret = EXCP_ERROR(env, "Can't get Tag"); goto done;} -#if defined(HAVE_CCM) - if (type == atom_aes_ccm) { - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_tag, (int)tag.size, tag.data) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_DecryptUpdate(ctx, NULL, &len, NULL, (int)in.size) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - } + ret = enif_make_tuple2(env, out, out_tag); + } else -#endif { - if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - } - - if (EVP_DecryptUpdate(ctx, NULL, &len, aad.data, (int)aad.size) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - if (EVP_DecryptUpdate(ctx, outp, &len, in.data, (int)in.size) != 1) - {ret = EXCP_ERROR(env, ""); goto done;} - #if defined(HAVE_GCM) - if (type == atom_aes_gcm) { - if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_tag, (int)tag.size, tag.data) != 1) - goto err; - if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) - goto err; - } + if (cipherp->flags & GCM_MODE) { + if (EVP_CIPHER_CTX_ctrl(ctx, cipherp->extra.aead.ctx_ctrl_set_tag, (int)tag_len, tag.data) != 1) + /* Decrypt error */ + {ret = atom_error; goto done;} + if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) + /* Decrypt error */ + {ret = atom_error; goto done;} + } #endif - CONSUME_REDS(env, in); - ret = out; - goto done; + ret = out; + } - err: - /* Decrypt failed, that is, wrong tag */ - ret = atom_error; + CONSUME_REDS(env, in); - done: +done: if (ctx) EVP_CIPHER_CTX_free(ctx); return ret; #else - return EXCP_NOTSUP(env, ""); + return EXCP_NOTSUP(env, "Unsupported Cipher"); #endif } + + diff --git a/lib/crypto/c_src/aead.h b/lib/crypto/c_src/aead.h index 54c0711535..2ec7a8a930 100644 --- a/lib/crypto/c_src/aead.h +++ b/lib/crypto/c_src/aead.h @@ -23,7 +23,6 @@ #include "common.h" -ERL_NIF_TERM aead_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM aead_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM aead_cipher(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #endif /* E_AEAD_H__ */ diff --git a/lib/crypto/c_src/algorithms.c b/lib/crypto/c_src/algorithms.c index 1d45ed9df2..75cddeb1e9 100644 --- a/lib/crypto/c_src/algorithms.c +++ b/lib/crypto/c_src/algorithms.c @@ -80,8 +80,12 @@ void init_algorithms_types(ErlNifEnv* env) algo_pubkey_cnt = 0; algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "rsa"); +#ifdef HAVE_DSA algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "dss"); +#endif +#ifdef HAVE_DH algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "dh"); +#endif #if defined(HAVE_EC) #if !defined(OPENSSL_NO_EC2M) algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "ec_gf2m"); @@ -251,29 +255,66 @@ void init_algorithms_types(ErlNifEnv* env) ASSERT(algo_rsa_opts_cnt <= sizeof(algo_rsa_opts)/sizeof(ERL_NIF_TERM)); } -ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) + +ERL_NIF_TERM hash_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + unsigned int cnt = +#ifdef FIPS_SUPPORT + FIPS_mode() ? algo_hash_fips_cnt : +#endif + algo_hash_cnt; + + return enif_make_list_from_array(env, algo_hash, cnt); +} + +ERL_NIF_TERM pubkey_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + unsigned int cnt = +#ifdef FIPS_SUPPORT + FIPS_mode() ? algo_pubkey_fips_cnt : +#endif + algo_pubkey_cnt; + + return enif_make_list_from_array(env, algo_pubkey, cnt); +} + + +ERL_NIF_TERM cipher_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return cipher_types_as_list(env); /* Exclude old api ciphers */ +} + +ERL_NIF_TERM mac_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + unsigned int cnt = +#ifdef FIPS_SUPPORT + FIPS_mode() ? algo_mac_fips_cnt : +#endif + algo_mac_cnt; + + return enif_make_list_from_array(env, algo_mac, cnt); +} + + +ERL_NIF_TERM curve_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { + unsigned int cnt = #ifdef FIPS_SUPPORT - int fips_mode = FIPS_mode(); + FIPS_mode() ? algo_curve_fips_cnt : +#endif + algo_curve_cnt; + + return enif_make_list_from_array(env, algo_curve, cnt); +} + + +ERL_NIF_TERM rsa_opts_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + unsigned int cnt = +#ifdef FIPS_SUPPORT + FIPS_mode() ? algo_rsa_opts_fips_cnt : +#endif + algo_rsa_opts_cnt; - unsigned int hash_cnt = fips_mode ? algo_hash_fips_cnt : algo_hash_cnt; - unsigned int pubkey_cnt = fips_mode ? algo_pubkey_fips_cnt : algo_pubkey_cnt; - unsigned int mac_cnt = fips_mode ? algo_mac_fips_cnt : algo_mac_cnt; - unsigned int curve_cnt = fips_mode ? algo_curve_fips_cnt : algo_curve_cnt; - unsigned int rsa_opts_cnt = fips_mode ? algo_rsa_opts_fips_cnt : algo_rsa_opts_cnt; -#else - unsigned int hash_cnt = algo_hash_cnt; - unsigned int pubkey_cnt = algo_pubkey_cnt; - unsigned int mac_cnt = algo_mac_cnt; - unsigned int curve_cnt = algo_curve_cnt; - unsigned int rsa_opts_cnt = algo_rsa_opts_cnt; -#endif - return enif_make_tuple6(env, - enif_make_list_from_array(env, algo_hash, hash_cnt), - enif_make_list_from_array(env, algo_pubkey, pubkey_cnt), - cipher_types_as_list(env), - enif_make_list_from_array(env, algo_mac, mac_cnt), - enif_make_list_from_array(env, algo_curve, curve_cnt), - enif_make_list_from_array(env, algo_rsa_opts, rsa_opts_cnt) - ); + return enif_make_list_from_array(env, algo_rsa_opts, cnt); } diff --git a/lib/crypto/c_src/algorithms.h b/lib/crypto/c_src/algorithms.h index 068fb661ec..4ad8b56db8 100644 --- a/lib/crypto/c_src/algorithms.h +++ b/lib/crypto/c_src/algorithms.h @@ -25,6 +25,11 @@ void init_algorithms_types(ErlNifEnv* env); -ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM hash_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM pubkey_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM cipher_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM mac_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM curve_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM rsa_opts_algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #endif /* E_ALGORITHMS_H__ */ diff --git a/lib/crypto/c_src/api_ng.c b/lib/crypto/c_src/api_ng.c index 5d063c3ae4..3408ba1b88 100644 --- a/lib/crypto/c_src/api_ng.c +++ b/lib/crypto/c_src/api_ng.c @@ -27,7 +27,7 @@ * */ ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM ng_crypto_one_shot(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM ng_crypto_one_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #ifdef HAVE_ECB_IVEC_BUG /* <= 0.9.8l returns faulty ivec length */ @@ -93,6 +93,13 @@ static int get_init_args(ErlNifEnv* env, goto err; } + if ((*cipherp)->flags & AEAD_CIPHER) + { + *return_term = EXCP_BADARG(env, "Missing arguments for this cipher"); + goto err; + } + + if (FORBIDDEN_IN_FIPS(*cipherp)) { *return_term = EXCP_NOTSUP(env, "Forbidden in FIPS"); @@ -413,13 +420,15 @@ int EVP_CIPHER_CTX_copy(EVP_CIPHER_CTX *out, const EVP_CIPHER_CTX *in) ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data [, IV]) */ struct evp_cipher_ctx *ctx_res; + struct evp_cipher_ctx ctx_res_copy; ERL_NIF_TERM ret; + ctx_res_copy.ctx = NULL; + if (!enif_get_resource(env, argv[0], (ErlNifResourceType*)evp_cipher_ctx_rtype, (void**)&ctx_res)) return EXCP_BADARG(env, "Bad 1:st arg"); if (argc == 3) { - struct evp_cipher_ctx ctx_res_copy; ErlNifBinary ivec_bin; memcpy(&ctx_res_copy, ctx_res, sizeof ctx_res_copy); @@ -474,6 +483,9 @@ ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ get_update_args(env, ctx_res, argv[1], &ret); err: + if (ctx_res_copy.ctx) + EVP_CIPHER_CTX_free(ctx_res_copy.ctx); + return ret; /* Both success and error */ } @@ -504,12 +516,17 @@ ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a /* One shot */ /*************************************************************************/ -ERL_NIF_TERM ng_crypto_one_shot(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +ERL_NIF_TERM ng_crypto_one_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Cipher, Key, IVec, Data, Encrypt) */ struct evp_cipher_ctx ctx_res; const struct cipher_type_t *cipherp; ERL_NIF_TERM ret; + ctx_res.ctx = NULL; +#if !defined(HAVE_EVP_AES_CTR) + ctx_res.env = NULL; +#endif + if (!get_init_args(env, &ctx_res, argv[0], argv[1], argv[2], argv[4], &cipherp, &ret)) goto ret; @@ -518,10 +535,17 @@ ERL_NIF_TERM ng_crypto_one_shot(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg ret: if (ctx_res.ctx) EVP_CIPHER_CTX_free(ctx_res.ctx); + +#if !defined(HAVE_EVP_AES_CTR) + if (ctx_res.env) + enif_free_env(ctx_res.env); +#endif + return ret; } -ERL_NIF_TERM ng_crypto_one_shot_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) + +ERL_NIF_TERM ng_crypto_one_time_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Cipher, Key, IVec, Data, Encrypt) % if no IV for the Cipher, set IVec = <<>> */ ErlNifBinary data_bin; @@ -536,10 +560,10 @@ ERL_NIF_TERM ng_crypto_one_shot_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM /* Run long jobs on a dirty scheduler to not block the current emulator thread */ if (data_bin.size > MAX_BYTES_TO_NIF) { - return enif_schedule_nif(env, "ng_crypto_one_shot", + return enif_schedule_nif(env, "ng_crypto_one_time", ERL_NIF_DIRTY_JOB_CPU_BOUND, - ng_crypto_one_shot, argc, argv); + ng_crypto_one_time, argc, argv); } - return ng_crypto_one_shot(env, argc, argv); + return ng_crypto_one_time(env, argc, argv); } diff --git a/lib/crypto/c_src/api_ng.h b/lib/crypto/c_src/api_ng.h index 5c7d9af3c5..aaf67524ae 100644 --- a/lib/crypto/c_src/api_ng.h +++ b/lib/crypto/c_src/api_ng.h @@ -25,6 +25,6 @@ ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -ERL_NIF_TERM ng_crypto_one_shot_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +ERL_NIF_TERM ng_crypto_one_time_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); #endif /* E_AES_H__ */ diff --git a/lib/crypto/c_src/atoms.c b/lib/crypto/c_src/atoms.c index 0793ffa6ca..059c14690f 100644 --- a/lib/crypto/c_src/atoms.c +++ b/lib/crypto/c_src/atoms.c @@ -70,6 +70,7 @@ ERL_NIF_TERM atom_onbasis; ERL_NIF_TERM atom_aes_cfb8; ERL_NIF_TERM atom_aes_cfb128; +ERL_NIF_TERM atom_aes_ige256; #ifdef HAVE_GCM ERL_NIF_TERM atom_aes_gcm; #endif @@ -188,6 +189,7 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM atom_aes_cfb8 = enif_make_atom(env, "aes_cfb8"); atom_aes_cfb128 = enif_make_atom(env, "aes_cfb128"); + atom_aes_ige256 = enif_make_atom(env, "aes_ige256"); #ifdef HAVE_GCM atom_aes_gcm = enif_make_atom(env, "aes_gcm"); #endif diff --git a/lib/crypto/c_src/atoms.h b/lib/crypto/c_src/atoms.h index 24f6dc26fd..f5913de96f 100644 --- a/lib/crypto/c_src/atoms.h +++ b/lib/crypto/c_src/atoms.h @@ -74,6 +74,7 @@ extern ERL_NIF_TERM atom_onbasis; extern ERL_NIF_TERM atom_aes_cfb8; extern ERL_NIF_TERM atom_aes_cfb128; +extern ERL_NIF_TERM atom_aes_ige256; #ifdef HAVE_GCM extern ERL_NIF_TERM atom_aes_gcm; #endif diff --git a/lib/crypto/c_src/cipher.c b/lib/crypto/c_src/cipher.c index 2652e1db4e..00072af632 100644 --- a/lib/crypto/c_src/cipher.c +++ b/lib/crypto/c_src/cipher.c @@ -20,10 +20,10 @@ #include "cipher.h" -#ifdef OPENSSL_NO_DES -#define COND_NO_DES_PTR(Ptr) (NULL) -#else +#ifdef HAVE_DES #define COND_NO_DES_PTR(Ptr) (Ptr) +#else +#define COND_NO_DES_PTR(Ptr) (NULL) #endif static struct cipher_type_t cipher_types[] = @@ -50,39 +50,30 @@ static struct cipher_type_t cipher_types[] = {{"des_ede3_cfb"}, {NULL}, 0, 0}, #endif +#ifdef HAVE_BF {{"blowfish_cbc"}, {&EVP_bf_cbc}, 0, NO_FIPS_CIPHER}, {{"blowfish_cfb64"}, {&EVP_bf_cfb64}, 0, NO_FIPS_CIPHER}, {{"blowfish_ofb64"}, {&EVP_bf_ofb}, 0, NO_FIPS_CIPHER}, {{"blowfish_ecb"}, {&EVP_bf_ecb}, 0, NO_FIPS_CIPHER | ECB_BUG_0_9_8L}, - - {{"aes_cbc"}, {&EVP_aes_128_cbc}, 16, 0}, - {{"aes_cbc"}, {&EVP_aes_192_cbc}, 24, 0}, - {{"aes_cbc"}, {&EVP_aes_256_cbc}, 32, 0}, +#else + {{"blowfish_cbc"}, {NULL}, 0, 0}, + {{"blowfish_cfb64"}, {NULL}, 0, 0}, + {{"blowfish_ofb64"}, {NULL}, 0, 0}, + {{"blowfish_ecb"}, {NULL}, 0, 0}, +#endif {{"aes_128_cbc"}, {&EVP_aes_128_cbc}, 16, 0}, {{"aes_192_cbc"}, {&EVP_aes_192_cbc}, 24, 0}, {{"aes_256_cbc"}, {&EVP_aes_256_cbc}, 32, 0}, - {{"aes_cfb8"}, {&EVP_aes_128_cfb8}, 16, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_cfb8"}, {&EVP_aes_192_cfb8}, 24, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_cfb8"}, {&EVP_aes_256_cfb8}, 32, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_128_cfb8"}, {&EVP_aes_128_cfb8}, 16, NO_FIPS_CIPHER | AES_CFBx}, {{"aes_192_cfb8"}, {&EVP_aes_192_cfb8}, 24, NO_FIPS_CIPHER | AES_CFBx}, {{"aes_256_cfb8"}, {&EVP_aes_256_cfb8}, 32, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_cfb128"}, {&EVP_aes_128_cfb128}, 16, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_cfb128"}, {&EVP_aes_192_cfb128}, 24, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_cfb128"}, {&EVP_aes_256_cfb128}, 32, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_128_cfb128"}, {&EVP_aes_128_cfb128}, 16, NO_FIPS_CIPHER | AES_CFBx}, {{"aes_192_cfb128"}, {&EVP_aes_192_cfb128}, 24, NO_FIPS_CIPHER | AES_CFBx}, {{"aes_256_cfb128"}, {&EVP_aes_256_cfb128}, 32, NO_FIPS_CIPHER | AES_CFBx}, - {{"aes_ecb"}, {&EVP_aes_128_ecb}, 16, ECB_BUG_0_9_8L}, - {{"aes_ecb"}, {&EVP_aes_192_ecb}, 24, ECB_BUG_0_9_8L}, - {{"aes_ecb"}, {&EVP_aes_256_ecb}, 32, ECB_BUG_0_9_8L}, - {{"aes_128_ecb"}, {&EVP_aes_128_ecb}, 16, ECB_BUG_0_9_8L}, {{"aes_192_ecb"}, {&EVP_aes_192_ecb}, 24, ECB_BUG_0_9_8L}, {{"aes_256_ecb"}, {&EVP_aes_256_ecb}, 32, ECB_BUG_0_9_8L}, @@ -91,16 +82,10 @@ static struct cipher_type_t cipher_types[] = {{"aes_128_ctr"}, {&EVP_aes_128_ctr}, 16, 0}, {{"aes_192_ctr"}, {&EVP_aes_192_ctr}, 24, 0}, {{"aes_256_ctr"}, {&EVP_aes_256_ctr}, 32, 0}, - {{"aes_ctr"}, {&EVP_aes_128_ctr}, 16, 0}, - {{"aes_ctr"}, {&EVP_aes_192_ctr}, 24, 0}, - {{"aes_ctr"}, {&EVP_aes_256_ctr}, 32, 0}, #else {{"aes_128_ctr"}, {NULL}, 16, AES_CTR_COMPAT}, {{"aes_192_ctr"}, {NULL}, 24, AES_CTR_COMPAT}, {{"aes_256_ctr"}, {NULL}, 32, AES_CTR_COMPAT}, - {{"aes_ctr"}, {NULL}, 16, AES_CTR_COMPAT}, - {{"aes_ctr"}, {NULL}, 24, AES_CTR_COMPAT}, - {{"aes_ctr"}, {NULL}, 32, AES_CTR_COMPAT}, #endif #if defined(HAVE_CHACHA20) @@ -117,31 +102,23 @@ static struct cipher_type_t cipher_types[] = #endif #if defined(HAVE_GCM) - {{"aes_gcm"}, {&EVP_aes_128_gcm}, 16, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, - {{"aes_gcm"}, {&EVP_aes_192_gcm}, 24, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, - {{"aes_gcm"}, {&EVP_aes_256_gcm}, 32, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, - {{"aes_128_gcm"}, {&EVP_aes_128_gcm}, 16, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, - {{"aes_192_gcm"}, {&EVP_aes_192_gcm}, 24, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, - {{"aes_256_gcm"}, {&EVP_aes_256_gcm}, 32, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, + {{"aes_128_gcm"}, {&EVP_aes_128_gcm}, 16, AEAD_CIPHER|GCM_MODE, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, + {{"aes_192_gcm"}, {&EVP_aes_192_gcm}, 24, AEAD_CIPHER|GCM_MODE, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, + {{"aes_256_gcm"}, {&EVP_aes_256_gcm}, 32, AEAD_CIPHER|GCM_MODE, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}}, #else - {{"aes_gcm"}, {NULL}, 0, AEAD_CIPHER, {{0,0,0}}}, - {{"aes_128_gcm"}, {NULL}, 16, AEAD_CIPHER, {{0,0,0}}}, - {{"aes_192_gcm"}, {NULL}, 24, AEAD_CIPHER, {{0,0,0}}}, - {{"aes_256_gcm"}, {NULL}, 32, AEAD_CIPHER, {{0,0,0}}}, + {{"aes_128_gcm"}, {NULL}, 16, AEAD_CIPHER|GCM_MODE, {{0,0,0}}}, + {{"aes_192_gcm"}, {NULL}, 24, AEAD_CIPHER|GCM_MODE, {{0,0,0}}}, + {{"aes_256_gcm"}, {NULL}, 32, AEAD_CIPHER|GCM_MODE, {{0,0,0}}}, #endif #if defined(HAVE_CCM) - {{"aes_ccm"}, {&EVP_aes_128_ccm}, 16, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, - {{"aes_ccm"}, {&EVP_aes_192_ccm}, 24, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, - {{"aes_ccm"}, {&EVP_aes_256_ccm}, 32, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, - {{"aes_128_ccm"}, {&EVP_aes_128_ccm}, 16, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, - {{"aes_192_ccm"}, {&EVP_aes_192_ccm}, 24, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, - {{"aes_256_ccm"}, {&EVP_aes_256_ccm}, 32, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, + {{"aes_128_ccm"}, {&EVP_aes_128_ccm}, 16, AEAD_CIPHER|CCM_MODE, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, + {{"aes_192_ccm"}, {&EVP_aes_192_ccm}, 24, AEAD_CIPHER|CCM_MODE, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, + {{"aes_256_ccm"}, {&EVP_aes_256_ccm}, 32, AEAD_CIPHER|CCM_MODE, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}}, #else - {{"aes_ccm"}, {NULL}, 0, AEAD_CIPHER, {{0,0,0}}}, - {{"aes_128_ccm"}, {NULL}, 16, AEAD_CIPHER, {{0,0,0}}}, - {{"aes_192_ccm"}, {NULL}, 24, AEAD_CIPHER, {{0,0,0}}}, - {{"aes_256_ccm"}, {NULL}, 32, AEAD_CIPHER, {{0,0,0}}}, + {{"aes_128_ccm"}, {NULL}, 16, AEAD_CIPHER|CCM_MODE, {{0,0,0}}}, + {{"aes_192_ccm"}, {NULL}, 24, AEAD_CIPHER|CCM_MODE, {{0,0,0}}}, + {{"aes_256_ccm"}, {NULL}, 32, AEAD_CIPHER|CCM_MODE, {{0,0,0}}}, #endif /*==== Specialy handled ciphers, only for inclusion in algorithm's list ====*/ @@ -352,13 +329,15 @@ ERL_NIF_TERM cipher_types_as_list(ErlNifEnv* env) prev = atom_undefined; for (p = cipher_types; (p->type.atom & (p->type.atom != atom_false)); p++) { - if ((prev != p->type.atom) && - ((p->cipher.p != NULL) || - (p->flags & (NON_EVP_CIPHER|AES_CTR_COMPAT)) ) && /* Special handling. Bad indeed... */ - ! FORBIDDEN_IN_FIPS(p) - ) - hd = enif_make_list_cell(env, p->type.atom, hd); - prev = p->type.atom; + if ((prev == p->type.atom) || + FORBIDDEN_IN_FIPS(p) ) + continue; + + if ((p->cipher.p != NULL) || + (p->type.atom == atom_aes_ige256)) /* Special handling. Bad indeed... */ + { + hd = enif_make_list_cell(env, p->type.atom, hd); + } } return hd; diff --git a/lib/crypto/c_src/cipher.h b/lib/crypto/c_src/cipher.h index b94873940f..0e51c410eb 100644 --- a/lib/crypto/c_src/cipher.h +++ b/lib/crypto/c_src/cipher.h @@ -46,6 +46,8 @@ struct cipher_type_t { #define AEAD_CIPHER 8 #define NON_EVP_CIPHER 16 #define AES_CTR_COMPAT 32 +#define CCM_MODE 64 +#define GCM_MODE 128 #ifdef FIPS_SUPPORT diff --git a/lib/crypto/c_src/common.h b/lib/crypto/c_src/common.h index 0bf7f09f4f..a7e59d5d01 100644 --- a/lib/crypto/c_src/common.h +++ b/lib/crypto/c_src/common.h @@ -38,8 +38,11 @@ /* All nif functions return a valid value or throws an exception */ #define EXCP(Env, Id, Str) enif_raise_exception((Env), \ - enif_make_tuple2((Env), \ + enif_make_tuple3((Env), \ (Id), \ + enif_make_tuple2((Env), \ + enif_make_string((Env),__FILE__,(ERL_NIF_LATIN1)), \ + enif_make_int((Env), __LINE__)), \ enif_make_string((Env),(Str),(ERL_NIF_LATIN1)) )) #define EXCP_NOTSUP(Env, Str) EXCP((Env), atom_notsup, (Str)) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 4aed06a489..d533cba140 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -63,7 +63,12 @@ static ErlNifFunc nif_funcs[] = { {"info_lib", 0, info_lib, 0}, {"info_fips", 0, info_fips, 0}, {"enable_fips_mode", 1, enable_fips_mode, 0}, - {"algorithms", 0, algorithms, 0}, + {"hash_algorithms", 0, hash_algorithms, 0}, + {"pubkey_algorithms", 0, pubkey_algorithms, 0}, + {"cipher_algorithms", 0, cipher_algorithms, 0}, + {"mac_algorithms", 0, mac_algorithms, 0}, + {"curve_algorithms", 0, curve_algorithms, 0}, + {"rsa_opts_algorithms", 0, rsa_opts_algorithms, 0}, {"hash_info", 1, hash_info_nif, 0}, {"hash_nif", 2, hash_nif, 0}, {"hash_init_nif", 1, hash_init_nif, 0}, @@ -81,7 +86,7 @@ static ErlNifFunc nif_funcs[] = { {"ng_crypto_init_nif", 4, ng_crypto_init_nif, 0}, {"ng_crypto_update_nif", 2, ng_crypto_update_nif, 0}, {"ng_crypto_update_nif", 3, ng_crypto_update_nif, 0}, - {"ng_crypto_one_shot_nif", 5, ng_crypto_one_shot_nif, 0}, + {"ng_crypto_one_time_nif", 5, ng_crypto_one_time_nif, 0}, {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif, 0}, {"strong_rand_range_nif", 1, strong_rand_range_nif, 0}, {"rand_uniform_nif", 2, rand_uniform_nif, 0}, @@ -105,8 +110,7 @@ static ErlNifFunc nif_funcs[] = { {"rand_seed_nif", 1, rand_seed_nif, 0}, - {"aead_encrypt", 6, aead_encrypt, 0}, - {"aead_decrypt", 6, aead_decrypt, 0}, + {"aead_cipher", 7, aead_cipher, 0}, {"poly1305_nif", 2, poly1305_nif, 0}, diff --git a/lib/crypto/c_src/dh.c b/lib/crypto/c_src/dh.c index 38eb534d99..13a2336f25 100644 --- a/lib/crypto/c_src/dh.c +++ b/lib/crypto/c_src/dh.c @@ -23,6 +23,7 @@ ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */ +#ifdef HAVE_DH DH *dh_params = NULL; unsigned int mpint; /* 0 or 4 */ ERL_NIF_TERM head, tail; @@ -187,10 +188,14 @@ ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar #endif return ret; +#else + return enif_raise_exception(env, atom_notsup); +#endif } ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (OthersPublicKey, MyPrivateKey, DHParams=[P,G]) */ +#ifdef HAVE_DH BIGNUM *other_pub_key = NULL; BIGNUM *dh_p = NULL; BIGNUM *dh_g = NULL; @@ -291,4 +296,7 @@ ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg DH_free(dh_priv); return ret; +#else + return enif_raise_exception(env, atom_notsup); +#endif } diff --git a/lib/crypto/c_src/dss.c b/lib/crypto/c_src/dss.c index 9bf8eb3ce0..63268f0f2b 100644 --- a/lib/crypto/c_src/dss.c +++ b/lib/crypto/c_src/dss.c @@ -21,6 +21,8 @@ #include "dss.h" #include "bn.h" +#ifdef HAVE_DSA + int get_dss_private_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa) { /* key=[P,Q,G,KEY] */ @@ -142,3 +144,5 @@ int get_dss_public_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa) BN_free(dsa_y); return 0; } + +#endif diff --git a/lib/crypto/c_src/dss.h b/lib/crypto/c_src/dss.h index 3275657e98..07e28ca7c5 100644 --- a/lib/crypto/c_src/dss.h +++ b/lib/crypto/c_src/dss.h @@ -23,7 +23,9 @@ #include "common.h" +#ifdef HAVE_DSA int get_dss_private_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa); int get_dss_public_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa); +#endif #endif /* E_DSS_H__ */ diff --git a/lib/crypto/c_src/openssl_config.h b/lib/crypto/c_src/openssl_config.h index f926f8af13..339eb5b8f4 100644 --- a/lib/crypto/c_src/openssl_config.h +++ b/lib/crypto/c_src/openssl_config.h @@ -25,9 +25,8 @@ #include <openssl/opensslconf.h> #include <openssl/crypto.h> -#ifndef OPENSSL_NO_DES #include <openssl/des.h> -#endif /* #ifndef OPENSSL_NO_DES */ + /* #include <openssl/idea.h> This is not supported on the openssl OTP requires */ #include <openssl/dsa.h> #include <openssl/rsa.h> @@ -166,6 +165,22 @@ # define HAVE_BLAKE2 #endif +#ifndef OPENSSL_NO_BF +# define HAVE_BF +#endif + +#ifndef OPENSSL_NO_DES +# define HAVE_DES +#endif + +#ifndef OPENSSL_NO_DH +# define HAVE_DH +#endif + +#ifndef OPENSSL_NO_DSA +# define HAVE_DSA +#endif + #ifndef OPENSSL_NO_MD4 # define HAVE_MD4 #endif diff --git a/lib/crypto/c_src/otp_test_engine.c b/lib/crypto/c_src/otp_test_engine.c index fd26b7cb5d..c3bd9dfb55 100644 --- a/lib/crypto/c_src/otp_test_engine.c +++ b/lib/crypto/c_src/otp_test_engine.c @@ -160,7 +160,7 @@ static int test_engine_md5_update(EVP_MD_CTX *ctx,const void *data, size_t count static int test_engine_md5_final(EVP_MD_CTX *ctx,unsigned char *md) { #ifdef OLD - fprintf(stderr, "MD5 final size of EVP_MD: %lu\r\n", sizeof(EVP_MD)); + fprintf(stderr, "MD5 final size of EVP_MD: %lu\r\n", (unsigned long)sizeof(EVP_MD)); if (!MD5_Final(md, data(ctx))) goto err; @@ -404,7 +404,7 @@ int test_rsa_sign(int dtype, } */ if ((sizeof(fake_flag) == m_len) - && bcmp(m,fake_flag,m_len) == 0) { + && memcmp(m,fake_flag,m_len) == 0) { int slen; printf("To be faked\r\n"); @@ -432,7 +432,7 @@ int test_rsa_verify(int dtype, printf("test_rsa_verify (dtype=%i) called m_len=%u siglen=%u\r\n", dtype, m_len, siglen); if ((sizeof(fake_flag) == m_len) - && bcmp(m,fake_flag,m_len) == 0) { + && memcmp(m,fake_flag,m_len) == 0) { int size; if ((size = RSA_size(rsa)) < 0) diff --git a/lib/crypto/c_src/pkey.c b/lib/crypto/c_src/pkey.c index 638bb588fa..a1e2677b34 100644 --- a/lib/crypto/c_src/pkey.c +++ b/lib/crypto/c_src/pkey.c @@ -254,7 +254,9 @@ static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_ { EVP_PKEY *result = NULL; RSA *rsa = NULL; +#ifdef HAVE_DSA DSA *dsa = NULL; +#endif #if defined(HAVE_EC) EC_KEY *ec = NULL; #endif @@ -327,6 +329,7 @@ static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_ return PKEY_NOTSUP; #endif } else if (algorithm == atom_dss) { +#ifdef HAVE_DSA if ((dsa = DSA_new()) == NULL) goto err; if (!get_dss_private_key(env, key, dsa)) @@ -340,9 +343,9 @@ static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_ dsa = NULL; } else { +#endif return PKEY_BADARG; } - goto done; err: @@ -357,8 +360,10 @@ static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_ enif_free(id); if (rsa) RSA_free(rsa); +#ifdef HAVE_DSA if (dsa) DSA_free(dsa); +#endif #ifdef HAVE_EC if (ec) EC_KEY_free(ec); @@ -377,7 +382,9 @@ static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_T { EVP_PKEY *result = NULL; RSA *rsa = NULL; +#ifdef HAVE_DSA DSA *dsa = NULL; +#endif #if defined(HAVE_EC) EC_KEY *ec = NULL; #endif @@ -449,6 +456,7 @@ static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_T return PKEY_NOTSUP; #endif } else if (algorithm == atom_dss) { +#ifdef HAVE_DSA if ((dsa = DSA_new()) == NULL) goto err; @@ -461,7 +469,9 @@ static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_T goto err; /* On success, result owns dsa */ dsa = NULL; - +#else + return PKEY_NOTSUP; +#endif } else { return PKEY_BADARG; } @@ -480,8 +490,10 @@ static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_T enif_free(id); if (rsa) RSA_free(rsa); +#ifdef HAVE_DSA if (dsa) DSA_free(dsa); +#endif #ifdef HAVE_EC if (ec) EC_KEY_free(ec); @@ -518,7 +530,9 @@ ERL_NIF_TERM pkey_sign_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) unsigned char *tbs; /* data to be signed */ size_t tbslen; RSA *rsa = NULL; +#ifdef HAVE_DSA DSA *dsa = NULL; +#endif #if defined(HAVE_EC) EC_KEY *ec = NULL; #endif @@ -706,8 +720,10 @@ enif_get_atom(env,argv[1],buf,1024,ERL_NIF_LATIN1); printf("hash=%s ",buf); enif_release_binary(&sig_bin); if (rsa) RSA_free(rsa); +#ifdef HAVE_DSA if (dsa) DSA_free(dsa); +#endif #ifdef HAVE_EC if (ec) EC_KEY_free(ec); @@ -744,7 +760,9 @@ ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[] size_t tbslen; ERL_NIF_TERM ret; RSA *rsa = NULL; +#ifdef HAVE_DSA DSA *dsa = NULL; +#endif #ifdef HAVE_EC EC_KEY *ec = NULL; #endif @@ -890,8 +908,10 @@ ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[] EVP_PKEY_free(pkey); if (rsa) RSA_free(rsa); +#ifdef HAVE_DSA if (dsa) DSA_free(dsa); +#endif #ifdef HAVE_EC if (ec) EC_KEY_free(ec); @@ -1358,7 +1378,9 @@ ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ERL_NIF_TERM ret; EVP_PKEY *pkey = NULL; RSA *rsa = NULL; +#ifdef HAVE_DSA DSA *dsa = NULL; +#endif ERL_NIF_TERM result[8]; ASSERT(argc == 2); @@ -1383,6 +1405,7 @@ ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ret = enif_make_list_from_array(env, result, 2); +#ifdef HAVE_DSA } else if (argv[0] == atom_dss) { const BIGNUM *p = NULL, *q = NULL, *g = NULL, *pub_key = NULL; @@ -1402,7 +1425,7 @@ ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM goto err; ret = enif_make_list_from_array(env, result, 4); - +#endif } else if (argv[0] == atom_ecdsa) { #if defined(HAVE_EC) /* not yet implemented @@ -1452,8 +1475,10 @@ ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM done: if (rsa) RSA_free(rsa); +#ifdef HAVE_DSA if (dsa) DSA_free(dsa); +#endif if (pkey) EVP_PKEY_free(pkey); diff --git a/lib/crypto/doc/src/Makefile b/lib/crypto/doc/src/Makefile index cbcafb7375..8da494dad6 100644 --- a/lib/crypto/doc/src/Makefile +++ b/lib/crypto/doc/src/Makefile @@ -39,7 +39,8 @@ XML_REF3_FILES = crypto.xml XML_REF6_FILES = crypto_app.xml XML_PART_FILES = usersguide.xml -XML_CHAPTER_FILES = notes.xml licenses.xml fips.xml engine_load.xml engine_keys.xml algorithm_details.xml +XML_CHAPTER_FILES = notes.xml licenses.xml fips.xml engine_load.xml engine_keys.xml \ + algorithm_details.xml new_api.xml BOOK_FILES = book.xml diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 8a4fad67de..d1d1252f29 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -42,7 +42,7 @@ <item> <url href="https://www.nist.gov/publications/sha-3-standard-permutation-based-hash-and-extendable-output-functions?pub_id=919061"> SHA-3 Standard: Permutation-Based Hash and Extendable-Output Functions [FIPS PUB 202] - </url> + </url> </item> <tag>BLAKE2</tag> <item> @@ -190,70 +190,101 @@ </description> <datatypes> - <datatype_title>Ciphers</datatype_title> + <datatype_title>Ciphers, new API</datatype_title> <datatype> <name name="cipher"/> - <name name="stream_cipher"/> - <name name="block_cipher"/> <desc> - <p>Ciphers known byt the CRYPTO application. Note that this list might be reduced if the - underlying libcrypto does not support all of them.</p> </desc> </datatype> - <datatype> - <name name="stream_cipher_iv"/> - <name name="stream_cipher_no_iv"/> + <name name="cipher_no_iv"/> <desc> - <p>Stream ciphers for - <seealso marker="#stream_init-3">stream_init/3</seealso> and - <seealso marker="#stream_init-2">stream_init/2</seealso> . - </p> + </desc> + </datatype> + <datatype> + <name name="cipher_iv"/> + <desc> + </desc> + </datatype> + <datatype> + <name name="cipher_aead"/> + <desc> + <p>Ciphers known by the CRYPTO application when using the + <seealso marker="crypto:new_api#the-new-api">new API</seealso>.</p> + <p>Note that this list might be reduced if the underlying libcrypto does not support all of them.</p> </desc> </datatype> + <datatype_title>Ciphers, old API</datatype_title> + <datatype> + <name name="block_cipher_with_iv"/> + <desc> + </desc> + </datatype> + <datatype> + <name name="block_cipher_without_iv"/> + <desc> + </desc> + </datatype> + <datatype> + <name name="stream_cipher"/> + <desc> + </desc> + </datatype> + <datatype> + <name name="aead_cipher"/> + <desc> + </desc> + </datatype> <datatype> - <name name="block_cipher_iv"/> <name name="cbc_cipher"/> + <desc> + </desc> + </datatype> + <datatype> <name name="cfb_cipher"/> <desc> - <p>Block ciphers with initialization vector for - <seealso marker="#block_encrypt-4">block_encrypt/4</seealso> and - <seealso marker="#block_decrypt-4">block_decrypt/4</seealso> . - </p> </desc> </datatype> - <datatype> - <name name="alias_cfb"/> - <name name="alias_cbc"/> + <name name="ctr_cipher"/> <desc> - <p>Names that are replaced by more common names. They may deprecated in futer releases.</p> - <p><c>des3_cbc</c> and <c>des_ede3</c> should be replaced by <c>des_ede3_cbc</c></p> - <p><c>des_ede3_cbf</c>, <c>des3_cbf</c> and <c>des3_cfb</c> should be replaced by <c>des_ede3_cfb</c>.</p> - <p><c>aes_cbc128</c> should be replaced by <c>aes_128_cbc</c>.</p> - <p><c>aes_cbc256</c> should be replaced by <c>aes_256_cbc</c>.</p> </desc> </datatype> - <datatype> - <name name="block_cipher_no_iv"/> <name name="ecb_cipher"/> <desc> - <p>Block ciphers without initialization vector for - <seealso marker="#block_encrypt-3">block_encrypt/3</seealso> and - <seealso marker="#block_decrypt-3">block_decrypt/3</seealso> . - </p> + <p>Ciphers known by the CRYPTO application when using the + <seealso marker="crypto:new_api#the-old-api">old API</seealso>.</p> + <p>Note that this list might be reduced if the underlying libcrypto does not support all of them.</p> </desc> </datatype> <datatype> - <name name="aead_cipher"/> + <name name="retired_cbc_cipher_aliases"/> + <desc> + </desc> + </datatype> + <datatype> + <name name="retired_cfb_cipher_aliases"/> <desc> - <p>Ciphers with simultaneous MAC-calculation or MAC-checking. - <seealso marker="#block_encrypt-4">block_encrypt/4</seealso> and - <seealso marker="#block_decrypt-4">block_decrypt/4</seealso> . + </desc> + </datatype> + <datatype> + <name name="retired_ctr_cipher_aliases"/> + <desc> + </desc> + </datatype> + <datatype> + <name name="retired_ecb_cipher_aliases"/> + <desc> + <p>Alternative, old names of ciphers known by the CRYPTO application when using the + <seealso marker="crypto:new_api#the-old-api">old API</seealso>. + See <seealso marker="crypto:new_api#retired-cipher-names">Retired cipher names</seealso> for names to + use instead to be prepared for an easy convertion to the + <seealso marker="crypto:new_api#the-new-api">new API</seealso>. </p> + <p>Note that this list might be reduced if the underlying libcrypto does not support all of them.</p> </desc> </datatype> @@ -547,6 +578,7 @@ <name name="stream_state"/> <name name="hmac_state"/> <name name="hash_state"/> + <name name="crypto_state"/> <desc> <p>Contexts with an internal state that should not be manipulated but passed between function calls. </p> @@ -575,117 +607,190 @@ <p>This is a more developed variant of the older <seealso marker="#type-run_time_error">run_time_error()</seealso>. </p> + <p>The exception is:</p> + <pre> + {Tag, {C_FileName,LineNumber}, Description} + + Tag = badarg | notsup | error + C_FileName = string() + LineNumber = integer() + Description = string() + </pre> + <p>It is like the older type an exception of the <c>error</c> class. In addition they contain a descriptive text in English. That text is targeted to a developer. Examples are "Bad key size" or "Cipher id is not an atom". </p> - <p>The exceptions are:</p> + <p>The exception tags are:</p> <taglist> - <tag><c>{badarg, Description::string()}</c></tag> + <tag><c>badarg</c></tag> <item><p>Signifies that one or more arguments are of wrong data type or are otherwise badly formed.</p> </item> - <tag><c>{notsup, Description::string()}</c></tag> + <tag><c>notsup</c></tag> <item><p>Signifies that the algorithm is known but is not supported by current underlying libcrypto or explicitly disabled when building that one.</p> </item> - <tag><c>{error, Description::string()}</c></tag> + <tag><c>error</c></tag> <item><p>An error condition that should not occur, for example a memory allocation failed or the underlying cryptolib returned an error code, for example "Can't initialize context, step 1". Thoose text usually needs searching the C-code to be understood.</p> </item> </taglist> + <p>To catch the exception, use for example:</p> + <code> + try crypto:crypto_init(Ciph, Key, IV, true) + catch + error:{Tag, {C_FileName,LineNumber}, Description} -> + do_something(......) + ..... + end + </code> </desc> </datatype> </datatypes> <!--================ FUNCTIONS ================--> + <section> + <title>New API</title> + </section> + <funcs> <func> - <name name="block_encrypt" arity="3" since="OTP 18.0"/> - <fsummary>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher</fsummary> + <name name="crypto_init" arity="3" since="OTP 22.0"/> + <fsummary>Initializes a series of encryptions or decryptions</fsummary> <desc> - <p>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher.</p> - <p>May raise exception <c>error:notsup</c> in case the chosen <c>Type</c> - is not supported by the underlying libcrypto implementation.</p> - <p>For keylengths and blocksizes see the - <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + <p>As <seealso marker="#crypto_init/4">crypto_init/4</seealso> but for ciphers without IVs.</p> + </desc> + </func> + + <func> + <name name="crypto_init" arity="4" since="OTP 22.0"/> + <fsummary>Initializes a series of encryptions or decryptions</fsummary> + <desc> + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + Initializes a series of encryptions or decryptions and creates an internal state + with a reference that is returned. + The actual encryption or decryption is done by + <seealso marker="crypto#crypto_update/2">crypto_update/2</seealso>. + </p> + <p>For encryption, set the <c>EncryptFlag</c> to <c>true</c>. For decryption, set it to <c>false</c>. + </p> + <p>See <seealso marker="crypto:new_api#examples-of-crypto_init-4-and-crypto_update-2"> + examples in the User's Guide.</seealso> </p> </desc> </func> <func> - <name name="block_decrypt" arity="3" since="OTP 18.0"/> - <fsummary>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher</fsummary> + <name name="crypto_update" arity="2" since="OTP 22.0"/> + <fsummary>Do an actual crypto operation on a part of the full text</fsummary> <desc> - <p>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher.</p> - <p>May raise exception <c>error:notsup</c> in case the chosen <c>Type</c> - is not supported by the underlying libcrypto implementation.</p> - <p>For keylengths and blocksizes see the - <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + It does an actual crypto operation on a part of the full text. If the part is less + than a number of full blocks, only the full blocks (possibly none) are encrypted + or decrypted and the remaining bytes are saved to the next <c>crypto_update</c> operation. + The <c>State</c> should be created with + <seealso marker="crypto#crypto_init/3">crypto_init/3</seealso> + or + <seealso marker="crypto#crypto_init/4">crypto_init/4</seealso>. + </p> + <p>See <seealso marker="crypto:new_api#examples-of-crypto_init-4-and-crypto_update-2"> + examples in the User's Guide.</seealso> </p> </desc> </func> <func> - <name since="OTP R16B01">block_encrypt(Type, Key, Ivec, PlainText) -> CipherText | Error</name> - <name since="OTP R16B01">block_encrypt(AeadType, Key, Ivec, {AAD, PlainText}) -> {CipherText, CipherTag} | Error</name> - <name since="OTP R16B01">block_encrypt(aes_gcm | aes_ccm, Key, Ivec, {AAD, PlainText, TagLength}) -> {CipherText, CipherTag} | Error </name> - <fsummary>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher</fsummary> - <type> - <v>Type = <seealso marker="#type-block_cipher_iv">block_cipher_iv()</seealso></v> - <v>AeadType = <seealso marker="#type-aead_cipher">aead_cipher()</seealso></v> - <v>Key = <seealso marker="#type-key">key()</seealso> | <seealso marker="#type-des3_key">des3_key()</seealso></v> - <v>PlainText = iodata()</v> - <v>AAD = IVec = CipherText = CipherTag = binary()</v> - <v>TagLength = 1..16</v> - <v>Error = <seealso marker="#type-run_time_error">run_time_error()</seealso></v> - </type> + <name name="crypto_dyn_iv_init" arity="3" since="OTP 22.0"/> + <fsummary>Initializes a series of encryptions or decryptions where the IV is provided later</fsummary> <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 raise exception <c>error:notsup</c> in case the chosen <c>Type</c> - is not supported by the underlying libcrypto implementation.</p> - <p>For keylengths, iv-sizes and blocksizes see the - <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + Initializes a series of encryptions or decryptions where the IV is provided later. + The actual encryption or decryption is done by + <seealso marker="crypto#crypto_dyn_iv_update/3">crypto_dyn_iv_update/3</seealso>. + </p> + <p>For encryption, set the <c>EncryptFlag</c> to <c>true</c>. For decryption, set it to <c>false</c>. </p> </desc> </func> <func> - <name since="OTP R16B01">block_decrypt(Type, Key, Ivec, CipherText) -> PlainText | Error</name> - <name since="OTP R16B01">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 = <seealso marker="#type-block_cipher_iv">block_cipher_iv()</seealso></v> - <v>AeadType = <seealso marker="#type-aead_cipher">aead_cipher()</seealso></v> - <v>Key = <seealso marker="#type-key">key()</seealso> | <seealso marker="#type-des3_key">des3_key()</seealso></v> - <v>PlainText = iodata()</v> - <v>AAD = IVec = CipherText = CipherTag = binary()</v> - <v>Error = BadTag | <seealso marker="#type-run_time_error">run_time_error()</seealso></v> - <v>BadTag = error</v> - </type> + <name name="crypto_dyn_iv_update" arity="3" since="OTP 22.0"/> + <fsummary>Do an actual crypto operation on a part of the full text and the IV is supplied for each part</fsummary> <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 raise exception <c>error:notsup</c> in case the chosen <c>Type</c> - is not supported by the underlying libcrypto implementation.</p> - <p>For keylengths, iv-sizes and blocksizes see the - <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + Do an actual crypto operation on a part of the full text and the IV is supplied for each part. + The <c>State</c> should be created with + <seealso marker="crypto#crypto_dyn_iv_init/3">crypto_dyn_iv_init/3</seealso>. </p> </desc> </func> - <func> + <func> + <name name="crypto_one_time" arity="4" since="OTP 22.0"/> + <fsummary>Do a complete encrypt or decrypt of the full text</fsummary> + <desc> + <p>As <seealso marker="#crypto_one_time/5">crypto_one_time/5</seealso> but for ciphers without IVs.</p> + </desc> + </func> + + <func> + <name name="crypto_one_time" arity="5" since="OTP 22.0"/> + <fsummary>Do a complete encrypt or decrypt of the full text</fsummary> + <desc> + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + Do a complete encrypt or decrypt of the full text in the argument <c>Data</c>. + </p> + <p>For encryption, set the <c>EncryptFlag</c> to <c>true</c>. For decryption, set it to <c>false</c>. + </p> + <p>See <seealso marker="crypto:new_api#example-of-crypto_one_time-5">examples in the User's Guide.</seealso> + </p> + </desc> + </func> + + <func> + <name name="crypto_one_time_aead" arity="6" since="OTP 22.0"/> + <name name="crypto_one_time_aead" arity="7" since="OTP 22.0"/> + <fsummary>Do a complete encrypt or decrypt with an AEAD cipher of the full text</fsummary> + <desc> + <p>Part of the <seealso marker="crypto:new_api#the-new-api">new API</seealso>. + Do a complete encrypt or decrypt with an AEAD cipher of the full text. + </p> + <p>For encryption, set the <c>EncryptFlag</c> to <c>true</c> and set the <c>TagOrTagLength</c> + to the wanted size of the tag, that is, the tag length. If the default length is wanted, the + <c>crypto_aead/6</c> form may be used. + </p> + <p>For decryption, set the <c>EncryptFlag</c> to <c>false</c> and put the tag to be checked + in the argument <c>TagOrTagLength</c>. + </p> + <p>See <seealso marker="crypto:new_api#example-of-crypto_one_time_aead-6">examples in the User's Guide.</seealso> + </p> + </desc> + </func> + + <func> + <name name="supports" arity="1" since="OTP 22.0"/> + <fsummary>Provide a list of available crypto algorithms.</fsummary> + <desc> + <p> Can be used to determine which crypto algorithms that are supported + by the underlying libcrypto library</p> + <p>See <seealso marker="#hash_info-1">hash_info/1</seealso> and <seealso marker="#cipher_info-1">cipher_info/1</seealso> + for information about the hash and cipher algorithms. + </p> + </desc> + </func> + + </funcs> + + <section> + <title>API kept from previous versions</title> + </section> + + <funcs> + <func> <name name="bytes_to_integer" arity="1" since="OTP R16B01"/> <fsummary>Convert binary representation, of an integer, to an Erlang integer.</fsummary> <desc> @@ -928,7 +1033,7 @@ cipher algorithm in question. </p> <note> - <p>The ciphers <c>aes_cbc</c>, <c>aes_cfb8</c>, <c>aes_cfb128</c>, <c>aes_ctr</c>, + <p>The ciphers <c>aes_cbc</c>, <c>aes_cfb8</c>, <c>aes_cfb128</c>, <c>aes_ctr</c>, <c>aes_ecb</c>, <c>aes_gcm</c> and <c>aes_ccm</c> has no keylength in the <c>Type</c> as opposed to for example <c>aes_128_ctr</c>. They adapt to the length of the key provided in the encrypt and decrypt function. Therefor it is impossible to return a valid keylength @@ -1094,7 +1199,7 @@ <seealso marker="#rand_seed_s-0">rand_seed_s/0</seealso>. </p> <p> - When using the state object from this function the + When using the state object from this function the <seealso marker="stdlib:rand">rand</seealso> functions using it may raise exception <c>error:low_entropy</c> in case the random generator failed due to lack of secure "randomness". @@ -1120,7 +1225,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <seealso marker="stdlib:rand#seed_s-1">rand:seed_s/1</seealso>. </p> <p> - When using the state object from this function the + When using the state object from this function the <seealso marker="stdlib:rand">rand</seealso> functions using it may raise exception <c>error:low_entropy</c> in case the random generator failed due to lack of secure "randomness". @@ -1129,7 +1234,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <p> The state returned from this function cannot be used to get a reproducable random sequence as from - the other + the other <seealso marker="stdlib:rand">rand</seealso> functions, since reproducability does not match cryptographically safe. @@ -1160,7 +1265,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre> <seealso marker="#rand_seed_alg_s-1">rand_seed_alg_s/1</seealso>. </p> <p> - When using the state object from this function the + When using the state object from this function the <seealso marker="stdlib:rand">rand</seealso> functions using it may raise exception <c>error:low_entropy</c> in case the random generator failed due to lack of secure "randomness". @@ -1227,7 +1332,7 @@ FloatValue = rand:uniform(). % again of 56 bits that makes calculations fast on 64 bit machines. </p> <p> - When using the state object from this function the + When using the state object from this function the <seealso marker="stdlib:rand">rand</seealso> functions using it may raise exception <c>error:low_entropy</c> in case the random generator failed due to lack of secure "randomness". @@ -1248,7 +1353,7 @@ FloatValue = rand:uniform(). % again <p> The state returned from this function cannot be used to get a reproducable random sequence as from - the other + the other <seealso marker="stdlib:rand">rand</seealso> functions, since reproducability does not match cryptographically safe. @@ -1332,68 +1437,6 @@ FloatValue = rand:uniform(). % again </func> <func> - <name name="stream_init" arity="2" since="OTP R16B01"/> - <fsummary></fsummary> - <desc> - <p>Initializes the state for use in RC4 stream encryption - <seealso marker="#stream_encrypt-2">stream_encrypt</seealso> and - <seealso marker="#stream_decrypt-2">stream_decrypt</seealso></p> - <p>For keylengths see the - <seealso marker="crypto:algorithm_details#stream-ciphers">User's Guide</seealso>. - </p> - </desc> - </func> - - <func> - <name name="stream_init" arity="3" since="OTP R16B01"/> - <fsummary></fsummary> - <desc> - <p>Initializes the state for use in streaming AES encryption using Counter mode (CTR). - <c>Key</c> is the AES key and must be either 128, 192, or 256 bits long. <c>IVec</c> is - an arbitrary initializing vector of 128 bits (16 bytes). This state is for use with - <seealso marker="#stream_encrypt-2">stream_encrypt</seealso> and - <seealso marker="#stream_decrypt-2">stream_decrypt</seealso>.</p> - <p>For keylengths and iv-sizes see the - <seealso marker="crypto:algorithm_details#stream-ciphers">User's Guide</seealso>. - </p> - </desc> - </func> - - <func> - <name name="stream_encrypt" arity="2" since="OTP R16B01"/> - <fsummary></fsummary> - <desc> - <p>Encrypts <c>PlainText</c> according to the stream cipher <c>Type</c> specified in stream_init/3. - <c>Text</c> can be any number of bytes. The initial <c>State</c> is created using - <seealso marker="#stream_init-2">stream_init</seealso>. - <c>NewState</c> must be passed into the next call to <c>stream_encrypt</c>.</p> - </desc> - </func> - - <func> - <name name="stream_decrypt" arity="2" since="OTP R16B01"/> - <fsummary></fsummary> - <desc> - <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_decrypt</c>.</p> - </desc> - </func> - - <func> - <name name="supports" arity="0" since="OTP R16B01"/> - <fsummary>Provide a list of available crypto algorithms.</fsummary> - <desc> - <p> Can be used to determine which crypto algorithms that are supported - by the underlying libcrypto library</p> - <p>See <seealso marker="#hash_info-1">hash_info/1</seealso> and <seealso marker="#cipher_info-1">cipher_info/1</seealso> - for information about the hash and cipher algorithms. - </p> - </desc> - </func> - - <func> <name name="ec_curves" arity="0" since="OTP 17.0"/> <fsummary>Provide a list of available named elliptic curves.</fsummary> <desc> @@ -1440,6 +1483,12 @@ FloatValue = rand:uniform(). % again </desc> </func> + </funcs> + <section> + <title>Engine API</title> + </section> + + <funcs> <!-- Engine functions --> <func> <name name="privkey_to_pubkey" arity="2" since="OTP 20.2"/> @@ -1752,5 +1801,167 @@ FloatValue = rand:uniform(). % again </funcs> +<section> + <title>Old API</title> +</section> + + <funcs> + <func> + <name name="block_encrypt" arity="3" since="OTP 18.0"/> + <fsummary>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher</fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the-new-api</seealso>.</p></dont> + <p>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher.</p> + <p>May raise exception <c>error:notsup</c> in case the chosen <c>Type</c> + is not supported by the underlying libcrypto implementation.</p> + <p>For keylengths and blocksizes see the + <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + </p> + </desc> + </func> + + <func> + <name name="block_decrypt" arity="3" since="OTP 18.0"/> + <fsummary>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher</fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p>Decrypt <c>CipherText</c> according to <c>Type</c> block cipher.</p> + <p>May raise exception <c>error:notsup</c> in case the chosen <c>Type</c> + is not supported by the underlying libcrypto implementation.</p> + <p>For keylengths and blocksizes see the + <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + </p> + </desc> + </func> + + <func> + <name since="OTP R16B01">block_encrypt(Type, Key, Ivec, PlainText) -> CipherText | Error</name> + <name since="OTP R16B01">block_encrypt(AeadType, Key, Ivec, {AAD, PlainText}) -> {CipherText, CipherTag} | Error</name> + <name since="OTP R16B01">block_encrypt(aes_gcm | aes_ccm, Key, Ivec, {AAD, PlainText, TagLength}) -> {CipherText, CipherTag} | Error </name> + <fsummary>Encrypt <c>PlainText</c> according to <c>Type</c> block cipher</fsummary> + <type> + <v>Type = <seealso marker="#type-block_cipher_with_iv">block_cipher_with_iv()</seealso></v> + <v>AeadType = <seealso marker="#type-aead_cipher">aead_cipher()</seealso></v> + <v>Key = <seealso marker="#type-key">key()</seealso> | <seealso marker="#type-des3_key">des3_key()</seealso></v> + <v>PlainText = iodata()</v> + <v>AAD = IVec = CipherText = CipherTag = binary()</v> + <v>TagLength = 1..16</v> + <v>Error = <seealso marker="#type-run_time_error">run_time_error()</seealso></v> + </type> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <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 raise exception <c>error:notsup</c> in case the chosen <c>Type</c> + is not supported by the underlying libcrypto implementation.</p> + <p>For keylengths, iv-sizes and blocksizes see the + <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + </p> + </desc> + </func> + + <func> + <name since="OTP R16B01">block_decrypt(Type, Key, Ivec, CipherText) -> PlainText | Error</name> + <name since="OTP R16B01">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 = <seealso marker="#type-block_cipher_with_iv">block_cipher_with_iv()</seealso></v> + <v>AeadType = <seealso marker="#type-aead_cipher">aead_cipher()</seealso></v> + <v>Key = <seealso marker="#type-key">key()</seealso> | <seealso marker="#type-des3_key">des3_key()</seealso></v> + <v>PlainText = iodata()</v> + <v>AAD = IVec = CipherText = CipherTag = binary()</v> + <v>Error = BadTag | <seealso marker="#type-run_time_error">run_time_error()</seealso></v> + <v>BadTag = error</v> + </type> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <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 raise exception <c>error:notsup</c> in case the chosen <c>Type</c> + is not supported by the underlying libcrypto implementation.</p> + <p>For keylengths, iv-sizes and blocksizes see the + <seealso marker="crypto:algorithm_details#ciphers">User's Guide</seealso>. + </p> + </desc> + </func> + + <func> + <name name="stream_init" arity="2" since="OTP R16B01"/> + <fsummary></fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p>Initializes the state for use in RC4 stream encryption + <seealso marker="#stream_encrypt-2">stream_encrypt</seealso> and + <seealso marker="#stream_decrypt-2">stream_decrypt</seealso></p> + <p>For keylengths see the + <seealso marker="crypto:algorithm_details#stream-ciphers">User's Guide</seealso>. + </p> + </desc> + </func> + + <func> + <name name="stream_init" arity="3" since="OTP R16B01"/> + <fsummary></fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p>Initializes the state for use in streaming AES encryption using Counter mode (CTR). + <c>Key</c> is the AES key and must be either 128, 192, or 256 bits long. <c>IVec</c> is + an arbitrary initializing vector of 128 bits (16 bytes). This state is for use with + <seealso marker="#stream_encrypt-2">stream_encrypt</seealso> and + <seealso marker="#stream_decrypt-2">stream_decrypt</seealso>.</p> + <p>For keylengths and iv-sizes see the + <seealso marker="crypto:algorithm_details#stream-ciphers">User's Guide</seealso>. + </p> + </desc> + </func> + + <func> + <name name="stream_encrypt" arity="2" since="OTP R16B01"/> + <fsummary></fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p>Encrypts <c>PlainText</c> according to the stream cipher <c>Type</c> specified in stream_init/3. + <c>Text</c> can be any number of bytes. The initial <c>State</c> is created using + <seealso marker="#stream_init-2">stream_init</seealso>. + <c>NewState</c> must be passed into the next call to <c>stream_encrypt</c>.</p> + </desc> + </func> + + <func> + <name name="stream_decrypt" arity="2" since="OTP R16B01"/> + <fsummary></fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <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_decrypt</c>.</p> + </desc> + </func> + + <func> + <name name="supports" arity="0" since="OTP R16B01"/> + <fsummary>Provide a list of available crypto algorithms.</fsummary> + <desc> + <dont><p>Don't use this function for new programs! Use + <seealso marker="crypto#supports-1">supports/1</seealso> in + <seealso marker="crypto:new_api">the new api</seealso>.</p></dont> + <p> Can be used to determine which crypto algorithms that are supported + by the underlying libcrypto library</p> + <p>See <seealso marker="#hash_info-1">hash_info/1</seealso> and <seealso marker="#cipher_info-1">cipher_info/1</seealso> + for information about the hash and cipher algorithms. + </p> + </desc> + </func> + + </funcs> + </erlref> diff --git a/lib/crypto/doc/src/new_api.xml b/lib/crypto/doc/src/new_api.xml new file mode 100644 index 0000000000..bd2334ac9f --- /dev/null +++ b/lib/crypto/doc/src/new_api.xml @@ -0,0 +1,260 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2014</year><year>2019</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + </legalnotice> + + <title>New and Old API</title> + <prepared>Hans Nilsson</prepared> + <docno></docno> + <date>2019-08-22</date> + <rev>A</rev> + <file>new_api.xml</file> + </header> + <p> + This chapter describes the new api to encryption and decryption. + </p> + + <section> + <title>Background</title> + <p>The CRYPTO app has evolved during its lifetime. Since also the OpenSSL cryptolib has changed the + API several times, there are parts of the CRYPTO app that uses a very old one internally and + other parts that uses the latest one. The internal definitions of e.g cipher names was a bit hard + to maintain. + </p> + <p>It turned out that using the old api in the new way (more about that later), and still keep it + backwards compatible, was not possible. Specially as more precision in the error messages was wanted + it could not be combined with the old standard. + </p> + <p>Therefore the old api (see next section) is kept for now but internally implemented with new primitives. + </p> + </section> + + <section> + <title>The old API</title> + <p>The old functions - not recommended for new programs - are:</p> + <list> + <item><seealso marker="crypto#block_encrypt-3">block_encrypt/3</seealso></item> + <item><seealso marker="crypto#block_encrypt-4">block_encrypt/4</seealso></item> + <item><seealso marker="crypto#block_decrypt-3">block_decrypt/3</seealso></item> + <item><seealso marker="crypto#block_decrypt-4">block_decrypt/4</seealso></item> + <item><seealso marker="crypto#stream_init-2">stream_init/2</seealso></item> + <item><seealso marker="crypto#stream_init-2">stream_init/3</seealso></item> + <item><seealso marker="crypto#stream_encrypt-2">stream_encrypt/2</seealso></item> + <item><seealso marker="crypto#stream_decrypt-2">stream_decrypt/2</seealso></item> + <item><seealso marker="crypto#supports-0">supports/0</seealso></item> + </list> + <p>They are not deprecated for now, but may be in a future release. + </p> + </section> + + <section> + <title>The new API</title> + <p>The new functions for encrypting or decrypting one single binary are: + </p> + <list> + <item><seealso marker="crypto#crypto_one_time/4">crypto_one_time/4</seealso></item> + <item><seealso marker="crypto#crypto_one_time/5">crypto_one_time/5</seealso></item> + <item><seealso marker="crypto#crypto_one_time_aead/6">crypto_one_time_aead/6</seealso></item> + <item><seealso marker="crypto#crypto_one_time_aead/7">crypto_one_time_aead/7</seealso></item> + </list> + <p>In those functions the internal crypto state is first created and initialized + with the cipher type, the key and possibly other data. Then the single binary is encrypted + or decrypted, + the crypto state is de-allocated and the result of the crypto operation is returned. + </p> + <p>The <c>crypto_one_time_aead</c> functions are for the ciphers of mode <c>ccm</c> or + <c>gcm</c>, and for the cipher <c>chacha20-poly1305</c>. + </p> + <p>For repeated encryption or decryption of a text divided in parts, where the internal + crypto state is initialized once, and then many binaries are encrypted or decrypted with + the same state, the functions are: + </p> + <list> + <item><seealso marker="crypto#crypto_init/4">crypto_init/4</seealso></item> + <item><seealso marker="crypto#crypto_init/3">crypto_init/3</seealso></item> + <item><seealso marker="crypto#crypto_update/2">crypto_update/2</seealso></item> + </list> + <p>The <c>crypto_init</c> initialies an internal cipher state, and one or more calls of + <c>crypto_update</c> does the acual encryption or decryption. Note that AEAD ciphers + can't be handled this way due to their nature. + </p> + <p>For repeated encryption or decryption of a text divided in parts where the + same cipher and same key is used, but a new initialization vector (nounce) should be applied + for each part, the functions are: + </p> + <list> + <item><seealso marker="crypto#crypto_dyn_iv_init/3">crypto_dyn_iv_init/3</seealso></item> + <item><seealso marker="crypto#crypto_dyn_iv_update/3">crypto_dyn_iv_update/3</seealso></item> + </list> + <p>An example of where those functions are needed, is when handling the TLS protocol.</p> + <p>For information about available algorithms, use: + </p> + <list> + <item><seealso marker="crypto#supports-1">supports/1</seealso></item> + <item><seealso marker="crypto#hash_info-1">hash_info/1</seealso></item> + <item><seealso marker="crypto#cipher_info-1">cipher_info/1</seealso></item> + </list> + + <section> + <title>Examples of crypto_init/4 and crypto_update/2</title> + <p>The functions <seealso marker="crypto#crypto_init/4">crypto_init/4</seealso> + and <seealso marker="crypto#crypto_update/2">crypto_update/2</seealso> are intended + to be used for encrypting or decrypting a sequence of blocks. First one call of + <c>crypto_init/4</c> initialises the crypto context. One or more calls <c>crypto_update/2</c> + does the actual encryption or decryption for each block. + </p> + <p>This example shows first the encryption of two blocks and then decryptions of the cipher + text, but divided into three blocks just to show that it is possible to divide the plain text and + cipher text differently for some ciphers:</p> + <code type="erl"> + 1> crypto:start(). + ok + 2> Key = <<1:128>>. + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1>> + 3> IV = <<0:128>>. + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0>> + 4> StateEnc = crypto:crypto_init(aes_128_ctr, Key, IV, true). % encrypt -> true + #Ref<0.3768901617.1128660993.124047> + 5> crypto:crypto_update(StateEnc, <<"First bytes">>). + <<67,44,216,166,25,130,203,5,66,6,162>> + 6> crypto:crypto_update(StateEnc, <<"Second bytes">>). + <<16,79,94,115,234,197,94,253,16,144,151,41>> + 7> + 7> StateDec = crypto:crypto_init(aes_128_ctr, Key, IV, false). % decrypt -> false + #Ref<0.3768901617.1128660994.124255> + 8> crypto:crypto_update(StateDec, <<67,44,216,166,25,130,203>>). + <<"First b">> + 9> crypto:crypto_update(StateDec, <<5,66,6,162,16,79,94,115,234,197, + 94,253,16,144,151>>). + <<"ytesSecond byte">> + 10> crypto:crypto_update(StateDec, <<41>>). + <<"s">> + 11> + </code> + <p>Note that the internal data that the <c>StateEnc</c> and <c>StateDec</c> references are + destructivly updated by the calls to <seealso marker="crypto#crypto_update/2">crypto_update/2</seealso>. + This is to gain time in the calls of the nifs interfacing the cryptolib. In a loop where the + state is saved in the loop's state, it also saves one update of the loop state per crypto operation. + </p> + <p>For example, a simple server receiving text parts to encrypt and send the result back to the + one who sent them (the <c>Requester</c>): + </p> + <code type="erl"> + encode(Crypto, Key, IV) -> + crypto_loop(crypto:crypto_init(Crypto, Key, IV, true)). + + crypto_loop(State) -> + receive + {Text, Requester} -> + Requester ! crypto:crypto_update(State, Text), + loop(State) + end. + </code> + </section> + + <section> + <title>Example of crypto_one_time/5</title> + <p>The same example as in the + <seealso marker="#examples-of-crypto_init-4-and-crypto_update-2">previous section</seealso>, + but now with one call to <seealso marker="crypto#crypto_one_time/5">crypto_one_time/5</seealso>: + </p> + <code> + 1> Key = <<1:128>>. + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1>> + 2> IV = <<0:128>>. + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0>> + 3> Txt = [<<"First bytes">>,<<"Second bytes">>]. + [<<"First bytes">>,<<"Second bytes">>] + 4> crypto:crypto_one_time(aes_128_ctr, Key, IV, Txt, true). + <<67,44,216,166,25,130,203,5,66,6,162,16,79,94,115,234, + 197,94,253,16,144,151,41>> + 5> + </code> + <p>The <c>[<<"First bytes">>,<<"Second bytes">>]</c> could of course have been one + single binary: <c><<"First bytesSecond bytes">></c>. + </p> + </section> + + <section> + <title>Example of crypto_one_time_aead/6</title> + <p>The same example as in the + <seealso marker="#example-of-crypto_one_time-5">previous section</seealso>, + but now with one call to <seealso marker="crypto#crypto_one_time_aead/6">crypto_one_time_aead/6</seealso>: + </p> + <code> + 1> Key = <<1:128>>. + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1>> + 2> IV = <<0:128>>. + <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0>> + 3> Txt = [<<"First bytes">>,<<"Second bytes">>]. + [<<"First bytes">>,<<"Second bytes">>] + 4> AAD = <<"Some bytes">>. + <<"Some bytes">> + 5> crypto:crypto_one_time_aead(aes_128_gcm, Key, IV, Txt, AAD, true). + {<<240,130,38,96,130,241,189,52,3,190,179,213,132,1,72, + 192,103,176,90,104,15,71,158>>, + <<131,47,45,91,142,85,9,244,21,141,214,71,31,135,2,155>>} + 9> + </code> + <p>The <c>[<<"First bytes">>,<<"Second bytes">>]</c> could of course have been one + single binary: <c><<"First bytesSecond bytes">></c>. + </p> + </section> + + </section> + + <section> + <title>Retired cipher names</title> + <p>This table lists the retired cipher names in the first column and suggests names to replace them with + in the second column. + </p> + <p>The new names follows the OpenSSL libcrypto names. The format is ALGORITM_KEYSIZE_MODE. + </p> + <p>Examples of algorithms are aes, chacha20 and des. The keysize is the number of bits + and examples of the mode are cbc, ctr and gcm. The mode may be followed by a number depending + on the mode. An example is the ccm mode which has a variant called ccm8 where the so called tag + has a length of eight bits. + </p> + <p>The old names had by time lost any common naming which the new names now introduces. The new names include + the key length which improves the error checking in the lower levels of the crypto application. + </p> + + <table> + <row><cell><strong>Instead of:</strong></cell> <cell><strong>Use:</strong> </cell></row> + + <row><cell><c>aes_cbc128</c> </cell> <cell> <c>aes_128_cbc</c> </cell></row> + <row><cell><c>aes_cbc256</c> </cell> <cell> <c>aes_256_cbc</c> </cell></row> + <row><cell><c>aes_cbc</c> </cell> <cell> <c>aes_128_cbc, aes_192_cbc, aes_256_cbc</c></cell></row> + <row><cell><c>aes_ccm</c> </cell> <cell> <c>aes_128_ccm, aes_192_ccm, aes_256_ccm</c></cell></row> + <row><cell><c>aes_cfb128</c> </cell> <cell> <c>aes_128_cfb128, aes_192_cfb128, aes_256_cfb128</c></cell></row> + <row><cell><c>aes_cfb8</c> </cell> <cell> <c>aes_128_cfb8, aes_192_cfb8, aes_256_cfb8</c></cell></row> + <row><cell><c>aes_ctr</c> </cell> <cell> <c>aes_128_ctr, aes_192_ctr, aes_256_ctr</c></cell></row> + <row><cell><c>aes_gcm</c> </cell> <cell> <c>aes_128_gcm, aes_192_gcm, aes_256_gcm</c></cell></row> + <row><cell><c>des3_cbc</c> </cell> <cell> <c>des_ede3_cbc</c></cell></row> + <row><cell><c>des3_cbf</c> </cell> <cell> <c>des_ede3_cfb</c></cell></row> + <row><cell><c>des3_cfb</c> </cell> <cell> <c>des_ede3_cfb</c></cell></row> + <row><cell><c>des_ede3</c> </cell> <cell> <c>des_ede3_cbc</c></cell></row> + <row><cell><c>des_ede3_cbf</c> </cell> <cell> <c>des_ede3_cfb</c></cell></row> + <tcaption></tcaption> + </table> + </section> + +</chapter> diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index c0b302734e..195c9d029d 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -31,6 +31,22 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 4.4.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed build link error on Windows. Unresolved symbol + 'bcmp'.</p> + <p> + Own Id: OTP-15750 Aux Id: ERL-905 </p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 4.4.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/crypto/doc/src/usersguide.xml b/lib/crypto/doc/src/usersguide.xml index 2dfc966609..134f900d4c 100644 --- a/lib/crypto/doc/src/usersguide.xml +++ b/lib/crypto/doc/src/usersguide.xml @@ -51,4 +51,5 @@ <xi:include href="engine_load.xml"/> <xi:include href="engine_keys.xml"/> <xi:include href="algorithm_details.xml"/> + <xi:include href="new_api.xml"/> </part> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index fd13481951..8ffdde2b90 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -58,9 +58,11 @@ %% New interface -export([crypto_init/4, crypto_init/3, crypto_update/2, - crypto_one_shot/5, - crypto_init_dyn_iv/3, - crypto_update_dyn_iv/3 + crypto_one_time/4, crypto_one_time/5, + crypto_one_time_aead/6, crypto_one_time_aead/7, + crypto_dyn_iv_init/3, + crypto_dyn_iv_update/3, + supports/1 ]). @@ -276,48 +278,153 @@ -type edwards_curve_ed() :: ed25519 | ed448 . -%%% --type cipher() :: block_cipher() - | stream_cipher() - | aead_cipher() . +%%%---------------------------------------------------------------- +%%% New cipher schema +%%% +-type cipher() :: cipher_no_iv() + | cipher_iv() + | cipher_aead() . --type block_cipher() :: block_cipher_iv() | block_cipher_no_iv() . +-type cipher_no_iv() :: aes_128_ecb + | aes_192_ecb + | aes_256_ecb --type block_cipher_iv() :: cbc_cipher() - | cfb_cipher() - | aes_ige256 - | blowfish_ofb64 - | rc2_cbc . + | blowfish_ecb + | des_ecb + | rc4 . --type cbc_cipher() :: des_cbc | des_ede3_cbc - | blowfish_cbc - | aes_cbc | aes_128_cbc | aes_192_cbc | aes_256_cbc - | alias_cbc() . --type alias_cbc() :: des3_cbc | des_ede3 - | aes_cbc128 | aes_cbc256 . +-type cipher_iv() :: aes_128_cbc + | aes_192_cbc + | aes_256_cbc + + | aes_128_cfb128 + | aes_192_cfb128 + | aes_256_cfb128 + + | aes_128_cfb8 + | aes_192_cfb8 + | aes_256_cfb8 + + | aes_128_ctr + | aes_192_ctr + | aes_256_ctr + + | aes_ige256 --type aead_cipher() :: aes_gcm + | blowfish_cbc + | blowfish_cfb64 + | blowfish_ofb64 + | chacha20 + | des_ede3_cbc + | des_ede3_cfb + + | des_cbc + | des_cfb + | rc2_cbc . + + +-type cipher_aead() :: aes_128_ccm + | aes_192_ccm + | aes_256_ccm + | aes_128_gcm | aes_192_gcm | aes_256_gcm - | aes_ccm - | aes_128_ccm - | aes_192_ccm - | aes_256_ccm + | chacha20_poly1305 . --type cfb_cipher() :: aes_cfb8 - | aes_cfb128 - | blowfish_cfb64 - | des_cfb - | des_ede3_cfb - | alias_cfb() . --type alias_cfb() :: des_ede3_cbf | des3_cbf - | des3_cfb . +%% -type retired_cipher_no_iv_aliases() :: aes_ecb . + +%% -type retired_cipher_iv_aliases() :: aes_cbc +%% | aes_cbc128 % aes_128_cbc +%% | aes_cbc256 % aes_256_cbc +%% | aes_cfb128 +%% | aes_cfb8 +%% | aes_ctr +%% | des3_cbc % des_ede3_cbc +%% | des_ede3 % des_ede3_cbc +%% | des_ede3_cbf % des_ede3_cfb +%% | des3_cbf % des_ede3_cfb +%% | des3_cfb . % des_ede3_cfb + +%% -type retired_cipher_aead_aliases() :: aes_ccm +%% | aes_gcm . --type block_cipher_no_iv() :: ecb_cipher() . --type ecb_cipher() :: des_ecb | blowfish_ecb | aes_ecb . +%%%---------------------------------------------------------------- +%%% Old cipher scheme +%%% +%%% +-type block_cipher_without_iv() :: ecb_cipher() . + +-type block_cipher_with_iv() :: cbc_cipher() + | cfb_cipher() + | blowfish_ofb64 + | aes_ige256 . + +-type stream_cipher() :: ctr_cipher() + | chacha20 + | rc4 . + + +%%%---- +-type cbc_cipher() :: aes_128_cbc + | aes_192_cbc + | aes_256_cbc + | blowfish_cbc + | des_cbc + | des_ede3_cbc + | rc2_cbc + | retired_cbc_cipher_aliases() . + +-type retired_cbc_cipher_aliases() :: aes_cbc % aes_*_cbc + | aes_cbc128 % aes_128_cbc + | aes_cbc256 % aes_256_cbc + | des3_cbc % des_ede3_cbc + | des_ede3 . % des_ede3_cbc + +%%%---- +-type cfb_cipher() :: aes_128_cfb128 + | aes_192_cfb128 + | aes_256_cfb128 + | aes_128_cfb8 + | aes_192_cfb8 + | aes_256_cfb8 + | blowfish_cfb64 + | des_cfb + | des_ede3_cfb + | retired_cfb_cipher_aliases() . + +-type retired_cfb_cipher_aliases() :: aes_cfb8 % aes_*_cfb8 + | aes_cfb128 % aes_*_cfb128 + | des3_cbf % des_ede3_cfb, cfb misspelled + | des3_cfb % des_ede3_cfb + | des_ede3_cbf .% cfb misspelled + + +%%%---- +-type ctr_cipher() :: aes_128_ctr + | aes_192_ctr + | aes_256_ctr + | retired_ctr_cipher_aliases() . + +-type retired_ctr_cipher_aliases() :: aes_ctr . % aes_*_ctr + +%%%---- +-type ecb_cipher() :: aes_128_ecb + | aes_192_ecb + | aes_256_ecb + | blowfish_ecb + | retired_ecb_cipher_aliases() . + +-type retired_ecb_cipher_aliases() :: aes_ecb . + +%%%---- +-type aead_cipher() :: aes_gcm | aes_ccm | chacha20_poly1305 . + + +%%%----- end old cipher schema ------------------------------------ +%%%---------------------------------------------------------------- -type key() :: iodata(). -type des3_key() :: [key()]. @@ -393,15 +500,43 @@ stop() -> Macs :: [hmac | cmac | poly1305], Curves :: [ec_named_curve() | edwards_curve_dh() | edwards_curve_ed()], RSAopts :: [rsa_sign_verify_opt() | rsa_opt()] . -supports()-> - {Hashs, PubKeys, Ciphers, Macs, Curves, RsaOpts} = algorithms(), - [{hashs, Hashs}, - {ciphers, prepend_cipher_aliases(Ciphers)}, - {public_keys, PubKeys}, - {macs, Macs}, - {curves, Curves}, - {rsa_opts, RsaOpts} - ]. +supports() -> + [{hashs, hash_algorithms()}, + {ciphers, prepend_old_aliases( cipher_algorithms())}, + {public_keys, pubkey_algorithms()}, + {macs, mac_algorithms()}, + {curves, curve_algorithms()}, + {rsa_opts, rsa_opts_algorithms()} + ]. + + +-spec supports(Type) -> Support + when Type :: hashs + | ciphers + | public_keys + | macs + | curves + | rsa_opts, + Support :: Hashs + | Ciphers + | PKs + | Macs + | Curves + | RSAopts, + Hashs :: [sha1() | sha2() | sha3() | blake2() | ripemd160 | compatibility_only_hash()], + Ciphers :: [cipher()], + PKs :: [rsa | dss | ecdsa | dh | ecdh | ec_gf2m], + Macs :: [hmac | cmac | poly1305], + Curves :: [ec_named_curve() | edwards_curve_dh() | edwards_curve_ed()], + RSAopts :: [rsa_sign_verify_opt() | rsa_opt()] . + +supports(hashs) -> hash_algorithms(); +supports(public_keys) -> pubkey_algorithms(); +supports(ciphers) -> cipher_algorithms(); +supports(macs) -> mac_algorithms(); +supports(curves) -> curve_algorithms(); +supports(rsa_opts) -> rsa_opts_algorithms(). + -spec info_lib() -> [{Name,VerNum,VerStr}] when Name :: binary(), VerNum :: integer(), @@ -564,9 +699,9 @@ poly1305(Key, Data) -> -define(COMPAT(CALL), try begin CALL end catch - error:{error,_} -> + error:{error, {_File,_Line}, _Reason} -> error(badarg); - error:{E,_Reason} when E==notsup ; E==badarg -> + error:{E, {_File,_Line}, _Reason} when E==notsup ; E==badarg -> error(E) end). @@ -594,7 +729,7 @@ poly1305(Key, Data) -> | xts_mode . -%% These ciphers are not available via the EVP interface on older cryptolibs. +%% %% These ciphers are not available via the EVP interface on older cryptolibs. cipher_info(aes_ctr) -> #{block_size => 1,iv_length => 16,key_length => 32,mode => ctr_mode,type => undefined}; cipher_info(aes_128_ctr) -> @@ -603,15 +738,42 @@ cipher_info(aes_192_ctr) -> #{block_size => 1,iv_length => 16,key_length => 24,mode => ctr_mode,type => undefined}; cipher_info(aes_256_ctr) -> #{block_size => 1,iv_length => 16,key_length => 32,mode => ctr_mode,type => undefined}; -%% This cipher is handled specialy. +%% %% This cipher is handled specialy. cipher_info(aes_ige256) -> #{block_size => 16,iv_length => 32,key_length => 16,mode => ige_mode,type => undefined}; +%% %% These ciphers belong to the "old" interface: +%% cipher_info(aes_cbc) -> +%% #{block_size => 16,iv_length => 16,key_length => 24,mode => cbc_mode,type => 423}; +%% cipher_info(aes_cbc128) -> +%% #{block_size => 16,iv_length => 16,key_length => 16,mode => cbc_mode,type => 419}; +%% cipher_info(aes_cbc256) -> +%% #{block_size => 16,iv_length => 16,key_length => 32,mode => cbc_mode,type => 427}; +%% cipher_info(aes_ccm) -> +%% #{block_size => 1,iv_length => 12,key_length => 24,mode => ccm_mode,type => 899}; +%% cipher_info(aes_cfb128) -> +%% #{block_size => 1,iv_length => 16,key_length => 32,mode => cfb_mode,type => 429}; +%% cipher_info(aes_cfb8) -> +%% #{block_size => 1,iv_length => 16,key_length => 32,mode => cfb_mode,type => 429}; +%% cipher_info(aes_ecb) -> +%% #{block_size => 16,iv_length => 0,key_length => 24,mode => ecb_mode,type => 422}; +%% cipher_info(aes_gcm) -> +%% #{block_size => 1,iv_length => 12,key_length => 24,mode => gcm_mode,type => 898}; +%% cipher_info(des3_cbc) -> +%% #{block_size => 8,iv_length => 8,key_length => 24,mode => cbc_mode,type => 44}; +%% cipher_info(des3_cbf) -> +%% #{block_size => 1,iv_length => 8,key_length => 24,mode => cfb_mode,type => 30}; +%% cipher_info(des3_cfb) -> +%% #{block_size => 1,iv_length => 8,key_length => 24,mode => cfb_mode,type => 30}; +%% cipher_info(des_ede3) -> +%% #{block_size => 8,iv_length => 8,key_length => 24,mode => cbc_mode,type => 44}; +%% cipher_info(des_ede3_cbf) -> +%% #{block_size => 1,iv_length => 8,key_length => 24,mode => cfb_mode,type => 30}; cipher_info(Type) -> cipher_info_nif(alias(Type)). %%%---- Block ciphers %%%---------------------------------------------------------------- --spec block_encrypt(Type::block_cipher_iv(), Key::key()|des3_key(), Ivec::binary(), PlainText::iodata()) -> +-spec block_encrypt(Type::block_cipher_with_iv(), Key::key()|des3_key(), Ivec::binary(), PlainText::iodata()) -> binary() | run_time_error(); (Type::aead_cipher(), Key::iodata(), Ivec::binary(), {AAD::binary(), PlainText::iodata()}) -> {binary(), binary()} | run_time_error(); @@ -627,34 +789,24 @@ block_encrypt(Type, Key0, Ivec, Data) -> ?COMPAT( case Data of {AAD, PlainText} -> - aead_encrypt(alias(Type,Key), Key, Ivec, AAD, PlainText, aead_tag_len(Type)); + crypto_one_time_aead(alias(Type,Key), Key, Ivec, PlainText, AAD, true); {AAD, PlainText, TagLength} -> - aead_encrypt(alias(Type,Key), Key, Ivec, AAD, PlainText, TagLength); + crypto_one_time_aead(alias(Type,Key), Key, Ivec, PlainText, AAD, TagLength, true); PlainText -> - crypto_one_shot(alias(Type,Key), Key, Ivec, PlainText, true) + crypto_one_time(alias(Type,Key), Key, Ivec, PlainText, true) end). --spec block_encrypt(Type::block_cipher_no_iv(), Key::key(), PlainText::iodata()) -> +-spec block_encrypt(Type::block_cipher_without_iv(), Key::key(), PlainText::iodata()) -> binary() | run_time_error(). block_encrypt(Type, Key0, PlainText) -> Key = iolist_to_binary(Key0), - ?COMPAT(crypto_one_shot(alias(Type,Key), Key, <<>>, PlainText, true)). + ?COMPAT(crypto_one_time(alias(Type,Key), Key, PlainText, true)). -aead_tag_len(chacha20_poly1305) -> 16; -aead_tag_len(aes_ccm) -> 12; -aead_tag_len(aes_128_ccm) -> 12; -aead_tag_len(aes_192_ccm) -> 12; -aead_tag_len(aes_256_ccm) -> 12; -aead_tag_len(aes_gcm) -> 16; -aead_tag_len(aes_128_gcm) -> 16; -aead_tag_len(aes_192_gcm) -> 16; -aead_tag_len(aes_256_gcm) -> 16. - %%%---------------------------------------------------------------- %%%---------------------------------------------------------------- --spec block_decrypt(Type::block_cipher_iv(), Key::key()|des3_key(), Ivec::binary(), Data::iodata()) -> +-spec block_decrypt(Type::block_cipher_with_iv(), Key::key()|des3_key(), Ivec::binary(), Data::iodata()) -> binary() | run_time_error(); (Type::aead_cipher(), Key::iodata(), Ivec::binary(), {AAD::binary(), Data::iodata(), Tag::binary()}) -> @@ -668,18 +820,18 @@ block_decrypt(Type, Key0, Ivec, Data) -> ?COMPAT( case Data of {AAD, CryptoText, Tag} -> - aead_decrypt(alias(Type,Key), Key, Ivec, AAD, CryptoText, Tag); + crypto_one_time_aead(alias(Type,Key), Key, Ivec, CryptoText, AAD, Tag, false); CryptoText -> - crypto_one_shot(alias(Type,Key), Key, Ivec, CryptoText, false) + crypto_one_time(alias(Type,Key), Key, Ivec, CryptoText, false) end). --spec block_decrypt(Type::block_cipher_no_iv(), Key::key(), Data::iodata()) -> +-spec block_decrypt(Type::block_cipher_without_iv(), Key::key(), Data::iodata()) -> binary() | run_time_error(). block_decrypt(Type, Key0, CryptoText) -> Key = iolist_to_binary(Key0), - ?COMPAT(crypto_one_shot(alias(Type,Key), Key, <<>>, CryptoText, false)). + ?COMPAT(crypto_one_time(alias(Type,Key), Key, CryptoText, false)). %%%-------- Stream ciphers API @@ -687,17 +839,9 @@ block_decrypt(Type, Key0, CryptoText) -> crypto_state() | {crypto_state(),flg_undefined} }. --type stream_cipher() :: stream_cipher_iv() | stream_cipher_no_iv() . --type stream_cipher_no_iv() :: rc4 . --type stream_cipher_iv() :: aes_ctr - | aes_128_ctr - | aes_192_ctr - | aes_256_ctr - | chacha20 . - %%%---- stream_init -spec stream_init(Type, Key, IVec) -> State | run_time_error() - when Type :: stream_cipher_iv(), + when Type :: stream_cipher(), Key :: iodata(), IVec ::binary(), State :: stream_state() . @@ -711,7 +855,7 @@ stream_init(Type, Key0, IVec) when is_binary(IVec) -> -spec stream_init(Type, Key) -> State | run_time_error() - when Type :: stream_cipher_no_iv(), + when Type :: rc4, Key :: iodata(), State :: stream_state() . stream_init(rc4 = Type, Key0) -> @@ -792,38 +936,35 @@ next_iv(Type, Data, _Ivec) -> %%% -spec crypto_init(Cipher, Key, EncryptFlag) -> State | descriptive_error() - when Cipher :: block_cipher_no_iv() - | stream_cipher_no_iv(), + when Cipher :: cipher_no_iv(), Key :: iodata(), EncryptFlag :: boolean(), State :: crypto_state() . crypto_init(Cipher, Key, EncryptFlag) -> %% The IV is supposed to be supplied by calling crypto_update/3 - ng_crypto_init_nif(alias(Cipher), iolist_to_binary(Key), <<>>, EncryptFlag). + ng_crypto_init_nif(Cipher, iolist_to_binary(Key), <<>>, EncryptFlag). -spec crypto_init(Cipher, Key, IV, EncryptFlag) -> State | descriptive_error() - when Cipher :: stream_cipher_iv() - | block_cipher_iv(), + when Cipher :: cipher_iv(), Key :: iodata(), IV :: iodata(), EncryptFlag :: boolean(), State :: crypto_state() . crypto_init(Cipher, Key, IV, EncryptFlag) -> - ng_crypto_init_nif(alias(Cipher), iolist_to_binary(Key), iolist_to_binary(IV), EncryptFlag). + ng_crypto_init_nif(Cipher, iolist_to_binary(Key), iolist_to_binary(IV), EncryptFlag). %%%---------------------------------------------------------------- --spec crypto_init_dyn_iv(Cipher, Key, EncryptFlag) -> State | descriptive_error() - when Cipher :: stream_cipher_iv() - | block_cipher_iv(), +-spec crypto_dyn_iv_init(Cipher, Key, EncryptFlag) -> State | descriptive_error() + when Cipher :: cipher_iv(), Key :: iodata(), EncryptFlag :: boolean(), State :: crypto_state() . -crypto_init_dyn_iv(Cipher, Key, EncryptFlag) -> +crypto_dyn_iv_init(Cipher, Key, EncryptFlag) -> %% The IV is supposed to be supplied by calling crypto_update/3 - ng_crypto_init_nif(alias(Cipher), iolist_to_binary(Key), undefined, EncryptFlag). + ng_crypto_init_nif(Cipher, iolist_to_binary(Key), undefined, EncryptFlag). %%%---------------------------------------------------------------- %%% @@ -846,12 +987,12 @@ crypto_update(State, Data0) -> %%%---------------------------------------------------------------- --spec crypto_update_dyn_iv(State, Data, IV) -> Result | descriptive_error() +-spec crypto_dyn_iv_update(State, Data, IV) -> Result | descriptive_error() when State :: crypto_state(), Data :: iodata(), IV :: iodata(), Result :: binary() . -crypto_update_dyn_iv(State, Data0, IV) -> +crypto_dyn_iv_update(State, Data0, IV) -> %% When State is from State = crypto_init(Cipher, Key, undefined, EncryptFlag) case iolist_to_binary(Data0) of <<>> -> @@ -866,29 +1007,86 @@ crypto_update_dyn_iv(State, Data0, IV) -> %%% The size must be an integer multiple of the crypto's blocksize. %%% --spec crypto_one_shot(Cipher, Key, IV, Data, EncryptFlag) -> +-spec crypto_one_time(Cipher, Key, Data, EncryptFlag) -> Result | descriptive_error() - when Cipher :: stream_cipher() - | block_cipher(), + when Cipher :: cipher_no_iv(), Key :: iodata(), - IV :: iodata() | undefined, Data :: iodata(), EncryptFlag :: boolean(), Result :: binary() . -crypto_one_shot(Cipher, Key, undefined, Data, EncryptFlag) -> - crypto_one_shot(Cipher, Key, <<>>, Data, EncryptFlag); +crypto_one_time(Cipher, Key, Data, EncryptFlag) -> + crypto_one_time(Cipher, Key, <<>>, Data, EncryptFlag). + +-spec crypto_one_time(Cipher, Key, IV, Data, EncryptFlag) -> + Result | descriptive_error() + when Cipher :: cipher_iv(), + Key :: iodata(), + IV :: iodata(), + Data :: iodata(), + EncryptFlag :: boolean(), + Result :: binary() . -crypto_one_shot(Cipher, Key, IV, Data0, EncryptFlag) -> +crypto_one_time(Cipher, Key, IV, Data0, EncryptFlag) -> case iolist_to_binary(Data0) of <<>> -> <<>>; % Known to fail on OpenSSL 0.9.8h Data -> - ng_crypto_one_shot_nif(alias(Cipher), + ng_crypto_one_time_nif(Cipher, iolist_to_binary(Key), iolist_to_binary(IV), Data, EncryptFlag) end. + +-spec crypto_one_time_aead(Cipher, Key, IV, InText, AAD, EncFlag::true) -> + Result | descriptive_error() + when Cipher :: cipher_aead(), + Key :: iodata(), + IV :: iodata(), + InText :: iodata(), + AAD :: iodata(), + Result :: EncryptResult, + EncryptResult :: {OutCryptoText, OutTag}, + OutCryptoText :: binary(), + OutTag :: binary(). + +crypto_one_time_aead(Cipher, Key, IV, PlainText, AAD, true) -> + crypto_one_time_aead(Cipher, Key, IV, PlainText, AAD, aead_tag_len(Cipher), true). + + +-spec crypto_one_time_aead(Cipher, Key, IV, InText, AAD, TagOrTagLength, EncFlag) -> + Result | descriptive_error() + when Cipher :: cipher_aead(), + Key :: iodata(), + IV :: iodata(), + InText :: iodata(), + AAD :: iodata(), + TagOrTagLength :: EncryptTagLength | DecryptTag, + EncryptTagLength :: non_neg_integer(), % or pos_integer() 1.. + DecryptTag :: iodata(), + EncFlag :: boolean(), + Result :: EncryptResult | DecryptResult, + EncryptResult :: {OutCryptoText, OutTag}, + DecryptResult :: OutPlainText | error, + OutCryptoText :: binary(), + OutTag :: binary(), + OutPlainText :: binary(). + +crypto_one_time_aead(Cipher, Key, IV, TextIn, AAD, TagOrTagLength, EncFlg) -> + aead_cipher(Cipher, Key, IV, TextIn, AAD, TagOrTagLength, EncFlg). + + +aead_tag_len(chacha20_poly1305) -> 16; +aead_tag_len(aes_ccm ) -> 12; +aead_tag_len(aes_128_ccm) -> 12; +aead_tag_len(aes_192_ccm) -> 12; +aead_tag_len(aes_256_ccm) -> 12; +aead_tag_len(aes_gcm ) -> 16; +aead_tag_len(aes_128_gcm) -> 16; +aead_tag_len(aes_192_gcm) -> 16; +aead_tag_len(aes_256_gcm) -> 16; +aead_tag_len(_) -> error({badarg, "Not an AEAD cipher"}). + %%%---------------------------------------------------------------- %%% NIFs @@ -909,15 +1107,42 @@ ng_crypto_update_nif(_State, _Data) -> ?nif_stub. ng_crypto_update_nif(_State, _Data, _IV) -> ?nif_stub. --spec ng_crypto_one_shot_nif(atom(), binary(), binary(), binary(), boolean() ) -> +-spec ng_crypto_one_time_nif(atom(), binary(), binary(), binary(), boolean() ) -> binary() | descriptive_error(). -ng_crypto_one_shot_nif(_Cipher, _Key, _IVec, _Data, _EncryptFlg) -> ?nif_stub. +ng_crypto_one_time_nif(_Cipher, _Key, _IVec, _Data, _EncryptFlg) -> ?nif_stub. %%%---------------------------------------------------------------- %%% Cipher aliases %%% -prepend_cipher_aliases(L) -> - [des3_cbc, des_ede3, des_ede3_cbf, des3_cbf, des3_cfb, aes_cbc128, aes_cbc256 | L]. +-define(if_also(Cipher, Ciphers, AliasCiphers), + case lists:member(Cipher, Ciphers) of + true -> + AliasCiphers; + false -> + Ciphers + end). + + +prepend_old_aliases(L0) -> + L1 = ?if_also(des_ede3_cbc, L0, + [des3_cbc, des_ede3, des_ede3_cbf, des3_cbf, des3_cfb | L0]), + L2 = ?if_also(aes_128_cbc, L1, + [aes_cbc, aes_cbc128, aes_cbc256 | L1]), + L3 = ?if_also(aes_128_ctr, L2, + [aes_ctr | L2]), + L4 = ?if_also(aes_128_ccm, L3, + [aes_ccm | L3]), + L5 = ?if_also(aes_128_gcm, L4, + [aes_gcm | L4]), + L6 = ?if_also(aes_128_cfb8, L5, + [aes_cfb8 | L5]), + L7 = ?if_also(aes_128_cfb128, L6, + [aes_cfb128 | L6]), + L8 = ?if_also(aes_128_ecb, L7, + [aes_ecb | L7]), + L8. + + %%%---- des_ede3_cbc alias(des3_cbc) -> des_ede3_cbc; @@ -933,42 +1158,37 @@ alias(aes_cbc256) -> aes_256_cbc; alias(Alg) -> Alg. -%%%---- des_ede3_cbc -alias(des3_cbc, _) -> des_ede3_cbc; -alias(des_ede3, _) -> des_ede3_cbc; -%%%---- des_ede3_cfb -alias(des_ede3_cbf,_ ) -> des_ede3_cfb; -alias(des3_cbf, _) -> des_ede3_cfb; -alias(des3_cfb, _) -> des_ede3_cfb; -%%%---- aes_*_cbc -alias(aes_cbc128, _) -> aes_128_cbc; -alias(aes_cbc256, _) -> aes_256_cbc; +alias(Ciph, Key) -> alias2(alias(Ciph), Key). -alias(aes_cbc, Key) when size(Key)==128 -> aes_128_cbc; -alias(aes_cbc, Key) when size(Key)==192 -> aes_192_cbc; -alias(aes_cbc, Key) when size(Key)==256 -> aes_256_cbc; +alias2(aes_cbc, Key) when size(Key)==16 -> aes_128_cbc; +alias2(aes_cbc, Key) when size(Key)==24 -> aes_192_cbc; +alias2(aes_cbc, Key) when size(Key)==32 -> aes_256_cbc; -alias(aes_cfb8, Key) when size(Key)==128 -> aes_128_cfb8; -alias(aes_cfb8, Key) when size(Key)==192 -> aes_192_cfb8; -alias(aes_cfb8, Key) when size(Key)==256 -> aes_256_cfb8; +alias2(aes_cfb8, Key) when size(Key)==16 -> aes_128_cfb8; +alias2(aes_cfb8, Key) when size(Key)==24 -> aes_192_cfb8; +alias2(aes_cfb8, Key) when size(Key)==32 -> aes_256_cfb8; -alias(aes_cfb128, Key) when size(Key)==128 -> aes_128_cfb128; -alias(aes_cfb128, Key) when size(Key)==192 -> aes_192_cfb128; -alias(aes_cfb128, Key) when size(Key)==256 -> aes_256_cfb128; +alias2(aes_cfb128, Key) when size(Key)==16 -> aes_128_cfb128; +alias2(aes_cfb128, Key) when size(Key)==24 -> aes_192_cfb128; +alias2(aes_cfb128, Key) when size(Key)==32 -> aes_256_cfb128; -alias(aes_ctr, Key) when size(Key)==128 -> aes_128_ctr; -alias(aes_ctr, Key) when size(Key)==192 -> aes_192_ctr; -alias(aes_ctr, Key) when size(Key)==256 -> aes_256_ctr; +alias2(aes_ctr, Key) when size(Key)==16 -> aes_128_ctr; +alias2(aes_ctr, Key) when size(Key)==24 -> aes_192_ctr; +alias2(aes_ctr, Key) when size(Key)==32 -> aes_256_ctr; -alias(aes_gcm, Key) when size(Key)==128 -> aes_128_gcm; -alias(aes_gcm, Key) when size(Key)==192 -> aes_192_gcm; -alias(aes_gcm, Key) when size(Key)==256 -> aes_256_gcm; +alias2(aes_ecb, Key) when size(Key)==16 -> aes_128_ecb; +alias2(aes_ecb, Key) when size(Key)==24 -> aes_192_ecb; +alias2(aes_ecb, Key) when size(Key)==32 -> aes_256_ecb; -alias(aes_ccm, Key) when size(Key)==128 -> aes_128_ccm; -alias(aes_ccm, Key) when size(Key)==192 -> aes_192_ccm; -alias(aes_ccm, Key) when size(Key)==256 -> aes_256_ccm; +alias2(aes_gcm, Key) when size(Key)==16 -> aes_128_gcm; +alias2(aes_gcm, Key) when size(Key)==24 -> aes_192_gcm; +alias2(aes_gcm, Key) when size(Key)==32 -> aes_256_gcm; -alias(Alg, _) -> Alg. +alias2(aes_ccm, Key) when size(Key)==16 -> aes_128_ccm; +alias2(aes_ccm, Key) when size(Key)==24 -> aes_192_ccm; +alias2(aes_ccm, Key) when size(Key)==32 -> aes_256_ccm; + +alias2(Alg, _) -> Alg. %%%================================================================ %%% @@ -2060,8 +2280,7 @@ cipher_info_nif(_Type) -> ?nif_stub. %% AES - in Galois/Counter Mode (GCM) %% %% The default tag length is EVP_GCM_TLS_TAG_LEN(16), -aead_encrypt(_Type, _Key, _Ivec, _AAD, _In, _TagLength) -> ?nif_stub. -aead_decrypt(_Type, _Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub. +aead_cipher(_Type, _Key, _Ivec, _AAD, _In, _TagOrTagLength, _EncFlg) -> ?nif_stub. %% %% AES - with 256 bit key in infinite garble extension mode (IGE) @@ -2233,7 +2452,13 @@ exor(Data1, Data2, _Size, MaxByts, Acc) -> do_exor(_A, _B) -> ?nif_stub. -algorithms() -> ?nif_stub. +hash_algorithms() -> ?nif_stub. +pubkey_algorithms() -> ?nif_stub. +cipher_algorithms() -> ?nif_stub. +mac_algorithms() -> ?nif_stub. +curve_algorithms() -> ?nif_stub. +rsa_opts_algorithms() -> ?nif_stub. + int_to_bin(X) when X < 0 -> int_to_bin_neg(X, []); int_to_bin(X) -> int_to_bin_pos(X, []). diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index ce5097de47..56691223c4 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -45,6 +45,42 @@ all() -> hash_info ]. +-define(NEW_CIPHER_TYPE_SCHEMA, + {group, des_ede3_cbc}, + {group, des_ede3_cfb}, + {group, aes_128_cbc}, + {group, aes_192_cbc}, + {group, aes_256_cbc}, + {group, aes_128_ctr}, + {group, aes_192_ctr}, + {group, aes_256_ctr}, + {group, aes_128_ccm}, + {group, aes_192_ccm}, + {group, aes_256_ccm}, + {group, aes_128_ecb}, + {group, aes_192_ecb}, + {group, aes_256_ecb}, + {group, aes_128_gcm}, + {group, aes_192_gcm}, + {group, aes_256_gcm}, + {group, des_ede3_cbc}, + {group, des_ede3_cfb} + ). + +-define(RETIRED_TYPE_ALIASES, + {group, aes_cbc}, + {group, aes_cbc128}, + {group, aes_cbc256}, + {group, aes_ccm}, + {group, aes_ctr}, + {group, aes_gcm}, + {group, aes_ecb}, + {group, des3_cfb}, + {group, des3_cbc}, + {group, des3_cbf}, + {group, des_ede3} + ). + groups() -> [{non_fips, [], [ {group, blake2b}, @@ -67,35 +103,35 @@ groups() -> {group, sha3_512}, {group, sha512}, {group, sha}, + {group, poly1305}, {group, dh}, {group, ecdh}, {group, srp}, - {group, aes_cbc}, - {group, aes_ccm}, - {group, aes_gcm}, {group, chacha20_poly1305}, {group, chacha20}, - {group, des3_cfb}, - {group, aes_cbc128}, - {group, aes_cbc256}, - {group, aes_cfb128}, - {group, aes_cfb8}, - {group, aes_ctr}, - {group, aes_ige256}, {group, blowfish_cbc}, {group, blowfish_cfb64}, {group, blowfish_ecb}, {group, blowfish_ofb64}, - {group, des3_cbc}, - {group, des3_cbf}, + + {group, aes_ige256}, {group, des_cbc}, {group, des_cfb}, - {group, des_ede3}, - {group, poly1305}, {group, rc2_cbc}, - {group, rc4} + {group, rc4}, + + ?NEW_CIPHER_TYPE_SCHEMA, + {group, aes_128_cfb128}, + {group, aes_192_cfb128}, + {group, aes_256_cfb128}, + {group, aes_128_cfb8}, + {group, aes_192_cfb8}, + {group, aes_256_cfb8}, + ?RETIRED_TYPE_ALIASES, + {group, aes_cfb128}, + {group, aes_cfb8} ]}, {fips, [], [ {group, no_blake2b}, @@ -114,123 +150,148 @@ groups() -> {group, sha256}, {group, sha384}, {group, sha512}, + {group, no_poly1305}, {group, dh}, {group, ecdh}, {group, no_srp}, - {group, aes_cbc}, - {group, aes_ccm}, - {group, aes_gcm}, {group, no_chacha20_poly1305}, {group, no_chacha20}, - {group, des3_cfb}, - {group, aes_cbc128}, - {group, aes_cbc256}, - {group, no_aes_cfb128}, - {group, no_aes_cfb8}, - {group, aes_ctr}, - {group, no_aes_ige256}, {group, no_blowfish_cbc}, {group, no_blowfish_cfb64}, {group, no_blowfish_ecb}, {group, no_blowfish_ofb64}, - {group, des3_cbc}, - {group, des3_cbf}, + + {group, no_aes_cfb128}, + {group, no_aes_cfb8}, + {group, no_aes_ige256}, {group, no_des_cbc}, {group, no_des_cfb}, - {group, des_ede3}, - {group, no_poly1305}, {group, no_rc2_cbc}, - {group, no_rc4} + {group, no_rc4}, + + ?NEW_CIPHER_TYPE_SCHEMA, + ?RETIRED_TYPE_ALIASES ]}, - {md4, [], [hash]}, - {md5, [], [hash, hmac]}, - {ripemd160, [], [hash]}, - {sha, [], [hash, hmac]}, - {sha224, [], [hash, hmac]}, - {sha256, [], [hash, hmac]}, - {sha384, [], [hash, hmac]}, - {sha512, [], [hash, hmac]}, - {sha3_224, [], [hash, hmac]}, - {sha3_256, [], [hash, hmac]}, - {sha3_384, [], [hash, hmac]}, - {sha3_512, [], [hash, hmac]}, - {blake2b, [], [hash, hmac]}, - {blake2s, [], [hash, hmac]}, - {no_blake2b, [], [no_hash, no_hmac]}, - {no_blake2s, [], [no_hash, no_hmac]}, - {rsa, [], [sign_verify, - public_encrypt, - private_encrypt, - generate - ]}, - {dss, [], [sign_verify - %% Does not work yet: ,public_encrypt, private_encrypt - ]}, - {ecdsa, [], [sign_verify - %% Does not work yet: ,public_encrypt, private_encrypt - ]}, - {ed25519, [], [sign_verify - %% Does not work yet: ,public_encrypt, private_encrypt - ]}, - {ed448, [], [sign_verify - %% Does not work yet: ,public_encrypt, private_encrypt - ]}, - {dh, [], [generate_compute, - compute_bug]}, - {ecdh, [], [use_all_elliptic_curves, compute, generate]}, - {srp, [], [generate_compute]}, - {des_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {des_cfb, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {des3_cbc,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {des_ede3,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {des3_cbf,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {des3_cfb,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {rc2_cbc,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_cbc128,[], [block, api_ng, api_ng_one_shot, api_ng_tls, cmac]}, - {aes_cfb8,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_cfb128,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_cbc256,[], [block, api_ng, api_ng_one_shot, api_ng_tls, cmac]}, - {aes_ecb,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_ige256,[], [block]}, - {blowfish_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {blowfish_ecb, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {blowfish_cfb64, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {blowfish_ofb64,[], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {rc4, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_ctr, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, - {aes_ccm, [], [aead]}, - {aes_gcm, [], [aead]}, - {chacha20_poly1305, [], [aead]}, - {chacha20, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, - {poly1305, [], [poly1305]}, - {no_poly1305, [], [no_poly1305]}, - {aes_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, - {no_aes_cfb8,[], [no_support, no_block]}, - {no_aes_cfb128,[], [no_support, no_block]}, - {no_md4, [], [no_support, no_hash]}, - {no_md5, [], [no_support, no_hash, no_hmac]}, - {no_ed25519, [], [no_support, no_sign_verify - %% Does not work yet: ,public_encrypt, private_encrypt - ]}, - {no_ed448, [], [no_support, no_sign_verify - %% Does not work yet: ,public_encrypt, private_encrypt - ]}, - {no_ripemd160, [], [no_support, no_hash]}, - {no_srp, [], [no_support, no_generate_compute]}, - {no_des_cbc, [], [no_support, no_block]}, - {no_des_cfb, [], [no_support, no_block]}, - {no_blowfish_cbc, [], [no_support, no_block]}, - {no_blowfish_ecb, [], [no_support, no_block]}, - {no_blowfish_cfb64, [], [no_support, no_block]}, - {no_blowfish_ofb64, [], [no_support, no_block]}, - {no_aes_ige256, [], [no_support, no_block]}, + + {md4, [], [hash]}, + {md5, [], [hash, hmac]}, + {ripemd160, [], [hash]}, + {sha, [], [hash, hmac]}, + {sha224, [], [hash, hmac]}, + {sha256, [], [hash, hmac]}, + {sha384, [], [hash, hmac]}, + {sha512, [], [hash, hmac]}, + {sha3_224, [], [hash, hmac]}, + {sha3_256, [], [hash, hmac]}, + {sha3_384, [], [hash, hmac]}, + {sha3_512, [], [hash, hmac]}, + {blake2b, [], [hash, hmac]}, + {blake2s, [], [hash, hmac]}, + {no_blake2b, [], [no_hash, no_hmac]}, + {no_blake2s, [], [no_hash, no_hmac]}, + {rsa, [], [sign_verify, + public_encrypt, + private_encrypt, + generate + ]}, + {dss, [], [sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {ecdsa, [], [sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {ed25519, [], [sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {ed448, [], [sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {dh, [], [generate_compute, compute_bug]}, + {ecdh, [], [use_all_elliptic_curves, compute, generate]}, + {srp, [], [generate_compute]}, + {des_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des_cfb, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des_ede3_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {des_ede3_cfb, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {rc2_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_cfb8, [], [block]}, + {aes_128_cfb8, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_192_cfb8, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_256_cfb8, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {no_aes_cfb8, [], [no_support, no_block]}, + {aes_cfb128, [], [block]}, + {aes_128_cfb128, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_192_cfb128, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_256_cfb128, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {no_aes_cfb128, [], [no_support, no_block]}, + {aes_ige256, [], [block]}, + {no_aes_ige256, [], [no_support, no_block]}, + {blowfish_cbc, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {blowfish_ecb, [], [block, api_ng, api_ng_one_shot]}, + {blowfish_cfb64, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {blowfish_ofb64, [], [block, api_ng, api_ng_one_shot, api_ng_tls]}, + {rc4, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_ctr, [], [stream]}, + {chacha20_poly1305, [], [aead]}, + {chacha20, [], [stream, api_ng, api_ng_one_shot, api_ng_tls]}, + {poly1305, [], [poly1305]}, + {no_poly1305, [], [no_poly1305]}, + {no_aes_cfb128, [], [no_support, no_block]}, + {no_md4, [], [no_support, no_hash]}, + {no_md5, [], [no_support, no_hash, no_hmac]}, + {no_ed25519, [], [no_support, no_sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {no_ed448, [], [no_support, no_sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {no_ripemd160, [], [no_support, no_hash]}, + {no_srp, [], [no_support, no_generate_compute]}, + {no_des_cbc, [], [no_support, no_block]}, + {no_des_cfb, [], [no_support, no_block]}, + {no_blowfish_cbc, [], [no_support, no_block]}, + {no_blowfish_ecb, [], [no_support, no_block]}, + {no_blowfish_cfb64, [], [no_support, no_block]}, + {no_blowfish_ofb64, [], [no_support, no_block]}, + {no_aes_ige256, [], [no_support, no_block]}, {no_chacha20_poly1305, [], [no_support, no_aead]}, - {no_chacha20, [], [no_support, no_stream_ivec]}, - {no_rc2_cbc, [], [no_support, no_block]}, - {no_rc4, [], [no_support, no_stream]}, - {api_errors, [], [api_errors_ecdh]} + {no_chacha20, [], [no_support, no_stream_ivec]}, + {no_rc2_cbc, [], [no_support, no_block]}, + {no_rc4, [], [no_support, no_stream]}, + {api_errors, [], [api_errors_ecdh]}, + + %% New cipher nameing schema + {des_ede3_cbc, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {des_ede3_cfb, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_128_cbc, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_192_cbc, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_256_cbc, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_128_ctr, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_192_ctr, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_256_ctr, [], [api_ng, api_ng_one_shot, api_ng_tls]}, + {aes_128_ccm, [], [aead]}, + {aes_192_ccm, [], [aead]}, + {aes_256_ccm, [], [aead]}, + {aes_128_ecb, [], [api_ng, api_ng_one_shot]}, + {aes_192_ecb, [], [api_ng, api_ng_one_shot]}, + {aes_256_ecb, [], [api_ng, api_ng_one_shot]}, + {aes_128_gcm, [], [aead]}, + {aes_192_gcm, [], [aead]}, + {aes_256_gcm, [], [aead]}, + + %% Retired aliases + {aes_cbc, [], [block]}, + {aes_cbc128, [], [block]}, + {aes_cbc256, [], [block]}, + {aes_ccm, [], [aead]}, + {aes_ecb, [], [block]}, + {aes_gcm, [], [aead]}, + {des3_cbc, [], [block]}, + {des_ede3, [], [block]}, + {des3_cbf, [], [block]}, + {des3_cfb, [], [block]} ]. %%------------------------------------------------------------------- @@ -429,8 +490,7 @@ poly1305(Config) -> %%-------------------------------------------------------------------- no_poly1305() -> [{doc, "Test disabled poly1305 function"}]. -no_poly1305(Config) -> - Type = ?config(type, Config), +no_poly1305(_Config) -> Key = <<133,214,190,120,87,85,109,51,127,68,82,254,66,213,6,168,1, 3,128,138,251,13,178,253,74,191,246,175,65,73,245,27>>, Txt = <<"Cryptographic Forum Research Group">>, @@ -440,7 +500,7 @@ no_poly1305(Config) -> block() -> [{doc, "Test block ciphers"}]. block(Config) when is_list(Config) -> - Blocks = lazy_eval(proplists:get_value(block, Config)), + [_|_] = Blocks = lazy_eval(proplists:get_value(cipher, Config)), lists:foreach(fun block_cipher/1, Blocks), lists:foreach(fun block_cipher/1, block_iolistify(Blocks)), lists:foreach(fun block_cipher_increment/1, block_iolistify(Blocks)). @@ -449,7 +509,7 @@ block(Config) when is_list(Config) -> no_block() -> [{doc, "Test disabled block ciphers"}]. no_block(Config) when is_list(Config) -> - Blocks = lazy_eval(proplists:get_value(block, Config)), + [_|_] = Blocks = lazy_eval(proplists:get_value(cipher, Config)), Args = case Blocks of [{_Type, _Key, _PlainText} = A | _] -> tuple_to_list(A); @@ -466,10 +526,8 @@ api_ng() -> [{doc, "Test new api"}]. api_ng(Config) when is_list(Config) -> - Blocks = lazy_eval(proplists:get_value(block, Config, [])), - Streams = lazy_eval(proplists:get_value(stream, Config, [])), - lists:foreach(fun api_ng_cipher_increment/1, Blocks++Streams). - + [_|_] = Ciphers = lazy_eval(proplists:get_value(cipher, Config, [])), + lists:foreach(fun api_ng_cipher_increment/1, Ciphers). api_ng_cipher_increment({Type, Key, PlainTexts}=_X) -> ct:log("~p",[_X]), @@ -523,9 +581,8 @@ api_ng_one_shot() -> [{doc, "Test new api"}]. api_ng_one_shot(Config) when is_list(Config) -> - Blocks = lazy_eval(proplists:get_value(block, Config, [])), - Streams = lazy_eval(proplists:get_value(stream, Config, [])), - lists:foreach(fun do_api_ng_one_shot/1, Blocks++Streams). + [_|_] = Ciphers = lazy_eval(proplists:get_value(cipher, Config, [])), + lists:foreach(fun do_api_ng_one_shot/1, Ciphers). do_api_ng_one_shot({Type, Key, PlainTexts}=_X) -> ct:log("~p",[_X]), @@ -537,8 +594,8 @@ do_api_ng_one_shot({Type, Key, IV, PlainTexts}=_X) -> do_api_ng_one_shot({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> ct:log("~p",[_X]), - PlainText = iolist_to_binary(PlainText0), - EncTxt = crypto:crypto_one_shot(Type, Key, IV, PlainText, true), + PlainText = iolist_to_binary(lazy_eval(PlainText0)), + EncTxt = crypto:crypto_one_time(Type, Key, IV, PlainText, true), case ExpectedEncText of undefined -> ok; @@ -546,14 +603,14 @@ do_api_ng_one_shot({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> ok; _ -> ct:log("encode~nIn: ~p~nExpected: ~p~nEnc: ~p~n", [{Type,Key,IV,PlainText}, ExpectedEncText, EncTxt]), - ct:fail("api_ng_one_shot (encode)",[]) + ct:fail("api_ng_one_time (encode)",[]) end, - case crypto:crypto_one_shot(Type, Key, IV, EncTxt, false) of + case crypto:crypto_one_time(Type, Key, IV, EncTxt, false) of PlainText -> ok; OtherPT -> ct:log("decode~nIn: ~p~nExpected: ~p~nDec: ~p~n", [{Type,Key,IV,EncTxt}, PlainText, OtherPT]), - ct:fail("api_ng_one_shot (decode)",[]) + ct:fail("api_ng_one_time (decode)",[]) end. %%-------------------------------------------------------------------- @@ -561,9 +618,8 @@ api_ng_tls() -> [{doc, "Test special tls api"}]. api_ng_tls(Config) when is_list(Config) -> - Blocks = lazy_eval(proplists:get_value(block, Config, [])), - Streams = lazy_eval(proplists:get_value(stream, Config, [])), - lists:foreach(fun do_api_ng_tls/1, Blocks++Streams). + [_|_] = Ciphers = lazy_eval(proplists:get_value(cipher, Config, [])), + lists:foreach(fun do_api_ng_tls/1, Ciphers). do_api_ng_tls({Type, Key, PlainTexts}=_X) -> @@ -576,16 +632,16 @@ do_api_ng_tls({Type, Key, IV, PlainTexts}=_X) -> do_api_ng_tls({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> ct:log("~p",[_X]), - PlainText = iolist_to_binary(PlainText0), - Renc = crypto:crypto_init_dyn_iv(Type, Key, true), - Rdec = crypto:crypto_init_dyn_iv(Type, Key, false), - EncTxt = crypto:crypto_update_dyn_iv(Renc, PlainText, IV), + PlainText = iolist_to_binary(lazy_eval(PlainText0)), + Renc = crypto:crypto_dyn_iv_init(Type, Key, true), + Rdec = crypto:crypto_dyn_iv_init(Type, Key, false), + EncTxt = crypto:crypto_dyn_iv_update(Renc, PlainText, IV), case ExpectedEncText of undefined -> ok; EncTxt -> %% Now check that the state is NOT updated: - case crypto:crypto_update_dyn_iv(Renc, PlainText, IV) of + case crypto:crypto_dyn_iv_update(Renc, PlainText, IV) of EncTxt -> ok; EncTxt2 -> @@ -596,10 +652,10 @@ do_api_ng_tls({Type, Key, IV, PlainText0, ExpectedEncText}=_X) -> ct:log("1st encode~nIn: ~p~nExpected: ~p~nEnc: ~p~n", [{Type,Key,IV,PlainText}, ExpectedEncText, OtherEnc]), ct:fail("api_ng_tls (encode)",[]) end, - case crypto:crypto_update_dyn_iv(Rdec, EncTxt, IV) of + case crypto:crypto_dyn_iv_update(Rdec, EncTxt, IV) of PlainText -> %% Now check that the state is NOT updated: - case crypto:crypto_update_dyn_iv(Rdec, EncTxt, IV) of + case crypto:crypto_dyn_iv_update(Rdec, EncTxt, IV) of PlainText -> ok; PlainText2 -> @@ -616,7 +672,7 @@ no_aead() -> [{doc, "Test disabled aead ciphers"}]. no_aead(Config) when is_list(Config) -> EncArg4 = - case lazy_eval(proplists:get_value(aead, Config)) of + case lazy_eval(proplists:get_value(cipher, Config)) of [{Type, Key, PlainText, Nonce, AAD, CipherText, CipherTag, TagLen, _Info} | _] -> {AAD, PlainText, TagLen}; [{Type, Key, PlainText, Nonce, AAD, CipherText, CipherTag, _Info} | _] -> @@ -631,7 +687,7 @@ no_aead(Config) when is_list(Config) -> stream() -> [{doc, "Test stream ciphers"}]. stream(Config) when is_list(Config) -> - Streams = lazy_eval(proplists:get_value(stream, Config)), + [_|_] = Streams = lazy_eval(proplists:get_value(cipher, Config)), lists:foreach(fun stream_cipher/1, Streams), lists:foreach(fun stream_cipher/1, stream_iolistify(Streams)), @@ -654,8 +710,7 @@ no_stream_ivec(Config) when is_list(Config) -> aead() -> [{doc, "Test AEAD ciphers"}]. aead(Config) when is_list(Config) -> - AEADs = lazy_eval(proplists:get_value(aead, Config)), - + [_|_] = AEADs = lazy_eval(proplists:get_value(cipher, Config)), FilteredAEADs = case proplists:get_bool(fips, Config) of false -> @@ -668,7 +723,6 @@ aead(Config) when is_list(Config) -> IVLen >= 12 end, AEADs) end, - lists:foreach(fun aead_cipher/1, FilteredAEADs). %%-------------------------------------------------------------------- @@ -847,8 +901,24 @@ cipher_info(Config) when is_list(Config) -> #{type := _,key_length := _,iv_length := _, block_size := _,mode := _} = crypto:cipher_info(aes_128_cbc), {'EXIT',_} = (catch crypto:cipher_info(not_a_cipher)), - lists:foreach(fun(C) -> crypto:cipher_info(C) end, - proplists:get_value(ciphers, crypto:supports())). + case lists:foldl(fun(C,Ok) -> + try crypto:cipher_info(C) + of + _ -> Ok + catch Cls:Exc -> + ct:pal("~p:~p ~p",[Cls,Exc,C]), + false + end + end, + true, +crypto:supports(ciphers)) of +%% proplists:get_value(ciphers, crypto:supports())) of + true -> + ok; + false -> + ct:fail('Cipher unsupported',[]) + end. + %%-------------------------------------------------------------------- hash_info() -> @@ -985,13 +1055,27 @@ block_cipher({Type, Key, IV, PlainText, CipherText}) -> ct:fail({{crypto, block_decrypt, [Type, Key, IV, CipherText]}, {expected, Plain}, {got, Other1}}) end. -block_cipher_increment({Type, Key, IV, PlainTexts}) - when Type == des_cbc; Type == aes_cbc; Type == des3_cbc -> +block_cipher_increment({Type, Key, IV, PlainTexts}) when Type == des_cbc ; + Type == des3_cbc ; + Type == aes_128_cbc ; + Type == aes_192_cbc ; + Type == aes_256_cbc + -> block_cipher_increment(Type, Key, IV, IV, PlainTexts, iolist_to_binary(PlainTexts), []); -block_cipher_increment({Type, Key, IV, PlainTexts, CipherText}) - when Type == des_cbc; Type == des3_cbc -> +block_cipher_increment({Type, Key, IV, PlainTexts, CipherText}) when Type == des_cbc; + Type == des_ede3_cbc ; + Type == des3_cbc ; + Type == des_ede3 ; + Type == des_ede3_cfb ; + Type == des_ede3_cbf ; + Type == des3_cbf ; + Type == des3_cfb + -> block_cipher_increment(Type, Key, IV, IV, PlainTexts, iolist_to_binary(PlainTexts), CipherText, []); -block_cipher_increment({Type, Key, IV, PlainTexts, _CipherText}) when Type == aes_cbc -> +block_cipher_increment({Type, Key, IV, PlainTexts, _CipherText}) when Type == aes_128_cbc ; + Type == aes_192_cbc ; + Type == aes_256_cbc + -> Plain = iolist_to_binary(PlainTexts), Blocks = [iolistify(Block) || << Block:128/bitstring >> <= Plain], block_cipher_increment(Type, Key, IV, IV, Blocks, Plain, []); @@ -1025,8 +1109,9 @@ block_cipher_increment(Type, Key, IV0, IV, [PlainText | PlainTexts], Plain, Ciph NextIV = crypto:next_iv(Type, CT), block_cipher_increment(Type, Key, IV0, NextIV, PlainTexts, Plain, CipherText, [CT | Acc]). -stream_cipher({Type, Key, PlainText}) -> - Plain = iolist_to_binary(PlainText), +stream_cipher({Type, Key, PlainText0}) -> + PlainText = lazy_eval(PlainText0), + Plain = iolist_to_binary(lazy_eval(PlainText)), StateE = crypto:stream_init(Type, Key), StateD = crypto:stream_init(Type, Key), {_, CipherText} = crypto:stream_encrypt(StateE, PlainText), @@ -1036,7 +1121,8 @@ stream_cipher({Type, Key, PlainText}) -> Other -> ct:fail({{crypto, stream_decrypt, [StateD, CipherText]}, {expected, PlainText}, {got, Other}}) end; -stream_cipher({Type, Key, IV, PlainText}) -> +stream_cipher({Type, Key, IV, PlainText0}) -> + PlainText = lazy_eval(PlainText0), Plain = iolist_to_binary(PlainText), StateE = crypto:stream_init(Type, Key, IV), StateD = crypto:stream_init(Type, Key, IV), @@ -1047,7 +1133,8 @@ stream_cipher({Type, Key, IV, PlainText}) -> Other -> ct:fail({{crypto, stream_decrypt, [StateD, CipherText]}, {expected, PlainText}, {got, Other}}) end; -stream_cipher({Type, Key, IV, PlainText, CipherText}) -> +stream_cipher({Type, Key, IV, PlainText0, CipherText}) -> + PlainText = lazy_eval(PlainText0), Plain = iolist_to_binary(PlainText), StateE = crypto:stream_init(Type, Key, IV), StateD = crypto:stream_init(Type, Key, IV), @@ -1112,7 +1199,7 @@ aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag, Info}) -> aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag, TagLen, Info}) -> <<TruncatedCipherTag:TagLen/binary, _/binary>> = CipherTag, Plain = iolist_to_binary(PlainText), - case crypto:block_encrypt(Type, Key, IV, {AAD, Plain, TagLen}) of + try crypto:block_encrypt(Type, Key, IV, {AAD, Plain, TagLen}) of {CipherText, TruncatedCipherTag} -> ok; Other0 -> @@ -1121,6 +1208,18 @@ aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag, TagLen, Info} [{info,Info}, {key,Key}, {pt,PlainText}, {iv,IV}, {aad,AAD}, {ct,CipherText}, {tag,CipherTag}, {taglen,TagLen}]}, {expected, {CipherText, TruncatedCipherTag}}, {got, Other0}}) + catch + error:E -> + ct:log("~p",[{Type, Key, PlainText, IV, AAD, CipherText, CipherTag, TagLen, Info}]), + try crypto:crypto_one_time_aead(Type, Key, IV, PlainText, AAD, TagLen, true) + of + RR -> + ct:log("Works: ~p",[RR]) + catch + CC:EE -> + ct:log("~p:~p", [CC,EE]) + end, + ct:fail("~p",[E]) end, case crypto:block_decrypt(Type, Key, IV, {AAD, CipherText, TruncatedCipherTag}) of Plain -> @@ -1369,16 +1468,15 @@ do_stream_iolistify({Type, Key, IV, PlainText}) -> {Type, iolistify(Key), IV, iolistify(PlainText)}; do_stream_iolistify({Type, Key, IV, PlainText, CipherText}) -> {Type, iolistify(Key), IV, iolistify(PlainText), CipherText}. - -do_block_iolistify({des_cbc = Type, Key, IV, PlainText}) -> - {Type, Key, IV, des_iolistify(PlainText)}; -do_block_iolistify({des3_cbc = Type, Key, IV, PlainText}) -> - {Type, Key, IV, des_iolistify(PlainText)}; -do_block_iolistify({des3_cbf = Type, Key, IV, PlainText}) -> - {Type, Key, IV, des_iolistify(PlainText)}; -do_block_iolistify({des3_cfb = Type, Key, IV, PlainText}) -> - {Type, Key, IV, des_iolistify(PlainText)}; -do_block_iolistify({des_ede3 = Type, Key, IV, PlainText}) -> +do_block_iolistify({Type, Key, IV, PlainText}) when Type == des_cbc ; + Type == des_ede3_cbc ; + Type == des3_cbc ; + Type == des_ede3 ; + Type == des_ede3_cfb ; + Type == des_ede3_cbf ; + Type == des3_cbf ; + Type == des3_cfb + -> {Type, Key, IV, des_iolistify(PlainText)}; do_block_iolistify({Type, Key, PlainText}) -> {Type, iolistify(Key), iolistify(PlainText)}; @@ -1387,10 +1485,13 @@ do_block_iolistify({Type, Key, IV, PlainText}) -> do_block_iolistify({Type, Key, IV, PlainText, CipherText}) -> {Type, iolistify(Key), IV, iolistify(PlainText), CipherText}. -iolistify(<<"Test With Truncation">>)-> +iolistify(X) -> + iolistify1(lazy_eval(X)). + +iolistify1(<<"Test With Truncation">>)-> %% Do not iolistify as it spoils this special case <<"Test With Truncation">>; -iolistify(Msg) when is_binary(Msg) -> +iolistify1(Msg) when is_binary(Msg) -> Length = erlang:byte_size(Msg), Split = Length div 2, List0 = binary_to_list(Msg), @@ -1400,8 +1501,8 @@ iolistify(Msg) when is_binary(Msg) -> {List1, List2}-> [List1, List2] end; -iolistify(Msg) -> - iolistify(list_to_binary(Msg)). +iolistify1(Msg) when is_list(Msg) -> + iolistify1(list_to_binary(Msg)). des_iolistify(Msg) -> des_iolist(erlang:byte_size(Msg) div 8, Msg, []). @@ -1480,7 +1581,7 @@ rand_uniform_aux_test(N) -> rand_uniform_aux_test(N-1). crypto_rand_uniform(L,H) -> - R1 = crypto:rand_uniform(L, H), + R1 = (L-1) + rand:uniform(H-L), case (R1 >= L) and (R1 < H) of true -> ok; @@ -1710,7 +1811,6 @@ group_config(dss = Type, Config) -> MsgPubEnc = <<"7896345786348 Asldi">>, PubPrivEnc = [{dss, Public, Private, MsgPubEnc, []}], [{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config]; - group_config(ecdsa = Type, Config) -> {Private, Public} = ec_key_named(), Msg = ec_msg(), @@ -1722,15 +1822,13 @@ group_config(ecdsa = Type, Config) -> MsgPubEnc = <<"7896345786348 Asldi">>, PubPrivEnc = [{ecdsa, Public, Private, MsgPubEnc, []}], [{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config]; - group_config(Type, Config) when Type == ed25519 ; Type == ed448 -> TestVectors = eddsa(Type), [{sign_verify,TestVectors} | Config]; - - group_config(srp, Config) -> GenerateCompute = [srp3(), srp6(), srp6a(), srp6a_smaller_prime()], [{generate_compute, GenerateCompute} | Config]; + group_config(ecdh, Config) -> Compute = ecdh(), Generate = ecc(), @@ -1738,77 +1836,19 @@ group_config(ecdh, Config) -> group_config(dh, Config) -> GenerateCompute = [dh()], [{generate_compute, GenerateCompute} | Config]; -group_config(des_cbc, Config) -> - Block = des_cbc(), - [{block, Block} | Config]; -group_config(des_cfb, Config) -> - Block = des_cfb(), - [{block, Block} | Config]; -group_config(des3_cbc, Config) -> - Block = des3_cbc(), - [{block, Block} | Config]; -group_config(des3_cbf, Config) -> - Block = des3_cbf(), - [{block, Block} | Config]; -group_config(des3_cfb, Config) -> - Block = des3_cfb(), - [{block, Block} | Config]; -group_config(des_ede3, Config) -> - Block = des_ede3(), - [{block, Block} | Config]; -group_config(rc2_cbc, Config) -> - Block = rc2_cbc(), - [{block, Block} | Config]; + group_config(aes_cbc128 = Type, Config) -> Block = fun() -> aes_cbc128(Config) end, Pairs = fun() -> cmac_nist(Config, Type) end, - [{block, Block}, {cmac, Pairs} | Config]; + [{cipher, Block}, {cmac, Pairs} | Config]; group_config(aes_cbc256 = Type, Config) -> Block = fun() -> aes_cbc256(Config) end, Pairs = fun() -> cmac_nist(Config, Type) end, - [{block, Block}, {cmac, Pairs} | Config]; -group_config(aes_ecb, Config) -> - Block = fun() -> aes_ecb(Config) end, - [{block, Block} | Config]; -group_config(aes_ige256, Config) -> - Block = aes_ige256(), - [{block, Block} | Config]; -group_config(aes_cfb8, Config) -> - Block = fun() -> aes_cfb8(Config) end, - [{block, Block} | Config]; -group_config(aes_cfb128, Config) -> - Block = fun() -> aes_cfb128(Config) end, - [{block, Block} | Config]; -group_config(blowfish_cbc, Config) -> - Block = blowfish_cbc(), - [{block, Block} | Config]; -group_config(blowfish_ecb, Config) -> - Block = blowfish_ecb(), - [{block, Block} | Config]; -group_config(blowfish_cfb64, Config) -> - Block = blowfish_cfb64(), - [{block, Block} | Config]; -group_config(blowfish_ofb64, Config) -> - Block = blowfish_ofb64(), - [{block, Block} | Config]; -group_config(rc4, Config) -> - Stream = rc4(), - [{stream, Stream} | Config]; -group_config(aes_ctr, Config) -> - Stream = aes_ctr(), - [{stream, Stream} | Config]; -group_config(aes_ccm, Config) -> - AEAD = fun() -> aes_ccm(Config) end, - [{aead, AEAD} | Config]; -group_config(aes_gcm, Config) -> - AEAD = fun() -> aes_gcm(Config) end, - [{aead, AEAD} | Config]; + [{cipher, Block}, {cmac, Pairs} | Config]; group_config(chacha20_poly1305, Config) -> - AEAD = chacha20_poly1305(), - [{aead, AEAD} | Config]; -group_config(chacha20, Config) -> - Stream = chacha20(), - [{stream, Stream} | Config]; + AEAD = chacha20_poly1305(Config), + [{cipher, AEAD} | Config]; + group_config(poly1305, Config) -> V = [%% {Key, Txt, Expect} {%% RFC7539 2.5.2 @@ -1818,11 +1858,12 @@ group_config(poly1305, Config) -> } ], [{poly1305,V} | Config]; -group_config(aes_cbc, Config) -> - Block = aes_cbc(Config), - [{block, Block} | Config]; -group_config(_, Config) -> - Config. + +group_config(F, Config) -> + TestVectors = fun() -> ?MODULE:F(Config) end, + [{cipher, TestVectors} | Config]. + + rsa_sign_verify_tests(Config, Msg, Public, Private, PublicS, PrivateS, OptsToTry) -> case ?config(fips, Config) of @@ -2413,19 +2454,19 @@ rfc4231_hmac_sha512() -> "debd71f8867289865df5a32d20cdc944" "b6022cac3c4982b10d5eeb55c3e4de15" "134676fb6de0446065c97440fa8c6a58")]. -des_cbc() -> +des_cbc(_) -> [{des_cbc, hexstr2bin("0123456789abcdef"), hexstr2bin("1234567890abcdef"), <<"Now is the time for all ">> }]. -des_cfb() -> +des_cfb(_) -> [{des_cfb, hexstr2bin("0123456789abcdef"), hexstr2bin("1234567890abcdef"), <<"Now is the">>}]. -des3_cbc() -> +des3_cbc(_) -> [{des3_cbc, [hexstr2bin("0123456789abcdef"), hexstr2bin("fedcba9876543210"), @@ -2434,7 +2475,7 @@ des3_cbc() -> <<"Now is the time for all ">> }]. -des_ede3() -> +des_ede3(_) -> [{des_ede3, [hexstr2bin("8000000000000000"), hexstr2bin("4000000000000000"), @@ -2443,7 +2484,23 @@ des_ede3() -> hexstr2bin("0000000000000000") }]. -des3_cbf() -> +des_ede3_cbc(_) -> + [{des_ede3_cbc, + [hexstr2bin("0123456789abcdef"), + hexstr2bin("fedcba9876543210"), + hexstr2bin("0f2d4b6987a5c3e1")], + hexstr2bin("1234567890abcdef"), + <<"Now is the time for all ">> + }, + {des_ede3_cbc, + [hexstr2bin("8000000000000000"), + hexstr2bin("4000000000000000"), + hexstr2bin("2000000000000000")], + hexstr2bin("7AD16FFB79C45926"), + hexstr2bin("0000000000000000") + }]. + +des3_cbf(_) -> [{des3_cbf, [hexstr2bin("0123456789abcdef"), hexstr2bin("fedcba9876543210"), @@ -2452,7 +2509,7 @@ des3_cbf() -> <<"Now is the time for all ">> }]. -des3_cfb() -> +des3_cfb(_) -> [{des3_cfb, [hexstr2bin("0123456789abcdef"), hexstr2bin("fedcba9876543210"), @@ -2461,7 +2518,16 @@ des3_cfb() -> <<"Now is the time for all ">> }]. -rc2_cbc() -> +des_ede3_cfb(_) -> + [{des_ede3_cfb, + [hexstr2bin("0123456789abcdef"), + hexstr2bin("fedcba9876543210"), + hexstr2bin("0f2d4b6987a5c3e1")], + hexstr2bin("1234567890abcdef"), + <<"Now is the time for all ">> + }]. + +rc2_cbc(_) -> [{rc2_cbc, <<146,210,160,124,215,227,153,239,227,17,222,140,3,93,27,191>>, <<72,91,135,182,25,42,35,210>>, @@ -2470,7 +2536,8 @@ rc2_cbc() -> %% AES CBC test vectors from http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf aes_cbc(Config) -> - read_rsp(Config, aes_cbc, + %% RETIRED aes_*_cbc + read_rsp(Config, aes_cbc, ["CBCVarTxt128.rsp", "CBCVarKey128.rsp", "CBCGFSbox128.rsp", "CBCKeySbox128.rsp", "CBCVarTxt192.rsp", "CBCVarKey192.rsp", "CBCGFSbox192.rsp", "CBCKeySbox192.rsp", "CBCVarTxt256.rsp", "CBCVarKey256.rsp", "CBCGFSbox256.rsp", "CBCKeySbox256.rsp", @@ -2478,15 +2545,32 @@ aes_cbc(Config) -> ]). aes_cbc128(Config) -> + %% RETIRED aes_128_cbc read_rsp(Config, aes_cbc128, ["CBCVarTxt128.rsp", "CBCVarKey128.rsp", "CBCGFSbox128.rsp", "CBCKeySbox128.rsp", "CBCMMT128.rsp"]). aes_cbc256(Config) -> + %% RETIRED aes_256_cbc read_rsp(Config, aes_cbc256, ["CBCVarTxt256.rsp", "CBCVarKey256.rsp", "CBCGFSbox256.rsp", "CBCKeySbox256.rsp", "CBCMMT256.rsp"]). +aes_128_cbc(Config) -> + read_rsp(Config, aes_128_cbc, + ["CBCVarTxt128.rsp", "CBCVarKey128.rsp", "CBCGFSbox128.rsp", "CBCKeySbox128.rsp", + "CBCMMT128.rsp"]). + +aes_192_cbc(Config) -> + read_rsp(Config, aes_192_cbc, + ["CBCVarTxt192.rsp", "CBCVarKey192.rsp", "CBCGFSbox192.rsp", "CBCKeySbox192.rsp", + "CBCMMT192.rsp"]). + +aes_256_cbc(Config) -> + read_rsp(Config, aes_256_cbc, + ["CBCVarTxt256.rsp", "CBCVarKey256.rsp", "CBCGFSbox256.rsp", "CBCKeySbox256.rsp", + "CBCMMT256.rsp"]). + aes_ecb(Config) -> read_rsp(Config, aes_ecb, ["ECBVarTxt128.rsp", "ECBVarKey128.rsp", "ECBGFSbox128.rsp", "ECBKeySbox128.rsp", @@ -2494,7 +2578,22 @@ aes_ecb(Config) -> "ECBVarTxt256.rsp", "ECBVarKey256.rsp", "ECBGFSbox256.rsp", "ECBKeySbox256.rsp", "ECBMMT128.rsp", "ECBMMT192.rsp", "ECBMMT256.rsp"]). -aes_ige256() -> +aes_128_ecb(Config) -> + read_rsp(Config, aes_128_ecb, + ["ECBVarTxt128.rsp", "ECBVarKey128.rsp", "ECBGFSbox128.rsp", "ECBKeySbox128.rsp", + "ECBMMT128.rsp"]). + +aes_192_ecb(Config) -> + read_rsp(Config, aes_192_ecb, + ["ECBVarTxt192.rsp", "ECBVarKey192.rsp", "ECBGFSbox192.rsp", "ECBKeySbox192.rsp", + "ECBMMT192.rsp"]). + +aes_256_ecb(Config) -> + read_rsp(Config, aes_256_ecb, + ["ECBVarTxt256.rsp", "ECBVarKey256.rsp", "ECBGFSbox256.rsp", "ECBKeySbox256.rsp", + "ECBMMT256.rsp"]). + +aes_ige256(_) -> [{aes_ige256, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), hexstr2bin("000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F"), @@ -2520,6 +2619,22 @@ aes_cfb8(Config) -> "CFB8VarTxt256.rsp", "CFB8VarKey256.rsp", "CFB8GFSbox256.rsp", "CFB8KeySbox256.rsp", "CFB8MMT128.rsp", "CFB8MMT192.rsp", "CFB8MMT256.rsp"]). +aes_128_cfb8(Config) -> + read_rsp(Config, aes_128_cfb8, + ["CFB8VarTxt128.rsp", "CFB8VarKey128.rsp", "CFB8GFSbox128.rsp", "CFB8KeySbox128.rsp", + "CFB8MMT128.rsp"]). + +aes_192_cfb8(Config) -> + read_rsp(Config, aes_192_cfb8, + ["CFB8VarTxt192.rsp", "CFB8VarKey192.rsp", "CFB8GFSbox192.rsp", "CFB8KeySbox192.rsp", + "CFB8MMT192.rsp"]). + +aes_256_cfb8(Config) -> + read_rsp(Config, aes_256_cfb8, + ["CFB8VarTxt256.rsp", "CFB8VarKey256.rsp", "CFB8GFSbox256.rsp", "CFB8KeySbox256.rsp", + "CFB8MMT256.rsp"]). + + aes_cfb128(Config) -> read_rsp(Config, aes_cfb128, ["CFB128VarTxt128.rsp", "CFB128VarKey128.rsp", "CFB128GFSbox128.rsp", "CFB128KeySbox128.rsp", @@ -2527,14 +2642,30 @@ aes_cfb128(Config) -> "CFB128VarTxt256.rsp", "CFB128VarKey256.rsp", "CFB128GFSbox256.rsp", "CFB128KeySbox256.rsp", "CFB128MMT128.rsp", "CFB128MMT192.rsp", "CFB128MMT256.rsp"]). -blowfish_cbc() -> +aes_128_cfb128(Config) -> + read_rsp(Config, aes_128_cfb128, + ["CFB128VarTxt128.rsp", "CFB128VarKey128.rsp", "CFB128GFSbox128.rsp", "CFB128KeySbox128.rsp", + "CFB128MMT128.rsp"]). + +aes_192_cfb128(Config) -> + read_rsp(Config, aes_192_cfb128, + ["CFB128VarTxt192.rsp", "CFB128VarKey192.rsp", "CFB128GFSbox192.rsp", "CFB128KeySbox192.rsp", + "CFB128MMT192.rsp"]). + +aes_256_cfb128(Config) -> + read_rsp(Config, aes_256_cfb128, + ["CFB128VarTxt256.rsp", "CFB128VarKey256.rsp", "CFB128GFSbox256.rsp", "CFB128KeySbox256.rsp", + "CFB128MMT256.rsp"]). + + +blowfish_cbc(_) -> [{blowfish_cbc, hexstr2bin("0123456789ABCDEFF0E1D2C3B4A59687"), hexstr2bin("FEDCBA9876543210"), hexstr2bin("37363534333231204E6F77206973207468652074696D6520666F722000000000") }]. -blowfish_ecb() -> +blowfish_ecb(_) -> [ {blowfish_ecb, hexstr2bin("0000000000000000"), @@ -2631,26 +2762,26 @@ blowfish_ecb() -> hexstr2bin("FFFFFFFFFFFFFFFF")} ]. -blowfish_cfb64() -> +blowfish_cfb64(_) -> [{blowfish_cfb64, hexstr2bin("0123456789ABCDEFF0E1D2C3B4A59687"), hexstr2bin("FEDCBA9876543210"), hexstr2bin("37363534333231204E6F77206973207468652074696D6520666F722000") }]. -blowfish_ofb64() -> +blowfish_ofb64(_) -> [{blowfish_ofb64, hexstr2bin("0123456789ABCDEFF0E1D2C3B4A59687"), hexstr2bin("FEDCBA9876543210"), hexstr2bin("37363534333231204E6F77206973207468652074696D6520666F722000") }]. -rc4() -> +rc4(_) -> [{rc4, <<"apaapa">>, <<"Yo baby yo">>}, {rc4, <<"apaapa">>, list_to_binary(lists:seq(0, 255))}, {rc4, <<"apaapa">>, long_msg()} ]. -aes_ctr() -> +aes_ctr(_) -> [ %% F.5.3 CTR-AES192.Encrypt {aes_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), @@ -2699,24 +2830,109 @@ aes_ctr() -> ]. +aes_128_ctr(_) -> + [ %% F.5.3 CTR-AES192.Encrypt + {aes_128_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_128_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff00"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_128_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff01"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef") }, + {aes_128_ctr, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff02"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")} + ]. + +aes_192_ctr(_) -> + [ %% F.5.3 CTR-AES192.Encrypt + {aes_192_ctr, hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_192_ctr, hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff00"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_192_ctr, hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff01"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_192_ctr, hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff02"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")} + ]. + +aes_256_ctr(_) -> + [ %% F.5.5 CTR-AES256.Encrypt + {aes_256_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_256_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff00"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_256_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff01"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_256_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdff02"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")}, + + {aes_256_ctr, hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"), + long_msg()} + ]. + + aes_gcm(Config) -> - read_rsp(Config, aes_gcm, + %% RETIRED aes_*_gcm + read_rsp(Config, aes_gcm, + ["gcmDecrypt128.rsp", + "gcmDecrypt192.rsp", + "gcmDecrypt256.rsp", + "gcmEncryptExtIV128.rsp", + "gcmEncryptExtIV192.rsp", + "gcmEncryptExtIV256.rsp"]). + +aes_128_gcm(Config) -> + read_rsp(Config, aes_128_gcm, ["gcmDecrypt128.rsp", - "gcmDecrypt192.rsp", - "gcmDecrypt256.rsp", - "gcmEncryptExtIV128.rsp", - "gcmEncryptExtIV192.rsp", + "gcmEncryptExtIV128.rsp"]). + +aes_192_gcm(Config) -> + read_rsp(Config, aes_192_gcm, + ["gcmDecrypt192.rsp", + "gcmEncryptExtIV192.rsp"]). + +aes_256_gcm(Config) -> + read_rsp(Config, aes_256_gcm, + ["gcmDecrypt256.rsp", "gcmEncryptExtIV256.rsp"]). + aes_ccm(Config) -> - read_rsp(Config, aes_ccm, - ["VADT128.rsp", "VADT192.rsp", "VADT256.rsp", - "VNT128.rsp", "VNT192.rsp", "VNT256.rsp", - "VPT128.rsp", "VPT192.rsp", "VPT256.rsp" - ]). + %% RETIRED aes_*_ccm + read_rsp(Config, aes_ccm, + ["VADT128.rsp", "VADT192.rsp", "VADT256.rsp", + "VNT128.rsp", "VNT192.rsp", "VNT256.rsp", + "VPT128.rsp", "VPT192.rsp", "VPT256.rsp" + ]). + +aes_128_ccm(Config) -> + read_rsp(Config, aes_128_ccm, + ["VADT128.rsp", "VNT128.rsp", "VPT128.rsp"]). + +aes_192_ccm(Config) -> + read_rsp(Config, aes_192_ccm, + ["VADT192.rsp", "VNT192.rsp", "VPT192.rsp"]). + +aes_256_ccm(Config) -> + read_rsp(Config, aes_256_ccm, + ["VADT256.rsp", "VNT256.rsp", "VPT256.rsp"]). + + %% https://tools.ietf.org/html/rfc7539#appendix-A.5 -chacha20_poly1305() -> +chacha20_poly1305(_) -> [ {chacha20_poly1305, hexstr2bin("1c9240a5eb55d38af333888604f6b5f0" %% Key @@ -2763,7 +2979,7 @@ chacha20_poly1305() -> ]. -chacha20() -> +chacha20(_) -> %%% chacha20 (no mode) test vectors from RFC 7539 A.2 [ %% Test Vector #1: @@ -3697,9 +3913,18 @@ parse_rsp(_Type, [], _State, Acc) -> Acc; parse_rsp(_Type, [<<"DECRYPT">>|_], _State, Acc) -> Acc; +parse_rsp(_Type, [<<"ENCRYPT">>|_], _State, Acc) -> + Acc; %% AES format parse_rsp(Type, [<<"COUNT = ", _/binary>>, <<"KEY = ", Key/binary>>, + <<"PLAINTEXT = ", PlainText/binary>>, + <<"CIPHERTEXT = ", CipherText/binary>>|Next], State, Acc) -> + parse_rsp(Type, Next, State, + [{Type, hexstr2bin(Key), + hexstr2bin(PlainText), hexstr2bin(CipherText)}|Acc]); +parse_rsp(Type, [<<"COUNT = ", _/binary>>, + <<"KEY = ", Key/binary>>, <<"IV = ", IV/binary>>, <<"PLAINTEXT = ", PlainText/binary>>, <<"CIPHERTEXT = ", CipherText/binary>>|Next], State, Acc) -> diff --git a/lib/crypto/test/engine_SUITE.erl b/lib/crypto/test/engine_SUITE.erl index 3416fbd78d..41cd132734 100644 --- a/lib/crypto/test/engine_SUITE.erl +++ b/lib/crypto/test/engine_SUITE.erl @@ -148,8 +148,21 @@ end_per_group(_, Config) -> end. %%-------------------------------------------------------------------- -init_per_testcase(_Case, Config) -> - Config. +init_per_testcase(Case, Config) -> + case string:tokens(atom_to_list(Case),"_") of + ["sign","verify",Type|_] -> + skip_if_unsup(list_to_atom(Type), Config); + + ["priv","encrypt","pub","decrypt",Type|_] -> + skip_if_unsup(list_to_atom(Type), Config); + + ["get","pub","from","priv","key",Type|_] -> + skip_if_unsup(list_to_atom(Type), Config); + + _ -> + Config + end. + end_per_testcase(_Case, _Config) -> ok. @@ -851,6 +864,19 @@ get_pub_from_priv_key_ecdsa(Config) -> %%%================================================================ %%% Help for engine_stored_pub_priv_keys* test cases %%% +skip_if_unsup(Type, Config) -> + case pkey_supported(Type) of + false -> + {skip, "Unsupported in this cryptolib"}; + true -> + Config + end. + + +pkey_supported(Type) -> + lists:member(Type, proplists:get_value(public_keys, crypto:supports(), [])). + + load_storage_engine(Config) -> load_storage_engine(Config, []). diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index deba17fb66..0a3d9f45e4 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 4.4.1 +CRYPTO_VSN = 4.4.2 diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index 185c8c9ae6..a168b3c8c5 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -320,9 +320,12 @@ message_to_string({call_to_missing, [M, F, A]}) -> message_to_string({exact_eq, [Type1, Op, Type2]}) -> io_lib:format("The test ~ts ~s ~ts can never evaluate to 'true'\n", [Type1, Op, Type2]); -message_to_string({fun_app_args, [Args, Type]}) -> +message_to_string({fun_app_args, [ArgNs, Args, Type]}) -> + PositionString = form_position_string(ArgNs), io_lib:format("Fun application with arguments ~ts will fail" - " since the function has type ~ts\n", [Args, Type]); + " since the function has type ~ts," + " which differs in the ~s argument\n", + [Args, Type, PositionString]); message_to_string({fun_app_no_fun, [Op, Type, Arity]}) -> io_lib:format("Fun application will fail since ~ts :: ~ts" " is not a function of arity ~w\n", [Op, Type, Arity]); diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 45b4abb253..f7aa167f5c 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -405,8 +405,13 @@ handle_apply(Tree, Map, State) -> t_fun_args(OpType1, 'universe')), case any_none(NewArgs) of true -> + EnumNewArgs = lists:zip(lists:seq(1, length(NewArgs)), + NewArgs), + ArgNs = [Arg || + {Arg, Type} <- EnumNewArgs, t_is_none(Type)], Msg = {fun_app_args, - [format_args(Args, ArgTypes, State), + [ArgNs, + format_args(Args, ArgTypes, State), format_type(OpType, State)]}, State3 = state__add_warning(State2, ?WARN_FAILING_CALL, Tree, Msg), diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 3fe026b096..245c099fef 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -46,6 +46,7 @@ ]). -include("dialyzer.hrl"). +-include("../../compiler/src/core_parse.hrl"). %%-define(DEBUG, true). @@ -751,9 +752,13 @@ pp_hook(Node, Ctxt, Cont) -> map -> pp_map(Node, Ctxt, Cont); literal -> - case is_map(cerl:concrete(Node)) of - true -> pp_map(Node, Ctxt, Cont); - false -> Cont(Node, Ctxt) + case cerl:concrete(Node) of + Map when is_map(Map) -> + pp_map(Node, Ctxt, Cont); + Bitstr when is_bitstring(Bitstr) -> + pp_binary(Node, Ctxt, Cont); + _ -> + Cont(Node, Ctxt) end; _ -> Cont(Node, Ctxt) @@ -761,7 +766,7 @@ pp_hook(Node, Ctxt, Cont) -> pp_binary(Node, Ctxt, Cont) -> prettypr:beside(prettypr:text("<<"), - prettypr:beside(pp_segments(cerl:binary_segments(Node), + prettypr:beside(pp_segments(cerl_binary_segments(Node), Ctxt, Cont), prettypr:text(">>"))). @@ -780,10 +785,29 @@ pp_segment(Node, Ctxt, Cont) -> Unit = cerl:bitstr_unit(Node), Type = cerl:bitstr_type(Node), Flags = cerl:bitstr_flags(Node), - prettypr:beside(Cont(Val, Ctxt), - prettypr:beside(pp_size(Size, Ctxt, Cont), - prettypr:beside(pp_opts(Type, Flags), - pp_unit(Unit, Ctxt, Cont)))). + RestPP = + case {concrete(Unit), concrete(Type), concrete(Flags)} of + {1, integer, [unsigned, big]} -> % Simplify common cases. + case concrete(Size) of + 8 -> prettypr:text(""); + _ -> pp_size(Size, Ctxt, Cont) + end; + {8, binary, [unsigned, big]} -> + SizePP = pp_size(Size, Ctxt, Cont), + prettypr:beside(SizePP, + prettypr:beside(prettypr:text("/"), pp_atom(Type))); + _What -> + SizePP = pp_size(Size, Ctxt, Cont), + UnitPP = pp_unit(Unit, Ctxt, Cont), + OptsPP = pp_opts(Type, Flags), + prettypr:beside(SizePP, prettypr:beside(OptsPP, UnitPP)) + end, + prettypr:beside(Cont(Val, Ctxt), RestPP). + +concrete(Cerl) -> + try cerl:concrete(Cerl) + catch _:_ -> anything_unexpected + end. pp_size(Size, Ctxt, Cont) -> case cerl:is_c_atom(Size) of @@ -859,6 +883,31 @@ seq([H | T], Separator, Ctxt, Fun) -> seq([], _, _, _) -> [prettypr:empty()]. +cerl_binary_segments(#c_literal{val = B}) when is_bitstring(B) -> + segs_from_bitstring(B); +cerl_binary_segments(CBinary) -> + cerl:binary_segments(CBinary). + +%% Copied from core_pp. The function cerl:binary_segments/2 should/could +%% be extended to handle literals, but then the cerl module cannot be +%% HiPE-compiled as of Erlang/OTP 22.0 (due to <<I:N>>). +segs_from_bitstring(<<H,T/bitstring>>) -> + [#c_bitstr{val=#c_literal{val=H}, + size=#c_literal{val=8}, + unit=#c_literal{val=1}, + type=#c_literal{val=integer}, + flags=#c_literal{val=[unsigned,big]}}|segs_from_bitstring(T)]; +segs_from_bitstring(<<>>) -> + []; +segs_from_bitstring(Bitstring) -> + N = bit_size(Bitstring), + <<I:N>> = Bitstring, + [#c_bitstr{val=#c_literal{val=I}, + size=#c_literal{val=N}, + unit=#c_literal{val=1}, + type=#c_literal{val=integer}, + flags=#c_literal{val=[unsigned,big]}}]. + %%------------------------------------------------------------------------------ -spec refold_pattern(cerl:cerl()) -> cerl:cerl(). diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/simple b/lib/dialyzer/test/opaque_SUITE_data/results/simple index 5cd8916aee..0e1bb934e9 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/simple +++ b/lib/dialyzer/test/opaque_SUITE_data/results/simple @@ -63,9 +63,9 @@ simple1_api.erl:381: Invalid type specification for function simple1_api:bool_ad simple1_api.erl:407: The size simple1_adt:i1() breaks the opacity of A simple1_api.erl:418: The attempt to match a term of type non_neg_integer() against the variable A breaks the opacity of simple1_adt:i1() simple1_api.erl:425: The attempt to match a term of type non_neg_integer() against the variable B breaks the opacity of simple1_adt:i1() -simple1_api.erl:432: The pattern <<_:B/integer-unit:1>> can never match the type any() +simple1_api.erl:432: The pattern <<_:B>> can never match the type any() simple1_api.erl:448: The attempt to match a term of type non_neg_integer() against the variable Sz breaks the opacity of simple1_adt:i1() -simple1_api.erl:460: The attempt to match a term of type simple1_adt:bit1() against the pattern <<_/binary-unit:8>> breaks the opacity of the term +simple1_api.erl:460: The attempt to match a term of type simple1_adt:bit1() against the pattern <<_/binary>> breaks the opacity of the term simple1_api.erl:478: The call 'foo':A(A::simple1_adt:a()) breaks the opacity of the term A :: simple1_adt:a() simple1_api.erl:486: The call A:'foo'(A::simple1_adt:a()) breaks the opacity of the term A :: simple1_adt:a() simple1_api.erl:499: The call 'foo':A(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i() diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/asn1 b/lib/dialyzer/test/r9c_SUITE_data/results/asn1 index 1cf03346ee..6e51b972af 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/asn1 +++ b/lib/dialyzer/test/r9c_SUITE_data/results/asn1 @@ -87,7 +87,7 @@ asn1rt_per_bin.erl:2127: Cons will produce an improper list since its 2nd argume asn1rt_per_bin.erl:2129: Cons will produce an improper list since its 2nd argument is integer() asn1rt_per_bin.erl:446: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_bin.erl:467: The variable _ can never match since previous clauses completely covered the type integer() -asn1rt_per_bin.erl:474: The pattern <{_N, <<_:8/integer-unit:1,Bs/binary-unit:8>>}, C> can never match since previous clauses completely covered the type <{0,_},integer()> +asn1rt_per_bin.erl:474: The pattern <{_N, <<_,Bs/binary>>}, C> can never match since previous clauses completely covered the type <{0,_},integer()> asn1rt_per_bin.erl:487: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_bin.erl:498: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_bin_rt2ct.erl:152: The call asn1rt_per_bin_rt2ct:getbit({0,maybe_improper_list()}) will never return since it differs in the 1st argument from the success typing arguments: (<<_:8,_:_*8>> | {non_neg_integer(),<<_:1,_:_*1>>}) @@ -95,7 +95,7 @@ asn1rt_per_bin_rt2ct.erl:1533: The pattern {'BMPString', {'octets', Ol}} can nev asn1rt_per_bin_rt2ct.erl:1875: The pattern {Name, Val} can never match since previous clauses completely covered the type any() asn1rt_per_bin_rt2ct.erl:443: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_bin_rt2ct.erl:464: The variable _ can never match since previous clauses completely covered the type integer() -asn1rt_per_bin_rt2ct.erl:471: The pattern <{_N, <<_B:8/integer-unit:1,Bs/binary-unit:8>>}, C> can never match since previous clauses completely covered the type <{0,_},integer()> +asn1rt_per_bin_rt2ct.erl:471: The pattern <{_N, <<_B,Bs/binary>>}, C> can never match since previous clauses completely covered the type <{0,_},integer()> asn1rt_per_bin_rt2ct.erl:484: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_bin_rt2ct.erl:495: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_v1.erl:1209: The pattern <_, 'true', _> can never match the type <_,'false',_> diff --git a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_responsecontrol.erl b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_responsecontrol.erl index a997db6880..53eeedc29f 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_responsecontrol.erl +++ b/lib/dialyzer/test/r9c_SUITE_data/src/inets/mod_responsecontrol.erl @@ -71,7 +71,7 @@ do_responsecontrol(Info) -> %% If a client sends more then one of the if-XXXX fields in a request -%% The standard says it does not specify the behaviuor so I specified it :-) +%% The standard says it does not specify the behaviour so I specified it :-) %% The priority between the fields is %% 1.If-modified %% 2.If-Unmodified diff --git a/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr b/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr index dbc8241971..797f83956d 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr +++ b/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr @@ -1,9 +1,9 @@ bs_fail_constr.erl:11: Function w3/1 has no local return -bs_fail_constr.erl:12: Binary construction will fail since the size field S in segment 42:S/integer-unit:1 has type neg_integer() +bs_fail_constr.erl:12: Binary construction will fail since the size field S in segment 42:S has type neg_integer() bs_fail_constr.erl:14: Function w4/1 has no local return bs_fail_constr.erl:15: Binary construction will fail since the value field V in segment V/utf32 has type float() bs_fail_constr.erl:5: Function w1/1 has no local return -bs_fail_constr.erl:6: Binary construction will fail since the value field V in segment V:8/integer-unit:1 has type float() +bs_fail_constr.erl:6: Binary construction will fail since the value field V in segment V has type float() bs_fail_constr.erl:8: Function w2/1 has no local return -bs_fail_constr.erl:9: Binary construction will fail since the value field V in segment V/binary-unit:8 has type atom() +bs_fail_constr.erl:9: Binary construction will fail since the value field V in segment V/binary has type atom() diff --git a/lib/dialyzer/test/small_SUITE_data/results/fun_app_args b/lib/dialyzer/test/small_SUITE_data/results/fun_app_args new file mode 100644 index 0000000000..ac153a6fb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/fun_app_args @@ -0,0 +1,3 @@ + +fun_app_args.erl:12: Fun application with arguments ('b',[]) will fail since the function has type 'c' | fun(('a',[]) -> any()), which differs in the 1st argument +fun_app_args.erl:12: The created fun has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring index e148e5cf22..dc3620fcf0 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring +++ b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring @@ -1,3 +1,3 @@ pretty_bitstring.erl:7: Function t/0 has no local return -pretty_bitstring.erl:8: The call binary:copy(#{#<1>(8, 1, 'integer', ['unsigned', 'big']), #<2>(8, 1, 'integer', ['unsigned', 'big']), #<3>(3, 1, 'integer', ['unsigned', 'big'])}#,2) breaks the contract (Subject,N) -> binary() when Subject :: binary(), N :: non_neg_integer() +pretty_bitstring.erl:8: The call binary:copy(<<1,2,3:3>>,2) breaks the contract (Subject,N) -> binary() when Subject :: binary(), N :: non_neg_integer() diff --git a/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash b/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash index 8c9df56a4b..7fd1f304cb 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash +++ b/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash @@ -3,12 +3,12 @@ tuple_set_crash.erl:103: Invalid type specification for function tuple_set_crash tuple_set_crash.erl:123: Invalid type specification for function tuple_set_crash:parse_video_target_info/1. The success typing is (<<_:48>>) -> [{'status',byte()} | {'target_id',non_neg_integer()},...] tuple_set_crash.erl:127: Invalid type specification for function tuple_set_crash:parse_audio_target_info/1. The success typing is (<<_:48>>) -> [{'master_volume',char()} | {'status',byte()} | {'target_id',non_neg_integer()},...] tuple_set_crash.erl:138: Invalid type specification for function tuple_set_crash:parse_av_device_info/1. The success typing is (<<_:48>>) -> [{'address',byte()} | {'device_id',non_neg_integer()} | {'model',binary()} | {'status',byte()},...] -tuple_set_crash.erl:143: The pattern <<TargetId:32/integer-little-unit:1,Rest1/binary-unit:8>> can never match the type <<_:8>> +tuple_set_crash.erl:143: The pattern <<TargetId:32/integer-little-unit:1,Rest1/binary>> can never match the type <<_:8>> tuple_set_crash.erl:155: Invalid type specification for function tuple_set_crash:parse_video_output_info/1. The success typing is (<<_:48>>) -> [{'audio_volume',char()} | {'display_type',binary()} | {'output_id',non_neg_integer()},...] -tuple_set_crash.erl:160: The pattern <<DeviceId:32/integer-little-unit:1,Rest1/binary-unit:8>> can never match the type <<_:8>> +tuple_set_crash.erl:160: The pattern <<DeviceId:32/integer-little-unit:1,Rest1/binary>> can never match the type <<_:8>> tuple_set_crash.erl:171: Invalid type specification for function tuple_set_crash:parse_audio_output_info/1. The success typing is (<<_:48>>) -> [{'output_id',non_neg_integer()},...] -tuple_set_crash.erl:176: The pattern <<DeviceId:32/integer-little-unit:1,Rest1/binary-unit:8>> can never match the type <<_:8>> -tuple_set_crash.erl:179: The pattern <<AudioVolume:16/integer-little-unit:1,Rest2/binary-unit:8>> can never match the type <<_:8>> -tuple_set_crash.erl:182: The pattern <<Delay:16/integer-little-unit:1,_Padding/binary-unit:8>> can never match the type <<_:8>> +tuple_set_crash.erl:176: The pattern <<DeviceId:32/integer-little-unit:1,Rest1/binary>> can never match the type <<_:8>> +tuple_set_crash.erl:179: The pattern <<AudioVolume:16/integer-little-unit:1,Rest2/binary>> can never match the type <<_:8>> +tuple_set_crash.erl:182: The pattern <<Delay:16/integer-little-unit:1,_Padding/binary>> can never match the type <<_:8>> tuple_set_crash.erl:62: The pattern {'play_list', _Playlist} can never match the type 'ok' | {'device_properties',[{atom(),_}]} | {'error',[{atom(),_}]} tuple_set_crash.erl:64: The pattern {'error', 17} can never match the type 'ok' | {'device_properties',[{atom(),_}]} | {'error',[{atom(),_}]} diff --git a/lib/dialyzer/test/small_SUITE_data/src/fun_app_args.erl b/lib/dialyzer/test/small_SUITE_data/src/fun_app_args.erl new file mode 100644 index 0000000000..b4409bc550 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/fun_app_args.erl @@ -0,0 +1,12 @@ +-module(fun_app_args). + +-export([t/1]). + +-type ft() :: fun((a, []) -> any()). + +-record(r, { + h = c :: c | ft() +}). + +t(#r{h = H}) -> + fun(_) -> (H)(b, []) end. diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml index 5777225ae7..8dcba93273 100644 --- a/lib/diameter/doc/src/notes.xml +++ b/lib/diameter/doc/src/notes.xml @@ -43,6 +43,23 @@ first.</p> <!-- ===================================================================== --> +<section><title>diameter 2.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix inadvertently broad monitor that resulted in + gen_server cast messages to hidden nodes from module + diameter_dist.</p> + <p> + Own Id: OTP-15768</p> + </item> + </list> + </section> + +</section> + <section><title>diameter 2.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/diameter/src/base/diameter_dist.erl b/lib/diameter/src/base/diameter_dist.erl index 5c29ea95a4..ed23152b8b 100644 --- a/lib/diameter/src/base/diameter_dist.erl +++ b/lib/diameter/src/base/diameter_dist.erl @@ -454,7 +454,8 @@ start_link() -> init([]) -> ets:new(?NODE_TABLE, [set, named_table]), ets:new(?SERVICE_TABLE, [bag, named_table]), - ok = net_kernel:monitor_nodes(true, [{node_type, all}, nodedown_reason]), + ok = net_kernel:monitor_nodes(true, [{node_type, visible}, + nodedown_reason]), ets:insert(?NODE_TABLE, [{?B(N), N} || N <- [node() | nodes()]]), abcast({attach, node()}), {ok, sets:new()}. @@ -521,5 +522,14 @@ terminate(_, _) -> %% code_change/3 +%% Old code inadvertently monitored all nodes: start a new +%% subscription and remove the old one. +code_change(_OldVsn, State, "2.2") -> + ok = net_kernel:monitor_nodes(true, [{node_type, visible}, + nodedown_reason]), + ok = net_kernel:monitor_nodes(false, [{node_type, all}, + nodedown_reason]), + {ok, State}; + code_change(_OldVsn, State, _Extra) -> {ok, State}. diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index 52263633fb..bb2a4a8e92 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -61,7 +61,8 @@ {"2.1.4", [{restart_application, diameter}]}, %% 20.3 {"2.1.4.1", [{restart_application, diameter}]}, %% 20.3.8.19 {"2.1.5", [{restart_application, diameter}]}, %% 21.0 - {"2.1.6", [{restart_application, diameter}]} %% 21.1 + {"2.1.6", [{restart_application, diameter}]}, %% 21.1 + {"2.2", [{update, diameter_dist, {advanced, "2.2"}}]} %% 21.3 ], [ {"0.9", [{restart_application, diameter}]}, @@ -104,6 +105,7 @@ {"2.1.4", [{restart_application, diameter}]}, {"2.1.4.1", [{restart_application, diameter}]}, {"2.1.5", [{restart_application, diameter}]}, - {"2.1.6", [{restart_application, diameter}]} + {"2.1.6", [{restart_application, diameter}]}, + {"2.2", [{restart_application, diameter}]} ] }. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index a900e8f28e..a8fbca5bc8 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -17,5 +17,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 2.2 +DIAMETER_VSN = 2.2.1 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/edoc/doc/edoc.dtd b/lib/edoc/doc/edoc.dtd new file mode 120000 index 0000000000..43f4b27db6 --- /dev/null +++ b/lib/edoc/doc/edoc.dtd @@ -0,0 +1 @@ +../priv/edoc.dtd
\ No newline at end of file diff --git a/lib/edoc/doc/edoc_doclet.hrl b/lib/edoc/doc/edoc_doclet.hrl new file mode 120000 index 0000000000..4623b18bb4 --- /dev/null +++ b/lib/edoc/doc/edoc_doclet.hrl @@ -0,0 +1 @@ +../include/edoc_doclet.hrl
\ No newline at end of file diff --git a/lib/edoc/doc/src/Makefile b/lib/edoc/doc/src/Makefile index aba94a6802..3e53e75c75 100644 --- a/lib/edoc/doc/src/Makefile +++ b/lib/edoc/doc/src/Makefile @@ -79,6 +79,11 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +INCLUDES_DIR = ../../include +INCLUDES = $(INCLUDES_DIR)/edoc_doclet.hrl + +DTDS_DIR = ../../priv +DTDS = $(DTDS_DIR)/edoc.dtd # ---------------------------------------------------- # FLAGS @@ -135,5 +140,6 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" + $(INSTALL_DATA) $(INCLUDES) $(DTDS) "$(RELSYSDIR)/doc/html" release_spec: diff --git a/lib/edoc/include/edoc_doclet.hrl b/lib/edoc/include/edoc_doclet.hrl index 1429ee5971..a05a9cb2bc 100644 --- a/lib/edoc/include/edoc_doclet.hrl +++ b/lib/edoc/include/edoc_doclet.hrl @@ -43,7 +43,7 @@ %% @type no_app(). %% A value used to mark absence of an Erlang application %% context. Use the macro `NO_APP' defined in -%% <a href="../include/edoc_doclet.hrl">`edoc_doclet.hrl'</a> +%% <a href="edoc_doclet.hrl">`edoc_doclet.hrl'</a> %% to produce this value. %% @type doclet_gen() = #doclet_gen{sources = [string()], diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index e9d62d3283..62483602aa 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -734,7 +734,7 @@ get_doc(File) -> %% %% @type edoc_module(). The EDoc documentation data for a module, %% expressed as an XML document in {@link //xmerl. XMerL} format. See -%% the file <a href="../priv/edoc.dtd">`edoc.dtd'</a> for details. +%% the file <a href="edoc.dtd">`edoc.dtd'</a> for details. %% %% @doc Reads a source code file and extracts EDoc documentation data. %% Note that without an environment parameter (see {@link get_doc/3}), diff --git a/lib/edoc/src/edoc_data.erl b/lib/edoc/src/edoc_data.erl index 7c077d3acd..a8373d6536 100644 --- a/lib/edoc/src/edoc_data.erl +++ b/lib/edoc/src/edoc_data.erl @@ -345,6 +345,8 @@ deprecated(Repl, Env) -> deprecated(Desc) -> [{deprecated, description(Desc)}]. +-dialyzer({no_match, replacement_function/2}). + replacement_function(M0, {M,F,A}) when is_list(A) -> %% refer to the largest listed arity - the most general version replacement_function(M0, {M,F,lists:last(lists:sort(A))}); diff --git a/lib/edoc/src/edoc_doclet.erl b/lib/edoc/src/edoc_doclet.erl index 6cb3095507..604291374a 100644 --- a/lib/edoc/src/edoc_doclet.erl +++ b/lib/edoc/src/edoc_doclet.erl @@ -62,7 +62,7 @@ %% @spec (Command::doclet_gen() | doclet_toc(), edoc_context()) -> ok %% @doc Main doclet entry point. See the file <a -%% href="../include/edoc_doclet.hrl">`edoc_doclet.hrl'</a> for the data +%% href="edoc_doclet.hrl">`edoc_doclet.hrl'</a> for the data %% structures used for passing parameters. %% %% Also see {@link edoc:layout/2} for layout-related options, and diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 6497922852..9b7e254dfe 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -957,20 +957,20 @@ do_modify_dn_0(Data, Entry, NewRDN, DelOldRDN, NewSup, Controls) -> do_unbind(Data) -> Req = "", log2(Data, "unbind request = ~p (has no reply)~n", [Req]), - case Data#eldap.using_tls of - true -> - send_request(Data#eldap.fd, Data, Data#eldap.id, {unbindRequest, Req}), - ssl:close(Data#eldap.fd); - false -> - OldTrapExit = process_flag(trap_exit, true), - catch send_request(Data#eldap.fd, Data, Data#eldap.id, {unbindRequest, Req}), - catch gen_tcp:close(Data#eldap.fd), - receive - {'EXIT', _From, _Reason} -> ok - after 0 -> ok - end, - process_flag(trap_exit, OldTrapExit) - end, + _ = case Data#eldap.using_tls of + true -> + send_request(Data#eldap.fd, Data, Data#eldap.id, {unbindRequest, Req}), + ssl:close(Data#eldap.fd); + false -> + OldTrapExit = process_flag(trap_exit, true), + catch send_request(Data#eldap.fd, Data, Data#eldap.id, {unbindRequest, Req}), + catch gen_tcp:close(Data#eldap.fd), + receive + {'EXIT', _From, _Reason} -> ok + after 0 -> ok + end, + process_flag(trap_exit, OldTrapExit) + end, {no_reply, Data#eldap{binddn = (#eldap{})#eldap.binddn, passwd = (#eldap{})#eldap.passwd, fd = (#eldap{})#eldap.fd, @@ -1130,7 +1130,7 @@ ldap_closed_p(Data, Emsg) when Data#eldap.using_tls == true -> %% Check if the SSL socket seems to be alive or not case catch ssl:sockname(Data#eldap.fd) of {error, _} -> - ssl:close(Data#eldap.fd), + _ = ssl:close(Data#eldap.fd), {error, ldap_closed}; {ok, _} -> {error, Emsg}; diff --git a/lib/erl_docgen/priv/dtd/book.dtd b/lib/erl_docgen/priv/dtd/book.dtd index aa07d38658..326bf3369a 100644 --- a/lib/erl_docgen/priv/dtd/book.dtd +++ b/lib/erl_docgen/priv/dtd/book.dtd @@ -30,7 +30,7 @@ insidecover?, pagetext, preamble, - (applications|parts|headline|pagetext)+, + (applications|parts|internals|headline|pagetext)+, (listoffigures?, listoftables?, listofterms?, @@ -56,6 +56,7 @@ <!ELEMENT applications (include)* > <!ELEMENT parts (title?,description?,(include|onepart)*) > <!ATTLIST parts lift (yes|no) "no" > +<!ELEMENT internals (include)* > <!ELEMENT headline (#PCDATA) > <!ELEMENT index EMPTY > <!ELEMENT listoffigures EMPTY > diff --git a/lib/erl_docgen/priv/dtd/common.dtd b/lib/erl_docgen/priv/dtd/common.dtd index b1578ad9d4..0ccd52068b 100644 --- a/lib/erl_docgen/priv/dtd/common.dtd +++ b/lib/erl_docgen/priv/dtd/common.dtd @@ -25,7 +25,7 @@ <!ENTITY % block "p|pre|code|list|taglist|codeinclude| erleval" > <!ENTITY % inline "#PCDATA|c|i|em|strong|term|cite|br|path|seealso| - url|marker|anno" > + url|marker|anno|image" > <!-- XXX --> <!ELEMENT p (%inline;)* > <!ELEMENT pre (#PCDATA|seealso|url|input|anno)* > diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl index c9be926e1e..18bc8cd1cf 100644 --- a/lib/erl_docgen/priv/xsl/db_html.xsl +++ b/lib/erl_docgen/priv/xsl/db_html.xsl @@ -836,6 +836,10 @@ <!-- .../part --> <xsl:call-template name="part.content" /> </xsl:if> + <xsl:if test="$lname = 'internal'"> + <!-- .../internals --> + <xsl:call-template name="internal.content" /> + </xsl:if> <xsl:if test="$lname = 'chapter'"> <!-- .../part/chapter --> <xsl:call-template name="chapter.content"> @@ -859,12 +863,24 @@ <xsl:param name="chapnum"/> <xsl:param name="curModule"/> <xsl:if test="(local-name() = 'part') or ((local-name() = 'chapter') and ancestor::part)"> - <!-- .../part or.../part/chapter --> + <!-- .../part or .../part/chapter --> <xsl:call-template name="menu.ug"> <xsl:with-param name="chapnum" select="$chapnum"/> </xsl:call-template> </xsl:if> - <xsl:if test="(local-name() = 'application') or (local-name() = 'erlref')or (local-name() = 'comref')or (local-name() = 'cref')or (local-name() = 'fileref')or (local-name() = 'appref')"> + <xsl:if test="(local-name() = 'internal' and descendant::chapter) or ((local-name() = 'chapter') and ancestor::internal)"> + <!-- .../internal or .../internal/chapter --> + <xsl:call-template name="menu.internal.ug"> + <xsl:with-param name="chapnum" select="$chapnum"/> + </xsl:call-template> + </xsl:if> + <xsl:if test="(local-name() = 'internal' and descendant::erlref) or (((local-name() = 'erlref') or (local-name() = 'comref') or (local-name() = 'cref') or (local-name() = 'fileref') or (local-name() = 'appref')) and ancestor::internal)"> + <!-- .../internal,.../internal/erlref, .../internal/comref or .../internal/cref or .../internal/fileref or .../internal/appref --> + <xsl:call-template name="menu.internal.ref"> + <xsl:with-param name="curModule" select="$curModule"/> + </xsl:call-template> + </xsl:if> + <xsl:if test="(local-name() = 'application') or (((local-name() = 'erlref') or (local-name() = 'comref') or (local-name() = 'cref') or (local-name() = 'fileref') or (local-name() = 'appref')) and ancestor::application)"> <!-- .../application,.../application/erlref, .../application/comref or .../application/cref or .../application/fileref or .../application/appref --> <xsl:call-template name="menu.ref"> <xsl:with-param name="curModule" select="$curModule"/> @@ -902,6 +918,9 @@ <xsl:if test="boolean(/book/applications)"> <li><a href="index.html">Reference Manual</a></li> </xsl:if> + <xsl:if test="boolean(/book/internals)"> + <li><a href="internal_docs.html">Internal Documentation</a></li> + </xsl:if> <xsl:if test="boolean(/book/releasenotes)"> <li><a href="release_notes.html">Release Notes</a></li> </xsl:if> @@ -942,6 +961,7 @@ <xsl:template match="/book"> <xsl:apply-templates select="parts"/> <xsl:apply-templates select="applications"/> + <xsl:apply-templates select="internals"/> <xsl:apply-templates select="releasenotes"/> </xsl:template> @@ -955,6 +975,11 @@ <xsl:apply-templates select="application"/> </xsl:template> + <!-- Internals --> + <xsl:template match="internals"> + <xsl:apply-templates select="internal"/> + </xsl:template> + <!-- Header --> <xsl:template match="header"/> @@ -1311,6 +1336,90 @@ </xsl:template> + <!-- Internal Docs --> + + <!-- Part --> + <xsl:template match="internal"> + + <xsl:document href="{$outdir}/internal_docs.html" method="html" encoding="UTF-8" indent="yes" doctype-public="-//W3C//DTD HTML 4.01 Transitional//EN"> + <xsl:call-template name="pagelayout"/> + </xsl:document> + </xsl:template> + + + <!-- Part content--> + <xsl:template name="internal.content"> + <div class="frontpage"/> + + <center><h1><xsl:value-of select="/book/header/title"/> Internal Docs</h1></center> + + <center><h4>Version <xsl:value-of select="$appver"/></h4></center> + <center><h4><xsl:value-of select="$gendate"/></h4></center> + <div class="extrafrontpageinfo"> + <center><xsl:value-of select="$extra_front_page_info"/></center> + </div> + + <xsl:apply-templates select="chapter|erlref"/> + + </xsl:template> + + <!-- Menu.internal.chapter --> + <xsl:template name="menu.internal.ug"> + <xsl:param name="chapnum"/> + + <div id="leftnav"> + <div class="innertube"> + + <xsl:call-template name="erlang_logo"/> + + <p class="section-title"><xsl:value-of select="/book/header/title"/></p> + <p class="section-subtitle">Internal Documentation</p> + <p class="section-version">Version <xsl:value-of select="$appver"/></p> + + <xsl:call-template name="menu_top"/> + + <xsl:call-template name="menu_middle"/> + + <h3>Chapters</h3> + + <ul class="flipMenu" imagepath="{$topdocdir}/js/flipmenu"> + <xsl:call-template name="menu.chapter"> + <xsl:with-param name="entries" select="/book/internals/internal/chapter[header/title]"/> + <xsl:with-param name="chapnum" select="$chapnum"/> + </xsl:call-template> + </ul> + </div> + </div> + </xsl:template> + + <!-- Menu.internal.ref --> + <xsl:template name="menu.internal.ref"> + <xsl:param name="curModule"/> + <div id="leftnav"> + <div class="innertube"> + + <xsl:call-template name="erlang_logo"/> + + <p class="section-title"><xsl:value-of select="/book/header/title"/></p> + <p class="section-subtitle">Reference Manual</p> + <p class="section-version">Version <xsl:value-of select="$appver"/></p> + + <xsl:call-template name="menu_top"/> + + <xsl:call-template name="menu_middle"/> + + <h3>Table of Contents</h3> + + <ul class="flipMenu"> + <xsl:call-template name="menu.ref2"> + <xsl:with-param name="entries" select="/book/internals/internal/erlref[module]|/book/internals/internal/cref[lib]|/book/internals/internal/comref[com]|/book/internals/internal/fileref[file]|/book/internals/internal/appref[app]"/> + <!--xsl:with-param name="genFuncMenu" select="true"/--> + <xsl:with-param name="curModule" select="$curModule"/> + </xsl:call-template> + </ul> + </div> + </div> + </xsl:template> <!--Users Guide --> diff --git a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl index d562cfddcc..5342d02947 100644 --- a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl +++ b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl @@ -1260,11 +1260,14 @@ get_text(#xmlElement{content=[E]}) -> %% text_and_name_only(Es) -> {N, Ts} text_and_a_name_only(Es) -> - [Name|_] = [Name || - #xmlElement{ - name = a, - attributes = [#xmlAttribute{name=name}]}=Name <- Es], - {Name#xmlElement{content = []}, text_only(Es)}. + case [Name || #xmlElement{ + name = a, + attributes = [#xmlAttribute{name=name}]}=Name <- Es] of + [Name|_] -> + {Name#xmlElement{content = []}, text_only(Es)}; + [] -> + {"", text_only(Es)} + end. %% text_only(Es) -> Ts %% Takes a list of xmlElement and xmlText and return a lists of xmlText. diff --git a/lib/erl_docgen/src/docgen_xmerl_xml_cb.erl b/lib/erl_docgen/src/docgen_xmerl_xml_cb.erl index 59d4dccfb7..9d69143c3c 100644 --- a/lib/erl_docgen/src/docgen_xmerl_xml_cb.erl +++ b/lib/erl_docgen/src/docgen_xmerl_xml_cb.erl @@ -87,6 +87,7 @@ convert_tag(underline, Attrs) -> {em, Attrs}; convert_tag(Tag, Attrs) -> {Tag, Attrs}. is_url("http:"++_) -> true; +is_url("https:"++_) -> true; is_url("../"++_) -> true; is_url(FileRef) -> case filename:extension(FileRef) of diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml index f081ca926a..7808bfd94f 100644 --- a/lib/erl_interface/doc/src/ei.xml +++ b/lib/erl_interface/doc/src/ei.xml @@ -183,6 +183,43 @@ typedef enum { </func> <func> + <name since="OTP @OTP-15712@"><ret>int</ret><nametext>ei_decode_bitstring(const char *buf, int *index, const char **pp, unsigned int *bitoffsp, size_t *nbitsp)</nametext></name> + <fsummary>Decode a bitstring.</fsummary> + <desc> + <p>Decodes a bit string from the binary format.</p> + <taglist> + <tag><c>pp</c></tag> + <item><p>Either <c>NULL</c> or <c>*pp</c> returns a pointer to + the first byte of the bit string. The returned bit string is + readable as long as the buffer pointed to by <c>buf</c> is + readable and not written to.</p> + </item> + <tag><c>bitoffsp</c></tag> + <item><p>Either <c>NULL</c> or <c>*bitoffsp</c> returns the + number of unused bits in the first byte pointed to by + <c>*pp</c>. The value of <c>*bitoffsp</c> is between 0 and 7. + Unused bits in the first byte are the most significant bits.</p> + </item> + <tag><c>nbitsp</c></tag> + <item><p>Either <c>NULL</c> or <c>*nbitsp</c> returns the length + of the bit string in <em>bits</em>.</p> + </item> + </taglist> + <p>Returns <c>0</c> if it was a bit string term.</p> + <p>The number of <em>bytes</em> pointed to by <c>*pp</c>, which are + part of the bit string, is <c>(*bitoffsp + *nbitsp + 7)/8</c>. If + <c>(*bitoffsp + *bitsp)%8 > 0</c> then only <c>(*bitoffsp + + *bitsp)%8</c> bits of the last byte are used. Unused bits in + the last byte are the least significant bits.</p> + <p>The values of unused bits in the first and last byte are undefined + and cannot be relied on.</p> + <p>Number of bits may be divisible by 8, which means a binary + decodable by <c>ei_decode_binary</c> is also decodable by + <c>ei_decode_bitstring</c>.</p> + </desc> + </func> + + <func> <name since=""><ret>int</ret><nametext>ei_decode_boolean(const char *buf, int *index, int *p)</nametext></name> <fsummary>Decode a boolean.</fsummary> <desc> @@ -349,8 +386,10 @@ typedef enum { <c>t</c> is actually an <c>ETERM**</c> (see <seealso marker="erl_eterm"><c>erl_eterm</c></seealso>). The term is later to be deallocated.</p> - <p>Notice that this function is located in the <c>Erl_Interface</c> - library.</p> + <note><p>This function is deprecated as of OTP 22 and will be removed in + OTP 23 together with the old legacy <c>erl_interface</c> library (functions + with prefix <c>erl_</c>).</p> + </note> </desc> </func> @@ -459,6 +498,28 @@ typedef enum { </func> <func> + <name since="OTP @OTP-15712@"><ret>int</ret> + <nametext>ei_encode_bitstring(char *buf, int *index, const char *p, size_t bitoffs, size_t nbits)</nametext></name> + <name since="OTP @OTP-15712@"><ret>int</ret> + <nametext>ei_x_encode_bitstring(ei_x_buff* x, const char *p, size_t bitoffs, size_t nbits)</nametext></name> + <fsummary>Encode a bitstring.</fsummary> + <desc> + <p>Encodes a bit string in the binary format.</p> + <p>The data is at <c>p</c>. The length of the bit string is <c>nbits</c> + bits. The first <c>bitoffs</c> bits of the data at <c>p</c> are unused. + The first byte which is part of the bit string is + <c>p[bitoffs/8]</c>. The <c>bitoffs%8</c> most significant bits of + the first byte <c>p[bitoffs/8]</c> are unused.</p> + <p>The number of bytes which is part of the bit string is <c>(bitoffs + + nbits + 7)/8</c>. If <c>(bitoffs + nbits)%8 > 0</c> then only <c>(bitoffs + + nbits)%8</c> bits of the last byte are used. Unused bits in + the last byte are the least significant bits.</p> + <p>The values of unused bits are disregarded and does not need to be + cleared.</p> + </desc> + </func> + + <func> <name since=""><ret>int</ret><nametext>ei_encode_boolean(char *buf, int *index, int p)</nametext></name> <name since=""><ret>int</ret><nametext>ei_x_encode_boolean(ei_x_buff* x, int p)</nametext></name> <fsummary>Encode a boolean.</fsummary> @@ -656,6 +717,10 @@ ei_x_encode_string(&x, "Banana");</pre> <c>erl_interface</c>. Parameter <c>t</c> is actually an <c>ETERM</c> pointer. This function does not free the <c>ETERM</c>.</p> + <note><p>These functions are deprecated as of OTP 22 and will be removed in + OTP 23 together with the old legacy <c>erl_interface</c> library + (functions with prefix <c>erl_</c>).</p> + </note> </desc> </func> <func> @@ -725,12 +790,12 @@ ei_encode_tuple_header(buf, &i, 0);</pre> <name since=""><ret>int</ret><nametext>ei_get_type(const char *buf, const int *index, int *type, int *size)</nametext></name> <fsummary>Fetch the type and size of an encoded term.</fsummary> <desc> - <p>Returns the type in <c>type</c> and size in - <c>size</c> of the encoded term. For strings and atoms, + <p>Returns the type in <c>*type</c> and size in + <c>*size</c> of the encoded term. For strings and atoms, size is the number of characters <em>not</em> including the - terminating <c>NULL</c>. For binaries, <c>size</c> is the number of - bytes. For lists and tuples, <c>size</c> is the arity of - the object. For other types, <c>size</c> is 0. In all + terminating <c>NULL</c>. For binaries and bitstrings, <c>*size</c> is + the number of bytes. For lists, tuples and maps, <c>*size</c> is the + arity of the object. For other types, <c>*size</c> is 0. In all cases, <c>index</c> is left unchanged.</p> </desc> </func> diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml index 32d28b853b..fc6a1bb548 100644 --- a/lib/erl_interface/doc/src/notes.xml +++ b/lib/erl_interface/doc/src/notes.xml @@ -31,6 +31,22 @@ </header> <p>This document describes the changes made to the Erl_interface application.</p> +<section><title>Erl_Interface 3.11.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix handling of Makefile dependencies so that parallel + make works properly.</p> + <p> + Own Id: OTP-15757</p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.11.1</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -153,6 +169,22 @@ </section> +<section><title>Erl_Interface 3.10.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix handling of Makefile dependencies so that parallel + make works properly.</p> + <p> + Own Id: OTP-15757</p> + </item> + </list> + </section> + +</section> + <section><title>Erl_Interface 3.10.2.1</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -1603,4 +1635,3 @@ </section> </section> </chapter> - diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h index aa2a49098f..ed0420300d 100644 --- a/lib/erl_interface/include/ei.h +++ b/lib/erl_interface/include/ei.h @@ -154,11 +154,14 @@ typedef LONG_PTR ssize_t; /* Sigh... */ #define ERL_STRING_EXT 'k' #define ERL_LIST_EXT 'l' #define ERL_BINARY_EXT 'm' +#define ERL_BIT_BINARY_EXT 'M' #define ERL_SMALL_BIG_EXT 'n' #define ERL_LARGE_BIG_EXT 'o' #define ERL_NEW_FUN_EXT 'p' #define ERL_MAP_EXT 't' #define ERL_FUN_EXT 'u' +#define ERL_EXPORT_EXT 'q' + #define ERL_NEW_CACHE 'N' /* c nodes don't know these two */ #define ERL_CACHED_ATOM 'C' @@ -269,15 +272,23 @@ typedef struct { typedef struct { long arity; char module[MAXATOMLEN_UTF8]; - erlang_char_encoding module_org_enc; - char md5[16]; - long index; - long old_index; - long uniq; - long n_free_vars; - erlang_pid pid; - long free_var_len; - char* free_vars; + enum { EI_FUN_CLOSURE, EI_FUN_EXPORT } type; + union { + struct { + char md5[16]; + long index; + long old_index; + long uniq; + long n_free_vars; + erlang_pid pid; + long free_var_len; + char* free_vars; + } closure; + struct { + char* func; + int func_allocated; + } exprt; + } u; } erlang_fun; /* a big */ @@ -515,7 +526,9 @@ int ei_x_encode_atom_len(ei_x_buff* x, const char* s, int len); int ei_x_encode_atom_len_as(ei_x_buff* x, const char* s, int len, erlang_char_encoding from, erlang_char_encoding to); int ei_encode_binary(char *buf, int *index, const void *p, long len); +int ei_encode_bitstring(char *buf, int *index, const char *p, size_t bitoffs, size_t bits); int ei_x_encode_binary(ei_x_buff* x, const void* s, int len); +int ei_x_encode_bitstring(ei_x_buff* x, const char* p, size_t bitoffs, size_t bits); int ei_encode_pid(char *buf, int *index, const erlang_pid *p); int ei_x_encode_pid(ei_x_buff* x, const erlang_pid* pid); int ei_encode_fun(char* buf, int* index, const erlang_fun* p); @@ -524,8 +537,8 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p); int ei_x_encode_port(ei_x_buff* x, const erlang_port *p); int ei_encode_ref(char *buf, int *index, const erlang_ref *p); int ei_x_encode_ref(ei_x_buff* x, const erlang_ref *p); -int ei_encode_term(char *buf, int *index, void *t); /* ETERM* actually */ -int ei_x_encode_term(ei_x_buff* x, void* t); +int ei_encode_term(char *buf, int *index, void *t) EI_DEPRECATED_ATTR; +int ei_x_encode_term(ei_x_buff* x, void* t) EI_DEPRECATED_ATTR; int ei_encode_trace(char *buf, int *index, const erlang_trace *p); int ei_x_encode_trace(ei_x_buff* x, const erlang_trace *p); int ei_encode_tuple_header(char *buf, int *index, int arity); @@ -547,8 +560,6 @@ int ei_x_encode_map_header(ei_x_buff* x, long n); */ int ei_get_type(const char *buf, const int *index, int *type, int *size); -int ei_get_type_internal(const char *buf, const int *index, int *type, - int *size); /* Step through buffer, decoding the given type into the buffer * provided. On success, 0 is returned and index is updated to point @@ -567,12 +578,15 @@ int ei_decode_string(const char *buf, int *index, char *p); int ei_decode_atom(const char *buf, int *index, char *p); int ei_decode_atom_as(const char *buf, int *index, char *p, int destlen, erlang_char_encoding want, erlang_char_encoding* was, erlang_char_encoding* result); int ei_decode_binary(const char *buf, int *index, void *p, long *len); +int ei_decode_bitstring(const char *buf, int *index, const char** pp, + unsigned int* bitoffsp, size_t *nbitsp); + int ei_decode_fun(const char* buf, int* index, erlang_fun* p); void free_fun(erlang_fun* f); int ei_decode_pid(const char *buf, int *index, erlang_pid *p); int ei_decode_port(const char *buf, int *index, erlang_port *p); int ei_decode_ref(const char *buf, int *index, erlang_ref *p); -int ei_decode_term(const char *buf, int *index, void *t); /* ETERM** actually */ +int ei_decode_term(const char *buf, int *index, void *t) EI_DEPRECATED_ATTR; int ei_decode_trace(const char *buf, int *index, erlang_trace *p); int ei_decode_tuple_header(const char *buf, int *index, int *arity); int ei_decode_list_header(const char *buf, int *index, int *arity); diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in index b2600f0fab..6e0d3476c7 100644 --- a/lib/erl_interface/src/Makefile.in +++ b/lib/erl_interface/src/Makefile.in @@ -784,29 +784,31 @@ $(MDD_OBJDIR)/ei_fake_prog_mdd_cxx$(EXE): prog/ei_fake_prog.c $(MDD_EILIB) # Create dependency file using gcc -MM ########################################################################### -depend: +depend: $(TARGET)/depend.mk + +$(TARGET)/depend.mk: $(TARGET)/config.h $(gen_verbose) - $(V_colon)@echo "Generating dependency file depend.mk..." - @echo "# Generated dependency rules" > depend.mk; \ - $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ + $(V_colon)echo "Generating dependency file depend.mk..." + @echo "# Generated dependency rules" > $@ + $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ sed 's&$(TARGET)&\$$\(TARGET\)&g' | \ - sed 's/^.*:/\$$\(ST_OBJDIR\)\/&/' >> depend.mk; \ - echo >> depend.mk; \ - $(CC) $(CFLAGS) -MM $(SOURCES) | \ + sed 's/^.*:/\$$\(ST_OBJDIR\)\/&/' >> $@ + @echo >> $@ + $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ sed 's&$(TARGET)&\$$\(TARGET\)&g' | \ - sed 's/^.*:/\$$\(MT_OBJDIR\)\/&/' >> depend.mk; \ - echo >> depend.mk; \ - $(CC) $(CFLAGS) -MM $(SOURCES) | \ + sed 's/^.*:/\$$\(MT_OBJDIR\)\/&/' >> $@ + @echo >> $@ + $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ sed 's&$(TARGET)&\$$\(TARGET\)&g' | \ - sed 's/^.*:/\$$\(MD_OBJDIR\)\/&/' >> depend.mk; \ - echo >> depend.mk; \ - $(CC) $(CFLAGS) -MM $(SOURCES) | \ + sed 's/^.*:/\$$\(MD_OBJDIR\)\/&/' >> $@ + @echo >> $@ + $(V_CC) $(CFLAGS) -MM $(SOURCES) | \ sed 's&$(TARGET)&\$$\(TARGET\)&g' | \ - sed 's/^.*:/\$$\(MDD_OBJDIR\)\/&/' >> depend.mk; \ - echo >> depend.mk + sed 's/^.*:/\$$\(MDD_OBJDIR\)\/&/' >> $@ + @echo >> $@ # For some reason this has to be after 'opt' target -include depend.mk +-include $(TARGET)/depend.mk # ---------------------------------------------------- # Release Target diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 7a304e6d4f..0cbad235cc 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -1846,6 +1846,7 @@ static int send_name_or_challenge(ei_socket_callbacks *cbs, const char* function[] = {"SEND_NAME", "SEND_CHALLENGE"}; int err; ssize_t len; + unsigned int flags; if (f_chall) siz += 4; @@ -1867,7 +1868,7 @@ static int send_name_or_challenge(ei_socket_callbacks *cbs, } put8(s, 'n'); put16be(s, version); - put32be(s, (DFLAG_EXTENDED_REFERENCES + flags = (DFLAG_EXTENDED_REFERENCES | DFLAG_DIST_MONITOR | DFLAG_EXTENDED_PIDS_PORTS | DFLAG_FUN_TAGS @@ -1876,7 +1877,14 @@ static int send_name_or_challenge(ei_socket_callbacks *cbs, | DFLAG_SMALL_ATOM_TAGS | DFLAG_UTF8_ATOMS | DFLAG_MAP_TAG - | DFLAG_BIG_CREATION)); + | DFLAG_BIG_CREATION + | DFLAG_EXPORT_PTR_TAG + | DFLAG_BIT_BINARIES); + if (ei_internal_use_21_bitstr_expfun()) { + flags &= ~(DFLAG_EXPORT_PTR_TAG + | DFLAG_BIT_BINARIES); + } + put32be(s, flags); if (f_chall) put32be(s, challenge); memcpy(s, nodename, strlen(nodename)); @@ -1941,8 +1949,7 @@ static int recv_challenge(ei_socket_callbacks *cbs, void *ctx, goto error; } - if (!(*flags & DFLAG_EXTENDED_PIDS_PORTS) - && !ei_internal_use_r9_pids_ports()) { + if (!(*flags & DFLAG_EXTENDED_PIDS_PORTS)) { EI_TRACE_ERR0("recv_challenge","<- RECV_CHALLENGE peer cannot " "handle extended pids and ports"); erl_errno = EIO; @@ -2236,8 +2243,7 @@ static int recv_name(ei_socket_callbacks *cbs, void *ctx, goto error; } - if (!(*flags & DFLAG_EXTENDED_PIDS_PORTS) - && !ei_internal_use_r9_pids_ports()) { + if (!(*flags & DFLAG_EXTENDED_PIDS_PORTS)) { EI_TRACE_ERR0("recv_name","<- RECV_NAME peer cannot " "handle extended pids and ports"); erl_errno = EIO; diff --git a/lib/erl_interface/src/connect/ei_connect_int.h b/lib/erl_interface/src/connect/ei_connect_int.h index 0bcccaa84b..b41a5f2b23 100644 --- a/lib/erl_interface/src/connect/ei_connect_int.h +++ b/lib/erl_interface/src/connect/ei_connect_int.h @@ -102,6 +102,8 @@ extern int h_errno; #define DFLAG_FUN_TAGS 16 #define DFLAG_NEW_FUN_TAGS 0x80 #define DFLAG_EXTENDED_PIDS_PORTS 0x100 +#define DFLAG_EXPORT_PTR_TAG 0x200 +#define DFLAG_BIT_BINARIES 0x400 #define DFLAG_NEW_FLOATS 0x800 #define DFLAG_SMALL_ATOM_TAGS 0x4000 #define DFLAG_UTF8_ATOMS 0x10000 diff --git a/lib/erl_interface/src/decode/decode_binary.c b/lib/erl_interface/src/decode/decode_binary.c index 5b8d234984..0d28c67230 100644 --- a/lib/erl_interface/src/decode/decode_binary.c +++ b/lib/erl_interface/src/decode/decode_binary.c @@ -40,4 +40,41 @@ int ei_decode_binary(const char *buf, int *index, void *p, long *lenp) return 0; } +int ei_decode_bitstring(const char *buf, int *index, + const char** pp, + unsigned int* bitoffsp, + size_t *nbitsp) +{ + const char *s = buf + *index; + const char *s0 = s; + unsigned char last_bits; + const unsigned char tag = get8(s); + size_t len = get32be(s); + + switch(tag) { + case ERL_BINARY_EXT: + if (nbitsp) + *nbitsp = len * 8; + break; + case ERL_BIT_BINARY_EXT: + last_bits = get8(s); + if (((last_bits==0) != (len==0)) || last_bits > 8) + return -1; + + if (nbitsp) + *nbitsp = (len == 0) ? 0 : ((len-1) * 8) + last_bits; + break; + default: + return -1; + } + + if (pp) + *pp = s; + if (bitoffsp) + *bitoffsp = 0; + + s += len; + *index += s-s0; + return 0; +} diff --git a/lib/erl_interface/src/decode/decode_fun.c b/lib/erl_interface/src/decode/decode_fun.c index f944c028af..3a7a2b01c1 100644 --- a/lib/erl_interface/src/decode/decode_fun.c +++ b/lib/erl_interface/src/decode/decode_fun.c @@ -33,22 +33,20 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) int i, ix, ix0, n; erlang_pid* p_pid; char* p_module; - erlang_char_encoding* p_module_org_enc; long* p_index; long* p_uniq; long* p_old_index; if (p != NULL) { - p_pid = &p->pid; + p_pid = &p->u.closure.pid; p_module = &p->module[0]; - p_module_org_enc = &p->module_org_enc; - p_index = &p->index; - p_uniq = &p->uniq; - p_old_index = &p->old_index; + p_index = &p->u.closure.index; + p_uniq = &p->u.closure.uniq; + p_old_index = &p->u.closure.old_index; } else { - p_pid = NULL; p_module = NULL; p_module_org_enc = NULL; p_index = NULL; p_uniq = NULL; p_old_index = NULL; + p_pid = NULL; p_module = NULL; } switch (get8(s)) { @@ -63,7 +61,7 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) return -1; /* then the module (atom) */ if (ei_decode_atom_as(s, &ix, p_module, MAXATOMLEN_UTF8, ERLANG_UTF8, - p_module_org_enc, NULL) < 0) + NULL, NULL) < 0) return -1; /* then the index */ if (ei_decode_long(s, &ix, p_index) < 0) @@ -78,11 +76,11 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) return -1; } if (p != NULL) { - p->n_free_vars = n; - p->free_var_len = ix - ix0; - p->free_vars = ei_malloc(ix - ix0); - if (!(p->free_vars)) return -1; - memcpy(p->free_vars, s + ix0, ix - ix0); + p->u.closure.n_free_vars = n; + p->u.closure.free_var_len = ix - ix0; + p->u.closure.free_vars = ei_malloc(ix - ix0); + if (!(p->u.closure.free_vars)) return -1; + memcpy(p->u.closure.free_vars, s + ix0, ix - ix0); } s += ix; *index += s-s0; @@ -93,20 +91,23 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) n = get32be(s); /* then the arity */ i = get8(s); - if (p != NULL) p->arity = i; - /* then md5 */ - if (p != NULL) memcpy(p->md5, s, 16); + if (p != NULL) { + p->type = EI_FUN_CLOSURE; + p->arity = i; + /* then md5 */ + memcpy(p->u.closure.md5, s, 16); + } s += 16; /* then index */ i = get32be(s); - if (p != NULL) p->index = i; + if (p != NULL) p->u.closure.index = i; /* then the number of free vars (environment) */ i = get32be(s); - if (p != NULL) p->n_free_vars = i; + if (p != NULL) p->u.closure.n_free_vars = i; /* then the module (atom) */ ix = 0; if (ei_decode_atom_as(s, &ix, p_module, MAXATOMLEN_UTF8, ERLANG_UTF8, - p_module_org_enc, NULL) < 0) + NULL, NULL) < 0) return -1; /* then the old_index */ if (ei_decode_long(s, &ix, p_old_index) < 0) @@ -122,17 +123,56 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) n = n - (s - s0) + 1; if (n < 0) return -1; if (p != NULL) { - p->free_var_len = n; + p->u.closure.free_var_len = n; if (n > 0) { - p->free_vars = malloc(n); - if (!(p->free_vars)) return -1; - memcpy(p->free_vars, s, n); + p->u.closure.free_vars = malloc(n); + if (!(p->u.closure.free_vars)) return -1; + memcpy(p->u.closure.free_vars, s, n); } } s += n; *index += s-s0; return 0; break; + case ERL_EXPORT_EXT: { + char* p_func; + long* p_arity; + int used; + + if (p) { + p->type = EI_FUN_EXPORT; + p_arity = &p->arity; + } + else { + p_arity = NULL; + } + if (ei_decode_atom_as(s, &ix, p_module, MAXATOMLEN_UTF8, ERLANG_UTF8, + NULL, NULL) < 0) + return -1; + if (p) { + /* try use module buffer for function name */ + used = strlen(p->module) + 1; + p_func = p->module + used; + p->u.exprt.func = p_func; + p->u.exprt.func_allocated = 0; + } + else { + used = 0; + p_func = NULL; + } + while (ei_decode_atom_as(s, &ix, p_func, MAXATOMLEN_UTF8-used, + ERLANG_UTF8, NULL, NULL) < 0) { + if (!used) + return -1; + p_func = malloc(MAXATOMLEN_UTF8); + p->u.exprt.func = p_func; + p->u.exprt.func_allocated = 1; + used = 0; + } + if (ei_decode_long(s, &ix, p_arity) < 0) + return -1; + return 0; + } default: return -1; } @@ -140,6 +180,14 @@ int ei_decode_fun(const char *buf, int *index, erlang_fun *p) void free_fun(erlang_fun* f) { - if (f->free_var_len > 0) - ei_free(f->free_vars); + switch (f->type) { + case EI_FUN_CLOSURE: + if (f->u.closure.free_var_len > 0) + ei_free(f->u.closure.free_vars); + break; + case EI_FUN_EXPORT: + if (f->u.exprt.func_allocated) + ei_free(f->u.exprt.func); + break; + } } diff --git a/lib/erl_interface/src/decode/decode_skip.c b/lib/erl_interface/src/decode/decode_skip.c index 0db315f09b..736c00e074 100644 --- a/lib/erl_interface/src/decode/decode_skip.c +++ b/lib/erl_interface/src/decode/decode_skip.c @@ -27,7 +27,7 @@ int ei_skip_term(const char* buf, int* index) /* ASSERT(ep != NULL); */ - ei_get_type_internal(buf, index, &ty, &n); + ei_get_type(buf, index, &ty, &n); switch (ty) { case ERL_ATOM_EXT: /* FIXME: what if some weird locale is in use? */ @@ -54,7 +54,7 @@ int ei_skip_term(const char* buf, int* index) if (ei_decode_list_header(buf, index, &n) < 0) return -1; for (i = 0; i < n; ++i) ei_skip_term(buf, index); - if (ei_get_type_internal(buf, index, &ty, &n) < 0) return -1; + if (ei_get_type(buf, index, &ty, &n) < 0) return -1; if (ty != ERL_NIL_EXT) ei_skip_term(buf, index); else @@ -79,6 +79,10 @@ int ei_skip_term(const char* buf, int* index) if (ei_decode_binary(buf, index, NULL, NULL) < 0) return -1; break; + case ERL_BIT_BINARY_EXT: + if (ei_decode_bitstring(buf, index, NULL, NULL, NULL) < 0) + return -1; + break; case ERL_SMALL_INTEGER_EXT: case ERL_INTEGER_EXT: if (ei_decode_long(buf, index, NULL) < 0) return -1; diff --git a/lib/erl_interface/src/depend.mk b/lib/erl_interface/src/depend.mk deleted file mode 100644 index af753046e5..0000000000 --- a/lib/erl_interface/src/depend.mk +++ /dev/null @@ -1,1133 +0,0 @@ -# Generated dependency rules -$(ST_OBJDIR)/ei_connect.o: connect/ei_connect.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h misc/eiext.h misc/ei_portio.h \ - misc/ei_internal.h connect/ei_connect_int.h misc/ei_locking.h \ - connect/eisend.h connect/eirecv.h misc/eimd5.h misc/putget.h \ - connect/ei_resolve.h epmd/ei_epmd.h -$(ST_OBJDIR)/ei_resolve.o: connect/ei_resolve.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h connect/ei_resolve.h misc/ei_locking.h -$(ST_OBJDIR)/eirecv.o: connect/eirecv.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eirecv.h misc/ei_portio.h \ - misc/ei_internal.h misc/putget.h misc/ei_trace.h misc/show_msg.h -$(ST_OBJDIR)/send.o: connect/send.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(ST_OBJDIR)/send_exit.o: connect/send_exit.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/ei_connect_int.h misc/ei_trace.h \ - misc/ei_internal.h misc/putget.h misc/show_msg.h -$(ST_OBJDIR)/send_reg.o: connect/send_reg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(ST_OBJDIR)/decode_atom.o: decode/decode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_big.o: decode/decode_big.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_bignum.o: decode/decode_bignum.c $(TARGET)/config.h -$(ST_OBJDIR)/decode_binary.o: decode/decode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_boolean.o: decode/decode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_char.o: decode/decode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_double.o: decode/decode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_fun.o: decode/decode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_malloc.h decode/decode_skip.h misc/putget.h -$(ST_OBJDIR)/decode_intlist.o: decode/decode_intlist.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_list_header.o: decode/decode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_long.o: decode/decode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_pid.o: decode/decode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_port.o: decode/decode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_ref.o: decode/decode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_skip.o: decode/decode_skip.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - decode/decode_skip.h -$(ST_OBJDIR)/decode_string.o: decode/decode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_trace.o: decode/decode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(ST_OBJDIR)/decode_tuple_header.o: decode/decode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_ulong.o: decode/decode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_version.o: decode/decode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_longlong.o: decode/decode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/decode_ulonglong.o: decode/decode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_atom.o: encode/encode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_bignum.o: encode/encode_bignum.c $(TARGET)/config.h -$(ST_OBJDIR)/encode_binary.o: encode/encode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_boolean.o: encode/encode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_char.o: encode/encode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_double.o: encode/encode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_fun.o: encode/encode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_list_header.o: encode/encode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_long.o: encode/encode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_pid.o: encode/encode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_port.o: encode/encode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_ref.o: encode/encode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_string.o: encode/encode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_trace.o: encode/encode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(ST_OBJDIR)/encode_tuple_header.o: encode/encode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_ulong.o: encode/encode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_version.o: encode/encode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(ST_OBJDIR)/encode_longlong.o: encode/encode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(ST_OBJDIR)/encode_ulonglong.o: encode/encode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(ST_OBJDIR)/epmd_port.o: epmd/epmd_port.c misc/ei_internal.h epmd/ei_epmd.h \ - misc/putget.h -$(ST_OBJDIR)/epmd_publish.o: epmd/epmd_publish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(ST_OBJDIR)/epmd_unpublish.o: epmd/epmd_unpublish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(ST_OBJDIR)/ei_decode_term.o: misc/ei_decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_decode_term.h misc/putget.h -$(ST_OBJDIR)/ei_format.o: misc/ei_format.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_malloc.h misc/ei_format.h -$(ST_OBJDIR)/ei_locking.o: misc/ei_locking.c $(TARGET)/config.h \ - misc/ei_malloc.h misc/ei_locking.h -$(ST_OBJDIR)/ei_malloc.o: misc/ei_malloc.c misc/ei_malloc.h -$(ST_OBJDIR)/ei_portio.o: misc/ei_portio.c misc/ei_portio.h misc/ei_internal.h -$(ST_OBJDIR)/ei_printterm.o: misc/ei_printterm.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_printterm.h misc/ei_malloc.h -$(ST_OBJDIR)/ei_pthreads.o: misc/ei_pthreads.c $(TARGET)/config.h \ - ../include/ei.h misc/ei_locking.h -$(ST_OBJDIR)/ei_trace.o: misc/ei_trace.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_trace.h -$(ST_OBJDIR)/ei_x_encode.o: misc/ei_x_encode.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_x_encode.h \ - misc/ei_malloc.h -$(ST_OBJDIR)/eimd5.o: misc/eimd5.c misc/eimd5.h -$(ST_OBJDIR)/get_type.o: misc/get_type.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h -$(ST_OBJDIR)/show_msg.o: misc/show_msg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h misc/ei_printterm.h \ - misc/ei_internal.h misc/show_msg.h -$(ST_OBJDIR)/ei_compat.o: misc/ei_compat.c ../include/ei.h misc/ei_internal.h -$(ST_OBJDIR)/hash_dohash.o: registry/hash_dohash.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_foreach.o: registry/hash_foreach.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_freetab.o: registry/hash_freetab.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_insert.o: registry/hash_insert.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_isprime.o: registry/hash_isprime.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_lookup.o: registry/hash_lookup.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_newtab.o: registry/hash_newtab.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_remove.o: registry/hash_remove.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_resize.o: registry/hash_resize.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/hash_rlookup.o: registry/hash_rlookup.c registry/hash.h ../include/ei.h -$(ST_OBJDIR)/reg_close.o: registry/reg_close.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_delete.o: registry/reg_delete.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_dirty.o: registry/reg_dirty.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_dump.o: registry/reg_dump.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(ST_OBJDIR)/reg_free.o: registry/reg_free.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_get.o: registry/reg_get.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_getf.o: registry/reg_getf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_geti.o: registry/reg_geti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_getp.o: registry/reg_getp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_gets.o: registry/reg_gets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_make.o: registry/reg_make.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_open.o: registry/reg_open.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_purge.o: registry/reg_purge.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_resize.o: registry/reg_resize.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_restore.o: registry/reg_restore.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(ST_OBJDIR)/reg_set.o: registry/reg_set.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_setf.o: registry/reg_setf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_seti.o: registry/reg_seti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_setp.o: registry/reg_setp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_sets.o: registry/reg_sets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_stat.o: registry/reg_stat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/reg_tabstat.o: registry/reg_tabstat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(ST_OBJDIR)/decode_term.o: legacy/decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h ../include/erl_interface.h -$(ST_OBJDIR)/encode_term.o: legacy/encode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h ../include/erl_interface.h \ - legacy/erl_marshal.h legacy/erl_eterm.h legacy/portability.h -$(ST_OBJDIR)/erl_connect.o: legacy/erl_connect.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_config.h \ - legacy/erl_connect.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h misc/putget.h connect/ei_connect_int.h \ - misc/ei_locking.h epmd/ei_epmd.h misc/ei_internal.h -$(ST_OBJDIR)/erl_error.o: legacy/erl_error.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_error.h -$(ST_OBJDIR)/erl_eterm.o: legacy/erl_eterm.c misc/ei_locking.h \ - $(TARGET)/config.h connect/ei_resolve.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_eterm.h \ - legacy/portability.h legacy/erl_malloc.h legacy/erl_marshal.h \ - legacy/erl_error.h legacy/erl_internal.h misc/ei_internal.h -$(ST_OBJDIR)/erl_fix_alloc.o: legacy/erl_fix_alloc.c $(TARGET)/config.h \ - misc/ei_locking.h ../include/erl_interface.h ../include/ei.h \ - legacy/erl_error.h legacy/erl_malloc.h legacy/erl_fix_alloc.h \ - legacy/erl_eterm.h legacy/portability.h -$(ST_OBJDIR)/erl_format.o: legacy/erl_format.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h legacy/erl_error.h legacy/erl_internal.h -$(ST_OBJDIR)/erl_malloc.o: legacy/erl_malloc.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_fix_alloc.h legacy/erl_malloc.h \ - legacy/erl_internal.h legacy/erl_eterm.h legacy/portability.h \ - misc/ei_malloc.h -$(ST_OBJDIR)/erl_marshal.o: legacy/erl_marshal.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_marshal.h \ - legacy/erl_eterm.h legacy/portability.h legacy/erl_malloc.h \ - legacy/erl_error.h legacy/erl_internal.h misc/eiext.h misc/putget.h -$(ST_OBJDIR)/erl_timeout.o: legacy/erl_timeout.c $(TARGET)/config.h \ - legacy/erl_timeout.h -$(ST_OBJDIR)/global_names.o: legacy/global_names.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(ST_OBJDIR)/global_register.o: legacy/global_register.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h ../include/erl_interface.h -$(ST_OBJDIR)/global_unregister.o: legacy/global_unregister.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(ST_OBJDIR)/global_whereis.o: legacy/global_whereis.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h - -$(MT_OBJDIR)/ei_connect.o: connect/ei_connect.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h misc/eiext.h misc/ei_portio.h \ - misc/ei_internal.h connect/ei_connect_int.h misc/ei_locking.h \ - connect/eisend.h connect/eirecv.h misc/eimd5.h misc/putget.h \ - connect/ei_resolve.h epmd/ei_epmd.h -$(MT_OBJDIR)/ei_resolve.o: connect/ei_resolve.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h connect/ei_resolve.h misc/ei_locking.h -$(MT_OBJDIR)/eirecv.o: connect/eirecv.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eirecv.h misc/ei_portio.h \ - misc/ei_internal.h misc/putget.h misc/ei_trace.h misc/show_msg.h -$(MT_OBJDIR)/send.o: connect/send.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(MT_OBJDIR)/send_exit.o: connect/send_exit.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/ei_connect_int.h misc/ei_trace.h \ - misc/ei_internal.h misc/putget.h misc/show_msg.h -$(MT_OBJDIR)/send_reg.o: connect/send_reg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(MT_OBJDIR)/decode_atom.o: decode/decode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_big.o: decode/decode_big.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_bignum.o: decode/decode_bignum.c $(TARGET)/config.h -$(MT_OBJDIR)/decode_binary.o: decode/decode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_boolean.o: decode/decode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_char.o: decode/decode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_double.o: decode/decode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_fun.o: decode/decode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_malloc.h decode/decode_skip.h misc/putget.h -$(MT_OBJDIR)/decode_intlist.o: decode/decode_intlist.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_list_header.o: decode/decode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_long.o: decode/decode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_pid.o: decode/decode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_port.o: decode/decode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_ref.o: decode/decode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_skip.o: decode/decode_skip.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - decode/decode_skip.h -$(MT_OBJDIR)/decode_string.o: decode/decode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_trace.o: decode/decode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(MT_OBJDIR)/decode_tuple_header.o: decode/decode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_ulong.o: decode/decode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_version.o: decode/decode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_longlong.o: decode/decode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/decode_ulonglong.o: decode/decode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_atom.o: encode/encode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_bignum.o: encode/encode_bignum.c $(TARGET)/config.h -$(MT_OBJDIR)/encode_binary.o: encode/encode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_boolean.o: encode/encode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_char.o: encode/encode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_double.o: encode/encode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_fun.o: encode/encode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_list_header.o: encode/encode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_long.o: encode/encode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_pid.o: encode/encode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_port.o: encode/encode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_ref.o: encode/encode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_string.o: encode/encode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_trace.o: encode/encode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(MT_OBJDIR)/encode_tuple_header.o: encode/encode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_ulong.o: encode/encode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_version.o: encode/encode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MT_OBJDIR)/encode_longlong.o: encode/encode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(MT_OBJDIR)/encode_ulonglong.o: encode/encode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(MT_OBJDIR)/epmd_port.o: epmd/epmd_port.c misc/ei_internal.h epmd/ei_epmd.h \ - misc/putget.h -$(MT_OBJDIR)/epmd_publish.o: epmd/epmd_publish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(MT_OBJDIR)/epmd_unpublish.o: epmd/epmd_unpublish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(MT_OBJDIR)/ei_decode_term.o: misc/ei_decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_decode_term.h misc/putget.h -$(MT_OBJDIR)/ei_format.o: misc/ei_format.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_malloc.h misc/ei_format.h -$(MT_OBJDIR)/ei_locking.o: misc/ei_locking.c $(TARGET)/config.h \ - misc/ei_malloc.h misc/ei_locking.h -$(MT_OBJDIR)/ei_malloc.o: misc/ei_malloc.c misc/ei_malloc.h -$(MT_OBJDIR)/ei_portio.o: misc/ei_portio.c misc/ei_portio.h misc/ei_internal.h -$(MT_OBJDIR)/ei_printterm.o: misc/ei_printterm.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_printterm.h misc/ei_malloc.h -$(MT_OBJDIR)/ei_pthreads.o: misc/ei_pthreads.c $(TARGET)/config.h \ - ../include/ei.h misc/ei_locking.h -$(MT_OBJDIR)/ei_trace.o: misc/ei_trace.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_trace.h -$(MT_OBJDIR)/ei_x_encode.o: misc/ei_x_encode.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_x_encode.h \ - misc/ei_malloc.h -$(MT_OBJDIR)/eimd5.o: misc/eimd5.c misc/eimd5.h -$(MT_OBJDIR)/get_type.o: misc/get_type.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h -$(MT_OBJDIR)/show_msg.o: misc/show_msg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h misc/ei_printterm.h \ - misc/ei_internal.h misc/show_msg.h -$(MT_OBJDIR)/ei_compat.o: misc/ei_compat.c ../include/ei.h misc/ei_internal.h -$(MT_OBJDIR)/hash_dohash.o: registry/hash_dohash.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_foreach.o: registry/hash_foreach.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_freetab.o: registry/hash_freetab.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_insert.o: registry/hash_insert.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_isprime.o: registry/hash_isprime.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_lookup.o: registry/hash_lookup.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_newtab.o: registry/hash_newtab.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_remove.o: registry/hash_remove.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_resize.o: registry/hash_resize.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/hash_rlookup.o: registry/hash_rlookup.c registry/hash.h ../include/ei.h -$(MT_OBJDIR)/reg_close.o: registry/reg_close.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_delete.o: registry/reg_delete.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_dirty.o: registry/reg_dirty.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_dump.o: registry/reg_dump.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(MT_OBJDIR)/reg_free.o: registry/reg_free.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_get.o: registry/reg_get.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_getf.o: registry/reg_getf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_geti.o: registry/reg_geti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_getp.o: registry/reg_getp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_gets.o: registry/reg_gets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_make.o: registry/reg_make.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_open.o: registry/reg_open.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_purge.o: registry/reg_purge.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_resize.o: registry/reg_resize.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_restore.o: registry/reg_restore.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(MT_OBJDIR)/reg_set.o: registry/reg_set.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_setf.o: registry/reg_setf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_seti.o: registry/reg_seti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_setp.o: registry/reg_setp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_sets.o: registry/reg_sets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_stat.o: registry/reg_stat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/reg_tabstat.o: registry/reg_tabstat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MT_OBJDIR)/decode_term.o: legacy/decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h ../include/erl_interface.h -$(MT_OBJDIR)/encode_term.o: legacy/encode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h ../include/erl_interface.h \ - legacy/erl_marshal.h legacy/erl_eterm.h legacy/portability.h -$(MT_OBJDIR)/erl_connect.o: legacy/erl_connect.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_config.h \ - legacy/erl_connect.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h misc/putget.h connect/ei_connect_int.h \ - misc/ei_locking.h epmd/ei_epmd.h misc/ei_internal.h -$(MT_OBJDIR)/erl_error.o: legacy/erl_error.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_error.h -$(MT_OBJDIR)/erl_eterm.o: legacy/erl_eterm.c misc/ei_locking.h \ - $(TARGET)/config.h connect/ei_resolve.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_eterm.h \ - legacy/portability.h legacy/erl_malloc.h legacy/erl_marshal.h \ - legacy/erl_error.h legacy/erl_internal.h misc/ei_internal.h -$(MT_OBJDIR)/erl_fix_alloc.o: legacy/erl_fix_alloc.c $(TARGET)/config.h \ - misc/ei_locking.h ../include/erl_interface.h ../include/ei.h \ - legacy/erl_error.h legacy/erl_malloc.h legacy/erl_fix_alloc.h \ - legacy/erl_eterm.h legacy/portability.h -$(MT_OBJDIR)/erl_format.o: legacy/erl_format.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h legacy/erl_error.h legacy/erl_internal.h -$(MT_OBJDIR)/erl_malloc.o: legacy/erl_malloc.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_fix_alloc.h legacy/erl_malloc.h \ - legacy/erl_internal.h legacy/erl_eterm.h legacy/portability.h \ - misc/ei_malloc.h -$(MT_OBJDIR)/erl_marshal.o: legacy/erl_marshal.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_marshal.h \ - legacy/erl_eterm.h legacy/portability.h legacy/erl_malloc.h \ - legacy/erl_error.h legacy/erl_internal.h misc/eiext.h misc/putget.h -$(MT_OBJDIR)/erl_timeout.o: legacy/erl_timeout.c $(TARGET)/config.h \ - legacy/erl_timeout.h -$(MT_OBJDIR)/global_names.o: legacy/global_names.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(MT_OBJDIR)/global_register.o: legacy/global_register.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h ../include/erl_interface.h -$(MT_OBJDIR)/global_unregister.o: legacy/global_unregister.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(MT_OBJDIR)/global_whereis.o: legacy/global_whereis.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h - -$(MD_OBJDIR)/ei_connect.o: connect/ei_connect.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h misc/eiext.h misc/ei_portio.h \ - misc/ei_internal.h connect/ei_connect_int.h misc/ei_locking.h \ - connect/eisend.h connect/eirecv.h misc/eimd5.h misc/putget.h \ - connect/ei_resolve.h epmd/ei_epmd.h -$(MD_OBJDIR)/ei_resolve.o: connect/ei_resolve.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h connect/ei_resolve.h misc/ei_locking.h -$(MD_OBJDIR)/eirecv.o: connect/eirecv.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eirecv.h misc/ei_portio.h \ - misc/ei_internal.h misc/putget.h misc/ei_trace.h misc/show_msg.h -$(MD_OBJDIR)/send.o: connect/send.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(MD_OBJDIR)/send_exit.o: connect/send_exit.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/ei_connect_int.h misc/ei_trace.h \ - misc/ei_internal.h misc/putget.h misc/show_msg.h -$(MD_OBJDIR)/send_reg.o: connect/send_reg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(MD_OBJDIR)/decode_atom.o: decode/decode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_big.o: decode/decode_big.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_bignum.o: decode/decode_bignum.c $(TARGET)/config.h -$(MD_OBJDIR)/decode_binary.o: decode/decode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_boolean.o: decode/decode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_char.o: decode/decode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_double.o: decode/decode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_fun.o: decode/decode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_malloc.h decode/decode_skip.h misc/putget.h -$(MD_OBJDIR)/decode_intlist.o: decode/decode_intlist.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_list_header.o: decode/decode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_long.o: decode/decode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_pid.o: decode/decode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_port.o: decode/decode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_ref.o: decode/decode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_skip.o: decode/decode_skip.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - decode/decode_skip.h -$(MD_OBJDIR)/decode_string.o: decode/decode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_trace.o: decode/decode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(MD_OBJDIR)/decode_tuple_header.o: decode/decode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_ulong.o: decode/decode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_version.o: decode/decode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_longlong.o: decode/decode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/decode_ulonglong.o: decode/decode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_atom.o: encode/encode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_bignum.o: encode/encode_bignum.c $(TARGET)/config.h -$(MD_OBJDIR)/encode_binary.o: encode/encode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_boolean.o: encode/encode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_char.o: encode/encode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_double.o: encode/encode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_fun.o: encode/encode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_list_header.o: encode/encode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_long.o: encode/encode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_pid.o: encode/encode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_port.o: encode/encode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_ref.o: encode/encode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_string.o: encode/encode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_trace.o: encode/encode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(MD_OBJDIR)/encode_tuple_header.o: encode/encode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_ulong.o: encode/encode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_version.o: encode/encode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MD_OBJDIR)/encode_longlong.o: encode/encode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(MD_OBJDIR)/encode_ulonglong.o: encode/encode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(MD_OBJDIR)/epmd_port.o: epmd/epmd_port.c misc/ei_internal.h epmd/ei_epmd.h \ - misc/putget.h -$(MD_OBJDIR)/epmd_publish.o: epmd/epmd_publish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(MD_OBJDIR)/epmd_unpublish.o: epmd/epmd_unpublish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(MD_OBJDIR)/ei_decode_term.o: misc/ei_decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_decode_term.h misc/putget.h -$(MD_OBJDIR)/ei_format.o: misc/ei_format.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_malloc.h misc/ei_format.h -$(MD_OBJDIR)/ei_locking.o: misc/ei_locking.c $(TARGET)/config.h \ - misc/ei_malloc.h misc/ei_locking.h -$(MD_OBJDIR)/ei_malloc.o: misc/ei_malloc.c misc/ei_malloc.h -$(MD_OBJDIR)/ei_portio.o: misc/ei_portio.c misc/ei_portio.h misc/ei_internal.h -$(MD_OBJDIR)/ei_printterm.o: misc/ei_printterm.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_printterm.h misc/ei_malloc.h -$(MD_OBJDIR)/ei_pthreads.o: misc/ei_pthreads.c $(TARGET)/config.h \ - ../include/ei.h misc/ei_locking.h -$(MD_OBJDIR)/ei_trace.o: misc/ei_trace.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_trace.h -$(MD_OBJDIR)/ei_x_encode.o: misc/ei_x_encode.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_x_encode.h \ - misc/ei_malloc.h -$(MD_OBJDIR)/eimd5.o: misc/eimd5.c misc/eimd5.h -$(MD_OBJDIR)/get_type.o: misc/get_type.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h -$(MD_OBJDIR)/show_msg.o: misc/show_msg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h misc/ei_printterm.h \ - misc/ei_internal.h misc/show_msg.h -$(MD_OBJDIR)/ei_compat.o: misc/ei_compat.c ../include/ei.h misc/ei_internal.h -$(MD_OBJDIR)/hash_dohash.o: registry/hash_dohash.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_foreach.o: registry/hash_foreach.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_freetab.o: registry/hash_freetab.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_insert.o: registry/hash_insert.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_isprime.o: registry/hash_isprime.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_lookup.o: registry/hash_lookup.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_newtab.o: registry/hash_newtab.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_remove.o: registry/hash_remove.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_resize.o: registry/hash_resize.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/hash_rlookup.o: registry/hash_rlookup.c registry/hash.h ../include/ei.h -$(MD_OBJDIR)/reg_close.o: registry/reg_close.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_delete.o: registry/reg_delete.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_dirty.o: registry/reg_dirty.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_dump.o: registry/reg_dump.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(MD_OBJDIR)/reg_free.o: registry/reg_free.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_get.o: registry/reg_get.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_getf.o: registry/reg_getf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_geti.o: registry/reg_geti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_getp.o: registry/reg_getp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_gets.o: registry/reg_gets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_make.o: registry/reg_make.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_open.o: registry/reg_open.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_purge.o: registry/reg_purge.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_resize.o: registry/reg_resize.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_restore.o: registry/reg_restore.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(MD_OBJDIR)/reg_set.o: registry/reg_set.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_setf.o: registry/reg_setf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_seti.o: registry/reg_seti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_setp.o: registry/reg_setp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_sets.o: registry/reg_sets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_stat.o: registry/reg_stat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/reg_tabstat.o: registry/reg_tabstat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MD_OBJDIR)/decode_term.o: legacy/decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h ../include/erl_interface.h -$(MD_OBJDIR)/encode_term.o: legacy/encode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h ../include/erl_interface.h \ - legacy/erl_marshal.h legacy/erl_eterm.h legacy/portability.h -$(MD_OBJDIR)/erl_connect.o: legacy/erl_connect.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_config.h \ - legacy/erl_connect.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h misc/putget.h connect/ei_connect_int.h \ - misc/ei_locking.h epmd/ei_epmd.h misc/ei_internal.h -$(MD_OBJDIR)/erl_error.o: legacy/erl_error.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_error.h -$(MD_OBJDIR)/erl_eterm.o: legacy/erl_eterm.c misc/ei_locking.h \ - $(TARGET)/config.h connect/ei_resolve.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_eterm.h \ - legacy/portability.h legacy/erl_malloc.h legacy/erl_marshal.h \ - legacy/erl_error.h legacy/erl_internal.h misc/ei_internal.h -$(MD_OBJDIR)/erl_fix_alloc.o: legacy/erl_fix_alloc.c $(TARGET)/config.h \ - misc/ei_locking.h ../include/erl_interface.h ../include/ei.h \ - legacy/erl_error.h legacy/erl_malloc.h legacy/erl_fix_alloc.h \ - legacy/erl_eterm.h legacy/portability.h -$(MD_OBJDIR)/erl_format.o: legacy/erl_format.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h legacy/erl_error.h legacy/erl_internal.h -$(MD_OBJDIR)/erl_malloc.o: legacy/erl_malloc.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_fix_alloc.h legacy/erl_malloc.h \ - legacy/erl_internal.h legacy/erl_eterm.h legacy/portability.h \ - misc/ei_malloc.h -$(MD_OBJDIR)/erl_marshal.o: legacy/erl_marshal.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_marshal.h \ - legacy/erl_eterm.h legacy/portability.h legacy/erl_malloc.h \ - legacy/erl_error.h legacy/erl_internal.h misc/eiext.h misc/putget.h -$(MD_OBJDIR)/erl_timeout.o: legacy/erl_timeout.c $(TARGET)/config.h \ - legacy/erl_timeout.h -$(MD_OBJDIR)/global_names.o: legacy/global_names.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(MD_OBJDIR)/global_register.o: legacy/global_register.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h ../include/erl_interface.h -$(MD_OBJDIR)/global_unregister.o: legacy/global_unregister.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(MD_OBJDIR)/global_whereis.o: legacy/global_whereis.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h - -$(MDD_OBJDIR)/ei_connect.o: connect/ei_connect.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h misc/eiext.h misc/ei_portio.h \ - misc/ei_internal.h connect/ei_connect_int.h misc/ei_locking.h \ - connect/eisend.h connect/eirecv.h misc/eimd5.h misc/putget.h \ - connect/ei_resolve.h epmd/ei_epmd.h -$(MDD_OBJDIR)/ei_resolve.o: connect/ei_resolve.c $(TARGET)/config.h \ - misc/eidef.h ../include/ei.h connect/ei_resolve.h misc/ei_locking.h -$(MDD_OBJDIR)/eirecv.o: connect/eirecv.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eirecv.h misc/ei_portio.h \ - misc/ei_internal.h misc/putget.h misc/ei_trace.h misc/show_msg.h -$(MDD_OBJDIR)/send.o: connect/send.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(MDD_OBJDIR)/send_exit.o: connect/send_exit.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/ei_connect_int.h misc/ei_trace.h \ - misc/ei_internal.h misc/putget.h misc/show_msg.h -$(MDD_OBJDIR)/send_reg.o: connect/send_reg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h connect/eisend.h misc/putget.h \ - connect/ei_connect_int.h misc/ei_internal.h misc/ei_trace.h \ - misc/show_msg.h -$(MDD_OBJDIR)/decode_atom.o: decode/decode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_big.o: decode/decode_big.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_bignum.o: decode/decode_bignum.c $(TARGET)/config.h -$(MDD_OBJDIR)/decode_binary.o: decode/decode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_boolean.o: decode/decode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_char.o: decode/decode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_double.o: decode/decode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_fun.o: decode/decode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_malloc.h decode/decode_skip.h misc/putget.h -$(MDD_OBJDIR)/decode_intlist.o: decode/decode_intlist.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_list_header.o: decode/decode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_long.o: decode/decode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_pid.o: decode/decode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_port.o: decode/decode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_ref.o: decode/decode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_skip.o: decode/decode_skip.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - decode/decode_skip.h -$(MDD_OBJDIR)/decode_string.o: decode/decode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_trace.o: decode/decode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(MDD_OBJDIR)/decode_tuple_header.o: decode/decode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_ulong.o: decode/decode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_version.o: decode/decode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_longlong.o: decode/decode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/decode_ulonglong.o: decode/decode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_atom.o: encode/encode_atom.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_bignum.o: encode/encode_bignum.c $(TARGET)/config.h -$(MDD_OBJDIR)/encode_binary.o: encode/encode_binary.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_boolean.o: encode/encode_boolean.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_char.o: encode/encode_char.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_double.o: encode/encode_double.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_fun.o: encode/encode_fun.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_list_header.o: encode/encode_list_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_long.o: encode/encode_long.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_pid.o: encode/encode_pid.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_port.o: encode/encode_port.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_ref.o: encode/encode_ref.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_string.o: encode/encode_string.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_trace.o: encode/encode_trace.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/putget.h -$(MDD_OBJDIR)/encode_tuple_header.o: encode/encode_tuple_header.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_ulong.o: encode/encode_ulong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_version.o: encode/encode_version.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h -$(MDD_OBJDIR)/encode_longlong.o: encode/encode_longlong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(MDD_OBJDIR)/encode_ulonglong.o: encode/encode_ulonglong.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h -$(MDD_OBJDIR)/epmd_port.o: epmd/epmd_port.c misc/ei_internal.h epmd/ei_epmd.h \ - misc/putget.h -$(MDD_OBJDIR)/epmd_publish.o: epmd/epmd_publish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(MDD_OBJDIR)/epmd_unpublish.o: epmd/epmd_unpublish.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_internal.h \ - misc/putget.h ../include/erl_interface.h epmd/ei_epmd.h -$(MDD_OBJDIR)/ei_decode_term.o: misc/ei_decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_decode_term.h misc/putget.h -$(MDD_OBJDIR)/ei_format.o: misc/ei_format.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_malloc.h misc/ei_format.h -$(MDD_OBJDIR)/ei_locking.o: misc/ei_locking.c $(TARGET)/config.h \ - misc/ei_malloc.h misc/ei_locking.h -$(MDD_OBJDIR)/ei_malloc.o: misc/ei_malloc.c misc/ei_malloc.h -$(MDD_OBJDIR)/ei_portio.o: misc/ei_portio.c misc/ei_portio.h misc/ei_internal.h -$(MDD_OBJDIR)/ei_printterm.o: misc/ei_printterm.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/ei_printterm.h misc/ei_malloc.h -$(MDD_OBJDIR)/ei_pthreads.o: misc/ei_pthreads.c $(TARGET)/config.h \ - ../include/ei.h misc/ei_locking.h -$(MDD_OBJDIR)/ei_trace.o: misc/ei_trace.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/ei_trace.h -$(MDD_OBJDIR)/ei_x_encode.o: misc/ei_x_encode.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/ei_x_encode.h \ - misc/ei_malloc.h -$(MDD_OBJDIR)/eimd5.o: misc/eimd5.c misc/eimd5.h -$(MDD_OBJDIR)/get_type.o: misc/get_type.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h -$(MDD_OBJDIR)/show_msg.o: misc/show_msg.c misc/eidef.h $(TARGET)/config.h \ - ../include/ei.h misc/eiext.h misc/putget.h misc/ei_printterm.h \ - misc/ei_internal.h misc/show_msg.h -$(MDD_OBJDIR)/ei_compat.o: misc/ei_compat.c ../include/ei.h misc/ei_internal.h -$(MDD_OBJDIR)/hash_dohash.o: registry/hash_dohash.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_foreach.o: registry/hash_foreach.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_freetab.o: registry/hash_freetab.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_insert.o: registry/hash_insert.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_isprime.o: registry/hash_isprime.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_lookup.o: registry/hash_lookup.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_newtab.o: registry/hash_newtab.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_remove.o: registry/hash_remove.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_resize.o: registry/hash_resize.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/hash_rlookup.o: registry/hash_rlookup.c registry/hash.h ../include/ei.h -$(MDD_OBJDIR)/reg_close.o: registry/reg_close.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_delete.o: registry/reg_delete.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_dirty.o: registry/reg_dirty.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_dump.o: registry/reg_dump.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(MDD_OBJDIR)/reg_free.o: registry/reg_free.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_get.o: registry/reg_get.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_getf.o: registry/reg_getf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_geti.o: registry/reg_geti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_getp.o: registry/reg_getp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_gets.o: registry/reg_gets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_make.o: registry/reg_make.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_open.o: registry/reg_open.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_purge.o: registry/reg_purge.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_resize.o: registry/reg_resize.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_restore.o: registry/reg_restore.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - registry/reg.h registry/hash.h connect/eisend.h connect/eirecv.h \ - connect/ei_connect_int.h -$(MDD_OBJDIR)/reg_set.o: registry/reg_set.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_setf.o: registry/reg_setf.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_seti.o: registry/reg_seti.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_setp.o: registry/reg_setp.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_sets.o: registry/reg_sets.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_stat.o: registry/reg_stat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/reg_tabstat.o: registry/reg_tabstat.c registry/reg.h ../include/ei.h \ - registry/hash.h -$(MDD_OBJDIR)/decode_term.o: legacy/decode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h ../include/erl_interface.h -$(MDD_OBJDIR)/encode_term.o: legacy/encode_term.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - misc/putget.h misc/ei_x_encode.h ../include/erl_interface.h \ - legacy/erl_marshal.h legacy/erl_eterm.h legacy/portability.h -$(MDD_OBJDIR)/erl_connect.o: legacy/erl_connect.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_config.h \ - legacy/erl_connect.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h misc/putget.h connect/ei_connect_int.h \ - misc/ei_locking.h epmd/ei_epmd.h misc/ei_internal.h -$(MDD_OBJDIR)/erl_error.o: legacy/erl_error.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_error.h -$(MDD_OBJDIR)/erl_eterm.o: legacy/erl_eterm.c misc/ei_locking.h \ - $(TARGET)/config.h connect/ei_resolve.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_eterm.h \ - legacy/portability.h legacy/erl_malloc.h legacy/erl_marshal.h \ - legacy/erl_error.h legacy/erl_internal.h misc/ei_internal.h -$(MDD_OBJDIR)/erl_fix_alloc.o: legacy/erl_fix_alloc.c $(TARGET)/config.h \ - misc/ei_locking.h ../include/erl_interface.h ../include/ei.h \ - legacy/erl_error.h legacy/erl_malloc.h legacy/erl_fix_alloc.h \ - legacy/erl_eterm.h legacy/portability.h -$(MDD_OBJDIR)/erl_format.o: legacy/erl_format.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_eterm.h legacy/portability.h \ - legacy/erl_malloc.h legacy/erl_error.h legacy/erl_internal.h -$(MDD_OBJDIR)/erl_malloc.o: legacy/erl_malloc.c ../include/erl_interface.h \ - ../include/ei.h legacy/erl_fix_alloc.h legacy/erl_malloc.h \ - legacy/erl_internal.h legacy/erl_eterm.h legacy/portability.h \ - misc/ei_malloc.h -$(MDD_OBJDIR)/erl_marshal.o: legacy/erl_marshal.c $(TARGET)/config.h \ - ../include/erl_interface.h ../include/ei.h legacy/erl_marshal.h \ - legacy/erl_eterm.h legacy/portability.h legacy/erl_malloc.h \ - legacy/erl_error.h legacy/erl_internal.h misc/eiext.h misc/putget.h -$(MDD_OBJDIR)/erl_timeout.o: legacy/erl_timeout.c $(TARGET)/config.h \ - legacy/erl_timeout.h -$(MDD_OBJDIR)/global_names.o: legacy/global_names.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(MDD_OBJDIR)/global_register.o: legacy/global_register.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h ../include/erl_interface.h -$(MDD_OBJDIR)/global_unregister.o: legacy/global_unregister.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h -$(MDD_OBJDIR)/global_whereis.o: legacy/global_whereis.c misc/eidef.h \ - $(TARGET)/config.h ../include/ei.h misc/eiext.h \ - connect/eisend.h connect/eirecv.h connect/ei_connect_int.h \ - ../include/erl_interface.h legacy/erl_connect.h - diff --git a/lib/erl_interface/src/encode/encode_binary.c b/lib/erl_interface/src/encode/encode_binary.c index 4471c51769..0562979417 100644 --- a/lib/erl_interface/src/encode/encode_binary.c +++ b/lib/erl_interface/src/encode/encode_binary.c @@ -22,6 +22,10 @@ #include "eiext.h" #include "putget.h" +static void copy_bits(const unsigned char* src, size_t soffs, + unsigned char* dst, size_t n); + + int ei_encode_binary(char *buf, int *index, const void *p, long len) { char *s = buf + *index; @@ -40,3 +44,106 @@ int ei_encode_binary(char *buf, int *index, const void *p, long len) return 0; } +int ei_encode_bitstring(char *buf, int *index, + const char *p, + size_t bitoffs, + size_t bits) +{ + char *s = buf + *index; + char *s0 = s; + size_t bytes = (bits + 7) / 8; + char last_bits = bits % 8; + + if (!buf) s += last_bits ? 6 : 5; + else { + char* tagp = s++; + put32be(s, bytes); + if (last_bits) { + *tagp = ERL_BIT_BINARY_EXT; + put8(s, last_bits); + } + else + *tagp = ERL_BINARY_EXT; + + copy_bits((const unsigned char*)p, bitoffs, (unsigned char*)s, bits); + } + s += bytes; + + *index += s-s0; + + return 0; +} + + +/* + * MAKE_MASK(n) constructs a mask with n bits. + * Example: MAKE_MASK(3) returns the binary number 00000111. + */ +#define MAKE_MASK(n) ((((unsigned) 1) << (n))-1) + + +static +void copy_bits(const unsigned char* src, /* Base pointer to source. */ + size_t soffs, /* Bit offset for source relative to src. */ + unsigned char* dst, /* Destination. */ + size_t n) /* Number of bits to copy. */ +{ + unsigned rmask; + unsigned count; + unsigned deoffs; + unsigned bits; + unsigned bits1; + unsigned rshift; + + if (n == 0) + return; + + deoffs = n & 7; + rmask = deoffs ? (MAKE_MASK(deoffs) << (8-deoffs)) : 0; + + if (soffs == 0) { + unsigned nbytes = (n + 7) / 8; + memcpy(dst, src, nbytes); + if (rmask) + dst[nbytes-1] &= rmask; + return; + } + + src += soffs / 8; + soffs &= 7; + + if (n < 8) { /* Less than one byte */ + bits = (*src << soffs); + if (soffs+n > 8) { + src++; + bits |= (*src >> (8 - soffs)); + } + *dst = bits & rmask; + return; + } + + count = n >> 3; + + rshift = 8 - soffs; + bits = *src; + if (soffs + n > 8) { + src++; + } + + while (count--) { + bits1 = bits << soffs; + bits = *src; + src++; + *dst = bits1 | (bits >> rshift); + dst++; + } + + if (rmask) { + bits1 = bits << soffs; + if ((rmask << rshift) & 0xff) { + bits = *src; + bits1 |= (bits >> rshift); + } + *dst = bits1 & rmask; + } +} diff --git a/lib/erl_interface/src/encode/encode_fun.c b/lib/erl_interface/src/encode/encode_fun.c index 3bfc7530d1..e29424f9f4 100644 --- a/lib/erl_interface/src/encode/encode_fun.c +++ b/lib/erl_interface/src/encode/encode_fun.c @@ -26,56 +26,72 @@ int ei_encode_fun(char *buf, int *index, const erlang_fun *p) { int ix = *index; - if (p->arity == -1) { - /* ERL_FUN_EXT */ - if (buf != NULL) { - char* s = buf + ix; - put8(s, ERL_FUN_EXT); - put32be(s, p->n_free_vars); - } - ix += sizeof(char) + 4; - if (ei_encode_pid(buf, &ix, &p->pid) < 0) - return -1; - if (ei_encode_atom_as(buf, &ix, p->module, ERLANG_UTF8, p->module_org_enc) < 0) - return -1; - if (ei_encode_long(buf, &ix, p->index) < 0) - return -1; - if (ei_encode_long(buf, &ix, p->uniq) < 0) - return -1; - if (buf != NULL) - memcpy(buf + ix, p->free_vars, p->free_var_len); - ix += p->free_var_len; - } else { - char *size_p; - /* ERL_NEW_FUN_EXT */ - if (buf != NULL) { - char* s = buf + ix; - put8(s, ERL_NEW_FUN_EXT); - size_p = s; - s += 4; - put8(s, p->arity); - memcpy(s, p->md5, sizeof(p->md5)); - s += sizeof(p->md5); - put32be(s, p->index); - put32be(s, p->n_free_vars); - } else - size_p = NULL; - ix += 1 + 4 + 1 + sizeof(p->md5) + 4 + 4; - if (ei_encode_atom_as(buf, &ix, p->module, ERLANG_UTF8, p->module_org_enc) < 0) - return -1; - if (ei_encode_long(buf, &ix, p->old_index) < 0) - return -1; - if (ei_encode_long(buf, &ix, p->uniq) < 0) - return -1; - if (ei_encode_pid(buf, &ix, &p->pid) < 0) - return -1; - if (buf != NULL) - memcpy(buf + ix, p->free_vars, p->free_var_len); - ix += p->free_var_len; - if (size_p != NULL) { - int sz = buf + ix - size_p; - put32be(size_p, sz); + switch (p->type) { + case EI_FUN_CLOSURE: + if (p->arity == -1) { + /* ERL_FUN_EXT */ + if (buf != NULL) { + char* s = buf + ix; + put8(s, ERL_FUN_EXT); + put32be(s, p->u.closure.n_free_vars); + } + ix += sizeof(char) + 4; + if (ei_encode_pid(buf, &ix, &p->u.closure.pid) < 0) + return -1; + if (ei_encode_atom_as(buf, &ix, p->module, ERLANG_UTF8, ERLANG_UTF8) < 0) + return -1; + if (ei_encode_long(buf, &ix, p->u.closure.index) < 0) + return -1; + if (ei_encode_long(buf, &ix, p->u.closure.uniq) < 0) + return -1; + if (buf != NULL) + memcpy(buf + ix, p->u.closure.free_vars, p->u.closure.free_var_len); + ix += p->u.closure.free_var_len; + } else { + char *size_p; + if (buf != NULL) { + char* s = buf + ix; + put8(s, ERL_NEW_FUN_EXT); + size_p = s; + s += 4; + put8(s, p->arity); + memcpy(s, p->u.closure.md5, sizeof(p->u.closure.md5)); + s += sizeof(p->u.closure.md5); + put32be(s, p->u.closure.index); + put32be(s, p->u.closure.n_free_vars); + } else + size_p = NULL; + ix += 1 + 4 + 1 + sizeof(p->u.closure.md5) + 4 + 4; + if (ei_encode_atom_as(buf, &ix, p->module, ERLANG_UTF8, ERLANG_UTF8) < 0) + return -1; + if (ei_encode_long(buf, &ix, p->u.closure.old_index) < 0) + return -1; + if (ei_encode_long(buf, &ix, p->u.closure.uniq) < 0) + return -1; + if (ei_encode_pid(buf, &ix, &p->u.closure.pid) < 0) + return -1; + if (buf != NULL) + memcpy(buf + ix, p->u.closure.free_vars, p->u.closure.free_var_len); + ix += p->u.closure.free_var_len; + if (size_p != NULL) { + int sz = buf + ix - size_p; + put32be(size_p, sz); + } } + break; + case EI_FUN_EXPORT: + if (buf != NULL) { + char* s = buf + ix; + put8(s, ERL_EXPORT_EXT); + } + ix++; + if (ei_encode_atom_as(buf, &ix, p->module, ERLANG_UTF8, ERLANG_UTF8) < 0) + return -1; + if (ei_encode_atom_as(buf, &ix, p->u.exprt.func, ERLANG_UTF8, ERLANG_UTF8) < 0) + return -1; + if (ei_encode_long(buf, &ix, p->arity) < 0) + return -1; + break; } *index = ix; return 0; diff --git a/lib/erl_interface/src/encode/encode_pid.c b/lib/erl_interface/src/encode/encode_pid.c index 0dfdb16372..d14746b40f 100644 --- a/lib/erl_interface/src/encode/encode_pid.c +++ b/lib/erl_interface/src/encode/encode_pid.c @@ -25,6 +25,7 @@ int ei_encode_pid(char *buf, int *index, const erlang_pid *p) { char* s = buf + *index; + const char tag = (p->creation > 3) ? ERL_NEW_PID_EXT : ERL_PID_EXT; ++(*index); /* skip ERL_PID_EXT */ if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), @@ -32,17 +33,21 @@ int ei_encode_pid(char *buf, int *index, const erlang_pid *p) return -1; if (buf) { - put8(s, ERL_NEW_PID_EXT); + put8(s, tag); s = buf + *index; /* now the integers */ put32be(s,p->num & 0x7fff); /* 15 bits */ put32be(s,p->serial & 0x1fff); /* 13 bits */ - put32be(s, p->creation); /* 32 bits */ + if (tag == ERL_PID_EXT) { + put8(s,(p->creation & 0x03)); /* 2 bits */ + } else { + put32be(s, p->creation); /* 32 bits */ + } } - *index += 4 + 4 + 4; + *index += 4 + 4 + (tag == ERL_PID_EXT ? 1 : 4); return 0; } diff --git a/lib/erl_interface/src/encode/encode_port.c b/lib/erl_interface/src/encode/encode_port.c index 0fb4018db1..eb464380c0 100644 --- a/lib/erl_interface/src/encode/encode_port.c +++ b/lib/erl_interface/src/encode/encode_port.c @@ -25,6 +25,7 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p) { char *s = buf + *index; + const char tag = p->creation > 3 ? ERL_NEW_PORT_EXT : ERL_PORT_EXT; ++(*index); /* skip ERL_PORT_EXT */ if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), ERLANG_UTF8, @@ -32,15 +33,19 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p) return -1; } if (buf) { - put8(s, ERL_NEW_PORT_EXT); + put8(s, tag); s = buf + *index; /* now the integers */ put32be(s,p->id & 0x0fffffff /* 28 bits */); - put32be(s, p->creation); + if (tag == ERL_PORT_EXT) { + put8(s,(p->creation & 0x03)); + } else { + put32be(s, p->creation); + } } - *index += 4 + 4; + *index += 4 + (tag == ERL_PORT_EXT ? 1 : 4); return 0; } diff --git a/lib/erl_interface/src/encode/encode_ref.c b/lib/erl_interface/src/encode/encode_ref.c index 8c2e0a25f7..5ccfc32c6d 100644 --- a/lib/erl_interface/src/encode/encode_ref.c +++ b/lib/erl_interface/src/encode/encode_ref.c @@ -24,6 +24,7 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) { + const char tag = (p->creation > 3) ? ERL_NEWER_REFERENCE_EXT : ERL_NEW_REFERENCE_EXT; char *s = buf + *index; int i; @@ -36,7 +37,7 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) /* Always encode as an extended reference; all participating parties are now expected to be able to decode extended references. */ if (buf) { - put8(s, ERL_NEWER_REFERENCE_EXT); + put8(s, tag); /* first, number of integers */ put16be(s, p->len); @@ -45,12 +46,15 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) s = buf + *index; /* now the integers */ - put32be(s, p->creation); + if (tag == ERL_NEW_REFERENCE_EXT) + put8(s,(p->creation & 0x03)); + else + put32be(s, p->creation); for (i = 0; i < p->len; i++) put32be(s,p->n[i]); } - *index += p->len*4 + 4; + *index += p->len*4 + (tag == ERL_NEW_REFERENCE_EXT ? 1 : 4); return 0; } diff --git a/lib/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c index 7ed2bdbc93..7ecea83b1a 100644 --- a/lib/erl_interface/src/legacy/erl_eterm.c +++ b/lib/erl_interface/src/legacy/erl_eterm.c @@ -299,12 +299,7 @@ void erl_mk_pid_helper(ETERM *ep, unsigned int number, unsigned int serial, unsigned int creation) { ERL_PID_NUMBER(ep) = number & 0x7fff; /* 15 bits */ - if (ei_internal_use_r9_pids_ports()) { - ERL_PID_SERIAL(ep) = serial & 0x07; /* 3 bits */ - } - else { - ERL_PID_SERIAL(ep) = serial & 0x1fff; /* 13 bits */ - } + ERL_PID_SERIAL(ep) = serial & 0x1fff; /* 13 bits */ ERL_PID_CREATION(ep) = creation; /* 32 bits */ } @@ -334,12 +329,7 @@ ETERM *erl_mk_port(const char *node, void erl_mk_port_helper(ETERM* ep, unsigned number, unsigned int creation) { - if (ei_internal_use_r9_pids_ports()) { - ERL_PORT_NUMBER(ep) = number & 0x3ffff; /* 18 bits */ - } - else { - ERL_PORT_NUMBER(ep) = number & 0x0fffffff; /* 18 bits */ - } + ERL_PORT_NUMBER(ep) = number & 0x0fffffff; /* 18 bits */ ERL_PORT_CREATION(ep) = creation; /* 32 bits */ } diff --git a/lib/erl_interface/src/misc/ei_compat.c b/lib/erl_interface/src/misc/ei_compat.c index 93d7dbfb83..787895992e 100644 --- a/lib/erl_interface/src/misc/ei_compat.c +++ b/lib/erl_interface/src/misc/ei_compat.c @@ -22,19 +22,22 @@ #include "ei.h" #include "ei_internal.h" -#define EI_COMPAT_NO_REL (~((unsigned) 0)) +#include <limits.h> -static unsigned compat_rel = EI_COMPAT_NO_REL; +#ifndef EI_COMPAT +# define EI_COMPAT UINT_MAX +#endif + +static unsigned compat_rel = EI_COMPAT; void ei_set_compat_rel(unsigned rel) { - if (compat_rel == EI_COMPAT_NO_REL) - compat_rel = rel; + compat_rel = rel; } -int -ei_internal_use_r9_pids_ports(void) +int ei_internal_use_21_bitstr_expfun(void) { - return compat_rel < 10; + return compat_rel < 22; } + diff --git a/lib/erl_interface/src/misc/ei_decode_term.c b/lib/erl_interface/src/misc/ei_decode_term.c index 63a7034508..8a4f7cc30d 100644 --- a/lib/erl_interface/src/misc/ei_decode_term.c +++ b/lib/erl_interface/src/misc/ei_decode_term.c @@ -87,6 +87,14 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term) case ERL_BINARY_EXT: term->size = get32be(s); return 0; + case ERL_BIT_BINARY_EXT: { + int bytes = get32be(s); + int last_bits = get8(s); + if (((last_bits==0) != (bytes==0)) || last_bits > 8) + return -1; + term->size = bytes; + return 0; + } case ERL_SMALL_BIG_EXT: if ((term->arity = get8(s)) != 4) return -1; sign = get8(s); diff --git a/lib/erl_interface/src/misc/ei_internal.h b/lib/erl_interface/src/misc/ei_internal.h index f28dd6d668..ab12597c86 100644 --- a/lib/erl_interface/src/misc/ei_internal.h +++ b/lib/erl_interface/src/misc/ei_internal.h @@ -157,7 +157,7 @@ int ei_init_connect(void); void ei_trace_printf(const char *name, int level, const char *format, ...); -int ei_internal_use_r9_pids_ports(void); +int ei_internal_use_21_bitstr_expfun(void); int ei_get_cbs_ctx__(ei_socket_callbacks **cbs, void **ctx, int fd); diff --git a/lib/erl_interface/src/misc/ei_printterm.c b/lib/erl_interface/src/misc/ei_printterm.c index 058de00de5..5c40fb7747 100644 --- a/lib/erl_interface/src/misc/ei_printterm.c +++ b/lib/erl_interface/src/misc/ei_printterm.c @@ -131,7 +131,7 @@ static int print_term(FILE* fp, ei_x_buff* x, if (fp == NULL && x == NULL) return -1; doquote = 0; - ei_get_type_internal(buf, index, &ty, &n); + ei_get_type(buf, index, &ty, &n); switch (ty) { case ERL_ATOM_EXT: case ERL_ATOM_UTF8_EXT: @@ -189,7 +189,7 @@ static int print_term(FILE* fp, ei_x_buff* x, xputs(", ", fp, x); ch_written += 2; } } - if (ei_get_type_internal(buf, &tindex, &ty, &n) < 0) goto err; + if (ei_get_type(buf, &tindex, &ty, &n) < 0) goto err; if (ty != ERL_NIL_EXT) { xputs(" | ", fp, x); ch_written += 3; r = print_term(fp, x, buf, &tindex); @@ -249,6 +249,34 @@ static int print_term(FILE* fp, ei_x_buff* x, xputc('>', fp, x); ++ch_written; ei_free(p); break; + case ERL_BIT_BINARY_EXT: { + const char* cp; + size_t bits; + unsigned int bitoffs; + int trunc = 0; + + if (ei_decode_bitstring(buf, index, &cp, &bitoffs, &bits) < 0 + || bitoffs != 0) { + goto err; + } + ch_written += xprintf(fp, x, "#Bits<"); + m = (bits+7) / 8; + if (m > BINPRINTSIZE) { + m = BINPRINTSIZE; + trunc = 1; + } + --m; + for (i = 0; i < m; ++i) { + ch_written += xprintf(fp, x, "%d,", cp[i]); + } + ch_written += xprintf(fp, x, "%d", cp[i]); + if (trunc) + ch_written += xprintf(fp, x, ",..."); + else if (bits % 8 != 0) + ch_written += xprintf(fp, x, ":%u", (unsigned)(bits % 8)); + xputc('>', fp, x); ++ch_written; + break; + } case ERL_SMALL_INTEGER_EXT: case ERL_INTEGER_EXT: if (ei_decode_long(buf, index, &l) < 0) goto err; diff --git a/lib/erl_interface/src/misc/ei_x_encode.c b/lib/erl_interface/src/misc/ei_x_encode.c index 4ff5974663..8e77679d2a 100644 --- a/lib/erl_interface/src/misc/ei_x_encode.c +++ b/lib/erl_interface/src/misc/ei_x_encode.c @@ -117,6 +117,16 @@ int ei_x_encode_binary(ei_x_buff* x, const void* p, int len) return ei_encode_binary(x->buff, &x->index, p, len); } +int ei_x_encode_bitstring(ei_x_buff* x, const char* p, size_t bitoffs, size_t bits) +{ + int i = x->index; + if (ei_encode_bitstring(NULL, &i, p, bitoffs, bits) == -1) + return -1; + if (!x_fix_buff(x, i)) + return -1; + return ei_encode_bitstring(x->buff, &x->index, p, bitoffs, bits); +} + int ei_x_encode_long(ei_x_buff* x, long n) { int i = x->index; diff --git a/lib/erl_interface/src/misc/get_type.c b/lib/erl_interface/src/misc/get_type.c index aa69cd4d60..eef58a9363 100644 --- a/lib/erl_interface/src/misc/get_type.c +++ b/lib/erl_interface/src/misc/get_type.c @@ -27,17 +27,8 @@ /* for types with meaningful length attributes, return the length too. In other cases, return length 0 */ -/* FIXME working on this one.... */ - int ei_get_type(const char *buf, const int *index, int *type, int *len) { - return ei_get_type_internal(buf, index, type, len); -} - - -int ei_get_type_internal(const char *buf, const int *index, - int *type, int *len) -{ const char *s = buf + *index; *type = get8(s); @@ -64,7 +55,9 @@ int ei_get_type_internal(const char *buf, const int *index, case ERL_LARGE_TUPLE_EXT: case ERL_LIST_EXT: + case ERL_MAP_EXT: case ERL_BINARY_EXT: + case ERL_BIT_BINARY_EXT: *len = get32be(s); break; diff --git a/lib/erl_interface/src/misc/show_msg.c b/lib/erl_interface/src/misc/show_msg.c index 5868cccba6..805d69e9b3 100644 --- a/lib/erl_interface/src/misc/show_msg.c +++ b/lib/erl_interface/src/misc/show_msg.c @@ -342,7 +342,7 @@ static void show_term(const char *termbuf, int *index, FILE *stream) int i, len; char *s; - ei_get_type_internal(termbuf,index,&type,&len); + ei_get_type(termbuf,index,&type,&len); switch (type) { case ERL_VERSION_MAGIC: @@ -455,6 +455,12 @@ static void show_term(const char *termbuf, int *index, FILE *stream) fprintf(stream,"#Bin<%ld>",num); break; + case ERL_BIT_BINARY_EXT: { + size_t bits; + ei_decode_bitstring(termbuf, index, NULL, NULL, &bits); + fprintf(stream, "#Bits<%lu>", (unsigned long)bits); + break; + } case ERL_LARGE_BIG_EXT: /* doesn't actually decode - just skip over it */ /* FIXME if GMP, what to do here?? */ diff --git a/lib/erl_interface/src/prog/ei_fake_prog.c b/lib/erl_interface/src/prog/ei_fake_prog.c index 158464b385..6f58c9833d 100644 --- a/lib/erl_interface/src/prog/ei_fake_prog.c +++ b/lib/erl_interface/src/prog/ei_fake_prog.c @@ -186,7 +186,6 @@ int main(void) ei_x_encode_empty_list(&eix); ei_get_type(charp, intp, intp, intp); - ei_get_type_internal(charp, intp, intp, intp); ei_decode_version(charp, intp, intp); ei_decode_long(charp, intp, longp); diff --git a/lib/erl_interface/src/registry/reg_dump.c b/lib/erl_interface/src/registry/reg_dump.c index 43c9824433..da0413e6e6 100644 --- a/lib/erl_interface/src/registry/reg_dump.c +++ b/lib/erl_interface/src/registry/reg_dump.c @@ -90,7 +90,7 @@ static int mn_start_dump(int fd, const erlang_pid *self, || (arity != 2) || ei_decode_atom(buf,&index,tmpbuf) || strcmp(tmpbuf,"rex") - || ei_get_type_internal(buf,&index,&type,&arity) + || ei_get_type(buf,&index,&type,&arity) || (type != ERL_PID_EXT)) return -1; /* bad response from other side */ diff --git a/lib/erl_interface/test/all_SUITE_data/ei_runner.h b/lib/erl_interface/test/all_SUITE_data/ei_runner.h index 2608661303..7c874ac82e 100644 --- a/lib/erl_interface/test/all_SUITE_data/ei_runner.h +++ b/lib/erl_interface/test/all_SUITE_data/ei_runner.h @@ -53,6 +53,7 @@ void free_packet(char*); #define fail(reason) do_fail(__FILE__, __LINE__, reason) #define fail1(reason, a1) do_fail(__FILE__, __LINE__, reason, a1) +#define fail2(reason, a1, a2) do_fail(__FILE__, __LINE__, reason, a1, a2) #define report(ok) do_report(__FILE__, __LINE__, ok) void do_report(char* file, int line, int ok); diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl index 9c9c3f86b6..f40c67375b 100644 --- a/lib/erl_interface/test/ei_accept_SUITE.erl +++ b/lib/erl_interface/test/ei_accept_SUITE.erl @@ -43,8 +43,12 @@ init_per_testcase(Case, Config) -> runner:init_per_testcase(?MODULE, Case, Config). ei_accept(Config) when is_list(Config) -> + ei_accept_do(Config, 0), % default + ei_accept_do(Config, 21). % ei_set_compat_rel + +ei_accept_do(Config, CompatRel) -> P = runner:start(Config, ?interpret), - 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, CompatRel), Myname = hd(tl(string:tokens(atom_to_list(node()), "@"))), io:format("Myname ~p ~n", [Myname]), @@ -52,15 +56,18 @@ ei_accept(Config) when is_list(Config) -> io:format("EINode ~p ~n", [EINode]), %% We take this opportunity to also test export-funs and bit-strings - %% with (ugly) tuple fallbacks. + %% with (ugly) tuple fallbacks in OTP 21 and older. %% Test both toward pending connection and established connection. RealTerms = [<<1:1>>, fun lists:map/2], - Fallbacks = [{<<128>>,1}, {lists,map}], + EncTerms = case CompatRel of + 0 -> RealTerms; + 21 -> [{<<128>>,1}, {lists,map}] + end, Self = self(), Funny = fun() -> hello end, TermToSend = {call, Self, "Test", Funny, RealTerms}, - TermToGet = {call, Self, "Test", Funny, Fallbacks}, + TermToGet = {call, Self, "Test", Funny, EncTerms}, Port = 6543, {ok, ListenFd} = ei_publish(P, Port), {any, EINode} ! TermToSend, @@ -94,7 +101,7 @@ ei_threaded_accept(Config) when is_list(Config) -> %% Test erlang:monitor toward erl_interface "processes" monitor_ei_process(Config) when is_list(Config) -> P = runner:start(Config, ?interpret), - 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, 0), Myname = hd(tl(string:tokens(atom_to_list(node()), "@"))), io:format("Myname ~p ~n", [Myname]), @@ -167,8 +174,8 @@ start_einode(Einode, N, Host) -> %%% Interface functions for ei (erl_interface) functions. -ei_connect_init(P, Num, Cookie, Creation) -> - send_command(P, ei_connect_init, [Num,Cookie,Creation]), +ei_connect_init(P, Num, Cookie, Creation, Compat) -> + send_command(P, ei_connect_init, [Num,Cookie,Creation,Compat]), case get_term(P) of {term,Int} when is_integer(Int) -> Int end. diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c index c209f506b1..09b0b5440b 100644 --- a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c +++ b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c @@ -58,7 +58,7 @@ static struct { int num_args; /* Number of arguments. */ void (*func)(char* buf, int len); } commands[] = { - "ei_connect_init", 3, cmd_ei_connect_init, + "ei_connect_init", 4, cmd_ei_connect_init, "ei_publish", 1, cmd_ei_publish, "ei_accept", 1, cmd_ei_accept, "ei_receive", 1, cmd_ei_receive, @@ -106,21 +106,25 @@ TESTCASE(interpret) static void cmd_ei_connect_init(char* buf, int len) { int index = 0, r = 0; - int type, size; - long l; - char b[100]; + long num, creation; + unsigned long compat; + char node_name[100]; char cookie[MAXATOMLEN], * cp = cookie; ei_x_buff res; - if (ei_decode_long(buf, &index, &l) < 0) + if (ei_decode_long(buf, &index, &num) < 0) fail("expected int"); - sprintf(b, "c%d", l); - /* FIXME don't use internal and maybe use skip?! */ - ei_get_type_internal(buf, &index, &type, &size); + sprintf(node_name, "c%d", num); if (ei_decode_atom(buf, &index, cookie) < 0) fail("expected atom (cookie)"); if (cookie[0] == '\0') cp = NULL; - r = ei_connect_init(&ec, b, cp, 0); + if (ei_decode_long(buf, &index, &creation) < 0) + fail("expected int"); + if (ei_decode_long(buf, &index, &compat) < 0) + fail("expected uint"); + if (compat) + ei_set_compat_rel(compat); + r = ei_connect_init(&ec, node_name, cp, creation); ei_x_new_with_version(&res); ei_x_encode_long(&res, r); send_bin_term(&res); diff --git a/lib/erl_interface/test/ei_connect_SUITE.erl b/lib/erl_interface/test/ei_connect_SUITE.erl index 75b6bf18da..6184ce801b 100644 --- a/lib/erl_interface/test/ei_connect_SUITE.erl +++ b/lib/erl_interface/test/ei_connect_SUITE.erl @@ -79,9 +79,10 @@ ei_send_funs(Config) when is_list(Config) -> {ok,Fd} = ei_connect(P, node()), Fun1 = fun ei_send/1, - Fun2 = fun(X) -> P, X, Fd, Fun1 end, + Fun2 = fun(X) -> {P, X, Fd, Fun1} end, + Bits = <<1,2,3:5>>, - AMsg={Fun1,Fun2}, + AMsg={Fun1,Fun2,Bits}, %%AMsg={wait_with_funs, new_dist_format}, ok = ei_send_funs(P, Fd, self(), AMsg), EIMsg = receive M -> M end, diff --git a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c index 58c0c7f8d8..385bcdd422 100644 --- a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c +++ b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c @@ -107,7 +107,6 @@ TESTCASE(interpret) static void cmd_ei_connect_init(char* buf, int len) { int index = 0, r = 0; - int type, size; long l; char b[100]; char cookie[MAXATOMLEN], * cp = cookie; @@ -115,8 +114,6 @@ static void cmd_ei_connect_init(char* buf, int len) if (ei_decode_long(buf, &index, &l) < 0) fail("expected int"); sprintf(b, "c%ld", l); - /* FIXME don't use internal and maybe use skip?! */ - ei_get_type_internal(buf, &index, &type, &size); if (ei_decode_atom(buf, &index, cookie) < 0) fail("expected atom (cookie)"); if (cookie[0] == '\0') @@ -212,6 +209,9 @@ static void cmd_ei_send_funs(char* buf, int len) erlang_pid pid; ei_x_buff x; erlang_fun fun1, fun2; + char* bitstring; + size_t bits; + int bitoffs; if (ei_decode_long(buf, &index, &fd) < 0) fail("expected long"); @@ -219,20 +219,24 @@ static void cmd_ei_send_funs(char* buf, int len) fail("expected pid (node)"); if (ei_decode_tuple_header(buf, &index, &n) < 0) fail("expected tuple"); - if (n != 2) + if (n != 3) fail("expected tuple"); if (ei_decode_fun(buf, &index, &fun1) < 0) fail("expected Fun1"); if (ei_decode_fun(buf, &index, &fun2) < 0) fail("expected Fun2"); + if (ei_decode_bitstring(buf, &index, &bitstring, &bitoffs, &bits) < 0) + fail("expected bitstring"); if (ei_x_new_with_version(&x) < 0) fail("ei_x_new_with_version"); - if (ei_x_encode_tuple_header(&x, 2) < 0) + if (ei_x_encode_tuple_header(&x, 3) < 0) fail("encode tuple header"); if (ei_x_encode_fun(&x, &fun1) < 0) fail("encode fun1"); if (ei_x_encode_fun(&x, &fun2) < 0) fail("encode fun2"); + if (ei_x_encode_bitstring(&x, bitstring, bitoffs, bits) < 0) + fail("encode bitstring"); free_fun(&fun1); free_fun(&fun2); send_errno_result(ei_send(fd, &pid, x.buff, x.index)); diff --git a/lib/erl_interface/test/ei_decode_SUITE.erl b/lib/erl_interface/test/ei_decode_SUITE.erl index 75560ea7c9..e005ec89c7 100644 --- a/lib/erl_interface/test/ei_decode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_SUITE.erl @@ -194,6 +194,9 @@ test_ei_decode_misc(Config) when is_list(Config) -> send_term_as_binary(P,<<>>), send_term_as_binary(P,<<"ÅÄÖåäö">>), + send_term_as_binary(P,<<1, 2, 3:5>>), + send_term_as_binary(P,<<1:1>>), + % send_term_as_binary(P,{}), % send_term_as_binary(P,[]), diff --git a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c index e516f310b6..46d6b8f2af 100644 --- a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c +++ b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c @@ -256,66 +256,134 @@ int ei_decode_my_string(const char *buf, int *index, char *to, //#define EI_DECODE_UTF8_STRING(FUNC,SIZE,VAL) -#define EI_DECODE_BIN(FUNC,SIZE,VAL,LEN) \ - { \ - char p[1024]; \ - char *buf; \ - long len; \ - int size1 = 0; \ - int size2 = 0; \ - int err; \ - message("ei_" #FUNC " should be " #VAL); \ - buf = read_packet(NULL); \ - err = ei_ ## FUNC(buf+1, &size1, NULL, &len); \ +static void decode_bin(int exp_size, const char* val, int exp_len) +{ + char p[1024]; + char *buf; + long len; + int size1 = 0; + int size2 = 0; + int err; + message("ei_decode_binary should be %s", val); + buf = read_packet(NULL); + err = ei_decode_binary(buf+1, &size1, NULL, &len); message("err = %d, size = %d, len = %d, expected size = %d, expected len = %d\n",\ - err,size1,len,SIZE,LEN); \ - if (err != 0) { \ - if (err != -1) { \ - fail("returned non zero but not -1 if NULL pointer"); \ - } else { \ - fail("returned non zero"); \ - } \ - return; \ - } \ -\ - if (len != LEN) { \ - fail("size is not correct"); \ - return; \ - } \ -\ - err = ei_ ## FUNC(buf+1, &size2, p, &len); \ + err,size1,len, exp_size, exp_len); + if (err != 0) { + if (err != -1) { + fail("returned non zero but not -1 if NULL pointer"); + } else { + fail("returned non zero"); + } + return; + } + + if (len != exp_len) { + fail("size is not correct"); + return; + } + + err = ei_decode_binary(buf+1, &size2, p, &len); message("err = %d, size = %d, len = %d, expected size = %d, expected len = %d\n",\ - err,size2,len,SIZE,LEN); \ - if (err != 0) { \ - if (err != -1) { \ - fail("returned non zero but not -1 if NULL pointer"); \ - } else { \ - fail("returned non zero"); \ - } \ - return; \ - } \ -\ - if (len != LEN) { \ - fail("size is not correct"); \ - return; \ - } \ -\ - if (strncmp(p,VAL,LEN) != 0) { \ - fail("value is not correct"); \ - return; \ - } \ -\ - if (size1 != size2) { \ - fail("size with and without pointer differs"); \ - return; \ - } \ -\ - if (size1 != SIZE) { \ - fail("size of encoded data is incorrect"); \ - return; \ - } \ - free_packet(buf); \ - } \ + err,size2,len, exp_size, exp_len); + if (err != 0) { + if (err != -1) { + fail("returned non zero but not -1 if NULL pointer"); + } else { + fail("returned non zero"); + } + return; + } + + if (len != exp_len) { + fail("size is not correct"); + return; + } + + if (strncmp(p,val,exp_len) != 0) { + fail("value is not correct"); + return; + } + + if (size1 != size2) { + fail("size with and without pointer differs"); + return; + } + + if (size1 != exp_size) { + fail("size of encoded data is incorrect"); + return; + } + free_packet(buf); +} + +static void decode_bits(int exp_size, const char* val, size_t exp_bits) +{ + const char* p; + char *buf; + size_t bits; + int bitoffs; + int size1 = 0; + int size2 = 0; + int err; + message("ei_decode_bitstring should be %d bits", (int)exp_bits); + buf = read_packet(NULL); + err = ei_decode_bitstring(buf+1, &size1, NULL, &bitoffs, &bits); + message("err = %d, size = %d, bitoffs = %d, bits = %d, expected size = %d, expected bits = %d\n",\ + err,size1, bitoffs, (int)bits, exp_size, (int)exp_bits); + + if (err != 0) { + if (err != -1) { + fail("returned non zero but not -1 if NULL pointer"); + } else { + fail("returned non zero"); + } + return; + } + + if (bits != exp_bits) { + fail("number of bits is not correct"); + return; + } + if (bitoffs != 0) { + fail("non zero bit offset"); + return; + } + + err = ei_decode_bitstring(buf+1, &size2, &p, NULL, &bits); + message("err = %d, size = %d, len = %d, expected size = %d, expected len = %d\n",\ + err,size2, (int)bits, exp_size, (int)exp_bits); + if (err != 0) { + if (err != -1) { + fail("returned non zero but not -1 if NULL pointer"); + } else { + fail("returned non zero"); + } + return; + } + + if (bits != exp_bits) { + fail("bits is not correct"); + return; + } + + if (memcmp(p, val, (exp_bits+7)/8) != 0) { + fail("value is not correct"); + return; + } + + if (size1 != size2) { + fail("size with and without pointer differs"); + return; + } + + if (size1 != exp_size) { + fail2("size of encoded data is incorrect %d != %d", size1, exp_size); + return; + } + free_packet(buf); +} + /* ******************************************************************** */ @@ -644,9 +712,17 @@ TESTCASE(test_ei_decode_misc) EI_DECODE_STRING(decode_my_string, 1, ""); EI_DECODE_STRING(decode_my_string, 9, "������"); - EI_DECODE_BIN(decode_binary, 8, "foo", 3); - EI_DECODE_BIN(decode_binary, 5, "", 0); - EI_DECODE_BIN(decode_binary, 11, "������", 6); + decode_bin(8, "foo", 3); + decode_bin(5, "", 0); + decode_bin(11, "������", 6); + +#define LAST_BYTE(V, BITS) ((V) << (8-(BITS))) + { + unsigned char bits1[] = {1, 2, LAST_BYTE(3,5) }; + unsigned char bits2[] = {LAST_BYTE(1,1) }; + decode_bits(9, bits1, 21); + decode_bits(7, bits2, 1); + } /* FIXME check \0 in strings and atoms? */ /* diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE.erl b/lib/erl_interface/test/ei_decode_encode_SUITE.erl index 0f23cdfbb9..3451d9f503 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE.erl +++ b/lib/erl_interface/test/ei_decode_encode_SUITE.erl @@ -120,9 +120,31 @@ test_ei_decode_encode(Config) when is_list(Config) -> send_rec(P, #{key => value}), send_rec(P, maps:put(Port, Ref, #{key => value, key2 => Pid})), + [send_rec(P, <<16#dec0deb175:B/little>>) || B <- lists:seq(0,48)], + + % And last an ugly duckling to test ei_encode_bitstring with bitoffs != 0 + encode_bitstring(P), + runner:recv_eot(P), ok. +encode_bitstring(P) -> + %% Send one bitstring to c-node + Bits = <<16#18f6d4b2907e5c3a1:66>>, + P ! {self(), {command, term_to_binary(Bits, [{minor_version, 2}])}}, + + %% and then receive and verify a number of different sub-bitstrings + receive_sub_bitstring(P, Bits, 0, bit_size(Bits)). + +receive_sub_bitstring(_, _, _, NBits) when NBits < 0 -> + ok; +receive_sub_bitstring(P, Bits, BitOffs, NBits) -> + <<_:BitOffs, Sub:NBits/bits, _/bits>> = Bits, + %%io:format("expecting term_to_binary(~p) = ~p\n", [Sub, term_to_binary(Sub)]), + {_B,Sub} = get_buf_and_term(P), + receive_sub_bitstring(P, Bits, BitOffs+1, NBits - ((NBits div 20)+1)). + + %% ######################################################################## %% diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c index 55d9ed1b1a..85ca6c56e9 100644 --- a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c +++ b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c @@ -40,6 +40,13 @@ typedef struct erlang_char_encoding enc; }my_atom; +typedef struct +{ + const char* bytes; + unsigned int bitoffs; + size_t nbits; +}my_bitstring; + struct my_obj { union { erlang_fun fun; @@ -49,6 +56,7 @@ struct my_obj { erlang_trace trace; erlang_big big; my_atom atom; + my_bitstring bits; int arity; }u; @@ -119,6 +127,26 @@ struct Type my_atom_type = { (encodeFT*)ei_encode_my_atom, (x_encodeFT*)ei_x_encode_my_atom }; +int ei_decode_my_bits(const char *buf, int *index, my_bitstring* a) +{ + return ei_decode_bitstring(buf, index, (a ? &a->bytes : NULL), + (a ? &a->bitoffs : NULL), + (a ? &a->nbits : NULL)); +} +int ei_encode_my_bits(char *buf, int *index, my_bitstring* a) +{ + return ei_encode_bitstring(buf, index, a->bytes, a->bitoffs, a->nbits); +} +int ei_x_encode_my_bits(ei_x_buff* x, my_bitstring* a) +{ + return ei_x_encode_bitstring(x, a->bytes, a->bitoffs, a->nbits); +} + +struct Type my_bitstring_type = { + "bits", "my_bitstring", (decodeFT*)ei_decode_my_bits, + (encodeFT*)ei_encode_my_bits, (x_encodeFT*)ei_x_encode_my_bits +}; + int my_decode_tuple_header(const char *buf, int *index, struct my_obj* obj) { @@ -237,11 +265,7 @@ void decode_encode(struct Type** tv, int nobj) size1 = 0; err = t->ei_decode_fp(inp, &size1, NULL); if (err != 0) { - if (err != -1) { - fail("decode returned non zero but not -1"); - } else { - fail1("decode '%s' returned non zero", t->name); - } + fail2("decode '%s' returned non zero %d", t->name, err); return; } if (size1 < 1) { @@ -470,6 +494,66 @@ void decode_encode_big(struct Type* t) } +void encode_bitstring(void) +{ + char* packet; + char* inp; + char out_buf[BUFSZ]; + int size; + int err, i; + ei_x_buff arg; + const char* p; + unsigned int bitoffs; + size_t nbits, org_nbits; + + packet = read_packet(NULL); + inp = packet+1; + + size = 0; + err = ei_decode_bitstring(inp, &size, &p, &bitoffs, &nbits); + if (err != 0) { + fail1("ei_decode_bitstring returned non zero %d", err); + return; + } + + /* + * Now send a bunch of different sub-bitstrings back + * encoded both with ei_encode_ and ei_x_encode_. + */ + org_nbits = nbits; + do { + size = 0; + err = ei_encode_bitstring(out_buf, &size, p, bitoffs, nbits); + if (err != 0) { + fail1("ei_encode_bitstring returned non zero %d", err); + return; + } + + ei_x_new(&arg); + err = ei_x_encode_bitstring(&arg, p, bitoffs, nbits); + if (err != 0) { + fail1("ei_x_encode_bitstring returned non zero %d", err); + ei_x_free(&arg); + return; + } + + if (arg.index < 1) { + fail("size is < 1"); + ei_x_free(&arg); + return; + } + + send_buffer(out_buf, size); + send_buffer(arg.buff, arg.index); + ei_x_free(&arg); + + bitoffs++; + nbits -= (nbits / 20) + 1; + } while (nbits < org_nbits); + + free_packet(packet); +} + /* ******************************************************************** */ @@ -537,6 +621,12 @@ TESTCASE(test_ei_decode_encode) decode_encode(map, 7); } + for (i=0; i <= 48; i++) { + decode_encode_one(&my_bitstring_type); + } + + encode_bitstring(); + report(1); } diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl index 4605293c74..77910a9fc7 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE.erl +++ b/lib/erl_interface/test/erl_eterm_SUITE.erl @@ -73,10 +73,6 @@ -import(runner, [get_term/1]). --define(REFERENCE_EXT, $e). --define(NEW_REFERENCE_EXT, $r). --define(NEWER_REFERENCE_EXT, $Z). - %% This test suite controls the running of the C language functions %% in eterm_test.c and print_term.c. @@ -1030,11 +1026,9 @@ cnode_1(Config) when is_list(Config) -> check_ref(Ref) -> case bin_ext_type(Ref) of - ?REFERENCE_EXT -> + 101 -> ct:fail(oldref); - ?NEW_REFERENCE_EXT -> - ok; - ?NEWER_REFERENCE_EXT -> + 114 -> ok; Type -> ct:fail({type, Type}) diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk index dae6052d55..5e63f75ab5 100644 --- a/lib/erl_interface/vsn.mk +++ b/lib/erl_interface/vsn.mk @@ -1,2 +1,2 @@ -EI_VSN = 3.11.1 +EI_VSN = 3.11.2 ERL_INTERFACE_VSN = $(EI_VSN) diff --git a/lib/hipe/doc/src/hipe_app.xml b/lib/hipe/doc/src/hipe_app.xml index 480290cd9e..61d92fdffe 100644 --- a/lib/hipe/doc/src/hipe_app.xml +++ b/lib/hipe/doc/src/hipe_app.xml @@ -64,9 +64,7 @@ <taglist> <tag>Binary matching</tag> <item><p>The HiPE compiler will crash on modules containing binary - matching unless they have been compiled with the <c>+no_bsm3</c> flag. - Note that this will disable all related optimizations done by the BEAM - compiler.</p> + matching.</p> </item> <tag>Stack traces</tag> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 91dd9cd6ed..2710ea2f2f 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,29 @@ <file>notes.xml</file> </header> - <section><title>Inets 7.0.6</title> + <section><title>Inets 7.0.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix the internal handling of the option + erl_script_timeout in httpd. If explicit + erl_script_timeout value was supplied in seconds it was + not correctly converted to millisecond units for internal + usage.</p> + <p> + This change fixes the handling of erl_script_timeout in + all possible configuration scenarios.</p> + <p> + Own Id: OTP-15769 Aux Id: ERIERL-345 </p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 7.0.6</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_server/httpd_example.erl b/lib/inets/src/http_server/httpd_example.erl index 37e4f97bc0..aaa7e428c2 100644 --- a/lib/inets/src/http_server/httpd_example.erl +++ b/lib/inets/src/http_server/httpd_example.erl @@ -24,7 +24,7 @@ -export([newformat/3, post_chunked/3, post_204/3]). %% These are used by the inets test-suite --export([delay/1, chunk_timeout/3]). +-export([delay/1, chunk_timeout/3, get_chunks/3]). print(String) -> @@ -196,3 +196,22 @@ chunk_timeout(SessionID, _, _StrInt) -> mod_esi:deliver(SessionID, top("Test chunk encoding timeout")), timer:sleep(20000), mod_esi:deliver(SessionID, footer()). + +get_chunks(Sid, _Env, In) -> + Tokens = string:tokens(In, [$&]), + PropList = lists:map(fun(E) -> + list_to_tuple(string:tokens(E,[$=])) end, + Tokens), + HeaderDelay = + list_to_integer(proplists:get_value("header_delay", PropList, "0")), + ChunkDelay = + list_to_integer(proplists:get_value("chunk_delay", PropList, "0")), + BadChunkDelay = + list_to_integer(proplists:get_value("bad_chunk_delay", PropList, "0")), + timer:sleep(HeaderDelay), + mod_esi:deliver(Sid, ["Content-Type: text/plain\r\n\r\n"]), + mod_esi:deliver(Sid, "Chunk 0 ms\r\n"), + timer:sleep(ChunkDelay), + mod_esi:deliver(Sid, io_lib:format("Chunk ~p ms\r\n", [ChunkDelay])), + timer:sleep(ChunkDelay + BadChunkDelay), + mod_esi:deliver(Sid, "BAD Chunk\r\n"). diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index f495f12f03..8cbd9798e6 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -119,7 +119,7 @@ load("EvalScriptAlias " ++ EvalScriptAlias, []) -> load("ErlScriptTimeout " ++ Timeout, [])-> case catch list_to_integer(string:strip(Timeout)) of TimeoutSec when is_integer(TimeoutSec) -> - {ok, [], {erl_script_timeout, TimeoutSec * 1000}}; + {ok, [], {erl_script_timeout, TimeoutSec}}; _ -> {error, ?NICE(string:strip(Timeout) ++ " is an invalid ErlScriptTimeout")} @@ -500,7 +500,7 @@ kill_esi_delivery_process(Pid) -> erl_script_timeout(Db) -> - httpd_util:lookup(Db, erl_script_timeout, ?DEFAULT_ERL_TIMEOUT * 1000). + httpd_util:lookup(Db, erl_script_timeout, ?DEFAULT_ERL_TIMEOUT) * 1000. script_elements(FuncAndInput, Input) -> case input_type(FuncAndInput) of diff --git a/lib/inets/src/http_server/mod_responsecontrol.erl b/lib/inets/src/http_server/mod_responsecontrol.erl index 07129940a5..a32ba65c22 100644 --- a/lib/inets/src/http_server/mod_responsecontrol.erl +++ b/lib/inets/src/http_server/mod_responsecontrol.erl @@ -71,7 +71,7 @@ do_responsecontrol(Info) -> %% If a client sends more then one of the if-XXXX fields in a request -%% The standard says it does not specify the behaviuor so I specified it :-) +%% The standard says it does not specify the behaviour so I specified it :-) %% The priority between the fields is %% 1.If-modified %% 2.If-Unmodified diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index fcb9ad7905..fc5ca14dcd 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -79,7 +79,10 @@ all() -> {group, http_not_sup}, {group, https_not_sup}, mime_types_format, - erl_script_timeout_option + erl_script_timeout_default, + erl_script_timeout_option, + erl_script_timeout_proplist, + erl_script_timeout_apache ]. groups() -> @@ -384,6 +387,10 @@ init_per_testcase(disk_log_bad_file, Config0) -> ct:timetrap({seconds, 20}), dbg(disk_log_internal, Config1, init); +init_per_testcase(erl_script_timeout_default, Config) -> + ct:timetrap({seconds, 60}), + dbg(erl_script_timeout_default, Config, init); + init_per_testcase(Case, Config) -> ct:timetrap({seconds, 20}), dbg(Case, Config, init). @@ -1777,16 +1784,128 @@ mime_types_format(Config) when is_list(Config) -> {"cpt","application/mac-compactpro"}, {"hqx","application/mac-binhex40"}]} = httpd_conf:load_mime_types(MimeTypes). +erl_script_timeout_default(Config) when is_list(Config) -> + inets:start(), + {ok, Pid} = inets:start(httpd, + [{port, 0}, + {server_name,"localhost"}, + {server_root,"./"}, + {document_root,"./"}, + {bind_address, any}, + {mimetypes, [{"html", "text/html"}]}, + {modules,[mod_esi]}, + {erl_script_alias, {"/erl", [httpd_example]}} + ]), + Info = httpd:info(Pid), + + Port = proplists:get_value(port, Info), + + %% Default erl_script_timeout is 15. + %% Verify: 13 =< erl_script_timeout =< 17 + Url = http_get_url(Port, 500, 13000, 4000), + + {ok, {_, _, Body}} = httpc:request(get, {Url, []}, [{timeout, 45000}], []), + ct:log("Response: ~p~n", [Body]), + verify_body(Body, 13000), + inets:stop(). erl_script_timeout_option(Config) when is_list(Config) -> inets:start(), - {ok, Pid} = inets:start(httpd, [{erl_script_timeout, 215}, - {server_name, "test"}, - {port,0}, - {server_root, "."}, - {document_root, "."}]), + {ok, Pid} = inets:start(httpd, + [{port, 0}, + {server_name,"localhost"}, + {server_root,"./"}, + {document_root,"./"}, + {bind_address, any}, + {mimetypes, [{"html", "text/html"}]}, + {modules,[mod_esi]}, + {erl_script_timeout, 2}, + {erl_script_alias, {"/erl", [httpd_example]}} + ]), Info = httpd:info(Pid), - 215 = proplists:get_value(erl_script_timeout, Info), + verify_timeout(Info, 2), + + Port = proplists:get_value(port, Info), + + %% Verify: 1 =< erl_script_timeout =< 3 + Url = http_get_url(Port, 500, 1000, 2000), + + {ok, {_, _, Body}} = httpc:request(Url), + ct:log("Response: ~p~n", [Body]), + verify_body(Body, 1000), + inets:stop(). + +erl_script_timeout_proplist(Config) when is_list(Config) -> + HttpdConf = filename:join(get_tmp_dir(Config), + "httpd_erl_script_timeout_proplist.conf"), + ServerConfig = + "[{port, 0},\n" ++ + " {server_name,\"localhost\"},\n" ++ + " {server_root,\"./\"},\n" ++ + " {document_root,\"./\"},\n" ++ + " {bind_address, any},\n" ++ + " {mimetypes, [{\"html\", \"text/html\"}]},\n" ++ + " {modules,[mod_esi]},\n" ++ + " {erl_script_timeout, 5},\n" ++ + " {erl_script_alias, {\"/erl\", [httpd_example]}}\n" ++ + "].", + ok = file:write_file(HttpdConf, ServerConfig), + + inets:start(), + {ok, Pid} = inets:start(httpd, + [{proplist_file, HttpdConf}]), + Info = httpd:info(Pid), + verify_timeout(Info, 5), + + Port = proplists:get_value(port, Info), + + %% Verify: 3 =< erl_script_timeout =< 7 + Url = http_get_url(Port, 500, 3000, 4000), + + {ok, {_, _, Body}} = httpc:request(Url), + ct:log("Response: ~p~n", [Body]), + verify_body(Body, 3000), + inets:stop(). + +erl_script_timeout_apache(Config) when is_list(Config) -> + HttpdConf = filename:join(get_tmp_dir(Config), + "httpd_erl_script_timeout.conf"), + MimeTypes = filename:join(get_tmp_dir(Config), + "erl_script_timeout_mime_types.conf"), + + MimeTypesConf = + "html\n" ++ + "text/html\n", + + ok = file:write_file(MimeTypes, MimeTypesConf), + + ServerConfig = + "Port 0\n" ++ + "ServerName localhost\n" ++ + "ServerRoot ./\n" ++ + "DocumentRoot ./\n" ++ + "BindAddress 0.0.0.0\n" ++ + "MimeTypes " ++ MimeTypes ++ "\n" ++ + "Modules mod_esi\n" ++ + "ErlScriptTimeout 8\n" ++ + "ErlScriptAlias /erl httpd_example\n", + + ok = file:write_file(HttpdConf, ServerConfig), + + inets:start(), + {ok, Pid} = inets:start(httpd, + [{file, HttpdConf}]), + Info = httpd:info(Pid), + verify_timeout(Info, 8), + + Port = proplists:get_value(port, Info), + + %% Verify: 6 =< erl_script_timeout =< 10 + Url = http_get_url(Port, 500, 6000, 4000), + + {ok, {_, _, Body}} = httpc:request(Url), + ct:log("Response: ~p~n", [Body]), + verify_body(Body, 6000), inets:stop(). @@ -1798,6 +1917,38 @@ url(http, End, Config) -> {ok,Host} = inet:gethostname(), ?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End. +http_get_url(Port0, HeaderDelay, ChunkDelay, BadChunkDelay) -> + {ok, Host} = inet:gethostname(), + Port = integer_to_list(Port0), + HD = integer_to_list(HeaderDelay), + CD = integer_to_list(ChunkDelay), + BD = integer_to_list(BadChunkDelay), + "http://" ++ Host ++ ":" ++ Port ++ + "/erl/httpd_example/get_chunks?header_delay=" ++ HD ++ + "&chunk_delay=" ++ CD ++ + "&bad_chunk_delay=" ++ BD. + +verify_body(Body, Timeout0) -> + Timeout = integer_to_list(Timeout0), + Res = string:find(Body, Timeout), + ct:log("Result: ~p~n", [Res]), + %% Fail if BAD chunk is found. + case Res =:= Timeout ++ " ms\r\n" of + true -> + ok; + false -> + ct:fail("Unexpected chunk received!") + end. + +verify_timeout(Info, Expected) -> + Timeout = proplists:get_value(erl_script_timeout, Info), + case Timeout =:= Expected of + true -> + ok; + false -> + ct:fail("Bad Timeout - Expected: ~p Got: ~p", [Expected, Timeout]) + end. + do_max_clients(Config) -> Version = proplists:get_value(http_version, Config), Host = proplists:get_value(host, Config), diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index b7ddf39ebd..fd248e793a 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 7.0.6 +INETS_VSN = 7.0.7 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/doc/src/jinterface_users_guide.xml b/lib/jinterface/doc/src/jinterface_users_guide.xml index 56f88124bf..504c77f339 100644 --- a/lib/jinterface/doc/src/jinterface_users_guide.xml +++ b/lib/jinterface/doc/src/jinterface_users_guide.xml @@ -366,20 +366,20 @@ OtpNode node = new OtpNode("gurka"); </code> <seealso marker="java/com/ericsson/otp/erlang/OtpEpmd">OtpEpmd</seealso> class. Nodes wishing to contact other nodes must first request information from Epmd before a connection can be set up, however this is done automatically - by <seealso marker="java/com/ericsson/otp/erlang/OtpSelf#connect(com.ericsson.otp.erlang.OtpPeer)">OtpSelf.connect()</seealso> when necessary. </p> - <p>When you use <seealso marker="java/com/ericsson/otp/erlang/OtpSelf#connect(com.ericsson.otp.erlang.OtpPeer)">OtpSelf.connect()</seealso> to connect to an Erlang node, + by <seealso marker="java/com/ericsson/otp/erlang/OtpSelf#connect-com.ericsson.otp.erlang.OtpPeer-">OtpSelf.connect()</seealso> when necessary. </p> + <p>When you use <seealso marker="java/com/ericsson/otp/erlang/OtpSelf#connect-com.ericsson.otp.erlang.OtpPeer-">OtpSelf.connect()</seealso> to connect to an Erlang node, a connection is first made to epmd and, if the node is known, a connection is then made to the Erlang node.</p> <p>Java nodes can also register themselves with epmd if they want other nodes in the system to be able to find and connect to them. - This is done by call to method <seealso marker="java/com/ericsson/otp/erlang/OtpEpmd#publishPort(com.ericsson.otp.erlang.OtpLocalNode)">OtpEpmd.publishPort()</seealso>.</p> + This is done by call to method <seealso marker="java/com/ericsson/otp/erlang/OtpEpmd#publishPort-com.ericsson.otp.erlang.OtpLocalNode-">OtpEpmd.publishPort()</seealso>.</p> <p>Be aware that on some systems (such as VxWorks), a failed node will not be detected by this mechanism since the operating system does not automatically close descriptors that were left open when the node failed. If a node has failed in this way, epmd will prevent you from registering a new node with the old name, since it thinks that the old name is still in use. In this case, you must unregister the name - explicitly, by using <seealso marker="java/com/ericsson/otp/erlang/OtpEpmd#unPublishPort(com.ericsson.otp.erlang.OtpLocalNode)">OtpEpmd.unPublishPort()</seealso></p> + explicitly, by using <seealso marker="java/com/ericsson/otp/erlang/OtpEpmd#unPublishPort-com.ericsson.otp.erlang.OtpLocalNode-">OtpEpmd.unPublishPort()</seealso></p> <p>This will cause epmd to close the connection from the far end. Note that if the name was in fact still in use by a node, the results of this operation are unpredictable. Also, doing this does not cause the 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 222330654a..c3f71a84f0 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractNode.java @@ -89,7 +89,7 @@ public class AbstractNode implements OtpTransportFactory { static final int dFlagHiddenAtomCache = 0x40; // NOT SUPPORTED static final int dflagNewFunTags = 0x80; static final int dFlagExtendedPidsPorts = 0x100; - static final int dFlagExportPtrTag = 0x200; // NOT SUPPORTED + static final int dFlagExportPtrTag = 0x200; static final int dFlagBitBinaries = 0x400; static final int dFlagNewFloats = 0x800; static final int dFlagUnicodeIo = 0x1000; @@ -105,6 +105,7 @@ public class AbstractNode implements OtpTransportFactory { int flags = dFlagExtendedReferences | dFlagExtendedPidsPorts | dFlagBitBinaries | dFlagNewFloats | dFlagFunTags | dflagNewFunTags | dFlagUtf8Atoms | dFlagMapTag + | dFlagExportPtrTag | dFlagBigCreation; /* initialize hostname and default cookie */ diff --git a/lib/jinterface/test/nc_SUITE.erl b/lib/jinterface/test/nc_SUITE.erl index 4f225a396e..7833d070b7 100644 --- a/lib/jinterface/test/nc_SUITE.erl +++ b/lib/jinterface/test/nc_SUITE.erl @@ -142,7 +142,8 @@ fun_roundtrip(Config) when is_list(Config)-> do_echo([fun(A, B) -> A + B end, fun(A) -> lists:reverse(A) end, fun() -> ok end, - fun fun_roundtrip/1], + fun fun_roundtrip/1, + fun ?MODULE:fun_roundtrip/1], Config). port_roundtrip(doc) -> []; diff --git a/lib/kernel/doc/src/application.xml b/lib/kernel/doc/src/application.xml index 83a83ebad2..f4ec2c610f 100644 --- a/lib/kernel/doc/src/application.xml +++ b/lib/kernel/doc/src/application.xml @@ -582,7 +582,7 @@ Nodes = [cp1@cave, {cp2@cave, cp3@cave}]</code> the primary application) for the primary application and all included applications, for which the start phase is defined.</p> <p>For a description of <c>StartType</c>, see - <seealso marker="Module:start/2"><c>Module:start/2</c></seealso>.</p> + <seealso marker="#Module:start/2"><c>Module:start/2</c></seealso>.</p> </desc> </func> <func> diff --git a/lib/kernel/doc/src/auth.xml b/lib/kernel/doc/src/auth.xml index a57da18de9..c735d02fed 100644 --- a/lib/kernel/doc/src/auth.xml +++ b/lib/kernel/doc/src/auth.xml @@ -46,7 +46,7 @@ <fsummary>Magic cookie for local node (deprecated).</fsummary> <desc> <p>Use - <seealso marker="erts:erlang#erlang:get_cookie/0"><c>erlang:get_cookie()</c></seealso> + <seealso marker="erts:erlang#get_cookie/0"><c>erlang:get_cookie()</c></seealso> in ERTS instead.</p> </desc> </func> @@ -58,7 +58,7 @@ </type_desc> <desc> <p>Use - <seealso marker="erts:erlang#erlang:set_cookie/2"><c>erlang:set_cookie(node(), <anno>Cookie</anno>)</c> + <seealso marker="erts:erlang#set_cookie/2"><c>erlang:set_cookie(node(), <anno>Cookie</anno>)</c> in ERTS</seealso> instead.</p> </desc> </func> @@ -94,7 +94,7 @@ <p>Sets the magic cookie of <c><anno>Node</anno></c> to <c><anno>Cookie</anno></c> and verifies the status of the authorization. Equivalent to calling - <seealso marker="erts:erlang#erlang:set_cookie/2"><c>erlang:set_cookie(<anno>Node</anno>, <anno>Cookie</anno>)</c></seealso>, followed by + <seealso marker="erts:erlang#set_cookie/2"><c>erlang:set_cookie(<anno>Node</anno>, <anno>Cookie</anno>)</c></seealso>, followed by <seealso marker="#is_auth/1"><c>auth:is_auth(<anno>Node</anno>)</c></seealso>.</p> </desc> </func> diff --git a/lib/kernel/doc/src/erl_ddll.xml b/lib/kernel/doc/src/erl_ddll.xml index f2d5e1b397..52d5bcd079 100644 --- a/lib/kernel/doc/src/erl_ddll.xml +++ b/lib/kernel/doc/src/erl_ddll.xml @@ -200,7 +200,7 @@ <fsummary>Remove a monitor for a driver.</fsummary> <desc> <p>Removes a driver monitor in much the same way as - <seealso marker="erts:erlang#erlang:demonitor/1"><c>erlang:demonitor/1</c></seealso> + <seealso marker="erts:erlang#demonitor/1"><c>erlang:demonitor/1</c></seealso> in ERTS does with process monitors. For details about how to create driver monitors, see @@ -430,7 +430,7 @@ <desc> <p>Creates a driver monitor and works in many ways as - <seealso marker="erts:erlang#erlang:monitor/2"><c>erlang:monitor/2</c></seealso> + <seealso marker="erts:erlang#monitor/2"><c>erlang:monitor/2</c></seealso> in ERTS, does for processes. When a driver changes state, the monitor results in a monitor message that is sent to the calling diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml index f70d6c24db..61ac1485c1 100644 --- a/lib/kernel/doc/src/gen_sctp.xml +++ b/lib/kernel/doc/src/gen_sctp.xml @@ -253,7 +253,7 @@ connect(Socket, Ip, Port>, <desc> <p>Assigns a new controlling process <c><anno>Pid</anno></c> to <c><anno>Socket</anno></c>. Same implementation as - <seealso marker="gen_udp:controlling_process/2"><c>gen_udp:controlling_process/2</c></seealso>. + <seealso marker="gen_udp#controlling_process/2"><c>gen_udp:controlling_process/2</c></seealso>. </p> </desc> </func> diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml index fc16473393..f8b41d24e2 100644 --- a/lib/kernel/doc/src/gen_tcp.xml +++ b/lib/kernel/doc/src/gen_tcp.xml @@ -259,6 +259,12 @@ do_recv(Sock, Bs) -> <p>The optional <c><anno>Timeout</anno></c> parameter specifies a time-out in milliseconds. Defaults to <c>infinity</c>.</p> <note> + <p>Keep in mind that if the underlying OS <c>connect()</c> call returns + a timeout, <c>gen_tcp:connect</c> will also return a timeout + (i.e. <c>{error, etimedout}</c>), even if a larger <c>Timeout</c> was + specified.</p> + </note> + <note> <p>The default values for options specified to <c>connect</c> can be affected by the Kernel configuration parameter <c>inet_default_connect_options</c>. For details, see diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 709ba8e8fd..d4678ca5db 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -294,6 +294,9 @@ fe80::204:acff:fe17:bf38 <datatype> <name name="socket_protocol"/> </datatype> + <datatype> + <name name="stat_option"/> + </datatype> </datatypes> <funcs> diff --git a/lib/kernel/doc/src/logger_chapter.xml b/lib/kernel/doc/src/logger_chapter.xml index 8458ffa042..1aa4b7a3a2 100644 --- a/lib/kernel/doc/src/logger_chapter.xml +++ b/lib/kernel/doc/src/logger_chapter.xml @@ -718,7 +718,7 @@ logger:debug(#{got => connection_request, id => Id, state => State}, </seealso></pre> <p>For all other values of <c>HandlerId</c>, this entry adds a new handler, equivalent to calling</p> - <pre><seealso marker="logger:add_handler/3"> + <pre><seealso marker="logger#add_handler/3"> logger:add_handler(HandlerId, Module, HandlerConfig) </seealso></pre> <p>Multiple entries of this type are allowed.</p></item> diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index 0c187eb19f..61bd598145 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -31,6 +31,21 @@ </header> <p>This document describes the changes made to the Kernel application.</p> +<section><title>Kernel 6.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a performance regression when reading files + opened with the <c>compressed</c> flag.</p> + <p> + Own Id: OTP-15706 Aux Id: ERIERL-336 </p> + </item> + </list> + </section> + +</section> + <section><title>Kernel 6.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/kernel/src/erl_distribution.erl b/lib/kernel/src/erl_distribution.erl index 0bec78e938..cdb2d2f1f6 100644 --- a/lib/kernel/src/erl_distribution.erl +++ b/lib/kernel/src/erl_distribution.erl @@ -21,6 +21,8 @@ -behaviour(supervisor). +-include_lib("kernel/include/logger.hrl"). + -export([start_link/0,start_link/2,init/1,start/1,stop/0]). -define(DBG,erlang:display([?MODULE,?LINE])). @@ -83,6 +85,10 @@ do_start_link([{Arg,Flag}|T]) -> case init:get_argument(Arg) of {ok,[[Name]]} -> start_link([list_to_atom(Name),Flag|ticktime()], true); + {ok,[[Name]|_Rest]} -> + ?LOG_WARNING("Multiple -~p given to erl, using the first, ~p", + [Arg, Name]), + start_link([list_to_atom(Name),Flag|ticktime()], true); _ -> do_start_link(T) end; diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl index f31a1722ce..7a14e2635c 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -33,10 +33,10 @@ -define(erlang_daemon_port, 4369). -endif. -ifndef(epmd_dist_high). --define(epmd_dist_high, 6). +-define(epmd_dist_high, 4370). -endif. -ifndef(epmd_dist_low). --define(epmd_dist_low, 5). +-define(epmd_dist_low, 4370). -endif. %% External exports @@ -342,13 +342,6 @@ wait_for_reg_reply(Socket, SoFar) -> receive {tcp, Socket, Data0} -> case SoFar ++ Data0 of - [$v, Result, A, B, C, D] -> - case Result of - 0 -> - {alive, Socket, ?u32(A, B, C, D)}; - _ -> - {error, duplicate_name} - end; [$y, Result, A, B] -> case Result of 0 -> diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index c4d276f9e8..e6a30d0b92 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -33,6 +33,7 @@ -export([breakpoint/2, disassemble/1, display/1, dist_ext_to_term/2, flat_size/1, get_internal_state/1, instructions/0, + interpreter_size/0, map_info/1, same/2, set_internal_state/2, size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2, dirty/3, lcnt_control/1, lcnt_control/2, lcnt_collect/0, lcnt_clear/0, @@ -118,6 +119,11 @@ get_internal_state(_) -> instructions() -> erlang:nif_error(undef). +-spec interpreter_size() -> pos_integer(). + +interpreter_size() -> + erlang:nif_error(undef). + -spec ic(F) -> Result when F :: function(), Result :: term(). diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src index 8fa3f5c588..aca3247c8f 100644 --- a/lib/kernel/src/kernel.appup.src +++ b/lib/kernel/src/kernel.appup.src @@ -43,7 +43,9 @@ {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^6\\.2$">>,[restart_new_emulator]}, {<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], + {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.3$">>,[restart_new_emulator]}, + {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}], [{<<"^5\\.3$">>,[restart_new_emulator]}, {<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -60,4 +62,6 @@ {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, {<<"^6\\.2$">>,[restart_new_emulator]}, {<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. + {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^6\\.3$">>,[restart_new_emulator]}, + {<<"^6\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}. diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl index 111d103df2..bfa091a036 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -68,7 +68,7 @@ config_change(Changed, New, Removed) -> %%% auth, ...) ...) %%% %%% The rectangular boxes are supervisors. All supervisors except -%%% for kernel_safe_sup terminates the enitre erlang node if any of +%%% for kernel_safe_sup terminates the entire erlang node if any of %%% their children dies. Any child that can't be restarted in case %%% of failure must be placed under one of these supervisors. Any %%% other child must be placed under safe_sup. These children may diff --git a/lib/kernel/src/raw_file_io_inflate.erl b/lib/kernel/src/raw_file_io_inflate.erl index 7e9780310c..d3ed02dd03 100644 --- a/lib/kernel/src/raw_file_io_inflate.erl +++ b/lib/kernel/src/raw_file_io_inflate.erl @@ -26,7 +26,7 @@ -include("file_int.hrl"). --define(INFLATE_CHUNK_SIZE, (1 bsl 10)). +-define(INFLATE_CHUNK_SIZE, (8 bsl 10)). -define(GZIP_WBITS, (16 + 15)). callback_mode() -> state_functions. diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index 8dd4ef1987..c3a022df0a 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -205,6 +205,9 @@ nodenames(Config) when is_list(Config) -> legal("a-1@b"), legal("a_1@b"), + %% Test that giving two -sname works as it should + test_node("a_1@b", false, long_or_short() ++ "a_0@b"), + illegal("cdé@a"), illegal("te欢st@a"). @@ -258,8 +261,11 @@ illegal(Name) -> test_node(Name) -> test_node(Name, false). test_node(Name, Illigal) -> + test_node(Name, Illigal, ""). +test_node(Name, Illigal, ExtraArgs) -> ProgName = ct:get_progname(), - Command = ProgName ++ " -noinput " ++ long_or_short() ++ Name ++ + Command = ProgName ++ " -noinput " ++ ExtraArgs ++ + long_or_short() ++ Name ++ " -eval \"net_adm:ping('" ++ atom_to_list(node()) ++ "')\"" ++ case Illigal of true -> diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl index f3db6705a2..8256444bdc 100644 --- a/lib/kernel/test/erl_distribution_wb_SUITE.erl +++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl @@ -47,9 +47,6 @@ R end). --define(EPMD_DIST_HIGH, 6). --define(EPMD_DIST_LOW, 5). - -define(DFLAG_PUBLISHED,1). -define(DFLAG_ATOM_CACHE,2). -define(DFLAG_EXTENDED_REFERENCES,4). @@ -60,18 +57,15 @@ -define(DFLAG_NEW_FUN_TAGS,16#80). -define(DFLAG_EXTENDED_PIDS_PORTS,16#100). -define(DFLAG_UTF8_ATOMS, 16#10000). --define(DFLAG_BIG_CREATION, 16#40000). %% From R9 and forward extended references is compulsory %% From R10 and forward extended pids and ports are compulsory %% From R20 and forward UTF8 atoms are compulsory %% From R21 and forward NEW_FUN_TAGS is compulsory (no more tuple fallback {fun, ...}) -%% From R22 and forward BIG_CREATION is compulsory -define(COMPULSORY_DFLAGS, (?DFLAG_EXTENDED_REFERENCES bor ?DFLAG_EXTENDED_PIDS_PORTS bor ?DFLAG_UTF8_ATOMS bor - ?DFLAG_NEW_FUN_TAGS bor - ?DFLAG_BIG_CREATION)). + ?DFLAG_NEW_FUN_TAGS)). -define(PASS_THROUGH, $p). @@ -214,9 +208,9 @@ pending_up_md5(Node,OurName,Cookie) -> {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, [{active,false}, {packet,2}]), - send_name(SocketA,OurName, ?EPMD_DIST_HIGH), + send_name(SocketA,OurName,5), ok = recv_status(SocketA), - {hidden,Node,?EPMD_DIST_HIGH,HisChallengeA} = recv_challenge(SocketA), % See 1) + {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1) OurChallengeA = gen_challenge(), OurDigestA = gen_digest(HisChallengeA, Cookie), send_challenge_reply(SocketA, OurChallengeA, OurDigestA), @@ -230,11 +224,11 @@ pending_up_md5(Node,OurName,Cookie) -> {ok, SocketB} = gen_tcp:connect(atom_to_list(NB),PortNo, [{active,false}, {packet,2}]), - send_name(SocketB,OurName, ?EPMD_DIST_HIGH), + send_name(SocketB,OurName,5), alive = recv_status(SocketB), send_status(SocketB, true), gen_tcp:close(SocketA), - {hidden,Node,?EPMD_DIST_HIGH,HisChallengeB} = recv_challenge(SocketB), % See 1) + {hidden,Node,5,HisChallengeB} = recv_challenge(SocketB), % See 1) OurChallengeB = gen_challenge(), OurDigestB = gen_digest(HisChallengeB, Cookie), send_challenge_reply(SocketB, OurChallengeB, OurDigestB), @@ -260,7 +254,7 @@ simultaneous_md5(Node, OurName, Cookie) when OurName < Node -> Else -> exit(Else) end, - EpmdSocket = register_node(OurName, LSocket, ?EPMD_DIST_LOW, ?EPMD_DIST_HIGH), + EpmdSocket = register(OurName, LSocket, 1, 5), {NA, NB} = split(Node), rpc:cast(Node, net_adm, ping, [OurName]), receive after 1000 -> ok end, @@ -268,7 +262,7 @@ simultaneous_md5(Node, OurName, Cookie) when OurName < Node -> {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, [{active,false}, {packet,2}]), - send_name(SocketA,OurName, ?EPMD_DIST_HIGH), + send_name(SocketA,OurName,5), %% We are still not marked up on the other side, as our first message %% is not sent. SocketB = case gen_tcp:accept(LSocket) of @@ -281,11 +275,11 @@ simultaneous_md5(Node, OurName, Cookie) when OurName < Node -> %% Now we are expected to close A gen_tcp:close(SocketA), %% But still Socket B will continue - {normal,Node,?EPMD_DIST_HIGH} = recv_name(SocketB), % See 1) + {normal,Node,5} = recv_name(SocketB), % See 1) send_status(SocketB, ok_simultaneous), MyChallengeB = gen_challenge(), - send_challenge(SocketB, OurName, MyChallengeB, ?EPMD_DIST_HIGH), - {ok,HisChallengeB} = recv_challenge_reply(SocketB, MyChallengeB, Cookie), + send_challenge(SocketB, OurName, MyChallengeB,5), + HisChallengeB = recv_challenge_reply(SocketB, MyChallengeB, Cookie), DigestB = gen_digest(HisChallengeB,Cookie), send_challenge_ack(SocketB, DigestB), inet:setopts(SocketB, [{active, false}, @@ -307,8 +301,7 @@ simultaneous_md5(Node, OurName, Cookie) when OurName > Node -> Else -> exit(Else) end, - EpmdSocket = register_node(OurName, LSocket, - ?EPMD_DIST_LOW, ?EPMD_DIST_HIGH), + EpmdSocket = register(OurName, LSocket, 1, 5), {NA, NB} = split(Node), rpc:cast(Node, net_adm, ping, [OurName]), receive after 1000 -> ok end, @@ -322,16 +315,16 @@ simultaneous_md5(Node, OurName, Cookie) when OurName > Node -> Else2 -> exit(Else2) end, - send_name(SocketA,OurName, ?EPMD_DIST_HIGH), + send_name(SocketA,OurName,5), ok_simultaneous = recv_status(SocketA), %% Socket B should die during this case catch begin - {normal,Node,?EPMD_DIST_HIGH} = recv_name(SocketB), % See 1) + {normal,Node,5} = recv_name(SocketB), % See 1) send_status(SocketB, ok_simultaneous), MyChallengeB = gen_challenge(), send_challenge(SocketB, OurName, MyChallengeB, 5), - {ok,HisChallengeB} = recv_challenge_reply( + HisChallengeB = recv_challenge_reply( SocketB, MyChallengeB, Cookie), @@ -353,7 +346,7 @@ simultaneous_md5(Node, OurName, Cookie) when OurName > Node -> end, gen_tcp:close(SocketB), %% But still Socket A will continue - {hidden,Node,?EPMD_DIST_HIGH,HisChallengeA} = recv_challenge(SocketA), % See 1) + {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1) OurChallengeA = gen_challenge(), OurDigestA = gen_digest(HisChallengeA, Cookie), send_challenge_reply(SocketA, OurChallengeA, OurDigestA), @@ -379,7 +372,7 @@ missing_compulsory_dflags(Config) when is_list(Config) -> [{active,false}, {packet,2}]), BadNode = list_to_atom(atom_to_list(Name2)++"@"++atom_to_list(NB)), - send_name(SocketA,BadNode, ?EPMD_DIST_HIGH, 0), + send_name(SocketA,BadNode,5,0), not_allowed = recv_status(SocketA), gen_tcp:close(SocketA), stop_node(Node), @@ -523,16 +516,16 @@ send_challenge_reply(Socket, Challenge, Digest) -> recv_challenge_reply(Socket, ChallengeA, Cookie) -> case gen_tcp:recv(Socket, 0) of - {ok,[$r,CB3,CB2,CB1,CB0 | SumB]=Data} when length(SumB) == 16 -> + {ok,[$r,CB3,CB2,CB1,CB0 | SumB]} when length(SumB) == 16 -> SumA = gen_digest(ChallengeA, Cookie), ChallengeB = ?u32(CB3,CB2,CB1,CB0), if SumB == SumA -> - {ok,ChallengeB}; + ChallengeB; true -> - {error,Data} + ?shutdown(bad_challenge_reply) end; - Err -> - {error,Err} + _ -> + ?shutdown(no_node) end. send_challenge_ack(Socket, Digest) -> @@ -627,13 +620,6 @@ wait_for_reg_reply(Socket, SoFar) -> receive {tcp, Socket, Data0} -> case SoFar ++ Data0 of - [$v, Result, A, B, C, D] -> - case Result of - 0 -> - {alive, Socket, ?u32(A, B, C, D)}; - _ -> - {error, duplicate_name} - end; [$y, Result, A, B] -> case Result of 0 -> @@ -654,7 +640,7 @@ wait_for_reg_reply(Socket, SoFar) -> end. -register_node(NodeName, ListenSocket, VLow, VHigh) -> +register(NodeName, ListenSocket, VLow, VHigh) -> {ok,{_,TcpPort}} = inet:sockname(ListenSocket), case do_register_node(NodeName, TcpPort, VLow, VHigh) of {alive, Socket, _Creation} -> diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 711ffccb67..3bc8e6e828 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -3744,19 +3744,33 @@ otp_10852(Config) when is_list(Config) -> ok = rpc_call(Node, read_file, [B]), ok = rpc_call(Node, make_link, [B,B]), case rpc_call(Node, make_symlink, [B,B]) of - ok -> ok; - {error, E} when (E =:= enotsup) or (E =:= eperm) -> - {win32,_} = os:type() + {error, eilseq} -> + %% Some versions of OS X refuse to create files with illegal names. + {unix,darwin} = os:type(); + {error, eperm} -> + %% The test user might not have permission to create symlinks. + {win32,_} = os:type(); + ok -> + ok end, ok = rpc_call(Node, delete, [B]), - ok = rpc_call(Node, make_dir, [B]), + case rpc_call(Node, make_dir, [B]) of + {error, eilseq} -> + {unix,darwin} = os:type(); + ok -> + ok + end, ok = rpc_call(Node, del_dir, [B]), - ok = rpc_call(Node, write_file, [B,B]), - {ok, Fd} = rpc_call(Node, open, [B,[read]]), - ok = rpc_call(Node, close, [Fd]), - {ok,0} = rpc_call(Node, copy, [B,B]), - {ok, Fd2, B} = rpc_call(Node, path_open, [["."], B, [read]]), - ok = rpc_call(Node, close, [Fd2]), + case rpc_call(Node, write_file, [B,B]) of + {error, eilseq} -> + {unix,darwin} = os:type(); + ok -> + {ok, Fd} = rpc_call(Node, open, [B,[read]]), + ok = rpc_call(Node, close, [Fd]), + {ok,0} = rpc_call(Node, copy, [B,B]), + {ok, Fd2, B} = rpc_call(Node, path_open, [["."], B, [read]]), + ok = rpc_call(Node, close, [Fd2]) + end, true = test_server:stop_node(Node), ok. @@ -4500,15 +4514,18 @@ run_large_file_test(Config, Run, Name) -> {{unix,sunos},OsVersion} when OsVersion < {5,5,1} -> {skip,"Only supported on Win32, Unix or SunOS >= 5.5.1"}; {{unix,_},_} -> - N = disc_free(proplists:get_value(priv_dir, Config)), - io:format("Free disk: ~w KByte~n", [N]), - if N < 5 * (1 bsl 20) -> - %% Less than 5 GByte free - {skip,"Less than 5 GByte free"}; - true -> - do_run_large_file_test(Config, Run, Name) - end; - _ -> + case disc_free(proplists:get_value(priv_dir, Config)) of + error -> + {skip, "Failed to query disk space for priv_dir. " + "Is it on a remote file system?~n"}; + N when N >= 5 * (1 bsl 20) -> + ct:pal("Free disk: ~w KByte~n", [N]), + do_run_large_file_test(Config, Run, Name); + N when N < 5 * (1 bsl 20) -> + ct:pal("Free disk: ~w KByte~n", [N]), + {skip,"Less than 5 GByte free"} + end; + _ -> {skip,"Only supported on Win32, Unix or SunOS >= 5.5.1"} end. @@ -4542,12 +4559,18 @@ do_run_large_file_test(Config, Run, Name0) -> disc_free(Path) -> Data = disksup:get_disk_data(), - {_,Tot,Perc} = hd(lists:filter( - fun({P,_Size,_Full}) -> - lists:prefix(filename:nativename(P), - filename:nativename(Path)) - end, lists:reverse(lists:sort(Data)))), - round(Tot * (1-(Perc/100))). + + %% What partitions could Data be mounted on? + Partitions = + [D || {P, _Tot, _Perc}=D <- Data, + lists:prefix(filename:nativename(P), filename:nativename(Path))], + + %% Sorting in descending order places the partition with the most specific + %% path first. + case lists:sort(fun erlang:'>='/2, Partitions) of + [{_,Tot, Perc} | _] -> round(Tot * (1-(Perc/100))); + [] -> error + end. memsize() -> {Tot,_Used,_} = memsup:get_memory_data(), diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl index 3afc647081..26cfd187c7 100644 --- a/lib/kernel/test/file_name_SUITE.erl +++ b/lib/kernel/test/file_name_SUITE.erl @@ -632,10 +632,13 @@ make_icky_dir(Mod, IckyDirName) -> hopeless_darwin() -> case {os:type(),os:version()} of - {{unix,darwin},{Major,_,_}} when Major < 9 -> - true; - _ -> - false + {{unix,darwin},{Major,_,_}} -> + %% icky file names worked between 10 and 17, but started returning + %% EILSEQ in 18. The check against 18 is exact in case newer + %% versions of Darwin support them again. + Major < 9 orelse Major =:= 18; + _ -> + false end. make_very_icky_dir(Mod, DirName) -> diff --git a/lib/kernel/test/logger_std_h_SUITE.erl b/lib/kernel/test/logger_std_h_SUITE.erl index 0c5516f82b..16ab0e97fc 100644 --- a/lib/kernel/test/logger_std_h_SUITE.erl +++ b/lib/kernel/test/logger_std_h_SUITE.erl @@ -71,6 +71,14 @@ init_per_group(_Group, Config) -> end_per_group(_Group, _Config) -> ok. +init_per_testcase(reopen_changed_log=TC, Config) -> + case os:type() of + {win32,_} -> + {skip,"This test can only work with inodes, i.e. not on Windows"}; + _ -> + ct:print("********** ~w **********", [TC]), + Config + end; init_per_testcase(TestHooksCase, Config) when TestHooksCase == write_failure; TestHooksCase == sync_failure -> diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index 7bebe1ba70..b1ae513223 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 6.3 +KERNEL_VSN = 6.3.1 diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index ba2d89313e..d28f229b3e 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -68,7 +68,7 @@ -type util_cpus() :: 'all' | integer() | [integer()]. -type util_state() :: 'user' | 'nice_user' | 'kernel' | 'wait' | 'idle'. --type util_value() :: [{util_state(), float()}] | float(). +-type util_value() :: [{util_state(), number()}] | number(). -type util_desc() :: {util_cpus(), util_value(), util_value(), []}. %%---------------------------------------------------------------------- @@ -122,7 +122,7 @@ util(Args) when is_list (Args) -> util(_) -> erlang:error(badarg). --spec util() -> float() | {'error', any()}. +-spec util() -> number() | {'error', any()}. util() -> case util([]) of diff --git a/lib/parsetools/test/leex_SUITE.erl b/lib/parsetools/test/leex_SUITE.erl index 3f5d9fee3e..ad8fb11beb 100644 --- a/lib/parsetools/test/leex_SUITE.erl +++ b/lib/parsetools/test/leex_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2017. All Rights Reserved. +%% Copyright Ericsson AB 2010-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -124,10 +124,6 @@ file(Config) when is_list(Config) -> "Erlang code.\n">>, ?line ok = file:write_file(Filename, Mini), ?line {error,[{_,[{none,leex,{file_error,_}}]}],[]} = - leex:file(Filename, [{scannerfile,"//"} | Ret]), - ?line {error,[{_,[{none,leex,{file_error,_}}]}],[]} = - leex:file(Filename, [{includefile,"//"} | Ret]), - ?line {error,[{_,[{none,leex,{file_error,_}}]}],[]} = leex:file(Filename, [{includefile,"/ /"} | Ret]), LeexPre = filename:join(Dir, "leexinc.hrl"), @@ -191,7 +187,6 @@ compile(Config) when is_list(Config) -> "{L}+ : {token,{word,TokenLine,TokenChars}}.\n" "Erlang code.\n">>, ?line ok = file:write_file(Filename, Mini), - ?line error = leex:compile(Filename, "//", #options{}), ?line ok = leex:compile(Filename, Scannerfile, #options{}), file:delete(Scannerfile), file:delete(Filename), diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index fb81ea68a4..12bb0b21b0 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -286,7 +286,9 @@ entries as ASN.1 DER encoded entities.</fsummary> <desc> <p>Decodes PEM binary data and returns entries as ASN.1 DER encoded entities.</p> - <p>Example <c>{ok, PemBin} = file:read_file("cert.pem").</c></p> + <p>Example <c>{ok, PemBin} = file:read_file("cert.pem"). + PemEntries = public_key:pem_decode(PemBin). + </c></p> </desc> </func> @@ -813,7 +815,8 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <p>The <c>{OtherRefId,term()}</c> is defined by the user and is passed to the <c>match_fun</c>, if defined. If the term in <c>OtherRefId</c> is a binary, it will be converted to a string. </p> - <p>The <c>ip</c> Reference ID takes an <seealso marker="inet:inet#type-ip_address">inet:ip_address()</seealso> + <p>The <c>ip</c> Reference ID takes an + <seealso marker="kernel:inet#type-ip_address">inet:ip_address()</seealso> or an ip address in string format (E.g "10.0.1.1" or "1234::5678:9012") as second element. </p> <p>The options are:</p> diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl index 61a1239d26..12c61e158f 100644 --- a/lib/public_key/src/pubkey_cert.erl +++ b/lib/public_key/src/pubkey_cert.erl @@ -1187,6 +1187,8 @@ sign_algorithm(#'ECPrivateKey'{parameters = Parms}, Opts) -> parameters = Parms}. rsa_digest_oid(sha1) -> ?'sha1WithRSAEncryption'; +rsa_digest_oid(sha) -> + ?'sha1WithRSAEncryption'; rsa_digest_oid(sha512) -> ?'sha512WithRSAEncryption'; rsa_digest_oid(sha384) -> @@ -1198,6 +1200,8 @@ rsa_digest_oid(md5) -> ecdsa_digest_oid(sha1) -> ?'ecdsa-with-SHA1'; +ecdsa_digest_oid(sha) -> + ?'ecdsa-with-SHA1'; ecdsa_digest_oid(sha512) -> ?'ecdsa-with-SHA512'; ecdsa_digest_oid(sha384) -> diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 47c5dbb95a..47266c514c 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -112,6 +112,7 @@ -type ssh_file() :: openssh_public_key | rfc4716_public_key | known_hosts | auth_keys. -type digest_type() :: none % None is for backwards compatibility + | sha1 % Backwards compatibility | crypto:rsa_digest_type() | crypto:dss_digest_type() | crypto:ecdsa_digest_type(). @@ -406,8 +407,7 @@ decrypt_private(CipherText, Options) when is_binary(CipherText), is_list(Options) -> - Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), - crypto:private_decrypt(rsa, CipherText, format_rsa_private_key(Key), Padding). + crypto:private_decrypt(rsa, CipherText, format_rsa_private_key(Key), default_options(Options)). %%-------------------------------------------------------------------- %% Description: Public key decryption using the public key. @@ -428,8 +428,7 @@ decrypt_public(CipherText, Key) -> PlainText :: binary() . decrypt_public(CipherText, #'RSAPublicKey'{modulus = N, publicExponent = E}, Options) when is_binary(CipherText), is_list(Options) -> - Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), - crypto:public_decrypt(rsa, CipherText,[E, N], Padding). + crypto:public_decrypt(rsa, CipherText,[E, N], default_options(Options)). %%-------------------------------------------------------------------- %% Description: Public key encryption using the public key. @@ -451,8 +450,7 @@ encrypt_public(PlainText, Key) -> CipherText :: binary() . encrypt_public(PlainText, #'RSAPublicKey'{modulus=N,publicExponent=E}, Options) when is_binary(PlainText), is_list(Options) -> - Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), - crypto:public_encrypt(rsa, PlainText, [E,N], Padding). + crypto:public_encrypt(rsa, PlainText, [E,N], default_options(Options)). %%-------------------------------------------------------------------- %% @@ -480,8 +478,7 @@ encrypt_private(PlainText, when is_binary(PlainText), is_integer(N), is_integer(E), is_integer(D), is_list(Options) -> - Padding = proplists:get_value(rsa_pad, Options, rsa_pkcs1_padding), - crypto:private_encrypt(rsa, PlainText, format_rsa_private_key(Key), Padding). + crypto:private_encrypt(rsa, PlainText, format_rsa_private_key(Key), default_options(Options)). %%-------------------------------------------------------------------- %% Description: List available group sizes among the pre-computed dh groups @@ -1234,6 +1231,33 @@ pkix_test_root_cert(Name, Opts) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +default_options([]) -> + [{rsa_padding, rsa_pkcs1_padding}]; +default_options(Opts) -> + case proplists:get_value(rsa_pad, Opts) of + undefined -> + case proplists:get_value(rsa_padding, Opts) of + undefined -> + case lists:dropwhile(fun erlang:is_tuple/1, Opts) of + [Pad|_] -> + set_padding(Pad, Opts); + [] -> + set_padding(rsa_pkcs1_padding, Opts) + end; + Pad -> + set_padding(Pad, Opts) + end; + Pad -> + set_padding(Pad, Opts) + end. + +set_padding(Pad, Opts) -> + [{rsa_padding,Pad} | [{T,V} || {T,V} <- Opts, + T =/= rsa_padding, + T =/= rsa_pad] + ]. + + format_sign_key(Key = #'RSAPrivateKey'{}) -> {rsa, format_rsa_private_key(Key)}; format_sign_key(#'DSAPrivateKey'{p = P, q = Q, g = G, x = X}) -> diff --git a/lib/sasl/src/Makefile b/lib/sasl/src/Makefile index 7338bdf016..fd62588f5c 100644 --- a/lib/sasl/src/Makefile +++ b/lib/sasl/src/Makefile @@ -61,7 +61,11 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- + ERL_COMPILE_FLAGS += -I../../stdlib/include -Werror +ifeq ($(USE_ESOCK), yes) +ERL_COMPILE_FLAGS += -DUSE_ESOCK=true +endif # ---------------------------------------------------- diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index c2c91fd667..b5a6b44f93 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -33,6 +33,7 @@ -export([read_application/4]). -export([make_hybrid_boot/4]). +-export([preloaded/0]). % Exported just for testing -import(lists, [filter/2, keysort/2, keysearch/3, map/2, reverse/1, append/1, foldl/3, member/2, foreach/2]). @@ -45,6 +46,13 @@ -compile({inline,[{badarg,2}]}). +-ifdef(USE_ESOCK). +-define(ESOCK_MODS, [socket]). +-else. +-define(ESOCK_MODS, []). +-endif. + + %%----------------------------------------------------------------- %% Create a boot script from a release file. %% Options is a list of {path, Path} | silent | local @@ -1566,7 +1574,7 @@ preloaded() -> erts_code_purger,erts_dirty_process_signal_handler, erts_internal,erts_literal_area_collector, init,net,persistent_term,prim_buffer,prim_eval,prim_file, - prim_inet,prim_zip,socket,zlib]. + prim_inet,prim_zip] ++ ?ESOCK_MODS ++ [zlib]. %%______________________________________________________________________ %% Kernel processes; processes that are specially treated by the init diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index 423d90fef6..a6c3d57148 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -73,6 +73,23 @@ </section> + <section><title>SNMP 5.2.11.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + [snmp|agent] Add a get-mechanism callback module (and a + corresponding behaviour). The agent calls this module to + handle each get (get, get-next and get-bulk) request.</p> + <p> + Own Id: OTP-15691 Aux Id: ERIERL-324 </p> + </item> + </list> + </section> + +</section> + <section><title>SNMP 5.2.11</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/snmp/include/snmp_types.hrl b/lib/snmp/include/snmp_types.hrl index ffe30996dc..eff17a13a3 100644 --- a/lib/snmp/include/snmp_types.hrl +++ b/lib/snmp/include/snmp_types.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -349,6 +349,9 @@ -define(view_included, 1). -define(view_excluded, 2). +-define(view_wildcard, 0). +-define(view_exact, 1). + %%----------------------------------------------------------------- %% From SNMPv2-SMI diff --git a/lib/snmp/src/agent/depend.mk b/lib/snmp/src/agent/depend.mk index 8eba50fa3b..49c7669e41 100644 --- a/lib/snmp/src/agent/depend.mk +++ b/lib/snmp/src/agent/depend.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2016. All Rights Reserved. +# Copyright Ericsson AB 2004-2019. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -24,6 +24,9 @@ $(EBIN)/snmpa_authentication_service.$(EMULATOR): \ $(EBIN)/snmpa_error_report.$(EMULATOR): \ snmpa_error_report.erl +$(EBIN)/snmpa_get_mechanism.$(EMULATOR): \ + snmpa_get_mechanism.erl + $(EBIN)/snmpa_network_interface.$(EMULATOR): \ snmpa_network_interface.erl @@ -78,6 +81,20 @@ $(EBIN)/snmpa_error_logger.$(EMULATOR): \ snmpa_error_report.erl \ snmpa_error_logger.erl +$(EBIN)/snmpa_set.$(EMULATOR): \ + snmpa_set_mechanism.erl \ + snmpa_set.erl \ + ../misc/snmp_verbosity.hrl + +$(EBIN)/snmpa_get.$(EMULATOR): \ + snmpa_get_mechanism.erl \ + snmpa_get.erl \ + ../misc/snmp_verbosity.hrl + +$(EBIN)/snmpa_get_lib.$(EMULATOR): \ + snmpa_get_lib.erl \ + ../misc/snmp_verbosity.hrl + $(EBIN)/snmpa_local_db.$(EMULATOR): \ snmpa_local_db.erl \ ../misc/snmp_debug.hrl \ diff --git a/lib/snmp/src/agent/modules.mk b/lib/snmp/src/agent/modules.mk index 0f8615588a..49cc158c2e 100644 --- a/lib/snmp/src/agent/modules.mk +++ b/lib/snmp/src/agent/modules.mk @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2016. All Rights Reserved. +# Copyright Ericsson AB 2004-2019. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -22,6 +22,7 @@ BEHAVIOUR_MODULES = \ snmpa_authentication_service \ snmpa_discovery_handler \ snmpa_error_report \ + snmpa_get_mechanism \ snmpa_mib_storage \ snmpa_mib_data \ snmpa_network_interface \ @@ -30,12 +31,24 @@ BEHAVIOUR_MODULES = \ snmpa_notification_filter \ snmpa_set_mechanism +MIB_MODULES = \ + snmp_community_mib \ + snmp_framework_mib \ + snmp_notification_mib \ + snmp_standard_mib \ + snmp_target_mib \ + snmp_user_based_sm_mib \ + snmp_view_based_acm_mib + # snmpa is "plain" interface module but also defines some agent specific types # and therefor must be compiled before the modules that use them, including # the behaviour modules... +# Some of the MIB modules also define types used elsewhere and therefor +# has to be built before the other mods. # snmpa_mib_data_ttln MODULES = \ snmpa \ + $(MIB_MODULES) \ $(BEHAVIOUR_MODULES) \ snmpa_acm \ snmpa_agent \ @@ -46,6 +59,8 @@ MODULES = \ snmpa_error \ snmpa_error_io \ snmpa_error_logger \ + snmpa_get \ + snmpa_get_lib \ snmpa_local_db \ snmpa_mib_storage_ets \ snmpa_mib_storage_dets \ @@ -66,17 +81,10 @@ MODULES = \ snmpa_trap \ snmpa_usm \ snmpa_vacm \ - snmp_community_mib \ - snmp_framework_mib \ snmp_generic \ snmp_generic_mnesia \ snmp_index \ - snmp_notification_mib \ - snmp_shadow_table \ - snmp_standard_mib \ - snmp_target_mib \ - snmp_user_based_sm_mib \ - snmp_view_based_acm_mib + snmp_shadow_table INTERNAL_HRL_FILES = \ 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 02415e8036..c6eeb7cea2 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-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -37,6 +37,12 @@ %% -export([emask2imask/1]). +-export_type([ + mibview/0, + internal_view_mask/0, + internal_view_mask_element/0, + internal_view_type/0 + ]). -include("snmp_types.hrl"). -include("SNMPv2-TC.hrl"). @@ -53,7 +59,13 @@ -type internal_view_mask() :: null | [internal_view_mask_element()]. --type internal_view_mask_element() :: 0 | 1. +-type internal_view_mask_element() :: ?view_wildcard | + ?view_exact. +-type internal_view_type() :: ?view_included | ?view_excluded. + +-type mibview() :: [{SubTree :: snmp:oid(), + Mask :: internal_view_mask(), + Type :: internal_view_type()}]. -type external_view_mask() :: octet_string(). % At most length of 16 octet -type octet_string() :: [octet()]. diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index 458b88359b..f280260f47 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-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,7 +28,8 @@ %% External exports -export([start_link/4, start_link/5, stop/1]). --export([subagent_set/2, +-export([subagent_get/3, subagent_get_next/3, + subagent_set/2, load_mibs/3, unload_mibs/3, which_mibs/1, whereis_mib/2, info/1, register_subagent/3, unregister_subagent/2, @@ -362,12 +363,19 @@ do_init(Prio, Parent, Ref, Options) -> "~n Options: ~p",[Prio, Parent, Ref, Options]), Mibs = get_mibs(Options), + SetModule = get_set_mechanism(Options), put(set_module, SetModule), + ?vtrace("set-module: ~w", [SetModule]), + + GetModule = get_get_mechanism(Options), + put(get_module, GetModule), + ?vtrace("get-module: ~w", [GetModule]), %% OTP-3324. For AXD301. AuthModule = get_authentication_service(Options), put(auth_module, AuthModule), + ?vtrace("auth-module: ~w", [AuthModule]), MultiT = get_multi_threaded(Options), Vsns = get_versions(Options), @@ -1133,7 +1141,7 @@ handle_call({subagent_get_next, MibView, Varbinds, PduData}, _From, S) -> "~n PduData: ~p", [MibView,Varbinds,PduData]), put_pdu_data(PduData), - {reply, do_get_next(MibView, Varbinds, infinity), S}; + {reply, do_get_next(MibView, Varbinds), S}; handle_call({subagent_set, Arguments, PduData}, _From, S) -> ?vlog("[handle_call] subagent set:" "~n Arguments: ~p" @@ -1174,7 +1182,7 @@ handle_call({get_next, Vars, Context}, _From, S) -> ?vdebug("Varbinds: ~p",[Varbinds]), MibView = snmpa_acm:get_root_mib_view(), Reply = - case do_get_next(MibView, Varbinds, infinity) of + case do_get_next(MibView, Varbinds) of {noError, 0, NewVarbinds} -> Vbs = lists:keysort(#varbind.org_index, NewVarbinds), [{Oid,Val} || #varbind{oid = Oid, value = Val} <- Vbs]; @@ -1786,9 +1794,8 @@ worker_loop(Master) -> GbMaxVBs, Extra) end catch - T:E -> - exit({worker_crash, Req, T, E, - erlang:get_stacktrace()}) + C:E:S -> + exit({worker_crash, Req, C, E, S}) end, Master ! worker_available, HandlePduRes; % For debugging... @@ -1814,9 +1821,8 @@ worker_loop(Master) -> get(net_if)) end catch - T:E -> - exit({worker_crash, Req, T, E, - erlang:get_stacktrace()}) + C:E:S -> + exit({worker_crash, Req, C, E, S}) end, Master ! worker_available, SendTrapRes; % For debugging... @@ -2535,22 +2541,31 @@ process_msg( process_pdu(#pdu{type='get-request', request_id = ReqId, varbinds=Vbs}, _PduMS, Vsn, MibView, _GbMaxVBs) -> ?vtrace("get ~p",[ReqId]), - Res = get_err(do_get(MibView, Vbs, false)), - ?vtrace("get result: " - "~n ~p",[Res]), + OrigRes = do_get(MibView, Vbs, false), + Res = get_err(OrigRes), {ErrStatus, ErrIndex, ResVarbinds} = if Vsn =:= 'version-1' -> validate_get_v1(Res); true -> Res end, - ?vtrace("get final result: " - "~n Error status: ~p" - "~n Error index: ~p" - "~n Varbinds: ~p", - [ErrStatus,ErrIndex,ResVarbinds]), + if + (ErrStatus =/= noError) -> + ?vlog("get final result: " + "~n Error status: ~p" + "~n Error index: ~p" + "~n when" + "~n Original Result: " + "~n ~p", [ErrStatus, ErrIndex, OrigRes]); + true -> + ?vtrace("get final result: " + "~n Error status: ~p" + "~n Error index: ~p" + "~n Varbinds: ~p", + [ErrStatus, ErrIndex, ResVarbinds]) + end, ResponseVarbinds = lists:keysort(#varbind.org_index, ResVarbinds), ?vtrace("response varbinds: " - "~n ~p",[ResponseVarbinds]), + "~n ~p", [ResponseVarbinds]), make_response_pdu(ReqId, ErrStatus, ErrIndex, Vbs, ResponseVarbinds); process_pdu(#pdu{type = 'get-next-request', request_id = ReqId, varbinds = Vbs}, @@ -2558,22 +2573,31 @@ process_pdu(#pdu{type = 'get-next-request', request_id = ReqId, varbinds = Vbs}, ?vtrace("process get-next-request -> entry with" "~n ReqId: ~p" "~n Vbs: ~p" - "~n MibView: ~p",[ReqId, Vbs, MibView]), - Res = get_err(do_get_next(MibView, Vbs, infinity)), - ?vtrace("get-next result: " - "~n ~p",[Res]), + "~n MibView: ~p", [ReqId, Vbs, MibView]), + OrigRes = do_get_next(MibView, Vbs), + Res = get_err(OrigRes), {ErrStatus, ErrIndex, ResVarbinds} = if Vsn =:= 'version-1' -> validate_next_v1(Res, MibView); true -> Res end, - ?vtrace("get-next final result -> validation result:" - "~n Error status: ~p" - "~n Error index: ~p" - "~n Varbinds: ~p",[ErrStatus,ErrIndex,ResVarbinds]), + if + (ErrStatus =/= noError) -> + ?vlog("get-next final result: " + "~n Error status: ~p" + "~n Error index: ~p" + "~n when" + "~n Original Result: " + "~n ~p", [ErrStatus, ErrIndex, OrigRes]); + true -> + ?vtrace("get-next final result:" + "~n Error status: ~p" + "~n Error index: ~p" + "~n Varbinds: ~p", [ErrStatus, ErrIndex, ResVarbinds]) + end, ResponseVarbinds = lists:keysort(#varbind.org_index, ResVarbinds), ?vtrace("get-next final result -> response varbinds: " - "~n ~p",[ResponseVarbinds]), + "~n ~p", [ResponseVarbinds]), make_response_pdu(ReqId, ErrStatus, ErrIndex, Vbs, ResponseVarbinds); process_pdu(#pdu{type = 'get-bulk-request', @@ -2582,31 +2606,50 @@ process_pdu(#pdu{type = 'get-bulk-request', error_status = NonRepeaters, error_index = MaxRepetitions}, PduMS, _Vsn, MibView, GbMaxVBs) -> - {ErrStatus, ErrIndex, ResponseVarbinds} = - get_err(do_get_bulk(MibView, NonRepeaters, MaxRepetitions, PduMS, Vbs, - GbMaxVBs)), - ?vtrace("get-bulk final result: " - "~n Error status: ~p" - "~n Error index: ~p" - "~n Respons varbinds: ~p", - [ErrStatus,ErrIndex,ResponseVarbinds]), + OrigRes = do_get_bulk(MibView, NonRepeaters, MaxRepetitions, PduMS, Vbs, + GbMaxVBs), + {ErrStatus, ErrIndex, ResponseVarbinds} = get_err(OrigRes), + if + (ErrStatus =/= noError) -> + ?vlog("get-bulk final result: " + "~n Error Status: ~p" + "~n Error Index: ~p" + "~n when" + "~n Original Result: " + "~n ~p", [ErrStatus, ErrIndex, OrigRes]); + true -> + ?vtrace("get-bulk final result: " + "~n Error status: ~p" + "~n Error index: ~p" + "~n Response Varbinds: ~p", + [ErrStatus, ErrIndex, ResponseVarbinds]) + end, make_response_pdu(ReqId, ErrStatus, ErrIndex, Vbs, ResponseVarbinds); process_pdu(#pdu{type = 'set-request', request_id = ReqId, varbinds = Vbs}, - _PduMS, Vsn, MibView, _GbMaxVbs)-> - Res = do_set(MibView, Vbs), - ?vtrace("set result: " - "~n ~p",[Res]), + _PduMS, Vsn, MibView, _GbMaxVbs) -> + OrigRes = do_set(MibView, Vbs), {ErrStatus, ErrIndex} = if - Vsn =:= 'version-1' -> validate_err(v2_to_v1, Res); - true -> Res + Vsn =:= 'version-1' -> validate_err(v2_to_v1, OrigRes); + true -> OrigRes end, - ?vtrace("set final result: " - "~n Error status: ~p" - "~n Error index: ~p",[ErrStatus,ErrIndex]), + if + (ErrStatus =/= noError) -> + ?vlog("set final result: " + "~n Error Status: ~p" + "~n Error Index: ~p" + "~n when" + "~n Original Result: " + "~n ~p", [ErrStatus, ErrIndex, OrigRes]); + true -> + ?vtrace("set final result: " + "~n Error Status: ~p" + "~n Error Index: ~p", [ErrStatus, ErrIndex]) + end, make_response_pdu(ReqId, ErrStatus, ErrIndex, Vbs, Vbs). + %%----------------------------------------------------------------- %% Transform a value == noSuchInstance | noSuchObject or a %% Counter64 type to a noSuchName error for the whole pdu. @@ -2650,8 +2693,7 @@ validate_next_v1_2([Vb | _Vbs], _MibView, _Res) {noSuchName, Vb#varbind.org_index}; validate_next_v1_2([Vb | Vbs], MibView, Res) when Vb#varbind.variabletype =:= 'Counter64' -> - case validate_next_v1( - do_get_next(MibView, [mk_next_oid(Vb)], infinity), MibView) of + case validate_next_v1( do_get_next(MibView, [mk_next_oid(Vb)]), MibView) of {noError, 0, [NVb]} -> validate_next_v1_2(Vbs, MibView, [NVb | Res]); {Error, Index, _OrgVb} -> @@ -2693,6 +2735,20 @@ mk_next_oid(Vb) -> %%%----------------------------------------------------------------- %%----------------------------------------------------------------- +%% Func: do_get/2 +%% Purpose: Handles all VBs in a request that is inside the +%% mibview (local). +%% Returns: {noError, 0, ListOfNewVarbinds} | +%% {ErrorStatus, ErrorIndex, []} +%%----------------------------------------------------------------- + +do_get(UnsortedVarbinds, IsNotification) -> + Extra = get(net_if_data), + GetModule = get(get_module), + GetModule:do_get(UnsortedVarbinds, IsNotification, Extra). + + +%%----------------------------------------------------------------- %% Func: do_get/3 %% Purpose: do_get handles "getRequests". %% Pre: incoming varbinds have type == 'NULL', value == unSpecified @@ -2700,390 +2756,24 @@ mk_next_oid(Vb) -> %% {ErrorStatus, ErrorIndex, []} %%----------------------------------------------------------------- -%% If this function is called from a worker-process, we *may* -%% need to tunnel into the master-agent and let it do the -%% work +%% If this function is called from a worker-process (or other process), +%% we *may* need to tunnel into the master-agent and let it do the work. do_get(MibView, UnsortedVarbinds, IsNotification) -> - do_get(MibView, UnsortedVarbinds, IsNotification, false). + Extra = get(net_if_data), + GetModule = get(get_module), + GetModule:do_get(MibView, UnsortedVarbinds, IsNotification, Extra). do_get(MibView, UnsortedVarbinds, IsNotification, ForceMaster) -> - ?vtrace("do_get -> entry with" - "~n MibView: ~p" - "~n UnsortedVarbinds: ~p" - "~n IsNotification: ~p", - [MibView, UnsortedVarbinds, IsNotification]), case (whereis(snmp_master_agent) =:= self()) of false when (ForceMaster =:= true) -> - %% I am a lowly worker process, handoff to the master agent PduData = get_pdu_data(), call(snmp_master_agent, {do_get, MibView, UnsortedVarbinds, IsNotification, PduData}); - - _ -> - %% This is me, the master, so go ahead - {OutSideView, InSideView} = - split_vbs_view(UnsortedVarbinds, MibView), - {Error, Index, NewVbs} = - do_get(InSideView, IsNotification), - {Error, Index, NewVbs ++ OutSideView} - - end. - - -split_vbs_view(Vbs, MibView) -> - ?vtrace("split the varbinds view", []), - split_vbs_view(Vbs, MibView, [], []). - -split_vbs_view([Vb | Vbs], MibView, Out, In) -> - case snmpa_acm:validate_mib_view(Vb#varbind.oid, MibView) of - true -> split_vbs_view(Vbs, MibView, Out, [Vb | In]); - false -> split_vbs_view(Vbs, MibView, - [Vb#varbind{value = noSuchObject} | Out], In) - end; -split_vbs_view([], _MibView, Out, In) -> - {Out, In}. - -do_get(UnsortedVarbinds, IsNotification) -> - {MyVarbinds, SubagentVarbinds} = sort_varbindlist(UnsortedVarbinds), - case do_get_local(MyVarbinds, [], IsNotification) of - {noError, 0, NewMyVarbinds} -> - case do_get_subagents(SubagentVarbinds, IsNotification) of - {noError, 0, NewSubagentVarbinds} -> - {noError, 0, NewMyVarbinds ++ NewSubagentVarbinds}; - {ErrorStatus, ErrorIndex, _} -> - {ErrorStatus, ErrorIndex, []} - end; - {ErrorStatus, ErrorIndex, _} -> - {ErrorStatus, ErrorIndex, []} - end. - -%%----------------------------------------------------------------- -%% Func: do_get_local/3 -%% Purpose: Loop the variablebindings list. We know that each varbind -%% in that list belongs to us. -%% Returns: {noError, 0, ListOfNewVarbinds} | -%% {ErrorStatus, ErrorIndex, []} -%%----------------------------------------------------------------- -do_get_local([Vb | Vbs], Res, IsNotification) -> - case try_get(Vb, IsNotification) of - NewVb when is_record(NewVb, varbind) -> - do_get_local(Vbs, [NewVb | Res], IsNotification); - ListOfNewVb when is_list(ListOfNewVb) -> - do_get_local(Vbs, lists:append(ListOfNewVb, Res), IsNotification); - {error, Error, OrgIndex} -> - {Error, OrgIndex, []} - end; -do_get_local([], Res, _IsNotification) -> - {noError, 0, Res}. - -%%----------------------------------------------------------------- -%% Func: do_get_subagents/2 -%% Purpose: Loop the list of varbinds for different subagents. -%% For each of them, call sub_agent_get to retreive -%% the values for them. -%% Returns: {noError, 0, ListOfNewVarbinds} | -%% {ErrorStatus, ErrorIndex, []} -%%----------------------------------------------------------------- -do_get_subagents(SubagentVarbinds, IsNotification) -> - do_get_subagents(SubagentVarbinds, [], IsNotification). -do_get_subagents([{SubAgentPid, SAVbs} | Tail], Res, IsNotification) -> - {_SAOids, Vbs} = sa_split(SAVbs), - case catch subagent_get(SubAgentPid, Vbs, IsNotification) of - {noError, 0, NewVbs} -> - do_get_subagents(Tail, lists:append(NewVbs, Res), IsNotification); - {ErrorStatus, ErrorIndex, _} -> - {ErrorStatus, ErrorIndex, []}; - {'EXIT', Reason} -> - user_err("Lost contact with subagent (get) ~w. Using genErr", - [Reason]), - {genErr, 0, []} - end; -do_get_subagents([], Res, _IsNotification) -> - {noError, 0, Res}. - - -%%----------------------------------------------------------------- -%% Func: try_get/2 -%% Returns: {error, ErrorStatus, OrgIndex} | -%% #varbind | -%% List of #varbind -%%----------------------------------------------------------------- -try_get(IVb, IsNotification) when is_record(IVb, ivarbind) -> - ?vtrace("try_get(ivarbind) -> entry with" - "~n IVb: ~p", [IVb]), - get_var_value_from_ivb(IVb, IsNotification); -try_get({TableOid, TableVbs}, IsNotification) -> - ?vtrace("try_get(table) -> entry with" - "~n TableOid: ~p" - "~n TableVbs: ~p", [TableOid, TableVbs]), - [#ivarbind{mibentry = MibEntry}|_] = TableVbs, - {NoAccessVbs, AccessVbs} = - check_all_table_vbs(TableVbs, IsNotification, [], []), - case get_tab_value_from_mib(MibEntry, TableOid, AccessVbs) of - {error, ErrorStatus, OrgIndex} -> - {error, ErrorStatus, OrgIndex}; - NVbs -> - NVbs ++ NoAccessVbs - end. - -%%----------------------------------------------------------------- -%% Make sure all requested columns are accessible. -%%----------------------------------------------------------------- -check_all_table_vbs([IVb| IVbs], IsNotification, NoA, A) -> - #ivarbind{mibentry = Me, varbind = Vb} = IVb, - case Me#me.access of - 'not-accessible' -> - NNoA = [Vb#varbind{value = noSuchInstance} | NoA], - check_all_table_vbs(IVbs, IsNotification, NNoA, A); - 'accessible-for-notify' when IsNotification =:= false -> - NNoA = [Vb#varbind{value = noSuchInstance} | NoA], - check_all_table_vbs(IVbs, IsNotification, NNoA, A); - 'write-only' -> - NNoA = [Vb#varbind{value = noSuchInstance} | NoA], - check_all_table_vbs(IVbs, IsNotification, NNoA, A); - _ -> - check_all_table_vbs(IVbs, IsNotification, NoA, [IVb | A]) - end; -check_all_table_vbs([], _IsNotification, NoA, A) -> {NoA, A}. - -%%----------------------------------------------------------------- -%% Returns: {error, ErrorStatus, OrgIndex} | -%% #varbind -%%----------------------------------------------------------------- -get_var_value_from_ivb(IVb, IsNotification) - when IVb#ivarbind.status =:= noError -> - ?vtrace("get_var_value_from_ivb(noError) -> entry", []), - #ivarbind{mibentry = Me, varbind = Vb} = IVb, - #varbind{org_index = OrgIndex, oid = Oid} = Vb, - case Me#me.access of - 'not-accessible' -> - Vb#varbind{value = noSuchInstance}; - 'accessible-for-notify' when IsNotification =:= false -> - Vb#varbind{value = noSuchInstance}; - 'write-only' -> - Vb#varbind{value = noSuchInstance}; - _ -> - case get_var_value_from_mib(Me, Oid) of - {value, Type, Value} -> - Vb#varbind{variabletype = Type, value = Value}; - {error, ErrorStatus} -> - {error, ErrorStatus, OrgIndex} - end - end; -get_var_value_from_ivb(#ivarbind{status = Status, varbind = Vb}, _) -> - ?vtrace("get_var_value_from_ivb(~p) -> entry", [Status]), - Vb#varbind{value = Status}. - -%%----------------------------------------------------------------- -%% Func: get_var_value_from_mib/1 -%% Purpose: -%% Returns: {error, ErrorStatus} | -%% {value, Type, Value} -%%----------------------------------------------------------------- -%% Pre: Oid is a correct instance Oid (lookup checked that). -%% Returns: A correct return value (see make_value_a_correct_value) -get_var_value_from_mib(#me{entrytype = variable, - asn1_type = ASN1Type, - mfa = {Mod, Func, Args}}, - _Oid) -> - ?vtrace("get_var_value_from_mib(variable) -> entry when" - "~n Mod: ~p" - "~n Func: ~p" - "~n Args: ~p", [Mod, Func, Args]), - Result = (catch dbg_apply(Mod, Func, [get | Args])), - % mib shall return {value, <a-nice-value-within-range>} | - % {noValue, noSuchName} (v1) | - % {noValue, noSuchObject | noSuchInstance} (v2, v1) - % everything else (including 'genErr') will generate 'genErr'. - make_value_a_correct_value(Result, ASN1Type, {Mod, Func, Args}); - -get_var_value_from_mib(#me{entrytype = table_column, - oid = MeOid, - asn1_type = ASN1Type, - mfa = {Mod, Func, Args}}, - Oid) -> - ?vtrace("get_var_value_from_mib(table_column) -> entry when" - "~n MeOid: ~p" - "~n Mod: ~p" - "~n Func: ~p" - "~n Args: ~p" - "~n Oid: ~p", [MeOid, Mod, Func, Args, Oid]), - Col = lists:last(MeOid), - Indexes = snmp_misc:diff(Oid, MeOid), - [Result] = (catch dbg_apply(Mod, Func, [get, Indexes, [Col] | Args])), - make_value_a_correct_value(Result, ASN1Type, - {Mod, Func, Args, Indexes, Col}). - - -%% For table operations we need to pass RestOid down to the table-function. -%% Its up to the table-function to check for noSuchInstance (ex: a -%% non-existing row). -%% Returns: {error, ErrorStatus, OrgIndex} | -%% {value, Type, Value} -get_tab_value_from_mib(#me{mfa = {Mod, Func, Args}}, TableOid, TableVbs) -> - ?vtrace("get_tab_value_from_mib -> entry when" - "~n Mod: ~p" - "~n Func: ~p" - "~n Args: ~p", [Mod, Func, Args]), - TableOpsWithShortOids = deletePrefixes(TableOid, TableVbs), - SortedVBsRows = snmpa_svbl:sort_varbinds_rows(TableOpsWithShortOids), - case get_value_all_rows(SortedVBsRows, Mod, Func, Args, []) of - {Error, Index} -> - #ivarbind{varbind = Vb} = lists:nth(Index, TableVbs), - {error, Error, Vb#varbind.org_index}; - ListOfValues -> - merge_varbinds_and_value(TableVbs, ListOfValues) + _ -> + do_get(MibView, UnsortedVarbinds, IsNotification) end. -%%----------------------------------------------------------------- -%% Values is a scrambled list of {CorrectValue, Index}, where Index -%% is index into the #ivarbind list. So for each Value, we must -%% find the corresponding #ivarbind, and merge them into a new -%% #varbind. -%% The Values list comes from validate_tab_res. -%%----------------------------------------------------------------- -merge_varbinds_and_value(IVbs, [{{value, Type, Value}, Index} | Values]) -> - #ivarbind{varbind = Vb} = lists:nth(Index, IVbs), - [Vb#varbind{variabletype = Type, value = Value} | - merge_varbinds_and_value(IVbs, Values)]; -merge_varbinds_and_value(_, []) -> []. - -get_value_all_rows([{[], OrgCols} | Rows], Mod, Func, Args, Res) -> - ?vtrace("get_value_all_rows -> entry when" - "~n OrgCols: ~p", [OrgCols]), - Cols = [{{value, noValue, noSuchInstance}, Index} || - {_Col, _ASN1Type, Index} <- OrgCols], - NewRes = lists:append(Cols, Res), - get_value_all_rows(Rows, Mod, Func, Args, NewRes); -get_value_all_rows([{RowIndex, OrgCols} | Rows], Mod, Func, Args, Res) -> - ?vtrace("get_value_all_rows -> entry when" - "~n RowIndex: ~p" - "~n OrgCols: ~p", [RowIndex, OrgCols]), - {DOrgCols, Dup} = remove_duplicates(OrgCols), - Cols = delete_index(DOrgCols), - Result = (catch dbg_apply(Mod, Func, [get, RowIndex, Cols | Args])), - case validate_tab_res(Result, DOrgCols, {Mod, Func, Args}) of - Values when is_list(Values) -> - NVals = restore_duplicates(Dup, Values), - NewRes = lists:append(NVals, Res), - get_value_all_rows(Rows, Mod, Func, Args, NewRes); - {error, ErrorStatus, Index} -> - validate_err(row_set, {ErrorStatus, Index}, {Mod, Func, Args}) - end; -get_value_all_rows([], _Mod, _Func, _Args, Res) -> - ?vtrace("get_value_all_rows -> entry when done" - "~n Res: ~p", [Res]), - Res. - -%%----------------------------------------------------------------- -%% Returns: list of {ShortOid, ASN1TYpe} -%%----------------------------------------------------------------- -deletePrefixes(Prefix, [#ivarbind{varbind = Varbind, mibentry = ME} | Vbs]) -> - #varbind{oid = Oid} = Varbind, - [{snmp_misc:diff(Oid, Prefix), ME#me.asn1_type} | - deletePrefixes(Prefix, Vbs)]; -deletePrefixes(_Prefix, []) -> []. - -%%----------------------------------------------------------------- -%% Args: {RowIndex, list of {ShortOid, ASN1Type}} -%% Returns: list of Col -%%----------------------------------------------------------------- -delete_index([{Col, _Val, _OrgIndex} | T]) -> - [Col | delete_index(T)]; -delete_index([]) -> []. - -%%----------------------------------------------------------------- -%% This function is called before 'get' on a table, and removes -%% any duplicate columns. It returns {Cols, DupInfo}. The Cols -%% are the unique columns. The instrumentation function is -%% called to get the values. These values, together with the -%% DupInfo, is later passed to restore_duplicates, which uses -%% the retrieved values to reconstruct the original column list, -%% but with the retrieved value for each column. -%%----------------------------------------------------------------- -remove_duplicates(Cols) -> - remove_duplicates(Cols, [], []). - - -remove_duplicates([{Col, V1, OrgIdx1}, {Col, V2, OrgIdx2} | T], NCols, Dup) -> - remove_duplicates([{Col, V1, OrgIdx1} | T], NCols, - [{Col, V2, OrgIdx2} | Dup]); -remove_duplicates([Col | T], NCols, Dup) -> - remove_duplicates(T, [Col | NCols], Dup); -remove_duplicates([], NCols, Dup) -> - {lists:reverse(NCols), lists:reverse(Dup)}. - -restore_duplicates([], Cols) -> - [{Val, OrgIndex} || {_Col, Val, OrgIndex} <- Cols]; -restore_duplicates([{Col, _Val2, OrgIndex2} | Dup], - [{Col, NVal, OrgIndex1} | Cols]) -> - [{NVal, OrgIndex2} | - restore_duplicates(Dup, [{Col, NVal, OrgIndex1} | Cols])]; -restore_duplicates(Dup, [{_Col, Val, OrgIndex} | T]) -> - [{Val, OrgIndex} | restore_duplicates(Dup, T)]. - -%% Maps the column number to Index. -% col_to_index(0, _) -> 0; -% col_to_index(Col, [{Col, _, Index}|_]) -> -% Index; -% col_to_index(Col, [_|Cols]) -> -% col_to_index(Col, Cols). - -%%----------------------------------------------------------------- -%% Three cases: -%% 1) All values ok -%% 2) table_func returned {Error, ...} -%% 3) Some value in Values list is erroneous. -%% Args: Value is a list of values from table_func(get..) -%% OrgCols is a list with {Col, ASN1Type, OrgIndex} -%% each element in Values and OrgCols correspond to each -%% other. -%%----------------------------------------------------------------- -validate_tab_res(Values, OrgCols, Mfa) when is_list(Values) -> - {_Col, _ASN1Type, OneIdx} = hd(OrgCols), - validate_tab_res(Values, OrgCols, Mfa, [], OneIdx); -validate_tab_res({noValue, Error}, OrgCols, Mfa) -> - Values = lists:duplicate(length(OrgCols), {noValue, Error}), - validate_tab_res(Values, OrgCols, Mfa); -validate_tab_res({genErr, Col}, OrgCols, Mfa) -> - case lists:keysearch(Col, 1, OrgCols) of - {value, {_Col, _ASN1Type, Index}} -> - {error, genErr, Index}; - _ -> - user_err("Invalid column in {genErr, ~w} from ~w (get)", - [Col, Mfa]), - [{_Col, _ASN1Type, Index} | _] = OrgCols, - {error, genErr, Index} - end; -validate_tab_res(genErr, [{_Col, __ASN1Type, Index} | _OrgCols], _Mfa) -> - {error, genErr, Index}; -validate_tab_res(Error, [{_Col, _ASN1Type, Index} | _OrgCols], Mfa) -> - user_err("Invalid return value ~w from ~w (get)",[Error, Mfa]), - {error, genErr, Index}. - -validate_tab_res([Value | Values], - [{Col, ASN1Type, Index} | OrgCols], - Mfa, Res, I) -> - %% This one makes it possible to return a list of genErr, which - %% is not allowed according to the manual. But that's ok, as - %% everything else will generate a genErr! (the only problem is - %% that it won't generate a user_error). - case make_value_a_correct_value(Value, ASN1Type, Mfa) of - {error, ErrorStatus} -> - {error, ErrorStatus, Index}; - CorrectValue -> - NewRes = [{Col, CorrectValue, Index} | Res], - validate_tab_res(Values, OrgCols, Mfa, NewRes, I) - end; -validate_tab_res([], [], _Mfa, Res, _I) -> - lists:reverse(Res); -validate_tab_res([], [{_Col, _ASN1Type, Index}|_], Mfa, _Res, _I) -> - user_err("Too few values returned from ~w (get)", [Mfa]), - {error, genErr, Index}; -validate_tab_res(_TooMany, [], Mfa, _Res, I) -> - user_err("Too many values returned from ~w (get)", [Mfa]), - {error, genErr, I}. %%%----------------------------------------------------------------- @@ -3125,491 +2815,12 @@ validate_tab_res(_TooMany, [], Mfa, _Res, I) -> %% subagent must be considered to be very rare. %%----------------------------------------------------------------- -%% It may be a bit agressive to check this already, -%% but since it is a security measure, it makes sense. -do_get_next(_MibView, UnsortedVarbinds, GbMaxVBs) - when (is_integer(GbMaxVBs) andalso (length(UnsortedVarbinds) > GbMaxVBs)) -> - {tooBig, 0, []}; % What is the correct index in this case? -do_get_next(MibView, UnsortedVBs, GbMaxVBs) -> - ?vt("do_get_next -> entry when" - "~n MibView: ~p" - "~n UnsortedVBs: ~p", [MibView, UnsortedVBs]), - SortedVBs = oid_sort_vbs(UnsortedVBs), - ?vt("do_get_next -> " - "~n SortedVBs: ~p", [SortedVBs]), - next_loop_varbinds([], SortedVBs, MibView, [], [], GbMaxVBs). - -oid_sort_vbs(Vbs) -> - lists:keysort(#varbind.oid, Vbs). - -next_loop_varbinds(_, Vbs, _MibView, Res, _LAVb, GbMaxVBs) - when (is_integer(GbMaxVBs) andalso - ((length(Vbs) + length(Res)) > GbMaxVBs)) -> - {tooBig, 0, []}; % What is the correct index in this case? - -%% LAVb is Last Accessible Vb -next_loop_varbinds([], [Vb | Vbs], MibView, Res, LAVb, GbMaxVBs) -> - ?vt("next_loop_varbinds -> entry when" - "~n Vb: ~p" - "~n MibView: ~p", [Vb, MibView]), - case varbind_next(Vb, MibView) of - endOfMibView -> - ?vt("next_loop_varbind -> endOfMibView", []), - RVb = if LAVb =:= [] -> Vb; - true -> LAVb - end, - NewVb = RVb#varbind{variabletype = 'NULL', value = endOfMibView}, - next_loop_varbinds([], Vbs, MibView, [NewVb | Res], [], GbMaxVBs); - - {variable, ME, VarOid} when ((ME#me.access =/= 'not-accessible') andalso - (ME#me.access =/= 'write-only') andalso - (ME#me.access =/= 'accessible-for-notify')) -> - ?vt("next_loop_varbind -> variable: " - "~n ME: ~p" - "~n VarOid: ~p", [ME, VarOid]), - case try_get_instance(Vb, ME) of - {value, noValue, _NoSuchSomething} -> - ?vt("next_loop_varbind -> noValue", []), - %% Try next one - NewVb = Vb#varbind{oid = VarOid, - value = 'NULL'}, - next_loop_varbinds([], [NewVb | Vbs], MibView, Res, [], - GbMaxVBs); - {value, Type, Value} -> - ?vt("next_loop_varbind -> value" - "~n Type: ~p" - "~n Value: ~p", [Type, Value]), - NewVb = Vb#varbind{oid = VarOid, - variabletype = Type, - value = Value}, - next_loop_varbinds([], Vbs, MibView, [NewVb | Res], [], - GbMaxVBs); - {error, ErrorStatus} -> - ?vdebug("next loop varbinds:" - "~n ErrorStatus: ~p",[ErrorStatus]), - {ErrorStatus, Vb#varbind.org_index, []} - end; - {variable, _ME, VarOid} -> - ?vt("next_loop_varbind -> variable: " - "~n VarOid: ~p", [VarOid]), - RVb = if LAVb =:= [] -> Vb; - true -> LAVb - end, - NewVb = Vb#varbind{oid = VarOid, value = 'NULL'}, - next_loop_varbinds([], [NewVb | Vbs], MibView, Res, RVb, GbMaxVBs); - {table, TableOid, TableRestOid, ME} -> - ?vt("next_loop_varbind -> table: " - "~n TableOid: ~p" - "~n TableRestOid: ~p" - "~n ME: ~p", [TableOid, TableRestOid, ME]), - next_loop_varbinds({table, TableOid, ME, - [{tab_oid(TableRestOid), Vb}]}, - Vbs, MibView, Res, [], GbMaxVBs); - {subagent, SubAgentPid, SAOid} -> - ?vt("next_loop_varbind -> subagent: " - "~n SubAgentPid: ~p" - "~n SAOid: ~p", [SubAgentPid, SAOid]), - NewVb = Vb#varbind{variabletype = 'NULL', value = 'NULL'}, - next_loop_varbinds({subagent, SubAgentPid, SAOid, [NewVb]}, - Vbs, MibView, Res, [], GbMaxVBs) - end; -next_loop_varbinds({table, TableOid, ME, TabOids}, - [Vb | Vbs], MibView, Res, _LAVb, GbMaxVBs) -> - ?vt("next_loop_varbinds(table) -> entry with" - "~n TableOid: ~p" - "~n Vb: ~p", [TableOid, Vb]), - case varbind_next(Vb, MibView) of - {table, TableOid, TableRestOid, _ME} -> - next_loop_varbinds({table, TableOid, ME, - [{tab_oid(TableRestOid), Vb} | TabOids]}, - Vbs, MibView, Res, [], GbMaxVBs); - _ -> - case get_next_table(ME, TableOid, TabOids, MibView) of - {ok, TabRes, TabEndOfTabVbs} -> - NewVbs = lists:append(TabEndOfTabVbs, [Vb | Vbs]), - NewRes = lists:append(TabRes, Res), - next_loop_varbinds([], NewVbs, MibView, NewRes, [], - GbMaxVBs); - {ErrorStatus, OrgIndex} -> - ?vdebug("next loop varbinds: next varbind" - "~n ErrorStatus: ~p" - "~n OrgIndex: ~p", - [ErrorStatus,OrgIndex]), - {ErrorStatus, OrgIndex, []} - end - end; -next_loop_varbinds({table, TableOid, ME, TabOids}, - [], MibView, Res, _LAVb, GbMaxVBs) -> - ?vt("next_loop_varbinds(table) -> entry with" - "~n TableOid: ~p", [TableOid]), - case get_next_table(ME, TableOid, TabOids, MibView) of - {ok, TabRes, TabEndOfTabVbs} -> - ?vt("next_loop_varbinds(table) -> get_next_table result:" - "~n TabRes: ~p" - "~n TabEndOfTabVbs: ~p", [TabRes, TabEndOfTabVbs]), - NewRes = lists:append(TabRes, Res), - next_loop_varbinds([], TabEndOfTabVbs, MibView, NewRes, [], - GbMaxVBs); - {ErrorStatus, OrgIndex} -> - ?vdebug("next loop varbinds: next table" - "~n ErrorStatus: ~p" - "~n OrgIndex: ~p", - [ErrorStatus,OrgIndex]), - {ErrorStatus, OrgIndex, []} - end; -next_loop_varbinds({subagent, SAPid, SAOid, SAVbs}, - [Vb | Vbs], MibView, Res, _LAVb, GbMaxVBs) -> - ?vt("next_loop_varbinds(subagent) -> entry with" - "~n SAPid: ~p" - "~n SAOid: ~p" - "~n Vb: ~p", [SAPid, SAOid, Vb]), - case varbind_next(Vb, MibView) of - {subagent, _SubAgentPid, SAOid} -> - next_loop_varbinds({subagent, SAPid, SAOid, - [Vb | SAVbs]}, - Vbs, MibView, Res, [], GbMaxVBs); - _ -> - case get_next_sa(SAPid, SAOid, SAVbs, MibView) of - {ok, SARes, SAEndOfMibViewVbs} -> - NewVbs = lists:append(SAEndOfMibViewVbs, [Vb | Vbs]), - NewRes = lists:append(SARes, Res), - next_loop_varbinds([], NewVbs, MibView, NewRes, [], - GbMaxVBs); - {noSuchName, OrgIndex} -> - %% v1 reply, treat this Vb as endOfMibView, and try again - %% for the others. - case lists:keysearch(OrgIndex, #varbind.org_index, SAVbs) of - {value, EVb} -> - NextOid = next_oid(SAOid), - EndOfVb = - EVb#varbind{oid = NextOid, - value = {endOfMibView, NextOid}}, - case lists:delete(EVb, SAVbs) of - [] -> - next_loop_varbinds([], [EndOfVb, Vb | Vbs], - MibView, Res, [], - GbMaxVBs); - TryAgainVbs -> - next_loop_varbinds({subagent, SAPid, SAOid, - TryAgainVbs}, - [EndOfVb, Vb | Vbs], - MibView, Res, [], - GbMaxVBs) - end; - false -> - %% bad index from subagent - {genErr, (hd(SAVbs))#varbind.org_index, []} - end; - {ErrorStatus, OrgIndex} -> - ?vdebug("next loop varbinds: next subagent" - "~n Vb: ~p" - "~n ErrorStatus: ~p" - "~n OrgIndex: ~p", - [Vb,ErrorStatus,OrgIndex]), - {ErrorStatus, OrgIndex, []} - end - end; -next_loop_varbinds({subagent, SAPid, SAOid, SAVbs}, - [], MibView, Res, _LAVb, GbMaxVBs) -> - ?vt("next_loop_varbinds(subagent) -> entry with" - "~n SAPid: ~p" - "~n SAOid: ~p", [SAPid, SAOid]), - case get_next_sa(SAPid, SAOid, SAVbs, MibView) of - {ok, SARes, SAEndOfMibViewVbs} -> - NewRes = lists:append(SARes, Res), - next_loop_varbinds([], SAEndOfMibViewVbs, MibView, NewRes, [], - GbMaxVBs); - {noSuchName, OrgIndex} -> - %% v1 reply, treat this Vb as endOfMibView, and try again for - %% the others. - case lists:keysearch(OrgIndex, #varbind.org_index, SAVbs) of - {value, EVb} -> - NextOid = next_oid(SAOid), - EndOfVb = EVb#varbind{oid = NextOid, - value = {endOfMibView, NextOid}}, - case lists:delete(EVb, SAVbs) of - [] -> - next_loop_varbinds([], [EndOfVb], MibView, Res, [], - GbMaxVBs); - TryAgainVbs -> - next_loop_varbinds({subagent, SAPid, SAOid, - TryAgainVbs}, - [EndOfVb], MibView, Res, [], - GbMaxVBs) - end; - false -> - %% bad index from subagent - {genErr, (hd(SAVbs))#varbind.org_index, []} - end; - {ErrorStatus, OrgIndex} -> - ?vdebug("next loop varbinds: next subagent" - "~n ErrorStatus: ~p" - "~n OrgIndex: ~p", - [ErrorStatus,OrgIndex]), - {ErrorStatus, OrgIndex, []} - end; -next_loop_varbinds([], [], _MibView, Res, _LAVb, _GbMaxVBs) -> - ?vt("next_loop_varbinds -> entry when done", []), - {noError, 0, Res}. - -try_get_instance(_Vb, #me{mfa = {M, F, A}, asn1_type = ASN1Type}) -> - ?vtrace("try_get_instance -> entry with" - "~n M: ~p" - "~n F: ~p" - "~n A: ~p", [M,F,A]), - Result = (catch dbg_apply(M, F, [get | A])), - % mib shall return {value, <a-nice-value-within-range>} | - % {noValue, noSuchName} (v1) | - % {noValue, noSuchObject | noSuchInstance} (v2, v1) - % everything else (including 'genErr') will generate 'genErr'. - make_value_a_correct_value(Result, ASN1Type, {M, F, A}). - -tab_oid([]) -> [0]; -tab_oid(X) -> X. - -%%----------------------------------------------------------------- -%% Perform a next, using the varbinds Oid if value is simple -%% value. If value is {endOf<something>, NextOid}, use NextOid. -%% This case happens when a table has returned endOfTable, or -%% a subagent has returned endOfMibView. -%%----------------------------------------------------------------- -varbind_next(#varbind{value = Value, oid = Oid}, MibView) -> - ?vt("varbind_next -> entry with" - "~n Value: ~p" - "~n Oid: ~p" - "~n MibView: ~p", [Value, Oid, MibView]), - case Value of - {endOfTable, NextOid} -> - snmpa_mib:next(get(mibserver), NextOid, MibView); - {endOfMibView, NextOid} -> - snmpa_mib:next(get(mibserver), NextOid, MibView); - _ -> - snmpa_mib:next(get(mibserver), Oid, MibView) - end. +do_get_next(MibView, UnsortedVarbinds) -> + Extra = get(net_if_data), + GetModule = get(get_module), + GetModule:do_get_next(MibView, UnsortedVarbinds, Extra). -get_next_table(#me{mfa = {M, F, A}}, TableOid, TableOids, MibView) -> - % We know that all TableOids have at least a column number as oid - ?vt("get_next_table -> entry with" - "~n M: ~p" - "~n F: ~p" - "~n A: ~p" - "~n TableOid: ~p" - "~n TableOids: ~p" - "~n MibView: ~p", [M, F, A, TableOid, TableOids, MibView]), - Sorted = snmpa_svbl:sort_varbinds_rows(TableOids), - case get_next_values_all_rows(Sorted, M,F,A, [], TableOid) of - NewVbs when is_list(NewVbs) -> - ?vt("get_next_table -> " - "~n NewVbs: ~p", [NewVbs]), - % We must now check each Vb for endOfTable and that it is - % in the MibView. If not, it becomes a endOfTable. We - % collect all of these together. - transform_tab_next_result(NewVbs, {[], []}, MibView); - {ErrorStatus, OrgIndex} -> - {ErrorStatus, OrgIndex} - end. - -get_next_values_all_rows([Row | Rows], M, F, A, Res, TabOid) -> - {RowIndex, TableOids} = Row, - Cols = delete_index(TableOids), - ?vt("get_next_values_all_rows -> " - "~n Cols: ~p", [Cols]), - Result = (catch dbg_apply(M, F, [get_next, RowIndex, Cols | A])), - ?vt("get_next_values_all_rows -> " - "~n Result: ~p", [Result]), - case validate_tab_next_res(Result, TableOids, {M, F, A}, TabOid) of - Values when is_list(Values) -> - ?vt("get_next_values_all_rows -> " - "~n Values: ~p", [Values]), - NewRes = lists:append(Values, Res), - get_next_values_all_rows(Rows, M, F, A, NewRes, TabOid); - {ErrorStatus, OrgIndex} -> - {ErrorStatus, OrgIndex} - end; -get_next_values_all_rows([], _M, _F, _A, Res, _TabOid) -> - Res. - -transform_tab_next_result([Vb | Vbs], {Res, EndOfs}, MibView) -> - case Vb#varbind.value of - {endOfTable, _} -> -%% ?vtrace("transform_tab_next_result -> endOfTable: " -%% "split varbinds",[]), -%% R = split_varbinds(Vbs, Res, [Vb | EndOfs]), -%% ?vtrace("transform_tab_next_result -> " -%% "~n R: ~p", [R]), -%% R; - split_varbinds(Vbs, Res, [Vb | EndOfs]); - _ -> - case snmpa_acm:validate_mib_view(Vb#varbind.oid, MibView) of - true -> - transform_tab_next_result(Vbs, {[Vb|Res], EndOfs},MibView); - _ -> - Oid = Vb#varbind.oid, - NewEndOf = Vb#varbind{value = {endOfTable, Oid}}, - transform_tab_next_result(Vbs, {Res, [NewEndOf | EndOfs]}, - MibView) - end - end; -transform_tab_next_result([], {Res, EndOfs}, _MibView) -> - ?vt("transform_tab_next_result -> entry with: " - "~n Res: ~p" - "~n EndIfs: ~p",[Res, EndOfs]), - {ok, Res, EndOfs}. - -%%----------------------------------------------------------------- -%% Three cases: -%% 1) All values ok -%% 2) table_func returned {Error, ...} -%% 3) Some value in Values list is erroneous. -%% Args: Value is a list of values from table_func(get_next, ...) -%% TableOids is a list of {TabRestOid, OrgVb} -%% each element in Values and TableOids correspond to each -%% other. -%% Returns: List of NewVarbinds | -%% {ErrorStatus, OrgIndex} -%% (In the NewVarbinds list, the value may be endOfTable) -%%----------------------------------------------------------------- -validate_tab_next_res(Values, TableOids, Mfa, TabOid) -> - ?vt("validate_tab_next_res -> entry with: " - "~n Values: ~p" - "~n TableOids: ~p" - "~n Mfa: ~p" - "~n TabOid: ~p", [Values, TableOids, Mfa, TabOid]), - {_Col, _ASN1Type, OneIdx} = hd(TableOids), - validate_tab_next_res(Values, TableOids, Mfa, [], TabOid, - next_oid(TabOid), OneIdx). -validate_tab_next_res([{NextOid, Value} | Values], - [{_ColNo, OrgVb, _Index} | TableOids], - Mfa, Res, TabOid, TabNextOid, I) -> - ?vt("validate_tab_next_res -> entry with: " - "~n NextOid: ~p" - "~n Value: ~p" - "~n Values: ~p" - "~n TableOids: ~p" - "~n Mfa: ~p" - "~n TabOid: ~p", - [NextOid, Value, Values, TableOids, Mfa, TabOid]), - #varbind{org_index = OrgIndex} = OrgVb, - ?vt("validate_tab_next_res -> OrgIndex: ~p", [OrgIndex]), - NextCompleteOid = lists:append(TabOid, NextOid), - case snmpa_mib:lookup(get(mibserver), NextCompleteOid) of - {table_column, #me{asn1_type = ASN1Type}, _TableEntryOid} -> - ?vt("validate_tab_next_res -> ASN1Type: ~p", [ASN1Type]), - case make_value_a_correct_value({value, Value}, ASN1Type, Mfa) of - {error, ErrorStatus} -> - ?vt("validate_tab_next_res -> " - "~n ErrorStatus: ~p", [ErrorStatus]), - {ErrorStatus, OrgIndex}; - {value, Type, NValue} -> - ?vt("validate_tab_next_res -> " - "~n Type: ~p" - "~n NValue: ~p", [Type, NValue]), - NewVb = OrgVb#varbind{oid = NextCompleteOid, - variabletype = Type, value = NValue}, - validate_tab_next_res(Values, TableOids, Mfa, - [NewVb | Res], TabOid, TabNextOid, I) - end; - Error -> - user_err("Invalid oid ~w from ~w (get_next). Using genErr => ~p", - [NextOid, Mfa, Error]), - {genErr, OrgIndex} - end; -validate_tab_next_res([endOfTable | Values], - [{_ColNo, OrgVb, _Index} | TableOids], - Mfa, Res, TabOid, TabNextOid, I) -> - ?vt("validate_tab_next_res(endOfTable) -> entry with: " - "~n Values: ~p" - "~n OrgVb: ~p" - "~n TableOids: ~p" - "~n Mfa: ~p" - "~n Res: ~p" - "~n TabOid: ~p" - "~n TabNextOid: ~p" - "~n I: ~p", - [Values, OrgVb, TableOids, Mfa, Res, TabOid, TabNextOid, I]), - NewVb = OrgVb#varbind{value = {endOfTable, TabNextOid}}, - validate_tab_next_res(Values, TableOids, Mfa, [NewVb | Res], - TabOid, TabNextOid, I); -validate_tab_next_res([], [], _Mfa, Res, _TabOid, _TabNextOid, _I) -> - Res; -validate_tab_next_res([], [{_Col, _OrgVb, Index}|_], Mfa, _Res, _, _, _I) -> - user_err("Too few values returned from ~w (get_next)", [Mfa]), - {genErr, Index}; -validate_tab_next_res({genErr, ColNumber}, OrgCols, - Mfa, _Res, _TabOid, _TabNextOid, _I) -> - OrgIndex = snmpa_svbl:col_to_orgindex(ColNumber, OrgCols), - validate_err(table_next, {genErr, OrgIndex}, Mfa); -validate_tab_next_res({error, Reason}, [{_ColNo, OrgVb, _Index} | _TableOids], - Mfa, _Res, _TabOid, _TabNextOid, _I) -> - #varbind{org_index = OrgIndex} = OrgVb, - user_err("Erroneous return value ~w from ~w (get_next)", - [Reason, Mfa]), - {genErr, OrgIndex}; -validate_tab_next_res(Error, [{_ColNo, OrgVb, _Index} | _TableOids], - Mfa, _Res, _TabOid, _TabNextOid, _I) -> - #varbind{org_index = OrgIndex} = OrgVb, - user_err("Invalid return value ~w from ~w (get_next)", - [Error, Mfa]), - {genErr, OrgIndex}; -validate_tab_next_res(TooMany, [], Mfa, _Res, _, _, I) -> - user_err("Too many values ~w returned from ~w (get_next)", - [TooMany, Mfa]), - {genErr, I}. - -%%----------------------------------------------------------------- -%% Func: get_next_sa/4 -%% Purpose: Loop the list of varbinds for the subagent. -%% Call subagent_get_next to retreive -%% the next varbinds. -%% Returns: {ok, ListOfNewVbs, ListOfEndOfMibViewsVbs} | -%% {ErrorStatus, ErrorIndex} -%%----------------------------------------------------------------- -get_next_sa(SAPid, SAOid, SAVbs, MibView) -> - case catch subagent_get_next(SAPid, MibView, SAVbs) of - {noError, 0, NewVbs} -> - NewerVbs = transform_sa_next_result(NewVbs,SAOid,next_oid(SAOid)), - split_varbinds(NewerVbs, [], []); - {ErrorStatus, ErrorIndex, _} -> - {ErrorStatus, ErrorIndex}; - {'EXIT', Reason} -> - user_err("Lost contact with subagent (next) ~w. Using genErr", - [Reason]), - {genErr, 0} - end. - -%%----------------------------------------------------------------- -%% Check for wrong prefix returned or endOfMibView, and convert -%% into {endOfMibView, SANextOid}. -%%----------------------------------------------------------------- -transform_sa_next_result([Vb | Vbs], SAOid, SANextOid) - when Vb#varbind.value =:= endOfMibView -> - [Vb#varbind{value = {endOfMibView, SANextOid}} | - transform_sa_next_result(Vbs, SAOid, SANextOid)]; -transform_sa_next_result([Vb | Vbs], SAOid, SANextOid) -> - case lists:prefix(SAOid, Vb#varbind.oid) of - true -> - [Vb | transform_sa_next_result(Vbs, SAOid, SANextOid)]; - _ -> - [Vb#varbind{oid = SANextOid, value = {endOfMibView, SANextOid}} | - transform_sa_next_result(Vbs, SAOid, SANextOid)] - end; -transform_sa_next_result([], _SAOid, _SANextOid) -> - []. - -split_varbinds([Vb | Vbs], Res, EndOfs) -> - case Vb#varbind.value of - {endOfMibView, _} -> split_varbinds(Vbs, Res, [Vb | EndOfs]); - {endOfTable, _} -> split_varbinds(Vbs, Res, [Vb | EndOfs]); - _ -> split_varbinds(Vbs, [Vb | Res], EndOfs) - end; -split_varbinds([], Res, EndOfs) -> {ok, Res, EndOfs}. - -next_oid(Oid) -> - case lists:reverse(Oid) of - [H | T] -> lists:reverse([H+1 | T]); - [] -> [] - end. %%%----------------------------------------------------------------- @@ -3623,200 +2834,12 @@ next_oid(Oid) -> %%%----------------------------------------------------------------- do_get_bulk(MibView, NonRepeaters, MaxRepetitions, PduMS, Varbinds, GbMaxVBs) -> - ?vtrace("do_get_bulk -> entry with" - "~n MibView: ~p" - "~n NonRepeaters: ~p" - "~n MaxRepetitions: ~p" - "~n PduMS: ~p" - "~n Varbinds: ~p" - "~n GbMaxVBs: ~p", - [MibView, NonRepeaters, MaxRepetitions, PduMS, Varbinds, GbMaxVBs]), - {NonRepVbs, RestVbs} = split_vbs(NonRepeaters, Varbinds, []), - ?vt("do_get_bulk -> split: " - "~n NonRepVbs: ~p" - "~n RestVbs: ~p", [NonRepVbs, RestVbs]), - case do_get_next(MibView, NonRepVbs, GbMaxVBs) of - {noError, 0, UResNonRepVbs} -> - ?vt("do_get_bulk -> next noError: " - "~n UResNonRepVbs: ~p", [UResNonRepVbs]), - ResNonRepVbs = lists:keysort(#varbind.org_index, UResNonRepVbs), - %% Decode the first varbinds, produce a reversed list of - %% listOfBytes. - case (catch enc_vbs(PduMS - ?empty_pdu_size, ResNonRepVbs)) of - {error, Idx, Reason} -> - user_err("failed encoding varbind ~w:~n~p", [Idx, Reason]), - {genErr, Idx, []}; - {SizeLeft, Res} when is_integer(SizeLeft) and is_list(Res) -> - ?vtrace("do_get_bulk -> encoded: " - "~n SizeLeft: ~p" - "~n Res: ~w", [SizeLeft, Res]), - case (catch do_get_rep(SizeLeft, MibView, MaxRepetitions, - RestVbs, Res, - length(UResNonRepVbs), GbMaxVBs)) of - {error, Idx, Reason} -> - user_err("failed encoding varbind ~w:~n~p", - [Idx, Reason]), - {genErr, Idx, []}; - Res when is_list(Res) -> - ?vtrace("do get bulk -> Res: " - "~n ~w", [Res]), - {noError, 0, conv_res(Res)}; - {noError, 0, Data} = OK -> - ?vtrace("do get bulk -> OK: " - "~n length(Data): ~w", [length(Data)]), - OK; - Else -> - ?vtrace("do get bulk -> Else: " - "~n ~w", [Else]), - Else - end; - Res when is_list(Res) -> - {noError, 0, conv_res(Res)} - end; + Extra = get(net_if_data), + GetModule = get(get_module), + GetModule:do_get_bulk(MibView, NonRepeaters, MaxRepetitions, + PduMS, Varbinds, GbMaxVBs, + Extra). - {ErrorStatus, Index, _} -> - ?vdebug("do get bulk: " - "~n ErrorStatus: ~p" - "~n Index: ~p",[ErrorStatus, Index]), - {ErrorStatus, Index, []} - end. - -% sz(L) when list(L) -> length(L); -% sz(B) when binary(B) -> size(B); -% sz(_) -> unknown. - -split_vbs(N, Varbinds, Res) when N =< 0 -> {Res, Varbinds}; -split_vbs(N, [H | T], Res) -> split_vbs(N-1, T, [H | Res]); -split_vbs(_N, [], Res) -> {Res, []}. - -enc_vbs(SizeLeft, Vbs) -> - ?vt("enc_vbs -> entry with" - "~n SizeLeft: ~w", [SizeLeft]), - Fun = fun(Vb, {Sz, Res}) when Sz > 0 -> - ?vt("enc_vbs -> (fun) entry with" - "~n Vb: ~p" - "~n Sz: ~p" - "~n Res: ~w", [Vb, Sz, Res]), - case (catch snmp_pdus:enc_varbind(Vb)) of - {'EXIT', Reason} -> - ?vtrace("enc_vbs -> encode failed: " - "~n Reason: ~p", [Reason]), - throw({error, Vb#varbind.org_index, Reason}); - X -> - ?vt("enc_vbs -> X: ~w", [X]), - Lx = length(X), - ?vt("enc_vbs -> Lx: ~w", [Lx]), - if - Lx < Sz -> - {Sz - length(X), [X | Res]}; - true -> - throw(Res) - end - end; - (_Vb, {_Sz, [_H | T]}) -> - ?vt("enc_vbs -> (fun) entry with" - "~n T: ~p", [T]), - throw(T); - (_Vb, {_Sz, []}) -> - ?vt("enc_vbs -> (fun) entry", []), - throw([]) - end, - lists:foldl(Fun, {SizeLeft, []}, Vbs). - -do_get_rep(Sz, MibView, MaxRepetitions, Varbinds, Res, GbNumVBs, GbMaxVBs) - when MaxRepetitions >= 0 -> - do_get_rep(Sz, MibView, 0, MaxRepetitions, Varbinds, Res, - GbNumVBs, GbMaxVBs); -do_get_rep(Sz, MibView, _MaxRepetitions, Varbinds, Res, GbNumVBs, GbMaxVBs) -> - do_get_rep(Sz, MibView, 0, 0, Varbinds, Res, GbNumVBs, GbMaxVBs). - -conv_res(ResVarbinds) -> - conv_res(ResVarbinds, []). -conv_res([VbListOfBytes | T], Bytes) -> - conv_res(T, VbListOfBytes ++ Bytes); -conv_res([], Bytes) -> - Bytes. - -%% The only other value, then a positive integer, is infinity. -do_get_rep(_Sz, _MibView, Count, Max, _, _Res, GbNumVBs, GbMaxVBs) - when (is_integer(GbMaxVBs) andalso (GbNumVBs > GbMaxVBs)) -> - ?vinfo("Max Get-BULK VBs limit (~w) exceeded (~w) when:" - "~n Count: ~p" - "~n Max: ~p", [GbMaxVBs, GbNumVBs, Count, Max]), - {tooBig, 0, []}; -do_get_rep(_Sz, _MibView, Max, Max, _, Res, _GbNumVBs, _GbMaxVBs) -> - ?vt("do_get_rep -> done when: " - "~n Res: ~p", [Res]), - {noError, 0, conv_res(Res)}; -do_get_rep(Sz, MibView, Count, Max, Varbinds, Res, GbNumVBs, GbMaxVBs) -> - ?vt("do_get_rep -> entry when: " - "~n Sz: ~p" - "~n Count: ~p" - "~n Res: ~w", [Sz, Count, Res]), - case try_get_bulk(Sz, MibView, Varbinds, GbMaxVBs) of - {noError, NextVarbinds, SizeLeft, Res2} -> - ?vt("do_get_rep -> noError: " - "~n SizeLeft: ~p" - "~n Res2: ~p", [SizeLeft, Res2]), - do_get_rep(SizeLeft, MibView, Count+1, Max, NextVarbinds, - Res2 ++ Res, - GbNumVBs + length(Varbinds), GbMaxVBs); - {endOfMibView, _NextVarbinds, _SizeLeft, Res2} -> - ?vt("do_get_rep -> endOfMibView: " - "~n Res2: ~p", [Res2]), - {noError, 0, conv_res(Res2 ++ Res)}; - {ErrorStatus, Index} -> - ?vtrace("do_get_rep -> done when error: " - "~n ErrorStatus: ~p" - "~n Index: ~p", [ErrorStatus, Index]), - {ErrorStatus, Index, []} - end. - -org_index_sort_vbs(Vbs) -> - lists:keysort(#varbind.org_index, Vbs). - -try_get_bulk(Sz, MibView, Varbinds, GbMaxVBs) -> - ?vt("try_get_bulk -> entry with" - "~n Sz: ~w" - "~n MibView: ~w" - "~n Varbinds: ~w", [Sz, MibView, Varbinds]), - case do_get_next(MibView, Varbinds, GbMaxVBs) of - {noError, 0, UNextVarbinds} -> - ?vt("try_get_bulk -> noError: " - "~n UNextVarbinds: ~p", [UNextVarbinds]), - NextVarbinds = org_index_sort_vbs(UNextVarbinds), - case (catch enc_vbs(Sz, NextVarbinds)) of - {error, Idx, Reason} -> - user_err("failed encoding varbind ~w:~n~p", [Idx, Reason]), - ?vtrace("try_get_bulk -> encode error: " - "~n Idx: ~p" - "~n Reason: ~p", [Idx, Reason]), - {genErr, Idx}; - {SizeLeft, Res} when is_integer(SizeLeft) andalso - is_list(Res) -> - ?vt("try get bulk -> encode ok: " - "~n SizeLeft: ~w" - "~n Res: ~w", [SizeLeft, Res]), - {check_end_of_mibview(NextVarbinds), - NextVarbinds, SizeLeft, Res}; - Res when is_list(Res) -> - ?vt("try get bulk -> Res: " - "~n ~w", [Res]), - {endOfMibView, [], 0, Res} - end; - {ErrorStatus, Index, _} -> - ?vt("try_get_bulk -> error: " - "~n ErrorStatus: ~p" - "~n Index: ~p", [ErrorStatus, Index]), - {ErrorStatus, Index} - end. - -%% If all variables in this pass are endOfMibView, -%% there is no reason to continue. -check_end_of_mibview([#varbind{value = endOfMibView} | T]) -> - check_end_of_mibview(T); -check_end_of_mibview([]) -> endOfMibView; -check_end_of_mibview(_) -> noError. %%%-------------------------------------------------- @@ -3834,14 +2857,11 @@ do_subagent_set(Arguments) -> SetModule = get(set_module), apply(SetModule, do_subagent_set, [Arguments]). + + %%%----------------------------------------------------------------- %%% 7. Misc functions %%%----------------------------------------------------------------- -sort_varbindlist(Varbinds) -> - snmpa_svbl:sort_varbindlist(get(mibserver), Varbinds). - -sa_split(SubagentVarbinds) -> - snmpa_svbl:sa_split(SubagentVarbinds). make_response_pdu(ReqId, ErrStatus, ErrIndex, OrgVarbinds, _ResponseVarbinds) when ErrIndex =/= 0 -> @@ -4139,6 +3159,7 @@ report_err(Val, Mfa, Err) -> user_err("Got ~p from ~w. Using ~w", [Val, Mfa, Err]), {error, Err}. + is_valid_pdu_type('get-request') -> true; is_valid_pdu_type('get-next-request') -> true; is_valid_pdu_type('get-bulk-request') -> true; @@ -4176,33 +3197,8 @@ mapfoldl(F, Eas, Accu0, [Hd|Tail]) -> mapfoldl(_F, _Eas, Accu, []) -> {Accu,[]}. -%%----------------------------------------------------------------- -%% Runtime debugging of the agent. -%%----------------------------------------------------------------- - -dbg_apply(M,F,A) -> - case get(verbosity) of - silence -> - apply(M,F,A); - _ -> - ?vlog("~n apply: ~w,~w,~p~n", [M,F,A]), - Res = (catch apply(M,F,A)), - case Res of - {'EXIT', Reason} -> - ?vinfo("Call to: " - "~n Module: ~p" - "~n Function: ~p" - "~n Args: ~p" - "~n" - "~nresulted in an exit" - "~n" - "~n ~p", [M, F, A, Reason]); - _ -> - ?vlog("~n returned: ~p", [Res]) - end, - Res - end. +%% --------------------------------------------------------------------- short_name(none) -> ma; short_name(_Pid) -> sa. @@ -4450,6 +3446,9 @@ get_mib_storage(Opts) -> get_set_mechanism(Opts) -> get_option(set_mechanism, Opts, snmpa_set). +get_get_mechanism(Opts) -> + get_option(get_mechanism, Opts, snmpa_get). + get_authentication_service(Opts) -> get_option(authentication_service, Opts, snmpa_acm). diff --git a/lib/snmp/src/agent/snmpa_app.erl b/lib/snmp/src/agent/snmpa_app.erl index 86ff145e93..c00929c334 100644 --- a/lib/snmp/src/agent/snmpa_app.erl +++ b/lib/snmp/src/agent/snmpa_app.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -67,6 +67,7 @@ convert_config(Opts) -> SaVerb = get_sub_agent_verbosity(Opts), [{agent_type, AgentType}, {agent_verbosity, SaVerb}, + {get_mechanism, snmpa_get}, {set_mechanism, SetModule}, {authentication_service, AuthModule}, {priority, Prio}, @@ -97,6 +98,7 @@ convert_config(Opts) -> {verbosity, ConfVerb}], [{agent_type, AgentType}, {agent_verbosity, MaVerb}, + {get_mechanism, snmpa_get}, {set_mechanism, SetModule}, {authentication_service, AuthModule}, {db_dir, DbDir}, diff --git a/lib/snmp/src/agent/snmpa_get.erl b/lib/snmp/src/agent/snmpa_get.erl new file mode 100644 index 0000000000..e67975a67d --- /dev/null +++ b/lib/snmp/src/agent/snmpa_get.erl @@ -0,0 +1,1150 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(snmpa_get). + +-behaviour(snmpa_get_mechanism). + + +%%%----------------------------------------------------------------- +%%% snmpa_get_mechanism exports +%%%----------------------------------------------------------------- + +-export([ + do_get/3, do_get/4, + do_get_next/3, + do_get_bulk/7 + ]). + +-define(VMODULE,"GET"). +-include("snmpa_internal.hrl"). +-include("snmp_types.hrl"). +-include("snmp_debug.hrl"). +-include("snmp_verbosity.hrl"). + +-ifndef(default_verbosity). +-define(default_verbosity,silence). +-endif. + +-define(empty_pdu_size, 21). + +-ifdef(snmp_extended_verbosity). +-define(vt(F,A), ?vtrace(F, A)). +-else. +-define(vt(_F, _A), ok). +-endif. + + +-define(AGENT, snmpa_agent). +-define(LIB, snmpa_get_lib). + + + +%%%----------------------------------------------------------------- +%%% 3. GET REQUEST +%%% -------------- +%%% According to RFC1157, section 4.1.2 and RFC1905, section 4.2.1. +%%% In rfc1157:4.1.2 it isn't specified if noSuchName should be +%%% returned even if some other varbind generates a genErr. +%%% In rfc1905:4.2.1 this is not a problem since exceptions are +%%% used, and thus a genErr will be returned anyway. +%%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Func: do_get/2 +%% Purpose: Handles all VBs in a request that is inside the +%% mibview (local). +%% Returns: {noError, 0, ListOfNewVarbinds} | +%% {ErrorStatus, ErrorIndex, []} +%%----------------------------------------------------------------- + +do_get(UnsortedVarbinds, IsNotification, _Extra) -> + {MyVarbinds, SubagentVarbinds} = ?LIB:agent_sort_vbs(UnsortedVarbinds), + case do_get_local(MyVarbinds, IsNotification) of + {noError, 0, NewMyVarbinds} -> + case do_get_subagents(SubagentVarbinds, IsNotification) of + {noError, 0, NewSubagentVarbinds} -> + {noError, 0, NewMyVarbinds ++ NewSubagentVarbinds}; + {ErrorStatus, ErrorIndex, _} -> + {ErrorStatus, ErrorIndex, []} + end; + {ErrorStatus, ErrorIndex, _} -> + {ErrorStatus, ErrorIndex, []} + end. + + +%%----------------------------------------------------------------- +%% Func: do_get/3 +%% Purpose: do_get handles "getRequests". +%% Pre: incoming varbinds have type == 'NULL', value == unSpecified +%% Returns: {noError, 0, ListOfNewVarbinds} | +%% {ErrorStatus, ErrorIndex, []} +%%----------------------------------------------------------------- + +do_get(MibView, UnsortedVarbinds, IsNotification, Extra) -> + ?vtrace("do_get -> entry with" + "~n MibView: ~p" + "~n UnsortedVarbinds: ~p" + "~n IsNotification: ~p", + [MibView, UnsortedVarbinds, IsNotification]), + %% This is me, the master, so go ahead + {OutSideView, InSideView} = ?LIB:split_vbs_view(UnsortedVarbinds, MibView), + {Error, Index, NewVbs} = do_get(InSideView, IsNotification, Extra), + {Error, Index, NewVbs ++ OutSideView}. + + + +%%----------------------------------------------------------------- +%% Func: do_get_local/2,3 +%% Purpose: Loop the variablebindings list. We know that each varbind +%% in that list belongs to us. +%% Returns: {noError, 0, ListOfNewVarbinds} | +%% {ErrorStatus, ErrorIndex, []} +%%----------------------------------------------------------------- + +do_get_local(VBs, IsNotification) -> + do_get_local(VBs, [], IsNotification). + +do_get_local([Vb | Vbs], Res, IsNotification) -> + case try_get(Vb, IsNotification) of + NewVb when is_record(NewVb, varbind) -> + do_get_local(Vbs, [NewVb | Res], IsNotification); + ListOfNewVb when is_list(ListOfNewVb) -> + do_get_local(Vbs, lists:append(ListOfNewVb, Res), IsNotification); + {error, Error, OrgIndex} -> + {Error, OrgIndex, []} + end; +do_get_local([], Res, _IsNotification) -> + {noError, 0, Res}. + + + +%%----------------------------------------------------------------- +%% Func: do_get_subagents/2 +%% Purpose: Loop the list of varbinds for different subagents. +%% For each of them, call sub_agent_get to retreive +%% the values for them. +%% Returns: {noError, 0, ListOfNewVarbinds} | +%% {ErrorStatus, ErrorIndex, []} +%%----------------------------------------------------------------- +do_get_subagents(SubagentVarbinds, IsNotification) -> + do_get_subagents(SubagentVarbinds, [], IsNotification). +do_get_subagents([{SubAgentPid, SAVbs} | Tail], Res, IsNotification) -> + {_SAOids, Vbs} = ?LIB:sa_split(SAVbs), + case catch ?AGENT:subagent_get(SubAgentPid, Vbs, IsNotification) of + {noError, 0, NewVbs} -> + do_get_subagents(Tail, lists:append(NewVbs, Res), IsNotification); + {ErrorStatus, ErrorIndex, _} -> + {ErrorStatus, ErrorIndex, []}; + {'EXIT', Reason} -> + ?LIB:user_err("Lost contact with subagent (get) ~w. Using genErr", + [Reason]), + {genErr, 0, []} + end; +do_get_subagents([], Res, _IsNotification) -> + {noError, 0, Res}. + + +%%----------------------------------------------------------------- +%% Func: try_get/2 +%% Returns: {error, ErrorStatus, OrgIndex} | +%% #varbind | +%% List of #varbind +%%----------------------------------------------------------------- +try_get(IVb, IsNotification) when is_record(IVb, ivarbind) -> + ?vtrace("try_get(ivarbind) -> entry with" + "~n IVb: ~p", [IVb]), + get_var_value_from_ivb(IVb, IsNotification); +try_get({TableOid, TableVbs}, IsNotification) -> + ?vtrace("try_get(table) -> entry with" + "~n TableOid: ~p" + "~n TableVbs: ~p", [TableOid, TableVbs]), + [#ivarbind{mibentry = MibEntry}|_] = TableVbs, + {NoAccessVbs, AccessVbs} = + check_all_table_vbs(TableVbs, IsNotification, [], []), + case get_tab_value_from_mib(MibEntry, TableOid, AccessVbs) of + {error, ErrorStatus, OrgIndex} -> + {error, ErrorStatus, OrgIndex}; + NVbs -> + NVbs ++ NoAccessVbs + end. + +%%----------------------------------------------------------------- +%% Make sure all requested columns are accessible. +%%----------------------------------------------------------------- +check_all_table_vbs([IVb| IVbs], IsNotification, NoA, A) -> + #ivarbind{mibentry = Me, varbind = Vb} = IVb, + case Me#me.access of + 'not-accessible' -> + NNoA = [Vb#varbind{value = noSuchInstance} | NoA], + check_all_table_vbs(IVbs, IsNotification, NNoA, A); + 'accessible-for-notify' when IsNotification =:= false -> + NNoA = [Vb#varbind{value = noSuchInstance} | NoA], + check_all_table_vbs(IVbs, IsNotification, NNoA, A); + 'write-only' -> + NNoA = [Vb#varbind{value = noSuchInstance} | NoA], + check_all_table_vbs(IVbs, IsNotification, NNoA, A); + _ -> + check_all_table_vbs(IVbs, IsNotification, NoA, [IVb | A]) + end; +check_all_table_vbs([], _IsNotification, NoA, A) -> {NoA, A}. + +%%----------------------------------------------------------------- +%% Returns: {error, ErrorStatus, OrgIndex} | +%% #varbind +%%----------------------------------------------------------------- +get_var_value_from_ivb(IVb, IsNotification) + when IVb#ivarbind.status =:= noError -> + ?vtrace("get_var_value_from_ivb(noError) -> entry", []), + #ivarbind{mibentry = Me, varbind = Vb} = IVb, + #varbind{org_index = OrgIndex, oid = Oid} = Vb, + case Me#me.access of + 'not-accessible' -> + Vb#varbind{value = noSuchInstance}; + 'accessible-for-notify' when IsNotification =:= false -> + Vb#varbind{value = noSuchInstance}; + 'write-only' -> + Vb#varbind{value = noSuchInstance}; + _ -> + case get_var_value_from_mib(Me, Oid) of + {value, Type, Value} -> + Vb#varbind{variabletype = Type, value = Value}; + {error, ErrorStatus} -> + {error, ErrorStatus, OrgIndex} + end + end; +get_var_value_from_ivb(#ivarbind{status = Status, varbind = Vb}, _) -> + ?vtrace("get_var_value_from_ivb(~p) -> entry", [Status]), + Vb#varbind{value = Status}. + +%%----------------------------------------------------------------- +%% Func: get_var_value_from_mib/1 +%% Purpose: +%% Returns: {error, ErrorStatus} | +%% {value, Type, Value} +%%----------------------------------------------------------------- +%% Pre: Oid is a correct instance Oid (lookup checked that). +%% Returns: A correct return value (see ?AGENT:make_value_a_correct_value) +get_var_value_from_mib(#me{entrytype = variable, + asn1_type = ASN1Type, + mfa = {Mod, Func, Args}}, + _Oid) -> + ?vtrace("get_var_value_from_mib(variable) -> entry when" + "~n Mod: ~p" + "~n Func: ~p" + "~n Args: ~p", [Mod, Func, Args]), + Result = (catch ?LIB:dbg_apply(Mod, Func, [get | Args])), + %% mib shall return {value, <a-nice-value-within-range>} | + %% {noValue, noSuchName} (v1) | + %% {noValue, noSuchObject | noSuchInstance} (v2, v1) + %% everything else (including 'genErr') will generate 'genErr'. + ?AGENT:make_value_a_correct_value(Result, ASN1Type, {Mod, Func, Args}); + +get_var_value_from_mib(#me{entrytype = table_column, + oid = MeOid, + asn1_type = ASN1Type, + mfa = {Mod, Func, Args}}, + Oid) -> + ?vtrace("get_var_value_from_mib(table_column) -> entry when" + "~n MeOid: ~p" + "~n Mod: ~p" + "~n Func: ~p" + "~n Args: ~p" + "~n Oid: ~p", [MeOid, Mod, Func, Args, Oid]), + Col = lists:last(MeOid), + Indexes = snmp_misc:diff(Oid, MeOid), + [Result] = (catch ?LIB:dbg_apply(Mod, Func, [get, Indexes, [Col] | Args])), + ?AGENT:make_value_a_correct_value(Result, ASN1Type, + {Mod, Func, Args, Indexes, Col}). + + +%% For table operations we need to pass RestOid down to the table-function. +%% Its up to the table-function to check for noSuchInstance (ex: a +%% non-existing row). +%% Returns: {error, ErrorStatus, OrgIndex} | +%% {value, Type, Value} +get_tab_value_from_mib(#me{mfa = {Mod, Func, Args}}, TableOid, TableVbs) -> + ?vtrace("get_tab_value_from_mib -> entry when" + "~n Mod: ~p" + "~n Func: ~p" + "~n Args: ~p", [Mod, Func, Args]), + TableOpsWithShortOids = ?LIB:delete_prefixes(TableOid, TableVbs), + SortedVBsRows = snmpa_svbl:sort_varbinds_rows(TableOpsWithShortOids), + case get_value_all_rows(SortedVBsRows, Mod, Func, Args, []) of + {Error, Index} -> + #ivarbind{varbind = Vb} = lists:nth(Index, TableVbs), + {error, Error, Vb#varbind.org_index}; + ListOfValues -> + merge_varbinds_and_value(TableVbs, ListOfValues) + end. + +%%----------------------------------------------------------------- +%% Values is a scrambled list of {CorrectValue, Index}, where Index +%% is index into the #ivarbind list. So for each Value, we must +%% find the corresponding #ivarbind, and merge them into a new +%% #varbind. +%% The Values list comes from validate_tab_res. +%%----------------------------------------------------------------- +merge_varbinds_and_value(IVbs, [{{value, Type, Value}, Index} | Values]) -> + #ivarbind{varbind = Vb} = lists:nth(Index, IVbs), + [Vb#varbind{variabletype = Type, value = Value} | + merge_varbinds_and_value(IVbs, Values)]; +merge_varbinds_and_value(_, []) -> []. + +get_value_all_rows([{[], OrgCols} | Rows], Mod, Func, Args, Res) -> + ?vtrace("get_value_all_rows -> entry when" + "~n OrgCols: ~p", [OrgCols]), + Cols = [{{value, noValue, noSuchInstance}, Index} || + {_Col, _ASN1Type, Index} <- OrgCols], + NewRes = lists:append(Cols, Res), + get_value_all_rows(Rows, Mod, Func, Args, NewRes); +get_value_all_rows([{RowIndex, OrgCols} | Rows], Mod, Func, Args, Res) -> + ?vtrace("get_value_all_rows -> entry when" + "~n RowIndex: ~p" + "~n OrgCols: ~p", [RowIndex, OrgCols]), + {DOrgCols, Dup} = remove_duplicates(OrgCols), + Cols = delete_index(DOrgCols), + Result = (catch ?LIB:dbg_apply(Mod, Func, [get, RowIndex, Cols | Args])), + case validate_tab_res(Result, DOrgCols, {Mod, Func, Args}) of + Values when is_list(Values) -> + NVals = restore_duplicates(Dup, Values), + NewRes = lists:append(NVals, Res), + get_value_all_rows(Rows, Mod, Func, Args, NewRes); + {error, ErrorStatus, Index} -> + ?AGENT:validate_err(row_set, {ErrorStatus, Index}, {Mod, Func, Args}) + end; +get_value_all_rows([], _Mod, _Func, _Args, Res) -> + ?vtrace("get_value_all_rows -> entry when done" + "~n Res: ~p", [Res]), + Res. + +%%----------------------------------------------------------------- +%% Args: {RowIndex, list of {ShortOid, ASN1Type}} +%% Returns: list of Col +%%----------------------------------------------------------------- +delete_index([{Col, _Val, _OrgIndex} | T]) -> + [Col | delete_index(T)]; +delete_index([]) -> []. + +%%----------------------------------------------------------------- +%% This function is called before 'get' on a table, and removes +%% any duplicate columns. It returns {Cols, DupInfo}. The Cols +%% are the unique columns. The instrumentation function is +%% called to get the values. These values, together with the +%% DupInfo, is later passed to restore_duplicates, which uses +%% the retrieved values to reconstruct the original column list, +%% but with the retrieved value for each column. +%%----------------------------------------------------------------- +remove_duplicates(Cols) -> + remove_duplicates(Cols, [], []). + + +remove_duplicates([{Col, V1, OrgIdx1}, {Col, V2, OrgIdx2} | T], NCols, Dup) -> + remove_duplicates([{Col, V1, OrgIdx1} | T], NCols, + [{Col, V2, OrgIdx2} | Dup]); +remove_duplicates([Col | T], NCols, Dup) -> + remove_duplicates(T, [Col | NCols], Dup); +remove_duplicates([], NCols, Dup) -> + {lists:reverse(NCols), lists:reverse(Dup)}. + +restore_duplicates([], Cols) -> + [{Val, OrgIndex} || {_Col, Val, OrgIndex} <- Cols]; +restore_duplicates([{Col, _Val2, OrgIndex2} | Dup], + [{Col, NVal, OrgIndex1} | Cols]) -> + [{NVal, OrgIndex2} | + restore_duplicates(Dup, [{Col, NVal, OrgIndex1} | Cols])]; +restore_duplicates(Dup, [{_Col, Val, OrgIndex} | T]) -> + [{Val, OrgIndex} | restore_duplicates(Dup, T)]. + + + +%%----------------------------------------------------------------- +%% Three cases: +%% 1) All values ok +%% 2) table_func returned {Error, ...} +%% 3) Some value in Values list is erroneous. +%% Args: Value is a list of values from table_func(get..) +%% OrgCols is a list with {Col, ASN1Type, OrgIndex} +%% each element in Values and OrgCols correspond to each +%% other. +%%----------------------------------------------------------------- +validate_tab_res(Values, OrgCols, Mfa) when is_list(Values) -> + {_Col, _ASN1Type, OneIdx} = hd(OrgCols), + validate_tab_res(Values, OrgCols, Mfa, [], OneIdx); +validate_tab_res({noValue, Error}, OrgCols, Mfa) -> + Values = lists:duplicate(length(OrgCols), {noValue, Error}), + validate_tab_res(Values, OrgCols, Mfa); +validate_tab_res({genErr, Col}, OrgCols, Mfa) -> + case lists:keysearch(Col, 1, OrgCols) of + {value, {_Col, _ASN1Type, Index}} -> + {error, genErr, Index}; + _ -> + ?LIB:user_err("Invalid column in {genErr, ~w} from ~w (get)", + [Col, Mfa]), + [{_Col, _ASN1Type, Index} | _] = OrgCols, + {error, genErr, Index} + end; +validate_tab_res(genErr, [{_Col, __ASN1Type, Index} | _OrgCols], _Mfa) -> + {error, genErr, Index}; +validate_tab_res(Error, [{_Col, _ASN1Type, Index} | _OrgCols], Mfa) -> + ?LIB:user_err("Invalid return value ~w from ~w (get)",[Error, Mfa]), + {error, genErr, Index}. + +validate_tab_res([Value | Values], + [{Col, ASN1Type, Index} | OrgCols], + Mfa, Res, I) -> + %% This one makes it possible to return a list of genErr, which + %% is not allowed according to the manual. But that's ok, as + %% everything else will generate a genErr! (the only problem is + %% that it won't generate a user_error). + case ?AGENT:make_value_a_correct_value(Value, ASN1Type, Mfa) of + {error, ErrorStatus} -> + {error, ErrorStatus, Index}; + CorrectValue -> + NewRes = [{Col, CorrectValue, Index} | Res], + validate_tab_res(Values, OrgCols, Mfa, NewRes, I) + end; +validate_tab_res([], [], _Mfa, Res, _I) -> + lists:reverse(Res); +validate_tab_res([], [{_Col, _ASN1Type, Index}|_], Mfa, _Res, _I) -> + ?LIB:user_err("Too few values returned from ~w (get)", [Mfa]), + {error, genErr, Index}; +validate_tab_res(_TooMany, [], Mfa, _Res, I) -> + ?LIB:user_err("Too many values returned from ~w (get)", [Mfa]), + {error, genErr, I}. + + + +%%%----------------------------------------------------------------- +%%% 4. GET-NEXT REQUEST +%%% -------------- +%%% According to RFC1157, section 4.1.3 and RFC1905, section 4.2.2. +%%%----------------------------------------------------------------- +%%----------------------------------------------------------------- +%% Func: do_get_next/3 +%% Purpose: do_get_next handles "getNextRequests". +%% Note: Even if it is SNMPv1, a varbind's value can be +%% endOfMibView. This is converted to noSuchName in process_pdu. +%% Returns: {noError, 0, ListOfNewVarbinds} | +%% {ErrorStatus, ErrorIndex, []} +%% Note2: ListOfNewVarbinds is not sorted in any order!!! +%% Alg: First, the variables are sorted in OID order. +%% +%% Second, next in the MIB is performed for each OID, and +%% the result is collected as: if next oid is a variable, +%% perform a get to retrieve its value; if next oid is in a +%% table, save this value and continue until we get an oid +%% outside this table. Then perform get_next on the table, +%% and continue with all endOfTables and the oid outside the +%% table; if next oid is an subagent, save this value and +%% continue as in the table case. +%% +%% Third, each response is checked for endOfMibView, or (for +%% subagents) that the Oid returned has the correct prefix. +%% (This is necessary since an SA can be registered under many +%% separated subtrees, and if the last variable in the first +%% subtree is requested in a next, the SA will return the first +%% variable in the second subtree. This might be working, since +%% there may be a variable in between these subtrees.) For each +%% of these, a new get-next is performed, one at a time. +%% This alg. might be optimised in several ways. The most +%% striking one is that the same SA might be called several +%% times, when one time should be enough. But it isn't clear +%% that this really matters, since many nexts across the same +%% subagent must be considered to be very rare. +%%----------------------------------------------------------------- + +do_get_next(MibView, UnsortedVBs, _Extra) -> + do_get_next2(MibView, UnsortedVBs, infinity). + +%% The third argument is only used if we are called as result +%% of a get-bulk request. +do_get_next2(_MibView, UnsortedVarbinds, GbMaxVBs) + when (is_integer(GbMaxVBs) andalso (length(UnsortedVarbinds) > GbMaxVBs)) -> + {tooBig, 0, []}; % What is the correct index in this case? +do_get_next2(MibView, UnsortedVBs, GbMaxVBs) -> + ?vt("do_get_next2 -> entry when" + "~n MibView: ~p" + "~n UnsortedVBs: ~p", [MibView, UnsortedVBs]), + SortedVBs = ?LIB:oid_sort_vbs(UnsortedVBs), + ?vt("do_get_next -> " + "~n SortedVBs: ~p", [SortedVBs]), + next_loop_varbinds([], SortedVBs, MibView, [], [], GbMaxVBs). + +next_loop_varbinds(_, Vbs, _MibView, Res, _LAVb, GbMaxVBs) + when (is_integer(GbMaxVBs) andalso + ((length(Vbs) + length(Res)) > GbMaxVBs)) -> + {tooBig, 0, []}; % What is the correct index in this case? + +%% LAVb is Last Accessible Vb +next_loop_varbinds([], [Vb | Vbs], MibView, Res, LAVb, GbMaxVBs) -> + ?vt("next_loop_varbinds -> entry when" + "~n Vb: ~p" + "~n MibView: ~p", [Vb, MibView]), + case varbind_next(Vb, MibView) of + endOfMibView -> + ?vt("next_loop_varbind -> endOfMibView", []), + RVb = if LAVb =:= [] -> Vb; + true -> LAVb + end, + NewVb = RVb#varbind{variabletype = 'NULL', value = endOfMibView}, + next_loop_varbinds([], Vbs, MibView, [NewVb | Res], [], GbMaxVBs); + + {variable, ME, VarOid} when ((ME#me.access =/= 'not-accessible') andalso + (ME#me.access =/= 'write-only') andalso + (ME#me.access =/= 'accessible-for-notify')) -> + ?vt("next_loop_varbind -> variable: " + "~n ME: ~p" + "~n VarOid: ~p", [ME, VarOid]), + case try_get_instance(Vb, ME) of + {value, noValue, _NoSuchSomething} -> + ?vt("next_loop_varbind -> noValue", []), + %% Try next one + NewVb = Vb#varbind{oid = VarOid, + value = 'NULL'}, + next_loop_varbinds([], [NewVb | Vbs], MibView, Res, [], + GbMaxVBs); + {value, Type, Value} -> + ?vt("next_loop_varbind -> value" + "~n Type: ~p" + "~n Value: ~p", [Type, Value]), + NewVb = Vb#varbind{oid = VarOid, + variabletype = Type, + value = Value}, + next_loop_varbinds([], Vbs, MibView, [NewVb | Res], [], + GbMaxVBs); + {error, ErrorStatus} -> + ?vdebug("next loop varbinds:" + "~n ErrorStatus: ~p",[ErrorStatus]), + {ErrorStatus, Vb#varbind.org_index, []} + end; + {variable, _ME, VarOid} -> + ?vt("next_loop_varbind -> variable: " + "~n VarOid: ~p", [VarOid]), + RVb = if LAVb =:= [] -> Vb; + true -> LAVb + end, + NewVb = Vb#varbind{oid = VarOid, value = 'NULL'}, + next_loop_varbinds([], [NewVb | Vbs], MibView, Res, RVb, GbMaxVBs); + {table, TableOid, TableRestOid, ME} -> + ?vt("next_loop_varbind -> table: " + "~n TableOid: ~p" + "~n TableRestOid: ~p" + "~n ME: ~p", [TableOid, TableRestOid, ME]), + next_loop_varbinds({table, TableOid, ME, + [{tab_oid(TableRestOid), Vb}]}, + Vbs, MibView, Res, [], GbMaxVBs); + {subagent, SubAgentPid, SAOid} -> + ?vt("next_loop_varbind -> subagent: " + "~n SubAgentPid: ~p" + "~n SAOid: ~p", [SubAgentPid, SAOid]), + NewVb = Vb#varbind{variabletype = 'NULL', value = 'NULL'}, + next_loop_varbinds({subagent, SubAgentPid, SAOid, [NewVb]}, + Vbs, MibView, Res, [], GbMaxVBs) + end; +next_loop_varbinds({table, TableOid, ME, TabOids}, + [Vb | Vbs], MibView, Res, _LAVb, GbMaxVBs) -> + ?vt("next_loop_varbinds(table) -> entry with" + "~n TableOid: ~p" + "~n Vb: ~p", [TableOid, Vb]), + case varbind_next(Vb, MibView) of + {table, TableOid, TableRestOid, _ME} -> + next_loop_varbinds({table, TableOid, ME, + [{tab_oid(TableRestOid), Vb} | TabOids]}, + Vbs, MibView, Res, [], GbMaxVBs); + _ -> + case get_next_table(ME, TableOid, TabOids, MibView) of + {ok, TabRes, TabEndOfTabVbs} -> + NewVbs = lists:append(TabEndOfTabVbs, [Vb | Vbs]), + NewRes = lists:append(TabRes, Res), + next_loop_varbinds([], NewVbs, MibView, NewRes, [], + GbMaxVBs); + {ErrorStatus, OrgIndex} -> + ?vdebug("next loop varbinds: next varbind" + "~n ErrorStatus: ~p" + "~n OrgIndex: ~p", + [ErrorStatus,OrgIndex]), + {ErrorStatus, OrgIndex, []} + end + end; +next_loop_varbinds({table, TableOid, ME, TabOids}, + [], MibView, Res, _LAVb, GbMaxVBs) -> + ?vt("next_loop_varbinds(table) -> entry with" + "~n TableOid: ~p", [TableOid]), + case get_next_table(ME, TableOid, TabOids, MibView) of + {ok, TabRes, TabEndOfTabVbs} -> + ?vt("next_loop_varbinds(table) -> get_next_table result:" + "~n TabRes: ~p" + "~n TabEndOfTabVbs: ~p", [TabRes, TabEndOfTabVbs]), + NewRes = lists:append(TabRes, Res), + next_loop_varbinds([], TabEndOfTabVbs, MibView, NewRes, [], + GbMaxVBs); + {ErrorStatus, OrgIndex} -> + ?vdebug("next loop varbinds: next table" + "~n ErrorStatus: ~p" + "~n OrgIndex: ~p", + [ErrorStatus,OrgIndex]), + {ErrorStatus, OrgIndex, []} + end; +next_loop_varbinds({subagent, SAPid, SAOid, SAVbs}, + [Vb | Vbs], MibView, Res, _LAVb, GbMaxVBs) -> + ?vt("next_loop_varbinds(subagent) -> entry with" + "~n SAPid: ~p" + "~n SAOid: ~p" + "~n Vb: ~p", [SAPid, SAOid, Vb]), + case varbind_next(Vb, MibView) of + {subagent, _SubAgentPid, SAOid} -> + next_loop_varbinds({subagent, SAPid, SAOid, + [Vb | SAVbs]}, + Vbs, MibView, Res, [], GbMaxVBs); + _ -> + case get_next_sa(SAPid, SAOid, SAVbs, MibView) of + {ok, SARes, SAEndOfMibViewVbs} -> + NewVbs = lists:append(SAEndOfMibViewVbs, [Vb | Vbs]), + NewRes = lists:append(SARes, Res), + next_loop_varbinds([], NewVbs, MibView, NewRes, [], + GbMaxVBs); + {noSuchName, OrgIndex} -> + %% v1 reply, treat this Vb as endOfMibView, and try again + %% for the others. + case lists:keysearch(OrgIndex, #varbind.org_index, SAVbs) of + {value, EVb} -> + NextOid = next_oid(SAOid), + EndOfVb = + EVb#varbind{oid = NextOid, + value = {endOfMibView, NextOid}}, + case lists:delete(EVb, SAVbs) of + [] -> + next_loop_varbinds([], [EndOfVb, Vb | Vbs], + MibView, Res, [], + GbMaxVBs); + TryAgainVbs -> + next_loop_varbinds({subagent, SAPid, SAOid, + TryAgainVbs}, + [EndOfVb, Vb | Vbs], + MibView, Res, [], + GbMaxVBs) + end; + false -> + %% bad index from subagent + {genErr, (hd(SAVbs))#varbind.org_index, []} + end; + {ErrorStatus, OrgIndex} -> + ?vdebug("next loop varbinds: next subagent" + "~n Vb: ~p" + "~n ErrorStatus: ~p" + "~n OrgIndex: ~p", + [Vb,ErrorStatus,OrgIndex]), + {ErrorStatus, OrgIndex, []} + end + end; +next_loop_varbinds({subagent, SAPid, SAOid, SAVbs}, + [], MibView, Res, _LAVb, GbMaxVBs) -> + ?vt("next_loop_varbinds(subagent) -> entry with" + "~n SAPid: ~p" + "~n SAOid: ~p", [SAPid, SAOid]), + case get_next_sa(SAPid, SAOid, SAVbs, MibView) of + {ok, SARes, SAEndOfMibViewVbs} -> + NewRes = lists:append(SARes, Res), + next_loop_varbinds([], SAEndOfMibViewVbs, MibView, NewRes, [], + GbMaxVBs); + {noSuchName, OrgIndex} -> + %% v1 reply, treat this Vb as endOfMibView, and try again for + %% the others. + case lists:keysearch(OrgIndex, #varbind.org_index, SAVbs) of + {value, EVb} -> + NextOid = next_oid(SAOid), + EndOfVb = EVb#varbind{oid = NextOid, + value = {endOfMibView, NextOid}}, + case lists:delete(EVb, SAVbs) of + [] -> + next_loop_varbinds([], [EndOfVb], MibView, Res, [], + GbMaxVBs); + TryAgainVbs -> + next_loop_varbinds({subagent, SAPid, SAOid, + TryAgainVbs}, + [EndOfVb], MibView, Res, [], + GbMaxVBs) + end; + false -> + %% bad index from subagent + {genErr, (hd(SAVbs))#varbind.org_index, []} + end; + {ErrorStatus, OrgIndex} -> + ?vdebug("next loop varbinds: next subagent" + "~n ErrorStatus: ~p" + "~n OrgIndex: ~p", + [ErrorStatus,OrgIndex]), + {ErrorStatus, OrgIndex, []} + end; +next_loop_varbinds([], [], _MibView, Res, _LAVb, _GbMaxVBs) -> + ?vt("next_loop_varbinds -> entry when done", []), + {noError, 0, Res}. + +try_get_instance(_Vb, #me{mfa = {M, F, A}, asn1_type = ASN1Type}) -> + ?vtrace("try_get_instance -> entry with" + "~n M: ~p" + "~n F: ~p" + "~n A: ~p", [M,F,A]), + Result = (catch ?LIB:dbg_apply(M, F, [get | A])), + % mib shall return {value, <a-nice-value-within-range>} | + % {noValue, noSuchName} (v1) | + % {noValue, noSuchObject | noSuchInstance} (v2, v1) + % everything else (including 'genErr') will generate 'genErr'. + ?AGENT:make_value_a_correct_value(Result, ASN1Type, {M, F, A}). + +tab_oid([]) -> [0]; +tab_oid(X) -> X. + + +%%----------------------------------------------------------------- +%% Perform a next, using the varbinds Oid if value is simple +%% value. If value is {endOf<something>, NextOid}, use NextOid. +%% This case happens when a table has returned endOfTable, or +%% a subagent has returned endOfMibView. +%%----------------------------------------------------------------- +varbind_next(#varbind{value = Value, oid = Oid}, MibView) -> + ?vt("varbind_next -> entry with" + "~n Value: ~p" + "~n Oid: ~p" + "~n MibView: ~p", [Value, Oid, MibView]), + case Value of + {endOfTable, NextOid} -> + snmpa_mib:next(get(mibserver), NextOid, MibView); + {endOfMibView, NextOid} -> + snmpa_mib:next(get(mibserver), NextOid, MibView); + _ -> + snmpa_mib:next(get(mibserver), Oid, MibView) + end. + +get_next_table(#me{mfa = {M, F, A}}, TableOid, TableOids, MibView) -> + % We know that all TableOids have at least a column number as oid + ?vt("get_next_table -> entry with" + "~n M: ~p" + "~n F: ~p" + "~n A: ~p" + "~n TableOid: ~p" + "~n TableOids: ~p" + "~n MibView: ~p", [M, F, A, TableOid, TableOids, MibView]), + Sorted = snmpa_svbl:sort_varbinds_rows(TableOids), + case get_next_values_all_rows(Sorted, M,F,A, [], TableOid) of + NewVbs when is_list(NewVbs) -> + ?vt("get_next_table -> " + "~n NewVbs: ~p", [NewVbs]), + % We must now check each Vb for endOfTable and that it is + % in the MibView. If not, it becomes a endOfTable. We + % collect all of these together. + transform_tab_next_result(NewVbs, {[], []}, MibView); + {ErrorStatus, OrgIndex} -> + {ErrorStatus, OrgIndex} + end. + +get_next_values_all_rows([Row | Rows], M, F, A, Res, TabOid) -> + {RowIndex, TableOids} = Row, + Cols = delete_index(TableOids), + ?vt("get_next_values_all_rows -> " + "~n Cols: ~p", [Cols]), + Result = (catch ?LIB:dbg_apply(M, F, [get_next, RowIndex, Cols | A])), + ?vt("get_next_values_all_rows -> " + "~n Result: ~p", [Result]), + case validate_tab_next_res(Result, TableOids, {M, F, A}, TabOid) of + Values when is_list(Values) -> + ?vt("get_next_values_all_rows -> " + "~n Values: ~p", [Values]), + NewRes = lists:append(Values, Res), + get_next_values_all_rows(Rows, M, F, A, NewRes, TabOid); + {ErrorStatus, OrgIndex} -> + {ErrorStatus, OrgIndex} + end; +get_next_values_all_rows([], _M, _F, _A, Res, _TabOid) -> + Res. + +transform_tab_next_result([Vb | Vbs], {Res, EndOfs}, MibView) -> + case Vb#varbind.value of + {endOfTable, _} -> + {ResVBs, EndOfVBs} = ?LIB:split_vbs(Vbs, Res, [Vb | EndOfs]), + {ok, ResVBs, EndOfVBs}; + _ -> + case snmpa_acm:validate_mib_view(Vb#varbind.oid, MibView) of + true -> + transform_tab_next_result(Vbs, {[Vb|Res], EndOfs},MibView); + _ -> + Oid = Vb#varbind.oid, + NewEndOf = Vb#varbind{value = {endOfTable, Oid}}, + transform_tab_next_result(Vbs, {Res, [NewEndOf | EndOfs]}, + MibView) + end + end; +transform_tab_next_result([], {Res, EndOfs}, _MibView) -> + ?vt("transform_tab_next_result -> entry with: " + "~n Res: ~p" + "~n EndIfs: ~p",[Res, EndOfs]), + {ok, Res, EndOfs}. + + + +%%----------------------------------------------------------------- +%% Three cases: +%% 1) All values ok +%% 2) table_func returned {Error, ...} +%% 3) Some value in Values list is erroneous. +%% Args: Value is a list of values from table_func(get_next, ...) +%% TableOids is a list of {TabRestOid, OrgVb} +%% each element in Values and TableOids correspond to each +%% other. +%% Returns: List of NewVarbinds | +%% {ErrorStatus, OrgIndex} +%% (In the NewVarbinds list, the value may be endOfTable) +%%----------------------------------------------------------------- +validate_tab_next_res(Values, TableOids, Mfa, TabOid) -> + ?vt("validate_tab_next_res -> entry with: " + "~n Values: ~p" + "~n TableOids: ~p" + "~n Mfa: ~p" + "~n TabOid: ~p", [Values, TableOids, Mfa, TabOid]), + {_Col, _ASN1Type, OneIdx} = hd(TableOids), + validate_tab_next_res(Values, TableOids, Mfa, [], TabOid, + next_oid(TabOid), OneIdx). +validate_tab_next_res([{NextOid, Value} | Values], + [{_ColNo, OrgVb, _Index} | TableOids], + Mfa, Res, TabOid, TabNextOid, I) -> + ?vt("validate_tab_next_res -> entry with: " + "~n NextOid: ~p" + "~n Value: ~p" + "~n Values: ~p" + "~n TableOids: ~p" + "~n Mfa: ~p" + "~n TabOid: ~p", + [NextOid, Value, Values, TableOids, Mfa, TabOid]), + #varbind{org_index = OrgIndex} = OrgVb, + ?vt("validate_tab_next_res -> OrgIndex: ~p", [OrgIndex]), + NextCompleteOid = lists:append(TabOid, NextOid), + case snmpa_mib:lookup(get(mibserver), NextCompleteOid) of + {table_column, #me{asn1_type = ASN1Type}, _TableEntryOid} -> + ?vt("validate_tab_next_res -> ASN1Type: ~p", [ASN1Type]), + case ?AGENT:make_value_a_correct_value({value, Value}, ASN1Type, Mfa) of + {error, ErrorStatus} -> + ?vt("validate_tab_next_res -> " + "~n ErrorStatus: ~p", [ErrorStatus]), + {ErrorStatus, OrgIndex}; + {value, Type, NValue} -> + ?vt("validate_tab_next_res -> " + "~n Type: ~p" + "~n NValue: ~p", [Type, NValue]), + NewVb = OrgVb#varbind{oid = NextCompleteOid, + variabletype = Type, value = NValue}, + validate_tab_next_res(Values, TableOids, Mfa, + [NewVb | Res], TabOid, TabNextOid, I) + end; + Error -> + ?LIB:user_err("Invalid oid ~w from ~w (get_next). Using genErr => ~p", + [NextOid, Mfa, Error]), + {genErr, OrgIndex} + end; +validate_tab_next_res([endOfTable | Values], + [{_ColNo, OrgVb, _Index} | TableOids], + Mfa, Res, TabOid, TabNextOid, I) -> + ?vt("validate_tab_next_res(endOfTable) -> entry with: " + "~n Values: ~p" + "~n OrgVb: ~p" + "~n TableOids: ~p" + "~n Mfa: ~p" + "~n Res: ~p" + "~n TabOid: ~p" + "~n TabNextOid: ~p" + "~n I: ~p", + [Values, OrgVb, TableOids, Mfa, Res, TabOid, TabNextOid, I]), + NewVb = OrgVb#varbind{value = {endOfTable, TabNextOid}}, + validate_tab_next_res(Values, TableOids, Mfa, [NewVb | Res], + TabOid, TabNextOid, I); +validate_tab_next_res([], [], _Mfa, Res, _TabOid, _TabNextOid, _I) -> + Res; +validate_tab_next_res([], [{_Col, _OrgVb, Index}|_], Mfa, _Res, _, _, _I) -> + ?LIB:user_err("Too few values returned from ~w (get_next)", [Mfa]), + {genErr, Index}; +validate_tab_next_res({genErr, ColNumber}, OrgCols, + Mfa, _Res, _TabOid, _TabNextOid, _I) -> + OrgIndex = snmpa_svbl:col_to_orgindex(ColNumber, OrgCols), + ?AGENT:validate_err(table_next, {genErr, OrgIndex}, Mfa); +validate_tab_next_res({error, Reason}, [{_ColNo, OrgVb, _Index} | _TableOids], + Mfa, _Res, _TabOid, _TabNextOid, _I) -> + #varbind{org_index = OrgIndex} = OrgVb, + ?LIB:user_err("Erroneous return value ~w from ~w (get_next)", + [Reason, Mfa]), + {genErr, OrgIndex}; +validate_tab_next_res(Error, [{_ColNo, OrgVb, _Index} | _TableOids], + Mfa, _Res, _TabOid, _TabNextOid, _I) -> + #varbind{org_index = OrgIndex} = OrgVb, + ?LIB:user_err("Invalid return value ~w from ~w (get_next)", + [Error, Mfa]), + {genErr, OrgIndex}; +validate_tab_next_res(TooMany, [], Mfa, _Res, _, _, I) -> + ?LIB:user_err("Too many values ~w returned from ~w (get_next)", + [TooMany, Mfa]), + {genErr, I}. + +%%----------------------------------------------------------------- +%% Func: get_next_sa/4 +%% Purpose: Loop the list of varbinds for the subagent. +%% Call subagent_get_next to retreive +%% the next varbinds. +%% Returns: {ok, ListOfNewVbs, ListOfEndOfMibViewsVbs} | +%% {ErrorStatus, ErrorIndex} +%%----------------------------------------------------------------- +get_next_sa(SAPid, SAOid, SAVbs, MibView) -> + case catch ?AGENT:subagent_get_next(SAPid, MibView, SAVbs) of + {noError, 0, NewVbs} -> + NewerVbs = transform_sa_next_result(NewVbs,SAOid,next_oid(SAOid)), + {ResVBs, EndOfVBs} = ?LIB:split_vbs(NewerVbs), + {ok, ResVBs, EndOfVBs}; + {ErrorStatus, ErrorIndex, _} -> + {ErrorStatus, ErrorIndex}; + {'EXIT', Reason} -> + ?LIB:user_err("Lost contact with subagent (next) ~w. Using genErr", + [Reason]), + {genErr, 0} + end. + +%%----------------------------------------------------------------- +%% Check for wrong prefix returned or endOfMibView, and convert +%% into {endOfMibView, SANextOid}. +%%----------------------------------------------------------------- +transform_sa_next_result([Vb | Vbs], SAOid, SANextOid) + when Vb#varbind.value =:= endOfMibView -> + [Vb#varbind{value = {endOfMibView, SANextOid}} | + transform_sa_next_result(Vbs, SAOid, SANextOid)]; +transform_sa_next_result([Vb | Vbs], SAOid, SANextOid) -> + case lists:prefix(SAOid, Vb#varbind.oid) of + true -> + [Vb | transform_sa_next_result(Vbs, SAOid, SANextOid)]; + _ -> + [Vb#varbind{oid = SANextOid, value = {endOfMibView, SANextOid}} | + transform_sa_next_result(Vbs, SAOid, SANextOid)] + end; +transform_sa_next_result([], _SAOid, _SANextOid) -> + []. + + +next_oid(Oid) -> + case lists:reverse(Oid) of + [H | T] -> lists:reverse([H+1 | T]); + [] -> [] + end. + + + +%%%----------------------------------------------------------------- +%%% 5. GET-BULK REQUEST +%%% +%%% In order to prevent excesses in reply sizes there are two +%%% preventive methods in place. One is to check that the encode +%%% size does not exceed Max PDU size (this is mentioned in the +%%% standard). The other is a simple VBs limit. That is, the +%%% resulting response cannot contain more then this number of VBs. +%%%----------------------------------------------------------------- + +do_get_bulk(MibView, NonRepeaters, MaxRepetitions, + PduMS, Varbinds, GbMaxVBs, _Extra) -> + ?vtrace("do_get_bulk -> entry with" + "~n MibView: ~p" + "~n NonRepeaters: ~p" + "~n MaxRepetitions: ~p" + "~n PduMS: ~p" + "~n Varbinds: ~p" + "~n GbMaxVBs: ~p", + [MibView, NonRepeaters, MaxRepetitions, PduMS, Varbinds, GbMaxVBs]), + {NonRepVbs, RestVbs} = ?LIB:split_vbs_gb(NonRepeaters, Varbinds), + ?vt("do_get_bulk -> split: " + "~n NonRepVbs: ~p" + "~n RestVbs: ~p", [NonRepVbs, RestVbs]), + case do_get_next2(MibView, NonRepVbs, GbMaxVBs) of + {noError, 0, UResNonRepVbs} -> + ?vt("do_get_bulk -> next noError: " + "~n UResNonRepVbs: ~p", [UResNonRepVbs]), + ResNonRepVbs = lists:keysort(#varbind.org_index, UResNonRepVbs), + %% Decode the first varbinds, produce a reversed list of + %% listOfBytes. + case (catch enc_vbs(PduMS - ?empty_pdu_size, ResNonRepVbs)) of + {error, Idx, Reason} -> + ?LIB:user_err("failed encoding varbind ~w:~n~p", [Idx, Reason]), + {genErr, Idx, []}; + {SizeLeft, Res} when is_integer(SizeLeft) and is_list(Res) -> + ?vtrace("do_get_bulk -> encoded: " + "~n SizeLeft: ~p" + "~n Res: ~w", [SizeLeft, Res]), + case (catch do_get_rep(SizeLeft, MibView, MaxRepetitions, + RestVbs, Res, + length(UResNonRepVbs), GbMaxVBs)) of + {error, Idx, Reason} -> + ?LIB:user_err("failed encoding varbind ~w:~n~p", + [Idx, Reason]), + {genErr, Idx, []}; + Res when is_list(Res) -> + ?vtrace("do get bulk -> Res: " + "~n ~w", [Res]), + {noError, 0, conv_res(Res)}; + {noError, 0, Data} = OK -> + ?vtrace("do get bulk -> OK: " + "~n length(Data): ~w", [length(Data)]), + OK; + Else -> + ?vtrace("do get bulk -> Else: " + "~n ~w", [Else]), + Else + end; + Res when is_list(Res) -> + {noError, 0, conv_res(Res)} + end; + + {ErrorStatus, Index, _} -> + ?vdebug("do get bulk: " + "~n ErrorStatus: ~p" + "~n Index: ~p",[ErrorStatus, Index]), + {ErrorStatus, Index, []} + end. + +enc_vbs(SizeLeft, Vbs) -> + ?vt("enc_vbs -> entry with" + "~n SizeLeft: ~w", [SizeLeft]), + Fun = fun(Vb, {Sz, Res}) when Sz > 0 -> + ?vt("enc_vbs -> (fun) entry with" + "~n Vb: ~p" + "~n Sz: ~p" + "~n Res: ~w", [Vb, Sz, Res]), + case (catch snmp_pdus:enc_varbind(Vb)) of + {'EXIT', Reason} -> + ?vtrace("enc_vbs -> encode failed: " + "~n Reason: ~p", [Reason]), + throw({error, Vb#varbind.org_index, Reason}); + X -> + ?vt("enc_vbs -> X: ~w", [X]), + Lx = length(X), + ?vt("enc_vbs -> Lx: ~w", [Lx]), + if + Lx < Sz -> + {Sz - length(X), [X | Res]}; + true -> + throw(Res) + end + end; + (_Vb, {_Sz, [_H | T]}) -> + ?vt("enc_vbs -> (fun) entry with" + "~n T: ~p", [T]), + throw(T); + (_Vb, {_Sz, []}) -> + ?vt("enc_vbs -> (fun) entry", []), + throw([]) + end, + lists:foldl(Fun, {SizeLeft, []}, Vbs). + +do_get_rep(Sz, MibView, MaxRepetitions, Varbinds, Res, GbNumVBs, GbMaxVBs) + when MaxRepetitions >= 0 -> + do_get_rep(Sz, MibView, 0, MaxRepetitions, Varbinds, Res, + GbNumVBs, GbMaxVBs); +do_get_rep(Sz, MibView, _MaxRepetitions, Varbinds, Res, GbNumVBs, GbMaxVBs) -> + do_get_rep(Sz, MibView, 0, 0, Varbinds, Res, GbNumVBs, GbMaxVBs). + +conv_res(ResVarbinds) -> + conv_res(ResVarbinds, []). +conv_res([VbListOfBytes | T], Bytes) -> + conv_res(T, VbListOfBytes ++ Bytes); +conv_res([], Bytes) -> + Bytes. + +%% The only other value, then a positive integer, is infinity. +do_get_rep(_Sz, _MibView, Count, Max, _, _Res, GbNumVBs, GbMaxVBs) + when (is_integer(GbMaxVBs) andalso (GbNumVBs > GbMaxVBs)) -> + ?vinfo("Max Get-BULK VBs limit (~w) exceeded (~w) when:" + "~n Count: ~p" + "~n Max: ~p", [GbMaxVBs, GbNumVBs, Count, Max]), + {tooBig, 0, []}; +do_get_rep(_Sz, _MibView, Max, Max, _, Res, _GbNumVBs, _GbMaxVBs) -> + ?vt("do_get_rep -> done when: " + "~n Res: ~p", [Res]), + {noError, 0, conv_res(Res)}; +do_get_rep(Sz, MibView, Count, Max, Varbinds, Res, GbNumVBs, GbMaxVBs) -> + ?vt("do_get_rep -> entry when: " + "~n Sz: ~p" + "~n Count: ~p" + "~n Res: ~w", [Sz, Count, Res]), + case try_get_bulk(Sz, MibView, Varbinds, GbMaxVBs) of + {noError, NextVarbinds, SizeLeft, Res2} -> + ?vt("do_get_rep -> noError: " + "~n SizeLeft: ~p" + "~n Res2: ~p", [SizeLeft, Res2]), + do_get_rep(SizeLeft, MibView, Count+1, Max, NextVarbinds, + Res2 ++ Res, + GbNumVBs + length(Varbinds), GbMaxVBs); + {endOfMibView, _NextVarbinds, _SizeLeft, Res2} -> + ?vt("do_get_rep -> endOfMibView: " + "~n Res2: ~p", [Res2]), + {noError, 0, conv_res(Res2 ++ Res)}; + {ErrorStatus, Index} -> + ?vtrace("do_get_rep -> done when error: " + "~n ErrorStatus: ~p" + "~n Index: ~p", [ErrorStatus, Index]), + {ErrorStatus, Index, []} + end. + +try_get_bulk(Sz, MibView, Varbinds, GbMaxVBs) -> + ?vt("try_get_bulk -> entry with" + "~n Sz: ~w" + "~n MibView: ~w" + "~n Varbinds: ~w", [Sz, MibView, Varbinds]), + case do_get_next2(MibView, Varbinds, GbMaxVBs) of + {noError, 0, UNextVarbinds} -> + ?vt("try_get_bulk -> noError: " + "~n UNextVarbinds: ~p", [UNextVarbinds]), + NextVarbinds = ?LIB:org_index_sort_vbs(UNextVarbinds), + case (catch enc_vbs(Sz, NextVarbinds)) of + {error, Idx, Reason} -> + ?LIB:user_err("failed encoding varbind ~w:~n~p", [Idx, Reason]), + ?vtrace("try_get_bulk -> encode error: " + "~n Idx: ~p" + "~n Reason: ~p", [Idx, Reason]), + {genErr, Idx}; + {SizeLeft, Res} when is_integer(SizeLeft) andalso + is_list(Res) -> + ?vt("try get bulk -> encode ok: " + "~n SizeLeft: ~w" + "~n Res: ~w", [SizeLeft, Res]), + {check_end_of_mibview(NextVarbinds), + NextVarbinds, SizeLeft, Res}; + Res when is_list(Res) -> + ?vt("try get bulk -> Res: " + "~n ~w", [Res]), + {endOfMibView, [], 0, Res} + end; + {ErrorStatus, Index, _} -> + ?vt("try_get_bulk -> error: " + "~n ErrorStatus: ~p" + "~n Index: ~p", [ErrorStatus, Index]), + {ErrorStatus, Index} + end. + +%% If all variables in this pass are endOfMibView, +%% there is no reason to continue. +check_end_of_mibview([#varbind{value = endOfMibView} | T]) -> + check_end_of_mibview(T); +check_end_of_mibview([]) -> endOfMibView; +check_end_of_mibview(_) -> noError. + + + diff --git a/lib/snmp/src/agent/snmpa_get_lib.erl b/lib/snmp/src/agent/snmpa_get_lib.erl new file mode 100644 index 0000000000..eaf7fe2641 --- /dev/null +++ b/lib/snmp/src/agent/snmpa_get_lib.erl @@ -0,0 +1,254 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Note that most of these functions *assume* that they are executed +%% by the agent. If they are not they may note work as they require +%% some properties to be set in the process dictionary! +%% + +-module(snmpa_get_lib). + +-export([ + split_vbs/1, split_vbs/3, + split_vbs_view/2, + split_vbs_gb/2, + + agent_sort_vbs/1, + oid_sort_vbs/1, org_index_sort_vbs/1, + + sa_split/1, + + delete_prefixes/2, + + dbg_apply/3, + + user_err/2 + ]). + +-define(VMODULE,"GET-LIB"). +-include("snmpa_internal.hrl"). +-include("snmp_types.hrl"). +-include("snmp_debug.hrl"). +-include("snmp_verbosity.hrl"). + + + + +%%----------------------------------------------------------------- +%% split_vbs/1,3 +%% +%% Splits the list of varbinds (basically) into two lists. One +%% of 'end of'-varbinds (mib view and tables) and then the rest +%% of the varbinds. +%%----------------------------------------------------------------- + +-spec split_vbs(VBs :: [snmp:varbind()]) -> + {ResVBs :: [snmp:varbind()], + EndOfVBs :: [snmp:varbind()]}. + +split_vbs(VBs) -> + split_vbs(VBs, [], []). + +-spec split_vbs(VBs :: [snmp:varbind()], + Res :: [snmp:varbind()], + EndOfs :: [snmp:varbind()]) -> + {ResVBs :: [snmp:varbind()], + EndOfVBs :: [snmp:varbind()]}. + +split_vbs([], ResVBs, EndOfVBs) -> + {ResVBs, EndOfVBs}; +split_vbs([VB | VBs], Res, EndOfs) -> + case VB#varbind.value of + {endOfMibView, _} -> split_vbs(VBs, Res, [VB | EndOfs]); + {endOfTable, _} -> split_vbs(VBs, Res, [VB | EndOfs]); + _ -> split_vbs(VBs, [VB | Res], EndOfs) + end. + + + +%%----------------------------------------------------------------- +%% split_vbs_view/2 +%% +%% Splits a list of varbinds into two lists based on the provided +%% MibView. One list of varbinds inside the MibView and one of +%% varbinds outside the MibView. +%%----------------------------------------------------------------- + +-spec split_vbs_view(VBs :: [snmp:varbind()], + MibView :: snmp_view_based_acm_mib:mibview()) -> + {OutSideView :: [snmp:varbind()], + InSideView :: [snmp:varbind()]}. + +split_vbs_view(VBs, MibView) -> + ?vtrace("split the varbinds view", []), + split_vbs_view(VBs, MibView, [], []). + +split_vbs_view([], _MibView, Out, In) -> + {Out, In}; +split_vbs_view([VB | VBs], MibView, Out, In) -> + case snmpa_acm:validate_mib_view(VB#varbind.oid, MibView) of + true -> + split_vbs_view(VBs, MibView, Out, [VB | In]); + false -> + VB2 = VB#varbind{value = noSuchObject}, + split_vbs_view(VBs, MibView, [VB2 | Out], In) + end. + + + +%%----------------------------------------------------------------- +%% split_vbs_gb/2 +%% +%% Performs a get-bulk split of the varbinds +%%----------------------------------------------------------------- + +-spec split_vbs_gb(NonRepeaters :: integer(), + VBs :: [snmp:varbind()]) -> + {NonRepVBs :: [snmp:varbind()], + RestVBs :: [snmp:varbind()]}. + +split_vbs_gb(N, VBs) -> + split_vbs_gb(N, VBs, []). + +split_vbs_gb(N, Varbinds, Res) when N =< 0 -> + {Res, Varbinds}; +split_vbs_gb(N, [H | T], Res) -> + split_vbs_gb(N-1, T, [H | Res]); +split_vbs_gb(_N, [], Res) -> + {Res, []}. + + + +%%----------------------------------------------------------------- +%% agent_sort_vbs/1 +%% +%% Sorts the varbinds into two categories. The first is varbinds +%% belonging to "our" agent and the other is varbinds for +%% subagents. +%%----------------------------------------------------------------- + +-spec agent_sort_vbs(VBs :: [snmp:varbind()]) -> + {AgentVBs :: [snmp:varbind()], + SubAgentVBs :: [snmp:varbind()]}. + +agent_sort_vbs(VBs) -> + snmpa_svbl:sort_varbindlist(get(mibserver), VBs). + + +%%----------------------------------------------------------------- +%% oid_sort_vbs/1 +%% +%% Sorts the varbinds based on their oid. +%%----------------------------------------------------------------- + +-spec oid_sort_vbs(VBs :: [snmp:varbind()]) -> SortedVBs :: [snmp:varbind()]. + +oid_sort_vbs(VBs) -> + lists:keysort(#varbind.oid, VBs). + + +%%----------------------------------------------------------------- +%% org_index_sort_vbs/1 +%% +%% Sorts the varbinds based on their org_index. +%%----------------------------------------------------------------- + +-spec org_index_sort_vbs(VBs :: [snmp:varbind()]) -> SortedVBs :: [snmp:varbind()]. + +org_index_sort_vbs(Vbs) -> + lists:keysort(#varbind.org_index, Vbs). + + + +%%----------------------------------------------------------------- +%% sa_split/1 +%% +%% Splits a list of {oid(), varbind()} into two lists of oid() +%% and varbind. The resulting lists are reversed! +%%----------------------------------------------------------------- + +-spec sa_split(SAVBs :: [{SAOid :: snmp:oid(), snmp:varbind()}]) -> + {Oids :: [snmp:oid()], VBs :: [snmp:varbind()]}. + +sa_split(SAVBs) -> + snmpa_svbl:sa_split(SAVBs). + + + +%%----------------------------------------------------------------- +%% delete_prefixes/2 +%% +%% Takes an Oid prefix and a list of ivarbinds and produces a list +%% of {ShortOid, ASN1Type}. The ShortOid is basically the oid with +%% the OidPrefix removed. +%%----------------------------------------------------------------- + +-spec delete_prefixes(OidPrefix :: snmp:oid(), + VBs :: [snmp:ivarbind()]) -> + [{ShortOid :: snmp:oid(), + ASN1Type :: snmp:asn1_type()}]. + +delete_prefixes(OidPrefix, IVBs) -> + [{snmp_misc:diff(Oid, OidPrefix), ME#me.asn1_type} || + #ivarbind{varbind = #varbind{oid = Oid}, mibentry = ME} <- IVBs]. + + + +%%----------------------------------------------------------------- +%% dbg_apply/3 +%% +%% Call instrumentation functions, but allow for debug printing +%% of useful debug info. +%%----------------------------------------------------------------- + +-spec dbg_apply(M :: atom(), F :: atom(), A :: list()) -> + any(). + +dbg_apply(M, F, A) -> + case get(verbosity) of + silence -> + apply(M,F,A); + _ -> + ?vlog("~n apply: ~w, ~w, ~p~n", [M,F,A]), + Res = (catch apply(M,F,A)), + case Res of + {'EXIT', Reason} -> + ?vinfo("Call to: " + "~n Module: ~p" + "~n Function: ~p" + "~n Args: ~p" + "~n" + "~nresulted in an exit" + "~n" + "~n ~p~n", [M, F, A, Reason]); + _ -> + ?vlog("~n returned: ~p~n", [Res]) + end, + Res + end. + + +%% --------------------------------------------------------------------- + +user_err(F, A) -> + snmpa_error:user_err(F, A). + + diff --git a/lib/snmp/src/agent/snmpa_get_mechanism.erl b/lib/snmp/src/agent/snmpa_get_mechanism.erl new file mode 100644 index 0000000000..744a6529e1 --- /dev/null +++ b/lib/snmp/src/agent/snmpa_get_mechanism.erl @@ -0,0 +1,79 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(snmpa_get_mechanism). + +%% +%% This module defines the behaviour for the undocumented (hidden) +%% get-mechanism feature. This allows for implementing your own +%% handling of get, get-next and get-bulk requests. +%% Probably only useful for special cases (e.g. optimization). +%% + + + +%% ----------- do_get/2,3 ----------------------------------------------------- + +%% Purpose: Handles all VBs in a request that is inside the +%% mibview (local). + +-callback do_get(UnsortedVBs :: [snmp:varbind()], + IsNotification :: boolean(), + Extra :: term()) -> + {noError, 0, ResVBs :: [snmp:varbind()]} | + {ErrStatus :: snmp:error_status(), ErrIndex :: snmp:error_index(), []}. + + +%% Purpose: Handles "get-requests". + +-callback do_get(MibView :: snmp_view_based_acm_mib:mibview(), + UnsortedVBs :: [snmp:varbind()], + IsNotification :: boolean(), + Extra :: term()) -> + {noError, 0, ResVBs :: [snmp:varbind()]} | + {ErrStatus :: snmp:error_status(), ErrIndex :: snmp:error_index(), []}. + + + + +%% ----------- do_get_next/2 ------------------------------------------------ + +%% Purpose: Handles "get-next-requests". + +-callback do_get_next(MibView :: snmp_view_based_acm_mib:mibview(), + UnsortedVBs :: [snmp:varbind()], + Extra :: term()) -> + {noError, 0, ResVBs :: [snmp:varbind()]} | + {ErrStatus :: snmp:error_status(), ErrIndex :: snmp:error_index(), []}. + + + + +%% ----------- do_get_bulk/6 ------------------------------------------------ + +-callback do_get_bulk(MibView :: snmp_view_based_acm_mib:mibview(), + NonRepeaters :: non_neg_integer(), + MaxRepetitions :: non_neg_integer(), + PduMS :: pos_integer(), + VBs :: [snmp:varbind()], + MaxVBs :: pos_integer(), + Extra :: term()) -> + {noError, 0, ResVBs :: [snmp:varbind()]} | + {ErrStatus :: snmp:error_status(), ErrIndex :: snmp:error_index(), []}. diff --git a/lib/snmp/src/agent/snmpa_local_db.erl b/lib/snmp/src/agent/snmpa_local_db.erl index eb67b9cd6f..f481641242 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-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -147,12 +147,13 @@ init([Prio, DbDir, DbInitError, Opts]) -> do_init(Prio, DbDir, DbInitError, Opts) -> process_flag(priority, Prio), process_flag(trap_exit, true), - put(sname,ldb), - put(verbosity,get_opt(verbosity, Opts, ?default_verbosity)), + put(sname, get_opt(sname, Opts, ldb)), + put(verbosity, get_opt(verbosity, Opts, ?default_verbosity)), ?vlog("starting",[]), Dets = dets_open(DbDir, DbInitError, Opts), Ets = ets:new(?ETS_TAB, [set, protected]), ?vdebug("started",[]), + put(started, snmp_misc:formated_timestamp()), {ok, #state{dets = Dets, ets = Ets}}. dets_open(DbDir, DbInitError, Opts) -> @@ -625,7 +626,7 @@ handle_info(Info, State) -> terminate(Reason, State) -> - ?vlog("terminate: ~p",[Reason]), + ?vlog("terminate: ~p", [Reason]), close(State). diff --git a/lib/snmp/src/agent/snmpa_set_lib.erl b/lib/snmp/src/agent/snmpa_set_lib.erl index 97b8ddf7c4..94120f4c7d 100644 --- a/lib/snmp/src/agent/snmpa_set_lib.erl +++ b/lib/snmp/src/agent/snmpa_set_lib.erl @@ -390,7 +390,7 @@ dbg_apply(M,F,A) -> {'EXIT', {function_clause, [{M, F, A} | _]}} -> {'EXIT', {hook_function_clause, {M, F, A}}}; - % XYZ: Older format for compatibility + %% XYZ: Older format for compatibility {'EXIT', {undef, {M, F, A}}} -> {'EXIT', {hook_undef, {M, F, A}}}; {'EXIT', {function_clause, {M, F, A}}} -> diff --git a/lib/snmp/src/agent/snmpa_supervisor.erl b/lib/snmp/src/agent/snmpa_supervisor.erl index cdb5ca840d..2cb0556001 100644 --- a/lib/snmp/src/agent/snmpa_supervisor.erl +++ b/lib/snmp/src/agent/snmpa_supervisor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -193,36 +193,36 @@ init([AgentType, Opts]) -> ?vdebug("agent restart type: ~w", [Restart]), %% -- Agent type -- - ets:insert(snmp_agent_table, {agent_type, AgentType}), + store(agent_type, AgentType), %% -- Prio -- Prio = get_opt(priority, Opts, normal), ?vdebug("[agent table] store priority: ~p",[Prio]), - ets:insert(snmp_agent_table, {priority, Prio}), + store(priority, Prio), %% -- Versions -- Vsns = get_opt(versions, Opts, [v1,v2,v3]), ?vdebug("[agent table] store versions: ~p",[Vsns]), - ets:insert(snmp_agent_table, {versions, Vsns}), + store(versions, Vsns), %% -- Max number of VBs in a Get-BULK response -- GbMaxVBs = get_gb_max_vbs(Opts), ?vdebug("[agent table] Get-BULK max VBs: ~p", [GbMaxVBs]), - ets:insert(snmp_agent_table, {gb_max_vbs, GbMaxVBs}), + store(gb_max_vbs, GbMaxVBs), %% -- DB-directory -- DbDir = get_opt(db_dir, Opts), ?vdebug("[agent table] store db_dir: ~n ~p",[DbDir]), - ets:insert(snmp_agent_table, {db_dir, filename:join([DbDir])}), + store(db_dir, filename:join([DbDir])), DbInitError = get_opt(db_init_error, Opts, terminate), ?vdebug("[agent table] store db_init_error: ~n ~p",[DbInitError]), - ets:insert(snmp_agent_table, {db_init_error, DbInitError}), + store(db_init_error, DbInitError), %% -- Error report module -- ErrorReportMod = get_opt(error_report_mod, Opts, snmpa_error_logger), ?vdebug("[agent table] store error report module: ~w",[ErrorReportMod]), - ets:insert(snmp_agent_table, {error_report_mod, ErrorReportMod}), + store(error_report_mod, ErrorReportMod), %% -- mib storage -- %% MibStorage has only one mandatory part: module @@ -320,31 +320,31 @@ init([AgentType, Opts]) -> end, ?vdebug("[agent table] store mib storage: ~w", [MibStorage]), - ets:insert(snmp_agent_table, {mib_storage, MibStorage}), + store(mib_storage, MibStorage), %% -- Agent mib storage -- AgentMibStorage = get_opt(agent_mib_storage, Opts, persistent), %% ?vdebug("[agent table] store agent mib storage: ~w",[AgentMibStorage]), - ets:insert(snmp_agent_table, {agent_mib_storage, AgentMibStorage}), + store(agent_mib_storage, AgentMibStorage), %% -- System start time -- ?vdebug("[agent table] store system start time",[]), - ets:insert(snmp_agent_table, {system_start_time, snmp_misc:now(cs)}), + store(system_start_time, snmp_misc:now(cs)), %% -- Symbolic store options -- SsOpts = get_opt(symbolic_store, Opts, []), ?vdebug("[agent table] store symbolic store options: ~w",[SsOpts]), - ets:insert(snmp_agent_table, {symbolic_store, SsOpts}), + store(symbolic_store, SsOpts), %% -- Local DB options -- LdbOpts = get_opt(local_db, Opts, []), ?vdebug("[agent table] store local db options: ~w",[LdbOpts]), - ets:insert(snmp_agent_table, {local_db, LdbOpts}), + store(local_db, LdbOpts), %% -- Target cache options -- TargetCacheOpts = get_opt(target_cache, Opts, []), ?vdebug("[agent table] store target cache options: ~w",[TargetCacheOpts]), - ets:insert(snmp_agent_table, {target_cache, TargetCacheOpts}), + store(target_cache, TargetCacheOpts), %% -- Specs -- SupFlags = {one_for_all, 0, 3600}, @@ -377,7 +377,7 @@ init([AgentType, Opts]) -> %% -- Config -- ConfOpts = get_opt(config, Opts, []), ?vdebug("[agent table] store config options: ~p", [ConfOpts]), - ets:insert(snmp_agent_table, {config, ConfOpts}), + store(config, ConfOpts), ConfigArgs = [Vsns, ConfOpts], ConfigSpec = @@ -390,43 +390,46 @@ init([AgentType, Opts]) -> %% -- Discovery processing -- DiscoOpts = get_opt(discovery, Opts, []), ?vdebug("[agent table] store discovery options: ~p", [DiscoOpts]), - ets:insert(snmp_agent_table, {discovery, DiscoOpts}), + store(discovery, DiscoOpts), %% -- Mibs -- Mibs = get_mibs(get_opt(mibs, Opts, []), Vsns), ?vdebug("[agent table] store mibs: ~n ~p",[Mibs]), - ets:insert(snmp_agent_table, {mibs, Mibs}), + store(mibs, Mibs), Ref = make_ref(), + %% -- Get module -- + GetModule = get_opt(get_mechanism, Opts, snmpa_get), + ?vdebug("[agent table] store get-module: ~p", [GetModule]), + store(get_mechanism, GetModule), + %% -- Set module -- SetModule = get_opt(set_mechanism, Opts, snmpa_set), ?vdebug("[agent table] store set-module: ~p",[SetModule]), - ets:insert(snmp_agent_table, {set_mechanism, ConfOpts}), + store(set_mechanism, SetModule), %% -- Authentication service -- AuthModule = get_opt(authentication_service, Opts, snmpa_acm), ?vdebug("[agent table] store authentication service: ~w", [AuthModule]), - ets:insert(snmp_agent_table, - {authentication_service, AuthModule}), + store(authentication_service, AuthModule), %% -- Multi-threaded -- MultiT = get_opt(multi_threaded, Opts, false), - ?vdebug("[agent table] store multi-threaded: ~p",[MultiT]), - ets:insert(snmp_agent_table, {multi_threaded, MultiT}), + ?vdebug("[agent table] store multi-threaded: ~p", [MultiT]), + store(multi_threaded, MultiT), %% -- Audit trail log -- case get_opt(audit_trail_log, Opts, not_found) of not_found -> - ?vdebug("[agent table] no audit trail log",[]), + ?vdebug("[agent table] no audit trail log", []), ok; AtlOpts -> ?vdebug("[agent table] " "store audit trail log options: ~p", [AtlOpts]), - ets:insert(snmp_agent_table, - {audit_trail_log, AtlOpts}), + store(audit_trail_log, AtlOpts), ok end, @@ -434,24 +437,25 @@ init([AgentType, Opts]) -> MibsOpts = get_opt(mib_server, Opts, []), ?vdebug("[agent table] store mib-server options: " "~n ~p", [MibsOpts]), - ets:insert(snmp_agent_table, {mib_server, MibsOpts}), + store(mib_server, MibsOpts), %% -- Network interface -- NiOpts = get_opt(net_if, Opts, []), ?vdebug("[agent table] store net-if options: " "~n ~p", [NiOpts]), - ets:insert(snmp_agent_table, {net_if, NiOpts}), + store(net_if, NiOpts), %% -- Note store -- NsOpts = get_opt(note_store, Opts, []), ?vdebug("[agent table] store note-store options: " "~n ~p",[NsOpts]), - ets:insert(snmp_agent_table, {note_store, NsOpts}), + store(note_store, NsOpts), AgentOpts = [{verbosity, AgentVerb}, {mibs, Mibs}, {mib_storage, MibStorage}, + {get_mechanism, GetModule}, {set_mechanism, SetModule}, {authentication_service, AuthModule}, {multi_threaded, MultiT}, @@ -480,6 +484,10 @@ init([AgentType, Opts]) -> {ok, {SupFlags, [MiscSupSpec, SymStoreSpec, LocalDbSpec, TargetCacheSpec | Rest]}}. + +store(Key, Value) -> + ets:insert(snmp_agent_table, {Key, Value}). + get_mibs(Mibs, Vsns) -> MibDir = filename:join(code:priv_dir(snmp), "mibs"), StdMib = diff --git a/lib/snmp/src/agent/snmpa_trap.erl b/lib/snmp/src/agent/snmpa_trap.erl index 293d1f3ccf..d04b6a206e 100644 --- a/lib/snmp/src/agent/snmpa_trap.erl +++ b/lib/snmp/src/agent/snmpa_trap.erl @@ -917,7 +917,7 @@ do_send_v2_trap(Recvs, Vbs, ExtraInfo, NetIf) -> TrapPdu = make_v2_notif_pdu(Vbs, 'snmpv2-trap'), AddrCommunities = mk_addr_communities(Recvs), lists:foreach(fun({Community, Addrs}) -> - ?vtrace("~n send v2 trap to ~p",[Addrs]), + ?vtrace("send v2 trap to ~p",[Addrs]), NetIf ! {send_pdu, 'version-2', TrapPdu, {community, Community}, Addrs, ExtraInfo} end, AddrCommunities), diff --git a/lib/snmp/src/app/snmp.app.src b/lib/snmp/src/app/snmp.app.src index d4bf0de61a..178309b488 100644 --- a/lib/snmp/src/app/snmp.app.src +++ b/lib/snmp/src/app/snmp.app.src @@ -49,6 +49,9 @@ snmpa_error_io, snmpa_error_logger, snmpa_error_report, + snmpa_get, + snmpa_get_lib, + snmpa_get_mechanism, snmpa_local_db, snmpa_mib, snmpa_mib_data, diff --git a/lib/snmp/src/app/snmp.config b/lib/snmp/src/app/snmp.config index b66ef5d7df..f35a636157 100644 --- a/lib/snmp/src/app/snmp.config +++ b/lib/snmp/src/app/snmp.config @@ -8,6 +8,7 @@ %% {agent_verbosity, verbosity()} | %% {versions, versions()} | %% {priority, atom()} | +%% {get_mechanism, module()} | %% {set_mechanism, module()} | %% {authentication_service, module()} | %% {multi_threaded, bool()} | diff --git a/lib/snmp/src/app/snmp.erl b/lib/snmp/src/app/snmp.erl index 8a736f688b..216452afdd 100644 --- a/lib/snmp/src/app/snmp.erl +++ b/lib/snmp/src/app/snmp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -116,7 +116,10 @@ pdu/0, trappdu/0, mib/0, - mib_name/0, + mib_name/0, + + error_status/0, + error_index/0, void/0 ]). @@ -208,6 +211,23 @@ -type pdu() :: #pdu{}. -type trappdu() :: #trappdu{}. +%% We should really specify all of these, but they are so numerous... +%% See the validate_err/1 function in the snmpa_agent. +%% Here are a number of them: +%% badValue | +%% commitFailed | +%% genErr | +%% inconsistentName | inconsistentValue | +%% noAccess | noCreation | +%% noSuchInstance | noSuchName | noSuchObject | +%% notWritable | +%% resourceUnavailable | +%% undoFailed | +%% wrongValue + +-type error_status() :: atom(). +-type error_index() :: pos_integer(). + -type void() :: term(). diff --git a/lib/snmp/src/misc/snmp_misc.erl b/lib/snmp/src/misc/snmp_misc.erl index 1f847b7a29..39254503ac 100644 --- a/lib/snmp/src/misc/snmp_misc.erl +++ b/lib/snmp/src/misc/snmp_misc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -64,8 +64,18 @@ strip_extension_from_filename/2, str_xor/2, time/3, - - verify_behaviour/2 + + verify_behaviour/2, + + %% These are used both for debugging (verbosity printouts) + %% and other such "utility" operations. + format_timestamp/1, format_timestamp/2, + format_short_timestamp/1, format_short_timestamp/2, + format_long_timestamp/1, format_long_timestamp/2, + formated_timestamp/0, + formated_short_timestamp/0, + formated_long_timestamp/0 + ]). @@ -112,6 +122,102 @@ now(sec) -> erlang:monotonic_time(seconds). + +%% --------------------------------------------------------------------------- +%% # formated_timstamp/0, formated_timstamp/1 +%% # format_short_timstamp/0, format_short_timstamp/1 +%% # format_long_timstamp/0, format_long_timstamp/1 +%% +%% Create a formatted timestamp. Short means that it will not include +%% the date in the formatted timestamp. Also it will only include millis. +%% --------------------------------------------------------------------------- + +formated_timestamp() -> + formated_long_timestamp(). + +formated_short_timestamp() -> + format_short_timestamp(os:timestamp()). + +formated_long_timestamp() -> + format_long_timestamp(os:timestamp()). + + +%% --------------------------------------------------------------------------- +%% # format_timstamp/1, format_timstamp/2 +%% # format_short_timstamp/1, format_short_timstamp/2 +%% # format_long_timstamp/1, format_long_timstamp/2 +%% +%% Formats the provided timestamp. Short means that it will not include +%% the date in the formatted timestamp. +%% --------------------------------------------------------------------------- + +-spec format_timestamp(Now :: erlang:timestamp()) -> + string(). + +format_timestamp(Now) -> + format_long_timestamp(Now). + +-spec format_short_timestamp(Now :: erlang:timestamp()) -> + string(). + +format_short_timestamp(Now) -> + N2T = fun(N) -> calendar:now_to_local_time(N) end, + format_timestamp(short, Now, N2T). + +-spec format_long_timestamp(Now :: erlang:timestamp()) -> + string(). + +format_long_timestamp(Now) -> + N2T = fun(N) -> calendar:now_to_local_time(N) end, + format_timestamp(long, Now, N2T). + +-spec format_timestamp(Now :: erlang:timestamp(), + N2T :: function()) -> + string(). + +format_timestamp(Now, N2T) when is_tuple(Now) andalso is_function(N2T) -> + format_long_timestamp(Now, N2T). + +-spec format_short_timestamp(Now :: erlang:timestamp(), + N2T :: function()) -> + string(). + +format_short_timestamp(Now, N2T) when is_tuple(Now) andalso is_function(N2T) -> + format_timestamp(short, Now, N2T). + +-spec format_long_timestamp(Now :: erlang:timestamp(), + N2T :: function()) -> + string(). + +format_long_timestamp(Now, N2T) when is_tuple(Now) andalso is_function(N2T) -> + format_timestamp(long, Now, N2T). + +format_timestamp(Format, {_N1, _N2, N3} = Now, N2T) -> + {Date, Time} = N2T(Now), + do_format_timestamp(Format, Date, Time, N3). + +do_format_timestamp(short, _Date, Time, N3) -> + do_format_short_timestamp(Time, N3); +do_format_timestamp(long, Date, Time, N3) -> + do_format_long_timestamp(Date, Time, N3). + +do_format_long_timestamp(Date, Time, N3) -> + {YYYY,MM,DD} = Date, + {Hour,Min,Sec} = Time, + FormatDate = + io_lib:format("~.4w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w.~.3.0w", + [YYYY, MM, DD, Hour, Min, Sec, N3 div 1000]), + lists:flatten(FormatDate). + +do_format_short_timestamp(Time, N3) -> + {Hour,Min,Sec} = Time, + FormatDate = + io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.3.0w", + [Hour, Min, Sec, N3 div 1000]), + lists:flatten(FormatDate). + + + is_crypto_supported(Alg) -> %% The 'try catch' handles the case when 'crypto' is %% not present in the system (or not started). diff --git a/lib/snmp/src/misc/snmp_verbosity.erl b/lib/snmp/src/misc/snmp_verbosity.erl index edfb52a474..9b2676d048 100644 --- a/lib/snmp/src/misc/snmp_verbosity.erl +++ b/lib/snmp/src/misc/snmp_verbosity.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2015. All Rights Reserved. +%% Copyright Ericsson AB 2000-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -70,16 +70,7 @@ print2(_Verbosity,Format,Arguments) -> timestamp() -> - format_timestamp(os:timestamp()). - -format_timestamp({_N1, _N2, N3} = Now) -> - {Date, Time} = calendar:now_to_datetime(Now), - {YYYY,MM,DD} = Date, - {Hour,Min,Sec} = Time, - FormatDate = - io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w ~w", - [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), - lists:flatten(FormatDate). + snmp_misc:formated_timestamp(). process_args([], Acc) -> lists:reverse(Acc); @@ -155,7 +146,8 @@ image_of_sname(mgr) -> "MGR"; image_of_sname(mgr_misc) -> "MGR_MISC"; image_of_sname(undefined) -> ""; -image_of_sname(V) -> lists:flatten(io_lib:format("~p",[V])). +image_of_sname(N) when is_list(N) -> N; % Used in testing +image_of_sname(N) -> lists:flatten(io_lib:format("~p", [N])). validate(info) -> info; diff --git a/lib/snmp/test/modules.mk b/lib/snmp/test/modules.mk index 0f54e67c65..8b6547f9a9 100644 --- a/lib/snmp/test/modules.mk +++ b/lib/snmp/test/modules.mk @@ -31,6 +31,7 @@ SUITE_MODULES = \ snmp_agent_mibs_test \ snmp_agent_nfilter_test \ snmp_agent_test \ + snmp_agent_test_get \ snmp_agent_conf_test \ snmp_agent_test_lib \ snmp_manager_config_test \ diff --git a/lib/snmp/test/snmp_agent_test.erl b/lib/snmp/test/snmp_agent_test.erl index f9c18af6ea..71e3fa3b9a 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-2018. All Rights Reserved. +%% Copyright Ericsson AB 2003-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1116,15 +1116,15 @@ init_ms(Config, Opts) when is_list(Config) -> Opts1 = [MasterAgentVerbosity, MibsVerbosity, SymStoreVerbosity | Opts], [{vsn, v1} | start_v1_agent(Config, Opts1)]. -init_size_check_mse(Config) when is_list(Config) -> - MibStorage = {mib_storage, [{module, snmpa_mib_storage_ets}]}, - init_size_check_ms(Config, [MibStorage]). +%% init_size_check_mse(Config) when is_list(Config) -> +%% MibStorage = {mib_storage, [{module, snmpa_mib_storage_ets}]}, +%% init_size_check_ms(Config, [MibStorage]). -init_size_check_msd(Config) when is_list(Config) -> - AgentDbDir = ?GCONF(agent_db_dir, Config), - MibStorage = {mib_storage, [{module, snmpa_mib_storage_dets}, - {options, [{dir, AgentDbDir}]}]}, - init_size_check_ms(Config, [MibStorage]). +%% init_size_check_msd(Config) when is_list(Config) -> +%% AgentDbDir = ?GCONF(agent_db_dir, Config), +%% MibStorage = {mib_storage, [{module, snmpa_mib_storage_dets}, +%% {options, [{dir, AgentDbDir}]}]}, +%% init_size_check_ms(Config, [MibStorage]). init_size_check_msm(Config) when is_list(Config) -> ?line AgentNode = ?GCONF(snmp_master, Config), @@ -5146,12 +5146,21 @@ snmp_framework_mib_3(Config) when is_list(Config) -> %% Req. SNMP-FRAMEWORK-MIB snmp_framework_mib_test() -> ?line ["agentEngine"] = get_req(1, [[snmpEngineID,0]]), + T1 = snmp_misc:now(ms), ?line [EngineTime] = get_req(2, [[snmpEngineTime,0]]), + T2 = snmp_misc:now(ms), ?SLEEP(5000), + T3 = snmp_misc:now(ms), ?line [EngineTime2] = get_req(3, [[snmpEngineTime,0]]), - ?DBG("snmp_framework_mib -> time(s): " - "~n EngineTime 1 = ~p" - "~n EngineTime 2 = ~p", [EngineTime, EngineTime2]), + T4 = snmp_misc:now(ms), + ?PRINT2("snmp_framework_mib -> time(s): " + "~n EngineTime 1: ~p" + "~n Time to acquire: ~w ms" + "~n EngineTime 2: ~p" + "~n Time to acquire: ~w ms" + "~n => (5 sec sleep between get(snmpEngineTime))" + "~n Total time to acquire: ~w ms", + [EngineTime, T2-T1, EngineTime2, T4-T3, T4-T1]), if (EngineTime+7) < EngineTime2 -> ?line ?FAIL({too_large_diff, EngineTime, EngineTime2}); @@ -5160,11 +5169,18 @@ snmp_framework_mib_test() -> true -> ok end, + T5 = snmp_misc:now(ms), ?line case get_req(4, [[snmpEngineBoots,0]]) of [Boots] when is_integer(Boots) -> + T6 = snmp_misc:now(ms), + ?PRINT2("snmp_framework_mib -> " + "~n boots: ~p" + "~n Time to acquire: ~w ms", [Boots, T6-T5]), ok; Else -> - ?FAIL(Else) + ?PRINT2("snmp_framework_mib -> failed get proper boots:" + "~n ~p", [Else]), + ?FAIL({invalid_boots, Else}) end, ok. diff --git a/lib/snmp/test/snmp_agent_test_get.erl b/lib/snmp/test/snmp_agent_test_get.erl new file mode 100644 index 0000000000..517c71507a --- /dev/null +++ b/lib/snmp/test/snmp_agent_test_get.erl @@ -0,0 +1,58 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(snmp_agent_test_get). + +-behaviour(snmpa_get_mechanism). + + +%%%----------------------------------------------------------------- +%%% snmpa_get_mechanism exports +%%%----------------------------------------------------------------- + +-export([ + do_get/3, do_get/4, + do_get_next/3, + do_get_bulk/7 + ]). + + + +do_get(UnsortedVarbinds, IsNotification, Extra) -> + snmpa_get:do_get(UnsortedVarbinds, IsNotification, Extra). + + + +do_get(MibView, UnsortedVarbinds, IsNotification, Extra) -> + snmpa_get:do_get(MibView, UnsortedVarbinds, IsNotification, Extra). + + + +do_get_next(MibView, UnsortedVBs, Extra) -> + snmpa_get:do_get_next(MibView, UnsortedVBs, Extra). + + + + +do_get_bulk(MibView, NonRepeaters, MaxRepetitions, + PduMS, Varbinds, GbMaxVBs, Extra) -> + snmpa_get:do_get_bulk(MibView, NonRepeaters, MaxRepetitions, + PduMS, Varbinds, GbMaxVBs, + Extra). diff --git a/lib/snmp/test/snmp_agent_test_lib.erl b/lib/snmp/test/snmp_agent_test_lib.erl index 66211d7105..6defdadb5a 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-2016. All Rights Reserved. +%% Copyright Ericsson AB 2005-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -358,22 +358,22 @@ run(Mod, Func, Args, Opts) -> "~n StdM: ~p", [M,Vsn,Dir,User,SecLevel,EngineID,CtxEngineID,Community,StdM]), case snmp_test_mgr:start([%% {agent, snmp_test_lib:hostname()}, - {packet_server_debug,true}, - {debug,true}, - {agent, get(master_host)}, - {ipfamily, get(ipfamily)}, - {agent_udp, 4000}, - {trap_udp, 5000}, - {recbuf,65535}, + {packet_server_debug, true}, + {debug, true}, + {agent, get(master_host)}, + {ipfamily, get(ipfamily)}, + {agent_udp, 4000}, + {trap_udp, 5000}, + {recbuf, 65535}, quiet, Vsn, - {community, Community}, - {user, User}, - {sec_level, SecLevel}, - {engine_id, EngineID}, - {context_engine_id, CtxEngineID}, - {dir, Dir}, - {mibs, mibs(StdM, M)}]) of + {community, Community}, + {user, User}, + {sec_level, SecLevel}, + {engine_id, EngineID}, + {context_engine_id, CtxEngineID}, + {dir, Dir}, + {mibs, mibs(StdM, M)}]) of {ok, _Pid} -> case (catch apply(Mod, Func, Args)) of {'EXIT', Reason} -> @@ -383,10 +383,18 @@ run(Mod, Func, Args, Opts) -> catch snmp_test_mgr:stop(), Res end; + + {error, Reason} -> + ?EPRINT2("Failed starting (test) manager: " + "~n ~p", [Reason]), + catch snmp_test_mgr:stop(), + ?line ?FAIL({mgr_start_error, Reason}); + Err -> - io:format("Error starting manager: ~p\n", [Err]), + ?EPRINT2("Failed starting (test) manager: " + "~n ~p", [Err]), catch snmp_test_mgr:stop(), - ?line ?FAIL({mgr_start, Err}) + ?line ?FAIL({mgr_start_failure, Err}) end. @@ -445,6 +453,7 @@ start_agent(Config, Vsns, Opts) -> [{versions, Vsns}, {agent_type, master}, {agent_verbosity, trace}, + {get_mechanism, snmp_agent_test_get}, {db_dir, AgentDbDir}, {audit_trail_log, [{type, read_write}, {dir, AgentLogDir}, @@ -463,20 +472,24 @@ start_agent(Config, Vsns, Opts) -> process_flag(trap_exit,true), + ?PRINT2("start_agent -> try start snmp app supervisor", []), {ok, AppSup} = snmp_app_sup:start_link(), unlink(AppSup), ?DBG("start_agent -> snmp app supervisor: ~p", [AppSup]), - ?DBG("start_agent -> start master agent",[]), + ?PRINT2("start_agent -> try start master agent",[]), ?line Sup = start_sup(Env), - - ?DBG("start_agent -> unlink from supervisor", []), ?line unlink(Sup), + ?DBG("start_agent -> snmp supervisor: ~p", [Sup]), + + ?PRINT2("start_agent -> try (rpc) start sub agent on ~p", [SaNode]), ?line SaDir = ?config(sa_dir, Config), - ?DBG("start_agent -> (rpc) start sub on ~p", [SaNode]), ?line {ok, Sub} = start_sub_sup(SaNode, SaDir), - ?DBG("start_agent -> done",[]), - ?line [{snmp_sup, {Sup, self()}}, {snmp_sub, Sub} | Config]. + ?DBG("start_agent -> done", []), + + ?line [{snmp_app_sup, AppSup}, + {snmp_sup, {Sup, self()}}, + {snmp_sub, Sub} | Config]. app_agent_env_init(Env0, Opts) -> @@ -669,35 +682,52 @@ merge_agent_options([{Key, _Value} = Opt|Opts], Options) -> stop_agent(Config) when is_list(Config) -> - ?LOG("stop_agent -> entry with" - "~n Config: ~p",[Config]), - - {Sup, Par} = ?config(snmp_sup, Config), - ?DBG("stop_agent -> attempt to stop (sup) ~p" - "~n Sup: ~p" - "~n Par: ~p", - [Sup, - (catch process_info(Sup)), - (catch process_info(Par))]), - - _Info = agent_info(Sup), - ?DBG("stop_agent -> Agent info: " - "~n ~p", [_Info]), - - stop_sup(Sup, Par), - - {Sup2, Par2} = ?config(snmp_sub, Config), - ?DBG("stop_agent -> attempt to stop (sub) ~p" - "~n Sup2: ~p" - "~n Par2: ~p", - [Sup2, - (catch process_info(Sup2)), - (catch process_info(Par2))]), - stop_sup(Sup2, Par2), - - ?DBG("stop_agent -> done - now cleanup config", []), - C1 = lists:keydelete(snmp_sup, 1, Config), - lists:keydelete(snmp_sub, 1, C1). + ?PRINT2("stop_agent -> entry with" + "~n Config: ~p",[Config]), + + + %% Stop the sub-agent (the agent supervisor) + {SubSup, SubPar} = ?config(snmp_sub, Config), + ?PRINT2("stop_agent -> attempt to stop sub agent (~p)" + "~n Sub Sup info: " + "~n ~p" + "~n Sub Par info: " + "~n ~p", + [SubSup, + (catch process_info(SubSup)), + (catch process_info(SubPar))]), + stop_sup(SubSup, SubPar), + Config2 = lists:keydelete(snmp_sub, 1, Config), + + + %% Stop the master-agent (the top agent supervisor) + {MasterSup, MasterPar} = ?config(snmp_sup, Config), + ?PRINT2("stop_agent -> attempt to stop master agent (~p)" + "~n Master Sup: " + "~n ~p" + "~n Master Par: " + "~n ~p" + "~n Agent Info: " + "~n ~p", + [MasterSup, + (catch process_info(MasterSup)), + (catch process_info(MasterPar)), + agent_info(MasterSup)]), + stop_sup(MasterSup, MasterPar), + Config3 = lists:keydelete(snmp_sup, 1, Config2), + + + %% Stop the top supervisor (of the snmp app) + AppSup = ?config(snmp_app_sup, Config), + ?PRINT2("stop_agent -> attempt to app sup ~p" + "~n App Sup: ~p", + [AppSup, + (catch process_info(AppSup))]), + Config4 = lists:keydelete(snmp_app_sup, 1, Config3), + + + ?PRINT2("stop_agent -> done", []), + Config4. start_sup(Env) -> @@ -727,7 +757,6 @@ stop_sup(Pid, _) -> ?LOG("stop_sup -> attempt to stop ~p", [Pid]), Ref = erlang:monitor(process, Pid), ?LOG("stop_sup -> Ref: ~p", [Ref]), - %% Pid ! {'EXIT', Parent, shutdown}, % usch exit(Pid, kill), await_stopped(Pid, Ref). @@ -863,13 +892,15 @@ expect(Mod, Line, Type, Enterp, Generic, Specific, ExpVBs) -> expect2(Mod, Line, Fun). expect2(Mod, Line, F) -> - io:format("EXPECT for ~w:~w~n", [Mod, Line]), + io_format_expect("for ~w:~w", [Mod, Line]), case F() of {error, Reason} -> - io:format("EXPECT failed at ~w:~w => ~n~p~n", [Mod, Line, Reason]), + io_format_expect("failed at ~w:~w => " + "~n ~p", [Mod, Line, Reason]), throw({error, {expect, Mod, Line, Reason}}); Else -> - io:format("EXPECT result for ~w:~w => ~n~p~n", [Mod, Line, Else]), + io_format_expect("result for ~w:~w => " + "~n ~p", [Mod, Line, Else]), Else end. @@ -898,20 +929,27 @@ receive_trap(To) -> end. +io_format_expect(F) -> + io_format_expect(F, []). + +io_format_expect(F, A) -> + ?PRINT2("EXPECT " ++ F, A). + + do_expect(Expect) when is_atom(Expect) -> do_expect({Expect, get_timeout()}); do_expect({any_pdu, To}) when is_integer(To) orelse (To =:= infinity) -> - io:format("EXPECT any PDU~n", []), + io_format_expect("any PDU"), receive_pdu(To); do_expect({any_trap, To}) -> - io:format("EXPECT any TRAP within ~w~n", [To]), + io_format_expect("any TRAP within ~w", [To]), receive_trap(To); do_expect({timeout, To}) -> - io:format("EXPECT nothing within ~w~n", [To]), + io_format_expect("nothing within ~w", [To]), receive X -> {error, {unexpected, X}} @@ -923,16 +961,16 @@ do_expect({timeout, To}) -> do_expect({Err, To}) when (is_atom(Err) andalso ((is_integer(To) andalso To > 0) orelse (To =:= infinity))) -> - io:format("EXPECT error ~w within ~w~n", [Err, To]), + io_format_expect("error ~w within ~w", [Err, To]), do_expect({{error, Err}, To}); do_expect({error, Err}) when is_atom(Err) -> Check = fun(_, R) -> R end, - io:format("EXPECT error ~w~n", [Err]), + io_format_expect("error ~w", [Err]), do_expect2(Check, any, Err, any, any, get_timeout()); do_expect({{error, Err}, To}) -> Check = fun(_, R) -> R end, - io:format("EXPECT error ~w within ~w~n", [Err, To]), + io_format_expect("error ~w within ~w", [Err, To]), do_expect2(Check, any, Err, any, any, To); %% exp_varbinds() -> [exp_varbind()] @@ -942,25 +980,23 @@ do_expect({{error, Err}, To}) -> %% ExpVBs -> exp_varbinds() | {VbsCondition, exp_varbinds()} do_expect(ExpVBs) -> Check = fun(_, R) -> R end, - io:format("EXPECT 'get-response'" - "~n with" - "~n Varbinds: ~p~n", [ExpVBs]), + io_format_expect("'get-response'" + "~n with" + "~n Varbinds: ~p", [ExpVBs]), do_expect2(Check, 'get-response', noError, 0, ExpVBs, get_timeout()). do_expect(v2trap, ExpVBs) -> Check = fun(_, R) -> R end, - io:format("EXPECT 'snmpv2-trap'" - "~n with" - "~n Varbinds: ~p~n", [ExpVBs]), + io_format_expect("'snmpv2-trap' with" + "~n Varbinds: ~p", [ExpVBs]), do_expect2(Check, 'snmpv2-trap', noError, 0, ExpVBs, get_timeout()); do_expect(report, ExpVBs) -> Check = fun(_, R) -> R end, - io:format("EXPECT 'report'" - "~n with" - "~n Varbinds: ~p~n", [ExpVBs]), + io_format_expect("'report' with" + "~n Varbinds: ~p", [ExpVBs]), do_expect2(Check, 'report', noError, 0, ExpVBs, get_timeout()); @@ -969,9 +1005,8 @@ do_expect(inform, ExpVBs) -> do_expect({inform, false}, ExpVBs) -> Check = fun(_, R) -> R end, - io:format("EXPECT 'inform-request' (false)" - "~n with" - "~n Varbinds: ~p~n", [ExpVBs]), + io_format_expect("'inform-request' (false) with" + "~n Varbinds: ~p", [ExpVBs]), do_expect2(Check, 'inform-request', noError, 0, ExpVBs, get_timeout()); do_expect({inform, true}, ExpVBs) -> @@ -985,9 +1020,8 @@ do_expect({inform, true}, ExpVBs) -> (_, Err) -> Err end, - io:format("EXPECT 'inform-request' (true)" - "~n with" - "~n Varbinds: ~p~n", [ExpVBs]), + io_format_expect("'inform-request' (true) with" + "~n Varbinds: ~p", [ExpVBs]), do_expect2(Check, 'inform-request', noError, 0, ExpVBs, get_timeout()); do_expect({inform, {error, EStat, EIdx}}, ExpVBs) @@ -1002,11 +1036,10 @@ do_expect({inform, {error, EStat, EIdx}}, ExpVBs) (_, Err) -> Err end, - io:format("EXPECT 'inform-request' (error)" - "~n with" - "~n Error Status: ~p" - "~n Error Index: ~p" - "~n Varbinds: ~p~n", [EStat, EIdx, ExpVBs]), + io_format_expect("'inform-request' (error) with" + "~n Error Status: ~p" + "~n Error Index: ~p" + "~n Varbinds: ~p", [EStat, EIdx, ExpVBs]), do_expect2(Check, 'inform-request', noError, 0, ExpVBs, get_timeout()). @@ -1017,26 +1050,23 @@ do_expect(Err, Idx, ExpVBs, To) when is_atom(Err) andalso (is_integer(Idx) orelse is_list(Idx) orelse (Idx == any)) -> Check = fun(_, R) -> R end, - io:format("EXPECT 'get-response'" - "~n with" - "~n Error: ~p" - "~n Index: ~p" - "~n Varbinds: ~p" - "~n within ~w~n", [Err, Idx, ExpVBs, To]), + io_format_expect("'get-response' withing ~w ms with" + "~n Error: ~p" + "~n Index: ~p" + "~n Varbinds: ~p", [To, Err, Idx, ExpVBs]), do_expect2(Check, 'get-response', Err, Idx, ExpVBs, To). do_expect(Type, Enterp, Generic, Specific, ExpVBs) -> - do_expect(Type, Enterp, Generic, Specific, ExpVBs, 3500). + do_expect(Type, Enterp, Generic, Specific, ExpVBs, get_timeout()). do_expect(trap, Enterp, Generic, Specific, ExpVBs, To) -> - io:format("EXPECT trap" - "~n with" - "~n Enterp: ~w" - "~n Generic: ~w" - "~n Specific: ~w" - "~n Varbinds: ~w" - "~n within ~w~n", [Enterp, Generic, Specific, ExpVBs, To]), + io_format_expect("trap within ~w ms with" + "~n Enterp: ~w" + "~n Generic: ~w" + "~n Specific: ~w" + "~n Varbinds: ~w", + [To, Enterp, Generic, Specific, ExpVBs]), PureE = purify_oid(Enterp), case receive_trap(To) of #trappdu{enterprise = PureE, @@ -1071,46 +1101,46 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) #pdu{type = Type, error_status = Err, error_index = Idx} when ExpVBs =:= any -> - io:format("EXPECT received expected pdu (1)~n", []), + io_format_expect("received expected pdu (1)"), ok; #pdu{type = Type, request_id = ReqId, error_status = Err2, error_index = Idx} when ExpVBs =:= any -> - io:format("EXPECT received expected pdu with " - "unexpected error status (2): " - "~n Error Status: ~p~n", [Err2]), + io_format_expect("received expected pdu with " + "unexpected error status (2): " + "~n Error Status: ~p", [Err2]), {error, {unexpected_error_status, Err, Err2, ReqId}}; #pdu{error_status = Err} when (Type =:= any) andalso (Idx =:= any) andalso (ExpVBs =:= any) -> - io:format("EXPECT received expected pdu (3)~n", []), + io_format_expect("received expected pdu (3)"), ok; #pdu{request_id = ReqId, error_status = Err2} when (Type =:= any) andalso (Idx =:= any) andalso (ExpVBs =:= any) -> - io:format("EXPECT received expected pdu with " - "unexpected error status (4): " - "~n Error Status: ~p~n", [Err2]), + io_format_expect("received expected pdu with " + "unexpected error status (4): " + "~n Error Status: ~p", [Err2]), {error, {unexpected_error_status, Err, Err2, ReqId}}; #pdu{type = Type, error_status = Err} when (Idx =:= any) andalso (ExpVBs =:= any) -> - io:format("EXPECT received expected pdu (5)~n", []), + io_format_expect("received expected pdu (5)", []), ok; #pdu{type = Type, request_id = ReqId, error_status = Err2} when (Idx =:= any) andalso (ExpVBs =:= any) -> - io:format("EXPECT received expected pdu with " - "unexpected error status (6): " - "~n Error Status: ~p~n", [Err2]), + io_format_expect("received expected pdu with " + "unexpected error status (6): " + "~n Error Status: ~p", [Err2]), {error, {unexpected_error_status, Err, Err2, ReqId}}; #pdu{type = Type, @@ -1119,13 +1149,13 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) error_index = EI} when is_list(Idx) andalso (ExpVBs =:= any) -> case lists:member(EI, Idx) of true -> - io:format("EXPECT received expected pdu with " - "expected error index (7)~n", []), + io_format_expect("received expected pdu with " + "expected error index (7)"), ok; false -> - io:format("EXPECT received expected pdu with " - "unexpected error index (8): " - "~n Error Index: ~p~n", [EI]), + io_format_expect("received expected pdu with " + "unexpected error index (8): " + "~n Error Index: ~p", [EI]), {error, {unexpected_error_index, EI, Idx, ReqId}} end; @@ -1135,15 +1165,15 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) error_index = EI} when is_list(Idx) andalso (ExpVBs =:= any) -> case lists:member(EI, Idx) of true -> - io:format("EXPECT received expected pdu with " - "unexpected error status (9): " - "~n Error Status: ~p~n", [Err2]), + io_format_expect("received expected pdu with " + "unexpected error status (9): " + "~n Error Status: ~p", [Err2]), {error, {unexpected_error_status, Err, Err2, ReqId}}; false -> - io:format("EXPECT received expected pdu with " - "unexpected error (10): " - "~n Error Status: ~p" - "~n Error index: ~p~n", [Err2, EI]), + io_format_expect("received expected pdu with " + "unexpected error (10): " + "~n Error Status: ~p" + "~n Error index: ~p", [Err2, EI]), {error, {unexpected_error, {Err, Idx}, {Err2, EI}, ReqId}} end; @@ -1151,12 +1181,12 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) request_id = ReqId, error_status = Err2, error_index = Idx2} when ExpVBs =:= any -> - io:format("EXPECT received unexpected pdu with (11) " - "~n Type: ~p" - "~n ReqId: ~p" - "~n Errot status: ~p" - "~n Error index: ~p" - "~n", [Type2, ReqId, Err2, Idx2]), + io_format_expect("received unexpected pdu with (11) " + "~n Type: ~p" + "~n ReqId: ~p" + "~n Errot status: ~p" + "~n Error index: ~p", + [Type2, ReqId, Err2, Idx2]), {error, {unexpected_pdu, {Type, Err, Idx}, {Type2, Err2, Idx2}, ReqId}}; @@ -1165,26 +1195,26 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) error_status = Err, error_index = Idx, varbinds = VBs} = PDU -> - io:format("EXPECT received pdu (12): " - "~n [exp] Type: ~p" - "~n [exp] Error Status: ~p" - "~n [exp] Error Index: ~p" - "~n VBs: ~p" - "~nwhen" - "~n ExpVBs: ~p" - "~n", [Type, Err, Idx, VBs, ExpVBs]), + io_format_expect("received pdu (12): " + "~n [exp] Type: ~p" + "~n [exp] Error Status: ~p" + "~n [exp] Error Index: ~p" + "~n VBs: ~p" + "~nwhen" + "~n ExpVBs: ~p", + [Type, Err, Idx, VBs, ExpVBs]), Check(PDU, check_vbs(purify_oids(ExpVBs), VBs)); #pdu{type = Type, error_status = Err, varbinds = VBs} = PDU when Idx =:= any -> - io:format("EXPECT received pdu (13): " - "~n [exp] Type: ~p" - "~n [exp] Error Status: ~p" - "~n VBs: ~p" - "~nwhen" - "~n ExpVBs: ~p" - "~n", [Type, Err, VBs, ExpVBs]), + io_format_expect("received pdu (13): " + "~n [exp] Type: ~p" + "~n [exp] Error Status: ~p" + "~n VBs: ~p" + "~nwhen" + "~n ExpVBs: ~p", + [Type, Err, VBs, ExpVBs]), Check(PDU, check_vbs(purify_oids(ExpVBs), VBs)); #pdu{type = Type, @@ -1192,15 +1222,15 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) error_status = Err, error_index = EI, varbinds = VBs} = PDU when is_list(Idx) -> - io:format("EXPECT received pdu (14): " - "~n [exp] Type: ~p" - "~n ReqId: ~p" - "~n [exp] Error Status: ~p" - "~n [exp] Error Index: ~p" - "~n VBs: ~p" - "~nwhen" - "~n ExpVBs: ~p" - "~n", [Type, ReqId, Err, EI, VBs, ExpVBs]), + io_format_expect("received pdu (14): " + "~n [exp] Type: ~p" + "~n ReqId: ~p" + "~n [exp] Error Status: ~p" + "~n [exp] Error Index: ~p" + "~n VBs: ~p" + "~nwhen" + "~n ExpVBs: ~p", + [Type, ReqId, Err, EI, VBs, ExpVBs]), PureVBs = purify_oids(ExpVBs), case lists:member(EI, Idx) of true -> @@ -1214,13 +1244,13 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) error_status = Err2, error_index = Idx2, varbinds = VBs2} -> - io:format("EXPECT received unexpected pdu with (15) " - "~n Type: ~p" - "~n ReqId: ~p" - "~n Errot status: ~p" - "~n Error index: ~p" - "~n Varbinds: ~p" - "~n", [Type2, ReqId, Err2, Idx2, VBs2]), + io_format_expect("received unexpected pdu with (15) " + "~n Type: ~p" + "~n ReqId: ~p" + "~n Errot status: ~p" + "~n Error index: ~p" + "~n Varbinds: ~p", + [Type2, ReqId, Err2, Idx2, VBs2]), {error, {unexpected_pdu, {Type, Err, Idx, purify_oids(ExpVBs)}, @@ -1228,9 +1258,8 @@ do_expect2(Check, Type, Err, Idx, ExpVBs, To) ReqId}}; Error -> - io:format("EXPECT received error (16): " - "~n Error: ~p" - "~n", [Error]), + io_format_expect("received error (16): " + "~n Error: ~p", [Error]), Error end. diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl index 2e48d5134d..a28f925a22 100644 --- a/lib/snmp/test/snmp_compiler_test.erl +++ b/lib/snmp/test/snmp_compiler_test.erl @@ -226,10 +226,8 @@ agent_capabilities(Config) when is_list(Config) -> put(tname,agent_capabilities), p("starting with Config: ~p~n", [Config]), - SnmpPrivDir = code:priv_dir(snmp), + SnmpPrivDir = which_priv_dir(snmp), SnmpMibsDir = join(SnmpPrivDir, "mibs"), - OtpMibsPrivDir = code:priv_dir(otp_mibs), - OtpMibsMibsDir = join(OtpMibsPrivDir, "mibs"), Dir = ?config(mib_dir, Config), AcMib = join(Dir,"AC-TEST-MIB.mib"), ?line {ok, MibFile1} = snmpc:compile(AcMib, [options, @@ -269,22 +267,20 @@ module_compliance(Config) when is_list(Config) -> put(tname,module_compliance), p("starting with Config: ~p~n", [Config]), - SnmpPrivDir = code:priv_dir(snmp), - SnmpMibsDir = join(SnmpPrivDir, "mibs"), - OtpMibsPrivDir = code:priv_dir(otp_mibs), - OtpMibsMibsDir = join(OtpMibsPrivDir, "mibs"), - Dir = ?config(mib_dir, Config), - AcMib = join(Dir,"MC-TEST-MIB.mib"), + SnmpPrivDir = which_priv_dir(snmp), + SnmpMibsDir = join(SnmpPrivDir, "mibs"), + Dir = ?config(mib_dir, Config), + AcMib = join(Dir,"MC-TEST-MIB.mib"), ?line {ok, MibFile1} = snmpc:compile(AcMib, [options, version, - {i, [SnmpMibsDir, OtpMibsMibsDir]}, + {i, [SnmpMibsDir]}, {outdir, Dir}, {verbosity, trace}]), ?line {ok, Mib1} = snmp_misc:read_mib(MibFile1), ?line {ok, MibFile2} = snmpc:compile(AcMib, [options, version, module_compliance, - {i, [SnmpMibsDir, OtpMibsMibsDir]}, + {i, [SnmpMibsDir]}, {outdir, Dir}, {verbosity, trace}]), ?line {ok, Mib2} = snmp_misc:read_mib(MibFile2), @@ -731,6 +727,15 @@ check_desc(Desc1, Desc2) -> exit({'description not equal', Desc1, Desc2}). +which_priv_dir(App) -> + case code:priv_dir(App) of + Dir when is_list(Dir) -> + Dir; + {error, Reason} -> + exit({App, priv_dir_not_found, Reason}) + end. + + %% join(Comp) -> %% filename:join(Comp). diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl index 6ced55f0cc..5b0ebf8647 100644 --- a/lib/snmp/test/snmp_manager_test.erl +++ b/lib/snmp/test/snmp_manager_test.erl @@ -204,10 +204,15 @@ init_per_testcase(Case, Config) when is_list(Config) -> Result = case lists:member(Case, DeprecatedApiCases) of true -> - %% ?SKIP(api_no_longer_supported); {skip, api_no_longer_supported}; false -> - init_per_testcase2(Case, Config) + try init_per_testcase2(Case, Config) + catch + C:{skip, _} = E:_ when ((C =:= throw) orelse (C =:= exit)) -> + E; + C:E:_ when ((C =:= throw) orelse (C =:= exit)) -> + {skip, {catched, C, E}} + end end, p(Case, "init_per_testcase end when" "~n Nodes: ~p" @@ -326,9 +331,25 @@ init_per_testcase3(Case, Config) -> true -> Config end, + %% We don't need to try catch this (init_agent) + %% since we have a try catch "higher up"... Conf2 = init_agent(Conf1), - Conf3 = init_manager(AutoInform, Conf2), - Conf4 = init_mgr_user(Conf3), + Conf3 = try init_manager(AutoInform, Conf2) + catch AC:AE:_ -> + %% Ouch we need to clean up: + %% The init_agent starts an agent node! + init_per_testcase_fail_agent_cleanup(Conf2), + throw({skip, {manager_init_failed, AC, AE}}) + end, + Conf4 = try init_mgr_user(Conf3) + catch MC:ME:_ -> + %% Ouch we need to clean up: + %% The init_agent starts an agent node! + %% The init_magager starts an manager node! + init_per_testcase_fail_manager_cleanup(Conf3), + init_per_testcase_fail_agent_cleanup(Conf3), + throw({skip, {manager_user_init_failed, MC, ME}}) + end, case lists:member(Case, ApiCases02 ++ ApiCases03) of true -> init_mgr_user_data2(Conf4); @@ -339,6 +360,12 @@ init_per_testcase3(Case, Config) -> Config end. +init_per_testcase_fail_manager_cleanup(Conf) -> + (catch fin_manager(Conf)). + +init_per_testcase_fail_agent_cleanup(Conf) -> + (catch fin_agent(Conf)). + end_per_testcase(Case, Config) when is_list(Config) -> p(Case, "end_per_testcase begin when" "~n Nodes: ~p~n~n", [erlang:nodes()]), @@ -993,18 +1020,40 @@ notify_started02(Config) when is_list(Config) -> {config, [{verbosity, log}, {dir, ConfDir}, {db_dir, DbDir}]}], p("start snmpm client process"), - Pid1 = ns02_loop1_start(), + NumIterations = 5, + Pid1 = ns02_client_start(NumIterations), + + p("start snmpm ctrl (starter) process"), + Pid2 = ns02_ctrl_start(Opts, NumIterations), + + %% On a reasonably fast machine, one iteration takes approx 4 seconds. + %% We measure the first iteration, and then we wait for the remaining + %% ones (4 in this case). + ApproxStartTime = + case ns02_client_await_approx_runtime(Pid1) of + {ok, T} -> + T; + {error, Reason} -> + %% Attempt cleanup just in case + exit(Pid1, kill), + exit(Pid2, kill), + ?FAIL(Reason); + {skip, Reason} -> + %% Attempt cleanup just in case + exit(Pid1, kill), + exit(Pid2, kill), + ?SKIP(Reason) + end, - p("start snmpm starter process"), - Pid2 = ns02_loop2_start(Opts), - - p("await snmpm client process exit"), + p("await snmpm client process exit (max ~p+10000 msec)", [ApproxStartTime]), receive {'EXIT', Pid1, normal} -> ok; {'EXIT', Pid1, Reason1} -> - ?FAIL(Reason1) - after 25000 -> + ?FAIL({client, Reason1}) + after ApproxStartTime + 10000 -> + exit(Pid1, kill), + exit(Pid2, kill), ?FAIL(timeout) end, @@ -1013,8 +1062,9 @@ notify_started02(Config) when is_list(Config) -> {'EXIT', Pid2, normal} -> ok; {'EXIT', Pid2, Reason2} -> - ?FAIL(Reason2) + ?FAIL({ctrl, Reason2}) after 5000 -> + exit(Pid2, kill), ?FAIL(timeout) end, @@ -1022,26 +1072,63 @@ notify_started02(Config) when is_list(Config) -> ok. -ns02_loop1_start() -> - spawn_link(fun() -> ns02_loop1() end). +ns02_client_start(N) -> + Self = self(), + spawn_link(fun() -> ns02_client(Self, N) end). + +ns02_client_await_approx_runtime(Pid) -> + receive + {?MODULE, client_time, Time} -> + {ok, Time}; + {'EXIT', Pid, Reason} -> + p("client (~p) failed: " + "~n ~p", [Pid, Reason]), + {error, Reason} + + after 15000 -> + %% Either something is *really* wrong or this machine + %% is dog slow. Either way, this is a skip-reason... + {skip, approx_runtime_timeout} + end. + -ns02_loop1() -> - put(tname,ns02_loop1), +ns02_client(Parent, N) when is_pid(Parent) -> + put(tname, ns02_client), p("starting"), - ns02_loop1(dummy, snmpm:notify_started(?NS_TIMEOUT), 5). + ns02_client_loop(Parent, + dummy, snmpm:notify_started(?NS_TIMEOUT), + snmp_misc:now(ms), undefined, + N). -ns02_loop1(_Ref, _Pid, 0) -> - p("done"), +ns02_client_loop(_Parent, _Ref, _Pid, _Begin, _End, 0) -> + %% p("loop -> done"), exit(normal); -ns02_loop1(Ref, Pid, N) -> - p("entry when" - "~n Ref: ~p" - "~n Pid: ~p" - "~n N: ~p", [Ref, Pid, N]), +ns02_client_loop(Parent, Ref, Pid, Begin, End, N) + when is_pid(Parent) andalso is_integer(Begin) andalso is_integer(End) -> + %% p("loop -> [~w] inform parent: ~w, ~w => ~w", [N, Begin, End, End-Begin]), + Parent ! {?MODULE, client_time, N*(End-Begin)}, + ns02_client_loop(undefined, Ref, Pid, snmp_misc:now(ms), undefined, N); +ns02_client_loop(Parent, Ref, Pid, Begin, End, N) + when is_integer(Begin) andalso is_integer(End) -> + %% p("loop -> [~w] entry when" + %% "~n Ref: ~p" + %% "~n Pid: ~p" + %% "~n Begin: ~p" + %% "~n End: ~p", [N, Ref, Pid, Begin, End]), + ns02_client_loop(Parent, Ref, Pid, snmp_misc:now(ms), undefined, N); +ns02_client_loop(Parent, Ref, Pid, Begin, End, N) -> + %% p("loop(await message) -> [~w] entry when" + %% "~n Ref: ~p" + %% "~n Pid: ~p" + %% "~n Begin: ~p" + %% "~n End: ~p", [N, Ref, Pid, Begin, End]), receive {snmpm_started, Pid} -> p("received expected started message (~w)", [N]), - ns02_loop1(snmpm:monitor(), dummy, N); + ns02_client_loop(Parent, + snmpm:monitor(), dummy, + Begin, End, + N); {snmpm_start_timeout, Pid} -> p("unexpected timout"), ?FAIL({unexpected_start_timeout, Pid}); @@ -1049,24 +1136,24 @@ ns02_loop1(Ref, Pid, N) -> p("received expected DOWN message (~w) with" "~n Obj: ~p" "~n Reason: ~p", [N, Obj, Reason]), - ns02_loop1(dummy, snmpm:notify_started(?NS_TIMEOUT), N-1) - after 10000 -> - ?FAIL(timeout) + ns02_client_loop(Parent, + dummy, snmpm:notify_started(?NS_TIMEOUT), + Begin, snmp_misc:now(ms), + N-1) end. - -ns02_loop2_start(Opts) -> - spawn_link(fun() -> ns02_loop2(Opts) end). +ns02_ctrl_start(Opts, N) -> + spawn_link(fun() -> ns02_ctrl(Opts, N) end). -ns02_loop2(Opts) -> - put(tname,ns02_loop2), +ns02_ctrl(Opts, N) -> + put(tname, ns02_ctrl), p("starting"), - ns02_loop2(Opts, 5). + ns02_ctrl_loop(Opts, N). -ns02_loop2(_Opts, 0) -> +ns02_ctrl_loop(_Opts, 0) -> p("done"), exit(normal); -ns02_loop2(Opts, N) -> +ns02_ctrl_loop(Opts, N) -> p("entry when N: ~p", [N]), ?SLEEP(2000), p("start manager"), @@ -1074,7 +1161,7 @@ ns02_loop2(Opts, N) -> ?SLEEP(2000), p("stop manager"), snmpm:stop(), - ns02_loop2(Opts, N-1). + ns02_ctrl_loop(Opts, N-1). %%====================================================================== @@ -5416,15 +5503,14 @@ init_manager(AutoInform, Config) -> start_manager(Node, Vsns, Conf) end catch - T:E -> - StackTrace = ?STACK(), + C:E:S -> p("Failure during manager start: " - "~n Error Type: ~p" - "~n Error: ~p" - "~n StackTrace: ~p", [T, E, StackTrace]), + "~n Error Class: ~p" + "~n Error: ~p" + "~n StackTrace: ~p", [C, E, S]), %% And now, *try* to cleanup (catch stop_node(Node)), - ?FAIL({failed_starting_manager, T, E, StackTrace}) + ?FAIL({failed_starting_manager, C, E, S}) end. fin_manager(Config) -> @@ -5432,7 +5518,7 @@ fin_manager(Config) -> StopMgrRes = stop_manager(Node), StopCryptoRes = fin_crypto(Node), StopNode = stop_node(Node), - p("fin_agent -> stop apps and (mgr node ~p) node results: " + p("fin_manager -> stop apps and (mgr node ~p) node results: " "~n SNMP Mgr: ~p" "~n Crypto: ~p" "~n Node: ~p", @@ -5498,15 +5584,14 @@ init_agent(Config) -> start_agent(Node, Vsns, Conf) end catch - T:E -> - StackTrace = ?STACK(), + C:E:S -> p("Failure during agent start: " - "~n Error Type: ~p" - "~n Error: ~p" - "~n StackTrace: ~p", [T, E, StackTrace]), + "~n Error Class: ~p" + "~n Error: ~p" + "~n StackTrace: ~p", [C, E, S]), %% And now, *try* to cleanup (catch stop_node(Node)), - ?FAIL({failed_starting_agent, T, E, StackTrace}) + ?FAIL({failed_starting_agent, C, E, S}) end. @@ -6179,7 +6264,12 @@ start_agent(Node, Vsns, Conf0, _Opts) -> {mib_server, [{verbosity, MSV}]}, {note_store, [{verbosity, NSV}]}, {stymbolic_store, [{verbosity, SSV}]}, - {net_if, [{verbosity, NIV}]}, + {net_if, [{verbosity, NIV}, + %% On some linux "they" add a 127.0.1.1 or somthing + %% similar, so if we don't specify bind_to + %% we don't know which address will be selected + %% (which will cause problems for some test cases). + {options, [{bind_to, true}]}]}, {multi_threaded, true}], ?line ok = set_agent_env(Node, Env), diff --git a/lib/snmp/test/snmp_test_lib.erl b/lib/snmp/test/snmp_test_lib.erl index 290f1bc31a..a483690653 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-2015. All Rights Reserved. +%% Copyright Ericsson AB 2002-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -41,7 +41,7 @@ -export([watchdog/3, watchdog_start/1, watchdog_start/2, watchdog_stop/1]). -export([del_dir/1]). -export([cover/1]). --export([p/2, print/5, formated_timestamp/0]). +-export([p/2, print1/2, print2/2, print/5, formated_timestamp/0]). %% ---------------------------------------------------------------------- @@ -58,12 +58,67 @@ from(H, [H | T]) -> T; from(H, [_ | T]) -> from(H, T); from(_H, []) -> []. +%% localhost() -> +%% {ok, Ip} = snmp_misc:ip(net_adm:localhost()), +%% Ip. +%% localhost(Family) -> +%% {ok, Ip} = snmp_misc:ip(net_adm:localhost(), Family), +%% Ip. + localhost() -> - {ok, Ip} = snmp_misc:ip(net_adm:localhost()), - Ip. + localhost(inet). + localhost(Family) -> - {ok, Ip} = snmp_misc:ip(net_adm:localhost(), Family), - Ip. + case inet:getaddr(net_adm:localhost(), Family) of + {ok, {127, _, _, _}} when (Family =:= inet) -> + %% Ouch, we need to use something else + case inet:getifaddrs() of + {ok, IfList} -> + which_addr(Family, IfList); + {error, Reason1} -> + fail({getifaddrs, Reason1}, ?MODULE, ?LINE) + end; + {ok, {0, _, _, _, _, _, _, _}} when (Family =:= inet6) -> + %% Ouch, we need to use something else + case inet:getifaddrs() of + {ok, IfList} -> + which_addr(Family, IfList); + {error, Reason1} -> + fail({getifaddrs, Reason1}, ?MODULE, ?LINE) + end; + {ok, Addr} -> + Addr; + {error, Reason2} -> + fail({getaddr, Reason2}, ?MODULE, ?LINE) + end. + +which_addr(_Family, []) -> + fail(no_valid_addr, ?MODULE, ?LINE); +which_addr(Family, [{"lo", _} | IfList]) -> + which_addr(Family, IfList); +which_addr(Family, [{"docker" ++ _, _} | IfList]) -> + which_addr(Family, IfList); +which_addr(Family, [{"br-" ++ _, _} | IfList]) -> + which_addr(Family, IfList); +which_addr(Family, [{_Name, IfOpts} | IfList]) -> + case which_addr2(Family, IfOpts) of + {ok, Addr} -> + Addr; + {error, _} -> + which_addr(Family, IfList) + end. + +which_addr2(_Family, []) -> + {error, not_found}; +which_addr2(Family, [{addr, Addr}|_]) + when (Family =:= inet) andalso (size(Addr) =:= 4) -> + {ok, Addr}; +which_addr2(Family, [{addr, Addr}|_]) + when (Family =:= inet6) andalso (size(Addr) =:= 8) -> + {ok, Addr}; +which_addr2(Family, [_|IfOpts]) -> + which_addr2(Family, IfOpts). + sz(L) when is_list(L) -> length(L); @@ -605,19 +660,30 @@ p(Mod, Case) when is_atom(Mod) andalso is_atom(Case) -> p(F, A) when is_list(F) andalso is_list(A) -> io:format(user, F ++ "~n", A). +%% This is just a bog standard printout, with a (formatted) timestamp +%% prefix and a newline after. +%% print1 - prints to both standard_io and user. +%% print2 - prints to just standard_io. + +print_format(F, A) -> + FTS = snmp_test_lib:formated_timestamp(), + io_lib:format("[~s] " ++ F ++ "~n", [FTS | A]). + +print1(F, A) -> + S = print_format(F, A), + io:format("~s", [S]), + io:format(user, "~s", [S]). + +print2(F, A) -> + S = print_format(F, A), + io:format("~s", [S]). + + print(Prefix, Module, Line, Format, Args) -> io:format("*** [~s] ~s ~p ~p ~p:~p *** " ++ Format ++ "~n", [formated_timestamp(), Prefix, node(), self(), Module, Line|Args]). formated_timestamp() -> - format_timestamp(os:timestamp()). - -format_timestamp({_N1, _N2, N3} = Now) -> - {Date, Time} = calendar:now_to_datetime(Now), - {YYYY,MM,DD} = Date, - {Hour,Min,Sec} = Time, - FormatDate = - io_lib:format("~.4w:~.2.0w:~.2.0w ~.2.0w:~.2.0w:~.2.0w ~w", - [YYYY,MM,DD,Hour,Min,Sec,round(N3/1000)]), - lists:flatten(FormatDate). + snmp_misc:formated_timestamp(). + diff --git a/lib/snmp/test/snmp_test_lib.hrl b/lib/snmp/test/snmp_test_lib.hrl index 7acebee1f1..335f3fff3c 100644 --- a/lib/snmp/test/snmp_test_lib.hrl +++ b/lib/snmp/test/snmp_test_lib.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2015. All Rights Reserved. +%% Copyright Ericsson AB 2002-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -127,24 +127,31 @@ -endif. -ifdef(snmp_debug). --define(DBG(F,A),?PRINT("DBG",F,A)). +-define(DBG(F,A), ?PRINT("DBG", F, A)). -else. --define(DBG(F,A),ok). +-define(DBG(F,A), ok). -endif. -ifdef(snmp_log). --define(LOG(F,A),?PRINT("LOG",F,A)). +-define(LOG(F,A), ?PRINT("LOG", F, A)). -else. --define(LOG(F,A),ok). +-define(LOG(F,A), ok). -endif. -ifdef(snmp_error). --define(ERR(F,A),?PRINT("ERR",F,A)). +-define(ERR(F,A), ?PRINT("ERR", F, A)). -else. --define(ERR(F,A),ok). +-define(ERR(F,A), ok). -endif. --define(INF(F,A),?PRINT("INF",F,A)). +-define(INF(F,A), ?PRINT("INF", F, A)). -define(PRINT(P,F,A), - snmp_test_lib:print(P,?MODULE,?LINE,F,A)). + snmp_test_lib:print(P, ?MODULE, ?LINE, F, A)). + +-define(PRINT1(F, A), snmp_test_lib:print1(F, A)). +-define(EPRINT1(F, A), ?PRINT1("<ERROR> " ++ F, A)). + +-define(PRINT2(F, A), snmp_test_lib:print2(F, A)). +-define(EPRINT2(F, A), ?PRINT2("<ERROR> " ++ F, A)). + diff --git a/lib/snmp/test/snmp_test_mgr.erl b/lib/snmp/test/snmp_test_mgr.erl index 36637d5cf4..73a4d56084 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-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -20,8 +20,10 @@ -module(snmp_test_mgr). + %%---------------------------------------------------------------------- -%% This module implements a simple SNMP manager for Erlang. +%% This module implements a simple SNMP manager for Erlang. Its used +%% during by the agent test suite. %%---------------------------------------------------------------------- %% c(snmp_test_mgr). @@ -49,16 +51,17 @@ -include_lib("snmp/include/snmp_types.hrl"). -include_lib("snmp/include/STANDARD-MIB.hrl"). - --record(state,{dbg = true, - quiet, - parent, - timeout = 3500, - print_traps = true, - mini_mib, - packet_server, - last_sent_pdu, - last_received_pdu}). +-include("snmp_test_lib.hrl"). + +-record(state, {dbg = true, + quiet, + parent, + timeout = 3500, + print_traps = true, + mini_mib, + packet_server, + last_sent_pdu, + last_received_pdu}). -define(SERVER, ?MODULE). -define(PACK_SERV, snmp_test_mgr_misc). @@ -197,27 +200,28 @@ init({Options, CallerPid}) -> put(debug, get_value(debug, Options, false)), d("init -> (~p) extract options",[self()]), PacksDbg = get_value(packet_server_debug, Options, false), - io:format("[~w] ~p -> PacksDbg: ~p~n", [?MODULE, self(), PacksDbg]), + print("[~w] ~p -> PacksDbg: ~p~n", [?MODULE, self(), PacksDbg]), RecBufSz = get_value(recbuf, Options, 1024), - io:format("[~w] ~p -> RecBufSz: ~p~n", [?MODULE, self(), RecBufSz]), + print("[~w] ~p -> RecBufSz: ~p~n", [?MODULE, self(), RecBufSz]), Mibs = get_value(mibs, Options, []), - io:format("[~w] ~p -> Mibs: ~p~n", [?MODULE, self(), Mibs]), + print("[~w] ~p -> Mibs: ~p~n", [?MODULE, self(), Mibs]), Udp = get_value(agent_udp, Options, 4000), - io:format("[~w] ~p -> Udp: ~p~n", [?MODULE, self(), Udp]), + print("[~w] ~p -> Udp: ~p~n", [?MODULE, self(), Udp]), User = get_value(user, Options, "initial"), - io:format("[~w] ~p -> User: ~p~n", [?MODULE, self(), User]), + print("[~w] ~p -> User: ~p~n", [?MODULE, self(), User]), EngineId = get_value(engine_id, Options, "agentEngine"), - io:format("[~w] ~p -> EngineId: ~p~n", [?MODULE, self(), EngineId]), + print("[~w] ~p -> EngineId: ~p~n", [?MODULE, self(), EngineId]), CtxEngineId = get_value(context_engine_id, Options, EngineId), - io:format("[~w] ~p -> CtxEngineId: ~p~n", [?MODULE, self(), CtxEngineId]), + print("[~w] ~p -> CtxEngineId: ~p~n", [?MODULE, self(), CtxEngineId]), TrapUdp = get_value(trap_udp, Options, 5000), - io:format("[~w] ~p -> TrapUdp: ~p~n", [?MODULE, self(), TrapUdp]), + print("[~w] ~p -> TrapUdp: ~p~n", [?MODULE, self(), TrapUdp]), Dir = get_value(dir, Options, "."), - io:format("[~w] ~p -> Dir: ~p~n", [?MODULE, self(), Dir]), + print("[~w] ~p -> Dir: ~p~n", [?MODULE, self(), Dir]), SecLevel = get_value(sec_level, Options, noAuthNoPriv), - io:format("[~w] ~p -> SecLevel: ~p~n", [?MODULE, self(), SecLevel]), + print("[~w] ~p -> SecLevel: ~p~n", [?MODULE, self(), SecLevel]), MiniMIB = snmp_mini_mib:create(Mibs), - io:format("[~w] ~p -> MiniMIB: ~p~n", [?MODULE, self(), MiniMIB]), + d("[~w] ~p -> MiniMIB: " + "~n ~p", [?MODULE, self(), MiniMIB]), Version = case lists:member(v2, Options) of true -> 'version-2'; false -> @@ -226,19 +230,19 @@ init({Options, CallerPid}) -> false -> 'version-1' end end, - io:format("[~w] ~p -> Version: ~p~n", [?MODULE, self(), Version]), + print("[~w] ~p -> Version: ~p~n", [?MODULE, self(), Version]), Com = case Version of 'version-3' -> get_value(context, Options, ""); _ -> get_value(community, Options, "public") end, - io:format("[~w] ~p -> Com: ~p~n", [?MODULE, self(), Com]), + print("[~w] ~p -> Com: ~p~n", [?MODULE, self(), Com]), VsnHdrD = {Com, User, EngineId, CtxEngineId, mk_seclevel(SecLevel)}, - io:format("[~w] ~p -> VsnHdrD: ~p~n", [?MODULE, self(), VsnHdrD]), + print("[~w] ~p -> VsnHdrD: ~p~n", [?MODULE, self(), VsnHdrD]), IpFamily = get_value(ipfamily, Options, inet), - io:format("[~w] ~p -> IpFamily: ~p~n", [?MODULE, self(), IpFamily]), + print("[~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) -> @@ -247,9 +251,9 @@ init({Options, CallerPid}) -> {ok, Ip} = snmp_misc:ip(Host, IpFamily), Ip end, - io:format("[~w] ~p -> AgIp: ~p~n", [?MODULE, self(), AgIp]), + print("[~w] ~p -> AgIp: ~p~n", [?MODULE, self(), AgIp]), Quiet = lists:member(quiet, Options), - io:format("[~w] ~p -> Quiet: ~p~n", [?MODULE, self(), Quiet]), + print("[~w] ~p -> Quiet: ~p~n", [?MODULE, self(), Quiet]), PackServ = start_packet_server( Quiet, Options, CallerPid, AgIp, Udp, TrapUdp, @@ -443,7 +447,8 @@ handle_cast({bulk, Args}, State) -> {noreply, execute_request(bulk, Args, State)}; handle_cast({response, RespPdu}, State) -> - d("handle_cast -> response request with ~p", [RespPdu]), + d("handle_cast -> response request with " + "~n ~p", [RespPdu]), ?PACK_SERV:send_pdu(RespPdu, State#state.packet_server), {noreply, State}; @@ -1126,14 +1131,15 @@ sizeOf(L) when is_list(L) -> sizeOf(B) when is_binary(B) -> size(B). -d(F,A) -> d(get(debug),F,A). +d(F, A) -> d(get(debug), F, A). -d(true,F,A) -> - io:format("*** [~s] MGR_DBG *** " ++ F ++ "~n", - [formated_timestamp()|A]); +d(true, F, A) -> + print(F, A); d(_,_F,_A) -> ok. +print(F, A) -> + ?PRINT2("MGR " ++ F, A). formated_timestamp() -> snmp_test_lib:formated_timestamp(). diff --git a/lib/snmp/test/snmp_test_mgr_misc.erl b/lib/snmp/test/snmp_test_mgr_misc.erl index 274fb5be26..315e3ebd9e 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-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -38,11 +38,14 @@ -define(SNMP_USE_V3, true). -include_lib("snmp/include/snmp_types.hrl"). +-include_lib("snmp/src/misc/snmp_verbosity.hrl"). +-include("snmp_test_lib.hrl"). %%---------------------------------------------------------------------- %% 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( @@ -101,11 +104,11 @@ init_packet( DbgOptions, IpFamily) -> put(sname, mgr_misc), init_debug(DbgOptions), - {ok, UdpId} = - gen_udp:open(TrapUdp, [{recbuf,BufSz}, {reuseaddr, true}, IpFamily]), + UdpOpts = [{recbuf,BufSz}, {reuseaddr, true}, IpFamily], + {ok, UdpId} = gen_udp:open(TrapUdp, UdpOpts), put(msg_id, 1), - proc_lib:init_ack(Parent, self()), init_usm(Version, Dir), + proc_lib:init_ack(Parent, self()), packet_loop(SnmpMgr, UdpId, AgentIp, UdpPort, VsnHdr, Version, []). init_debug(Dbg) when is_atom(Dbg) -> @@ -200,86 +203,24 @@ packet_loop(SnmpMgr, UdpId, AgentIp, UdpPort, VsnHdr, Version, MsgData) -> handle_udp_packet(_V, undefined, UdpId, Ip, UdpPort, Bytes, SnmpMgr, AgentIp) -> - M = (catch snmp_pdus:dec_message_only(Bytes)), - MsgData3 = - case M of - Message when Message#message.version =:= 'version-3' -> - d("handle_udp_packet -> version 3"), - case catch handle_v3_msg(Bytes, Message) of - {ok, NewData, MsgData2} -> - Msg = Message#message{data = NewData}, - case SnmpMgr of - {pdu, Pid} -> - Pdu = get_pdu(Msg), - d("packet_loop -> " - "send pdu to manager (~w): ~p", [Pid, Pdu]), - Pid ! {snmp_pdu, Pdu}; - {msg, Pid} -> - d("packet_loop -> " - "send msg to manager (~w): ~p", [Pid, Msg]), - Pid ! {snmp_msg, Msg, Ip, UdpPort} - end, - MsgData2; - {error, Reason, B} -> - udp_send(UdpId, AgentIp, UdpPort, B), - error("Decoding error. Auto-sending Report.\n" - "Reason: ~w " - "(UDPport: ~w, Ip: ~w)", - [Reason, UdpPort, Ip]), - []; - {error, Reason} -> - error("Decoding error. " - "Bytes: ~w ~n Reason: ~w " - "(UDPport: ~w, Ip: ~w)", - [Bytes, Reason, UdpPort, Ip]), - [] - end; - Message when is_record(Message, message) -> - %% v1 or v2c - d("handle_udp_packet -> version v1 or v2c"), - case catch snmp_pdus:dec_pdu(Message#message.data) of - Pdu when is_record(Pdu, pdu) -> - case SnmpMgr of - {pdu, Pid} -> - d("handle_udp_packet -> " - "send pdu to manager (~w): ~p", - [Pid, Pdu]), - Pid ! {snmp_pdu, Pdu}; - {msg, Pid} -> - d("handle_udp_packet -> " - "send pdu-msg to manager (~w): ~p", - [Pid, Pdu]), - Msg = Message#message{data = Pdu}, - Pid ! {snmp_msg, Msg, Ip, UdpPort} - end; - Pdu when is_record(Pdu, trappdu) -> - case SnmpMgr of - {pdu, Pid} -> - d("handle_udp_packet -> " - "send trap to manager (~w): ~p", - [Pid, Pdu]), - Pid ! {snmp_pdu, Pdu}; - {msg, Pid} -> - d("handle_udp_packet -> " - "send trap-msg to manager (~w): ~p", - [Pid, Pdu]), - Msg = Message#message{data = Pdu}, - Pid ! {snmp_msg, Msg, Ip, UdpPort} - end; - Reason -> - error("Decoding error. " - "Bytes: ~w ~n Reason: ~w " - "(UDPport: ~w, Ip: ~w)", - [Bytes, Reason, UdpPort, Ip]) - end, - []; - Reason -> - error("Decoding error. Bytes: ~w ~n Reason: ~w " - "(UDPport: ~w, Ip: ~w)", - [Bytes, Reason, UdpPort, Ip]), - [] - end, - MsgData3; + try snmp_pdus:dec_message_only(Bytes) of + Message when Message#message.version =:= 'version-3' -> + d("handle_udp_packet -> version 3"), + handle_v3_message(SnmpMgr, UdpId, Ip, UdpPort, AgentIp, + Bytes, Message); + + Message when is_record(Message, message) -> + d("handle_udp_packet -> version 1 or 2"), + handle_v1_or_v2_message(SnmpMgr, UdpId, Ip, UdpPort, AgentIp, + Bytes, Message) + + catch + Class:Error:_ -> + error("Decoding error (~w). Bytes: ~w ~n Error: ~w " + "(UDPport: ~w, Ip: ~w)", + [Class, Bytes, Error, UdpPort, Ip]), + [] + end; handle_udp_packet(V, {DiscoReqMsg, From}, _UdpId, _Ip, _UdpPort, Bytes, _, _AgentIp) -> DiscoRspMsg = (catch snmp_pdus:dec_message(Bytes)), @@ -297,6 +238,88 @@ handle_udp_packet(V, {DiscoReqMsg, From}, _UdpId, _Ip, _UdpPort, [] end. +handle_v3_message(Mgr, UdpId, Ip, UdpPort, AgentIp, + Bytes, Message) -> + try handle_v3_msg(Bytes, Message) of + {ok, NewData, MsgData} -> + Msg = Message#message{data = NewData}, + case Mgr of + {pdu, Pid} -> + Pdu = get_pdu(Msg), + d("handle_v3_message -> send pdu to manager (~p): " + "~n ~p", [Pid, Pdu]), + Pid ! {snmp_pdu, Pdu}; + {msg, Pid} -> + d("handle_v3_message -> send msg to manager (~p): " + "~n ~p", [Pid, Msg]), + Pid ! {snmp_msg, Msg, Ip, UdpPort} + end, + MsgData + + catch + throw:{error, Reason, B}:_ -> + udp_send(UdpId, AgentIp, UdpPort, B), + error("Decoding (v3) error. Auto-sending Report.\n" + "~n Reason: ~w " + "(UDPport: ~w, Ip: ~w)", + [Reason, UdpPort, Ip]), + []; + + throw:{error, Reason}:_ -> + error("Decoding (v3) error. " + "~n Bytes: ~w" + "~n Reason: ~w " + "(UDPport: ~w, Ip: ~w)", + [Bytes, Reason, UdpPort, Ip]), + []; + + Class:Error:_ -> + error("Decoding (v3) error (~w). " + "~n Bytes: ~w" + "~n Error: ~w " + "(UDPport: ~w, Ip: ~w)", + [Class, Bytes, Error, UdpPort, Ip]), + [] + + end. + +handle_v1_or_v2_message(Mgr, _UdpId, Ip, UdpPort, _AgentIp, + Bytes, Message) -> + try snmp_pdus:dec_pdu(Message#message.data) of + Pdu when is_record(Pdu, pdu) -> + case Mgr of + {pdu, Pid} -> + d("handle_v1_or_v2_message -> send pdu to manager (~p): " + "~n ~p", [Pid, Pdu]), + Pid ! {snmp_pdu, Pdu}; + {msg, Pid} -> + d("handle_v1_or_v2_message -> send msg to manager (~p): " + "~n ~p", [Pid, Pdu]), + Msg = Message#message{data = Pdu}, + Pid ! {snmp_msg, Msg, Ip, UdpPort} + end; + Pdu when is_record(Pdu, trappdu) -> + case Mgr of + {pdu, Pid} -> + d("handle_v1_or_v2_message -> send trap-pdu to manager (~p): " + "~n ~p", [Pid, Pdu]), + Pid ! {snmp_pdu, Pdu}; + {msg, Pid} -> + d("handle_v1_or_v2_message -> send trap-msg to manager (~p): " + "~n ~p", [Pid, Pdu]), + Msg = Message#message{data = Pdu}, + Pid ! {snmp_msg, Msg, Ip, UdpPort} + end + + catch + Class:Error:_ -> + error("Decoding (v1 or v2) error (~w): " + "~n Bytes: ~w" + "~n Error: ~w " + "(UDPport: ~w, Ip: ~w)", + [Class, Bytes, Error, UdpPort, Ip]) + end. + %% This function assumes that the agent and the manager (thats us) %% has the same version. @@ -578,18 +601,100 @@ set_pdu(Msg, RePdu) -> init_usm('version-3', Dir) -> + ?vlog("init_usm -> create (and init) fake \"agent\" table", []), ets:new(snmp_agent_table, [set, public, named_table]), ets:insert(snmp_agent_table, {agent_mib_storage, persistent}), - snmpa_local_db:start_link(normal, Dir, [{verbosity,trace}]), + %% The local-db process may *still* be running (from a previous + %% test case), on the way down, but not yet dead. + %% Either way, before we start it, make sure its dead and *gone*! + %% How do we do that without getting hung up? Calling the stop + %% function, will not do since it uses Timeout=infinity. + ?vlog("init_usm -> ensure (old) fake local-db is dead", []), + ensure_local_db_dead(), + ?vlog("init_usm -> try start fake local-db", []), + case snmpa_local_db:start_link(normal, Dir, + [{sname, "MGR-LOCAL-DB"}, + {verbosity, trace}]) of + {ok, Pid} -> + ?vlog("started: ~p" + "~n ~p", [Pid, process_info(Pid)]); + {error, {already_started, Pid}} -> + LDBInfo = process_info(Pid), + ?vlog("already started: ~p" + "~n ~p", [Pid, LDBInfo]), + ?FAIL({still_running, snmpa_local_db, LDBInfo}); + {error, Reason} -> + ?FAIL({failed_starting, snmpa_local_db, Reason}) + end, NameDb = snmpa_agent:db(snmpEngineID), + ?vlog("init_usm -> try set manager engine-id", []), R = snmp_generic:variable_set(NameDb, "mgrEngine"), - io:format("~w:init_usm -> engine-id set result: ~p~n", [?MODULE,R]), + snmp_verbosity:print(info, info, "init_usm -> engine-id set result: ~p", [R]), + ?vlog("init_usm -> try set engine boots (framework-mib)", []), snmp_framework_mib:set_engine_boots(1), + ?vlog("init_usm -> try set engine time (framework-mib)", []), snmp_framework_mib:set_engine_time(1), - snmp_user_based_sm_mib:reconfigure(Dir); + ?vlog("init_usm -> try usm (mib) reconfigure", []), + snmp_user_based_sm_mib:reconfigure(Dir), + ?vlog("init_usm -> done", []), + ok; init_usm(_Vsn, _Dir) -> ok. +ensure_local_db_dead() -> + ensure_dead(whereis(snmpa_local_db), 2000). + +ensure_dead(Pid, Timeout) when is_pid(Pid) -> + MRef = erlang:monitor(process, Pid), + try + begin + ensure_dead_wait(Pid, MRef, Timeout), + ensure_dead_stop(Pid, MRef, Timeout), + ensure_dead_kill(Pid, MRef, Timeout), + exit(failed_stop_local_db) + end + catch + throw:ok -> + ok + end; +ensure_dead(_, _) -> + ?vlog("ensure_dead -> already dead", []), + ok. + +ensure_dead_wait(Pid, MRef, Timeout) -> + receive + {'DOWN', MRef, process, Pid, _Info} -> + ?vlog("ensure_dead_wait -> died peacefully", []), + throw(ok) + after Timeout -> + ?vlog("ensure_dead_wait -> giving up", []), + ok + end. + +ensure_dead_stop(Pid, MRef, Timeout) -> + StopPid = spawn(fun() -> snmpa_local_db:stop() end), + receive + {'DOWN', MRef, process, Pid, _Info} -> + ?vlog("ensure_dead -> dead (stopped)", []), + throw(ok) + after Timeout -> + ?vlog("ensure_dead_stop -> giving up", []), + exit(StopPid, kill), + ok + end. + +ensure_dead_kill(Pid, MRef, Timeout) -> + exit(Pid, kill), + receive + {'DOWN', MRef, process, Pid, _Info} -> + ?vlog("ensure_dead -> dead (killed)", []), + throw(ok) + after Timeout -> + ?vlog("ensure_dead_kill -> giving up", []), + ok + end. + + display_incomming_message(M) -> display_message("Incomming",M). @@ -782,13 +887,13 @@ sz(O) -> {unknown_size, O}. d(F) -> d(F, []). -d(F,A) -> d(get(debug),F,A). +d(F,A) -> d(get(debug), F, A). -d(true,F,A) -> - io:format("*** [~s] MGR_PS_DBG *** " ++ F ++ "~n", - [formated_timestamp()|A]); +d(true, F, A) -> + print(F, A); d(_,_F,_A) -> ok. -formated_timestamp() -> - snmp_test_lib:formated_timestamp(). +print(F, A) -> + ?PRINT2("MGR_PS " ++ F, A). + diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 17f14bdea2..78990c48f2 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,53 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.7.6</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + When an SSH server receives the very first message on a + new TCP connection, and that message is not the expected + one, the 64 first bytes of the received message are now + dumped in the INFO REPORT that reports the Protocol + Error.</p> + <p> + This facilitates the debugging of who sends the bad + message or of detecting a possible port scanning.</p> + <p> + Own Id: OTP-15772</p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 4.7.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The callback <c>ssh_channel:init/1</c> was missing in + OTP-21</p> + <p> + Own Id: OTP-15762</p> + </item> + <item> + <p> + If a client was connected to an server on an already open + socket, the callback <c>fun(PeerName,FingerPrint)</c> in + the <c>accept_callback</c> option passed the local name + in the argument PeerName instead of the remote name.</p> + <p> + Own Id: OTP-15763</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.7.4</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -325,6 +372,24 @@ </section> </section> +<section><title>Ssh 4.6.9.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + If a client was connected to an server on an already open + socket, the callback <c>fun(PeerName,FingerPrint)</c> in + the <c>accept_callback</c> option passed the local name + in the argument PeerName instead of the remote name.</p> + <p> + Own Id: OTP-15763</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.6.9.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src index 410061cded..7449405d20 100644 --- a/lib/ssh/src/ssh.app.src +++ b/lib/ssh/src/ssh.app.src @@ -44,10 +44,10 @@ {env, []}, {mod, {ssh_app, []}}, {runtime_dependencies, [ - "crypto-4.2", - "erts-6.0", - "kernel-3.0", - "public_key-1.5.2", - "stdlib-3.3" + "crypto-@OTP-15644@", + "erts-9.0", + "kernel-5.3", + "public_key-1.6.1", + "stdlib-3.4.1" ]}]}. diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 9281bf84a7..ff5aee14d7 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -127,7 +127,7 @@ connect(Socket, UserOptions, NegotiationTimeout) when is_port(Socket), Options -> case valid_socket_to_use(Socket, ?GET_OPT(transport,Options)) of ok -> - {ok, {Host,_Port}} = inet:sockname(Socket), + {ok, {Host,_Port}} = inet:peername(Socket), Opts = ?PUT_INTERNAL_OPT([{user_pid,self()}, {host,Host}], Options), ssh_connection_handler:start_connection(client, Socket, Opts, NegotiationTimeout); {error,SockError} -> diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 923e9309f4..04453e6ef0 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -396,11 +396,13 @@ recv_mac_size = 0, encrypt = none, %% encrypt algorithm + encrypt_cipher, %% cipher. could be different from the algorithm encrypt_keys, %% encrypt keys encrypt_block_size = 8, encrypt_ctx, decrypt = none, %% decrypt algorithm + decrypt_cipher, %% cipher. could be different from the algorithm decrypt_keys, %% decrypt keys decrypt_block_size = 8, decrypt_ctx, %% Decryption context diff --git a/lib/ssh/src/ssh_channel.erl b/lib/ssh/src/ssh_channel.erl index 443bd05086..1d977e3bc9 100644 --- a/lib/ssh/src/ssh_channel.erl +++ b/lib/ssh/src/ssh_channel.erl @@ -58,6 +58,7 @@ State::term()}. %%% API -export([start/4, start/5, start_link/4, start_link/5, call/2, call/3, + init/1, cast/2, reply/2, enter_loop/1]). %%==================================================================== @@ -76,6 +77,9 @@ cast(ChannelPid, Msg) -> reply(From, Msg) -> ssh_client_channel:reply(From, Msg). +init(Args) -> + ssh_client_channel:init(Args). + start(ConnectionManager, ChannelId, CallBack, CbInitArgs) -> ssh_client_channel:start(ConnectionManager, ChannelId, CallBack, CbInitArgs). diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 7c87591cf2..8f32966a12 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -594,7 +594,7 @@ handle_event(_, socket_control, {hello,_}=StateName, D) -> {stop, {shutdown,{unexpected_getopts_return, Other}}} end; -handle_event(_, {info_line,_Line}, {hello,Role}=StateName, D) -> +handle_event(_, {info_line,Line}, {hello,Role}=StateName, D) -> case Role of client -> %% The server may send info lines to the client before the version_exchange @@ -605,9 +605,9 @@ handle_event(_, {info_line,_Line}, {hello,Role}=StateName, D) -> %% But the client may NOT send them to the server. Openssh answers with cleartext, %% and so do we send_bytes("Protocol mismatch.", D), - ?call_disconnectfun_and_log_cond("Protocol mismatch.", - "Protocol mismatch in version exchange. Client sent info lines.", - StateName, D), + Msg = io_lib:format("Protocol mismatch in version exchange. Client sent info lines.~n~s", + [ssh_dbg:hex_dump(Line, 64)]), + ?call_disconnectfun_and_log_cond("Protocol mismatch.", Msg, StateName, D), {stop, {shutdown,"Protocol mismatch in version exchange. Client sent info lines."}} end; diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl index 4fe15b24d3..43ac4c0ccf 100644 --- a/lib/ssh/src/ssh_dbg.erl +++ b/lib/ssh/src/ssh_dbg.erl @@ -60,6 +60,7 @@ cbuf_stop_clear/0, cbuf_in/1, cbuf_list/0, + hex_dump/1, hex_dump/2, fmt_cbuf_items/0, fmt_cbuf_item/1 ]). @@ -439,3 +440,75 @@ fmt_value(#circ_buf_entry{module = M, io_lib:format("~p:~p ~p/~p ~p~n~s",[M,L,F,A,Pid,fmt_value(V)]); fmt_value(Value) -> io_lib:format("~p",[Value]). + +%%%================================================================ + +-record(h, {max_bytes = 65536, + bytes_per_line = 16, + address_len = 4 + }). + + +hex_dump(Data) -> hex_dump1(Data, hd_opts([])). + +hex_dump(X, Max) when is_integer(Max) -> + hex_dump(X, [{max_bytes,Max}]); +hex_dump(X, OptList) when is_list(OptList) -> + hex_dump1(X, hd_opts(OptList)). + +hex_dump1(B, Opts) when is_binary(B) -> hex_dump1(binary_to_list(B), Opts); +hex_dump1(L, Opts) when is_list(L), length(L) > Opts#h.max_bytes -> + io_lib:format("~s---- skip ~w bytes----~n", [hex_dump1(lists:sublist(L,Opts#h.max_bytes), Opts), + length(L) - Opts#h.max_bytes + ]); +hex_dump1(L, Opts0) when is_list(L) -> + Opts = Opts0#h{address_len = num_hex_digits(Opts0#h.max_bytes)}, + Result = hex_dump(L, [{0,[],[]}], Opts), + [io_lib:format("~*.s | ~*s | ~s~n" + "~*.c-+-~*c-+-~*c~n", + [Opts#h.address_len, lists:sublist("Address",Opts#h.address_len), + -3*Opts#h.bytes_per_line, lists:sublist("Hexdump",3*Opts#h.bytes_per_line), + "ASCII", + Opts#h.address_len, $-, + 3*Opts#h.bytes_per_line, $-, + Opts#h.bytes_per_line, $- + ]) | + [io_lib:format("~*.16.0b | ~s~*c | ~s~n",[Opts#h.address_len, N*Opts#h.bytes_per_line, + lists:reverse(Hexs), + 3*(Opts#h.bytes_per_line-length(Hexs)), $ , + lists:reverse(Chars)]) + || {N,Hexs,Chars} <- lists:reverse(Result) + ] + ]. + + +hd_opts(L) -> lists:foldl(fun hd_opt/2, #h{}, L). + +hd_opt({max_bytes,M}, O) -> O#h{max_bytes=M}; +hd_opt({bytes_per_line,M}, O) -> O#h{bytes_per_line=M}. + + +num_hex_digits(N) when N<16 -> 1; +num_hex_digits(N) -> trunc(math:ceil(math:log2(N)/4)). + + +hex_dump([L|Cs], Result0, Opts) when is_list(L) -> + Result = hex_dump(L,Result0, Opts), + hex_dump(Cs, Result, Opts); + +hex_dump(Cs, [{N0,_,Chars}|_]=Lines, Opts) when length(Chars) == Opts#h.bytes_per_line -> + hex_dump(Cs, [{N0+1,[],[]}|Lines], Opts); + +hex_dump([C|Cs], [{N,Hexs,Chars}|Lines], Opts) -> + Asc = if + 16#20 =< C,C =< 16#7E -> C; + true -> $. + end, + Hex = io_lib:format("~2.16.0b ", [C]), + hex_dump(Cs, [{N, [Hex|Hexs], [Asc|Chars]} | Lines], Opts); + +hex_dump([], Result, _) -> + Result. + + + diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index aa9ba0f9bb..5ec12e2d04 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -508,7 +508,7 @@ close_our_file({_,Fd}, FileMod, FS0) -> FS1. %%% stat: do the stat -stat(Vsn, ReqId, Data, State, F) -> +stat(_Vsn, ReqId, Data, State, F) -> <<?UINT32(BLen), BPath:BLen/binary, _/binary>> = Data, stat(ReqId, unicode:characters_to_list(BPath), State, F). diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 1f4e281a30..eaab13433a 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -170,7 +170,7 @@ supported_algorithms(cipher) -> {'AEAD_AES_256_GCM', [{ciphers,aes_256_gcm}]}, {'AEAD_AES_128_GCM', [{ciphers,aes_128_gcm}]}, {'aes128-cbc', [{ciphers,aes_128_cbc}]}, - {'3des-cbc', [{ciphers,des3_cbc}]} + {'3des-cbc', [{ciphers,des_ede3_cbc}]} ] )); supported_algorithms(mac) -> @@ -1328,25 +1328,27 @@ verify(PlainText, HashAlg, Sig, Key, _) -> %%% Start of a more parameterized crypto handling. cipher('AEAD_AES_128_GCM') -> - #cipher{key_bytes = 16, + #cipher{impl = aes_128_gcm, + key_bytes = 16, iv_bytes = 12, block_bytes = 16, pkt_type = aead}; cipher('AEAD_AES_256_GCM') -> - #cipher{key_bytes = 32, + #cipher{impl = aes_256_gcm, + key_bytes = 32, iv_bytes = 12, block_bytes = 16, pkt_type = aead}; cipher('3des-cbc') -> - #cipher{impl = des3_cbc, + #cipher{impl = des_ede3_cbc, key_bytes = 24, iv_bytes = 8, block_bytes = 8}; cipher('aes128-cbc') -> - #cipher{impl = aes_cbc, + #cipher{impl = aes_128_cbc, key_bytes = 16, iv_bytes = 16, block_bytes = 16}; @@ -1370,7 +1372,8 @@ cipher('aes256-ctr') -> block_bytes = 16}; cipher('[email protected]') -> % FIXME: Verify!! - #cipher{key_bytes = 32, + #cipher{impl = chacha20_poly1305, + key_bytes = 32, iv_bytes = 12, block_bytes = 8, pkt_type = aead}; @@ -1407,12 +1410,14 @@ encrypt_init(#ssh{encrypt = '[email protected]', role = Role} = Ssh) encrypt_init(#ssh{encrypt = SshCipher, role = Role} = Ssh) when SshCipher == 'AEAD_AES_128_GCM'; SshCipher == 'AEAD_AES_256_GCM' -> {IvMagic, KeyMagic} = encrypt_magic(Role), - #cipher{key_bytes = KeyBytes, + #cipher{impl = CryptoCipher, + key_bytes = KeyBytes, iv_bytes = IvBytes, block_bytes = BlockBytes} = cipher(SshCipher), IV = hash(Ssh, IvMagic, 8*IvBytes), K = hash(Ssh, KeyMagic, 8*KeyBytes), - {ok, Ssh#ssh{encrypt_keys = K, + {ok, Ssh#ssh{encrypt_cipher = CryptoCipher, + encrypt_keys = K, encrypt_block_size = BlockBytes, encrypt_ctx = IV}}; @@ -1425,11 +1430,12 @@ encrypt_init(#ssh{encrypt = SshCipher, role = Role} = Ssh) -> IV = hash(Ssh, IvMagic, 8*IvBytes), K = hash(Ssh, KeyMagic, 8*KeyBytes), Ctx0 = crypto:crypto_init(CryptoCipher, K, IV, true), - {ok, Ssh#ssh{encrypt_block_size = BlockBytes, + {ok, Ssh#ssh{encrypt_cipher = CryptoCipher, + encrypt_block_size = BlockBytes, encrypt_ctx = Ctx0}}. encrypt_final(Ssh) -> - {ok, Ssh#ssh{encrypt = none, + {ok, Ssh#ssh{encrypt = none, encrypt_keys = undefined, encrypt_block_size = 8, encrypt_ctx = undefined @@ -1445,30 +1451,31 @@ encrypt(#ssh{encrypt = '[email protected]', <<LenData:4/binary, PayloadData/binary>>) -> %% Encrypt length IV1 = <<0:8/unit:8, Seq:8/unit:8>>, - EncLen = crypto:crypto_one_shot(chacha20, K1, IV1, LenData, true), + EncLen = crypto:crypto_one_time(chacha20, K1, IV1, LenData, true), %% Encrypt payload IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, - EncPayloadData = crypto:crypto_one_shot(chacha20, K2, IV2, PayloadData, true), + EncPayloadData = crypto:crypto_one_time(chacha20, K2, IV2, PayloadData, true), %% MAC tag - PolyKey = crypto:crypto_one_shot(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, true), + PolyKey = crypto:crypto_one_time(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, true), EncBytes = <<EncLen/binary,EncPayloadData/binary>>, Ctag = crypto:poly1305(PolyKey, EncBytes), %% Result {Ssh, {EncBytes,Ctag}}; encrypt(#ssh{encrypt = SshCipher, + encrypt_cipher = CryptoCipher, encrypt_keys = K, encrypt_ctx = IV0} = Ssh, <<LenData:4/binary, PayloadData/binary>>) when SshCipher == 'AEAD_AES_128_GCM' ; SshCipher == 'AEAD_AES_256_GCM' -> - {Ctext,Ctag} = crypto:block_encrypt(aes_gcm, K, IV0, {LenData,PayloadData}), + {Ctext,Ctag} = crypto:crypto_one_time_aead(CryptoCipher, K, IV0, PayloadData, LenData, true), IV = next_gcm_iv(IV0), {Ssh#ssh{encrypt_ctx = IV}, {<<LenData/binary,Ctext/binary>>,Ctag}}; encrypt(#ssh{encrypt_ctx = Ctx0} = Ssh, Data) -> Enc = crypto:crypto_update(Ctx0, Data), {Ssh, Enc}. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Decryption %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1485,12 +1492,14 @@ decrypt_init(#ssh{decrypt = '[email protected]', role = Role} = Ssh) decrypt_init(#ssh{decrypt = SshCipher, role = Role} = Ssh) when SshCipher == 'AEAD_AES_128_GCM'; SshCipher == 'AEAD_AES_256_GCM' -> {IvMagic, KeyMagic} = decrypt_magic(Role), - #cipher{key_bytes = KeyBytes, + #cipher{impl = CryptoCipher, + key_bytes = KeyBytes, iv_bytes = IvBytes, block_bytes = BlockBytes} = cipher(SshCipher), IV = hash(Ssh, IvMagic, 8*IvBytes), K = hash(Ssh, KeyMagic, 8*KeyBytes), - {ok, Ssh#ssh{decrypt_keys = K, + {ok, Ssh#ssh{decrypt_cipher = CryptoCipher, + decrypt_keys = K, decrypt_block_size = BlockBytes, decrypt_ctx = IV}}; @@ -1503,9 +1512,11 @@ decrypt_init(#ssh{decrypt = SshCipher, role = Role} = Ssh) -> IV = hash(Ssh, IvMagic, 8*IvBytes), K = hash(Ssh, KeyMagic, 8*KeyBytes), Ctx0 = crypto:crypto_init(CryptoCipher, K, IV, false), - {ok, Ssh#ssh{decrypt_block_size = BlockBytes, + {ok, Ssh#ssh{decrypt_cipher = CryptoCipher, + decrypt_block_size = BlockBytes, decrypt_ctx = Ctx0}}. + decrypt_final(Ssh) -> {ok, Ssh#ssh {decrypt = none, decrypt_keys = undefined, @@ -1517,35 +1528,37 @@ decrypt(Ssh, <<>>) -> {Ssh, <<>>}; decrypt(#ssh{decrypt = '[email protected]', - decrypt_keys = {K1,_K2}, - recv_sequence = Seq} = Ssh, {length,EncryptedLen}) -> - PacketLenBin = crypto:crypto_one_shot(chacha20, K1, <<0:8/unit:8, Seq:8/unit:8>>, EncryptedLen, false), - {Ssh, PacketLenBin}; - -decrypt(#ssh{decrypt = '[email protected]', - decrypt_keys = {_K1,K2}, - recv_sequence = Seq} = Ssh, {AAD,Ctext,Ctag}) -> - %% The length is already decoded and used to divide the input - %% Check the mac (important that it is timing-safe): - PolyKey = crypto:crypto_one_shot(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, false), - case equal_const_time(Ctag, crypto:poly1305(PolyKey, <<AAD/binary,Ctext/binary>>)) of - true -> - %% MAC is ok, decode - IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, - PlainText = crypto:crypto_one_shot(chacha20, K2, IV2, Ctext, false), - {Ssh, PlainText}; - false -> - {Ssh,error} + decrypt_keys = {K1,K2}, + recv_sequence = Seq} = Ssh, Data) -> + case Data of + {length,EncryptedLen} -> + %% The length is decrypted separately in a first step + PacketLenBin = crypto:crypto_one_time(chacha20, K1, <<0:8/unit:8, Seq:8/unit:8>>, EncryptedLen, false), + {Ssh, PacketLenBin}; + {AAD,Ctext,Ctag} -> + %% The length is already decrypted and used to divide the input + %% Check the mac (important that it is timing-safe): + PolyKey = crypto:crypto_one_time(chacha20, K2, <<0:8/unit:8,Seq:8/unit:8>>, <<0:32/unit:8>>, false), + case equal_const_time(Ctag, crypto:poly1305(PolyKey, <<AAD/binary,Ctext/binary>>)) of + true -> + %% MAC is ok, decode + IV2 = <<1:8/little-unit:8, Seq:8/unit:8>>, + PlainText = crypto:crypto_one_time(chacha20, K2, IV2, Ctext, false), + {Ssh, PlainText}; + false -> + {Ssh,error} + end end; decrypt(#ssh{decrypt = none} = Ssh, Data) -> {Ssh, Data}; decrypt(#ssh{decrypt = SshCipher, + decrypt_cipher = CryptoCipher, decrypt_keys = K, - decrypt_ctx = IV0} = Ssh, Data = {_AAD,_Ctext,_Ctag}) when SshCipher == 'AEAD_AES_128_GCM' ; - SshCipher == 'AEAD_AES_256_GCM' -> - Dec = crypto:block_decrypt(aes_gcm, K, IV0, Data), % Dec = PlainText | error + decrypt_ctx = IV0} = Ssh, {AAD,Ctext,Ctag}) when SshCipher == 'AEAD_AES_128_GCM' ; + SshCipher == 'AEAD_AES_256_GCM' -> + Dec = crypto:crypto_one_time_aead(CryptoCipher, K, IV0, Ctext, AAD, Ctag, false), IV = next_gcm_iv(IV0), {Ssh#ssh{decrypt_ctx = IV}, Dec}; diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 5de6d52092..9b987dea5a 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -1399,7 +1399,7 @@ rekey_chk(Config, RLdaemon, RLclient) -> Kex1 = ssh_test_lib:get_kex_init(ConnectionRef), %% Make both sides send something: - {ok, SftpPid} = ssh_sftp:start_channel(ConnectionRef), + {ok, _SftpPid} = ssh_sftp:start_channel(ConnectionRef), %% Check rekeying timer:sleep(?REKEY_DATA_TMO), diff --git a/lib/ssh/test/ssh_bench_SUITE.erl b/lib/ssh/test/ssh_bench_SUITE.erl index 2ac4e5636a..880c519a5e 100644 --- a/lib/ssh/test/ssh_bench_SUITE.erl +++ b/lib/ssh/test/ssh_bench_SUITE.erl @@ -178,7 +178,7 @@ gen_data(DataSz) -> connect_measure(Port, Cipher, Mac, Data, Options) -> - AES_GCM = {cipher, + _AES_GCM = {cipher, []}, %% ['[email protected]', %% '[email protected]']}, @@ -187,22 +187,22 @@ connect_measure(Port, Cipher, Mac, Data, Options) -> {none,none} -> [{modify_algorithms,[{prepend, [{cipher,[Cipher]}, {mac,[Mac]}]} -%%% ,{rm,[AES_GCM]} +%%% ,{rm,[_AES_GCM]} ]}]; {none,_} -> [{modify_algorithms,[{prepend, [{cipher,[Cipher]}]} -%%% ,{rm,[AES_GCM]} +%%% ,{rm,[_AES_GCM]} ]}, {preferred_algorithms, [{mac,[Mac]}]}]; {_,none} -> [{modify_algorithms,[{prepend, [{mac,[Mac]}]} -%%% ,{rm,[AES_GCM]} +%%% ,{rm,[_AES_GCM]} ]}, {preferred_algorithms, [{cipher,[Cipher]}]}]; _ -> [{preferred_algorithms, [{cipher,[Cipher]}, {mac,[Mac]}]} -%%% ,{modify_algorithms, [{rm,[AES_GCM]}]} +%%% ,{modify_algorithms, [{rm,[_AES_GCM]}]} ] end, Times = diff --git a/lib/ssh/test/ssh_chan_behaviours_SUITE.erl b/lib/ssh/test/ssh_chan_behaviours_SUITE.erl index 16ed152bcd..103d7253fd 100644 --- a/lib/ssh/test/ssh_chan_behaviours_SUITE.erl +++ b/lib/ssh/test/ssh_chan_behaviours_SUITE.erl @@ -128,8 +128,8 @@ subsystem_client(Config) -> C = proplists:get_value(connref, Config), {ok,ChRef} = ssh_chan_behaviours_client:start_link(C), - IDclt = ?EXPECT({{C,Ch1clt}, {ssh_channel_up,Ch1clt,C}}, {C,Ch1clt}), - IDsrv = ?EXPECT({{_Csrv,Ch1srv}, {ssh_channel_up,Ch1srv,_Csrv}}, {_Csrv,Ch1srv}), + IDclt = ?EXPECT({{C,_Ch1clt}, {ssh_channel_up,_Ch1clt,C}}, {C,_Ch1clt}), + IDsrv = ?EXPECT({{_Csrv,_Ch1srv}, {ssh_channel_up,_Ch1srv,_Csrv}}, {_Csrv,_Ch1srv}), ok = ssh_chan_behaviours_client:stop(ChRef), ?EXPECT({IDclt, {terminate,normal}}, []), % From the proper channel handler diff --git a/lib/ssh/test/ssh_chan_behaviours_client.erl b/lib/ssh/test/ssh_chan_behaviours_client.erl index 15f17733d6..8dd18973ad 100644 --- a/lib/ssh/test/ssh_chan_behaviours_client.erl +++ b/lib/ssh/test/ssh_chan_behaviours_client.erl @@ -94,7 +94,7 @@ handle_ssh_msg({ssh_cm, C, {eof, Ch}}=M, #state{ch=Ch,cm=C} = State) -> ?DBG(State, "eof",[]), {ok, State}; -handle_ssh_msg({ssh_cm, C, {signal, _Ch, _SigNameStr}=Sig} = M, #state{ch=Ch,cm=C} = State) -> +handle_ssh_msg({ssh_cm, C, {signal, Ch, _SigNameStr}=Sig} = M, #state{ch=Ch,cm=C} = State) -> %% Ignore signals according to RFC 4254 section 6.9. tell_parent(M, State), ?DBG(State, "~p",[Sig]), diff --git a/lib/ssh/test/ssh_chan_behaviours_server.erl b/lib/ssh/test/ssh_chan_behaviours_server.erl index 1408675a6e..1d504b1bc6 100644 --- a/lib/ssh/test/ssh_chan_behaviours_server.erl +++ b/lib/ssh/test/ssh_chan_behaviours_server.erl @@ -65,7 +65,7 @@ handle_ssh_msg({ssh_cm, C, {eof, Ch}}=M, #state{ch=Ch,cm=C} = State) -> ?DBG(State, "eof",[]), {ok, State}; -handle_ssh_msg({ssh_cm, C, {signal, _Ch, _SigNameStr}=Sig} = M, #state{ch=Ch,cm=C} = State) -> +handle_ssh_msg({ssh_cm, C, {signal, Ch, _SigNameStr}=Sig} = M, #state{ch=Ch,cm=C} = State) -> %% Ignore signals according to RFC 4254 section 6.9. tell_parent(M, State), ?DBG(State, "~p",[Sig]), diff --git a/lib/ssh/test/ssh_compat_SUITE.erl b/lib/ssh/test/ssh_compat_SUITE.erl index 8e82527c6e..06ed9082cf 100644 --- a/lib/ssh/test/ssh_compat_SUITE.erl +++ b/lib/ssh/test/ssh_compat_SUITE.erl @@ -150,8 +150,7 @@ init_per_group(G, Config0) -> stop_docker(ID), {fail, "Can't contact docker sshd"} catch - Class:Exc -> - ST = erlang:get_stacktrace(), + Class:Exc:ST -> ct:log("common_algs: ~p:~p~n~p",[Class,Exc,ST]), stop_docker(ID), {fail, "Failed during setup"} @@ -160,8 +159,7 @@ init_per_group(G, Config0) -> cant_start_docker -> {skip, "Can't start docker"}; - C:E -> - ST = erlang:get_stacktrace(), + C:E:ST -> ct:log("No ~p~n~p:~p~n~p",[G,C,E,ST]), {skip, "Can't start docker"} end; @@ -1026,8 +1024,7 @@ receive_hello(S) -> Result -> Result catch - Class:Error -> - ST = erlang:get_stacktrace(), + Class:Error:ST -> {error, {Class,Error,ST}} end. @@ -1104,8 +1101,7 @@ sftp_tests_erl_server(Config, ServerIP, ServerPort, ServerRootDir, UserDir) -> call_sftp_in_docker(Config, ServerIP, ServerPort, Cmnds, UserDir), check_local_directory(ServerRootDir) catch - Class:Error -> - ST = erlang:get_stacktrace(), + Class:Error:ST -> {error, {Class,Error,ST}} end. @@ -1133,7 +1129,7 @@ check_local_directory(ServerRootDir) -> check_local_directory(ServerRootDir, SleepTime, N) -> case do_check_local_directory(ServerRootDir) of - {error,Error} when N>0 -> + {error,_Error} when N>0 -> %% Could be that the erlang side is faster and the docker's operations %% are not yet finalized. %% Sleep for a while and retry a few times: @@ -1347,8 +1343,7 @@ one_test_erl_client(SFTP, Id, C) when SFTP==sftp ; SFTP==sftp_async -> catch ssh_sftp:stop_channel(Ch), R catch - Class:Error -> - ST = erlang:get_stacktrace(), + Class:Error:ST -> {error, {SFTP,Id,Class,Error,ST}} end. diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index 60d0da2a39..bf90f74324 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -214,7 +214,7 @@ init_per_testcase(_TestCase, Config) -> file:make_dir(UserDir), [{user_dir,UserDir}|Config]. -end_per_testcase(_TestCase, Config) -> +end_per_testcase(_TestCase, _Config) -> ssh:stop(), ok. diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index a1a7eebcde..1129303414 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -409,7 +409,7 @@ ct:log("DataDir ~p:~n ~p~n~nSystDir ~p:~n ~p~n~nUserDir ~p:~n ~p",[DataDir, file setup_ecdsa_auth_keys(Size, DataDir, UserDir). setup_eddsa(Alg, DataDir, UserDir) -> - {IdPriv, IdPub, HostPriv, HostPub} = + {IdPriv, _IdPub, HostPriv, HostPub} = case Alg of ed25519 -> {"id_ed25519", "id_ed25519.pub", "ssh_host_ed25519_key", "ssh_host_ed25519_key.pub"}; ed448 -> {"id_ed448", "id_ed448.pub", "ssh_host_ed448_key", "ssh_host_ed448_key.pub"} @@ -970,7 +970,7 @@ expected_state(_) -> false. %%%---------------------------------------------------------------- %%% Return a string with N random characters %%% -random_chars(N) -> [crypto:rand_uniform($a,$z) || _<-lists:duplicate(N,x)]. +random_chars(N) -> [($a-1)+rand:uniform($z-$a) || _<-lists:duplicate(N,x)]. create_random_dir(Config) -> diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl index f2c9892f95..3f4df2c986 100644 --- a/lib/ssh/test/ssh_trpt_test_lib.erl +++ b/lib/ssh/test/ssh_trpt_test_lib.erl @@ -570,75 +570,6 @@ receive_binary_msg(S0=#s{}) -> -old_receive_binary_msg(S0=#s{ssh=C0=#ssh{decrypt_block_size = BlockSize, - recv_mac_size = MacSize - } - }) -> - case size(S0#s.encrypted_data_buffer) >= max(8,BlockSize) of - false -> - %% Need more bytes to decode the packet_length field - Remaining = max(8,BlockSize) - size(S0#s.encrypted_data_buffer), - receive_binary_msg( receive_wait(Remaining, S0) ); - true -> - %% Has enough bytes to decode the packet_length field - {_, <<?UINT32(PacketLen), _/binary>>, _} = - ssh_transport:decrypt_blocks(S0#s.encrypted_data_buffer, BlockSize, C0), % FIXME: BlockSize should be at least 4 - - %% FIXME: Check that ((4+PacketLen) rem BlockSize) == 0 ? - - S1 = if - PacketLen > ?SSH_MAX_PACKET_SIZE -> - fail({too_large_message,PacketLen},S0); % FIXME: disconnect - - ((4+PacketLen) rem BlockSize) =/= 0 -> - fail(bad_packet_length_modulo, S0); % FIXME: disconnect - - size(S0#s.encrypted_data_buffer) >= (4 + PacketLen + MacSize) -> - %% has the whole packet - S0; - - true -> - %% need more bytes to get have the whole packet - Remaining = (4 + PacketLen + MacSize) - size(S0#s.encrypted_data_buffer), - receive_wait(Remaining, S0) - end, - - %% Decrypt all, including the packet_length part (re-use the initial #ssh{}) - {C1, SshPacket = <<?UINT32(_),?BYTE(PadLen),Tail/binary>>, EncRest} = - ssh_transport:decrypt_blocks(S1#s.encrypted_data_buffer, PacketLen+4, C0), - - PayloadLen = PacketLen - 1 - PadLen, - <<CompressedPayload:PayloadLen/binary, _Padding:PadLen/binary>> = Tail, - - {C2, Payload} = ssh_transport:decompress(C1, CompressedPayload), - - <<Mac:MacSize/binary, Rest/binary>> = EncRest, - - case {ssh_transport:is_valid_mac(Mac, SshPacket, C2), - catch ssh_message:decode(set_prefix_if_trouble(Payload,S1))} - of - {false, _} -> fail(bad_mac,S1); - {_, {'EXIT',_}} -> fail(decode_failed,S1); - - {true, Msg} -> - C3 = case Msg of - #ssh_msg_kexinit{} -> - ssh_transport:key_init(opposite_role(C2), C2, Payload); - _ -> - C2 - end, - S2 = opt(print_messages, S1, - fun(X) when X==true;X==detail -> {"Recv~n~s~n",[format_msg(Msg)]} end), - S3 = opt(print_messages, S2, - fun(detail) -> {"decrypted bytes ~p~n",[SshPacket]} end), - S3#s{ssh = inc_recv_seq_num(C3), - encrypted_data_buffer = Rest, - return_value = Msg - } - end - end. - - set_prefix_if_trouble(Msg = <<?BYTE(Op),_/binary>>, #s{alg=#alg{kex=Kex}}) when Op == 30; Op == 31 diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 0f9eee887c..837da27ab0 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,4 +1,4 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.7.4 +SSH_VSN = 4.7.6 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index a511cb4db3..f0231da2ad 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -27,6 +27,23 @@ </header> <p>This document describes the changes made to the SSL application.</p> +<section><title>SSL 9.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + With the default BEAST Mitigation strategy for TLS 1.0 an + empty TLS fragment could be sent after a one-byte + fragment. This glitch has been fixed.</p> + <p> + Own Id: OTP-15054 Aux Id: ERIERL-346 </p> + </item> + </list> + </section> + +</section> + <section><title>SSL 9.2.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 74a0a0a03e..d626748af6 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -128,7 +128,7 @@ <name name="hostname"/> </datatype> - <datatype> + <datatype> <name name="ip_address"/> </datatype> @@ -136,14 +136,14 @@ <name name="protocol_version"/> </datatype> - <datatype> + <datatype> <name name="tls_version"/> </datatype> - + <datatype> <name name="dtls_version"/> </datatype> - + <datatype> <name name="tls_legacy_version"/> </datatype> @@ -151,9 +151,8 @@ <datatype> <name name="dtls_legacy_version"/> </datatype> - - - <datatype> + + <datatype> <name name="prf_random"/> </datatype> @@ -218,10 +217,6 @@ </datatype> <datatype> - <name name="eccs"/> - </datatype> - - <datatype> <name name="named_curve"/> </datatype> @@ -253,6 +248,10 @@ <name name="tls_alert"/> </datatype> + <datatype> + <name name="reason"/> + </datatype> + <datatype_title>TLS/DTLS OPTION DESCRIPTIONS - COMMON for SERVER and CLIENT</datatype_title> <datatype> @@ -343,13 +342,6 @@ </datatype> <datatype> - <name name="eccs"/> - <desc><p> Allows to specify the order of preference for named curves - and to restrict their usage when using a cipher suite supporting them.</p> - </desc> - </datatype> - - <datatype> <name name="signature_schemes"/> <desc> <p> @@ -1109,13 +1101,8 @@ fun(srp, Username :: string(), UserState :: term()) -> <funcs> <func> - <name since="OTP 20.3">append_cipher_suites(Deferred, Suites) -> ciphers() </name> + <name name="append_cipher_suites" arity="2" since="OTP 20.3"/> <fsummary></fsummary> - <type> - <v>Deferred = <seealso marker="#type-ciphers">ciphers()</seealso> | - <seealso marker="#type-cipher_filters">cipher_filters()</seealso></v> - <v>Suites = <seealso marker="#type-ciphers">ciphers()</seealso></v> - </type> <desc><p>Make <c>Deferred</c> suites become the least preferred suites, that is put them at the end of the cipher suite list <c>Suites</c> after removing them from <c>Suites</c> if @@ -1126,25 +1113,18 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R14B">cipher_suites() -></name> - <name since="OTP R14B">cipher_suites(Type) -> [old_cipher_suite()]</name> + <name name="cipher_suites" arity="0" since="OTP R14B"/> + <name name="cipher_suites" arity="1" since="OTP R14B"/> <fsummary>Returns a list of supported cipher suites.</fsummary> - <type> - <v>Type = erlang | openssl | all</v> - </type> <desc> <p>Deprecated in OTP 21, use <seealso marker="#cipher_suites-2">cipher_suites/2</seealso> instead.</p> </desc> </func> <func> - <name since="OTP 20.3">cipher_suites(Supported, Version) -> ciphers()</name> + <name name="cipher_suites" arity="2" since="OTP 20.3"/> <fsummary>Returns a list of all default or all supported cipher suites.</fsummary> - <type> - <v> Supported = default | all | anonymous </v> - <v> Version = <seealso marker="#type-protocol_version">protocol_version() </seealso></v> - </type> <desc><p>Returns all default or all supported (except anonymous), or all anonymous cipher suites for a TLS version</p> @@ -1152,16 +1132,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 19.2">eccs() -></name> - <name since="OTP 19.2">eccs(Version) -> NamedCurves</name> + <name name="eccs" arity="0" since="OTP 19.2"/> + <name name="eccs" arity="1" since="OTP 19.2"/> <fsummary>Returns a list of supported ECCs.</fsummary> - - <type> - <v> Version = <seealso marker="#type-protocol_version">protocol_version() </seealso></v> - <v> NamedCurves = <seealso marker="#type-named_curve">[named_curve()] </seealso></v> - - </type> - <desc><p>Returns a list of supported ECCs. <c>eccs()</c> is equivalent to calling <c>eccs(Protocol)</c> with all supported protocols and then deduplicating the output.</p> @@ -1169,9 +1142,8 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 17.5">clear_pem_cache() -> ok </name> + <name name="clear_pem_cache" arity="0" since="OTP 17.5"/> <fsummary> Clears the pem cache</fsummary> - <desc><p>PEM files, used by ssl API-functions, are cached. The cache is regularly checked to see if any cache entries should be invalidated, however this function provides a way to @@ -1181,19 +1153,10 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R14B">connect(Socket, Options) -> </name> - <name since="">connect(Socket, Options, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext} - | {error, Reason}</name> + <name name="connect" arity="2" since="OTP R14B"/> + <name name="connect" arity="3" clause_i="1" since=""/> <fsummary>Upgrades a <c>gen_tcp</c>, or equivalent, connected socket to an TLS socket.</fsummary> - <type> - <v>Socket = <seealso marker="#type-socket"> socket() </seealso></v> - <v>Options = <seealso marker="#type-tls_client_option"> [tls_client_option()] </seealso></v> - <v>Timeout = timeout()</v> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Ext = <seealso marker="#type-protocol_extensions">protocol_extensions()</seealso></v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc><p>Upgrades a <c>gen_tcp</c>, or equivalent, connected socket to an TLS socket, that is, performs the client-side TLS handshake.</p> @@ -1225,18 +1188,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">connect(Host, Port, Options) -></name> - <name since="">connect(Host, Port, Options, Timeout) -> - {ok, SslSocket}| {ok, SslSocket, Ext} | {error, Reason}</name> + <name since="" name="connect" arity="3" clause_i="2"/> + <name since="" name="connect" arity="4"/> <fsummary>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</fsummary> - <type> - <v>Host =<seealso marker="#type-host"> host() </seealso> </v> - <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> - <v>Options = <seealso marker="#type-tls_client_option"> [tls_client_option()]</seealso></v> - <v>Timeout = timeout()</v> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc><p>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</p> <p> When the option <c>verify</c> is set to <c>verify_peer</c> the check @@ -1273,24 +1227,15 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">close(SslSocket) -> ok | {error, Reason}</name> + <name since="" name="close" arity="1" /> <fsummary>Closes an TLS/DTLS connection.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Reason = term()</v> - </type> <desc><p>Closes an TLS/DTLS connection.</p> </desc> </func> <func> - <name since="OTP 18.1">close(SslSocket, How) -> ok | {ok, port()} | {error, Reason}</name> + <name since="OTP 18.1" name="close" arity="2"/> <fsummary>Closes an TLS connection.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>How = timeout() | {NewController::pid(), timeout()} </v> - <v>Reason = term()</v> - </type> <desc><p>Closes or downgrades an TLS connection. In the latter case the transport connection will be handed over to the <c>NewController</c> process after receiving the TLS close alert from the peer. The returned transport socket will have @@ -1299,15 +1244,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">controlling_process(SslSocket, NewOwner) -> - ok | {error, Reason}</name> + <name since="" name="controlling_process" arity="2" /> <fsummary>Assigns a new controlling process to the TLS/DTLS socket.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>NewOwner = pid()</v> - <v>Reason = term()</v> - </type> <desc><p>Assigns a new controlling process to the SSL socket. A controlling process is the owner of an SSL socket, and receives all messages from the socket.</p> @@ -1315,17 +1254,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 18.0">connection_information(SslSocket) -> - {ok, Result} | {error, Reason} </name> + <name since="OTP 18.0" name="connection_information" arity="1"/> <fsummary>Returns all the connection information. </fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Item = protocol | selected_cipher_suite | sni_hostname | ecc | session_id | atom()</v> - <d>Meaningful atoms, not specified above, are the ssl option names.</d> - <v>Result = [{Item::atom(), Value::term()}]</v> - <v>Reason = term()</v> - </type> <desc><p>Returns the most relevant information about the connection, ssl options that are undefined will be filtered out. Note that values that affect the security of the connection will only be returned if explicitly requested by connection_information/2.</p> @@ -1336,34 +1267,23 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 18.0">connection_information(SslSocket, Items) -> - {ok, Result} | {error, Reason} </name> + <name since="OTP 18.0" name="connection_information" arity="2"/> <fsummary>Returns the requested connection information. </fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Items = [Item]</v> - <v>Item = protocol | cipher_suite | sni_hostname | ecc | session_id | client_random - | server_random | master_secret | atom()</v> - <d>Note that client_random, server_random and master_secret are values - that affect the security of connection. Meaningful atoms, not specified above, are the ssl option names.</d> - <v>Result = [{Item::atom(), Value::term()}]</v> - <v>Reason = term()</v> - </type> <desc><p>Returns the requested information items about the connection, if they are defined.</p> + <p>Note that client_random, server_random and master_secret are values + that affect the security of connection. Meaningful atoms, not specified + above, are the ssl option names.</p> + <note><p>If only undefined options are requested the resulting list can be empty.</p></note> </desc> </func> <func> - <name since="OTP 20.3">filter_cipher_suites(Suites, Filters) -> ciphers()</name> + <name since="OTP 20.3" name="filter_cipher_suites" arity="2" /> <fsummary></fsummary> - <type> - <v> Suites = <seealso marker="#type-ciphers"> ciphers() </seealso></v> - <v> Filters = <seealso marker="#type-cipher_filters"> cipher_filters() </seealso></v> - </type> <desc><p>Removes cipher suites if any of the filter functions returns false for any part of the cipher suite. This function also calls default filter functions to make sure the cipher @@ -1373,24 +1293,16 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">format_error(Reason) -> string()</name> + <name since="" name="format_error" arity="1" /> <fsummary>Returns an error string.</fsummary> - <type> - <v>Reason = term()</v> - </type> <desc> <p>Presents the error returned by an SSL function as a printable string.</p> </desc> </func> <func> - <name since="">getopts(SslSocket, OptionNames) -> - {ok, [socketoption()]} | {error, Reason}</name> + <name since="" name="getopts" arity="2" /> <fsummary>Gets the values of the specified options.</fsummary> - <type> - <v>Socket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>OptionNames = [atom()]</v> - </type> <desc> <p>Gets the values of the specified socket options. </p> @@ -1398,16 +1310,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 19.0">getstat(SslSocket) -> - {ok, OptionValues} | {error, inet:posix()}</name> - <name since="OTP 19.0">getstat(SslSocket, OptionNames) -> - {ok, OptionValues} | {error, inet:posix()}</name> + <name since="OTP 19.0" name="getstat" arity="1" /> + <name since="OTP 19.0" name="getstat" arity="2" /> <fsummary>Get one or more statistic options for a socket</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>OptionNames = [atom()]</v> - <v>OptionValues = [{inet:stat_option(), integer()}]</v> - </type> <desc> <p>Gets one or more statistic options for the underlying TCP socket.</p> <p>See inet:getstat/2 for statistic options description.</p> @@ -1415,14 +1320,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 21.0">handshake(HsSocket) -> </name> - <name since="OTP 21.0">handshake(HsSocket, Timeout) -> {ok, SslSocket} | {error, Reason}</name> + <name since="OTP 21.0" name="handshake" arity="1" /> + <name since="OTP 21.0" name="handshake" arity="2" clause_i="1" /> <fsummary>Performs server-side SSL/TLS handshake.</fsummary> - <type> - <v>HsSocket = SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Timeout = timeout()</v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc> <p>Performs the SSL/TLS/DTLS server-side handshake.</p> <p>Returns a new TLS/DTLS socket if the handshake is successful.</p> @@ -1435,17 +1335,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 21.0">handshake(Socket, Options) -> </name> - <name since="OTP 21.0">handshake(Socket, Options, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason}</name> + <name since="OTP 21.0" name="handshake" arity="2" clause_i="2" /> + <name since="OTP 21.0" name="handshake" arity="3" /> <fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary> - <type> - <v>Socket = socket() | <seealso marker="#type-sslsocket"> socket() </seealso> </v> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso> </v> - <v>Ext = <seealso marker="#type-protocol_extensions">protocol_extensions()</seealso></v> - <v>Options = <seealso marker="#type-tls_server_option"> [server_option()] </seealso> </v> - <v>Timeout = timeout()</v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc> <p>If <c>Socket</c> is a ordinary <c>socket()</c>: upgrades a <c>gen_tcp</c>, or equivalent, socket to an SSL socket, that is, performs @@ -1481,52 +1373,33 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 21.0">handshake_cancel(SslSocket) -> ok </name> + <name since="OTP 21.0" name="handshake_cancel" arity="1" /> <fsummary>Cancel handshake with a fatal alert</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - </type> <desc> <p>Cancel the handshake with a fatal <c>USER_CANCELED</c> alert.</p> </desc> </func> <func> - <name since="OTP 21.0">handshake_continue(HsSocket, Options) -> {ok, SslSocket} | {error, Reason}</name> - <name since="OTP 21.0">handshake_continue(HsSocket, Options, Timeout) -> {ok, SslSocket} | {error, Reason}</name> + <name since="OTP 21.0" name="handshake_continue" arity="2" /> + <name since="OTP 21.0" name="handshake_continue" arity="3" /> <fsummary>Continue the SSL/TLS handshake.</fsummary> - <type> - <v>HsSocket = SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Options = <seealso marker="#type-tls_option"> tls_option() </seealso> </v> - <v>Timeout = timeout()</v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc> <p>Continue the SSL/TLS handshake possiby with new, additional or changed options.</p> </desc> </func> <func> - <name since="">listen(Port, Options) -> - {ok, ListenSocket} | {error, Reason}</name> + <name since="" name="listen" arity="2" /> <fsummary>Creates an SSL listen socket.</fsummary> - <type> - <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> - <v>Options = <seealso marker="#type-tls_server_option"> [server_option()] </seealso></v> - <v>ListenSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - </type> <desc> <p>Creates an SSL listen socket.</p> </desc> </func> <func> - <name since="OTP 18.0">negotiated_protocol(SslSocket) -> {ok, Protocol} | {error, protocol_not_negotiated}</name> + <name since="OTP 18.0" name="negotiated_protocol" arity="1" /> <fsummary>Returns the protocol negotiated through ALPN or NPN extensions.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Protocol = binary()</v> - </type> <desc> <p> Returns the protocol negotiated through ALPN or NPN extensions. @@ -1535,12 +1408,8 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">peercert(SslSocket) -> {ok, Cert} | {error, Reason}</name> + <name since="" name="peercert" arity="1" /> <fsummary>Returns the peer certificate.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Cert = binary()</v> - </type> <desc> <p>The peer certificate is returned as a DER-encoded binary. The certificate can be decoded with @@ -1550,27 +1419,16 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">peername(SslSocket) -> {ok, {Address, Port}} | - {error, Reason}</name> + <name since="" name="peername" arity="1" /> <fsummary>Returns the peer address and port.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Address = ipaddress()</v> - <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> - </type> <desc> <p>Returns the address and port number of the peer.</p> </desc> </func> <func> - <name since="OTP 20.3">prepend_cipher_suites(Preferred, Suites) -> ciphers()</name> + <name since="OTP 20.3" name="prepend_cipher_suites" arity="2" /> <fsummary></fsummary> - <type> - <v>Preferred = <seealso marker="#type-ciphers">ciphers()</seealso> | - <seealso marker="#type-cipher_filters">cipher_filters()</seealso></v> - <v>Suites = <seealso marker="#type-ciphers">ciphers()</seealso></v> - </type> <desc><p>Make <c>Preferred</c> suites become the most preferred suites that is put them at the head of the cipher suite list <c>Suites</c> after removing them from <c>Suites</c> if @@ -1581,15 +1439,8 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R15B01">prf(Socket, Secret, Label, Seed, WantedLength) -> {ok, binary()} | {error, reason()}</name> + <name since="OTP R15B01" name="prf" arity="5" /> <fsummary>Uses a session Pseudo-Random Function to generate key material.</fsummary> - <type> - <v>Socket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Secret = binary() | master_secret</v> - <v>Label = binary()</v> - <v>Seed = [binary() | <seealso marker="#type-prf_random"> prf_random()</seealso>]</v> - <v>WantedLength = non_neg_integer()</v> - </type> <desc> <p>Uses the Pseudo-Random Function (PRF) of a TLS session to generate extra key material. It either takes user-generated values for @@ -1601,16 +1452,14 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">recv(SslSocket, Length) -> </name> - <name since="">recv(SslSocket, Length, Timeout) -> {ok, Data} | {error, - Reason}</name> + <name since="" name="recv" arity="2" /> + <name since="" name="recv" arity="3" /> <fsummary>Receives data on a socket.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Length = integer()</v> - <v>Timeout = timeout()</v> - <v>Data = [char()] | binary()</v> - </type> + <type_desc variable="HttpPacket">See the description of + <c>HttpPacket</c> in + <seealso marker="erts:erlang#decode_packet/3"><c>erlang:decode_packet/3</c></seealso> + in ERTS. + </type_desc> <desc> <p>Receives a packet from a socket in passive mode. A closed socket is indicated by return value @@ -1628,11 +1477,8 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R14B">renegotiate(SslSocket) -> ok | {error, Reason}</name> + <name since="OTP R14B" name="renegotiate" arity="1" /> <fsummary>Initiates a new handshake.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - </type> <desc><p>Initiates a new handshake. A notable return value is <c>{error, renegotiation_rejected}</c> indicating that the peer refused to go through with the renegotiation, but the connection @@ -1641,40 +1487,27 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">send(SslSocket, Data) -> ok | {error, Reason}</name> + <name since="" name="send" arity="2" /> <fsummary>Writes data to a socket.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Data = iodata()</v> - </type> <desc> - <p>Writes <c>Data</c> to <c>Socket</c>.</p> + <p>Writes <c>Data</c> to <c>SslSocket</c>.</p> <p>A notable return value is <c>{error, closed}</c> indicating that the socket is closed.</p> </desc> </func> <func> - <name since="">setopts(SslSocket, Options) -> ok | {error, Reason}</name> + <name since="" name="setopts" arity="2" /> <fsummary>Sets socket options.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Options = <seealso marker="#type-socket_option"> [socket_option()] </seealso></v> - </type> <desc> <p>Sets options according to <c>Options</c> for socket - <c>Socket</c>.</p> + <c>SslSocket</c>.</p> </desc> </func> <func> - <name since="OTP R14B">shutdown(SslSocket, How) -> ok | {error, Reason}</name> + <name since="OTP R14B" name="shutdown" arity="2" /> <fsummary>Immediately closes a socket.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>How = read | write | read_write</v> - <v>Reason = reason()</v> - </type> <desc> <p>Immediately closes a socket in one or two directions.</p> <p><c>How == write</c> means closing the socket for writing, @@ -1686,14 +1519,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">ssl_accept(SslSocket) -> </name> - <name since="">ssl_accept(SslSocket, Timeout) -> ok | {error, Reason}</name> + <name since="" name="ssl_accept" arity="1" /> + <name since="" name="ssl_accept" arity="2" /> <fsummary>Performs server-side SSL/TLS handshake.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Timeout = timeout()</v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc> <p>Deprecated in OTP 21, use <seealso marker="#handshake-1">handshake/[1,2]</seealso> instead.</p> <note><p>handshake/[1,2] always returns a new socket.</p></note> @@ -1701,15 +1529,8 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">ssl_accept(Socket, Options) -> </name> - <name since="OTP R14B">ssl_accept(Socket, Options, Timeout) -> {ok, Socket} | ok | {error, Reason}</name> + <name since="OTP R14B" name="ssl_accept" arity="3" /> <fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary> - <type> - <v>Socket = socket() | <seealso marker="#type-sslsocket"> sslsocket() </seealso> </v> - <v>Options = <seealso marker="#type-tls_server_option"> [server_option()] </seealso> </v> - <v>Timeout = timeout()</v> - <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v> - </type> <desc> <p>Deprecated in OTP 21, use <seealso marker="#handshake-3">handshake/[2,3]</seealso> instead.</p> <note><p>handshake/[2,3] always returns a new socket.</p></note> @@ -1717,27 +1538,18 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="">sockname(SslSocket) -> {ok, {Address, Port}} | - {error, Reason}</name> + <name since="" name="sockname" arity="1" /> <fsummary>Returns the local address and port.</fsummary> - <type> - <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Address = <seealso marker="#type-ip_address">ip_address()</seealso></v> - <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v> - </type> <desc> <p>Returns the local address and port number of socket - <c>Socket</c>.</p> + <c>SslSocket</c>.</p> </desc> </func> <func> - <name since="OTP R14B">start() -> </name> + <name since="OTP R14B" name="start" arity="0" /> <name since="OTP R14B">start(Type) -> ok | {error, Reason}</name> <fsummary>Starts the SSL application.</fsummary> - <type> - <v>Type = permanent | transient | temporary</v> - </type> <desc> <p>Starts the SSL application. Default type is <c>temporary</c>.</p> @@ -1745,7 +1557,7 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R14B">stop() -> ok </name> + <name since="OTP R14B" name="stop" arity="0" /> <fsummary>Stops the SSL application.</fsummary> <desc> <p>Stops the SSL application.</p> @@ -1753,28 +1565,18 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP 21.0">suite_to_str(CipherSuite) -> String</name> + <name since="OTP 21.0" name="suite_to_str" arity="1" clause_i="1" /> <fsummary>Returns the string representation of a cipher suite.</fsummary> - <type> - <v>CipherSuite = <seealso marker="#type-erl_cipher_suite"> erl_cipher_suite() </seealso></v> - <v>String = string()</v> - </type> <desc> <p>Returns the string representation of a cipher suite.</p> </desc> </func> <func> - <name since="">transport_accept(ListenSocket) -></name> - <name since="">transport_accept(ListenSocket, Timeout) -> - {ok, SslSocket} | {error, Reason}</name> + <name since="" name="transport_accept" arity="1" /> + <name since="" name="transport_accept" arity="2" /> <fsummary>Accepts an incoming connection and prepares for <c>ssl_accept</c>.</fsummary> - <type> - <v>ListenSocket = SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v> - <v>Timeout = timeout()</v> - <v>Reason = reason()</v> - </type> <desc> <p>Accepts an incoming connection request on a listen socket. <c>ListenSocket</c> must be a socket returned from @@ -1800,13 +1602,9 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name since="OTP R14B">versions() -> [versions_info()]</name> + <name since="OTP R14B" name="versions" arity="0" /> <fsummary>Returns version information relevant for the SSL application.</fsummary> - <type> - <v>versions_info() = {app_vsn, string()} | {supported | available, [ssl_tls_protocol()]} | - {supported_dtls | available_dtls, [dtls_protocol()]} </v> - </type> <desc> <p>Returns version information relevant for the SSL application.</p> diff --git a/lib/ssl/doc/src/standards_compliance.xml b/lib/ssl/doc/src/standards_compliance.xml index c20bab4e50..ca98385f85 100644 --- a/lib/ssl/doc/src/standards_compliance.xml +++ b/lib/ssl/doc/src/standards_compliance.xml @@ -126,8 +126,34 @@ <section> <title>TLS 1.3</title> - <p> This section describes the current state of standards compliance for TLS 1.3.</p> - <p>(C = Compliant, NC = Non-Compliant, P = Partially-Compliant, NA = Not Applicable)</p> + <p>OTP-22 introduces basic support for TLS 1.3 on the server side. Basic functionality + covers a simple TLS 1.3 handshake with support of the mandatory extensions + (supported_groups, signature_algorithms, key_share, supported_versions and + signature_algorithms_cert). The server supports a selective set of cryptographic algorithms:</p> + <list type="bulleted"> + <item>Key Exchange: ECDHE</item> + <item>Groups: all standard groups supported for the Diffie-Hellman key exchange</item> + <item>Ciphers: TLS_AES_128_GCM_SHA256, TLS_AES_256_GCM_SHA384, + TLS_CHACHA20_POLY1305_SHA256 and TLS_AES_128_CCM_SHA256</item> + <item>Signature Algorithms: RSA and RSA PSS</item> + <item>Certificates: currently only certificates with RSA keys are supported</item> + </list> + <p>Other notable features:</p> + <list type="bulleted"> + <item>The server supports the HelloRetryRequest mechanism</item> + <item>PSK and session resumption not supported</item> + <item>Early data and 0-RTT not supported</item> + <item>Key and Initialization Vector Update not supported</item> + </list> + <p>For more detailed information see the + <seealso marker="#soc_table">Standards Compliance</seealso> below.</p> + <warning><p>Note that the client side is not yet functional. It is planned to be released + later in OTP-22.</p></warning> + + <p> The following table describes the current state of standards compliance for TLS 1.3.</p> + <p>(<em>C</em> = Compliant, <em>NC</em> = Non-Compliant, <em>PC</em> = Partially-Compliant, + <em>NA</em> = Not Applicable)</p> + <marker id="soc_table"/> <table> <row> <cell align="left" valign="middle"><em>Section</em></cell> @@ -155,7 +181,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle">RSASSA-PSS signature schemes</cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle">22</cell> </row> <row> @@ -178,7 +204,7 @@ </url> </cell> <cell align="left" valign="middle"></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -240,7 +266,7 @@ </url> </cell> <cell align="left" valign="middle"></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -783,7 +809,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>Server</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1265,7 +1291,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>Server</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1379,7 +1405,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>Server</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1456,7 +1482,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>Server</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1527,7 +1553,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>Server</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em></em></cell> </row> <row> @@ -1762,7 +1788,7 @@ </url> </cell> <cell align="left" valign="middle"><em></em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1924,7 +1950,7 @@ </url> </cell> <cell align="left" valign="middle"><em></em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1942,14 +1968,14 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle">SHOULD implement the TLS_CHACHA20_POLY1305_SHA256</cell> - <cell align="left" valign="middle"><em>NC</em></cell> - <cell align="left" valign="middle"></cell> + <cell align="left" valign="middle"><em>C</em></cell> + <cell align="left" valign="middle">22</cell> </row> <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>Digital signatures</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -1997,7 +2023,7 @@ </url> </cell> <cell align="left" valign="middle"><em></em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -2108,7 +2134,7 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle"><em>TLS 1.3 ServerHello</em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -2160,7 +2186,7 @@ </url> </cell> <cell align="left" valign="middle"><em></em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> <row> @@ -2178,14 +2204,14 @@ <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle">TLS_CHACHA20_POLY1305_SHA256</cell> - <cell align="left" valign="middle"><em>NC</em></cell> - <cell align="left" valign="middle"></cell> + <cell align="left" valign="middle"><em>C</em></cell> + <cell align="left" valign="middle">22</cell> </row> <row> <cell align="left" valign="middle"></cell> <cell align="left" valign="middle">TLS_AES_128_CCM_SHA256</cell> - <cell align="left" valign="middle"><em>NC</em></cell> - <cell align="left" valign="middle"></cell> + <cell align="left" valign="middle"><em>C</em></cell> + <cell align="left" valign="middle">22</cell> </row> <row> <cell align="left" valign="middle"></cell> @@ -2223,7 +2249,7 @@ </url> </cell> <cell align="left" valign="middle"><em></em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> @@ -2289,7 +2315,7 @@ </url> </cell> <cell align="left" valign="middle"><em></em></cell> - <cell align="left" valign="middle"><em>P</em></cell> + <cell align="left" valign="middle"><em>PC</em></cell> <cell align="left" valign="middle"><em>22</em></cell> </row> diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 30b2ab7c4f..e070006900 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -67,7 +67,7 @@ %% Setup %%==================================================================== start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} = Opts, - User, {CbModule, _,_, _} = CbInfo, + User, {CbModule, _, _, _, _} = CbInfo, Timeout) -> try {ok, Pid} = dtls_connection_sup:start_child([Role, Host, Port, Socket, @@ -147,13 +147,16 @@ next_record(#state{static_env = #static_env{role = server, socket = {Listener, {Client, _}}}} = State) -> dtls_packet_demux:active_once(Listener, Client, self()), {no_record, State}; -next_record(#state{static_env = #static_env{role = client, +next_record(#state{protocol_specific = #{active_n_toggle := true, + active_n := N} = ProtocolSpec, + static_env = #static_env{role = client, socket = {_Server, Socket} = DTLSSocket, close_tag = CloseTag, transport_cb = Transport}} = State) -> - case dtls_socket:setopts(Transport, Socket, [{active,once}]) of + case dtls_socket:setopts(Transport, Socket, [{active,N}]) of ok -> - {no_record, State}; + {no_record, State#state{protocol_specific = + ProtocolSpec#{active_n_toggle => false}}}; _ -> self() ! {CloseTag, DTLSSocket}, {no_record, State} @@ -193,7 +196,8 @@ next_event(StateName, no_record, %% TODO maybe buffer later epoch next_event(StateName, no_record, State, Actions); {#alert{} = Alert, State} -> - {next_state, StateName, State, [{next_event, internal, Alert} | Actions]} + Version = State#state.connection_env#connection_env.negotiated_version, + handle_own_alert(Alert, Version, StateName, State) end; next_event(connection = StateName, Record, #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) -> @@ -233,7 +237,8 @@ next_event(StateName, Record, %% TODO maybe buffer later epoch next_event(StateName, no_record, State0, Actions); #alert{} = Alert -> - {next_state, StateName, State0, [{next_event, internal, Alert} | Actions]} + Version = State0#state.connection_env#connection_env.negotiated_version, + handle_own_alert(Alert, Version, StateName, State0) end. %%% DTLS record protocol level application data messages @@ -289,9 +294,10 @@ handle_protocol_record(#ssl_tls{type = _Unknown}, StateName, State) -> %% Handshake handling %%==================================================================== -renegotiate(#state{static_env = #static_env{role = client}} = State, Actions) -> +renegotiate(#state{static_env = #static_env{role = client}} = State0, Actions) -> %% Handle same way as if server requested %% the renegotiation + State = reinit_handshake_data(State0), {next_state, connection, State, [{next_event, internal, #hello_request{}} | Actions]}; @@ -449,8 +455,7 @@ init({call, From}, {start, Timeout}, session = Session0#session{session_id = Hello#client_hello.session_id}, start_or_recv_from = From}, - {Record, State} = next_record(State3), - next_event(hello, Record, State, [{{timeout, handshake}, Timeout, close} | Actions]); + next_event(hello, no_record, State3, [{{timeout, handshake}, Timeout, close} | Actions]); init({call, _} = Type, Event, #state{static_env = #static_env{role = server}, protocol_specific = PS} = State) -> Result = gen_handshake(?FUNCTION_NAME, Type, Event, @@ -508,9 +513,8 @@ hello(internal, #client_hello{cookie = <<>>, %% negotiated. VerifyRequest = dtls_handshake:hello_verify_request(Cookie, ?HELLO_VERIFY_REQUEST_VERSION), State1 = prepare_flight(State0#state{connection_env = CEnv#connection_env{negotiated_version = Version}}), - {State2, Actions} = send_handshake(VerifyRequest, State1), - {Record, State} = next_record(State2), - next_event(?FUNCTION_NAME, Record, + {State, Actions} = send_handshake(VerifyRequest, State1), + next_event(?FUNCTION_NAME, no_record, State#state{handshake_env = HsEnv#handshake_env{ tls_handshake_history = ssl_handshake:init_handshake_history()}}, @@ -712,12 +716,10 @@ connection(internal, #hello_request{}, #state{static_env = #static_env{host = Ho HelloVersion = dtls_record:hello_version(Version, SslOpts#ssl_options.versions), State1 = prepare_flight(State0), {State2, Actions} = send_handshake(Hello, State1#state{connection_env = CEnv#connection_env{negotiated_version = HelloVersion}}), - {Record, State} = - next_record( - State2#state{protocol_specific = PS#{flight_state => initial_flight_state(DataTag)}, - session = Session0#session{session_id - = Hello#client_hello.session_id}}), - next_event(hello, Record, State, Actions); + State = State2#state{protocol_specific = PS#{flight_state => initial_flight_state(DataTag)}, + session = Session0#session{session_id + = Hello#client_hello.session_id}}, + next_event(hello, no_record, State, Actions); connection(internal, #client_hello{} = Hello, #state{static_env = #static_env{role = server}, handshake_env = #handshake_env{allow_renegotiate = true} = HsEnv} = State) -> %% Mitigate Computational DoS attack @@ -773,7 +775,7 @@ format_status(Type, Data) -> %%% Internal functions %%-------------------------------------------------------------------- initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, - {CbModule, DataTag, CloseTag, ErrorTag}) -> + {CbModule, DataTag, CloseTag, ErrorTag, PassiveTag}) -> #ssl_options{beast_mitigation = BeastMitigation} = SSLOptions, ConnectionStates = dtls_record:init_connection_states(Role, BeastMitigation), @@ -783,7 +785,12 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, _ -> ssl_session_cache end, - + InternalActiveN = case application:get_env(ssl, internal_active_n) of + {ok, N} when is_integer(N) -> + N; + _ -> + ?INTERNAL_ACTIVE_N + end, Monitor = erlang:monitor(process, User), InitStatEnv = #static_env{ role = Role, @@ -792,6 +799,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, data_tag = DataTag, close_tag = CloseTag, error_tag = ErrorTag, + passive_tag = PassiveTag, host = Host, port = Port, socket = Socket, @@ -815,7 +823,9 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, user_data_buffer = {[],0,[]}, start_or_recv_from = undefined, flight_buffer = new_flight(), - protocol_specific = #{flight_state => initial_flight_state(DataTag)} + protocol_specific = #{active_n => InternalActiveN, + active_n_toggle => true, + flight_state => initial_flight_state(DataTag)} }. initial_flight_state(udp)-> @@ -912,12 +922,21 @@ handle_info({Protocol, _, _, _, Data}, StateName, ssl_connection:handle_normal_shutdown(Alert, StateName, State0), {stop, {shutdown, own_alert}, State0} end; + +handle_info({PassiveTag, Socket}, StateName, + #state{static_env = #static_env{socket = {_, Socket}, + passive_tag = PassiveTag}, + protocol_specific = PS} = State) -> + next_event(StateName, no_record, + State#state{protocol_specific = PS#{active_n_toggle => true}}); + handle_info({CloseTag, Socket}, StateName, #state{static_env = #static_env{socket = Socket, close_tag = CloseTag}, connection_env = #connection_env{negotiated_version = Version}, socket_options = #socket_options{active = Active}, - protocol_buffers = #protocol_buffers{dtls_cipher_texts = CTs}} = State) -> + protocol_buffers = #protocol_buffers{dtls_cipher_texts = CTs}, + protocol_specific = PS} = State) -> %% Note that as of DTLS 1.2 (TLS 1.1), %% failure to properly close a connection no longer requires that a %% session not be resumed. This is a change from DTLS 1.0 to conform @@ -940,7 +959,8 @@ handle_info({CloseTag, Socket}, StateName, %% Fixes non-delivery of final DTLS record in {active, once}. %% Basically allows the application the opportunity to set {active, once} again %% and then receive the final message. - next_event(StateName, no_record, State) + next_event(StateName, no_record, State#state{ + protocol_specific = PS#{active_n_toggle => true}}) end; handle_info(new_cookie_secret, StateName, @@ -1075,10 +1095,10 @@ start_retransmision_timer(Timeout, #state{protocol_specific = PS} = State) -> {State#state{protocol_specific = PS#{flight_state => {retransmit, new_timeout(Timeout)}}}, [{state_timeout, Timeout, flight_retransmission_timeout}]}. -new_timeout(N) when N =< 30 -> +new_timeout(N) when N =< 30000 -> N * 2; new_timeout(_) -> - 60. + 60000. send_handshake_flight(#state{static_env = #static_env{socket = Socket, transport_cb = Transport}, diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 46e8348ce0..d8c0e30973 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -193,7 +193,7 @@ handle_client_hello(Version, no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY); _ -> - #{key_exchange := KeyExAlg} = ssl_cipher_format:suite_definition(CipherSuite), + #{key_exchange := KeyExAlg} = ssl_cipher_format:suite_bin_to_map(CipherSuite), case ssl_handshake:select_hashsign({ClientHashSigns, undefined}, Cert, KeyExAlg, SupportedHashSigns, TLSVersion) of #alert{} = Alert -> @@ -427,74 +427,135 @@ merge_fragment(Frag0, [Frag1 | Rest]) -> Frag -> merge_fragment(Frag, Rest) end. -%% Duplicate + + +%% Duplicate (fully contained fragment) +%% 2,5 _ _ P P P P P +%% 2,5 _ _ C C C C C merge_fragments(#handshake_fragment{ - fragment_offset = PreviousOffSet, + fragment_offset = PreviousOffSet, fragment_length = PreviousLen, fragment = PreviousData - } = Previous, + } = Previous, #handshake_fragment{ fragment_offset = PreviousOffSet, fragment_length = PreviousLen, fragment = PreviousData}) -> Previous; -%% Lager fragment save new data +%% Duplicate (fully contained fragment) +%% 2,5 _ _ P P P P P +%% 2,2 _ _ C C +%% 0,3 X X X +%% 5,3 _ _ _ _ _ X X X merge_fragments(#handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = PreviousLen, + fragment_offset = PreviousOffset, + fragment_length = PreviousLen + } = Previous, + #handshake_fragment{ + fragment_offset = CurrentOffset, + fragment_length = CurrentLen}) + when PreviousOffset =< CurrentOffset andalso + CurrentOffset =< PreviousOffset + PreviousLen andalso + CurrentOffset + CurrentLen =< PreviousOffset + PreviousLen -> + Previous; + +%% Fully overlapping fragments +%% 2,5 _ _ P P P P P +%% 0,8 C C C C C C C C +merge_fragments(#handshake_fragment{ + fragment_offset = PreviousOffset, + fragment_length = PreviousLen + }, + #handshake_fragment{ + fragment_offset = CurrentOffset, + fragment_length = CurrentLen} = Current) + when CurrentOffset =< PreviousOffset andalso + CurrentOffset + CurrentLen >= PreviousOffset + PreviousLen -> + Current; + +%% Overlapping fragments +%% 2,5 _ _ P P P P P +%% 0,3 C C C +merge_fragments(#handshake_fragment{ + fragment_offset = PreviousOffset, + fragment_length = PreviousLen, fragment = PreviousData - } = Previous, - #handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = CurrentLen, - fragment = CurrentData}) when CurrentLen > PreviousLen -> - NewLength = CurrentLen - PreviousLen, - <<_:PreviousLen/binary, NewData/binary>> = CurrentData, + } = Previous, + #handshake_fragment{ + fragment_offset = CurrentOffset, + fragment_length = CurrentLen, + fragment = CurrentData}) + when CurrentOffset < PreviousOffset andalso + CurrentOffset + CurrentLen < PreviousOffset + PreviousLen -> + NewDataLen = PreviousOffset - CurrentOffset, + <<NewData:NewDataLen/binary, _/binary>> = CurrentData, Previous#handshake_fragment{ - fragment_length = PreviousLen + NewLength, - fragment = <<PreviousData/binary, NewData/binary>> + fragment_length = PreviousLen + NewDataLen, + fragment = <<NewData/binary, PreviousData/binary>> }; -%% Smaller fragment +%% Overlapping fragments +%% 2,5 _ _ P P P P P +%% 5,3 _ _ _ _ _ C C C merge_fragments(#handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = PreviousLen - } = Previous, - #handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = CurrentLen}) when CurrentLen < PreviousLen -> - Previous; -%% Next fragment, might be overlapping + fragment_offset = PreviousOffset, + fragment_length = PreviousLen, + fragment = PreviousData + } = Previous, + #handshake_fragment{ + fragment_offset = CurrentOffset, + fragment_length = CurrentLen, + fragment = CurrentData}) + when CurrentOffset > PreviousOffset andalso + CurrentOffset < PreviousOffset + PreviousLen -> + NewDataLen = CurrentOffset + CurrentLen - (PreviousOffset + PreviousLen), + DropLen = CurrentLen - NewDataLen, + <<_:DropLen/binary, NewData/binary>> = CurrentData, + Previous#handshake_fragment{ + fragment_length = PreviousLen + NewDataLen, + fragment = <<PreviousData/binary, NewData/binary>> + }; + +%% Adjacent fragments +%% 2,5 _ _ P P P P P +%% 7,3 _ _ _ _ _ _ _ C C C merge_fragments(#handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = PreviousLen, + fragment_offset = PreviousOffset, + fragment_length = PreviousLen, fragment = PreviousData - } = Previous, - #handshake_fragment{ - fragment_offset = CurrentOffSet, - fragment_length = CurrentLen, - fragment = CurrentData}) - when PreviousOffSet + PreviousLen >= CurrentOffSet andalso - PreviousOffSet + PreviousLen < CurrentOffSet + CurrentLen -> - CurrentStart = PreviousOffSet + PreviousLen - CurrentOffSet, - <<_:CurrentStart/bytes, Data/binary>> = CurrentData, + } = Previous, + #handshake_fragment{ + fragment_offset = CurrentOffset, + fragment_length = CurrentLen, + fragment = CurrentData}) + when CurrentOffset =:= PreviousOffset + PreviousLen -> Previous#handshake_fragment{ - fragment_length = PreviousLen + CurrentLen - CurrentStart, - fragment = <<PreviousData/binary, Data/binary>>}; -%% already fully contained fragment + fragment_length = PreviousLen + CurrentLen, + fragment = <<PreviousData/binary, CurrentData/binary>> + }; + +%% Adjacent fragments +%% 2,5 _ _ P P P P P +%% 0,2 C C merge_fragments(#handshake_fragment{ - fragment_offset = PreviousOffSet, - fragment_length = PreviousLen - } = Previous, + fragment_offset = PreviousOffset, + fragment_length = PreviousLen, + fragment = PreviousData + } = Previous, #handshake_fragment{ - fragment_offset = CurrentOffSet, - fragment_length = CurrentLen}) - when PreviousOffSet + PreviousLen >= CurrentOffSet andalso - PreviousOffSet + PreviousLen >= CurrentOffSet + CurrentLen -> - Previous; + fragment_offset = CurrentOffset, + fragment_length = CurrentLen, + fragment = CurrentData}) + when PreviousOffset =:= CurrentOffset + CurrentLen -> + Previous#handshake_fragment{ + fragment_length = PreviousLen + CurrentLen, + fragment = <<CurrentData/binary, PreviousData/binary>> + }; %% No merge there is a gap +%% 3,5 _ _ _ P P P P +%% 0,2 C C merge_fragments(Previous, Current) -> [Previous, Current]. diff --git a/lib/ssl/src/dtls_packet_demux.erl b/lib/ssl/src/dtls_packet_demux.erl index e0423b07b4..c6431b55a9 100644 --- a/lib/ssl/src/dtls_packet_demux.erl +++ b/lib/ssl/src/dtls_packet_demux.erl @@ -35,7 +35,8 @@ terminate/2, code_change/3]). -record(state, - {port, + {active_n, + port, listener, transport, dtls_options, @@ -76,10 +77,18 @@ set_sock_opts(PacketSocket, Opts) -> %%% gen_server callbacks %%%=================================================================== -init([Port, {TransportModule, _,_,_} = TransportInfo, EmOpts, InetOptions, DTLSOptions]) -> +init([Port, {TransportModule, _,_,_,_} = TransportInfo, EmOpts, InetOptions, DTLSOptions]) -> try {ok, Socket} = TransportModule:open(Port, InetOptions), - {ok, #state{port = Port, + InternalActiveN = case application:get_env(ssl, internal_active_n) of + {ok, N} when is_integer(N) -> + N; + _ -> + ?INTERNAL_ACTIVE_N + end, + + {ok, #state{active_n = InternalActiveN, + port = Port, first = true, transport = TransportInfo, dtls_options = DTLSOptions, @@ -92,10 +101,11 @@ init([Port, {TransportModule, _,_,_} = TransportInfo, EmOpts, InetOptions, DTLSO handle_call({accept, _}, _, #state{close = true} = State) -> {reply, {error, closed}, State}; -handle_call({accept, Accepter}, From, #state{first = true, +handle_call({accept, Accepter}, From, #state{active_n = N, + first = true, accepters = Accepters, listener = Socket} = State0) -> - next_datagram(Socket), + next_datagram(Socket, N), State = State0#state{first = false, accepters = queue:in({Accepter, From}, Accepters)}, {noreply, State}; @@ -137,19 +147,24 @@ handle_cast({active_once, Client, Pid}, State0) -> State = handle_active_once(Client, Pid, State0), {noreply, State}. -handle_info({Transport, Socket, IP, InPortNo, _} = Msg, #state{listener = Socket, transport = {_,Transport,_,_}} = State0) -> +handle_info({Transport, Socket, IP, InPortNo, _} = Msg, #state{listener = Socket, transport = {_,Transport,_,_,_}} = State0) -> State = handle_datagram({IP, InPortNo}, Msg, State0), - next_datagram(Socket), {noreply, State}; +handle_info({PassiveTag, Socket}, + #state{active_n = N, + listener = Socket, + transport = {_,_,_, udp_error, PassiveTag}}) -> + next_datagram(Socket, N); + %% UDP socket does not have a connection and should not receive an econnreset %% This does however happens on some windows versions. Just ignoring it %% appears to make things work as expected! -handle_info({udp_error, Socket, econnreset = Error}, #state{listener = Socket, transport = {_,_,_, udp_error}} = State) -> +handle_info({udp_error, Socket, econnreset = Error}, #state{listener = Socket, transport = {_,_,_, udp_error,_}} = State) -> Report = io_lib:format("Ignore SSL UDP Listener: Socket error: ~p ~n", [Error]), ?LOG_NOTICE(Report), {noreply, State}; -handle_info({ErrorTag, Socket, Error}, #state{listener = Socket, transport = {_,_,_, ErrorTag}} = State) -> +handle_info({ErrorTag, Socket, Error}, #state{listener = Socket, transport = {_,_,_, ErrorTag,_}} = State) -> Report = io_lib:format("SSL Packet muliplxer shutdown: Socket error: ~p ~n", [Error]), ?LOG_NOTICE(Report), {noreply, State#state{close=true}}; @@ -203,16 +218,16 @@ dispatch(Client, Msg, #state{dtls_msq_queues = MsgQueues} = State) -> Pid ! Msg, State#state{dtls_msq_queues = kv_update(Client, Queue, MsgQueues)}; - {{value, _}, Queue} -> + {{value, _UDP}, _Queue} -> State#state{dtls_msq_queues = - kv_update(Client, queue:in(Msg, Queue), MsgQueues)}; + kv_update(Client, queue:in(Msg, Queue0), MsgQueues)}; {empty, Queue} -> State#state{dtls_msq_queues = kv_update(Client, queue:in(Msg, Queue), MsgQueues)} end end. -next_datagram(Socket) -> - inet:setopts(Socket, [{active, once}]). +next_datagram(Socket, N) -> + inet:setopts(Socket, [{active, N}]). handle_active_once(Client, Pid, #state{dtls_msq_queues = MsgQueues} = State0) -> Queue0 = kv_get(Client, MsgQueues), diff --git a/lib/ssl/src/dtls_socket.erl b/lib/ssl/src/dtls_socket.erl index 4d07372e31..b305d08f70 100644 --- a/lib/ssl/src/dtls_socket.erl +++ b/lib/ssl/src/dtls_socket.erl @@ -45,7 +45,7 @@ listen(Port, #config{transport_info = TransportInfo, Err end. -accept(dtls, #config{transport_info = {Transport,_,_,_}, +accept(dtls, #config{transport_info = {Transport,_,_,_,_}, connection_cb = ConnectionCb, dtls_handler = {Listner, _}}, _Timeout) -> case dtls_packet_demux:accept(Listner, self()) of @@ -55,7 +55,7 @@ accept(dtls, #config{transport_info = {Transport,_,_,_}, {error, Reason} end. -connect(Address, Port, #config{transport_info = {Transport, _, _, _} = CbInfo, +connect(Address, Port, #config{transport_info = {Transport, _, _, _, _} = CbInfo, connection_cb = ConnectionCb, ssl = SslOpts, emulated = EmOpts, @@ -174,7 +174,7 @@ default_inet_values() -> [{active, true}, {mode, list}, {packet, 0}, {packet_size, 0}]. default_cb_info() -> - {gen_udp, udp, udp_closed, udp_error}. + {gen_udp, udp, udp_closed, udp_error, udp_passive}. get_emulated_opts(EmOpts, EmOptNames) -> lists:map(fun(Name) -> {value, Value} = lists:keysearch(Name, 1, EmOpts), diff --git a/lib/ssl/src/dtls_v1.erl b/lib/ssl/src/dtls_v1.erl index b365961a6a..fc9dce02ce 100644 --- a/lib/ssl/src/dtls_v1.erl +++ b/lib/ssl/src/dtls_v1.erl @@ -31,18 +31,18 @@ suites(Minor) -> lists:filter(fun(Cipher) -> - is_acceptable_cipher(ssl_cipher_format:suite_definition(Cipher)) + is_acceptable_cipher(ssl_cipher_format:suite_bin_to_map(Cipher)) end, tls_v1:suites(corresponding_minor_tls_version(Minor))). all_suites(Version) -> lists:filter(fun(Cipher) -> - is_acceptable_cipher(ssl_cipher_format:suite_definition(Cipher)) + is_acceptable_cipher(ssl_cipher_format:suite_bin_to_map(Cipher)) end, ssl_cipher:all_suites(corresponding_tls_version(Version))). anonymous_suites(Version) -> lists:filter(fun(Cipher) -> - is_acceptable_cipher(ssl_cipher_format:suite_definition(Cipher)) + is_acceptable_cipher(ssl_cipher_format:suite_bin_to_map(Cipher)) end, ssl_cipher:anonymous_suites(corresponding_tls_version(Version))). diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index e7fab7ebc5..8d9b92361b 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2018. All Rights Reserved. +%% Copyright Ericsson AB 2011-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -132,8 +132,8 @@ f_recv(SslSocket, Length, Timeout) -> f_setopts_pre_nodeup(_SslSocket) -> ok. -f_setopts_post_nodeup(_SslSocket) -> - ok. +f_setopts_post_nodeup(SslSocket) -> + ssl:setopts(SslSocket, [nodelay()]). f_getll(DistCtrl) -> {ok, DistCtrl}. @@ -199,7 +199,7 @@ listen(Name) -> gen_listen(Driver, Name) -> case inet_tcp_dist:gen_listen(Driver, Name) of {ok, {Socket, Address, Creation}} -> - inet:setopts(Socket, [{packet, 4}]), + inet:setopts(Socket, [{packet, 4}, {nodelay, true}]), {ok, {Socket, Address#net_address{protocol=tls}, Creation}}; Other -> Other @@ -532,7 +532,7 @@ do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNo case ssl:connect( Address, TcpPort, [binary, {active, false}, {packet, 4}, - Driver:family(), nodelay()] ++ Opts, + Driver:family(), {nodelay, true}] ++ Opts, net_kernel:connecttime()) of {ok, #sslsocket{pid = [_, DistCtrl| _]} = SslSocket} -> _ = monitor_pid(DistCtrl), diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index c7c96370b3..e3bb4df1ac 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -86,41 +86,46 @@ srp_param_type/0]). %% ------------------------------------------------------------------------------------------------------- --type socket() :: gen_tcp:socket(). --type socket_option() :: gen_tcp:connect_option() | gen_tcp:listen_option() | gen_udp:option(). --type sslsocket() :: any(). --type tls_option() :: tls_client_option() | tls_server_option(). --type tls_client_option() :: client_option() | common_option() | socket_option() | transport_option(). --type tls_server_option() :: server_option() | common_option() | socket_option() | transport_option(). + +-type socket() :: gen_tcp:socket(). % exported +-type socket_option() :: gen_tcp:connect_option() | gen_tcp:listen_option() | gen_udp:option(). % exported +-type sslsocket() :: any(). % exported +-type tls_option() :: tls_client_option() | tls_server_option(). % exported +-type tls_client_option() :: client_option() | common_option() | socket_option() | transport_option(). % exported +-type tls_server_option() :: server_option() | common_option() | socket_option() | transport_option(). % exported -type active_msgs() :: {ssl, sslsocket(), Data::binary() | list()} | {ssl_closed, sslsocket()} | - {ssl_error, sslsocket(), Reason::term()} | {ssl_passive, sslsocket()}. + {ssl_error, sslsocket(), Reason::any()} | {ssl_passive, sslsocket()}. % exported -type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom(), ErrTag::atom()}} | {cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom(), ErrTag::atom(), PassiveTag::atom()}}. --type host() :: hostname() | ip_address(). +-type host() :: hostname() | ip_address(). % exported -type hostname() :: string(). -type ip_address() :: inet:ip_address(). --type session_id() :: binary(). --type protocol_version() :: tls_version() | dtls_version(). +-type session_id() :: binary(). % exported +-type protocol_version() :: tls_version() | dtls_version(). % exported -type tls_version() :: 'tlsv1.2' | 'tlsv1.3' | tls_legacy_version(). -type dtls_version() :: 'dtlsv1.2' | dtls_legacy_version(). -type tls_legacy_version() :: tlsv1 | 'tlsv1.1' | sslv3. --type dtls_legacy_version() :: 'dtlsv1'. +-type dtls_legacy_version() :: 'dtlsv1'. -type verify_type() :: verify_none | verify_peer. -type cipher() :: aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | + aes_128_ccm | + aes_256_ccm | + aes_128_ccm_8 | + aes_256_ccm_8 | chacha20_poly1305 | - legacy_cipher(). + legacy_cipher(). % exported -type legacy_cipher() :: rc4_128 | des_cbc | '3des_ede_cbc'. -type hash() :: sha | sha2() | - legacy_hash(). + legacy_hash(). % exported -type sha2() :: sha224 | sha256 | @@ -129,7 +134,7 @@ -type legacy_hash() :: md5. --type sign_algo() :: rsa | dsa | ecdsa. +-type sign_algo() :: rsa | dsa | ecdsa. % exported -type sign_scheme() :: rsa_pkcs1_sha256 | rsa_pkcs1_sha384 @@ -151,7 +156,7 @@ srp_rsa| srp_dss | psk | dhe_psk | rsa_psk | dh_anon | ecdh_anon | srp_anon | - any. %% TLS 1.3 + any. %% TLS 1.3 , exported -type erl_cipher_suite() :: #{key_exchange := kex_algo(), cipher := cipher(), mac := hash() | aead, @@ -191,15 +196,18 @@ secp160r1 | secp160r2. +-type group() :: secp256r1 | secp384r1 | secp521r1 | ffdhe2048 | + ffdhe3072 | ffdhe4096 | ffdhe6144 | ffdhe8192. + -type srp_param_type() :: srp_1024 | srp_1536 | srp_2048 | srp_3072 | srp_4096 | srp_6144 | - srp_8192. + srp_8192. % exported --type error_alert() :: {tls_alert, {tls_alert(), Description::string()}}. +-type error_alert() :: {tls_alert, {tls_alert(), Description::string()}}. % exported -type tls_alert() :: close_notify | unexpected_message | @@ -230,6 +238,7 @@ bad_certificate_hash_value | unknown_psk_identity | no_application_protocol. + %% ------------------------------------------------------------------------------------------------------- -type common_option() :: {protocol, protocol()} | {handshake, handshake_completion()} | @@ -239,7 +248,7 @@ {keyfile, key_pem()} | {password, key_password()} | {ciphers, cipher_suites()} | - {eccs, eccs()} | + {eccs, [named_curve()]} | {signature_algs_cert, signature_schemes()} | {secure_renegotiate, secure_renegotiation()} | {depth, allowed_cert_chain_length()} | @@ -266,29 +275,28 @@ #{algorithm := rsa | dss | ecdsa, engine := crypto:engine_ref(), key_id := crypto:key_id(), - password => crypto:password()}. + password => crypto:password()}. % exported -type key_pem() :: file:filename(). -type key_password() :: string(). -type cipher_suites() :: ciphers(). -type ciphers() :: [erl_cipher_suite()] | - string(). % (according to old API) + string(). % (according to old API) exported -type cipher_filters() :: list({key_exchange | cipher | mac | prf, - algo_filter()}). + algo_filter()}). % exported -type algo_filter() :: fun((kex_algo()|cipher()|hash()|aead|default_prf) -> true | false). --type eccs() :: [named_curve()]. -type secure_renegotiation() :: boolean(). -type allowed_cert_chain_length() :: integer(). --type custom_verify() :: {Verifyfun :: fun(), InitialUserState :: term()}. +-type custom_verify() :: {Verifyfun :: fun(), InitialUserState :: any()}. -type crl_check() :: boolean() | peer | best_effort. --type crl_cache_opts() :: [term()]. +-type crl_cache_opts() :: [any()]. -type handshake_size() :: integer(). -type hibernate_after() :: timeout(). -type root_fun() :: fun(). -type protocol_versions() :: [protocol_version()]. -type signature_algs() :: [{hash(), sign_algo()}]. -type signature_schemes() :: [sign_scheme()]. --type custom_user_lookup() :: {Lookupfun :: fun(), UserState :: term()}. +-type custom_user_lookup() :: {Lookupfun :: fun(), UserState :: any()}. -type padding_check() :: boolean(). -type beast_mitigation() :: one_n_minus_one | zero_n | disabled. -type srp_identity() :: {Username :: string(), Password :: string()}. @@ -371,7 +379,7 @@ -type honor_ecc_order() :: boolean(). -type client_renegotiation() :: boolean(). %% ------------------------------------------------------------------------------------------------------- --type prf_random() :: client_random | server_random. +-type prf_random() :: client_random | server_random. % exported -type protocol_extensions() :: #{renegotiation_info => binary(), signature_algs => signature_algs(), alpn => app_level_protocol(), @@ -379,7 +387,7 @@ next_protocol => app_level_protocol(), ec_point_formats => [0..2], elliptic_curves => [public_key:oid()], - sni => hostname()}. + sni => hostname()}. % exported %% ------------------------------------------------------------------------------------------------------- %%%-------------------------------------------------------------------- @@ -415,14 +423,31 @@ stop() -> %% %% Description: Connect to an ssl server. %%-------------------------------------------------------------------- --spec connect(host() | port(), [tls_client_option()]) -> {ok, #sslsocket{}} | - {error, reason()}. + +-spec connect(TCPSocket, TLSOptions) -> + {ok, sslsocket()} | + {error, reason()} | + {option_not_a_key_value_tuple, any()} when + TCPSocket :: socket(), + TLSOptions :: [tls_client_option()]. + connect(Socket, SslOptions) when is_port(Socket) -> connect(Socket, SslOptions, infinity). --spec connect(host() | port(), [tls_client_option()] | inet:port_number(), - timeout() | list()) -> - {ok, #sslsocket{}} | {error, reason()}. +-spec connect(TCPSocket, TLSOptions, Timeout) -> + {ok, sslsocket()} | {error, reason()} when + TCPSocket :: socket(), + TLSOptions :: [tls_client_option()], + Timeout :: timeout(); + (Host, Port, TLSOptions) -> + {ok, sslsocket()} | + {ok, sslsocket(),Ext :: protocol_extensions()} | + {error, reason()} | + {option_not_a_key_value_tuple, any()} when + Host :: host(), + Port :: inet:port_number(), + TLSOptions :: [tls_client_option()]. + connect(Socket, SslOptions0, Timeout) when is_port(Socket), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> CbInfo = handle_option(cb_info, SslOptions0, default_cb_info(tls)), @@ -439,8 +464,16 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket), connect(Host, Port, Options) -> connect(Host, Port, Options, infinity). --spec connect(host() | port(), inet:port_number(), list(), timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. + +-spec connect(Host, Port, TLSOptions, Timeout) -> + {ok, sslsocket()} | + {ok, sslsocket(),Ext :: protocol_extensions()} | + {error, reason()} | + {option_not_a_key_value_tuple, any()} when + Host :: host(), + Port :: inet:port_number(), + TLSOptions :: [tls_client_option()], + Timeout :: timeout(). connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> try @@ -457,7 +490,10 @@ connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout end. %%-------------------------------------------------------------------- --spec listen(inet:port_number(), [tls_server_option()]) ->{ok, #sslsocket{}} | {error, reason()}. +-spec listen(Port, Options) -> {ok, ListenSocket} | {error, reason()} when + Port::inet:port_number(), + Options::[tls_server_option()], + ListenSocket :: sslsocket(). %% %% Description: Creates an ssl listen socket. @@ -476,13 +512,20 @@ listen(Port, Options0) -> %% %% Description: Performs transport accept on an ssl listen socket %%-------------------------------------------------------------------- --spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} | - {error, reason()}. +-spec transport_accept(ListenSocket) -> {ok, SslSocket} | + {error, reason()} when + ListenSocket :: sslsocket(), + SslSocket :: sslsocket(). + transport_accept(ListenSocket) -> transport_accept(ListenSocket, infinity). --spec transport_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | - {error, reason()}. +-spec transport_accept(ListenSocket, Timeout) -> {ok, SslSocket} | + {error, reason()} when + ListenSocket :: sslsocket(), + Timeout :: timeout(), + SslSocket :: sslsocket(). + transport_accept(#sslsocket{pid = {ListenSocket, #config{connection_cb = ConnectionCb} = Config}}, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> @@ -498,12 +541,22 @@ transport_accept(#sslsocket{pid = {ListenSocket, %% Description: Performs accept on an ssl listen socket. e.i. performs %% ssl handshake. %%-------------------------------------------------------------------- --spec ssl_accept(#sslsocket{}) -> ok | {error, timeout | closed | {options, any()}| error_alert()}. +-spec ssl_accept(SslSocket) -> + ok | + {error, Reason} when + SslSocket :: sslsocket(), + Reason :: closed | timeout | error_alert(). + ssl_accept(ListenSocket) -> ssl_accept(ListenSocket, [], infinity). --spec ssl_accept(#sslsocket{} | port(), timeout()| [tls_server_option()]) -> - ok | {ok, #sslsocket{}} | {error, timeout | closed | {options, any()}| error_alert()}. +-spec ssl_accept(Socket, TimeoutOrOptions) -> + ok | + {ok, sslsocket()} | {error, Reason} when + Socket :: sslsocket() | socket(), + TimeoutOrOptions :: timeout() | [tls_server_option()], + Reason :: timeout | closed | {options, any()} | error_alert(). + ssl_accept(Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_accept(Socket, [], Timeout); ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> @@ -511,8 +564,13 @@ ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) -> ssl_accept(Socket, Timeout) -> ssl_accept(Socket, [], Timeout). --spec ssl_accept(#sslsocket{} | port(), [tls_server_option()], timeout()) -> - ok | {ok, #sslsocket{}} | {error, timeout | closed | {options, any()}| error_alert()}. +-spec ssl_accept(Socket, Options, Timeout) -> + ok | {ok, sslsocket()} | {error, Reason} when + Socket :: sslsocket() | socket(), + Options :: [tls_server_option()], + Timeout :: timeout(), + Reason :: timeout | closed | {options, any()} | error_alert(). + ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> handshake(Socket, SslOptions, Timeout); ssl_accept(Socket, SslOptions, Timeout) -> @@ -529,13 +587,28 @@ ssl_accept(Socket, SslOptions, Timeout) -> %%-------------------------------------------------------------------- %% Performs the SSL/TLS/DTLS server-side handshake. --spec handshake(#sslsocket{}) -> {ok, #sslsocket{}} | {error, timeout | closed | {options, any()} | error_alert()}. +-spec handshake(HsSocket) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason} when + HsSocket :: sslsocket(), + SslSocket :: sslsocket(), + Ext :: protocol_extensions(), + Reason :: closed | timeout | error_alert(). handshake(ListenSocket) -> handshake(ListenSocket, infinity). --spec handshake(#sslsocket{} | port(), timeout()| [tls_server_option()]) -> - {ok, #sslsocket{}} | {error, timeout | closed | {options, any()} | error_alert()}. +-spec handshake(HsSocket, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason} when + HsSocket :: sslsocket(), + Timeout :: timeout(), + SslSocket :: sslsocket(), + Ext :: protocol_extensions(), + Reason :: closed | timeout | error_alert(); + (Socket, Options) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason} when + Socket :: socket() | sslsocket(), + SslSocket :: sslsocket(), + Options :: [server_option()], + Ext :: protocol_extensions(), + Reason :: closed | timeout | error_alert(). + handshake(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) -> ssl_connection:handshake(Socket, Timeout); @@ -549,8 +622,17 @@ handshake(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Tim handshake(ListenSocket, SslOptions) when is_port(ListenSocket) -> handshake(ListenSocket, SslOptions, infinity). --spec handshake(#sslsocket{} | port(), [tls_server_option()], timeout()) -> - {ok, #sslsocket{}} | {error, timeout | closed | {options, any()} | error_alert()}. +-spec handshake(Socket, Options, Timeout) -> + {ok, SslSocket} | + {ok, SslSocket, Ext} | + {error, Reason} when + Socket :: socket() | sslsocket(), + SslSocket :: sslsocket(), + Options :: [server_option()], + Timeout :: timeout(), + Ext :: protocol_extensions(), + Reason :: closed | timeout | {options, any()} | error_alert(). + handshake(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> handshake(Socket, Timeout); @@ -593,8 +675,12 @@ handshake(Socket, SslOptions, Timeout) when is_port(Socket), %%-------------------------------------------------------------------- --spec handshake_continue(#sslsocket{}, [tls_client_option() | tls_server_option()]) -> - {ok, #sslsocket{}} | {error, reason()}. +-spec handshake_continue(HsSocket, Options) -> + {ok, SslSocket} | {error, Reason} when + HsSocket :: sslsocket(), + Options :: [tls_client_option() | tls_server_option()], + SslSocket :: sslsocket(), + Reason :: closed | timeout | error_alert(). %% %% %% Description: Continues the handshke possible with newly supplied options. @@ -602,8 +688,13 @@ handshake(Socket, SslOptions, Timeout) when is_port(Socket), handshake_continue(Socket, SSLOptions) -> handshake_continue(Socket, SSLOptions, infinity). %%-------------------------------------------------------------------- --spec handshake_continue(#sslsocket{}, [tls_client_option() | tls_server_option()], timeout()) -> - {ok, #sslsocket{}} | {error, reason()}. +-spec handshake_continue(HsSocket, Options, Timeout) -> + {ok, SslSocket} | {error, Reason} when + HsSocket :: sslsocket(), + Options :: [tls_client_option() | tls_server_option()], + Timeout :: timeout(), + SslSocket :: sslsocket(), + Reason :: closed | timeout | error_alert(). %% %% %% Description: Continues the handshke possible with newly supplied options. @@ -611,7 +702,7 @@ handshake_continue(Socket, SSLOptions) -> handshake_continue(Socket, SSLOptions, Timeout) -> ssl_connection:handshake_continue(Socket, SSLOptions, Timeout). %%-------------------------------------------------------------------- --spec handshake_cancel(#sslsocket{}) -> term(). +-spec handshake_cancel(#sslsocket{}) -> any(). %% %% Description: Cancels the handshakes sending a close alert. %%-------------------------------------------------------------------- @@ -619,7 +710,9 @@ handshake_cancel(Socket) -> ssl_connection:handshake_cancel(Socket). %%-------------------------------------------------------------------- --spec close(#sslsocket{}) -> term(). +-spec close(SslSocket) -> ok | {error, Reason} when + SslSocket :: sslsocket(), + Reason :: any(). %% %% Description: Close an ssl connection %%-------------------------------------------------------------------- @@ -631,7 +724,10 @@ close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_,_,_,_} Transport:close(ListenSocket). %%-------------------------------------------------------------------- --spec close(#sslsocket{}, timeout() | {pid(), integer()}) -> term(). +-spec close(SslSocket, How) -> ok | {ok, port()} | {error,Reason} when + SslSocket :: sslsocket(), + How :: timeout() | {NewController::pid(), timeout()}, + Reason :: any(). %% %% Description: Close an ssl connection %%-------------------------------------------------------------------- @@ -647,7 +743,9 @@ close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_,_,_,_} Transport:close(ListenSocket). %%-------------------------------------------------------------------- --spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}. +-spec send(SslSocket, Data) -> ok | {error, reason()} when + SslSocket :: sslsocket(), + Data :: iodata(). %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- @@ -667,11 +765,22 @@ send(#sslsocket{pid = {ListenSocket, #config{transport_info = Info}}}, Data) -> %% %% Description: Receives data when active = false %%-------------------------------------------------------------------- --spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}. +-spec recv(SslSocket, Length) -> {ok, Data} | {error, reason()} when + SslSocket :: sslsocket(), + Length :: integer(), + Data :: binary() | list() | HttpPacket, + HttpPacket :: any(). + recv(Socket, Length) -> recv(Socket, Length, infinity). --spec recv(#sslsocket{}, integer(), timeout()) -> {ok, binary()| list()} | {error, reason()}. +-spec recv(SslSocket, Length, Timeout) -> {ok, Data} | {error, reason()} when + SslSocket :: sslsocket(), + Length :: integer(), + Data :: binary() | list() | HttpPacket, + Timeout :: timeout(), + HttpPacket :: any(). + recv(#sslsocket{pid = [Pid|_]}, Length, Timeout) when is_pid(Pid), (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)-> ssl_connection:recv(Pid, Length, Timeout); @@ -683,7 +792,10 @@ recv(#sslsocket{pid = {Listen, Transport:recv(Listen, 0). %% {error,enotconn} %%-------------------------------------------------------------------- --spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}. +-spec controlling_process(SslSocket, NewOwner) -> ok | {error, Reason} when + SslSocket :: sslsocket(), + NewOwner :: pid(), + Reason :: any(). %% %% Description: Changes process that receives the messages when active = true %% or once. @@ -702,7 +814,11 @@ controlling_process(#sslsocket{pid = {Listen, %%-------------------------------------------------------------------- --spec connection_information(#sslsocket{}) -> {ok, list()} | {error, reason()}. +-spec connection_information(SslSocket) -> {ok, Result} | {error, reason()} when + SslSocket :: sslsocket(), + Result :: [{OptionName, OptionValue}], + OptionName :: atom(), + OptionValue :: any(). %% %% Description: Return SSL information for the connection %%-------------------------------------------------------------------- @@ -719,7 +835,12 @@ connection_information(#sslsocket{pid = {dtls,_}}) -> {error,enotconn}. %%-------------------------------------------------------------------- --spec connection_information(#sslsocket{}, [atom()]) -> {ok, list()} | {error, reason()}. +-spec connection_information(SslSocket, Items) -> {ok, Result} | {error, reason()} when + SslSocket :: sslsocket(), + Items :: [OptionName], + Result :: [{OptionName, OptionValue}], + OptionName :: atom(), + OptionValue :: any(). %% %% Description: Return SSL information for the connection %%-------------------------------------------------------------------- @@ -733,7 +854,11 @@ connection_information(#sslsocket{pid = [Pid|_]}, Items) when is_pid(Pid) -> end. %%-------------------------------------------------------------------- --spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. +-spec peername(SslSocket) -> {ok, {Address, Port}} | + {error, reason()} when + SslSocket :: sslsocket(), + Address :: inet:ip_address(), + Port :: inet:port_number(). %% %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- @@ -749,7 +874,9 @@ peername(#sslsocket{pid = {dtls,_}}) -> {error,enotconn}. %%-------------------------------------------------------------------- --spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. +-spec peercert(SslSocket) -> {ok, Cert} | {error, reason()} when + SslSocket :: sslsocket(), + Cert :: binary(). %% %% Description: Returns the peercert. %%-------------------------------------------------------------------- @@ -766,7 +893,10 @@ peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> {error, enotconn}. %%-------------------------------------------------------------------- --spec negotiated_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}. +-spec negotiated_protocol(SslSocket) -> {ok, Protocol} | {error, Reason} when + SslSocket :: sslsocket(), + Protocol :: binary(), + Reason :: protocol_not_negotiated. %% %% Description: Returns the protocol that has been negotiated. If no %% protocol has been negotiated will return {error, protocol_not_negotiated} @@ -780,24 +910,26 @@ negotiated_protocol(#sslsocket{pid = [Pid|_]}) when is_pid(Pid) -> cipher_suites() -> cipher_suites(erlang). %%-------------------------------------------------------------------- --spec cipher_suites(erlang | openssl | all) -> - [old_cipher_suite() | string()]. +-spec cipher_suites(Type) -> [old_cipher_suite() | string()] when + Type :: erlang | openssl | all. + %% Description: Returns all supported cipher suites. %%-------------------------------------------------------------------- cipher_suites(erlang) -> - [ssl_cipher_format:erl_suite_definition(Suite) || Suite <- available_suites(default)]; + [ssl_cipher_format:suite_legacy(Suite) || Suite <- available_suites(default)]; cipher_suites(openssl) -> - [ssl_cipher_format:openssl_suite_name(Suite) || + [ssl_cipher_format:suite_map_to_openssl_str(ssl_cipher_format:suite_bin_to_map(Suite)) || Suite <- available_suites(default)]; cipher_suites(all) -> - [ssl_cipher_format:erl_suite_definition(Suite) || Suite <- available_suites(all)]. + [ssl_cipher_format:suite_legacy(Suite) || Suite <- available_suites(all)]. %%-------------------------------------------------------------------- --spec cipher_suites(default | all | anonymous, ssl_record:ssl_version() | - tls_record:tls_atom_version() | dtls_record:dtls_atom_version()) -> - [erl_cipher_suite()]. +-spec cipher_suites(Supported, Version) -> ciphers() when + Supported :: default | all | anonymous, + Version :: protocol_version(). + %% Description: Returns all default and all supported cipher suites for a %% TLS/DTLS version %%-------------------------------------------------------------------- @@ -810,12 +942,13 @@ cipher_suites(Base, Version) when Version == 'dtlsv1.2'; Version == 'dtlsv1'-> cipher_suites(Base, dtls_record:protocol_version(Version)); cipher_suites(Base, Version) -> - [ssl_cipher_format:suite_definition(Suite) || Suite <- supported_suites(Base, Version)]. + [ssl_cipher_format:suite_bin_to_map(Suite) || Suite <- supported_suites(Base, Version)]. %%-------------------------------------------------------------------- --spec filter_cipher_suites([erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()] , - [{key_exchange | cipher | mac | prf, fun()}] | []) -> - [erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]. +-spec filter_cipher_suites(Suites, Filters) -> Ciphers when + Suites :: ciphers(), + Filters :: cipher_filters(), + Ciphers :: ciphers(). %% Description: Removes cipher suites if any of the filter functions returns false %% for any part of the cipher suite. This function also calls default filter functions @@ -833,10 +966,10 @@ filter_cipher_suites(Suites, Filters0) -> prf_filters => add_filter(proplists:get_value(prf, Filters0), PrfF)}, ssl_cipher:filter_suites(Suites, Filters). %%-------------------------------------------------------------------- --spec prepend_cipher_suites([erl_cipher_suite()] | - [{key_exchange | cipher | mac | prf, fun()}], - [erl_cipher_suite()]) -> - [erl_cipher_suite()]. +-spec prepend_cipher_suites(Preferred, Suites) -> ciphers() when + Preferred :: ciphers() | cipher_filters(), + Suites :: ciphers(). + %% Description: Make <Preferred> suites become the most prefered %% suites that is put them at the head of the cipher suite list %% and remove them from <Suites> if present. <Preferred> may be a @@ -851,10 +984,10 @@ prepend_cipher_suites(Filters, Suites) -> Preferred = filter_cipher_suites(Suites, Filters), Preferred ++ (Suites -- Preferred). %%-------------------------------------------------------------------- --spec append_cipher_suites(Deferred :: [erl_cipher_suite()] | - [{key_exchange | cipher | mac | prf, fun()}], - [erl_cipher_suite()]) -> - [erl_cipher_suite()]. +-spec append_cipher_suites(Deferred, Suites) -> ciphers() when + Deferred :: ciphers() | cipher_filters(), + Suites :: ciphers(). + %% Description: Make <Deferred> suites suites become the %% least prefered suites that is put them at the end of the cipher suite list %% and removed them from <Suites> if present. @@ -868,7 +1001,9 @@ append_cipher_suites(Filters, Suites) -> (Suites -- Deferred) ++ Deferred. %%-------------------------------------------------------------------- --spec eccs() -> tls_v1:curves(). +-spec eccs() -> NamedCurves when + NamedCurves :: [named_curve()]. + %% Description: returns all supported curves across all versions %%-------------------------------------------------------------------- eccs() -> @@ -876,27 +1011,24 @@ eccs() -> eccs_filter_supported(Curves). %%-------------------------------------------------------------------- --spec eccs(tls_record:tls_atom_version() | - ssl_record:ssl_version() | dtls_record:dtls_atom_version()) -> - tls_v1:curves(). +-spec eccs(Version) -> NamedCurves when + Version :: protocol_version(), + NamedCurves :: [named_curve()]. + %% Description: returns the curves supported for a given version of %% ssl/tls. %%-------------------------------------------------------------------- -eccs({3,0}) -> +eccs(sslv3) -> []; -eccs({3,_}) -> - Curves = tls_v1:ecc_curves(all), - eccs_filter_supported(Curves); -eccs({254,_} = Version) -> - eccs(dtls_v1:corresponding_tls_version(Version)); +eccs('dtlsv1') -> + eccs('tlsv1.1'); +eccs('dtlsv1.2') -> + eccs('tlsv1.2'); eccs(Version) when Version == 'tlsv1.2'; Version == 'tlsv1.1'; - Version == tlsv1; - Version == sslv3 -> - eccs(tls_record:protocol_version(Version)); -eccs(Version) when Version == 'dtlsv1.2'; - Version == 'dtlsv1'-> - eccs(dtls_v1:corresponding_tls_version(dtls_record:protocol_version(Version))). + Version == tlsv1 -> + Curves = tls_v1:ecc_curves(all), + eccs_filter_supported(Curves). eccs_filter_supported(Curves) -> CryptoCurves = crypto:ec_curves(), @@ -904,28 +1036,30 @@ eccs_filter_supported(Curves) -> Curves). %%-------------------------------------------------------------------- --spec groups() -> tls_v1:supported_groups(). +-spec groups() -> [group()]. %% Description: returns all supported groups (TLS 1.3 and later) %%-------------------------------------------------------------------- groups() -> tls_v1:groups(4). %%-------------------------------------------------------------------- --spec groups(default) -> tls_v1:supported_groups(). +-spec groups(default) -> [group()]. %% Description: returns the default groups (TLS 1.3 and later) %%-------------------------------------------------------------------- groups(default) -> tls_v1:default_groups(4). %%-------------------------------------------------------------------- --spec getopts(#sslsocket{}, [gen_tcp:option_name()]) -> - {ok, [gen_tcp:option()]} | {error, reason()}. +-spec getopts(SslSocket, OptionNames) -> + {ok, [gen_tcp:option()]} | {error, reason()} when + SslSocket :: sslsocket(), + OptionNames :: [gen_tcp:option_name()]. %% %% Description: Gets options %%-------------------------------------------------------------------- getopts(#sslsocket{pid = [Pid|_]}, OptionTags) when is_pid(Pid), is_list(OptionTags) -> ssl_connection:get_opts(Pid, OptionTags); -getopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, OptionTags) when is_list(OptionTags) -> +getopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_,_}}}} = ListenSocket, OptionTags) when is_list(OptionTags) -> try dtls_socket:getopts(Transport, ListenSocket, OptionTags) of {ok, _} = Result -> Result; @@ -950,7 +1084,9 @@ getopts(#sslsocket{}, OptionTags) -> {error, {options, {socket_options, OptionTags}}}. %%-------------------------------------------------------------------- --spec setopts(#sslsocket{}, [gen_tcp:option()]) -> ok | {error, reason()}. +-spec setopts(SslSocket, Options) -> ok | {error, reason()} when + SslSocket :: sslsocket(), + Options :: [gen_tcp:option()]. %% %% Description: Sets options %%-------------------------------------------------------------------- @@ -982,7 +1118,7 @@ setopts(#sslsocket{pid = [Pid|_]}, Options0) when is_pid(Pid), is_list(Options0) _:_ -> {error, {options, {not_a_proplist, Options0}}} end; -setopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> +setopts(#sslsocket{pid = {dtls, #config{transport_info = {Transport,_,_,_,_}}}} = ListenSocket, Options) when is_list(Options) -> try dtls_socket:setopts(Transport, ListenSocket, Options) of ok -> ok; @@ -1006,9 +1142,9 @@ setopts(#sslsocket{}, Options) -> {error, {options,{not_a_proplist, Options}}}. %%--------------------------------------------------------------- --spec getstat(Socket) -> - {ok, OptionValues} | {error, inet:posix()} when - Socket :: #sslsocket{}, +-spec getstat(SslSocket) -> + {ok, OptionValues} | {error, inet:posix()} when + SslSocket :: sslsocket(), OptionValues :: [{inet:stat_option(), integer()}]. %% %% Description: Get all statistic options for a socket. @@ -1017,22 +1153,24 @@ getstat(Socket) -> getstat(Socket, inet:stats()). %%--------------------------------------------------------------- --spec getstat(Socket, Options) -> - {ok, OptionValues} | {error, inet:posix()} when - Socket :: #sslsocket{}, +-spec getstat(SslSocket, Options) -> + {ok, OptionValues} | {error, inet:posix()} when + SslSocket :: sslsocket(), Options :: [inet:stat_option()], OptionValues :: [{inet:stat_option(), integer()}]. %% %% Description: Get one or more statistic options for a socket. %%-------------------------------------------------------------------- -getstat(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _}}}}, Options) when is_port(Listen), is_list(Options) -> +getstat(#sslsocket{pid = {Listen, #config{transport_info = {Transport, _, _, _, _}}}}, Options) when is_port(Listen), is_list(Options) -> tls_socket:getstat(Transport, Listen, Options); getstat(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _, _}}, Options) when is_pid(Pid), is_list(Options) -> tls_socket:getstat(Transport, Socket, Options). %%--------------------------------------------------------------- --spec shutdown(#sslsocket{}, read | write | read_write) -> ok | {error, reason()}. +-spec shutdown(SslSocket, How) -> ok | {error, reason()} when + SslSocket :: sslsocket(), + How :: read | write | read_write. %% %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- @@ -1046,7 +1184,11 @@ shutdown(#sslsocket{pid = [Pid|_]}, How) when is_pid(Pid) -> ssl_connection:shutdown(Pid, How). %%-------------------------------------------------------------------- --spec sockname(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. +-spec sockname(SslSocket) -> + {ok, {Address, Port}} | {error, reason()} when + SslSocket :: sslsocket(), + Address :: inet:ip_address(), + Port :: inet:port_number(). %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- @@ -1060,10 +1202,10 @@ sockname(#sslsocket{pid = [Pid| _], fd = {Transport, Socket,_,_}}) when is_pid(P tls_socket:sockname(Transport, Socket). %%--------------------------------------------------------------- --spec versions() -> [{ssl_app, string()} | {supported, [tls_record:tls_atom_version()]} | - {supported_dtls, [dtls_record:dtls_atom_version()]} | - {available, [tls_record:tls_atom_version()]} | - {available_dtls, [dtls_record:dtls_atom_version()]}]. +-spec versions() -> [VersionInfo] when + VersionInfo :: {ssl_app, string()} | + {supported | available, [tls_version()]} | + {supported_dtls | available_dtls, [dtls_version()]}. %% %% Description: Returns a list of relevant versions. %%-------------------------------------------------------------------- @@ -1081,7 +1223,8 @@ versions() -> %%--------------------------------------------------------------- --spec renegotiate(#sslsocket{}) -> ok | {error, reason()}. +-spec renegotiate(SslSocket) -> ok | {error, reason()} when + SslSocket :: sslsocket(). %% %% Description: Initiates a renegotiation. %%-------------------------------------------------------------------- @@ -1101,9 +1244,13 @@ renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> {error, enotconn}. %%-------------------------------------------------------------------- --spec prf(#sslsocket{}, binary() | 'master_secret', binary(), - [binary() | prf_random()], non_neg_integer()) -> - {ok, binary()} | {error, reason()}. +-spec prf(SslSocket, Secret, Label, Seed, WantedLength) -> + {ok, binary()} | {error, reason()} when + SslSocket :: sslsocket(), + Secret :: binary() | 'master_secret', + Label::binary(), + Seed :: [binary() | prf_random()], + WantedLength :: non_neg_integer(). %% %% Description: use a ssl sessions TLS PRF to generate key material %%-------------------------------------------------------------------- @@ -1124,7 +1271,8 @@ clear_pem_cache() -> ssl_pem_cache:clear(). %%--------------------------------------------------------------- --spec format_error({error, term()}) -> list(). +-spec format_error({error, Reason}) -> string() when + Reason :: any(). %% %% Description: Creates error string. %%-------------------------------------------------------------------- @@ -1162,15 +1310,20 @@ tls_version({3, _} = Version) -> tls_version({254, _} = Version) -> dtls_v1:corresponding_tls_version(Version). - %%-------------------------------------------------------------------- --spec suite_to_str(erl_cipher_suite()) -> string(). +-spec suite_to_str(CipherSuite) -> string() when + CipherSuite :: erl_cipher_suite(); + (CipherSuite) -> string() when + %% For internal use! + CipherSuite :: #{key_exchange := null, + cipher := null, + mac := null, + prf := null}. %% %% Description: Return the string representation of a cipher suite. %%-------------------------------------------------------------------- suite_to_str(Cipher) -> - ssl_cipher_format:suite_to_str(Cipher). - + ssl_cipher_format:suite_map_to_str(Cipher). %%%-------------------------------------------------------------- %%% Internal functions @@ -1810,10 +1963,10 @@ binary_cipher_suites(Version, []) -> %% not require explicit configuration default_binary_suites(Version); binary_cipher_suites(Version, [Map|_] = Ciphers0) when is_map(Map) -> - Ciphers = [ssl_cipher_format:suite(C) || C <- Ciphers0], + Ciphers = [ssl_cipher_format:suite_map_to_bin(C) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Tuple|_] = Ciphers0) when is_tuple(Tuple) -> - Ciphers = [ssl_cipher_format:suite(tuple_to_map(C)) || C <- Ciphers0], + Ciphers = [ssl_cipher_format:suite_map_to_bin(tuple_to_map(C)) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> All = ssl_cipher:all_suites(Version) ++ @@ -1828,11 +1981,11 @@ binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) end; binary_cipher_suites(Version, [Head | _] = Ciphers0) when is_list(Head) -> %% Format: ["RC4-SHA","RC4-MD5"] - Ciphers = [ssl_cipher_format:openssl_suite(C) || C <- Ciphers0], + Ciphers = [ssl_cipher_format:suite_openssl_str_to_map(C) || C <- Ciphers0], binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, Ciphers0) -> %% Format: "RC4-SHA:RC4-MD5" - Ciphers = [ssl_cipher_format:openssl_suite(C) || C <- string:lexemes(Ciphers0, ":")], + Ciphers = [ssl_cipher_format:suite_openssl_str_to_map(C) || C <- string:lexemes(Ciphers0, ":")], binary_cipher_suites(Version, Ciphers). default_binary_suites(Version) -> @@ -2137,7 +2290,7 @@ default_option_role(_,_,_) -> default_cb_info(tls) -> {gen_tcp, tcp, tcp_closed, tcp_error, tcp_passive}; default_cb_info(dtls) -> - {gen_udp, udp, udp_closed, udp_error}. + {gen_udp, udp, udp_closed, udp_error, udp_passive}. include_security_info([]) -> false; diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index fe8736d2df..21db887bb5 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -35,7 +35,7 @@ -include_lib("public_key/include/public_key.hrl"). -export([security_parameters/2, security_parameters/3, security_parameters_1_3/2, - cipher_init/3, nonce_seed/2, decipher/6, cipher/5, aead_encrypt/5, aead_decrypt/6, + cipher_init/3, nonce_seed/2, decipher/6, cipher/5, aead_encrypt/6, aead_decrypt/6, suites/1, all_suites/1, crypto_support_filters/0, chacha_suites/1, anonymous_suites/1, psk_suites/1, psk_suites_anon/1, srp_suites/0, srp_suites_anon/0, @@ -76,7 +76,7 @@ security_parameters(?TLS_NULL_WITH_NULL_NULL = CipherSuite, SecParams) -> %%------------------------------------------------------------------- security_parameters(Version, CipherSuite, SecParams) -> #{cipher := Cipher, mac := Hash, - prf := PrfHashAlg} = ssl_cipher_format:suite_definition(CipherSuite), + prf := PrfHashAlg} = ssl_cipher_format:suite_bin_to_map(CipherSuite), SecParams#security_parameters{ cipher_suite = CipherSuite, bulk_cipher_algorithm = bulk_cipher_algorithm(Cipher), @@ -91,7 +91,7 @@ security_parameters(Version, CipherSuite, SecParams) -> security_parameters_1_3(SecParams, CipherSuite) -> #{cipher := Cipher, prf := PrfHashAlg} = - ssl_cipher_format:suite_definition(CipherSuite), + ssl_cipher_format:suite_bin_to_map(CipherSuite), SecParams#security_parameters{ cipher_suite = CipherSuite, bulk_cipher_algorithm = bulk_cipher_algorithm(Cipher), @@ -106,9 +106,13 @@ security_parameters_1_3(SecParams, CipherSuite) -> 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) -> +cipher_init(Type, IV, Key) when Type == ?AES_GCM; + Type == ?AES_CCM -> <<Nonce:64>> = random_bytes(8), #cipher_state{iv = IV, key = Key, nonce = Nonce, tag_len = 16}; +cipher_init(?AES_CCM_8, IV, Key) -> + <<Nonce:64>> = random_bytes(8), + #cipher_state{iv = IV, key = Key, nonce = Nonce, tag_len = 8}; cipher_init(?CHACHA20_POLY1305, IV, Key) -> #cipher_state{iv = IV, key = Key, tag_len = 16}; cipher_init(_BCA, IV, Key) -> @@ -148,14 +152,18 @@ cipher(?AES_CBC, CipherState, Mac, Fragment, Version) -> crypto:block_encrypt(aes_cbc256, Key, IV, T) end, block_size(aes_128_cbc), CipherState, Mac, Fragment, Version). -aead_encrypt(Type, Key, Nonce, Fragment, AdditionalData) -> - crypto:block_encrypt(aead_type(Type), Key, Nonce, {AdditionalData, Fragment}). +aead_encrypt(Type, Key, Nonce, Fragment, AdditionalData, TagLen) -> + crypto:block_encrypt(aead_type(Type), Key, Nonce, {AdditionalData, Fragment, TagLen}). aead_decrypt(Type, Key, Nonce, CipherText, CipherTag, AdditionalData) -> crypto:block_decrypt(aead_type(Type), Key, Nonce, {AdditionalData, CipherText, CipherTag}). aead_type(?AES_GCM) -> aes_gcm; +aead_type(?AES_CCM) -> + aes_ccm; +aead_type(?AES_CCM_8) -> + aes_ccm; aead_type(?CHACHA20_POLY1305) -> chacha20_poly1305. @@ -311,8 +319,7 @@ anonymous_suites({254, _} = Version) -> dtls_v1:anonymous_suites(Version); anonymous_suites(4) -> []; %% Raw public key negotiation may be used instead -anonymous_suites(N) - when N >= 3 -> +anonymous_suites( 3 = N) -> psk_suites_anon(N) ++ [?TLS_DH_anon_WITH_AES_128_GCM_SHA256, ?TLS_DH_anon_WITH_AES_256_GCM_SHA384, @@ -347,8 +354,7 @@ psk_suites({3, N}) -> psk_suites(N); psk_suites(4) -> []; %% TODO Add new PSK, PSK_(EC)DHE suites -psk_suites(N) - when N >= 3 -> +psk_suites(3) -> [ ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384, ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384, @@ -369,20 +375,32 @@ psk_suites(_) -> %%-------------------------------------------------------------------- psk_suites_anon({3, N}) -> psk_suites_anon(N); -psk_suites_anon(N) - when N >= 3 -> +psk_suites_anon(3) -> [ ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384, ?TLS_PSK_WITH_AES_256_GCM_SHA384, ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384, ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384, ?TLS_PSK_WITH_AES_256_CBC_SHA384, + ?TLS_DHE_PSK_WITH_AES_256_CCM, + ?TLS_PSK_DHE_WITH_AES_256_CCM_8, + ?TLS_PSK_WITH_AES_256_CCM, + ?TLS_PSK_WITH_AES_256_CCM_8, ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256, + ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256, ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256, ?TLS_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256, + ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256, ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256, ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256, - ?TLS_PSK_WITH_AES_128_CBC_SHA256 + ?TLS_PSK_WITH_AES_128_CBC_SHA256, + ?TLS_DHE_PSK_WITH_AES_128_CCM, + ?TLS_PSK_DHE_WITH_AES_128_CCM_8, + ?TLS_PSK_WITH_AES_128_CCM, + ?TLS_PSK_WITH_AES_128_CCM_8, + ?TLS_ECDHE_PSK_WITH_RC4_128_SHA ] ++ psk_suites_anon(0); psk_suites_anon(_) -> [?TLS_DHE_PSK_WITH_AES_256_CBC_SHA, @@ -531,7 +549,7 @@ filter_suite(#{key_exchange := KeyExchange, all_filters(Hash, HashFilters) andalso all_filters(Prf, PrfFilters); filter_suite(Suite, Filters) -> - filter_suite(ssl_cipher_format:suite_definition(Suite), Filters). + filter_suite(ssl_cipher_format:suite_bin_to_map(Suite), Filters). %%-------------------------------------------------------------------- -spec filter_suites([ssl:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]) -> @@ -589,7 +607,7 @@ is_acceptable_keyexchange(dhe_rsa, Algos) -> proplists:get_bool(dh, Algos) andalso proplists:get_bool(rsa, Algos); is_acceptable_keyexchange(KeyExchange, Algos) when KeyExchange == ecdh_anon; - KeyExchange == ecdhe_psk -> + KeyExchange == ecdhe_psk -> proplists:get_bool(ecdh, Algos); is_acceptable_keyexchange(KeyExchange, Algos) when KeyExchange == ecdh_ecdsa; KeyExchange == ecdhe_ecdsa -> @@ -629,6 +647,12 @@ 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 == aes_128_ccm; + Cipher == aes_256_ccm; + Cipher == aes_128_ccm_8; + Cipher == aes_256_ccm_8 -> + proplists:get_bool(aes_ccm, Algos); is_acceptable_cipher(Cipher, Algos) -> proplists:get_bool(Cipher, Algos). @@ -721,6 +745,12 @@ bulk_cipher_algorithm(Cipher) when Cipher == aes_128_cbc; bulk_cipher_algorithm(Cipher) when Cipher == aes_128_gcm; Cipher == aes_256_gcm -> ?AES_GCM; +bulk_cipher_algorithm(Cipher) when Cipher == aes_128_ccm; + Cipher == aes_256_ccm -> + ?AES_CCM; +bulk_cipher_algorithm(Cipher) when Cipher == aes_128_ccm_8; + Cipher == aes_256_ccm_8 -> + ?AES_CCM_8; bulk_cipher_algorithm(chacha20_poly1305) -> ?CHACHA20_POLY1305. @@ -735,6 +765,10 @@ type(Cipher) when Cipher == des_cbc; ?BLOCK; type(Cipher) when Cipher == aes_128_gcm; Cipher == aes_256_gcm; + Cipher == aes_128_ccm; + Cipher == aes_256_ccm; + Cipher == aes_128_ccm_8; + Cipher == aes_256_ccm_8; Cipher == chacha20_poly1305 -> ?AEAD. @@ -752,8 +786,16 @@ key_material(aes_256_cbc) -> 32; key_material(aes_128_gcm) -> 16; +key_material(aes_128_ccm) -> + 16; +key_material(aes_128_ccm_8) -> + 16; key_material(aes_256_gcm) -> 32; +key_material(aes_256_ccm_8) -> + 32; +key_material(aes_256_ccm) -> + 32; key_material(chacha20_poly1305) -> 32. @@ -769,6 +811,10 @@ expanded_key_material(Cipher) when Cipher == aes_128_cbc; Cipher == aes_256_cbc; Cipher == aes_128_gcm; Cipher == aes_256_gcm; + Cipher == aes_128_ccm; + Cipher == aes_256_ccm; + Cipher == aes_128_ccm_8; + Cipher == aes_256_ccm_8; Cipher == chacha20_poly1305 -> unknown. @@ -778,22 +824,31 @@ effective_key_bits(des_cbc) -> 56; effective_key_bits(Cipher) when Cipher == rc4_128; Cipher == aes_128_cbc; - Cipher == aes_128_gcm -> + Cipher == aes_128_gcm; + Cipher == aes_128_ccm; + Cipher == aes_128_ccm_8 -> 128; effective_key_bits('3des_ede_cbc') -> 168; effective_key_bits(Cipher) when Cipher == aes_256_cbc; Cipher == aes_256_gcm; + Cipher == aes_256_ccm; + Cipher == aes_256_ccm_8; Cipher == chacha20_poly1305 -> 256. iv_size(Cipher) when Cipher == null; - Cipher == rc4_128; - Cipher == chacha20_poly1305-> + Cipher == rc4_128 -> 0; iv_size(Cipher) when Cipher == aes_128_gcm; - Cipher == aes_256_gcm -> + Cipher == aes_256_gcm; + Cipher == aes_128_ccm; + Cipher == aes_256_ccm; + Cipher == aes_128_ccm_8; + Cipher == aes_256_ccm_8 -> 4; +iv_size(chacha20_poly1305) -> + 12; iv_size(Cipher) -> block_size(Cipher). @@ -804,6 +859,10 @@ block_size(Cipher) when Cipher == aes_128_cbc; Cipher == aes_256_cbc; Cipher == aes_128_gcm; Cipher == aes_256_gcm; + Cipher == aes_128_ccm; + Cipher == aes_256_ccm; + Cipher == aes_128_ccm_8; + Cipher == aes_256_ccm_8; Cipher == chacha20_poly1305 -> 16. @@ -880,6 +939,11 @@ signature_scheme(?RSA_PSS_PSS_SHA384) -> rsa_pss_pss_sha384; signature_scheme(?RSA_PSS_PSS_SHA512) -> rsa_pss_pss_sha512; signature_scheme(?RSA_PKCS1_SHA1) -> rsa_pkcs1_sha1; signature_scheme(?ECDSA_SHA1) -> ecdsa_sha1; +%% Handling legacy signature algorithms for logging purposes. These algorithms +%% cannot be used in TLS 1.3 handshakes. +signature_scheme(SignAlgo) when is_integer(SignAlgo) -> + <<?BYTE(Hash),?BYTE(Sign)>> = <<?UINT16(SignAlgo)>>, + {ssl_cipher:hash_algorithm(Hash), ssl_cipher:sign_algorithm(Sign)}; signature_scheme(_) -> unassigned. %% TODO: reserved code points? diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index 00822ad9de..0fa5f66c49 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -601,16 +601,82 @@ %% 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)>>). +%%% ChaCha20-Poly1305 Cipher Suites for Transport Layer Security (TLS) RFC7905 -%% TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x14} --define(TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#14)>>). +%% TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xA8} +-define(TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#A8)>>). + +%% TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xA9} +-define(TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#A9)>>). + +%% TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAA} +-define(TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AA)>>). + +%% TLS_PSK_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAB} +-define(TLS_PSK_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AB)>>). + +%% TLS_ECDHE_PSK_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAC} +-define(TLS_ECDHE_PSK_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AC)>>). + +%% TLS_DHE_PSK_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAD} +-define(TLS_DHE_PSK_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AD)>>). + +%% TLS_RSA_PSK_WITH_CHACHA20_POLY1305_SHA256 = {0xCC, 0xAE} +-define(TLS_RSA_PSK_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#AE)>>). + + + +%% RFC 6655 - TLS-1.2 cipher suites + +%% TLS_RSA_WITH_AES_128_CCM = {0xC0,0x9C} +-define(TLS_RSA_WITH_AES_128_CCM, <<?BYTE(16#C0), ?BYTE(16#9C)>>). + +%% TLS_RSA_WITH_AES_256_CCM = {0xC0,0x9D} +-define(TLS_RSA_WITH_AES_256_CCM, <<?BYTE(16#C0), ?BYTE(16#9D)>>). + +%% TLS_DHE_RSA_WITH_AES_256_CCM = {0xC0,0x9E} +-define(TLS_DHE_RSA_WITH_AES_256_CCM, <<?BYTE(16#C0), ?BYTE(16#9E)>>). + +%% TLS_DHE_RSA_WITH_AES_128_CCM = {0xC0,0x9F} +-define(TLS_DHE_RSA_WITH_AES_128_CCM, <<?BYTE(16#C0), ?BYTE(16#9F)>>). + +%% TLS_RSA_WITH_AES_256_CCM_8 = {0xC0,0x9A0} +-define(TLS_RSA_WITH_AES_256_CCM_8, <<?BYTE(16#C0), ?BYTE(16#A0)>>). + +%% TLS_RSA_WITH_AES_128_CCM_8 = {0xC0,0xA1} +-define(TLS_RSA_WITH_AES_128_CCM_8, <<?BYTE(16#C0), ?BYTE(16#A1)>>). + +%% TLS_DHE_RSA_WITH_AES_128_CCM_8 = {0xC0,0xA2} +-define(TLS_DHE_RSA_WITH_AES_128_CCM_8, <<?BYTE(16#C0), ?BYTE(16#A2)>>). + +%% TLS_DHE_RSA_WITH_AES_256_CCM_8 = {0xC0,0xA3} +-define(TLS_DHE_RSA_WITH_AES_256_CCM_8, <<?BYTE(16#C0), ?BYTE(16#A3)>>). + +%% TLS_PSK_WITH_AES_128_CCM = {0xC0,0xA4} +-define(TLS_PSK_WITH_AES_128_CCM, <<?BYTE(16#C0), ?BYTE(16#A4)>>). + +%% TLS_PSK_WITH_AES_256_CCM = {0xC0,0xA5) +-define(TLS_PSK_WITH_AES_256_CCM, <<?BYTE(16#C0), ?BYTE(16#A5)>>). + +%% TLS_DHE_PSK_WITH_AES_128_CCM = {0xC0,0xA6} +-define(TLS_DHE_PSK_WITH_AES_128_CCM, <<?BYTE(16#C0), ?BYTE(16#A6)>>). + +%% TLS_DHE_PSK_WITH_AES_256_CCM = {0xC0,0xA7} +-define(TLS_DHE_PSK_WITH_AES_256_CCM, <<?BYTE(16#C0), ?BYTE(16#A7)>>). + +%% TLS_PSK_WITH_AES_128_CCM_8 = {0xC0,0xA8} +-define(TLS_PSK_WITH_AES_128_CCM_8, <<?BYTE(16#C0), ?BYTE(16#A8)>>). + +%% TLS_PSK_WITH_AES_256_CCM_8 = {0xC0,0xA9) +-define(TLS_PSK_WITH_AES_256_CCM_8, <<?BYTE(16#C0), ?BYTE(16#A9)>>). + +%% TLS_PSK_DHE_WITH_AES_128_CCM_8 = {0xC0,0xAA} +-define(TLS_PSK_DHE_WITH_AES_128_CCM_8, <<?BYTE(16#C0), ?BYTE(16#AA)>>). + +%% TLS_PSK_DHE_WITH_AES_256_CCM_8 = << ?BYTE(0xC0,0xAB} +-define(TLS_PSK_DHE_WITH_AES_256_CCM_8, <<?BYTE(16#C0),?BYTE(16#AB)>>). -%% TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 = {0xcc, 0x15} --define(TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, <<?BYTE(16#CC), ?BYTE(16#15)>>). %%% TLS 1.3 cipher suites RFC8446 @@ -624,9 +690,9 @@ -define(TLS_CHACHA20_POLY1305_SHA256, <<?BYTE(16#13),?BYTE(16#03)>>). %% %% TLS_AES_128_CCM_SHA256 = {0x13,0x04} -%% -define(TLS_AES_128_CCM_SHA256, <<?BYTE(16#13), ?BYTE(16#04)>>). +-define(TLS_AES_128_CCM_SHA256, <<?BYTE(16#13), ?BYTE(16#04)>>). %% %% TLS_AES_128_CCM_8_SHA256 = {0x13,0x05} -%% -define(TLS_AES_128_CCM_8_SHA256, <<?BYTE(16#13),?BYTE(16#05)>>). +-define(TLS_AES_128_CCM_8_SHA256, <<?BYTE(16#13),?BYTE(16#05)>>). -endif. % -ifdef(ssl_cipher). diff --git a/lib/ssl/src/ssl_cipher_format.erl b/lib/ssl/src/ssl_cipher_format.erl index b592295d56..577156a4b5 100644 --- a/lib/ssl/src/ssl_cipher_format.erl +++ b/lib/ssl/src/ssl_cipher_format.erl @@ -48,48 +48,134 @@ -type openssl_cipher_suite() :: string(). --export([suite_to_str/1, suite_definition/1, suite/1, erl_suite_definition/1, - openssl_suite/1, openssl_suite_name/1]). +-export([suite_map_to_bin/1, %% Binary format + suite_bin_to_map/1, %% Erlang API format + suite_map_to_str/1, %% RFC string + suite_str_to_map/1, + suite_map_to_openssl_str/1, %% OpenSSL name + suite_openssl_str_to_map/1, + suite_legacy/1 %% Erlang legacy format + ]). %%-------------------------------------------------------------------- --spec suite_to_str(internal_erl_cipher_suite()) -> string(). +-spec suite_map_to_str(internal_erl_cipher_suite()) -> string(). %% %% Description: Return the string representation of a cipher suite. %%-------------------------------------------------------------------- -suite_to_str(#{key_exchange := null, +suite_map_to_str(#{key_exchange := null, cipher := null, mac := null, prf := null}) -> "TLS_EMPTY_RENEGOTIATION_INFO_SCSV"; -suite_to_str(#{key_exchange := any, +suite_map_to_str(#{key_exchange := any, cipher := Cipher, mac := aead, prf := PRF}) -> "TLS_" ++ string:to_upper(atom_to_list(Cipher)) ++ "_" ++ string:to_upper(atom_to_list(PRF)); -suite_to_str(#{key_exchange := Kex, +suite_map_to_str(#{key_exchange := Kex, cipher := Cipher, mac := aead, prf := PRF}) -> "TLS_" ++ string:to_upper(atom_to_list(Kex)) ++ "_WITH_" ++ string:to_upper(atom_to_list(Cipher)) ++ "_" ++ string:to_upper(atom_to_list(PRF)); -suite_to_str(#{key_exchange := Kex, +suite_map_to_str(#{key_exchange := Kex, cipher := Cipher, mac := Mac}) -> "TLS_" ++ string:to_upper(atom_to_list(Kex)) ++ "_WITH_" ++ string:to_upper(atom_to_list(Cipher)) ++ "_" ++ string:to_upper(atom_to_list(Mac)). +suite_str_to_map("TLS_EMPTY_RENEGOTIATION_INFO_SCSV") -> + #{key_exchange => null, + cipher => null, + mac => null, + prf => null}; +suite_str_to_map(SuiteStr)-> + Str0 = string:trim(SuiteStr, leading, "TLS_"), + case string:split(Str0, "_WITH_") of + [Rest] -> + tls_1_3_suite_str_to_map(Rest); + [Kex| Rest] -> + pre_tls_1_3_suite_str_to_map(Kex, Rest) + end. + +suite_map_to_openssl_str(#{key_exchange := any, + mac := aead} = Suite) -> + %% TLS 1.3 OpenSSL finally use RFC names + suite_map_to_str(Suite); +suite_map_to_openssl_str(#{key_exchange := null} = Suite) -> + %% TLS_EMPTY_RENEGOTIATION_INFO_SCSV + suite_map_to_str(Suite); +suite_map_to_openssl_str(#{key_exchange := Kex, + cipher := chacha20_poly1305 = Cipher, + mac := aead}) -> + openssl_suite_start(string:to_upper(atom_to_list(Kex))) + ++ openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))); +suite_map_to_openssl_str(#{key_exchange := Kex, + cipher := Cipher, + mac := aead, + prf := PRF}) -> + openssl_suite_start(string:to_upper(atom_to_list(Kex))) + ++ openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))) ++ + "-" ++ string:to_upper(atom_to_list(PRF)); +suite_map_to_openssl_str(#{key_exchange := Kex, + cipher := Cipher, + mac := Mac}) -> + openssl_suite_start(string:to_upper(atom_to_list(Kex))) + ++ openssl_cipher_name(Kex, string:to_upper(atom_to_list(Cipher))) ++ + "-" ++ string:to_upper(atom_to_list(Mac)). + + +suite_openssl_str_to_map("TLS_" ++ _ = SuiteStr) -> + suite_str_to_map(SuiteStr); +suite_openssl_str_to_map("DHE-RSA-" ++ Rest) -> + suite_openssl_str_to_map("DHE-RSA", Rest); +suite_openssl_str_to_map("DHE-DSS-" ++ Rest) -> + suite_openssl_str_to_map("DHE-DSS", Rest); +suite_openssl_str_to_map("EDH-RSA-" ++ Rest) -> + suite_openssl_str_to_map("DHE-RSA", Rest); +suite_openssl_str_to_map("EDH-DSS-" ++ Rest) -> + suite_openssl_str_to_map("DHE-DSS", Rest); +suite_openssl_str_to_map("DES" ++ _ = Rest) -> + suite_openssl_str_to_map("RSA", Rest); +suite_openssl_str_to_map("AES" ++ _ = Rest) -> + suite_openssl_str_to_map("RSA", Rest); +suite_openssl_str_to_map("RC4" ++ _ = Rest) -> + suite_openssl_str_to_map("RSA", Rest); +suite_openssl_str_to_map("ECDH-RSA-" ++ Rest) -> + suite_openssl_str_to_map("ECDH-RSA", Rest); +suite_openssl_str_to_map("ECDH-ECDSA-" ++ Rest) -> + suite_openssl_str_to_map("ECDH-ECDSA", Rest); +suite_openssl_str_to_map("ECDHE-RSA-" ++ Rest) -> + suite_openssl_str_to_map("ECDHE-RSA", Rest); +suite_openssl_str_to_map("ECDHE-ECDSA-" ++ Rest) -> + suite_openssl_str_to_map("ECDHE-ECDSA", Rest); +suite_openssl_str_to_map("RSA-PSK-" ++ Rest) -> + suite_openssl_str_to_map("RSA-PSK", Rest); +suite_openssl_str_to_map("RSA-" ++ Rest) -> + suite_openssl_str_to_map("RSA", Rest); +suite_openssl_str_to_map("DHE-PSK-" ++ Rest) -> + suite_openssl_str_to_map("DHE-PSK", Rest); +suite_openssl_str_to_map("ECDHE-PSK-" ++ Rest) -> + suite_openssl_str_to_map("ECDHE-PSK", Rest); +suite_openssl_str_to_map("PSK-" ++ Rest) -> + suite_openssl_str_to_map("PSK", Rest); +suite_openssl_str_to_map("SRP-RSA-" ++ Rest) -> + suite_openssl_str_to_map("SRP-RSA", Rest); +suite_openssl_str_to_map("SRP-" ++ Rest) -> + suite_openssl_str_to_map("SRP", Rest). + %%-------------------------------------------------------------------- --spec suite_definition(cipher_suite()) -> internal_erl_cipher_suite(). +-spec suite_bin_to_map(cipher_suite()) -> internal_erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. %% Note: Currently not supported suites are commented away. %% They should be supported or removed in the future. %%------------------------------------------------------------------- %% TLS v1.1 suites -suite_definition(?TLS_NULL_WITH_NULL_NULL) -> +suite_bin_to_map(?TLS_NULL_WITH_NULL_NULL) -> #{key_exchange => null, cipher => null, mac => null, @@ -97,111 +183,111 @@ suite_definition(?TLS_NULL_WITH_NULL_NULL) -> %% RFC 5746 - Not a real cipher suite used to signal empty "renegotiation_info" extension %% to avoid handshake failure from old servers that do not ignore %% hello extension data as they should. -suite_definition(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV) -> +suite_bin_to_map(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV) -> #{key_exchange => null, cipher => null, mac => null, prf => null}; -suite_definition(?TLS_RSA_WITH_RC4_128_MD5) -> +suite_bin_to_map(?TLS_RSA_WITH_RC4_128_MD5) -> #{key_exchange => rsa, cipher => rc4_128, mac => md5, prf => default_prf}; -suite_definition(?TLS_RSA_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_RSA_WITH_RC4_128_SHA) -> #{key_exchange => rsa, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_WITH_DES_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_WITH_DES_CBC_SHA) -> #{key_exchange => rsa, cipher => des_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => rsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_DES_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_DES_CBC_SHA) -> #{key_exchange => dhe_dss, cipher => des_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => dhe_dss, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> #{key_exchange => dhe_rsa, cipher => des_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => dhe_rsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; %%% TSL V1.1 AES suites -suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => rsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> #{key_exchange => dhe_dss, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => dhe_rsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => rsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> #{key_exchange => dhe_dss, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => dhe_rsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; %% TLS v1.2 suites -%% suite_definition(?TLS_RSA_WITH_NULL_SHA) -> +%% suite_bin_to_map(?TLS_RSA_WITH_NULL_SHA) -> %% {rsa, null, sha, default_prf}; -suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_RSA_WITH_AES_128_CBC_SHA256) -> #{key_exchange => rsa, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA256) -> +suite_bin_to_map(?TLS_RSA_WITH_AES_256_CBC_SHA256) -> #{key_exchange => rsa, cipher => aes_256_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256) -> #{key_exchange => dhe_dss, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256) -> #{key_exchange => dhe_rsa, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256) -> #{key_exchange => dhe_dss, cipher => aes_256_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> #{key_exchange => dhe_rsa, cipher => aes_256_cbc, mac => sha256, @@ -213,638 +299,683 @@ suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> %% TLS_DH_RSA_WITH_AES_256_CBC_SHA256 DH_RSA AES_256_CBC SHA256 %%% DH-ANON deprecated by TLS spec and not available %%% by default, but good for testing purposes. -suite_definition(?TLS_DH_anon_WITH_RC4_128_MD5) -> +suite_bin_to_map(?TLS_DH_anon_WITH_RC4_128_MD5) -> #{key_exchange => dh_anon, cipher => rc4_128, mac => md5, prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_DES_CBC_SHA) -> +suite_bin_to_map(?TLS_DH_anon_WITH_DES_CBC_SHA) -> #{key_exchange => dh_anon, cipher => des_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => dh_anon, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_DH_anon_WITH_AES_128_CBC_SHA) -> #{key_exchange => dh_anon, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_DH_anon_WITH_AES_256_CBC_SHA) -> #{key_exchange => dh_anon, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_DH_anon_WITH_AES_128_CBC_SHA256) -> #{key_exchange => dh_anon, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA256) -> +suite_bin_to_map(?TLS_DH_anon_WITH_AES_256_CBC_SHA256) -> #{key_exchange => dh_anon, cipher => aes_256_cbc, mac => sha256, prf => default_prf}; %%% PSK Cipher Suites RFC 4279 -suite_definition(?TLS_PSK_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_PSK_WITH_RC4_128_SHA) -> #{key_exchange => psk, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_PSK_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_PSK_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => psk, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_128_CBC_SHA) -> #{key_exchange => psk, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_256_CBC_SHA) -> #{key_exchange => psk, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_RC4_128_SHA) -> #{key_exchange => dhe_psk, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => dhe_psk, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA) -> #{key_exchange => dhe_psk, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA) -> #{key_exchange => dhe_psk, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_RC4_128_SHA) -> #{key_exchange => rsa_psk, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => rsa_psk, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA) -> #{key_exchange => rsa_psk, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA) -> #{key_exchange => rsa_psk, cipher => aes_256_cbc, mac => sha, prf => default_prf}; %%% PSK NULL Cipher Suites RFC 4785 -suite_definition(?TLS_PSK_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_PSK_WITH_NULL_SHA) -> #{key_exchange => psk, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_NULL_SHA) -> #{key_exchange => dhe_psk, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_NULL_SHA) -> #{key_exchange => rsa_psk, cipher => null, mac => sha, prf => default_prf}; %%% TLS 1.2 PSK Cipher Suites RFC 5487 -suite_definition(?TLS_PSK_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => psk, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_PSK_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => psk, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dhe_psk, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dhe_psk, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => rsa_psk, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => rsa_psk, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_PSK_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => psk, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_PSK_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_256_CBC_SHA384) -> #{key_exchange => psk, cipher => aes_256_cbc, mac => sha384, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => dhe_psk, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384) -> #{key_exchange => dhe_psk, cipher => aes_256_cbc, mac => sha384, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => rsa_psk, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384) -> #{key_exchange => rsa_psk, cipher => aes_256_cbc, mac => sha384, prf => default_prf}; -suite_definition(?TLS_PSK_WITH_NULL_SHA256) -> +suite_bin_to_map(?TLS_PSK_WITH_NULL_SHA256) -> #{key_exchange => psk, cipher => null, mac => sha256, prf => default_prf}; -suite_definition(?TLS_PSK_WITH_NULL_SHA384) -> +suite_bin_to_map(?TLS_PSK_WITH_NULL_SHA384) -> #{key_exchange => psk, cipher => null, mac => sha384, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA256) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_NULL_SHA256) -> #{key_exchange => dhe_psk, cipher => null, mac => sha256, prf => default_prf}; -suite_definition(?TLS_DHE_PSK_WITH_NULL_SHA384) -> +suite_bin_to_map(?TLS_DHE_PSK_WITH_NULL_SHA384) -> #{key_exchange => dhe_psk, cipher => null, mac => sha384, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA256) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_NULL_SHA256) -> #{key_exchange => rsa_psk, cipher => null, mac => sha256, prf => default_prf}; -suite_definition(?TLS_RSA_PSK_WITH_NULL_SHA384) -> +suite_bin_to_map(?TLS_RSA_PSK_WITH_NULL_SHA384) -> #{key_exchange => rsa_psk, cipher => null, mac => sha384, prf => default_prf}; %%% ECDHE PSK Cipher Suites RFC 5489 -suite_definition(?TLS_ECDHE_PSK_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_RC4_128_SHA) -> #{key_exchange => ecdhe_psk, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => ecdhe_psk, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA) -> #{key_exchange => ecdhe_psk, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA) -> #{key_exchange => ecdhe_psk, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256) -> #{key_exchange => ecdhe_psk, cipher => aes_128_cbc, mac => sha256, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384) -> #{key_exchange => ecdhe_psk, cipher => aes_256_cbc, mac => sha384, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_NULL_SHA256) -> #{key_exchange => ecdhe_psk, cipher => null, mac => sha256, prf => default_prf}; -suite_definition(?TLS_ECDHE_PSK_WITH_NULL_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_NULL_SHA384) -> #{key_exchange => ecdhe_psk, cipher => null, mac => sha384, prf => default_prf}; %%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 -suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdhe_psk, cipher => aes_128_gcm, mac => null, prf => sha256}; -suite_definition(?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdhe_psk, cipher => aes_256_gcm, mac => null, prf => sha384}; -%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256) -> -%% #{key_exchange => ecdhe_psk, -%% cipher => aes_128_ccm, -%% mac => null, -%% prf =>sha256}; -%% suite_definition(?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256) -> -%% #{key_exchange => ecdhe_psk, -%% cipher => aes_256_ccm, -%% mac => null, -%% prf => sha256}; +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256) -> + #{key_exchange => ecdhe_psk, + cipher => aes_128_ccm, + mac => null, + prf =>sha256}; +suite_bin_to_map(?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256) -> + #{key_exchange => ecdhe_psk, + cipher => aes_128_ccm_8, + mac => null, + prf =>sha256}; %%% SRP Cipher Suites RFC 5054 -suite_definition(?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => srp_anon, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => srp_rsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => srp_dss, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_WITH_AES_128_CBC_SHA) -> #{key_exchange => srp_anon, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => srp_rsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA) -> #{key_exchange => srp_dss, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_WITH_AES_256_CBC_SHA) -> #{key_exchange => srp_anon, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => srp_rsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> #{key_exchange => srp_dss, cipher => aes_256_cbc, mac => sha, prf => default_prf}; %% RFC 4492 EC TLS suites -suite_definition(?TLS_ECDH_ECDSA_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_NULL_SHA) -> #{key_exchange => ecdh_ecdsa, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> #{key_exchange => ecdh_ecdsa, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => ecdh_ecdsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => ecdh_ecdsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => ecdh_ecdsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_NULL_SHA) -> #{key_exchange => ecdhe_ecdsa, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> #{key_exchange => ecdhe_ecdsa, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => ecdhe_ecdsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_NULL_SHA) -> #{key_exchange => ecdh_rsa, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> #{key_exchange => ecdh_rsa, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => ecdh_rsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => ecdh_rsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => ecdh_rsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_NULL_SHA) -> #{key_exchange => ecdhe_rsa, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> #{key_exchange => ecdhe_rsa, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => ecdhe_rsa, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> #{key_exchange => ecdhe_rsa, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> #{key_exchange => ecdhe_rsa, cipher => aes_256_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_NULL_SHA) -> +suite_bin_to_map(?TLS_ECDH_anon_WITH_NULL_SHA) -> #{key_exchange => ecdh_anon, cipher => null, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_RC4_128_SHA) -> +suite_bin_to_map(?TLS_ECDH_anon_WITH_RC4_128_SHA) -> #{key_exchange => ecdh_anon, cipher => rc4_128, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA) -> #{key_exchange => ecdh_anon, cipher => '3des_ede_cbc', mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_AES_128_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_anon_WITH_AES_128_CBC_SHA) -> #{key_exchange => ecdh_anon, cipher => aes_128_cbc, mac => sha, prf => default_prf}; -suite_definition(?TLS_ECDH_anon_WITH_AES_256_CBC_SHA) -> +suite_bin_to_map(?TLS_ECDH_anon_WITH_AES_256_CBC_SHA) -> #{key_exchange => ecdh_anon, cipher => aes_256_cbc, mac => sha, prf => default_prf}; %% RFC 5289 EC TLS suites -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_128_cbc, mac => sha256, prf => sha256}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_256_cbc, mac => sha384, prf => sha384}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> #{key_exchange => ecdh_ecdsa, cipher => aes_128_cbc, mac => sha256, prf => sha256}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> #{key_exchange => ecdh_ecdsa, cipher => aes_256_cbc, mac => sha384, prf => sha384}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> #{key_exchange => ecdhe_rsa, cipher => aes_128_cbc, mac => sha256, prf => sha256}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> #{key_exchange => ecdhe_rsa, cipher => aes_256_cbc, mac => sha384, prf => sha384}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> #{key_exchange => ecdh_rsa, cipher => aes_128_cbc, mac => sha256, prf => sha256}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> #{key_exchange => ecdh_rsa, cipher => aes_256_cbc, mac => sha384, prf => sha384}; %% RFC 5288 AES-GCM Cipher Suites -suite_definition(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => rsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => rsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dhe_rsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dhe_rsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_DH_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_rsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_DH_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_rsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dhe_dss, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dhe_dss, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_DH_DSS_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_dss, cipher => aes_128_gcm, mac => null, prf => sha256}; -suite_definition(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_DH_DSS_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_dss, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_DH_anon_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_DH_anon_WITH_AES_128_GCM_SHA256) -> #{key_exchange => dh_anon, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_DH_anon_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_DH_anon_WITH_AES_256_GCM_SHA384) -> #{key_exchange => dh_anon, cipher => aes_256_gcm, mac => aead, prf => sha384}; %% RFC 5289 ECC AES-GCM Cipher Suites -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdhe_ecdsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdh_ecdsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdh_ecdsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdhe_rsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdhe_rsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256) -> #{key_exchange => ecdh_rsa, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384) -> #{key_exchange => ecdh_rsa, cipher => aes_256_gcm, mac => aead, prf => sha384}; -%% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites -suite_definition(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> +suite_bin_to_map(?TLS_PSK_WITH_AES_128_CCM) -> + #{key_exchange => psk, + cipher => aes_128_ccm, + mac => aead, + prf => sha256}; +suite_bin_to_map(?TLS_PSK_WITH_AES_256_CCM) -> + #{key_exchange => psk, + cipher => aes_256_ccm, + mac => aead, + prf => sha256}; +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_128_CCM) -> + #{key_exchange => dhe_psk, + cipher => aes_128_ccm, + mac => aead, + prf => sha256}; +suite_bin_to_map(?TLS_DHE_PSK_WITH_AES_256_CCM) -> + #{key_exchange => dhe_psk, + cipher => aes_256_ccm, + mac => aead, + prf => sha256}; +suite_bin_to_map(?TLS_PSK_WITH_AES_128_CCM_8) -> + #{key_exchange => psk, + cipher => aes_128_ccm_8, + mac => aead, + prf => sha256}; +suite_bin_to_map(?TLS_PSK_WITH_AES_256_CCM_8) -> + #{key_exchange => psk, + cipher => aes_256_ccm_8, + mac => aead, + prf => sha256}; +suite_bin_to_map(?TLS_PSK_DHE_WITH_AES_128_CCM_8) -> + #{key_exchange => dhe_psk, + cipher => aes_128_ccm_8, + mac => aead, + prf => sha256}; +suite_bin_to_map(?TLS_PSK_DHE_WITH_AES_256_CCM_8) -> + #{key_exchange => dhe_psk, + cipher => aes_256_ccm_8, + mac => aead, + prf => sha256}; +suite_bin_to_map(#{key_exchange := psk_dhe, + cipher := aes_256_ccm_8, + mac := aead, + prf := sha256}) -> + ?TLS_PSK_DHE_WITH_AES_256_CCM_8; + +% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites +suite_bin_to_map(?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> #{key_exchange => ecdhe_rsa, cipher => chacha20_poly1305, mac => aead, prf => sha256}; -suite_definition(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> +suite_bin_to_map(?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256) -> #{key_exchange => ecdhe_ecdsa, cipher => chacha20_poly1305, mac => aead, prf => sha256}; -suite_definition(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> +suite_bin_to_map(?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256) -> #{key_exchange => dhe_rsa, cipher => chacha20_poly1305, mac => aead, prf => sha256}; %% TLS 1.3 Cipher Suites RFC8446 -suite_definition(?TLS_AES_128_GCM_SHA256) -> +suite_bin_to_map(?TLS_AES_128_GCM_SHA256) -> #{key_exchange => any, cipher => aes_128_gcm, mac => aead, prf => sha256}; -suite_definition(?TLS_AES_256_GCM_SHA384) -> +suite_bin_to_map(?TLS_AES_256_GCM_SHA384) -> #{key_exchange => any, cipher => aes_256_gcm, mac => aead, prf => sha384}; -suite_definition(?TLS_CHACHA20_POLY1305_SHA256) -> +suite_bin_to_map(?TLS_CHACHA20_POLY1305_SHA256) -> #{key_exchange => any, cipher => chacha20_poly1305, mac => aead, - prf => sha256}. -%% suite_definition(?TLS_AES_128_CCM_SHA256) -> -%% #{key_exchange => any, -%% cipher => aes_128_ccm, -%% mac => aead, -%% prf => sha256}; -%% suite_definition(?TLS_AES_128_CCM_8_SHA256) -> -%% #{key_exchange => any, + prf => sha256}; +suite_bin_to_map(?TLS_AES_128_CCM_SHA256) -> + #{key_exchange => any, + cipher => aes_128_ccm, + mac => aead, + prf => sha256}. +%% suite_bin_to_map(?TLS_AES_128_CCM_8_SHA256) -> +%% #{key_exchange => any, %% cipher => aes_128_ccm_8, -%% mac => aead, -%% prf => sha256}. - +%% mac => aead, +%% prf => sha256}. %%-------------------------------------------------------------------- --spec erl_suite_definition(cipher_suite() | internal_erl_cipher_suite()) -> old_erl_cipher_suite(). +-spec suite_legacy(cipher_suite() | internal_erl_cipher_suite()) -> old_erl_cipher_suite(). %% %% Description: Return erlang cipher suite definition. Filters last value %% for now (compatibility reasons). %%-------------------------------------------------------------------- -erl_suite_definition(Bin) when is_binary(Bin) -> - erl_suite_definition(suite_definition(Bin)); -erl_suite_definition(#{key_exchange := KeyExchange, cipher := Cipher, +suite_legacy(Bin) when is_binary(Bin) -> + suite_legacy(suite_bin_to_map(Bin)); +suite_legacy(#{key_exchange := KeyExchange, cipher := Cipher, mac := Hash, prf := Prf}) -> case Prf of default_prf -> @@ -854,993 +985,896 @@ erl_suite_definition(#{key_exchange := KeyExchange, cipher := Cipher, end. %%-------------------------------------------------------------------- --spec suite(internal_erl_cipher_suite()) -> cipher_suite(). +-spec suite_map_to_bin(internal_erl_cipher_suite()) -> cipher_suite(). %% %% Description: Return TLS cipher suite definition. %%-------------------------------------------------------------------- %% TLS v1.1 suites -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := rc4_128, mac := md5}) -> ?TLS_RSA_WITH_RC4_128_MD5; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := rc4_128, mac := sha}) -> ?TLS_RSA_WITH_RC4_128_SHA; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := des_cbc, mac := sha}) -> ?TLS_RSA_WITH_DES_CBC_SHA; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher :='3des_ede_cbc', mac := sha}) -> ?TLS_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher:= des_cbc, mac := sha}) -> ?TLS_DHE_DSS_WITH_DES_CBC_SHA; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher:= '3des_ede_cbc', mac := sha}) -> ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher:= des_cbc, mac := sha}) -> ?TLS_DHE_RSA_WITH_DES_CBC_SHA; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher:= '3des_ede_cbc', mac := sha}) -> ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher:= rc4_128, mac := md5}) -> ?TLS_DH_anon_WITH_RC4_128_MD5; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher:= des_cbc, mac := sha}) -> ?TLS_DH_anon_WITH_DES_CBC_SHA; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher:= '3des_ede_cbc', mac := sha}) -> ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA; %%% TSL V1.1 AES suites -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher := aes_128_cbc, mac := sha}) -> ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher := aes_128_cbc, mac := sha}) -> ?TLS_DH_anon_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher := aes_256_cbc, mac := sha}) -> ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher := aes_256_cbc, mac := sha}) -> ?TLS_DH_anon_WITH_AES_256_CBC_SHA; %% TLS v1.2 suites -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_RSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_256_cbc, mac := sha256}) -> ?TLS_RSA_WITH_AES_256_CBC_SHA256; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher := aes_256_cbc, mac := sha256}) -> ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_256_cbc, mac := sha256}) -> ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_DH_anon_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher := aes_256_cbc, mac := sha256}) -> ?TLS_DH_anon_WITH_AES_256_CBC_SHA256; %%% PSK Cipher Suites RFC 4279 -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := rc4_128, mac := sha}) -> ?TLS_PSK_WITH_RC4_128_SHA; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_PSK_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_128_cbc, mac := sha}) -> ?TLS_PSK_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_256_cbc, mac := sha}) -> ?TLS_PSK_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := rc4_128, mac := sha}) -> ?TLS_DHE_PSK_WITH_RC4_128_SHA; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_DHE_PSK_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_128_cbc, mac := sha}) -> ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_256_cbc, mac := sha}) -> ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := rc4_128, mac := sha}) -> ?TLS_RSA_PSK_WITH_RC4_128_SHA; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_RSA_PSK_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := aes_128_cbc, mac := sha}) -> ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := aes_256_cbc, mac := sha}) -> ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA; %%% PSK NULL Cipher Suites RFC 4785 -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := null, mac := sha}) -> ?TLS_PSK_WITH_NULL_SHA; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := null, mac := sha}) -> ?TLS_DHE_PSK_WITH_NULL_SHA; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := null, mac := sha}) -> ?TLS_RSA_PSK_WITH_NULL_SHA; %%% TLS 1.2 PSK Cipher Suites RFC 5487 -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_PSK_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_PSK_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_DHE_PSK_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_DHE_PSK_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_RSA_PSK_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_RSA_PSK_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_PSK_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := aes_256_cbc, mac := sha384}) -> ?TLS_PSK_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_DHE_PSK_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := aes_256_cbc, mac := sha384}) -> ?TLS_DHE_PSK_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_RSA_PSK_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := aes_256_cbc, mac := sha384}) -> ?TLS_RSA_PSK_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := null, mac := sha256}) -> ?TLS_PSK_WITH_NULL_SHA256; -suite(#{key_exchange := psk, +suite_map_to_bin(#{key_exchange := psk, cipher := null, mac := sha384}) -> ?TLS_PSK_WITH_NULL_SHA384; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := null, mac := sha256}) -> ?TLS_DHE_PSK_WITH_NULL_SHA256; -suite(#{key_exchange := dhe_psk, +suite_map_to_bin(#{key_exchange := dhe_psk, cipher := null, mac := sha384}) -> ?TLS_DHE_PSK_WITH_NULL_SHA384; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := null, mac := sha256}) -> ?TLS_RSA_PSK_WITH_NULL_SHA256; -suite(#{key_exchange := rsa_psk, +suite_map_to_bin(#{key_exchange := rsa_psk, cipher := null, mac := sha384}) -> ?TLS_RSA_PSK_WITH_NULL_SHA384; %%% ECDHE PSK Cipher Suites RFC 5489 -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := rc4_128, mac := sha}) -> ?TLS_ECDHE_PSK_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher :='3des_ede_cbc', mac := sha}) -> ?TLS_ECDHE_PSK_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_128_cbc, mac := sha}) -> ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_128_cbc, mac := sha256}) -> ?TLS_ECDHE_PSK_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_256_cbc, mac := sha384}) -> ?TLS_ECDHE_PSK_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := null, mac := sha256}) -> ?TLS_ECDHE_PSK_WITH_NULL_SHA256; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := null, mac := sha384}) -> ?TLS_ECDHE_PSK_WITH_NULL_SHA384; %%% ECDHE_PSK with AES-GCM and AES-CCM Cipher Suites, draft-ietf-tls-ecdhe-psk-aead-05 -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_128_gcm, mac := null, prf := sha256}) -> ?TLS_ECDHE_PSK_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdhe_psk, +suite_map_to_bin(#{key_exchange := ecdhe_psk, cipher := aes_256_gcm, mac := null, prf := sha384}) -> ?TLS_ECDHE_PSK_WITH_AES_256_GCM_SHA384; - %% suite(#{key_exchange := ecdhe_psk, - %% cipher := aes_128_ccm, - %% mac := null, - %% prf := sha256}) -> - %% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256; - %% suite(#{key_exchange := ecdhe_psk, - %% cipher := aes_256_ccm, - %% mac := null, - %% prf := sha256}) -> - %% ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256; +suite_map_to_bin(#{key_exchange := ecdhe_psk, + cipher := aes_128_ccm_8, + mac := null, + prf := sha256}) -> + ?TLS_ECDHE_PSK_WITH_AES_128_CCM_8_SHA256; +suite_map_to_bin(#{key_exchange := ecdhe_psk, + cipher := aes_128_ccm, + mac := null, + prf := sha256}) -> + ?TLS_ECDHE_PSK_WITH_AES_128_CCM_SHA256; %%% SRP Cipher Suites RFC 5054 -suite(#{key_exchange := srp_anon, +suite_map_to_bin(#{key_exchange := srp_anon, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_SRP_SHA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := srp_rsa, +suite_map_to_bin(#{key_exchange := srp_rsa, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := srp_dss, +suite_map_to_bin(#{key_exchange := srp_dss, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := srp_anon, +suite_map_to_bin(#{key_exchange := srp_anon, cipher := aes_128_cbc, mac := sha}) -> ?TLS_SRP_SHA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := srp_rsa, +suite_map_to_bin(#{key_exchange := srp_rsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := srp_dss, +suite_map_to_bin(#{key_exchange := srp_dss, cipher := aes_128_cbc, mac := sha}) -> ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := srp_anon, +suite_map_to_bin(#{key_exchange := srp_anon, cipher := aes_256_cbc, mac := sha}) -> ?TLS_SRP_SHA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := srp_rsa, +suite_map_to_bin(#{key_exchange := srp_rsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := srp_dss, +suite_map_to_bin(#{key_exchange := srp_dss, cipher := aes_256_cbc, mac := sha}) -> ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA; %%% RFC 4492 EC TLS suites -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := null, mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_NULL_SHA; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := rc4_128, mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := null, mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_NULL_SHA; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := rc4_128, mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := null, mac := sha}) -> ?TLS_ECDH_RSA_WITH_NULL_SHA; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := rc4_128, mac := sha}) -> ?TLS_ECDH_RSA_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := null, mac := sha}) -> ?TLS_ECDHE_RSA_WITH_NULL_SHA; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := rc4_128, mac := sha}) -> ?TLS_ECDHE_RSA_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := aes_128_cbc, mac := sha}) -> ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA; -suite(#{key_exchange := ecdh_anon, +suite_map_to_bin(#{key_exchange := ecdh_anon, cipher := null, mac := sha}) -> ?TLS_ECDH_anon_WITH_NULL_SHA; -suite(#{key_exchange := ecdh_anon, +suite_map_to_bin(#{key_exchange := ecdh_anon, cipher := rc4_128, mac := sha}) -> ?TLS_ECDH_anon_WITH_RC4_128_SHA; -suite(#{key_exchange := ecdh_anon, +suite_map_to_bin(#{key_exchange := ecdh_anon, cipher := '3des_ede_cbc', mac := sha}) -> ?TLS_ECDH_anon_WITH_3DES_EDE_CBC_SHA; -suite(#{key_exchange := ecdh_anon, +suite_map_to_bin(#{key_exchange := ecdh_anon, cipher := aes_128_cbc, mac := sha}) -> ?TLS_ECDH_anon_WITH_AES_128_CBC_SHA; -suite(#{key_exchange := ecdh_anon, +suite_map_to_bin(#{key_exchange := ecdh_anon, cipher := aes_256_cbc, mac := sha}) -> ?TLS_ECDH_anon_WITH_AES_256_CBC_SHA; %%% RFC 5289 EC TLS suites -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_128_cbc, mac:= sha256, prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_256_cbc, mac := sha384, prf := sha384}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := aes_128_cbc, mac := sha256, prf := sha256}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := aes_256_cbc, mac := sha384, prf := sha384}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := aes_128_cbc, mac := sha256, prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := aes_256_cbc, mac := sha384, prf := sha384}) -> ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := aes_128_cbc, mac := sha256, prf := sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := aes_256_cbc, mac := sha384, prf := sha384}) -> ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; %% RFC 5288 AES-GCM Cipher Suites -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := rsa, +suite_map_to_bin(#{key_exchange := rsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_RSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_DHE_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dh_rsa, +suite_map_to_bin(#{key_exchange := dh_rsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_DH_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dh_rsa, +suite_map_to_bin(#{key_exchange := dh_rsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_DH_RSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_DHE_DSS_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dhe_dss, +suite_map_to_bin(#{key_exchange := dhe_dss, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dh_dss, +suite_map_to_bin(#{key_exchange := dh_dss, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_DH_DSS_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dh_dss, +suite_map_to_bin(#{key_exchange := dh_dss, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_DH_DSS_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_DH_anon_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := dh_anon, +suite_map_to_bin(#{key_exchange := dh_anon, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_DH_anon_WITH_AES_256_GCM_SHA384; %% RFC 5289 ECC AES-GCM Cipher Suites -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_ECDH_ECDSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdh_ecdsa, +suite_map_to_bin(#{key_exchange := ecdh_ecdsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_ECDH_ECDSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_ECDH_RSA_WITH_AES_128_GCM_SHA256; -suite(#{key_exchange := ecdh_rsa, +suite_map_to_bin(#{key_exchange := ecdh_rsa, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_ECDH_RSA_WITH_AES_256_GCM_SHA384; %% draft-agl-tls-chacha20poly1305-04 Chacha20/Poly1305 Suites -suite(#{key_exchange := ecdhe_rsa, +suite_map_to_bin(#{key_exchange := ecdhe_rsa, cipher := chacha20_poly1305, mac := aead, prf := sha256}) -> ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256; -suite(#{key_exchange := ecdhe_ecdsa, +suite_map_to_bin(#{key_exchange := ecdhe_ecdsa, cipher := chacha20_poly1305, mac := aead, prf := sha256}) -> ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256; -suite(#{key_exchange := dhe_rsa, +suite_map_to_bin(#{key_exchange := dhe_rsa, cipher := chacha20_poly1305, mac := aead, prf := sha256}) -> ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256; + +%% RFC 6655 - TLS-1.2 cipher suites +suite_map_to_bin(#{key_exchange := psk, + cipher := aes_128_ccm, + mac := aead, + prf := sha256}) -> + ?TLS_PSK_WITH_AES_128_CCM; +suite_map_to_bin(#{key_exchange := psk, + cipher := aes_256_ccm, + mac := aead, + prf := sha256}) -> + ?TLS_PSK_WITH_AES_256_CCM; +suite_map_to_bin(#{key_exchange := dhe_psk, + cipher := aes_128_ccm, + mac := aead, + prf := sha256}) -> + ?TLS_DHE_PSK_WITH_AES_128_CCM; +suite_map_to_bin(#{key_exchange := dhe_psk, + cipher := aes_256_ccm, + mac := aead, + prf := sha256}) -> + ?TLS_DHE_PSK_WITH_AES_256_CCM; +suite_map_to_bin(#{key_exchange := rsa, + cipher := aes_128_ccm, + mac := aead, + prf := sha256}) -> + ?TLS_RSA_WITH_AES_128_CCM; +suite_map_to_bin(#{key_exchange := rsa, + cipher := aes_256_ccm, + mac := aead, + prf := sha256}) -> + ?TLS_RSA_WITH_AES_256_CCM; +suite_map_to_bin(#{key_exchange := dhe_rsa, + cipher := aes_128_ccm, + mac := aead, + prf := sha256}) -> + ?TLS_DHE_RSA_WITH_AES_128_CCM; +suite_map_to_bin(#{key_exchange := dhe_rsa, + cipher := aes_256_ccm, + mac := aead, + prf := sha256}) -> + ?TLS_DHE_RSA_WITH_AES_256_CCM; + +suite_map_to_bin(#{key_exchange := psk, + cipher := aes_128_ccm_8, + mac := aead, + prf := sha256}) -> + ?TLS_PSK_WITH_AES_128_CCM_8; +suite_map_to_bin(#{key_exchange := psk, + cipher := aes_256_ccm_8, + mac := aead, + prf := sha256}) -> + ?TLS_PSK_WITH_AES_256_CCM_8; +suite_map_to_bin(#{key_exchange := dhe_psk, + cipher := aes_128_ccm_8, + mac := aead, + prf := sha256}) -> + ?TLS_PSK_DHE_WITH_AES_128_CCM_8; +suite_map_to_bin(#{key_exchange := dhe_psk, + cipher := aes_256_ccm_8, + mac := aead, + prf := sha256}) -> + ?TLS_PSK_DHE_WITH_AES_256_CCM_8; +suite_map_to_bin(#{key_exchange := rsa, + cipher := aes_128_ccm_8, + mac := aead, + prf := sha256}) -> + ?TLS_RSA_WITH_AES_128_CCM_8; +suite_map_to_bin(#{key_exchange := rsa, + cipher := aes_256_ccm_8, + mac := aead, + prf := sha256}) -> + ?TLS_RSA_WITH_AES_256_CCM_8; +suite_map_to_bin(#{key_exchange := dhe_rsa, + cipher := aes_128_ccm_8, + mac := aead, + prf := sha256}) -> + ?TLS_DHE_RSA_WITH_AES_128_CCM_8; +suite_map_to_bin(#{key_exchange := dhe_rsa, + cipher := aes_256_ccm_8, + mac := aead, + prf := sha256}) -> + ?TLS_DHE_RSA_WITH_AES_256_CCM_8; + %% TLS 1.3 Cipher Suites RFC8446 -suite(#{key_exchange := any, +suite_map_to_bin(#{key_exchange := any, cipher := aes_128_gcm, mac := aead, prf := sha256}) -> ?TLS_AES_128_GCM_SHA256; -suite(#{key_exchange := any, +suite_map_to_bin(#{key_exchange := any, cipher := aes_256_gcm, mac := aead, prf := sha384}) -> ?TLS_AES_256_GCM_SHA384; -suite(#{key_exchange := any, +suite_map_to_bin(#{key_exchange := any, cipher := chacha20_poly1305, mac := aead, prf := sha256}) -> - ?TLS_CHACHA20_POLY1305_SHA256. -%% suite(#{key_exchange := any, -%% cipher := aes_128_ccm, -%% mac := aead, -%% prf := sha256}) -> -%% ?TLS_AES_128_CCM_SHA256; -%% suite(#{key_exchange := any, + ?TLS_CHACHA20_POLY1305_SHA256; +suite_map_to_bin(#{key_exchange := any, + cipher := aes_128_ccm, + mac := aead, + prf := sha256}) -> + ?TLS_AES_128_CCM_SHA256. +%% suite_map_to_bin(#{key_exchange := any, %% cipher := aes_128_ccm_8, %% mac := aead, %% prf := sha256}) -> %% ?TLS_AES_128_CCM_8_SHA256. -%%-------------------------------------------------------------------- --spec openssl_suite(openssl_cipher_suite()) -> cipher_suite(). -%% -%% Description: Return TLS cipher suite definition. -%%-------------------------------------------------------------------- -%% translate constants <-> openssl-strings -openssl_suite("DHE-RSA-AES256-SHA256") -> - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256; -openssl_suite("DHE-DSS-AES256-SHA256") -> - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256; -openssl_suite("AES256-SHA256") -> - ?TLS_RSA_WITH_AES_256_CBC_SHA256; -openssl_suite("DHE-RSA-AES128-SHA256") -> - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256; -openssl_suite("DHE-DSS-AES128-SHA256") -> - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256; -openssl_suite("AES128-SHA256") -> - ?TLS_RSA_WITH_AES_128_CBC_SHA256; -openssl_suite("DHE-RSA-AES256-SHA") -> - ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA; -openssl_suite("DHE-DSS-AES256-SHA") -> - ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA; -openssl_suite("AES256-SHA") -> - ?TLS_RSA_WITH_AES_256_CBC_SHA; -openssl_suite("EDH-RSA-DES-CBC3-SHA") -> - ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("EDH-DSS-DES-CBC3-SHA") -> - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA; -openssl_suite("DES-CBC3-SHA") -> - ?TLS_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("DHE-RSA-AES128-SHA") -> - ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA; -openssl_suite("DHE-DSS-AES128-SHA") -> - ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; -openssl_suite("AES128-SHA") -> - ?TLS_RSA_WITH_AES_128_CBC_SHA; -openssl_suite("RC4-SHA") -> - ?TLS_RSA_WITH_RC4_128_SHA; -openssl_suite("RC4-MD5") -> - ?TLS_RSA_WITH_RC4_128_MD5; -openssl_suite("EDH-RSA-DES-CBC-SHA") -> - ?TLS_DHE_RSA_WITH_DES_CBC_SHA; -openssl_suite("DES-CBC-SHA") -> - ?TLS_RSA_WITH_DES_CBC_SHA; - -%%% SRP Cipher Suites RFC 5054 - -openssl_suite("SRP-DSS-AES-256-CBC-SHA") -> - ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA; -openssl_suite("SRP-RSA-AES-256-CBC-SHA") -> - ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA; -openssl_suite("SRP-DSS-3DES-EDE-CBC-SHA") -> - ?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA; -openssl_suite("SRP-RSA-3DES-EDE-CBC-SHA") -> - ?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("SRP-DSS-AES-128-CBC-SHA") -> - ?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA; -openssl_suite("SRP-RSA-AES-128-CBC-SHA") -> - ?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA; - -%% RFC 4492 EC TLS suites -openssl_suite("ECDH-ECDSA-RC4-SHA") -> - ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA; -openssl_suite("ECDH-ECDSA-DES-CBC3-SHA") -> - ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("ECDH-ECDSA-AES128-SHA") -> - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA; -openssl_suite("ECDH-ECDSA-AES256-SHA") -> - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA; -openssl_suite("ECDHE-ECDSA-RC4-SHA") -> - ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA; -openssl_suite("ECDHE-ECDSA-DES-CBC3-SHA") -> - ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("ECDHE-ECDSA-AES128-SHA") -> - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA; -openssl_suite("ECDHE-ECDSA-AES256-SHA") -> - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA; - -openssl_suite("ECDHE-RSA-RC4-SHA") -> - ?TLS_ECDHE_RSA_WITH_RC4_128_SHA; -openssl_suite("ECDHE-RSA-DES-CBC3-SHA") -> - ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("ECDHE-RSA-AES128-SHA") -> - ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA; -openssl_suite("ECDHE-RSA-AES256-SHA") -> - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA; -openssl_suite("ECDH-RSA-RC4-SHA") -> - ?TLS_ECDH_RSA_WITH_RC4_128_SHA; -openssl_suite("ECDH-RSA-DES-CBC3-SHA") -> - ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA; -openssl_suite("ECDH-RSA-AES128-SHA") -> - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA; -openssl_suite("ECDH-RSA-AES256-SHA") -> - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA; +tls_1_3_suite_str_to_map(CipherStr) -> + {Cipher, Mac, Prf} = cipher_str_to_algs(CipherStr, ""), + #{key_exchange => any, + mac => Mac, + cipher => Cipher, + prf => Prf + }. -%% RFC 5289 EC TLS suites -openssl_suite("ECDHE-ECDSA-AES128-SHA256") -> - ?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256; -openssl_suite("ECDHE-ECDSA-AES256-SHA384") -> - ?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384; -openssl_suite("ECDH-ECDSA-AES128-SHA256") -> - ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256; -openssl_suite("ECDH-ECDSA-AES256-SHA384") -> - ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384; -openssl_suite("ECDHE-RSA-AES128-SHA256") -> - ?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256; -openssl_suite("ECDHE-RSA-AES256-SHA384") -> - ?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384; -openssl_suite("ECDH-RSA-AES128-SHA256") -> - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256; -openssl_suite("ECDH-RSA-AES256-SHA384") -> - ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384; +pre_tls_1_3_suite_str_to_map(KexStr, Rest) -> + Kex = algo_str_to_atom(KexStr), + [CipherStr, AlgStr] = string:split(Rest, "_", trailing), + {Cipher, Mac, Prf} = cipher_str_to_algs(CipherStr, AlgStr), + #{key_exchange => Kex, + mac => Mac, + cipher => Cipher, + prf => Prf + }. + +cipher_str_to_algs(CipherStr, "CCM"= End) -> %% PRE TLS 1.3 + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, sha256}; +cipher_str_to_algs(CipherStr, "8" = End) -> %% PRE TLS 1.3 + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, sha256}; +cipher_str_to_algs(CipherStr, "CHACHA20_POLY1305" = End) -> %% PRE TLS 1.3 + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, sha256}; +cipher_str_to_algs(CipherStr0, "") -> %% TLS 1.3 + [CipherStr, AlgStr] = string:split(CipherStr0, "_", trailing), + Hash = algo_str_to_atom(AlgStr), + Cipher = algo_str_to_atom(CipherStr), + {Cipher, aead, Hash}; +cipher_str_to_algs(CipherStr, HashStr) -> %% PRE TLS 1.3 + Hash = algo_str_to_atom(HashStr), + Cipher = algo_str_to_atom(CipherStr), + case is_aead_cipher(CipherStr) of + true -> + {Cipher, aead, Hash}; + false -> + {Cipher, Hash, default_prf} + end. -%% 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; +%% PRE TLS 1.3 +is_aead_cipher("CHACHA20_POLY1305") -> + true; +is_aead_cipher(CipherStr) -> + [_, Rest] = string:split(CipherStr, "_", trailing), + (Rest == "GCM") orelse (Rest == "CCM") orelse (Rest == "8"). -%% 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; +openssl_is_aead_cipher("CHACHA20-POLY1305") -> + true; +openssl_is_aead_cipher(CipherStr) -> + case string:split(CipherStr, "-", trailing) of + [_, Rest] -> + (Rest == "GCM") orelse (Rest == "CCM") orelse (Rest == "8"); + [_] -> + false + end. -%% TLS 1.3 Cipher Suites RFC8446 -openssl_suite("TLS_AES_128_GCM_SHA256") -> - ?TLS_AES_128_GCM_SHA256; -openssl_suite("TLS_AES_256_GCM_SHA384") -> - ?TLS_AES_256_GCM_SHA384; -openssl_suite("TLS_CHACHA20_POLY1305_SHA256") -> - ?TLS_CHACHA20_POLY1305_SHA256. -%% openssl_suite("TLS_AES_128_CCM_SHA256") -> -%% ?TLS_AES_128_CCM_SHA256; -%% openssl_suite("TLS_AES_128_CCM_8_SHA256") -> -%% ?TLS_AES_128_CCM_8_SHA256. +algo_str_to_atom(AlgoStr) -> + erlang:list_to_existing_atom(string:to_lower(AlgoStr)). -%%-------------------------------------------------------------------- --spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite() | internal_erl_cipher_suite(). -%% -%% Description: Return openssl cipher suite name if possible -%%------------------------------------------------------------------- -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> - "DHE-RSA-AES256-SHA"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> - "DHE-DSS-AES256-SHA"; -openssl_suite_name(?TLS_RSA_WITH_AES_256_CBC_SHA) -> - "AES256-SHA"; -openssl_suite_name(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - "EDH-RSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> - "EDH-DSS-DES-CBC3-SHA"; -openssl_suite_name(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> - "DES-CBC3-SHA"; -openssl_suite_name( ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> - "DHE-RSA-AES128-SHA"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> - "DHE-DSS-AES128-SHA"; -openssl_suite_name(?TLS_RSA_WITH_AES_128_CBC_SHA) -> - "AES128-SHA"; -openssl_suite_name(?TLS_RSA_WITH_RC4_128_SHA) -> - "RC4-SHA"; -openssl_suite_name(?TLS_RSA_WITH_RC4_128_MD5) -> - "RC4-MD5"; -openssl_suite_name(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> - "EDH-RSA-DES-CBC-SHA"; -openssl_suite_name(?TLS_RSA_WITH_DES_CBC_SHA) -> - "DES-CBC-SHA"; -openssl_suite_name(?TLS_RSA_WITH_NULL_SHA256) -> - "NULL-SHA256"; -openssl_suite_name(?TLS_RSA_WITH_AES_128_CBC_SHA256) -> - "AES128-SHA256"; -openssl_suite_name(?TLS_RSA_WITH_AES_256_CBC_SHA256) -> - "AES256-SHA256"; -openssl_suite_name(?TLS_DH_DSS_WITH_AES_128_CBC_SHA256) -> - "DH-DSS-AES128-SHA256"; -openssl_suite_name(?TLS_DH_RSA_WITH_AES_128_CBC_SHA256) -> - "DH-RSA-AES128-SHA256"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA256) -> - "DHE-DSS-AES128-SHA256"; -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA256) -> - "DHE-RSA-AES128-SHA256"; -openssl_suite_name(?TLS_DH_DSS_WITH_AES_256_CBC_SHA256) -> - "DH-DSS-AES256-SHA256"; -openssl_suite_name(?TLS_DH_RSA_WITH_AES_256_CBC_SHA256) -> - "DH-RSA-AES256-SHA256"; -openssl_suite_name(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA256) -> - "DHE-DSS-AES256-SHA256"; -openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256) -> - "DHE-RSA-AES256-SHA256"; +openssl_cipher_name(Kex, "AES_128_CBC" ++ _ = CipherStr) when Kex == rsa; + Kex == dhe_rsa; + Kex == ecdhe_rsa; + Kex == ecdhe_ecdsa -> + openssl_name_concat(CipherStr); +openssl_cipher_name(Kex, "AES_256_CBC" ++ _ = CipherStr) when Kex == rsa; + Kex == dhe_rsa; + Kex == ecdhe_rsa; + Kex == ecdhe_ecdsa -> + openssl_name_concat(CipherStr); +openssl_cipher_name(Kex, "AES_128_CBC" ++ _ = CipherStr) when Kex == srp; + Kex == srp_rsa -> + lists:append(string:replace(CipherStr, "_", "-", all)); +openssl_cipher_name(Kex, "AES_256_CBC" ++ _ = CipherStr) when Kex == srp; + Kex == srp_rsa -> + lists:append(string:replace(CipherStr, "_", "-", all)); +openssl_cipher_name(_, "AES_128_CBC" ++ _ = CipherStr) -> + openssl_name_concat(CipherStr) ++ "-CBC"; +openssl_cipher_name(_, "AES_256_CBC" ++ _ = CipherStr) -> + openssl_name_concat(CipherStr) ++ "-CBC"; +openssl_cipher_name(_, "AES_128_GCM" ++ _ = CipherStr) -> + openssl_name_concat(CipherStr) ++ "-GCM"; +openssl_cipher_name(_, "AES_256_GCM" ++ _ = CipherStr) -> + openssl_name_concat(CipherStr) ++ "-GCM"; +openssl_cipher_name(_, "RC4" ++ _) -> + "RC4"; +openssl_cipher_name(_, CipherStr) -> + lists:append(string:replace(CipherStr, "_", "-", all)). -%%% PSK Cipher Suites RFC 4279 -openssl_suite_name(?TLS_PSK_WITH_AES_256_CBC_SHA) -> - "PSK-AES256-CBC-SHA"; -openssl_suite_name(?TLS_PSK_WITH_3DES_EDE_CBC_SHA) -> - "PSK-3DES-EDE-CBC-SHA"; -openssl_suite_name(?TLS_PSK_WITH_AES_128_CBC_SHA) -> - "PSK-AES128-CBC-SHA"; -openssl_suite_name(?TLS_PSK_WITH_RC4_128_SHA) -> - "PSK-RC4-SHA"; +openssl_suite_start(Kex) -> + case openssl_kex_name(Kex) of + "" -> + ""; + Name -> + Name ++ "-" + end. -%%% SRP Cipher Suites RFC 5054 +openssl_kex_name("RSA") -> + ""; +openssl_kex_name(Kex) -> + lists:append(string:replace(Kex, "_", "-", all)). -openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_3DES_EDE_CBC_SHA) -> - "SRP-RSA-3DES-EDE-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_3DES_EDE_CBC_SHA) -> - "SRP-DSS-3DES-EDE-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_AES_128_CBC_SHA) -> - "SRP-RSA-AES-128-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_AES_128_CBC_SHA) -> - "SRP-DSS-AES-128-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA) -> - "SRP-RSA-AES-256-CBC-SHA"; -openssl_suite_name(?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA) -> - "SRP-DSS-AES-256-CBC-SHA"; +kex_name_from_openssl(Kex) -> + lists:append(string:replace(Kex, "-", "_", all)). -%% RFC 4492 EC TLS suites -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_RC4_128_SHA) -> - "ECDH-ECDSA-RC4-SHA"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA) -> - "ECDH-ECDSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA) -> - "ECDH-ECDSA-AES128-SHA"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA) -> - "ECDH-ECDSA-AES256-SHA"; +cipher_name_from_openssl("AES128") -> + "AES_128_CBC"; +cipher_name_from_openssl("AES256") -> + "AES_256_CBC"; +cipher_name_from_openssl("AES128-CBC") -> + "AES_128_CBC"; +cipher_name_from_openssl("AES256-CBC") -> + "AES_256_CBC"; +cipher_name_from_openssl("AES-128-CBC") -> + "AES_128_CBC"; +cipher_name_from_openssl("AES-256-CBC") -> + "AES_256_CBC"; +cipher_name_from_openssl("AES128-GCM") -> + "AES_128_GCM"; +cipher_name_from_openssl("AES256-GCM") -> + "AES_256_GCM"; +cipher_name_from_openssl("RC4") -> + "RC4_128"; +cipher_name_from_openssl(Str) -> + Str. -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA) -> - "ECDHE-ECDSA-RC4-SHA"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA) -> - "ECDHE-ECDSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA) -> - "ECDHE-ECDSA-AES128-SHA"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA) -> - "ECDHE-ECDSA-AES256-SHA"; +openssl_name_concat(Str0) -> + [Str, _] = string:split(Str0, "_", trailing), + [Part1, Part2] = string:split(Str, "_", trailing), + Part1 ++ Part2. -openssl_suite_name(?TLS_ECDH_RSA_WITH_RC4_128_SHA) -> - "ECDH-RSA-RC4-SHA"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA) -> - "ECDH-RSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA) -> - "ECDH-RSA-AES128-SHA"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA) -> - "ECDH-RSA-AES256-SHA"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_RC4_128_SHA) -> - "ECDHE-RSA-RC4-SHA"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - "ECDHE-RSA-DES-CBC3-SHA"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA) -> - "ECDHE-RSA-AES128-SHA"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA) -> - "ECDHE-RSA-AES256-SHA"; +suite_openssl_str_to_map(Kex0, Rest) -> + Kex = algo_str_to_atom(kex_name_from_openssl(Kex0)), + [CipherStr, AlgStr] = string:split(Rest, "-", trailing), + {Cipher, Mac, Prf} = openssl_cipher_str_to_algs(CipherStr, AlgStr), + #{key_exchange => Kex, + mac => Mac, + cipher => Cipher, + prf => Prf + }. -%% RFC 5289 EC TLS suites -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256) -> - "ECDHE-ECDSA-AES128-SHA256"; -openssl_suite_name(?TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384) -> - "ECDHE-ECDSA-AES256-SHA384"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA256) -> - "ECDH-ECDSA-AES128-SHA256"; -openssl_suite_name(?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384) -> - "ECDH-ECDSA-AES256-SHA384"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256) -> - "ECDHE-RSA-AES128-SHA256"; -openssl_suite_name(?TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384) -> - "ECDHE-RSA-AES256-SHA384"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA256) -> - "ECDH-RSA-AES128-SHA256"; -openssl_suite_name(?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384) -> - "ECDH-RSA-AES256-SHA384"; +%% Does only need own implementation PRE TLS 1.3 +openssl_cipher_str_to_algs(CipherStr, "CCM"= End) -> + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, sha256}; +openssl_cipher_str_to_algs(CipherStr, "8" = End) -> + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, sha256}; +openssl_cipher_str_to_algs(CipherStr, "POLY1305" = End) -> + Cipher = algo_str_to_atom(CipherStr ++ "_" ++ End), + {Cipher, aead, sha256}; +openssl_cipher_str_to_algs(CipherStr, HashStr) -> + Hash = algo_str_to_atom(HashStr), + Cipher = algo_str_to_atom(cipher_name_from_openssl(CipherStr)), + case openssl_is_aead_cipher(CipherStr) of + true -> + {Cipher, aead, Hash}; + false -> + {Cipher, Hash, openssl_prf(Hash)} + end. -%% 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"; +openssl_prf(sha256)-> + sha256; +openssl_prf(sha384) -> + sha384; +openssl_prf(_) -> + default_prf. -%% 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"; -%% TLS 1.3 Cipher Suites RFC8446 -openssl_suite_name(?TLS_AES_128_GCM_SHA256) -> - "TLS_AES_128_GCM_SHA256"; -openssl_suite_name(?TLS_AES_256_GCM_SHA384) -> - "TLS_AES_256_GCM_SHA384"; -openssl_suite_name(?TLS_CHACHA20_POLY1305_SHA256) -> - "TLS_CHACHA20_POLY1305_SHA256"; -%% openssl_suite(?TLS_AES_128_CCM_SHA256) -> -%% "TLS_AES_128_CCM_SHA256"; -%% openssl_suite(?TLS_AES_128_CCM_8_SHA256) -> -%% "TLS_AES_128_CCM_8_SHA256"; -%% No oppenssl name -openssl_suite_name(Cipher) -> - suite_definition(Cipher). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 1e97fe046b..a5f754d2e3 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -115,7 +115,7 @@ handshake(Connection, Port, Socket, Opts, User, CbInfo, Timeout) -> %%-------------------------------------------------------------------- -spec handshake(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | - {ok, #sslsocket{}, map()}| {error, reason()}. + {ok, #sslsocket{}, map()}| {error, reason()}. %% %% Description: Starts ssl handshake. %%-------------------------------------------------------------------- @@ -130,8 +130,8 @@ handshake(#sslsocket{pid = [Pid|_]} = Socket, Timeout) -> end. %%-------------------------------------------------------------------- --spec handshake(#sslsocket{}, {#ssl_options{},#socket_options{}}, - timeout()) -> {ok, #sslsocket{}} | {error, reason()}. +-spec handshake(#sslsocket{}, {#ssl_options{},#socket_options{}}, timeout()) -> + {ok, #sslsocket{}} | {ok, #sslsocket{}, map()} | {error, reason()}. %% %% Description: Starts ssl handshake with some new options %%-------------------------------------------------------------------- @@ -703,7 +703,7 @@ handle_session(#server_hello{cipher_suite = CipherSuite, handshake_env = #handshake_env{negotiated_protocol = CurrentProtocol} = HsEnv, connection_env = #connection_env{negotiated_version = ReqVersion} = CEnv} = State0) -> #{key_exchange := KeyAlgorithm} = - ssl_cipher_format:suite_definition(CipherSuite), + ssl_cipher_format:suite_bin_to_map(CipherSuite), PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), @@ -1573,7 +1573,7 @@ connection_info(#state{static_env = #static_env{protocol_cb = Connection}, connection_env = #connection_env{negotiated_version = {_,_} = Version}, ssl_options = Opts}) -> RecordCB = record_cb(Connection), - CipherSuiteDef = #{key_exchange := KexAlg} = ssl_cipher_format:suite_definition(CipherSuite), + CipherSuiteDef = #{key_exchange := KexAlg} = ssl_cipher_format:suite_bin_to_map(CipherSuite), IsNamedCurveSuite = lists:member(KexAlg, [ecdh_ecdsa, ecdhe_ecdsa, ecdh_rsa, ecdhe_rsa, ecdh_anon]), CurveInfo = case ECCCurve of @@ -1584,7 +1584,7 @@ connection_info(#state{static_env = #static_env{protocol_cb = Connection}, end, [{protocol, RecordCB:protocol_version(Version)}, {session_id, SessionId}, - {cipher_suite, ssl_cipher_format:erl_suite_definition(CipherSuiteDef)}, + {cipher_suite, ssl_cipher_format:suite_legacy(CipherSuiteDef)}, {selected_cipher_suite, CipherSuiteDef}, {sni_hostname, SNIHostname} | CurveInfo] ++ ssl_options_list(Opts). @@ -1711,7 +1711,7 @@ resumed_server_hello(#state{session = Session, server_hello(ServerHello, State0, Connection) -> CipherSuite = ServerHello#server_hello.cipher_suite, - #{key_exchange := KeyAlgorithm} = ssl_cipher_format:suite_definition(CipherSuite), + #{key_exchange := KeyAlgorithm} = ssl_cipher_format:suite_bin_to_map(CipherSuite), #state{handshake_env = HsEnv} = State = Connection:queue_handshake(ServerHello, State0), State#state{handshake_env = HsEnv#handshake_env{kex_algorithm = KeyAlgorithm}}. @@ -1726,7 +1726,7 @@ handle_peer_cert(Role, PeerCert, PublicKeyInfo, State1 = State0#state{handshake_env = HsEnv#handshake_env{public_key_info = PublicKeyInfo}, session = Session#session{peer_certificate = PeerCert}}, - #{key_exchange := KeyAlgorithm} = ssl_cipher_format:suite_definition(CipherSuite), + #{key_exchange := KeyAlgorithm} = ssl_cipher_format:suite_bin_to_map(CipherSuite), State = handle_peer_cert_key(Role, PeerCert, PublicKeyInfo, KeyAlgorithm, State1), Connection:next_event(certify, no_record, State). @@ -2728,7 +2728,7 @@ ssl_options_list([ciphers = Key | Keys], [Value | Values], Acc) -> ssl_options_list(Keys, Values, [{Key, lists:map( fun(Suite) -> - ssl_cipher_format:suite_definition(Suite) + ssl_cipher_format:suite_bin_to_map(Suite) end, Value)} | Acc]); ssl_options_list([Key | Keys], [Value | Values], Acc) -> diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 6c95a7edf8..7b34991f4f 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -98,7 +98,7 @@ hello_request() -> #hello_request{}. %%-------------------------------------------------------------------- --spec server_hello(#session{}, ssl_record:ssl_version(), ssl_record:connection_states(), +-spec server_hello(binary(), ssl_record:ssl_version(), ssl_record:connection_states(), Extension::map()) -> #server_hello{}. %% %% Description: Creates a server hello message. @@ -182,7 +182,7 @@ client_certificate_verify(OwnCert, MasterSecret, Version, %% Description: Creates a certificate_request message, called by the server. %%-------------------------------------------------------------------- certificate_request(CipherSuite, CertDbHandle, CertDbRef, HashSigns, Version) -> - Types = certificate_types(ssl_cipher_format:suite_definition(CipherSuite), Version), + Types = certificate_types(ssl_cipher_format:suite_bin_to_map(CipherSuite), Version), Authorities = certificate_authorities(CertDbHandle, CertDbRef), #certificate_request{ certificate_types = Types, @@ -883,7 +883,7 @@ available_suites(ServerCert, UserSuites, Version, undefined, Curve) -> filter_unavailable_ecc_suites(Curve, Suites); available_suites(ServerCert, UserSuites, Version, HashSigns, Curve) -> Suites = available_suites(ServerCert, UserSuites, Version, undefined, Curve), - filter_hashsigns(Suites, [ssl_cipher_format:suite_definition(Suite) || Suite <- Suites], HashSigns, + filter_hashsigns(Suites, [ssl_cipher_format:suite_bin_to_map(Suite) || Suite <- Suites], HashSigns, Version, []). available_signature_algs(undefined, _) -> @@ -1085,7 +1085,7 @@ add_common_extensions(Version, {EcPointFormats, EllipticCurves} = case advertises_ec_ciphers( - lists:map(fun ssl_cipher_format:suite_definition/1, + lists:map(fun ssl_cipher_format:suite_bin_to_map/1, CipherSuites)) of true -> client_ecc_extensions(SupportedECCs); @@ -2421,7 +2421,7 @@ decode_extensions(<<?UINT16(?KEY_SHARE_EXT), ?UINT16(Len), decode_extensions(<<?UINT16(?KEY_SHARE_EXT), ?UINT16(Len), ExtData:Len/binary, Rest/binary>>, Version, MessageType = hello_retry_request, Acc) -> - <<?UINT16(Group),Rest/binary>> = ExtData, + <<?UINT16(Group)>> = ExtData, decode_extensions(Rest, Version, MessageType, Acc#{key_share => #key_share_hello_retry_request{ @@ -2990,7 +2990,7 @@ handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) -> cert_curve(_, _, no_suite) -> {no_curve, no_suite}; cert_curve(Cert, ECCCurve0, CipherSuite) -> - case ssl_cipher_format:suite_definition(CipherSuite) of + case ssl_cipher_format:suite_bin_to_map(CipherSuite) of #{key_exchange := Kex} when Kex == ecdh_ecdsa; Kex == ecdh_rsa -> OtpCert = public_key:pkix_decode_cert(Cert, otp), diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 4ee0230d88..06c3ccae45 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -28,12 +28,12 @@ -define(VSN, "8.2.6"). -define(SECRET_PRINTOUT, "***"). --type reason() :: term(). --type reply() :: term(). --type msg() :: term(). --type from() :: term(). +-type reason() :: any(). +-type reply() :: any(). +-type msg() :: any(). +-type from() :: any(). -type certdb_ref() :: reference(). --type db_handle() :: term(). +-type db_handle() :: any(). -type der_cert() :: binary(). -type issuer() :: tuple(). -type serialnumber() :: integer(). @@ -109,26 +109,26 @@ -define('24H_in_sec', 86400). -record(ssl_options, { - protocol :: tls | dtls, - versions :: [ssl_record:ssl_version()], %% ssl_record:atom_version() in API - verify :: verify_none | verify_peer, + protocol :: tls | dtls | 'undefined', + versions :: [ssl_record:ssl_version()] | 'undefined', %% ssl_record:atom_version() in API + verify :: verify_none | verify_peer | 'undefined', verify_fun, %%:: fun(CertVerifyErrors::term()) -> boolean(), - partial_chain :: fun(), - fail_if_no_peer_cert :: boolean(), - verify_client_once :: boolean(), + partial_chain :: fun() | 'undefined', + fail_if_no_peer_cert :: boolean() | 'undefined', + verify_client_once :: boolean() | 'undefined', %% fun(Extensions, State, Verify, AccError) -> {Extensions, State, AccError} validate_extensions_fun, - depth :: integer(), - certfile :: binary(), + depth :: integer() | 'undefined', + certfile :: binary() | 'undefined', cert :: public_key:der_encoded() | secret_printout() | 'undefined', - keyfile :: binary(), - key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', + keyfile :: binary() | 'undefined', + key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo' | 'undefined', public_key:der_encoded()} | map() %%map() -> ssl:key() how to handle dialyzer? | secret_printout() | 'undefined', password :: string() | secret_printout() | 'undefined', cacerts :: [public_key:der_encoded()] | secret_printout() | 'undefined', - cacertfile :: binary(), - dh :: public_key:der_encoded() | secret_printout(), + cacertfile :: binary() | 'undefined', + dh :: public_key:der_encoded() | secret_printout() | 'undefined', dhfile :: binary() | secret_printout() | 'undefined', user_lookup_fun, % server option, fun to lookup the user psk_identity :: binary() | secret_printout() | 'undefined', @@ -140,23 +140,23 @@ reuse_session :: fun() | binary() | undefined, %% Server side is a fun() %% If false sessions will never be reused, if true they %% will be reused if possible. - reuse_sessions :: boolean() | save, %% Only client side can use value save + reuse_sessions :: boolean() | save | 'undefined', %% Only client side can use value save renegotiate_at, secure_renegotiate, client_renegotiation, %% undefined if not hibernating, or number of ms of %% inactivity after which ssl_connection will go into %% hibernation - hibernate_after :: timeout(), + hibernate_after :: timeout() | 'undefined', %% This option should only be set to true by inet_tls_dist erl_dist = false :: boolean(), - alpn_advertised_protocols = undefined :: [binary()] | undefined , + alpn_advertised_protocols = undefined :: [binary()] | undefined, alpn_preferred_protocols = undefined :: [binary()] | undefined, next_protocols_advertised = undefined :: [binary()] | undefined, next_protocol_selector = undefined, %% fun([binary()]) -> binary()) log_level = notice :: atom(), server_name_indication = undefined, - sni_hosts :: [{inet:hostname(), [tuple()]}], + sni_hosts :: [{inet:hostname(), [tuple()]}] | 'undefined', sni_fun :: function() | undefined, %% Should the server prefer its own cipher order over the one provided by %% the client? @@ -166,14 +166,14 @@ %%mitigation entirely? beast_mitigation = one_n_minus_one :: one_n_minus_one | zero_n | disabled, fallback = false :: boolean(), - crl_check :: boolean() | peer | best_effort, + crl_check :: boolean() | peer | best_effort | 'undefined', crl_cache, signature_algs, signature_algs_cert, eccs, supported_groups, %% RFC 8422, RFC 8446 - honor_ecc_order :: boolean(), - max_handshake_size :: integer(), + honor_ecc_order :: boolean() | 'undefined', + max_handshake_size :: integer() | 'undefined', handshake, customize_hostname_check %% , @@ -199,9 +199,9 @@ }). -type state_name() :: hello | abbreviated | certify | cipher | connection. --type gen_fsm_state_return() :: {next_state, state_name(), term()} | - {next_state, state_name(), term(), timeout()} | - {stop, term(), term()}. +-type gen_fsm_state_return() :: {next_state, state_name(), any()} | + {next_state, state_name(), any(), timeout()} | + {stop, any(), any()}. -type ssl_options() :: #ssl_options{}. -endif. % -ifdef(ssl_internal). diff --git a/lib/ssl/src/ssl_logger.erl b/lib/ssl/src/ssl_logger.erl index f497315235..987693b96b 100644 --- a/lib/ssl/src/ssl_logger.erl +++ b/lib/ssl/src/ssl_logger.erl @@ -206,10 +206,14 @@ parse_handshake(Direction, #encrypted_extensions{} = EncryptedExtensions) -> parse_cipher_suites([_|_] = Ciphers) -> [format_cipher(C) || C <- Ciphers]. -format_cipher(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV) -> - 'TLS_EMPTY_RENEGOTIATION_INFO_SCSV'; format_cipher(C0) -> - list_to_atom(ssl_cipher_format:openssl_suite_name(C0)). + try ssl_cipher_format:suite_bin_to_map(C0) of + Map -> + ssl_cipher_format:suite_map_to_str(Map) + catch + error:function_clause -> + format_uknown_cipher_suite(C0) + end. get_client_version(Version, Extensions) -> CHVersions = maps:get(client_hello_versions, Extensions, undefined), @@ -436,3 +440,7 @@ number_to_hex(N) -> H -> lists:reverse(H) end. + +format_uknown_cipher_suite(<<?BYTE(X), ?BYTE(Y)>>) -> + "0x" ++ number_to_hex(X) ++ "0x" ++ number_to_hex(Y). + diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 91f1876980..867d2cfc5a 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -395,7 +395,7 @@ decipher_aead(Type, #cipher_state{key = Key} = CipherState, AAD0, CipherFragment try Nonce = decrypt_nonce(Type, CipherState, CipherFragment), {AAD, CipherText, CipherTag} = aead_ciphertext_split(Type, CipherState, CipherFragment, AAD0), - case ssl_cipher:aead_decrypt(Type, Key, Nonce, CipherText, CipherTag, AAD) of + case ssl_cipher:aead_decrypt(Type, Key, Nonce, CipherText, CipherTag, AAD) of Content when is_binary(Content) -> Content; _ -> @@ -471,34 +471,43 @@ initial_security_params(ConnectionEnd) -> -define(end_additional_data(AAD, Len), << (begin(AAD)end)/binary, ?UINT16(begin(Len)end) >>). -do_cipher_aead(?CHACHA20_POLY1305 = Type, Fragment, #cipher_state{key=Key} = CipherState, AAD0) -> +do_cipher_aead(?CHACHA20_POLY1305 = Type, Fragment, #cipher_state{key=Key, tag_len = TagLen} = CipherState, AAD0) -> AAD = ?end_additional_data(AAD0, erlang:iolist_size(Fragment)), - Nonce = encrypt_nonce(Type, CipherState), - {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD), + Nonce = chacha_nonce(CipherState), + {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD, TagLen), {<<Content/binary, CipherTag/binary>>, CipherState}; -do_cipher_aead(Type, Fragment, #cipher_state{key=Key, nonce = ExplicitNonce} = CipherState, AAD0) -> +do_cipher_aead(Type, Fragment, #cipher_state{key=Key, tag_len = TagLen, nonce = ExplicitNonce} = CipherState, AAD0) -> AAD = ?end_additional_data(AAD0, erlang:iolist_size(Fragment)), Nonce = encrypt_nonce(Type, CipherState), - {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD), + {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD, TagLen), {<<ExplicitNonce:64/integer, Content/binary, CipherTag/binary>>, CipherState#cipher_state{nonce = ExplicitNonce + 1}}. -encrypt_nonce(?CHACHA20_POLY1305, #cipher_state{nonce = Nonce, iv = IV}) -> - crypto:exor(<<?UINT32(0), Nonce/binary>>, IV); -encrypt_nonce(?AES_GCM, #cipher_state{iv = IV, nonce = ExplicitNonce}) -> + +chacha_nonce(#cipher_state{nonce = Nonce, iv = IV}) -> + crypto:exor(<<?UINT32(0), Nonce/binary>>, IV). + +encrypt_nonce(Type, #cipher_state{iv = IV, nonce = ExplicitNonce}) when Type == ?AES_GCM; + Type == ?AES_CCM; + Type == ?AES_CCM_8 -> <<Salt:4/bytes, _/binary>> = IV, <<Salt/binary, ExplicitNonce:64/integer>>. -decrypt_nonce(?CHACHA20_POLY1305, #cipher_state{nonce = Nonce, iv = IV}, _) -> - crypto:exor(<<Nonce:96/unsigned-big-integer>>, IV); -decrypt_nonce(?AES_GCM, #cipher_state{iv = <<Salt:4/bytes, _/binary>>}, <<ExplicitNonce:8/bytes, _/binary>>) -> - <<Salt/binary, ExplicitNonce/binary>>. +decrypt_nonce(?CHACHA20_POLY1305, CipherState, _) -> + chacha_nonce(CipherState); +decrypt_nonce(Type, #cipher_state{iv = <<Salt:4/bytes, _/binary>>}, <<ExplicitNonce:8/bytes, _/binary>>) when + Type == ?AES_GCM; + Type == ?AES_CCM; + Type == ?AES_CCM_8 -> + <<Salt/binary, ExplicitNonce/binary>>. -compile({inline, [aead_ciphertext_split/4]}). aead_ciphertext_split(?CHACHA20_POLY1305, #cipher_state{tag_len = Len}, CipherTextFragment, AAD) -> CipherLen = byte_size(CipherTextFragment) - Len, <<CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment, {?end_additional_data(AAD, CipherLen), CipherText, CipherTag}; -aead_ciphertext_split(?AES_GCM, #cipher_state{tag_len = Len}, CipherTextFragment, AAD) -> +aead_ciphertext_split(Type, #cipher_state{tag_len = Len}, CipherTextFragment, AAD) when Type == ?AES_GCM; + Type == ?AES_CCM; + Type == ?AES_CCM_8 -> CipherLen = byte_size(CipherTextFragment) - (Len + 8), %% 8 is length of explicit Nonce << _:8/bytes, CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment, {?end_additional_data(AAD, CipherLen), CipherText, CipherTag}. diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index eb718fd20c..6d4d47cedb 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -96,6 +96,11 @@ -define(AES_CBC, 7). -define(AES_GCM, 8). -define(CHACHA20_POLY1305, 9). +%% Following two are not defined in any RFC but we want to have the +%% same type of handling internaly, all of these "bulk_cipher_algorithm" +%% enums are only used internaly anyway. +-define(AES_CCM, 10). +-define(AES_CCM_8, 11). %% CipherType -define(STREAM, 0). diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index fde73cdef1..a05858221a 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -934,7 +934,7 @@ wait_sh(Type, Event, State) -> callback_mode() -> state_functions. -terminate({shutdown, sender_died, Reason}, _StateName, +terminate({shutdown, {sender_died, Reason}}, _StateName, #state{static_env = #static_env{socket = Socket, transport_cb = Transport}} = State) -> @@ -1119,7 +1119,7 @@ handle_info({CloseTag, Socket}, StateName, end; handle_info({'EXIT', Sender, Reason}, _, #state{protocol_specific = #{sender := Sender}} = State) -> - {stop, {shutdown, sender_died, Reason}, State}; + {stop, {shutdown, {sender_died, Reason}}, State}; handle_info(Msg, StateName, State) -> ssl_connection:StateName(info, Msg, State, ?MODULE). diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index e7cee1956b..2480e05097 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -251,7 +251,7 @@ encode_handshake(Package, Version) -> %%-------------------------------------------------------------------- -spec get_tls_handshake(tls_record:tls_version(), binary(), binary() | iolist(), #ssl_options{}) -> - {[tls_handshake()], binary()}. + {[{tls_handshake(), binary()}], binary()}. %% %% Description: Given buffered and new data from ssl_record, collects %% and returns it as a list of handshake messages, also returns leftover @@ -294,7 +294,7 @@ handle_client_hello(Version, no_suite -> ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_ciphers); _ -> - #{key_exchange := KeyExAlg} = ssl_cipher_format:suite_definition(CipherSuite), + #{key_exchange := KeyExAlg} = ssl_cipher_format:suite_bin_to_map(CipherSuite), case ssl_handshake:select_hashsign({ClientHashSigns, ClientSignatureSchemes}, Cert, KeyExAlg, SupportedHashSigns, diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index 0efedf3400..8a4ad922e1 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -887,7 +887,7 @@ calculate_handshake_secrets(ClientKey, SelectedGroup, KeyShare, tls_v1:server_handshake_traffic_secret(HKDFAlgo, HandshakeSecret, lists:reverse(Messages)), %% Calculate traffic keys - #{cipher := Cipher} = ssl_cipher_format:suite_definition(CipherSuite), + #{cipher := Cipher} = ssl_cipher_format:suite_bin_to_map(CipherSuite), {ReadKey, ReadIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ClientHSTrafficSecret), {WriteKey, WriteIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ServerHSTrafficSecret), @@ -922,7 +922,7 @@ calculate_traffic_secrets(#state{connection_states = ConnectionStates, tls_v1:server_application_traffic_secret_0(HKDFAlgo, MasterSecret, lists:reverse(Messages)), %% Calculate traffic keys - #{cipher := Cipher} = ssl_cipher_format:suite_definition(CipherSuite), + #{cipher := Cipher} = ssl_cipher_format:suite_bin_to_map(CipherSuite), {ReadKey, ReadIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ClientAppTrafficSecret0), {WriteKey, WriteIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ServerAppTrafficSecret0), @@ -1323,7 +1323,9 @@ get_signature_scheme_list(#signature_algorithms_cert{ ClientSignatureSchemes; get_signature_scheme_list(#signature_algorithms{ signature_scheme_list = ClientSignatureSchemes}) -> - ClientSignatureSchemes. + %% Filter unassigned and legacy elements + lists:filter(fun (E) -> is_atom(E) andalso E =/= unassigned end, + ClientSignatureSchemes). get_supported_groups(#supported_groups{supported_groups = Groups}) -> Groups. diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 9f0c588cb6..a5c550a429 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -602,16 +602,18 @@ encode_fragments(_Type, _Version, _Data, CS, _CompS, _CipherS, _Seq, _CipherFrag %% 1/n-1 splitting countermeasure Rizzo/Duong-Beast, RC4 chiphers are %% not vulnerable to this attack. -split_iovec([<<FirstByte:8, Rest/binary>>|Data], Version, BCA, one_n_minus_one) +split_iovec(Data, Version, BCA, one_n_minus_one) when (BCA =/= ?RC4) andalso ({3, 1} == Version orelse {3, 0} == Version) -> - [[FirstByte]|split_iovec([Rest|Data])]; + {Part, RestData} = split_iovec(Data, 1, []), + [Part|split_iovec(RestData)]; %% 0/n splitting countermeasure for clients that are incompatible with 1/n-1 %% splitting. split_iovec(Data, Version, BCA, zero_n) when (BCA =/= ?RC4) andalso ({3, 1} == Version orelse {3, 0} == Version) -> - [<<>>|split_iovec(Data)]; + {Part, RestData} = split_iovec(Data, 0, []), + [Part|split_iovec(RestData)]; split_iovec(Data, _Version, _BCA, _BeatMitigation) -> split_iovec(Data). @@ -621,16 +623,16 @@ split_iovec(Data) -> {Part,Rest} = split_iovec(Data, ?MAX_PLAIN_TEXT_LENGTH, []), [Part|split_iovec(Rest)]. %% -split_iovec([Bin|Data], SplitSize, Acc) -> +split_iovec([Bin|Data] = Bin_Data, SplitSize, Acc) -> BinSize = byte_size(Bin), if + BinSize =< SplitSize -> + split_iovec(Data, SplitSize - BinSize, [Bin|Acc]); + SplitSize == 0 -> + {lists:reverse(Acc), Bin_Data}; SplitSize < BinSize -> {Last, Rest} = erlang:split_binary(Bin, SplitSize), - {lists:reverse(Acc, [Last]), [Rest|Data]}; - BinSize < SplitSize -> - split_iovec(Data, SplitSize - BinSize, [Bin|Acc]); - true -> % Perfect match - {lists:reverse(Acc, [Bin]), Data} + {lists:reverse(Acc, [Last]), [Rest|Data]} end; split_iovec([], _SplitSize, Acc) -> {lists:reverse(Acc),[]}. diff --git a/lib/ssl/src/tls_record_1_3.erl b/lib/ssl/src/tls_record_1_3.erl index 97331e1510..74321a1ae2 100644 --- a/lib/ssl/src/tls_record_1_3.erl +++ b/lib/ssl/src/tls_record_1_3.erl @@ -252,7 +252,7 @@ cipher_aead(Fragment, BulkCipherAlgo, Key, Seq, IV, TagLen) -> AAD = additional_data(erlang:iolist_size(Fragment) + TagLen), Nonce = nonce(Seq, IV), {Content, CipherTag} = - ssl_cipher:aead_encrypt(BulkCipherAlgo, Key, Nonce, Fragment, AAD), + ssl_cipher:aead_encrypt(BulkCipherAlgo, Key, Nonce, Fragment, AAD, TagLen), <<Content/binary, CipherTag/binary>>. encode_tls_cipher_text(#tls_cipher_text{opaque_type = Type, diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index f103f3218b..27cd5765e5 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -501,18 +501,18 @@ suites(3) -> suites(4) -> [?TLS_AES_256_GCM_SHA384, ?TLS_AES_128_GCM_SHA256, - ?TLS_CHACHA20_POLY1305_SHA256 + ?TLS_CHACHA20_POLY1305_SHA256, + ?TLS_AES_128_CCM_SHA256 %% Not supported - %% ?TLS_AES_128_CCM_SHA256, %% ?TLS_AES_128_CCM_8_SHA256 ] ++ suites(3); suites('TLS_v1.3') -> [?TLS_AES_256_GCM_SHA384, ?TLS_AES_128_GCM_SHA256, - ?TLS_CHACHA20_POLY1305_SHA256 + ?TLS_CHACHA20_POLY1305_SHA256, + ?TLS_AES_128_CCM_SHA256 %% Not supported - %% ?TLS_AES_128_CCM_SHA256, %% ?TLS_AES_128_CCM_8_SHA256 ]. diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index fc483b0a94..dba90aaff0 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -44,6 +44,7 @@ MODULES = \ ssl_bench_SUITE \ ssl_cipher_SUITE \ ssl_cipher_suite_SUITE \ + openssl_server_cipher_suite_SUITE\ ssl_certificate_verify_SUITE\ ssl_crl_SUITE\ ssl_dist_SUITE \ @@ -64,8 +65,9 @@ MODULES = \ ssl_sni_SUITE \ ssl_eqc_SUITE \ ssl_rfc_5869_SUITE \ - make_certs\ - x509_test + make_certs \ + x509_test \ + inet_crypto_dist ERL_FILES = $(MODULES:%=%.erl) diff --git a/lib/ssl/test/inet_crypto_dist.erl b/lib/ssl/test/inet_crypto_dist.erl new file mode 100644 index 0000000000..5aafaac983 --- /dev/null +++ b/lib/ssl/test/inet_crypto_dist.erl @@ -0,0 +1,1323 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% ------------------------------------------------------------------------- +%% +%% Module for encrypted Erlang protocol - a minimal encrypted +%% distribution protocol based on only a shared secret +%% and the crypto application +%% +-module(inet_crypto_dist). +-define(DIST_NAME, inet_crypto). +-define(DIST_PROTO, crypto). +-define(DRIVER, inet_tcp). +-define(FAMILY, inet). + +-define(PROTOCOL, inet_crypto_dist_v1). +-define(DEFAULT_BLOCK_CRYPTO, aes_128_gcm). +-define(DEFAULT_HASH_ALGORITHM, sha256). +-define(DEFAULT_REKEY_INTERVAL, 32768). + +-export([listen/1, accept/1, accept_connection/5, + setup/5, close/1, select/1, is_node_name/1]). +-export([is_supported/0]). + +%% Generalized dist API, for sibling IPv6 module inet6_crypto_dist +-export([gen_listen/2, gen_accept/2, gen_accept_connection/6, + gen_setup/6, gen_close/2, gen_select/2]). + +-export([nodelay/0]). + +%% Debug +%%%-compile(export_all). +-export([dbg/0, test_server/0, test_client/1]). + +-include_lib("kernel/include/net_address.hrl"). +-include_lib("kernel/include/dist.hrl"). +-include_lib("kernel/include/dist_util.hrl"). + +%% Test if crypto has got enough capabilities for this module to run +%% +is_supported() -> + try {crypto:cipher_info(?DEFAULT_BLOCK_CRYPTO), + crypto:hash_info(?DEFAULT_HASH_ALGORITHM)} + of + {#{block_size := _, iv_length := _, key_length := _}, + #{size := _}} -> + true + catch + error:undef -> + false + end. + +%% ------------------------------------------------------------------------- +%% Erlang distribution plugin structure explained to myself +%% ------- +%% These are the processes involved in the distribution: +%% * net_kernel +%% * The Acceptor +%% * The Controller | Handshaker | Ticker +%% * The DistCtrl process that may be split into: +%% + The Output controller +%% + The Input controller +%% For the regular inet_tcp_dist distribution module, DistCtrl +%% is not one or two processes, but one port - a gen_tcp socket +%% +%% When the VM is started with the argument "-proto_dist inet_crypto" +%% net_kernel registers the module inet_crypto_dist as distribution +%% module. net_kernel calls listen/1 to create a listen socket +%% and then accept/1 with the listen socket as argument to spawn +%% the Acceptor process, which is linked to net_kernel. Apparently +%% the listen socket is owned by net_kernel - I wonder if it could +%% be owned by the Acceptor process instead... +%% +%% The Acceptor process calls blocking accept on the listen socket +%% and when an incoming socket is returned it spawns the DistCtrl +%% process a linked to the Acceptor. The ownership of the accepted +%% socket is transferred to the DistCtrl process. +%% A message is sent to net_kernel to inform it that an incoming +%% connection has appeared and the Acceptor awaits a reply from net_kernel. +%% +%% net_kernel then calls accept_connection/5 to spawn the Controller | +%% Handshaker | Ticker process that is linked to net_kernel. +%% The Controller then awaits a message from the Acceptor process. +%% +%% When net_kernel has spawned the Controller it replies with a message +%% to the Acceptor that then calls DistCtrl to changes its links +%% so DistCtrl ends up linked to the Controller and not to the Acceptor. +%% The Acceptor then sends a message to the Controller. The Controller +%% then changes role into the Handshaker creates a #hs_data{} record +%% and calls dist_util:handshake_other_started/1. After this +%% the Acceptor goes back into a blocking accept on the listen socket. +%% +%% For the regular distribution inet_tcp_dist DistCtrl is a gen_tcp socket +%% and when it is a process it also acts as a socket. The #hs_data{} +%% record used by dist_util presents a set of funs that are used +%% by dist_util to perform the distribution handshake. These funs +%% make sure to transfer the handshake messages through the DistCtrl +%% "socket". +%% +%% When the handshake is finished a fun for this purpose in #hs_data{} +%% is called, which tells DistCtrl that it does not need to be prepared +%% for any more #hs_data{} handshake calls. The DistCtrl process in this +%% module then spawns the Input controller process that gets ownership +%% of the connection's gen_tcp socket and changes into {active, N} mode +%% so now it gets all incoming traffic and delivers that to the VM. +%% The original DistCtrl process changes role into the Output controller +%% process and starts asking the VM for outbound messages and transfers +%% them on the connection socket. +%% +%% The Handshaker now changes into the Ticker role, and uses only two +%% functions in the #hs_data{} record; one to get socket statistics +%% and one to send a tick. None of these may block for any reason +%% in particular not for a congested socket since that would destroy +%% connection supervision. +%% +%% +%% For an connection net_kernel calls setup/5 which spawns the +%% Controller process as linked to net_kernel. This Controller process +%% connects to the other node's listen socket and when that is succesful +%% spawns the DistCtrl process as linked to the controller and transfers +%% socket ownership to it. +%% +%% Then the Controller creates the #hs_data{} record and calls +%% dist_util:handshake_we_started/1 which changes the process role +%% into Handshaker. +%% +%% When the distribution handshake is finished the procedure is just +%% as for an incoming connection above. +%% +%% +%% To sum it up. +%% +%% There is an Acceptor process that is linked to net_kernel and +%% informs it when new connections arrive. +%% +%% net_kernel spawns Controllers for incoming and for outgoing connections. +%% these Controllers use the DistCtrl processes to do distribution +%% handshake and after that becomes Tickers that supervise the connection. +%% +%% The Controller | Handshaker | Ticker is linked to net_kernel, and to +%% DistCtrl, one or both. If any of these connection processes would die +%% all others should be killed by the links. Therefore none of them may +%% terminate with reason 'normal'. +%% ------------------------------------------------------------------------- + +%% ------------------------------------------------------------------------- +%% select/1 is called by net_kernel to ask if this distribution protocol +%% is willing to handle Node +%% + +select(Node) -> + gen_select(Node, ?DRIVER). + +gen_select(Node, Driver) -> + case dist_util:split_node(Node) of + {node, _, Host} -> + case Driver:getaddr(Host) of + {ok, _} -> true; + _ -> false + end; + _ -> + false + end. + +%% ------------------------------------------------------------------------- + +is_node_name(Node) -> + dist_util:is_node_name(Node). + +%% ------------------------------------------------------------------------- +%% Called by net_kernel to create a listen socket for this +%% distribution protocol. This listen socket is used by +%% the Acceptor process. +%% + +listen(Name) -> + gen_listen(Name, ?DRIVER). + +gen_listen(Name, Driver) -> + case inet_tcp_dist:gen_listen(Driver, Name) of + {ok, {Socket, Address, Creation}} -> + inet:setopts(Socket, [binary, {nodelay, true}]), + {ok, + {Socket, Address#net_address{protocol = ?DIST_PROTO}, Creation}}; + Other -> + Other + end. + +%% ------------------------------------------------------------------------- +%% Called by net_kernel to spawn the Acceptor process that awaits +%% new connection in a blocking accept and informs net_kernel +%% when a new connection has appeared, and starts the DistCtrl +%% "socket" process for the connection. +%% + +accept(Listen) -> + gen_accept(Listen, ?DRIVER). + +gen_accept(Listen, Driver) -> + NetKernel = self(), + %% + %% Spawn Acceptor process + %% + Config = config(), + monitor_dist_proc( + spawn_opt( + fun () -> + accept_loop(Listen, Driver, NetKernel, Config) + end, + [link, {priority, max}])). + +accept_loop(Listen, Driver, NetKernel, Config) -> + case Driver:accept(Listen) of + {ok, Socket} -> + wait_for_code_server(), + Timeout = net_kernel:connecttime(), + DistCtrl = start_dist_ctrl(Socket, Config, Timeout), + %% DistCtrl is a "socket" + NetKernel ! + {accept, + self(), DistCtrl, Driver:family(), ?DIST_PROTO}, + receive + {NetKernel, controller, Controller} -> + call_dist_ctrl(DistCtrl, {controller, Controller, self()}), + Controller ! {self(), controller, Socket}; + {NetKernel, unsupported_protocol} -> + exit(unsupported_protocol) + end, + accept_loop(Listen, Driver, NetKernel, Config); + AcceptError -> + exit({accept, AcceptError}) + end. + +wait_for_code_server() -> + %% This is an ugly hack. Starting encryption on a connection + %% requires the crypto module to be loaded. Loading the crypto + %% module triggers its on_load function, which calls + %% code:priv_dir/1 to find the directory where its NIF library is. + %% However, distribution is started earlier than the code server, + %% so the code server is not necessarily started yet, and + %% code:priv_dir/1 might fail because of that, if we receive + %% an incoming connection on the distribution port early enough. + %% + %% If the on_load function of a module fails, the module is + %% unloaded, and the function call that triggered loading it fails + %% with 'undef', which is rather confusing. + %% + %% So let's avoid that by waiting for the code server to start. + %% + case whereis(code_server) of + undefined -> + timer:sleep(10), + wait_for_code_server(); + Pid when is_pid(Pid) -> + ok + end. + +%% ------------------------------------------------------------------------- +%% Called by net_kernel when a new connection has appeared, to spawn +%% a Controller process that performs the handshake with the new node, +%% and then becomes the Ticker connection supervisor. +%% ------------------------------------------------------------------------- + +accept_connection(Acceptor, DistCtrl, MyNode, Allowed, SetupTime) -> + gen_accept_connection( + Acceptor, DistCtrl, MyNode, Allowed, SetupTime, ?DRIVER). + +gen_accept_connection( + Acceptor, DistCtrl, MyNode, Allowed, SetupTime, Driver) -> + NetKernel = self(), + %% + %% Spawn Controller/handshaker/ticker process + %% + monitor_dist_proc( + spawn_opt( + fun() -> + do_accept( + Acceptor, DistCtrl, + MyNode, Allowed, SetupTime, Driver, NetKernel) + end, + [link, {priority, max}])). + +do_accept( + Acceptor, DistCtrl, MyNode, Allowed, SetupTime, Driver, NetKernel) -> + receive + {Acceptor, controller, Socket} -> + Timer = dist_util:start_timer(SetupTime), + HSData = + hs_data_common( + NetKernel, MyNode, DistCtrl, Timer, + Socket, Driver:family()), + HSData_1 = + HSData#hs_data{ + this_node = MyNode, + this_flags = 0, + allowed = Allowed}, + dist_util:handshake_other_started(trace(HSData_1)) + end. + +%% ------------------------------------------------------------------------- +%% Called by net_kernel to spawn a Controller process that sets up +%% a new connection to another Erlang node, performs the handshake +%% with the other it, and then becomes the Ticker process +%% that supervises the connection. +%% ------------------------------------------------------------------------- + +setup(Node, Type, MyNode, LongOrShortNames, SetupTime) -> + gen_setup(Node, Type, MyNode, LongOrShortNames, SetupTime, ?DRIVER). + +gen_setup(Node, Type, MyNode, LongOrShortNames, SetupTime, Driver) -> + NetKernel = self(), + %% + %% Spawn Controller/handshaker/ticker process + %% + monitor_dist_proc( + spawn_opt( + setup_fun( + Node, Type, MyNode, LongOrShortNames, SetupTime, Driver, NetKernel), + [link, {priority, max}])). + +-spec setup_fun(_,_,_,_,_,_,_) -> fun(() -> no_return()). +setup_fun( + Node, Type, MyNode, LongOrShortNames, SetupTime, Driver, NetKernel) -> + fun() -> + do_setup( + Node, Type, MyNode, LongOrShortNames, SetupTime, + Driver, NetKernel) + end. + +-spec do_setup(_,_,_,_,_,_,_) -> no_return(). +do_setup( + Node, Type, MyNode, LongOrShortNames, SetupTime, Driver, NetKernel) -> + {Name, Address} = split_node(Driver, Node, LongOrShortNames), + ErlEpmd = net_kernel:epmd_module(), + {ARMod, ARFun} = get_address_resolver(ErlEpmd, Driver), + Timer = trace(dist_util:start_timer(SetupTime)), + case ARMod:ARFun(Name, Address, Driver:family()) of + {ok, Ip, TcpPort, Version} -> + do_setup_connect( + Node, Type, MyNode, Timer, Driver, NetKernel, + Ip, TcpPort, Version); + {ok, Ip} -> + case ErlEpmd:port_please(Name, Ip) of + {port, TcpPort, Version} -> + do_setup_connect( + Node, Type, MyNode, Timer, Driver, NetKernel, + Ip, TcpPort, Version); + Other -> + ?shutdown2( + Node, + trace( + {port_please_failed, ErlEpmd, Name, Ip, Other})) + end; + Other -> + ?shutdown2( + Node, + trace({getaddr_failed, Driver, Address, Other})) + end. + +-spec do_setup_connect(_,_,_,_,_,_,_,_,_) -> no_return(). + +do_setup_connect( + Node, Type, MyNode, Timer, Driver, NetKernel, + Ip, TcpPort, Version) -> + dist_util:reset_timer(Timer), + ConnectOpts = + trace( + connect_options( + [binary, {active, false}, {packet, 2}, {nodelay, true}])), + case Driver:connect(Ip, TcpPort, ConnectOpts) of + {ok, Socket} -> + Config = config(), + DistCtrl = + start_dist_ctrl(Socket, Config, net_kernel:connecttime()), + %% DistCtrl is a "socket" + HSData = + hs_data_common( + NetKernel, MyNode, DistCtrl, Timer, + Socket, Driver:family()), + HSData_1 = + HSData#hs_data{ + other_node = Node, + this_flags = 0, + other_version = Version, + request_type = Type}, + dist_util:handshake_we_started(trace(HSData_1)); + ConnectError -> + ?shutdown2(Node, + trace({connect_failed, Ip, TcpPort, ConnectError})) + end. + +%% ------------------------------------------------------------------------- +%% close/1 is only called by net_kernel on the socket returned by listen/1. + +close(Socket) -> + gen_close(Socket, ?DRIVER). + +gen_close(Socket, Driver) -> + trace(Driver:close(Socket)). + +%% ------------------------------------------------------------------------- + + +hs_data_common(NetKernel, MyNode, DistCtrl, Timer, Socket, Family) -> + %% Field 'socket' below is set to DistCtrl, which makes + %% the distribution handshake process (ticker) call + %% the funs below with DistCtrl as the S argument. + %% So, S =:= DistCtrl below... + #hs_data{ + kernel_pid = NetKernel, + this_node = MyNode, + socket = DistCtrl, + timer = Timer, + %% + f_send = + fun (S, Packet) when S =:= DistCtrl -> + call_dist_ctrl(S, {send, Packet}) + end, + f_recv = + fun (S, 0, infinity) when S =:= DistCtrl -> + case call_dist_ctrl(S, recv) of + {ok, Bin} when is_binary(Bin) -> + {ok, binary_to_list(Bin)}; + Error -> + Error + end + end, + f_setopts_pre_nodeup = + fun (S) when S =:= DistCtrl -> + ok + end, + f_setopts_post_nodeup = + fun (S) when S =:= DistCtrl -> + ok + end, + f_getll = + fun (S) when S =:= DistCtrl -> + {ok, S} %% DistCtrl is the distribution port + end, + f_address = + fun (S, Node) when S =:= DistCtrl -> + case call_dist_ctrl(S, peername) of + {ok, Address} -> + case dist_util:split_node(Node) of + {node, _, Host} -> + #net_address{ + address = Address, + host = Host, + protocol = ?DIST_PROTO, + family = Family}; + _ -> + {error, no_node} + end + end + end, + f_handshake_complete = + fun (S, _Node, DistHandle) when S =:= DistCtrl -> + call_dist_ctrl(S, {handshake_complete, DistHandle}) + end, + %% + %% mf_tick/1, mf_getstat/1, mf_setopts/2 and mf_getopts/2 + %% are called by the ticker any time after f_handshake_complete/3 + %% so they may not block the caller even for congested socket + mf_tick = + fun (S) when S =:= DistCtrl -> + S ! dist_tick + end, + mf_getstat = + fun (S) when S =:= DistCtrl -> + case + inet:getstat(Socket, [recv_cnt, send_cnt, send_pend]) + of + {ok, Stat} -> + split_stat(Stat, 0, 0, 0); + Error -> + Error + end + end, + mf_setopts = + fun (S, Opts) when S =:= DistCtrl -> + inet:setopts(Socket, setopts_filter(Opts)) + end, + mf_getopts = + fun (S, Opts) when S =:= DistCtrl -> + inet:getopts(Socket, Opts) + end}. + +setopts_filter(Opts) -> + [Opt || + Opt <- Opts, + case Opt of + {K, _} when K =:= active; K =:= deliver; K =:= packet -> false; + K when K =:= list; K =:= binary -> false; + K when K =:= inet; K =:= inet6 -> false; + _ -> true + end]. + +split_stat([{recv_cnt, R}|Stat], _, W, P) -> + split_stat(Stat, R, W, P); +split_stat([{send_cnt, W}|Stat], R, _, P) -> + split_stat(Stat, R, W, P); +split_stat([{send_pend, P}|Stat], R, W, _) -> + split_stat(Stat, R, W, P); +split_stat([], R, W, P) -> + {ok, R, W, P}. + +%% ------------------------------------------------------------ +%% Determine if EPMD module supports address resolving. Default +%% is to use inet_tcp:getaddr/2. +%% ------------------------------------------------------------ +get_address_resolver(EpmdModule, _Driver) -> + case erlang:function_exported(EpmdModule, address_please, 3) of + true -> {EpmdModule, address_please}; + _ -> {erl_epmd, address_please} + end. + + +%% If Node is illegal terminate the connection setup!! +split_node(Driver, Node, LongOrShortNames) -> + case dist_util:split_node(Node) of + {node, Name, Host} -> + check_node(Driver, Node, Name, Host, LongOrShortNames); + {host, _} -> + error_logger:error_msg( + "** Nodename ~p illegal, no '@' character **~n", + [Node]), + ?shutdown2(Node, trace({illegal_node_n@me, Node})); + _ -> + error_logger:error_msg( + "** Nodename ~p illegal **~n", [Node]), + ?shutdown2(Node, trace({illegal_node_name, Node})) + end. + +check_node(Driver, Node, Name, Host, LongOrShortNames) -> + case string:split(Host, ".", all) of + [_] when LongOrShortNames =:= longnames -> + case Driver:parse_address(Host) of + {ok, _} -> + {Name, Host}; + _ -> + error_logger:error_msg( + "** System running to use " + "fully qualified hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown2(Node, trace({not_longnames, Host})) + end; + [_, _|_] when LongOrShortNames =:= shortnames -> + error_logger:error_msg( + "** System NOT running to use " + "fully qualified hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown2(Node, trace({not_shortnames, Host})); + _ -> + {Name, Host} + end. + +%% ------------------------------------------------------------------------- + +connect_options(Opts) -> + case application:get_env(kernel, inet_dist_connect_options) of + {ok, ConnectOpts} -> + Opts ++ setopts_filter(ConnectOpts); + _ -> + Opts + end. + +%% we may not always want the nodelay behaviour +%% for performance reasons +nodelay() -> + case application:get_env(kernel, dist_nodelay) of + undefined -> + {nodelay, true}; + {ok, true} -> + {nodelay, true}; + {ok, false} -> + {nodelay, false}; + _ -> + {nodelay, true} + end. + +config() -> + case init:get_argument(?DIST_NAME) of + error -> + error({missing_argument, ?DIST_NAME}); + {ok, [[String]]} -> + {ok, Tokens, _} = erl_scan:string(String ++ "."), + case erl_parse:parse_term(Tokens) of + {ok, #{secret := Secret} = Config} + when is_binary(Secret); is_list(Secret) -> + Config; + {ok, #{} = Config} -> + error({missing_secret, [{?DIST_NAME,Config}]}); + _ -> + error({bad_argument_value, [{?DIST_NAME,String}]}) + end; + {ok, Value} -> + error({malformed_argument, [{?DIST_NAME,Value}]}) + end. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% The DistCtrl process(es). +%% +%% At net_kernel handshake_complete spawns off the input controller that +%% takes over the socket ownership, and itself becomes the output controller +%% +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%% XXX Missing to "productified": +%%% * Cryptoanalysis by experts +%%% * Proof of usefulness +%%% * Unifying exit reasons using a death_row() function +%%% * Verification (and rejection) of other end's crypto parameters +%%% * OTP:ification (proc_lib?) +%%% * An application to belong to (crypto|kernel?) +%%% * Secret on file (cookie as default?), parameter handling +%%% * Restart and/or code reload policy + +%% Debug client and server + +test_config() -> + #{secret => <<"Secret Cluster Password 123456">>}. + +test_server() -> + {ok, Listen} = gen_tcp:listen(0, [{packet, 2}, {active, false}, binary]), + {ok, Port} = inet:port(Listen), + io:format(?MODULE_STRING":test_client(~w).~n", [Port]), + {ok, Socket} = gen_tcp:accept(Listen), + test(Socket). + +test_client(Port) -> + {ok, Socket} = + gen_tcp:connect( + localhost, Port, [{packet, 2}, {active, false}, binary]), + test(Socket). + +test(Socket) -> + start_dist_ctrl(Socket, test_config(), 10000). + +%% ------------------------------------------------------------------------- + +start_dist_ctrl(Socket, Config, Timeout) -> + Protocol = ?PROTOCOL, + Controller = self(), + Server = + monitor_dist_proc( + spawn_opt( + fun () -> + receive + {?MODULE, From, start} -> + {SendParams, RecvParams} = + init(Socket, Config, Protocol), + reply(From, self()), + handshake(SendParams, 0, RecvParams, 0, Controller) + end + end, + [link, + {priority, max}, + {message_queue_data, off_heap}, + {fullsweep_after, 0}])), + ok = gen_tcp:controlling_process(Socket, Server), + call_dist_ctrl(Server, start, Timeout). + + +call_dist_ctrl(Server, Msg) -> + call_dist_ctrl(Server, Msg, infinity). +%% +call_dist_ctrl(Server, Msg, Timeout) -> + Ref = erlang:monitor(process, Server), + Server ! {?MODULE, {Ref, self()}, Msg}, + receive + {Ref, Res} -> + erlang:demonitor(Ref, [flush]), + Res; + {'DOWN', Ref, process, Server, Reason} -> + exit({?PROTOCOL, Reason}) + after Timeout -> + exit(Server, timeout), + receive + {'DOWN', Ref, process, Server, _} -> + exit({?PROTOCOL, timeout}) + end + end. + +reply({Ref, Pid}, Msg) -> + Pid ! {Ref, Msg}, + ok. + +%% ------------------------------------------------------------------------- + +-record(params, + {protocol, % Encryption protocol tag + socket, + dist_handle, + hash_algorithm, + block_crypto, + rekey_interval, + iv, + key, + tag_len}). + +-define(TCP_ACTIVE, 64). +-define(CHUNK_SIZE, (65536 - 512)). +%% The start chunk starts with zeros, so it seems logical to not have +%% a chunk type with value 0 +-define(HANDSHAKE_CHUNK, 1). +-define(DATA_CHUNK, 2). +-define(TICK_CHUNK, 3). +-define(REKEY_CHUNK, 4). + +%% ------------------------------------------------------------------------- +%% Crypto strategy +%% ------- +%% The crypto strategy is as simple as possible to get an encrypted +%% connection as benchmark reference. It is geared around AEAD +%% ciphers in particular AES-GCM. +%% +%% The init message and the start message must fit in the TCP buffers +%% since both sides start with sending the init message, waits +%% for the other end's init message, sends the start message +%% and waits for the other end's start message. So if the send +%% blocks we have a deadlock. +%% +%% The init message is unencrypted and contains the block cipher and hash +%% algorithms the sender will use, the IV and a key salt. Both sides' +%% key salt is used with the mutual secret as input to the hash algorithm +%% to create different encryption/decryption keys for both directions. +%% +%% The start message is the first encrypted message and contains just +%% encrypted zeros the width of the key, with the header of the init +%% message as AAD data. Successfully decrypting this message +%% verifies that we have an encrypted channel. +%% +%% Subsequent encrypted messages has the sequence number and the length +%% of the message as AAD data. These messages has got a message type +%% differentiating data from ticks. Ticks have a random size in an +%% attempt to make them less obvious to spot. +%% +%% The only reaction to errors is to crash noisily wich will bring +%% down the connection and hopefully produce something useful +%% in the local log, but all the other end sees is a closed connection. +%% ------------------------------------------------------------------------- + +init(Socket, Config, Protocol) -> + Secret = maps:get(secret, Config), + HashAlgorithm = + maps:get(hash_algorithm, Config, ?DEFAULT_HASH_ALGORITHM), + BlockCrypto = + maps:get(block_crypto, Config, ?DEFAULT_BLOCK_CRYPTO), + RekeyInterval = + maps:get(rekey_interval, Config, ?DEFAULT_REKEY_INTERVAL), + %% + SendParams = + init_params( + Socket, Protocol, HashAlgorithm, BlockCrypto, RekeyInterval), + send_init(SendParams, Secret). + +send_init( + #params{ + protocol = Protocol, + socket = Socket, + block_crypto = BlockCrypto, + iv = IVLen, + key = KeyLen, + hash_algorithm = HashAlgorithm} = SendParams, + Secret) -> + %% + ProtocolString = atom_to_binary(Protocol, utf8), + BlockCryptoString = atom_to_binary(BlockCrypto, utf8), + HashAlgorithmString = atom_to_binary(HashAlgorithm, utf8), + SendHeader = + <<ProtocolString/binary, 0, + HashAlgorithmString/binary, 0, + BlockCryptoString/binary, 0>>, + <<IV:IVLen/binary, KeySalt:KeyLen/binary>> = IV_KeySalt = + crypto:strong_rand_bytes(IVLen + KeyLen), + InitPacket = [SendHeader, IV_KeySalt], + ok = gen_tcp:send(Socket, InitPacket), + recv_init(SendParams#params{iv = IV, key = KeySalt}, Secret, SendHeader). + +recv_init( + #params{ + socket = Socket, + hash_algorithm = SendHashAlgorithm, + key = SendKeySalt} = SendParams, Secret, SendHeader) -> + %% + {ok, InitPacket} = gen_tcp:recv(Socket, 0), + [ProtocolString, Rest_1] = binary:split(InitPacket, <<0>>), + Protocol = binary_to_existing_atom(ProtocolString, utf8), + case Protocol of + ?PROTOCOL -> + [HashAlgorithmString, Rest_2] = binary:split(Rest_1, <<0>>), + HashAlgorithm = binary_to_existing_atom(HashAlgorithmString, utf8), + [BlockCryptoString, Rest_3] = binary:split(Rest_2, <<0>>), + BlockCrypto = binary_to_existing_atom(BlockCryptoString, utf8), + #params{ + hash_algorithm = RecvHashAlgorithm, + iv = RecvIVLen, + key = RecvKeyLen} = RecvParams = + init_params( + Socket, Protocol, HashAlgorithm, BlockCrypto, undefined), + <<RecvIV:RecvIVLen/binary, + RecvKeySalt:RecvKeyLen/binary>> = Rest_3, + SendKey = + hash_key(SendHashAlgorithm, SendKeySalt, [RecvKeySalt, Secret]), + RecvKey = + hash_key(RecvHashAlgorithm, RecvKeySalt, [SendKeySalt, Secret]), + SendParams_1 = SendParams#params{key = SendKey}, + RecvParams_1 = RecvParams#params{iv = RecvIV, key = RecvKey}, + RecvHeaderLen = byte_size(InitPacket) - RecvIVLen - RecvKeyLen, + <<RecvHeader:RecvHeaderLen/binary, _/binary>> = InitPacket, + send_start(SendParams_1, SendHeader), + RecvRekeyInterval = recv_start(RecvParams_1, RecvHeader), + {SendParams_1, + RecvParams_1#params{rekey_interval = RecvRekeyInterval}} + end. + +send_start( + #params{ + socket = Socket, + block_crypto = BlockCrypto, + rekey_interval= RekeyInterval, + iv = IV, + key = Key, + tag_len = TagLen}, AAD) -> + %% + KeyLen = byte_size(Key), + Zeros = binary:copy(<<0>>, KeyLen), + {Ciphertext, CipherTag} = + crypto:block_encrypt( + crypto_cipher_name(BlockCrypto), + Key, IV, {AAD, [Zeros, <<RekeyInterval:32>>], TagLen}), + ok = gen_tcp:send(Socket, [Ciphertext, CipherTag]). + +recv_start( + #params{ + socket = Socket, + block_crypto = BlockCrypto, + iv = IV, + key = Key, + tag_len = TagLen}, AAD) -> + {ok, Packet} = gen_tcp:recv(Socket, 0), + KeyLen = byte_size(Key), + PacketLen = KeyLen + 4, + <<Ciphertext:PacketLen/binary, CipherTag:TagLen/binary>> = Packet, + Zeros = binary:copy(<<0>>, KeyLen), + case + crypto:block_decrypt( + crypto_cipher_name(BlockCrypto), + Key, IV, {AAD, Ciphertext, CipherTag}) + of + <<Zeros:KeyLen/binary, RekeyInterval:32>> + when 1 =< RekeyInterval -> + RekeyInterval; + _ -> + error(decrypt_error) + end. + +init_params(Socket, Protocol, HashAlgorithm, BlockCrypto, RekeyInterval) -> + #{block_size := 1, + iv_length := IVLen, + key_length := KeyLen} = crypto:cipher_info(BlockCrypto), + case crypto:hash_info(HashAlgorithm) of + #{size := HashSize} when HashSize >= KeyLen -> + #params{ + socket = Socket, + protocol = Protocol, + hash_algorithm = HashAlgorithm, + block_crypto = BlockCrypto, + rekey_interval = RekeyInterval, + iv = IVLen, + key = KeyLen, + tag_len = 16} + end. + +crypto_cipher_name(BlockCrypto) -> + case BlockCrypto of + aes_128_gcm -> aes_gcm; + aes_192_gcm -> aes_gcm; + aes_256_gcm -> aes_gcm + end. + +hash_key(HashAlgorithm, KeySalt, OtherSalt) -> + KeyLen = byte_size(KeySalt), + <<Key:KeyLen/binary, _/binary>> = + crypto:hash(HashAlgorithm, [KeySalt, OtherSalt]), + Key. + +%% ------------------------------------------------------------------------- +%% net_kernel distribution handshake in progress +%% + +handshake( + SendParams, SendSeq, + #params{socket = Socket} = RecvParams, RecvSeq, Controller) -> + receive + {?MODULE, From, {controller, Controller_1, Parent}} -> + Result = link(Controller_1), + true = unlink(Parent), + reply(From, Result), + handshake(SendParams, SendSeq, RecvParams, RecvSeq, Controller_1); + {?MODULE, From, {handshake_complete, DistHandle}} -> + reply(From, ok), + InputHandler = + monitor_dist_proc( + spawn_opt( + fun () -> + link(Controller), + receive + DistHandle -> + ok = + inet:setopts( + Socket, + [{active, ?TCP_ACTIVE}, + nodelay()]), + input_handler( + RecvParams#params{ + dist_handle = DistHandle}, + RecvSeq, empty_q(), infinity) + end + end, + [link, + {priority, normal}, + {message_queue_data, off_heap}, + {fullsweep_after, 0}])), + _ = monitor(process, InputHandler), % For the benchmark test + ok = gen_tcp:controlling_process(Socket, InputHandler), + ok = erlang:dist_ctrl_input_handler(DistHandle, InputHandler), + InputHandler ! DistHandle, + process_flag(priority, normal), + erlang:dist_ctrl_get_data_notification(DistHandle), + crypto:rand_seed_alg(crypto_cache), + output_handler( + SendParams#params{dist_handle = DistHandle}, SendSeq); + %% + {?MODULE, From, {send, Data}} -> + {SendParams_1, SendSeq_1} = + encrypt_and_send_chunk( + SendParams, SendSeq, [?HANDSHAKE_CHUNK, Data]), + reply(From, ok), + handshake( + SendParams_1, SendSeq_1, RecvParams, RecvSeq, Controller); + {?MODULE, From, recv} -> + {RecvParams_1, RecvSeq_1, Reply} = + recv_and_decrypt_chunk(RecvParams, RecvSeq), + reply(From, Reply), + handshake( + SendParams, SendSeq, RecvParams_1, RecvSeq_1, Controller); + {?MODULE, From, peername} -> + reply(From, inet:peername(Socket)), + handshake(SendParams, SendSeq, RecvParams, RecvSeq, Controller); + %% + _Alien -> + handshake(SendParams, SendSeq, RecvParams, RecvSeq, Controller) + end. + +recv_and_decrypt_chunk(#params{socket = Socket} = RecvParams, RecvSeq) -> + case gen_tcp:recv(Socket, 0) of + {ok, Chunk} -> + case decrypt_chunk(RecvParams, RecvSeq, Chunk) of + <<?HANDSHAKE_CHUNK, Cleartext/binary>> -> + {RecvParams, RecvSeq + 1, {ok, Cleartext}}; + #params{} = RecvParams_1 -> + recv_and_decrypt_chunk(RecvParams_1, 0); + _ -> + error(decrypt_error) + end; + Error -> + {RecvParams, RecvSeq, Error} + end. + +%% ------------------------------------------------------------------------- +%% Output handler process +%% +%% The game here is to flush all dist_data and dist_tick messages, +%% prioritize dist_data over dist_tick, and to not use selective receive + +output_handler(Params, Seq) -> + receive + Msg -> + case Msg of + dist_data -> + output_handler_data(Params, Seq); + dist_tick -> + output_handler_tick(Params, Seq); + _Other -> + %% Ignore + output_handler(Params, Seq) + end + end. + +output_handler_data(Params, Seq) -> + receive + Msg -> + case Msg of + dist_data -> + output_handler_data(Params, Seq); + dist_tick -> + output_handler_data(Params, Seq); + _Other -> + %% Ignore + output_handler_data(Params, Seq) + end + after 0 -> + DistHandle = Params#params.dist_handle, + Q = get_data(DistHandle, empty_q()), + {Params_1, Seq_1} = output_handler_send(Params, Seq, Q, true), + erlang:dist_ctrl_get_data_notification(DistHandle), + output_handler(Params_1, Seq_1) + end. + +output_handler_tick(Params, Seq) -> + receive + Msg -> + case Msg of + dist_data -> + output_handler_data(Params, Seq); + dist_tick -> + output_handler_tick(Params, Seq); + _Other -> + %% Ignore + output_handler_tick(Params, Seq) + end + after 0 -> + TickSize = 8 + rand:uniform(56), + TickData = binary:copy(<<0>>, TickSize), + {Params_1, Seq_1} = + encrypt_and_send_chunk(Params, Seq, [?TICK_CHUNK, TickData]), + output_handler(Params_1, Seq_1) + end. + +output_handler_send( + #params{dist_handle = DistHandle} = Params, Seq, {_, Size, _} = Q, Retry) -> + %% + if + ?CHUNK_SIZE < Size -> + {Cleartext, Q_1} = deq_iovec(?CHUNK_SIZE, Q), + {Params_1, Seq_1} = + encrypt_and_send_chunk(Params, Seq, [?DATA_CHUNK, Cleartext]), + output_handler_send(Params_1, Seq_1, Q_1, Retry); + Retry -> + Q_1 = get_data(DistHandle, Q), + output_handler_send(Params, Seq, Q_1, false); + true -> + {Cleartext, _} = deq_iovec(Size, Q), + encrypt_and_send_chunk(Params, Seq, [?DATA_CHUNK, Cleartext]) + end. + +%% ------------------------------------------------------------------------- +%% Input handler process +%% +%% Here is T 0 or infinity to steer if we should try to receive +%% more data or not; start with infinity, and when we get some +%% data try with 0 to see if more is waiting + +input_handler(#params{socket = Socket} = Params, Seq, Q, T) -> + receive + Msg -> + case Msg of + {tcp_passive, Socket} -> + ok = inet:setopts(Socket, [{active, ?TCP_ACTIVE}]), + Q_1 = + case T of + 0 -> + deliver_data(Params#params.dist_handle, Q); + infinity -> + Q + end, + input_handler(Params, Seq, Q_1, infinity); + {tcp, Socket, Chunk} -> + input_chunk(Params, Seq, Q, Chunk); + {tcp_closed, Socket} -> + error(connection_closed); + _Other -> + %% Ignore... + input_handler(Params, Seq, Q, T) + end + after T -> + Q_1 = deliver_data(Params#params.dist_handle, Q), + input_handler(Params, Seq, Q_1, infinity) + end. + +input_chunk(Params, Seq, Q, Chunk) -> + case decrypt_chunk(Params, Seq, Chunk) of + <<?DATA_CHUNK, Cleartext/binary>> -> + input_handler(Params, Seq + 1, enq_binary(Cleartext, Q), 0); + <<?TICK_CHUNK, _/binary>> -> + input_handler(Params, Seq + 1, Q, 0); + #params{} = Params_1 -> + input_handler(Params_1, 0, Q, 0); + _ -> + error(decrypt_error) + end. + +%% ------------------------------------------------------------------------- +%% erlang:dist_ctrl_* helpers + +%% Get data for sending from the VM and place it in a queue +%% +get_data(DistHandle, {Front, Size, Rear}) -> + get_data(DistHandle, Front, Size, Rear). +%% +get_data(DistHandle, Front, Size, Rear) -> + case erlang:dist_ctrl_get_data(DistHandle) of + none -> + {Front, Size, Rear}; + Bin when is_binary(Bin) -> + Len = byte_size(Bin), + get_data( + DistHandle, Front, Size + 4 + Len, + [Bin, <<Len:32>>|Rear]); + [Bin1, Bin2] -> + Len = byte_size(Bin1) + byte_size(Bin2), + get_data( + DistHandle, Front, Size + 4 + Len, + [Bin2, Bin1, <<Len:32>>|Rear]); + Iovec -> + Len = iolist_size(Iovec), + get_data( + DistHandle, Front, Size + 4 + Len, + lists:reverse(Iovec, [<<Len:32>>|Rear])) + end. + +%% De-packet and deliver received data to the VM from a queue +%% +deliver_data(DistHandle, Q) -> + case Q of + {[], Size, []} -> + Size = 0, % Assert + Q; + {[], Size, Rear} -> + [Bin|Front] = lists:reverse(Rear), + deliver_data(DistHandle, Front, Size, [], Bin); + {[Bin|Front], Size, Rear} -> + deliver_data(DistHandle, Front, Size, Rear, Bin) + end. +%% +deliver_data(DistHandle, Front, Size, Rear, Bin) -> + case Bin of + <<DataSizeA:32, DataA:DataSizeA/binary, + DataSizeB:32, DataB:DataSizeB/binary, Rest/binary>> -> + erlang:dist_ctrl_put_data(DistHandle, DataA), + erlang:dist_ctrl_put_data(DistHandle, DataB), + deliver_data( + DistHandle, + Front, Size - (4 + DataSizeA + 4 + DataSizeB), Rear, + Rest); + <<DataSize:32, Data:DataSize/binary, Rest/binary>> -> + erlang:dist_ctrl_put_data(DistHandle, Data), + deliver_data(DistHandle, Front, Size - (4 + DataSize), Rear, Rest); + <<DataSize:32, FirstData/binary>> -> + TotalSize = 4 + DataSize, + if + TotalSize =< Size -> + BinSize = byte_size(Bin), + {MoreData, Q} = + deq_iovec( + TotalSize - BinSize, + Front, Size - BinSize, Rear), + erlang:dist_ctrl_put_data(DistHandle, [FirstData|MoreData]), + deliver_data(DistHandle, Q); + true -> % Incomplete data + {[Bin|Front], Size, Rear} + end; + <<_/binary>> -> + BinSize = byte_size(Bin), + if + 4 =< Size -> % Fragmented header - extract a header bin + {RestHeader, {Front_1, _Size_1, Rear_1}} = + deq_iovec(4 - BinSize, Front, Size - BinSize, Rear), + Header = iolist_to_binary([Bin|RestHeader]), + deliver_data(DistHandle, Front_1, Size, Rear_1, Header); + true -> % Incomplete header + {[Bin|Front], Size, Rear} + end + end. + +%% ------------------------------------------------------------------------- +%% Encryption and decryption helpers + +encrypt_and_send_chunk( + #params{ + socket = Socket, rekey_interval = Seq, + key = Key, iv = IV, hash_algorithm = HashAlgorithm} = Params, + Seq, Cleartext) -> + %% + KeyLen = byte_size(Key), + IVLen = byte_size(IV), + Chunk = <<IV_1:IVLen/binary, KeySalt:KeyLen/binary>> = + crypto:strong_rand_bytes(IVLen + KeyLen), + ok = gen_tcp:send(Socket, encrypt_chunk(Params, Seq, [?REKEY_CHUNK, Chunk])), + Key_1 = hash_key(HashAlgorithm, Key, KeySalt), + Params_1 = Params#params{key = Key_1, iv = IV_1}, + ok = gen_tcp:send(Socket, encrypt_chunk(Params_1, 0, Cleartext)), + {Params_1, 1}; +encrypt_and_send_chunk(#params{socket = Socket} = Params, Seq, Cleartext) -> + ok = gen_tcp:send(Socket, encrypt_chunk(Params, Seq, Cleartext)), + {Params, Seq + 1}. + +encrypt_chunk( + #params{ + block_crypto = BlockCrypto, + iv = IV, key = Key, tag_len = TagLen}, Seq, Cleartext) -> + %% + ChunkLen = iolist_size(Cleartext) + TagLen, + AAD = <<Seq:32, ChunkLen:32>>, + {Ciphertext, CipherTag} = + crypto:block_encrypt( + crypto_cipher_name(BlockCrypto), Key, IV, {AAD, Cleartext, TagLen}), + Chunk = [Ciphertext,CipherTag], + Chunk. + +decrypt_chunk( + #params{ + block_crypto = BlockCrypto, + iv = IV, key = Key, tag_len = TagLen} = Params, Seq, Chunk) -> + %% + ChunkLen = byte_size(Chunk), + true = TagLen =< ChunkLen, % Assert + AAD = <<Seq:32, ChunkLen:32>>, + CiphertextLen = ChunkLen - TagLen, + <<Ciphertext:CiphertextLen/binary, CipherTag:TagLen/binary>> = Chunk, + block_decrypt( + Params, Seq, crypto_cipher_name(BlockCrypto), + Key, IV, {AAD, Ciphertext, CipherTag}). + +block_decrypt( + #params{rekey_interval = Seq} = Params, Seq, CipherName, Key, IV, Data) -> + %% + KeyLen = byte_size(Key), + IVLen = byte_size(IV), + case crypto:block_decrypt(CipherName, Key, IV, Data) of + <<?REKEY_CHUNK, IV_1:IVLen/binary, KeySalt:KeyLen/binary>> -> + Key_1 = hash_key(Params#params.hash_algorithm, Key, KeySalt), + Params#params{iv = IV_1, key = Key_1}; + _ -> + error(decrypt_error) + end; +block_decrypt(_Params, _Seq, CipherName, Key, IV, Data) -> + crypto:block_decrypt(CipherName, Key, IV, Data). + +%% ------------------------------------------------------------------------- +%% Queue of binaries i.e an iovec queue + +empty_q() -> + {[], 0, []}. + +enq_binary(Bin, {Front, Size, Rear}) -> + {Front, Size + byte_size(Bin), [Bin|Rear]}. + +deq_iovec(GetSize, {Front, Size, Rear}) when GetSize =< Size -> + deq_iovec(GetSize, Front, Size, Rear, []). +%% +deq_iovec(GetSize, Front, Size, Rear) -> + deq_iovec(GetSize, Front, Size, Rear, []). +%% +deq_iovec(GetSize, [], Size, Rear, Acc) -> + deq_iovec(GetSize, lists:reverse(Rear), Size, [], Acc); +deq_iovec(GetSize, [Bin|Front], Size, Rear, Acc) -> + BinSize = byte_size(Bin), + if + BinSize < GetSize -> + deq_iovec( + GetSize - BinSize, Front, Size - BinSize, Rear, [Bin|Acc]); + GetSize < BinSize -> + {Bin1,Bin2} = erlang:split_binary(Bin, GetSize), + {lists:reverse(Acc, [Bin1]), {[Bin2|Front], Size - GetSize, Rear}}; + true -> + {lists:reverse(Acc, [Bin]), {Front, Size - BinSize, Rear}} + end. + +%% ------------------------------------------------------------------------- + +%% Trace point +trace(Term) -> Term. + +%% Keep an eye on this Pid (debug) +monitor_dist_proc(Pid) -> +%%% spawn( +%%% fun () -> +%%% MRef = erlang:monitor(process, Pid), +%%% receive +%%% {'DOWN', MRef, _, _, normal} -> +%%% error_logger:error_report( +%%% [dist_proc_died, +%%% {reason, normal}, +%%% {pid, Pid}]); +%%% {'DOWN', MRef, _, _, Reason} -> +%%% error_logger:info_report( +%%% [dist_proc_died, +%%% {reason, Reason}, +%%% {pid, Pid}]) +%%% end +%%% end), + Pid. + +dbg() -> + dbg:stop(), + dbg:tracer(), + dbg:p(all, c), + dbg:tpl(?MODULE, cx), + dbg:tpl(erlang, dist_ctrl_get_data_notification, cx), + dbg:tpl(erlang, dist_ctrl_get_data, cx), + dbg:tpl(erlang, dist_ctrl_put_data, cx), + ok. diff --git a/lib/ssl/test/openssl_server_cipher_suite_SUITE.erl b/lib/ssl/test/openssl_server_cipher_suite_SUITE.erl new file mode 100644 index 0000000000..907de1abe2 --- /dev/null +++ b/lib/ssl/test/openssl_server_cipher_suite_SUITE.erl @@ -0,0 +1,768 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(openssl_server_cipher_suite_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- +all() -> + [ + {group, 'tlsv1.2'}, + {group, 'tlsv1.1'}, + {group, 'tlsv1'}, + {group, 'sslv3'}, + {group, 'dtlsv1.2'}, + {group, 'dtlsv1'} + ]. + +groups() -> + %% TODO: Enable SRP, PSK suites (needs OpenSSL s_server conf) + %% TODO: Enable all "kex" on DTLS + [ + {'tlsv1.2', [], kex()}, + {'tlsv1.1', [], kex()}, + {'tlsv1', [], kex()}, + {'sslv3', [], kex()}, + {'dtlsv1.2', [], dtls_kex()}, + {'dtlsv1', [], dtls_kex()}, + {dhe_rsa, [],[dhe_rsa_3des_ede_cbc, + dhe_rsa_aes_128_cbc, + dhe_rsa_aes_256_cbc, + dhe_rsa_chacha20_poly1305 + ]}, + {ecdhe_rsa, [], [ecdhe_rsa_3des_ede_cbc, + ecdhe_rsa_aes_128_cbc, + ecdhe_rsa_aes_128_gcm, + ecdhe_rsa_aes_256_cbc, + ecdhe_rsa_aes_256_gcm, + ecdhe_rsa_chacha20_poly1305 + ]}, + {ecdhe_ecdsa, [],[ecdhe_ecdsa_rc4_128, + ecdhe_ecdsa_3des_ede_cbc, + ecdhe_ecdsa_aes_128_cbc, + ecdhe_ecdsa_aes_128_gcm, + ecdhe_ecdsa_aes_256_cbc, + ecdhe_ecdsa_aes_256_gcm, + ecdhe_ecdsa_chacha20_poly1305 + ]}, + {rsa, [], [rsa_3des_ede_cbc, + rsa_aes_128_cbc, + rsa_aes_256_cbc, + rsa_rc4_128 + ]}, + {dhe_dss, [], [dhe_dss_3des_ede_cbc, + dhe_dss_aes_128_cbc, + dhe_dss_aes_256_cbc]}, + %% {srp_rsa, [], [srp_rsa_3des_ede_cbc, + %% srp_rsa_aes_128_cbc, + %% srp_rsa_aes_256_cbc]}, + %% {srp_dss, [], [srp_dss_3des_ede_cbc, + %% srp_dss_aes_128_cbc, + %% srp_dss_aes_256_cbc]}, + %% {rsa_psk, [], [rsa_psk_3des_ede_cbc, + %% rsa_psk_rc4_128, + %% rsa_psk_aes_128_cbc, + %% rsa_psk_aes_256_cbc + %% ]}, + {dh_anon, [], [dh_anon_rc4_128, + dh_anon_3des_ede_cbc, + dh_anon_aes_128_cbc, + dh_anon_aes_128_gcm, + dh_anon_aes_256_cbc, + dh_anon_aes_256_gcm]}, + {ecdh_anon, [], [ecdh_anon_3des_ede_cbc, + ecdh_anon_aes_128_cbc, + ecdh_anon_aes_256_cbc + ]} + %% {srp_anon, [], [srp_anon_3des_ede_cbc, + %% srp_anon_aes_128_cbc, + %% srp_anon_aes_256_cbc]}, + %% {psk, [], [psk_3des_ede_cbc, + %% psk_rc4_128, + %% psk_aes_128_cbc, + %% psk_aes_128_ccm, + %% psk_aes_128_ccm_8, + %% psk_aes_256_cbc, + %% psk_aes_256_ccm, + %% psk_aes_256_ccm_8 + %% ]}, + %% {dhe_psk, [], [dhe_psk_3des_ede_cbc, + %% dhe_psk_rc4_128, + %% dhe_psk_aes_128_cbc, + %% dhe_psk_aes_128_ccm, + %% dhe_psk_aes_128_ccm_8, + %% dhe_psk_aes_256_cbc, + %% dhe_psk_aes_256_ccm, + %% dhe_psk_aes_256_ccm_8 + %% ]}, + %% {ecdhe_psk, [], [ecdhe_psk_3des_ede_cbc, + %% ecdhe_psk_rc4_128, + %% ecdhe_psk_aes_128_cbc, + %% ecdhe_psk_aes_128_ccm, + %% ecdhe_psk_aes_128_ccm_8, + %% ecdhe_psk_aes_256_cbc + %% ]} + ]. + +kex() -> + rsa() ++ ecdsa() ++ dss() ++ anonymous(). + +dtls_kex() -> %% Should be all kex in the future + dtls_rsa() ++ dss() ++ anonymous(). + +rsa() -> + [{group, dhe_rsa}, + {group, ecdhe_rsa}, + {group, rsa} %%, {group, srp_rsa}, + %%{group, rsa_psk} + ]. + +dtls_rsa() -> + [ + {group, rsa} + %%,{group, rsa_psk} + ]. + +ecdsa() -> + [{group, ecdhe_ecdsa}]. + +dss() -> + [{group, dhe_dss} + %%{group, srp_dss} + ]. + +anonymous() -> + [{group, dh_anon}, + {group, ecdh_anon} + %% {group, psk}, + %%{group, dhe_psk}, + %%{group, ecdhe_psk} + %%{group, srp_anon} + ]. + +init_per_suite(Config) -> + catch crypto:stop(), + try crypto:start() of + ok -> + ssl_test_lib:clean_start(), + Config + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(_Config) -> + ssl:stop(), + application:stop(crypto). + +%%-------------------------------------------------------------------- +init_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + case ssl_test_lib:supports_ssl_tls_version(GroupName) of + true -> + do_init_per_group(GroupName, Config); + false -> + {skip, {openssl_does_not_support, GroupName}} + end; + false -> + do_init_per_group(GroupName, Config) + end. + +do_init_per_group(GroupName, Config) when GroupName == ecdh_anon; + GroupName == ecdhe_rsa; + GroupName == ecdhe_psk -> + case proplists:get_bool(ecdh, proplists:get_value(public_keys, crypto:supports())) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing EC crypto support"} + end; +do_init_per_group(ecdhe_ecdsa = GroupName, Config) -> + PKAlg = proplists:get_value(public_keys, crypto:supports()), + case lists:member(ecdh, PKAlg) andalso lists:member(ecdsa, PKAlg) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing EC crypto support"} + end; +do_init_per_group(dhe_dss = GroupName, Config) -> + PKAlg = proplists:get_value(public_keys, crypto:supports()), + case lists:member(dss, PKAlg) andalso lists:member(dh, PKAlg) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing DSS crypto support"} + end; +do_init_per_group(srp_dss = GroupName, Config) -> + PKAlg = proplists:get_value(public_keys, crypto:supports()), + case lists:member(dss, PKAlg) andalso lists:member(srp, PKAlg) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing DSS_SRP crypto support"} + end; +do_init_per_group(GroupName, Config) when GroupName == srp_anon; + GroupName == srp_rsa -> + PKAlg = proplists:get_value(public_keys, crypto:supports()), + case lists:member(srp, PKAlg) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing SRP crypto support"} + end; +do_init_per_group(dhe_psk = GroupName, Config) -> + PKAlg = proplists:get_value(public_keys, crypto:supports()), + case lists:member(dh, PKAlg) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing SRP crypto support"} + end; +do_init_per_group(GroupName, Config0) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:init_tls_version(GroupName, end_per_group(GroupName, Config0)); + false -> + init_certs(GroupName, Config0) + end. + +end_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + ssl_test_lib:clean_tls_version(Config); + false -> + Config + end. + +init_per_testcase(TestCase, Config) when TestCase == psk_3des_ede_cbc; + TestCase == srp_anon_3des_ede_cbc; + TestCase == dhe_psk_3des_ede_cbc; + TestCase == ecdhe_psk_3des_ede_cbc; + TestCase == srp_rsa_3des_ede_cbc; + TestCase == srp_dss_3des_ede_cbc; + TestCase == rsa_psk_3des_ede_cbc; + TestCase == rsa_3des_ede_cbc; + TestCase == dhe_rsa_3des_ede_cbc; + TestCase == dhe_dss_3des_ede_cbc; + TestCase == ecdhe_rsa_3des_ede_cbc; + TestCase == srp_anon_dss_3des_ede_cbc; + TestCase == dh_anon_3des_ede_cbc; + TestCase == ecdh_anon_3des_ede_cbc; + TestCase == ecdhe_ecdsa_3des_ede_cbc -> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(des_ede3, SupCiphers) of + true -> + ct:timetrap({seconds, 5}), + Config; + _ -> + {skip, "Missing 3DES crypto support"} + end; +init_per_testcase(TestCase, Config) when TestCase == psk_rc4_128; + TestCase == ecdhe_psk_rc4_128; + TestCase == dhe_psk_rc4_128; + TestCase == rsa_psk_rc4_128; + TestCase == rsa_rc4_128; + TestCase == ecdhe_rsa_rc4_128; + TestCase == ecdhe_ecdsa_rc4_128; + TestCase == dh_anon_rc4_128 -> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(rc4, SupCiphers) of + true -> + ct:timetrap({seconds, 5}), + Config; + _ -> + {skip, "Missing RC4 crypto support"} + end; +init_per_testcase(TestCase, Config) when TestCase == psk_aes_128_ccm_8; + TestCase == rsa_psk_aes_128_ccm_8; + TestCase == psk_aes_128_ccm_8; + TestCase == dhe_psk_aes_128_ccm_8; + TestCase == ecdhe_psk_aes_128_ccm_8 -> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(aes_128_ccm, SupCiphers) of + true -> + ct:timetrap({seconds, 5}), + Config; + _ -> + {skip, "Missing AES_128_CCM crypto support"} + end; +init_per_testcase(TestCase, Config) when TestCase == psk_aes_256_ccm_8; + TestCase == rsa_psk_aes_256_ccm_8; + TestCase == psk_aes_256_ccm_8; + TestCase == dhe_psk_aes_256_ccm_8; + TestCase == ecdhe_psk_aes_256_ccm_8 -> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(aes_256_ccm, SupCiphers) of + true -> + ct:timetrap({seconds, 5}), + Config; + _ -> + {skip, "Missing AES_256_CCM crypto support"} + end; +init_per_testcase(TestCase, Config) -> + Cipher = ssl_test_lib:test_cipher(TestCase, Config), + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(Cipher, SupCiphers) of + true -> + ct:timetrap({seconds, 5}), + Config; + _ -> + {skip, {Cipher, SupCiphers}} + end. + +end_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% Initializtion ------------------------------------------ +%%-------------------------------------------------------------------- +init_certs(srp_rsa, Config) -> + {ClientOpts, ServerOpts} = ssl_test_lib:make_rsa_cert_chains([{server_chain, ssl_test_lib:default_cert_chain_conf()}, + {client_chain, ssl_test_lib:default_cert_chain_conf()}], + Config, ""), + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}} | ServerOpts], + client_config => [{srp_identity, {"Test-User", "secret"}} | ClientOpts]}} | + proplists:delete(tls_config, Config)]; +init_certs(srp_anon, Config) -> + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}}], + client_config => [{srp_identity, {"Test-User", "secret"}}]}} | + proplists:delete(tls_config, Config)]; +init_certs(rsa_psk, Config) -> + Ext = x509_test:extensions([{key_usage, [digitalSignature, keyEncipherment]}]), + {ClientOpts, ServerOpts} = ssl_test_lib:make_rsa_cert_chains([{server_chain, + [[ssl_test_lib:digest()],[ssl_test_lib:digest()], + [ssl_test_lib:digest(), {extensions, Ext}]]}, + {client_chain, ssl_test_lib:default_cert_chain_conf()}], + Config, "_peer_keyEncipherment"), + PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}} | ServerOpts], + client_config => [{psk_identity, "Test-User"}, + {user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}} | ClientOpts]}} | + proplists:delete(tls_config, Config)]; +init_certs(rsa, Config) -> + Ext = x509_test:extensions([{key_usage, [digitalSignature, keyEncipherment]}]), + {ClientOpts, ServerOpts} = ssl_test_lib:make_rsa_cert_chains([{server_chain, + [[ssl_test_lib:digest()],[ssl_test_lib:digest()], + [ssl_test_lib:digest(), {extensions, Ext}]]} + ], + Config, "_peer_keyEncipherment"), + [{tls_config, #{server_config => ServerOpts, + client_config => ClientOpts}} | + proplists:delete(tls_config, Config)]; +init_certs(dhe_dss, Config) -> + {ClientOpts, ServerOpts} = ssl_test_lib:make_dsa_cert_chains([{server_chain, ssl_test_lib:default_cert_chain_conf()}, + {client_chain, ssl_test_lib:default_cert_chain_conf()}], + Config, ""), + [{tls_config, #{server_config => ServerOpts, + client_config => ClientOpts}} | + proplists:delete(tls_config, Config)]; +init_certs(srp_dss, Config) -> + {ClientOpts, ServerOpts} = ssl_test_lib:make_dsa_cert_chains([{server_chain, ssl_test_lib:default_cert_chain_conf()}, + {client_chain, ssl_test_lib:default_cert_chain_conf()}], + Config, ""), + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}} | ServerOpts], + client_config => [{srp_identity, {"Test-User", "secret"}} | ClientOpts]}} | + proplists:delete(tls_config, Config)]; +init_certs(GroupName, Config) when GroupName == dhe_rsa; + GroupName == ecdhe_rsa -> + {ClientOpts, ServerOpts} = ssl_test_lib:make_rsa_cert_chains([{server_chain, ssl_test_lib:default_cert_chain_conf()}, + {client_chain, ssl_test_lib:default_cert_chain_conf()}], + Config, ""), + [{tls_config, #{server_config => ServerOpts, + client_config => ClientOpts}} | + proplists:delete(tls_config, Config)]; +init_certs(GroupName, Config) when GroupName == dhe_ecdsa; + GroupName == ecdhe_ecdsa -> + {ClientOpts, ServerOpts} = ssl_test_lib:make_ecc_cert_chains([{server_chain, ssl_test_lib:default_cert_chain_conf()}, + {client_chain, ssl_test_lib:default_cert_chain_conf()}], + Config, ""), + [{tls_config, #{server_config => ServerOpts, + client_config => ClientOpts}} | + proplists:delete(tls_config, Config)]; +init_certs(GroupName, Config) when GroupName == psk; + GroupName == dhe_psk; + GroupName == ecdhe_psk -> + PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}}], + client_config => [{psk_identity, "Test-User"}, + {user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}}]}} | + proplists:delete(tls_config, Config)]; +init_certs(srp, Config) -> + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}}], + client_config => [{srp_identity, {"Test-User", "secret"}}]}} | + proplists:delete(tls_config, Config)]; +init_certs(_GroupName, Config) -> + %% Anonymous does not need certs + [{tls_config, #{server_config => [], + client_config => []}} | + proplists:delete(tls_config, Config)]. +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- + +%%-------------------------------------------------------------------- +%% SRP -------------------------------------------------------- +%%-------------------------------------------------------------------- +srp_rsa_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_rsa, '3des_ede_cbc', Config). + +srp_rsa_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_rsa, 'aes_128_cbc', Config). + +srp_rsa_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_rsa, 'aes_256_cbc', Config). + +srp_dss_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_dss, '3des_ede_cbc', Config). + +srp_dss_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_dss, 'aes_128_cbc', Config). + +srp_dss_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_dss, 'aes_256_cbc', Config). + +%%-------------------------------------------------------------------- +%% PSK -------------------------------------------------------- +%%-------------------------------------------------------------------- +rsa_psk_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, '3des_ede_cbc', Config). + +rsa_psk_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'aes_128_cbc', Config). + +rsa_psk_aes_128_ccm(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'aes_128_ccm', Config). + +rsa_psk_aes_128_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'aes_128_ccm_8', Config). + +rsa_psk_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'aes_256_cbc', Config). + +rsa_psk_aes_256_ccm(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'aes_256_ccm', Config). + +rsa_psk_aes_256_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'aes_256_ccm_8', Config). + +rsa_psk_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(rsa_psk, 'rc4_128', Config). + +%%-------------------------------------------------------------------- +%% RSA -------------------------------------------------------- +%%-------------------------------------------------------------------- +rsa_des_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa, 'des_cbc', Config). + +rsa_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa, '3des_ede_cbc', Config). + +rsa_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa, 'aes_128_cbc', Config). + +rsa_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(rsa, 'aes_256_cbc', Config). + +rsa_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(rsa, 'aes_128_gcm', Config). + +rsa_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(rsa, 'aes_256_gcm', Config). + +rsa_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(rsa, 'rc4_128', Config). +%%-------------------------------------------------------------------- +%% DHE_RSA -------------------------------------------------------- +%%-------------------------------------------------------------------- +dhe_rsa_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, '3des_ede_cbc', Config). + +dhe_rsa_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, 'aes_128_cbc', Config). + +dhe_rsa_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, 'aes_128_gcm', Config). + +dhe_rsa_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, 'aes_256_cbc', Config). + +dhe_rsa_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, 'aes_256_gcm', Config). + +dhe_rsa_chacha20_poly1305(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, 'chacha20_poly1305', Config). +%%-------------------------------------------------------------------- +%% ECDHE_RSA -------------------------------------------------------- +%%-------------------------------------------------------------------- +ecdhe_rsa_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, '3des_ede_cbc', Config). + +ecdhe_rsa_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'aes_128_cbc', Config). + +ecdhe_rsa_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'aes_128_gcm', Config). + +ecdhe_rsa_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'aes_256_cbc', Config). + +ecdhe_rsa_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'aes_256_gcm', Config). + +ecdhe_rsa_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'rc4_128', Config). + +ecdhe_rsa_chacha20_poly1305(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'chacha20_poly1305', Config). + +%%-------------------------------------------------------------------- +%% ECDHE_ECDSA -------------------------------------------------------- +%%-------------------------------------------------------------------- +ecdhe_ecdsa_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'rc4_128', Config). + +ecdhe_ecdsa_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, '3des_ede_cbc', Config). + +ecdhe_ecdsa_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_128_cbc', Config). + +ecdhe_ecdsa_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_128_gcm', Config). + +ecdhe_ecdsa_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_256_cbc', Config). + +ecdhe_ecdsa_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'aes_256_gcm', Config). + +ecdhe_ecdsa_chacha20_poly1305(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'chacha20_poly1305', Config). +%%-------------------------------------------------------------------- +%% DHE_DSS -------------------------------------------------------- +%%-------------------------------------------------------------------- +dhe_dss_des_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_dss, 'des_cbc', Config). + +dhe_dss_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_dss, '3des_ede_cbc', Config). + +dhe_dss_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_dss, 'aes_128_cbc', Config). + +dhe_dss_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_dss, 'aes_256_cbc', Config). + +dhe_dss_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(dhe_dss, 'aes_128_gcm', Config). + +dhe_dss_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(dhe_dss, 'aes_256_gcm', Config). + +%%-------------------------------------------------------------------- +%% Anonymous -------------------------------------------------------- +%%-------------------------------------------------------------------- +dh_anon_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(dh_anon, '3des_ede_cbc', Config). + +dh_anon_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(dh_anon, 'aes_128_cbc', Config). + +dh_anon_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(dh_anon, 'aes_128_gcm', Config). + +dh_anon_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(dh_anon, 'aes_256_cbc', Config). + +dh_anon_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(dh_anon, 'aes_256_gcm', Config). + +dh_anon_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(dh_anon, 'rc4_128', Config). + +ecdh_anon_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdh_anon, '3des_ede_cbc', Config). + +ecdh_anon_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdh_anon, 'aes_128_cbc', Config). + +ecdh_anon_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdh_anon, 'aes_256_cbc', Config). + +srp_anon_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_anon, '3des_ede_cbc', Config). + +srp_anon_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_anon, 'aes_128_cbc', Config). + +srp_anon_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_anon, 'aes_256_cbc', Config). + +dhe_psk_des_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'des_cbc', Config). + +dhe_psk_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'rc4_128', Config). + +dhe_psk_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, '3des_ede_cbc', Config). + +dhe_psk_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_128_cbc', Config). + +dhe_psk_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_256_cbc', Config). + +dhe_psk_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_128_gcm', Config). + +dhe_psk_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_256_gcm', Config). + +dhe_psk_aes_128_ccm(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_128_ccm', Config). + +dhe_psk_aes_256_ccm(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_256_ccm', Config). + +dhe_psk_aes_128_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_128_ccm_8', Config). + +dhe_psk_aes_256_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(dhe_psk, 'aes_256_ccm_8', Config). + +ecdhe_psk_des_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'des_cbc', Config). + +ecdhe_psk_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'rc4_128', Config). + +ecdhe_psk_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, '3des_ede_cbc', Config). + +ecdhe_psk_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_128_cbc', Config). + +ecdhe_psk_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_256_cbc', Config). + +ecdhe_psk_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_128_gcm', Config). + +ecdhe_psk_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_256_gcm', Config). + +ecdhe_psk_aes_128_ccm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_128_ccm', Config). + +ecdhe_psk_aes_128_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_128_ccm_8', Config). + +psk_des_cbc(Config) when is_list(Config) -> + run_ciphers_test(psk, 'des_cbc', Config). + +psk_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(psk, 'rc4_128', Config). + +psk_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(psk, '3des_ede_cbc', Config). + +psk_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_128_cbc', Config). + +psk_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_256_cbc', Config). + +psk_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_128_gcm', Config). + +psk_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_256_gcm', Config). + +psk_aes_128_ccm(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_128_ccm', Config). + +psk_aes_256_ccm(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_256_ccm', Config). + +psk_aes_128_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_128_ccm_8', Config). + +psk_aes_256_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(psk, 'aes_256_ccm_8', Config). + +%%-------------------------------------------------------------------- +%% Internal functions ---------------------------------------------- +%%-------------------------------------------------------------------- +run_ciphers_test(Kex, Cipher, Config) -> + Version = ssl_test_lib:protocol_version(Config), + TestCiphers = test_ciphers(Kex, Cipher, Version), + + case TestCiphers of + [_|_] -> + lists:foreach(fun(TestCipher) -> + cipher_suite_test(TestCipher, Version, Config) + end, TestCiphers); + [] -> + {skip, {not_sup, Kex, Cipher, Version}} + end. + +cipher_suite_test(CipherSuite, _Version, Config) -> + #{server_config := SOpts, + client_config := COpts} = proplists:get_value(tls_config, Config), + ServerOpts = ssl_test_lib:ssl_options(SOpts, Config), + ClientOpts = ssl_test_lib:ssl_options(COpts, Config), + ct:log("Testing CipherSuite ~p~n", [CipherSuite]), + ct:log("Server Opts ~p~n", [ServerOpts]), + ct:log("Client Opts ~p~n", [ClientOpts]), + ssl_test_lib:basic_test([{ciphers, [CipherSuite]} | COpts], SOpts, [{client_type, erlang}, + {server_type, openssl} | Config]). + + +test_ciphers(Kex, Cipher, Version) -> + Ciphers = ssl:filter_cipher_suites(ssl:cipher_suites(default, Version) ++ ssl:cipher_suites(anonymous, Version), + [{key_exchange, + fun(Kex0) when Kex0 == Kex -> true; + (_) -> false + end}, + {cipher, + fun(Cipher0) when Cipher0 == Cipher -> true; + (_) -> false + end}]), + ct:log("Version ~p Testing ~p~n", [Version, Ciphers]), + OpenSSLCiphers = openssl_ciphers(), + ct:log("OpenSSLCiphers ~p~n", [OpenSSLCiphers]), + lists:filter(fun(C) -> + ct:log("Cipher ~p~n", [C]), + lists:member(ssl_cipher_format:suite_map_to_openssl_str(C), OpenSSLCiphers) + end, Ciphers). + + +openssl_ciphers() -> + Str = os:cmd("openssl ciphers"), + string:split(string:strip(Str, right, $\n), ":", all). diff --git a/lib/ssl/test/ssl.spec b/lib/ssl/test/ssl.spec index 24272327c3..15587abecd 100644 --- a/lib/ssl/test/ssl.spec +++ b/lib/ssl/test/ssl.spec @@ -6,5 +6,7 @@ {skip_groups,dir,ssl_bench_SUITE,payload,"Benchmarks run separately"}. {skip_groups,dir,ssl_bench_SUITE,pem_cache,"Benchmarks run separately"}. {skip_groups,dir,ssl_dist_bench_SUITE,setup,"Benchmarks run separately"}. +{skip_groups,dir,ssl_dist_bench_SUITE,roundtrip,"Benchmarks run separately"}. {skip_groups,dir,ssl_dist_bench_SUITE,throughput,"Benchmarks run separately"}. +{skip_groups,dir,ssl_dist_bench_SUITE,sched_utilization,"Benchmarks run separately"}. diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl index ca8d0ec70c..d02888793c 100644 --- a/lib/ssl/test/ssl_ECC_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -51,35 +51,7 @@ groups() -> ]. test_cases()-> - key_cert_combinations() - ++ misc() - ++ ecc_negotiation(). - -key_cert_combinations() -> - server_ecdh_rsa() ++ - server_ecdhe_rsa() ++ - server_ecdh_ecdsa() ++ - server_ecdhe_ecdsa(). - -server_ecdh_rsa() -> - [client_ecdh_rsa_server_ecdh_rsa, - client_ecdhe_rsa_server_ecdh_rsa, - client_ecdhe_ecdsa_server_ecdh_rsa]. - -server_ecdhe_rsa() -> - [client_ecdh_rsa_server_ecdhe_rsa, - client_ecdhe_rsa_server_ecdhe_rsa, - client_ecdhe_ecdsa_server_ecdhe_rsa]. - -server_ecdh_ecdsa() -> - [client_ecdh_ecdsa_server_ecdh_ecdsa, - client_ecdhe_rsa_server_ecdh_ecdsa, - client_ecdhe_ecdsa_server_ecdh_ecdsa]. - -server_ecdhe_ecdsa() -> - [client_ecdh_rsa_server_ecdhe_ecdsa, - client_ecdh_ecdsa_server_ecdhe_ecdsa, - client_ecdhe_ecdsa_server_ecdhe_ecdsa]. + misc() ++ ecc_negotiation(). misc()-> [client_ecdsa_server_ecdsa_with_raw_key]. @@ -160,35 +132,6 @@ end_per_testcase(_TestCase, Config) -> %% Test diffrent certificate chain types, note that it is the servers %% chain that affect what cipher suit that will be choosen -%% ECDH_RSA -client_ecdh_rsa_server_ecdh_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_rsa_server_ecdh_rsa(Config). -client_ecdhe_rsa_server_ecdh_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_rsa_server_ecdh_rsa(Config). -client_ecdhe_ecdsa_server_ecdh_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdh_rsa(Config). -%% ECDHE_RSA -client_ecdh_rsa_server_ecdhe_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_rsa_server_ecdhe_rsa(Config). -client_ecdhe_rsa_server_ecdhe_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_rsa_server_ecdhe_rsa(Config). -client_ecdhe_ecdsa_server_ecdhe_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdhe_rsa(Config). -%% ECDH_ECDSA -client_ecdh_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_ecdsa_server_ecdh_ecdsa(Config). -client_ecdhe_rsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_rsa_server_ecdh_ecdsa(Config). -client_ecdhe_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdh_ecdsa(Config). -%% ECDHE_ECDSA -client_ecdh_rsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_rsa_server_ecdhe_ecdsa(Config). -client_ecdh_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_ecdsa_server_ecdhe_ecdsa(Config). -client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config). - client_ecdsa_server_ecdsa_with_raw_key(Config) when is_list(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, @@ -212,7 +155,7 @@ client_ecdsa_server_ecdsa_with_raw_key(Config) when is_list(Config) -> ecc_default_order(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, @@ -227,7 +170,7 @@ ecc_default_order(Config) -> ecc_default_order_custom_curves(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, @@ -242,7 +185,7 @@ ecc_default_order_custom_curves(Config) -> ecc_client_order(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, @@ -257,7 +200,7 @@ ecc_client_order(Config) -> ecc_client_order_custom_curves(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, @@ -282,7 +225,7 @@ ecc_unknown_curve(Config) -> client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdh_rsa, ecdhe_ecdsa, Config), @@ -296,7 +239,7 @@ client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) -> client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdh_rsa, ecdhe_rsa, Config), @@ -311,7 +254,7 @@ client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) -> client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_rsa, ecdhe_ecdsa, Config), @@ -325,7 +268,7 @@ client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) -> client_ecdhe_rsa_server_ecdhe_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_rsa, ecdhe_rsa, Config), @@ -339,7 +282,7 @@ client_ecdhe_rsa_server_ecdhe_rsa_server_custom(Config) -> end. client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), Ext = x509_test:extensions([{key_usage, [keyEncipherment]}]), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, [[], [], [{extensions, Ext}]]}, {client_chain, Default}], @@ -357,7 +300,7 @@ client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) -> client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, Config), @@ -371,7 +314,7 @@ client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) -> client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_rsa, Config), @@ -385,7 +328,7 @@ client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) -> client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_ecdsa, ecdhe_ecdsa, Config), @@ -399,7 +342,7 @@ client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) -> client_ecdhe_rsa_server_ecdhe_ecdsa_client_custom(Config) -> Default = ssl_test_lib:default_cert_chain_conf(), - DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), + DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(1))), {COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default}, {client_chain, Default}], ecdhe_rsa, ecdhe_ecdsa, Config), diff --git a/lib/ssl/test/ssl_ECC_openssl_SUITE.erl b/lib/ssl/test/ssl_ECC_openssl_SUITE.erl index 81a7dfd2da..68d4e910fd 100644 --- a/lib/ssl/test/ssl_ECC_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_openssl_SUITE.erl @@ -33,77 +33,23 @@ %%-------------------------------------------------------------------- all() -> - case test_cases() of - [_|_] -> - all_groups(); - [] -> - [skip] - end. - -all_groups() -> case ssl_test_lib:openssl_sane_dtls() of true -> [{group, 'tlsv1.2'}, - {group, 'tlsv1.1'}, - {group, 'tlsv1'}, - {group, 'dtlsv1.2'}, - {group, 'dtlsv1'}]; + {group, 'dtlsv1.2'}]; false -> - [{group, 'tlsv1.2'}, - {group, 'tlsv1.1'}, - {group, 'tlsv1'}] + [{group, 'tlsv1.2'}] end. groups() -> case ssl_test_lib:openssl_sane_dtls() of true -> - [{'tlsv1.2', [], [mix_sign | test_cases()]}, - {'tlsv1.1', [], test_cases()}, - {'tlsv1', [], test_cases()}, - {'dtlsv1.2', [], [mix_sign | test_cases()]}, - {'dtlsv1', [], test_cases()}]; + [{'tlsv1.2', [], [mix_sign]}, + {'dtlsv1.2', [], [mix_sign]}]; false -> - [{'tlsv1.2', [], [mix_sign | test_cases()]}, - {'tlsv1.1', [], test_cases()}, - {'tlsv1', [], test_cases()}] + [{'tlsv1.2', [], [mix_sign]}] end. - -test_cases()-> - cert_combinations(). -cert_combinations() -> - lists:append(lists:map(fun({Name, Suites}) -> - case ssl_test_lib:openssl_filter(Name) of - [] -> - []; - [_|_] -> - Suites - end - end, [{"ECDH-ECDSA", server_ecdh_ecdsa()}, - {"ECDH-RSA", server_ecdh_rsa()}, - {"ECDHE-RSA", server_ecdhe_rsa()}, - {"ECDHE-ECDSA", server_ecdhe_ecdsa()} - ])). -server_ecdh_rsa() -> - [client_ecdh_rsa_server_ecdh_rsa, - client_ecdhe_rsa_server_ecdh_rsa, - client_ecdhe_ecdsa_server_ecdh_rsa]. - -server_ecdhe_rsa() -> - [client_ecdh_rsa_server_ecdhe_rsa, - client_ecdhe_rsa_server_ecdhe_rsa, - client_ecdhe_ecdsa_server_ecdhe_rsa]. - -server_ecdh_ecdsa() -> - [client_ecdh_ecdsa_server_ecdh_ecdsa, - client_ecdhe_rsa_server_ecdh_ecdsa, - client_ecdhe_ecdsa_server_ecdh_ecdsa]. - -server_ecdhe_ecdsa() -> - [client_ecdh_rsa_server_ecdhe_ecdsa, - client_ecdh_ecdsa_server_ecdhe_ecdsa, - client_ecdhe_ecdsa_server_ecdhe_ecdsa]. - %%-------------------------------------------------------------------- init_per_suite(Config0) -> end_per_suite(Config0), @@ -171,38 +117,6 @@ end_per_testcase(_TestCase, Config) -> skip(Config) when is_list(Config) -> {skip, openssl_does_not_support_ECC}. -%% Test diffrent certificate chain types, note that it is the servers -%% chain that affect what cipher suit that will be choosen - -%% ECDH_RSA -client_ecdh_rsa_server_ecdh_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_rsa_server_ecdh_rsa(Config). -client_ecdhe_rsa_server_ecdh_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_rsa_server_ecdh_rsa(Config). -client_ecdhe_ecdsa_server_ecdh_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdh_rsa(Config). -%% ECDHE_RSA -client_ecdh_rsa_server_ecdhe_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_rsa_server_ecdhe_rsa(Config). -client_ecdhe_rsa_server_ecdhe_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_rsa_server_ecdhe_rsa(Config). -client_ecdhe_ecdsa_server_ecdhe_rsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdhe_rsa(Config). -%% ECDH_ECDSA -client_ecdh_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_ecdsa_server_ecdh_ecdsa(Config). -client_ecdhe_rsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_rsa_server_ecdh_ecdsa(Config). -client_ecdhe_ecdsa_server_ecdh_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdh_ecdsa(Config). -%% ECDHE_ECDSA -client_ecdh_rsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_rsa_server_ecdhe_ecdsa(Config). -client_ecdh_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdh_ecdsa_server_ecdhe_ecdsa(Config). -client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config) when is_list(Config) -> - ssl_ECC:client_ecdhe_ecdsa_server_ecdhe_ecdsa(Config). - mix_sign(Config) -> {COpts0, SOpts0} = ssl_test_lib:make_mix_cert(Config), COpts = ssl_test_lib:ssl_options(COpts0, Config), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 6c536816aa..20d9f28512 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -76,11 +76,9 @@ groups() -> {'sslv3', [], all_versions_groups() ++ tls_versions_groups() ++ rizzo_tests() ++ [tls_ciphersuite_vs_version]}, {api,[], api_tests()}, {api_tls,[], api_tests_tls()}, - {tls_ciphers,[], tls_cipher_tests()}, {session, [], session_tests()}, {renegotiate, [], renegotiate_tests()}, {ciphers, [], cipher_tests()}, - {ciphers_ec, [], cipher_tests_ec()}, {error_handling_tests, [], error_handling_tests()}, {error_handling_tests_tls, [], error_handling_tests_tls()} ]. @@ -88,14 +86,12 @@ groups() -> tls_versions_groups ()-> [ {group, api_tls}, - {group, tls_ciphers}, {group, error_handling_tests_tls}]. all_versions_groups ()-> [{group, api}, {group, renegotiate}, {group, ciphers}, - {group, ciphers_ec}, {group, error_handling_tests}]. @@ -211,38 +207,11 @@ renegotiate_tests() -> renegotiate_dos_mitigate_passive, renegotiate_dos_mitigate_absolute]. -tls_cipher_tests() -> - [rc4_rsa_cipher_suites, - rc4_ecdh_rsa_cipher_suites, - rc4_ecdsa_cipher_suites]. - cipher_tests() -> [old_cipher_suites, - cipher_suites_mix, - %%ciphers_rsa_signed_certs, - %%ciphers_rsa_signed_certs_openssl_names, - %%ciphers_dsa_signed_certs, - %%ciphers_dsa_signed_certs_openssl_names, - chacha_rsa_cipher_suites, - chacha_ecdsa_cipher_suites, - %%anonymous_cipher_suites, - %%psk_cipher_suites, - %%psk_with_hint_cipher_suites, - %%psk_anon_cipher_suites, - %%psk_anon_with_hint_cipher_suites, - %%srp_cipher_suites, - %%srp_anon_cipher_suites, - %%srp_dsa_cipher_suites, - %%des_rsa_cipher_suites, - %%des_ecdh_rsa_cipher_suites, + cipher_suites_mix, default_reject_anonymous]. -cipher_tests_ec() -> - [ciphers_ecdsa_signed_certs, - ciphers_ecdsa_signed_certs_openssl_names, - ciphers_ecdh_rsa_signed_certs, - ciphers_ecdh_rsa_signed_certs_openssl_names]. - error_handling_tests()-> [close_transport_accept, recv_active, @@ -410,26 +379,7 @@ init_per_testcase(TestCase, Config) when TestCase == client_renegotiate; ct:timetrap({seconds, ?SEC_RENEGOTIATION_TIMEOUT + 5}), Config; -init_per_testcase(TestCase, Config) when TestCase == psk_cipher_suites; - TestCase == psk_with_hint_cipher_suites; - TestCase == ciphers_rsa_signed_certs; - TestCase == ciphers_rsa_signed_certs_openssl_names; - TestCase == ciphers_ecdh_rsa_signed_certs_openssl_names; - TestCase == ciphers_ecdh_rsa_signed_certs; - TestCase == ciphers_dsa_signed_certs; - TestCase == ciphers_dsa_signed_certs_openssl_names; - TestCase == anonymous_cipher_suites; - TestCase == ciphers_ecdsa_signed_certs; - TestCase == ciphers_ecdsa_signed_certs_openssl_names; - TestCase == anonymous_cipher_suites; - TestCase == psk_anon_cipher_suites; - TestCase == psk_anon_with_hint_cipher_suites; - TestCase == srp_cipher_suites; - TestCase == srp_anon_cipher_suites; - TestCase == srp_dsa_cipher_suites; - TestCase == des_rsa_cipher_suites; - TestCase == des_ecdh_rsa_cipher_suites; - TestCase == versions_option; +init_per_testcase(TestCase, Config) when TestCase == versions_option; TestCase == tls_tcp_connect_big -> ssl_test_lib:ct_log_supported_protocol_versions(Config), ct:timetrap({seconds, 60}), @@ -599,11 +549,10 @@ alerts(Config) when is_list(Config) -> Alerts = [?ALERT_REC(?WARNING, ?CLOSE_NOTIFY) | [?ALERT_REC(?FATAL, Desc) || Desc <- Descriptions]], lists:foreach(fun(Alert) -> - case ssl_alert:alert_txt(Alert) of - Txt when is_list(Txt) -> - ok; - Other -> - ct:fail({unexpected, Other}) + try ssl_alert:alert_txt(Alert) + catch + C:E:T -> + ct:fail({unexpected, {C, E, T}}) end end, Alerts). %%-------------------------------------------------------------------- @@ -1883,14 +1832,12 @@ eccs() -> eccs(Config) when is_list(Config) -> [_|_] = All = ssl:eccs(), - [] = SSL3 = ssl:eccs({3,0}), - [_|_] = Tls = ssl:eccs({3,1}), - [_|_] = Tls1 = ssl:eccs({3,2}), - [_|_] = Tls2 = ssl:eccs({3,3}), [] = SSL3 = ssl:eccs(sslv3), [_|_] = Tls = ssl:eccs(tlsv1), [_|_] = Tls1 = ssl:eccs('tlsv1.1'), [_|_] = Tls2 = ssl:eccs('tlsv1.2'), + [_|_] = Tls1 = ssl:eccs('dtlsv1'), + [_|_] = Tls2 = ssl:eccs('dtlsv1.2'), %% ordering is currently unverified by the test true = lists:sort(All) =:= lists:usort(SSL3 ++ Tls ++ Tls1 ++ Tls2), ok. @@ -2709,144 +2656,6 @@ tls_shutdown_error(Config) when is_list(Config) -> ok = ssl:close(Listen), {error, closed} = ssl:shutdown(Listen, read_write). -%%------------------------------------------------------------------- -ciphers_rsa_signed_certs() -> - [{doc,"Test all rsa ssl cipher suites in highest support ssl/tls version"}]. - -ciphers_rsa_signed_certs(Config) when is_list(Config) -> - Ciphers = ssl_test_lib:rsa_suites(crypto), - run_suites(Ciphers, Config, rsa). -%%------------------------------------------------------------------- -ciphers_rsa_signed_certs_openssl_names() -> - [{doc,"Test all rsa ssl cipher suites in highest support ssl/tls version"}]. - -ciphers_rsa_signed_certs_openssl_names(Config) when is_list(Config) -> - Ciphers = ssl_test_lib:openssl_rsa_suites(), - run_suites(Ciphers, Config, rsa). - -%%------------------------------------------------------------------- -ciphers_dsa_signed_certs() -> - [{doc,"Test all dsa ssl cipher suites in highest support ssl/tls version"}]. - -ciphers_dsa_signed_certs(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = ssl_test_lib:dsa_suites(NVersion), - run_suites(Ciphers, Config, dsa). -%%------------------------------------------------------------------- -ciphers_dsa_signed_certs_openssl_names() -> - [{doc,"Test all dsa ssl cipher suites in highest support ssl/tls version"}]. - -ciphers_dsa_signed_certs_openssl_names(Config) when is_list(Config) -> - Ciphers = ssl_test_lib:openssl_dsa_suites(), - run_suites(Ciphers, Config, dsa). - -%%------------------------------------------------------------------- -chacha_rsa_cipher_suites()-> - [{doc,"Test the cacha with ECDSA signed certs ciphersuites"}]. -chacha_rsa_cipher_suites(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = [S || {KeyEx,_,_} = S <- ssl_test_lib:chacha_suites(NVersion), - KeyEx == ecdhe_rsa, KeyEx == dhe_rsa], - run_suites(Ciphers, Config, chacha_ecdsa). - -%%------------------------------------------------------------------- -chacha_ecdsa_cipher_suites()-> - [{doc,"Test the cacha with ECDSA signed certs ciphersuites"}]. -chacha_ecdsa_cipher_suites(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = [S || {ecdhe_ecdsa,_,_} = S <- ssl_test_lib:chacha_suites(NVersion)], - run_suites(Ciphers, Config, chacha_rsa). -%%----------------------------------------------------------------- -anonymous_cipher_suites()-> - [{doc,"Test the anonymous ciphersuites"}]. -anonymous_cipher_suites(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = ssl_test_lib:ecdh_dh_anonymous_suites(NVersion), - run_suites(Ciphers, Config, anonymous). -%%------------------------------------------------------------------- -psk_cipher_suites() -> - [{doc, "Test the PSK ciphersuites WITHOUT server supplied identity hint"}]. -psk_cipher_suites(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = ssl_test_lib:psk_suites(NVersion), - run_suites(Ciphers, Config, psk). -%%------------------------------------------------------------------- -psk_with_hint_cipher_suites()-> - [{doc, "Test the PSK ciphersuites WITH server supplied identity hint"}]. -psk_with_hint_cipher_suites(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = ssl_test_lib:psk_suites(NVersion), - run_suites(Ciphers, Config, psk_with_hint). -%%------------------------------------------------------------------- -psk_anon_cipher_suites() -> - [{doc, "Test the anonymous PSK ciphersuites WITHOUT server supplied identity hint"}]. -psk_anon_cipher_suites(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = ssl_test_lib:psk_anon_suites(NVersion), - run_suites(Ciphers, Config, psk_anon). -%%------------------------------------------------------------------- -psk_anon_with_hint_cipher_suites()-> - [{doc, "Test the anonymous PSK ciphersuites WITH server supplied identity hint"}]. -psk_anon_with_hint_cipher_suites(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = ssl_test_lib:psk_anon_suites(NVersion), - run_suites(Ciphers, Config, psk_anon_with_hint). -%%------------------------------------------------------------------- -srp_cipher_suites()-> - [{doc, "Test the SRP ciphersuites"}]. -srp_cipher_suites(Config) when is_list(Config) -> - Ciphers = ssl_test_lib:srp_suites(), - run_suites(Ciphers, Config, srp). -%%------------------------------------------------------------------- -srp_anon_cipher_suites()-> - [{doc, "Test the anonymous SRP ciphersuites"}]. -srp_anon_cipher_suites(Config) when is_list(Config) -> - Ciphers = ssl_test_lib:srp_anon_suites(), - run_suites(Ciphers, Config, srp_anon). -%%------------------------------------------------------------------- -srp_dsa_cipher_suites()-> - [{doc, "Test the SRP DSA ciphersuites"}]. -srp_dsa_cipher_suites(Config) when is_list(Config) -> - Ciphers = ssl_test_lib:srp_dss_suites(), - run_suites(Ciphers, Config, srp_dsa). -%%------------------------------------------------------------------- -rc4_rsa_cipher_suites()-> - [{doc, "Test the RC4 ciphersuites"}]. -rc4_rsa_cipher_suites(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = [S || {rsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)], - run_suites(Ciphers, Config, rc4_rsa). -%------------------------------------------------------------------- -rc4_ecdh_rsa_cipher_suites()-> - [{doc, "Test the RC4 ciphersuites"}]. -rc4_ecdh_rsa_cipher_suites(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = [S || {ecdh_rsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)], - run_suites(Ciphers, Config, rc4_ecdh_rsa). - -%%------------------------------------------------------------------- -rc4_ecdsa_cipher_suites()-> - [{doc, "Test the RC4 ciphersuites"}]. -rc4_ecdsa_cipher_suites(Config) when is_list(Config) -> - NVersion = tls_record:highest_protocol_version([]), - Ciphers = [S || {ecdhe_ecdsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)], - run_suites(Ciphers, Config, rc4_ecdsa). - -%%------------------------------------------------------------------- -des_rsa_cipher_suites()-> - [{doc, "Test the des_rsa ciphersuites"}]. -des_rsa_cipher_suites(Config) when is_list(Config) -> - NVersion = tls_record:highest_protocol_version([]), - Ciphers = [S || {rsa,_,_} = S <- ssl_test_lib:des_suites(NVersion)], - run_suites(Ciphers, Config, des_rsa). -%------------------------------------------------------------------- -des_ecdh_rsa_cipher_suites()-> - [{doc, "Test ECDH rsa signed ciphersuites"}]. -des_ecdh_rsa_cipher_suites(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = [S || {dhe_rsa,_,_} = S <- ssl_test_lib:des_suites(NVersion)], - run_suites(Ciphers, Config, des_dhe_rsa). - %%-------------------------------------------------------------------- default_reject_anonymous()-> [{doc,"Test that by default anonymous cipher suites are rejected "}]. @@ -2873,36 +2682,6 @@ default_reject_anonymous(Config) when is_list(Config) -> ssl_test_lib:check_server_alert(Server, Client, insufficient_security). %%-------------------------------------------------------------------- -ciphers_ecdsa_signed_certs() -> - [{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}]. - -ciphers_ecdsa_signed_certs(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = ssl_test_lib:ecdsa_suites(NVersion), - run_suites(Ciphers, Config, ecdsa). -%%-------------------------------------------------------------------- -ciphers_ecdsa_signed_certs_openssl_names() -> - [{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}]. - -ciphers_ecdsa_signed_certs_openssl_names(Config) when is_list(Config) -> - Ciphers = ssl_test_lib:openssl_ecdsa_suites(), - run_suites(Ciphers, Config, ecdsa). -%%-------------------------------------------------------------------- -ciphers_ecdh_rsa_signed_certs() -> - [{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}]. - -ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) -> - NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = ssl_test_lib:ecdh_rsa_suites(NVersion), - run_suites(Ciphers, Config, ecdh_rsa). -%%-------------------------------------------------------------------- -ciphers_ecdh_rsa_signed_certs_openssl_names() -> - [{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}]. - -ciphers_ecdh_rsa_signed_certs_openssl_names(Config) when is_list(Config) -> - Ciphers = ssl_test_lib:openssl_ecdh_rsa_suites(), - run_suites(Ciphers, Config, ecdh_rsa). -%%-------------------------------------------------------------------- reuse_session() -> [{doc,"Test reuse of sessions (short handshake)"}]. reuse_session(Config) when is_list(Config) -> @@ -2993,8 +2772,8 @@ make_sure_expired(Host, Port, Id) -> server_does_not_want_to_reuse_session() -> [{doc,"Test reuse of sessions (short handshake)"}]. server_does_not_want_to_reuse_session(Config) when is_list(Config) -> - ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = @@ -3873,7 +3652,7 @@ listen_socket(Config) -> {error, enotconn} = ssl:peername(ListenSocket), {error, enotconn} = ssl:peercert(ListenSocket), {error, enotconn} = ssl:renegotiate(ListenSocket), - {error, enotconn} = ssl:prf(ListenSocket, 'master_secret', <<"Label">>, client_random, 256), + {error, enotconn} = ssl:prf(ListenSocket, 'master_secret', <<"Label">>, [client_random], 256), {error, enotconn} = ssl:shutdown(ListenSocket, read_write), ok = ssl:close(ListenSocket). @@ -6356,147 +6135,6 @@ client_server_opts(#{key_exchange := KeyAlgo}, Config) when KeyAlgo == ecdh_rsa {ssl_test_lib:ssl_options(client_opts, Config), ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}. -run_suites(Ciphers, Config, Type) -> - Version = ssl_test_lib:protocol_version(Config), - ct:log("Running cipher suites ~p~n", [Ciphers]), - {ClientOpts, ServerOpts} = - case Type of - rsa -> - {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_rsa_opts, Config)]}; - dsa -> - {ssl_test_lib:ssl_options(client_dsa_verify_opts, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_dsa_opts, Config)]}; - anonymous -> - %% No certs in opts! - {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options([], Config)]}; - psk -> - {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_psk, Config)]}; - psk_with_hint -> - {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_psk_hint, Config) - ]}; - psk_anon -> - {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_psk_anon, Config)]}; - psk_anon_with_hint -> - {ssl_test_lib:ssl_options(client_psk, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]}; - srp -> - {ssl_test_lib:ssl_options(client_srp, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_srp, Config)]}; - srp_anon -> - {ssl_test_lib:ssl_options(client_srp, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_srp_anon, Config)]}; - srp_dsa -> - {ssl_test_lib:ssl_options(client_srp_dsa, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_srp_dsa, Config)]}; - ecdsa -> - {ssl_test_lib:ssl_options(client_ecdsa_opts, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]}; - ecdh_rsa -> - {ssl_test_lib:ssl_options(client_ecdh_rsa_opts, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)]}; - rc4_rsa -> - {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_rsa_verify_opts, Config)]}; - rc4_ecdh_rsa -> - {ssl_test_lib:ssl_options(client_ecdh_rsa_opts, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)]}; - rc4_ecdsa -> - {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]}; - des_dhe_rsa -> - {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_verification_opts, Config)]}; - des_rsa -> - {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_rsa_verify_opts, Config)]}; - chacha_rsa -> - {ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_rsa_verify_opts, Config)]}; - chacha_ecdsa -> - {ssl_test_lib:ssl_options(client_ecdsa_opts, Config), - [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]} - end, - Suites = ssl_test_lib:filter_suites(Ciphers, Version), - ct:pal("ssl_test_lib:filter_suites(~p ~p) -> ~p ", [Ciphers, Version, Suites]), - Results0 = lists:map(fun(Cipher) -> - cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end, - ssl_test_lib:filter_suites(Ciphers, Version)), - Results = lists:flatten(Results0), - true = length(Results) == length(Suites), - check_cipher_result(Results). - -check_cipher_result([]) -> - ok; -check_cipher_result([ok | Rest]) -> - check_cipher_result(Rest); -check_cipher_result([_ |_] = Error) -> - ct:fail(Error). - -erlang_cipher_suite(Suite) when is_list(Suite)-> - ssl_cipher_format:suite_definition(ssl_cipher_format:openssl_suite(Suite)); -erlang_cipher_suite(Suite) -> - Suite. - -cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> - %% process_flag(trap_exit, true), - ct:log("Testing CipherSuite ~p~n", [CipherSuite]), - ct:log("Server Opts ~p~n", [ServerOpts]), - ct:log("Client Opts ~p~n", [ClientOpts]), - {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - - ErlangCipherSuite = erlang_cipher_suite(CipherSuite), - - ConnectionInfo = {ok, {Version, ErlangCipherSuite}}, - - Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}}, - {options, 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, cipher_result, [ConnectionInfo]}}, - {options, - [{ciphers,[CipherSuite]} | - ClientOpts]}]), - - Result = ssl_test_lib:wait_for_result(Server, ok, Client, ok), - - ssl_test_lib:close(Server), - ssl_test_lib:close(Client), - - case Result of - ok -> - [ok]; - Error -> - [{ErlangCipherSuite, Error}] - end. - connection_information_result(Socket) -> {ok, Info = [_ | _]} = ssl:connection_information(Socket), case length(Info) > 3 of diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 4f340af4f5..55dee9a48f 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -448,7 +448,7 @@ server_require_peer_cert_partial_chain_fun_fail(Config) when is_list(Config) -> [{_,_,_}, {_, IntermidiateCA, _} | _] = public_key:pem_decode(ServerCAs), PartialChain = fun(_CertChain) -> - ture = false %% crash on purpose + true = false %% crash on purpose end, Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, diff --git a/lib/ssl/test/ssl_cipher_suite_SUITE.erl b/lib/ssl/test/ssl_cipher_suite_SUITE.erl index 6a2be0e267..51788c29e7 100644 --- a/lib/ssl/test/ssl_cipher_suite_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_suite_SUITE.erl @@ -50,25 +50,29 @@ groups() -> {'dtlsv1', [], kex()}, {dhe_rsa, [],[dhe_rsa_3des_ede_cbc, dhe_rsa_aes_128_cbc, - dhe_rsa_aes_256_cbc + dhe_rsa_aes_256_cbc, + dhe_rsa_chacha20_poly1305 ]}, {ecdhe_rsa, [], [ecdhe_rsa_3des_ede_cbc, ecdhe_rsa_aes_128_cbc, ecdhe_rsa_aes_128_gcm, ecdhe_rsa_aes_256_cbc, - ecdhe_rsa_aes_256_gcm + ecdhe_rsa_aes_256_gcm, + ecdhe_rsa_chacha20_poly1305 ]}, {ecdhe_ecdsa, [],[ecdhe_ecdsa_rc4_128, ecdhe_ecdsa_3des_ede_cbc, ecdhe_ecdsa_aes_128_cbc, ecdhe_ecdsa_aes_128_gcm, ecdhe_ecdsa_aes_256_cbc, - ecdhe_ecdsa_aes_256_gcm + ecdhe_ecdsa_aes_256_gcm, + ecdhe_ecdsa_chacha20_poly1305 ]}, {rsa, [], [rsa_3des_ede_cbc, rsa_aes_128_cbc, rsa_aes_256_cbc, - rsa_rc4_128]}, + rsa_rc4_128 + ]}, {dhe_dss, [], [dhe_dss_3des_ede_cbc, dhe_dss_aes_128_cbc, dhe_dss_aes_256_cbc]}, @@ -81,11 +85,7 @@ groups() -> {rsa_psk, [], [rsa_psk_3des_ede_cbc, rsa_psk_rc4_128, rsa_psk_aes_128_cbc, - %% rsa_psk_aes_128_ccm, - %% rsa_psk_aes_128_ccm_8, rsa_psk_aes_256_cbc - %% rsa_psk_aes_256_ccm, - %% rsa_psk_aes_256_ccm_8 ]}, {dh_anon, [], [dh_anon_rc4_128, dh_anon_3des_ede_cbc, @@ -97,30 +97,36 @@ groups() -> ecdh_anon_aes_128_cbc, ecdh_anon_aes_256_cbc ]}, - {srp, [], [srp_3des_ede_cbc, - srp_aes_128_cbc, - srp_aes_256_cbc]}, + {srp_anon, [], [srp_anon_3des_ede_cbc, + srp_anon_aes_128_cbc, + srp_anon_aes_256_cbc]}, {psk, [], [psk_3des_ede_cbc, psk_rc4_128, psk_aes_128_cbc, - %% psk_aes_128_ccm, - %% psk_aes_128_ccm_8, - psk_aes_256_cbc - %% psk_aes_256_ccm, - %% psk_aes_256_ccm_8 + psk_aes_128_ccm, + psk_aes_128_ccm_8, + psk_aes_256_cbc, + psk_aes_256_ccm, + psk_aes_256_ccm_8 ]}, {dhe_psk, [], [dhe_psk_3des_ede_cbc, dhe_psk_rc4_128, dhe_psk_aes_128_cbc, - %% dhe_psk_aes_128_ccm, - %% dhe_psk_aes_128_ccm_8, - dhe_psk_aes_256_cbc - %% dhe_psk_aes_256_ccm, - %% dhe_psk_aes_256_ccm_8 + dhe_psk_aes_128_ccm, + dhe_psk_aes_128_ccm_8, + dhe_psk_aes_256_cbc, + dhe_psk_aes_256_ccm, + dhe_psk_aes_256_ccm_8 + ]}, + {ecdhe_psk, [], [ecdhe_psk_3des_ede_cbc, + ecdhe_psk_rc4_128, + ecdhe_psk_aes_128_cbc, + ecdhe_psk_aes_128_ccm, + ecdhe_psk_aes_128_ccm_8, + ecdhe_psk_aes_256_cbc ]} ]. - kex() -> rsa() ++ ecdsa() ++ dss() ++ anonymous(). @@ -144,9 +150,9 @@ anonymous() -> {group, ecdh_anon}, {group, psk}, {group, dhe_psk}, - {group, srp} + {group, ecdhe_psk}, + {group, srp_anon} ]. - init_per_suite(Config) -> catch crypto:stop(), @@ -162,11 +168,19 @@ end_per_suite(_Config) -> ssl:stop(), application:stop(crypto). -%%-------------------------------------------------------------------- + init_per_group(GroupName, Config) when GroupName == ecdh_anon; GroupName == ecdhe_rsa; - GroupName == ecdhe_ecdsa -> - case ssl_test_lib:sufficient_crypto_support(ec_cipher) of + GroupName == ecdhe_psk -> + case proplists:get_bool(ecdh, proplists:get_value(public_keys, crypto:supports())) of + true -> + init_certs(GroupName, Config); + false -> + {skip, "Missing EC crypto support"} + end; +init_per_group(ecdhe_ecdsa = GroupName, Config) -> + PKAlg = proplists:get_value(public_keys, crypto:supports()), + case lists:member(ecdh, PKAlg) andalso lists:member(ecdsa, PKAlg) of true -> init_certs(GroupName, Config); false -> @@ -188,7 +202,7 @@ init_per_group(srp_dss = GroupName, Config) -> false -> {skip, "Missing DSS_SRP crypto support"} end; -init_per_group(GroupName, Config) when GroupName == srp; +init_per_group(GroupName, Config) when GroupName == srp_anon; GroupName == srp_rsa -> PKAlg = proplists:get_value(public_keys, crypto:supports()), case lists:member(srp, PKAlg) of @@ -220,28 +234,32 @@ end_per_group(GroupName, Config) -> false -> Config end. + init_per_testcase(TestCase, Config) when TestCase == psk_3des_ede_cbc; - TestCase == srp_3des_ede_cbc; + TestCase == srp_anon_3des_ede_cbc; TestCase == dhe_psk_3des_ede_cbc; + TestCase == ecdhe_psk_3des_ede_cbc; TestCase == srp_rsa_3des_ede_cbc; + TestCase == srp_dss_3des_ede_cbc; TestCase == rsa_psk_3des_ede_cbc; TestCase == rsa_3des_ede_cbc; TestCase == dhe_rsa_3des_ede_cbc; TestCase == dhe_dss_3des_ede_cbc; TestCase == ecdhe_rsa_3des_ede_cbc; - TestCase == srp_dss_3des_ede_cbc; + TestCase == srp_anon_dss_3des_ede_cbc; TestCase == dh_anon_3des_ede_cbc; TestCase == ecdh_anon_3des_ede_cbc; TestCase == ecdhe_ecdsa_3des_ede_cbc -> SupCiphers = proplists:get_value(ciphers, crypto:supports()), case lists:member(des_ede3, SupCiphers) of true -> - ct:timetrap({seconds, 2}), + ct:timetrap({seconds, 5}), Config; _ -> {skip, "Missing 3DES crypto support"} end; init_per_testcase(TestCase, Config) when TestCase == psk_rc4_128; + TestCase == ecdhe_psk_rc4_128; TestCase == dhe_psk_rc4_128; TestCase == rsa_psk_rc4_128; TestCase == rsa_rc4_128; @@ -251,18 +269,43 @@ init_per_testcase(TestCase, Config) when TestCase == psk_rc4_128; SupCiphers = proplists:get_value(ciphers, crypto:supports()), case lists:member(rc4, SupCiphers) of true -> - ct:timetrap({seconds, 2}), + ct:timetrap({seconds, 5}), Config; _ -> {skip, "Missing RC4 crypto support"} end; -init_per_testcase(TestCase, Config) -> - Cipher = test_cipher(TestCase, Config), - %%Reason = io_lib:format("Missing ~p crypto support", [Cipher]), +init_per_testcase(TestCase, Config) when TestCase == psk_aes_128_ccm_8; + TestCase == rsa_psk_aes_128_ccm_8; + TestCase == psk_aes_128_ccm_8; + TestCase == dhe_psk_aes_128_ccm_8; + TestCase == ecdhe_psk_aes_128_ccm_8 -> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(aes_128_ccm, SupCiphers) of + true -> + ct:timetrap({seconds, 5}), + Config; + _ -> + {skip, "Missing AES_128_CCM crypto support"} + end; +init_per_testcase(TestCase, Config) when TestCase == psk_aes_256_ccm_8; + TestCase == rsa_psk_aes_256_ccm_8; + TestCase == psk_aes_256_ccm_8; + TestCase == dhe_psk_aes_256_ccm_8; + TestCase == ecdhe_psk_aes_256_ccm_8 -> + SupCiphers = proplists:get_value(ciphers, crypto:supports()), + case lists:member(aes_256_ccm, SupCiphers) of + true -> + ct:timetrap({seconds, 5}), + Config; + _ -> + {skip, "Missing AES_256_CCM crypto support"} + end; +init_per_testcase(TestCase, Config) -> + Cipher = ssl_test_lib:test_cipher(TestCase, Config), SupCiphers = proplists:get_value(ciphers, crypto:supports()), case lists:member(Cipher, SupCiphers) of true -> - ct:timetrap({seconds, 2}), + ct:timetrap({seconds, 5}), Config; _ -> {skip, {Cipher, SupCiphers}} @@ -271,24 +314,32 @@ init_per_testcase(TestCase, Config) -> end_per_testcase(_TestCase, Config) -> Config. +%%-------------------------------------------------------------------- +%% Initializtion ------------------------------------------ +%%-------------------------------------------------------------------- + init_certs(srp_rsa, Config) -> DefConf = ssl_test_lib:default_cert_chain_conf(), CertChainConf = ssl_test_lib:gen_conf(rsa, rsa, DefConf, DefConf), #{server_config := ServerOpts, client_config := ClientOpts} = public_key:pkix_test_data(CertChainConf), - [{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, undefined}} | ServerOpts], + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}} | ServerOpts], client_config => [{srp_identity, {"Test-User", "secret"}} | ClientOpts]}} | proplists:delete(tls_config, Config)]; +init_certs(srp_anon, Config) -> + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}}], + client_config => [{srp_identity, {"Test-User", "secret"}}]}} | + proplists:delete(tls_config, Config)]; init_certs(rsa_psk, Config) -> ClientExt = x509_test:extensions([{key_usage, [digitalSignature, keyEncipherment]}]), {ClientOpts, ServerOpts} = ssl_test_lib:make_rsa_cert_chains([{server_chain, [[],[],[{extensions, ClientExt}]]}], Config, "_peer_keyEncipherment"), PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, - [{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, PskSharedSecret}} | ServerOpts], + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}} | ServerOpts], client_config => [{psk_identity, "Test-User"}, - {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}} | ClientOpts]}} | + {user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}} | ClientOpts]}} | proplists:delete(tls_config, Config)]; init_certs(rsa, Config) -> ClientExt = x509_test:extensions([{key_usage, [digitalSignature, keyEncipherment]}]), @@ -313,7 +364,7 @@ init_certs(srp_dss, Config) -> #{server_config := ServerOpts, client_config := ClientOpts} = public_key:pkix_test_data(CertChainConf), - [{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, undefined}} | ServerOpts], + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}} | ServerOpts], client_config => [{srp_identity, {"Test-User", "secret"}} | ClientOpts]}} | proplists:delete(tls_config, Config)]; init_certs(GroupName, Config) when GroupName == dhe_rsa; @@ -337,14 +388,15 @@ init_certs(GroupName, Config) when GroupName == dhe_ecdsa; client_config => ClientOpts}} | proplists:delete(tls_config, Config)]; init_certs(GroupName, Config) when GroupName == psk; - GroupName == dhe_psk -> + GroupName == dhe_psk; + GroupName == ecdhe_psk -> PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>, - [{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}], + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}}], client_config => [{psk_identity, "Test-User"}, - {user_lookup_fun, {fun user_lookup/3, PskSharedSecret}}]}} | + {user_lookup_fun, {fun ssl_test_lib:user_lookup/3, PskSharedSecret}}]}} | proplists:delete(tls_config, Config)]; init_certs(srp, Config) -> - [{tls_config, #{server_config => [{user_lookup_fun, {fun user_lookup/3, undefined}}], + [{tls_config, #{server_config => [{user_lookup_fun, {fun ssl_test_lib:user_lookup/3, undefined}}], client_config => [{srp_identity, {"Test-User", "secret"}}]}} | proplists:delete(tls_config, Config)]; init_certs(_GroupName, Config) -> @@ -352,6 +404,7 @@ init_certs(_GroupName, Config) -> [{tls_config, #{server_config => [], client_config => []}} | proplists:delete(tls_config, Config)]. + %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- @@ -443,7 +496,10 @@ dhe_rsa_aes_256_cbc(Config) when is_list(Config) -> run_ciphers_test(dhe_rsa, 'aes_256_cbc', Config). dhe_rsa_aes_256_gcm(Config) when is_list(Config) -> - run_ciphers_test(dhe_rsa, 'aes_256_gcm', Config). + run_ciphers_test(dhe_rsa, 'aes_256_gcm', Config). + +dhe_rsa_chacha20_poly1305(Config) when is_list(Config) -> + run_ciphers_test(dhe_rsa, 'chacha20_poly1305', Config). %%-------------------------------------------------------------------- %% ECDHE_RSA -------------------------------------------------------- %%-------------------------------------------------------------------- @@ -464,6 +520,10 @@ ecdhe_rsa_aes_256_gcm(Config) when is_list(Config) -> ecdhe_rsa_rc4_128(Config) when is_list(Config) -> run_ciphers_test(ecdhe_rsa, 'rc4_128', Config). + +ecdhe_rsa_chacha20_poly1305(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_rsa, 'chacha20_poly1305', Config). + %%-------------------------------------------------------------------- %% ECDHE_ECDSA -------------------------------------------------------- %%-------------------------------------------------------------------- @@ -485,6 +545,8 @@ ecdhe_ecdsa_aes_256_cbc(Config) when is_list(Config) -> ecdhe_ecdsa_aes_256_gcm(Config) when is_list(Config) -> run_ciphers_test(ecdhe_ecdsa, 'aes_256_gcm', Config). +ecdhe_ecdsa_chacha20_poly1305(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_ecdsa, 'chacha20_poly1305', Config). %%-------------------------------------------------------------------- %% DHE_DSS -------------------------------------------------------- %%-------------------------------------------------------------------- @@ -536,14 +598,14 @@ ecdh_anon_aes_128_cbc(Config) when is_list(Config) -> ecdh_anon_aes_256_cbc(Config) when is_list(Config) -> run_ciphers_test(ecdh_anon, 'aes_256_cbc', Config). -srp_3des_ede_cbc(Config) when is_list(Config) -> - run_ciphers_test(srp, '3des_ede_cbc', Config). +srp_anon_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_anon, '3des_ede_cbc', Config). -srp_aes_128_cbc(Config) when is_list(Config) -> - run_ciphers_test(srp, 'aes_128_cbc', Config). +srp_anon_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_anon, 'aes_128_cbc', Config). -srp_aes_256_cbc(Config) when is_list(Config) -> - run_ciphers_test(srp, 'aes_256_cbc', Config). +srp_anon_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(srp_anon, 'aes_256_cbc', Config). dhe_psk_des_cbc(Config) when is_list(Config) -> run_ciphers_test(dhe_psk, 'des_cbc', Config). @@ -578,6 +640,33 @@ dhe_psk_aes_128_ccm_8(Config) when is_list(Config) -> dhe_psk_aes_256_ccm_8(Config) when is_list(Config) -> run_ciphers_test(dhe_psk, 'aes_256_ccm_8', Config). +ecdhe_psk_des_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'des_cbc', Config). + +ecdhe_psk_rc4_128(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'rc4_128', Config). + +ecdhe_psk_3des_ede_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, '3des_ede_cbc', Config). + +ecdhe_psk_aes_128_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_128_cbc', Config). + +ecdhe_psk_aes_256_cbc(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_256_cbc', Config). + +ecdhe_psk_aes_128_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_128_gcm', Config). + +ecdhe_psk_aes_256_gcm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_256_gcm', Config). + +ecdhe_psk_aes_128_ccm(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_128_ccm', Config). + +ecdhe_psk_aes_128_ccm_8(Config) when is_list(Config) -> + run_ciphers_test(ecdhe_psk, 'aes_128_ccm_8', Config). + psk_des_cbc(Config) when is_list(Config) -> run_ciphers_test(psk, 'des_cbc', Config). @@ -614,10 +703,6 @@ psk_aes_256_ccm_8(Config) when is_list(Config) -> %%-------------------------------------------------------------------- %% Internal functions ---------------------------------------------- %%-------------------------------------------------------------------- -test_cipher(TestCase, Config) -> - [{name, Group} |_] = proplists:get_value(tc_group_properties, Config), - list_to_atom(re:replace(atom_to_list(TestCase), atom_to_list(Group) ++ "_", "", [{return, list}])). - run_ciphers_test(Kex, Cipher, Config) -> Version = ssl_test_lib:protocol_version(Config), TestCiphers = test_ciphers(Kex, Cipher, Version), @@ -631,49 +716,35 @@ run_ciphers_test(Kex, Cipher, Config) -> {skip, {not_sup, Kex, Cipher, Version}} end. -cipher_suite_test(CipherSuite, Version, Config) -> +cipher_suite_test(ErlangCipherSuite, Version, Config) -> #{server_config := SOpts, client_config := COpts} = proplists:get_value(tls_config, Config), ServerOpts = ssl_test_lib:ssl_options(SOpts, Config), ClientOpts = ssl_test_lib:ssl_options(COpts, Config), - ct:log("Testing CipherSuite ~p~n", [CipherSuite]), + ct:log("Testing CipherSuite ~p~n", [ErlangCipherSuite]), ct:log("Server Opts ~p~n", [ServerOpts]), ct:log("Client Opts ~p~n", [ClientOpts]), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - ErlangCipherSuite = erlang_cipher_suite(CipherSuite), - ConnectionInfo = {ok, {Version, ErlangCipherSuite}}, Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}}, - {options, [{versions, [Version]}, {ciphers, [CipherSuite]} | ServerOpts]}]), + {options, [{versions, [Version]}, {ciphers, [ErlangCipherSuite]} | 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, cipher_result, [ConnectionInfo]}}, - {options, - [{versions, [Version]}, {ciphers, [CipherSuite]} | - ClientOpts]}]), + {options, [{versions, [Version]}, {ciphers, [ErlangCipherSuite]} | + ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), ssl_test_lib:close(Client). -erlang_cipher_suite(Suite) when is_list(Suite)-> - ssl_cipher_format:suite_definition(ssl_cipher_format:openssl_suite(Suite)); -erlang_cipher_suite(Suite) -> - Suite. - -user_lookup(psk, _Identity, UserState) -> - {ok, UserState}; -user_lookup(srp, Username, _UserState) -> - Salt = ssl_cipher:random_bytes(16), - UserPassHash = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, <<"secret">>])]), - {ok, {srp_1024, Salt, UserPassHash}}. test_ciphers(Kex, Cipher, Version) -> ssl:filter_cipher_suites(ssl:cipher_suites(all, Version) ++ ssl:cipher_suites(anonymous, Version), @@ -685,3 +756,4 @@ test_ciphers(Kex, Cipher, Version) -> fun(Cipher0) when Cipher0 == Cipher -> true; (_) -> false end}]). + diff --git a/lib/ssl/test/ssl_dist_bench_SUITE.erl b/lib/ssl/test/ssl_dist_bench_SUITE.erl index 7e7de5c9bf..1fea6f6f72 100644 --- a/lib/ssl/test/ssl_dist_bench_SUITE.erl +++ b/lib/ssl/test/ssl_dist_bench_SUITE.erl @@ -49,10 +49,14 @@ suite() -> [{ct_hooks, [{ts_install_cth, [{nodenames, 2}]}]}]. -all() -> [{group, ssl}, {group, plain}]. +all() -> + [{group, ssl}, + {group, crypto}, + {group, plain}]. groups() -> [{ssl, all_groups()}, + {crypto, all_groups()}, {plain, all_groups()}, %% {setup, [{repeat, 1}], [setup]}, @@ -164,6 +168,17 @@ end_per_suite(Config) -> init_per_group(ssl, Config) -> [{ssl_dist, true}, {ssl_dist_prefix, "SSL"}|Config]; +init_per_group(crypto, Config) -> + case inet_crypto_dist:is_supported() of + true -> + [{ssl_dist, false}, {ssl_dist_prefix, "Crypto"}, + {ssl_dist_args, + "-proto_dist inet_crypto " + "-inet_crypto '#{secret => \"123456\"}'"} + |Config]; + false -> + {skip, "Not supported on this OTP version"} + end; init_per_group(plain, Config) -> [{ssl_dist, false}, {ssl_dist_prefix, "Plain"}|Config]; init_per_group(_GroupName, Config) -> @@ -374,29 +389,46 @@ sched_utilization(A, B, Prefix, HA, HB, SSL) -> [A] = ssl_apply(HB, erlang, nodes, []), msacc:print(ClientMsacc), msacc:print(ServerMsacc), - ct:pal("Got ~p msgs",[length(Msgs)]), - report(Prefix++" Sched Utilization Client", - 10000 * msacc:stats(system_runtime,ClientMsacc) / - msacc:stats(system_realtime,ClientMsacc), "util 0.01 %"), - report(Prefix++" Sched Utilization Server", - 10000 * msacc:stats(system_runtime,ServerMsacc) / - msacc:stats(system_realtime,ServerMsacc), "util 0.01 %"), - ok. + ct:pal("Got ~p busy_dist_port msgs",[length(Msgs)]), + ct:log("Stats of B from A: ~p", + [ssl_apply(HA, net_kernel, node_info, [B])]), + ct:log("Stats of A from B: ~p", + [ssl_apply(HB, net_kernel, node_info, [A])]), + SchedUtilClient = + round(10000 * msacc:stats(system_runtime,ClientMsacc) / + msacc:stats(system_realtime,ClientMsacc)), + SchedUtilServer = + round(10000 * msacc:stats(system_runtime,ServerMsacc) / + msacc:stats(system_realtime,ServerMsacc)), + Verdict = + case Msgs of + [] -> + ""; + _ -> + " ???" + end, + {comment, ClientComment} = + report(Prefix ++ " Sched Utilization Client" ++ Verdict, + SchedUtilClient, "/100 %" ++ Verdict), + {comment, ServerComment} = + report(Prefix++" Sched Utilization Server" ++ Verdict, + SchedUtilServer, "/100 %" ++ Verdict), + {comment, "Client " ++ ClientComment ++ ", Server " ++ ServerComment}. %% Runs on node A and spawns a server on node B %% We want to avoid getting busy_dist_port as it hides the true SU usage %% of the receiver and sender. sched_util_runner(A, B, true) -> - sched_util_runner(A, B, 50); + sched_util_runner(A, B, 250); sched_util_runner(A, B, false) -> sched_util_runner(A, B, 250); sched_util_runner(A, B, Senders) -> Payload = payload(5), [A] = rpc:call(B, erlang, nodes, []), - ServerPid = - erlang:spawn( - B, - fun () -> throughput_server() end), + ServerPids = + [erlang:spawn_link( + B, fun () -> throughput_server() end) + || _ <- lists:seq(1, Senders)], ServerMsacc = erlang:spawn( B, @@ -404,24 +436,28 @@ sched_util_runner(A, B, Senders) -> receive {start,Pid} -> msacc:start(10000), - Pid ! {ServerPid,msacc:stats()} + receive + {done,Pid} -> + Pid ! {self(),msacc:stats()} + end end end), - spawn_link( - fun() -> - %% We spawn 250 senders which should mean that we - %% have a load of 250 msgs/msec - [spawn_link( - fun() -> - throughput_client(ServerPid,Payload) - end) || _ <- lists:seq(1, Senders)] - end), - erlang:system_monitor(self(),[busy_dist_port]), + %% We spawn 250 senders which should mean that we + %% have a load of 250 msgs/msec + [spawn_link( + fun() -> + throughput_client(Pid, Payload) + end) || Pid <- ServerPids], + %% + receive after 1000 -> ok end, ServerMsacc ! {start,self()}, msacc:start(10000), ClientMsaccStats = msacc:stats(), - ServerMsaccStats = receive {ServerPid,Stats} -> Stats end, + receive after 1000 -> ok end, + ServerMsacc ! {done,self()}, + ServerMsaccStats = receive {ServerMsacc,Stats} -> Stats end, + %% {ClientMsaccStats,ServerMsaccStats, flush()}. flush() -> @@ -522,15 +558,20 @@ throughput(A, B, Prefix, HA, HB, Packets, Size) -> + byte_size(erlang:term_to_binary([0|<<>>])), % Benchmark overhead Bytes = Packets * (Size + Overhead), io:format("~w bytes, ~.4g s~n", [Bytes,Time/1000000]), + SizeString = integer_to_list(Size), ClientMsaccStats =:= undefined orelse - io:format( - "Sender core usage ratio: ~.4g ns/byte~n", - [msacc:stats(system_runtime, ClientMsaccStats)*1000/Bytes]), + report( + Prefix ++ " Sender_RelativeCoreLoad_" ++ SizeString, + round(msacc:stats(system_runtime, ClientMsaccStats) + * 1000000 / Bytes), + "ps/byte"), ServerMsaccStats =:= undefined orelse begin - io:format( - "Receiver core usage ratio: ~.4g ns/byte~n", - [msacc:stats(system_runtime, ServerMsaccStats)*1000/Bytes]), + report( + Prefix ++ " Receiver_RelativeCoreLoad_" ++ SizeString, + round(msacc:stats(system_runtime, ServerMsaccStats) + * 1000000 / Bytes), + "ps/byte"), msacc:print(ServerMsaccStats) end, io:format("******* ClientProf:~n", []), prof_print(ClientProf), @@ -538,7 +579,7 @@ throughput(A, B, Prefix, HA, HB, Packets, Size) -> io:format("******* Server GC Before:~n~p~n", [Server_GC_Before]), io:format("******* Server GC After:~n~p~n", [Server_GC_After]), Speed = round((Bytes * 1000000) / (1024 * Time)), - report(Prefix++" Throughput_"++integer_to_list(Size), Speed, "kB/s"). + report(Prefix ++ " Throughput_" ++ SizeString, Speed, "kB/s"). %% Runs on node A and spawns a server on node B throughput_runner(A, B, Rounds, Size) -> @@ -546,11 +587,12 @@ throughput_runner(A, B, Rounds, Size) -> [A] = rpc:call(B, erlang, nodes, []), ClientPid = self(), ServerPid = - erlang:spawn( + erlang:spawn_opt( B, - fun () -> throughput_server(ClientPid, Rounds) end), + fun () -> throughput_server(ClientPid, Rounds) end, + [{message_queue_data, off_heap}]), ServerMon = erlang:monitor(process, ServerPid), - msacc:available() andalso + msacc_available() andalso begin msacc:stop(), msacc:reset(), @@ -562,7 +604,7 @@ throughput_runner(A, B, Rounds, Size) -> throughput_client(ServerPid, ServerMon, Payload, Rounds), prof_stop(), MsaccStats = - case msacc:available() of + case msacc_available() of true -> MStats = msacc:stats(), msacc:stop(), @@ -602,7 +644,7 @@ throughput_server(Pid, N) -> GC_Before = get_server_gc_info(), %% dbg:tracer(port, dbg:trace_port(file, "throughput_server_gc.log")), %% dbg:p(TLSDistReceiver, garbage_collection), - msacc:available() andalso + msacc_available() andalso begin msacc:stop(), msacc:reset(), @@ -615,7 +657,7 @@ throughput_server(Pid, N) -> throughput_server_loop(_Pid, GC_Before, 0) -> prof_stop(), MsaccStats = - case msacc:available() of + case msacc_available() of true -> msacc:stop(), MStats = msacc:stats(), @@ -632,8 +674,13 @@ throughput_server_loop(_Pid, GC_Before, 0) -> server_gc_after => get_server_gc_info()}); throughput_server_loop(Pid, GC_Before, N) -> receive - {Pid, N, _} -> - throughput_server_loop(Pid, GC_Before, N-1) + Msg -> + case Msg of + {Pid, N, _} -> + throughput_server_loop(Pid, GC_Before, N - 1); + Other -> + erlang:error({self(),?FUNCTION_NAME,Other}) + end end. get_server_gc_info() -> @@ -773,7 +820,7 @@ get_node_args(Tag, Config) -> true -> proplists:get_value(Tag, Config); false -> - "" + proplists:get_value(ssl_dist_args, Config, "") end. @@ -828,3 +875,6 @@ report(Name, Value, Unit) -> term_to_string(Term) -> unicode:characters_to_list( io_lib:write(Term, [{encoding, unicode}])). + +msacc_available() -> + msacc:available(). diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl index 7f33fe3204..b71b15b028 100644 --- a/lib/ssl/test/ssl_session_cache_SUITE.erl +++ b/lib/ssl/test/ssl_session_cache_SUITE.erl @@ -186,7 +186,7 @@ session_cleanup() -> session_cleanup(Config) when is_list(Config) -> process_flag(trap_exit, true), ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index f79f57fbd7..3b161a0c8a 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -51,20 +51,20 @@ node_to_hostip(Node) -> Address. start_server(Args) -> - Result = spawn_link(?MODULE, run_server, [Args]), + Node = proplists:get_value(node, Args), + Result = spawn_link(Node, ?MODULE, run_server, [Args]), receive {listen, up} -> Result end. run_server(Opts) -> - Node = proplists:get_value(node, Opts), Port = proplists:get_value(port, Opts), Options = proplists:get_value(options, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]), - {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]), + {ok, ListenSocket} = Transport:listen(Port, Options), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), run_server(ListenSocket, Opts). @@ -90,13 +90,12 @@ do_run_server(_, ok = Result, Opts) -> Pid = proplists:get_value(from, Opts), Pid ! {self(), Result}; do_run_server(ListenSocket, AcceptSocket, Opts) -> - Node = proplists:get_value(node, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), {Module, Function, Args} = proplists:get_value(mfa, Opts), ct:log("~p:~p~nServer: apply(~p,~p,~p)~n", [?MODULE,?LINE, Module, Function, [AcceptSocket | Args]]), - case rpc:call(Node, Module, Function, [AcceptSocket | Args]) of + case apply(Module, Function, [AcceptSocket | Args]) of no_result_msg -> ok; Msg -> @@ -110,8 +109,8 @@ do_run_server(ListenSocket, AcceptSocket, Opts) -> run_server(ListenSocket, [MFA | proplists:delete(mfa, Opts)]); close -> ct:log("~p:~p~nServer closing ~p ~n", [?MODULE,?LINE, self()]), - Result = rpc:call(Node, Transport, close, [AcceptSocket], 500), - Result1 = rpc:call(Node, Transport, close, [ListenSocket], 500), + Result = Transport:close(AcceptSocket), + Result1 = Transport:close(ListenSocket), ct:log("~p:~p~nResult ~p : ~p ~n", [?MODULE,?LINE, Result, Result1]); {ssl_closed, _} -> ok @@ -132,41 +131,37 @@ connect(#sslsocket{} = ListenSocket, Opts) -> remove_close_msg(ReconnectTimes), AcceptSocket end; -connect(ListenSocket, Opts) -> - Node = proplists:get_value(node, Opts), +connect(ListenSocket, _Opts) -> ct:log("~p:~p~ngen_tcp:accept(~p)~n", [?MODULE,?LINE, ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, - [ListenSocket]), + {ok, AcceptSocket} = gen_tcp:accept(ListenSocket), AcceptSocket. connect(_, _, 0, AcceptSocket, _, _, _) -> AcceptSocket; connect(ListenSocket, Node, _N, _, Timeout, SslOpts, cancel) -> ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, - [ListenSocket]), + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, SslOpts,Timeout]), - case rpc:call(Node, ssl, handshake, [AcceptSocket, SslOpts, Timeout]) of + case ssl:handshake(AcceptSocket, SslOpts, Timeout) of {ok, Socket0, Ext} -> ct:log("Ext ~p:~n", [Ext]), ct:log("~p:~p~nssl:handshake_cancel(~p)~n", [?MODULE,?LINE, Socket0]), - rpc:call(Node, ssl, handshake_cancel, [Socket0]); + ssl:handshake_cancel(Socket0); Result -> ct:log("~p:~p~nssl:handshake@~p ret ~p",[?MODULE,?LINE, Node,Result]), Result end; connect(ListenSocket, Node, N, _, Timeout, SslOpts, [_|_] =ContOpts) -> ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, - [ListenSocket]), + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, SslOpts,Timeout]), - case rpc:call(Node, ssl, handshake, [AcceptSocket, SslOpts, Timeout]) of + case ssl:handshake(AcceptSocket, SslOpts, Timeout) of {ok, Socket0, Ext} -> ct:log("Ext ~p:~n", [Ext]), ct:log("~p:~p~nssl:handshake_continue(~p,~p,~p)~n", [?MODULE,?LINE, Socket0, ContOpts,Timeout]), - case rpc:call(Node, ssl, handshake_continue, [Socket0, ContOpts, Timeout]) of + case ssl:handshake_continue(Socket0, ContOpts, Timeout) of {ok, Socket} -> connect(ListenSocket, Node, N-1, Socket, Timeout, SslOpts, ContOpts); Error -> @@ -179,35 +174,35 @@ connect(ListenSocket, Node, N, _, Timeout, SslOpts, [_|_] =ContOpts) -> end; connect(ListenSocket, Node, N, _, Timeout, [], ContOpts) -> ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, - [ListenSocket]), + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, Timeout]), - case rpc:call(Node, ssl, ssl_accept, [AcceptSocket, Timeout]) of - ok -> - connect(ListenSocket, Node, N-1, AcceptSocket, Timeout, [], ContOpts); + case ssl:handshake(AcceptSocket, Timeout) of + {ok, Socket} -> + connect(ListenSocket, Node, N-1, Socket, Timeout, [], ContOpts); Result -> - ct:log("~p:~p~nssl:ssl_accept@~p ret ~p",[?MODULE,?LINE, Node,Result]), + ct:log("~p:~p~nssl:handshake@~p ret ~p",[?MODULE,?LINE, Node,Result]), Result end; -connect(ListenSocket, Node, _, _, Timeout, Opts, _) -> +connect(ListenSocket, _Node, _, _, Timeout, Opts, _) -> ct:log("ssl:transport_accept(~p)~n", [ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, - [ListenSocket]), - ct:log("ssl:ssl_accept(~p,~p, ~p)~n", [AcceptSocket, Opts, Timeout]), - rpc:call(Node, ssl, ssl_accept, [AcceptSocket, Opts, Timeout]), + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), + ct:log("ssl:handshake(~p,~p, ~p)~n", [AcceptSocket, Opts, Timeout]), + ssl:handshake(AcceptSocket, Opts, Timeout), AcceptSocket. start_server_transport_abuse_socket(Args) -> - Result = spawn_link(?MODULE, transport_accept_abuse, [Args]), + Node = proplists:get_value(node, Args), + Result = spawn_link(Node, ?MODULE, transport_accept_abuse, [Args]), receive {listen, up} -> Result end. start_server_transport_control(Args) -> - Result = spawn_link(?MODULE, transport_switch_control, [Args]), + Node = proplists:get_value(node, Args), + Result = spawn_link(Node, ?MODULE, transport_switch_control, [Args]), receive {listen, up} -> Result @@ -215,35 +210,31 @@ start_server_transport_control(Args) -> transport_accept_abuse(Opts) -> - Node = proplists:get_value(node, Opts), Port = proplists:get_value(port, Opts), Options = proplists:get_value(options, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]), - {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]), + {ok, ListenSocket} = Transport:listen(Port, Options), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), - {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, - [ListenSocket]), - {error, _} = rpc:call(Node, ssl, connection_information, [AcceptSocket]), - _ = rpc:call(Node, ssl, handshake, [AcceptSocket, infinity]), + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), + {error, _} = ssl:connection_information(AcceptSocket), + _ = ssl:handshake(AcceptSocket, infinity), Pid ! {self(), ok}. transport_switch_control(Opts) -> - Node = proplists:get_value(node, Opts), Port = proplists:get_value(port, Opts), Options = proplists:get_value(options, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]), - {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]), + {ok, ListenSocket} = Transport:listen(Port, Options), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), - {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, - [ListenSocket]), - ok = rpc:call(Node, ssl, controlling_process, [AcceptSocket, self()]), + {ok, AcceptSocket} = ssl:transport_accept(ListenSocket), + ok = ssl:controlling_process(AcceptSocket, self()), Pid ! {self(), ok}. @@ -256,7 +247,8 @@ remove_close_msg(ReconnectTimes) -> end. start_client(Args) -> - Result = spawn_link(?MODULE, run_client_init, [lists:delete(return_socket, Args)]), + Node = proplists:get_value(node, Args), + Result = spawn_link(Node, ?MODULE, run_client_init, [lists:delete(return_socket, Args)]), receive {connected, Socket} -> case lists:member(return_socket, Args) of @@ -288,8 +280,8 @@ run_client(Opts) -> client_cont_loop(Node, Host, Port, Pid, Transport, Options, ContOpts, Opts) end. -client_loop(Node, Host, Port, Pid, Transport, Options, Opts) -> - case rpc:call(Node, Transport, connect, [Host, Port, Options]) of +client_loop(_Node, Host, Port, Pid, Transport, Options, Opts) -> + case Transport:connect(Host, Port, Options) of {ok, Socket} -> Pid ! {connected, Socket}, ct:log("~p:~p~nClient: connected~n", [?MODULE,?LINE]), @@ -299,7 +291,7 @@ client_loop(Node, Host, Port, Pid, Transport, Options, Opts) -> {Module, Function, Args} = proplists:get_value(mfa, Opts), ct:log("~p:~p~nClient: apply(~p,~p,~p)~n", [?MODULE,?LINE, Module, Function, [Socket | Args]]), - case rpc:call(Node, Module, Function, [Socket | Args]) of + case apply(Module, Function, [Socket | Args]) of no_result_msg -> ok; Msg -> @@ -309,7 +301,7 @@ client_loop(Node, Host, Port, Pid, Transport, Options, Opts) -> receive close -> ct:log("~p:~p~nClient closing~n", [?MODULE,?LINE]), - rpc:call(Node, Transport, close, [Socket]); + Transport:close(Socket); {ssl_closed, Socket} -> ok; {gen_tcp, closed} -> @@ -339,16 +331,13 @@ client_loop(Node, Host, Port, Pid, Transport, Options, Opts) -> end; {error, Reason} -> ct:log("~p:~p~nClient: connection failed: ~p ~n", [?MODULE,?LINE, Reason]), - Pid ! {connect_failed, Reason}; - {badrpc,BadRPC} -> - ct:log("~p:~p~nBad rpc: ~p",[?MODULE,?LINE, BadRPC]), - Pid ! {connect_failed, {badrpc,BadRPC}} + Pid ! {connect_failed, Reason} end. -client_cont_loop(Node, Host, Port, Pid, Transport, Options, cancel, _Opts) -> - case rpc:call(Node, Transport, connect, [Host, Port, Options]) of +client_cont_loop(_Node, Host, Port, Pid, Transport, Options, cancel, _Opts) -> + case Transport:connect(Host, Port, Options) of {ok, Socket, _} -> - Result = rpc:call(Node, Transport, handshake_cancel, [Socket]), + Result = Transport:handshake_cancel(Socket), ct:log("~p:~p~nClient: Cancel: ~p ~n", [?MODULE,?LINE, Result]), Pid ! {connect_failed, Result}; {error, Reason} -> @@ -356,17 +345,17 @@ client_cont_loop(Node, Host, Port, Pid, Transport, Options, cancel, _Opts) -> Pid ! {connect_failed, Reason} end; -client_cont_loop(Node, Host, Port, Pid, Transport, Options, ContOpts, Opts) -> - case rpc:call(Node, Transport, connect, [Host, Port, Options]) of +client_cont_loop(_Node, Host, Port, Pid, Transport, Options, ContOpts, Opts) -> + case Transport:connect(Host, Port, Options) of {ok, Socket0, _} -> ct:log("~p:~p~nClient: handshake_continue(~p, ~p, infinity) ~n", [?MODULE, ?LINE, Socket0, ContOpts]), - case rpc:call(Node, Transport, handshake_continue, [Socket0, ContOpts]) of + case Transport:handshake_continue(Socket0, ContOpts) of {ok, Socket} -> Pid ! {connected, Socket}, {Module, Function, Args} = proplists:get_value(mfa, Opts), ct:log("~p:~p~nClient: apply(~p,~p,~p)~n", [?MODULE,?LINE, Module, Function, [Socket | Args]]), - case rpc:call(Node, Module, Function, [Socket | Args]) of + case apply(Module, Function, [Socket | Args]) of no_result_msg -> ok; Msg -> @@ -642,6 +631,40 @@ make_rsa_cert_chains(UserConf, Config, Suffix) -> [{reuseaddr, true}, {verify, verify_peer} | ServerConf] }. +make_ecc_cert_chains(UserConf, Config, Suffix) -> + ClientChain = proplists:get_value(client_chain, UserConf, default_cert_chain_conf()), + ServerChain = proplists:get_value(server_chain, UserConf, default_cert_chain_conf()), + CertChainConf = gen_conf(ecdsa, ecdsa, ClientChain, ServerChain), + ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "ecdsa" ++ Suffix]), + ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "ecdsa" ++ Suffix]), + GenCertData = public_key:pkix_test_data(CertChainConf), + [{server_config, ServerConf}, + {client_config, ClientConf}] = + x509_test:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase), + {[{verify, verify_peer} | ClientConf], + [{reuseaddr, true}, {verify, verify_peer} | ServerConf] + }. + + +make_dsa_cert_chains(UserConf, Config, Suffix) -> + CryptoSupport = crypto:supports(), + case proplists:get_bool(dss, proplists:get_value(public_keys, CryptoSupport)) of + true -> + ClientChain = proplists:get_value(client_chain, UserConf, default_cert_chain_conf()), + ServerChain = proplists:get_value(server_chain, UserConf, default_cert_chain_conf()), + CertChainConf = gen_conf(dsa, dsa, ClientChain, ServerChain), + ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "dsa" ++ Suffix]), + ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "dsa" ++ Suffix]), + GenCertData = public_key:pkix_test_data(CertChainConf), + [{server_config, ServerConf}, + {client_config, ClientConf}] = + x509_test:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase), + {[{verify, verify_peer} | ClientConf], + [{reuseaddr, true}, {verify, verify_peer} | ServerConf]}; + false -> + Config + end. + make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config) -> make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config, ?DEFAULT_CURVE). %% @@ -896,14 +919,14 @@ make_ecdh_rsa_cert(Config) -> end. start_upgrade_server(Args) -> - Result = spawn_link(?MODULE, run_upgrade_server, [Args]), + Node = proplists:get_value(node, Args), + Result = spawn_link(Node, ?MODULE, run_upgrade_server, [Args]), receive {listen, up} -> Result end. run_upgrade_server(Opts) -> - Node = proplists:get_value(node, Opts), Port = proplists:get_value(port, Opts), TimeOut = proplists:get_value(timeout, Opts, infinity), TcpOptions = proplists:get_value(tcp_options, Opts), @@ -911,43 +934,41 @@ run_upgrade_server(Opts) -> Pid = proplists:get_value(from, Opts), ct:log("~p:~p~ngen_tcp:listen(~p, ~p)~n", [?MODULE,?LINE, Port, TcpOptions]), - {ok, ListenSocket} = rpc:call(Node, gen_tcp, listen, [Port, TcpOptions]), + {ok, ListenSocket} = gen_tcp:listen(Port, TcpOptions), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), ct:log("~p:~p~ngen_tcp:accept(~p)~n", [?MODULE,?LINE, ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]), + {ok, AcceptSocket} = gen_tcp:accept(ListenSocket), try {ok, SslAcceptSocket} = case TimeOut of infinity -> - ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n", + ct:log("~p:~p~nssl:handshake(~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, SslOptions]), - rpc:call(Node, ssl, ssl_accept, - [AcceptSocket, SslOptions]); + ssl:handshake(AcceptSocket, SslOptions); _ -> - ct:log("~p:~p~nssl:ssl_accept(~p, ~p, ~p)~n", + ct:log("~p:~p~nssl:handshake(~p, ~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, SslOptions, TimeOut]), - rpc:call(Node, ssl, ssl_accept, - [AcceptSocket, SslOptions, TimeOut]) + ssl:handshake(AcceptSocket, SslOptions, TimeOut) end, {Module, Function, Args} = proplists:get_value(mfa, Opts), - Msg = rpc:call(Node, Module, Function, [SslAcceptSocket | Args]), + Msg = apply(Module, Function, [SslAcceptSocket | Args]), ct:log("~p:~p~nUpgrade Server Msg: ~p ~n", [?MODULE,?LINE, Msg]), Pid ! {self(), Msg}, receive close -> ct:log("~p:~p~nUpgrade Server closing~n", [?MODULE,?LINE]), - rpc:call(Node, ssl, close, [SslAcceptSocket]) + ssl:close(SslAcceptSocket) end catch error:{badmatch, Error} -> Pid ! {self(), Error} end. start_upgrade_client(Args) -> - spawn_link(?MODULE, run_upgrade_client, [Args]). + Node = proplists:get_value(node, Args), + spawn_link(Node, ?MODULE, run_upgrade_client, [Args]). run_upgrade_client(Opts) -> - Node = proplists:get_value(node, Opts), Host = proplists:get_value(host, Opts), Port = proplists:get_value(port, Opts), Pid = proplists:get_value(from, Opts), @@ -956,34 +977,34 @@ run_upgrade_client(Opts) -> ct:log("~p:~p~ngen_tcp:connect(~p, ~p, ~p)~n", [?MODULE,?LINE, Host, Port, TcpOptions]), - {ok, Socket} = rpc:call(Node, gen_tcp, connect, [Host, Port, TcpOptions]), + {ok, Socket} = gen_tcp:connect(Host, Port, TcpOptions), send_selected_port(Pid, Port, Socket), ct:log("~p:~p~nssl:connect(~p, ~p)~n", [?MODULE,?LINE, Socket, SslOptions]), - {ok, SslSocket} = rpc:call(Node, ssl, connect, [Socket, SslOptions]), + {ok, SslSocket} = ssl:connect(Socket, SslOptions), {Module, Function, Args} = proplists:get_value(mfa, Opts), ct:log("~p:~p~napply(~p, ~p, ~p)~n", [?MODULE,?LINE, Module, Function, [SslSocket | Args]]), - Msg = rpc:call(Node, Module, Function, [SslSocket | Args]), + Msg = apply(Module, Function, [SslSocket | Args]), ct:log("~p:~p~nUpgrade Client Msg: ~p ~n", [?MODULE,?LINE, Msg]), Pid ! {self(), Msg}, receive close -> ct:log("~p:~p~nUpgrade Client closing~n", [?MODULE,?LINE]), - rpc:call(Node, ssl, close, [SslSocket]) + ssl:close(SslSocket) end. start_upgrade_server_error(Args) -> - Result = spawn_link(?MODULE, run_upgrade_server_error, [Args]), + Node = proplists:get_value(node, Args), + Result = spawn_link(Node,?MODULE, run_upgrade_server_error, [Args]), receive {listen, up} -> Result end. run_upgrade_server_error(Opts) -> - Node = proplists:get_value(node, Opts), Port = proplists:get_value(port, Opts), TimeOut = proplists:get_value(timeout, Opts, infinity), TcpOptions = proplists:get_value(tcp_options, Opts), @@ -991,22 +1012,20 @@ run_upgrade_server_error(Opts) -> Pid = proplists:get_value(from, Opts), ct:log("~p:~p~ngen_tcp:listen(~p, ~p)~n", [?MODULE,?LINE, Port, TcpOptions]), - {ok, ListenSocket} = rpc:call(Node, gen_tcp, listen, [Port, TcpOptions]), + {ok, ListenSocket} = gen_tcp:listen(Port, TcpOptions), Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), ct:log("~p:~p~ngen_tcp:accept(~p)~n", [?MODULE,?LINE, ListenSocket]), - {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]), + {ok, AcceptSocket} = gen_tcp:accept(ListenSocket), Error = case TimeOut of infinity -> - ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n", + ct:log("~p:~p~nssl:handshake(~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, SslOptions]), - rpc:call(Node, ssl, ssl_accept, - [AcceptSocket, SslOptions]); + ssl:handshake(AcceptSocket, SslOptions); _ -> - ct:log("~p:~p~nssl:ssl_accept(~p, ~p, ~p)~n", + ct:log("~p:~p~nssl:ssl_handshake(~p, ~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, SslOptions, TimeOut]), - rpc:call(Node, ssl, ssl_accept, - [AcceptSocket, SslOptions, TimeOut]) + ssl:handshake(AcceptSocket, SslOptions, TimeOut) end, Pid ! {self(), Error}. @@ -1018,32 +1037,31 @@ start_server_error(Args) -> end. run_server_error(Opts) -> - Node = proplists:get_value(node, Opts), Port = proplists:get_value(port, Opts), Options = proplists:get_value(options, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]), - case rpc:call(Node, Transport, listen, [Port, Options]) of + case Transport:listen(Port, Options) of {ok, #sslsocket{} = ListenSocket} -> %% To make sure error_client will %% get {error, closed} and not {error, connection_refused} Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), ct:log("~p:~p~nssl:transport_accept(~p)~n", [?MODULE,?LINE, ListenSocket]), - case rpc:call(Node, Transport, transport_accept, [ListenSocket]) of + case Transport:transport_accept(ListenSocket) of {error, _} = Error -> Pid ! {self(), Error}; {ok, AcceptSocket} -> ct:log("~p:~p~nssl:ssl_accept(~p)~n", [?MODULE,?LINE, AcceptSocket]), - Error = rpc:call(Node, ssl, ssl_accept, [AcceptSocket]), + Error = ssl:handshake(AcceptSocket), Pid ! {self(), Error} end; {ok, ListenSocket} -> Pid ! {listen, up}, send_selected_port(Pid, Port, ListenSocket), ct:log("~p:~p~n~p:accept(~p)~n", [?MODULE,?LINE, Transport, ListenSocket]), - case rpc:call(Node, Transport, accept, [ListenSocket]) of + case Transport:accept(ListenSocket) of {error, _} = Error -> Pid ! {self(), Error} end; @@ -1055,17 +1073,17 @@ run_server_error(Opts) -> end. start_client_error(Args) -> - spawn_link(?MODULE, run_client_error, [Args]). + Node = proplists:get_value(node, Args), + spawn_link(Node, ?MODULE, run_client_error, [Args]). run_client_error(Opts) -> - Node = proplists:get_value(node, Opts), Host = proplists:get_value(host, Opts), Port = proplists:get_value(port, Opts), Pid = proplists:get_value(from, Opts), Transport = proplists:get_value(transport, Opts, ssl), Options = proplists:get_value(options, Opts), ct:log("~p:~p~nssl:connect(~p, ~p, ~p)~n", [?MODULE,?LINE, Host, Port, Options]), - Error = rpc:call(Node, Transport, connect, [Host, Port, Options]), + Error = Transport:connect(Host, Port, Options), Pid ! {self(), Error}. accepters(N) -> @@ -1083,7 +1101,7 @@ accepters(Acc, N) -> basic_test(COpts, SOpts, Config) -> SType = proplists:get_value(server_type, Config), CType = proplists:get_value(client_type, Config), - {Server, Port} = start_server(SType, SOpts, Config), + {Server, Port} = start_server(SType, COpts, SOpts, Config), Client = start_client(CType, Port, COpts, Config), gen_check_result(Server, SType, Client, CType), stop(Server, Client). @@ -1150,7 +1168,7 @@ start_client(erlang, Port, ClientOpts, Config) -> {host, Hostname}, {from, self()}, {mfa, {ssl_test_lib, check_key_exchange_send_active, [KeyEx]}}, - {options, [{verify, verify_peer} | ClientOpts]}]). + {options, ClientOpts}]). %% Workaround for running tests on machines where openssl %% s_client would use an IPv6 address with localhost. As @@ -1185,20 +1203,19 @@ start_client_ecc_error(erlang, Port, ClientOpts, ECCOpts, Config) -> [{verify, verify_peer} | ClientOpts]}]). -start_server(openssl, ServerOpts, Config) -> - Cert = proplists:get_value(certfile, ServerOpts), - Key = proplists:get_value(keyfile, ServerOpts), - CA = proplists:get_value(cacertfile, ServerOpts), +start_server(openssl, ClientOpts, ServerOpts, Config) -> Port = inet_port(node()), Version = protocol_version(Config), Exe = "openssl", - Args = ["s_server", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), - "-verify", "2", "-cert", Cert, "-CAfile", CA, - "-key", Key, "-msg", "-debug"], + CertArgs = openssl_cert_options(ServerOpts), + [Cipher|_] = proplists:get_value(ciphers, ClientOpts, ssl:cipher_suites(default,Version)), + Args = ["s_server", "-accept", integer_to_list(Port), "-cipher", + ssl_cipher_format:suite_map_to_openssl_str(Cipher), + ssl_test_lib:version_flag(Version)] ++ CertArgs ++ ["-msg", "-debug"], OpenSslPort = portable_open_port(Exe, Args), true = port_command(OpenSslPort, "Hello world"), {OpenSslPort, Port}; -start_server(erlang, ServerOpts, Config) -> +start_server(erlang, _, ServerOpts, Config) -> {_, ServerNode, _} = ssl_test_lib:run_where(Config), KeyEx = proplists:get_value(check_keyex, Config, false), Server = start_server([{node, ServerNode}, {port, 0}, @@ -1261,6 +1278,29 @@ stop(Client, Server) -> close(Server), close(Client). + +openssl_cert_options(ServerOpts) -> + Cert = proplists:get_value(certfile, ServerOpts, undefined), + Key = proplists:get_value(keyfile, ServerOpts, undefined), + CA = proplists:get_value(cacertfile, ServerOpts, undefined), + case CA of + undefined -> + case cert_option("-cert", Cert) ++ cert_option("-key", Key) of + [] -> + ["-nocert"]; + Other -> + Other + end; + _ -> + cert_option("-cert", Cert) ++ cert_option("-CAfile", CA) ++ + cert_option("-key", Key) ++ ["-verify", "2"] + end. + +cert_option(_, undefined) -> + []; +cert_option(Opt, Value) -> + [Opt, Value]. + supported_eccs(Opts) -> ToCheck = proplists:get_value(eccs, Opts, []), Supported = ssl:eccs(), @@ -1357,13 +1397,13 @@ common_ciphers(crypto) -> common_ciphers(openssl) -> OpenSslSuites = string:tokens(string:strip(os:cmd("openssl ciphers"), right, $\n), ":"), - [ssl_cipher_format:suite_definition(S) + [ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:suites(tls_record:highest_protocol_version([])), - lists:member(ssl_cipher_format:openssl_suite_name(S), OpenSslSuites) + lists:member(ssl_cipher_format:suite_map_to_openssl_str(ssl_cipher_format:suite_bin_to_map(S)), OpenSslSuites) ]. available_suites(Version) -> - [ssl_cipher_format:suite_definition(Suite) || + [ssl_cipher_format:suite_bin_to_map(Suite) || Suite <- ssl_cipher:filter_suites(ssl_cipher:suites(Version))]. @@ -1436,7 +1476,7 @@ string_regex_filter(_Str, _Search) -> false. ecdh_dh_anonymous_suites(Version) -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:anonymous_suites(Version)], + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:anonymous_suites(Version)], [{key_exchange, fun(dh_anon) -> true; @@ -1446,7 +1486,7 @@ ecdh_dh_anonymous_suites(Version) -> false end}]). psk_suites({3,_} = Version) -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:psk_suites(Version)], []); + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:psk_suites(Version)], []); psk_suites(Version) -> ssl:filter_cipher_suites(psk_suites(dtls_v1:corresponding_tls_version(Version)), [{cipher, @@ -1457,7 +1497,7 @@ psk_suites(Version) -> end}]). psk_anon_suites({3,_} = Version) -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:psk_suites_anon(Version)], + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:psk_suites_anon(Version)], [{key_exchange, fun(psk) -> true; @@ -1480,7 +1520,7 @@ psk_anon_suites(Version) -> srp_suites() -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:srp_suites()], + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:srp_suites()], [{key_exchange, fun(srp_rsa) -> true; @@ -1488,10 +1528,10 @@ srp_suites() -> false end}]). srp_anon_suites() -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:srp_suites_anon()], + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:srp_suites_anon()], []). srp_dss_suites() -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:srp_suites()], + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:srp_suites()], [{key_exchange, fun(srp_dss) -> true; @@ -1499,14 +1539,14 @@ srp_dss_suites() -> false end}]). chacha_suites(Version) -> - [ssl_cipher_format:suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:chacha_suites(Version))]. + [ssl_cipher_format:suite_bin_to_map(S) || S <- ssl_cipher:filter_suites(ssl_cipher:chacha_suites(Version))]. rc4_suites(Version) -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <-ssl_cipher:rc4_suites(Version)], []). + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <-ssl_cipher:rc4_suites(Version)], []). des_suites(Version) -> - ssl:filter_cipher_suites([ssl_cipher_format:suite_definition(S) || S <-ssl_cipher:des_suites(Version)], []). + ssl:filter_cipher_suites([ssl_cipher_format:suite_bin_to_map(S) || S <-ssl_cipher:des_suites(Version)], []). tuple_to_map({Kex, Cipher, Mac}) -> #{key_exchange => Kex, @@ -1533,10 +1573,13 @@ cipher_result(Socket, Result) -> ct:log("~p:~p~nSuccessfull connect: ~p~n", [?MODULE,?LINE, Result]), %% Importante to send two packets here %% to properly test "cipher state" handling - ssl:send(Socket, "Hello\n"), - "Hello\n" = active_recv(Socket, length( "Hello\n")), - ssl:send(Socket, " world\n"), - " world\n" = active_recv(Socket, length(" world\n")), + Hello = "Hello\n", + World = " world\n", + ssl:send(Socket, Hello), + ct:sleep(500), + ssl:send(Socket, World), + Expected = Hello ++ World, + Expected = active_recv(Socket, length(Expected)), ok. session_info_result(Socket) -> @@ -1769,6 +1812,15 @@ is_sane_ecc(crypto) -> is_sane_ecc(_) -> sufficient_crypto_support(cipher_ec). +is_sane_oppenssl_client() -> + [{_,_, Bin}] = crypto:info_lib(), + case binary_to_list(Bin) of + "OpenSSL 0.9" ++ _ -> + false; + _ -> + true + end. + is_fips(openssl) -> VersionStr = os:cmd("openssl version"), case re:split(VersionStr, "fips") of @@ -1877,6 +1929,14 @@ check_sane_openssl_version(Version) -> case {Version, os:cmd("openssl version")} of {'sslv3', "OpenSSL 1.0.2" ++ _} -> false; + {'dtlsv1', "OpenSSL 0" ++ _} -> + false; + {'dtlsv1.2', "OpenSSL 0" ++ _} -> + false; + {'dtlsv1.2', "OpenSSL 1.0.2" ++ _} -> + false; + {'dtlsv1', "OpenSSL 1.0.0" ++ _} -> + false; {'dtlsv1', _} -> not is_fips(openssl); {'dtlsv1.2', _} -> @@ -1889,18 +1949,10 @@ check_sane_openssl_version(Version) -> false; {'tlsv1.1', "OpenSSL 1.0.0" ++ _} -> false; - {'dtlsv1.2', "OpenSSL 1.0.2" ++ _} -> - false; - {'dtlsv1', "OpenSSL 1.0.0" ++ _} -> - false; {'tlsv1.2', "OpenSSL 0" ++ _} -> false; {'tlsv1.1', "OpenSSL 0" ++ _} -> false; - {'dtlsv1', "OpenSSL 0" ++ _} -> - false; - {'dtlsv1.2', "OpenSSL 0" ++ _} -> - false; {_, _} -> true end; @@ -1945,10 +1997,10 @@ version_flag('dtlsv1') -> "-dtls1". filter_suites([Cipher | _] = Ciphers, AtomVersion) when is_list(Cipher)-> - filter_suites([ssl_cipher_format:openssl_suite(S) || S <- Ciphers], + filter_suites([ssl_cipher_format:suite_openssl_str_to_map(S) || S <- Ciphers], AtomVersion); filter_suites([Cipher | _] = Ciphers, AtomVersion) when is_binary(Cipher)-> - filter_suites([ssl_cipher_format:suite_definition(S) || S <- Ciphers], + filter_suites([ssl_cipher_format:suite_bin_to_map(S) || S <- Ciphers], AtomVersion); filter_suites(Ciphers0, AtomVersion) -> Version = tls_version(AtomVersion), @@ -1960,7 +2012,7 @@ filter_suites(Ciphers0, AtomVersion) -> ++ ssl_cipher:srp_suites_anon() ++ ssl_cipher:rc4_suites(Version), Supported1 = ssl_cipher:filter_suites(Supported0), - Supported2 = [ssl_cipher_format:suite_definition(S) || S <- Supported1], + Supported2 = [ssl_cipher_format:suite_bin_to_map(S) || S <- Supported1], [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported2)]. -define(OPENSSL_QUIT, "Q\n"). @@ -2378,3 +2430,16 @@ user_lookup(srp, Username, _UserState) -> Salt = ssl_cipher:random_bytes(16), UserPassHash = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, <<"secret">>])]), {ok, {srp_1024, Salt, UserPassHash}}. + +test_cipher(TestCase, Config) -> + [{name, Group} |_] = proplists:get_value(tc_group_properties, Config), + list_to_atom(re:replace(atom_to_list(TestCase), atom_to_list(Group) ++ "_", "", [{return, list}])). + +digest() -> + case application:get_env(ssl, protocol_version, application:get_env(ssl, dtls_protocol_version)) of + Ver when Ver == 'tlsv1.2'; + Ver == 'dtlsv1.2' -> + {digest, sha256}; + _ -> + {digest, sha1} + end. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index df84411b6d..07abddbcf7 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -39,16 +39,14 @@ all() -> case ssl_test_lib:openssl_sane_dtls() of true -> - [{group, basic}, - {group, 'tlsv1.2'}, + [{group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, {group, 'sslv3'}, {group, 'dtlsv1.2'}, {group, 'dtlsv1'}]; false -> - [{group, basic}, - {group, 'tlsv1.2'}, + [{group, 'tlsv1.2'}, {group, 'tlsv1.1'}, {group, 'tlsv1'}, {group, 'sslv3'}] @@ -57,8 +55,7 @@ all() -> groups() -> case ssl_test_lib:openssl_sane_dtls() of true -> - [{basic, [], basic_tests()}, - {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, + [{'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, {'sslv3', [], all_versions_tests()}, @@ -66,20 +63,13 @@ groups() -> {'dtlsv1', [], dtls_all_versions_tests()} ]; false -> - [{basic, [], basic_tests()}, - {'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, + [{'tlsv1.2', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, {'tlsv1.1', [], all_versions_tests() ++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, {'tlsv1', [], all_versions_tests()++ alpn_tests() ++ npn_tests() ++ sni_server_tests()}, {'sslv3', [], all_versions_tests()} ] end. - -basic_tests() -> - [basic_erlang_client_openssl_server, - basic_erlang_server_openssl_client, - expired_session - ]. - + all_versions_tests() -> [ erlang_client_openssl_server, @@ -191,16 +181,6 @@ end_per_suite(_Config) -> ssl:stop(), application:stop(crypto). -init_per_group(basic, Config0) -> - case ssl_test_lib:supports_ssl_tls_version('tlsv1.2') - orelse ssl_test_lib:supports_ssl_tls_version('tlsv1.1') - orelse ssl_test_lib:supports_ssl_tls_version('tlsv1') - of - true -> - ssl_test_lib:clean_tls_version(Config0); - false -> - {skip, "only sslv3 supported by OpenSSL"} - end; init_per_group(GroupName, Config) -> case ssl_test_lib:is_tls_version(GroupName) of @@ -243,7 +223,7 @@ init_per_testcase(TestCase, Config) when TestCase == erlang_server_openssl_client_dsa_cert; TestCase == erlang_client_openssl_server_dsa_cert; TestCase == erlang_server_openssl_client_dsa_cert -> - case ssl_test_lib:openssl_dsa_support() of + case ssl_test_lib:openssl_dsa_support() andalso ssl_test_lib:is_sane_oppenssl_client() of true -> special_init(TestCase, Config); false -> @@ -344,7 +324,16 @@ special_init(TestCase, Config0) ]} ]}]} | Config0], check_openssl_sni_support(Config); - +special_init(TestCase, Config) + when TestCase == erlang_server_openssl_client; + TestCase == erlang_server_openssl_client_client_cert; + TestCase == erlang_server_openssl_client_reuse_session -> + case ssl_test_lib:is_sane_oppenssl_client() of + true -> + Config; + false -> + {skip, "Broken OpenSSL client"} + end; special_init(_, Config) -> Config. @@ -357,85 +346,7 @@ end_per_testcase(_, Config) -> %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- -basic_erlang_client_openssl_server() -> - [{doc,"Test erlang client with openssl server"}]. -basic_erlang_client_openssl_server(Config) when is_list(Config) -> - process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config), - - {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), - - Data = "From openssl to erlang", - - Port = ssl_test_lib:inet_port(node()), - CertFile = proplists:get_value(certfile, ServerOpts), - KeyFile = proplists:get_value(keyfile, ServerOpts), - - Exe = "openssl", - Args = ["s_server", "-accept", integer_to_list(Port), - "-cert", CertFile, "-key", KeyFile], - - OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), - - - ssl_test_lib:wait_for_openssl_server(Port, tls), - - Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, - {host, Hostname}, - {from, self()}, - {mfa, {?MODULE, - erlang_ssl_receive, [Data]}}, - {options, ClientOpts}]), - true = port_command(OpensslPort, Data), - - ssl_test_lib:check_result(Client, ok), - - %% Clean close down! Server needs to be closed first !! - ssl_test_lib:close_port(OpensslPort), - ssl_test_lib:close(Client), - process_flag(trap_exit, false). - -%%-------------------------------------------------------------------- -basic_erlang_server_openssl_client() -> - [{doc,"Test erlang server with openssl client"}]. -basic_erlang_server_openssl_client(Config) when is_list(Config) -> - process_flag(trap_exit, true), - ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), - - {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), - - Data = "From openssl to erlang", - Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, - {from, self()}, - {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, - {options,ServerOpts}]), - - Port = ssl_test_lib:inet_port(Server), - - Exe = "openssl", - Args = case no_low_flag("-no_ssl2") of - [] -> - ["s_client", "-connect", hostname_format(Hostname) ++ - ":" ++ integer_to_list(Port), no_low_flag("-no_ssl3") - | workaround_openssl_s_clinent()]; - Flag -> - ["s_client", "-connect", hostname_format(Hostname) ++ - ":" ++ integer_to_list(Port), no_low_flag("-no_ssl3"), Flag - | workaround_openssl_s_clinent()] - end, - - OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), - true = port_command(OpenSslPort, Data), - - ssl_test_lib:check_result(Server, ok), - - %% Clean close down! Server needs to be closed first !! - ssl_test_lib:close(Server), - ssl_test_lib:close_port(OpenSslPort), - process_flag(trap_exit, false). -%%-------------------------------------------------------------------- erlang_client_openssl_server() -> [{doc,"Test erlang client with openssl server"}]. erlang_client_openssl_server(Config) when is_list(Config) -> @@ -1161,7 +1072,7 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> Client1 = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, - {mfa, {ssl_test_lib, no_result_msg, []}}, + {mfa, {ssl_test_lib, no_result, []}}, {options, [{versions, [Version]} | ClientOpts]}]), @@ -1249,7 +1160,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> ct:log("Ports ~p~n", [[erlang:port_info(P) || P <- erlang:ports()]]), ssl_test_lib:consume_port_exit(OpenSslPort), - ssl_test_lib:check_server_alert(Server, bad_record_mac), + ssl_test_lib:check_server_alert(Server, unexpected_message), process_flag(trap_exit, false). %%-------------------------------------------------------------------- @@ -1550,6 +1461,7 @@ send_and_hostname(SSLSocket) -> end. erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> + Version = ssl_test_lib:protocol_version(Config), ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), ServerOptions = proplists:get_value(sni_server_opts, Config) ++ proplists:get_value(server_rsa_opts, Config), {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -1560,9 +1472,9 @@ erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, Exe = "openssl", ClientArgs = case SNIHostname of undefined -> - openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname,Port); + openssl_client_args(Version, Hostname,Port); _ -> - openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname, Port, SNIHostname) + openssl_client_args(Version, Hostname, Port, SNIHostname) end, ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs), @@ -1573,6 +1485,7 @@ erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) -> + Version = ssl_test_lib:protocol_version(Config), ct:log("Start running handshake for sni_fun, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]), [{sni_hosts, ServerSNIConf}] = proplists:get_value(sni_server_opts, Config), SNIFun = fun(Domain) -> proplists:get_value(Domain, ServerSNIConf, undefined) end, @@ -1585,9 +1498,9 @@ erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHo Exe = "openssl", ClientArgs = case SNIHostname of undefined -> - openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname,Port); + openssl_client_args(Version, Hostname,Port); _ -> - openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname, Port, SNIHostname) + openssl_client_args(Version, Hostname, Port, SNIHostname) end, ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs), @@ -1998,13 +1911,19 @@ send_wait_send(Socket, [ErlData, OpenSslData]) -> check_openssl_sni_support(Config) -> HelpText = os:cmd("openssl s_client --help"), - case string:str(HelpText, "-servername") of - 0 -> - {skip, "Current openssl doesn't support SNI"}; - _ -> - Config + case ssl_test_lib:is_sane_oppenssl_client() of + true -> + case string:str(HelpText, "-servername") of + 0 -> + {skip, "Current openssl doesn't support SNI"}; + _ -> + Config + end; + false -> + {skip, "Current openssl doesn't support SNI or extension handling is flawed"} end. + check_openssl_npn_support(Config) -> HelpText = os:cmd("openssl s_client --help"), case string:str(HelpText, "nextprotoneg") of @@ -2070,17 +1989,13 @@ workaround_openssl_s_clinent() -> [] end. -openssl_client_args(false, Hostname, Port) -> - ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port)]; -openssl_client_args(true, Hostname, Port) -> - ["s_client", "-no_ssl2", "-connect", Hostname ++ ":" ++ integer_to_list(Port)]. +openssl_client_args(Version, Hostname, Port) -> + ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port), ssl_test_lib:version_flag(Version)]. -openssl_client_args(false, Hostname, Port, ServerName) -> +openssl_client_args(Version, Hostname, Port, ServerName) -> ["s_client", "-connect", Hostname ++ ":" ++ - integer_to_list(Port), "-servername", ServerName]; -openssl_client_args(true, Hostname, Port, ServerName) -> - ["s_client", "-no_ssl2", "-connect", Hostname ++ ":" ++ - integer_to_list(Port), "-servername", ServerName]. + integer_to_list(Port), ssl_test_lib:version_flag(Version), "-servername", ServerName]. + hostname_format(Hostname) -> case lists:member($., Hostname) of @@ -2090,22 +2005,12 @@ hostname_format(Hostname) -> "localhost" end. -no_low_flag("-no_ssl2" = Flag) -> - case ssl_test_lib:supports_ssl_tls_version(sslv2) of - true -> - Flag; - false -> - "" - end; -no_low_flag(Flag) -> - Flag. - openssl_has_common_ciphers(Ciphers) -> OCiphers = ssl_test_lib:common_ciphers(openssl), has_common_ciphers(Ciphers, OCiphers). -has_common_ciphers([], OCiphers) -> +has_common_ciphers([], _) -> false; has_common_ciphers([Cipher | Rest], OCiphers) -> case lists:member(Cipher, OCiphers) of diff --git a/lib/ssl/test/ssl_upgrade_SUITE.erl b/lib/ssl/test/ssl_upgrade_SUITE.erl index 875399db76..ead18aeb73 100644 --- a/lib/ssl/test/ssl_upgrade_SUITE.erl +++ b/lib/ssl/test/ssl_upgrade_SUITE.erl @@ -47,10 +47,7 @@ init_per_suite(Config0) -> {skip, Reason} -> {skip, Reason}; Config -> - Result = - {ok, _} = make_certs:all(proplists:get_value(data_dir, Config), - proplists:get_value(priv_dir, Config)), - ssl_test_lib:cert_options(Config) + ssl_test_lib:make_rsa_cert(Config) end catch _:_ -> {skip, "Crypto did not start"} @@ -149,8 +146,8 @@ use_connection(Socket) -> end. soft_start_connection(Config, ResulProxy) -> - ClientOpts = proplists:get_value(client_verification_opts, Config), - ServerOpts = proplists:get_value(server_verification_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = start_server([{node, ServerNode}, {port, 0}, {from, ResulProxy}, @@ -166,8 +163,8 @@ soft_start_connection(Config, ResulProxy) -> {Server, Client}. restart_start_connection(Config, ResulProxy) -> - ClientOpts = proplists:get_value(client_verification_opts, Config), - ServerOpts = proplists:get_value(server_verification_opts, Config), + ClientOpts = proplists:get_value(client_rsa_verify_opts, Config), + ServerOpts = proplists:get_value(server_rsa_verify_opts, Config), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), Server = start_server([{node, ServerNode}, {port, 0}, {from, ResulProxy}, diff --git a/lib/ssl/test/x509_test.erl b/lib/ssl/test/x509_test.erl index fea01efdaf..faf223ae35 100644 --- a/lib/ssl/test/x509_test.erl +++ b/lib/ssl/test/x509_test.erl @@ -22,7 +22,7 @@ -module(x509_test). - -include_lib("public_key/include/public_key.hrl"). +-include_lib("public_key/include/public_key.hrl"). -export([extensions/1, gen_pem_config_files/3]). diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index c4bcc1560c..98070f794c 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 9.2.1 +SSL_VSN = 9.2.2 diff --git a/lib/stdlib/doc/src/calendar.xml b/lib/stdlib/doc/src/calendar.xml index 518a085c89..6308420c52 100644 --- a/lib/stdlib/doc/src/calendar.xml +++ b/lib/stdlib/doc/src/calendar.xml @@ -513,7 +513,7 @@ <title>Date and Time Source</title> <p>Local time is obtained from the Erlang BIF <c>localtime/0</c>. Universal time is computed from the BIF <c>universaltime/0</c>.</p> - <p>The following fapply:</p> + <p>The following apply:</p> <list type="bulleted"> <item>There are 86400 seconds in a day.</item> <item>There are 365 days in an ordinary year.</item> diff --git a/lib/stdlib/doc/src/dets.xml b/lib/stdlib/doc/src/dets.xml index 8e4e002000..8b9502a3b1 100644 --- a/lib/stdlib/doc/src/dets.xml +++ b/lib/stdlib/doc/src/dets.xml @@ -1090,8 +1090,8 @@ ok </item> <item> <p><c>select</c> - The table is traversed by calling - <seealso marker="dets:select/3"><c>dets:select/3</c></seealso> and - <seealso marker="dets:select/1"><c>dets:select/1</c></seealso>. + <seealso marker="dets#select/3"><c>dets:select/3</c></seealso> and + <seealso marker="dets#select/1"><c>dets:select/1</c></seealso>. Option <c>n_objects</c> determines the number of objects returned (the third argument of <c>select/3</c>). The match specification (the second argument of diff --git a/lib/stdlib/doc/src/digraph_utils.xml b/lib/stdlib/doc/src/digraph_utils.xml index 13b0aaad9e..a23b02c6c1 100644 --- a/lib/stdlib/doc/src/digraph_utils.xml +++ b/lib/stdlib/doc/src/digraph_utils.xml @@ -371,7 +371,7 @@ the default, the type of <c><anno>Digraph</anno></c> is used for the subgraph as well. Otherwise the option value of <c>type</c> is used as argument to - <seealso marker="digraph:new/1"><c>digraph:new/1</c></seealso>.</p> + <seealso marker="digraph#new/1"><c>digraph:new/1</c></seealso>.</p> <p>If the value of option <c>keep_labels</c> is <c>true</c>, which is the default, the <seealso marker="#label">labels</seealso> of vertices and edges diff --git a/lib/stdlib/doc/src/erl_pp.xml b/lib/stdlib/doc/src/erl_pp.xml index f1c3aa5a41..0a46139db6 100644 --- a/lib/stdlib/doc/src/erl_pp.xml +++ b/lib/stdlib/doc/src/erl_pp.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>1996</year> - <year>2016</year> + <year>2019</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -65,6 +65,10 @@ </datatype> <datatype> <name name="option"/> + <desc> + <p>The option <c>quote_singleton_atom_types</c> + is used to add quotes to all singleton atom types.</p> + </desc> </datatype> <datatype> <name name="options"/> diff --git a/lib/stdlib/doc/src/gb_trees.xml b/lib/stdlib/doc/src/gb_trees.xml index 570c9c7cb6..08aa1865e8 100644 --- a/lib/stdlib/doc/src/gb_trees.xml +++ b/lib/stdlib/doc/src/gb_trees.xml @@ -42,11 +42,8 @@ <section> <title>Data Structure</title> - <code type="none"> -{Size, Tree}</code> - - <p><c>Tree</c> is composed of nodes of the form <c>{Key, Value, Smaller, - Bigger}</c> and the "empty tree" node <c>nil</c>.</p> + <p>Trees and iterators are built using opaque data structures that should + not be pattern-matched from outside this module.</p> <p>There is no attempt to balance trees after deletions. As deletions do not increase the height of a tree, this should be OK.</p> diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index 23c3f6e981..65650a25c7 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -31,6 +31,21 @@ </header> <p>This document describes the changes made to the STDLIB application.</p> +<section><title>STDLIB 3.8.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a performance regression when reading files + opened with the <c>compressed</c> flag.</p> + <p> + Own Id: OTP-15706 Aux Id: ERIERL-336 </p> + </item> + </list> + </section> + +</section> + <section><title>STDLIB 3.8</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml index aeb9f48735..bb983903a9 100644 --- a/lib/stdlib/doc/src/proc_lib.xml +++ b/lib/stdlib/doc/src/proc_lib.xml @@ -166,7 +166,7 @@ <fsummary>Hibernate a process until a message is sent to it.</fsummary> <desc> <p>This function does the same as (and does call) the - <seealso marker="erts:erlang#erlang:hibernate/3"> + <seealso marker="erts:erlang#hibernate/3"> <c>hibernate/3</c></seealso> BIF, but ensures that exception handling and logging continues to work as expected when the process wakes up.</p> diff --git a/lib/stdlib/doc/src/qlc.xml b/lib/stdlib/doc/src/qlc.xml index fe60c2e9bb..34f7c5bab9 100644 --- a/lib/stdlib/doc/src/qlc.xml +++ b/lib/stdlib/doc/src/qlc.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2004</year><year>2016</year> + <year>2004</year><year>2019</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -581,11 +581,13 @@ gb_iter(I0, N, EFun) -> <input>{K} <- ets:table(E1),</input> <input>K == 2.71 orelse K == a]),</input> <input>io:format("~s~n", [qlc:info(Q1)]).</input> -ets:match_spec_run(lists:flatmap(fun(V) -> - ets:lookup(20493, V) - end, - [a,2.71]), - ets:match_spec_compile([{{'$1'},[],['$1']}]))</pre> +ets:match_spec_run( + lists:flatmap(fun(V) -> + ets:lookup(#Ref<0.3098908599.2283929601.256025>, + V) + end, + [a, 2.71]), + ets:match_spec_compile([{{'$1'}, [], ['$1']}]))</pre> <p>In the example, operator <c>==/2</c> has been handled exactly as <c>=:=/2</c> would have been handled. However, @@ -607,9 +609,10 @@ ets:match_spec_run(lists:flatmap(fun(V) -> <input>end,</input> <input>Q2 = F2({2,2}),</input> <input>io:format("~s~n", [qlc:info(Q2)]).</input> -ets:table(53264, +ets:table(#Ref<0.3098908599.2283929601.256125>, [{traverse, - {select,[{{'$1','$2'},[{'==','$1',{const,{2,2}}}],['$2']}]}}]) + {select, + [{{'$1', '$2'}, [{'==', '$1', {const, {2, 2}}}], ['$2']}]}}]) 3> <input>lists:sort(qlc:e(Q2)).</input> [a,b,c]</pre> @@ -629,8 +632,9 @@ ets:table(53264, <input>end,</input> <input>Q3 = F3({2,2}),</input> <input>io:format("~s~n", [qlc:info(Q3)]).</input> -ets:match_spec_run(ets:lookup(86033, {2,2}), - ets:match_spec_compile([{{'$1','$2'},[],['$2']}])) +ets:match_spec_run(ets:lookup(#Ref<0.3098908599.2283929601.256211>, + {2, 2}), + ets:match_spec_compile([{{'$1', '$2'}, [], ['$2']}])) 5> <input>qlc:e(Q3).</input> [b]</pre> @@ -892,21 +896,21 @@ begin V1 = qlc:q([ SQV || - SQV <- [x,y] + SQV <- [x, y] ], - [{unique,true}]), + [{unique, true}]), V2 = qlc:q([ SQV || - SQV <- [a,b] + SQV <- [a, b] ], - [{unique,true}]), + [{unique, true}]), qlc:q([ {X,Y} || X <- V1, Y <- V2 ], - [{unique,true}]) + [{unique, true}]) end</pre> <p>In the following example QLC <c>V2</c> has been inserted to show the joined generators and the join @@ -927,19 +931,21 @@ begin V1 = qlc:q([ P0 || - P0 = {W,Y} <- ets:table(17) + P0 = {W, Y} <- + ets:table(#Ref<0.3098908599.2283929601.256549>) ]), V2 = qlc:q([ - [G1|G2] || + [G1 | G2] || G2 <- V1, - G1 <- ets:table(16), + G1 <- + ets:table(#Ref<0.3098908599.2283929601.256548>), element(2, G1) =:= element(1, G2) ], - [{join,lookup}]), + [{join, lookup}]), qlc:q([ - {X,Z,W} || - [{X,Z}|{W,Y}] <- V2 + {X, Z, W} || + [{X, Z} | {W, Y}] <- V2 ]) end</pre> </desc> @@ -1080,27 +1086,27 @@ begin V1 = qlc:q([ P0 || - P0 = {X,Z} <- - qlc:keysort(1, [{a,1},{b,4},{c,6}], []) + P0 = {X, Z} <- + qlc:keysort(1, [{a, 1}, {b, 4}, {c, 6}], []) ]), V2 = qlc:q([ P0 || - P0 = {W,Y} <- - qlc:keysort(2, [{2,a},{3,b},{4,c}], []) + P0 = {W, Y} <- + qlc:keysort(2, [{2, a}, {3, b}, {4, c}], []) ]), V3 = qlc:q([ - [G1|G2] || + [G1 | G2] || G1 <- V1, G2 <- V2, element(1, G1) == element(2, G2) ], - [{join,merge},{cache,list}]), + [{join, merge}, {cache, list}]), qlc:q([ - {A,X,Z,W} || - A <- [a,b,c], - [{X,Z}|{W,Y}] <- V3, + {A, X, Z, W} || + A <- [a, b, c], + [{X, Z} | {W, Y}] <- V3, X =:= Y ]) end</pre> @@ -1141,14 +1147,21 @@ ets:match_spec_run( gb_trees:lookup(K, gb_trees:from_orddict([])) of - {value,V} -> - [{K,V}]; + {value, V} -> + [{K, V}]; none -> [] end end, - [{1,a},{1,b},{1,c},{2,a},{2,b},{2,c}]), - ets:match_spec_compile([{{{'$1','$2'},'_'},[],['$1']}]))</pre> + [{1, a}, + {1, b}, + {1, c}, + {2, a}, + {2, b}, + {2, c}]), + ets:match_spec_compile([{{{'$1', '$2'}, '_'}, + [], + ['$1']}]))</pre> <p>Options:</p> <list type="bulleted"> <item> diff --git a/lib/stdlib/doc/src/queue.xml b/lib/stdlib/doc/src/queue.xml index 83a8afea81..89cce6d85b 100644 --- a/lib/stdlib/doc/src/queue.xml +++ b/lib/stdlib/doc/src/queue.xml @@ -168,7 +168,7 @@ <fsummary>Test if a queue is empty.</fsummary> <desc> <p>Tests if <c><anno>Q</anno></c> is empty and returns <c>true</c> if - so, otherwise otherwise.</p> + so, otherwise <c>false</c>.</p> </desc> </func> diff --git a/lib/stdlib/doc/src/slave.xml b/lib/stdlib/doc/src/slave.xml index 778c5f66e5..f9e42ad47d 100644 --- a/lib/stdlib/doc/src/slave.xml +++ b/lib/stdlib/doc/src/slave.xml @@ -51,7 +51,7 @@ <p>An alternative to the <c>ssh</c> program can be specified on the command line to - <seealso marker="erts:erl#erl"><c>erl(1)</c></seealso> as follows:</p> + <seealso marker="erts:erl"><c>erl(1)</c></seealso> as follows:</p> <pre> -rsh Program</pre> @@ -140,7 +140,7 @@ rpc:call(N, slave, pseudo, [node(), [pxw_server]]).</code> <p>Argument <c><anno>Args</anno></c> is used to set <c>erl</c> command-line arguments. If provided, it is passed to the new node and can be used for a variety of purposes; see - <seealso marker="erts:erl#erl"><c>erl(1)</c></seealso>.</p> + <seealso marker="erts:erl"><c>erl(1)</c></seealso>.</p> <p>As an example, suppose that you want to start a slave node at host <c>H</c> with node name <c>Name@H</c> and want the slave node to have the following properties:</p> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 3ec78a2667..e0c37ca030 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -79,6 +79,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> -type fa() :: {atom(), arity()}. % function+arity -type ta() :: {atom(), arity()}. % type+arity +-type module_or_mfa() :: module() | mfa(). + -record(typeinfo, {attr, line}). %% Usage of records, functions, and imports. The variable table, which @@ -115,6 +117,8 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> :: erl_anno:anno(), clashes=[], %Exported functions named as BIFs not_deprecated=[], %Not considered deprecated + not_removed=gb_sets:empty() %Not considered removed + :: gb_sets:set(module_or_mfa()), func=[], %Current function warn_format=0, %Warn format calls enabled_warnings=[], %All enabled warnings (ordset). @@ -573,7 +577,10 @@ start(File, Opts) -> false, Opts)}, {missing_spec_all, bool_option(warn_missing_spec_all, nowarn_missing_spec_all, - false, Opts)} + false, Opts)}, + {removed, + bool_option(warn_removed, nowarn_removed, + true, Opts)} ], Enabled1 = [Category || {Category,true} <- Enabled0], Enabled = ordsets:from_list(Enabled1), @@ -670,8 +677,9 @@ forms(Forms0, St0) -> no_auto = AutoImportSuppressed}), St2 = bif_clashes(Forms, St1), St3 = not_deprecated(Forms, St2), - St4 = foldl(fun form/2, pre_scan(Forms, St3), Forms), - post_traversal_check(Forms, St4). + St4 = not_removed(Forms, St3), + St5 = foldl(fun form/2, pre_scan(Forms, St4), Forms), + post_traversal_check(Forms, St5). pre_scan([{attribute,L,compile,C} | Fs], St) -> case is_warn_enabled(export_all, St) andalso @@ -846,6 +854,24 @@ not_deprecated(Forms, #lint{compile=Opts}=St0) -> end, St0, ML), St1#lint{not_deprecated = ordsets:from_list(Nowarn)}. +%% not_removed(Forms, State0) -> State + +not_removed(Forms, #lint{compile=Opts}=St0) -> + %% There are no line numbers in St0#lint.compile. + MFAsL = [{MFA,L} || + {attribute, L, compile, Args} <- Forms, + {nowarn_removed, MFAs0} <- lists:flatten([Args]), + MFA <- lists:flatten([MFAs0])], + Nowarn = [MFA || + {nowarn_removed, MFAs0} <- Opts, + MFA <- lists:flatten([MFAs0])], + St1 = foldl(fun ({{M, _F, _A}, L}, St2) -> + check_module_name(M, L, St2); + ({M,L}, St2) -> + check_module_name(M, L, St2) + end, St0, MFAsL), + St1#lint{not_removed = gb_sets:from_list(Nowarn)}. + %% The nowarn_bif_clash directive is not only deprecated, it's actually an error from R14A disallowed_compile_flags(Forms, St0) -> %% There are (still) no line numbers in St0#lint.compile. @@ -2250,6 +2276,9 @@ expr({'fun',Line,Body}, Vt, St) -> case Body of {clauses,Cs} -> fun_clauses(Cs, Vt, St); + {function,record_info,2} -> + %% It is illegal to call record_info/2 with unknown arguments. + {[],add_error(Line, illegal_record_info, St)}; {function,F,A} -> %% BifClash - Fun expression %% N.B. Only allows BIFs here as well, NO IMPORTS!! @@ -3769,13 +3798,23 @@ deprecated_function(Line, M, F, As, St) -> add_warning(Line, {deprecated, MFA, Replacement, Rel}, St) end; {removed, String} when is_list(String) -> - add_warning(Line, {removed, MFA, String}, St); + add_removed_warning(Line, MFA, {removed, MFA, String}, St); {removed, Replacement, Rel} -> - add_warning(Line, {removed, MFA, Replacement, Rel}, St); + add_removed_warning(Line, MFA, {removed, MFA, Replacement, Rel}, St); no -> St end. +add_removed_warning(Line, {M, _, _}=MFA, Warning, #lint{not_removed=NotRemoved}=St) -> + case is_warn_enabled(removed, St) andalso + not gb_sets:is_element(M, NotRemoved) andalso + not gb_sets:is_element(MFA, NotRemoved) of + true -> + add_warning(Line, Warning, St); + false -> + St + end. + -dialyzer({no_match, deprecated_type/5}). deprecated_type(L, M, N, As, St) -> diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index ada3ff5de3..255c0ae81f 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -26,7 +26,7 @@ attribute/1,attribute/2,function/1,function/2, guard/1,guard/2,exprs/1,exprs/2,exprs/3,expr/1,expr/2,expr/3,expr/4]). --import(lists, [append/1,foldr/3,mapfoldl/3,reverse/1,reverse/2]). +-import(lists, [append/1,foldr/3,map/2,mapfoldl/3,reverse/1,reverse/2]). -import(io_lib, [write/1,format/2]). -import(erl_parse, [inop_prec/1,preop_prec/1,func_prec/0,max_prec/0, type_inop_prec/1, type_preop_prec/1]). @@ -41,10 +41,11 @@ io_lib:chars())). -type(option() :: {hook, hook_function()} - | {encoding, latin1 | unicode | utf8}). + | {encoding, latin1 | unicode | utf8} + | {quote_singleton_atom_types, boolean()}). -type(options() :: hook_function() | [option()]). --record(pp, {value_fun, string_fun, char_fun}). +-record(pp, {value_fun, singleton_atom_type_fun, string_fun, char_fun}). -record(options, {hook, encoding, opts}). @@ -206,22 +207,43 @@ options(Hook) -> #options{hook = Hook, encoding = encoding([]), opts = Hook}. state(Options) when is_list(Options) -> + Quote = proplists:get_bool(quote_singleton_atom_types, Options), case encoding(Options) of - latin1 -> state(); - unicode -> unicode_state() + latin1 -> latin1_state(Quote); + unicode -> unicode_state(Quote) end; state(_Hook) -> - state(). + latin1_state(false). -state() -> +latin1_state(Quote) -> Options = [{encoding,latin1}], - #pp{value_fun = fun(V) -> io_lib_pretty:print(V, Options) end, + ValueFun = fun(V) -> io_lib_pretty:print(V, Options) end, + SingletonFun = + case Quote of + true -> + fun(A) -> + io_lib:write_string_as_latin1(atom_to_list(A), $') + end; %' + false -> + ValueFun + end, + #pp{value_fun = ValueFun, + singleton_atom_type_fun = SingletonFun, string_fun = fun io_lib:write_string_as_latin1/1, char_fun = fun io_lib:write_char_as_latin1/1}. -unicode_state() -> +unicode_state(Quote) -> Options = [{encoding,unicode}], - #pp{value_fun = fun(V) -> io_lib_pretty:print(V, Options) end, + ValueFun = fun(V) -> io_lib_pretty:print(V, Options) end, + SingletonFun = + case Quote of + true -> + fun(A) -> io_lib:write_string(atom_to_list(A), $') end; %' + false -> + ValueFun + end, + #pp{value_fun = ValueFun, + singleton_atom_type_fun = SingletonFun, string_fun = fun io_lib:write_string/1, char_fun = fun io_lib:write_char/1}. @@ -350,7 +372,7 @@ ltype({user_type,Line,T,Ts}, _) -> ltype({remote_type,Line,[M,F,Ts]}, _) -> simple_type({remote,Line,M,F}, Ts); ltype({atom,_,T}, _) -> - {atom,T}; + {singleton_atom_type,T}; ltype(E, P) -> lexpr(E, P, options(none)). @@ -360,7 +382,12 @@ binary_type(I1, I2) -> P = max_prec(), E1 = [[leaf("_:"),lexpr(I1, P, options(none))] || B], E2 = [[leaf("_:_*"),lexpr(I2, P, options(none))] || U], - {seq,'<<','>>',[$,],E1++E2}. + case E1++E2 of + [] -> + leaf("<<>>"); + Es -> + {seq,'<<','>>',[$,],Es} + end. map_type(Fs) -> {first,[$#],map_pair_types(Fs)}. @@ -386,6 +413,8 @@ typed(B, Type) -> {_L,_P,R} = type_inop_prec('::'), {list,[{cstep,[B,' ::'],ltype(Type, R)}]}. +tuple_type([], _) -> + leaf("{}"); tuple_type(Ts, F) -> {seq,${,$},[$,],ltypes(Ts, F, 0)}. @@ -454,7 +483,7 @@ pname(A) when is_atom(A) -> write(A). falist([]) -> - [leaf("[]")]; + ['[]']; falist(Falist) -> L = [begin {Name,Arity} = Fa, @@ -562,22 +591,22 @@ lexpr({map, _, Map, Fs}, Prec, Opts) -> El = {first,[Rl,$#],map_fields(Fs, Opts)}, maybe_paren(P, Prec, El); lexpr({block,_,Es}, _, Opts) -> - {list,[{step,'begin',body(Es, Opts)},'end']}; + {list,[{step,'begin',body(Es, Opts)},{reserved,'end'}]}; lexpr({'if',_,Cs}, _, Opts) -> - {list,[{step,'if',if_clauses(Cs, Opts)},'end']}; + {list,[{step,'if',if_clauses(Cs, Opts)},{reserved,'end'}]}; lexpr({'case',_,Expr,Cs}, _, Opts) -> - {list,[{step,{list,[{step,'case',lexpr(Expr, Opts)},'of']}, + {list,[{step,{list,[{step,'case',lexpr(Expr, Opts)},{reserved,'of'}]}, cr_clauses(Cs, Opts)}, - 'end']}; + {reserved,'end'}]}; lexpr({'cond',_,Cs}, _, Opts) -> - {list,[{step,leaf("cond"),cond_clauses(Cs, Opts)},'end']}; + {list,[{step,leaf("cond"),cond_clauses(Cs, Opts)},{reserved,'end'}]}; lexpr({'receive',_,Cs}, _, Opts) -> - {list,[{step,'receive',cr_clauses(Cs, Opts)},'end']}; + {list,[{step,'receive',cr_clauses(Cs, Opts)},{reserved,'end'}]}; lexpr({'receive',_,Cs,To,ToOpt}, _, Opts) -> Al = {list,[{step,[lexpr(To, Opts),' ->'],body(ToOpt, Opts)}]}, {list,[{step,'receive',cr_clauses(Cs, Opts)}, {step,'after',Al}, - 'end']}; + {reserved,'end'}]}; lexpr({'fun',_,{function,F,A}}, _Prec, _Opts) -> [leaf("fun "),{atom,F},leaf(format("/~w", [A]))]; lexpr({'fun',L,{function,_,_}=Func,Extra}, Prec, Opts) -> @@ -596,15 +625,17 @@ lexpr({'fun',_,{function,M,F,A}}, _Prec, Opts) -> ArityItem = lexpr(A, Opts), ["fun ",NameItem,$:,CallItem,$/,ArityItem]; lexpr({'fun',_,{clauses,Cs}}, _Prec, Opts) -> - {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},'end']}; + {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},{reserved,'end'}]}; lexpr({named_fun,_,Name,Cs}, _Prec, Opts) -> - {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}; + {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})}, + {reserved,'end'}]}; lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Opts) -> {force_nl,fun_info(Extra), - {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},'end']}}; + {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},{reserved,'end'}]}}; lexpr({named_fun,_,Name,Cs,Extra}, _Prec, Opts) -> {force_nl,fun_info(Extra), - {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}}; + {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})}, + {reserved,'end'}]}}; lexpr({call,_,{remote,_,{atom,_,M},{atom,_,F}=N}=Name,Args}, Prec, Opts) -> case erl_internal:bif(M, F, length(Args)) of true -> @@ -619,7 +650,7 @@ lexpr({'try',_,Es,Scs,Ccs,As}, _, Opts) -> Scs =:= [] -> {step,'try',body(Es, Opts)}; true -> - {step,{list,[{step,'try',body(Es, Opts)},'of']}, + {step,{list,[{step,'try',body(Es, Opts)},{reserved,'of'}]}, cr_clauses(Scs, Opts)} end, if @@ -634,7 +665,7 @@ lexpr({'try',_,Es,Scs,Ccs,As}, _, Opts) -> true -> {step,'after',body(As, Opts)} end, - 'end']}; + {reserved,'end'}]}; lexpr({'catch',_,Expr}, Prec, Opts) -> {P,R} = preop_prec('catch'), El = {list,[{step,'catch',lexpr(Expr, R, Opts)}]}, @@ -647,7 +678,7 @@ lexpr({match,_,Lhs,Rhs}, Prec, Opts) -> maybe_paren(P, Prec, El); lexpr({op,_,Op,Arg}, Prec, Opts) -> {P,R} = preop_prec(Op), - Ol = leaf(format("~s ", [Op])), + Ol = {reserved, leaf(format("~s ", [Op]))}, El = [Ol,lexpr(Arg, R, Opts)], maybe_paren(P, Prec, El); lexpr({op,_,Op,Larg,Rarg}, Prec, Opts) when Op =:= 'orelse'; @@ -655,14 +686,14 @@ lexpr({op,_,Op,Larg,Rarg}, Prec, Opts) when Op =:= 'orelse'; %% Breaks lines since R12B. {L,P,R} = inop_prec(Op), Ll = lexpr(Larg, L, Opts), - Ol = leaf(format("~s", [Op])), + Ol = {reserved, leaf(format("~s", [Op]))}, Lr = lexpr(Rarg, R, Opts), El = {prefer_nl,[[]],[Ll,Ol,Lr]}, maybe_paren(P, Prec, El); lexpr({op,_,Op,Larg,Rarg}, Prec, Opts) -> {L,P,R} = inop_prec(Op), Ll = lexpr(Larg, L, Opts), - Ol = leaf(format("~s", [Op])), + Ol = {reserved, leaf(format("~s", [Op]))}, Lr = lexpr(Rarg, R, Opts), El = {list,[Ll,Ol,Lr]}, maybe_paren(P, Prec, El); @@ -882,16 +913,18 @@ lc_qual(Q, Opts) -> lexpr(Q, 0, Opts). proper_list(Es, Opts) -> - {seq,$[,$],$,,lexprs(Es, Opts)}. + {seq,$[,$],[$,],lexprs(Es, Opts)}. improper_list(Es, Opts) -> - {seq,$[,$],{$,,$|},lexprs(Es, Opts)}. + {seq,$[,$],[{$,,' |'}],lexprs(Es, Opts)}. tuple(L, Opts) -> tuple(L, fun lexpr/2, Opts). +tuple([], _F, _Opts) -> + leaf("{}"); tuple(Es, F, Opts) -> - {seq,${,$},$,,lexprs(Es, F, Opts)}. + {seq,${,$},[$,],lexprs(Es, F, Opts)}. args(As, Opts) -> {seq,$(,$),[$,],lexprs(As, Opts)}. @@ -939,6 +972,7 @@ frmt(Item, I, PP) -> %%% - {prefer_nl,Sep,IPs}: forces linebreak between Is unlesss negative %%% indentation. %%% - {atom,A}: an atom +%%% - {singleton_atom_type,A}: an singleton atom type %%% - {char,C}: a character %%% - {string,S}: a string. %%% - {value,T}: a term. @@ -983,8 +1017,10 @@ f({seq,Before,After,Sep,LItems}, I0, ST, WT, PP) -> end, {BCharsL++Chars,Size}; no -> - {BCharsL++insert_newlines(CharsSizeL, I, ST), - nsz(lists:last(Sizes), I0)} + CharsList = handle_step(CharsSizeL, I, ST), + {LChars, LSize} = + maybe_newlines(CharsList, LItems, I, NSepChars, ST), + {[BCharsL,LChars],nsz(LSize, I0)} end; f({force_nl,_ExtraInfoItem,Item}, I, ST, WT, PP) when I < 0 -> %% Extra info is a comment; cannot have that on the same line @@ -1000,23 +1036,28 @@ f({prefer_nl,Sep,LItems}, I0, ST, WT, PP) -> Sizes =:= [] -> {[], 0}; true -> - {insert_newlines(CharsSize2L, I0, ST),nsz(lists:last(Sizes), I0)} + {insert_newlines(CharsSize2L, I0, ST), + nsz(lists:last(Sizes), I0)} end; f({value,V}, I, ST, WT, PP) -> f(write_a_value(V, PP), I, ST, WT, PP); f({atom,A}, I, ST, WT, PP) -> f(write_an_atom(A, PP), I, ST, WT, PP); +f({singleton_atom_type,A}, I, ST, WT, PP) -> + f(write_a_singleton_atom_type(A, PP), I, ST, WT, PP); f({char,C}, I, ST, WT, PP) -> f(write_a_char(C, PP), I, ST, WT, PP); f({string,S}, I, ST, WT, PP) -> f(write_a_string(S, I, PP), I, ST, WT, PP); +f({reserved,R}, I, ST, WT, PP) -> + f(R, I, ST, WT, PP); f({hook,HookExpr,Precedence,Func,Options}, I, _ST, _WT, _PP) -> Chars = Func(HookExpr, I, Precedence, Options), {Chars,indentation(Chars, I)}; f({ehook,HookExpr,Precedence,{Mod,Func,Eas}=ModFuncEas}, I, _ST, _WT, _PP) -> Chars = apply(Mod, Func, [HookExpr,I,Precedence,ModFuncEas|Eas]), {Chars,indentation(Chars, I)}; -f(WordName, _I, _ST, WT, _PP) -> % when is_atom(WordName) +f(WordName, _I, _ST, WT, _PP) when is_atom(WordName) -> word(WordName, WT). -define(IND, 4). @@ -1038,12 +1079,18 @@ fl(CItems, Sep0, I0, After, ST, WT, PP) -> true -> [CharSize1,f([Item2,S], incr(I0, ?IND), ST, WT, PP)] end; + ({reserved,Word}, S) -> + [f([Word,S], I0, ST, WT, PP),{[],0}]; (Item, S) -> [f([Item,S], I0, ST, WT, PP),{[],0}] end, - {Sep,LastSep} = case Sep0 of {_,_} -> Sep0; _ -> {Sep0,Sep0} end, + {Sep,LastSep} = sep(Sep0), fl1(CItems, F, Sep, LastSep, After). +sep([{S,LS}]) -> {[S],[LS]}; +sep({_,_}=Sep) -> Sep; +sep(S) -> {S, S}. + fl1([CItem], F, _Sep, _LastSep, After) -> [F(CItem,After)]; fl1([CItem1,CItem2], F, _Sep, LastSep, After) -> @@ -1069,20 +1116,64 @@ unz1(CharSizes) -> nonzero(CharSizes) -> lists:filter(fun({_,Sz}) -> Sz =/= 0 end, CharSizes). -insert_newlines(CharsSizesL, I, ST) when I >= 0 -> - insert_nl(foldr(fun([{_C1,0},{_C2,0}], A) -> - A; - ([{C1,_Sz1},{_C2,0}], A) -> - [C1|A]; - ([{C1,_Sz1},{C2,Sz2}], A) when Sz2 > 0 -> - [insert_nl([C1,C2], I+?IND, ST)|A] - end, [], CharsSizesL), I, ST). +maybe_newlines([{Chars,Size}], [], _I, _NSepChars, _ST) -> + {Chars,Size}; +maybe_newlines(CharsSizeList, Items, I, NSepChars, ST) when I >= 0 -> + maybe_sep(CharsSizeList, Items, I, NSepChars, nl_indent(I, ST)). + +maybe_sep([{Chars1,Size1}|CharsSizeL], [Item|Items], I0, NSepChars, Sep) -> + I1 = case classify_item(Item) of + atomic -> + I0 + Size1; + _ -> + ?MAXLINE+1 + end, + maybe_sep1(CharsSizeL, Items, I0, I1, Sep, NSepChars, Size1, [Chars1]). + +maybe_sep1([{Chars,Size}|CharsSizeL], [Item|Items], + I0, I, Sep, NSepChars, Sz0, A) -> + case classify_item(Item) of + atomic when is_integer(Size) -> + Size1 = Size + 1, + I1 = I + Size1, + if + I1 =< ?MAXLINE -> + A1 = if + NSepChars > 0 -> [Chars,$\s|A]; + true -> [Chars|A] + end, + maybe_sep1(CharsSizeL, Items, I0, I1, Sep, NSepChars, + Sz0 + Size1, A1); + true -> + A1 = [Chars,Sep|A], + maybe_sep1(CharsSizeL, Items, I0, I0 + Size, Sep, + NSepChars, Size1, A1) + end; + _ -> + A1 = [Chars,Sep|A], + maybe_sep1(CharsSizeL, Items, I0, ?MAXLINE+1, Sep, NSepChars, + 0, A1) + end; +maybe_sep1(_CharsSizeL, _Items, _Io, _I, _Sep, _NSepChars, Sz, A) -> + {lists:reverse(A), Sz}. +insert_newlines(CharsSizesL, I, ST) when I >= 0 -> + {CharsL, _} = unz1(handle_step(CharsSizesL, I, ST)), + insert_nl(CharsL, I, ST). + +handle_step(CharsSizesL, I, ST) -> + map(fun([{_C1,0},{_C2,0}]) -> + {[], 0}; + ([{C1,Sz1},{_C2,0}]) -> + {C1, Sz1}; + ([{C1,Sz1},{C2,Sz2}]) when Sz2 > 0 -> + {insert_nl([C1,C2], I+?IND, ST),line_size([Sz1,Sz2])} + end, CharsSizesL). insert_nl(CharsL, I, ST) -> insert_sep(CharsL, nl_indent(I, ST)). -insert_sep([Chars1 | CharsL], Sep) -> +insert_sep([Chars1|CharsL], Sep) -> [Chars1 | [[Sep,Chars] || Chars <- CharsL]]. nl_indent(0, _T) -> @@ -1090,6 +1181,12 @@ nl_indent(0, _T) -> nl_indent(I, T) when I > 0 -> [$\n|spaces(I, T)]. +classify_item({atom, _}) -> atomic; +classify_item({singleton_atom_type, _}) -> atomic; +classify_item(Atom) when is_atom(Atom) -> atomic; +classify_item({leaf, _, _}) -> atomic; +classify_item(_) -> complex. + same_line(I0, SizeL, NSepChars) -> try Size = lists:sum(SizeL) + NSepChars, @@ -1150,6 +1247,9 @@ write_a_value(V, PP) -> write_an_atom(A, PP) -> flat_leaf(write_atom(A, PP)). +write_a_singleton_atom_type(A, PP) -> + flat_leaf(write_singleton_atom_type(A, PP)). + write_a_char(C, PP) -> flat_leaf(write_char(C, PP)). @@ -1184,6 +1284,9 @@ write_value(V, PP) -> write_atom(A, PP) -> (PP#pp.value_fun)(A). +write_singleton_atom_type(A, PP) -> + (PP#pp.singleton_atom_type_fun)(A). + write_string(S, PP) -> (PP#pp.string_fun)(S). diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl index d8b8f466b1..7064fcacfa 100644 --- a/lib/stdlib/src/erl_tar.erl +++ b/lib/stdlib/src/erl_tar.erl @@ -324,7 +324,7 @@ do_open(Name, Mode) when is_list(Mode) -> open1({binary,Bin}, read, _Raw, Opts) when is_binary(Bin) -> case file:open(Bin, [ram,binary,read]) of {ok,File} -> - _ = [ram_file:uncompress(File) || Opts =:= [compressed]], + _ = [ram_file:uncompress(File) || lists:member(compressed, Opts)], {ok, #reader{handle=File,access=read,func=fun file_op/2}}; Error -> Error @@ -357,7 +357,7 @@ open_mode([read|Rest], false, Raw, Opts) -> open_mode([write|Rest], false, Raw, Opts) -> open_mode(Rest, write, Raw, Opts); open_mode([compressed|Rest], Access, Raw, Opts) -> - open_mode(Rest, Access, Raw, [compressed|Opts]); + open_mode(Rest, Access, Raw, [compressed,read_ahead|Opts]); open_mode([cooked|Rest], Access, _Raw, Opts) -> open_mode(Rest, Access, [], Opts); open_mode([], Access, Raw, Opts) -> diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index b95cb8f525..fa34f19637 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -323,90 +323,6 @@ obsolete_1(snmp, N, A) -> obsolete_1(snmpa, old_info_format, 1) -> {deprecated, "Deprecated; (will be removed in OTP 18); use \"new\" format instead"}; -obsolete_1(snmpm, agent_info, 3) -> - {removed, {snmpm, agent_info, 2}, "R16B"}; -obsolete_1(snmpm, update_agent_info, 5) -> - {removed, {snmpm, update_agent_info, 4}, "R16B"}; -obsolete_1(snmpm, g, 3) -> - {removed, {snmpm, sync_get, 3}, "R16B"}; -obsolete_1(snmpm, g, 4) -> - {removed, {snmpm, sync_get, [3,4]}, "R16B"}; -obsolete_1(snmpm, g, 5) -> - {removed, {snmpm, sync_get, [4,5]}, "R16B"}; -obsolete_1(snmpm, g, 6) -> - {removed, {snmpm, sync_get, [5,6]}, "R16B"}; -obsolete_1(snmpm, g, 7) -> - {removed, {snmpm, sync_get, 6}, "R16B"}; -obsolete_1(snmpm, ag, 3) -> - {removed, {snmpm, async_get, 3}, "R16B"}; -obsolete_1(snmpm, ag, 4) -> - {removed, {snmpm, async_get, [3,4]}, "R16B"}; -obsolete_1(snmpm, ag, 5) -> - {removed, {snmpm, async_get, [4,5]}, "R16B"}; -obsolete_1(snmpm, ag, 6) -> - {removed, {snmpm, async_get, [5,6]}, "R16B"}; -obsolete_1(snmpm, ag, 7) -> - {removed, {snmpm, async_get, 6}, "R16B"}; -obsolete_1(snmpm, gn, 3) -> - {removed, {snmpm, sync_get_next, 3}, "R16B"}; -obsolete_1(snmpm, gn, 4) -> - {removed, {snmpm, sync_get_next, [3,4]}, "R16B"}; -obsolete_1(snmpm, gn, 5) -> - {removed, {snmpm, sync_get_next, [4,5]}, "R16B"}; -obsolete_1(snmpm, gn, 6) -> - {removed, {snmpm, sync_get_next, [5,6]}, "R16B"}; -obsolete_1(snmpm, gn, 7) -> - {removed, {snmpm, sync_get_next, 6}, "R16B"}; -obsolete_1(snmpm, agn, 3) -> - {removed, {snmpm, async_get_next, 3}, "R16B"}; -obsolete_1(snmpm, agn, 4) -> - {removed, {snmpm, async_get_next, [3,4]}, "R16B"}; -obsolete_1(snmpm, agn, 5) -> - {removed, {snmpm, async_get_next, [4,5]}, "R16B"}; -obsolete_1(snmpm, agn, 6) -> - {removed, {snmpm, async_get_next, [5,6]}, "R16B"}; -obsolete_1(snmpm, agn, 7) -> - {removed, {snmpm, async_get_next, 6}, "R16B"}; -obsolete_1(snmpm, s, 3) -> - {removed, {snmpm, sync_set, 3}, "R16B"}; -obsolete_1(snmpm, s, 4) -> - {removed, {snmpm, sync_set, [3,4]}, "R16B"}; -obsolete_1(snmpm, s, 5) -> - {removed, {snmpm, sync_set, [4,5]}, "R16B"}; -obsolete_1(snmpm, s, 6) -> - {removed, {snmpm, sync_set, [5,6]}, "R16B"}; -obsolete_1(snmpm, s, 7) -> - {removed, {snmpm, sync_set, 6}, "R16B"}; -obsolete_1(snmpm, as, 3) -> - {removed, {snmpm, async_set, 3}, "R16B"}; -obsolete_1(snmpm, as, 4) -> - {removed, {snmpm, async_set, [3,4]}, "R16B"}; -obsolete_1(snmpm, as, 5) -> - {removed, {snmpm, async_set, [4,5]}, "R16B"}; -obsolete_1(snmpm, as, 6) -> - {removed, {snmpm, async_set, [5,6]}, "R16B"}; -obsolete_1(snmpm, as, 7) -> - {removed, {snmpm, async_set, 6}, "R16B"}; -obsolete_1(snmpm, gb, 5) -> - {removed, {snmpm, sync_get_bulk, 5}, "R16B"}; -obsolete_1(snmpm, gb, 6) -> - {removed, {snmpm, sync_get_bulk, [5,6]}, "R16B"}; -obsolete_1(snmpm, gb, 7) -> - {removed, {snmpm, sync_get_bulk, [6,7]}, "R16B"}; -obsolete_1(snmpm, gb, 8) -> - {removed, {snmpm, sync_get_bulk, [7,8]}, "R16B"}; -obsolete_1(snmpm, gb, 9) -> - {removed, {snmpm, sync_get_bulk, 8}, "R16B"}; -obsolete_1(snmpm, agb, 5) -> - {removed, {snmpm, async_get_bulk, 5}, "R16B"}; -obsolete_1(snmpm, agb, 6) -> - {removed, {snmpm, async_get_bulk, [5,6]}, "R16B"}; -obsolete_1(snmpm, agb, 7) -> - {removed, {snmpm, async_get_bulk, [6,7]}, "R16B"}; -obsolete_1(snmpm, agb, 8) -> - {removed, {snmpm, async_get_bulk, [7,8]}, "R16B"}; -obsolete_1(snmpm, agb, 9) -> - {removed, {snmpm, async_get_bulk, 8}, "R16B"}; %% *** MEGACO *** @@ -417,6 +333,7 @@ obsolete_1(megaco, format_versions, 1) -> %% *** OS-MON-MIB *** +%% FIXME: Remove this warning in OTP 24. obsolete_1(os_mon_mib, _, _) -> {removed, "was removed in 22.0"}; @@ -431,64 +348,6 @@ obsolete_1(auth, node_cookie, 1) -> obsolete_1(auth, node_cookie, 2) -> {deprecated, "Deprecated; use erlang:set_cookie/2 and net_adm:ping/1 instead"}; -obsolete_1(http, request, 1) -> {removed,{httpc,request,1},"R15B"}; -obsolete_1(http, request, 2) -> {removed,{httpc,request,2},"R15B"}; -obsolete_1(http, request, 4) -> {removed,{httpc,request,4},"R15B"}; -obsolete_1(http, request, 5) -> {removed,{httpc,request,5},"R15B"}; -obsolete_1(http, cancel_request, 1) -> {removed,{httpc,cancel_request,1},"R15B"}; -obsolete_1(http, cancel_request, 2) -> {removed,{httpc,cancel_request,2},"R15B"}; -obsolete_1(http, set_option, 2) -> {removed,{httpc,set_option,2},"R15B"}; -obsolete_1(http, set_option, 3) -> {removed,{httpc,set_option,3},"R15B"}; -obsolete_1(http, set_options, 1) -> {removed,{httpc,set_options,1},"R15B"}; -obsolete_1(http, set_options, 2) -> {removed,{httpc,set_options,2},"R15B"}; -obsolete_1(http, verify_cookies, 2) -> {removed,{httpc,store_cookies,2},"R15B"}; -obsolete_1(http, verify_cookies, 3) -> {removed,{httpc,store_cookies,3},"R15B"}; -obsolete_1(http, cookie_header, 1) -> {removed,{httpc,cookie_header,1},"R15B"}; -obsolete_1(http, cookie_header, 2) -> {removed,{httpc,cookie_header,2},"R15B"}; -obsolete_1(http, stream_next, 1) -> {removed,{httpc,stream_next,1},"R15B"}; -obsolete_1(http, default_profile, 0) -> {removed,{httpc,default_profile,0},"R15B"}; - -%% Added in R13A. -obsolete_1(regexp, _, _) -> - {removed, "removed in R15; use the re module instead"}; - -%% Added in R13B04. -obsolete_1(erlang, concat_binary, 1) -> - {removed,{erlang,list_to_binary,1},"R15B"}; - -%% Added in R14A. -obsolete_1(ssl, peercert, 2) -> - {removed ,"removed in R15A; use ssl:peercert/1 and public_key:pkix_decode_cert/2 instead"}; - -%% Added in R14B. -obsolete_1(public_key, pem_to_der, 1) -> - {removed,"removed in R15A; use file:read_file/1 and public_key:pem_decode/1"}; -obsolete_1(public_key, decode_private_key, A) when A =:= 1; A =:= 2 -> - {removed, "removed in R15A; use public_key:pem_entry_decode/1"}; - -%% Added in R14B03. -obsolete_1(docb_gen, _, _) -> - {removed,"the DocBuilder application was removed in R15B"}; -obsolete_1(docb_transform, _, _) -> - {removed,"the DocBuilder application was removed in R15B"}; -obsolete_1(docb_xml_check, _, _) -> - {removed,"the DocBuilder application was removed in R15B"}; - -%% Added in R15B -obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver -> - {removed,"removed (will be removed in OTP 18); has no effect as drivers are no longer used"}; -obsolete_1(ssl, pid, 1) -> - {removed,"was removed in R16; is no longer needed"}; -obsolete_1(inviso, _, _) -> - {removed,"the inviso application was removed in R16"}; - -%% Added in R15B01. -obsolete_1(ssh, sign_data, 2) -> - {removed,"removed in R16A; use public_key:pem_decode/1, public_key:pem_entry_decode/1 " - "and public_key:sign/3 instead"}; -obsolete_1(ssh, verify_data, 3) -> - {removed,"removed in R16A; use public_key:ssh_decode/1, and public_key:verify/4 instead"}; - %% Added in R16 obsolete_1(wxCalendarCtrl, enableYearChange, _) -> %% wx bug documented? {deprecated,"deprecated function not available in wxWidgets-2.9 and later"}; @@ -609,10 +468,8 @@ obsolete_1(queue, lait, 1) -> %% Removed in OTP 19. -obsolete_1(overload, _, _) -> - {removed, "removed in OTP 19"}; obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 -> - {removed, {rpc, multi_server_call, A}, "removed in OTP 19"}; + {removed, {rpc, multi_server_call, A}, "19.0"}; %% Added in OTP 20. diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index 37ea97c353..08612ed17f 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -41,7 +41,9 @@ {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.7$">>,[restart_new_emulator]}, {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}], + {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.8$">>,[restart_new_emulator]}, + {<<"^3\\.8\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}], [{<<"^3\\.4$">>,[restart_new_emulator]}, {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, @@ -56,4 +58,6 @@ {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, {<<"^3\\.7$">>,[restart_new_emulator]}, {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}, - {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}. + {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}, + {<<"^3\\.8$">>,[restart_new_emulator]}, + {<<"^3\\.8\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index e791da48cf..fe98a3796d 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -2109,11 +2109,32 @@ otp_5362(Config) when is_list(Config) -> {calendar,local_time_to_universal_time_dst,1}, "a future release"}}]}}, {call_removed_function, - <<"t(X) -> regexp:match(X).">>, + <<"t(X) -> erlang:hash(X, 10000).">>, [], {warnings, - [{1,erl_lint,{removed,{regexp,match,1}, - "removed in R15; use the re module instead"}}]}} + [{1,erl_lint,{removed,{erlang,hash,2},{erlang,phash2,2},"20.0"}}]}}, + + {nowarn_call_removed_function_1, + <<"t(X) -> erlang:hash(X, 10000).">>, + [{nowarn_removed,{erlang,hash,2}}], + []}, + + {nowarn_call_removed_function_2, + <<"t(X) -> os_mon_mib:any_function_really(erlang:hash(X, 10000)).">>, + [nowarn_removed], + []}, + + {call_removed_module, + <<"t(X) -> os_mon_mib:any_function_really(X).">>, + [], + {warnings,[{1,erl_lint, + {removed,{os_mon_mib,any_function_really,1}, + "was removed in 22.0"}}]}}, + + {nowarn_call_removed_module, + <<"t(X) -> os_mon_mib:any_function_really(X).">>, + [{nowarn_removed,os_mon_mib}], + []} ], @@ -3555,10 +3576,12 @@ basic_errors(Config) -> {illegal_record_info, <<"f1() -> record_info(42, record). - f2() -> record_info(shoe_size, record).">>, + f2() -> record_info(shoe_size, record). + f3() -> fun record_info/2.">>, [], {errors,[{1,erl_lint,illegal_record_info}, - {2,erl_lint,illegal_record_info}],[]}}, + {2,erl_lint,illegal_record_info}, + {3,erl_lint,illegal_record_info}],[]}}, {illegal_expr, <<"f() -> a:b.">>, diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index f5d80e7e68..3eb1670806 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -47,11 +47,12 @@ hook/1, neg_indent/1, maps_syntax/1, + quoted_atom_types/1, otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1, otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1, otp_10302/1, otp_10820/1, otp_11100/1, otp_11861/1, pr_1014/1, - otp_13662/1, otp_14285/1, otp_15592/1]). + otp_13662/1, otp_14285/1, otp_15592/1, otp_15751/1, otp_15755/1]). %% Internal export. -export([ehook/6]). @@ -74,14 +75,14 @@ groups() -> [{expr, [], [func, call, recs, try_catch, if_then, receive_after, bits, head_tail, cond1, block, case1, ops, - messages, maps_syntax + messages, maps_syntax, quoted_atom_types ]}, {attributes, [], [misc_attrs, import_export, dialyzer_attrs]}, {tickets, [], [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238, otp_8473, otp_8522, otp_8567, otp_8664, otp_9147, otp_10302, otp_10820, otp_11100, otp_11861, pr_1014, otp_13662, - otp_14285, otp_15592]}]. + otp_14285, otp_15592, otp_15751, otp_15755]}]. init_per_suite(Config) -> Config. @@ -473,10 +474,10 @@ cond1(Config) when is_list(Config) -> [{tuple,5,[{atom,5,x},{atom,5,y}]}]}]}, CChars = flat_expr1(C), "cond\n" - " {foo,bar} ->\n" - " [a,b];\n" + " {foo, bar} ->\n" + " [a, b];\n" " true ->\n" - " {x,y}\n" + " {x, y}\n" "end" = CChars, ok. @@ -711,7 +712,7 @@ otp_6321(Config) when is_list(Config) -> Str = "S = hopp, {hej, S}. ", {done, {ok, Tokens, _EndLine}, ""} = erl_scan:tokens("", Str, _L=1), {ok, Exprs} = erl_parse:parse_exprs(Tokens), - "S = hopp, {hej,S}" = lists:flatten(erl_pp:exprs(Exprs)), + "S = hopp, {hej, S}" = lists:flatten(erl_pp:exprs(Exprs)), ok. %% OTP_6911. More newlines. @@ -912,6 +913,21 @@ maps_syntax(Config) when is_list(Config) -> ok = pp_forms(F), ok. +quoted_atom_types(Config) when is_list(Config) -> + Q = [{quote_singleton_atom_types, true}], + U = [{encoding,unicode}], + L = [{encoding,latin1}], + F = "-type t() :: a | a().", + "-type t() :: 'a' | a().\n" = + lists:flatten(parse_and_pp_forms(F, Q ++ L)), + "-type t() :: 'a' | a().\n" = + lists:flatten(parse_and_pp_forms(F, Q ++ U)), + UF = "-type t() :: '\x{400}' | '\x{400}'().", + "-type t() :: '\\x{400}' | '\\x{400}'().\n" = + lists:flatten(parse_and_pp_forms(UF, Q ++ L)), + "-type t() :: '\x{400}' | '\x{400}'().\n" = + lists:flatten(parse_and_pp_forms(UF, Q ++ U)), + ok. %% OTP_8567. Avoid duplicated 'undefined' in record field types. otp_8567(Config) when is_list(Config) -> @@ -1096,7 +1112,7 @@ otp_11861(Config) when is_list(Config) -> A3 = erl_anno:new(3), "-optional_callbacks([bar/0]).\n" = pf({attribute,A3,optional_callbacks,[{bar,0}]}), - "-optional_callbacks([{bar,1,bad}]).\n" = + "-optional_callbacks([{bar, 1, bad}]).\n" = pf({attribute,A3,optional_callbacks,[{bar,1,bad}]}), ok. @@ -1172,6 +1188,79 @@ otp_15592(_Config) -> "56789012345678901234:f(<<>>)">>), ok. +otp_15751(_Config) -> + ok = pp_expr(<<"try foo:bar() + catch + Reason : Stacktrace -> + {Reason, Stacktrace} + end">>), + ok = pp_expr(<<"try foo:bar() + catch + throw: Reason : Stacktrace -> + {Reason, Stacktrace} + end">>), + ok = pp_expr(<<"try foo:bar() + catch + Reason : _ -> + Reason + end">>), + ok = pp_expr(<<"try foo:bar() + catch + throw: Reason : _ -> + Reason + end">>), + ok = pp_expr(<<"try foo:bar() + catch + Reason -> + Reason + end">>), + ok = pp_expr(<<"try foo:bar() + catch + throw: Reason -> + Reason + end">>), + ok. + +otp_15755(_Config) -> + "[{a, b}, c, {d, e} | t]" = + flat_parse_and_pp_expr("[{a, b}, c, {d, e} | t]", 0, []), + "[{a, b},\n c, d,\n {d, e},\n 1, 2.0,\n {d, e},\n <<>>, {},\n {d, e},\n" + " [], [],\n {d, e} |\n t]" = + flat_parse_and_pp_expr("[{a,b},c,d,{d,e},1,2.0,{d,e},<<>>," + "{},{d,e},[],[],{d,e}|t]", 0, []), + "[{a, b},\n c, d,\n {d, e},\n 1, 2.0,\n {d, e},\n <<>>, {},\n {d, e},\n" + " [], [], d, e | t]" = + flat_parse_and_pp_expr("[{a,b},c,d,{d,e},1,2.0,{d,e},<<>>," + "{},{d,e},[],[],d,e|t]", 0, []), + + "-type t() :: + a | b | c | a | b | a | b | a | b | a | b | a | b | a | b | + a | b | a | b | a | b.\n" = + lists:flatten(parse_and_pp_forms( + "-type t() :: a | b | c| a | b | a | b | a | b | a |" + " b | a | b | a | b | a | b | a | b |a | b.", [])), + + "-type t() :: + {dict, 0, 16, 16, 8, 80, 48, + {[], [], [], [], [], [], [], [], [], [], [], [], [], [], [], + []}, + {{[], [], [], [], [], [], [], [], [], [], [], [], [], [], []}}}.\n" = + lists:flatten(parse_and_pp_forms( + "-type t() :: {dict,0,16,16,8,80,48," + "{[],[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]}," + "{{[],[],[],[],[],[],[],[],[],[],[],[],[],[],[]}}}.", [])), + + "-type t() :: + {{a}, + 0, 16, + {16}, + 8, 80, 48, a, b, e, f, 'sf s sdf', [], {}, + {[]}}.\n" = + lists:flatten(parse_and_pp_forms( + "-type t() :: {{a}, 0, 16, {16}, 8, 80, 48, a, b, e, f," + " 'sf s sdf', [], {}, {[]}}.", [])), + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% compile(Config, Tests) -> @@ -1303,6 +1392,9 @@ pp_expr(List, Options) when is_list(List) -> not_ok end. +flat_parse_and_pp_expr(String, Indent, Options) -> + lists:flatten(parse_and_pp_expr(String, Indent, Options)). + parse_and_pp_expr(String, Indent, Options) -> StringDot = lists:flatten(String) ++ ".", erl_pp:expr(parse_expr(StringDot), Indent, Options). diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 87ca9bd32c..dd49288417 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -24,7 +24,7 @@ -export([default/1,setbag/1,badnew/1,verybadnew/1,named/1,keypos2/1, privacy/1]). -export([empty/1,badinsert/1]). --export([time_lookup/1,badlookup/1,lookup_order/1]). +-export([badlookup/1,lookup_order/1]). -export([delete_elem/1,delete_tab/1,delete_large_tab/1, delete_large_named_table/1, evil_delete/1,baddelete/1,match_delete/1,table_leak/1]). @@ -42,6 +42,8 @@ select_bound_chunk/1, t_delete_all_objects/1, t_insert_list/1, t_test_ms/1, t_select_delete/1,t_select_replace/1,t_select_replace_next_bug/1,t_ets_dets/1]). +-export([test_table_size_concurrency/1,test_table_memory_concurrency/1, + test_delete_table_while_size_snapshot/1, test_delete_table_while_size_snapshot_helper/0]). -export([ordered/1, ordered_match/1, interface_equality/1, fixtable_next/1, fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1, @@ -156,14 +158,18 @@ all() -> whereis_table, delete_unfix_race, test_throughput_benchmark, - {group, benchmark}]. + {group, benchmark}, + test_table_size_concurrency, + test_table_memory_concurrency, + test_delete_table_while_size_snapshot]. + groups() -> [{new, [], [default, setbag, badnew, verybadnew, named, keypos2, privacy]}, {insert, [], [empty, badinsert]}, - {lookup, [], [time_lookup, badlookup, lookup_order]}, + {lookup, [], [badlookup, lookup_order]}, {lookup_element, [], [lookup_element_mult]}, {delete, [], [delete_elem, delete_tab, delete_large_tab, @@ -828,7 +834,11 @@ adjust_xmem([_T1,_T2,_T3,_T4], {A0,B0,C0,D0} = _Mem0, EstCnt) -> {TabSz, EstSz} = erts_debug:get_internal_state('DbTable_words'), HTabSz = TabSz + EstCnt*EstSz, - {A0+TabSz, B0+HTabSz, C0+HTabSz, D0+HTabSz}. + OrdSetExtra = case erlang:system_info(wordsize) of + 8 -> 40; % larger stack on 64 bit architectures + _ -> 0 + end, + {A0+TabSz+OrdSetExtra, B0+HTabSz, C0+HTabSz, D0+HTabSz}. %% Misc. whitebox tests t_whitebox(Config) when is_list(Config) -> @@ -3384,31 +3394,6 @@ badinsert_do(Opts) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Test lookup timing. -time_lookup(Config) when is_list(Config) -> - %% just for timing, really - EtsMem = etsmem(), - Values = repeat_for_opts_all_table_types(fun time_lookup_do/1), - verify_etsmem(EtsMem), - {comment,lists:flatten(io_lib:format( - "~p ets lookups/s",[Values]))}. - -time_lookup_do(Opts) -> - Tab = ets_new(foo,Opts), - fill_tab(Tab,foo), - ets:insert(Tab,{{a,key},foo}), - N = 100000, - {Time,_} = timer:tc(fun() -> time_lookup_many(N, Tab) end), - Seconds = Time / 1000000, - true = ets:delete(Tab), - round(N / Seconds). % lookups/s - -time_lookup_many(0, _Tab) -> - ok; -time_lookup_many(N, Tab) -> - ets:lookup(Tab, {a,key}), - time_lookup_many(N-1, Tab). - %% Check proper return values from bad lookups in existing/non existing %% ets tables. badlookup(Config) when is_list(Config) -> @@ -4102,6 +4087,11 @@ slot_do(Opts) -> fill_tab(Tab,foo), Elts = ets:info(Tab,size), Elts = slot_loop(Tab,0,0), + case ets:info(Tab, type) of + ordered_set -> + '$end_of_table' = ets:slot(Tab,Elts); + _ -> ok + end, true = ets:delete(Tab), verify_etsmem(EtsMem). @@ -4453,6 +4443,131 @@ info_do(Opts) -> undefined = ets:info(non_existing_table_xxyy,safe_fixed), verify_etsmem(EtsMem). +size_loop(_T, 0, _, _) -> + ok; +size_loop(T, I, PrevSize, WhatToTest) -> + Size = ets:info(T, WhatToTest), + case Size < PrevSize of + true -> ct:fail("Bad ets:info/2"); + _ -> ok + end, + size_loop(T, I -1, Size, WhatToTest). + +add_loop(_T, 0) -> + ok; +add_loop(T, I) -> + ets:insert(T, {I}), + add_loop(T, I -1). + + +test_table_counter_concurrency(WhatToTest) -> + IntStatePrevOn = + erts_debug:set_internal_state(available_internal_state, true), + ItemsToAdd = 1000000, + SizeLoopSize = 1000, + T = ets:new(k, [public, ordered_set, {write_concurrency, true}]), + erts_debug:set_internal_state(ets_debug_random_split_join, {T, false}), + 0 = ets:info(T, size), + P = self(), + SpawnedSizeProcs = + [spawn_link(fun() -> + size_loop(T, SizeLoopSize, 0, WhatToTest), + P ! done + end) + || _ <- lists:seq(1, 6)], + spawn_link(fun() -> + add_loop(T, ItemsToAdd), + P ! done_add + end), + [receive + done -> ok; + done_add -> ok + end + || _ <- [ok|SpawnedSizeProcs]], + case WhatToTest =:= size of + true -> + ItemsToAdd = ets:info(T, size); + _ -> + ok + end, + erts_debug:set_internal_state(available_internal_state, IntStatePrevOn), + ok. + +test_table_size_concurrency(Config) when is_list(Config) -> + test_table_counter_concurrency(size). + +test_table_memory_concurrency(Config) when is_list(Config) -> + test_table_counter_concurrency(memory). + +%% Tests that calling the ets:delete operation on a table T with +%% decentralized counters works while ets:info(T, size) operations are +%% active +test_delete_table_while_size_snapshot(Config) when is_list(Config) -> + %% Run test case in a slave node as other test suites in stdlib + %% depend on that pids are ordered in creation order which is no + %% longer the case when many processes have been started before + Node = start_slave(), + ok = rpc:call(Node, ?MODULE, test_delete_table_while_size_snapshot_helper, []), + test_server:stop_node(Node), + ok. + +test_delete_table_while_size_snapshot_helper()-> + TopParent = self(), + repeat_par( + fun() -> + Table = ets:new(t, [public, ordered_set, + {write_concurrency, true}]), + Parent = self(), + NrOfSizeProcs = 100, + Pids = [ spawn(fun()-> size_process(Table, Parent) end) + || _ <- lists:seq(1, NrOfSizeProcs)], + timer:sleep(1), + ets:delete(Table), + [receive + table_gone -> ok; + Problem -> TopParent ! Problem + end || _ <- Pids] + end, + 15000), + receive + Problem -> throw(Problem) + after 0 -> ok + end. + +size_process(Table, Parent) -> + try ets:info(Table, size) of + N when is_integer(N) -> + size_process(Table, Parent); + undefined -> Parent ! table_gone; + E -> Parent ! {got_unexpected, E} + catch + E -> Parent ! {got_unexpected_exception, E} + end. + +start_slave() -> + MicroSecs = erlang:monotonic_time(), + Name = "ets_" ++ integer_to_list(MicroSecs), + Pa = filename:dirname(code:which(?MODULE)), + {ok, Node} = test_server:start_node(list_to_atom(Name), slave, [{args, "-pa " ++ Pa}]), + Node. + +repeat_par(FunToRepeat, NrOfTimes) -> + repeat_par_help(FunToRepeat, NrOfTimes, NrOfTimes). + +repeat_par_help(_FunToRepeat, 0, OrgNrOfTimes) -> + repeat(fun()-> receive done -> ok end end, OrgNrOfTimes); +repeat_par_help(FunToRepeat, NrOfTimes, OrgNrOfTimes) -> + Parent = self(), + case NrOfTimes rem 5 of + 0 -> timer:sleep(1); + _ -> ok + end, + spawn(fun()-> + FunToRepeat(), + Parent ! done + end), + repeat_par_help(FunToRepeat, NrOfTimes-1, OrgNrOfTimes). + %% Test various duplicate_bags stuff. dups(Config) when is_list(Config) -> repeat_for_opts(fun dups_do/1). diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 2354a08f78..8a43f15d2c 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2018. All Rights Reserved. +%% Copyright Ericsson AB 2004-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -2436,7 +2436,7 @@ info(Config) when is_list(Config) -> <<"{'EXIT', {badarg, _}} = (catch qlc:info([X || {X} <- []], {n_elements, 0})), L = lists:seq(1, 1000), - \"[1,2,3,4,5,6,7,8,9,10|'...']\" = qlc:info(L, {n_elements, 10}), + \"[1, 2, 3, 4, 5, 6, 7, 8, 9, 10 | '...']\" = qlc:info(L, {n_elements, 10}), {cons,A1,{integer,A2,1},{atom,A3,'...'}} = qlc:info(L, [{n_elements, 1},{format,abstract_code}]), 1 = erl_anno:line(A1), @@ -2447,8 +2447,8 @@ info(Config) when is_list(Config) -> {atom,_,'...'}}}}, {call,_,_,_}]} = qlc:info(Q, [{n_elements, 3},{format,abstract_code}]), - \"ets:match_spec_run([a,b,c,d,e,f],\n\" - \" ets:match_spec_compile([{'$1',[true],\" + \"ets:match_spec_run([a, b, c, d, e, f],\n\" + \" ets:match_spec_compile([{'$1', [true], \" \"[{{'$1'}}]}]))\" = qlc:info(Q, [{n_elements, infinity}])">>, @@ -6547,7 +6547,7 @@ otp_7114(Config) when is_list(Config) -> otp_7232(Config) when is_list(Config) -> Ts = [<<"L = [fun math:sqrt/1, list_to_pid(\"<0.4.1>\"), erlang:make_ref()], - \"[fun math:sqrt/1,<0.4.1>,#Ref<\" ++ _ = qlc:info(L), + \"[fun math:sqrt/1, <0.4.1>, #Ref<\" ++ _ = qlc:info(L), {call,_, {remote,_,{atom,_,qlc},{atom,_,sort}}, [{cons,_, @@ -6563,7 +6563,7 @@ otp_7232(Config) when is_list(Config) -> \"qlc:sort([55296,56296],[{order,fun'-function/0-fun-2-'/2}])\" = format_info(Q, true), AC = qlc:info(Q, {format, abstract_code}), - \"qlc:sort([55296,56296], [{order,fun '-function/0-fun-2-'/2}])\" = + \"qlc:sort([55296, 56296], [{order, fun '-function/0-fun-2-'/2}])\" = binary_to_list(iolist_to_binary(erl_pp:expr(AC)))">>, %% OTP-7234. erl_parse:abstract() handles bit strings @@ -7088,21 +7088,21 @@ manpage(Config) when is_list(Config) -> \" V1 =\n\" \" qlc:q([ \n\" \" SQV ||\n\" - \" SQV <- [x,y]\n\" + \" SQV <- [x, y]\n\" \" ],\n\" - \" [{unique,true}]),\n\" + \" [{unique, true}]),\n\" \" V2 =\n\" \" qlc:q([ \n\" \" SQV ||\n\" - \" SQV <- [a,b]\n\" + \" SQV <- [a, b]\n\" \" ],\n\" - \" [{unique,true}]),\n\" + \" [{unique, true}]),\n\" \" qlc:q([ \n\" - \" {X,Y} ||\n\" + \" {X, Y} ||\n\" \" X <- V1,\n\" \" Y <- V2\n\" \" ],\n\" - \" [{unique,true}])\n\" + \" [{unique, true}])\n\" \"end\", true = B =:= qlc:info(QH, unique_all)">>, @@ -7118,19 +7118,19 @@ manpage(Config) when is_list(Config) -> \" V1 =\n\" \" qlc:q([ \n\" \" P0 ||\n\" - \" P0 = {W,Y} <- ets:table(_)\n\" + \" P0 = {W, Y} <- ets:table(_)\n\" \" ]),\n\" \" V2 =\n\" \" qlc:q([ \n\" - \" [G1|G2] ||\n\" + \" [G1 | G2] ||\n\" \" G2 <- V1,\n\" \" G1 <- ets:table(_),\n\" \" element(2, G1) =:= element(1, G2)\n\" \" ],\n\" - \" [{join,lookup}]),\n\" + \" [{join, lookup}]),\n\" \" qlc:q([ \n\" - \" {X,Z,W} ||\n\" - \" [{X,Z}|{W,Y}] <- V2\n\" + \" {X, Z, W} ||\n\" + \" [{X, Z} | {W, Y}] <- V2\n\" \" ])\n\" \"end\", Info1 = @@ -7155,25 +7155,28 @@ manpage(Config) when is_list(Config) -> \" V1 =\n\" \" qlc:q([ \n\" \" P0 ||\n\" - \" P0 = {X,Z} <- qlc:keysort(1, [{a,1},{b,4},{c,6}], [])\n\" + \" P0 = {X, Z} <-\n\" + \" qlc:keysort(1, [{a, 1}, {b, 4}, {c, 6}], [])\n\" \" ]),\n\" \" V2 =\n\" \" qlc:q([ \n\" \" P0 ||\n\" - \" P0 = {W,Y} <- qlc:keysort(2, [{2,a},{3,b},{4,c}], [])\n\" + \" P0 = {W, Y} <-\n\" + \" qlc:keysort(2, [{2, a}, {3, b}, {4, c}], [])\n\" + \" ]),\n\" \" V3 =\n\" \" qlc:q([ \n\" - \" [G1|G2] ||\n\" + \" [G1 | G2] ||\n\" \" G1 <- V1,\n\" \" G2 <- V2,\n\" \" element(1, G1) == element(2, G2)\n\" \" ],\n\" - \" [{join,merge},{cache,list}]),\n\" + \" [{join, merge}, {cache, list}]),\n\" \" qlc:q([ \n\" - \" {A,X,Z,W} ||\n\" - \" A <- [a,b,c],\n\" - \" [{X,Z}|{W,Y}] <- V3,\n\" + \" {A, X, Z, W} ||\n\" + \" A <- [a, b, c],\n\" + \" [{X, Z} | {W, Y}] <- V3,\n\" \" X =:= Y\n\" \" ])\n\" \"end\", @@ -7215,14 +7218,21 @@ manpage(Config) when is_list(Config) -> gb_trees:lookup(K, gb_trees:from_orddict([])) of - {value,V} -> - [{K,V}]; + {value, V} -> + [{K, V}]; none -> [] end end, - [{1,a},{1,b},{1,c},{2,a},{2,b},{2,c}]), - ets:match_spec_compile([{{{'$1','$2'},'_'},[],['$1']}]))\", + [{1, a}, + {1, b}, + {1, c}, + {2, a}, + {2, b}, + {2, c}]), + ets:match_spec_compile([{{{'$1', '$2'}, '_'}, + [], + ['$1']}]))\", L = qlc:info(QH)">> ], run(Config, Ts), diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 22136d687c..cdb6031b07 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2018. All Rights Reserved. +%% Copyright Ericsson AB 2004-2019. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -2591,7 +2591,7 @@ otp_7184(Config) when is_list(Config) -> otp_7232(Config) when is_list(Config) -> Info = <<"qlc:info(qlc:sort(qlc:q([X || X <- [55296,56296]]), " "{order, fun(A,B)-> A>B end})).">>, - "qlc:sort([55296,56296],\n" + "qlc:sort([55296, 56296],\n" " [{order,\n" " fun(A, B) ->\n" " A > B\n" @@ -2752,7 +2752,7 @@ otp_10302(Config) when is_list(Config) -> h().">>, "ok.\n\"\x{400}\"\nA = \"\x{400}\".\nok.\n" - "1: io:setopts([{encoding,utf8}])\n-> ok.\n" + "1: io:setopts([{encoding, utf8}])\n-> ok.\n" "2: A = [1024] = \"\x{400}\"\n-> \"\x{400}\"\n" "3: b()\n-> ok.\nok.\n" = t({Node,Test4}), diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl index 50f7df7a2a..1abd9b1f2f 100644 --- a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl +++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl @@ -24,7 +24,7 @@ -export([init/1, terminate/3]). -export([state1/3, state2/3]). --behaivour(gen_fsm). +-behaviour(gen_fsm). %% API diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk index cbefd6590a..6471dc70e0 100644 --- a/lib/stdlib/vsn.mk +++ b/lib/stdlib/vsn.mk @@ -1 +1 @@ -STDLIB_VSN = 3.8 +STDLIB_VSN = 3.8.1 diff --git a/lib/syntax_tools/doc/demo.erl b/lib/syntax_tools/doc/demo.erl new file mode 120000 index 0000000000..fe40fb65ec --- /dev/null +++ b/lib/syntax_tools/doc/demo.erl @@ -0,0 +1 @@ +../examples/demo.erl
\ No newline at end of file diff --git a/lib/syntax_tools/doc/overview.edoc b/lib/syntax_tools/doc/overview.edoc index 3111633a99..7be96f1a55 100644 --- a/lib/syntax_tools/doc/overview.edoc +++ b/lib/syntax_tools/doc/overview.edoc @@ -26,7 +26,7 @@ library module {@link prettypr}: this is a powerful and flexible generic pretty printing library, which is also distributed separately. For a short demonstration of parsing and pretty-printing, simply -compile the included module <a href="../examples/demo.erl">`demo.erl'</a>, +compile the included module <a href="demo.erl">`demo.erl'</a>, and execute `demo:run()' from the Erlang shell. It will compile the remaining modules and give you further instructions. diff --git a/lib/syntax_tools/doc/src/Makefile b/lib/syntax_tools/doc/src/Makefile index d953287bad..b799c76177 100644 --- a/lib/syntax_tools/doc/src/Makefile +++ b/lib/syntax_tools/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2018. All Rights Reserved. +# Copyright Ericsson AB 2006-2019. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -82,6 +82,9 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +EXAMPLES_DIR = ../../examples +EXAMPLES = $(EXAMPLES_DIR)/demo.erl + SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml) TOP_SPECS_FILE = specs.xml @@ -146,5 +149,7 @@ release_docs_spec: docs $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" + $(INSTALL_DIR) "$(RELSYSDIR)/examples" + $(INSTALL_DATA) $(EXAMPLES) "$(RELSYSDIR)/doc/html" release_spec: diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index 6b42f7a0a1..e1dd1bd73b 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -74,7 +74,7 @@ smoke_test_file(File) -> [print_error_markers(F, File) || F <- Forms], ok; {error,Reason} -> - io:format("~s: ~p\n", [File,Reason]), + io:format("~ts: ~p\n", [File,Reason]), error end. @@ -82,7 +82,7 @@ print_error_markers(F, File) -> case erl_syntax:type(F) of error_marker -> {L,M,Info} = erl_syntax:error_marker_info(F), - io:format("~ts:~p: ~s", [File,L,M:format_error(Info)]); + io:format("~ts:~p: ~ts", [File,L,M:format_error(Info)]); _ -> ok end. @@ -362,7 +362,7 @@ test_comment_scan([File|Files],DataDir) -> end, Fs1 = erl_recomment:recomment_forms(Fs0, Comments), Fs2 = erl_syntax_lib:map(Fun, Fs1), - io:format("File: ~s~n", [Filename]), + io:format("File: ~ts~n", [Filename]), io:put_chars(erl_prettypr:format(Fs2, [{paper, 120}, {ribbon, 110}])), test_comment_scan(Files,DataDir). @@ -377,8 +377,8 @@ test_prettypr([File|Files],DataDir,PrivDir) -> PP = erl_prettypr:format(Fs, [{paper, 120}, {ribbon, 110}]), io:put_chars(PP), OutFile = filename:join(PrivDir, File), - ok = file:write_file(OutFile,iolist_to_binary(PP)), - io:format("Parsing OutFile: ~s~n", [OutFile]), + ok = file:write_file(OutFile,unicode:characters_to_binary(PP)), + io:format("Parsing OutFile: ~ts~n", [OutFile]), {ok, Fs2} = epp:parse_file(OutFile, [], []), case [Error || {error, _} = Error <- Fs2] of [] -> @@ -445,7 +445,7 @@ pretty_print_parse_forms([{Fs0,Type}|FsForms],PrivDir,Filename) -> {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)), + ok = file:write_file(OutFile,unicode:characters_to_binary(PP)), pretty_print_parse_forms(FsForms,PrivDir,Filename). diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml index 28f8346a19..2191ebe2df 100644 --- a/lib/tools/doc/src/notes.xml +++ b/lib/tools/doc/src/notes.xml @@ -128,6 +128,21 @@ </section> +<section><title>Tools 2.11.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Minor fixes for <c>make clean</c>.</p> + <p> + Own Id: OTP-15657</p> + </item> + </list> + </section> + +</section> + <section><title>Tools 2.11.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -1905,4 +1920,3 @@ </section> </section> </chapter> - diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el index 2ee584d11a..fbdd298da3 100644 --- a/lib/tools/emacs/erlang-test.el +++ b/lib/tools/emacs/erlang-test.el @@ -50,8 +50,15 @@ ;; The -L option adds a directory to the load-path. It should be the ;; directory containing erlang.el and erlang-test.el. ;; -;; 3. Call the script test-erlang-mode in this directory. This script -;; use the second method. +;; 3. Run the emacs_SUITE. The testcases tests_interpreted/1 and +;; tests_compiled/1 in this suite are using the second method. One +;; way to run this suite is with the ct_run tool, for example like the +;; following when standing at the OTP repo top directory: +;; +;; ct_run -suite lib/tools/test/emacs_SUITE +;; +;; Note that this creates a lot of html log files in the current +;; directory. ;;; Code: diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 38c0eba92b..0b3a2319e2 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -4,7 +4,7 @@ ;; Author: Anders Lindgren ;; Keywords: erlang, languages, processes ;; Date: 2011-12-11 -;; Version: 2.8.1 +;; Version: 2.8.2 ;; Package-Requires: ((emacs "24.1")) ;; %CopyrightBegin% @@ -87,7 +87,7 @@ "The Erlang programming language." :group 'languages) -(defconst erlang-version "2.8.1" +(defconst erlang-version "2.8.2" "The version number of Erlang mode.") (defcustom erlang-root-dir nil @@ -502,6 +502,13 @@ regardless of where in the line point is when the TAB command is used." :type 'boolean :safe 'booleanp) +(defcustom erlang-max-files-to-visit-for-refining-xrefs 32 + "Upper limit how many files to visit for checking arity. +When `nil' there is no limit." + :group 'erlang + :type '(restricted-sexp :match-alternatives (integerp 'nil)) + :safe (lambda (val) (or (eq val nil) (integerp val)))) + (defvar erlang-man-inhibit (eq system-type 'windows-nt) "Inhibit the creation of the Erlang Manual Pages menu. @@ -3689,10 +3696,13 @@ When an identifier is found return a list with 4 elements: module or nil. 2. Module - Module name string or nil. In case of a -qualified-function a search fails if no entries with correct -module are found. For other kinds the module is just a -preference. If no matching entries are found the search will be -retried without regard to module. +qualified-function the module is explicitly specified (like +module:fun()) and the search fails if no entries with correct +module are found. For other kinds the module is guessed: either +fetched from import statements or it is assumed to be the local +module. In these cases the module is just a preference. If no +matching entries are found the search will be retried without +regard to module. 3. Name - String name of function, module, record or macro. @@ -3704,18 +3714,22 @@ of arguments could be found, otherwise nil." (if (eq (char-syntax (following-char)) ? ) (skip-chars-backward " \t")) (skip-chars-backward "[:word:]_:'") - (cond ((looking-at erlang-module-function-regexp) + (cond ((and (eq (preceding-char) ??) + (looking-at (concat "\\(MODULE\\):" erlang-atom-regexp))) + (erlang-get-qualified-function-id-at-point (erlang-get-module))) + ((looking-at erlang-module-function-regexp) (erlang-get-qualified-function-id-at-point)) ((looking-at (concat erlang-atom-regexp ":")) (erlang-get-module-id-at-point)) ((looking-at erlang-name-regexp) (erlang-get-some-other-id-at-point))))))) -(defun erlang-get-qualified-function-id-at-point () +(defun erlang-get-qualified-function-id-at-point (&optional module) (let ((kind 'qualified-function) - (module (erlang-remove-quotes - (buffer-substring-no-properties - (match-beginning 1) (match-end 1)))) + (module (or module + (erlang-remove-quotes + (buffer-substring-no-properties + (match-beginning 1) (match-end 1))))) (name (erlang-remove-quotes (buffer-substring-no-properties (match-beginning (1+ erlang-atom-regexp-matches)) @@ -3825,7 +3839,8 @@ of arguments could be found, otherwise nil." (let ((case-fold-search nil)) ; force string matching to be case sensitive (if (and (stringp str) (not (string-match (eval-when-compile - (concat "\\`" erlang-atom-regexp "\\'")) str))) + (concat "\\`" erlang-atom-regexp "\\'")) + str))) (progn (setq str (replace-regexp-in-string "'" "\\'" str t t )) (concat "'" str "'")) @@ -4879,15 +4894,36 @@ about Erlang modules." ;; The backend below is a wrapper around the built-in etags backend. ;; It adds awareness of the module:tag syntax in a similar way that is ;; done above for the old etags commands. +;; +;; In addition arity is also considered when jumping to definitions. +;; There is however currently no information about arity in the TAGS +;; file. Also two functions with the same name but different arity +;; _sometimes_ get one TAGS entry each and sometimes are joined in one +;; single entry. If they are directly consecutive they will be +;; joined. If there are other functions etc in between then they will +;; get one entry each. +;; +;; These limitations are present in both the etags program shipped +;; with GNU Emacs and the tags.erl program in this repository. +;; +;; Therefore erlang.el must complement the information in TAGS by +;; visiting files and checking arity. When searching for popular +;; function names (like init, handle_call etc) in a big TAGS file +;; (like one indexing this repository) this may be quite +;; time-consuming. There exists therefore an upper limit for the +;; number of files to visit (called +;; `erlang-max-files-to-visit-for-refining-xrefs'). +;; +;; As mentioned this xref implementation is based on the etags xref +;; implementation. But in the cases where arity is considered the +;; etags information structures (class xref-etags-location) will be +;; translated to our own structures which include arity (class +;; erlang-xref-location). This translation is started in the function +;; `erlang-refine-xrefs'. -(defvar erlang-current-arity nil - "The arity of the function currently being searched. - -There is no information about arity in the TAGS file. -Consecutive functions with same name but different arity will -only get one entry in the TAGS file. Matching TAGS entries are -therefore selected without regarding arity. The arity is -considered first when it is time to jump to the definition.") +;; I mention this as a head up that some of the functions below deal +;; with xref items with xref-etags-location and some deal with xref +;; items with erlang-xref-location. (defun erlang-etags--xref-backend () 'erlang-etags) @@ -4895,127 +4931,80 @@ considered first when it is time to jump to the definition.") (when (locate-library (symbol-name feature)) (require feature))) -(and (erlang-soft-require 'xref) - (erlang-soft-require 'cl-generic) - (erlang-soft-require 'eieio) - (erlang-soft-require 'etags) - ;; The purpose of using eval here is to avoid compilation - ;; warnings in emacsen without cl-defmethod etc. - (eval - '(progn - (cl-defmethod xref-backend-identifier-at-point - ((_backend (eql erlang-etags))) - (if (eq this-command 'xref-find-references) - (if (use-region-p) - (buffer-substring-no-properties (region-beginning) - (region-end)) - (thing-at-point 'symbol)) - (erlang-id-to-string (erlang-get-identifier-at-point)))) - - (cl-defmethod xref-backend-definitions - ((_backend (eql erlang-etags)) identifier) - (erlang-xref-find-definitions identifier)) - - (cl-defmethod xref-backend-apropos - ((_backend (eql erlang-etags)) identifier) - (erlang-xref-find-definitions identifier t)) - - (cl-defmethod xref-backend-identifier-completion-table - ((_backend (eql erlang-etags))) - (let ((erlang-replace-etags-tags-completion-table t)) - (tags-completion-table))) - - (defclass erlang-xref-location (xref-etags-location) ()) - - (defun erlang-convert-xrefs (xrefs) - (mapcar (lambda (xref) - (oset xref location (erlang-make-location - (oref xref location))) - xref) - xrefs)) - - (defun erlang-make-location (etags-location) - (with-slots (tag-info file) etags-location - (make-instance 'erlang-xref-location :tag-info tag-info - :file file))) - - (cl-defmethod xref-location-marker ((locus erlang-xref-location)) - (with-slots (tag-info file) locus - (with-current-buffer (find-file-noselect file) - (save-excursion - (or (erlang-goto-tag-location-by-arity tag-info) - (etags-goto-tag-location tag-info)) - ;; Reset erlang-current-arity. We want to jump to - ;; correct arity in the first attempt. That is now - ;; done. Possible remaining jumps will be from - ;; entries in the *xref* buffer and then we want to - ;; ignore the arity. (Alternatively we could remove - ;; all but one xref entry per file when we know the - ;; arity). - (setq erlang-current-arity nil) - (point-marker))))) - - (defun erlang-xref-context (xref) - (with-slots (tag-info) (xref-item-location xref) - (car tag-info)))))) - - -(defun erlang-goto-tag-location-by-arity (tag-info) - (when erlang-current-arity - (let* ((tag-text (car tag-info)) - (tag-pos (cdr (cdr tag-info))) - (tag-line (car (cdr tag-info))) - (regexp (erlang-tag-info-regexp tag-text)) - (startpos (or tag-pos - (when tag-line - (goto-char (point-min)) - (forward-line (1- tag-line)) - (point)) - (point-min)))) - (setq startpos (max (- startpos 2000) - (point-min))) - (goto-char startpos) - (let ((pos (or (erlang-search-by-arity regexp) - (unless (eq startpos (point-min)) - (goto-char (point-min)) - (erlang-search-by-arity regexp))))) - (when pos - (goto-char pos) - t))))) - -(defun erlang-tag-info-regexp (tag-text) - (concat "^" - (regexp-quote tag-text) - ;; Erlang function entries in TAGS includes the opening - ;; parenthesis for the argument list. Erlang macro entries - ;; do not. Add it here in order to end up in correct - ;; position for erlang-get-arity. - (if (string-prefix-p "-define" tag-text) - "\\s-*(" - ""))) - -(defun erlang-search-by-arity (regexp) - (let (pos) - (while (and (null pos) - (re-search-forward regexp nil t)) - (when (eq erlang-current-arity (save-excursion (erlang-get-arity))) - (setq pos (point-at-bol)))) - pos)) - - +(when (and (erlang-soft-require 'xref) + (erlang-soft-require 'cl-generic) + (erlang-soft-require 'eieio) + (erlang-soft-require 'etags)) + ;; The purpose of using eval here is to avoid compilation + ;; warnings in emacsen without cl-defmethod etc. + (eval + '(progn + (cl-defmethod xref-backend-identifier-at-point ((_backend + (eql erlang-etags))) + (if (eq this-command 'xref-find-references) + (if (use-region-p) + (buffer-substring-no-properties (region-beginning) + (region-end)) + (thing-at-point 'symbol)) + (erlang-id-to-string (erlang-get-identifier-at-point)))) + + (cl-defmethod xref-backend-definitions ((_backend (eql erlang-etags)) + identifier) + (erlang-xref-find-definitions identifier)) + + (cl-defmethod xref-backend-apropos ((_backend (eql erlang-etags)) + identifier) + (erlang-xref-find-definitions identifier t)) + + (cl-defmethod xref-backend-identifier-completion-table + ((_backend (eql erlang-etags))) + (let ((erlang-replace-etags-tags-completion-table t)) + (tags-completion-table))) + + (defclass erlang-xref-location (xref-file-location) + ((arity :type fixnum :initarg :arity + :reader erlang-xref-location-arity)) + :documentation "An erlang location is a file location plus arity.") + + ;; This method definition only calls the superclass which is + ;; the default behaviour if it was not defined. It is only + ;; needed for "upgrade" purposes. In version 2.8.1 of + ;; erlang.el this method was defined differently and in case + ;; user switch to a new erlang.el without restarting Emacs + ;; this method needs to be redefined. + (cl-defmethod xref-location-marker ((locus erlang-xref-location)) + (cl-call-next-method locus))))) + +;; If this function returns a single xref the user will jump to that +;; directly. If two or more xrefs are returned a *xref* window is +;; displayed and the user can choose where to jump. Hence we want to +;; return a single xref when we are pretty sure that is where the user +;; wants to go. Otherwise return all possible xrefs but sort them so +;; that xrefs in the local file is first and if arity is known sort +;; the xrefs with matching arity before others. + +;; Note that the arity sorting work may partly be undone later when +;; the hits are presented in the *xref* buffer since they then will be +;; grouped together by file. Ie when one file have one hit with +;; correct arity and others with wrong arity these hits will be +;; grouped together and may end up before hits with correct arity. (defun erlang-xref-find-definitions (identifier &optional is-regexp) (erlang-with-id (kind module name arity) identifier - (setq erlang-current-arity arity) (cond ((eq kind 'module) (erlang-xref-find-definitions-module name)) + ((eq kind 'qualified-function) + (erlang-xref-find-definitions-qualified-function module + name + arity + is-regexp)) (module - (erlang-xref-find-definitions-module-tag module + (erlang-xref-find-definitions-module-tag kind + module name - (eq kind - 'qualified-function) + arity is-regexp)) (t - (erlang-xref-find-definitions-tag kind name is-regexp))))) + (erlang-xref-find-definitions-tag kind name arity is-regexp))))) (defun erlang-xref-find-definitions-module (module) (and (fboundp 'xref-make) @@ -5040,65 +5029,252 @@ considered first when it is time to jump to the definition.") (setq files (cdr files)))))) (nreverse xrefs)))) -(defun erlang-visit-tags-table-buffer (cont cbuf) - (if (< emacs-major-version 26) - (visit-tags-table-buffer cont) - ;; Remove this with-no-warnings when Emacs 26 is the required - ;; version minimum. - (with-no-warnings - (visit-tags-table-buffer cont cbuf)))) - -(defun erlang-xref-find-definitions-module-tag (module +(defun erlang-xref-find-definitions-qualified-function (module + tag + arity + is-regexp) + "Find definitions of TAG in MODULE preferably with arity ARITY. +If one single perfect match was found return only that (ignoring +other definitions matching TAG). If IS-REGEXP is non-nil then +TAG is a regexp." + (let* ((xrefs (when (fboundp 'etags--xref-find-definitions) + (etags--xref-find-definitions tag is-regexp))) + (xrefs-split (erlang-split-xrefs-on-module xrefs module)) + (module-xrefs (car xrefs-split)) + (module-xrefs (erlang-refine-xrefs module-xrefs + 'qualified-function + tag + is-regexp))) + (or (erlang-single-arity-match module-xrefs arity) + (erlang-sort-by-arity module-xrefs arity)))) + + +;; We will end up here when erlang-get-some-other-id-at-point either +;; found module among the import statements or module is just the +;; current local file. +(defun erlang-xref-find-definitions-module-tag (kind + module tag - is-qualified + arity is-regexp) - "Find definitions of TAG and filter away definitions outside of -MODULE. If IS-QUALIFIED is nil and no definitions was found inside -the MODULE then return any definitions found outside. If -IS-REGEXP is non-nil then TAG is a regexp." - (and (fboundp 'etags--xref-find-definitions) - (fboundp 'erlang-convert-xrefs) - (let ((xrefs (erlang-convert-xrefs - (etags--xref-find-definitions tag is-regexp))) - xrefs-in-module) - (dolist (xref xrefs) - (when (string-equal module (erlang-xref-module xref)) - (push xref xrefs-in-module))) - (cond (is-qualified xrefs-in-module) - (xrefs-in-module xrefs-in-module) - (t xrefs))))) - -(defun erlang-xref-find-definitions-tag (kind tag is-regexp) - "Find all definitions of TAG and reorder them so that -definitions in the currently visited file comes first." - (and (fboundp 'etags--xref-find-definitions) - (fboundp 'erlang-convert-xrefs) - (let* ((current-file (and (buffer-file-name) - (file-truename (buffer-file-name)))) - (regexp (erlang-etags-regexp kind tag is-regexp)) - (xrefs (erlang-convert-xrefs - (etags--xref-find-definitions regexp t))) - local-xrefs non-local-xrefs) - (while xrefs - (let ((xref (car xrefs))) - (if (string-equal (erlang-xref-truename-file xref) - current-file) - (push xref local-xrefs) - (push xref non-local-xrefs)) - (setq xrefs (cdr xrefs)))) - (append (reverse local-xrefs) - (reverse non-local-xrefs))))) + "Find definitions of TAG preferably in MODULE and with arity ARITY. +Return definitions outside MODULE if none are found inside. If +IS-REGEXP is non-nil then TAG is a regexp. + +If one single perfect match was found return only that (ignoring +other definitions matching TAG)." + (let* ((xrefs (when (fboundp 'etags--xref-find-definitions) + (etags--xref-find-definitions tag is-regexp))) + (xrefs-split (erlang-split-xrefs-on-module xrefs module)) + (module-xrefs (car xrefs-split)) + (module-xrefs (erlang-refine-xrefs module-xrefs + kind + tag + is-regexp))) + (or (erlang-single-arity-match module-xrefs arity) + (erlang-xref-find-definitions-tag kind tag arity is-regexp xrefs)))) + +(defun erlang-xref-find-definitions-tag (kind + tag + arity + is-regexp + &optional xrefs) + "Find definitions of TAG preferably in local file and with arity ARITY. +If one single perfect match was found return only that (ignoring +other definitions matching TAG). If no such local match was +found then look for a matching BIF in the same way. If IS-REGEXP +is non-nil then TAG is a regexp." + (let* ((regexp (erlang-etags-regexp kind tag is-regexp)) + (xrefs (or xrefs + (when (fboundp 'etags--xref-find-definitions) + (etags--xref-find-definitions regexp t)))) + (xrefs-split (erlang-split-xrefs xrefs)) + (local-xrefs (car xrefs-split)) + (local-xrefs (erlang-refine-xrefs local-xrefs + kind + tag + is-regexp)) + (bif-xrefs (cadr xrefs-split)) + (other-xrefs (caddr xrefs-split))) + (or (erlang-single-arity-match local-xrefs arity) + ;; No local match, look for a matching BIF. + (progn + (setq bif-xrefs (erlang-refine-xrefs bif-xrefs + kind + tag + is-regexp)) + (erlang-single-arity-match bif-xrefs arity)) + (progn + (setq other-xrefs (erlang-refine-xrefs other-xrefs + kind + tag + is-regexp)) + (and (null local-xrefs) + (null bif-xrefs) + ;; No local of BIF matches at all. Is there a single + ;; arity match among the rest? + (erlang-single-arity-match other-xrefs arity))) + (append (erlang-sort-by-arity local-xrefs arity) + (erlang-sort-by-arity bif-xrefs arity) + (erlang-sort-by-arity other-xrefs arity))))) + + +(defun erlang-refine-xrefs (xrefs kind tag is-regexp) + (if (or (memq kind '(record module)) + ;; No support for apropos here. + is-regexp + (erlang-too-many-files-in-xrefs xrefs)) + xrefs + (when (and xrefs + (fboundp 'xref-item-location) + (fboundp 'xref-location-group) + (fboundp 'slot-value)) + (let (files) + (cl-loop for xref in xrefs + for loc = (xref-item-location xref) + for file = (xref-location-group loc) + do (pushnew file files :test 'string-equal)) + (or (cl-loop for file in files + append (erlang-xrefs-in-file file kind tag is-regexp)) + ;; Failed for some reason. Pretend like it is raining and + ;; return the unrefined xrefs. + xrefs))))) + +(defun erlang-too-many-files-in-xrefs (xrefs) + (and erlang-max-files-to-visit-for-refining-xrefs + (let ((files-to-visit (delete-dups + (mapcar #'erlang-xref-truename-file + xrefs)))) + (if (< (length files-to-visit) + erlang-max-files-to-visit-for-refining-xrefs) + nil + (message (concat "Too many hits to consider arity (see " + "`erlang-max-files-to-visit-for-refining-xrefs')")) + t)))) + +(defun erlang-xrefs-in-file (file kind tag is-regexp) + (when (fboundp 'make-instance) + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char (point-min)) + (let ((regexp (concat ; "^" + (erlang-etags-regexp kind tag is-regexp) + "\\s *(")) + last-arity) + (cl-loop while (re-search-forward regexp nil t) + for name = (match-string-no-properties 1) + for arity = (save-excursion + (erlang-get-arity)) + for loc = (make-instance 'erlang-xref-location + :file file + :line (line-number-at-pos) + :column 0 + :arity arity) + for sum = (erlang-xref-summary kind name arity) + when (and arity + (not (eq arity last-arity))) + collect (make-instance 'xref-item + :summary sum + :location loc) + do (setq last-arity arity))))))) + +(defun erlang-xref-summary (kind tag arity) + (format "%s%s%s" + (if (memq kind '(record macro module)) + (format "%s " kind) + "") + tag + (if arity (format "/%s" arity) ""))) + +(defun erlang-single-arity-match (xrefs wanted-arity) + "Attempt to find one perfect match. + +If we have all information needed to consider arity then return a +single perfect match or nothing. If there are more than one +match nothing is returned. + +If we don't have all information needed to consider arity just +return XREFS as is." + (if (erlang-should-consider-arity-p xrefs wanted-arity) + (let ((nr-matches 0) + match) + (while (and xrefs + (< nr-matches 2)) + (let* ((xref (car xrefs)) + (arity (erlang-xref-arity xref))) + (when (eq arity wanted-arity) + (setq match xref + nr-matches (1+ nr-matches))) + (setq xrefs (cdr xrefs)))) + (when (eq nr-matches 1) + (list match))) + (when (eq (length xrefs) 1) + xrefs))) + +(defun erlang-sort-by-arity (xrefs wanted-arity) + (if (erlang-should-consider-arity-p xrefs wanted-arity) + (let (matches non-matches) + (while xrefs + (let* ((xref (car xrefs)) + (arity (erlang-xref-arity xref))) + (push xref (if (eq arity wanted-arity) + matches + non-matches)) + (setq xrefs (cdr xrefs)))) + (append (reverse matches) (reverse non-matches) xrefs)) + xrefs)) + +(defun erlang-should-consider-arity-p (xrefs wanted-arity) + (and wanted-arity + xrefs + (fboundp 'erlang-xref-location-p) + (fboundp 'xref-item-location) + (erlang-xref-location-p (xref-item-location (car xrefs))))) (defun erlang-etags-regexp (kind tag is-regexp) - (let ((tag-regexp (if is-regexp - tag - (regexp-quote tag)))) - (cond ((eq kind 'record) - (concat "-record\\s-*(\\s-*" tag-regexp)) - ((eq kind 'macro) - (concat "-define\\s-*(\\s-*" tag-regexp)) - (t tag-regexp)))) - + (let ((tag-regexp (concat "\\(" + (if is-regexp + tag + (regexp-quote tag)) + "\\)"))) + (concat (if is-regexp "" "^") + (cond ((eq kind 'record) + (concat "-record\\s-*(\\s-*" tag-regexp)) + ((eq kind 'macro) + (concat "-define\\s-*(\\s-*" tag-regexp)) + (t + tag-regexp)) + (if is-regexp "" "\\_>")))) + +(defun erlang-xref-arity (xref) + (and (fboundp 'erlang-xref-location-arity) + (fboundp 'xref-item-location) + (erlang-xref-location-arity (xref-item-location xref)))) + +(defun erlang-split-xrefs-on-module (xrefs module) + (let (local-xrefs non-local-xrefs) + (dolist (xref xrefs) + (if (string-equal (erlang-xref-module xref) + module) + (push xref local-xrefs) + (push xref non-local-xrefs))) + (cons (reverse local-xrefs) + (reverse non-local-xrefs)))) + +(defun erlang-split-xrefs (xrefs) + (let ((current-file (and (buffer-file-name) + (file-truename (buffer-file-name)))) + local-xrefs bif-xrefs other-xrefs) + (dolist (xref xrefs) + (cond ((string-equal (erlang-xref-truename-file xref) current-file) + (push xref local-xrefs)) + ((string-equal (erlang-xref-module xref) "erlang") + (push xref bif-xrefs)) + (t + (push xref other-xrefs)))) + (list (reverse local-xrefs) + (reverse bif-xrefs) + (reverse other-xrefs)))) (defun erlang-xref-module (xref) (erlang-get-module-from-file-name (erlang-xref-file xref))) @@ -5113,7 +5289,13 @@ definitions in the currently visited file comes first." (fboundp 'xref-item-location) (xref-location-group (xref-item-location xref)))) - +(defun erlang-visit-tags-table-buffer (cont cbuf) + (if (< emacs-major-version 26) + (visit-tags-table-buffer cont) + ;; Remove this with-no-warnings when Emacs 26 is the required + ;; version minimum. + (with-no-warnings + (visit-tags-table-buffer cont cbuf)))) ;;; ;;; Prepare for other methods to run an Erlang slave process. diff --git a/lib/tools/test/Makefile b/lib/tools/test/Makefile index 2b7b17afb3..7a0a941ccc 100644 --- a/lib/tools/test/Makefile +++ b/lib/tools/test/Makefile @@ -32,6 +32,7 @@ MODULES = \ make_SUITE \ tools_SUITE \ xref_SUITE \ + prof_bench_SUITE \ ignore_cores ERL_FILES= $(MODULES:%=%.erl) @@ -41,7 +42,7 @@ INSTALL_PROGS= $(TARGET_FILES) EMAKEFILE=Emakefile -SPEC_FILES= tools.spec +SPEC_FILES= tools.spec tools_bench.spec COVER_FILE = tools.cover # ---------------------------------------------------- diff --git a/lib/tools/test/emacs_SUITE.erl b/lib/tools/test/emacs_SUITE.erl index a6d43d1816..73270e6ed6 100644 --- a/lib/tools/test/emacs_SUITE.erl +++ b/lib/tools/test/emacs_SUITE.erl @@ -70,19 +70,20 @@ bif_highlight(Config) -> check_bif_highlight(Bin, Tag, Compare) -> - [_H,IntMatch,_T] = + [_H,Match,_T] = re:split(Bin,<<"defvar ",Tag/binary, "[^(]*\\(([^)]*)">>,[]), - EmacsIntBifs = [list_to_atom(S) || - S <- string:tokens(binary_to_list(IntMatch)," '\"\n")], + EmacsBifs = [list_to_atom(S) || + S <- string:tokens(binary_to_list(Match)," '\"\n")], - ct:log("Emacs ~p",[EmacsIntBifs]), - ct:log("Int ~p",[Compare]), + ct:log("Comparing ~s", [Tag]), + ct:log("Emacs ~p",[EmacsBifs]), + ct:log("Erlang ~p",[Compare]), - ct:log("Diff1 ~p",[Compare -- EmacsIntBifs]), - ct:log("Diff2 ~p",[EmacsIntBifs -- Compare]), - [] = Compare -- EmacsIntBifs, - [] = EmacsIntBifs -- Compare. + ct:log("Only in Erlang ~p",[Compare -- EmacsBifs]), + ct:log("Only in Emacs ~p",[EmacsBifs -- Compare]), + [] = Compare -- EmacsBifs, + [] = EmacsBifs -- Compare. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -118,7 +119,7 @@ compile_and_load(_Config) -> false -> " " end, emacs([Pedantic, - " -f batch-byte-compile ",filename:join(Dir, File)]), + " -f batch-byte-compile ", dquote(filename:join(Dir, File))]), true end, lists:foreach(Compile, Files), @@ -143,6 +144,10 @@ tests_compiled(_Config) -> ok end. + +dquote(Str) -> + "\"" ++ Str ++ "\"". + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% indent(Config) -> @@ -188,7 +193,9 @@ diff(Orig, File) -> end. emacs_version_ok(AcceptVer) -> - case os:cmd("emacs --version | head -1") of + VersionLine = os:cmd("emacs --version | head -1"), + io:format("~s~n", [VersionLine]), + case VersionLine of "GNU Emacs " ++ Ver -> case string:to_float(Ver) of {Vsn, _} when Vsn >= AcceptVer -> @@ -204,14 +211,14 @@ emacs_version_ok(AcceptVer) -> emacs(EmacsCmds) when is_list(EmacsCmds) -> Cmd = ["emacs ", "--batch --quick ", - "--directory ", emacs_dir(), " ", + "--directory ", dquote(emacs_dir()), " ", "--eval \"(require 'erlang-start)\" " | EmacsCmds], Res0 = os:cmd(Cmd ++ " ; echo $?"), Rows = string:lexemes(Res0, ["\r\n", $\n]), Res = lists:last(Rows), Output = string:join(lists:droplast(Rows), "\n"), - io:format("Cmd ~s:~n => ~s ~ts~n", [Cmd, Res, Output]), + io:format("Cmd ~ts:~n => ~s ~ts~n", [Cmd, Res, Output]), "0" = Res, Output. diff --git a/lib/tools/test/instrument_SUITE.erl b/lib/tools/test/instrument_SUITE.erl index 33259df58f..f474669836 100644 --- a/lib/tools/test/instrument_SUITE.erl +++ b/lib/tools/test/instrument_SUITE.erl @@ -260,13 +260,18 @@ test_format(Options0, Gather, Verify) -> test_abort(Gather) -> %% There's no way for us to tell whether this actually aborted or ran to %% completion, but it might catch a few segfaults. + %% This testcase is mostly useful when run in an debug emulator as it needs + %% the modified reduction count to trigger the odd trap scenarios Runner = self(), Ref = make_ref(), spawn_opt(fun() -> - [Gather({Type, SchedId, 1, 1, Ref}) || - Type <- erlang:system_info(alloc_util_allocators), - SchedId <- lists:seq(0, erlang:system_info(schedulers))], - Runner ! Ref + [begin + Ref2 = make_ref(), + [Gather({Type, SchedId, 1, 1, Ref2}) || + Type <- erlang:system_info(alloc_util_allocators), + SchedId <- lists:seq(0, erlang:system_info(schedulers))] + end || _ <- lists:seq(1,100)], + Runner ! Ref end, [{priority, max}]), receive Ref -> ok diff --git a/lib/tools/test/prof_bench_SUITE.erl b/lib/tools/test/prof_bench_SUITE.erl new file mode 100644 index 0000000000..50d0ba9cd9 --- /dev/null +++ b/lib/tools/test/prof_bench_SUITE.erl @@ -0,0 +1,126 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(prof_bench_SUITE). + +-include_lib("common_test/include/ct_event.hrl"). + +%% Test server framework exports +-export([all/0, suite/0, init_per_suite/1, end_per_suite/1]). + +-export([overhead/1]). + +%%%--------------------------------------------------------------------- +%%% Test suites +%%%--------------------------------------------------------------------- + + +suite() -> + [{timetrap,{minutes,10}}]. + +all() -> + [overhead]. + +init_per_suite(Config) -> + case {test_server:is_native(fprof_SUITE) or + (lists:any(fun(M) -> test_server:is_native(M) end, modules())) or + (whereis(cover_server) =/= undefined), + erlang:system_info(wordsize)} + of + {true, _} -> {skip, "Native or cover code"}; + {_, 4} -> {skip, "Can't run on 32-bit as files will be large"}; + {false, 8} -> Config + end. + +end_per_suite(Config) -> + LogFile = filename:join(proplists:get_value(priv_dir, Config), "fprof.trace"), + file:delete(LogFile), + ok. + +%%%--------------------------------------------------------------------- + +%% ct:run_test([{suite, prof_bench_SUITE}]). +overhead(Config) -> + LogFile = filename:join(proplists:get_value(priv_dir, Config), "fprof.trace"), + SofsCopy = filename:join(proplists:get_value(data_dir, Config), "sofs_copy.erl"), + TC = fun() -> compile:file(SofsCopy, [binary]) end, + _Warmup = timer:tc(TC), + + {NormTime,{ok, sofs_copy, _}} = timer:tc(TC), + {FProfTime,{ok,sofs_copy,_}} = fprof:apply(timer, tc, [TC], [{file, LogFile}]), + ct:pal("FProf: ~p Norm: ~p Ratio: ~p",[FProfTime, NormTime, NormTime / FProfTime * 100]), + {ok,{EProfTime,{ok,sofs_copy,_}}} = eprof:profile([], timer, tc, [TC]), + ct:pal("EProf: ~p Norm: ~p Ratio: ~p",[EProfTime, NormTime, NormTime / EProfTime * 100]), + {CProfTime,{ok,sofs_copy,_}} = cprof_apply(timer, tc, [TC]), + ct:pal("CProf: ~p Norm: ~p Ratio: ~p",[CProfTime, NormTime, NormTime / CProfTime * 100]), + {CoverTime,{ok,sofs_copy,_}} = cover_apply(timer, tc, [TC]), + ct:pal("Cover: ~p Norm: ~p Ratio: ~p",[CoverTime, NormTime, NormTime / CoverTime * 100]), + + ct_event:notify(#event{name = benchmark_data, + data = [{name, fprof_overhead}, + {value, NormTime / FProfTime * 100}]}), + ct_event:notify(#event{name = benchmark_data, + data = [{name, eprof_overhead}, + {value, NormTime / EProfTime * 100}]}), + ct_event:notify(#event{name = benchmark_data, + data = [{name, cprof_overhead}, + {value, NormTime / CProfTime * 100}]}), + ct_event:notify(#event{name = benchmark_data, + data = [{name, cover_overhead}, + {value, NormTime / CoverTime * 100}]}). + +%% overhead(Config) -> +%% LogFile = filename:join(proplists:get_value(priv_dir, Config), "fprof.trace"), +%% SofsCopy = filename:join(proplists:get_value(data_dir, Config), "sofs_copy.erl"), +%% TC = fun() -> compile:file(SofsCopy, [binary]) end, +%% _Warmup = timer:tc(TC), + +%% [{ok,{EProfTime,{ok,sofs_copy,_}}} = eprof:profile([], timer, tc, [TC]) +%% || _ <- lists:seq(1,10)], +%% %% [fprof:apply(timer, tc, [TC], [{file, LogFile}]) || _ <- lists:seq(1,10)], +%% {FProfTime,{ok,sofs_copy,_}} = fprof:apply(timer, tc, [TC], [{file, LogFile}]), +%% {NormTime,{ok, sofs_copy, _}} = timer:tc(TC), + + %% ct:pal("FProf: ~p Norm: ~p Ratio: ~p",[FProfTime, NormTime, FProfTime / NormTime]). + +cprof_apply(M, F, A) -> + cprof:start(), + Res = apply(M, F, A), + cprof:stop(), + Res. + +cover_apply(M, F, A) -> + cover:start(), + catch cover:local_only(), + Modules = modules(), + [code:unstick_mod(Mod) || Mod <- Modules], + cover:compile_beam(Modules), + [code:stick_mod(Mod) || Mod <- Modules], + Res = apply(M, F, A), + cover:stop(), + Res. + +modules() -> + application:load(compiler), + {ok, CompilerModules} = application:get_key(compiler, modules), + %% Only cover compile a subset of the stdlib modules + StdlibModules = [erl_parse, erl_expand_records, erl_lint, gb_trees, gb_sets, sofs, + beam_lib, dict, epp, erl_anno, erl_bits, + orddict, ordsets, sets, string, unicode, unicode_util], + CompilerModules ++ StdlibModules. diff --git a/lib/tools/test/prof_bench_SUITE_data/sofs_copy.erl b/lib/tools/test/prof_bench_SUITE_data/sofs_copy.erl new file mode 100644 index 0000000000..2a9b19177e --- /dev/null +++ b/lib/tools/test/prof_bench_SUITE_data/sofs_copy.erl @@ -0,0 +1,2809 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2017. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(sofs_copy). + +-export([from_term/1, from_term/2, from_external/2, empty_set/0, + is_type/1, set/1, set/2, from_sets/1, relation/1, relation/2, + a_function/1, a_function/2, family/1, family/2, + to_external/1, type/1, to_sets/1, no_elements/1, + specification/2, union/2, intersection/2, difference/2, + symdiff/2, symmetric_partition/2, product/1, product/2, + constant_function/2, is_equal/2, is_subset/2, is_sofs_set/1, + is_set/1, is_empty_set/1, is_disjoint/2]). + +-export([union/1, intersection/1, canonical_relation/1]). + +-export([relation_to_family/1, domain/1, range/1, field/1, + relative_product/1, relative_product/2, relative_product1/2, + converse/1, image/2, inverse_image/2, strict_relation/1, + weak_relation/1, extension/3, is_a_function/1]). + +-export([composite/2, inverse/1]). + +-export([restriction/2, restriction/3, drestriction/2, drestriction/3, + substitution/2, projection/2, partition/1, partition/2, + partition/3, multiple_relative_product/2, join/4]). + +-export([family_to_relation/1, family_specification/2, + union_of_family/1, intersection_of_family/1, + family_union/1, family_intersection/1, + family_domain/1, family_range/1, family_field/1, + family_union/2, family_intersection/2, family_difference/2, + partition_family/2, family_projection/2]). + +-export([family_to_digraph/1, family_to_digraph/2, + digraph_to_family/1, digraph_to_family/2]). + +%% Shorter names of some functions. +-export([fam2rel/1, rel2fam/1]). + +-import(lists, + [any/2, append/1, flatten/1, foreach/2, + keysort/2, last/1, map/2, mapfoldl/3, member/2, merge/2, + reverse/1, reverse/2, sort/1, umerge/1, umerge/2, usort/1]). + +-compile({inline, [{family_to_relation,1}, {relation_to_family,1}]}). + +-compile({inline, [{rel,2},{a_func,2},{fam,2},{term2set,2}]}). + +-compile({inline, [{external_fun,1},{element_type,1}]}). + +-compile({inline, + [{unify_types,2}, {match_types,2}, + {test_rel,3}, {symdiff,3}, + {subst,3}]}). + +-compile({inline, [{fam_binop,3}]}). + +%% Nope, no is_member, del_member or add_member. +%% +%% See also "Naive Set Theory" by Paul R. Halmos. +%% +%% By convention, erlang:error/1 is called from exported functions. + +-define(TAG, 'Set'). +-define(ORDTAG, 'OrdSet'). + +-record(?TAG, {data = [] :: list(), type = type :: term()}). +-record(?ORDTAG, {orddata = {} :: tuple() | atom(), + ordtype = type :: term()}). + +-define(LIST(S), (S)#?TAG.data). +-define(TYPE(S), (S)#?TAG.type). +-define(SET(L, T), #?TAG{data = L, type = T}). +-define(IS_SET(S), is_record(S, ?TAG)). +-define(IS_UNTYPED_SET(S), ?TYPE(S) =:= ?ANYTYPE). + +%% Ordered sets and atoms: +-define(ORDDATA(S), (S)#?ORDTAG.orddata). +-define(ORDTYPE(S), (S)#?ORDTAG.ordtype). +-define(ORDSET(L, T), #?ORDTAG{orddata = L, ordtype = T}). +-define(IS_ORDSET(S), is_record(S, ?ORDTAG)). +-define(ATOM_TYPE, atom). +-define(IS_ATOM_TYPE(T), is_atom(T)). % true for ?ANYTYPE... + +%% When IS_SET is true: +-define(ANYTYPE, '_'). +-define(BINREL(X, Y), {X, Y}). +-define(IS_RELATION(R), is_tuple(R)). +-define(REL_ARITY(R), tuple_size(R)). +-define(REL_TYPE(I, R), element(I, R)). +-define(SET_OF(X), [X]). +-define(IS_SET_OF(X), is_list(X)). +-define(FAMILY(X, Y), ?BINREL(X, ?SET_OF(Y))). + +-export_type([anyset/0, binary_relation/0, external_set/0, a_function/0, + family/0, relation/0, set_of_sets/0, set_fun/0, spec_fun/0, + type/0]). +-export_type([ordset/0, a_set/0]). + +-type(anyset() :: ordset() | a_set()). +-type(binary_relation() :: relation()). +-type(external_set() :: term()). +-type(a_function() :: relation()). +-type(family() :: a_function()). +-opaque(ordset() :: #?ORDTAG{}). +-type(relation() :: a_set()). +-opaque(a_set() :: #?TAG{}). +-type(set_of_sets() :: a_set()). +-type(set_fun() :: pos_integer() + | {external, fun((external_set()) -> external_set())} + | fun((anyset()) -> anyset())). +-type(spec_fun() :: {external, fun((external_set()) -> boolean())} + | fun((anyset()) -> boolean())). +-type(type() :: term()). + +-type(tuple_of(_T) :: tuple()). + +%% +%% Exported functions +%% + +%%% +%%% Create sets +%%% + +-spec(from_term(Term) -> AnySet when + AnySet :: anyset(), + Term :: term()). +from_term(T) -> + Type = case T of + _ when is_list(T) -> [?ANYTYPE]; + _ -> ?ANYTYPE + end, + try setify(T, Type) + catch _:_ -> erlang:error(badarg) + end. + +-spec(from_term(Term, Type) -> AnySet when + AnySet :: anyset(), + Term :: term(), + Type :: type()). +from_term(L, T) -> + case is_type(T) of + true -> + try setify(L, T) + catch _:_ -> erlang:error(badarg) + end; + false -> + erlang:error(badarg) + end. + +-spec(from_external(ExternalSet, Type) -> AnySet when + ExternalSet :: external_set(), + AnySet :: anyset(), + Type :: type()). +from_external(L, ?SET_OF(Type)) -> + ?SET(L, Type); +from_external(T, Type) -> + ?ORDSET(T, Type). + +-spec(empty_set() -> Set when + Set :: a_set()). +empty_set() -> + ?SET([], ?ANYTYPE). + +-spec(is_type(Term) -> Bool when + Bool :: boolean(), + Term :: term()). +is_type(Atom) when ?IS_ATOM_TYPE(Atom), Atom =/= ?ANYTYPE -> + true; +is_type(?SET_OF(T)) -> + is_element_type(T); +is_type(T) when tuple_size(T) > 0 -> + is_types(tuple_size(T), T); +is_type(_T) -> + false. + +-spec(set(Terms) -> Set when + Set :: a_set(), + Terms :: [term()]). +set(L) -> + try usort(L) of + SL -> ?SET(SL, ?ATOM_TYPE) + catch _:_ -> erlang:error(badarg) + end. + +-spec(set(Terms, Type) -> Set when + Set :: a_set(), + Terms :: [term()], + Type :: type()). +set(L, ?SET_OF(Type)) when ?IS_ATOM_TYPE(Type), Type =/= ?ANYTYPE -> + try usort(L) of + SL -> ?SET(SL, Type) + catch _:_ -> erlang:error(badarg) + end; +set(L, ?SET_OF(_) = T) -> + try setify(L, T) + catch _:_ -> erlang:error(badarg) + end; +set(_, _) -> + erlang:error(badarg). + +-spec(from_sets(ListOfSets) -> Set when + Set :: a_set(), + ListOfSets :: [anyset()]; + (TupleOfSets) -> Ordset when + Ordset :: ordset(), + TupleOfSets :: tuple_of(anyset())). +from_sets(Ss) when is_list(Ss) -> + case set_of_sets(Ss, [], ?ANYTYPE) of + {error, Error} -> + erlang:error(Error); + Set -> + Set + end; +from_sets(Tuple) when is_tuple(Tuple) -> + case ordset_of_sets(tuple_to_list(Tuple), [], []) of + error -> + erlang:error(badarg); + Set -> + Set + end; +from_sets(_) -> + erlang:error(badarg). + +-spec(relation(Tuples) -> Relation when + Relation :: relation(), + Tuples :: [tuple()]). +relation([]) -> + ?SET([], ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)); +relation(Ts = [T | _]) when is_tuple(T) -> + try rel(Ts, tuple_size(T)) + catch _:_ -> erlang:error(badarg) + end; +relation(_) -> + erlang:error(badarg). + +-spec(relation(Tuples, Type) -> Relation when + N :: integer(), + Type :: N | type(), + Relation :: relation(), + Tuples :: [tuple()]). +relation(Ts, TS) -> + try rel(Ts, TS) + catch _:_ -> erlang:error(badarg) + end. + +-spec(a_function(Tuples) -> Function when + Function :: a_function(), + Tuples :: [tuple()]). +a_function(Ts) -> + try func(Ts, ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)) of + Bad when is_atom(Bad) -> + erlang:error(Bad); + Set -> + Set + catch _:_ -> erlang:error(badarg) + end. + +-spec(a_function(Tuples, Type) -> Function when + Function :: a_function(), + Tuples :: [tuple()], + Type :: type()). +a_function(Ts, T) -> + try a_func(Ts, T) of + Bad when is_atom(Bad) -> + erlang:error(Bad); + Set -> + Set + catch _:_ -> erlang:error(badarg) + end. + +-spec(family(Tuples) -> Family when + Family :: family(), + Tuples :: [tuple()]). +family(Ts) -> + try fam2(Ts, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) of + Bad when is_atom(Bad) -> + erlang:error(Bad); + Set -> + Set + catch _:_ -> erlang:error(badarg) + end. + +-spec(family(Tuples, Type) -> Family when + Family :: family(), + Tuples :: [tuple()], + Type :: type()). +family(Ts, T) -> + try fam(Ts, T) of + Bad when is_atom(Bad) -> + erlang:error(Bad); + Set -> + Set + catch _:_ -> erlang:error(badarg) + end. + +%%% +%%% Functions on sets. +%%% + +-spec(to_external(AnySet) -> ExternalSet when + ExternalSet :: external_set(), + AnySet :: anyset()). +to_external(S) when ?IS_SET(S) -> + ?LIST(S); +to_external(S) when ?IS_ORDSET(S) -> + ?ORDDATA(S). + +-spec(type(AnySet) -> Type when + AnySet :: anyset(), + Type :: type()). +type(S) when ?IS_SET(S) -> + ?SET_OF(?TYPE(S)); +type(S) when ?IS_ORDSET(S) -> + ?ORDTYPE(S). + +-spec(to_sets(ASet) -> Sets when + ASet :: a_set() | ordset(), + Sets :: tuple_of(AnySet) | [AnySet], + AnySet :: anyset()). +to_sets(S) when ?IS_SET(S) -> + case ?TYPE(S) of + ?SET_OF(Type) -> list_of_sets(?LIST(S), Type, []); + Type -> list_of_ordsets(?LIST(S), Type, []) + end; +to_sets(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) -> + tuple_of_sets(tuple_to_list(?ORDDATA(S)), tuple_to_list(?ORDTYPE(S)), []); +to_sets(S) when ?IS_ORDSET(S) -> + erlang:error(badarg). + +-spec(no_elements(ASet) -> NoElements when + ASet :: a_set() | ordset(), + NoElements :: non_neg_integer()). +no_elements(S) when ?IS_SET(S) -> + length(?LIST(S)); +no_elements(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) -> + tuple_size(?ORDDATA(S)); +no_elements(S) when ?IS_ORDSET(S) -> + erlang:error(badarg). + +-spec(specification(Fun, Set1) -> Set2 when + Fun :: spec_fun(), + Set1 :: a_set(), + Set2 :: a_set()). +specification(Fun, S) when ?IS_SET(S) -> + Type = ?TYPE(S), + R = case external_fun(Fun) of + false -> + spec(?LIST(S), Fun, element_type(Type), []); + XFun -> + specification(?LIST(S), XFun, []) + end, + case R of + SL when is_list(SL) -> + ?SET(SL, Type); + Bad -> + erlang:error(Bad) + end. + +-spec(union(Set1, Set2) -> Set3 when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +union(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> ?SET(umerge(?LIST(S1), ?LIST(S2)), Type) + end. + +-spec(intersection(Set1, Set2) -> Set3 when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +intersection(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> ?SET(intersection(?LIST(S1), ?LIST(S2), []), Type) + end. + +-spec(difference(Set1, Set2) -> Set3 when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +difference(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> ?SET(difference(?LIST(S1), ?LIST(S2), []), Type) + end. + +-spec(symdiff(Set1, Set2) -> Set3 when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +symdiff(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> ?SET(symdiff(?LIST(S1), ?LIST(S2), []), Type) + end. + +-spec(symmetric_partition(Set1, Set2) -> {Set3, Set4, Set5} when + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set(), + Set4 :: a_set(), + Set5 :: a_set()). +symmetric_partition(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case unify_types(?TYPE(S1), ?TYPE(S2)) of + [] -> erlang:error(type_mismatch); + Type -> sympart(?LIST(S1), ?LIST(S2), [], [], [], Type) + end. + +-spec(product(Set1, Set2) -> BinRel when + BinRel :: binary_relation(), + Set1 :: a_set(), + Set2 :: a_set()). +product(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + if + ?TYPE(S1) =:= ?ANYTYPE -> S1; + ?TYPE(S2) =:= ?ANYTYPE -> S2; + true -> + F = fun(E) -> {0, E} end, + T = ?BINREL(?TYPE(S1), ?TYPE(S2)), + ?SET(relprod(map(F, ?LIST(S1)), map(F, ?LIST(S2))), T) + end. + +-spec(product(TupleOfSets) -> Relation when + Relation :: relation(), + TupleOfSets :: tuple_of(a_set())). +product({S1, S2}) -> + product(S1, S2); +product(T) when is_tuple(T) -> + Ss = tuple_to_list(T), + try sets_to_list(Ss) of + [] -> + erlang:error(badarg); + L -> + Type = types(Ss, []), + case member([], L) of + true -> + empty_set(); + false -> + ?SET(reverse(prod(L, [], [])), Type) + end + catch _:_ -> erlang:error(badarg) + end. + +-spec(constant_function(Set, AnySet) -> Function when + AnySet :: anyset(), + Function :: a_function(), + Set :: a_set()). +constant_function(S, E) when ?IS_SET(S) -> + case {?TYPE(S), is_sofs_set(E)} of + {?ANYTYPE, true} -> S; + {Type, true} -> + NType = ?BINREL(Type, type(E)), + ?SET(constant_function(?LIST(S), to_external(E), []), NType); + _ -> erlang:error(badarg) + end; +constant_function(S, _) when ?IS_ORDSET(S) -> + erlang:error(badarg). + +-spec(is_equal(AnySet1, AnySet2) -> Bool when + AnySet1 :: anyset(), + AnySet2 :: anyset(), + Bool :: boolean()). +is_equal(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case match_types(?TYPE(S1), ?TYPE(S2)) of + true -> ?LIST(S1) == ?LIST(S2); + false -> erlang:error(type_mismatch) + end; +is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_ORDSET(S2) -> + case match_types(?ORDTYPE(S1), ?ORDTYPE(S2)) of + true -> ?ORDDATA(S1) == ?ORDDATA(S2); + false -> erlang:error(type_mismatch) + end; +is_equal(S1, S2) when ?IS_SET(S1), ?IS_ORDSET(S2) -> + erlang:error(type_mismatch); +is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_SET(S2) -> + erlang:error(type_mismatch). + +-spec(is_subset(Set1, Set2) -> Bool when + Bool :: boolean(), + Set1 :: a_set(), + Set2 :: a_set()). +is_subset(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case match_types(?TYPE(S1), ?TYPE(S2)) of + true -> subset(?LIST(S1), ?LIST(S2)); + false -> erlang:error(type_mismatch) + end. + +-spec(is_sofs_set(Term) -> Bool when + Bool :: boolean(), + Term :: term()). +is_sofs_set(S) when ?IS_SET(S) -> + true; +is_sofs_set(S) when ?IS_ORDSET(S) -> + true; +is_sofs_set(_S) -> + false. + +-spec(is_set(AnySet) -> Bool when + AnySet :: anyset(), + Bool :: boolean()). +is_set(S) when ?IS_SET(S) -> + true; +is_set(S) when ?IS_ORDSET(S) -> + false. + +-spec(is_empty_set(AnySet) -> Bool when + AnySet :: anyset(), + Bool :: boolean()). +is_empty_set(S) when ?IS_SET(S) -> + ?LIST(S) =:= []; +is_empty_set(S) when ?IS_ORDSET(S) -> + false. + +-spec(is_disjoint(Set1, Set2) -> Bool when + Bool :: boolean(), + Set1 :: a_set(), + Set2 :: a_set()). +is_disjoint(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + case match_types(?TYPE(S1), ?TYPE(S2)) of + true -> + case ?LIST(S1) of + [] -> true; + [A | As] -> disjoint(?LIST(S2), A, As) + end; + false -> erlang:error(type_mismatch) + end. + +%%% +%%% Functions on set-of-sets. +%%% + +-spec(union(SetOfSets) -> Set when + Set :: a_set(), + SetOfSets :: set_of_sets()). +union(Sets) when ?IS_SET(Sets) -> + case ?TYPE(Sets) of + ?SET_OF(Type) -> ?SET(lunion(?LIST(Sets)), Type); + ?ANYTYPE -> Sets; + _ -> erlang:error(badarg) + end. + +-spec(intersection(SetOfSets) -> Set when + Set :: a_set(), + SetOfSets :: set_of_sets()). +intersection(Sets) when ?IS_SET(Sets) -> + case ?LIST(Sets) of + [] -> erlang:error(badarg); + [L | Ls] -> + case ?TYPE(Sets) of + ?SET_OF(Type) -> + ?SET(lintersection(Ls, L), Type); + _ -> erlang:error(badarg) + end + end. + +-spec(canonical_relation(SetOfSets) -> BinRel when + BinRel :: binary_relation(), + SetOfSets :: set_of_sets()). +canonical_relation(Sets) when ?IS_SET(Sets) -> + ST = ?TYPE(Sets), + case ST of + ?SET_OF(?ANYTYPE) -> empty_set(); + ?SET_OF(Type) -> + ?SET(can_rel(?LIST(Sets), []), ?BINREL(Type, ST)); + ?ANYTYPE -> Sets; + _ -> erlang:error(badarg) + end. + +%%% +%%% Functions on binary relations only. +%%% + +-spec(rel2fam(BinRel) -> Family when + Family :: family(), + BinRel :: binary_relation()). +rel2fam(R) -> + relation_to_family(R). + +-spec(relation_to_family(BinRel) -> Family when + Family :: family(), + BinRel :: binary_relation()). +%% Inlined. +relation_to_family(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> + ?SET(rel2family(?LIST(R)), ?FAMILY(DT, RT)); + ?ANYTYPE -> R; + _Else -> erlang:error(badarg) + end. + +-spec(domain(BinRel) -> Set when + BinRel :: binary_relation(), + Set :: a_set()). +domain(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(DT, _) -> ?SET(dom(?LIST(R)), DT); + ?ANYTYPE -> R; + _Else -> erlang:error(badarg) + end. + +-spec(range(BinRel) -> Set when + BinRel :: binary_relation(), + Set :: a_set()). +range(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(_, RT) -> ?SET(ran(?LIST(R), []), RT); + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(field(BinRel) -> Set when + BinRel :: binary_relation(), + Set :: a_set()). +%% In "Introduction to LOGIC", Suppes defines the field of a binary +%% relation to be the union of the domain and the range (or +%% counterdomain). +field(R) -> + union(domain(R), range(R)). + +-spec(relative_product(ListOfBinRels) -> BinRel2 when + ListOfBinRels :: [BinRel, ...], + BinRel :: binary_relation(), + BinRel2 :: binary_relation()). +%% The following clause is kept for backward compatibility. +%% The list is due to Dialyzer's specs. +relative_product(RT) when is_tuple(RT) -> + relative_product(tuple_to_list(RT)); +relative_product(RL) when is_list(RL) -> + case relprod_n(RL, foo, false, false) of + {error, Reason} -> + erlang:error(Reason); + Reply -> + Reply + end. + +-spec(relative_product(ListOfBinRels, BinRel1) -> BinRel2 when + ListOfBinRels :: [BinRel, ...], + BinRel :: binary_relation(), + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(); + (BinRel1, BinRel2) -> BinRel3 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + BinRel3 :: binary_relation()). +relative_product(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) -> + relative_product1(converse(R1), R2); +%% The following clause is kept for backward compatibility. +%% The list is due to Dialyzer's specs. +relative_product(RT, R) when is_tuple(RT), ?IS_SET(R) -> + relative_product(tuple_to_list(RT), R); +relative_product(RL, R) when is_list(RL), ?IS_SET(R) -> + EmptyR = case ?TYPE(R) of + ?BINREL(_, _) -> ?LIST(R) =:= []; + ?ANYTYPE -> true; + _ -> erlang:error(badarg) + end, + case relprod_n(RL, R, EmptyR, true) of + {error, Reason} -> + erlang:error(Reason); + Reply -> + Reply + end. + +-spec(relative_product1(BinRel1, BinRel2) -> BinRel3 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + BinRel3 :: binary_relation()). +relative_product1(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) -> + {DTR1, RTR1} = case ?TYPE(R1) of + ?BINREL(_, _) = R1T -> R1T; + ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; + _ -> erlang:error(badarg) + end, + {DTR2, RTR2} = case ?TYPE(R2) of + ?BINREL(_, _) = R2T -> R2T; + ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; + _ -> erlang:error(badarg) + end, + case match_types(DTR1, DTR2) of + true when DTR1 =:= ?ANYTYPE -> R1; + true when DTR2 =:= ?ANYTYPE -> R2; + true -> ?SET(relprod(?LIST(R1), ?LIST(R2)), ?BINREL(RTR1, RTR2)); + false -> erlang:error(type_mismatch) + end. + +-spec(converse(BinRel1) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation()). +converse(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> ?SET(converse(?LIST(R), []), ?BINREL(RT, DT)); + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(image(BinRel, Set1) -> Set2 when + BinRel :: binary_relation(), + Set1 :: a_set(), + Set2 :: a_set()). +image(R, S) when ?IS_SET(R), ?IS_SET(S) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> + case match_types(DT, ?TYPE(S)) of + true -> + ?SET(usort(restrict(?LIST(S), ?LIST(R))), RT); + false -> + erlang:error(type_mismatch) + end; + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(inverse_image(BinRel, Set1) -> Set2 when + BinRel :: binary_relation(), + Set1 :: a_set(), + Set2 :: a_set()). +inverse_image(R, S) when ?IS_SET(R), ?IS_SET(S) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> + case match_types(RT, ?TYPE(S)) of + true -> + NL = restrict(?LIST(S), converse(?LIST(R), [])), + ?SET(usort(NL), DT); + false -> + erlang:error(type_mismatch) + end; + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(strict_relation(BinRel1) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation()). +strict_relation(R) when ?IS_SET(R) -> + case ?TYPE(R) of + Type = ?BINREL(_, _) -> + ?SET(strict(?LIST(R), []), Type); + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(weak_relation(BinRel1) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation()). +weak_relation(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(DT, RT) -> + case unify_types(DT, RT) of + [] -> + erlang:error(badarg); + Type -> + ?SET(weak(?LIST(R)), ?BINREL(Type, Type)) + end; + ?ANYTYPE -> R; + _ -> erlang:error(badarg) + end. + +-spec(extension(BinRel1, Set, AnySet) -> BinRel2 when + AnySet :: anyset(), + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + Set :: a_set()). +extension(R, S, E) when ?IS_SET(R), ?IS_SET(S) -> + case {?TYPE(R), ?TYPE(S), is_sofs_set(E)} of + {T=?BINREL(DT, RT), ST, true} -> + case match_types(DT, ST) and match_types(RT, type(E)) of + false -> + erlang:error(type_mismatch); + true -> + RL = ?LIST(R), + case extc([], ?LIST(S), to_external(E), RL) of + [] -> + R; + L -> + ?SET(merge(RL, reverse(L)), T) + end + end; + {?ANYTYPE, ?ANYTYPE, true} -> + R; + {?ANYTYPE, ST, true} -> + case type(E) of + ?SET_OF(?ANYTYPE) -> + R; + ET -> + ?SET([], ?BINREL(ST, ET)) + end; + {_, _, true} -> + erlang:error(badarg) + end. + +-spec(is_a_function(BinRel) -> Bool when + Bool :: boolean(), + BinRel :: binary_relation()). +is_a_function(R) when ?IS_SET(R) -> + case ?TYPE(R) of + ?BINREL(_, _) -> + case ?LIST(R) of + [] -> true; + [{V,_} | Es] -> is_a_func(Es, V) + end; + ?ANYTYPE -> true; + _ -> erlang:error(badarg) + end. + +-spec(restriction(BinRel1, Set) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + Set :: a_set()). +restriction(Relation, Set) -> + restriction(1, Relation, Set). + +-spec(drestriction(BinRel1, Set) -> BinRel2 when + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation(), + Set :: a_set()). +drestriction(Relation, Set) -> + drestriction(1, Relation, Set). + +%%% +%%% Functions on functions only. +%%% + +-spec(composite(Function1, Function2) -> Function3 when + Function1 :: a_function(), + Function2 :: a_function(), + Function3 :: a_function()). +composite(Fn1, Fn2) when ?IS_SET(Fn1), ?IS_SET(Fn2) -> + ?BINREL(DTF1, RTF1) = case ?TYPE(Fn1)of + ?BINREL(_, _) = F1T -> F1T; + ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; + _ -> erlang:error(badarg) + end, + ?BINREL(DTF2, RTF2) = case ?TYPE(Fn2) of + ?BINREL(_, _) = F2T -> F2T; + ?ANYTYPE -> {?ANYTYPE, ?ANYTYPE}; + _ -> erlang:error(badarg) + end, + case match_types(RTF1, DTF2) of + true when DTF1 =:= ?ANYTYPE -> Fn1; + true when DTF2 =:= ?ANYTYPE -> Fn2; + true -> + case comp(?LIST(Fn1), ?LIST(Fn2)) of + SL when is_list(SL) -> + ?SET(sort(SL), ?BINREL(DTF1, RTF2)); + Bad -> + erlang:error(Bad) + end; + false -> erlang:error(type_mismatch) + end. + +-spec(inverse(Function1) -> Function2 when + Function1 :: a_function(), + Function2 :: a_function()). +inverse(Fn) when ?IS_SET(Fn) -> + case ?TYPE(Fn) of + ?BINREL(DT, RT) -> + case inverse1(?LIST(Fn)) of + SL when is_list(SL) -> + ?SET(SL, ?BINREL(RT, DT)); + Bad -> + erlang:error(Bad) + end; + ?ANYTYPE -> Fn; + _ -> erlang:error(badarg) + end. + +%%% +%%% Functions on relations (binary or other). +%%% + +-spec(restriction(SetFun, Set1, Set2) -> Set3 when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +%% Equivalent to range(restriction(inverse(substitution(Fun, S1)), S2)). +restriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) -> + RT = ?TYPE(R), + ST = ?TYPE(S), + case check_for_sort(RT, I) of + empty -> + R; + error -> + erlang:error(badarg); + Sort -> + RL = ?LIST(R), + case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of + {true, _SL} when RL =:= [] -> + R; + {true, []} -> + ?SET([], RT); + {true, [E | Es]} when Sort =:= false -> % I =:= 1 + ?SET(reverse(restrict_n(I, RL, E, Es, [])), RT); + {true, [E | Es]} -> + ?SET(sort(restrict_n(I, keysort(I, RL), E, Es, [])), RT); + {false, _SL} -> + erlang:error(type_mismatch) + end + end; +restriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + Type1 = ?TYPE(S1), + Type2 = ?TYPE(S2), + SL1 = ?LIST(S1), + case external_fun(SetFun) of + false when Type2 =:= ?ANYTYPE -> + S2; + false -> + case subst(SL1, SetFun, element_type(Type1)) of + {NSL, NewType} -> % NewType can be ?ANYTYPE + case match_types(NewType, Type2) of + true -> + NL = sort(restrict(?LIST(S2), converse(NSL, []))), + ?SET(NL, Type1); + false -> + erlang:error(type_mismatch) + end; + Bad -> + erlang:error(Bad) + end; + _ when Type1 =:= ?ANYTYPE -> + S1; + _XFun when ?IS_SET_OF(Type1) -> + erlang:error(badarg); + XFun -> + FunT = XFun(Type1), + try check_fun(Type1, XFun, FunT) of + Sort -> + case match_types(FunT, Type2) of + true -> + R1 = inverse_substitution(SL1, XFun, Sort), + ?SET(sort(Sort, restrict(?LIST(S2), R1)), Type1); + false -> + erlang:error(type_mismatch) + end + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(drestriction(SetFun, Set1, Set2) -> Set3 when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set()). +drestriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) -> + RT = ?TYPE(R), + ST = ?TYPE(S), + case check_for_sort(RT, I) of + empty -> + R; + error -> + erlang:error(badarg); + Sort -> + RL = ?LIST(R), + case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of + {true, []} -> + R; + {true, _SL} when RL =:= [] -> + R; + {true, [E | Es]} when Sort =:= false -> % I =:= 1 + ?SET(diff_restrict_n(I, RL, E, Es, []), RT); + {true, [E | Es]} -> + ?SET(diff_restrict_n(I, keysort(I, RL), E, Es, []), RT); + {false, _SL} -> + erlang:error(type_mismatch) + end + end; +drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + Type1 = ?TYPE(S1), + Type2 = ?TYPE(S2), + SL1 = ?LIST(S1), + case external_fun(SetFun) of + false when Type2 =:= ?ANYTYPE -> + S1; + false -> + case subst(SL1, SetFun, element_type(Type1)) of + {NSL, NewType} -> % NewType can be ?ANYTYPE + case match_types(NewType, Type2) of + true -> + SL2 = ?LIST(S2), + NL = sort(diff_restrict(SL2, converse(NSL, []))), + ?SET(NL, Type1); + false -> + erlang:error(type_mismatch) + end; + Bad -> + erlang:error(Bad) + end; + _ when Type1 =:= ?ANYTYPE -> + S1; + _XFun when ?IS_SET_OF(Type1) -> + erlang:error(badarg); + XFun -> + FunT = XFun(Type1), + try check_fun(Type1, XFun, FunT) of + Sort -> + case match_types(FunT, Type2) of + true -> + R1 = inverse_substitution(SL1, XFun, Sort), + SL2 = ?LIST(S2), + ?SET(sort(Sort, diff_restrict(SL2, R1)), Type1); + false -> + erlang:error(type_mismatch) + end + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(projection(SetFun, Set1) -> Set2 when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set()). +projection(I, Set) when is_integer(I), ?IS_SET(Set) -> + Type = ?TYPE(Set), + case check_for_sort(Type, I) of + empty -> + Set; + error -> + erlang:error(badarg); + _ when I =:= 1 -> + ?SET(projection1(?LIST(Set)), ?REL_TYPE(I, Type)); + _ -> + ?SET(projection_n(?LIST(Set), I, []), ?REL_TYPE(I, Type)) + end; +projection(Fun, Set) -> + range(substitution(Fun, Set)). + +-spec(substitution(SetFun, Set1) -> Set2 when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set()). +substitution(I, Set) when is_integer(I), ?IS_SET(Set) -> + Type = ?TYPE(Set), + case check_for_sort(Type, I) of + empty -> + Set; + error -> + erlang:error(badarg); + _Sort -> + NType = ?REL_TYPE(I, Type), + NSL = substitute_element(?LIST(Set), I, []), + ?SET(NSL, ?BINREL(Type, NType)) + end; +substitution(SetFun, Set) when ?IS_SET(Set) -> + Type = ?TYPE(Set), + L = ?LIST(Set), + case external_fun(SetFun) of + false when L =/= [] -> + case subst(L, SetFun, element_type(Type)) of + {SL, NewType} -> + ?SET(reverse(SL), ?BINREL(Type, NewType)); + Bad -> + erlang:error(Bad) + end; + false -> + empty_set(); + _ when Type =:= ?ANYTYPE -> + empty_set(); + _XFun when ?IS_SET_OF(Type) -> + erlang:error(badarg); + XFun -> + FunT = XFun(Type), + try check_fun(Type, XFun, FunT) of + _Sort -> + SL = substitute(L, XFun, []), + ?SET(SL, ?BINREL(Type, FunT)) + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(partition(SetOfSets) -> Partition when + SetOfSets :: set_of_sets(), + Partition :: a_set()). +partition(Sets) -> + F1 = relation_to_family(canonical_relation(Sets)), + F2 = relation_to_family(converse(F1)), + range(F2). + +-spec(partition(SetFun, Set) -> Partition when + SetFun :: set_fun(), + Partition :: a_set(), + Set :: a_set()). +partition(I, Set) when is_integer(I), ?IS_SET(Set) -> + Type = ?TYPE(Set), + case check_for_sort(Type, I) of + empty -> + Set; + error -> + erlang:error(badarg); + false -> % I =:= 1 + ?SET(partition_n(I, ?LIST(Set)), ?SET_OF(Type)); + true -> + ?SET(partition_n(I, keysort(I, ?LIST(Set))), ?SET_OF(Type)) + end; +partition(Fun, Set) -> + range(partition_family(Fun, Set)). + +-spec(partition(SetFun, Set1, Set2) -> {Set3, Set4} when + SetFun :: set_fun(), + Set1 :: a_set(), + Set2 :: a_set(), + Set3 :: a_set(), + Set4 :: a_set()). +partition(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) -> + RT = ?TYPE(R), + ST = ?TYPE(S), + case check_for_sort(RT, I) of + empty -> + {R, R}; + error -> + erlang:error(badarg); + Sort -> + RL = ?LIST(R), + case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of + {true, _SL} when RL =:= [] -> + {R, R}; + {true, []} -> + {?SET([], RT), R}; + {true, [E | Es]} when Sort =:= false -> % I =:= 1 + [L1 | L2] = partition3_n(I, RL, E, Es, [], []), + {?SET(L1, RT), ?SET(L2, RT)}; + {true, [E | Es]} -> + [L1 | L2] = partition3_n(I, keysort(I,RL), E, Es, [], []), + {?SET(L1, RT), ?SET(L2, RT)}; + {false, _SL} -> + erlang:error(type_mismatch) + end + end; +partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) -> + Type1 = ?TYPE(S1), + Type2 = ?TYPE(S2), + SL1 = ?LIST(S1), + case external_fun(SetFun) of + false when Type2 =:= ?ANYTYPE -> + {S2, S1}; + false -> + case subst(SL1, SetFun, element_type(Type1)) of + {NSL, NewType} -> % NewType can be ?ANYTYPE + case match_types(NewType, Type2) of + true -> + R1 = converse(NSL, []), + [L1 | L2] = partition3(?LIST(S2), R1), + {?SET(sort(L1), Type1), ?SET(sort(L2), Type1)}; + false -> + erlang:error(type_mismatch) + end; + Bad -> + erlang:error(Bad) + end; + _ when Type1 =:= ?ANYTYPE -> + {S1, S1}; + _XFun when ?IS_SET_OF(Type1) -> + erlang:error(badarg); + XFun -> + FunT = XFun(Type1), + try check_fun(Type1, XFun, FunT) of + Sort -> + case match_types(FunT, Type2) of + true -> + R1 = inverse_substitution(SL1, XFun, Sort), + [L1 | L2] = partition3(?LIST(S2), R1), + {?SET(sort(L1), Type1), ?SET(sort(L2), Type1)}; + false -> + erlang:error(type_mismatch) + end + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(multiple_relative_product(TupleOfBinRels, BinRel1) -> BinRel2 when + TupleOfBinRels :: tuple_of(BinRel), + BinRel :: binary_relation(), + BinRel1 :: binary_relation(), + BinRel2 :: binary_relation()). +multiple_relative_product(T, R) when is_tuple(T), ?IS_SET(R) -> + case test_rel(R, tuple_size(T), eq) of + true when ?TYPE(R) =:= ?ANYTYPE -> + empty_set(); + true -> + MProd = mul_relprod(tuple_to_list(T), 1, R), + relative_product(MProd); + false -> + erlang:error(badarg) + end. + +-spec(join(Relation1, I, Relation2, J) -> Relation3 when + Relation1 :: relation(), + Relation2 :: relation(), + Relation3 :: relation(), + I :: pos_integer(), + J :: pos_integer()). +join(R1, I1, R2, I2) + when ?IS_SET(R1), ?IS_SET(R2), is_integer(I1), is_integer(I2) -> + case test_rel(R1, I1, lte) and test_rel(R2, I2, lte) of + false -> erlang:error(badarg); + true when ?TYPE(R1) =:= ?ANYTYPE -> R1; + true when ?TYPE(R2) =:= ?ANYTYPE -> R2; + true -> + L1 = ?LIST(raise_element(R1, I1)), + L2 = ?LIST(raise_element(R2, I2)), + T = relprod1(L1, L2), + F = case (I1 =:= 1) and (I2 =:= 1) of + true -> + fun({X,Y}) -> join_element(X, Y) end; + false -> + fun({X,Y}) -> + list_to_tuple(join_element(X, Y, I2)) + end + end, + ?SET(replace(T, F, []), F({?TYPE(R1), ?TYPE(R2)})) + end. + +%% Inlined. +test_rel(R, I, C) -> + case ?TYPE(R) of + Rel when ?IS_RELATION(Rel), C =:= eq, I =:= ?REL_ARITY(Rel) -> true; + Rel when ?IS_RELATION(Rel), C =:= lte, I>=1, I =< ?REL_ARITY(Rel) -> + true; + ?ANYTYPE -> true; + _ -> false + end. + +%%% +%%% Family functions +%%% + +-spec(fam2rel(Family) -> BinRel when + Family :: family(), + BinRel :: binary_relation()). +fam2rel(F) -> + family_to_relation(F). + +-spec(family_to_relation(Family) -> BinRel when + Family :: family(), + BinRel :: binary_relation()). +%% Inlined. +family_to_relation(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(DT, RT) -> + ?SET(family2rel(?LIST(F), []), ?BINREL(DT, RT)); + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_specification(Fun, Family1) -> Family2 when + Fun :: spec_fun(), + Family1 :: family(), + Family2 :: family()). +family_specification(Fun, F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_DT, Type) = FType -> + R = case external_fun(Fun) of + false -> + fam_spec(?LIST(F), Fun, Type, []); + XFun -> + fam_specification(?LIST(F), XFun, []) + end, + case R of + SL when is_list(SL) -> + ?SET(SL, FType); + Bad -> + erlang:error(Bad) + end; + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(union_of_family(Family) -> Set when + Family :: family(), + Set :: a_set()). +union_of_family(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_DT, Type) -> + ?SET(un_of_fam(?LIST(F), []), Type); + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(intersection_of_family(Family) -> Set when + Family :: family(), + Set :: a_set()). +intersection_of_family(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_DT, Type) -> + case int_of_fam(?LIST(F)) of + FU when is_list(FU) -> + ?SET(FU, Type); + Bad -> + erlang:error(Bad) + end; + _ -> erlang:error(badarg) + end. + +-spec(family_union(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_union(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(DT, ?SET_OF(Type)) -> + ?SET(fam_un(?LIST(F), []), ?FAMILY(DT, Type)); + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_intersection(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_intersection(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(DT, ?SET_OF(Type)) -> + case fam_int(?LIST(F), []) of + FU when is_list(FU) -> + ?SET(FU, ?FAMILY(DT, Type)); + Bad -> + erlang:error(Bad) + end; + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_domain(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_domain(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(FDT, ?BINREL(DT, _)) -> + ?SET(fam_dom(?LIST(F), []), ?FAMILY(FDT, DT)); + ?ANYTYPE -> F; + ?FAMILY(_, ?ANYTYPE) -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_range(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_range(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(DT, ?BINREL(_, RT)) -> + ?SET(fam_ran(?LIST(F), []), ?FAMILY(DT, RT)); + ?ANYTYPE -> F; + ?FAMILY(_, ?ANYTYPE) -> F; + _ -> erlang:error(badarg) + end. + +-spec(family_field(Family1) -> Family2 when + Family1 :: family(), + Family2 :: family()). +family_field(F) -> + family_union(family_domain(F), family_range(F)). + +-spec(family_union(Family1, Family2) -> Family3 when + Family1 :: family(), + Family2 :: family(), + Family3 :: family()). +family_union(F1, F2) -> + fam_binop(F1, F2, fun fam_union/3). + +-spec(family_intersection(Family1, Family2) -> Family3 when + Family1 :: family(), + Family2 :: family(), + Family3 :: family()). +family_intersection(F1, F2) -> + fam_binop(F1, F2, fun fam_intersect/3). + +-spec(family_difference(Family1, Family2) -> Family3 when + Family1 :: family(), + Family2 :: family(), + Family3 :: family()). +family_difference(F1, F2) -> + fam_binop(F1, F2, fun fam_difference/3). + +%% Inlined. +fam_binop(F1, F2, FF) when ?IS_SET(F1), ?IS_SET(F2) -> + case unify_types(?TYPE(F1), ?TYPE(F2)) of + [] -> + erlang:error(type_mismatch); + ?ANYTYPE -> + F1; + Type = ?FAMILY(_, _) -> + ?SET(FF(?LIST(F1), ?LIST(F2), []), Type); + _ -> erlang:error(badarg) + end. + +-spec(partition_family(SetFun, Set) -> Family when + Family :: family(), + SetFun :: set_fun(), + Set :: a_set()). +partition_family(I, Set) when is_integer(I), ?IS_SET(Set) -> + Type = ?TYPE(Set), + case check_for_sort(Type, I) of + empty -> + Set; + error -> + erlang:error(badarg); + false -> % when I =:= 1 + ?SET(fam_partition_n(I, ?LIST(Set)), + ?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type))); + true -> + ?SET(fam_partition_n(I, keysort(I, ?LIST(Set))), + ?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type))) + end; +partition_family(SetFun, Set) when ?IS_SET(Set) -> + Type = ?TYPE(Set), + SL = ?LIST(Set), + case external_fun(SetFun) of + false when SL =/= [] -> + case subst(SL, SetFun, element_type(Type)) of + {NSL, NewType} -> + P = fam_partition(converse(NSL, []), true), + ?SET(reverse(P), ?BINREL(NewType, ?SET_OF(Type))); + Bad -> + erlang:error(Bad) + end; + false -> + empty_set(); + _ when Type =:= ?ANYTYPE -> + empty_set(); + _XFun when ?IS_SET_OF(Type) -> + erlang:error(badarg); + XFun -> + DType = XFun(Type), + try check_fun(Type, XFun, DType) of + Sort -> + Ts = inverse_substitution(?LIST(Set), XFun, Sort), + P = fam_partition(Ts, Sort), + ?SET(reverse(P), ?BINREL(DType, ?SET_OF(Type))) + catch _:_ -> erlang:error(badarg) + end + end. + +-spec(family_projection(SetFun, Family1) -> Family2 when + SetFun :: set_fun(), + Family1 :: family(), + Family2 :: family()). +family_projection(SetFun, F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_, _) when [] =:= ?LIST(F) -> + empty_set(); + ?FAMILY(DT, Type) -> + case external_fun(SetFun) of + false -> + case fam_proj(?LIST(F), SetFun, Type, ?ANYTYPE, []) of + {SL, NewType} -> + ?SET(SL, ?BINREL(DT, NewType)); + Bad -> + erlang:error(Bad) + end; + _ -> + erlang:error(badarg) + end; + ?ANYTYPE -> F; + _ -> erlang:error(badarg) + end. + +%%% +%%% Digraph functions +%%% + +-spec(family_to_digraph(Family) -> Graph when + Graph :: digraph:graph(), + Family :: family()). +family_to_digraph(F) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_, _) -> fam2digraph(F, digraph:new()); + ?ANYTYPE -> digraph:new(); + _Else -> erlang:error(badarg) + end. + +-spec(family_to_digraph(Family, GraphType) -> Graph when + Graph :: digraph:graph(), + Family :: family(), + GraphType :: [digraph:d_type()]). +family_to_digraph(F, Type) when ?IS_SET(F) -> + case ?TYPE(F) of + ?FAMILY(_, _) -> ok; + ?ANYTYPE -> ok; + _Else -> erlang:error(badarg) + end, + try digraph:new(Type) of + G -> case catch fam2digraph(F, G) of + {error, Reason} -> + true = digraph:delete(G), + erlang:error(Reason); + _ -> + G + end + catch + error:badarg -> erlang:error(badarg) + end. + +-spec(digraph_to_family(Graph) -> Family when + Graph :: digraph:graph(), + Family :: family()). +digraph_to_family(G) -> + try digraph_family(G) of + L -> ?SET(L, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) + catch _:_ -> erlang:error(badarg) + end. + +-spec(digraph_to_family(Graph, Type) -> Family when + Graph :: digraph:graph(), + Family :: family(), + Type :: type()). +digraph_to_family(G, T) -> + case {is_type(T), T} of + {true, ?SET_OF(?FAMILY(_,_) = Type)} -> + try digraph_family(G) of + L -> ?SET(L, Type) + catch _:_ -> erlang:error(badarg) + end; + _ -> + erlang:error(badarg) + end. + +%% +%% Local functions +%% + +%% Type = OrderedSetType +%% | SetType +%% | atom() except '_' +%% OrderedSetType = {Type, ..., Type} +%% SetType = [ElementType] % list of exactly one element +%% ElementType = '_' % any type (implies empty set) +%% | Type + +is_types(0, _T) -> + true; +is_types(I, T) -> + case is_type(?REL_TYPE(I, T)) of + true -> is_types(I-1, T); + false -> false + end. + +is_element_type(?ANYTYPE) -> + true; +is_element_type(T) -> + is_type(T). + +set_of_sets([S | Ss], L, T0) when ?IS_SET(S) -> + case unify_types([?TYPE(S)], T0) of + [] -> {error, type_mismatch}; + Type -> set_of_sets(Ss, [?LIST(S) | L], Type) + end; +set_of_sets([S | Ss], L, T0) when ?IS_ORDSET(S) -> + case unify_types(?ORDTYPE(S), T0) of + [] -> {error, type_mismatch}; + Type -> set_of_sets(Ss, [?ORDDATA(S) | L], Type) + end; +set_of_sets([], L, T) -> + ?SET(usort(L), T); +set_of_sets(_, _L, _T) -> + {error, badarg}. + +ordset_of_sets([S | Ss], L, T) when ?IS_SET(S) -> + ordset_of_sets(Ss, [?LIST(S) | L], [[?TYPE(S)] | T]); +ordset_of_sets([S | Ss], L, T) when ?IS_ORDSET(S) -> + ordset_of_sets(Ss, [?ORDDATA(S) | L], [?ORDTYPE(S) | T]); +ordset_of_sets([], L, T) -> + ?ORDSET(list_to_tuple(reverse(L)), list_to_tuple(reverse(T))); +ordset_of_sets(_, _L, _T) -> + error. + +%% Inlined. +rel(Ts, [Type]) -> + case is_type(Type) and atoms_only(Type, 1) of + true -> + rel(Ts, tuple_size(Type), Type); + false -> + rel_type(Ts, [], Type) + end; +rel(Ts, Sz) -> + rel(Ts, Sz, erlang:make_tuple(Sz, ?ATOM_TYPE)). + +atoms_only(Type, I) when ?IS_ATOM_TYPE(?REL_TYPE(I, Type)) -> + atoms_only(Type, I+1); +atoms_only(Type, I) when I > tuple_size(Type), ?IS_RELATION(Type) -> + true; +atoms_only(_Type, _I) -> + false. + +rel(Ts, Sz, Type) when Sz >= 1 -> + SL = usort(Ts), + rel(SL, SL, Sz, Type). + +rel([T | Ts], L, Sz, Type) when tuple_size(T) =:= Sz -> + rel(Ts, L, Sz, Type); +rel([], L, _Sz, Type) -> + ?SET(L, Type). + +rel_type([E | Ts], L, Type) -> + {NType, NE} = make_element(E, Type, Type), + rel_type(Ts, [NE | L], NType); +rel_type([], [], ?ANYTYPE) -> + empty_set(); +rel_type([], SL, Type) when ?IS_RELATION(Type) -> + ?SET(usort(SL), Type). + +%% Inlined. +a_func(Ts, T) -> + case {T, is_type(T)} of + {[?BINREL(DT, RT) = Type], true} when ?IS_ATOM_TYPE(DT), + ?IS_ATOM_TYPE(RT) -> + func(Ts, Type); + {[Type], true} -> + func_type(Ts, [], Type, fun(?BINREL(_,_)) -> true end) + end. + +func(L0, Type) -> + L = usort(L0), + func(L, L, L, Type). + +func([{X,_} | Ts], X0, L, Type) when X /= X0 -> + func(Ts, X, L, Type); +func([{X,_} | _Ts], X0, _L, _Type) when X == X0 -> + bad_function; +func([], _X0, L, Type) -> + ?SET(L, Type). + +%% Inlined. +fam(Ts, T) -> + case {T, is_type(T)} of + {[?FAMILY(DT, RT) = Type], true} when ?IS_ATOM_TYPE(DT), + ?IS_ATOM_TYPE(RT) -> + fam2(Ts, Type); + {[Type], true} -> + func_type(Ts, [], Type, fun(?FAMILY(_,_)) -> true end) + end. + +fam2([], Type) -> + ?SET([], Type); +fam2(Ts, Type) -> + fam2(sort(Ts), Ts, [], Type). + +fam2([{I,L} | T], I0, SL, Type) when I /= I0 -> + fam2(T, I, [{I,usort(L)} | SL], Type); +fam2([{I,L} | T], I0, SL, Type) when I == I0 -> + case {usort(L), SL} of + {NL, [{_I,NL1} | _]} when NL == NL1 -> + fam2(T, I0, SL, Type); + _ -> + bad_function + end; +fam2([], _I0, SL, Type) -> + ?SET(reverse(SL), Type). + +func_type([E | T], SL, Type, F) -> + {NType, NE} = make_element(E, Type, Type), + func_type(T, [NE | SL], NType, F); +func_type([], [], ?ANYTYPE, _F) -> + empty_set(); +func_type([], SL, Type, F) -> + true = F(Type), + NL = usort(SL), + check_function(NL, ?SET(NL, Type)). + +setify(L, ?SET_OF(Atom)) when ?IS_ATOM_TYPE(Atom), Atom =/= ?ANYTYPE -> + ?SET(usort(L), Atom); +setify(L, ?SET_OF(Type0)) -> + try is_no_lists(Type0) of + N when is_integer(N) -> + rel(L, N, Type0); + Sizes -> + make_oset(L, Sizes, L, Type0) + catch + _:_ -> + {?SET_OF(Type), Set} = create(L, Type0, Type0, []), + ?SET(Set, Type) + end; +setify(E, Type0) -> + {Type, OrdSet} = make_element(E, Type0, Type0), + ?ORDSET(OrdSet, Type). + +is_no_lists(T) when is_tuple(T) -> + Sz = tuple_size(T), + is_no_lists(T, Sz, Sz, []). + +is_no_lists(_T, 0, Sz, []) -> + Sz; +is_no_lists(_T, 0, Sz, L) -> + {Sz, L}; +is_no_lists(T, I, Sz, L) when ?IS_ATOM_TYPE(?REL_TYPE(I, T)) -> + is_no_lists(T, I-1, Sz, L); +is_no_lists(T, I, Sz, L) -> + is_no_lists(T, I-1, Sz, [{I,is_no_lists(?REL_TYPE(I, T))} | L]). + +create([E | Es], T, T0, L) -> + {NT, S} = make_element(E, T, T0), + create(Es, NT, T0, [S | L]); +create([], T, _T0, L) -> + {?SET_OF(T), usort(L)}. + +make_element(C, ?ANYTYPE, _T0) -> + make_element(C); +make_element(C, Atom, ?ANYTYPE) when ?IS_ATOM_TYPE(Atom), + not is_list(C), not is_tuple(C) -> + {Atom, C}; +make_element(C, Atom, Atom) when ?IS_ATOM_TYPE(Atom) -> + {Atom, C}; +make_element(T, TT, ?ANYTYPE) when tuple_size(T) =:= tuple_size(TT) -> + make_tuple(tuple_to_list(T), tuple_to_list(TT), [], [], ?ANYTYPE); +make_element(T, TT, T0) when tuple_size(T) =:= tuple_size(TT) -> + make_tuple(tuple_to_list(T), tuple_to_list(TT), [], [], tuple_to_list(T0)); +make_element(L, [LT], ?ANYTYPE) when is_list(L) -> + create(L, LT, ?ANYTYPE, []); +make_element(L, [LT], [T0]) when is_list(L) -> + create(L, LT, T0, []). + +make_tuple([E | Es], [T | Ts], NT, L, T0) when T0 =:= ?ANYTYPE -> + {ET, ES} = make_element(E, T, T0), + make_tuple(Es, Ts, [ET | NT], [ES | L], T0); +make_tuple([E | Es], [T | Ts], NT, L, [T0 | T0s]) -> + {ET, ES} = make_element(E, T, T0), + make_tuple(Es, Ts, [ET | NT], [ES | L], T0s); +make_tuple([], [], NT, L, _T0s) when NT =/= [] -> + {list_to_tuple(reverse(NT)), list_to_tuple(reverse(L))}. + +%% Derive type. +make_element(C) when not is_list(C), not is_tuple(C) -> + {?ATOM_TYPE, C}; +make_element(T) when is_tuple(T) -> + make_tuple(tuple_to_list(T), [], []); +make_element(L) when is_list(L) -> + create(L, ?ANYTYPE, ?ANYTYPE, []). + +make_tuple([E | Es], T, L) -> + {ET, ES} = make_element(E), + make_tuple(Es, [ET | T], [ES | L]); +make_tuple([], T, L) when T =/= [] -> + {list_to_tuple(reverse(T)), list_to_tuple(reverse(L))}. + +make_oset([T | Ts], Szs, L, Type) -> + true = test_oset(Szs, T, T), + make_oset(Ts, Szs, L, Type); +make_oset([], _Szs, L, Type) -> + ?SET(usort(L), Type). + +%% Optimization. Avoid re-building (nested) tuples. +test_oset({Sz,Args}, T, T0) when tuple_size(T) =:= Sz -> + test_oset_args(Args, T, T0); +test_oset(Sz, T, _T0) when tuple_size(T) =:= Sz -> + true. + +test_oset_args([{Arg,Szs} | Ss], T, T0) -> + true = test_oset(Szs, ?REL_TYPE(Arg, T), T0), + test_oset_args(Ss, T, T0); +test_oset_args([], _T, _T0) -> + true. + +list_of_sets([S | Ss], Type, L) -> + list_of_sets(Ss, Type, [?SET(S, Type) | L]); +list_of_sets([], _Type, L) -> + reverse(L). + +list_of_ordsets([S | Ss], Type, L) -> + list_of_ordsets(Ss, Type, [?ORDSET(S, Type) | L]); +list_of_ordsets([], _Type, L) -> + reverse(L). + +tuple_of_sets([S | Ss], [?SET_OF(Type) | Types], L) -> + tuple_of_sets(Ss, Types, [?SET(S, Type) | L]); +tuple_of_sets([S | Ss], [Type | Types], L) -> + tuple_of_sets(Ss, Types, [?ORDSET(S, Type) | L]); +tuple_of_sets([], [], L) -> + list_to_tuple(reverse(L)). + +spec([E | Es], Fun, Type, L) -> + case Fun(term2set(E, Type)) of + true -> + spec(Es, Fun, Type, [E | L]); + false -> + spec(Es, Fun, Type, L); + _ -> + badarg + end; +spec([], _Fun, _Type, L) -> + reverse(L). + +specification([E | Es], Fun, L) -> + case Fun(E) of + true -> + specification(Es, Fun, [E | L]); + false -> + specification(Es, Fun, L); + _ -> + badarg + end; +specification([], _Fun, L) -> + reverse(L). + +%% Elements from the first list are kept. +intersection([H1 | T1], [H2 | T2], L) when H1 < H2 -> + intersection1(T1, T2, L, H2); +intersection([H1 | T1], [H2 | T2], L) when H1 == H2 -> + intersection(T1, T2, [H1 | L]); +intersection([H1 | T1], [_H2 | T2], L) -> + intersection2(T1, T2, L, H1); +intersection(_, _, L) -> + reverse(L). + +intersection1([H1 | T1], T2, L, H2) when H1 < H2 -> + intersection1(T1, T2, L, H2); +intersection1([H1 | T1], T2, L, H2) when H1 == H2 -> + intersection(T1, T2, [H1 | L]); +intersection1([H1 | T1], T2, L, _H2) -> + intersection2(T1, T2, L, H1); +intersection1(_, _, L, _) -> + reverse(L). + +intersection2(T1, [H2 | T2], L, H1) when H1 > H2 -> + intersection2(T1, T2, L, H1); +intersection2(T1, [H2 | T2], L, H1) when H1 == H2 -> + intersection(T1, T2, [H1 | L]); +intersection2(T1, [H2 | T2], L, _H1) -> + intersection1(T1, T2, L, H2); +intersection2(_, _, L, _) -> + reverse(L). + +difference([H1 | T1], [H2 | T2], L) when H1 < H2 -> + diff(T1, T2, [H1 | L], H2); +difference([H1 | T1], [H2 | T2], L) when H1 == H2 -> + difference(T1, T2, L); +difference([H1 | T1], [_H2 | T2], L) -> + diff2(T1, T2, L, H1); +difference(L1, _, L) -> + reverse(L, L1). + +diff([H1 | T1], T2, L, H2) when H1 < H2 -> + diff(T1, T2, [H1 | L], H2); +diff([H1 | T1], T2, L, H2) when H1 == H2 -> + difference(T1, T2, L); +diff([H1 | T1], T2, L, _H2) -> + diff2(T1, T2, L, H1); +diff(_, _, L, _) -> + reverse(L). + +diff2(T1, [H2 | T2], L, H1) when H1 > H2 -> + diff2(T1, T2, L, H1); +diff2(T1, [H2 | T2], L, H1) when H1 == H2 -> + difference(T1, T2, L); +diff2(T1, [H2 | T2], L, H1) -> + diff(T1, T2, [H1 | L], H2); +diff2(T1, _, L, H1) -> + reverse(L, [H1 | T1]). + +symdiff([H1 | T1], T2, L) -> + symdiff2(T1, T2, L, H1); +symdiff(_, T2, L) -> + reverse(L, T2). + +symdiff1([H1 | T1], T2, L, H2) when H1 < H2 -> + symdiff1(T1, T2, [H1 | L], H2); +symdiff1([H1 | T1], T2, L, H2) when H1 == H2 -> + symdiff(T1, T2, L); +symdiff1([H1 | T1], T2, L, H2) -> + symdiff2(T1, T2, [H2 | L], H1); +symdiff1(_, T2, L, H2) -> + reverse(L, [H2 | T2]). + +symdiff2(T1, [H2 | T2], L, H1) when H1 > H2 -> + symdiff2(T1, T2, [H2 | L], H1); +symdiff2(T1, [H2 | T2], L, H1) when H1 == H2 -> + symdiff(T1, T2, L); +symdiff2(T1, [H2 | T2], L, H1) -> + symdiff1(T1, T2, [H1 | L], H2); +symdiff2(T1, _, L, H1) -> + reverse(L, [H1 | T1]). + +sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) when H1 < H2 -> + sympart1(T1, T2, [H1 | L1], L12, L2, T, H2); +sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) when H1 == H2 -> + sympart(T1, T2, L1, [H1 | L12], L2, T); +sympart([H1 | T1], [H2 | T2], L1, L12, L2, T) -> + sympart2(T1, T2, L1, L12, [H2 | L2], T, H1); +sympart(S1, [], L1, L12, L2, T) -> + {?SET(reverse(L1, S1), T), + ?SET(reverse(L12), T), + ?SET(reverse(L2), T)}; +sympart(_, S2, L1, L12, L2, T) -> + {?SET(reverse(L1), T), + ?SET(reverse(L12), T), + ?SET(reverse(L2, S2), T)}. + +sympart1([H1 | T1], T2, L1, L12, L2, T, H2) when H1 < H2 -> + sympart1(T1, T2, [H1 | L1], L12, L2, T, H2); +sympart1([H1 | T1], T2, L1, L12, L2, T, H2) when H1 == H2 -> + sympart(T1, T2, L1, [H1 | L12], L2, T); +sympart1([H1 | T1], T2, L1, L12, L2, T, H2) -> + sympart2(T1, T2, L1, L12, [H2 | L2], T, H1); +sympart1(_, T2, L1, L12, L2, T, H2) -> + {?SET(reverse(L1), T), + ?SET(reverse(L12), T), + ?SET(reverse(L2, [H2 | T2]), T)}. + +sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) when H1 > H2 -> + sympart2(T1, T2, L1, L12, [H2 | L2], T, H1); +sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) when H1 == H2 -> + sympart(T1, T2, L1, [H1 | L12], L2, T); +sympart2(T1, [H2 | T2], L1, L12, L2, T, H1) -> + sympart1(T1, T2, [H1 | L1], L12, L2, T, H2); +sympart2(T1, _, L1, L12, L2, T, H1) -> + {?SET(reverse(L1, [H1 | T1]), T), + ?SET(reverse(L12), T), + ?SET(reverse(L2), T)}. + +prod([[E | Es] | Xs], T, L) -> + prod(Es, Xs, T, prod(Xs, [E | T], L)); +prod([], T, L) -> + [list_to_tuple(reverse(T)) | L]. + +prod([E | Es], Xs, T, L) -> + prod(Es, Xs, T, prod(Xs, [E | T], L)); +prod([], _Xs, _E, L) -> + L. + +constant_function([E | Es], X, L) -> + constant_function(Es, X, [{E,X} | L]); +constant_function([], _X, L) -> + reverse(L). + +subset([H1 | T1], [H2 | T2]) when H1 > H2 -> + subset(T1, T2, H1); +subset([H1 | T1], [H2 | T2]) when H1 == H2 -> + subset(T1, T2); +subset(L1, _) -> + L1 =:= []. + +subset(T1, [H2 | T2], H1) when H1 > H2 -> + subset(T1, T2, H1); +subset(T1, [H2 | T2], H1) when H1 == H2 -> + subset(T1, T2); +subset(_, _, _) -> + false. + +disjoint([B | Bs], A, As) when A < B -> + disjoint(As, B, Bs); +disjoint([B | _Bs], A, _As) when A == B -> + false; +disjoint([_B | Bs], A, As) -> + disjoint(Bs, A, As); +disjoint(_Bs, _A, _As) -> + true. + +%% Append sets that come in order, then "merge". +lunion([[_] = S]) -> % optimization + S; +lunion([[] | Ls]) -> + lunion(Ls); +lunion([S | Ss]) -> + umerge(lunion(Ss, last(S), [S], [])); +lunion([]) -> + []. + +lunion([[E] = S | Ss], Last, SL, Ls) when E > Last -> % optimization + lunion(Ss, E, [S | SL], Ls); +lunion([S | Ss], Last, SL, Ls) when hd(S) > Last -> + lunion(Ss, last(S), [S | SL], Ls); +lunion([S | Ss], _Last, SL, Ls) -> + lunion(Ss, last(S), [S], [append(reverse(SL)) | Ls]); +lunion([], _Last, SL, Ls) -> + [append(reverse(SL)) | Ls]. + +%% The empty list is always the first list, if present. +lintersection(_, []) -> + []; +lintersection([S | Ss], S0) -> + lintersection(Ss, intersection(S, S0, [])); +lintersection([], S) -> + S. + +can_rel([S | Ss], L) -> + can_rel(Ss, L, S, S); +can_rel([], L) -> + sort(L). + +can_rel(Ss, L, [E | Es], S) -> + can_rel(Ss, [{E, S} | L], Es, S); +can_rel(Ss, L, _, _S) -> + can_rel(Ss, L). + +rel2family([{X,Y} | S]) -> + rel2fam(S, X, [Y], []); +rel2family([]) -> + []. + +rel2fam([{X,Y} | S], X0, YL, L) when X0 == X -> + rel2fam(S, X0, [Y | YL], L); +rel2fam([{X,Y} | S], X0, [A,B | YL], L) -> % optimization + rel2fam(S, X, [Y], [{X0,reverse(YL,[B,A])} | L]); +rel2fam([{X,Y} | S], X0, YL, L) -> + rel2fam(S, X, [Y], [{X0,YL} | L]); +rel2fam([], X, YL, L) -> + reverse([{X,reverse(YL)} | L]). + +dom([{X,_} | Es]) -> + dom([], X, Es); +dom([] = L) -> + L. + +dom(L, X, [{X1,_} | Es]) when X == X1 -> + dom(L, X, Es); +dom(L, X, [{Y,_} | Es]) -> + dom([X | L], Y, Es); +dom(L, X, []) -> + reverse(L, [X]). + +ran([{_,Y} | Es], L) -> + ran(Es, [Y | L]); +ran([], L) -> + usort(L). + +relprod(A, B) -> + usort(relprod1(A, B)). + +relprod1([{Ay,Ax} | A], B) -> + relprod1(B, Ay, Ax, A, []); +relprod1(_A, _B) -> + []. + +relprod1([{Bx,_By} | B], Ay, Ax, A, L) when Ay > Bx -> + relprod1(B, Ay, Ax, A, L); +relprod1([{Bx,By} | B], Ay, Ax, A, L) when Ay == Bx -> + relprod(B, Bx, By, A, [{Ax,By} | L], Ax, B, Ay); +relprod1([{Bx,By} | B], _Ay, _Ax, A, L) -> + relprod2(B, Bx, By, A, L); +relprod1(_B, _Ay, _Ax, _A, L) -> + L. + +relprod2(B, Bx, By, [{Ay, _Ax} | A], L) when Ay < Bx -> + relprod2(B, Bx, By, A, L); +relprod2(B, Bx, By, [{Ay, Ax} | A], L) when Ay == Bx -> + relprod(B, Bx, By, A, [{Ax,By} | L], Ax, B, Ay); +relprod2(B, _Bx, _By, [{Ay, Ax} | A], L) -> + relprod1(B, Ay, Ax, A, L); +relprod2(_, _, _, _, L) -> + L. + +relprod(B0, Bx0, By0, A0, L, Ax, [{Bx,By} | B], Ay) when Ay == Bx -> + relprod(B0, Bx0, By0, A0, [{Ax,By} | L], Ax, B, Ay); +relprod(B0, Bx0, By0, A0, L, _Ax, _B, _Ay) -> + relprod2(B0, Bx0, By0, A0, L). + +relprod_n([], _R, _EmptyG, _IsR) -> + {error, badarg}; +relprod_n(RL, R, EmptyR, IsR) -> + case domain_type(RL, ?ANYTYPE) of + Error = {error, _Reason} -> + Error; + DType -> + Empty = any(fun is_empty_set/1, RL) or EmptyR, + RType = range_type(RL, []), + Type = ?BINREL(DType, RType), + Prod = + case Empty of + true when DType =:= ?ANYTYPE; RType =:= ?ANYTYPE -> + empty_set(); + true -> + ?SET([], Type); + false -> + TL = ?LIST((relprod_n(RL))), + Sz = length(RL), + Fun = fun({X,A}) -> {X, flat(Sz, A, [])} end, + ?SET(map(Fun, TL), Type) + end, + case IsR of + true -> relative_product(Prod, R); + false -> Prod + end + end. + +relprod_n([R | Rs]) -> + relprod_n(Rs, R). + +relprod_n([], R) -> + R; +relprod_n([R | Rs], R0) -> + T = raise_element(R0, 1), + R1 = relative_product1(T, R), + NR = projection({external, fun({{X,A},AS}) -> {X,{A,AS}} end}, R1), + relprod_n(Rs, NR). + +flat(1, A, L) -> + list_to_tuple([A | L]); +flat(N, {T,A}, L) -> + flat(N-1, T, [A | L]). + +domain_type([T | Ts], T0) when ?IS_SET(T) -> + case ?TYPE(T) of + ?BINREL(DT, _RT) -> + case unify_types(DT, T0) of + [] -> {error, type_mismatch}; + T1 -> domain_type(Ts, T1) + end; + ?ANYTYPE -> + domain_type(Ts, T0); + _ -> {error, badarg} + end; +domain_type([], T0) -> + T0. + +range_type([T | Ts], L) -> + case ?TYPE(T) of + ?BINREL(_DT, RT) -> + range_type(Ts, [RT | L]); + ?ANYTYPE -> + ?ANYTYPE + end; +range_type([], L) -> + list_to_tuple(reverse(L)). + +converse([{A,B} | X], L) -> + converse(X, [{B,A} | L]); +converse([], L) -> + sort(L). + +strict([{E1,E2} | Es], L) when E1 == E2 -> + strict(Es, L); +strict([E | Es], L) -> + strict(Es, [E | L]); +strict([], L) -> + reverse(L). + +weak(Es) -> + %% Not very efficient... + weak(Es, ran(Es, []), []). + +weak(Es=[{X,_} | _], [Y | Ys], L) when X > Y -> + weak(Es, Ys, [{Y,Y} | L]); +weak(Es=[{X,_} | _], [Y | Ys], L) when X == Y -> + weak(Es, Ys, L); +weak([E={X,Y} | Es], Ys, L) when X > Y -> + weak1(Es, Ys, [E | L], X); +weak([E={X,Y} | Es], Ys, L) when X == Y -> + weak2(Es, Ys, [E | L], X); +weak([E={X,_Y} | Es], Ys, L) -> % when X < _Y + weak2(Es, Ys, [E, {X,X} | L], X); +weak([], [Y | Ys], L) -> + weak([], Ys, [{Y,Y} | L]); +weak([], [], L) -> + reverse(L). + +weak1([E={X,Y} | Es], Ys, L, X0) when X > Y, X == X0 -> + weak1(Es, Ys, [E | L], X); +weak1([E={X,Y} | Es], Ys, L, X0) when X == Y, X == X0 -> + weak2(Es, Ys, [E | L], X); +weak1([E={X,_Y} | Es], Ys, L, X0) when X == X0 -> % when X < Y + weak2(Es, Ys, [E, {X,X} | L], X); +weak1(Es, Ys, L, X) -> + weak(Es, Ys, [{X,X} | L]). + +weak2([E={X,_Y} | Es], Ys, L, X0) when X == X0 -> % when X < _Y + weak2(Es, Ys, [E | L], X); +weak2(Es, Ys, L, _X) -> + weak(Es, Ys, L). + +extc(L, [D | Ds], C, Ts) -> + extc(L, Ds, C, Ts, D); +extc(L, [], _C, _Ts) -> + L. + +extc(L, Ds, C, [{X,_Y} | Ts], D) when X < D -> + extc(L, Ds, C, Ts, D); +extc(L, Ds, C, [{X,_Y} | Ts], D) when X == D -> + extc(L, Ds, C, Ts); +extc(L, Ds, C, [{X,_Y} | Ts], D) -> + extc2([{D,C} | L], Ds, C, Ts, X); +extc(L, Ds, C, [], D) -> + extc_tail([{D,C} | L], Ds, C). + +extc2(L, [D | Ds], C, Ts, X) when X > D -> + extc2([{D,C} | L], Ds, C, Ts, X); +extc2(L, [D | Ds], C, Ts, X) when X == D -> + extc(L, Ds, C, Ts); +extc2(L, [D | Ds], C, Ts, _X) -> + extc(L, Ds, C, Ts, D); +extc2(L, [], _C, _Ts, _X) -> + L. + +extc_tail(L, [D | Ds], C) -> + extc_tail([{D,C} | L], Ds, C); +extc_tail(L, [], _C) -> + L. + +is_a_func([{E,_} | Es], E0) when E /= E0 -> + is_a_func(Es, E); +is_a_func(L, _E) -> + L =:= []. + +restrict_n(I, [T | Ts], Key, Keys, L) -> + case element(I, T) of + K when K < Key -> + restrict_n(I, Ts, Key, Keys, L); + K when K == Key -> + restrict_n(I, Ts, Key, Keys, [T | L]); + K -> + restrict_n(I, K, Ts, Keys, L, T) + end; +restrict_n(_I, _Ts, _Key, _Keys, L) -> + L. + +restrict_n(I, K, Ts, [Key | Keys], L, E) when K > Key -> + restrict_n(I, K, Ts, Keys, L, E); +restrict_n(I, K, Ts, [Key | Keys], L, E) when K == Key -> + restrict_n(I, Ts, Key, Keys, [E | L]); +restrict_n(I, _K, Ts, [Key | Keys], L, _E) -> + restrict_n(I, Ts, Key, Keys, L); +restrict_n(_I, _K, _Ts, _Keys, L, _E) -> + L. + +restrict([Key | Keys], Tuples) -> + restrict(Tuples, Key, Keys, []); +restrict(_Keys, _Tuples) -> + []. + +restrict([{K,_E} | Ts], Key, Keys, L) when K < Key -> + restrict(Ts, Key, Keys, L); +restrict([{K,E} | Ts], Key, Keys, L) when K == Key -> + restrict(Ts, Key, Keys, [E | L]); +restrict([{K,E} | Ts], _Key, Keys, L) -> + restrict(Ts, K, Keys, L, E); +restrict(_Ts, _Key, _Keys, L) -> + L. + +restrict(Ts, K, [Key | Keys], L, E) when K > Key -> + restrict(Ts, K, Keys, L, E); +restrict(Ts, K, [Key | Keys], L, E) when K == Key -> + restrict(Ts, Key, Keys, [E | L]); +restrict(Ts, _K, [Key | Keys], L, _E) -> + restrict(Ts, Key, Keys, L); +restrict(_Ts, _K, _Keys, L, _E) -> + L. + +diff_restrict_n(I, [T | Ts], Key, Keys, L) -> + case element(I, T) of + K when K < Key -> + diff_restrict_n(I, Ts, Key, Keys, [T | L]); + K when K == Key -> + diff_restrict_n(I, Ts, Key, Keys, L); + K -> + diff_restrict_n(I, K, Ts, Keys, L, T) + end; +diff_restrict_n(I, _Ts, _Key, _Keys, L) when I =:= 1 -> + reverse(L); +diff_restrict_n(_I, _Ts, _Key, _Keys, L) -> + sort(L). + +diff_restrict_n(I, K, Ts, [Key | Keys], L, T) when K > Key -> + diff_restrict_n(I, K, Ts, Keys, L, T); +diff_restrict_n(I, K, Ts, [Key | Keys], L, _T) when K == Key -> + diff_restrict_n(I, Ts, Key, Keys, L); +diff_restrict_n(I, _K, Ts, [Key | Keys], L, T) -> + diff_restrict_n(I, Ts, Key, Keys, [T | L]); +diff_restrict_n(I, _K, Ts, _Keys, L, T) when I =:= 1 -> + reverse(L, [T | Ts]); +diff_restrict_n(_I, _K, Ts, _Keys, L, T) -> + sort([T | Ts ++ L]). + +diff_restrict([Key | Keys], Tuples) -> + diff_restrict(Tuples, Key, Keys, []); +diff_restrict(_Keys, Tuples) -> + diff_restrict_tail(Tuples, []). + +diff_restrict([{K,E} | Ts], Key, Keys, L) when K < Key -> + diff_restrict(Ts, Key, Keys, [E | L]); +diff_restrict([{K,_E} | Ts], Key, Keys, L) when K == Key -> + diff_restrict(Ts, Key, Keys, L); +diff_restrict([{K,E} | Ts], _Key, Keys, L) -> + diff_restrict(Ts, K, Keys, L, E); +diff_restrict(_Ts, _Key, _Keys, L) -> + L. + +diff_restrict(Ts, K, [Key | Keys], L, E) when K > Key -> + diff_restrict(Ts, K, Keys, L, E); +diff_restrict(Ts, K, [Key | Keys], L, _E) when K == Key -> + diff_restrict(Ts, Key, Keys, L); +diff_restrict(Ts, _K, [Key | Keys], L, E) -> + diff_restrict(Ts, Key, Keys, [E | L]); +diff_restrict(Ts, _K, _Keys, L, E) -> + diff_restrict_tail(Ts, [E | L]). + +diff_restrict_tail([{_K,E} | Ts], L) -> + diff_restrict_tail(Ts, [E | L]); +diff_restrict_tail(_Ts, L) -> + L. + +comp([], B) -> + check_function(B, []); +comp(_A, []) -> + bad_function; +comp(A0, [{Bx,By} | B]) -> + A = converse(A0, []), + check_function(A0, comp1(A, B, [], Bx, By)). + +comp1([{Ay,Ax} | A], B, L, Bx, By) when Ay == Bx -> + comp1(A, B, [{Ax,By} | L], Bx, By); +comp1([{Ay,Ax} | A], B, L, Bx, _By) when Ay > Bx -> + comp2(A, B, L, Bx, Ay, Ax); +comp1([{Ay,_Ax} | _A], _B, _L, Bx, _By) when Ay < Bx -> + bad_function; +comp1([], B, L, Bx, _By) -> + check_function(Bx, B, L). + +comp2(A, [{Bx,_By} | B], L, Bx0, Ay, Ax) when Ay > Bx, Bx /= Bx0 -> + comp2(A, B, L, Bx, Ay, Ax); +comp2(A, [{Bx,By} | B], L, _Bx0, Ay, Ax) when Ay == Bx -> + comp1(A, B, [{Ax,By} | L], Bx, By); +comp2(_A, _B, _L, _Bx0, _Ay, _Ax) -> + bad_function. + +inverse1([{A,B} | X]) -> + inverse(X, A, [{B,A}]); +inverse1([]) -> + []. + +inverse([{A,B} | X], A0, L) when A0 /= A -> + inverse(X, A, [{B,A} | L]); +inverse([{A,_B} | _X], A0, _L) when A0 == A -> + bad_function; +inverse([], _A0, L) -> + SL = [{V,_} | Es] = sort(L), + case is_a_func(Es, V) of + true -> SL; + false -> bad_function + end. + +%% Inlined. +external_fun({external, Function}) when is_atom(Function) -> + false; +external_fun({external, Fun}) -> + Fun; +external_fun(_) -> + false. + +%% Inlined. +element_type(?SET_OF(Type)) -> Type; +element_type(Type) -> Type. + +subst(Ts, Fun, Type) -> + subst(Ts, Fun, Type, ?ANYTYPE, []). + +subst([T | Ts], Fun, Type, NType, L) -> + case setfun(T, Fun, Type, NType) of + {SD, ST} -> subst(Ts, Fun, Type, ST, [{T, SD} | L]); + Bad -> Bad + end; +subst([], _Fun, _Type, NType, L) -> + {L, NType}. + +projection1([E | Es]) -> + projection1([], element(1, E), Es); +projection1([] = L) -> + L. + +projection1(L, X, [E | Es]) -> + case element(1, E) of + X1 when X == X1 -> projection1(L, X, Es); + X1 -> projection1([X | L], X1, Es) + end; +projection1(L, X, []) -> + reverse(L, [X]). + +projection_n([E | Es], I, L) -> + projection_n(Es, I, [element(I, E) | L]); +projection_n([], _I, L) -> + usort(L). + +substitute_element([T | Ts], I, L) -> + substitute_element(Ts, I, [{T, element(I, T)} | L]); +substitute_element(_, _I, L) -> + reverse(L). + +substitute([T | Ts], Fun, L) -> + substitute(Ts, Fun, [{T, Fun(T)} | L]); +substitute(_, _Fun, L) -> + reverse(L). + +partition_n(I, [E | Ts]) -> + partition_n(I, Ts, element(I, E), [E], []); +partition_n(_I, []) -> + []. + +partition_n(I, [E | Ts], K, Es, P) -> + case {element(I, E), Es} of + {K1, _} when K == K1 -> + partition_n(I, Ts, K, [E | Es], P); + {K1, [_]} -> % optimization + partition_n(I, Ts, K1, [E], [Es | P]); + {K1, _} -> + partition_n(I, Ts, K1, [E], [reverse(Es) | P]) + end; +partition_n(I, [], _K, Es, P) when I > 1 -> + sort([reverse(Es) | P]); +partition_n(_I, [], _K, [_] = Es, P) -> % optimization + reverse(P, [Es]); +partition_n(_I, [], _K, Es, P) -> + reverse(P, [reverse(Es)]). + +partition3_n(I, [T | Ts], Key, Keys, L1, L2) -> + case element(I, T) of + K when K < Key -> + partition3_n(I, Ts, Key, Keys, L1, [T | L2]); + K when K == Key -> + partition3_n(I, Ts, Key, Keys, [T | L1], L2); + K -> + partition3_n(I, K, Ts, Keys, L1, L2, T) + end; +partition3_n(I, _Ts, _Key, _Keys, L1, L2) when I =:= 1 -> + [reverse(L1) | reverse(L2)]; +partition3_n(_I, _Ts, _Key, _Keys, L1, L2) -> + [sort(L1) | sort(L2)]. + +partition3_n(I, K, Ts, [Key | Keys], L1, L2, T) when K > Key -> + partition3_n(I, K, Ts, Keys, L1, L2, T); +partition3_n(I, K, Ts, [Key | Keys], L1, L2, T) when K == Key -> + partition3_n(I, Ts, Key, Keys, [T | L1], L2); +partition3_n(I, _K, Ts, [Key | Keys], L1, L2, T) -> + partition3_n(I, Ts, Key, Keys, L1, [T | L2]); +partition3_n(I, _K, Ts, _Keys, L1, L2, T) when I =:= 1 -> + [reverse(L1) | reverse(L2, [T | Ts])]; +partition3_n(_I, _K, Ts, _Keys, L1, L2, T) -> + [sort(L1) | sort([T | Ts ++ L2])]. + +partition3([Key | Keys], Tuples) -> + partition3(Tuples, Key, Keys, [], []); +partition3(_Keys, Tuples) -> + partition3_tail(Tuples, [], []). + +partition3([{K,E} | Ts], Key, Keys, L1, L2) when K < Key -> + partition3(Ts, Key, Keys, L1, [E | L2]); +partition3([{K,E} | Ts], Key, Keys, L1, L2) when K == Key -> + partition3(Ts, Key, Keys, [E | L1], L2); +partition3([{K,E} | Ts], _Key, Keys, L1, L2) -> + partition3(Ts, K, Keys, L1, L2, E); +partition3(_Ts, _Key, _Keys, L1, L2) -> + [L1 | L2]. + +partition3(Ts, K, [Key | Keys], L1, L2, E) when K > Key -> + partition3(Ts, K, Keys, L1, L2, E); +partition3(Ts, K, [Key | Keys], L1, L2, E) when K == Key -> + partition3(Ts, Key, Keys, [E | L1], L2); +partition3(Ts, _K, [Key | Keys], L1, L2, E) -> + partition3(Ts, Key, Keys, L1, [E | L2]); +partition3(Ts, _K, _Keys, L1, L2, E) -> + partition3_tail(Ts, L1, [E | L2]). + +partition3_tail([{_K,E} | Ts], L1, L2) -> + partition3_tail(Ts, L1, [E | L2]); +partition3_tail(_Ts, L1, L2) -> + [L1 | L2]. + +replace([E | Es], F, L) -> + replace(Es, F, [F(E) | L]); +replace(_, _F, L) -> + sort(L). + +mul_relprod([T | Ts], I, R) when ?IS_SET(T) -> + P = raise_element(R, I), + F = relative_product1(P, T), + [F | mul_relprod(Ts, I+1, R)]; +mul_relprod([], _I, _R) -> + []. + +raise_element(R, I) -> + L = sort(I =/= 1, rearr(?LIST(R), I, [])), + Type = ?TYPE(R), + ?SET(L, ?BINREL(?REL_TYPE(I, Type), Type)). + +rearr([E | Es], I, L) -> + rearr(Es, I, [{element(I, E), E} | L]); +rearr([], _I, L) -> + L. + +join_element(E1, E2) -> + [_ | L2] = tuple_to_list(E2), + list_to_tuple(tuple_to_list(E1) ++ L2). + +join_element(E1, E2, I2) -> + tuple_to_list(E1) ++ join_element2(tuple_to_list(E2), 1, I2). + +join_element2([B | Bs], C, I2) when C =/= I2 -> + [B | join_element2(Bs, C+1, I2)]; +join_element2([_ | Bs], _C, _I2) -> + Bs. + +family2rel([{X,S} | F], L) -> + fam2rel(F, L, X, S); +family2rel([], L) -> + reverse(L). + +fam2rel(F, L, X, [Y | Ys]) -> + fam2rel(F, [{X,Y} | L], X, Ys); +fam2rel(F, L, _X, _) -> + family2rel(F, L). + +fam_spec([{_,S}=E | F], Fun, Type, L) -> + case Fun(?SET(S, Type)) of + true -> + fam_spec(F, Fun, Type, [E | L]); + false -> + fam_spec(F, Fun, Type, L); + _ -> + badarg + end; +fam_spec([], _Fun, _Type, L) -> + reverse(L). + +fam_specification([{_,S}=E | F], Fun, L) -> + case Fun(S) of + true -> + fam_specification(F, Fun, [E | L]); + false -> + fam_specification(F, Fun, L); + _ -> + badarg + end; +fam_specification([], _Fun, L) -> + reverse(L). + +un_of_fam([{_X,S} | F], L) -> + un_of_fam(F, [S | L]); +un_of_fam([], L) -> + lunion(sort(L)). + +int_of_fam([{_,S} | F]) -> + int_of_fam(F, [S]); +int_of_fam([]) -> + badarg. + +int_of_fam([{_,S} | F], L) -> + int_of_fam(F, [S | L]); +int_of_fam([], [L | Ls]) -> + lintersection(Ls, L). + +fam_un([{X,S} | F], L) -> + fam_un(F, [{X, lunion(S)} | L]); +fam_un([], L) -> + reverse(L). + +fam_int([{X, [S | Ss]} | F], L) -> + fam_int(F, [{X, lintersection(Ss, S)} | L]); +fam_int([{_X,[]} | _F], _L) -> + badarg; +fam_int([], L) -> + reverse(L). + +fam_dom([{X,S} | F], L) -> + fam_dom(F, [{X, dom(S)} | L]); +fam_dom([], L) -> + reverse(L). + +fam_ran([{X,S} | F], L) -> + fam_ran(F, [{X, ran(S, [])} | L]); +fam_ran([], L) -> + reverse(L). + +fam_union(F1 = [{A,_AS} | _AL], [B1={B,_BS} | BL], L) when A > B -> + fam_union(F1, BL, [B1 | L]); +fam_union([{A,AS} | AL], [{B,BS} | BL], L) when A == B -> + fam_union(AL, BL, [{A, umerge(AS, BS)} | L]); +fam_union([A1 | AL], F2, L) -> + fam_union(AL, F2, [A1 | L]); +fam_union(_, F2, L) -> + reverse(L, F2). + +fam_intersect(F1 = [{A,_AS} | _AL], [{B,_BS} | BL], L) when A > B -> + fam_intersect(F1, BL, L); +fam_intersect([{A,AS} | AL], [{B,BS} | BL], L) when A == B -> + fam_intersect(AL, BL, [{A, intersection(AS, BS, [])} | L]); +fam_intersect([_A1 | AL], F2, L) -> + fam_intersect(AL, F2, L); +fam_intersect(_, _, L) -> + reverse(L). + +fam_difference(F1 = [{A,_AS} | _AL], [{B,_BS} | BL], L) when A > B -> + fam_difference(F1, BL, L); +fam_difference([{A,AS} | AL], [{B,BS} | BL], L) when A == B -> + fam_difference(AL, BL, [{A, difference(AS, BS, [])} | L]); +fam_difference([A1 | AL], F2, L) -> + fam_difference(AL, F2, [A1 | L]); +fam_difference(F1, _, L) -> + reverse(L, F1). + +check_function([{X,_} | XL], R) -> + check_function(X, XL, R); +check_function([], R) -> + R. + +check_function(X0, [{X,_} | XL], R) when X0 /= X -> + check_function(X, XL, R); +check_function(X0, [{X,_} | _XL], _R) when X0 == X -> + bad_function; +check_function(_X0, [], R) -> + R. + +fam_partition_n(I, [E | Ts]) -> + fam_partition_n(I, Ts, element(I, E), [E], []); +fam_partition_n(_I, []) -> + []. + +fam_partition_n(I, [E | Ts], K, Es, P) -> + case {element(I, E), Es} of + {K1, _} when K == K1 -> + fam_partition_n(I, Ts, K, [E | Es], P); + {K1, [_]} -> % optimization + fam_partition_n(I, Ts, K1, [E], [{K,Es} | P]); + {K1, _} -> + fam_partition_n(I, Ts, K1, [E], [{K,reverse(Es)} | P]) + end; +fam_partition_n(_I, [], K, [_] = Es, P) -> % optimization + reverse(P, [{K,Es}]); +fam_partition_n(_I, [], K, Es, P) -> + reverse(P, [{K,reverse(Es)}]). + +fam_partition([{K,Vs} | Ts], Sort) -> + fam_partition(Ts, K, [Vs], [], Sort); +fam_partition([], _Sort) -> + []. + +fam_partition([{K1,V} | Ts], K, Vs, P, S) when K1 == K -> + fam_partition(Ts, K, [V | Vs], P, S); +fam_partition([{K1,V} | Ts], K, [_] = Vs, P, S) -> % optimization + fam_partition(Ts, K1, [V], [{K, Vs} | P], S); +fam_partition([{K1,V} | Ts], K, Vs, P, S) -> + fam_partition(Ts, K1, [V], [{K, sort(S, Vs)} | P], S); +fam_partition([], K, [_] = Vs, P, _S) -> % optimization + [{K, Vs} | P]; +fam_partition([], K, Vs, P, S) -> + [{K, sort(S, Vs)} | P]. + +fam_proj([{X,S} | F], Fun, Type, NType, L) -> + case setfun(S, Fun, Type, NType) of + {SD, ST} -> fam_proj(F, Fun, Type, ST, [{X, SD} | L]); + Bad -> Bad + end; +fam_proj([], _Fun, _Type, NType, L) -> + {reverse(L), NType}. + +setfun(T, Fun, Type, NType) -> + case Fun(term2set(T, Type)) of + NS when ?IS_SET(NS) -> + case unify_types(NType, ?SET_OF(?TYPE(NS))) of + [] -> type_mismatch; + NT -> {?LIST(NS), NT} + end; + NS when ?IS_ORDSET(NS) -> + case unify_types(NType, NT = ?ORDTYPE(NS)) of + [] -> type_mismatch; + NT -> {?ORDDATA(NS), NT} + end; + _ -> + badarg + end. + +%% Inlined. +term2set(L, Type) when is_list(L) -> + ?SET(L, Type); +term2set(T, Type) -> + ?ORDSET(T, Type). + +fam2digraph(F, G) -> + Fun = fun({From, ToL}) -> + digraph:add_vertex(G, From), + Fun2 = fun(To) -> + digraph:add_vertex(G, To), + case digraph:add_edge(G, From, To) of + {error, {bad_edge, _}} -> + throw({error, cyclic}); + _ -> + true + end + end, + foreach(Fun2, ToL) + end, + foreach(Fun, to_external(F)), + G. + +digraph_family(G) -> + Vs = sort(digraph:vertices(G)), + digraph_fam(Vs, Vs, G, []). + +digraph_fam([V | Vs], V0, G, L) when V /= V0 -> + Ns = sort(digraph:out_neighbours(G, V)), + digraph_fam(Vs, V, G, [{V,Ns} | L]); +digraph_fam([], _V0, _G, L) -> + reverse(L). + +%% -> boolean() +check_fun(T, F, FunT) -> + true = is_type(FunT), + {NT, _MaxI} = number_tuples(T, 1), + L = flatten(tuple2list(F(NT))), + has_hole(L, 1). + +number_tuples(T, N) when is_tuple(T) -> + {L, NN} = mapfoldl(fun number_tuples/2, N, tuple_to_list(T)), + {list_to_tuple(L), NN}; +number_tuples(_, N) -> + {N, N+1}. + +tuple2list(T) when is_tuple(T) -> + map(fun tuple2list/1, tuple_to_list(T)); +tuple2list(C) -> + [C]. + +has_hole([I | Is], I0) when I =< I0 -> has_hole(Is, erlang:max(I+1, I0)); +has_hole(Is, _I) -> Is =/= []. + +%% Optimization. Same as check_fun/3, but for integers. +check_for_sort(T, _I) when T =:= ?ANYTYPE -> + empty; +check_for_sort(T, I) when ?IS_RELATION(T), I =< ?REL_ARITY(T), I >= 1 -> + I > 1; +check_for_sort(_T, _I) -> + error. + +inverse_substitution(L, Fun, Sort) -> + %% One easily sees that the inverse of the tuples created by + %% applying Fun need to be sorted iff the tuples created by Fun + %% need to be sorted. + sort(Sort, fun_rearr(L, Fun, [])). + +fun_rearr([E | Es], Fun, L) -> + fun_rearr(Es, Fun, [{Fun(E), E} | L]); +fun_rearr([], _Fun, L) -> + L. + +sets_to_list(Ss) -> + map(fun(S) when ?IS_SET(S) -> ?LIST(S) end, Ss). + +types([], L) -> + list_to_tuple(reverse(L)); +types([S | _Ss], _L) when ?TYPE(S) =:= ?ANYTYPE -> + ?ANYTYPE; +types([S | Ss], L) -> + types(Ss, [?TYPE(S) | L]). + +%% Inlined. +unify_types(T, T) -> T; +unify_types(Type1, Type2) -> + catch unify_types1(Type1, Type2). + +unify_types1(Atom, Atom) when ?IS_ATOM_TYPE(Atom) -> + Atom; +unify_types1(?ANYTYPE, Type) -> + Type; +unify_types1(Type, ?ANYTYPE) -> + Type; +unify_types1(?SET_OF(Type1), ?SET_OF(Type2)) -> + [unify_types1(Type1, Type2)]; +unify_types1(T1, T2) when tuple_size(T1) =:= tuple_size(T2) -> + unify_typesl(tuple_size(T1), T1, T2, []); +unify_types1(_T1, _T2) -> + throw([]). + +unify_typesl(0, _T1, _T2, L) -> + list_to_tuple(L); +unify_typesl(N, T1, T2, L) -> + T = unify_types1(?REL_TYPE(N, T1), ?REL_TYPE(N, T2)), + unify_typesl(N-1, T1, T2, [T | L]). + +%% inlined. +match_types(T, T) -> true; +match_types(Type1, Type2) -> match_types1(Type1, Type2). + +match_types1(Atom, Atom) when ?IS_ATOM_TYPE(Atom) -> + true; +match_types1(?ANYTYPE, _) -> + true; +match_types1(_, ?ANYTYPE) -> + true; +match_types1(?SET_OF(Type1), ?SET_OF(Type2)) -> + match_types1(Type1, Type2); +match_types1(T1, T2) when tuple_size(T1) =:= tuple_size(T2) -> + match_typesl(tuple_size(T1), T1, T2); +match_types1(_T1, _T2) -> + false. + +match_typesl(0, _T1, _T2) -> + true; +match_typesl(N, T1, T2) -> + case match_types1(?REL_TYPE(N, T1), ?REL_TYPE(N, T2)) of + true -> match_typesl(N-1, T1, T2); + false -> false + end. + +sort(true, L) -> + sort(L); +sort(false, L) -> + reverse(L). diff --git a/lib/tools/test/tools_bench.spec b/lib/tools/test/tools_bench.spec new file mode 100644 index 0000000000..ef08fd68a8 --- /dev/null +++ b/lib/tools/test/tools_bench.spec @@ -0,0 +1 @@ +{suites,"../tools_test",[prof_bench_SUITE]}. diff --git a/lib/wx/examples/simple/hello2.erl b/lib/wx/examples/simple/hello2.erl index 656c056d9a..07a9a56b7d 100644 --- a/lib/wx/examples/simple/hello2.erl +++ b/lib/wx/examples/simple/hello2.erl @@ -33,7 +33,7 @@ init/1, handle_info/2, handle_event/2, handle_call/3, code_change/3, terminate/2]). --behavoiur(wx_object). +-behaviour(wx_object). -record(state, {win}). diff --git a/make/configure.in b/make/configure.in index bf3fd0751f..c4b89c4f45 100644 --- a/make/configure.in +++ b/make/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script. dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1998-2016. All Rights Reserved. +dnl Copyright Ericsson AB 1998-2019. All Rights Reserved. dnl dnl Licensed under the Apache License, Version 2.0 (the "License"); dnl you may not use this file except in compliance with the License. @@ -298,6 +298,10 @@ AC_ARG_ENABLE(builtin-zlib, AS_HELP_STRING([--enable-builtin-zlib], [force use of our own built-in zlib])) +AC_ARG_ENABLE(esock, +AS_HELP_STRING([--enable-esock], [enable builtin experimental socket (as a nif) support (default)]) +AS_HELP_STRING([--disable-esock], [disable builtin experimental socket (as a nif) support])) + AC_ARG_ENABLE(sharing-preserving, AS_HELP_STRING([--enable-sharing-preserving], [enable copying of terms without destroying sharing])) diff --git a/make/emd2exml.in b/make/emd2exml.in index 24837696f4..ec3de0a7f8 100755 --- a/make/emd2exml.in +++ b/make/emd2exml.in @@ -462,7 +462,7 @@ url([C|Cs], Bool, Acc) -> url(Cs, Bool, [C|Acc]). link_or_image(Str, Type) -> - case link_or_image_text(Str, "") of + case link_or_image_text(Str) of no -> no; {Text, Cont1} -> case link_or_image_data(Cont1, none, Type, "", "") of @@ -471,9 +471,14 @@ link_or_image(Str, Type) -> {["<url href=\"", text(Url), "\">", text(Text), "</url>"], Cont2}; {seealso, SeeAlso, _Title, Cont2} -> - {["<seealso marker=\"", text(SeeAlso), "\">", - text(Text), "</seealso>"], - Cont2}; + case internal_seealso(SeeAlso) of + no -> + {["<seealso marker=\"", text(SeeAlso), "\">", + text(Text), "</seealso>"], + Cont2}; + {yes, SeeAlsoKey} -> + {delayed, link, SeeAlsoKey, text(Text), Cont2} + end; {image, Image, Title, Cont2} -> {["<image file=\"", text(Image), "\"><icaption>", text(Title), "</icaption></image>"], @@ -485,16 +490,41 @@ link_or_image(Str, Type) -> end end. +internal_seealso("#" ++ Marker) -> + {yes, {internal, Marker}}; +internal_seealso(_) -> + no. + +link_or_image_text(Cs0) -> + {Prefix, Cs2} = case Cs0 of + "__" ++ Cs1 -> {"__", Cs1}; + "_" ++ Cs1 -> {"_", Cs1}; + "**" ++ Cs1 -> {"**", Cs1}; + "*" ++ Cs1 -> {"*", Cs1}; + Cs1 -> {"", Cs1} + end, + {Text0, Cs} = link_or_image_text(Cs2, []), + Text = case lists:prefix(Prefix, Text0) of + false -> + lists:reverse(Text0, Prefix); + true -> + lists:reverse(lists:nthtail(length(Prefix), Text0)) + end, + case Text of + [] -> + no; + [_|_] -> + {Text, Cs} + end. + link_or_image_text([$\\,C|Cs], Acc) -> link_or_image_text(Cs, [C|Acc]); -link_or_image_text([$]|_Cs], "") -> - no; link_or_image_text([$]|Cs], Acc) -> - {lists:reverse(Acc), Cs}; + {Acc, Cs}; link_or_image_text([C|Cs], Acc) -> link_or_image_text(Cs, [C|Acc]); link_or_image_text([], _Acc) -> - no. + {[], []}. link_or_image_data([C|Cs], none, link, "", "") when C == $ ; C == $\t -> link_or_image_data(Cs, none, link, "", ""); @@ -615,8 +645,10 @@ put_title(S, 1, Title) -> put_title(#state{mlist = MList0, toc = TOC} = S0, H, Title) -> TitleStr = text(Title), - MList1 = [mk_lvl_marker(Title) | MList0], + TitleMarker = mk_lvl_marker(Title), + MList1 = [TitleMarker | MList0], Marker = mk_marker(MList1), + MarkerKey = string:lowercase(TitleMarker), S1 = chk_h1(H, S0#state{toc = [TOC, lists:duplicate(H," "), @@ -624,13 +656,15 @@ put_title(#state{mlist = MList0, "<seealso marker=\"#",Marker,"\">", TitleStr,"</seealso>",nl()], h = H, - mlist = MList1}), + mlist = MList1 + }), S2 = put_chars(S1, ["<marker id=\"", Marker, "\"/>",nl()]), + S3 = write_delayed(S2, {internal, MarkerKey}, {"#" ++ Marker, ""}), {STag, ETag} = case H > ?MAX_HEADING of true -> {"<p><strong>", "</strong></p>"}; false -> {"<title>", "</title>"} end, - put_chars(S2, [STag, TitleStr, ETag, nl()]). + put_chars(S3, [STag, TitleStr, ETag, nl()]). setext_heading(H, #state{line = Line, h = OldH} = S0) -> S1 = sections(H, OldH, S0), @@ -1204,7 +1238,7 @@ put_delayed(#state{out = Out} = S, Key, Data) -> S#state{out = [{delayed, Key, Data} | Out]}. put_chars(#state{out = Out} = S, Chars) -> - S#state{out = [[Chars] | Out]}. + S#state{out = [Chars | Out]}. put_line(#state{out = Out} = S, String) -> S#state{out = [[String, nl()] | Out]}. @@ -1219,6 +1253,15 @@ complete_output(S, [], Out) -> Out]}; complete_output(S, [{delayed, IX}|Rest], Out) -> complete_output(S, Rest, [read_delayed(S, IX)|Out]); +complete_output(S, [{delayed, {internal, Key0}, {link, Text, _Line}}|Rest], Out) -> + Key = [C || C <- Key0, C =/= $_], + case read_delayed(S, {internal, Key}) of + {value, {Url, _}} -> + complete_output(S, Rest, [mk_link(Text, Url)|Out]); + none -> + Url = "#" ++ Key0, + complete_output(S, Rest, [mk_link(Text, Url)|Out]) + end; complete_output(S, [{delayed, Key, {link, Text, Line}}|Rest], Out) -> case read_delayed(S, Key) of {value, {Url, _Title}} -> @@ -1235,9 +1278,27 @@ complete_output(S, [{delayed, Key, {image, _Text, Line}}|Rest], Out) -> {File, _} = S#state.ifile, error(File, Line, "Image definition name `~ts' not found~n", [Key]) end; +complete_output(S, [["</p>","\n"]=ParaStart, + Contents, + ["<p>","\n"]=ParaEnd|Rest], Out) -> + case is_image_tag(Contents) of + true -> + %% Get rid of the paragraph around an image tag. It would mess up + %% figure numbering. + complete_output(S, Rest, [Contents|Out]); + false -> + complete_output(S, [Contents,ParaEnd|Rest], [ParaStart|Out]) + end; complete_output(S, [Next|Rest], Out) -> complete_output(S, Rest, [Next|Out]). +is_image_tag("<image" ++ _) -> + true; +is_image_tag([[_|_]=H | _]) -> + is_image_tag(H); +is_image_tag(_) -> + false. + write_output(_OFD, []) -> ok; write_output(OFD, [O|Os]) -> diff --git a/make/fixup_development_runtime_dependencies b/make/fixup_development_runtime_dependencies index e06bd5faca..1c0a649578 100755 --- a/make/fixup_development_runtime_dependencies +++ b/make/fixup_development_runtime_dependencies @@ -44,7 +44,7 @@ my $erl_top = shift @ARGV; chdir $erl_top or die "Failed to change directory into '$erl_top'"; -print "Fixup of development runtime dependencies\n"; +print "Fixing up development runtime dependencies\n"; # # Determine versions of all applications in the source tree... diff --git a/make/otp.mk.in b/make/otp.mk.in index ceff8f7c31..cdddb90734 100644 --- a/make/otp.mk.in +++ b/make/otp.mk.in @@ -4,7 +4,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2016. All Rights Reserved. +# Copyright Ericsson AB 1997-2019. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -51,6 +51,8 @@ TYPES = @TYPES@ USE_PGO = @USE_PGO@ +USE_ESOCK = @USE_ESOCK@ + # Slash separated list of return values from $(origin VAR) # that are untrusted - set default in this file instead. # The list is not space separated since some return values diff --git a/make/otp_patch_solve_forward_merge_version b/make/otp_patch_solve_forward_merge_version index 45a4fb75db..ec635144f6 100644 --- a/make/otp_patch_solve_forward_merge_version +++ b/make/otp_patch_solve_forward_merge_version @@ -1 +1 @@ -8 +9 diff --git a/make/otp_release_targets.mk b/make/otp_release_targets.mk index d1fbf6c58f..615bf1adb7 100644 --- a/make/otp_release_targets.mk +++ b/make/otp_release_targets.mk @@ -156,7 +156,7 @@ endif ## These are the patterns of file names that xmllint cannot currently parse -XI_INC_FILES:=%user_man.xml %usersguide.xml %refman.xml %ref_man.xml %part.xml %book.xml +XI_INC_FILES:=%user_man.xml %usersguide.xml %refman.xml %ref_man.xml %part.xml %book.xml %internal.xml ## These are the files that we should run the xmllint on LINT_XI_INC_FILES := $(filter-out $(XI_INC_FILES), $(ALL_XI_INC_FILES)) diff --git a/otp_versions.table b/otp_versions.table index cc5d331b06..566aa3cb4c 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,8 @@ +OTP-21.3.7 : ssh-4.7.6 # asn1-5.0.8 common_test-1.17.1 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erl_interface-3.11.2 erts-10.3.4 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.7 jinterface-1.9.1 kernel-6.3.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssl-9.2.2 stdlib-3.8.1 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.20 : +OTP-21.3.6 : ssl-9.2.2 # asn1-5.0.8 common_test-1.17.1 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2.1 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erl_interface-3.11.2 erts-10.3.4 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.7 jinterface-1.9.1 kernel-6.3.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.5 stdlib-3.8.1 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.20 : +OTP-21.3.5 : diameter-2.2.1 erts-10.3.4 inets-7.0.7 # asn1-5.0.8 common_test-1.17.1 compiler-7.3.2 crypto-4.4.2 debugger-4.2.6 dialyzer-3.3.2 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erl_interface-3.11.2 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 jinterface-1.9.1 kernel-6.3.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.5 ssl-9.2.1 stdlib-3.8.1 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.20 : +OTP-21.3.4 : common_test-1.17.1 crypto-4.4.2 erl_interface-3.11.2 erts-10.3.3 ssh-4.7.5 # asn1-5.0.8 compiler-7.3.2 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 jinterface-1.9.1 kernel-6.3.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssl-9.2.1 stdlib-3.8.1 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.20 : +OTP-21.3.3 : erts-10.3.2 kernel-6.3.1 stdlib-3.8.1 # asn1-5.0.8 common_test-1.17 compiler-7.3.2 crypto-4.4.1 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erl_interface-3.11.1 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 jinterface-1.9.1 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.4 ssl-9.2.1 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.20 : OTP-21.3.2 : erts-10.3.1 xmerl-1.3.20 # asn1-5.0.8 common_test-1.17 compiler-7.3.2 crypto-4.4.1 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erl_interface-3.11.1 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 jinterface-1.9.1 kernel-6.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.4 ssl-9.2.1 stdlib-3.8 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 : OTP-21.3.1 : erl_interface-3.11.1 ssl-9.2.1 # asn1-5.0.8 common_test-1.17 compiler-7.3.2 crypto-4.4.1 debugger-4.2.6 dialyzer-3.3.2 diameter-2.2 edoc-0.10 eldap-1.2.6 erl_docgen-0.9 erts-10.3 et-1.6.4 eunit-2.3.7 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 jinterface-1.9.1 kernel-6.3 megaco-3.18.4 mnesia-4.15.6 observer-2.9 odbc-2.12.3 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.5 reltool-0.7.8 runtime_tools-1.13.2 sasl-3.3 snmp-5.2.12 ssh-4.7.4 stdlib-3.8 syntax_tools-2.1.7 tftp-1.0.1 tools-3.1 wx-1.8.7 xmerl-1.3.19 : OTP-21.3 : common_test-1.17 compiler-7.3.2 crypto-4.4.1 dialyzer-3.3.2 diameter-2.2 edoc-0.10 erl_docgen-0.9 erl_interface-3.11 erts-10.3 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 kernel-6.3 mnesia-4.15.6 observer-2.9 odbc-2.12.3 public_key-1.6.5 runtime_tools-1.13.2 ssh-4.7.4 ssl-9.2 stdlib-3.8 syntax_tools-2.1.7 tools-3.1 wx-1.8.7 # asn1-5.0.8 debugger-4.2.6 eldap-1.2.6 et-1.6.4 eunit-2.3.7 jinterface-1.9.1 megaco-3.18.4 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 reltool-0.7.8 sasl-3.3 snmp-5.2.12 tftp-1.0.1 xmerl-1.3.19 : @@ -24,6 +29,7 @@ OTP-21.0.3 : erts-10.0.3 # asn1-5.0.6 common_test-1.16 compiler-7.2.2 crypto-4.3 OTP-21.0.2 : compiler-7.2.2 erts-10.0.2 public_key-1.6.1 stdlib-3.5.1 # asn1-5.0.6 common_test-1.16 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 : OTP-21.0.1 : compiler-7.2.1 erts-10.0.1 # asn1-5.0.6 common_test-1.16 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0 stdlib-3.5 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 : OTP-21.0 : asn1-5.0.6 common_test-1.16 compiler-7.2 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 erts-10.0 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 mnesia-4.15.4 observer-2.8 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 ssh-4.7 ssl-9.0 stdlib-3.5 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 # megaco-3.18.3 odbc-2.12.1 snmp-5.2.11 : +OTP-20.3.8.21 : common_test-1.15.4.2 erl_interface-3.10.2.2 erts-9.3.3.10 snmp-5.2.11.1 ssh-4.6.9.4 tools-2.11.2.1 # asn1-5.0.5.2 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4.1 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 wx-1.8.3 xmerl-1.3.16.1 : OTP-20.3.8.20 : common_test-1.15.4.1 # asn1-5.0.5.2 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4.1 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 erts-9.3.3.9 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.3 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16.1 : OTP-20.3.8.19 : diameter-2.1.4.1 erts-9.3.3.9 # asn1-5.0.5.2 common_test-1.15.4 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.3 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16.1 : OTP-20.3.8.18 : erts-9.3.3.8 # asn1-5.0.5.2 common_test-1.15.4 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.3 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16.1 : diff --git a/scripts/run-dialyzer b/scripts/run-dialyzer index 621de3fa65..44436594d3 100755 --- a/scripts/run-dialyzer +++ b/scripts/run-dialyzer @@ -1,17 +1,47 @@ #!/bin/bash set -e -set -x -$ERL_TOP/bin/dialyzer --build_plt --apps asn1 compiler crypto dialyzer edoc erts et ftp hipe inets kernel mnesia observer public_key runtime_tools snmp ssh ssl stdlib syntax_tools tftp wx xmerl --statistics -$ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps compiler erts ftp tftp kernel stdlib asn1 crypto dialyzer hipe parsetools public_key runtime_tools sasl tools --statistics -$ERL_TOP/bin/dialyzer -n --apps common_test debugger edoc ftp inets mnesia observer ssh ssl syntax_tools tftp wx xmerl --statistics +filter () { + FILTER_RESULT="" + for app in $1; do + if echo " $2 " | grep -v " $app " > /dev/null; then + FILTER_RESULT="$FILTER_RESULT $app" + fi + done +} + +ALL_APPLICATIONS=$(ls -d -1 lib/*/ | sed 's:^lib\|/::g') +echo "All applications: $ALL_APPLICATIONS" |tr '\n' ' ' && echo "" + +BASE_PLT="compiler crypto erts hipe kernel stdlib syntax_tools" +APP_PLT="asn1 edoc et ftp inets mnesia observer public_key sasl runtime_tools snmp ssl tftp wx xmerl tools" +NO_UNMATCHED="common_test debugger edoc eunit ftp inets mnesia observer reltool ssh ssl syntax_tools tftp wx xmerl" +WARNINGS="diameter megaco snmp" + +TRAVIS_SKIP="" +if [ "X$TRAVIS" = "Xtrue" ]; then + TRAVIS_SKIP="common_test eldap erl_docgen odbc eunit reltool os_mon diameter megaco snmp" +fi + +filter "$ALL_APPLICATIONS" "$NO_UNMATCHED $WARNINGS $TRAVIS_SKIP" +UNMATCHED=$FILTER_RESULT +filter "$APP_PLT" "$TRAVIS_SKIP" +APP_PLT=$FILTER_RESULT +filter "$NO_UNMATCHED" "$TRAVIS_SKIP" +NO_UNMATCHED=$FILTER_RESULT +filter "$WARNINGS" "$TRAVIS_SKIP" +WARNINGS=$FILTER_RESULT -# In travis we don't dialyze everything as it takes too much time -if [ "X$TRAVIS" != "Xtrue" ]; then - $ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps eldap erl_docgen et odbc --statistics - $ERL_TOP/bin/dialyzer -n --apps eunit reltool os_mon --statistics +echo "UNMATCHED = $UNMATCHED" +echo "NO_UNMATCHED = $NO_UNMATCHED" +echo "WARNINGS = $WARNINGS" + +set -x - # These application are not run always as the currently have dialyzer warnings - # $ERL_TOP/bin/dialyzer -n --apps diameter megaco snmp --statistics +$ERL_TOP/bin/dialyzer --build_plt -Wunknown --apps $BASE_PLT $APP_PLT --statistics +$ERL_TOP/bin/dialyzer -n -Wunknown -Wunmatched_returns --apps $UNMATCHED --statistics +$ERL_TOP/bin/dialyzer -n -Wunknown --apps $NO_UNMATCHED --statistics +if [ "X$WARNINGS" != "X" ]; then + $ERL_TOP/bin/dialyzer -n --apps $WARNINGS --statistics fi diff --git a/system/doc/efficiency_guide/commoncaveats.xml b/system/doc/efficiency_guide/commoncaveats.xml index 367da09ba3..7b2128d888 100644 --- a/system/doc/efficiency_guide/commoncaveats.xml +++ b/system/doc/efficiency_guide/commoncaveats.xml @@ -36,10 +36,9 @@ <title>Timer Module</title> <p>Creating timers using <seealso - marker="erts:erlang#erlang:send_after/3">erlang:send_after/3</seealso> + marker="erts:erlang#send_after/3">erlang:send_after/3</seealso> and - <seealso marker="erts:erlang#erlang:start_timer/3">erlang:start_timer/3</seealso> -, + <seealso marker="erts:erlang#start_timer/3">erlang:start_timer/3</seealso>, is much more efficient than using the timers provided by the <seealso marker="stdlib:timer">timer</seealso> module in STDLIB. The <c>timer</c> module uses a separate process to manage the timers. diff --git a/system/doc/installation_guide/Makefile b/system/doc/installation_guide/Makefile index 38252757d6..c5234c1c9a 100644 --- a/system/doc/installation_guide/Makefile +++ b/system/doc/installation_guide/Makefile @@ -113,6 +113,8 @@ clean clean_docs: rm -f $(GENERATED_XML_FILES) rm -f $(XMLDIR)/*.xml rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html + rm -f $(XML_GEN_FILES) + rm -rf $(HTMLDIR) rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) rm -f errs core *~ diff --git a/system/doc/system_principles/create_target.xmlsrc b/system/doc/system_principles/create_target.xmlsrc index 47b84e5760..ea0d938936 100644 --- a/system/doc/system_principles/create_target.xmlsrc +++ b/system/doc/system_principles/create_target.xmlsrc @@ -352,7 +352,7 @@ fi START_ERL_DATA=${1:-$RELDIR/start_erl.data} $ROOTDIR/bin/run_erl -daemon /tmp/ $ROOTDIR/log "exec $ROOTDIR/bin/start_erl $ROOTDIR\ -$RELDIR $START_ERL_DATA -heart</code> +$RELDIR $START_ERL_DATA -heart"</code> <p>We use the simplest possible <c>sys.config</c>, which we store in <c>releases/FIRST</c>:</p> <code type="none"> diff --git a/system/doc/tutorial/overview.xml b/system/doc/tutorial/overview.xml index 255c22f2c1..bd652b1e4b 100644 --- a/system/doc/tutorial/overview.xml +++ b/system/doc/tutorial/overview.xml @@ -245,13 +245,13 @@ Term = binary_to_term(Binary)</pre> </section> <section> - <title>IC</title> + <title>IC and CORBA</title> <p>IC (Erlang IDL Compiler) is an interface generator that, given an IDL interface specification, automatically generates stub code in Erlang, C, or Java. See the IC User's Guide and IC Reference Manual.</p> - <p>For details, see the <seealso marker="ic:ic">ic</seealso> - manual page in IC.</p> + <p>For details, see the + <url href="https://github.com/erlang/corba">corba repository</url>.</p> </section> <section> |