diff options
161 files changed, 10912 insertions, 4821 deletions
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/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/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_ext_dist.xml b/erts/doc/src/erl_ext_dist.xml index a6bc44b8c8..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> 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/emulator/Makefile.in b/erts/emulator/Makefile.in index 448f41b523..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 \ @@ -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/dist.c b/erts/emulator/beam/dist.c index 30fe13fad3..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 @@ -1844,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); } @@ -1886,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; } @@ -1936,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); @@ -1993,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, @@ -2048,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; @@ -2307,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; @@ -2318,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); @@ -3431,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); } 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 7ff345a54b..0339589b79 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -4236,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; @@ -4693,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_db.c b/erts/emulator/beam/erl_db.c index c0f5c506f4..d24f30f126 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -4573,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 b22f35a5ef..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); diff --git a/erts/emulator/beam/erl_db_catree.c b/erts/emulator/beam/erl_db_catree.c index 962fe4c4f8..e0d5e44f58 100644 --- a/erts/emulator/beam/erl_db_catree.c +++ b/erts/emulator/beam/erl_db_catree.c @@ -647,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) { @@ -1406,6 +1407,9 @@ int db_create_catree(Process *p, DbTable *tbl) 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; } @@ -2257,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 fde442eaf5..cf3498dabb 100644 --- a/erts/emulator/beam/erl_db_catree.h +++ b/erts/emulator/beam/erl_db_catree.h @@ -124,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_util.h b/erts/emulator/beam/erl_db_util.h index 97f2848679..02d4dd6c9a 100644 --- a/erts/emulator/beam/erl_db_util.h +++ b/erts/emulator/beam/erl_db_util.h @@ -326,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_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_process.c b/erts/emulator/beam/erl_process.c index 2b45d2d353..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,15 +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); + 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: @@ -12163,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 @@ -12350,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); @@ -12386,15 +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); + 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: @@ -12410,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 @@ -12891,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_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/external.c b/erts/emulator/beam/external.c index 395ff51ad3..ec67ab2aed 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -112,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); @@ -603,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) @@ -1253,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); @@ -1272,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); @@ -1331,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); @@ -1880,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 { @@ -1924,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 { @@ -2012,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); } @@ -2062,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; @@ -2081,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); @@ -2118,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 */ @@ -4184,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) { @@ -4223,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: @@ -4399,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); @@ -4420,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); @@ -4452,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); } @@ -4492,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 f2cc9bf98f..b556c9076c 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -164,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/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/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/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 98be50815c..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; } } 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/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/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index 6e31c73e10..7885d35d9d 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -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]). @@ -96,7 +97,7 @@ all() -> 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]}, @@ -1460,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, @@ -1479,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 @@ -1504,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 @@ -1528,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). diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index cbed71cedd..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), @@ -2644,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) @@ -2652,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/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/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/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/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/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/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/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/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 1ba49558c8..56691223c4 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -490,7 +490,7 @@ poly1305(Config) -> %%-------------------------------------------------------------------- no_poly1305() -> [{doc, "Test disabled poly1305 function"}]. -no_poly1305(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">>, @@ -1581,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; 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/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/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/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/src/docgen_edoc_xml_cb.erl b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl index 2c9aa2e3a3..5342d02947 100644 --- a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl +++ b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl @@ -1260,7 +1260,6 @@ get_text(#xmlElement{content=[E]}) -> %% text_and_name_only(Es) -> {N, Ts} text_and_a_name_only(Es) -> - erlang:display(Es), case [Name || #xmlElement{ name = a, attributes = [#xmlAttribute{name=name}]}=Name <- Es] 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/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/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/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/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/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/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/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/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/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 8db5620686..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> 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 431c77141c..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(). 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/src/misc/snmp_misc.erl b/lib/snmp/src/misc/snmp_misc.erl index 0cc04d4056..39254503ac 100644 --- a/lib/snmp/src/misc/snmp_misc.erl +++ b/lib/snmp/src/misc/snmp_misc.erl @@ -151,41 +151,41 @@ formated_long_timestamp() -> %% the date in the formatted timestamp. %% --------------------------------------------------------------------------- --spec format_timestamp(Now :: os:timestamp()) -> +-spec format_timestamp(Now :: erlang:timestamp()) -> string(). format_timestamp(Now) -> format_long_timestamp(Now). --spec format_short_timestamp(Now :: os:timestamp()) -> +-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 :: os:timestamp()) -> +-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 :: os:timestamp(), +-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 :: os:timestamp(), +-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 :: os:timestamp(), +-spec format_long_timestamp(Now :: erlang:timestamp(), N2T :: function()) -> string(). @@ -195,14 +195,8 @@ format_long_timestamp(Now, N2T) when is_tuple(Now) andalso is_function(N2T) -> format_timestamp(Format, {_N1, _N2, N3} = Now, N2T) -> {Date, Time} = N2T(Now), do_format_timestamp(Format, Date, Time, N3). - %% case Format of - %% short -> - %% do_format_short_timestamp(Time, N3); - %% long -> - %% do_format_long_timestamp(Date, Time, N3) - %% end. - -do_format_timestamp(short, 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). diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index bad5815f40..78990c48f2 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,28 @@ <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> 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.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_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 2299346a30..eaab13433a 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -1328,13 +1328,15 @@ 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}; @@ -1346,7 +1348,7 @@ cipher('3des-cbc') -> 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 @@ -1457,18 +1463,19 @@ encrypt(#ssh{encrypt = '[email protected]', {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_time(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_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} + 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 2947f82556..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.5 +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/ssl.erl b/lib/ssl/src/ssl.erl index 74511dce4b..e3bb4df1ac 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -86,27 +86,28 @@ 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 | @@ -117,14 +118,14 @@ 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 | @@ -133,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 @@ -155,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, @@ -195,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 | @@ -234,6 +238,7 @@ bad_certificate_hash_value | unknown_psk_identity | no_application_protocol. + %% ------------------------------------------------------------------------------------------------------- -type common_option() :: {protocol, protocol()} | {handshake, handshake_completion()} | @@ -243,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()} | @@ -270,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()}. @@ -375,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(), @@ -383,7 +387,7 @@ next_protocol => app_level_protocol(), ec_point_formats => [0..2], elliptic_curves => [public_key:oid()], - sni => hostname()}. + sni => hostname()}. % exported %% ------------------------------------------------------------------------------------------------------- %%%-------------------------------------------------------------------- @@ -419,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)), @@ -443,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 @@ -461,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. @@ -480,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) -> @@ -502,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) -> @@ -515,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) -> @@ -533,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); @@ -553,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); @@ -597,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. @@ -606,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. @@ -615,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. %%-------------------------------------------------------------------- @@ -623,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 %%-------------------------------------------------------------------- @@ -635,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 %%-------------------------------------------------------------------- @@ -651,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 %%-------------------------------------------------------------------- @@ -671,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); @@ -687,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. @@ -706,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 %%-------------------------------------------------------------------- @@ -723,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 %%-------------------------------------------------------------------- @@ -737,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. %%-------------------------------------------------------------------- @@ -753,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. %%-------------------------------------------------------------------- @@ -770,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} @@ -784,8 +910,9 @@ 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) -> @@ -799,9 +926,10 @@ cipher_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 %%-------------------------------------------------------------------- @@ -817,9 +945,10 @@ cipher_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 @@ -837,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 @@ -855,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. @@ -872,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() -> @@ -880,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(), @@ -908,22 +1036,24 @@ 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 %%-------------------------------------------------------------------- @@ -954,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 %%-------------------------------------------------------------------- @@ -1010,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. @@ -1021,9 +1153,9 @@ 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()}]. %% @@ -1036,7 +1168,9 @@ getstat(#sslsocket{pid = [Pid|_], fd = {Transport, Socket, _, _}}, Options) when 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 %%-------------------------------------------------------------------- @@ -1050,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 %%-------------------------------------------------------------------- @@ -1064,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. %%-------------------------------------------------------------------- @@ -1085,7 +1223,8 @@ versions() -> %%--------------------------------------------------------------- --spec renegotiate(#sslsocket{}) -> ok | {error, reason()}. +-spec renegotiate(SslSocket) -> ok | {error, reason()} when + SslSocket :: sslsocket(). %% %% Description: Initiates a renegotiation. %%-------------------------------------------------------------------- @@ -1105,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 %%-------------------------------------------------------------------- @@ -1128,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. %%-------------------------------------------------------------------- @@ -1167,7 +1311,14 @@ 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. %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index 9c5e2f80a9..0fa5f66c49 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -690,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 887eb6c653..577156a4b5 100644 --- a/lib/ssl/src/ssl_cipher_format.erl +++ b/lib/ssl/src/ssl_cipher_format.erl @@ -955,12 +955,12 @@ suite_bin_to_map(?TLS_CHACHA20_POLY1305_SHA256) -> #{key_exchange => any, cipher => chacha20_poly1305, mac => aead, - prf => sha256}. -%% suite_bin_to_map(?TLS_AES_128_CCM_SHA256) -> -%% #{key_exchange => any, -%% cipher => aes_128_ccm, -%% mac => aead -%% prf => sha256}; + 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, @@ -1690,12 +1690,12 @@ suite_map_to_bin(#{key_exchange := any, cipher := chacha20_poly1305, mac := aead, prf := sha256}) -> - ?TLS_CHACHA20_POLY1305_SHA256. -%% suite_map_to_bin(#{key_exchange := any, -%% cipher := aes_128_ccm, -%% mac := aead, -%% prf := sha256}) -> -%% ?TLS_AES_128_CCM_SHA256; + ?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, diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 6e325b504c..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 %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index dc037bb1ea..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. 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/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index 74ab0d5923..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 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_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 f7fae16088..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 \ 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_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 7b98209b31..20d9f28512 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -549,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). %%-------------------------------------------------------------------- @@ -1833,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. @@ -3655,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). 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 8805df7b52..51788c29e7 100644 --- a/lib/ssl/test/ssl_cipher_suite_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_suite_SUITE.erl @@ -127,7 +127,6 @@ groups() -> ]} ]. - kex() -> rsa() ++ ecdsa() ++ dss() ++ anonymous(). @@ -154,7 +153,6 @@ anonymous() -> {group, ecdhe_psk}, {group, srp_anon} ]. - init_per_suite(Config) -> catch crypto:stop(), @@ -170,7 +168,7 @@ end_per_suite(_Config) -> ssl:stop(), application:stop(crypto). -%%-------------------------------------------------------------------- + init_per_group(GroupName, Config) when GroupName == ecdh_anon; GroupName == ecdhe_rsa; GroupName == ecdhe_psk -> @@ -236,6 +234,7 @@ end_per_group(GroupName, 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; @@ -302,8 +301,7 @@ init_per_testcase(TestCase, Config) when TestCase == psk_aes_256_ccm_8; {skip, "Missing AES_256_CCM crypto support"} end; init_per_testcase(TestCase, Config) -> - Cipher = test_cipher(TestCase, Config), - %%Reason = io_lib:format("Missing ~p crypto support", [Cipher]), + Cipher = ssl_test_lib:test_cipher(TestCase, Config), SupCiphers = proplists:get_value(ciphers, crypto:supports()), case lists:member(Cipher, SupCiphers) of true -> @@ -316,17 +314,21 @@ 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 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(rsa_psk, Config) -> @@ -335,9 +337,9 @@ init_certs(rsa_psk, Config) -> [[],[],[{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]}]), @@ -362,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; @@ -389,12 +391,12 @@ 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 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) -> @@ -402,6 +404,7 @@ init_certs(_GroupName, Config) -> [{tls_config, #{server_config => [], client_config => []}} | proplists:delete(tls_config, Config)]. + %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- @@ -700,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), @@ -717,30 +716,28 @@ 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]} | + {options, [{versions, [Version]}, {ciphers, [ErlangCipherSuite]} | ClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -748,17 +745,6 @@ cipher_suite_test(CipherSuite, Version, Config) -> 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:suite_openssl_str_to_map(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), @@ -770,3 +756,4 @@ test_ciphers(Kex, Cipher, Version) -> fun(Cipher0) when Cipher0 == Cipher -> true; (_) -> false end}]). + diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 798bdf0416..3b161a0c8a 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -631,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). %% @@ -1067,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). @@ -1134,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 @@ -1169,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}, @@ -1245,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(), @@ -1873,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', _} -> @@ -1885,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; @@ -2374,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/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/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/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/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 4640b2b228..dd49288417 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -4461,21 +4461,24 @@ add_loop(T, I) -> 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(fun() -> - size_loop(T, SizeLoopSize, 0, WhatToTest), - P ! done - end) + [spawn_link(fun() -> + size_loop(T, SizeLoopSize, 0, WhatToTest), + P ! done + end) || _ <- lists:seq(1, 6)], - spawn(fun() -> - add_loop(T, ItemsToAdd), - P ! done_add - end), + spawn_link(fun() -> + add_loop(T, ItemsToAdd), + P ! done_add + end), [receive done -> ok; done_add -> ok @@ -4487,6 +4490,7 @@ test_table_counter_concurrency(WhatToTest) -> _ -> ok end, + erts_debug:set_internal_state(available_internal_state, IntStatePrevOn), ok. test_table_size_concurrency(Config) when is_list(Config) -> 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 8756a4e9b3..73270e6ed6 100644 --- a/lib/tools/test/emacs_SUITE.erl +++ b/lib/tools/test/emacs_SUITE.erl @@ -119,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), @@ -144,6 +144,10 @@ tests_compiled(_Config) -> ok end. + +dquote(Str) -> + "\"" ++ Str ++ "\"". + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% indent(Config) -> @@ -207,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/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/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/otp_versions.table b/otp_versions.table index 42c57a68fa..566aa3cb4c 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,5 @@ +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 : 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/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"> |