diff options
238 files changed, 5964 insertions, 1608 deletions
diff --git a/OTP_VERSION b/OTP_VERSION index 8fad390b2f..6f1dcfcb03 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -17.2 +17.3-rc0 diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot Binary files differindex b57eef57ab..c497fe37fc 100644 --- a/bootstrap/bin/start.boot +++ b/bootstrap/bin/start.boot diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot Binary files differindex b57eef57ab..c497fe37fc 100644 --- a/bootstrap/bin/start_clean.boot +++ b/bootstrap/bin/start_clean.boot diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 42ff7e9c1f..f58fdd7171 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index f415965277..f12713417f 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -18,7 +18,7 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "5.0"}, + {vsn, "5.0.1"}, {modules, [ beam_a, beam_asm, diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex 923c4d98fd..cce0ac7832 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/kernel/ebin/erl_boot_server.beam b/bootstrap/lib/kernel/ebin/erl_boot_server.beam Binary files differindex 7e43b0fb36..6e56a1061d 100644 --- a/bootstrap/lib/kernel/ebin/erl_boot_server.beam +++ b/bootstrap/lib/kernel/ebin/erl_boot_server.beam diff --git a/bootstrap/lib/kernel/ebin/erl_epmd.beam b/bootstrap/lib/kernel/ebin/erl_epmd.beam Binary files differindex 1a74da7f1f..bf171450e9 100644 --- a/bootstrap/lib/kernel/ebin/erl_epmd.beam +++ b/bootstrap/lib/kernel/ebin/erl_epmd.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex 46263fae7b..b24c850af3 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex fe203f816f..4d156b726c 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app index 1fd4edd044..e60b36e1e7 100644 --- a/bootstrap/lib/kernel/ebin/kernel.app +++ b/bootstrap/lib/kernel/ebin/kernel.app @@ -21,7 +21,7 @@ {application, kernel, [ {description, "ERTS CXC 138 10"}, - {vsn, "3.0"}, + {vsn, "3.0.2"}, {modules, [application, application_controller, application_master, @@ -115,6 +115,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-6.0", "stdlib-2.0", "sasl-2.4"]} + {runtime_dependencies, ["erts-6.1.2", "stdlib-2.0", "sasl-2.4"]} ] }. diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam Binary files differindex fb722b3b4e..4b09aae8a5 100644 --- a/bootstrap/lib/kernel/ebin/net_adm.beam +++ b/bootstrap/lib/kernel/ebin/net_adm.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam Binary files differindex fe45755343..b2b97bda8a 100644 --- a/bootstrap/lib/stdlib/ebin/erl_scan.beam +++ b/bootstrap/lib/stdlib/ebin/erl_scan.beam diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam Binary files differindex 1f84adafa5..9fc7dd79cb 100644 --- a/bootstrap/lib/stdlib/ebin/filelib.beam +++ b/bootstrap/lib/stdlib/ebin/filelib.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam Binary files differindex bf5bbb7839..1eee773838 100644 --- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam +++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam Binary files differindex fe95ca0826..cb9421b7c5 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam Binary files differindex e579d3cb2e..fcfce54d0e 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_format.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_format.beam diff --git a/bootstrap/lib/stdlib/ebin/maps.beam b/bootstrap/lib/stdlib/ebin/maps.beam Binary files differindex 4268a97fec..8473da95d7 100644 --- a/bootstrap/lib/stdlib/ebin/maps.beam +++ b/bootstrap/lib/stdlib/ebin/maps.beam diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam Binary files differindex ee23fef6f0..368d3e39a0 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex 3756c0d46a..8c4734f208 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app index 1d255fb2c8..8cbf23e958 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.app +++ b/bootstrap/lib/stdlib/ebin/stdlib.app @@ -19,7 +19,7 @@ %% {application, stdlib, [{description, "ERTS CXC 138 10"}, - {vsn, "2.0"}, + {vsn, "2.1.1"}, {modules, [array, base64, beam_lib, @@ -103,7 +103,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.4","kernel-3.0","erts-6.0","crypto-3.3", + {runtime_dependencies, ["sasl-2.4","kernel-3.0.2","erts-6.2","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/configure.in b/configure.in index be906dcb4e..780e660f9d 100644 --- a/configure.in +++ b/configure.in @@ -366,6 +366,12 @@ elif test X"$TMPSYS" '=' X"Darwin-i386"; then export LDFLAGS fi +m4_define(DEFAULT_SANITIZERS, [address,undefined]) +AC_ARG_ENABLE(sanitizers, + AS_HELP_STRING( + [--enable-sanitizers@<:@=comma-separated list of sanitizers@:>@], + [Default=DEFAULT_SANITIZERS])) + AC_ARG_ENABLE([silent-rules], [dnl AS_HELP_STRING( [--enable-silent-rules], diff --git a/erts/configure.in b/erts/configure.in index f66110b98b..40b335849c 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -4821,6 +4821,26 @@ if test "x$GCC" = xyes; then fi dnl ---------------------------------------------------------------------- +dnl Enable -fsanitize= flags. +dnl ---------------------------------------------------------------------- + +m4_define(DEFAULT_SANITIZERS, [address,undefined]) +AC_ARG_ENABLE( + sanitizers, + AS_HELP_STRING( + [--enable-sanitizers@<:@=comma-separated list of sanitizers@:>@], + [Default=DEFAULT_SANITIZERS]), +[ +case "$enableval" in + no) sanitizers= ;; + yes) sanitizers="-fsanitize=DEFAULT_SANITIZERS" ;; + *) sanitizers="-fsanitize=$enableval" ;; +esac +CFLAGS="$CFLAGS $sanitizers" +LDFLAGS="$LDFLAGS $sanitizers" +]) + +dnl ---------------------------------------------------------------------- dnl Output the result. dnl ---------------------------------------------------------------------- diff --git a/erts/doc/src/crash_dump.xml b/erts/doc/src/crash_dump.xml index c59741f250..d3de29b876 100644 --- a/erts/doc/src/crash_dump.xml +++ b/erts/doc/src/crash_dump.xml @@ -85,20 +85,22 @@ operating system.</p> <list type="bulleted"> <item>"<em><A></em>: Cannot allocate <em><N></em> - bytes of memory (of type "<em><T></em>")." - The system - has run out of memory. <A> is the allocator that failed - to allocate memory, <N> is the number of bytes that - <A> tried to allocate, and <T> is the memory block - type that the memory was needed for. The most common case is - that a process stores huge amounts of data. In this case - <T> is most often <c><![CDATA[heap]]></c>, <c><![CDATA[old_heap]]></c>, - <c><![CDATA[heap_frag]]></c>, or <c><![CDATA[binary]]></c>. For more information on - allocators see - <seealso marker="erts_alloc">erts_alloc(3)</seealso>.</item> + bytes of memory (of type "<em><T></em>", thread + <em><I></em>em>)." - The system has run out of memory. <A> + is the allocator that failed to allocate memory, <N> is the + number of bytes that <A> tried to allocate, <T> is the + memory block type that the memory was needed for, and <I> is the + thread identifier. The most common case is that a process stores huge + amounts of data. In this case <T> is most often + <c><![CDATA[heap]]></c>, <c><![CDATA[old_heap]]></c>, + <c><![CDATA[heap_frag]]></c>, or <c><![CDATA[binary]]></c>. + For more information on allocators see + <seealso marker="erts_alloc">erts_alloc(3)</seealso>.</item> <item>"<em><A></em>: Cannot reallocate <em><N></em> - bytes of memory (of type "<em><T></em>")." - Same as - above with the exception that memory was being reallocated - instead of being allocated when the system ran out of memory.</item> + bytes of memory (of type "<em><T></em>", thread + <em><I></em>em>)." - Same as above with the exception that memory + was being reallocated instead of being allocated when the system ran + out of memory.</item> <item>"Unexpected op code <em>N</em>" - Error in compiled code, <c><![CDATA[beam]]></c> file damaged or error in the compiler.</item> <item>"Module <em>Name</em> undefined" <c><![CDATA[|]]></c> "Function @@ -246,6 +248,9 @@ <tag><em>Last scheduled in for | Current call</em></tag> <item>The current function of the process. These fields will not always exist.</item> + <tag><em>Run queue</em></tag> + <item>The identifier of the scheduler run queue in which the process is + running.</item> <tag><em>Spawned by</em></tag> <item>The parent of the process, i.e. the process which executed <c><![CDATA[spawn]]></c> or <c><![CDATA[spawn_link]]></c>.</item> diff --git a/erts/doc/src/epmd.xml b/erts/doc/src/epmd.xml index 963d35c3c8..25f819ab50 100644 --- a/erts/doc/src/epmd.xml +++ b/erts/doc/src/epmd.xml @@ -58,12 +58,12 @@ of the IP address and a port number. The name of the node is an atom on the form of <c><![CDATA[Name@Node]]></c>. The job of the <c><![CDATA[epmd]]></c> daemon is to keep track of which - node name listens on which address. Hence, <c><![CDATA[epmd]]></c> map + node name listens on which address. Hence, <c><![CDATA[epmd]]></c> maps symbolic node names to machine addresses.</p> <p>The TCP/IP <c>epmd</c> daemon actually only keeps track of - the <c>Name</c> (first) part of an Erlang node name, the <c>Host</c> - part (whatever is after the <c><![CDATA[@]]></c> is implicit in the + the <c>Name</c> (first) part of an Erlang node name. The <c>Host</c> + part (whatever is after the <c><![CDATA[@]]></c>) is implicit in the node name where the <c>epmd</c> daemon was actually contacted, as is the IP address where the Erlang node can be reached. Consistent and correct TCP naming services are @@ -77,12 +77,12 @@ <p>The daemon is started automatically by the <c>erl</c> command if the node is to be distributed and there is no running instance present. If automatically launched, - environment variables has to be used to alter the behavior of + environment variables have to be used to alter the behavior of the daemon. See the <seealso marker="#environment_variables">Environment variables</seealso> section below.</p> - <p>If the -daemon argument is not given, the + <p>If the -daemon argument is not given, <c><![CDATA[epmd]]></c> runs as a normal program with the controlling terminal of the shell in which it is started. Normally, it should run as a daemon.</p> @@ -122,7 +122,7 @@ comma-separated list of IP addresses and on the loopback address (which is implicitly added to the list if it has not been specified). This can also be set using the - <c><![CDATA[ERL_EPMD_ADDRESS]]></c> environment variable, see the + <c><![CDATA[ERL_EPMD_ADDRESS]]></c> environment variable. See the section <seealso marker="#environment_variables">Environment variables</seealso> below.</p> </item> @@ -130,7 +130,7 @@ <item> <p>Let this instance of epmd listen to another TCP port than default 4369. This can also be set using the - <c><![CDATA[ERL_EPMD_PORT]]></c> environment variable, see the + <c><![CDATA[ERL_EPMD_PORT]]></c> environment variable. See the section <seealso marker="#environment_variables">Environment variables</seealso> below</p> </item> @@ -153,7 +153,7 @@ <p>With relaxed command checking, the <c>epmd</c> daemon can be killed from the localhost with i.e. <c>epmd -kill</c> even if there are active nodes registered. Normally only daemons with an empty node database can be killed with the <c>epmd -kill</c> command.</p> </item> <item> - <p>The <c>epmd -stop</c> command (and the corresponding messages to epmd, as can be given using <c>erl_interface/ei</c>) is normally always ignored, as it opens up for strange situation when two nodes of the same name can be alive at the same time. A node unregisters itself by just closing the connection to epmd, why the <c>stop</c> command was only intended for use in debugging situations.</p> + <p>The <c>epmd -stop</c> command (and the corresponding messages to epmd, as can be given using <c>erl_interface/ei</c>) is normally always ignored, as it opens up the possibility of a strange situation where two nodes of the same name can be alive at the same time. A node unregisters itself by just closing the connection to epmd, which is why the <c>stop</c> command was only intended for use in debugging situations.</p> <p>With relaxed command checking enabled, you can forcibly unregister live nodes.</p> </item> </list> @@ -166,7 +166,7 @@ <section> <marker id="debug_flags"></marker> <title>DbgExtra options</title> - <p>These options are purely for debugging and testing epmd clients, they should not be used in normal operation.</p> + <p>These options are purely for debugging and testing epmd clients. They should not be used in normal operation.</p> <taglist> <tag><c><![CDATA[-packet_timeout Seconds]]></c></tag> @@ -177,9 +177,9 @@ </item> <tag><c><![CDATA[-delay_accept Seconds]]></c></tag> <item> - <p>To simulate a busy server you can insert a delay between epmd - gets notified about that a new connection is requested and - when the connections gets accepted.</p> + <p>To simulate a busy server you can insert a delay between when epmd + gets notified that a new connection is requested and + when the connection gets accepted.</p> </item> <tag><c><![CDATA[-delay_write Seconds]]></c></tag> <item> @@ -191,15 +191,15 @@ <section> <marker id="interactive_flags"></marker> <title>Interactive options</title> - <p>These options make <c>epmd</c> run as an interactive command displaying the results of sending queries ta an already running instance of <c>epmd</c>. The epmd contacted is always on the local node, but the <c>-port</c> option can be used to select between instances if several are running using different port on the host.</p> + <p>These options make <c>epmd</c> run as an interactive command, displaying the results of sending queries to an already running instance of <c>epmd</c>. The epmd contacted is always on the local node, but the <c>-port</c> option can be used to select between instances if several are running using different ports on the host.</p> <taglist> <tag><c><![CDATA[-port No]]></c></tag> <item> <p>Contacts the <c>epmd</c> listening on the given TCP port number (default 4369). This can also be set using the - <c><![CDATA[ERL_EPMD_PORT]]></c> environment variable, see the + <c><![CDATA[ERL_EPMD_PORT]]></c> environment variable. See the section <seealso marker="#environment_variables">Environment - variables</seealso> below</p> + variables</seealso> below.</p> </item> <tag><c><![CDATA[-names]]></c></tag> <item> @@ -210,7 +210,7 @@ <p>Kill the currently running <c>epmd</c>.</p> <p>Killing the running <c>epmd</c> is only allowed if <c>epmd - -names</c> show an empty database or + -names</c> shows an empty database or <c>-relaxed_command_check</c> was given when the running instance of <c>epmd</c> was started. Note that <c>-relaxed_command_check</c> is given when starting the @@ -228,7 +228,7 @@ <p>This command can only be used when contacting <c>epmd</c> instances started with the <c>-relaxed_command_check</c> flag. Note that relaxed command checking has to be enabled for - the <c>epmd</c> daemon contacted, When running epmd + the <c>epmd</c> daemon contacted. When running epmd interactively, <c>-relaxed_command_check</c> has no effect.</p> </item> @@ -259,7 +259,7 @@ <item> <p>If set prior to start, the <c>epmd</c> daemon will behave as if the <c>-relaxed_command_check</c> option was given at - start-up. If consequently setting this option before starting + start-up. Consequently, if this option is set before starting the Erlang virtual machine, the automatically started <c>epmd</c> will accept the <c>-kill</c> and <c>-stop</c> commands without restrictions.</p> @@ -287,8 +287,8 @@ remote hosts. However, only the query commands are answered (and acted upon) if the query comes from a remote host. It is always an error to try to register a nodename if the client is not a process - located on the same host as the <c>epmd</c> instance is running on, - why such requests are considered hostile and the connection is + located on the same host as the <c>epmd</c> instance is running on- + such requests are considered hostile and the connection is immediately closed.</p> <p>The queries accepted from remote nodes are:</p> @@ -307,3 +307,4 @@ </comref> + diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index f8f4d14436..f856b9ab86 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -851,6 +851,19 @@ </p> </item> <tag><marker id="+SDio"><c><![CDATA[+SDio IOSchedulers]]></c></marker></tag> + <item> + <p>Sets the number of dirty I/O scheduler threads to create when threading + support has been enabled. The valid range is 0-1024. By default, the number + of dirty I/O scheduler threads created is 10, same as the default number of + threads in the <seealso marker="#async_thread_pool_size">async thread pool + </seealso>. + </p> + <p>This option is ignored if the emulator doesn't have threading support + enabled. Currently, <em>this option is experimental</em> and is supported only + if the emulator was configured and built with support for dirty schedulers + enabled (it's disabled by default). + </p> + </item> <tag><c><![CDATA[+sFlag Value]]></c></tag> <item> <p>Scheduling specific flags.</p> @@ -1173,7 +1186,7 @@ utilization. </p> </item> - <tag><marker id="+swct"><c>+sws very_eager|eager|medium|lazy|very_lazy</c></marker></tag> + <tag><marker id="+swct"><c>+swct very_eager|eager|medium|lazy|very_lazy</c></marker></tag> <item> <p> Set scheduler wake cleanup threshold. Default is <c>medium</c>. diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 6b1f4cccf8..1d33b334bb 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -168,16 +168,18 @@ ok <p><marker id="lengthy_work"/> As mentioned in the <seealso marker="#WARNING">warning</seealso> text at the beginning of this document it is of vital importance that a native function - does return relatively fast. It is hard to give an exact maximum amount + return relatively quickly. It is hard to give an exact maximum amount of time that a native function is allowed to work, but as a rule of thumb - a well behaving native function should return to its caller before a + a well-behaving native function should return to its caller before a millisecond has passed. This can be achieved using different approaches. - If you have full control over the code that are to execute in the native + If you have full control over the code to execute in the native function, the best approach is to divide the work into multiple chunks of - work and call the native function multiple times. Function + work and call the native function multiple times, either directly from Erlang code + or by having a native function schedule a future NIF call via the + <seealso marker="#enif_schedule_nif"> enif_schedule_nif</seealso> function. Function <seealso marker="#enif_consume_timeslice">enif_consume_timeslice</seealso> can be - used this facilitate such work division. In some cases, however, this might not - be possible, e.g. when calling third party libraries. Then you typically want + used to help with such work division. In some cases, however, this might not + be possible, e.g. when calling third-party libraries. Then you typically want to dispatch the work to another thread, return from the native function, and wait for the result. The thread can send the result back to the calling thread using message passing. Information @@ -342,29 +344,31 @@ ok libraries might however fail if deprecated features are used. </p></item> - <tag>Dirty NIFs</tag> - <item><p><marker id="dirty_nifs"/><em>Note that the dirty NIF functionality - is experimental</em> and that you have to enable support for dirty - schedulers when building OTP in order to try the functionality out. Native functions + <tag>Long-running NIFs</tag> + <item><p><marker id="dirty_nifs"/>Native functions <seealso marker="#lengthy_work"> must normally run quickly</seealso>, as explained earlier in this document. They generally should execute for no more than a millisecond. But not all native functions can execute so quickly; for example, functions that encrypt large blocks of data or perform lengthy file system operations can often run for tens of seconds or more.</p> - <p>A NIF that cannot execute in a millisecond or less is called a "dirty NIF" since - it performs work that the Erlang runtime cannot handle cleanly. Applications - that make use of such functions must indicate to the runtime that the functions are + <p>If the functionality of a long-running NIF can be split so that its work can be + achieved through a series of shorter NIF calls, the application can either make that series + of NIF calls from the Erlang level, or it can call a NIF that first performs a chunk of the + work, then invokes the <seealso marker="#enif_schedule_nif">enif_schedule_nif</seealso> + function to schedule another NIF call to perform the next chunk. The final call scheduled + in this manner can then return the overall result. Breaking up a long-running function in + this manner enables the VM to regain control between calls to the NIFs, thereby avoiding + degraded responsiveness, scheduler load balancing problems, and other strange behaviours.</p> + <p>A NIF that cannot be split and cannot execute in a millisecond or less is called a "dirty NIF" + because it performs work that the Erlang runtime cannot handle cleanly. + <em>Note that the dirty NIF functionality described here is experimental</em> and that you have to + enable support for dirty schedulers when building OTP in order to try the functionality out. + Applications that make use of such functions must indicate to the runtime that the functions are dirty so they can be handled specially. To schedule a dirty NIF for execution, the - application calls <seealso marker="#enif_schedule_dirty_nif">enif_schedule_dirty_nif</seealso>, - passing to it a pointer to the dirty NIF to be executed and indicating with a flag + appropriate flags value can be set for the NIF in its <seealso marker="#ErlNifFunc">ErlNifFunc</seealso> + entry, or the application can call <seealso marker="#enif_schedule_nif">enif_schedule_nif</seealso>, + passing to it a pointer to the dirty NIF to be executed and indicating with the <c>flags</c> argument whether it expects the operation to be CPU-bound or I/O-bound.</p> - <p>All dirty NIFs must ultimately invoke the <seealso marker="#enif_schedule_dirty_nif_finalizer"> - enif_schedule_dirty_nif_finalizer</seealso> as their final action, passing to it the - result they wish to return to the original caller. A finalizer function can either - receive the result and return it directly, or it can return a different value instead. - For convenience, the NIF API provides the <seealso marker="#enif_dirty_nif_finalizer"> - enif_dirty_nif_finalizer</seealso> function that applications can use as a finalizer; - it simply returns its result argument.</p> <note><p>Dirty NIF support is available only when the emulator is configured with dirty schedulers enabled. This feature is currently disabled by default. To determine whether the dirty NIF API is available, native code can check to see if the C preprocessor macro @@ -498,6 +502,7 @@ typedef struct { const char* <em>name</em>; unsigned <em>arity</em>; ERL_NIF_TERM (*<em>fptr</em>)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + unsigned flags; } ErlNifFunc; </code> <p>Describes a NIF by its name, arity and implementation. @@ -508,7 +513,17 @@ typedef struct { will thus denote the Nth argument to the NIF. Note that the <c>argc</c> argument allows for the same C function to implement several Erlang functions with different arity (but - same name probably).</p> + same name probably). For a regular NIF, <c>flags</c> is 0 (and + so its value can be omitted for statically initialized <c>ErlNifFunc</c> + instances), or it can be used to indicate that the NIF is a <seealso + marker="#dirty_nifs">dirty NIF</seealso> that should be executed + on a dirty scheduler thread (<em>note that the dirty NIF functionality + described here is experimental</em> and that you have to enable + support for dirty schedulers when building OTP in order to try the + functionality out). If the dirty NIF is expected to be + CPU-bound, its <c>flags</c> field should be set to + <c>ERL_NIF_DIRTY_JOB_CPU_BOUND</c>, or for I/O-bound jobs, + <c>ERL_NIF_DIRTY_JOB_IO_BOUND</c>.</p> </item> <tag><marker id="ErlNifBinary"/>ErlNifBinary</tag> <item> @@ -672,18 +687,6 @@ typedef enum { See also the <seealso marker="#WARNING">warning</seealso> text at the beginning of this document.</p> </desc> </func> - <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_dirty_nif_finalizer(ErlNifEnv* env, ERL_NIF_TERM result)</nametext></name> - <fsummary>Simple dirty NIF result finalizer</fsummary> - <desc> - <p>A convenience function that a dirty NIF can use as a finalizer that simply - return its <c>result</c> argument as its return value. This function is provided - for dirty NIFs with results that should be returned directly to the original caller.</p> - <note><p>This function is available only when the emulator is configured with dirty - schedulers enabled. This feature is currently disabled by default. To determine whether - the dirty NIF API is available, native code can check to see if the C preprocessor macro - <c>ERL_NIF_DIRTY_SCHEDULER_SUPPORT</c> is defined.</p></note> - </desc> - </func> <func><name><ret>int</ret><nametext>enif_equal_tids(ErlNifTid tid1, ErlNifTid tid2)</nametext></name> <fsummary></fsummary> <desc><p>Same as <seealso marker="erl_driver#erl_drv_equal_tids">erl_drv_equal_tids</seealso>. @@ -811,9 +814,9 @@ typedef enum { built with threading support, dirty scheduler threads are available and <c>enif_have_dirty_schedulers()</c> returns true. If the emulator was built without threading support, <c>enif_have_dirty_schedulers()</c> returns false.</p> - <p>If dirty scheduler threads are not available in the emulator, calls to - <c>enif_schedule_dirty_nif</c> and <c>enif_schedule_dirty_nif_finalizer</c> result in - the NIF and finalizer functions being called directly within the calling thread.</p> + <p>If dirty scheduler threads are not available in the emulator, a call to + <c>enif_schedule_nif</c> with its <c>flags</c> argument set to indicate that the specified + NIF is to be executed on a dirty scheduler thread results in a <c>badarg</c> exception.</p> <note><p>This function is available only when the emulator is configured with dirty schedulers enabled. This feature is currently disabled by default. To determine whether the dirty NIF API is available, native code can check to see if the C preprocessor macro @@ -873,8 +876,8 @@ typedef enum { <p>Check to see if the current NIF is executing on a dirty scheduler thread. If the emulator is built with threading support, calling <c>enif_is_on_dirty_scheduler</c> from within a dirty NIF returns true. It returns false when the calling NIF is a regular - NIF or a NIF finalizer, both of which run on normal scheduler threads, or when the emulator - is built without threading support.</p> + NIF running on a normal scheduler thread, or when the emulator is built without threading + support.</p> <note><p>This function is available only when the emulator is configured with dirty schedulers enabled. This feature is currently disabled by default. To determine whether the dirty NIF API is available, native code can check to see if the C preprocessor macro @@ -1245,46 +1248,27 @@ typedef enum { <desc><p>Same as <seealso marker="erl_driver#erl_drv_rwlock_tryrwlock">erl_drv_rwlock_tryrwlock</seealso>. </p></desc> </func> - <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_schedule_dirty_nif(ErlNifEnv* env, int flags, ERL_NIF_TERM (*fp)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]), int argc, const ERL_NIF_TERM argv[])</nametext></name> - <fsummary>Schedule a dirty NIF for execution</fsummary> + <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_schedule_nif(ErlNifEnv* env, const char* fun_name, int flags, ERL_NIF_TERM (*fp)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]), int argc, const ERL_NIF_TERM argv[])</nametext></name> + <fsummary>Schedule a NIF for execution</fsummary> <desc> - <p>Schedule dirty NIF <c>fp</c> to execute a long-running operation. The <c>flags</c> - argument must be set to either <c>ERL_NIF_DIRTY_JOB_CPU_BOUND</c> if the job is expected to - be primarily CPU-bound, or <c>ERL_NIF_DIRTY_JOB_IO_BOUND</c> for jobs that will be - I/O-bound. The <c>argc</c> and <c>argv</c> arguments can either be the originals passed - into the calling NIF, or they can be values created by the calling NIF. The calling - NIF must use the return value of <c>enif_schedule_dirty_nif</c> as its own return value.</p> - <p>Be aware that <c>enif_schedule_dirty_nif</c>, as its name implies, only schedules the - dirty NIF for future execution. The calling NIF does not block waiting for the dirty NIF to - execute and return, which means that the calling NIF can't expect to receive the dirty NIF + <p>Schedule NIF <c>fp</c> to execute. This function allows an application to break up long-running + work into multiple regular NIF calls or to schedule a <seealso marker="#dirty_nifs">dirty NIF</seealso> + to execute on a dirty scheduler thread (<em>note that the dirty NIF functionality described here is + experimental</em> and that you have to enable support for dirty schedulers when building OTP in + order to try the functionality out).</p> + <p>The <c>fun_name</c> argument provides a name for the NIF being scheduled for execution. If it cannot + be converted to an atom, <c>enif_schedule_nif</c> returns a <c>badarg</c> exception.</p> + <p>The <c>flags</c> argument must be set to 0 for a regular NIF, or if the emulator was built the + experimental dirty scheduler support enabled, <c>flags</c> can be set to either <c>ERL_NIF_DIRTY_JOB_CPU_BOUND</c> + if the job is expected to be primarily CPU-bound, or <c>ERL_NIF_DIRTY_JOB_IO_BOUND</c> for jobs that will + be I/O-bound.</p> + <p>The <c>argc</c> and <c>argv</c> arguments can either be the originals passed into the calling NIF, or + they can be values created by the calling NIF.</p> + <p>The calling NIF must use the return value of <c>enif_schedule_nif</c> as its own return value.</p> + <p>Be aware that <c>enif_schedule_nif</c>, as its name implies, only schedules the + NIF for future execution. The calling NIF does not block waiting for the scheduled NIF to + execute and return, which means that the calling NIF can't expect to receive the scheduled NIF return value and use it for further operations.</p> - <p>A dirty NIF may not invoke the <seealso marker="#enif_make_badarg">enif_make_badarg</seealso> - to raise an exception. If it wishes to return an exception, the dirty NIF should pass a - regular result indicating the exception details to its finalizer, and allow the finalizer - to raise the exception on its behalf.</p> - <note><p>This function is available only when the emulator is configured with dirty schedulers - enabled. This feature is currently disabled by default. To determine whether the dirty NIF API - is available, native code can check to see if the C preprocessor macro - <c>ERL_NIF_DIRTY_SCHEDULER_SUPPORT</c> is defined.</p></note> - </desc> - </func> - <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_schedule_dirty_nif_finalizer(ErlNifEnv* env, ERL_NIF_TERM result, ERL_NIF_TERM (*fp)(ErlNifEnv* env, ERL_NIF_TERM result))</nametext></name> - <fsummary>Schedule a dirty NIF finalizer</fsummary> - <desc> - <p>When a dirty NIF finishes executing, it must schedule a finalizer function to return - its result to the original NIF caller. The dirty NIF passes <c>result</c> as the value it - wants the finalizer to use as the return value. The <c>fp</c> argument is a pointer to the - finalizer function. The NIF API provides the <seealso marker="#enif_dirty_nif_finalizer"> - enif_dirty_nif_finalizer</seealso> function that can be used as a finalizer that simply - returns its <c>result</c> argument. You are also free to write your own custom finalizer - that uses <c>result</c> to derive a different return value, or ignores <c>result</c> - entirely and returns a completely different value.</p> - <p>Without exception, all dirty NIFs must invoke <c>enif_schedule_dirty_nif_finalizer</c> - to complete their execution.</p> - <note><p>This function is available only when the emulator is configured with dirty - schedulers enabled. This feature is currently disabled by default. To determine whether - the dirty NIF API is available, native code can check to see if the C preprocessor macro - <c>ERL_NIF_DIRTY_SCHEDULER_SUPPORT</c> is defined.</p></note> </desc> </func> <func><name><ret>ErlNifPid *</ret><nametext>enif_self(ErlNifEnv* caller_env, ErlNifPid* pid)</nametext></name> @@ -1384,4 +1368,3 @@ typedef enum { <p><seealso marker="erlang#load_nif-2">erlang:load_nif/2</seealso></p> </section> </cref> - diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml index 9ad42374bf..84168397f6 100644 --- a/erts/doc/src/erlang.xml +++ b/erts/doc/src/erlang.xml @@ -4968,7 +4968,7 @@ true</pre> <desc> <p>Note that the run-time is the sum of the run-time for all threads in the Erlang run-time system and may therefore be greater - than the wall-clock time.</p> + than the wall-clock time. The time is returned in milliseconds.</p> <pre> > <input>statistics(runtime).</input> {1690,1620} diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 086d29c668..5c4bb3ed25 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -940,6 +940,27 @@ Thanks to Matwey V. Kornilov</p> <p> Own Id: OTP-11829</p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 5.10.4.1</title> + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + When using gen_tcp:connect and the <c>fd</c> option with + <c>port</c> and/or <c>ip</c>, the <c>port</c> and + <c>ip</c> options were ignored. This has been fixed so + that if <c>port</c> and/or <c>ip</c> is specified + together with <c>fd</c> a bind is requested for that + <c>fd</c>. If <c>port</c> and/or <c>ip</c> is not + specified bind will not be called.</p> + <p> + Own Id: OTP-12061</p> </item> </list> </section> diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 1026e5f649..8bfb7d2ad2 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -3503,6 +3503,7 @@ get_map_elements_fail: * I[0]: &&call_nif * I[1]: Function pointer to NIF function * I[2]: Pointer to erl_module_nif + * I[3]: Function pointer to dirty NIF */ BifFunction vbf; @@ -3523,13 +3524,6 @@ get_map_elements_fail: reg[0] = r(0); nif_bif_result = (*fp)(&env, bif_nif_arity, reg); erts_post_nif(&env); -#ifdef ERTS_DIRTY_SCHEDULERS - if (is_non_value(nif_bif_result) && c_p->freason == TRAP) { - Export* ep = ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(c_p); - ep->code[0] = I[-3]; - ep->code[1] = I[-2]; - } -#endif } ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result)); PROCESS_MAIN_CHK_LOCKS(c_p); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index e96177cfd9..cfc6146b0a 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -2363,7 +2363,11 @@ load_code(LoaderState* stp) if (stp->may_load_nif) { const int finfo_ix = ci - FUNC_INFO_SZ; - enum { MIN_FUNC_SZ = 3 }; +#ifdef ERTS_DIRTY_SCHEDULERS + enum { MIN_FUNC_SZ = 4 }; +#else + enum { MIN_FUNC_SZ = 3 }; +#endif if (finfo_ix - last_func_start < MIN_FUNC_SZ && last_func_start) { /* Must make room for call_nif op */ int pad = MIN_FUNC_SZ - (finfo_ix - last_func_start); diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index fcbeb6cf5c..f3c05d047d 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1869,6 +1869,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { } else if (is_external_pid(to)) { dep = external_pid_dist_entry(to); if(dep == erts_this_dist_entry) { +#if DEBUG erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "Discarding message %T from %T to %T in an old " @@ -1879,6 +1880,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { external_pid_creation(to), erts_this_node->creation); erts_send_error_to_logger(p->group_leader, dsbufp); +#endif return 0; } return remote_send(p, dep, to, to, msg, suspend); @@ -1912,6 +1914,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { } else if (is_external_port(to) && (external_port_dist_entry(to) == erts_this_dist_entry)) { +#if DEBUG erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "Discarding message %T from %T to %T in an old " @@ -1922,6 +1925,7 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend, Eterm *refp) { external_port_creation(to), erts_this_node->creation); erts_send_error_to_logger(p->group_leader, dsbufp); +#endif return 0; } else if (is_internal_port(to)) { int ret_val; diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 011e49f1fe..e68b8e6274 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -601,6 +601,10 @@ bif maps:values/1 bif erts_internal:cmp_term/2 # +# New in 17.1. +# +bif erlang:fun_info_mfa/1 +# # Obsolete # diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 41a041eba6..e62caa6b22 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -274,6 +274,9 @@ _b = _b << _s; \ _vn1 = _b >> H_EXP; \ _vn0 = _b & LO_MASK; \ + /* Sometimes _s is 0 which triggers undefined behaviour for the \ + (_a0>>(D_EXP-_s)) shift, but this is ok because the \ + & -s will make it all to 0 later anyways. */ \ _un32 = (_a1 << _s) | ((_a0>>(D_EXP-_s)) & (-_s >> (D_EXP-1))); \ _un10 = _a0 << _s; \ _un1 = _un10 >> H_EXP; \ @@ -1506,13 +1509,15 @@ Eterm uword_to_big(UWord x, Eterm *y) */ Eterm small_to_big(Sint x, Eterm *y) { + Uint xu; if (x >= 0) { + xu = x; *y = make_pos_bignum_header(1); } else { - x = -x; + xu = -(Uint)x; *y = make_neg_bignum_header(1); } - BIG_DIGIT(y, 0) = x; + BIG_DIGIT(y, 0) = xu; return make_big(y); } @@ -1540,21 +1545,24 @@ Eterm erts_uint64_to_big(Uint64 x, Eterm **hpp) Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp) { Eterm *hp = *hpp; + Uint64 ux; int neg; - if (x >= 0) + if (x >= 0) { neg = 0; + ux = x; + } else { neg = 1; - x = -x; + ux = -(Uint64)x; } #if defined(ARCH_32) || HALFWORD_HEAP - if (x >= (((Uint64) 1) << 32)) { + if (ux >= (((Uint64) 1) << 32)) { if (neg) *hp = make_neg_bignum_header(2); else *hp = make_pos_bignum_header(2); - BIG_DIGIT(hp, 0) = (Uint) (x & ((Uint) 0xffffffff)); - BIG_DIGIT(hp, 1) = (Uint) ((x >> 32) & ((Uint) 0xffffffff)); + BIG_DIGIT(hp, 0) = (Uint) (ux & ((Uint) 0xffffffff)); + BIG_DIGIT(hp, 1) = (Uint) ((ux >> 32) & ((Uint) 0xffffffff)); *hpp += 3; } else @@ -1564,7 +1572,7 @@ Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp) *hp = make_neg_bignum_header(1); else *hp = make_pos_bignum_header(1); - BIG_DIGIT(hp, 0) = (Uint) x; + BIG_DIGIT(hp, 0) = (Uint) ux; *hpp += 2; } return make_big(hp); diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index d80111822e..da31876d75 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -101,7 +101,7 @@ typedef Uint dsize_t; /* Vector size type */ #define ERTS_SINT64_HEAP_SIZE(X) \ (IS_SSMALL((X)) \ ? 0 \ - : ERTS_UINT64_BIG_HEAP_SIZE__((X) >= 0 ? (X) : -(X))) + : ERTS_UINT64_BIG_HEAP_SIZE__((X) >= 0 ? (X) : -(Uint64)(X))) #define ERTS_UINT64_HEAP_SIZE(X) \ (IS_USMALL(0, (X)) ? 0 : ERTS_UINT64_BIG_HEAP_SIZE__((X))) diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 7d4f52ee23..08265b590d 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -256,6 +256,7 @@ print_process_info(int to, void *to_arg, Process *p) p->current[1], p->current[2]); } + erts_print(to, to_arg, "Run queue: %d\n", erts_get_runq_proc(p)->ix); erts_print(to, to_arg, "Spawned by: %T\n", p->parent); approx_started = (time_t) p->approx_started; diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 05ac24e04d..90cd227fae 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1873,8 +1873,8 @@ erts_alc_fatal_error(int error, int func, ErtsAlcType_t n, ...) size = va_arg(argp, Uint); va_end(argp); erl_exit(1, - "%s: Cannot %s %lu bytes of memory (of type \"%s\").\n", - allctr_str, op, size, t_str); + "%s: Cannot %s %lu bytes of memory (of type \"%s\", thread %d).\n", + allctr_str, op, size, t_str, ERTS_ALC_GET_THR_IX()); break; } case ERTS_ALC_E_NOALLCTR: diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 45f0cc4312..a4e164bf51 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -3274,6 +3274,15 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) ASSERT(!(flags & CFLG_FORCE_MSEG && flags & CFLG_FORCE_SYS_ALLOC)); + if (umem_sz > (ERTS_UINT_MAX - ERTS_UINT_MAX/100)) { + /* Do an overly conservative _overflow_ check here so we don't + * have to deal with it from here on. I guess we could be more accurate + * but I don't think the need to allocate over 99% of the address space + * will ever arise on any machine, neither 32 nor 64 bit. + */ + return NULL; + } + blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz); #ifdef ERTS_SMP diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c index 7e0e825a0d..3bf78adce7 100644 --- a/erts/emulator/beam/erl_bif_binary.c +++ b/erts/emulator/beam/erl_bif_binary.c @@ -1324,9 +1324,9 @@ static int parse_match_opts_list(Eterm l, Eterm bin, Uint *posp, Uint *endp) goto badarg; } if (len < 0) { - Sint lentmp = -len; + Uint lentmp = -(Uint)len; /* overflow */ - if (lentmp == len || lentmp < 0 || -lentmp != len) { + if ((Sint)lentmp < 0) { goto badarg; } len = lentmp; @@ -1555,9 +1555,9 @@ BIF_RETTYPE erts_binary_part(Process *p, Eterm binary, Eterm epos, Eterm elen) goto badarg; } if (len < 0) { - Sint lentmp = -len; + Uint lentmp = -(Uint)len; /* overflow */ - if (lentmp == len || lentmp < 0 || -lentmp != len) { + if ((Sint)lentmp < 0) { goto badarg; } len = lentmp; @@ -1644,9 +1644,9 @@ BIF_RETTYPE erts_gc_binary_part(Process *p, Eterm *reg, Eterm live, int range_is goto badarg; } if (len < 0) { - Sint lentmp = -len; + Uint lentmp = -(Uint)len; /* overflow */ - if (lentmp == len || lentmp < 0 || -lentmp != len) { + if ((Sint)lentmp < 0) { goto badarg; } len = lentmp; @@ -2213,9 +2213,9 @@ static BIF_RETTYPE binary_bin_to_list_common(Process *p, goto badarg; } if (len < 0) { - Sint lentmp = -len; + Uint lentmp = -(Uint)len; /* overflow */ - if (lentmp == len || lentmp < 0 || -lentmp != len) { + if ((Sint)lentmp < 0) { goto badarg; } len = lentmp; diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 4d5e55aaf5..6efe9d9550 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -3055,6 +3055,25 @@ fun_info_2(BIF_ALIST_2) return TUPLE2(hp, what, val); } +BIF_RETTYPE +fun_info_mfa_1(BIF_ALIST_1) +{ + Process* p = BIF_P; + Eterm fun = BIF_ARG_1; + Eterm* hp; + + if (is_fun(fun)) { + ErlFunThing* funp = (ErlFunThing *) fun_val(fun); + hp = HAlloc(p, 4); + BIF_RET(TUPLE3(hp,funp->fe->module,funp->fe->address[-2],make_small(funp->arity))); + } else if (is_export(fun)) { + Export* exp = (Export *) ((UWord) (export_val(fun))[1]); + hp = HAlloc(p, 4); + BIF_RET(TUPLE3(hp,exp->code[0],exp->code[1],make_small(exp->code[2]))); + } + BIF_ERROR(p, BADARG); +} + BIF_RETTYPE is_process_alive_1(BIF_ALIST_1) { if(is_internal_pid(BIF_ARG_1)) { @@ -3856,16 +3875,19 @@ static Eterm lcnt_build_lock_stats_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_s Uint tries = 0, colls = 0; unsigned long timer_s = 0, timer_ns = 0, timer_n = 0; unsigned int line = 0; + unsigned int i; Eterm af, uil; Eterm uit, uic; Eterm uits, uitns, uitn; Eterm tt, tstat, tloc, t; + Eterm thist, vhist[ERTS_LCNT_HISTOGRAM_SLOT_SIZE]; /* term: - * [{{file, line}, {tries, colls, {seconds, nanoseconds, n_blocks}}}] + * [{{file, line}, {tries, colls, {seconds, nanoseconds, n_blocks}}, + * { .. histogram .. }] */ - + tries = (Uint) ethr_atomic_read(&stats->tries); colls = (Uint) ethr_atomic_read(&stats->colls); @@ -3874,23 +3896,27 @@ static Eterm lcnt_build_lock_stats_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_s timer_ns = stats->timer.ns; timer_n = stats->timer_n; - af = erts_atom_put(stats->file, strlen(stats->file), ERTS_ATOM_ENC_LATIN1, 1); + af = erts_atom_put((byte *)stats->file, strlen(stats->file), ERTS_ATOM_ENC_LATIN1, 1); uil = erts_bld_uint( hpp, szp, line); tloc = erts_bld_tuple(hpp, szp, 2, af, uil); - uit = erts_bld_uint( hpp, szp, tries); - uic = erts_bld_uint( hpp, szp, colls); - + uit = erts_bld_uint( hpp, szp, tries); + uic = erts_bld_uint( hpp, szp, colls); + uits = erts_bld_uint( hpp, szp, timer_s); uitns = erts_bld_uint( hpp, szp, timer_ns); uitn = erts_bld_uint( hpp, szp, timer_n); tt = erts_bld_tuple(hpp, szp, 3, uits, uitns, uitn); tstat = erts_bld_tuple(hpp, szp, 3, uit, uic, tt); - - t = erts_bld_tuple(hpp, szp, 2, tloc, tstat); - - res = erts_bld_cons( hpp, szp, t, res); + + for(i = 0; i < ERTS_LCNT_HISTOGRAM_SLOT_SIZE; i++) { + vhist[i] = erts_bld_uint(hpp, szp, stats->hist.ns[i]); + } + thist = erts_bld_tuplev(hpp, szp, ERTS_LCNT_HISTOGRAM_SLOT_SIZE, vhist); + + t = erts_bld_tuple(hpp, szp, 3, tloc, tstat, thist); + res = erts_bld_cons( hpp, szp, t, res); return res; } @@ -3911,13 +3937,13 @@ static Eterm lcnt_build_lock_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_t *lock ASSERT(ltype); - type = erts_atom_put(ltype, strlen(ltype), ERTS_ATOM_ENC_LATIN1, 1); - name = erts_atom_put(lock->name, strlen(lock->name), ERTS_ATOM_ENC_LATIN1, 1); + type = erts_atom_put((byte *)ltype, strlen(ltype), ERTS_ATOM_ENC_LATIN1, 1); + name = erts_atom_put((byte *)lock->name, strlen(lock->name), ERTS_ATOM_ENC_LATIN1, 1); if (lock->flag & ERTS_LCNT_LT_ALLOC) { /* use allocator types names as id's for allocator locks */ ltype = (char *) ERTS_ALC_A2AD(signed_val(lock->id)); - id = erts_atom_put(ltype, strlen(ltype), ERTS_ATOM_ENC_LATIN1, 1); + id = erts_atom_put((byte *)ltype, strlen(ltype), ERTS_ATOM_ENC_LATIN1, 1); } else if (lock->flag & ERTS_LCNT_LT_PROCLOCK) { /* use registered names as id's for process locks if available */ proc = erts_proc_lookup(lock->id); @@ -3928,16 +3954,15 @@ static Eterm lcnt_build_lock_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_t *lock id = lock->id; } } else { - id = lock->id; + id = lock->id; } - + for (i = 0; i < lock->n_stats; i++) { stats = lcnt_build_lock_stats_term(hpp, szp, &(lock->stats[i]), stats); } - - t = erts_bld_tuple(hpp, szp, 4, name, id, type, stats); - - res = erts_bld_cons( hpp, szp, t, res); + + t = erts_bld_tuple(hpp, szp, 4, name, id, type, stats); + res = erts_bld_cons( hpp, szp, t, res); return res; } @@ -3957,12 +3982,12 @@ static Eterm lcnt_build_result_term(Eterm **hpp, Uint *szp, erts_lcnt_data_t *da dtns = erts_bld_uint( hpp, szp, data->duration.ns); tdt = erts_bld_tuple(hpp, szp, 2, dts, dtns); - adur = erts_atom_put(str_duration, strlen(str_duration), ERTS_ATOM_ENC_LATIN1, 1); + adur = erts_atom_put((byte *)str_duration, strlen(str_duration), ERTS_ATOM_ENC_LATIN1, 1); tdur = erts_bld_tuple(hpp, szp, 2, adur, tdt); /* lock tuple */ - aloc = erts_atom_put(str_locks, strlen(str_locks), ERTS_ATOM_ENC_LATIN1, 1); + aloc = erts_atom_put((byte *)str_locks, strlen(str_locks), ERTS_ATOM_ENC_LATIN1, 1); for (lock = data->current_locks->head; lock != NULL ; lock = lock->next ) { lloc = lcnt_build_lock_term(hpp, szp, lock, lloc); diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h index 6c9f53ce87..06dfeb1260 100644 --- a/erts/emulator/beam/erl_binary.h +++ b/erts/emulator/beam/erl_binary.h @@ -236,6 +236,8 @@ erts_bin_drv_alloc_fnf(Uint size) { Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; void *res; + if (bsize < size) /* overflow */ + return NULL; res = erts_alloc_fnf(ERTS_ALC_T_DRV_BINARY, bsize); ERTS_CHK_BIN_ALIGNMENT(res); return (Binary *) res; @@ -246,6 +248,8 @@ erts_bin_drv_alloc(Uint size) { Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; void *res; + if (bsize < size) /* overflow */ + erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, size); res = erts_alloc(ERTS_ALC_T_DRV_BINARY, bsize); ERTS_CHK_BIN_ALIGNMENT(res); return (Binary *) res; @@ -257,6 +261,8 @@ erts_bin_nrml_alloc(Uint size) { Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; void *res; + if (bsize < size) /* overflow */ + erts_alloc_enomem(ERTS_ALC_T_BINARY, size); res = erts_alloc(ERTS_ALC_T_BINARY, bsize); ERTS_CHK_BIN_ALIGNMENT(res); return (Binary *) res; @@ -267,11 +273,12 @@ erts_bin_realloc_fnf(Binary *bp, Uint size) { Binary *nbp; Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; + ErtsAlcType_t type = (bp->flags & BIN_FLAG_DRV) ? ERTS_ALC_T_DRV_BINARY + : ERTS_ALC_T_BINARY; ASSERT((bp->flags & BIN_FLAG_MAGIC) == 0); - if (bp->flags & BIN_FLAG_DRV) - nbp = erts_realloc_fnf(ERTS_ALC_T_DRV_BINARY, (void *) bp, bsize); - else - nbp = erts_realloc_fnf(ERTS_ALC_T_BINARY, (void *) bp, bsize); + if (bsize < size) /* overflow */ + return NULL; + nbp = erts_realloc_fnf(type, (void *) bp, bsize); ERTS_CHK_BIN_ALIGNMENT(nbp); return nbp; } @@ -281,17 +288,14 @@ erts_bin_realloc(Binary *bp, Uint size) { Binary *nbp; Uint bsize = ERTS_SIZEOF_Binary(size) + CHICKEN_PAD; + ErtsAlcType_t type = (bp->flags & BIN_FLAG_DRV) ? ERTS_ALC_T_DRV_BINARY + : ERTS_ALC_T_BINARY; ASSERT((bp->flags & BIN_FLAG_MAGIC) == 0); - if (bp->flags & BIN_FLAG_DRV) - nbp = erts_realloc_fnf(ERTS_ALC_T_DRV_BINARY, (void *) bp, bsize); - else - nbp = erts_realloc_fnf(ERTS_ALC_T_BINARY, (void *) bp, bsize); + if (bsize < size) /* overflow */ + erts_realloc_enomem(type, bp, size); + nbp = erts_realloc_fnf(type, (void *) bp, bsize); if (!nbp) - erts_realloc_n_enomem(ERTS_ALC_T2N(bp->flags & BIN_FLAG_DRV - ? ERTS_ALC_T_DRV_BINARY - : ERTS_ALC_T_BINARY), - bp, - bsize); + erts_realloc_enomem(type, bp, bsize); ERTS_CHK_BIN_ALIGNMENT(nbp); return nbp; } @@ -312,6 +316,7 @@ erts_create_magic_binary(Uint size, void (*destructor)(Binary *)) { Uint bsize = ERTS_MAGIC_BIN_SIZE(size); Binary* bptr = erts_alloc_fnf(ERTS_ALC_T_BINARY, bsize); + ASSERT(bsize > size); if (!bptr) erts_alloc_n_enomem(ERTS_ALC_T2N(ERTS_ALC_T_BINARY), bsize); ERTS_CHK_BIN_ALIGNMENT(bptr); diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index aa15d2cc57..0db42d4325 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -2018,6 +2018,20 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) roots[n].sz = 1; n++; } + + /* + * If a NIF has saved arguments, they need to be added + */ + if (ERTS_PROC_GET_NIF_TRAP_EXPORT(p)) { + Eterm* argv; + int argc; + if (erts_setup_nif_gc(p, &argv, &argc)) { + roots[n].v = argv; + roots[n].sz = argc; + n++; + } + } + ASSERT(n <= rootset->size); mp = p->msg.first; diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c index 5e6d812242..88c4006934 100644 --- a/erts/emulator/beam/erl_init.c +++ b/erts/emulator/beam/erl_init.c @@ -2066,8 +2066,10 @@ erl_exit_vv(int n, int flush_async, char *fmt, va_list args1, va_list args2) system_cleanup(flush_async); save_statistics(); - - an = abs(n); + if (n < 0) + an = -(unsigned int)n; + else + an = n; if (erts_mtrace_enabled) erts_mtrace_exit((Uint32) an); diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index c13eb87012..b105ece6f1 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -139,7 +139,6 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "drv_tsd", NULL }, { "async_enq_mtx", NULL }, #ifdef ERTS_SMP - { "sys_msg_q", NULL }, { "atom_tab", NULL }, { "make_ref", NULL }, { "misc_op_list_pre_alloc_lock", "address" }, @@ -148,6 +147,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "btm_pre_alloc_lock", NULL, }, { "dist_entry_out_queue", "address" }, { "port_sched_lock", "port_id" }, + { "sys_msg_q", NULL }, { "port_table", NULL }, #endif { "mtrace_op", NULL }, @@ -227,8 +227,7 @@ rw_op_str(Uint16 flags) case ERTS_LC_FLG_LO_READ: return " (r)"; case ERTS_LC_FLG_LO_WRITE: - erts_fprintf(stderr, "\nInternal error\n"); - lc_abort(); + ERTS_INTERNAL_ERROR("Only write flag present"); default: break; } @@ -311,8 +310,7 @@ static ERTS_INLINE void lc_free(void *p) static void *lc_core_alloc(void) { lc_unlock(); - erts_fprintf(stderr, "Lock checker out of memory!\n"); - lc_abort(); + ERTS_INTERNAL_ERROR("Lock checker out of memory!\n"); } #else @@ -325,8 +323,7 @@ static void *lc_core_alloc(void) fbs = (erts_lc_free_block_t *) malloc(sizeof(erts_lc_free_block_t) * ERTS_LC_FB_CHUNK_SIZE); if (!fbs) { - erts_fprintf(stderr, "Lock checker failed to allocate memory!\n"); - lc_abort(); + ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!"); } for (i = 1; i < ERTS_LC_FB_CHUNK_SIZE - 1; i++) { #ifdef DEBUG @@ -366,11 +363,11 @@ create_locked_locks(char *thread_name) { erts_lc_locked_locks_t *l_lcks = malloc(sizeof(erts_lc_locked_locks_t)); if (!l_lcks) - lc_abort(); + ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!"); l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown"); if (!l_lcks->thread_name) - lc_abort(); + ERTS_INTERNAL_ERROR("Lock checker failed to allocate memory!"); l_lcks->emu_thread = 0; l_lcks->tid = erts_thr_self(); @@ -691,7 +688,7 @@ erts_lc_set_thread_name(char *thread_name) free((void *) l_lcks->thread_name); l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown"); if (!l_lcks->thread_name) - lc_abort(); + ERTS_INTERNAL_ERROR("strdup failed"); } l_lcks->emu_thread = 1; } @@ -1330,7 +1327,7 @@ erts_lc_init(void) #endif /* #ifdef ERTS_LC_STATIC_ALLOC */ if (ethr_spinlock_init(&free_blocks_lock) != 0) - lc_abort(); + ERTS_INTERNAL_ERROR("spinlock_init failed"); erts_tsd_key_create(&locks_key,"erts_lock_check_key"); } diff --git a/erts/emulator/beam/erl_lock_count.c b/erts/emulator/beam/erl_lock_count.c index 6f44bf097b..cf6996ea06 100644 --- a/erts/emulator/beam/erl_lock_count.c +++ b/erts/emulator/beam/erl_lock_count.c @@ -61,6 +61,25 @@ static ERTS_INLINE void lcnt_unlock(void) { ethr_mutex_unlock(&lcnt_data_lock); } +const int log2_tab64[64] = { + 63, 0, 58, 1, 59, 47, 53, 2, + 60, 39, 48, 27, 54, 33, 42, 3, + 61, 51, 37, 40, 49, 18, 28, 20, + 55, 30, 34, 11, 43, 14, 22, 4, + 62, 57, 46, 52, 38, 26, 32, 41, + 50, 36, 17, 19, 29, 10, 13, 21, + 56, 45, 25, 31, 35, 16, 9, 12, + 44, 24, 15, 8, 23, 7, 6, 5}; + +static ERTS_INLINE int lcnt_log2(Uint64 v) { + v |= v >> 1; + v |= v >> 2; + v |= v >> 4; + v |= v >> 8; + v |= v >> 16; + v |= v >> 32; + return log2_tab64[((Uint64)((v - (v >> 1))*0x07EDD5E59A4E28C2)) >> 58]; +} static char* lcnt_lock_type(Uint16 flag) { switch(flag & ERTS_LCNT_LT_ALL) { @@ -81,19 +100,20 @@ static void lcnt_clear_stats(erts_lcnt_lock_stats_t *stats) { stats->timer_n = 0; stats->file = (char *)str_undefined; stats->line = 0; + sys_memzero(stats->hist.ns, sizeof(stats->hist.ns)); } static void lcnt_time(erts_lcnt_time_t *time) { -#ifdef HAVE_GETHRTIME +#if 0 || defined(HAVE_GETHRTIME) SysHrTime hr_time; hr_time = sys_gethrtime(); time->s = (unsigned long)(hr_time / 1000000000LL); time->ns = (unsigned long)(hr_time - 1000000000LL*time->s); -#else - SysTimeval tv; - sys_gettimeofday(&tv); - time->s = tv.tv_sec; - time->ns = tv.tv_usec*1000LL; +#else + SysTimeval tv; + sys_gettimeofday(&tv); + time->s = tv.tv_sec; + time->ns = tv.tv_usec*1000LL; #endif } @@ -111,28 +131,29 @@ static void lcnt_time_diff(erts_lcnt_time_t *d, erts_lcnt_time_t *t1, erts_lcnt_ dns += 1000000000LL; } + ASSERT(ds >= 0); + d->s = ds; d->ns = dns; } -/* difference d must be positive */ +/* difference d must be non-negative */ static void lcnt_time_add(erts_lcnt_time_t *t, erts_lcnt_time_t *d) { - unsigned long ngns = 0; - t->s += d->s; t->ns += d->ns; - ngns = t->ns / 1000000000LL; + t->s += t->ns / 1000000000LL; t->ns = t->ns % 1000000000LL; - - t->s += ngns; } static erts_lcnt_thread_data_t *lcnt_thread_data_alloc(void) { erts_lcnt_thread_data_t *eltd; eltd = (erts_lcnt_thread_data_t*)malloc(sizeof(erts_lcnt_thread_data_t)); + if (!eltd) { + ERTS_INTERNAL_ERROR("Lock counter failed to allocate memory!"); + } eltd->timer_set = 0; eltd->lock_in_conflict = 0; @@ -158,59 +179,64 @@ static char* lock_opt(Uint16 flag) { return "--"; } -static void print_lock_x(erts_lcnt_lock_t *lock, Uint16 flag, char *action, char *extra) { - erts_aint_t colls, tries, w_state, r_state; - erts_lcnt_lock_stats_t *stats = NULL; - +static void print_lock_x(erts_lcnt_lock_t *lock, Uint16 flag, char *action) { + erts_aint_t w_state, r_state; char *type; - int i; - + + if (strcmp(lock->name, "run_queue") != 0) return; type = lcnt_lock_type(lock->flag); r_state = ethr_atomic_read(&lock->r_state); w_state = ethr_atomic_read(&lock->w_state); - if (lock->flag & flag) { - erts_printf("%20s [%30s] [r/w state %4ld/%4ld] id %T %s\r\n", - action, - lock->name, - r_state, - w_state, - lock->id, - extra); + erts_fprintf(stderr,"%10s [%24s] [r/w state %4ld/%4ld] %2s id %T\r\n", + action, + lock->name, + r_state, + w_state, + type, + lock->id); } } - -static void print_lock(erts_lcnt_lock_t *lock, char *action) { - if (strcmp(lock->name, "proc_main") == 0) { - print_lock_x(lock, ERTS_LCNT_LT_ALL, action, ""); - } -} - #endif static erts_lcnt_lock_stats_t *lcnt_get_lock_stats(erts_lcnt_lock_t *lock, char *file, unsigned int line) { unsigned int i; erts_lcnt_lock_stats_t *stats = NULL; - - for (i = 0; i < lock->n_stats; i++) { - if ((lock->stats[i].file == file) && (lock->stats[i].line == line)) { - return &(lock->stats[i]); - } - } - if (lock->n_stats < ERTS_LCNT_MAX_LOCK_LOCATIONS) { - stats = &lock->stats[lock->n_stats]; - lock->n_stats++; - stats->file = file; - stats->line = line; - return stats; + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_LOCATION) { + for (i = 0; i < lock->n_stats; i++) { + if ((lock->stats[i].file == file) && (lock->stats[i].line == line)) { + return &(lock->stats[i]); + } + } + if (lock->n_stats < ERTS_LCNT_MAX_LOCK_LOCATIONS) { + stats = &lock->stats[lock->n_stats]; + lock->n_stats++; + stats->file = file; + stats->line = line; + return stats; + } } return &lock->stats[0]; +} +static void lcnt_update_stats_hist(erts_lcnt_hist_t *hist, erts_lcnt_time_t *time_wait) { + int idx; + unsigned long r; + + if (time_wait->s > 0 || time_wait->ns > ERTS_LCNT_HISTOGRAM_MAX_NS) { + idx = ERTS_LCNT_HISTOGRAM_SLOT_SIZE - 1; + } else { + r = time_wait->ns >> ERTS_LCNT_HISTOGRAM_RSHIFT; + if (r) idx = lcnt_log2(r); + else idx = 0; + } + hist->ns[idx]++; } -static void lcnt_update_stats(erts_lcnt_lock_stats_t *stats, int lock_in_conflict, erts_lcnt_time_t *time_wait) { +static void lcnt_update_stats(erts_lcnt_lock_stats_t *stats, int lock_in_conflict, + erts_lcnt_time_t *time_wait) { ethr_atomic_inc(&stats->tries); @@ -220,6 +246,7 @@ static void lcnt_update_stats(erts_lcnt_lock_stats_t *stats, int lock_in_conflic if (time_wait) { lcnt_time_add(&(stats->timer), time_wait); stats->timer_n++; + lcnt_update_stats_hist(&stats->hist,time_wait); } } @@ -248,6 +275,9 @@ void erts_lcnt_init() { /* init lcnt structure */ erts_lcnt_data = (erts_lcnt_data_t*)malloc(sizeof(erts_lcnt_data_t)); + if (!erts_lcnt_data) { + ERTS_INTERNAL_ERROR("Lock counter failed to allocate memory!"); + } erts_lcnt_data->current_locks = erts_lcnt_list_init(); erts_lcnt_data->deleted_locks = erts_lcnt_list_init(); @@ -269,6 +299,9 @@ erts_lcnt_lock_list_t *erts_lcnt_list_init(void) { erts_lcnt_lock_list_t *list; list = (erts_lcnt_lock_list_t*)malloc(sizeof(erts_lcnt_lock_list_t)); + if (!list) { + ERTS_INTERNAL_ERROR("Lock counter failed to allocate memory!"); + } list->head = NULL; list->tail = NULL; list->n = 0; @@ -330,8 +363,9 @@ void erts_lcnt_list_delete(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock) /* interface to erl_threads.h */ /* only lock on init and destroy, all others should use atomics */ void erts_lcnt_init_lock(erts_lcnt_lock_t *lock, char *name, Uint16 flag ) { - erts_lcnt_init_lock_x(lock, name, flag, am_undefined); + erts_lcnt_init_lock_x(lock, name, flag, NIL); } + void erts_lcnt_init_lock_x(erts_lcnt_lock_t *lock, char *name, Uint16 flag, Eterm id) { int i; if (!name) { @@ -360,7 +394,6 @@ void erts_lcnt_init_lock_x(erts_lcnt_lock_t *lock, char *name, Uint16 flag, Eter } erts_lcnt_list_insert(erts_lcnt_data->current_locks, lock); - lcnt_unlock(); } @@ -375,6 +408,9 @@ void erts_lcnt_destroy_lock(erts_lcnt_lock_t *lock) { /* copy structure and insert the copy */ deleted_lock = (erts_lcnt_lock_t*)malloc(sizeof(erts_lcnt_lock_t)); + if (!deleted_lock) { + ERTS_INTERNAL_ERROR("Lock counter failed to allocate memory!"); + } memcpy(deleted_lock, lock, sizeof(erts_lcnt_lock_t)); deleted_lock->next = NULL; @@ -417,8 +453,9 @@ void erts_lcnt_lock_opt(erts_lcnt_lock_t *lock, Uint16 option) { if ((w_state > 0) || (r_state > 0)) { eltd->lock_in_conflict = 1; - if (eltd->timer_set == 0) + if (eltd->timer_set == 0) { lcnt_time(&eltd->timer); + } eltd->timer_set++; } else { eltd->lock_in_conflict = 0; @@ -433,7 +470,7 @@ void erts_lcnt_lock(erts_lcnt_lock_t *lock) { if (!ERTS_LCNT_LOCK_TYPE(lock)) return; w_state = ethr_atomic_read(&lock->w_state); - ethr_atomic_inc( &lock->w_state); + ethr_atomic_inc(&lock->w_state); eltd = lcnt_get_thread_data(); @@ -446,10 +483,10 @@ void erts_lcnt_lock(erts_lcnt_lock_t *lock) { * 'atomicly'. All other locks will block the thread if w_state > 0 * i.e. locked. */ - if (eltd->timer_set == 0) + if (eltd->timer_set == 0) { lcnt_time(&eltd->timer); + } eltd->timer_set++; - } else { eltd->lock_in_conflict = 0; } @@ -459,11 +496,10 @@ void erts_lcnt_lock(erts_lcnt_lock_t *lock) { void erts_lcnt_lock_unaquire(erts_lcnt_lock_t *lock) { /* should check if this thread was "waiting" */ - if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return; if (!ERTS_LCNT_LOCK_TYPE(lock)) return; - ethr_atomic_dec( &lock->w_state); + ethr_atomic_dec(&lock->w_state); } /* erts_lcnt_lock_post @@ -491,7 +527,7 @@ void erts_lcnt_lock_post_x(erts_lcnt_lock_t *lock, char *file, unsigned int line if (!(lock->flag & (ERTS_LCNT_LT_RWMUTEX | ERTS_LCNT_LT_RWSPINLOCK))) { flowstate = ethr_atomic_read(&lock->flowstate); ASSERT(flowstate == 0); - ethr_atomic_inc( &lock->flowstate); + ethr_atomic_inc(&lock->flowstate); } #endif @@ -500,19 +536,12 @@ void erts_lcnt_lock_post_x(erts_lcnt_lock_t *lock, char *file, unsigned int line ASSERT(eltd); /* if lock was in conflict, time it */ - - if (erts_lcnt_rt_options & ERTS_LCNT_OPT_LOCATION) { - stats = lcnt_get_lock_stats(lock, file, line); - } else { - stats = &lock->stats[0]; - } - + stats = lcnt_get_lock_stats(lock, file, line); if (eltd->timer_set) { lcnt_time(&timer); lcnt_time_diff(&time_wait, &timer, &(eltd->timer)); lcnt_update_stats(stats, eltd->lock_in_conflict, &time_wait); - eltd->timer_set--; ASSERT(eltd->timer_set >= 0); } else { @@ -541,11 +570,11 @@ void erts_lcnt_unlock(erts_lcnt_lock_t *lock) { /* flowstate */ flowstate = ethr_atomic_read(&lock->flowstate); ASSERT(flowstate == 1); - ethr_atomic_dec( &lock->flowstate); + ethr_atomic_dec(&lock->flowstate); /* write state */ w_state = ethr_atomic_read(&lock->w_state); - ASSERT(w_state > 0) + ASSERT(w_state > 0); #endif ethr_atomic_dec(&lock->w_state); } @@ -582,9 +611,7 @@ void erts_lcnt_trylock(erts_lcnt_lock_t *lock, int res) { ethr_atomic_inc( &lock->flowstate); #endif ethr_atomic_inc(&lock->w_state); - lcnt_update_stats(&(lock->stats[0]), 0, NULL); - } else { ethr_atomic_inc(&lock->stats[0].tries); ethr_atomic_inc(&lock->stats[0].colls); diff --git a/erts/emulator/beam/erl_lock_count.h b/erts/emulator/beam/erl_lock_count.h index 75f7cd028b..ffbb93da1b 100644 --- a/erts/emulator/beam/erl_lock_count.h +++ b/erts/emulator/beam/erl_lock_count.h @@ -35,6 +35,10 @@ * | | | - collisions (including trylock busy) * | | | - timer (time spent in waiting for lock) * | | | - n_timer (collisions excluding trylock busy) + * | | | - histogram + * | | | | - # 0 = log2(lock wait_time ns) + * | | | | - ... + * | | | | - # n = log2(lock wait_time ns) * * Each instance of a lock is the unique lock, i.e. set and id in that set. * For each lock there is a set of statistics with where and what impact @@ -68,8 +72,17 @@ #include "ethread.h" +#define ERTS_LCNT_MAX_LOCK_LOCATIONS (10) -#define ERTS_LCNT_MAX_LOCK_LOCATIONS (10) +/* histogram */ +#define ERTS_LCNT_HISTOGRAM_MAX_NS (((unsigned long)1LL << 28) - 1) +#if 0 || defined(HAVE_GETHRTIME) +#define ERTS_LCNT_HISTOGRAM_SLOT_SIZE (30) +#define ERTS_LCNT_HISTOGRAM_RSHIFT (0) +#else +#define ERTS_LCNT_HISTOGRAM_SLOT_SIZE (20) +#define ERTS_LCNT_HISTOGRAM_RSHIFT (10) +#endif #define ERTS_LCNT_LT_SPINLOCK (((Uint16) 1) << 0) #define ERTS_LCNT_LT_RWSPINLOCK (((Uint16) 1) << 1) @@ -104,6 +117,10 @@ typedef struct { extern erts_lcnt_time_t timer_start; +typedef struct { + Uint32 ns[ERTS_LCNT_HISTOGRAM_SLOT_SIZE]; /* log2 array of nano seconds occurences */ +} erts_lcnt_hist_t; + typedef struct erts_lcnt_lock_stats_s { /* "tries" and "colls" needs to be atomic since * trylock busy does not aquire a lock and there @@ -118,6 +135,7 @@ typedef struct erts_lcnt_lock_stats_s { unsigned long timer_n; /* #times waited for lock */ erts_lcnt_time_t timer; /* total wait time for lock */ + erts_lcnt_hist_t hist; } erts_lcnt_lock_stats_t; /* rw locks uses both states, other locks only uses w_state */ diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 59a677a12c..8870fac7d9 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -415,7 +415,13 @@ erts_queue_dist_message(Process *rcvr, if (!(*rcvr_locks & ERTS_PROC_LOCK_MSGQ)) erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_MSGQ); - erts_proc_notify_new_message(rcvr); + erts_proc_notify_new_message(rcvr, +#ifdef ERTS_SMP + *rcvr_locks +#else + 0 +#endif + ); } } @@ -542,7 +548,13 @@ queue_message(Process *c_p, if (locked_msgq) erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_MSGQ); - erts_proc_notify_new_message(receiver); + erts_proc_notify_new_message(receiver, +#ifdef ERTS_SMP + *receiver_locks +#else + 0 +#endif + ); #ifndef ERTS_SMP ERTS_HOLE_CHECK(receiver); diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 8c4bf73dbe..1caea6dcf8 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1525,72 +1525,251 @@ int enif_consume_timeslice(ErlNifEnv* env, int percent) return ERTS_BIF_REDS_LEFT(env->proc) == 0; } -#ifdef ERTS_DIRTY_SCHEDULERS - -/* NIFs exports need one more item than the Export struct provides, the - * erl_module_nif*, so the DirtyNifExport below adds that. The Export - * member must be first in the struct. +/* + * NIF exports need a few more items than the Export struct provides, + * including the erl_module_nif* and a NIF function pointer, so the + * NifExport below adds those. The Export member must be first in the + * struct. The saved_mfa, saved_argc, nif_level, alloced_argv_sz and argv + * members are used to track the MFA and arguments of the top NIF in case a + * chain of one or more enif_schedule_nif() calls results in an exception, + * since in that case the original MFA and registers have to be restored + * before returning to Erlang to ensure stacktrace information associated + * with the exception is correct. */ +typedef ERL_NIF_TERM (*NativeFunPtr)(ErlNifEnv*, int, const ERL_NIF_TERM[]); + typedef struct { Export exp; struct erl_module_nif* m; -} DirtyNifExport; + NativeFunPtr fp; + Eterm saved_mfa[3]; + int saved_argc; + int alloced_argv_sz; + Eterm argv[1]; +} NifExport; -static void -alloc_proc_psd(Process* proc, DirtyNifExport **ep) +/* + * If a process has saved arguments, they need to be part of the GC + * rootset. The function below is called from setup_rootset() in + * erl_gc.c. This function is declared in erl_process.h. + */ +int +erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj) +{ + NifExport* ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + int gc = (ep && ep->saved_argc > 0); + + if (gc) { + *objv = ep->argv; + *nobj = ep->saved_argc; + } + return gc; +} + +/* + * Allocate a NifExport and set it in proc specific data + */ +static NifExport* +allocate_nif_sched_data(Process* proc, int argc) { + NifExport* ep; + size_t argv_extra, total; int i; - if (!*ep) { - *ep = erts_alloc(ERTS_ALC_T_PSD, sizeof(DirtyNifExport)); - sys_memset((void*) *ep, 0, sizeof(DirtyNifExport)); - for (i=0; i<ERTS_NUM_CODE_IX; i++) { - (*ep)->exp.addressv[i] = &(*ep)->exp.code[3]; - } - (*ep)->exp.code[3] = (BeamInstr) em_call_nif; + + argv_extra = argc > 1 ? sizeof(Eterm)*(argc-1) : 0; + total = sizeof(NifExport) + argv_extra; + ep = erts_alloc(ERTS_ALC_T_PSD, total); + sys_memset((void*) ep, 0, total); + ep->alloced_argv_sz = argc; + for (i=0; i<ERTS_NUM_CODE_IX; i++) { + ep->exp.addressv[i] = &ep->exp.code[3]; } - (void) ERTS_PROC_SET_DIRTY_SCHED_TRAP_EXPORT(proc, ERTS_PROC_LOCK_MAIN, &(*ep)->exp); + ep->exp.code[3] = (BeamInstr) em_call_nif; + (void) ERTS_PROC_SET_NIF_TRAP_EXPORT(proc, ERTS_PROC_LOCK_MAIN, &ep->exp); + return ep; } +/* + * Initialize a NifExport struct. Create it if needed and store it in the + * proc. The direct_fp function is what will be invoked by op_call_nif, and + * the indirect_fp function, if not NULL, is what the direct_fp function + * will call. If the allocated NifExport isn't enough to hold all of argv, + * allocate a larger one. Save MFA and registers only if the need_save + * parameter is true. + */ static ERL_NIF_TERM -execute_dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +init_nif_sched_data(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirect_fp, + int need_save, int argc, const ERL_NIF_TERM argv[]) { - Eterm* reg = ERTS_PROC_GET_SCHDATA(env->proc)->x_reg_array; - ERL_NIF_TERM result, dirty_result = (ERL_NIF_TERM) reg[0]; - typedef ERL_NIF_TERM (*FinalizerFP)(ErlNifEnv*, ERL_NIF_TERM); - FinalizerFP fp; -#if HAVE_INT64 && SIZEOF_LONG != 8 - ASSERT(sizeof(fp) <= sizeof(ErlNifUInt64)); - enif_get_uint64(env, reg[1], (ErlNifUInt64 *) &fp); -#else - ASSERT(sizeof(fp) <= sizeof(unsigned long)); - enif_get_ulong(env, reg[1], (unsigned long *) &fp); -#endif - result = (*fp)(env, dirty_result); - if (erts_refc_dectest(&env->mod_nif->rt_dtor_cnt, 0) == 0 - && env->mod_nif->mod == NULL) - close_lib(env->mod_nif); - return result; + Process* proc = env->proc; + Eterm* reg = ERTS_PROC_GET_SCHDATA(proc)->x_reg_array; + NifExport* ep; + int i; + + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + if (!ep) + ep = allocate_nif_sched_data(proc, argc); + else if (need_save && ep->alloced_argv_sz < argc) { + NifExport* new_ep = allocate_nif_sched_data(proc, argc); + erts_free(ERTS_ALC_T_PSD, (void*) ep); + ep = new_ep; + } + ERTS_VBUMP_ALL_REDS(proc); + for (i = 0; i < argc; i++) { + if (need_save) + ep->argv[i] = reg[i]; + reg[i] = (Eterm) argv[i]; + } + if (need_save) { + ep->saved_mfa[0] = proc->current[0]; + ep->saved_mfa[1] = proc->current[1]; + ep->saved_mfa[2] = proc->current[2]; + ep->saved_argc = argc; + } + proc->i = (BeamInstr*) ep->exp.addressv[0]; + ep->exp.code[0] = (BeamInstr) proc->current[0]; + ep->exp.code[1] = (BeamInstr) proc->current[1]; + ep->exp.code[2] = argc; + ep->exp.code[4] = (BeamInstr) direct_fp; + ep->m = env->mod_nif; + ep->fp = indirect_fp; + proc->freason = TRAP; + return THE_NON_VALUE; } -#endif /* ERTS_DIRTY_SCHEDULERS */ +/* + * Restore saved MFA and registers. Registers are restored only when the + * exception flag is true. + */ +static void +restore_nif_mfa(Process* proc, NifExport* ep, int exception) +{ + int i; + Eterm* reg = ERTS_PROC_GET_SCHDATA(proc)->x_reg_array; -#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT + proc->current[0] = ep->saved_mfa[0]; + proc->current[1] = ep->saved_mfa[1]; + proc->current[2] = ep->saved_mfa[2]; + if (exception) + for (i = 0; i < ep->saved_argc; i++) + reg[i] = ep->argv[i]; + ep->saved_argc = 0; + ep->saved_mfa[0] = THE_NON_VALUE; +} -ERL_NIF_TERM -enif_schedule_dirty_nif(ErlNifEnv* env, int flags, - ERL_NIF_TERM (*fp)(ErlNifEnv*, int, const ERL_NIF_TERM[]), - int argc, const ERL_NIF_TERM argv[]) +#ifdef ERTS_DIRTY_SCHEDULERS + +/* + * Finalize a dirty NIF call. This function is scheduled to cause the VM to + * switch the process off a dirty scheduler thread and back onto a regular + * scheduler thread, and then return the result from the dirty NIF. It also + * restores the original NIF MFA when necessary based on the value of + * ep->fp set by execute_dirty_nif via init_nif_sched_data -- non-NULL + * means restore, NULL means do not restore. + */ +static ERL_NIF_TERM +dirty_nif_finalizer(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + Process* proc = env->proc; + NifExport* ep; + + ASSERT(argc == 1); + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(env->proc->scheduler_data)); + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + if (ep->fp) + restore_nif_mfa(proc, ep, 0); + return argv[0]; +} + +/* Finalize a dirty NIF call that raised an exception. Otherwise same as + * the dirty_nif_finalizer() function. + */ +static ERL_NIF_TERM +dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + Process* proc = env->proc; + NifExport* ep; + + ASSERT(!ERTS_SCHEDULER_IS_DIRTY(env->proc->scheduler_data)); + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + if (ep->fp) + restore_nif_mfa(proc, ep, 1); + return enif_make_badarg(env); +} + +/* + * Dirty NIF execution wrapper function. Invoke an application's dirty NIF, + * then check the result and schedule the appropriate finalizer function + * where needed. Also restore the original NIF MFA when appropriate. + */ +static ERL_NIF_TERM +execute_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + Process* proc = env->proc; + NativeFunPtr fp = (NativeFunPtr) proc->current[6]; + NifExport* ep; + ERL_NIF_TERM result; + + ASSERT(ERTS_SCHEDULER_IS_DIRTY(env->proc->scheduler_data)); + + /* + * Set ep->fp to NULL before the native call so we know later whether it scheduled another NIF for execution + */ + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + ep->fp = NULL; + result = (*fp)(env, argc, argv); + erts_smp_atomic32_read_band_mb(&proc->state, + ~(ERTS_PSFLG_DIRTY_CPU_PROC + |ERTS_PSFLG_DIRTY_IO_PROC + |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q + |ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); + if (erts_refc_dectest(&env->mod_nif->rt_dtor_cnt, 0) == 0 && env->mod_nif->mod == NULL) + close_lib(env->mod_nif); + /* + * If no more NIFs were scheduled by the native call via + * enif_schedule_nif(), then ep->fp will still be NULL as set above, in + * which case we need to restore the original NIF calling + * context. Reuse fp essentially as a boolean for this, passing it to + * init_nif_sched_data below. Both dirty_nif_exception and + * dirty_nif_finalizer then check ep->fp to decide whether or not to + * restore the original calling context. + */ + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + if (ep->fp) + fp = NULL; + if (is_non_value(result)) { + if (proc->freason != TRAP) { + ASSERT(proc->freason == BADARG); + return init_nif_sched_data(env, dirty_nif_exception, fp, 0, argc, argv); + } else { + if (ep->fp == NULL) + restore_nif_mfa(proc, ep, 1); + return result; + } + } + else + return init_nif_sched_data(env, dirty_nif_finalizer, fp, 0, 1, &result); +} + +/* + * Dirty NIF scheduling wrapper function. Schedule a dirty NIF to execute + * via the execute_dirty_nif() wrapper function. The dirty scheduler thread + * type (CPU or I/O) is indicated in flags parameter. + */ +static ERTS_INLINE ERL_NIF_TERM +schedule_dirty_nif(ErlNifEnv* env, int flags, int argc, const ERL_NIF_TERM argv[]) { -#ifdef USE_THREADS erts_aint32_t state, n, a; Process* proc = env->proc; - Eterm* reg = ERTS_PROC_GET_SCHDATA(proc)->x_reg_array; - DirtyNifExport* ep = NULL; - int i; + NativeFunPtr fp = (NativeFunPtr) proc->current[6]; + NifExport* ep; + int need_save; - int chkflgs = (flags & (ERL_NIF_DIRTY_JOB_IO_BOUND|ERL_NIF_DIRTY_JOB_CPU_BOUND)); - if (chkflgs != ERL_NIF_DIRTY_JOB_IO_BOUND && chkflgs != ERL_NIF_DIRTY_JOB_CPU_BOUND) - return enif_make_badarg(env); + ASSERT(flags==ERL_NIF_DIRTY_JOB_IO_BOUND || flags==ERL_NIF_DIRTY_JOB_CPU_BOUND); a = erts_smp_atomic32_read_acqb(&proc->state); while (1) { @@ -1602,7 +1781,7 @@ enif_schedule_dirty_nif(ErlNifEnv* env, int flags, */ n &= ~(ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_IO_PROC |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q); - if (chkflgs == ERL_NIF_DIRTY_JOB_CPU_BOUND) + if (flags == ERL_NIF_DIRTY_JOB_CPU_BOUND) n |= ERTS_PSFLG_DIRTY_CPU_PROC; else n |= ERTS_PSFLG_DIRTY_IO_PROC; @@ -1610,69 +1789,100 @@ enif_schedule_dirty_nif(ErlNifEnv* env, int flags, if (a == state) break; } - if (!(ep = (DirtyNifExport*) ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(proc))) - alloc_proc_psd(proc, &ep); - ERTS_VBUMP_ALL_REDS(proc); - ep->exp.code[2] = argc; - for (i = 0; i < argc; i++) { - reg[i] = (Eterm) argv[i]; - } - proc->i = (BeamInstr*) ep->exp.addressv[0]; - ep->exp.code[4] = (BeamInstr) fp; - ep->m = env->mod_nif; - proc->freason = TRAP; - erts_refc_inc(&env->mod_nif->rt_dtor_cnt, 1); + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + need_save = (ep == NULL || is_non_value(ep->saved_mfa[0])); + return init_nif_sched_data(env, execute_dirty_nif, fp, need_save, argc, argv); +} - return THE_NON_VALUE; -#else - return (*fp)(env, argc, argv); -#endif +static ERL_NIF_TERM +schedule_dirty_io_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_IO_BOUND, argc, argv); +} + +static ERL_NIF_TERM +schedule_dirty_cpu_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + return schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, argc, argv); +} + +#endif /* ERTS_DIRTY_SCHEDULERS */ + +/* + * NIF execution wrapper used by enif_schedule_nif() for regular NIFs. It + * calls the actual NIF, restores original NIF MFA if necessary, and + * then returns the NIF result. + */ +static ERL_NIF_TERM +execute_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + Process* proc = env->proc; + NativeFunPtr fp = (NativeFunPtr) proc->current[6]; + NifExport* ep; + ERL_NIF_TERM result; + + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + ep->fp = NULL; + result = (*fp)(env, argc, argv); + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + /* + * If no NIFs were scheduled by the native call via + * enif_schedule_nif(), then ep->fp will still be NULL as set above, in + * which case we need to restore the original NIF MFA. + */ + if (ep->fp == NULL) + restore_nif_mfa(proc, ep, is_non_value(result) && proc->freason != TRAP); + return result; } ERL_NIF_TERM -enif_schedule_dirty_nif_finalizer(ErlNifEnv* env, ERL_NIF_TERM result, - ERL_NIF_TERM (*fp)(ErlNifEnv*, ERL_NIF_TERM)) +enif_schedule_nif(ErlNifEnv* env, const char* fun_name, int flags, + ERL_NIF_TERM (*fp)(ErlNifEnv*, int, const ERL_NIF_TERM[]), + int argc, const ERL_NIF_TERM argv[]) { -#ifdef USE_THREADS Process* proc = env->proc; - Eterm* reg = ERTS_PROC_GET_SCHDATA(proc)->x_reg_array; - DirtyNifExport* ep; + NifExport* ep; + ERL_NIF_TERM fun_name_atom, result; + int need_save; - erts_smp_atomic32_read_band_mb(&proc->state, - ~(ERTS_PSFLG_DIRTY_CPU_PROC - |ERTS_PSFLG_DIRTY_IO_PROC - |ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q - |ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); - if (!(ep = (DirtyNifExport*) ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(proc))) - alloc_proc_psd(proc, &ep); - ERTS_VBUMP_ALL_REDS(proc); - ep->exp.code[2] = 2; - reg[0] = (Eterm) result; -#if HAVE_INT64 && SIZEOF_LONG != 8 - ASSERT(sizeof(fp) <= sizeof(ErlNifUInt64)); - reg[1] = (Eterm) enif_make_uint64(env, (ErlNifUInt64) fp); -#else - ASSERT(sizeof(fp) <= sizeof(unsigned long)); - reg[1] = (Eterm) enif_make_ulong(env, (unsigned long) fp); -#endif - proc->i = (BeamInstr*) ep->exp.addressv[0]; - ep->exp.code[4] = (BeamInstr) execute_dirty_nif_finalizer; - proc->freason = TRAP; + if (argc > MAX_ARG) + return enif_make_badarg(env); + fun_name_atom = enif_make_atom(env, fun_name); + if (enif_is_exception(env, fun_name_atom)) + return fun_name_atom; - return THE_NON_VALUE; + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + need_save = (ep == NULL || is_non_value(ep->saved_mfa[0])); + + if (flags) { +#ifdef ERTS_DIRTY_SCHEDULERS + NativeFunPtr sched_fun; + int chkflgs = (flags & (ERL_NIF_DIRTY_JOB_IO_BOUND|ERL_NIF_DIRTY_JOB_CPU_BOUND)); + if (chkflgs == ERL_NIF_DIRTY_JOB_IO_BOUND) + sched_fun = schedule_dirty_io_nif; + else if (chkflgs == ERL_NIF_DIRTY_JOB_CPU_BOUND) + sched_fun = schedule_dirty_cpu_nif; + else + return enif_make_badarg(env); + result = init_nif_sched_data(env, sched_fun, fp, need_save, argc, argv); #else - return (*fp)(env, result); + return enif_make_badarg(env); #endif -} + } + else + result = init_nif_sched_data(env, execute_nif, fp, need_save, argc, argv); -/* A simple finalizer that just returns its result argument */ -ERL_NIF_TERM -enif_dirty_nif_finalizer(ErlNifEnv* env, ERL_NIF_TERM result) -{ + ep = (NifExport*) ERTS_PROC_GET_NIF_TRAP_EXPORT(proc); + ASSERT(ep); + ep->exp.code[1] = (BeamInstr) fun_name_atom; return result; } +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT + int enif_is_on_dirty_scheduler(ErlNifEnv* env) { @@ -1989,6 +2199,35 @@ static Eterm load_nif_error(Process* p, const char* atom, const char* format, .. return ret; } +/* + * The function below is for looping through ErlNifFunc arrays, helping + * provide backwards compatibility across the version 2.7 change that added + * the "flags" field to ErlNifFunc. + */ +static ErlNifFunc* next_func(ErlNifEntry* entry, int* incrp, ErlNifFunc* func) +{ + ASSERT(incrp); + if (!*incrp) { + if (entry->major > 2 || (entry->major == 2 && entry->minor >= 7)) + *incrp = sizeof(ErlNifFunc); + else { + /* + * ErlNifFuncV1 below is what ErlNifFunc was before the + * addition of the flags field for 2.7, and is needed to handle + * backward compatibility. + */ + typedef struct { + const char* name; + unsigned arity; + ERL_NIF_TERM (*fptr)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + }ErlNifFuncV1; + *incrp = sizeof(ErlNifFuncV1); + } + } + return (ErlNifFunc*) ((char*)func + *incrp); +} + + BIF_RETTYPE load_nif_2(BIF_ALIST_2) { static const char bad_lib[] = "bad_lib"; @@ -2098,22 +2337,48 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) } else { /*erts_fprintf(stderr, "Found module %T\r\n", mod_atom);*/ - + + int maybe_dirty_nifs = ((entry->major > 2 || (entry->major == 2 && entry->minor >= 7)) + && (entry->options & ERL_NIF_DIRTY_NIF_OPTION)); + int incr = 0; + ErlNifFunc* f = entry->funcs; for (i=0; i < entry->num_of_funcs && ret==am_ok; i++) { BeamInstr** code_pp; - ErlNifFunc* f = &entry->funcs[i]; if (!erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1) || (code_pp = get_func_pp(mod->curr.code, f_atom, f->arity))==NULL) { ret = load_nif_error(BIF_P,bad_lib,"Function not found %T:%s/%u", mod_atom, f->name, f->arity); - } - else if (code_pp[1] - code_pp[0] < (5+3)) { + } + else if (maybe_dirty_nifs && f->flags) { + /* + * If the flags field is non-zero and this emulator was + * built with dirty scheduler support, check that the flags + * value is legal. But if this emulator was built without + * dirty scheduler support, treat a non-zero flags field as + * a load error. + */ +#ifdef ERTS_DIRTY_SCHEDULERS + if (f->flags != ERL_NIF_DIRTY_JOB_IO_BOUND && f->flags != ERL_NIF_DIRTY_JOB_CPU_BOUND) + ret = load_nif_error(BIF_P, bad_lib, "Illegal flags field value %d for NIF %T:%s/%u", + f->flags, mod_atom, f->name, f->arity); +#else + ret = load_nif_error(BIF_P, bad_lib, "NIF %T:%s/%u requires a runtime with dirty scheduler support.", + mod_atom, f->name, f->arity); +#endif + } +#ifdef ERTS_DIRTY_SCHEDULERS + else if (code_pp[1] - code_pp[0] < (5+4)) +#else + else if (code_pp[1] - code_pp[0] < (5+3)) +#endif + { ret = load_nif_error(BIF_P,bad_lib,"No explicit call to load_nif" - " in module (%T:%s/%u to small)", - mod_atom, entry->funcs[i].name, entry->funcs[i].arity); + " in module (%T:%s/%u too small)", + mod_atom, f->name, f->arity); } /*erts_fprintf(stderr, "Found NIF %T:%s/%u\r\n", - mod_atom, entry->funcs[i].name, entry->funcs[i].arity);*/ + mod_atom, f->name, f->arity);*/ + f = next_func(entry, &incr, f); } } @@ -2139,7 +2404,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) * is deprecated and was only ment as a development feature not to * be used in production systems. (See warning below) */ - int k; + int k, old_incr = 0; + ErlNifFunc* old_func; lib->priv_data = mod->curr.nif->priv_data; ASSERT(mod->curr.nif->entry != NULL); @@ -2148,13 +2414,16 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) goto error; } /* Check that no NIF is removed */ + old_func = mod->curr.nif->entry->funcs; for (k=0; k < mod->curr.nif->entry->num_of_funcs; k++) { - ErlNifFunc* old_func = &mod->curr.nif->entry->funcs[k]; + int incr = 0; + ErlNifFunc* f = entry->funcs; for (i=0; i < entry->num_of_funcs; i++) { - if (old_func->arity == entry->funcs[i].arity - && sys_strcmp(old_func->name, entry->funcs[i].name) == 0) { + if (old_func->arity == f->arity + && sys_strcmp(old_func->name, f->name) == 0) { break; } + f = next_func(entry, &incr, f); } if (i == entry->num_of_funcs) { ret = load_nif_error(BIF_P,reload,"Reloaded library missing " @@ -2162,7 +2431,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) old_func->name, old_func->arity); goto error; } - } + old_func = next_func(mod->curr.nif->entry, &old_incr, old_func); + } erts_pre_nif(&env, BIF_P, lib); veto = entry->reload(&env, &lib->priv_data, BIF_ARG_2); erts_post_nif(&env); @@ -2209,13 +2479,17 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) /* ** Everything ok, patch the beam code with op_call_nif */ - mod->curr.nif = lib; + + int incr = 0; + ErlNifFunc* f = entry->funcs; + + mod->curr.nif = lib; for (i=0; i < entry->num_of_funcs; i++) { BeamInstr* code_ptr; - erts_atom_get(entry->funcs[i].name, sys_strlen(entry->funcs[i].name), &f_atom, ERTS_ATOM_ENC_LATIN1); - code_ptr = *get_func_pp(mod->curr.code, f_atom, entry->funcs[i].arity); - + erts_atom_get(f->name, sys_strlen(f->name), &f_atom, ERTS_ATOM_ENC_LATIN1); + code_ptr = *get_func_pp(mod->curr.code, f_atom, f->arity); + if (code_ptr[1] == 0) { code_ptr[5+0] = (BeamInstr) BeamOp(op_call_nif); } @@ -2223,10 +2497,21 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) GenericBp* g = (GenericBp *) code_ptr[1]; ASSERT(code_ptr[5+0] == (BeamInstr) BeamOp(op_i_generic_breakpoint)); - g->orig_instr = (BeamInstr) BeamOp(op_call_nif); - } - code_ptr[5+1] = (BeamInstr) entry->funcs[i].fptr; + g->orig_instr = (BeamInstr) BeamOp(op_call_nif); + } + if ((entry->major > 2 || (entry->major == 2 && entry->minor >= 7)) + && (entry->options & ERL_NIF_DIRTY_NIF_OPTION) && f->flags) { +#ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT + code_ptr[5+3] = (BeamInstr) f->fptr; + code_ptr[5+1] = (f->flags == ERL_NIF_DIRTY_JOB_IO_BOUND) ? + (BeamInstr) schedule_dirty_io_nif : + (BeamInstr) schedule_dirty_cpu_nif; +#endif + } + else + code_ptr[5+1] = (BeamInstr) f->fptr; code_ptr[5+2] = (BeamInstr) lib; + f = next_func(entry, &incr, f); } } else { diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 5b93c2398e..226fc199a1 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -42,9 +42,13 @@ ** 2.5: R17 Maps API additions ** 2.6: R17 with maps ** R17 dirty schedulers +** 2.7: 17.3 add enif_schedule_nif +** remove enif_schedule_dirty_nif, enif_schedule_dirty_nif_finalizer, enif_dirty_nif_finalizer +** add ErlNifEntry options +** add ErlNifFunc flags */ #define ERL_NIF_MAJOR_VERSION 2 -#define ERL_NIF_MINOR_VERSION 6 +#define ERL_NIF_MINOR_VERSION 7 /* * The emulator will refuse to load a nif-lib with a major version @@ -125,8 +129,10 @@ typedef struct const char* name; unsigned arity; ERL_NIF_TERM (*fptr)(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + unsigned flags; }ErlNifFunc; + typedef struct enif_entry_t { int major; @@ -139,8 +145,11 @@ typedef struct enif_entry_t int (*upgrade)(ErlNifEnv*, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); void (*unload) (ErlNifEnv*, void* priv_data); const char* vm_variant; + unsigned options; }ErlNifEntry; +/* Field bits for ErlNifEntry options */ +#define ERL_NIF_DIRTY_NIF_OPTION 1 typedef struct @@ -232,10 +241,21 @@ extern TWinDynNifCallbacks WinDynNifCallbacks; # else # define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* nif_init(TWinDynNifCallbacks* callbacks) # endif -# define ERL_NIF_INIT_BODY memcpy(&WinDynNifCallbacks,callbacks,sizeof(TWinDynNifCallbacks)) +# ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT +# define ERL_NIF_INIT_BODY do { \ + memcpy(&WinDynNifCallbacks,callbacks,sizeof(TWinDynNifCallbacks)); \ + entry.options = ERL_NIF_DIRTY_NIF_OPTION; \ + } while(0) +# else +# define ERL_NIF_INIT_BODY memcpy(&WinDynNifCallbacks,callbacks,sizeof(TWinDynNifCallbacks)) +# endif #else # define ERL_NIF_INIT_GLOB -# define ERL_NIF_INIT_BODY +# ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT +# define ERL_NIF_INIT_BODY entry.options = ERL_NIF_DIRTY_NIF_OPTION +# else +# define ERL_NIF_INIT_BODY +# endif # ifdef STATIC_ERLANG_NIF # define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _nif_init(void) # else diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index d7c554e60b..be39816a64 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -141,10 +141,8 @@ ERL_NIF_API_FUNC_DECL(int,enif_is_number,(ErlNifEnv*, ERL_NIF_TERM term)); ERL_NIF_API_FUNC_DECL(void*,enif_dlopen,(const char* lib, void (*err_handler)(void*,const char*), void* err_arg)); ERL_NIF_API_FUNC_DECL(void*,enif_dlsym,(void* handle, const char* symbol, void (*err_handler)(void*,const char*), void* err_arg)); ERL_NIF_API_FUNC_DECL(int,enif_consume_timeslice,(ErlNifEnv*, int percent)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_nif,(ErlNifEnv*,const char*,int,ERL_NIF_TERM (*)(ErlNifEnv*,int,const ERL_NIF_TERM[]),int,const ERL_NIF_TERM[])); #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT -ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_dirty_nif,(ErlNifEnv*,int,ERL_NIF_TERM (*)(ErlNifEnv*,int,const ERL_NIF_TERM[]),int,const ERL_NIF_TERM[])); -ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_schedule_dirty_nif_finalizer,(ErlNifEnv*,ERL_NIF_TERM,ERL_NIF_TERM (*)(ErlNifEnv*,ERL_NIF_TERM))); -ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_dirty_nif_finalizer,(ErlNifEnv*,ERL_NIF_TERM)); ERL_NIF_API_FUNC_DECL(int,enif_is_on_dirty_scheduler,(ErlNifEnv*)); ERL_NIF_API_FUNC_DECL(int,enif_have_dirty_schedulers,(void)); #endif @@ -289,10 +287,8 @@ ERL_NIF_API_FUNC_DECL(int, enif_map_iterator_get_pair, (ErlNifEnv *env, ErlNifMa # define enif_dlopen ERL_NIF_API_FUNC_MACRO(enif_dlopen) # define enif_dlsym ERL_NIF_API_FUNC_MACRO(enif_dlsym) # define enif_consume_timeslice ERL_NIF_API_FUNC_MACRO(enif_consume_timeslice) +# define enif_schedule_nif ERL_NIF_API_FUNC_MACRO(enif_schedule_nif) #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT -# define enif_schedule_dirty_nif ERL_NIF_API_FUNC_MACRO(enif_schedule_dirty_nif) -# define enif_schedule_dirty_nif_finalizer ERL_NIF_API_FUNC_MACRO(enif_schedule_dirty_nif_finalizer) -# define enif_dirty_nif_finalizer ERL_NIF_API_FUNC_MACRO(enif_dirty_nif_finalizer) # define enif_is_on_dirty_scheduler ERL_NIF_API_FUNC_MACRO(enif_is_on_dirty_scheduler) # define enif_have_dirty_schedulers ERL_NIF_API_FUNC_MACRO(enif_have_dirty_schedulers) #endif diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index 31d9a1e26e..682f6f8f4b 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -68,6 +68,13 @@ static void chk_task_queues(Port *pp, ErtsPortTask *execq, int processing_busy_q #define DTRACE_DRIVER(PROBE_NAME, PP) do {} while(0) #endif +#define ERTS_SMP_LC_VERIFY_RQ(RQ, PP) \ + do { \ + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); \ + ERTS_SMP_LC_ASSERT((RQ) == ((ErtsRunQueue *) \ + erts_smp_atomic_read_nob(&(PP)->run_queue))); \ + } while (0) + erts_smp_atomic_t erts_port_task_outstanding_io_tasks; #define ERTS_PT_STATE_SCHEDULED 0 @@ -798,12 +805,13 @@ schedule_port_task_handle_list_free(ErtsPortTaskHandleList *pthlp) static ERTS_INLINE void abort_nosuspend_task(Port *pp, ErtsPortTaskType type, - ErtsPortTaskTypeData *tdp) + ErtsPortTaskTypeData *tdp, + int bpq_data) { ASSERT(type == ERTS_PORT_TASK_PROC_SIG); - if (!pp->sched.taskq.bpq) + if (!bpq_data) tdp->psig.callback(NULL, ERTS_PORT_SFLG_INVALID, ERTS_PROC2PORT_SIG_ABORT_NOSUSPEND, @@ -991,6 +999,7 @@ static ERTS_INLINE int finalize_exec(Port *pp, ErtsPortTask **execq, int processing_busy_q) { erts_aint32_t act; + unsigned int prof_runnable_ports; if (!processing_busy_q) pp->sched.taskq.local.first = *execq; @@ -1007,6 +1016,10 @@ finalize_exec(Port *pp, ErtsPortTask **execq, int processing_busy_q) if (act & ERTS_PTS_FLG_CHK_UNSET_BUSY_PORT_Q) act = check_unset_busy_port_q(pp, act, pp->sched.taskq.bpq); + prof_runnable_ports = erts_system_profile_flags.runnable_ports; + if (prof_runnable_ports) + erts_port_task_sched_lock(&pp->sched); + while (1) { erts_aint32_t new, exp; @@ -1018,12 +1031,24 @@ finalize_exec(Port *pp, ErtsPortTask **execq, int processing_busy_q) act = erts_smp_atomic32_cmpxchg_relb(&pp->sched.flags, new, exp); - ASSERT(!(act & ERTS_PTS_FLG_IN_RUNQ)); + ERTS_LC_ASSERT(!(act & ERTS_PTS_FLG_IN_RUNQ)); + ERTS_LC_ASSERT(!(act & ERTS_PTS_FLG_EXEC_IMM)); if (exp == act) break; } + if (prof_runnable_ports | IS_TRACED_FL(pp, F_TRACE_SCHED_PORTS)) { + /* trace port scheduling, out */ + if (IS_TRACED_FL(pp, F_TRACE_SCHED_PORTS)) + trace_sched_ports(pp, am_out); + if (prof_runnable_ports) { + if (!(act & (ERTS_PTS_FLG_EXEC_IMM|ERTS_PTS_FLG_HAVE_TASKS))) + profile_runnable_port(pp, am_inactive); + erts_port_task_sched_unlock(&pp->sched); + } + } + return (act & ERTS_PTS_FLG_HAVE_TASKS) != 0; } @@ -1345,7 +1370,7 @@ erts_port_task_abort_nosuspend_tasks(Port *pp) #endif schedule_port_task_handle_list_free(pthlp); - abort_nosuspend_task(pp, type, &td); + abort_nosuspend_task(pp, type, &td, pp->sched.taskq.bpq != NULL); } } @@ -1369,6 +1394,7 @@ erts_port_task_schedule(Eterm id, Port *pp; ErtsPortTask *ptp = NULL; erts_aint32_t act, add_flags; + unsigned int prof_runnable_ports; if (pthp && erts_port_task_is_scheduled(pthp)) { ASSERT(0); @@ -1457,6 +1483,10 @@ erts_port_task_schedule(Eterm id, if (ns_pthlp) add_flags |= ERTS_PTS_FLG_HAVE_NS_TASKS; + prof_runnable_ports = erts_system_profile_flags.runnable_ports; + if (prof_runnable_ports) + erts_port_task_sched_lock(&pp->sched); + while (1) { erts_aint32_t new, exp; @@ -1481,6 +1511,13 @@ erts_port_task_schedule(Eterm id, goto done; /* Died after our task insert... */ } + if (prof_runnable_ports) { + if (!(act & ERTS_PTS_FLG_EXEC_IMM)) + profile_runnable_port(pp, am_active); + erts_port_task_sched_unlock(&pp->sched); + prof_runnable_ports = 0; + } + /* Enqueue port on run-queue */ runq = erts_port_runq(pp); @@ -1489,8 +1526,10 @@ erts_port_task_schedule(Eterm id, #ifdef ERTS_SMP xrunq = erts_check_emigration_need(runq, ERTS_PORT_PRIO_LEVEL); + ERTS_SMP_LC_ASSERT(runq != xrunq); + ERTS_SMP_LC_VERIFY_RQ(runq, pp); if (xrunq) { - /* Port emigrated ... */ + /* Emigrate port ... */ erts_smp_atomic_set_nob(&pp->run_queue, (erts_aint_t) xrunq); erts_smp_runq_unlock(runq); runq = erts_port_runq(pp); @@ -1500,10 +1539,6 @@ erts_port_task_schedule(Eterm id, #endif enqueue_port(runq, pp); - - if (erts_system_profile_flags.runnable_ports) { - profile_runnable_port(pp, am_active); - } erts_smp_runq_unlock(runq); @@ -1511,6 +1546,9 @@ erts_port_task_schedule(Eterm id, done: + if (prof_runnable_ports) + erts_port_task_sched_unlock(&pp->sched); + #ifdef ERTS_SMP if (dhndl != ERTS_THR_PRGR_DHANDLE_MANAGED) erts_port_dec_refc(pp); @@ -1525,7 +1563,7 @@ abort_nosuspend: erts_port_dec_refc(pp); #endif - abort_nosuspend_task(pp, ptp->type, &ptp->u.alive.td); + abort_nosuspend_task(pp, ptp->type, &ptp->u.alive.td, 0); ASSERT(ns_pthlp); erts_free(ERTS_ALC_T_PT_HNDL_LIST, ns_pthlp); @@ -1609,6 +1647,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) goto done; } + ERTS_SMP_LC_VERIFY_RQ(runq, pp); + erts_smp_runq_unlock(runq); *curr_port_pp = pp; @@ -1765,10 +1805,6 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) erts_unblock_fpe(fpe_was_unmasked); - /* trace port scheduling, out */ - if (IS_TRACED_FL(pp, F_TRACE_SCHED_PORTS)) { - trace_sched_ports(pp, am_out); - } if (io_tasks_executed) { ASSERT(erts_smp_atomic_read_nob(&erts_port_task_outstanding_io_tasks) @@ -1791,11 +1827,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) erts_smp_runq_lock(runq); - if (!active) { - if (erts_system_profile_flags.runnable_ports) - profile_runnable_port(pp, am_inactive); - } - else { + if (active) { #ifdef ERTS_SMP ErtsRunQueue *xrunq; #endif @@ -1804,6 +1836,8 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) #ifdef ERTS_SMP xrunq = erts_check_emigration_need(runq, ERTS_PORT_PRIO_LEVEL); + ERTS_SMP_LC_ASSERT(runq != xrunq); + ERTS_SMP_LC_VERIFY_RQ(runq, pp); if (!xrunq) { #endif enqueue_port(runq, pp); @@ -1811,7 +1845,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) #ifdef ERTS_SMP } else { - /* Port emigrated ... */ + /* Emigrate port... */ erts_smp_atomic_set_nob(&pp->run_queue, (erts_aint_t) xrunq); erts_smp_runq_unlock(runq); diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h index 1d30465ec9..9ef0cfcedc 100644 --- a/erts/emulator/beam/erl_port_task.h +++ b/erts/emulator/beam/erl_port_task.h @@ -78,6 +78,7 @@ extern erts_smp_atomic_t erts_port_task_outstanding_io_tasks; #define ERTS_PTS_FLG_PARALLELISM (((erts_aint32_t) 1) << 9) #define ERTS_PTS_FLG_FORCE_SCHED (((erts_aint32_t) 1) << 10) #define ERTS_PTS_FLG_EXITING (((erts_aint32_t) 1) << 11) +#define ERTS_PTS_FLG_EXEC_IMM (((erts_aint32_t) 1) << 12) #define ERTS_PTS_FLGS_BUSY \ (ERTS_PTS_FLG_BUSY_PORT | ERTS_PTS_FLG_BUSY_PORT_Q) @@ -87,6 +88,7 @@ extern erts_smp_atomic_t erts_port_task_outstanding_io_tasks; | ERTS_PTS_FLG_HAVE_BUSY_TASKS \ | ERTS_PTS_FLG_HAVE_TASKS \ | ERTS_PTS_FLG_EXEC \ + | ERTS_PTS_FLG_EXEC_IMM \ | ERTS_PTS_FLG_FORCE_SCHED \ | ERTS_PTS_FLG_EXITING) diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index b73f9b7f92..685004f267 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -590,12 +590,10 @@ erts_pre_init_process(void) erts_psd_required_locks[ERTS_PSD_DELAYED_GC_TASK_QS].set_locks = ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS; -#ifdef ERTS_DIRTY_SCHEDULERS - erts_psd_required_locks[ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT].get_locks - = ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT_GET_LOCKS; - erts_psd_required_locks[ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT].set_locks - = ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT_SET_LOCKS; -#endif + erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].get_locks + = ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_NIF_TRAP_EXPORT].set_locks + = ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS; /* Check that we have locks for all entries */ for (ix = 0; ix < ERTS_PSD_SIZE; ix++) { @@ -2211,6 +2209,9 @@ aux_work_timeout_early_init(int no_schedulers) p = (UWord) malloc((sizeof(ErtsAuxWorkTmo) + sizeof(erts_atomic32_t)*(no_schedulers+1)) + ERTS_CACHE_LINE_SIZE-1); + if (!p) { + ERTS_INTERNAL_ERROR("malloc failed to allocate memory!"); + } if (p & ERTS_CACHE_LINE_MASK) p = (p & ~ERTS_CACHE_LINE_MASK) + ERTS_CACHE_LINE_SIZE; ASSERT((p & ERTS_CACHE_LINE_MASK) == 0); @@ -3755,17 +3756,25 @@ evacuate_run_queue(ErtsRunQueue *rq, } #ifdef ERTS_DIRTY_SCHEDULERS else if (state & ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q) { - erts_aint32_t old; - old = erts_smp_atomic32_read_band_nob(&proc->state, - ~(ERTS_PSFLG_DIRTY_CPU_PROC - | ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q)); +#ifdef DEBUG + erts_aint32_t old = +#else + (void) +#endif + erts_smp_atomic32_read_band_nob(&proc->state, + ~(ERTS_PSFLG_DIRTY_CPU_PROC + | ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q)); /* assert that no other dirty flags are set */ ASSERT(!(old & (ERTS_PSFLG_DIRTY_IO_PROC|ERTS_PSFLG_DIRTY_IO_PROC_IN_Q))); } else if (state & ERTS_PSFLG_DIRTY_IO_PROC_IN_Q) { - erts_aint32_t old; - old = erts_smp_atomic32_read_band_nob(&proc->state, - ~(ERTS_PSFLG_DIRTY_IO_PROC - | ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); +#ifdef DEBUG + erts_aint32_t old = +#else + (void) +#endif + erts_smp_atomic32_read_band_nob(&proc->state, + ~(ERTS_PSFLG_DIRTY_IO_PROC + | ERTS_PSFLG_DIRTY_IO_PROC_IN_Q)); /* assert that no other dirty flags are set */ ASSERT(!(old & (ERTS_PSFLG_DIRTY_CPU_PROC|ERTS_PSFLG_DIRTY_CPU_PROC_IN_Q))); } @@ -5874,6 +5883,9 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p, Proces case ERTS_ENQUEUE_NOT: if (erts_system_profile_flags.runnable_procs) { + /* Status lock prevents out of order "runnable proc" trace msgs */ + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + if (!(a & ERTS_PSFLG_ACTIVE_SYS) && (!(a & ERTS_PSFLG_ACTIVE) || (a & ERTS_PSFLG_SUSPENDED))) { @@ -5987,7 +5999,8 @@ change_proc_schedule_state(Process *p, erts_aint32_t clear_state_flags, erts_aint32_t set_state_flags, erts_aint32_t *statep, - erts_aint32_t *enq_prio_p) + erts_aint32_t *enq_prio_p, + ErtsProcLocks locks) { /* * NOTE: ERTS_PSFLG_RUNNING, ERTS_PSFLG_RUNNING_SYS and @@ -5996,6 +6009,11 @@ change_proc_schedule_state(Process *p, */ erts_aint32_t a = *statep, n; int enqueue; /* < 0 -> use proxy */ + unsigned int prof_runnable_procs = erts_system_profile_flags.runnable_procs; + unsigned int lock_status = (prof_runnable_procs + && !(locks & ERTS_PROC_LOCK_STATUS)); + + ERTS_SMP_LC_ASSERT(locks == erts_proc_lc_my_proc_locks(p)); ASSERT(!(a & ERTS_PSFLG_PROXY)); ASSERT((clear_state_flags & (ERTS_PSFLG_RUNNING @@ -6005,6 +6023,9 @@ change_proc_schedule_state(Process *p, | ERTS_PSFLG_RUNNING_SYS | ERTS_PSFLG_ACTIVE_SYS)) == 0); + if (lock_status) + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + while (1) { erts_aint32_t e; n = e = a; @@ -6040,7 +6061,9 @@ change_proc_schedule_state(Process *p, break; } - if (erts_system_profile_flags.runnable_procs) { + if (prof_runnable_procs) { + + /* Status lock prevents out of order "runnable proc" trace msgs */ if (((n & (ERTS_PSFLG_SUSPENDED | ERTS_PSFLG_ACTIVE)) == ERTS_PSFLG_ACTIVE) @@ -6053,15 +6076,18 @@ change_proc_schedule_state(Process *p, profile_runnable_proc(p, am_active); } + if (lock_status) + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); } + *statep = a; return enqueue; } static ERTS_INLINE void -schedule_process(Process *p, erts_aint32_t in_state) +schedule_process(Process *p, erts_aint32_t in_state, ErtsProcLocks locks) { erts_aint32_t enq_prio = -1; erts_aint32_t state = in_state; @@ -6069,7 +6095,8 @@ schedule_process(Process *p, erts_aint32_t in_state) 0, ERTS_PSFLG_ACTIVE, &state, - &enq_prio); + &enq_prio, + locks); if (enqueue != ERTS_ENQUEUE_NOT) add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), state, @@ -6077,16 +6104,27 @@ schedule_process(Process *p, erts_aint32_t in_state) } void -erts_schedule_process(Process *p, erts_aint32_t state) +erts_schedule_process(Process *p, erts_aint32_t state, ErtsProcLocks locks) { - schedule_process(p, state); + schedule_process(p, state, locks); } static void schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) { + /* + * Expects status lock to be locked when called, and + * returns with status lock unlocked... + */ erts_aint32_t a = state, n, enq_prio = -1; int enqueue; /* < 0 -> use proxy */ + unsigned int prof_runnable_procs = erts_system_profile_flags.runnable_procs; + + /* Status lock prevents out of order "runnable proc" trace msgs */ + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + + if (!prof_runnable_procs) + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); ASSERT(!(state & ERTS_PSFLG_PROXY)); @@ -6095,7 +6133,7 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) n = e = a; if (a & ERTS_PSFLG_FREE) - return; /* We don't want to schedule free processes... */ + goto cleanup; /* We don't want to schedule free processes... */ enqueue = ERTS_ENQUEUE_NOT; n |= ERTS_PSFLG_ACTIVE_SYS; @@ -6108,7 +6146,7 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) goto cleanup; } - if (erts_system_profile_flags.runnable_procs) { + if (prof_runnable_procs) { if (!(a & (ERTS_PSFLG_ACTIVE_SYS | ERTS_PSFLG_RUNNING @@ -6118,6 +6156,8 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) profile_runnable_proc(p, am_active); } + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + prof_runnable_procs = 0; } if (enqueue != ERTS_ENQUEUE_NOT) { @@ -6132,8 +6172,14 @@ schedule_process_sys_task(Process *p, erts_aint32_t state, Process *proxy) } cleanup: + + if (prof_runnable_procs) + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + if (proxy) free_proxy_proc(proxy); + + ERTS_SMP_LC_ASSERT(!(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p))); } static ERTS_INLINE int @@ -6200,7 +6246,7 @@ suspend_process(Process *c_p, Process *p) } static ERTS_INLINE void -resume_process(Process *p) +resume_process(Process *p, ErtsProcLocks locks) { erts_aint32_t state, enq_prio = -1; int enqueue; @@ -6217,7 +6263,8 @@ resume_process(Process *p) ERTS_PSFLG_SUSPENDED, 0, &state, - &enq_prio); + &enq_prio, + locks); if (enqueue) add2runq(enqueue > 0 ? p : make_proxy_proc(NULL, p, enq_prio), state, @@ -7818,6 +7865,9 @@ erts_start_schedulers(void) #ifdef ETHR_HAVE_THREAD_NAMES opts.name = malloc(80); + if (!opts.name) { + ERTS_INTERNAL_ERROR("malloc failed to allocate memory!"); + } #endif #ifdef ERTS_SMP @@ -8030,7 +8080,8 @@ handle_pend_sync_suspend(Process *suspendee, } /* suspender is suspended waiting for suspendee to suspend; resume suspender */ - resume_process(suspender); + ASSERT(suspendee != suspender); + resume_process(suspender, ERTS_PROC_LOCK_STATUS); erts_smp_proc_unlock(suspender, ERTS_PROC_LOCK_STATUS); } } @@ -8065,7 +8116,7 @@ pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks, ASSERT(c_p->flags & F_P2PNR_RESCHED); c_p->flags &= ~F_P2PNR_RESCHED; if (!suspend && rp) - resume_process(rp); + resume_process(rp, rp_locks); } else { @@ -8223,7 +8274,8 @@ handle_pend_bif_sync_suspend(Process *suspendee, } /* suspender is suspended waiting for suspendee to suspend; resume suspender */ - resume_process(suspender); + ASSERT(suspender != suspendee); + resume_process(suspender, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); erts_smp_proc_unlock(suspender, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); } @@ -8583,7 +8635,8 @@ resume_process_1(BIF_ALIST_1) ASSERT(ERTS_PSFLG_SUSPENDED & erts_smp_atomic32_read_nob(&suspendee->state)); - resume_process(suspendee); + ASSERT(BIF_P != suspendee); + resume_process(suspendee, ERTS_PROC_LOCK_STATUS); erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS); } @@ -8713,7 +8766,7 @@ erts_resume(Process* process, ErtsProcLocks process_locks) ERTS_SMP_LC_ASSERT(process_locks == erts_proc_lc_my_proc_locks(process)); if (!(process_locks & ERTS_PROC_LOCK_STATUS)) erts_smp_proc_lock(process, ERTS_PROC_LOCK_STATUS); - resume_process(process); + resume_process(process, process_locks|ERTS_PROC_LOCK_STATUS); if (!(process_locks & ERTS_PROC_LOCK_STATUS)) erts_smp_proc_unlock(process, ERTS_PROC_LOCK_STATUS); } @@ -8732,7 +8785,7 @@ erts_resume_processes(ErtsProcList *list) proc = erts_pid2proc(NULL, 0, plp->pid, ERTS_PROC_LOCK_STATUS); if (proc) { if (erts_proclist_same(plp, proc)) { - resume_process(proc); + resume_process(proc, ERTS_PROC_LOCK_STATUS); nresumed++; } erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_STATUS); @@ -9968,8 +10021,10 @@ erts_internal_request_system_task_3(BIF_ALIST_3) rp_state = n; } - erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); - + /* + * schedule_process_sys_task() unlocks status + * lock on process. + */ schedule_process_sys_task(rp, rp_state, NULL); if (free_stqs) @@ -10714,7 +10769,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). * Schedule process for execution. */ - schedule_process(p, state); + schedule_process(p, state, 0); VERBOSE(DEBUG_PROCESSES, ("Created a new process: %T\n",p->common.id)); @@ -11035,7 +11090,8 @@ set_proc_exiting(Process *p, ERTS_PSFLG_SUSPENDED|ERTS_PSFLG_PENDING_EXIT, ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE, &state, - &enq_prio); + &enq_prio, + ERTS_PROC_LOCKS_ALL); p->fvalue = reason; if (bp) @@ -11076,7 +11132,8 @@ set_proc_self_exiting(Process *c_p) ERTS_PSFLG_SUSPENDED|ERTS_PSFLG_PENDING_EXIT, ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE, &state, - &enq_prio); + &enq_prio, + ERTS_PROC_LOCKS_ALL); ASSERT(!enqueue); return state; @@ -11721,8 +11778,9 @@ resume_suspend_monitor(ErtsSuspendMonitor *smon, void *vc_p) Process *suspendee = erts_pid2proc((Process *) vc_p, ERTS_PROC_LOCK_MAIN, smon->pid, ERTS_PROC_LOCK_STATUS); if (suspendee) { + ASSERT(suspendee != vc_p); if (smon->active) - resume_process(suspendee); + resume_process(suspendee, ERTS_PROC_LOCK_STATUS); erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS); } erts_destroy_suspend_monitor(smon); @@ -12055,7 +12113,7 @@ timeout_proc(Process* p) state = erts_smp_atomic32_read_acqb(&p->state); if (!(state & ERTS_PSFLG_ACTIVE)) - schedule_process(p, state); + schedule_process(p, state, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); } diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index ed6dadbffa..9b740f049e 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -734,13 +734,9 @@ erts_smp_reset_max_len(ErtsRunQueue *rq, ErtsRunQueueInfo *rqi) #define ERTS_PSD_DIST_ENTRY 3 #define ERTS_PSD_CALL_TIME_BP 4 #define ERTS_PSD_DELAYED_GC_TASK_QS 5 -#ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT 6 +#define ERTS_PSD_NIF_TRAP_EXPORT 6 #define ERTS_PSD_SIZE 7 -#else -#define ERTS_PSD_SIZE 6 -#endif typedef struct { void *data[ERTS_PSD_SIZE]; @@ -767,10 +763,8 @@ typedef struct { #define ERTS_PSD_DELAYED_GC_TASK_QS_GET_LOCKS ERTS_PROC_LOCK_MAIN #define ERTS_PSD_DELAYED_GC_TASK_QS_SET_LOCKS ERTS_PROC_LOCK_MAIN -#ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT_GET_LOCKS ERTS_PROC_LOCK_MAIN -#define ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT_SET_LOCKS ERTS_PROC_LOCK_MAIN -#endif +#define ERTS_PSD_NIF_TRAP_EXPORT_GET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_NIF_TRAP_EXPORT_SET_LOCKS ERTS_PROC_LOCK_MAIN typedef struct { ErtsProcLocks get_locks; @@ -1367,6 +1361,8 @@ Uint64 erts_get_proc_interval(void); Uint64 erts_ensure_later_proc_interval(Uint64); Uint64 erts_step_proc_interval(void); +int erts_setup_nif_gc(Process* proc, Eterm** objv, int* nobj); /* see erl_nif.c */ + ErtsProcList *erts_proclist_create(Process *); void erts_proclist_destroy(ErtsProcList *); @@ -1704,17 +1700,17 @@ ErtsSchedulerData *erts_get_scheduler_data(void) #endif #endif -void erts_schedule_process(Process *, erts_aint32_t); +void erts_schedule_process(Process *, erts_aint32_t, ErtsProcLocks); -ERTS_GLB_INLINE void erts_proc_notify_new_message(Process *p); +ERTS_GLB_INLINE void erts_proc_notify_new_message(Process *p, ErtsProcLocks locks); #if ERTS_GLB_INLINE_INCL_FUNC_DEF ERTS_GLB_INLINE void -erts_proc_notify_new_message(Process *p) +erts_proc_notify_new_message(Process *p, ErtsProcLocks locks) { /* No barrier needed, due to msg lock */ erts_aint32_t state = erts_smp_atomic32_read_nob(&p->state); if (!(state & ERTS_PSFLG_ACTIVE)) - erts_schedule_process(p, state); + erts_schedule_process(p, state, locks); } #endif @@ -1817,12 +1813,10 @@ erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data) #define ERTS_PROC_SET_DELAYED_GC_TASK_QS(P, L, PBT) \ ((ErtsProcSysTaskQs *) erts_psd_set((P), (L), ERTS_PSD_DELAYED_GC_TASK_QS, (void *) (PBT))) -#ifdef ERTS_DIRTY_SCHEDULERS -#define ERTS_PROC_GET_DIRTY_SCHED_TRAP_EXPORT(P) \ - ((Export *) erts_psd_get((P), ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT)) -#define ERTS_PROC_SET_DIRTY_SCHED_TRAP_EXPORT(P, L, DSTE) \ - ((Export *) erts_psd_set((P), (L), ERTS_PSD_DIRTY_SCHED_TRAP_EXPORT, (void *) (DSTE))) -#endif +#define ERTS_PROC_GET_NIF_TRAP_EXPORT(P) \ + ((Export *) erts_psd_get((P), ERTS_PSD_NIF_TRAP_EXPORT)) +#define ERTS_PROC_SET_NIF_TRAP_EXPORT(P, L, DSTE) \ + ((Export *) erts_psd_set((P), (L), ERTS_PSD_NIF_TRAP_EXPORT, (void *) (DSTE))) ERTS_GLB_INLINE Eterm erts_proc_get_error_handler(Process *p); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index edf4a28784..ae053fc191 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1218,9 +1218,10 @@ typedef struct { static ERTS_INLINE ErtsTryImmDrvCallResult try_imm_drv_call(ErtsTryImmDrvCallState *sp) { + unsigned int prof_runnable_ports; ErtsTryImmDrvCallResult res; int reds_left_in; - erts_aint32_t invalid_state, invalid_sched_flags; + erts_aint32_t act, exp, invalid_state, invalid_sched_flags; Port *prt = sp->port; Process *c_p = sp->c_p; @@ -1247,18 +1248,39 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp) goto locked_fail; } - sp->sched_flags = erts_smp_atomic32_read_nob(&prt->sched.flags); - if (sp->sched_flags & invalid_sched_flags) { - res = ERTS_TRY_IMM_DRV_CALL_INVALID_SCHED_FLAGS; - goto locked_fail; - } + prof_runnable_ports = erts_system_profile_flags.runnable_ports; + if (prof_runnable_ports) + erts_port_task_sched_lock(&prt->sched); + act = erts_smp_atomic32_read_nob(&prt->sched.flags); + + do { + erts_aint32_t new; + + if (act & invalid_sched_flags) { + res = ERTS_TRY_IMM_DRV_CALL_INVALID_SCHED_FLAGS; + sp->sched_flags = act; + goto locked_fail; + } + exp = act; + new = act | ERTS_PTS_FLG_EXEC_IMM; + act = erts_smp_atomic32_cmpxchg_mb(&prt->sched.flags, new, exp); + } while (act != exp); + + sp->sched_flags = act; if (!c_p) reds_left_in = CONTEXT_REDS/10; else { if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) trace_virtual_sched(c_p, am_out); + /* + * No status lock held while sending runnable + * proc trace messages. It is however not needed + * in this case, since only this thread can send + * such messages for this process until the process + * has been scheduled out. + */ if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) profile_runnable_proc(c_p, am_inactive); @@ -1273,11 +1295,14 @@ try_imm_drv_call(ErtsTryImmDrvCallState *sp) ERTS_SMP_CHK_NO_PROC_LOCKS; - if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) - trace_sched_ports_where(prt, am_in, sp->port_op); - if (erts_system_profile_flags.runnable_ports - && !erts_port_is_scheduled(prt)) - profile_runnable_port(prt, am_active); + if (prof_runnable_ports | IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) { + if (prof_runnable_ports && !(act & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC))) + profile_runnable_port(prt, am_active); + if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) + trace_sched_ports_where(prt, am_in, sp->port_op); + if (prof_runnable_ports) + erts_port_task_sched_unlock(&prt->sched); + } sp->fpe_was_unmasked = erts_block_fpe(); @@ -1294,17 +1319,31 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) int reds; Port *prt = sp->port; Process *c_p = sp->c_p; + erts_aint32_t act; + unsigned int prof_runnable_ports; reds = prt->reds; reds += erts_port_driver_callback_epilogue(prt, NULL); erts_unblock_fpe(sp->fpe_was_unmasked); - if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) - trace_sched_ports_where(prt, am_out, sp->port_op); - if (erts_system_profile_flags.runnable_ports - && !erts_port_is_scheduled(prt)) - profile_runnable_port(prt, am_inactive); + prof_runnable_ports = erts_system_profile_flags.runnable_ports; + if (prof_runnable_ports) + erts_port_task_sched_lock(&prt->sched); + + act = erts_smp_atomic32_read_band_mb(&prt->sched.flags, + ~ERTS_PTS_FLG_EXEC_IMM); + ERTS_SMP_LC_ASSERT(act & ERTS_PTS_FLG_EXEC_IMM); + + if (prof_runnable_ports | IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) { + if (IS_TRACED_FL(prt, F_TRACE_SCHED_PORTS)) + trace_sched_ports_where(prt, am_out, sp->port_op); + if (prof_runnable_ports) { + if (!(act & (ERTS_PTS_FLG_IN_RUNQ|ERTS_PTS_FLG_EXEC))) + profile_runnable_port(prt, am_inactive); + erts_port_task_sched_unlock(&prt->sched); + } + } erts_port_release(prt); @@ -1319,6 +1358,13 @@ finalize_imm_drv_call(ErtsTryImmDrvCallState *sp) if (IS_TRACED_FL(c_p, F_TRACE_SCHED_PROCS)) trace_virtual_sched(c_p, am_in); + /* + * No status lock held while sending runnable + * proc trace messages. It is however not needed + * in this case, since only this thread can send + * such messages for this process until the process + * has been scheduled out. + */ if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) profile_runnable_proc(c_p, am_active); @@ -6129,7 +6175,7 @@ driver_pdl_create(ErlDrvPort dp) return NULL; pdl = erts_alloc(ERTS_ALC_T_PORT_DATA_LOCK, sizeof(struct erl_drv_port_data_lock)); - erts_mtx_init(&pdl->mtx, "port_data_lock"); + erts_mtx_init_x(&pdl->mtx, "port_data_lock", pp->common.id, 1); pdl_init_refc(pdl); erts_port_inc_refc(pp); pdl->prt = pp; @@ -7166,7 +7212,7 @@ char *driver_dl_error(void) #define ERL_DRV_SYS_INFO_SIZE(LAST_FIELD) \ - (((size_t) &((ErlDrvSysInfo *) 0)->LAST_FIELD) \ + (offsetof(ErlDrvSysInfo, LAST_FIELD) \ + sizeof(((ErlDrvSysInfo *) 0)->LAST_FIELD)) void diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 05f07e57b2..3d8dd9c6d0 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -274,6 +274,7 @@ __decl_noreturn void __noreturn erl_assert_error(const char* expr, const char *f typedef unsigned int Eterm; typedef unsigned int Uint; typedef int Sint; +#define ERTS_UINT_MAX UINT_MAX #define ERTS_SIZEOF_ETERM SIZEOF_INT #define ErtsStrToSint strtol #else @@ -347,6 +348,7 @@ typedef long long Sint; typedef Uint UWord; typedef Sint SWord; +#define ERTS_UINT_MAX ERTS_UWORD_MAX #endif /* HALFWORD_HEAP */ diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 72092ec7b0..55f9e68e78 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -3948,6 +3948,9 @@ erts_save_emu_args(int argc, char **argv) size += sz+1; } ptr = (char *) malloc(size); + if (!ptr) { + ERTS_INTERNAL_ERROR("malloc failed to allocate memory!"); + } #ifdef DEBUG end_ptr = ptr + size; #endif diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 09bada457d..891589d1c5 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -4372,7 +4372,7 @@ static int erl_inet_close(inet_descriptor* desc) desc_close(desc); desc->state = INET_STATE_CLOSED; } else if (desc->prebound && (desc->s != INVALID_SOCKET)) { - sock_select(desc, FD_READ | FD_WRITE | FD_CLOSE, 0); + sock_select(desc, FD_READ | FD_WRITE | FD_CLOSE | ERL_DRV_USE_NO_CALLBACK, 0); desc->event_mask = 0; #ifdef __WIN32__ desc->forced_events = 0; @@ -4536,7 +4536,8 @@ static ErlDrvSSizeT inet_ctl_open(inet_descriptor* desc, int domain, int type, /* as inet_open but pass in an open socket (MUST BE OF RIGHT TYPE) */ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type, - SOCKET s, char** rbuf, ErlDrvSizeT rsize) + SOCKET s, Uint32 bound, + char** rbuf, ErlDrvSizeT rsize) { inet_address name; unsigned int sz = sizeof(name); @@ -4560,7 +4561,12 @@ static ErlDrvSSizeT inet_ctl_fdopen(inet_descriptor* desc, int domain, int type, #ifdef __WIN32__ driver_select(desc->port, desc->event, ERL_DRV_READ, 1); #endif - desc->state = INET_STATE_BOUND; /* assume bound */ + + if (bound) + desc->state = INET_STATE_BOUND; + else + desc->state = INET_STATE_OPEN; + if (type == SOCK_STREAM) { /* check if connected */ sz = sizeof(name); if (!IS_SOCKET_ERROR(sock_peer(s, (struct sockaddr*) &name, &sz))) { @@ -5772,7 +5778,7 @@ done: ia_p->Ipv6IfIndex && ia_p->Ipv6IfIndex != index) { - /* Oops, there was an other interface for IPv6. Possible? XXX */ + /* Oops, there was another interface for IPv6. Possible? XXX */ index = ia_p->Ipv6IfIndex; goto index; } @@ -9121,10 +9127,11 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd, break; } - case INET_REQ_FDOPEN: { /* pass in an open socket */ + case INET_REQ_FDOPEN: { /* pass in an open (and optionally bound) socket */ int domain; + int bound; DEBUGF(("tcp_inet_ctl(%ld): FDOPEN\r\n", (long)desc->inet.port)); - if (len != 6) return ctl_error(EINVAL, rbuf, rsize); + if (len != 6 && len != 10) return ctl_error(EINVAL, rbuf, rsize); switch(buf[0]) { case INET_AF_INET: domain = AF_INET; @@ -9142,8 +9149,13 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd, return ctl_error(EINVAL, rbuf, rsize); } if (buf[1] != INET_TYPE_STREAM) return ctl_error(EINVAL, rbuf, rsize); + + if (len == 6) bound = 1; + else bound = get_int32(buf+2+4); + return inet_ctl_fdopen(INETP(desc), domain, SOCK_STREAM, - (SOCKET) get_int32(buf+2), rbuf, rsize); + (SOCKET) get_int32(buf+2), + bound, rbuf, rsize); break; } @@ -11116,10 +11128,11 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, return replen; - case INET_REQ_FDOPEN: { /* pass in an open (and bound) socket */ + case INET_REQ_FDOPEN: { /* pass in an open (and optionally bound) socket */ SOCKET s; + int bound; DEBUGF(("packet inet_ctl(%ld): FDOPEN\r\n", (long)desc->port)); - if (len != 6) { + if (len != 6 && len != 10) { return ctl_error(EINVAL, rbuf, rsize); } switch (buf[0]) { @@ -11144,7 +11157,11 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, return ctl_error(EINVAL, rbuf, rsize); } s = (SOCKET)get_int32(buf+2); - replen = inet_ctl_fdopen(desc, af, type, s, rbuf, rsize); + + if (len == 6) bound = 1; + else bound = get_int32(buf+2+4); + + replen = inet_ctl_fdopen(desc, af, type, s, bound, rbuf, rsize); if ((*rbuf)[0] != INET_REP_ERROR) { if (desc->active) diff --git a/erts/emulator/drivers/unix/multi_drv.c b/erts/emulator/drivers/unix/multi_drv.c index 822c96730c..724d325ed5 100644 --- a/erts/emulator/drivers/unix/multi_drv.c +++ b/erts/emulator/drivers/unix/multi_drv.c @@ -20,7 +20,7 @@ /* Purpose: Multidriver interface This is an example of a driver which allows multiple instances of itself. I.e have one erlang process execute open_port(multi......) and - at the same time have an other erlang process open an other port + at the same time have another erlang process open another port running multi there as well. */ diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index 0a58a625b2..aa412a20c8 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -2157,7 +2157,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, #ifdef ERTS_POLL_DEBUG_PRINT erts_printf("Entering erts_poll_wait(), timeout=%d\n", - (int) tv->tv_sec*1000 + tv->tv_usec/1000); + (int) tvp->tv_sec*1000 + tvp->tv_usec/1000); #endif if (ERTS_POLLSET_SET_POLLED_CHK(ps)) { diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 0b0568c31a..dfbe47786a 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -31,6 +31,7 @@ MODULES= \ a_SUITE \ after_SUITE \ alloc_SUITE \ + async_ports_SUITE \ beam_SUITE \ beam_literals_SUITE \ bif_SUITE \ diff --git a/erts/emulator/test/async_ports_SUITE.erl b/erts/emulator/test/async_ports_SUITE.erl new file mode 100644 index 0000000000..c89b3655ff --- /dev/null +++ b/erts/emulator/test/async_ports_SUITE.erl @@ -0,0 +1,118 @@ +-module(async_ports_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-compile(export_all). + +-define(PACKET_SIZE, (10 * 1024 * 8)). +-define(CPORT_DELAY, 100). +-define(TEST_LOOPS_COUNT, 100000). +-define(SLEEP_BEFORE_CHECK, 1000). +-define(TEST_PROCS_COUNT, 2). +-define(TC_TIMETRAP_SECONDS, 10). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + permanent_busy_test + ]. + +permanent_busy_test(Config) -> + ct:timetrap({seconds, ?TC_TIMETRAP_SECONDS}), + ExePath = filename:join(?config(data_dir, Config), "cport"), + + Self = self(), + spawn_link( + fun() -> + Block = <<0:?PACKET_SIZE>>, + + Port = open_port(ExePath), + + Testers = + lists:map( + fun(_) -> + erlang:spawn_link(?MODULE, run_loop, + [Self, + Port, + Block, + ?TEST_LOOPS_COUNT, + 0]) + end, + lists:seq(1, ?TEST_PROCS_COUNT)), + Self ! {test_info, Port, Testers}, + endless_flush(Port) + end), + + receive + {test_info, Port, Testers} -> + MaxWaitTime = round(0.7 * ?TC_TIMETRAP_SECONDS * 1000), + ct:log("wait testers, maximum ~w mcsec~n", [MaxWaitTime]), + ok = wait_testers(MaxWaitTime, Testers), + timer:sleep(?SLEEP_BEFORE_CHECK), + case erlang:port_command(Port, <<"test">>, [nosuspend]) of + false -> + exit(port_dead); + true -> + ok + end + end. + +wait_testers(Timeout, Testers) -> + lists:foldl( + fun(Pid, AccIn) -> + StartWait = os:timestamp(), + receive + {Pid, port_dead} -> + recalc_timeout(AccIn, StartWait) + after AccIn -> + Pid ! stop, + recalc_timeout(AccIn, StartWait) + end + end, Timeout, Testers), + ok. + +recalc_timeout(TimeoutIn, WaitStart) -> + erlang:max(0, TimeoutIn - round(timer:now_diff(os:timestamp(), WaitStart)) div 1000). + +open_port(ExePath) -> + erlang:open_port({spawn, ExePath ++ " 100"}, [{packet, 4}, eof, exit_status, use_stdio, binary]). + +run_loop(RootProc, Port, Block, CheckLimit, BusyCnt) -> + receive + stop -> + ok + after 0 -> + case erlang:port_command(Port, Block, [nosuspend]) of + true -> + run_loop(RootProc, Port, Block, CheckLimit, 0); + false -> + if + BusyCnt + 1 > CheckLimit -> + check_dead(RootProc, Port, Block, CheckLimit); + true -> + run_loop(RootProc, Port, Block, CheckLimit, BusyCnt + 1) + end + end + end. + +check_dead(RootProc, Port, Block, CheckLimit) -> + ct:log("~p: check port dead~n", [self()]), + timer:sleep(?SLEEP_BEFORE_CHECK), + case erlang:port_command(Port, Block, [nosuspend]) of + true -> + ct:log("not dead~n"), + run_loop(RootProc, Port, Block, CheckLimit, 0); + false -> + ct:log("port dead: ~p~n", [Port]), + RootProc ! {self(), port_dead}, + ok + end. + +endless_flush(Port) -> + receive + {Port, {data, _}} -> + endless_flush(Port); + {Port, SomethingWrong} -> + erlang:error({someting_wrong, SomethingWrong}) + end. diff --git a/erts/emulator/test/async_ports_SUITE_data/Makefile.src b/erts/emulator/test/async_ports_SUITE_data/Makefile.src new file mode 100644 index 0000000000..56da3fbe12 --- /dev/null +++ b/erts/emulator/test/async_ports_SUITE_data/Makefile.src @@ -0,0 +1,15 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = cport@exe@ + + +all: $(PROGS) + +cport@exe@: cport@obj@ + $(LD) $(CROSSLDFLAGS) -o cport cport@obj@ @LIBS@ + +cport@obj@: cport.c + $(CC) -c -o cport@obj@ $(CFLAGS) cport.c diff --git a/erts/emulator/test/async_ports_SUITE_data/cport.c b/erts/emulator/test/async_ports_SUITE_data/cport.c new file mode 100644 index 0000000000..033aff382a --- /dev/null +++ b/erts/emulator/test/async_ports_SUITE_data/cport.c @@ -0,0 +1,81 @@ +#include <stdlib.h> +#include <stdio.h> +#include <errno.h> +#include <string.h> +#ifdef __WIN32__ +# include "windows.h" +# include "winbase.h" +#else +# include <unistd.h> +#endif + +typedef unsigned char byte; + +int read_cmd(byte *buf) +{ + int len; + if (read_exact(buf, 4) != 4) + return(-1); + + len = (buf[0] << 24) | (buf[1] << 16) | (buf[2] << 8) | buf[3]; + return read_exact(buf, len); +} + +int write_cmd(byte *buf, int len) +{ + byte li[4]; + li[0] = (len >> 24) & 0xff; + li[1] = (len >> 16) & 0xff; + li[2] = (len >> 8) & 0xff; + li[3] = len & 0xff; + write_exact(&li, 4); + + return write_exact(buf, len); +} + +int read_exact(byte *buf, int len) +{ + int i, got=0; + do { + if ((i = read(0, buf+got, len-got)) <= 0) + { + return(i); + } + got += i; + } while (got<len); + return len; +} + +int write_exact(byte *buf, int len) +{ + int i, wrote = 0; + do { + if ((i = write(1, buf+wrote, len-wrote)) < 0) + return (i); + wrote += i; + } while (wrote<len); + return len; +} + +byte static_buf[31457280]; // 30 mb + +int main(int argc, char **argv) { + int sleep_time = atoi(argv[1]); + int fn, arg, res; + byte *buf = &static_buf[0]; + int len = 0; + if (sleep_time <= 0) + sleep_time = 0; +#ifdef __WIN32__ + else + sleep_time = ((sleep_time - 1) / 1000) + 1; /* Milli seconds */ +#endif + while ((len = read_cmd(buf)) > 0) { +#ifdef __WIN32__ + Sleep((DWORD) sleep_time); +#else + usleep(sleep_time); +#endif + write_cmd(buf, len); + } +} diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl index 4b4af0babe..2ed5aaa0d0 100644 --- a/erts/emulator/test/busy_port_SUITE.erl +++ b/erts/emulator/test/busy_port_SUITE.erl @@ -98,8 +98,10 @@ generator(0, Writer, _Data) -> %% Calling process_info(Pid, current_function) on a suspended process %% used to crash Beam. - {current_function, {erlang, send, 2}} = - process_info(Writer, current_function), + case process_info(Writer, [status,current_function]) of + [{status,suspended},{current_function,{erlang,send,2}}] -> ok; + [{status,suspended},{current_function,{erlang,bif_return_trap,_}}] -> ok + end, unlock_slave(); generator(N, Writer, Data) -> Writer ! {exec, Data}, diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index c62bc0c454..344bde7c91 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -1062,10 +1062,9 @@ otp_6602(Config) when is_list(Config) -> %% Inet driver use port locking... {ok, S} = gen_udp:open(0), {ok, Fd} = inet:getfd(S), - {ok, Port} = inet:port(S), %% Steal fd (lock checker used to %% trigger here). - {ok, _S2} = gen_udp:open(Port,[{fd,Fd}]), + {ok, _S2} = gen_udp:open(0,[{fd,Fd}]), Parent ! Done end), ?line receive Done -> ok end, diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl index 8ad5f290ed..2968f5bebb 100644 --- a/erts/emulator/test/fun_SUITE.erl +++ b/erts/emulator/test/fun_SUITE.erl @@ -30,7 +30,7 @@ fun_to_port/1,t_hash/1,t_phash/1,t_phash2/1,md5/1, refc/1,refc_ets/1,refc_dist/1, const_propagation/1,t_arity/1,t_is_function2/1, - t_fun_info/1]). + t_fun_info/1,t_fun_info_mfa/1]). -export([nothing/0]). @@ -42,7 +42,8 @@ all() -> [bad_apply, bad_fun_call, badarity, ext_badarity, equality, ordering, fun_to_port, t_hash, t_phash, t_phash2, md5, refc, refc_ets, refc_dist, - const_propagation, t_arity, t_is_function2, t_fun_info]. + const_propagation, t_arity, t_is_function2, t_fun_info, + t_fun_info_mfa]. groups() -> []. @@ -824,6 +825,24 @@ t_fun_info(Config) when is_list(Config) -> ?line bad_info(<<1,2>>), ok. +t_fun_info_mfa(Config) when is_list(Config) -> + Fun1 = fun spawn_call/2, + {module,M1} = erlang:fun_info(Fun1, module), + {name,F1} = erlang:fun_info(Fun1, name), + {arity,A1} = erlang:fun_info(Fun1, arity), + {M1,F1,A1=2} = erlang:fun_info_mfa(Fun1), + %% Module fun. + Fun2 = fun ?MODULE:t_fun_info/1, + {module,M2} = erlang:fun_info(Fun2, module), + {name,F2} = erlang:fun_info(Fun2, name), + {arity,A2} = erlang:fun_info(Fun2, arity), + {M2,F2,A2=1} = erlang:fun_info_mfa(Fun2), + + %% Not fun. + {'EXIT',_} = (catch erlang:fun_info_mfa(id(d))), + ok. + + bad_info(Term) -> try erlang:fun_info(Term, module) of Any -> diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index 2e9b4aeab1..14e6585220 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -38,7 +38,8 @@ is_checks/1, get_length/1, make_atom/1, make_string/1, reverse_list_test/1, otp_9828/1, - otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1 + otp_9668/1, consume_timeslice/1, dirty_nif/1, dirty_nif_send/1, + dirty_nif_exception/1, nif_schedule/1 ]). -export([many_args_100/100]). @@ -66,7 +67,8 @@ all() -> send_threaded, neg, is_checks, get_length, make_atom, make_string,reverse_list_test, otp_9828, - otp_9668, consume_timeslice, dirty_nif, dirty_nif_send + otp_9668, consume_timeslice, + nif_schedule, dirty_nif, dirty_nif_send, dirty_nif_exception ]. groups() -> @@ -1540,6 +1542,20 @@ consume_timeslice(Config) when is_list(Config) -> ok. +nif_schedule(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + A = "this is a string", + B = {this,is,a,tuple}, + {B,A} = call_nif_schedule(A, B), + ok = try call_nif_schedule(1, 2) + catch + error:badarg -> + [{?MODULE,call_nif_schedule,[1,2],_}|_] = + erlang:get_stacktrace(), + ok + end, + ok. + dirty_nif(Config) when is_list(Config) -> try erlang:system_info(dirty_cpu_schedulers) of N when is_integer(N) -> @@ -1572,6 +1588,24 @@ dirty_nif_send(Config) when is_list(Config) -> {skipped,"No dirty scheduler support"} end. +dirty_nif_exception(Config) when is_list(Config) -> + try erlang:system_info(dirty_cpu_schedulers) of + N when is_integer(N) -> + ensure_lib_loaded(Config), + try + call_dirty_nif_exception(), + ?t:fail(expected_badarg) + catch + error:badarg -> + [{?MODULE,call_dirty_nif_exception,[],_}|_] = + erlang:get_stacktrace(), + ok + end + catch + error:badarg -> + {skipped,"No dirty scheduler support"} + end. + next_msg(_Pid) -> receive M -> M @@ -1702,8 +1736,10 @@ type_sizes() -> ?nif_stub. otp_9668_nif(_) -> ?nif_stub. otp_9828_nif(_) -> ?nif_stub. consume_timeslice_nif(_,_) -> ?nif_stub. +call_nif_schedule(_,_) -> ?nif_stub. call_dirty_nif(_,_,_) -> ?nif_stub. send_from_dirty_nif(_) -> ?nif_stub. +call_dirty_nif_exception() -> ?nif_stub. %% maps is_map_nif(_) -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 25e20f3e7d..ff5fb8c5af 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1513,6 +1513,31 @@ static ERL_NIF_TERM consume_timeslice_nif(ErlNifEnv* env, int argc, const ERL_NI } } +static ERL_NIF_TERM nif_sched2(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + char s[64]; + if (!enif_get_string(env, argv[2], s, sizeof s, ERL_NIF_LATIN1)) + return enif_make_badarg(env); + return enif_make_tuple2(env, argv[3], argv[2]); +} + +static ERL_NIF_TERM nif_sched1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM new_argv[4]; + new_argv[0] = enif_make_atom(env, "garbage0"); + new_argv[1] = enif_make_atom(env, "garbage1"); + new_argv[2] = argv[0]; + new_argv[3] = argv[1]; + return enif_schedule_nif(env, "nif_sched2", 0, nif_sched2, 4, new_argv); +} + +static ERL_NIF_TERM call_nif_schedule(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + if (argc != 2) + return enif_make_atom(env, "false"); + return enif_schedule_nif(env, "nif_sched1", 0, nif_sched1, argc, argv); +} + #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT static ERL_NIF_TERM dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { @@ -1527,11 +1552,10 @@ static ERL_NIF_TERM dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ enif_get_int(env, argv[0], &n); enif_get_string(env, argv[1], s, sizeof s, ERL_NIF_LATIN1); enif_inspect_binary(env, argv[2], &b); - result = enif_make_tuple3(env, - enif_make_int(env, n), - enif_make_string(env, s, ERL_NIF_LATIN1), - enif_make_binary(env, &b)); - return enif_schedule_dirty_nif_finalizer(env, result, enif_dirty_nif_finalizer); + return enif_make_tuple3(env, + enif_make_int(env, n), + enif_make_string(env, s, ERL_NIF_LATIN1), + enif_make_binary(env, &b)); } static ERL_NIF_TERM call_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) @@ -1546,7 +1570,7 @@ static ERL_NIF_TERM call_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM if (enif_get_int(env, argv[0], &n) && enif_get_string(env, argv[1], s, sizeof s, ERL_NIF_LATIN1) && enif_inspect_binary(env, argv[2], &b)) - return enif_schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_nif, argc, argv); + return enif_schedule_nif(env, "call_dirty_nif", ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_nif, argc, argv); else return enif_make_badarg(env); } else { @@ -1554,35 +1578,42 @@ static ERL_NIF_TERM call_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM } } -static ERL_NIF_TERM dirty_sender(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { ERL_NIF_TERM result; ErlNifPid pid; ErlNifEnv* menv; int res; - enif_get_local_pid(env, argv[0], &pid); + if (!enif_get_local_pid(env, argv[0], &pid)) + return enif_make_badarg(env); result = enif_make_tuple2(env, enif_make_atom(env, "ok"), enif_make_pid(env, &pid)); menv = enif_alloc_env(); res = enif_send(env, &pid, menv, result); enif_free_env(menv); if (!res) - /* Note the next line will crash, since dirty nifs can't return exceptions. - * This is intentional, since enif_send should not fail if the test succeeds. - */ - return enif_schedule_dirty_nif_finalizer(env, enif_make_badarg(env), enif_dirty_nif_finalizer); + return enif_make_badarg(env); else - return enif_schedule_dirty_nif_finalizer(env, result, enif_dirty_nif_finalizer); + return result; } -static ERL_NIF_TERM send_from_dirty_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +static ERL_NIF_TERM call_dirty_nif_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) { - ERL_NIF_TERM result; - ErlNifPid pid; - - if (!enif_get_local_pid(env, argv[0], &pid)) + switch (argc) { + case 0: { + ERL_NIF_TERM args[255]; + int i; + for (i = 0; i < 255; i++) + args[i] = enif_make_int(env, i); + return enif_schedule_nif(env, "call_dirty_nif_exception", ERL_NIF_DIRTY_JOB_CPU_BOUND, + call_dirty_nif_exception, 255, argv); + } + case 1: return enif_make_badarg(env); - return enif_schedule_dirty_nif(env, ERL_NIF_DIRTY_JOB_CPU_BOUND, dirty_sender, argc, argv); + default: + return enif_schedule_nif(env, "call_dirty_nif_exception", ERL_NIF_DIRTY_JOB_CPU_BOUND, + call_dirty_nif_exception, argc-1, argv); + } } #endif @@ -1763,9 +1794,11 @@ static ErlNifFunc nif_funcs[] = {"otp_9668_nif", 1, otp_9668_nif}, {"otp_9828_nif", 1, otp_9828_nif}, {"consume_timeslice_nif", 2, consume_timeslice_nif}, + {"call_nif_schedule", 2, call_nif_schedule}, #ifdef ERL_NIF_DIRTY_SCHEDULER_SUPPORT {"call_dirty_nif", 3, call_dirty_nif}, - {"send_from_dirty_nif", 1, send_from_dirty_nif}, + {"send_from_dirty_nif", 1, send_from_dirty_nif, ERL_NIF_DIRTY_JOB_CPU_BOUND}, + {"call_dirty_nif_exception", 0, call_dirty_nif_exception, ERL_NIF_DIRTY_JOB_IO_BOUND}, #endif {"is_map_nif", 1, is_map_nif}, {"get_map_size_nif", 1, get_map_size_nif}, diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c index 3cfa7a782f..9630e0cdf0 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -498,7 +498,11 @@ static void dbg_gen_printf(int onsyslog,int perr,int from_level, #ifdef HAVE_SYSLOG_H if (onsyslog) { - erts_vsnprintf(buf, DEBUG_BUFFER_SIZE, format, args); + int len; + len = erts_vsnprintf(buf, DEBUG_BUFFER_SIZE, format, args); + if (perr != 0 && len < sizeof(buf)) { + erts_snprintf(buf+len, sizeof(buf)-len, ": %s", strerror(perr)); + } syslog(LOG_ERR,"epmd: %s",buf); } #endif diff --git a/erts/etc/common/run_erl_common.c b/erts/etc/common/run_erl_common.c index dc55c2bea4..580b6cc3c5 100644 --- a/erts/etc/common/run_erl_common.c +++ b/erts/etc/common/run_erl_common.c @@ -74,15 +74,6 @@ * run_erl multiple times with different global variables without them * effecting eachother. */ -typedef struct run_erl_ run_erl; - -#ifdef __OSE__ -static OSPPDKEY run_erl_pp_key; -#define RE_DATA (*(run_erl**)ose_get_ppdata(run_erl_pp_key)) -#else -static run_erl re; -#define RE_DATA (&re) -#endif #define STATUSFILE (RE_DATA->statusfile) #define LOG_DIR (RE_DATA->log_dir) @@ -116,6 +107,16 @@ struct run_erl_ { unsigned protocol_ver; }; +typedef struct run_erl_ run_erl; + +#ifdef __OSE__ +static OSPPDKEY run_erl_pp_key; +#define RE_DATA (*(run_erl**)ose_get_ppdata(run_erl_pp_key)) +#else +static run_erl re; +#define RE_DATA (&re) +#endif + /* prototypes */ static int next_log(int log_num); diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c index a6fc4c2bf5..4b123b8911 100644 --- a/erts/etc/unix/run_erl.c +++ b/erts/etc/unix/run_erl.c @@ -40,9 +40,13 @@ #ifdef HAVE_CONFIG_H # include "config.h" #endif + #ifdef HAVE_WORKING_POSIX_OPENPT +#ifndef _XOPEN_SOURCE #define _XOPEN_SOURCE 600 #endif +#endif + #include <sys/types.h> #include <sys/wait.h> #include <sys/stat.h> diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 260badbcb3..cf3effc1e5 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam Binary files differindex 93e70cd623..8420052533 100644 --- a/erts/preloaded/ebin/prim_inet.beam +++ b/erts/preloaded/ebin/prim_inet.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 4ff0513321..98d7a942a6 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -91,7 +91,7 @@ -export([external_size/2, finish_after_on_load/2, finish_loading/1, float/1]). -export([float_to_binary/1, float_to_binary/2, float_to_list/1, float_to_list/2]). --export([fun_info/2, fun_to_list/1, function_exported/3]). +-export([fun_info/2, fun_info_mfa/1, fun_to_list/1, function_exported/3]). -export([garbage_collect/0, garbage_collect/1, garbage_collect/2]). -export([garbage_collect_message_area/0, get/0, get/1, get_keys/1]). -export([get_module_info/1, get_stacktrace/0, group_leader/0]). @@ -827,6 +827,15 @@ float_to_list(_Float, _Options) -> fun_info(_Fun, _Item) -> erlang:nif_error(undefined). +%% fun_info_mfa/1 +-spec erlang:fun_info_mfa(Fun) -> {Mod, Name, Arity} when + Fun :: function(), + Mod :: atom(), + Name :: atom(), + Arity :: non_neg_integer(). +fun_info_mfa(_Fun) -> + erlang:nif_error(undefined). + %% fun_to_list/1 -spec erlang:fun_to_list(Fun) -> string() when Fun :: function(). diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl index 143c718130..79ff013c77 100644 --- a/erts/preloaded/src/prim_inet.erl +++ b/erts/preloaded/src/prim_inet.erl @@ -25,7 +25,7 @@ %% Primitive inet_drv interface --export([open/3, open/4, fdopen/4, close/1]). +-export([open/3, open/4, fdopen/4, fdopen/5, close/1]). -export([bind/3, listen/1, listen/2, peeloff/2]). -export([connect/3, connect/4, async_connect/4]). -export([accept/1, accept/2, async_accept/2]). @@ -70,7 +70,12 @@ open(Protocol, Family, Type, Opts) -> open(Protocol, Family, Type, Opts, ?INET_REQ_OPEN, []). fdopen(Protocol, Family, Type, Fd) when is_integer(Fd) -> - open(Protocol, Family, Type, [], ?INET_REQ_FDOPEN, ?int32(Fd)). + fdopen(Protocol, Family, Type, Fd, true). + +fdopen(Protocol, Family, Type, Fd, Bound) + when is_integer(Fd), Bound == true orelse Bound == false -> + open(Protocol, Family, Type, [], ?INET_REQ_FDOPEN, + [?int32(Fd), enc_value_2(bool, Bound)]). open(Protocol, Family, Type, Opts, Req, Data) -> Drv = protocol2drv(Protocol), diff --git a/lib/asn1/doc/src/asn1_ug.xml b/lib/asn1/doc/src/asn1_ug.xml index 020e58c615..8b33497dd3 100644 --- a/lib/asn1/doc/src/asn1_ug.xml +++ b/lib/asn1/doc/src/asn1_ug.xml @@ -1390,7 +1390,7 @@ GENERAL-PROCEDURES GENERAL-PROCEDURE ::= { instance, if a Type is used in a definition with certain purpose, one want the type-name to express the intention. This can be done with parameterization.</p> - <p>When many types (or an other ASN.1 entity) only differs in some + <p>When many types (or another ASN.1 entity) only differs in some minor cases, but the structure of the types are similar, only one general type can be defined and the differences may be supplied through parameters. </p> diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile index 99161ce68a..57233a7f6c 100644 --- a/lib/common_test/doc/src/Makefile +++ b/lib/common_test/doc/src/Makefile @@ -47,6 +47,7 @@ CT_MODULES = \ ct_snmp \ unix_telnet \ ct_slave \ + ct_property_test \ ct_netconfc CT_XML_FILES = $(CT_MODULES:=.xml) diff --git a/lib/common_test/doc/src/ref_man.xml b/lib/common_test/doc/src/ref_man.xml index 2f5c892e60..c266b70d00 100644 --- a/lib/common_test/doc/src/ref_man.xml +++ b/lib/common_test/doc/src/ref_man.xml @@ -78,6 +78,7 @@ <xi:include href="unix_telnet.xml"/> <xi:include href="ct_slave.xml"/> <xi:include href="ct_hooks.xml"/> + <xi:include href="ct_property_test.xml"/> </application> diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index e28751fb59..580d5dbd7b 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -1,7 +1,7 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2012. All Rights Reserved. +%% Copyright Ericsson AB 2009-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -64,7 +64,7 @@ {applications, [kernel,stdlib]}, {env, []}, {runtime_dependencies,["xmerl-1.3.7","webtool-0.8.10","tools-2.6.14", - "test_server-3.7","stdlib-2.0","ssh-3.0.1", + "test_server-3.7.1","stdlib-2.0","ssh-3.0.1", "snmp-4.25.1","sasl-2.4","runtime_tools-1.8.14", "kernel-3.0","inets-5.10","erts-6.0", "debugger-4.0","crypto-3.3","compiler-5.0"]}]}. diff --git a/lib/common_test/src/ct_property_test.erl b/lib/common_test/src/ct_property_test.erl new file mode 100644 index 0000000000..e401fef669 --- /dev/null +++ b/lib/common_test/src/ct_property_test.erl @@ -0,0 +1,178 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +%%% @doc EXPERIMENTAL support in common-test for calling property based tests. +%%% +%%% <p>This module is a first step towards running Property Based testing in the +%%% Common Test framework. A property testing tool like QuickCheck or PropEr is +%%% assumed to be installed.</p> +%%% +%%% <p>The idea is to have a common_test testsuite calling a property testing +%%% tool with special property test suites as defined by that tool. In this manual +%%% we assume the usual Erlang Application directory structure. The tests are +%%% collected in the application's <c>test</c> directory. The test directory +%%% has a sub-directory called <c>property_test</c> where everything needed for +%%% the property tests are collected.</p> +%%% +%%% <p>A typical ct test suite using <c>ct_property_test</c> is organized as follows: +%%% </p> +%%% ``` +%%% -include_lib("common_test/include/ct.hrl"). +%%% +%%% all() -> [prop_ftp_case]. +%%% +%%% init_per_suite(Config) -> +%%% ct_property_test:init_per_suite(Config). +%%% +%%% %%%---- test case +%%% prop_ftp_case(Config) -> +%%% ct_property_test:quickcheck( +%%% ftp_simple_client_server:prop_ftp(Config), +%%% Config +%%% ). +%%% ''' +%%% +%%% <warning> +%%% This is experimental code which may be changed or removed +%%% anytime without any warning. +%%% </warning> +%%% +%%% @end + +-module(ct_property_test). + +%% API +-export([init_per_suite/1, + quickcheck/2]). + +-include_lib("common_test/include/ct.hrl"). + +%%%----------------------------------------------------------------- +%%% @spec init_per_suite(Config) -> Config | {skip,Reason} +%%% +%%% @doc Initializes Config for property testing. +%%% +%%% <p>The function investigates if support is available for either Quickcheck or PropEr. +%%% The options <c>{property_dir,AbsPath}</c> and +%%% <c>{property_test_tool,Tool}</c> is set in the Config returned.</p> +%%% <p>The function is intended to be called in the init_per_suite in the test suite.</p> +%%% <p>The property tests are assumed to be in the subdirectory <c>property_test</c>.</p> +%%% @end + +init_per_suite(Config) -> + case which_module_exists([eqc,proper]) of + {ok,ToolModule} -> + ct:pal("Found property tester ~p",[ToolModule]), + Path = property_tests_path("property_test", Config), + case compile_tests(Path,ToolModule) of + error -> + {fail, "Property test compilation failed in "++Path}; + up_to_date -> + add_code_pathz(Path), + [{property_dir,Path}, + {property_test_tool,ToolModule} | Config] + end; + + not_found -> + ct:pal("No property tester found",[]), + {skip, "No property testing tool found"} + end. + +%%%----------------------------------------------------------------- +%%% @spec quickcheck(Property, Config) -> true | {fail,Reason} +%%% +%%% @doc Call quickcheck and return the result in a form suitable for common_test. +%%% +%%% <p>The function is intended to be called in the test cases in the test suite.</p> +%%% @end + +quickcheck(Property, Config) -> + Tool = proplists:get_value(property_test_tool,Config), + mk_ct_return( Tool:quickcheck(Property) ). + + +%%%================================================================ +%%% +%%% Local functions +%%% + +%%% Make return values back to the calling Common Test suite +mk_ct_return(true) -> + true; +mk_ct_return(Other) -> + try lists:last(hd(eqc:counterexample())) + of + {set,{var,_},{call,M,F,Args}} -> + {fail, io_lib:format("~p:~p/~p returned bad result",[M,F,length(Args)])} + catch + _:_ -> + {fail, Other} + end. + +%%% Check if a property testing tool is found +which_module_exists([Module|Modules]) -> + case module_exists(Module) of + true -> {ok,Module}; + false -> which_module_exists(Modules) + end; +which_module_exists(_) -> + not_found. + +module_exists(Module) -> + is_list(catch Module:module_info()). + +%%% The path to the property tests +property_tests_path(Dir, Config) -> + DataDir = proplists:get_value(data_dir, Config), + filename:join(lists:droplast(filename:split(DataDir))++[Dir]). + +%%% Extend the code path with Dir if it not already present +add_code_pathz(Dir) -> + case lists:member(Dir, code:get_path()) of + true -> ok; + false -> code:add_pathz(Dir) + end. + +compile_tests(Path, ToolModule) -> + MacroDefs = macro_def(ToolModule), + {ok,Cwd} = file:get_cwd(), + ok = file:set_cwd(Path), + {ok,FileNames} = file:list_dir("."), + BeamFiles = [F || F<-FileNames, + filename:extension(F) == ".beam"], + [file:delete(F) || F<-BeamFiles], + ct:pal("Compiling in ~p:~n Deleted ~p~n MacroDefs=~p",[Path,BeamFiles,MacroDefs]), + Result = make:all([load|MacroDefs]), + file:set_cwd(Cwd), + Result. + + +macro_def(eqc) -> [{d, 'EQC'}]; +macro_def(proper) -> [{d, 'PROPER'}]. + diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index def8a6a6f4..00c0925b40 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.8.1 +COMMON_TEST_VSN = 1.8.2 diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index ce40213bad..82817a987a 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -2248,23 +2248,23 @@ letify(#c_var{name=Vname}=Var, Val, Body) -> %% opt_case_in_let(LetExpr) -> LetExpr' -opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) -> - opt_case_in_let_0(Vs, Arg, B, Let). +opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> + opt_case_in_let_0(Vs, Arg, B, Let, Sub). opt_case_in_let_0([#c_var{name=V}], Arg, - #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let) -> + #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) -> case opt_case_in_let_1(V, Arg, Cs) of impossible -> case is_simple_case_arg(Arg) andalso not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of true -> - expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new()); + expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub)); false -> Let end; Expr -> Expr end; -opt_case_in_let_0(_, _, _, Let) -> Let. +opt_case_in_let_0(_, _, _, Let, _) -> Let. opt_case_in_let_1(V, Arg, Cs) -> try @@ -2607,7 +2607,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body0, effect, Sub) -> expr(#c_seq{arg=Arg,body=Body}, effect, sub_new_preserve_types(Sub)); true -> Let = Let0#c_let{vars=Vs,arg=Arg,body=Body}, - opt_case_in_let_arg(opt_case_in_let(Let), effect, Sub) + opt_case_in_let_arg(opt_case_in_let(Let, Sub), effect, Sub) end end; opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> @@ -2630,7 +2630,7 @@ opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub)); {Vs,Arg,Body} -> opt_case_in_let_arg( - opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}), + opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}, Sub), value, Sub) end. diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 1d2dfc7b2d..f27fc1a842 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -20,8 +20,6 @@ -module(dialyzer_contracts). --compile(export_all). - -export([check_contract/2, check_contracts/4, contracts_without_fun/3, @@ -686,7 +684,7 @@ picky_contract_check(CSig0, Sig0, MFA, FileLine, Contract, RecDict, Acc) -> true -> Acc; false -> case extra_contract_warning(MFA, FileLine, Contract, - CSig, Sig, RecDict) of + CSig0, Sig0, RecDict) of no_warning -> Acc; {warning, Warning} -> [Warning|Acc] end @@ -752,7 +750,8 @@ is_remote_types_related(Contract, CSig, Sig, RecDict) -> t_from_forms_without_remote([{FType, []}], RecDict) -> Type0 = erl_types:t_from_form(FType, RecDict), - {ok, erl_types:subst_all_remote(Type0, erl_types:t_none())}; + Type1 = erl_types:subst_all_remote(Type0, erl_types:t_none()), + {ok, erl_types:subst_all_vars_to_any(Type1)}; t_from_forms_without_remote([{_FType, _Constrs}], _RecDict) -> %% 'When' constraints unsupported; diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 92aab68ad6..03005e689f 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -93,6 +93,8 @@ -define(TYPE_LIMIT, 3). +-define(BITS, 128). + -record(state, {callgraph :: dialyzer_callgraph:callgraph(), envs :: env_tab(), fun_tab :: fun_tab(), @@ -1610,10 +1612,18 @@ bind_bin_segs([Seg|Segs], BinType, Acc, Map, State) -> SizeVal = lists:max(List), Flags = cerl:concrete(cerl:bitstr_flags(Seg)), N = SizeVal * UnitVal, - case lists:member(signed, Flags) of - true -> t_from_range(-(1 bsl (N - 1)), 1 bsl (N - 1) - 1); - false -> t_from_range(0, 1 bsl N - 1) - end + case N >= ?BITS of + true -> + case lists:member(signed, Flags) of + true -> t_from_range(neg_inf, pos_inf); + false -> t_from_range(0, pos_inf) + end; + false -> + case lists:member(signed, Flags) of + true -> t_from_range(-(1 bsl (N - 1)), 1 bsl (N - 1) - 1); + false -> t_from_range(0, 1 bsl N - 1) + end + end end end, {Map2, [_]} = bind_pat_vars([Val], [ValConstr], [], Map1, State, false), diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug5.erl b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug5.erl new file mode 100644 index 0000000000..28d739de8e --- /dev/null +++ b/lib/dialyzer/test/opaque_SUITE_data/src/opaque/opaque_bug5.erl @@ -0,0 +1,10 @@ +%% Second arg of is_record call wasn't checked properly + +-module(opaque_bug5). + +-export([b/0]). + +b() -> + is_record(id({a}), id(a)). + +id(I) -> I. diff --git a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring new file mode 100644 index 0000000000..0ad6eee766 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring @@ -0,0 +1,3 @@ + +pretty_bitstring.erl:7: Function t/0 has no local return +pretty_bitstring.erl:8: The call binary:copy(#{#<1>(8, 1, 'integer', ['unsigned', 'big']), #<2>(8, 1, 'integer', ['unsigned', 'big']), #<3>(3, 1, 'integer', ['unsigned', 'big'])}#,2) breaks the contract (Subject,N) -> binary() when is_subtype(Subject,binary()), is_subtype(N,non_neg_integer()) diff --git a/lib/dialyzer/test/small_SUITE_data/src/limit.erl b/lib/dialyzer/test/small_SUITE_data/src/limit.erl new file mode 100644 index 0000000000..97ee585b77 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/limit.erl @@ -0,0 +1,20 @@ +%% Misc cases where Dialyzer would fail with system_limit or crash + +-module(limit). + +-export([tu/0, big/1, b2/0]). + +tu() -> + erlang:make_tuple(1 bsl 24, def, [{5,e},{1,a},{3,c}]). + +big(<<Int:1152921504606846976/unit:128,0,_/binary>>) -> {5,Int}. + +b2() -> + Maxbig = maxbig(), + _ = bnot Maxbig, + ok. + +maxbig() -> + %% We assume that the maximum arity is (1 bsl 19) - 1. + Ws = erlang:system_info(wordsize), + (((1 bsl ((16777184 * (Ws div 4))-1)) - 1) bsl 1) + 1. diff --git a/lib/dialyzer/test/small_SUITE_data/src/pretty_bitstring.erl b/lib/dialyzer/test/small_SUITE_data/src/pretty_bitstring.erl new file mode 100644 index 0000000000..3dbf5ab7a7 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/pretty_bitstring.erl @@ -0,0 +1,8 @@ +%% Prettyprint bitstrings. + +-module(pretty_bitstring). + +-export([t/0]). + +t() -> + binary:copy(<<1,2,3:3>>,2). diff --git a/lib/dialyzer/test/underspecs_SUITE_data/results/arr b/lib/dialyzer/test/underspecs_SUITE_data/results/arr new file mode 100644 index 0000000000..9497d12eec --- /dev/null +++ b/lib/dialyzer/test/underspecs_SUITE_data/results/arr @@ -0,0 +1,4 @@ + +arr.erl:14: Type specification arr:test2(array:array(T),non_neg_integer(),T) -> array:array(T) is a supertype of the success typing: arr:test2(array:array(_),pos_integer(),_) -> array:array(_) +arr.erl:24: Type specification arr:test4(array:array(T),non_neg_integer(),_) -> array:array(T) is a supertype of the success typing: arr:test4(array:array(_),pos_integer(),_) -> array:array(_) +arr.erl:29: Type specification arr:test5(array:array(T),non_neg_integer(),T) -> array:array(T) is a supertype of the success typing: arr:test5(array:array(_),non_neg_integer(),integer()) -> array:array(_) diff --git a/lib/dialyzer/test/underspecs_SUITE_data/src/arr.erl b/lib/dialyzer/test/underspecs_SUITE_data/src/arr.erl new file mode 100644 index 0000000000..3b265ccec2 --- /dev/null +++ b/lib/dialyzer/test/underspecs_SUITE_data/src/arr.erl @@ -0,0 +1,41 @@ +-module(arr). + +%% http://erlang.org/pipermail/erlang-questions/2014-August/080445.html + +-define(A, array). + +-export([test/3, test2/3, test3/3, test4/3, test5/3, test6/3]). + +-spec test(?A:array(T), non_neg_integer(), T) -> ?A:array(T). + +test(Array, N, Value) -> + ?A:set(N, Value, Array). + +-spec test2(?A:array(T), non_neg_integer(), T) -> ?A:array(T). + +test2(Array, N, Value) when N > 0 -> + ?A:set(N, Value, Array). + +-spec test3(?A:array(T), non_neg_integer(), _) -> ?A:array(T). + +test3(Array, N, Value) -> + ?A:set(N, Value, Array). + +-spec test4(?A:array(T), non_neg_integer(), _) -> ?A:array(T). + +test4(Array, N, Value) when N > 0 -> + ?A:set(N, Value, Array). + +-spec test5(?A:array(T), non_neg_integer(), T) -> ?A:array(T). + +test5(Array, N, Value) when is_integer(Value) -> + ?A:set(N, Value, Array). + +%% One would ideally want a warning also for test6(), but the current +%% analysis of parametrized opaque types is not strong enough to +%% discover this. +-spec test6(?A:array(integer()), non_neg_integer(), integer()) -> + ?A:array(any()). + +test6(Array, N, Value) -> + ?A:set(N, Value, Array). diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index e164ff060f..f4e78e8f3a 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -885,7 +885,7 @@ t_map(Es) -> ["#{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). t_map_field([K,V]) -> - [t_utype_elem(K) ++ " => " ++ t_utype_elem(V)]. + t_utype_elem(K) ++ [" => "] ++ t_utype_elem(V). t_record(E, Es) -> Name = ["#"] ++ t_type(get_elem(atom, Es)), @@ -1082,6 +1082,10 @@ ot_type([#xmlElement{name = nonempty_list, content = Es}]) -> ot_nonempty_list(Es); ot_type([#xmlElement{name = tuple, content = Es}]) -> ot_tuple(Es); +ot_type([#xmlElement{name = map, content = Es}]) -> + ot_map(Es); +ot_type([#xmlElement{name = map_field, content = Es}]) -> + ot_map_field(Es); ot_type([#xmlElement{name = 'fun', content = Es}]) -> ot_fun(Es); ot_type([#xmlElement{name = record, content = Es}]) -> @@ -1138,6 +1142,12 @@ ot_nonempty_list(Es) -> ot_tuple(Es) -> {type,0,tuple,[ot_utype_elem(E) || E <- Es]}. +ot_map(Es) -> + {type,0,map,[ot_utype_elem(E) || E <- Es]}. + +ot_map_field(Es) -> + {type,0,map_field_assoc,[ot_utype_elem(E) || E <- Es]}. + ot_fun(Es) -> Range = ot_utype(get_elem(type, Es)), Args = [ot_utype_elem(A) || A <- get_content(argtypes, Es)], diff --git a/lib/edoc/test/edoc_SUITE_data/map_module.erl b/lib/edoc/test/edoc_SUITE_data/map_module.erl index 94ee7e6f26..f242721637 100644 --- a/lib/edoc/test/edoc_SUITE_data/map_module.erl +++ b/lib/edoc/test/edoc_SUITE_data/map_module.erl @@ -1,6 +1,6 @@ -module(map_module). --export([foo1/1,foo2/3]). +-export([foo1/1,foo2/3,start_child/2]). %% @type wazzup() = integer() %% @type some_type() = map() @@ -25,3 +25,43 @@ foo1(#{ a:= 1, b := V}) -> V. Map :: #{ get => 'value', 'value' => binary()}) -> binary(). foo2(Type1, {a,#{ "a" := _}}, #{get := value, value := B}) when is_map(Type1) -> B. + +%% from supervisor 18.0 + +-type child() :: 'undefined' | pid(). +-type child_id() :: term(). +-type mfargs() :: {M :: module(), F :: atom(), A :: [term()] | undefined}. +-type modules() :: [module()] | 'dynamic'. +-type restart() :: 'permanent' | 'transient' | 'temporary'. +-type shutdown() :: 'brutal_kill' | timeout(). +-type worker() :: 'worker' | 'supervisor'. +-type sup_ref() :: (Name :: atom()) + | {Name :: atom(), Node :: node()} + | {'global', Name :: atom()} + | {'via', Module :: module(), Name :: any()} + | pid(). +-type child_spec() :: #{name => child_id(), % mandatory + start => mfargs(), % mandatory + restart => restart(), % optional + shutdown => shutdown(), % optional + type => worker(), % optional + modules => modules()} % optional + | {Id :: child_id(), + StartFunc :: mfargs(), + Restart :: restart(), + Shutdown :: shutdown(), + Type :: worker(), + Modules :: modules()}. + +-type startchild_err() :: 'already_present' + | {'already_started', Child :: child()} | term(). +-type startchild_ret() :: {'ok', Child :: child()} + | {'ok', Child :: child(), Info :: term()} + | {'error', startchild_err()}. + + +-spec start_child(SupRef, ChildSpec) -> startchild_ret() when + SupRef :: sup_ref(), + ChildSpec :: child_spec() | (List :: [term()]). +start_child(Supervisor, ChildSpec) -> + {Supervisor,ChildSpec}. diff --git a/lib/eldap/test/README b/lib/eldap/test/README index 8774db1504..ec774c1ae3 100644 --- a/lib/eldap/test/README +++ b/lib/eldap/test/README @@ -19,7 +19,7 @@ This will however not work, since slapd is guarded by apparmor that checks that To make a local extension of alowed operations: sudo emacs /etc/apparmor.d/local/usr.sbin.slapd -and, after the change (yes, at least on Ubuntu it is right to edit ../local/.. but run with an other file) : +and, after the change (yes, at least on Ubuntu it is right to edit ../local/.. but run with another file): sudo apparmor_parser -r /etc/apparmor.d/usr.sbin.slapd diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl index 886194598f..cbdbbbee80 100644 --- a/lib/erl_docgen/src/docgen_otp_specs.erl +++ b/lib/erl_docgen/src/docgen_otp_specs.erl @@ -388,8 +388,10 @@ t_type([#xmlElement{name = nonempty_list, content = Es}]) -> t_nonempty_list(Es); t_type([#xmlElement{name = tuple, content = Es}]) -> t_tuple(Es); -t_type([#xmlElement{name = map}]) -> - t_map(); +t_type([#xmlElement{name = map, content = Es}]) -> + t_map(Es); +t_type([#xmlElement{name = map_field, content = Es}]) -> + t_map_field(Es); t_type([#xmlElement{name = 'fun', content = Es}]) -> ["fun("] ++ t_fun(Es) ++ [")"]; t_type([E = #xmlElement{name = record, content = Es}]) -> @@ -432,8 +434,11 @@ t_nonempty_list(Es) -> t_tuple(Es) -> ["{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). -t_map() -> - ["map()"]. +t_map(Es) -> + ["#{"] ++ seq(fun t_utype_elem/1, Es, ["}"]). + +t_map_field([K,V]) -> + [t_utype_elem(K) ++ " => " ++ t_utype_elem(V)]. t_fun(Es) -> ["("] ++ seq(fun t_utype_elem/1, get_content(argtypes, Es), @@ -550,6 +555,10 @@ ot_type([#xmlElement{name = nonempty_list, content = Es}]) -> ot_nonempty_list(Es); ot_type([#xmlElement{name = tuple, content = Es}]) -> ot_tuple(Es); +ot_type([#xmlElement{name = map, content = Es}]) -> + ot_map(Es); +ot_type([#xmlElement{name = map_field, content = Es}]) -> + ot_map_field(Es); ot_type([#xmlElement{name = 'fun', content = Es}]) -> ot_fun(Es); ot_type([#xmlElement{name = record, content = Es}]) -> @@ -606,6 +615,12 @@ ot_nonempty_list(Es) -> ot_tuple(Es) -> {type,0,tuple,[ot_utype_elem(E) || E <- Es]}. +ot_map(Es) -> + {type,0,map,[ot_utype_elem(E) || E <- Es]}. + +ot_map_field(Es) -> + {type,0,map_field_assoc,[ot_utype_elem(E) || E <- Es]}. + ot_fun(Es) -> Range = ot_utype(get_elem(type, Es)), Args = [ot_utype_elem(A) || A <- get_content(argtypes, Es)], diff --git a/lib/erl_interface/configure.in b/lib/erl_interface/configure.in index d511f2e240..ef78f0f87b 100644 --- a/lib/erl_interface/configure.in +++ b/lib/erl_interface/configure.in @@ -311,6 +311,26 @@ else fi fi +dnl ---------------------------------------------------------------------- +dnl Enable -fsanitize= flags. +dnl ---------------------------------------------------------------------- + +m4_define(DEFAULT_SANITIZERS, [address,undefined]) +AC_ARG_ENABLE( + sanitizers, + AS_HELP_STRING( + [--enable-sanitizers@<:@=comma-separated list of sanitizers@:>@], + [Default=DEFAULT_SANITIZERS]), +[ +case "$enableval" in + no) sanitizers= ;; + yes) sanitizers="-fsanitize=DEFAULT_SANITIZERS" ;; + *) sanitizers="-fsanitize=$enableval" ;; +esac +CFLAGS="$CFLAGS $sanitizers" +LDFLAGS="$LDFLAGS $sanitizers" +]) + # --------------------------------------------------------------------------- # XXX # --------------------------------------------------------------------------- diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 2e8418d61e..45c000ef76 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -761,7 +761,7 @@ int ei_close_connection(int fd) #endif /* - * Accept and initiate a connection from an other + * Accept and initiate a connection from another * Erlang node. Return a file descriptor at success, * otherwise -1; */ diff --git a/lib/erl_interface/src/legacy/erl_connect.c b/lib/erl_interface/src/legacy/erl_connect.c index ae0265a388..d70d914b79 100644 --- a/lib/erl_interface/src/legacy/erl_connect.c +++ b/lib/erl_interface/src/legacy/erl_connect.c @@ -190,7 +190,7 @@ int erl_close_connection(int fd) } /* - * Accept and initiate a connection from an other + * Accept and initiate a connection from another * Erlang node. Return a file descriptor at success, * otherwise -1; */ diff --git a/lib/eunit/src/eunit_data.erl b/lib/eunit/src/eunit_data.erl index 0350f9bf6e..cbbc6fbc15 100644 --- a/lib/eunit/src/eunit_data.erl +++ b/lib/eunit/src/eunit_data.erl @@ -440,13 +440,8 @@ parse_function({M, F}) when is_atom(M), is_atom(F) -> parse_function(F) -> bad_test(F). -check_arity(F, N, T) when is_function(F) -> - case erlang:fun_info(F, arity) of - {arity, N} -> - ok; - _ -> - bad_test(T) - end; +check_arity(F, N, _) when is_function(F, N) -> + ok; check_arity(_, _, T) -> bad_test(T). diff --git a/lib/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl index 9a3873f46d..f4a67439d6 100644 --- a/lib/hipe/cerl/cerl_prettypr.erl +++ b/lib/hipe/cerl/cerl_prettypr.erl @@ -1,7 +1,7 @@ %% ===================================================================== %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -476,13 +476,20 @@ lay_literal(Node, Ctxt) -> %% that could represent printable characters - we %% always print an integer. text(int_lit(Node)); - V when is_binary(V) -> - lay_binary(c_binary([c_bitstr(abstract(B), - abstract(8), + V when is_bitstring(V) -> + Val = fun(I) when is_integer(I) -> I; + (B) when is_bitstring(B) -> + BZ = bit_size(B), <<BV:BZ>> = B, BV + end, + Sz = fun(I) when is_integer(I) -> 8; + (B) when is_bitstring(B) -> bit_size(B) + end, + lay_binary(c_binary([c_bitstr(abstract(Val(B)), + abstract(Sz(B)), abstract(1), abstract(integer), abstract([unsigned, big])) - || B <- binary_to_list(V)]), + || B <- bitstring_to_list(V)]), Ctxt); [] -> text("[]"); diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index a460f16272..74e93bf098 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1891,7 +1891,11 @@ infinity_add(neg_inf, _Number) -> neg_inf; infinity_add(_Number, pos_inf) -> pos_inf; infinity_add(_Number, neg_inf) -> neg_inf; infinity_add(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> - Number1 + Number2. + try Number1 + Number2 + catch + error:system_limit when Number1 < 0 -> neg_inf; + error:system_limit -> pos_inf + end. infinity_mult(neg_inf, Number) -> Greater = infinity_geq(Number, 0), @@ -1902,7 +1906,13 @@ infinity_mult(pos_inf, Number) -> infinity_inv(infinity_mult(neg_inf, Number)); infinity_mult(Number, pos_inf) -> infinity_inv(infinity_mult(neg_inf, Number)); infinity_mult(Number, neg_inf) -> infinity_mult(neg_inf, Number); infinity_mult(Number1, Number2) when is_integer(Number1), is_integer(Number2)-> - Number1 * Number2. + try Number1 * Number2 + catch + error:system_limit -> + if (Number1 >= 0) =:= (Number2 >= 0) -> pos_inf; + true -> neg_inf + end + end. width({Min, Max}) -> infinity_max([width(Min), width(Max)]); width(pos_inf) -> pos_inf; @@ -2633,7 +2643,9 @@ opaque_args(M, F, A, Xs, Opaques) -> true -> case t_tuple_subtypes(X, Opaques) of unknown -> false; - List when length(List) >= 1 -> opaque_recargs(List, Y, Opaques) + List when length(List) >= 1 -> + (t_is_atom(Y, Opaques) andalso + opaque_recargs(List, Y, Opaques)) end; false -> t_has_opaque_subtype(X, Opaques) end]; diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 0927c17b6b..4b2bec5fa8 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -262,6 +262,8 @@ -define(TAG_IMMED1_SIZE, 4). -define(BITS, (erlang:system_info(wordsize) * 8) - ?TAG_IMMED1_SIZE). +-define(MAX_TUPLE_SIZE, (1 bsl 10)). + %%----------------------------------------------------------------------------- %% Type tags and qualifiers %% @@ -1770,6 +1772,8 @@ t_tuple() -> -spec t_tuple(non_neg_integer() | [erl_type()]) -> erl_type(). +t_tuple(N) when is_integer(N), N > ?MAX_TUPLE_SIZE -> + t_tuple(); t_tuple(N) when is_integer(N) -> ?tuple(lists:duplicate(N, ?any), N, ?any); t_tuple(List) -> diff --git a/lib/ic/c_src/oe_ei_encode_pid.c b/lib/ic/c_src/oe_ei_encode_pid.c index b7083f84a0..609f441cf8 100644 --- a/lib/ic/c_src/oe_ei_encode_pid.c +++ b/lib/ic/c_src/oe_ei_encode_pid.c @@ -23,7 +23,7 @@ int oe_ei_encode_pid(CORBA_Environment *ev, const erlang_pid *p) { int size = ev->_iout; - (int) ei_encode_pid(NULL, &size, p); + ei_encode_pid(NULL, &size, p); if (size >= ev->_outbufsz) { char *buf = ev->_outbuf; diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 37eb7ba718..06cb035370 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -332,7 +332,7 @@ filename() = string() <p>Defaults to <c>true</c>. </p> </item> - <tag><c><![CDATA[header_as_is]]></c></tag> + <tag><c><![CDATA[headers_as_is]]></c></tag> <item> <p>Shall the headers provided by the user be made lower case or be regarded as case sensitive. </p> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 5ae6760f08..d152d9f0be 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -1793,7 +1793,7 @@ tls_tunnel_request(#request{headers = Headers, host_header(#http_request_h{host = Host}, _) -> Host; -%% Handles header_as_is +%% Handles headers_as_is host_header(_, URI) -> {ok, {_, _, Host, _, _, _}} = http_uri:parse(URI), Host. diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index b3c9cbc46a..9bea58cc9e 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -35,6 +35,7 @@ -include("http_internal.hrl"). -include("httpd_internal.hrl"). +-define(HANDSHAKE_TIMEOUT, 5000). -record(state, {mod, %% #mod{} manager, %% pid() status, %% accept | busy | blocked @@ -96,15 +97,13 @@ init([Manager, ConfigDB, AcceptTimeout]) -> {SocketType, Socket} = await_socket_ownership_transfer(AcceptTimeout), - TimeOut = httpd_util:lookup(ConfigDB, keep_alive_timeout, 150000), - Then = erlang:now(), + KeepAliveTimeOut = httpd_util:lookup(ConfigDB, keep_alive_timeout, 150000), - case http_transport:negotiate(SocketType, Socket, TimeOut) of + case http_transport:negotiate(SocketType, Socket, ?HANDSHAKE_TIMEOUT) of {error, _Error} -> exit(shutdown); %% Can be 'normal'. ok -> - NewTimeout = TimeOut - timer:now_diff(now(),Then) div 1000, - continue_init(Manager, ConfigDB, SocketType, Socket, NewTimeout) + continue_init(Manager, ConfigDB, SocketType, Socket, KeepAliveTimeOut) end. continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> diff --git a/lib/inets/test/ftp_property_test_SUITE.erl b/lib/inets/test/ftp_property_test_SUITE.erl new file mode 100644 index 0000000000..c7077421f4 --- /dev/null +++ b/lib/inets/test/ftp_property_test_SUITE.erl @@ -0,0 +1,52 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%%% Run like this: +%%% ct:run_test([{suite,"ftp_property_test_SUITE"}, {logdir,"/ldisk/OTP/LOG"}]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(ftp_property_test_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +all() -> [prop_ftp_case]. + + +init_per_suite(Config) -> + inets:start(), + ct_property_test:init_per_suite(Config). + + +%%%---- test case +prop_ftp_case(Config) -> + ct_property_test:quickcheck( + ftp_simple_client_server:prop_ftp(Config), + Config + ). diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 4be20d3a69..4010597657 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -39,6 +39,7 @@ -define(FAIL_EXPIRE_TIME,1). %% Seconds before successful auths timeout. -define(AUTH_TIMEOUT,5). +-define(URL_START, "http://"). %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- @@ -63,7 +64,9 @@ all() -> {group, http_htaccess}, {group, https_htaccess}, {group, http_security}, - {group, https_security} + {group, https_security}, + {group, http_reload}, + {group, https_reload} ]. groups() -> @@ -84,7 +87,18 @@ groups() -> {https_htaccess, [], [{group, htaccess}]}, {http_security, [], [{group, security}]}, {https_security, [], [{group, security}]}, + {http_reload, [], [{group, reload}]}, + {https_reload, [], [{group, reload}]}, {limit, [], [max_clients_1_1, max_clients_1_0, max_clients_0_9]}, + {reload, [], [non_disturbing_reconfiger_dies, + disturbing_reconfiger_dies, + non_disturbing_1_1, + non_disturbing_1_0, + non_disturbing_0_9, + disturbing_1_1, + disturbing_1_0, + disturbing_0_9 + ]}, {basic_auth, [], [basic_auth_1_1, basic_auth_1_0, basic_auth_0_9]}, {auth_api, [], [auth_api_1_1, auth_api_1_0, auth_api_0_9 ]}, @@ -134,8 +148,24 @@ init_per_suite(Config) -> inets_test_lib:del_dirs(ServerRoot), DocRoot = filename:join(ServerRoot, "htdocs"), setup_server_dirs(ServerRoot, DocRoot, DataDir), + {ok, Hostname0} = inet:gethostname(), + Inet = + case (catch ct:get_config(ipv6_hosts)) of + undefined -> + inet; + Hosts when is_list(Hosts) -> + case lists:member(list_to_atom(Hostname0), Hosts) of + true -> + inet6; + false -> + inet + end; + _ -> + inet + end, [{server_root, ServerRoot}, {doc_root, DocRoot}, + {ipfamily, Inet}, {node, node()}, {host, inets_test_lib:hostname()}, {address, getaddr()} | Config]. @@ -150,7 +180,8 @@ init_per_group(Group, Config0) when Group == https_basic; Group == https_auth_api; Group == https_auth_api_dets; Group == https_auth_api_mnesia; - Group == https_security + Group == https_security; + Group == https_reload -> init_ssl(Group, Config0); init_per_group(Group, Config0) when Group == http_basic; @@ -159,7 +190,8 @@ init_per_group(Group, Config0) when Group == http_basic; Group == http_auth_api; Group == http_auth_api_dets; Group == http_auth_api_mnesia; - Group == http_security + Group == http_security; + Group == http_reload -> ok = start_apps(Group), init_httpd(Group, [{type, ip_comm} | Config0]); @@ -202,17 +234,19 @@ end_per_group(Group, _Config) when Group == http_basic; Group == http_auth_api_dets; Group == http_auth_api_mnesia; Group == http_htaccess; - Group == http_security + Group == http_security; + Group == http_reload -> inets:stop(); end_per_group(Group, _Config) when Group == https_basic; Group == https_limit; Group == https_basic_auth; Group == https_auth_api; - Group == http_auth_api_dets; - Group == http_auth_api_mnesia; + Group == https_auth_api_dets; + Group == https_auth_api_mnesia; Group == https_htaccess; - Group == http_security + Group == https_security; + Group == https_reload -> ssl:stop(), inets:stop(); @@ -506,7 +540,7 @@ ipv6(Config) when is_list(Config) -> true -> Version = ?config(http_version, Config), Host = ?config(host, Config), - URI = http_request("GET /", Version, Host), + URI = http_request("GET / ", Version, Host), httpd_test_lib:verify_request(?config(type, Config), Host, ?config(port, Config), [inet6], ?config(code, Config), @@ -1088,12 +1122,114 @@ security(Config) -> [{statuscode, 401}]), true = unblock_user(Node, "two", Port, OpenDir). + +%%------------------------------------------------------------------------- +non_disturbing_reconfiger_dies(Config) when is_list(Config) -> + do_reconfiger_dies([{http_version, "HTTP/1.1"} | Config], non_disturbing). +disturbing_reconfiger_dies(Config) when is_list(Config) -> + do_reconfiger_dies([{http_version, "HTTP/1.1"} | Config], disturbing). + +do_reconfiger_dies(Config, DisturbingType) -> + Server = ?config(server_pid, Config), + Version = ?config(http_version, Config), + Host = ?config(host, Config), + Port = ?config(port, Config), + Type = ?config(type, Config), + + HttpdConfig = httpd:info(Server), + BlockRequest = http_request("GET /eval?httpd_example:delay(2000) ", Version, Host), + {ok, Socket} = inets_test_lib:connect_bin(Type, Host, Port, transport_opts(Type, Config)), + inets_test_lib:send(Type, Socket, BlockRequest), + ct:sleep(100), %% Avoid possible timing issues + Pid = spawn(fun() -> httpd:reload_config([{server_name, "httpd_kill_" ++ Version}, + {port, Port}| + proplists:delete(server_name, HttpdConfig)], DisturbingType) + end), + monitor(process, Pid), + exit(Pid, kill), + receive + {'DOWN', _, _, _, _} -> + ok + end, + inets_test_lib:close(Type, Socket), + [{server_name, "httpd_test"}] = httpd:info(Server, [server_name]). +%%------------------------------------------------------------------------- +disturbing_1_1(Config) when is_list(Config) -> + disturbing([{http_version, "HTTP/1.1"} | Config]). + +disturbing_1_0(Config) when is_list(Config) -> + disturbing([{http_version, "HTTP/1.0"} | Config]). + +disturbing_0_9(Config) when is_list(Config) -> + disturbing([{http_version, "HTTP/0.9"} | Config]). + +disturbing(Config) when is_list(Config)-> + Server = ?config(server_pid, Config), + Version = ?config(http_version, Config), + Host = ?config(host, Config), + Port = ?config(port, Config), + Type = ?config(type, Config), + HttpdConfig = httpd:info(Server), + BlockRequest = http_request("GET /eval?httpd_example:delay(2000) ", Version, Host), + {ok, Socket} = inets_test_lib:connect_bin(Type, Host, Port, transport_opts(Type, Config)), + inets_test_lib:send(Type, Socket, BlockRequest), + ct:sleep(100), %% Avoid possible timing issues + ok = httpd:reload_config([{server_name, "httpd_disturbing_" ++ Version}, {port, Port}| + proplists:delete(server_name, HttpdConfig)], disturbing), + Close = list_to_atom((typestr(Type)) ++ "_closed"), + receive + {Close, Socket} -> + ok; + Msg -> + ct:fail({{expected, {Close, Socket}}, {got, Msg}}) + end, + inets_test_lib:close(Type, Socket), + [{server_name, "httpd_disturbing_" ++ Version}] = httpd:info(Server, [server_name]). +%%------------------------------------------------------------------------- +non_disturbing_1_1(Config) when is_list(Config) -> + non_disturbing([{http_version, "HTTP/1.1"} | Config]). + +non_disturbing_1_0(Config) when is_list(Config) -> + non_disturbing([{http_version, "HTTP/1.0"} | Config]). + +non_disturbing_0_9(Config) when is_list(Config) -> + non_disturbing([{http_version, "HTTP/0.9"} | Config]). + +non_disturbing(Config) when is_list(Config)-> + Server = ?config(server_pid, Config), + Version = ?config(http_version, Config), + Host = ?config(host, Config), + Port = ?config(port, Config), + Type = ?config(type, Config), + + HttpdConfig = httpd:info(Server), + BlockRequest = http_request("GET /eval?httpd_example:delay(2000) ", Version, Host), + {ok, Socket} = inets_test_lib:connect_bin(Type, Host, Port, transport_opts(Type, Config)), + inets_test_lib:send(Type, Socket, BlockRequest), + ct:sleep(100), %% Avoid possible timing issues + ok = httpd:reload_config([{server_name, "httpd_non_disturbing_" ++ Version}, {port, Port}| + proplists:delete(server_name, HttpdConfig)], non_disturbing), + Transport = type(Type), + receive + {Transport, Socket, Msg} -> + ct:pal("Received message ~p~n", [Msg]), + ok + after 2000 -> + ct:fail(timeout) + end, + inets_test_lib:close(Type, Socket), + [{server_name, "httpd_non_disturbing_" ++ Version}] = httpd:info(Server, [server_name]). %%-------------------------------------------------------------------- %% Internal functions ----------------------------------- %%-------------------------------------------------------------------- +url(http, End, Config) -> + Port = ?config(port, Config), + {ok,Host} = inet:gethostname(), + ?URL_START ++ Host ++ ":" ++ integer_to_list(Port) ++ End. + do_max_clients(Config) -> Version = ?config(http_version, Config), Host = ?config(host, Config), @@ -1171,7 +1307,9 @@ start_apps(Group) when Group == https_basic; Group == https_auth_api_dets; Group == https_auth_api_mnesia; Group == http_htaccess; - Group == http_security -> + Group == http_security; + Group == http_reload + -> inets_test_lib:start_apps([inets, asn1, crypto, public_key, ssl]); start_apps(Group) when Group == http_basic; Group == http_limit; @@ -1180,7 +1318,8 @@ start_apps(Group) when Group == http_basic; Group == http_auth_api_dets; Group == http_auth_api_mnesia; Group == https_htaccess; - Group == https_security -> + Group == https_security; + Group == https_reload-> inets_test_lib:start_apps([inets]). server_start(_, HttpdConfig) -> @@ -1224,6 +1363,10 @@ server_config(http_basic, Config) -> basic_conf() ++ server_config(http, Config); server_config(https_basic, Config) -> basic_conf() ++ server_config(https, Config); +server_config(http_reload, Config) -> + [{keep_alive_timeout, 2}] ++ server_config(http, Config); +server_config(https_reload, Config) -> + [{keep_alive_timeout, 2}] ++ server_config(https, Config); server_config(http_limit, Config) -> [{max_clients, 1}] ++ server_config(http, Config); server_config(https_limit, Config) -> @@ -1270,7 +1413,7 @@ server_config(http, Config) -> {server_root, ServerRoot}, {document_root, ?config(doc_root, Config)}, {bind_address, any}, - {ipfamily, inet}, + {ipfamily, ?config(ipfamily, Config)}, {max_header_size, 256}, {max_header_action, close}, {directory_index, ["index.html", "welcome.html"]}, @@ -1539,9 +1682,10 @@ cleanup_mnesia() -> transport_opts(ssl, Config) -> PrivDir = ?config(priv_dir, Config), - [{cacertfile, filename:join(PrivDir, "public_key_cacert.pem")}]; -transport_opts(_, _) -> - []. + [?config(ipfamily, Config), + {cacertfile, filename:join(PrivDir, "public_key_cacert.pem")}]; +transport_opts(_, Config) -> + [?config(ipfamily, Config)]. %%% mod_range @@ -1792,3 +1936,12 @@ event(What, Port, Dir, Data) -> global:send(mod_security_test, Msg) end. +type(ip_comm) -> + tcp; +type(_) -> + ssl. + +typestr(ip_comm) -> + "tcp"; +typestr(_) -> + "ssl". diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl index 1fcc5f257e..baef699629 100644 --- a/lib/inets/test/httpd_basic_SUITE.erl +++ b/lib/inets/test/httpd_basic_SUITE.erl @@ -129,7 +129,7 @@ end_per_suite(_Config) -> %% Note: This function is free to add any key/value pairs to the Config %% variable, but should NOT alter/remove any existing entries. %%-------------------------------------------------------------------- -init_per_testcase(Case, Config) -> +init_per_testcase(_Case, Config) -> Config. diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index 36a5bb9e71..647fa6f6c1 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -91,16 +91,7 @@ verify_request(SocketType, Host, Port, Node, RequestStr, Options, TimeOut) when (is_integer(TimeOut) orelse (TimeOut =:= infinity)) -> verify_request(SocketType, Host, Port, [], Node, RequestStr, Options, TimeOut). -verify_request(SocketType, Host, Port, TranspOpts0, Node, RequestStr, Options, TimeOut) -> - %% For now, until we modernize the httpd tests - TranspOpts = - case lists:member(inet6, TranspOpts0) of - true -> - TranspOpts0; - false -> - [inet | TranspOpts0] - end, - +verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, TimeOut) -> try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of {ok, Socket} -> ok = inets_test_lib:send(SocketType, Socket, RequestStr), diff --git a/lib/inets/test/old_httpd_SUITE.erl b/lib/inets/test/old_httpd_SUITE.erl index 19c2bc129e..74c11f71ba 100644 --- a/lib/inets/test/old_httpd_SUITE.erl +++ b/lib/inets/test/old_httpd_SUITE.erl @@ -186,20 +186,23 @@ groups() -> %% Only used through load_config %% but we still need these tests %% should be cleaned up and moved to new test suite - ip_restart_no_block, - ip_restart_disturbing_block, - ip_restart_non_disturbing_block, - ip_block_disturbing_idle, - ip_block_non_disturbing_idle, - ip_block_503, - ip_block_disturbing_active, - ip_block_non_disturbing_active, - ip_block_disturbing_active_timeout_not_released, - ip_block_disturbing_active_timeout_released, - ip_block_non_disturbing_active_timeout_not_released, - ip_block_non_disturbing_active_timeout_released, - ip_block_disturbing_blocker_dies, - ip_block_non_disturbing_blocker_dies + %%ip_restart_no_block, + %%ip_restart_disturbing_block, + %%ip_restart_non_disturbing_block, + %% Tested in inets_SUITE + %%ip_block_disturbing_idle, + %%ip_block_non_disturbing_idle, + ip_block_503 + %% Tested in new httpd_SUITE + %%ip_block_disturbing_active, + %%ip_block_non_disturbing_active, + %%ip_block_disturbing_blocker_dies, + %%ip_block_non_disturbing_blocker_dies + %% No longer relevant + %%ip_block_disturbing_active_timeout_not_released, + %%ip_block_disturbing_active_timeout_released, + %%ip_block_non_disturbing_active_timeout_not_released, + %%ip_block_non_disturbing_active_timeout_released, ]}, {ssl, [], [{group, essl}]}, {essl, [], diff --git a/lib/inets/test/property_test/README b/lib/inets/test/property_test/README new file mode 100644 index 0000000000..57602bf719 --- /dev/null +++ b/lib/inets/test/property_test/README @@ -0,0 +1,12 @@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +The test in this directory are written assuming that the user has a QuickCheck license. They are to be run manually. Some may be possible to be run with other tools, e.g. PropEr. + diff --git a/lib/inets/test/property_test/ftp_simple_client_server.erl b/lib/inets/test/property_test/ftp_simple_client_server.erl new file mode 100644 index 0000000000..40e630ee5c --- /dev/null +++ b/lib/inets/test/property_test/ftp_simple_client_server.erl @@ -0,0 +1,306 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ftp_simple_client_server). + +-compile(export_all). + +-ifndef(EQC). +-ifndef(PROPER). +-define(EQC,true). +%%-define(PROPER,true). +-endif. +-endif. + + +-ifdef(EQC). + +-include_lib("eqc/include/eqc.hrl"). +-include_lib("eqc/include/eqc_statem.hrl"). +-define(MOD_eqc, eqc). +-define(MOD_eqc_gen, eqc_gen). +-define(MOD_eqc_statem, eqc_statem). + +-else. +-ifdef(PROPER). + +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc, proper). +-define(MOD_eqc_gen, proper_gen). +-define(MOD_eqc_statem, proper_statem). + +-endif. +-endif. + +-record(state, { + initialized = false, + priv_dir, + data_dir, + servers = [], % [ {IP,Port,Userid,Pwd} ] + clients = [], % [ client_ref() ] + store = [] % [ {Name,Contents} ] + }). + +-define(fmt(F,A), io:format(F,A)). +%%-define(fmt(F,A), ok). + +-define(v(K,L), proplists:get_value(K,L)). + +%%%================================================================ +%%% +%%% Properties +%%% + +%% This function is for normal eqc calls: +prop_ftp() -> + {ok,PWD} = file:get_cwd(), + prop_ftp(filename:join([PWD,?MODULE_STRING++"_data"]), + filename:join([PWD,?MODULE_STRING,"_files"])). + +%% This function is for calls from common_test test cases: +prop_ftp(Config) -> + prop_ftp(filename:join([?v(property_dir,Config), ?MODULE_STRING++"_data"]), + ?v(priv_dir,Config) ). + + +prop_ftp(DataDir, PrivDir) -> + S0 = #state{data_dir = DataDir, + priv_dir = PrivDir}, + ?FORALL(Cmds, more_commands(10,commands(?MODULE,S0)), + aggregate(command_names(Cmds), + begin {_H,S,Result} = run_commands(?MODULE,Cmds), + % io:format('**** Result=~p~n',[Result]), + % io:format('**** S=~p~n',[S]), + % io:format('**** _H=~p~n',[_H]), + % io:format('**** Cmds=~p~n',[Cmds]), + [cmnd_stop_server(X) || X <- S#state.servers], + [inets:stop(ftpc,X) || {ok,X} <- S#state.clients], + Result==ok + end) + ). + +%%%================================================================ +%%% +%%% State model +%%% + +%% @doc Returns the state in which each test case starts. (Unless a different +%% initial state is supplied explicitly to, e.g. commands/2.) +-spec initial_state() ->?MOD_eqc_statem:symbolic_state(). +initial_state() -> + ?fmt("Initial_state()~n",[]), + #state{}. + +%% @doc Command generator, S is the current state +-spec command(S :: ?MOD_eqc_statem:symbolic_state()) -> ?MOD_eqc_gen:gen(eqc_statem:call()). + +command(#state{initialized=false, + priv_dir=PrivDir}) -> + {call,?MODULE,cmnd_init,[PrivDir]}; + +command(#state{servers=[], + priv_dir=PrivDir, + data_dir=DataDir}) -> + {call,?MODULE,cmnd_start_server,[PrivDir,DataDir]}; + +command(#state{servers=Ss=[_|_], + clients=[]}) -> + {call,?MODULE,cmnd_start_client,[oneof(Ss)]}; + +command(#state{servers=Ss=[_|_], + clients=Cs=[_|_], + store=Store=[_|_] + }) -> + frequency([ + { 5, {call,?MODULE,cmnd_start_client,[oneof(Ss)]}}, + { 5, {call,?MODULE,cmnd_stop_client,[oneof(Cs)]}}, + {10, {call,?MODULE,cmnd_put,[oneof(Cs),file_path(),file_contents()]}}, + {20, {call,?MODULE,cmnd_get,[oneof(Cs),oneof(Store)]}}, + {10, {call,?MODULE,cmnd_delete,[oneof(Cs),oneof(Store)]}} + ]); + +command(#state{servers=Ss=[_|_], + clients=Cs=[_|_], + store=[] + }) -> + frequency([ + {5, {call,?MODULE,cmnd_start_client,[oneof(Ss)]}}, + {5, {call,?MODULE,cmnd_stop_client,[oneof(Cs)]}}, + {10, {call,?MODULE,cmnd_put,[oneof(Cs),file_path(),file_contents()]}} + ]). + +%% @doc Precondition, checked before command is added to the command sequence. +-spec precondition(S :: ?MOD_eqc_statem:symbolic_state(), C :: ?MOD_eqc_statem:call()) -> boolean(). + +precondition(#state{clients=Cs}, {call, _, cmnd_put, [C,_,_]}) -> lists:member(C,Cs); + +precondition(#state{clients=Cs, store=Store}, + {call, _, cmnd_get, [C,X]}) -> lists:member(C,Cs) andalso lists:member(X,Store); + +precondition(#state{clients=Cs, store=Store}, + {call, _, cmnd_delete, [C,X]}) -> lists:member(C,Cs) andalso lists:member(X,Store); + +precondition(#state{servers=Ss}, {call, _, cmnd_start_client, _}) -> Ss =/= []; + +precondition(#state{clients=Cs}, {call, _, cmnd_stop_client, [C]}) -> lists:member(C,Cs); + +precondition(#state{initialized=IsInit}, {call, _, cmnd_init, _}) -> IsInit==false; + +precondition(_S, {call, _, _, _}) -> true. + + +%% @doc Postcondition, checked after command has been evaluated +%% Note: S is the state before next_state(S,_,C) +-spec postcondition(S :: ?MOD_eqc_statem:dynamic_state(), C :: ?MOD_eqc_statem:call(), + Res :: term()) -> boolean(). + +postcondition(_S, {call, _, cmnd_get, [_,{_Name,Expected}]}, {ok,Value}) -> + Value == Expected; + +postcondition(S, {call, _, cmnd_delete, [_,{Name,_Expected}]}, ok) -> + ?fmt("file:read_file(..) = ~p~n",[file:read_file(filename:join(S#state.priv_dir,Name))]), + {error,enoent} == file:read_file(filename:join(S#state.priv_dir,Name)); + +postcondition(S, {call, _, cmnd_put, [_,Name,Value]}, ok) -> + {ok,Bin} = file:read_file(filename:join(S#state.priv_dir,Name)), + Bin == unicode:characters_to_binary(Value); + +postcondition(_S, {call, _, cmnd_stop_client, _}, ok) -> true; + +postcondition(_S, {call, _, cmnd_start_client, _}, {ok,_}) -> true; + +postcondition(_S, {call, _, cmnd_init, _}, ok) -> true; + +postcondition(_S, {call, _, cmnd_start_server, _}, {ok,_}) -> true. + + +%% @doc Next state transformation, S is the current state. Returns next state. +-spec next_state(S :: ?MOD_eqc_statem:symbolic_state(), + V :: ?MOD_eqc_statem:var(), + C :: ?MOD_eqc_statem:call()) -> ?MOD_eqc_statem:symbolic_state(). + +next_state(S, _V, {call, _, cmnd_put, [_,Name,Val]}) -> + S#state{store = [{Name,Val} | lists:keydelete(Name,1,S#state.store)]}; + +next_state(S, _V, {call, _, cmnd_delete, [_,{Name,_Val}]}) -> + S#state{store = lists:keydelete(Name,1,S#state.store)}; + +next_state(S, V, {call, _, cmnd_start_client, _}) -> + S#state{clients = [V | S#state.clients]}; + +next_state(S, V, {call, _, cmnd_start_server, _}) -> + S#state{servers = [V | S#state.servers]}; + +next_state(S, _V, {call, _, cmnd_stop_client, [C]}) -> + S#state{clients = S#state.clients -- [C]}; + +next_state(S, _V, {call, _, cmnd_init, _}) -> + S#state{initialized=true}; + +next_state(S, _V, {call, _, _, _}) -> + S. + +%%%================================================================ +%%% +%%% Data model +%%% + +file_path() -> non_empty(list(alphanum_char())). +%%file_path() -> non_empty( list(oneof([alphanum_char(), utf8_char()])) ). + +%%file_contents() -> list(alphanum_char()). +file_contents() -> list(oneof([alphanum_char(), utf8_char()])). + +alphanum_char() -> oneof(lists:seq($a,$z) ++ lists:seq($A,$Z) ++ lists:seq($0,$9)). + +utf8_char() -> oneof("åäöÅÄÖ話话カタカナひらがな"). + +%%%================================================================ +%%% +%%% Commands doing something with the System Under Test +%%% + +cmnd_init(PrivDir) -> + ?fmt('Call cmnd_init(~p)~n',[PrivDir]), + os:cmd("killall vsftpd"), + clear_files(PrivDir), + ok. + +cmnd_start_server(PrivDir, DataDir) -> + ?fmt('Call cmnd_start_server(~p, ~p)~n',[PrivDir,DataDir]), + Cmnd = ["vsftpd ", filename:join(DataDir,"vsftpd.conf"), + " -oftpd_banner=erlang_otp_testing" + " -oanon_root=",PrivDir + ], + ?fmt("Cmnd=~s~n",[Cmnd]), + case os:cmd(Cmnd) of + [] -> + {ok,{"localhost",9999,"ftp","[email protected]"}}; + Other -> + {error,Other} + end. + +cmnd_stop_server({ok,{_Host,Port,_Usr,_Pwd}}) -> + os:cmd("kill `netstat -tpln | grep "++integer_to_list(Port)++" | awk '{print $7}' | awk -F/ '{print $1}'`"). + +cmnd_start_client({ok,{Host,Port,Usr,Pwd}}) -> + ?fmt('Call cmnd_start_client(~p)...',[{Host,Port,Usr,Pwd}]), + case inets:start(ftpc, [{host,Host},{port,Port}]) of + {ok,Client} -> + ?fmt("~p...",[{ok,Client}]), + case ftp:user(Client, Usr, Pwd) of + ok -> + ?fmt("OK!~n",[]), + {ok,Client}; + Other -> + ?fmt("Other1=~p~n",[Other]), + inets:stop(ftpc,Client), Other + end; + Other -> + ?fmt("Other2=~p~n",[Other]), + Other + end. + +cmnd_stop_client({ok,Client}) -> + ?fmt('Call cmnd_stop_client(~p)~n',[Client]), + inets:stop(ftpc, Client). %% -> ok | Other + +cmnd_delete({ok,Client}, {Name,_ExpectedValue}) -> + ?fmt('Call cmnd_delete(~p, ~p)~n',[Client,Name]), + R=ftp:delete(Client, Name), + ?fmt("R=~p~n",[R]), + R. + +cmnd_put({ok,Client}, Name, Value) -> + ?fmt('Call cmnd_put(~p, ~p, ~p)...',[Client, Name, Value]), + R = ftp:send_bin(Client, unicode:characters_to_binary(Value), Name), % ok | {error,Error} + ?fmt('~p~n',[R]), + R. + +cmnd_get({ok,Client}, {Name,_ExpectedValue}) -> + ?fmt('Call cmnd_get(~p, ~p)~n',[Client,Name]), + case ftp:recv_bin(Client, Name) of + {ok,Bin} -> {ok, unicode:characters_to_list(Bin)}; + Other -> Other + end. + + +clear_files(Dir) -> + os:cmd(["rm -fr ",filename:join(Dir,"*")]). diff --git a/lib/inets/test/property_test/ftp_simple_client_server_data/vsftpd.conf b/lib/inets/test/property_test/ftp_simple_client_server_data/vsftpd.conf new file mode 100644 index 0000000000..fd48e2abf0 --- /dev/null +++ b/lib/inets/test/property_test/ftp_simple_client_server_data/vsftpd.conf @@ -0,0 +1,26 @@ + +### +### Some parameters are given in the vsftpd start command. +### +### Typical command-line paramters are such that has a file path +### component like cert files. +### + + +listen=YES +listen_port=9999 +run_as_launching_user=YES +ssl_enable=NO +#allow_anon_ssl=YES + +background=YES + +write_enable=YES +anonymous_enable=YES +anon_upload_enable=YES +anon_mkdir_write_enable=YES +anon_other_write_enable=YES +anon_world_readable_only=NO + +### Shouldn't be necessary.... +require_ssl_reuse=NO diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 79081f371c..029f6ac4d2 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.10.2 +INETS_VSN = 5.10.3 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java index 9ba6a4a0ab..85d303689f 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/AbstractConnection.java @@ -266,7 +266,7 @@ public abstract class AbstractConnection extends Thread { * * @param dest * the Erlang PID of the remote process. - * @param msg + * @param payload * the encoded message to send. * * @exception java.io.IOException @@ -959,7 +959,9 @@ public abstract class AbstractConnection extends Thread { } catch (final Exception e) { final String nn = peer.node(); close(); - throw new IOException("Error accepting connection from " + nn); + IOException ioe = new IOException("Error accepting connection from " + nn); + ioe.initCause(e); + throw ioe; } if (traceLevel >= handshakeThreshold) { System.out.println("<- MD5 ACCEPTED " + peer.host()); @@ -990,7 +992,9 @@ public abstract class AbstractConnection extends Thread { throw ae; } catch (final Exception e) { close(); - throw new IOException("Cannot connect to peer node"); + IOException ioe = new IOException("Cannot connect to peer node"); + ioe.initCause(e); + throw ioe; } } diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpConnection.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpConnection.java index 8e8bd473c8..e7a9d1092c 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpConnection.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpConnection.java @@ -404,7 +404,7 @@ public class OtpConnection extends AbstractConnection { * * @param dest * the Erlang PID of the remote process. - * @param msg + * @param payload * the encoded message to send. * * @exception java.io.IOException diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangFun.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangFun.java index fc104e9564..c52909acc5 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangFun.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangFun.java @@ -94,7 +94,7 @@ public class OtpErlangFun extends OtpErlangObject implements Serializable { return false; } } else { - if (!md5.equals(f.md5)) { + if (!Arrays.equals(md5, f.md5)) { return false; } } @@ -104,7 +104,7 @@ public class OtpErlangFun extends OtpErlangObject implements Serializable { if (freeVars == null) { return f.freeVars == null; } - return freeVars.equals(f.freeVars); + return Arrays.equals(freeVars, f.freeVars); } @Override diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangLong.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangLong.java index 7e3e2a7296..84b1355c54 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangLong.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangLong.java @@ -51,8 +51,8 @@ public class OtpErlangLong extends OtpErlangObject implements Serializable, /** * Create an Erlang integer from the given value. * - * @param val - * the long value to use. + * @param v + * the big integer value to use. */ public OtpErlangLong(final BigInteger v) { if (v == null) { diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java index 03c18e55a2..0254edd5da 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangMap.java @@ -58,15 +58,23 @@ public class OtpErlangMap extends OtpErlangObject implements Serializable, /** * Create a map from an array of terms. * - * @param elems + * @param keys * the array of terms to create the map from. - * @param start - * the offset of the first term to insert. + * @param kstart + * the offset of the first key to insert. + * @param kcount + * the number of keys to insert. + * @param values + * the array of values to create the map from. + * @param vstart + * the offset of the first value to insert. * @param vcount - * the number of terms to insert. + * the number of values to insert. * * @exception java.lang.IllegalArgumentException * if any array is empty (null) or contains null elements. + * @exception java.lang.IllegalArgumentException + * if kcount and vcount differ. */ public OtpErlangMap(final OtpErlangObject[] keys, final int kstart, final int kcount, final OtpErlangObject[] values, final int vstart, diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java index fe81ce302d..f75e4353d0 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java @@ -162,7 +162,7 @@ public class OtpErlangPid extends OtpErlangObject implements Serializable, * Determine if two PIDs are equal. PIDs are equal if their components are * equal. * - * @param port + * @param o * the other PID to compare to. * * @return true if the PIDs are equal, false otherwise. diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java index 6766b52ce5..a5e202c473 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangString.java @@ -41,8 +41,6 @@ public class OtpErlangString extends OtpErlangObject implements Serializable, /** * Create an Erlang string from a list of integers. - * - * @return an Erlang string with Unicode code units. * * @throws OtpErlangException * for non-proper and non-integer lists. diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java index 0d1342d796..f813594541 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java @@ -21,6 +21,7 @@ package com.ericsson.otp.erlang; import java.io.ByteArrayInputStream; import java.io.IOException; import java.math.BigDecimal; +import java.util.Arrays; /** * Provides a stream for decoding Erlang terms from external format. @@ -819,7 +820,7 @@ public class OtpInputStream extends ByteArrayInputStream { if (unsigned) { if (c < 0) { throw new OtpErlangDecodeException("Value not unsigned: " - + b); + + Arrays.toString(b)); } while (b[i] == 0) { i++; // Skip leading zero sign bytes @@ -844,7 +845,7 @@ public class OtpInputStream extends ByteArrayInputStream { if (b.length - i > 8) { // More than 64 bits of value throw new OtpErlangDecodeException( - "Value does not fit in long: " + b); + "Value does not fit in long: " + Arrays.toString(b)); } // Convert the necessary bytes for (v = c < 0 ? -1 : 0; i < b.length; i++) { diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java index 0fd93b09f4..4a4a1e7f8f 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java @@ -69,6 +69,7 @@ package com.ericsson.otp.erlang; * notify other parties in a timely manner. * </p> * + * <p> * When retrieving messages from a mailbox that has received an exit signal, an * {@link OtpErlangExit OtpErlangExit} exception will be raised. Note that the * exception is queued in the mailbox along with other messages, and will not be @@ -420,7 +421,6 @@ public class OtpMbox { /** * Equivalent to <code>exit(new OtpErlangAtom(reason))</code>. - * </p> * * @see #exit(OtpErlangObject) */ diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMsg.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMsg.java index 6f507bf4bb..31a5d0fb8f 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMsg.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMsg.java @@ -30,14 +30,14 @@ package com.ericsson.otp.erlang; * </p> * * <p> - * The header information that is available is as follows: <lu> + * The header information that is available is as follows: <ul> * <li> a tag indicating the type of message * <li> the intended recipient of the message, either as a * {@link OtpErlangPid pid} or as a String, but never both. * <li> (sometimes) the sender of the message. Due to some eccentric * characteristics of the Erlang distribution protocol, not all messages have * information about the sending process. In particular, only messages whose tag - * is {@link OtpMsg#regSendTag regSendTag} contain sender information. </lu> + * is {@link OtpMsg#regSendTag regSendTag} contain sender information. </ul> * * <p> * Message are sent using the Erlang external format (see separate diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java index a78423db44..c98790bbd4 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java @@ -202,7 +202,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { /** * Write an array of bytes to the stream. * - * @param buf + * @param bytes * the array of bytes to write. * */ @@ -637,7 +637,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { * Write a positive short to the stream. The short is interpreted as a two's * complement unsigned short even if it is negative. * - * @param s + * @param us * the short to use. */ public void write_ushort(final short us) { diff --git a/lib/jinterface/test/jinterface_SUITE.erl b/lib/jinterface/test/jinterface_SUITE.erl index cb725164cd..00abc97ff5 100644 --- a/lib/jinterface/test/jinterface_SUITE.erl +++ b/lib/jinterface/test/jinterface_SUITE.erl @@ -38,7 +38,8 @@ java_exit_with_reason_any_term/1, status_handler_localStatus/1, status_handler_remoteStatus/1, status_handler_connAttempt/1, - maps/1 + maps/1, + fun_equals/1 ]). -include_lib("common_test/include/ct.hrl"). @@ -106,7 +107,8 @@ fundamental() -> register_and_whereis, % RegisterAndWhereis.java get_names, % GetNames.java boolean_atom, % BooleanAtom.java - maps % Maps.java + maps, % Maps.java + fun_equals % FunEquals.java ]. ping() -> @@ -691,6 +693,18 @@ maps(Config) when is_list(Config) -> []). %%%----------------------------------------------------------------- +fun_equals(doc) -> + ["FunEquals.java: " + "Test OtpErlangFun.equals()"]; +fun_equals(suite) -> + []; +fun_equals(Config) when is_list(Config) -> + ok = jitu:java(?config(java, Config), + ?config(data_dir, Config), + "FunEquals", + []). + +%%%----------------------------------------------------------------- %%% INTERNAL FUNCTIONS %%%----------------------------------------------------------------- send_receive(TestCaseTag,Fun,Config) -> diff --git a/lib/jinterface/test/jinterface_SUITE_data/FunEquals.java b/lib/jinterface/test/jinterface_SUITE_data/FunEquals.java new file mode 100644 index 0000000000..14f884cee7 --- /dev/null +++ b/lib/jinterface/test/jinterface_SUITE_data/FunEquals.java @@ -0,0 +1,71 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2010. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +import java.util.Arrays; + +import com.ericsson.otp.erlang.*; + +public class FunEquals { + + /* + Implements test case jinterface_SUITE:fun_equals/1 + + Test the function OtpErlangFun.equals() + */ + + public static void main(String argv[]) { + + OtpErlangPid pid = new OtpErlangPid("here", 4, 5, 0); + String module = "mod"; + int arity = 2; + byte[] md5 = new byte[]{3,5,7}; + int index = 2; + long old_index = 1; + long uniq= 2; + OtpErlangObject[] freeVars = new OtpErlangObject[]{ + new OtpErlangAtom("hej"), new OtpErlangLong(9) + }; + + OtpErlangFun f1 = new OtpErlangFun(pid, module, arity, md5, + index, old_index, uniq, freeVars); + OtpErlangFun f2 = new OtpErlangFun(pid, module, arity, copyArray(md5), + index, old_index, uniq, copyArray(freeVars)); + + if(!f1.equals(f2)) + fail(1); + + } + + private static void fail(int reason) { + System.exit(reason); + } + + private static byte[] copyArray(byte[] source) { + byte[] result = new byte[source.length]; + System.arraycopy(source, 0, result, 0, source.length); + return result; + } + + private static OtpErlangObject[] copyArray(OtpErlangObject[] source) { + OtpErlangObject[] result = new OtpErlangObject[source.length]; + System.arraycopy(source, 0, result, 0, source.length); + return result; + } + +} diff --git a/lib/jinterface/test/jinterface_SUITE_data/Makefile.src b/lib/jinterface/test/jinterface_SUITE_data/Makefile.src index a15ed1aa63..cd68f1ead5 100644 --- a/lib/jinterface/test/jinterface_SUITE_data/Makefile.src +++ b/lib/jinterface/test/jinterface_SUITE_data/Makefile.src @@ -47,7 +47,8 @@ JAVA_FILES = \ MboxSendReceive.java \ MboxLinkUnlink.java \ NodeStatusHandler.java \ - Maps.java + Maps.java \ + FunEquals.java CLASS_FILES = $(JAVA_FILES:.java=.class) diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml index dbd0d3c815..820ecd1e30 100644 --- a/lib/kernel/doc/src/gen_tcp.xml +++ b/lib/kernel/doc/src/gen_tcp.xml @@ -112,7 +112,12 @@ do_recv(Sock, Bs) -> <item> <p>If a socket has somehow been connected without using <c>gen_tcp</c>, use this option to pass the file - descriptor for it.</p> + descriptor for it. If <c>{ip, ip_address()}</c> + and/or <c>{port, port_number()}</c> is combined with + this option the fd will be bound to the given interface + and port before connecting. If these options are not given + it is assumed that the fd is already bound appropriately. + </p> </item> <tag><c>inet</c></tag> diff --git a/lib/kernel/doc/src/gen_udp.xml b/lib/kernel/doc/src/gen_udp.xml index 503725fe18..291d1b0da7 100644 --- a/lib/kernel/doc/src/gen_udp.xml +++ b/lib/kernel/doc/src/gen_udp.xml @@ -84,7 +84,12 @@ <item> <p>If a socket has somehow been opened without using <c>gen_udp</c>, use this option to pass the file - descriptor for it.</p> + descriptor for it. If <c><anno>Port</anno></c> is not set to 0 + and/or <c>{ip, ip_address()}</c> is combined with this option + the fd will be bound to the given interface and port after being + opened. If these options are not given it is assumed that the fd + is already bound appropriately. + </p> </item> <tag><c>inet6</c></tag> <item> diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml index 35889f9d11..f92770603a 100644 --- a/lib/kernel/doc/src/notes.xml +++ b/lib/kernel/doc/src/notes.xml @@ -151,7 +151,6 @@ </list> </section> - <section><title>Improvements and New Features</title> <list> <item> @@ -295,7 +294,26 @@ </item> </list> </section> +</section> +<section><title>Kernel 2.16.4.1</title> + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + When using gen_tcp:connect and the <c>fd</c> option with + <c>port</c> and/or <c>ip</c>, the <c>port</c> and + <c>ip</c> options were ignored. This has been fixed so + that if <c>port</c> and/or <c>ip</c> is specified + together with <c>fd</c> a bind is requested for that + <c>fd</c>. If <c>port</c> and/or <c>ip</c> is not + specified bind will not be called.</p> + <p> + Own Id: OTP-12061</p> + </item> + </list> + </section> </section> <section><title>Kernel 2.16.4</title> diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl index b4fae24ef3..f6e2ca0954 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -85,24 +85,19 @@ port_please1(Node,HostName, Timeout) -> Else end. -names() -> +names() -> {ok, H} = inet:gethostname(), names(H). -names(HostName) when is_atom(HostName) -> - names1(atom_to_list(HostName)); -names(HostName) when is_list(HostName) -> - names1(HostName); -names(EpmdAddr) -> - get_names(EpmdAddr). - -names1(HostName) -> +names(HostName) when is_atom(HostName); is_list(HostName) -> case inet:gethostbyname(HostName) of {ok,{hostent, _Name, _ , _Af, _Size, [EpmdAddr | _]}} -> get_names(EpmdAddr); Else -> Else - end. + end; +names(EpmdAddr) -> + get_names(EpmdAddr). register_node(Name, PortNo) -> diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index 41d422d7d4..d17da2d329 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -1257,9 +1257,9 @@ open(FdO, Addr, Port, Opts, Protocol, Family, Type, Module) Error -> Error end; -open(Fd, _Addr, _Port, Opts, Protocol, Family, Type, Module) +open(Fd, Addr, Port, Opts, Protocol, Family, Type, Module) when is_integer(Fd) -> - fdopen(Fd, Opts, Protocol, Family, Type, Module). + fdopen(Fd, Addr, Port, Opts, Protocol, Family, Type, Module). bindx(S, [Addr], Port0) -> {IP, Port} = set_bindx_port(Addr, Port0), @@ -1298,12 +1298,35 @@ change_bindx_0_port({_IP, _Port}=Addr, _AssignedPort) -> {'ok', socket()} | {'error', posix()}. fdopen(Fd, Opts, Protocol, Family, Type, Module) -> - case prim_inet:fdopen(Protocol, Family, Type, Fd) of + fdopen(Fd, any, 0, Opts, Protocol, Family, Type, Module). + +fdopen(Fd, Addr, Port, Opts, Protocol, Family, Type, Module) -> + IsAnyAddr = (Addr == {0,0,0,0} orelse Addr == {0,0,0,0,0,0,0,0} + orelse Addr == any), + Bound = Port == 0 andalso IsAnyAddr, + case prim_inet:fdopen(Protocol, Family, Type, Fd, Bound) of {ok, S} -> case prim_inet:setopts(S, Opts) of ok -> - inet_db:register_socket(S, Module), - {ok, S}; + case if + Bound -> + %% We do not do any binding if default + %% port+addr options where given in order + %% to keep backwards compatability with + %% pre Erlang/TOP 17 + {ok, ok}; + is_list(Addr) -> + bindx(S, Addr, Port); + true -> + prim_inet:bind(S, Addr, Port) + end of + {ok, _} -> + inet_db:register_socket(S, Module), + {ok, S}; + Error -> + prim_inet:close(S), + Error + end; Error -> prim_inet:close(S), Error end; diff --git a/lib/kernel/src/net_adm.erl b/lib/kernel/src/net_adm.erl index 3f5eac7822..2cdfb76417 100644 --- a/lib/kernel/src/net_adm.erl +++ b/lib/kernel/src/net_adm.erl @@ -89,18 +89,13 @@ names() -> -spec names(Host) -> {ok, [{Name, Port}]} | {error, Reason} when - Host :: atom() | string(), + Host :: atom() | string() | inet:ip_address(), Name :: string(), Port :: non_neg_integer(), Reason :: address | file:posix(). names(Hostname) -> - case inet:gethostbyname(Hostname) of - {ok, {hostent, _Name, _ , _Af, _Size, [Addr | _]}} -> - erl_epmd:names(Addr); - Else -> - Else - end. + erl_epmd:names(Hostname). -spec dns_hostname(Host) -> {ok, Name} | {error, Host} when Host :: atom() | string(), diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl index a7af00c12a..c27d265550 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE.erl +++ b/lib/kernel/test/gen_tcp_api_SUITE.erl @@ -32,14 +32,16 @@ t_connect_bad/1, t_recv_timeout/1, t_recv_eof/1, t_shutdown_write/1, t_shutdown_both/1, t_shutdown_error/1, - t_fdopen/1, t_implicit_inet6/1]). + t_fdopen/1, t_fdconnect/1, t_implicit_inet6/1]). + +-export([getsockfd/0,closesockfd/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [{group, t_accept}, {group, t_connect}, {group, t_recv}, t_shutdown_write, t_shutdown_both, t_shutdown_error, - t_fdopen, t_implicit_inet6]. + t_fdopen, t_fdconnect, t_implicit_inet6]. groups() -> [{t_accept, [], [t_accept_timeout]}, @@ -185,6 +187,37 @@ t_fdopen(Config) when is_list(Config) -> ?line ok = gen_tcp:close(L), ok. +t_fdconnect(Config) when is_list(Config) -> + Question = "Aaaa... Long time ago in a small town in Germany,", + Question1 = list_to_binary(Question), + Question2 = [<<"Aaaa">>, "... ", $L, <<>>, $o, "ng time ago ", + ["in ", [], <<"a small town">>, [" in Germany,", <<>>]]], + Question1 = iolist_to_binary(Question2), + Answer = "there was a shoemaker, Schumacher was his name.", + Path = ?config(data_dir, Config), + Lib = "gen_tcp_api_SUITE", + ok = erlang:load_nif(filename:join(Path,Lib), []), + {ok, L} = gen_tcp:listen(0, [{active, false}]), + {ok, Port} = inet:port(L), + FD = gen_tcp_api_SUITE:getsockfd(), + {ok, Client} = gen_tcp:connect(localhost, Port, [{fd,FD},{port,20002}, + {active,false}]), + {ok, Server} = gen_tcp:accept(L), + ok = gen_tcp:send(Client, Question), + {ok, Question} = gen_tcp:recv(Server, length(Question), 2000), + ok = gen_tcp:send(Client, Question1), + {ok, Question} = gen_tcp:recv(Server, length(Question), 2000), + ok = gen_tcp:send(Client, Question2), + {ok, Question} = gen_tcp:recv(Server, length(Question), 2000), + ok = gen_tcp:send(Server, Answer), + {ok, Answer} = gen_tcp:recv(Client, length(Answer), 2000), + ok = gen_tcp:close(Client), + FD = gen_tcp_api_SUITE:closesockfd(FD), + {error,closed} = gen_tcp:recv(Server, 1, 2000), + ok = gen_tcp:close(Server), + ok = gen_tcp:close(L), + ok. + %%% implicit inet6 option to api functions @@ -300,3 +333,7 @@ unused_ip(A, B, C, D) -> end. ok({ok,V}) -> V. + + +getsockfd() -> undefined. +closesockfd(_FD) -> undefined. diff --git a/lib/kernel/test/gen_tcp_api_SUITE_data/Makefile.src b/lib/kernel/test/gen_tcp_api_SUITE_data/Makefile.src new file mode 100644 index 0000000000..5477598160 --- /dev/null +++ b/lib/kernel/test/gen_tcp_api_SUITE_data/Makefile.src @@ -0,0 +1,9 @@ + +NIF_LIBS = gen_tcp_api_SUITE@dll@ +SHLIB_EXTRA_LDLIBS = @LIBS@ + +all: $(NIF_LIBS) + +@SHLIB_RULES@ + +$(NIF_LIBS): gen_tcp_api_SUITE.c diff --git a/lib/kernel/test/gen_tcp_api_SUITE_data/gen_tcp_api_SUITE.c b/lib/kernel/test/gen_tcp_api_SUITE_data/gen_tcp_api_SUITE.c new file mode 100644 index 0000000000..73a6568b30 --- /dev/null +++ b/lib/kernel/test/gen_tcp_api_SUITE_data/gen_tcp_api_SUITE.c @@ -0,0 +1,60 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009-2013. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#include "erl_nif.h" + +#include <stdio.h> +#include <string.h> +#include <assert.h> +#include <limits.h> +#include <sys/types.h> + +#ifdef __WIN32__ +#include <winsock2.h> +#else +#include <sys/socket.h> +#endif + +#define sock_open(af, type, proto) socket((af), (type), (proto)) + +static ERL_NIF_TERM getsockfd(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int fd; + + fd = sock_open(AF_INET, SOCK_STREAM, 0); + return enif_make_int(env, fd); +} + +static ERL_NIF_TERM closesockfd(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + int fd; + + enif_get_int(env, argv[0], &fd); + + close(fd); + + return enif_make_int(env, fd); +} + +static ErlNifFunc nif_funcs[] = +{ + {"getsockfd", 0, getsockfd}, + {"closesockfd", 1, closesockfd} +}; + +ERL_NIF_INIT(gen_tcp_api_SUITE,nif_funcs,NULL,NULL,NULL,NULL) diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl index 2df4bf7c95..4e4aeb67e2 100644 --- a/lib/kernel/test/gen_tcp_misc_SUITE.erl +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -882,7 +882,7 @@ passive_sockets_server_send(Socket, X) -> accept_closed_by_other_process(doc) -> ["Tests the return value from gen_tcp:accept when ", - "the socket is closed from an other process. (OTP-3817)"]; + "the socket is closed from another process. (OTP-3817)"]; accept_closed_by_other_process(Config) when is_list(Config) -> ?line Parent = self(), ?line {ok, ListenSocket} = gen_tcp:listen(0, []), diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index 6bb41999c5..8177123332 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -447,8 +447,8 @@ open_fd(Config) when is_list(Config) -> {ok,S1} = gen_udp:open(0), {ok,P2} = inet:port(S1), {ok,FD} = prim_inet:getfd(S1), - {error,einval} = gen_udp:open(P2, [inet6, {fd,FD}]), - {ok,S2} = gen_udp:open(P2, [{fd,FD}]), + {error,einval} = gen_udp:open(0, [inet6, {fd,FD}]), + {ok,S2} = gen_udp:open(0, [{fd,FD}]), {ok,S3} = gen_udp:open(0), {ok,P3} = inet:port(S3), ok = gen_udp:send(S3, Addr, P2, Msg), diff --git a/lib/megaco/configure.in b/lib/megaco/configure.in index 64daa959b5..e3c24a58b8 100644 --- a/lib/megaco/configure.in +++ b/lib/megaco/configure.in @@ -167,6 +167,26 @@ if test "x$GCC" = xyes; then LM_TRY_ENABLE_CFLAG([-Werror=return-type], [CFLAGS]) fi +dnl ---------------------------------------------------------------------- +dnl Enable -fsanitize= flags. +dnl ---------------------------------------------------------------------- + +m4_define(DEFAULT_SANITIZERS, [address,undefined]) +AC_ARG_ENABLE( + sanitizers, + AS_HELP_STRING( + [--enable-sanitizers@<:@=comma-separated list of sanitizers@:>@], + [Default=DEFAULT_SANITIZERS]), +[ +case "$enableval" in + no) sanitizers= ;; + yes) sanitizers="-fsanitize=DEFAULT_SANITIZERS" ;; + *) sanitizers="-fsanitize=$enableval" ;; +esac +CFLAGS="$CFLAGS $sanitizers" +LDFLAGS="$LDFLAGS $sanitizers" +]) + dnl dnl If ${ERL_TOP}/make/otp_ded.mk.in exists and contains DED_MK_VSN > 0, dnl every thing releted to compiling Dynamic Erlang Drivers can be found diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index 08212dfede..df2c27afba 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -38,7 +38,23 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.12.1</title> + <section><title>Mnesia 4.12.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a race which could make create_table fail if a node + was going down during the transaction.</p> + <p> + Own Id: OTP-12124 Aux Id: seq12694 </p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.12.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index fe2fd67d71..5a9bae54da 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -300,8 +300,13 @@ mnesia_down(Node) -> end. wait_for_schema_commit_lock() -> - link(whereis(?SERVER_NAME)), - unsafe_call(wait_for_schema_commit_lock). + try + Pid = whereis(?SERVER_NAME), + link(Pid), %% Keep the link until release_schema_commit_lock + gen_server:call(Pid, wait_for_schema_commit_lock, infinity) + catch _:_ -> + mnesia:abort({node_not_running, node()}) + end. block_controller() -> call(block_controller). @@ -557,12 +562,6 @@ cast(Msg) -> abcast(Nodes, Msg) -> gen_server:abcast(Nodes, ?SERVER_NAME, Msg). -unsafe_call(Msg) -> - case whereis(?SERVER_NAME) of - undefined -> {error, {node_not_running, node()}}; - Pid -> gen_server:call(Pid, Msg, infinity) - end. - call(Msg) -> case whereis(?SERVER_NAME) of undefined -> diff --git a/lib/mnesia/src/mnesia_frag.erl b/lib/mnesia/src/mnesia_frag.erl index 4a1616e054..66fc20913c 100644 --- a/lib/mnesia/src/mnesia_frag.erl +++ b/lib/mnesia/src/mnesia_frag.erl @@ -939,7 +939,7 @@ do_split(_FH, _OldN, _FragNames, [], Ops) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Delete a fragment from a fragmented table -%% and merge its records with an other fragment +%% and merge its records with another fragment make_multi_del_frag(Tab) -> verify_multi(Tab), diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index 4afbea1cc2..530317bcdd 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -208,7 +208,8 @@ do_get_network_copy(Tab, Reason, Ns, Storage, Cs) -> set({Tab, load_node}, Node), set({Tab, load_reason}, Reason), mnesia_controller:i_have_tab(Tab), - dbg_out("Table ~p copied from ~p to ~p~n", [Tab, Node, node()]), + dbg_out("Table ~p copied from ~p to ~p (~b entries)~n", + [Tab, Node, node(), mnesia:table_info(Tab, size)]), {loaded, ok}; Err = {error, _} when element(1, Reason) == dumper -> {not_loaded,Err}; diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index 173c46898b..d16d501103 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.12.1 +MNESIA_VSN = 4.12.2 diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index 03ca1bf9c1..c86f5ea916 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -112,10 +112,6 @@ setup(#state{frame = Frame} = State) -> observer_lib:create_menus(DefMenus, MenuBar, default), wxFrame:setMenuBar(Frame, MenuBar), - StatusBar = wxStatusBar:new(Frame), - wxFrame:setStatusBar(Frame, StatusBar), - wxFrame:setTitle(Frame, atom_to_list(node())), - wxStatusBar:setStatusText(StatusBar, atom_to_list(node())), %% Setup panels Panel = wxPanel:new(Frame, []), @@ -131,6 +127,11 @@ setup(#state{frame = Frame} = State) -> wxSizer:add(MainSizer, Notebook, [{proportion, 1}, {flag, ?wxEXPAND}]), wxPanel:setSizer(Panel, MainSizer), + StatusBar = wxStatusBar:new(Frame), + wxFrame:setStatusBar(Frame, StatusBar), + wxFrame:setTitle(Frame, atom_to_list(node())), + wxStatusBar:setStatusText(StatusBar, atom_to_list(node())), + wxNotebook:connect(Notebook, command_notebook_page_changing), wxFrame:connect(Frame, close_window, [{skip, true}]), wxMenu:connect(Frame, command_menu_selected), diff --git a/lib/odbc/c_src/odbcserver.c b/lib/odbc/c_src/odbcserver.c index b4655ce373..84c201a656 100644 --- a/lib/odbc/c_src/odbcserver.c +++ b/lib/odbc/c_src/odbcserver.c @@ -389,6 +389,9 @@ DWORD WINAPI database_handler(const char *port) close_socket(socket); clean_socket_lib(); /* Exit will be done by suervisor thread */ +#ifdef WIN32 + return (DWORD)0; +#endif } /* Description: Calls the appropriate function to handle the database @@ -631,7 +634,7 @@ static db_result_msg db_query(byte *sql, db_state *state) &statement_handle(state)))) DO_EXIT(EXIT_ALLOC); - result = SQLExecDirect(statement_handle(state), sql, SQL_NTS); + result = SQLExecDirect(statement_handle(state), (SQLCHAR *)sql, SQL_NTS); /* SQL_SUCCESS_WITH_INFO at this point may indicate an error in user input. */ if (result != SQL_SUCCESS && result != SQL_NO_DATA_FOUND) { @@ -723,7 +726,7 @@ static db_result_msg db_select_count(byte *sql, db_state *state) (SQLPOINTER)SQL_SCROLLABLE, (SQLINTEGER)0); } - if(!sql_success(SQLExecDirect(statement_handle(state), sql, SQL_NTS))) { + if(!sql_success(SQLExecDirect(statement_handle(state), (SQLCHAR *)sql, SQL_NTS))) { diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); clean_state(state); return encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); @@ -864,7 +867,7 @@ static db_result_msg db_param_query(byte *buffer, db_state *state) if(params != NULL) { - result = SQLExecDirect(statement_handle(state), sql, SQL_NTS); + result = SQLExecDirect(statement_handle(state), (SQLCHAR *)sql, SQL_NTS); if (!sql_success(result) || result == SQL_NO_DATA) { diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); } @@ -955,7 +958,7 @@ static db_result_msg db_describe_table(byte *sql, db_state *state) &statement_handle(state)))) DO_EXIT(EXIT_ALLOC); - if (!sql_success(SQLPrepare(statement_handle(state), sql, SQL_NTS))){ + if (!sql_success(SQLPrepare(statement_handle(state), (SQLCHAR *)sql, SQL_NTS))){ diagnos = get_diagnos(SQL_HANDLE_STMT, statement_handle(state), extended_errors(state)); msg = encode_error_message(diagnos.error_msg, extended_error(state, diagnos.sqlState), diagnos.nativeError); clean_state(state); @@ -1324,7 +1327,7 @@ static db_result_msg encode_column_name_list(SQLSMALLINT num_of_columns, if (columns(state)[i].type.c == SQL_C_BINARY) { /* retrived later by retrive_binary_data */ - }else { + } else { if(!sql_success( SQLBindCol (statement_handle(state), @@ -1336,7 +1339,7 @@ static db_result_msg encode_column_name_list(SQLSMALLINT num_of_columns, DO_EXIT(EXIT_BIND); } ei_x_encode_string_len(&dynamic_buffer(state), - name, name_len); + (char *)name, name_len); } else { columns(state)[i].type.len = 0; @@ -2739,8 +2742,8 @@ static diagnos get_diagnos(SQLSMALLINT handleType, SQLHANDLE handle, Boolean ext the error message is obtained */ for(record_nr = 1; ;record_nr++) { result = SQLGetDiagRec(handleType, handle, record_nr, current_sql_state, - &nativeError, current_errmsg_pos, - (SQLSMALLINT)errmsg_buffer_size, &errmsg_size); + &nativeError, (SQLCHAR *)current_errmsg_pos, + (SQLSMALLINT)errmsg_buffer_size, &errmsg_size); if(result == SQL_SUCCESS) { /* update the sqlstate in the diagnos record, because the SQLGetDiagRec call succeeded */ diff --git a/lib/odbc/c_src/odbcserver.h b/lib/odbc/c_src/odbcserver.h index 916a7cb31d..7112fd2d47 100644 --- a/lib/odbc/c_src/odbcserver.h +++ b/lib/odbc/c_src/odbcserver.h @@ -119,7 +119,7 @@ /*------------------------ TYPDEFS ----------------------------------*/ -typedef unsigned char byte; +typedef char byte; typedef int Boolean; typedef struct { @@ -201,4 +201,4 @@ typedef enum { #define param_query(db_state) (db_state -> param_query) #define out_params(db_state) (db_state -> out_params) #define extended_errors(db_state) (db_state -> extended_errors) -#define extended_error(db_state, errorcode) ( extended_errors(state) ? errorcode : NULL ) +#define extended_error(db_state, errorcode) ( extended_errors(state) ? ((char *)errorcode) : NULL ) diff --git a/lib/odbc/configure.in b/lib/odbc/configure.in index f86146759c..ea5c51965f 100644 --- a/lib/odbc/configure.in +++ b/lib/odbc/configure.in @@ -228,4 +228,24 @@ if test "x$GCC" = xyes; then LM_TRY_ENABLE_CFLAG([-Werror=return-type], [CFLAGS]) fi +dnl ---------------------------------------------------------------------- +dnl Enable -fsanitize= flags. +dnl ---------------------------------------------------------------------- + +m4_define(DEFAULT_SANITIZERS, [address,undefined]) +AC_ARG_ENABLE( + sanitizers, + AS_HELP_STRING( + [--enable-sanitizers@<:@=comma-separated list of sanitizers@:>@], + [Default=DEFAULT_SANITIZERS]), +[ +case "$enableval" in + no) sanitizers= ;; + yes) sanitizers="-fsanitize=DEFAULT_SANITIZERS" ;; + *) sanitizers="-fsanitize=$enableval" ;; +esac +CFLAGS="$CFLAGS $sanitizers" +LDFLAGS="$LDFLAGS $sanitizers" +]) + AC_OUTPUT(c_src/$host/Makefile:c_src/Makefile.in) diff --git a/lib/odbc/doc/src/error_handling.xml b/lib/odbc/doc/src/error_handling.xml index b255865263..0b6179409d 100644 --- a/lib/odbc/doc/src/error_handling.xml +++ b/lib/odbc/doc/src/error_handling.xml @@ -88,7 +88,7 @@ <section> <title>The whole picture </title> <p>As the Erlang ODBC application relies on third party products - and communicates with a database that probably runs on an other + and communicates with a database that probably runs on another computer in the network there are plenty of things that might go wrong. To fully understand the things that might happen it facilitate to know the design of the Erlang ODBC application, diff --git a/lib/odbc/test/odbc_connect_SUITE.erl b/lib/odbc/test/odbc_connect_SUITE.erl index 2a16388929..1907069726 100644 --- a/lib/odbc/test/odbc_connect_SUITE.erl +++ b/lib/odbc/test/odbc_connect_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -47,7 +47,7 @@ all() -> case odbc_test_lib:odbc_check() of ok -> [not_exist_db, commit, rollback, not_explicit_commit, - no_c_node, port_dies, control_process_dies, + no_c_executable, port_dies, control_process_dies, {group, client_dies}, connect_timeout, timeout, many_timeouts, timeout_reset, disconnect_on_timeout, connection_closed, disable_scrollable_cursors, @@ -248,28 +248,31 @@ not_exist_db(_Config) -> test_server:sleep(100). %%------------------------------------------------------------------------- -no_c_node(doc) -> +no_c_executable(doc) -> "Test what happens if the port-program can not be found"; -no_c_node(suite) -> []; -no_c_node(_Config) -> +no_c_executable(suite) -> []; +no_c_executable(_Config) -> process_flag(trap_exit, true), Dir = filename:nativename(filename:join(code:priv_dir(odbc), "bin")), FileName1 = filename:nativename(os:find_executable("odbcserver", Dir)), FileName2 = filename:nativename(filename:join(Dir, "odbcsrv")), - ok = file:rename(FileName1, FileName2), - Result = - case catch odbc:connect(?RDBMS:connection_string(), - odbc_test_lib:platform_options()) of - {error, port_program_executable_not_found} -> - ok; - Else -> - Else - end, - - ok = file:rename(FileName2, FileName1), - ok = Result. + case file:rename(FileName1, FileName2) of + ok -> + Result = + case catch odbc:connect(?RDBMS:connection_string(), + odbc_test_lib:platform_options()) of + {error, port_program_executable_not_found} -> + ok; + Else -> + Else + end, + ok = file:rename(FileName2, FileName1), + ok = Result; + _ -> + {skip, "File permission issues"} + end. %%------------------------------------------------------------------------ port_dies(doc) -> diff --git a/lib/os_mon/doc/src/disksup.xml b/lib/os_mon/doc/src/disksup.xml index dbcfd65095..0e76178edb 100644 --- a/lib/os_mon/doc/src/disksup.xml +++ b/lib/os_mon/doc/src/disksup.xml @@ -73,6 +73,17 @@ much disk can be utilized before the <c>disk_almost_full</c> alarm is set. The default is 0.80 (80%).</p> </item> + <tag><c>disksup_posix_only = bool()</c></tag> + <item> + <p>Specifies whether the <c>disksup</c> helper process should only + use POSIX conformant commands (<c>true</c>) or not. The default is + <c>false</c>. Setting this parameter to <c>true</c> can be + necessary on embedded systems with stripped-down versions + of Unix tools like <c>df</c>. The returned disk data and alarms + can be different when using this option.</p> + <p>The parameter is ignored on platforms that are known to not be + posix compatible (Windows and SunOS).</p> + </item> </taglist> <p>See <seealso marker="kernel:config">config(4)</seealso> for information about how to change the value of configuration diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl index 278da26a20..af5bcc6fe8 100644 --- a/lib/os_mon/src/disksup.erl +++ b/lib/os_mon/src/disksup.erl @@ -81,10 +81,12 @@ param_type(disk_space_check_interval, Val) when is_integer(Val), param_type(disk_almost_full_threshold, Val) when is_number(Val), 0=<Val, Val=<1 -> true; +param_type(disksup_posix_only, Val) when Val==true; Val==false -> true; param_type(_Param, _Val) -> false. param_default(disk_space_check_interval) -> 30; -param_default(disk_almost_full_threshold) -> 0.80. +param_default(disk_almost_full_threshold) -> 0.80; +param_default(disksup_posix_only) -> false. %%---------------------------------------------------------------------- %% gen_server callbacks @@ -94,7 +96,8 @@ init([]) -> process_flag(trap_exit, true), process_flag(priority, low), - OS = get_os(), + PosixOnly = os_mon:get_env(disksup, disksup_posix_only), + OS = get_os(PosixOnly), Port = case OS of {unix, Flavor} when Flavor==sunos4; Flavor==solaris; @@ -102,6 +105,7 @@ init([]) -> Flavor==dragonfly; Flavor==darwin; Flavor==linux; + Flavor==posix; Flavor==openbsd; Flavor==netbsd; Flavor==irix64; @@ -205,14 +209,16 @@ format_status(_Opt, [_PDict, #state{os = OS, threshold = Threshold, %% Internal functions %%---------------------------------------------------------------------- -get_os() -> +get_os(PosixOnly) -> case os:type() of {unix, sunos} -> - case os:version() of + case os:version() of {5,_,_} -> {unix, solaris}; {4,_,_} -> {unix, sunos4}; V -> exit({unknown_os_version, V}) - end; + end; + {unix, _} when PosixOnly -> + {unix, posix}; {unix, irix64} -> {unix, irix}; OS -> OS @@ -259,6 +265,9 @@ check_disk_space({unix, irix}, Port, Threshold) -> check_disk_space({unix, linux}, Port, Threshold) -> Result = my_cmd("/bin/df -lk", Port), check_disks_solaris(skip_to_eol(Result), Threshold); +check_disk_space({unix, posix}, Port, Threshold) -> + Result = my_cmd("df -k -P", Port), + check_disks_solaris(skip_to_eol(Result), Threshold); check_disk_space({unix, dragonfly}, Port, Threshold) -> Result = my_cmd("/bin/df -k -t ufs,hammer", Port), check_disks_solaris(skip_to_eol(Result), Threshold); diff --git a/lib/os_mon/test/disksup_SUITE.erl b/lib/os_mon/test/disksup_SUITE.erl index 94661cfa77..f9addd96cf 100644 --- a/lib/os_mon/test/disksup_SUITE.erl +++ b/lib/os_mon/test/disksup_SUITE.erl @@ -29,6 +29,7 @@ -export([port/1]). -export([terminate/1, unavailable/1, restart/1]). -export([otp_5910/1]). +-export([posix_only/1]). %% Default timetrap timeout (set in init_per_testcase) -define(default_timeout, ?t:minutes(1)). @@ -48,7 +49,8 @@ init_per_testcase(_Case, Config) -> Dog = ?t:timetrap(?default_timeout), [{watchdog,Dog} | Config]. -end_per_testcase(unavailable, Config) -> +end_per_testcase(TC, Config) when TC =:= unavailable; + TC =:= posix_only -> restart(Config), end_per_testcase(dummy, Config); end_per_testcase(_Case, Config) -> @@ -60,11 +62,10 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> Bugs = [otp_5910], + Always = [api, config, alarm, port, posix_only, unavailable] ++ Bugs, case test_server:os_type() of - {unix, sunos} -> - [api, config, alarm, port, unavailable] ++ Bugs; - {unix, _OSname} -> [api, alarm] ++ Bugs; - {win32, _OSname} -> [api, alarm] ++ Bugs; + {unix, _OSname} -> Always; + {win32, _OSname} -> Always; _OS -> [unavailable] end. @@ -83,12 +84,7 @@ api(doc) -> ["Test of API functions"]; api(Config) when is_list(Config) -> %% get_disk_data() - [{Id,KByte,Capacity}|_] = get_disk_data(), - true = io_lib:printable_list(Id), - true = is_integer(KByte), - true = is_integer(Capacity), - true = Capacity>0, - true = KByte>0, + ok = check_get_disk_data(), %% get_check_interval() 1800000 = disksup:get_check_interval(), @@ -340,6 +336,7 @@ restart(suite) -> []; restart(Config) when is_list(Config) -> ok = application:set_env(os_mon, start_disksup, true), + ok = application:set_env(os_mon, disksup_posix_only, false), {ok, _Pid} = supervisor:restart_child(os_mon_sup, disksup), ok. @@ -405,9 +402,28 @@ otp_5910(Config) when is_list(Config) -> ok = application:start(os_mon), ok. +posix_only(suite) -> []; +posix_only(doc) -> ["Test disksup_posix_only option"]; +posix_only(Config) when is_list(Config) -> + %% Set option and restart disksup + ok = application:set_env(os_mon, disksup_posix_only, true), + ok = supervisor:terminate_child(os_mon_sup, disksup), + {ok, _Child1} = supervisor:restart_child(os_mon_sup, disksup), + + ok = check_get_disk_data(). + dump_info() -> io:format("Status: ~p~n", [sys:get_status(disksup)]). +check_get_disk_data() -> + [{Id,KByte,Capacity}|_] = get_disk_data(), + true = io_lib:printable_list(Id), + true = is_integer(KByte), + true = is_integer(Capacity), + true = Capacity>0, + true = KByte>0, + ok. + % filter get_disk_data and remove entriew with zero capacity % "non-normal" filesystems report zero capacity % - Perhaps errorneous 'df -k -l'? diff --git a/lib/public_key/asn1/OTP-PKIX.asn1 b/lib/public_key/asn1/OTP-PKIX.asn1 index 8d3c76adf5..37196bb9bf 100644 --- a/lib/public_key/asn1/OTP-PKIX.asn1 +++ b/lib/public_key/asn1/OTP-PKIX.asn1 @@ -452,23 +452,23 @@ SupportedPublicKeyAlgorithms PUBLIC-KEY-ALGORITHM-CLASS ::= { ecdsa-with-sha1 SIGNATURE-ALGORITHM-CLASS ::= { ID ecdsa-with-SHA1 - TYPE NULL } -- XXX Must be empty and not NULL + TYPE EcpkParameters } -- XXX Must be empty and not NULL ecdsa-with-sha224 SIGNATURE-ALGORITHM-CLASS ::= { ID ecdsa-with-SHA224 - TYPE NULL } -- XXX Must be empty and not NULL + TYPE EcpkParameters } -- XXX Must be empty and not NULL ecdsa-with-sha256 SIGNATURE-ALGORITHM-CLASS ::= { ID ecdsa-with-SHA256 - TYPE NULL } -- XXX Must be empty and not NULL + TYPE EcpkParameters } -- XXX Must be empty and not NULL ecdsa-with-sha384 SIGNATURE-ALGORITHM-CLASS ::= { ID ecdsa-with-SHA384 - TYPE NULL } -- XXX Must be empty and not NULL + TYPE EcpkParameters } -- XXX Must be empty and not NULL ecdsa-with-sha512 SIGNATURE-ALGORITHM-CLASS ::= { ID ecdsa-with-SHA512 - TYPE NULL } -- XXX Must be empty and not NULL + TYPE EcpkParameters } -- XXX Must be empty and not NULL FIELD-ID-CLASS ::= CLASS { &id OBJECT IDENTIFIER UNIQUE, diff --git a/lib/public_key/doc/src/cert_records.xml b/lib/public_key/doc/src/cert_records.xml index 397c13b463..d1293d12b8 100644 --- a/lib/public_key/doc/src/cert_records.xml +++ b/lib/public_key/doc/src/cert_records.xml @@ -36,8 +36,9 @@ <p>This chapter briefly describes erlang records derived from ASN1 specifications used to handle <c> X509 certificates</c> and <c>CertificationRequest</c>. - The intent is to describe the data types and not to specify the meaning of each - component for this we refer you to <url + The intent is to describe the data types +and not to specify the semantics of each component. For information on the +semantics, please see <url href="http://www.ietf.org/rfc/rfc5280.txt">RFC 5280</url> and <url href="http://www.ietf.org/rfc/rfc5967.txt">PKCS-10</url>. </p> diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 8e93f562d4..88b1a9248e 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -75,7 +75,7 @@ <p><em>Data Types </em></p> - <p><code>oid() - a tuple of integers as generated by the ASN1 compiler.</code></p> + <p><code>oid() - Object Identifier, a tuple of integers as generated by the ASN1 compiler.</code></p> <p><code>boolean() = true | false</code></p> @@ -92,7 +92,7 @@ not_encrypted | cipher_info()}</code></p> <p><code>cipher_info() = {"RC2-CBC | "DES-CBC" | "DES-EDE3-CBC", - crypto:rand_bytes(8)} | 'PBES2-params'}</code></p> + crypto:rand_bytes(8) | {#'PBEParameter{}, digest_type()} |#'PBES2-params'{}}</code></p> <p><code>public_key() = rsa_public_key() | dsa_public_key() | ec_public_key()</code></p> <p><code>private_key() = rsa_private_key() | dsa_private_key() | ec_private_key()</code></p> @@ -113,6 +113,8 @@ <p><code>rsa_padding() = 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | 'rsa_no_padding'</code></p> + + <p><code>digest_type() - Union of below digest types</code></p> <p><code>rsa_digest_type() = 'md5' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</code></p> @@ -499,7 +501,7 @@ fun(OtpCert :: #'OTPCertificate'{}, <fsummary> Performs CRL validation.</fsummary> <type> <v> OTPCertificate = #'OTPCertificate'{}</v> - <v> DPAndCRLs = [{DP::#'DistributionPoint'{} ,CRL::#'CertificateList'{}}] </v> + <v> DPAndCRLs = [{DP::#'DistributionPoint'{}, {DerCRL::der_encoded(), CRL::#'CertificateList'{}}}] </v> <v> Options = proplists:proplist()</v> <v> CRLStatus() = valid | {bad_cert, revocation_status_undetermined} | {bad_cert, {revoked, crl_reason()}}</v> diff --git a/lib/public_key/doc/src/public_key_records.xml b/lib/public_key/doc/src/public_key_records.xml index 13bb996f7f..d3534846fa 100644 --- a/lib/public_key/doc/src/public_key_records.xml +++ b/lib/public_key/doc/src/public_key_records.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2008</year> - <year>2013</year> + <year>2014</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -35,17 +35,27 @@ </header> <p>This chapter briefly describes Erlang records derived from ASN1 - specifications used to handle public and private keys. The intent - is to describe the data types and not to specify the meaning of - each component for this we refer you to the relevant standards and RFCs.</p> + specifications used to handle public and private keys. + The intent is to describe the data types + and not to specify the semantics of each component. For information on the + semantics, please see the relevant standards and RFCs.</p> <p>Use the following include directive to get access to the - records and constant macros used in the following sections.</p> + records and constant macros described in the following sections.</p> <code> -include_lib("public_key/include/public_key.hrl"). </code> + <section> + <title>Common Data Types</title> + + <p>Common non-standard Erlang + data types used to described the record fields in the + below sections are defined in <seealso + marker="public_key">public key reference manual </seealso></p> + </section> + <section> - <title>RSA as defined by the PKCS-1 standard and RFC 3447.</title> + <title>RSA as defined by the PKCS-1 standard and <url href="http://www.ietf.org/rfc/rfc3447.txt"> RFC 3447 </url></title> <code> #'RSAPublicKey'{ @@ -76,7 +86,8 @@ </section> <section> - <title>DSA as defined by Digital Signature Standard (NIST FIPS PUB 186-2) + <title>DSA as defined by + <url href="http://csrc.nist.gov/publications/fips/fips186-3/fips_186-3.pdf"> Digital Signature Standard (NIST FIPS PUB 186-2) </url> </title> <code> @@ -96,4 +107,47 @@ }. </code> </section> + + <section> + <title>ECC (Elliptic Curve) <url href="http://www.ietf.org/rfc/rfc3447.txt"> RFC 5480 </url> + </title> + + <code> +#'ECPrivateKey'{ + version, % integer() + privateKey, % octet_string() + parameters, % der_encoded() - {'EcpkParameters', #'ECParameters'{}} | + {'EcpkParameters', {namedCurve, oid()}} | + {'EcpkParameters', 'NULL'} % Inherited by CA + publicKey % bitstring() + }. + +#'ECParameters'{ + version, % integer() + fieldID, % #'FieldID'{} + curve, % #'Curve'{} + base, % octet_string() + order, % integer() + cofactor % integer() + }. + +#'Curve'{ + a, % octet_string() + b, % octet_string() + seed % bitstring() - optional + + }. + +#'FieldID'{ + fieldType, % oid() + parameters % Depending on fieldType + }. + +#'ECPoint'{ + point % octet_string() - the public key + }. + + </code> + </section> + </chapter> diff --git a/lib/public_key/src/pubkey_pbe.erl b/lib/public_key/src/pubkey_pbe.erl index 460624163b..521a32189d 100644 --- a/lib/public_key/src/pubkey_pbe.erl +++ b/lib/public_key/src/pubkey_pbe.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -22,7 +22,7 @@ -include("public_key.hrl"). --export([encode/4, decode/4, decrypt_parameters/1]). +-export([encode/4, decode/4, decrypt_parameters/1, encrypt_parameters/1]). -export([pbdkdf1/4, pbdkdf2/7]). -define(DEFAULT_SHA_MAC_KEYLEN, 20). @@ -40,16 +40,16 @@ %%-------------------------------------------------------------------- encode(Data, Password, "DES-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_encrypt(des_cbc, Key, IV, Data); + crypto:block_encrypt(des_cbc, Key, IV, pbe_pad(Data, KeyDevParams)); encode(Data, Password, "DES-EDE3-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), <<Key1:8/binary, Key2:8/binary, Key3:8/binary>> = Key, - crypto:block_encrypt(des3_cbc, [Key1, Key2, Key3], IV, Data); + crypto:block_encrypt(des3_cbc, [Key1, Key2, Key3], IV, pbe_pad(Data)); encode(Data, Password, "RC2-CBC" = Cipher, KeyDevParams) -> {Key, IV} = password_to_key_and_iv(Password, Cipher, KeyDevParams), - crypto:block_encrypt(rc2_cbc, Key, IV, Data). + crypto:block_encrypt(rc2_cbc, Key, IV, pbe_pad(Data, KeyDevParams)). %%-------------------------------------------------------------------- -spec decode(binary(), string(), string(), term()) -> binary(). %% @@ -108,6 +108,15 @@ decrypt_parameters(#'EncryptedPrivateKeyInfo_encryptionAlgorithm'{ algorithm = Oid, parameters = Param}) -> decrypt_parameters(Oid, Param). + +%%-------------------------------------------------------------------- +-spec encrypt_parameters({Cipher::string(), Params::term()}) -> + #'EncryptedPrivateKeyInfo_encryptionAlgorithm'{}. +%% +%% Description: Performs ANS1-decoding of encryption parameters. +%%-------------------------------------------------------------------- +encrypt_parameters({Cipher, Params}) -> + encrypt_parameters(Cipher, Params). %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -117,14 +126,18 @@ password_to_key_and_iv(Password, _, #'PBES2-params'{} = Params) -> <<Key:KeyLen/binary, _/binary>> = pbdkdf2(Password, Salt, ItrCount, KeyLen, PseudoRandomFunction, PseudoHash, PseudoOtputLen), {Key, IV}; +password_to_key_and_iv(Password, _Cipher, {#'PBEParameter'{salt = Salt, + iterationCount = Count}, Hash}) -> + <<Key:8/binary, IV:8/binary, _/binary>> + = pbdkdf1(Password, erlang:iolist_to_binary(Salt), Count, Hash), + {Key, IV}; password_to_key_and_iv(Password, Cipher, Salt) -> - KeyLen = derived_key_length(Cipher, undefined), + KeyLen = derived_key_length(Cipher, undefined), <<Key:KeyLen/binary, _/binary>> = pem_encrypt(<<>>, Password, Salt, ceiling(KeyLen div 16), <<>>, md5), %% Old PEM encryption does not use standard encryption method - %% pbdkdf1 and uses then salt as IV + %% pbdkdf1 and uses then salt as IV {Key, Salt}. - pem_encrypt(_, _, _, 0, Acc, _) -> Acc; pem_encrypt(Prev, Password, Salt, Count, Acc, Hash) -> @@ -169,7 +182,52 @@ do_xor_sum(Prf, PrfHash, PrfLen, Prev, Password, Count, Acc)-> decrypt_parameters(?'id-PBES2', DekParams) -> {ok, Params} = 'PKCS-FRAME':decode('PBES2-params', DekParams), - {cipher(Params#'PBES2-params'.encryptionScheme), Params}. + {cipher(Params#'PBES2-params'.encryptionScheme), Params}; +decrypt_parameters(?'pbeWithSHA1AndRC2-CBC', DekParams) -> + {ok, Params} = 'PKCS-FRAME':decode('PBEParameter', DekParams), + {"RC2-CBC", {Params, sha}}; +decrypt_parameters(?'pbeWithSHA1AndDES-CBC', DekParams) -> + {ok, Params} = 'PKCS-FRAME':decode('PBEParameter', DekParams), + {"DES-CBC", {Params, sha}}; +decrypt_parameters(?'pbeWithMD5AndRC2-CBC', DekParams) -> + {ok, Params} = 'PKCS-FRAME':decode('PBEParameter', DekParams), + {"RC2-CBC", {Params, md5}}; +decrypt_parameters(?'pbeWithMD5AndDES-CBC', DekParams) -> + {ok, Params} = 'PKCS-FRAME':decode('PBEParameter', DekParams), + {"DES-CBC", {Params, md5}}. + +encrypt_parameters(_Cipher, #'PBES2-params'{} = Params) -> + {ok, Der} ='PKCS-FRAME':encode('PBES2-params', Params), + #'EncryptedPrivateKeyInfo_encryptionAlgorithm'{ + algorithm = ?'id-PBES2', + parameters = Der}; + +encrypt_parameters(Cipher, {#'PBEParameter'{} = Params, Hash}) -> + {ok, Der} ='PKCS-FRAME':encode('PBEParameter', Params), + #'EncryptedPrivateKeyInfo_encryptionAlgorithm'{ + algorithm = pbe1_oid(Cipher, Hash), + parameters = Der}. + +pbe1_oid("RC2-CBC", sha) -> + ?'pbeWithSHA1AndRC2-CBC'; +pbe1_oid("DES-CBC", sha) -> + ?'pbeWithSHA1AndDES-CBC'; +pbe1_oid("RC2-CBC", md5) -> + ?'pbeWithMD5AndRC2-CBC'; +pbe1_oid("DES-CBC", md5) -> + ?'pbeWithMD5AndDES-CBC'. + +pbe_pad(Data, {#'PBEParameter'{}, _}) -> + pbe_pad(Data); +pbe_pad(Data, #'PBES2-params'{}) -> + pbe_pad(Data); +pbe_pad(Data, _) -> + Data. + +pbe_pad(Data) -> + N = 8 - (erlang:byte_size(Data) rem 8), + Pad = list_to_binary(lists:duplicate(N, N)), + <<Data/binary, Pad/binary>>. key_derivation_params(#'PBES2-params'{keyDerivationFunc = KeyDerivationFunc, encryptionScheme = EncScheme}) -> diff --git a/lib/public_key/src/pubkey_pem.erl b/lib/public_key/src/pubkey_pem.erl index 3a1653d989..98881c4a6a 100644 --- a/lib/public_key/src/pubkey_pem.erl +++ b/lib/public_key/src/pubkey_pem.erl @@ -68,7 +68,8 @@ encode(PemEntries) -> %%-------------------------------------------------------------------- -spec decipher({public_key:pki_asn1_type(), DerEncrypted::binary(), - {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{}}}, + {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{} + | {#'PBEParameter'{}, atom()}}}, string()) -> Der::binary(). %% %% Description: Deciphers a decrypted pem entry. @@ -77,7 +78,8 @@ decipher({_, DecryptDer, {Cipher, KeyDevParams}}, Password) -> pubkey_pbe:decode(DecryptDer, Password, Cipher, KeyDevParams). %%-------------------------------------------------------------------- --spec cipher(Der::binary(), {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{}} , +-spec cipher(Der::binary(), {Cipher :: string(), Salt :: iodata() | #'PBES2-params'{} + | {#'PBEParameter'{}, atom()}}, string()) -> binary(). %% %% Description: Ciphers a PEM entry @@ -94,6 +96,10 @@ encode_pem_entries(Entries) -> encode_pem_entry({Type, Der, not_encrypted}) -> StartStr = pem_start(Type), [StartStr, "\n", b64encode_and_split(Der), "\n", pem_end(StartStr) ,"\n\n"]; +encode_pem_entry({'PrivateKeyInfo', Der, EncParams}) -> + EncDer = encode_encrypted_private_keyinfo(Der, EncParams), + StartStr = pem_start('EncryptedPrivateKeyInfo'), + [StartStr, "\n", b64encode_and_split(EncDer), "\n", pem_end(StartStr) ,"\n\n"]; encode_pem_entry({Type, Der, {Cipher, Salt}}) -> StartStr = pem_start(Type), [StartStr,"\n", pem_decrypt(),"\n", pem_decrypt_info(Cipher, Salt),"\n", @@ -139,6 +145,12 @@ decode_encrypted_private_keyinfo(Der) -> DecryptParams = pubkey_pbe:decrypt_parameters(AlgorithmInfo), {'PrivateKeyInfo', iolist_to_binary(Data), DecryptParams}. + +encode_encrypted_private_keyinfo(EncData, EncryptParmams) -> + AlgorithmInfo = pubkey_pbe:encrypt_parameters(EncryptParmams), + public_key:der_encode('EncryptedPrivateKeyInfo', + #'EncryptedPrivateKeyInfo'{encryptionAlgorithm = AlgorithmInfo, + encryptedData = EncData}). split_bin(Bin) -> split_bin(0, Bin). @@ -197,13 +209,15 @@ pem_start('DSAPrivateKey') -> <<"-----BEGIN DSA PRIVATE KEY-----">>; pem_start('DHParameter') -> <<"-----BEGIN DH PARAMETERS-----">>; +pem_start('EncryptedPrivateKeyInfo') -> + <<"-----BEGIN ENCRYPTED PRIVATE KEY-----">>; pem_start('CertificationRequest') -> <<"-----BEGIN CERTIFICATE REQUEST-----">>; pem_start('ContentInfo') -> <<"-----BEGIN PKCS7-----">>; pem_start('CertificateList') -> <<"-----BEGIN X509 CRL-----">>; -pem_start('OTPEcpkParameters') -> +pem_start('EcpkParameters') -> <<"-----BEGIN EC PARAMETERS-----">>; pem_start('ECPrivateKey') -> <<"-----BEGIN EC PRIVATE KEY-----">>. @@ -260,7 +274,7 @@ asn1_type(<<"-----BEGIN PKCS7-----">>) -> asn1_type(<<"-----BEGIN X509 CRL-----">>) -> 'CertificateList'; asn1_type(<<"-----BEGIN EC PARAMETERS-----">>) -> - 'OTPEcpkParameters'; + 'EcpkParameters'; asn1_type(<<"-----BEGIN EC PRIVATE KEY-----">>) -> 'ECPrivateKey'. diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index a732455aa7..1bbf4ef416 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -64,9 +64,15 @@ -type der_encoded() :: binary(). -type pki_asn1_type() :: 'Certificate' | 'RSAPrivateKey' | 'RSAPublicKey' | 'DSAPrivateKey' | 'DSAPublicKey' | 'DHParameter' - | 'SubjectPublicKeyInfo' | 'CertificationRequest' | 'CertificateList'. --type pem_entry() :: {pki_asn1_type(), binary(), %% DER or Encrypted DER - not_encrypted | {Cipher :: string(), Salt :: binary()}}. + | 'SubjectPublicKeyInfo' | 'PrivateKeyInfo' | + 'CertificationRequest' | 'CertificateList' | + 'ECPrivateKey' | 'EcpkParameters'. +-type pem_entry() :: {pki_asn1_type(), + binary(), %% DER or Encrypted DER + not_encrypted | {Cipher :: string(), Salt :: binary()} | + {Cipher :: string(), #'PBES2-params'{}} | + {Cipher :: string(), {#'PBEParameter'{}, atom()}} %% hash type + }. -type asn1_type() :: atom(). %% see "OTP-PUB-KEY.hrl -type ssh_file() :: openssh_public_key | rfc4716_public_key | known_hosts | auth_keys. @@ -133,20 +139,19 @@ pem_entry_decode({Asn1Type, CryptDer, {Cipher, #'PBES2-params'{}}} = PemEntry, is_binary(CryptDer) andalso is_list(Cipher) -> do_pem_entry_decode(PemEntry, Password); +pem_entry_decode({Asn1Type, CryptDer, {Cipher, {#'PBEParameter'{},_}}} = PemEntry, + Password) when is_atom(Asn1Type) andalso + is_binary(CryptDer) andalso + is_list(Cipher) -> + do_pem_entry_decode(PemEntry, Password); pem_entry_decode({Asn1Type, CryptDer, {Cipher, Salt}} = PemEntry, Password) when is_atom(Asn1Type) andalso is_binary(CryptDer) andalso is_list(Cipher) andalso is_binary(Salt) andalso - erlang:byte_size(Salt) == 8 -> - do_pem_entry_decode(PemEntry, Password); -pem_entry_decode({Asn1Type, CryptDer, {"AES-128-CBC"=Cipher, IV}} = PemEntry, - Password) when is_atom(Asn1Type) andalso - is_binary(CryptDer) andalso - is_list(Cipher) andalso - is_binary(IV) andalso - erlang:byte_size(IV) == 16 -> - do_pem_entry_decode(PemEntry, Password). + ((erlang:byte_size(Salt) == 8) or (erlang:byte_size(Salt) == 16)) -> + do_pem_entry_decode(PemEntry, Password). + %%-------------------------------------------------------------------- -spec pem_entry_encode(pki_asn1_type(), term()) -> pem_entry(). @@ -174,13 +179,19 @@ pem_entry_encode(Asn1Type, Entity, {{Cipher, #'PBES2-params'{}} = CipherInfo, is_list(Password) andalso is_list(Cipher) -> do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password); - +pem_entry_encode(Asn1Type, Entity, {{Cipher, + {#'PBEParameter'{}, _}} = CipherInfo, + Password}) when is_atom(Asn1Type) andalso + is_list(Password) andalso + is_list(Cipher) -> + do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password); pem_entry_encode(Asn1Type, Entity, {{Cipher, Salt} = CipherInfo, Password}) when is_atom(Asn1Type) andalso is_list(Password) andalso is_list(Cipher) andalso is_binary(Salt) andalso - erlang:byte_size(Salt) == 8 -> + ((erlang:byte_size(Salt) == 8) or + (erlang:byte_size(Salt) == 16)) -> do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password). %%-------------------------------------------------------------------- @@ -615,11 +626,11 @@ pkix_path_validation(#'OTPCertificate'{} = TrustedCert, CertChain, Options) %-------------------------------------------------------------------- -spec pkix_crls_validate(#'OTPCertificate'{}, - [{DP::#'DistributionPoint'{} ,CRL::#'CertificateList'{}}], + [{DP::#'DistributionPoint'{}, {DerCRL::binary(), CRL::#'CertificateList'{}}}], Options :: proplists:proplist()) -> valid | {bad_cert, revocation_status_undetermined} | {bad_cert, {revoked, crl_reason()}}. -%% Description: Performs a basic path validation according to RFC 5280. +%% Description: Performs a CRL validation according to RFC 5280. %%-------------------------------------------------------------------- pkix_crls_validate(OtpCert, [{_,_,_} |_] = DPAndCRLs, Options) -> pkix_crls_validate(OtpCert, DPAndCRLs, DPAndCRLs, diff --git a/lib/public_key/test/pbe_SUITE.erl b/lib/public_key/test/pbe_SUITE.erl index b68ffbd5fd..aa2bbdd24b 100644 --- a/lib/public_key/test/pbe_SUITE.erl +++ b/lib/public_key/test/pbe_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -35,7 +35,9 @@ all() -> [ pbdkdf1, pbdkdf2, - encrypted_private_key_info]. + old_enc, + pbes1, + pbes2]. groups() -> []. @@ -192,44 +194,48 @@ pbdkdf2(Config) when is_list(Config) -> 16#cc, 16#37, 16#d7, 16#f0, 16#34, 16#25, 16#e0, 16#c3>> = pubkey_pbe:pbdkdf2("pass\0word", "sa\0lt", 4096, 16, fun crypto:hmac/4, sha, 20). - -encrypted_private_key_info() -> - [{doc,"Tests reading a EncryptedPrivateKeyInfo file encrypted with different ciphers"}]. -encrypted_private_key_info(Config) when is_list(Config) -> + +old_enc() -> + [{doc,"Tests encode/decode RSA key encrypted with different ciphers using old PEM encryption scheme"}]. +old_enc(Config) when is_list(Config) -> Datadir = ?config(data_dir, Config), - {ok, PemDes} = file:read_file(filename:join(Datadir, "des_cbc_enc_key.pem")), + %% key generated with ssh-keygen -N hello_aes -f old_aes_128_cbc_enc_key.pem + {ok, PemAesCbc} = file:read_file(filename:join(Datadir, "old_aes_128_cbc_enc_key.pem")), - PemDesEntry = public_key:pem_decode(PemDes), - ct:print("Pem entry: ~p" , [PemDesEntry]), - [{'PrivateKeyInfo', _, {"DES-CBC",_}} = PubEntry0] = PemDesEntry, - KeyInfo = public_key:pem_entry_decode(PubEntry0, "password"), - - {ok, Pem3Des} = file:read_file(filename:join(Datadir, "des_ede3_cbc_enc_key.pem")), - - Pem3DesEntry = public_key:pem_decode(Pem3Des), - ct:print("Pem entry: ~p" , [Pem3DesEntry]), - [{'PrivateKeyInfo', _, {"DES-EDE3-CBC",_}} = PubEntry1] = Pem3DesEntry, - KeyInfo = public_key:pem_entry_decode(PubEntry1, "password"), - - {ok, PemRc2} = file:read_file(filename:join(Datadir, "rc2_cbc_enc_key.pem")), - - PemRc2Entry = public_key:pem_decode(PemRc2), - ct:print("Pem entry: ~p" , [PemRc2Entry]), - [{'PrivateKeyInfo', _, {"RC2-CBC",_}} = PubEntry2] = PemRc2Entry, - KeyInfo = public_key:pem_entry_decode(PubEntry2, "password"), - - %% key generated with ssh-keygen -N hello_aes -f aes_128_cbc_enc_key - {ok, PemAesCbc} = file:read_file(filename:join(Datadir, "aes_128_cbc_enc_key")), - PemAesCbcEntry = public_key:pem_decode(PemAesCbc), ct:print("Pem entry: ~p" , [PemAesCbcEntry]), [{'RSAPrivateKey', _, {"AES-128-CBC",_}} = PubAesCbcEntry] = PemAesCbcEntry, - #'RSAPrivateKey'{} = public_key:pem_entry_decode(PubAesCbcEntry, "hello_aes"), - - check_key_info(KeyInfo). + #'RSAPrivateKey'{} = public_key:pem_entry_decode(PubAesCbcEntry, "hello_aes"). +pbes1() -> + [{doc,"Tests encode/decode EncryptedPrivateKeyInfo encrypted with different ciphers using PBES1"}]. +pbes1(Config) when is_list(Config) -> + decode_encode_key_file("pbes1_des_cbc_md5_enc_key.pem", "password", "DES-CBC", Config). + +pbes2() -> + [{doc,"Tests encode/decode EncryptedPrivateKeyInfo encrypted with different ciphers using PBES2"}]. +pbes2(Config) when is_list(Config) -> + decode_encode_key_file("pbes2_des_cbc_enc_key.pem", "password", "DES-CBC", Config), + decode_encode_key_file("pbes2_des_ede3_cbc_enc_key.pem", "password", "DES-EDE3-CBC", Config), + decode_encode_key_file("pbes2_rc2_cbc_enc_key.pem", "password", "RC2-CBC", Config). check_key_info(#'PrivateKeyInfo'{privateKeyAlgorithm = #'PrivateKeyInfo_privateKeyAlgorithm'{algorithm = ?rsaEncryption}, privateKey = Key}) -> #'RSAPrivateKey'{} = public_key:der_decode('RSAPrivateKey', iolist_to_binary(Key)). + +decode_encode_key_file(File, Password, Cipher, Config) -> + Datadir = ?config(data_dir, Config), + {ok, PemKey} = file:read_file(filename:join(Datadir, File)), + + PemEntry = public_key:pem_decode(PemKey), + ct:print("Pem entry: ~p" , [PemEntry]), + [{Asn1Type, _, {Cipher,_} = CipherInfo} = PubEntry] = PemEntry, + KeyInfo = public_key:pem_entry_decode(PubEntry, Password), + PemKey1 = public_key:pem_encode([public_key:pem_entry_encode(Asn1Type, KeyInfo, {CipherInfo, Password})]), + Pem = strip_ending_newlines(PemKey), + Pem = strip_ending_newlines(PemKey1), + check_key_info(KeyInfo). + +strip_ending_newlines(Bin) -> + string:strip(binary_to_list(Bin), right, 10). diff --git a/lib/public_key/test/pbe_SUITE_data/aes_128_cbc_enc_key b/lib/public_key/test/pbe_SUITE_data/old_aes_128_cbc_enc_key.pem index 34c7543f30..34c7543f30 100644 --- a/lib/public_key/test/pbe_SUITE_data/aes_128_cbc_enc_key +++ b/lib/public_key/test/pbe_SUITE_data/old_aes_128_cbc_enc_key.pem diff --git a/lib/public_key/test/pbe_SUITE_data/pbes1_des_cbc_md5_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/pbes1_des_cbc_md5_enc_key.pem new file mode 100644 index 0000000000..12e860c7a7 --- /dev/null +++ b/lib/public_key/test/pbe_SUITE_data/pbes1_des_cbc_md5_enc_key.pem @@ -0,0 +1,17 @@ +-----BEGIN ENCRYPTED PRIVATE KEY----- +MIICoTAbBgkqhkiG9w0BBQMwDgQIZmB6EGEnIOcCAggABIICgDaaKoCEUowjKt5M +uwMAIf7uugy09OcqR8PcB9ioiuk5NQGXkIBxOOlOuFb6xrP+O2dSppr5k/ZU+NEX +Lf18AdMld1nlE6lwjPytOIqt6Q3YMeny8un1/jopnkQZKthJ5moER5ohp/2osTDV +4Ih8MtHTwE879SHAmj7Y3G7itKHQi17212DVmL+D+P7iRzTCKIyPj5KMXvXN+eor +j0urZXVOeyRTABHQnf6xJn8K+dGowC/AJTQWOgFunlBKzecepqF22OQzIW2R60aM +VgykSd8A5G8o1F+tO2Qrp6KM9Ak709dUX8qRb/C02w5rjg2g0frgFyEGX0pUJbno +dJLKMOT1WvDnsXaS720beyzrOynWiAuaFZwb1/nPSQnzJ4t0mUvQQis5ph3eHSR/ +a9/PER81IDjPtjlTJjaOGuwhIRmGFsLUrQhOnVcI7Z5TCSj7EHdqK3xzjSVzu5DY +BqE2rsigiIOszPdbK4tKCDheIwBhYdptDvG9c+j3Mj0YNOXJxsX0gVoMqtpwryNG +OZy5fLujS4l+cPq64dOh/LE87mrM9St6M6gw2VRW7d0U18Muubp/MK8q9O2i80Nw +ZFrHHE1N09x3aTnty4mwdCHl6w5aJMZg6WbUXJnf0zKa8ADv5wZmAvW3fO4G8434 +3FHj1hdyKPcoVjoFVawyRUflF/jYd1pLpV+iZwDDR4lacb4ay1Lut452ifZ8DqOq +lWYL0uskCn1WI856vtlLV3gnV02xDjAilSY2hASOyoD1wypZefPn5S+U3vkLuzFZ +ycbyIwGYTLWj71u8Vu3JceRI3OIPDuM7zcNHr71eQyiwLEA0iszQQA9xgqmeFtJO +IkpUTAY= +-----END ENCRYPTED PRIVATE KEY----- diff --git a/lib/public_key/test/pbe_SUITE_data/des_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/pbes2_des_cbc_enc_key.pem index eaa06145aa..eaa06145aa 100644 --- a/lib/public_key/test/pbe_SUITE_data/des_cbc_enc_key.pem +++ b/lib/public_key/test/pbe_SUITE_data/pbes2_des_cbc_enc_key.pem diff --git a/lib/public_key/test/pbe_SUITE_data/des_ede3_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/pbes2_des_ede3_cbc_enc_key.pem index 22ea46d56f..22ea46d56f 100644 --- a/lib/public_key/test/pbe_SUITE_data/des_ede3_cbc_enc_key.pem +++ b/lib/public_key/test/pbe_SUITE_data/pbes2_des_ede3_cbc_enc_key.pem diff --git a/lib/public_key/test/pbe_SUITE_data/rc2_cbc_enc_key.pem b/lib/public_key/test/pbe_SUITE_data/pbes2_rc2_cbc_enc_key.pem index 618cddcfd7..618cddcfd7 100644 --- a/lib/public_key/test/pbe_SUITE_data/rc2_cbc_enc_key.pem +++ b/lib/public_key/test/pbe_SUITE_data/pbes2_rc2_cbc_enc_key.pem diff --git a/lib/sasl/doc/src/alarm_handler.xml b/lib/sasl/doc/src/alarm_handler.xml index ab3041137e..e4def7c7f5 100644 --- a/lib/sasl/doc/src/alarm_handler.xml +++ b/lib/sasl/doc/src/alarm_handler.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>1996</year> - <year>2013</year> + <year>2014</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -87,7 +87,9 @@ <v>AlarmId = term()</v> </type> <desc> - <p>Clears all alarms with id <c>AlarmId</c>. + <p>Sends the <c>clear_alarm</c> event to all event handlers.</p> + <p>When receiving this event, the default simple handler + clears the latest received alarm with id <c>AlarmId</c>. </p> </desc> </func> @@ -109,8 +111,10 @@ <v>AlarmDescription = term()</v> </type> <desc> - <p>Sets an alarm with id <c>AlarmId</c>. This id is used at a - later stage when the alarm is cleared. + <p>Sends the <c>set_alarm</c> event to all event handlers.</p> + <p>When receiving this event, the default simple handler + stores the alarm. The <c>AlarmId</c> identifies the alarm + and is used when the alarm is cleared. </p> </desc> </func> diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 0dbec7527a..60440d3a80 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -29,6 +29,27 @@ <file>notes.xml</file> </header> +<section><title>Ssh 3.0.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + When starting an ssh-daemon giving the option + {parallel_login, true}, the timeout for authentication + negotiation ({negotiation_timeout, integer()}) was never + removed.</p> + <p> + This caused the session to always be terminated after the + timeout if parallel_login was set.</p> + <p> + Own Id: OTP-12057 Aux Id: seq12663 </p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 3.0.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 876eba598a..9f5d1c003d 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -36,8 +36,8 @@ <list type="bulleted"> <item>SSH requires the crypto and public_key applications.</item> <item>Supported SSH version is 2.0 </item> - <item>Supported MAC algorithms: hmac-sha1</item> - <item>Supported encryption algorithms: aes128-cb and 3des-cbc</item> + <item>Supported MAC algorithms: hmac-sha2-256 and hmac-sha1</item> + <item>Supported encryption algorithms: aes128-ctr, aes128-cb and 3des-cbc</item> <item>Supports unicode filenames if the emulator and the underlaying OS supports it. See the DESCRIPTION section in <seealso marker="kernel:file">file</seealso> for information about this subject</item> <item>Supports unicode in shell and cli</item> </list> diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 743c01a42c..8a8d4bb89e 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -392,7 +392,8 @@ handle_ssh_option({compression, Value} = Opt) when is_atom(Value) -> Opt; handle_ssh_option({exec, {Module, Function, _}} = Opt) when is_atom(Module), is_atom(Function) -> - + Opt; +handle_ssh_option({exec, Function} = Opt) when is_function(Function) -> Opt; handle_ssh_option({auth_methods, Value} = Opt) when is_list(Value) -> Opt; diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index 77453e8fd7..18841e3d2d 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -457,17 +457,17 @@ bin_to_list(I) when is_integer(I) -> start_shell(ConnectionHandler, State) -> Shell = State#state.shell, - ConnectionInfo = ssh_connection_handler:info(ConnectionHandler, + ConnectionInfo = ssh_connection_handler:connection_info(ConnectionHandler, [peer, user]), ShellFun = case is_function(Shell) of true -> - {ok, User} = + User = proplists:get_value(user, ConnectionInfo), case erlang:fun_info(Shell, arity) of {arity, 1} -> fun() -> Shell(User) end; {arity, 2} -> - [{_, PeerAddr}] = + {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo), fun() -> Shell(User, PeerAddr) end; _ -> @@ -485,9 +485,9 @@ start_shell(_ConnectionHandler, Cmd, #state{exec={M, F, A}} = State) -> State#state{group = Group, buf = empty_buf()}; start_shell(ConnectionHandler, Cmd, #state{exec=Shell} = State) when is_function(Shell) -> - ConnectionInfo = ssh_connection_handler:info(ConnectionHandler, + ConnectionInfo = ssh_connection_handler:connection_info(ConnectionHandler, [peer, user]), - {ok, User} = + User = proplists:get_value(user, ConnectionInfo), ShellFun = case erlang:fun_info(Shell, arity) of @@ -496,7 +496,7 @@ start_shell(ConnectionHandler, Cmd, #state{exec=Shell} = State) when is_function {arity, 2} -> fun() -> Shell(Cmd, User) end; {arity, 3} -> - [{_, PeerAddr}] = + {_, PeerAddr} = proplists:get_value(peer, ConnectionInfo), fun() -> Shell(Cmd, User, PeerAddr) end; _ -> diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index b377614949..33849f4527 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -782,9 +782,8 @@ handle_cli_msg(#connection{channel_cache = Cache} = Connection, erlang:monitor(process, Pid), Channel = Channel0#channel{user = Pid}, ssh_channel:cache_update(Cache, Channel), - Reply = {connection_reply, - channel_success_msg(RemoteId)}, - {{replies, [{channel_data, Pid, Reply0}, Reply]}, Connection}; + {Reply, Connection1} = reply_msg(Channel, Connection, Reply0), + {{replies, [Reply]}, Connection1}; _Other -> Reply = {connection_reply, channel_failure_msg(RemoteId)}, diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 06866392da..86804c4436 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -104,21 +104,11 @@ start_connection(client = Role, Socket, Options, Timeout) -> start_connection(server = Role, Socket, Options, Timeout) -> try - Sups = proplists:get_value(supervisors, Options), - ConnectionSup = proplists:get_value(connection_sup, Sups), - Opts = [{supervisors, Sups}, {user_pid, self()} | proplists:get_value(ssh_opts, Options, [])], - {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Opts]), - {_, Callback, _} = proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), - socket_control(Socket, Pid, Callback), - case proplists:get_value(parallel_login, Opts, false) of + case proplists:get_value(parallel_login, Options, false) of true -> - spawn(fun() -> - Ref = erlang:monitor(process, Pid), - handshake(Pid, Ref, Timeout) - end); + spawn(fun() -> start_server_connection(Role, Socket, Options, Timeout) end); false -> - Ref = erlang:monitor(process, Pid), - handshake(Pid, Ref, Timeout) + start_server_connection(Role, Socket, Options, Timeout) end catch exit:{noproc, _} -> @@ -127,6 +117,18 @@ start_connection(server = Role, Socket, Options, Timeout) -> {error, Error} end. + +start_server_connection(server = Role, Socket, Options, Timeout) -> + Sups = proplists:get_value(supervisors, Options), + ConnectionSup = proplists:get_value(connection_sup, Sups), + Opts = [{supervisors, Sups}, {user_pid, self()} | proplists:get_value(ssh_opts, Options, [])], + {ok, Pid} = ssh_connection_sup:start_child(ConnectionSup, [Role, Socket, Opts]), + {_, Callback, _} = proplists:get_value(transport, Options, {tcp, gen_tcp, tcp_closed}), + socket_control(Socket, Pid, Callback), + Ref = erlang:monitor(process, Pid), + handshake(Pid, Ref, Timeout). + + start_link(Role, Socket, Options) -> {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Socket, Options]])}. diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index 27723dc870..ea05c849b7 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -113,15 +113,28 @@ key_init(client, Ssh, Value) -> key_init(server, Ssh, Value) -> Ssh#ssh{s_keyinit = Value}. +available_ssh_algos() -> + Supports = crypto:supports(), + CipherAlgos = [{aes_ctr, "aes128-ctr"}, {aes_cbc128, "aes128-cbc"}, {des3_cbc, "3des-cbc"}], + Ciphers = [SshAlgo || + {CryptoAlgo, SshAlgo} <- CipherAlgos, + lists:member(CryptoAlgo, proplists:get_value(ciphers, Supports, []))], + HashAlgos = [{sha256, "hmac-sha2-256"}, {sha, "hmac-sha1"}], + Hashs = [SshAlgo || + {CryptoAlgo, SshAlgo} <- HashAlgos, + lists:member(CryptoAlgo, proplists:get_value(hashs, Supports, []))], + {Ciphers, Hashs}. + kexinit_messsage(client, Random, Compression, HostKeyAlgs) -> + {CipherAlgs, HashAlgs} = available_ssh_algos(), #ssh_msg_kexinit{ cookie = Random, kex_algorithms = ["diffie-hellman-group1-sha1"], server_host_key_algorithms = HostKeyAlgs, - encryption_algorithms_client_to_server = ["aes128-cbc","3des-cbc"], - encryption_algorithms_server_to_client = ["aes128-cbc","3des-cbc"], - mac_algorithms_client_to_server = ["hmac-sha1"], - mac_algorithms_server_to_client = ["hmac-sha1"], + encryption_algorithms_client_to_server = CipherAlgs, + encryption_algorithms_server_to_client = CipherAlgs, + mac_algorithms_client_to_server = HashAlgs, + mac_algorithms_server_to_client = HashAlgs, compression_algorithms_client_to_server = Compression, compression_algorithms_server_to_client = Compression, languages_client_to_server = [], @@ -129,14 +142,15 @@ kexinit_messsage(client, Random, Compression, HostKeyAlgs) -> }; kexinit_messsage(server, Random, Compression, HostKeyAlgs) -> + {CipherAlgs, HashAlgs} = available_ssh_algos(), #ssh_msg_kexinit{ cookie = Random, kex_algorithms = ["diffie-hellman-group1-sha1"], server_host_key_algorithms = HostKeyAlgs, - encryption_algorithms_client_to_server = ["aes128-cbc","3des-cbc"], - encryption_algorithms_server_to_client = ["aes128-cbc","3des-cbc"], - mac_algorithms_client_to_server = ["hmac-sha1"], - mac_algorithms_server_to_client = ["hmac-sha1"], + encryption_algorithms_client_to_server = CipherAlgs, + encryption_algorithms_server_to_client = CipherAlgs, + mac_algorithms_client_to_server = HashAlgs, + mac_algorithms_server_to_client = HashAlgs, compression_algorithms_client_to_server = Compression, compression_algorithms_server_to_client = Compression, languages_client_to_server = [], @@ -636,7 +650,21 @@ encrypt_init(#ssh{encrypt = 'aes128-cbc', role = server} = Ssh) -> <<K:16/binary>> = hash(Ssh, "D", 128), {ok, Ssh#ssh{encrypt_keys = K, encrypt_block_size = 16, - encrypt_ctx = IV}}. + encrypt_ctx = IV}}; +encrypt_init(#ssh{encrypt = 'aes128-ctr', role = client} = Ssh) -> + IV = hash(Ssh, "A", 128), + <<K:16/binary>> = hash(Ssh, "C", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{encrypt_keys = K, + encrypt_block_size = 16, + encrypt_ctx = State}}; +encrypt_init(#ssh{encrypt = 'aes128-ctr', role = server} = Ssh) -> + IV = hash(Ssh, "B", 128), + <<K:16/binary>> = hash(Ssh, "D", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{encrypt_keys = K, + encrypt_block_size = 16, + encrypt_ctx = State}}. encrypt_final(Ssh) -> {ok, Ssh#ssh{encrypt = none, @@ -658,7 +686,11 @@ encrypt(#ssh{encrypt = 'aes128-cbc', encrypt_ctx = IV0} = Ssh, Data) -> Enc = crypto:block_encrypt(aes_cbc128, K,IV0,Data), IV = crypto:next_iv(aes_cbc, Enc), - {Ssh#ssh{encrypt_ctx = IV}, Enc}. + {Ssh#ssh{encrypt_ctx = IV}, Enc}; +encrypt(#ssh{encrypt = 'aes128-ctr', + encrypt_ctx = State0} = Ssh, Data) -> + {State, Enc} = crypto:stream_encrypt(State0,Data), + {Ssh#ssh{encrypt_ctx = State}, Enc}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -690,7 +722,21 @@ decrypt_init(#ssh{decrypt = 'aes128-cbc', role = server} = Ssh) -> hash(Ssh, "C", 128)}, <<K:16/binary>> = KD, {ok, Ssh#ssh{decrypt_keys = K, decrypt_ctx = IV, - decrypt_block_size = 16}}. + decrypt_block_size = 16}}; +decrypt_init(#ssh{decrypt = 'aes128-ctr', role = client} = Ssh) -> + IV = hash(Ssh, "B", 128), + <<K:16/binary>> = hash(Ssh, "D", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{decrypt_keys = K, + decrypt_block_size = 16, + decrypt_ctx = State}}; +decrypt_init(#ssh{decrypt = 'aes128-ctr', role = server} = Ssh) -> + IV = hash(Ssh, "A", 128), + <<K:16/binary>> = hash(Ssh, "C", 128), + State = crypto:stream_init(aes_ctr, K, IV), + {ok, Ssh#ssh{decrypt_keys = K, + decrypt_block_size = 16, + decrypt_ctx = State}}. decrypt_final(Ssh) -> @@ -711,7 +757,11 @@ decrypt(#ssh{decrypt = 'aes128-cbc', decrypt_keys = Key, decrypt_ctx = IV0} = Ssh, Data) -> Dec = crypto:block_decrypt(aes_cbc128, Key,IV0,Data), IV = crypto:next_iv(aes_cbc, Data), - {Ssh#ssh{decrypt_ctx = IV}, Dec}. + {Ssh#ssh{decrypt_ctx = IV}, Dec}; +decrypt(#ssh{decrypt = 'aes128-ctr', + decrypt_ctx = State0} = Ssh, Data) -> + {State, Enc} = crypto:stream_decrypt(State0,Data), + {Ssh#ssh{decrypt_ctx = State}, Enc}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Compression @@ -846,7 +896,9 @@ mac('hmac-sha1-96', Key, SeqNum, Data) -> mac('hmac-md5', Key, SeqNum, Data) -> crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data]); mac('hmac-md5-96', Key, SeqNum, Data) -> - crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-md5-96')). + crypto:hmac(md5, Key, [<<?UINT32(SeqNum)>>, Data], mac_digest_size('hmac-md5-96')); +mac('hmac-sha2-256', Key, SeqNum, Data) -> + crypto:hmac(sha256, Key, [<<?UINT32(SeqNum)>>, Data]). %% return N hash bytes (HASH) hash(SSH, Char, Bits) -> @@ -911,12 +963,14 @@ mac_key_size('hmac-sha1') -> 20*8; mac_key_size('hmac-sha1-96') -> 20*8; mac_key_size('hmac-md5') -> 16*8; mac_key_size('hmac-md5-96') -> 16*8; +mac_key_size('hmac-sha2-256')-> 32*8; mac_key_size(none) -> 0. mac_digest_size('hmac-sha1') -> 20; mac_digest_size('hmac-sha1-96') -> 12; mac_digest_size('hmac-md5') -> 20; mac_digest_size('hmac-md5-96') -> 12; +mac_digest_size('hmac-sha2-256') -> 32; mac_digest_size(none) -> 0. peer_name({Host, _}) -> diff --git a/lib/ssh/test/property_test/README b/lib/ssh/test/property_test/README new file mode 100644 index 0000000000..57602bf719 --- /dev/null +++ b/lib/ssh/test/property_test/README @@ -0,0 +1,12 @@ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +The test in this directory are written assuming that the user has a QuickCheck license. They are to be run manually. Some may be possible to be run with other tools, e.g. PropEr. + diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server.erl b/lib/ssh/test/property_test/ssh_eqc_client_server.erl new file mode 100644 index 0000000000..3a84acebb3 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server.erl @@ -0,0 +1,602 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ssh_eqc_client_server). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +-ifdef(PROPER). +%% Proper is not supported. +-else. + +-include_lib("eqc/include/eqc.hrl"). +-include_lib("eqc/include/eqc_statem.hrl"). +-eqc_group_commands(true). + +-define(SSH_DIR,"ssh_eqc_client_server_dirs"). + +-define(sec, *1000). +-define(min, *60?sec). + +-record(srvr,{ref, + address, + port + }). + +-record(conn,{ref, + srvr_ref + }). + +-record(chan, {ref, + conn_ref, + subsystem, + client_pid + }). + +-record(state,{ + initialized = false, + servers = [], % [#srvr{}] + clients = [], + connections = [], % [#conn{}] + channels = [], % [#chan{}] + data_dir + }). + +%%%=============================================================== +%%% +%%% Specification of addresses, subsystems and such. +%%% + +-define(MAX_NUM_SERVERS, 3). +-define(MAX_NUM_CLIENTS, 3). + +-define(SUBSYSTEMS, ["echo1", "echo2", "echo3", "echo4"]). + +-define(SERVER_ADDRESS, { {127,1,1,1}, inet_port({127,1,1,1}) }). + +-define(SERVER_EXTRA_OPTIONS, [{parallel_login,bool()}] ). + + +%%%================================================================ +%%% +%%% The properties - one sequantial and one parallel with the same model +%%% +%%% Run as +%%% +%%% $ (cd ..; make) +%%% $ erl -pz .. +%%% +%%% eqc:quickcheck( ssh_eqc_client_server:prop_seq() ). +%%% eqc:quickcheck( ssh_eqc_client_server:prop_parallel() ). +%%% eqc:quickcheck( ssh_eqc_client_server:prop_parallel_multi() ). +%%% + + +%% To be called as eqc:quickcheck( ssh_eqc_client_server:prop_seq() ). +prop_seq() -> + do_prop_seq(?SSH_DIR). + +%% To be called from a common_test test suite +prop_seq(CT_Config) -> + do_prop_seq(full_path(?SSH_DIR, CT_Config)). + + +do_prop_seq(DataDir) -> + ?FORALL(Cmds,commands(?MODULE, #state{data_dir=DataDir}), + begin + {H,Sf,Result} = run_commands(?MODULE,Cmds), + present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) + end). + +full_path(SSHdir, CT_Config) -> + filename:join(proplists:get_value(property_dir, CT_Config), + SSHdir). +%%%---- +prop_parallel() -> + do_prop_parallel(?SSH_DIR). + +%% To be called from a common_test test suite +prop_parallel(CT_Config) -> + do_prop_parallel(full_path(?SSH_DIR, CT_Config)). + +do_prop_parallel(DataDir) -> + ?FORALL(Cmds,parallel_commands(?MODULE, #state{data_dir=DataDir}), + begin + {H,Sf,Result} = run_parallel_commands(?MODULE,Cmds), + present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) + end). + +%%%---- +prop_parallel_multi() -> + do_prop_parallel_multi(?SSH_DIR). + +%% To be called from a common_test test suite +prop_parallel_multi(CT_Config) -> + do_prop_parallel_multi(full_path(?SSH_DIR, CT_Config)). + +do_prop_parallel_multi(DataDir) -> + ?FORALL(Repetitions,?SHRINK(1,[10]), + ?FORALL(Cmds,parallel_commands(?MODULE, #state{data_dir=DataDir}), + ?ALWAYS(Repetitions, + begin + {H,Sf,Result} = run_parallel_commands(?MODULE,Cmds), + present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) + end))). + +%%%================================================================ +%%% State machine spec + +%%% called when using commands/1 +initial_state() -> + S = initial_state(#state{}), + S#state{initialized=true}. + +%%% called when using commands/2 +initial_state(S) -> + application:stop(ssh), + ssh:start(), + setup_rsa(S#state.data_dir). + +%%%---------------- +weight(S, ssh_send) -> 5*length([C || C<-S#state.channels, has_subsyst(C)]); +weight(S, ssh_start_subsyst) -> 3*length([C || C<-S#state.channels, no_subsyst(C)]); +weight(S, ssh_close_channel) -> 2*length([C || C<-S#state.channels, has_subsyst(C)]); +weight(S, ssh_open_channel) -> length(S#state.connections); +weight(_S, _) -> 1. + +%%%---------------- +%%% Initialize + +initial_state_pre(S) -> not S#state.initialized. + +initial_state_args(S) -> [S]. + +initial_state_next(S, _, _) -> S#state{initialized=true}. + +%%%---------------- +%%% Start a new daemon +%%% Precondition: not more than ?MAX_NUM_SERVERS started + +ssh_server_pre(S) -> S#state.initialized andalso + length(S#state.servers) < ?MAX_NUM_SERVERS. + +ssh_server_args(S) -> [?SERVER_ADDRESS, S#state.data_dir, ?SERVER_EXTRA_OPTIONS]. + +ssh_server({IP,Port}, DataDir, ExtraOptions) -> + ok(ssh:daemon(IP, Port, + [ + {system_dir, system_dir(DataDir)}, + {user_dir, user_dir(DataDir)}, + {subsystems, [{SS, {ssh_eqc_subsys, [SS]}} || SS <- ?SUBSYSTEMS]} + | ExtraOptions + ])). + +ssh_server_post(_S, _Args, Result) -> is_ok(Result). + +ssh_server_next(S, Result, [{IP,Port},_,_]) -> + S#state{servers=[#srvr{ref = Result, + address = IP, + port = Port} + | S#state.servers]}. + +%%%---------------- +%%% Start a new client +%%% Precondition: not more than ?MAX_NUM_CLIENTS started + +ssh_client_pre(S) -> S#state.initialized andalso + length(S#state.clients) < ?MAX_NUM_CLIENTS. + +ssh_client_args(_S) -> []. + +ssh_client() -> spawn(fun client_init/0). + +ssh_client_next(S, Pid, _) -> S#state{clients=[Pid|S#state.clients]}. + + +client_init() -> client_loop(). + +client_loop() -> + receive + {please_do,Fun,Ref,Pid} -> + Pid ! {my_pleasure, catch Fun(), Ref}, + client_loop() + end. + +do(Pid, Fun) -> do(Pid, Fun, 30?sec). + +do(Pid, Fun, Timeout) when is_function(Fun,0) -> + Pid ! {please_do,Fun,Ref=make_ref(),self()}, + receive + {my_pleasure, Result, Ref} -> Result + after + Timeout -> {error,do_timeout} + end. + +%%%---------------- +%%% Start a new connection +%%% Precondition: deamon exists + +ssh_open_connection_pre(S) -> S#state.servers /= []. + +ssh_open_connection_args(S) -> [oneof(S#state.servers), S#state.data_dir]. + +ssh_open_connection(#srvr{address=Ip, port=Port}, DataDir) -> + ok(ssh:connect(ensure_string(Ip), Port, + [ + {silently_accept_hosts, true}, + {user_dir, user_dir(DataDir)}, + {user_interaction, false} + ])). + +ssh_open_connection_post(_S, _Args, Result) -> is_ok(Result). + +ssh_open_connection_next(S, ConnRef, [#srvr{ref=SrvrRef},_]) -> + S#state{connections=[#conn{ref=ConnRef, srvr_ref=SrvrRef}|S#state.connections]}. + +%%%---------------- +%%% Stop a new connection +%%% Precondition: connection exists + +ssh_close_connection_pre(S) -> S#state.connections /= []. + +ssh_close_connection_args(S) -> [oneof(S#state.connections)]. + +ssh_close_connection(#conn{ref=ConnectionRef}) -> ssh:close(ConnectionRef). + +ssh_close_connection_next(S, _, [Conn=#conn{ref=ConnRef}]) -> + S#state{connections = S#state.connections--[Conn], + channels = [C || C <- S#state.channels, + C#chan.conn_ref /= ConnRef] + }. + +%%%---------------- +%%% Start a new channel without a sub system +%%% Precondition: connection exists + +ssh_open_channel_pre(S) -> S#state.connections /= []. + +ssh_open_channel_args(S) -> [oneof(S#state.connections)]. + +%%% For re-arrangement in parallel tests. +ssh_open_channel_pre(S,[C]) -> lists:member(C,S#state.connections). + +ssh_open_channel(#conn{ref=ConnectionRef}) -> + ok(ssh_connection:session_channel(ConnectionRef, 20?sec)). + +ssh_open_channel_post(_S, _Args, Result) -> is_ok(Result). + +ssh_open_channel_next(S, ChannelRef, [#conn{ref=ConnRef}]) -> + S#state{channels=[#chan{ref=ChannelRef, + conn_ref=ConnRef} + | S#state.channels]}. + +%%%---------------- +%%% Stop a channel +%%% Precondition: a channel exists, with or without a subsystem + +ssh_close_channel_pre(S) -> S#state.channels /= []. + +ssh_close_channel_args(S) -> [oneof(S#state.channels)]. + +ssh_close_channel(#chan{ref=ChannelRef, conn_ref=ConnectionRef}) -> + ssh_connection:close(ConnectionRef, ChannelRef). + +ssh_close_channel_next(S, _, [C]) -> + S#state{channels = [Ci || Ci <- S#state.channels, + sig(C) /= sig(Ci)]}. + + +sig(C) -> {C#chan.ref, C#chan.conn_ref}. + + +%%%---------------- +%%% Start a sub system on a channel +%%% Precondition: A channel without subsystem exists + +ssh_start_subsyst_pre(S) -> lists:any(fun no_subsyst/1, S#state.channels) andalso + S#state.clients /= []. + +ssh_start_subsyst_args(S) -> [oneof(lists:filter(fun no_subsyst/1, S#state.channels)), + oneof(?SUBSYSTEMS), + oneof(S#state.clients) + ]. + +%% For re-arrangement in parallel tests. +ssh_start_subsyst_pre(S, [C|_]) -> lists:member(C,S#state.channels) + andalso no_subsyst(C). + +ssh_start_subsyst(#chan{ref=ChannelRef, conn_ref=ConnectionRef}, SubSystem, Pid) -> + do(Pid, fun()->ssh_connection:subsystem(ConnectionRef, ChannelRef, SubSystem, 120?sec) end). + +ssh_start_subsyst_post(_S, _Args, Result) -> Result==success. + +ssh_start_subsyst_next(S, _Result, [C,SS,Pid|_]) -> + S#state{channels = [C#chan{subsystem=SS, + client_pid=Pid}|(S#state.channels--[C])] }. + +%%%---------------- +%%% Send a message on a channel +%%% Precondition: a channel exists with a subsystem connected + +ssh_send_pre(S) -> lists:any(fun has_subsyst/1, S#state.channels). + +ssh_send_args(S) -> [oneof(lists:filter(fun has_subsyst/1, S#state.channels)), + choose(0,1), + message()]. + +%% For re-arrangement in parallel tests. +ssh_send_pre(S, [C|_]) -> lists:member(C, S#state.channels). + +ssh_send(C=#chan{conn_ref=ConnectionRef, ref=ChannelRef, client_pid=Pid}, Type, Msg) -> + do(Pid, + fun() -> + case ssh_connection:send(ConnectionRef, ChannelRef, Type, modify_msg(C,Msg), 10?sec) of + ok -> + receive + {ssh_cm,ConnectionRef,{data,ChannelRef,Type,Answer}} -> Answer + after 15?sec -> + %% receive + %% Other -> {error,{unexpected,Other}} + %% after 0 -> + {error,receive_timeout} + %% end + end; + Other -> + Other + end + end). + +ssh_send_blocking(_S, _Args) -> + true. + +ssh_send_post(_S, [C,_,Msg], Response) when is_binary(Response) -> + Expected = ssh_eqc_subsys:response(modify_msg(C,Msg), C#chan.subsystem), + case Response of + Expected -> true; + _ -> {send_failed, size(Response), size(Expected)} + end; + +ssh_send_post(_S, _Args, Response) -> + {error,Response}. + + +modify_msg(_, <<>>) -> <<>>; +modify_msg(#chan{subsystem=SS}, Msg) -> <<(list_to_binary(SS))/binary,Msg/binary>>. + +%%%================================================================ +%%% Misc functions + +message() -> + resize(500, binary()). + + %% binary(). + + %% oneof([binary(), + %% ?LET(Size, choose(0,10000), binary(Size)) + %% ]). + +has_subsyst(C) -> C#chan.subsystem /= undefined. + +no_subsyst(C) -> not has_subsyst(C). + + +ok({ok,X}) -> X; +ok({error,Err}) -> {error,Err}. + +is_ok({error,_}) -> false; +is_ok(_) -> true. + +ensure_string({A,B,C,D}) -> lists:flatten(io_lib:format("~w.~w.~w.~w",[A,B,C,D])); +ensure_string(X) -> X. + +%%%---------------------------------------------------------------- +present_result(_Module, Cmds, _Triple, true) -> + aggregate(with_title("Distribution sequential/parallel"), sequential_parallel(Cmds), + aggregate(with_title("Function calls"), cmnd_names(Cmds), + aggregate(with_title("Message sizes"), empty_msgs(Cmds), + aggregate(print_frequencies(), message_sizes(Cmds), + aggregate(title("Length of command sequences",print_frequencies()), num_calls(Cmds), + true))))); + +present_result(Module, Cmds, Triple, false) -> + pretty_commands(Module, Cmds, Triple, [{show_states,true}], false). + + + +cmnd_names(Cs) -> traverse_commands(fun cmnd_name/1, Cs). +cmnd_name(L) -> [F || {set,_Var,{call,_Mod,F,_As}} <- L]. + +empty_msgs(Cs) -> traverse_commands(fun empty_msg/1, Cs). +empty_msg(L) -> [empty || {set,_,{call,_,ssh_send,[_,_,Msg]}} <- L, + size(Msg)==0]. + +message_sizes(Cs) -> traverse_commands(fun message_size/1, Cs). +message_size(L) -> [size(Msg) || {set,_,{call,_,ssh_send,[_,_,Msg]}} <- L]. + +num_calls(Cs) -> traverse_commands(fun num_call/1, Cs). +num_call(L) -> [length(L)]. + +sequential_parallel(Cs) -> + traverse_commands(fun(L) -> dup_module(L, sequential) end, + fun(L) -> [dup_module(L1, mkmod("parallel",num(L1,L))) || L1<-L] end, + Cs). +dup_module(L, ModName) -> lists:duplicate(length(L), ModName). +mkmod(PfxStr,N) -> list_to_atom(PfxStr++"_"++integer_to_list(N)). + +%% Meta functions for the aggregate functions +traverse_commands(Fun, L) when is_list(L) -> Fun(L); +traverse_commands(Fun, {Seq, ParLs}) -> Fun(lists:append([Seq|ParLs])). + +traverse_commands(Fseq, _Fpar, L) when is_list(L) -> Fseq(L); +traverse_commands(Fseq, Fpar, {Seq, ParLs}) -> lists:append([Fseq(Seq)|Fpar(ParLs)]). + +%%%---------------- +%% PrintMethod([{term(), int()}]) -> any(). +print_frequencies() -> print_frequencies(10). + +print_frequencies(Ngroups) -> fun([]) -> io:format('Empty list!~n',[]); + (L ) -> print_frequencies(L,Ngroups,0,element(1,lists:last(L))) + end. + +print_frequencies(Ngroups, MaxValue) -> fun(L) -> print_frequencies(L,Ngroups,0,MaxValue) end. + +print_frequencies(L, N, Min, Max) when N>Max -> print_frequencies(L++[{N,0}], N, Min, N); +print_frequencies(L, N, Min, Max) -> +%%io:format('L=~p~n',[L]), + try + IntervalUpperLimits = + lists:reverse( + [Max | tl(lists:reverse(lists:seq(Min,Max,round((Max-Min)/N))))] + ), + {Acc0,_} = lists:mapfoldl(fun(Upper,Lower) -> + {{{Lower,Upper},0}, Upper+1} + end, hd(IntervalUpperLimits), tl(IntervalUpperLimits)), + Fs0 = get_frequencies(L, Acc0), + SumVal = lists:sum([V||{_,V}<-Fs0]), + Fs = with_percentage(Fs0, SumVal), + Mean = mean(L), + Median = median(L), + Npos_value = num_digits(SumVal), + Npos_range = num_digits(Max), + io:format("Range~*s: ~s~n",[2*Npos_range-2,"", "Number in range"]), + io:format("~*c:~*c~n",[2*Npos_range+3,$-, max(16,Npos_value+10),$- ]), + [begin + io:format("~*w - ~*w: ~*w ~5.1f%",[Npos_range,Rlow, + Npos_range,Rhigh, + Npos_value,Val, + Percent]), + [io:format(" <-- mean=~.1f",[Mean]) || in_interval(Mean, Interval)], + [io:format(" <-- median=" ++ + if + is_float(Median) -> "~.1f"; + true -> "~p" + end, [Median]) || in_interval(Median, Interval)], + io:nl() + end + || {Interval={Rlow,Rhigh},Val,Percent} <- Fs], + io:format('~*c ~*c~n',[2*Npos_range,32,Npos_value+2,$-]), + io:format('~*c ~*w~n',[2*Npos_range,32,Npos_value,SumVal]) + %%,io:format('L=~p~n',[L]) + catch + C:E -> + io:format('*** Faild printing (~p:~p) for~n~p~n',[C,E,L]) + end. + +get_frequencies([{I,Num}|T], [{{Lower,Upper},Cnt}|Acc]) when Lower=<I,I=<Upper -> + get_frequencies(T, [{{Lower,Upper},Cnt+Num}|Acc]); +get_frequencies(L=[{I,_Num}|_], [Ah={{_Lower,Upper},_Cnt}|Acc]) when I>Upper -> + [Ah | get_frequencies(L,Acc)]; +get_frequencies([], Acc) -> + Acc. + +with_percentage(Fs, Sum) -> + [{Rng,Val,100*Val/Sum} || {Rng,Val} <- Fs]. + + +title(Str, Fun) -> + fun(L) -> + io:format('~s~n',[Str]), + Fun(L) + end. + +num_digits(I) -> 1+trunc(math:log(I)/math:log(10)). + +num(Elem, List) -> length(lists:takewhile(fun(E) -> E /= Elem end, List)) + 1. + +%%%---- Just for naming an operation for readability +is_odd(I) -> (I rem 2) == 1. + +in_interval(Value, {Rlow,Rhigh}) -> + try + Rlow=<round(Value) andalso round(Value)=<Rhigh + catch + _:_ -> false + end. + +%%%================================================================ +%%% Statistical functions + +%%%---- Mean value +mean(L = [X|_]) when is_number(X) -> + lists:sum(L) / length(L); +mean(L = [{_Value,_Weight}|_]) -> + SumOfWeights = lists:sum([W||{_,W}<-L]), + WeightedSum = lists:sum([W*V||{V,W}<-L]), + WeightedSum / SumOfWeights; +mean(_) -> + undefined. + +%%%---- Median +median(L = [X|_]) when is_number(X) -> + case is_odd(length(L)) of + true -> + hd(lists:nthtail(length(L) div 2, L)); + false -> + %% 1) L has at least on element (the when test). + %% 2) Length is even. + %% => Length >= 2 + [M1,M2|_] = lists:nthtail((length(L) div 2)-1, L), + (M1+M2) / 2 + end; +%% integer Weights... +median(L = [{_Value,_Weight}|_]) -> + median( lists:append([lists:duplicate(W,V) || {V,W} <- L]) ); +median(_) -> + undefined. + +%%%================================================================ +%%% The rest is taken and modified from ssh_test_lib.erl +inet_port(IpAddress)-> + {ok, Socket} = gen_tcp:listen(0, [{ip,IpAddress},{reuseaddr,true}]), + {ok, Port} = inet:port(Socket), + gen_tcp:close(Socket), + Port. + +setup_rsa(Dir) -> + erase_dir(system_dir(Dir)), + erase_dir(user_dir(Dir)), + file:make_dir(system_dir(Dir)), + file:make_dir(user_dir(Dir)), + + file:copy(data_dir(Dir,"id_rsa"), user_dir(Dir,"id_rsa")), + file:copy(data_dir(Dir,"ssh_host_rsa_key"), system_dir(Dir,"ssh_host_rsa_key")), + file:copy(data_dir(Dir,"ssh_host_rsa_key"), system_dir(Dir,"ssh_host_rsa_key.pub")), + ssh_test_lib:setup_rsa_known_host(data_dir(Dir), user_dir(Dir)), + ssh_test_lib:setup_rsa_auth_keys(data_dir(Dir), user_dir(Dir)). + +data_dir(Dir, File) -> filename:join(Dir, File). +system_dir(Dir, File) -> filename:join([Dir, "system", File]). +user_dir(Dir, File) -> filename:join([Dir, "user", File]). + +data_dir(Dir) -> Dir. +system_dir(Dir) -> system_dir(Dir,""). +user_dir(Dir) -> user_dir(Dir,""). + +erase_dir(Dir) -> + case file:list_dir(Dir) of + {ok,Files} -> lists:foreach(fun(F) -> file:delete(filename:join(Dir,F)) end, + Files); + _ -> ok + end, + file:del_dir(Dir). + +-endif. diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_dsa b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_rsa b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/id_rsa @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key.pub b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key.pub b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_client_server_dirs/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl new file mode 100644 index 0000000000..6ddf2c9972 --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_encode_decode.erl @@ -0,0 +1,381 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ssh_eqc_encode_decode). + +-compile(export_all). + +-ifndef(EQC). +-ifndef(PROPER). +-define(EQC,true). +%%-define(PROPER,true). +-endif. +-endif. + +-ifdef(EQC). +-include_lib("eqc/include/eqc.hrl"). +-define(MOD_eqc,eqc). +-else. +-ifdef(PROPER). +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc,proper). +-endif. +-endif. + + +%%% Properties: + +prop_ssh_decode() -> + ?FORALL(Msg, ssh_msg(), + try ssh_message:decode(Msg) + of + _ -> true + catch + C:E -> io:format('~p:~p~n',[C,E]), + false + end + ). + + +%%% This fails because ssh_message is not symmetric in encode and decode regarding data types +prop_ssh_decode_encode() -> + ?FORALL(Msg, ssh_msg(), + Msg == ssh_message:encode(ssh_message:decode(Msg)) + ). + + +%%%================================================================ +%%% +%%% Scripts to generate message generators +%%% + +%% awk '/^( |\t)+byte( |\t)+SSH/,/^( |\t)*$/{print}' rfc425?.txt | sed 's/^\( \|\\t\)*//' > msgs.txt + +%% awk '/^byte( |\t)+SSH/{print $2","}' < msgs.txt + +%% awk 'BEGIN{print "%%%---- BEGIN GENERATED";prev=0} END{print " >>.\n%%%---- END GENERATED"} /^byte( |\t)+SSH/{if (prev==1) print " >>.\n"; prev=1; printf "%c%s%c",39,$2,39; print "()->\n <<?"$2;next} /^string( |\t)+\"/{print " ,"$2;next} /^string( |\t)+.*address/{print " ,(ssh_string_address())/binary %%",$2,$3,$4,$5,$6;next}/^string( |\t)+.*US-ASCII/{print " ,(ssh_string_US_ASCII())/binary %%",$2,$3,$4,$5,$6;next} /^string( |\t)+.*UTF-8/{print " ,(ssh_string_UTF_8())/binary %% ",$2,$3,$4,$5,$6;next} /^[a-z0-9]+( |\t)/{print " ,(ssh_"$1"())/binary %%",$2,$3,$4,$5,$6;next} /^byte\[16\]( |\t)+/{print" ,(ssh_byte_16())/binary %%",$2,$3,$4,$5,$6;next} /^name-list( |\t)+/{print" ,(ssh_name_list())/binary %%",$2,$3,$4,$5,$6;next} /./{print "?? %%",$0}' < msgs.txt > gen.txt + +%%%================================================================ +%%% +%%% Generators +%%% + +ssh_msg() -> ?LET(M,oneof( +[[msg_code('SSH_MSG_CHANNEL_CLOSE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_DATA'),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_EOF'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_EXTENDED_DATA'),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_FAILURE'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("direct-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("forwarded-tcpip"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("session"),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string("x11"),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN'),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_CONFIRMATION'),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_OPEN_FAILURE'),gen_uint32(),gen_uint32(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("env"),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exec"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-signal"),0,gen_string( ),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("exit-status"),0,gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("pty-req"),gen_boolean(),gen_string( ),gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("shell"),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("signal"),0,gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("subsystem"),gen_boolean(),gen_string( )], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("window-change"),0,gen_uint32(),gen_uint32(),gen_uint32(),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("x11-req"),gen_boolean(),gen_boolean(),gen_string( ),gen_string( ),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string("xon-xoff"),0,gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_REQUEST'),gen_uint32(),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_CHANNEL_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_CHANNEL_WINDOW_ADJUST'),gen_uint32(),gen_uint32()], +%%Assym [msg_code('SSH_MSG_DEBUG'),gen_boolean(),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_DISCONNECT'),gen_uint32(),gen_string( ),gen_string( )], +%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("cancel-tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], +%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string("tcpip-forward"),gen_boolean(),gen_string( ),gen_uint32()], +%%Assym [msg_code('SSH_MSG_GLOBAL_REQUEST'),gen_string( ),gen_boolean()], + [msg_code('SSH_MSG_IGNORE'),gen_string( )], + %% [msg_code('SSH_MSG_KEXDH_INIT'),gen_mpint()], + %% [msg_code('SSH_MSG_KEXDH_REPLY'),gen_string( ),gen_mpint(),gen_string( )], + %% [msg_code('SSH_MSG_KEXINIT'),gen_byte(16),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_name_list(),gen_boolean(),gen_uint32()], + [msg_code('SSH_MSG_KEX_DH_GEX_GROUP'),gen_mpint(),gen_mpint()], + [msg_code('SSH_MSG_NEWKEYS')], + [msg_code('SSH_MSG_REQUEST_FAILURE')], + [msg_code('SSH_MSG_REQUEST_SUCCESS')], + [msg_code('SSH_MSG_REQUEST_SUCCESS'),gen_uint32()], + [msg_code('SSH_MSG_SERVICE_ACCEPT'),gen_string( )], + [msg_code('SSH_MSG_SERVICE_REQUEST'),gen_string( )], + [msg_code('SSH_MSG_UNIMPLEMENTED'),gen_uint32()], + [msg_code('SSH_MSG_USERAUTH_BANNER'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_FAILURE'),gen_name_list(),gen_boolean()], + [msg_code('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_PK_OK'),gen_string( ),gen_string( )], + [msg_code('SSH_MSG_USERAUTH_SUCCESS')] +] + +), list_to_binary(M)). + + +%%%================================================================ +%%% +%%% Generator +%%% + +do() -> + io_lib:format('[~s~n]', + [write_gen( + files(["rfc4254.txt", + "rfc4253.txt", + "rfc4419.txt", + "rfc4252.txt", + "rfc4256.txt"]))]). + + +write_gen(L) when is_list(L) -> + string:join(lists:map(fun write_gen/1, L), ",\n "); +write_gen({MsgName,Args}) -> + lists:flatten(["[",generate_args([MsgName|Args]),"]"]). + +generate_args(As) -> string:join([generate_arg(A) || A <- As], ","). + +generate_arg({<<"string">>, <<"\"",B/binary>>}) -> + S = get_string($",B), + ["gen_string(\"",S,"\")"]; +generate_arg({<<"string">>, _}) -> "gen_string( )"; +generate_arg({<<"byte[",B/binary>>, _}) -> + io_lib:format("gen_byte(~p)",[list_to_integer(get_string($],B))]); +generate_arg({<<"byte">> ,_}) -> "gen_byte()"; +generate_arg({<<"uint16">>,_}) -> "gen_uint16()"; +generate_arg({<<"uint32">>,_}) -> "gen_uint32()"; +generate_arg({<<"uint64">>,_}) -> "gen_uint64()"; +generate_arg({<<"mpint">>,_}) -> "gen_mpint()"; +generate_arg({<<"name-list">>,_}) -> "gen_name_list()"; +generate_arg({<<"boolean">>,<<"FALSE">>}) -> "0"; +generate_arg({<<"boolean">>,<<"TRUE">>}) -> "1"; +generate_arg({<<"boolean">>,_}) -> "gen_boolean()"; +generate_arg({<<"....">>,_}) -> ""; %% FIXME +generate_arg(Name) when is_binary(Name) -> + lists:flatten(["msg_code('",binary_to_list(Name),"')"]). + + +gen_boolean() -> choose(0,1). + +gen_byte() -> choose(0,255). + +gen_uint16() -> gen_byte(2). + +gen_uint32() -> gen_byte(4). + +gen_uint64() -> gen_byte(8). + +gen_byte(N) when N>0 -> [gen_byte() || _ <- lists:seq(1,N)]. + +gen_char() -> choose($a,$z). + +gen_mpint() -> ?LET(Size, choose(1,20), + ?LET(Str, vector(Size, gen_byte()), + gen_string( strip_0s(Str) ) + )). + +strip_0s([0|T]) -> strip_0s(T); +strip_0s(X) -> X. + + +gen_string() -> + ?LET(Size, choose(0,10), + ?LET(Vector,vector(Size, gen_char()), + gen_string(Vector) + )). + +gen_string(S) when is_binary(S) -> gen_string(binary_to_list(S)); +gen_string(S) when is_list(S) -> uint32_to_list(length(S)) ++ S. + +gen_name_list() -> + ?LET(NumNames, choose(0,10), + ?LET(L, [gen_name() || _ <- lists:seq(1,NumNames)], + gen_string( string:join(L,"," ) ) + )). + +gen_name() -> gen_string(). + +uint32_to_list(I) -> binary_to_list(<<I:32/unsigned-big-integer>>). + +%%%---- +get_string(Delim, B) -> + binary_to_list( element(1, split_binary(B, count_string_chars(Delim,B,0))) ). + +count_string_chars(Delim, <<Delim,_/binary>>, Acc) -> Acc; +count_string_chars(Delim, <<_,B/binary>>, Acc) -> count_string_chars(Delim, B, Acc+1). + + +-define(MSG_CODE(Name,Num), +msg_code(Name) -> Num; +msg_code(Num) -> Name +). + +?MSG_CODE('SSH_MSG_USERAUTH_REQUEST', 50); +?MSG_CODE('SSH_MSG_USERAUTH_FAILURE', 51); +?MSG_CODE('SSH_MSG_USERAUTH_SUCCESS', 52); +?MSG_CODE('SSH_MSG_USERAUTH_BANNER', 53); +?MSG_CODE('SSH_MSG_USERAUTH_PK_OK', 60); +?MSG_CODE('SSH_MSG_USERAUTH_PASSWD_CHANGEREQ', 60); +?MSG_CODE('SSH_MSG_DISCONNECT', 1); +?MSG_CODE('SSH_MSG_IGNORE', 2); +?MSG_CODE('SSH_MSG_UNIMPLEMENTED', 3); +?MSG_CODE('SSH_MSG_DEBUG', 4); +?MSG_CODE('SSH_MSG_SERVICE_REQUEST', 5); +?MSG_CODE('SSH_MSG_SERVICE_ACCEPT', 6); +?MSG_CODE('SSH_MSG_KEXINIT', 20); +?MSG_CODE('SSH_MSG_NEWKEYS', 21); +?MSG_CODE('SSH_MSG_GLOBAL_REQUEST', 80); +?MSG_CODE('SSH_MSG_REQUEST_SUCCESS', 81); +?MSG_CODE('SSH_MSG_REQUEST_FAILURE', 82); +?MSG_CODE('SSH_MSG_CHANNEL_OPEN', 90); +?MSG_CODE('SSH_MSG_CHANNEL_OPEN_CONFIRMATION', 91); +?MSG_CODE('SSH_MSG_CHANNEL_OPEN_FAILURE', 92); +?MSG_CODE('SSH_MSG_CHANNEL_WINDOW_ADJUST', 93); +?MSG_CODE('SSH_MSG_CHANNEL_DATA', 94); +?MSG_CODE('SSH_MSG_CHANNEL_EXTENDED_DATA', 95); +?MSG_CODE('SSH_MSG_CHANNEL_EOF', 96); +?MSG_CODE('SSH_MSG_CHANNEL_CLOSE', 97); +?MSG_CODE('SSH_MSG_CHANNEL_REQUEST', 98); +?MSG_CODE('SSH_MSG_CHANNEL_SUCCESS', 99); +?MSG_CODE('SSH_MSG_CHANNEL_FAILURE', 100); +?MSG_CODE('SSH_MSG_USERAUTH_INFO_REQUEST', 60); +?MSG_CODE('SSH_MSG_USERAUTH_INFO_RESPONSE', 61); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST_OLD', 30); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REQUEST', 34); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_GROUP', 31); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_INIT', 32); +?MSG_CODE('SSH_MSG_KEX_DH_GEX_REPLY', 33). + +%%%============================================================================= +%%%============================================================================= +%%%============================================================================= + +files(Fs) -> + Defs = lists:usort(lists:flatten(lists:map(fun file/1, Fs))), + DefinedIDs = lists:usort([binary_to_list(element(1,D)) || D <- Defs]), + WantedIDs = lists:usort(wanted_messages()), + Missing = WantedIDs -- DefinedIDs, + case Missing of + [] -> ok; + _ -> io:format('%% Warning: missing ~p~n', [Missing]) + end, + Defs. + + +file(F) -> + {ok,B} = file:read_file(F), + hunt_msg_def(B). + + +hunt_msg_def(<<"\n",B/binary>>) -> some_hope(skip_blanks(B)); +hunt_msg_def(<<_, B/binary>>) -> hunt_msg_def(B); +hunt_msg_def(<<>>) -> []. + +some_hope(<<"byte ", B/binary>>) -> try_message(skip_blanks(B)); +some_hope(B) -> hunt_msg_def(B). + +try_message(B = <<"SSH_MSG_",_/binary>>) -> + {ID,Rest} = get_id(B), + case lists:member(binary_to_list(ID), wanted_messages()) of + true -> + {Lines,More} = get_def_lines(skip_blanks(Rest), []), + [{ID,lists:reverse(Lines)} | hunt_msg_def(More)]; + false -> + hunt_msg_def(Rest) + end; +try_message(B) -> hunt_msg_def(B). + + +skip_blanks(<<32, B/binary>>) -> skip_blanks(B); +skip_blanks(<< 9, B/binary>>) -> skip_blanks(B); +skip_blanks(B) -> B. + +get_def_lines(B0 = <<"\n",B/binary>>, Acc) -> + {ID,Rest} = get_id(skip_blanks(B)), + case {size(ID), skip_blanks(Rest)} of + {0,<<"....",More/binary>>} -> + {Text,LineEnd} = get_to_eol(skip_blanks(More)), + get_def_lines(LineEnd, [{<<"....">>,Text}|Acc]); + {0,_} -> + {Acc,B0}; + {_,Rest1} -> + {Text,LineEnd} = get_to_eol(Rest1), + get_def_lines(LineEnd, [{ID,Text}|Acc]) + end; +get_def_lines(B, Acc) -> + {Acc,B}. + + +get_to_eol(B) -> split_binary(B, count_to_eol(B,0)). + +count_to_eol(<<"\n",_/binary>>, Acc) -> Acc; +count_to_eol(<<>>, Acc) -> Acc; +count_to_eol(<<_,B/binary>>, Acc) -> count_to_eol(B,Acc+1). + + +get_id(B) -> split_binary(B, count_id_chars(B,0)). + +count_id_chars(<<C,B/binary>>, Acc) when $A=<C,C=<$Z -> count_id_chars(B,Acc+1); +count_id_chars(<<C,B/binary>>, Acc) when $a=<C,C=<$z -> count_id_chars(B,Acc+1); +count_id_chars(<<C,B/binary>>, Acc) when $0=<C,C=<$9 -> count_id_chars(B,Acc+1); +count_id_chars(<<"_",B/binary>>, Acc) -> count_id_chars(B,Acc+1); +count_id_chars(<<"-",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g name-list +count_id_chars(<<"[",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] +count_id_chars(<<"]",B/binary>>, Acc) -> count_id_chars(B,Acc+1); %% e.g byte[16] +count_id_chars(_, Acc) -> Acc. + +wanted_messages() -> + ["SSH_MSG_CHANNEL_CLOSE", + "SSH_MSG_CHANNEL_DATA", + "SSH_MSG_CHANNEL_EOF", + "SSH_MSG_CHANNEL_EXTENDED_DATA", + "SSH_MSG_CHANNEL_FAILURE", + "SSH_MSG_CHANNEL_OPEN", + "SSH_MSG_CHANNEL_OPEN_CONFIRMATION", + "SSH_MSG_CHANNEL_OPEN_FAILURE", + "SSH_MSG_CHANNEL_REQUEST", + "SSH_MSG_CHANNEL_SUCCESS", + "SSH_MSG_CHANNEL_WINDOW_ADJUST", + "SSH_MSG_DEBUG", + "SSH_MSG_DISCONNECT", + "SSH_MSG_GLOBAL_REQUEST", + "SSH_MSG_IGNORE", + "SSH_MSG_KEXDH_INIT", + "SSH_MSG_KEXDH_REPLY", + "SSH_MSG_KEXINIT", + "SSH_MSG_KEX_DH_GEX_GROUP", + "SSH_MSG_KEX_DH_GEX_REQUEST", + "SSH_MSG_KEX_DH_GEX_REQUEST_OLD", + "SSH_MSG_NEWKEYS", + "SSH_MSG_REQUEST_FAILURE", + "SSH_MSG_REQUEST_SUCCESS", + "SSH_MSG_SERVICE_ACCEPT", + "SSH_MSG_SERVICE_REQUEST", + "SSH_MSG_UNIMPLEMENTED", + "SSH_MSG_USERAUTH_BANNER", + "SSH_MSG_USERAUTH_FAILURE", +%% hard args "SSH_MSG_USERAUTH_INFO_REQUEST", +%% "SSH_MSG_USERAUTH_INFO_RESPONSE", + "SSH_MSG_USERAUTH_PASSWD_CHANGEREQ", + "SSH_MSG_USERAUTH_PK_OK", +%%rfc4252 p12 error "SSH_MSG_USERAUTH_REQUEST", + "SSH_MSG_USERAUTH_SUCCESS"]. + diff --git a/lib/ssh/test/property_test/ssh_eqc_subsys.erl b/lib/ssh/test/property_test/ssh_eqc_subsys.erl new file mode 100644 index 0000000000..e4b6af166f --- /dev/null +++ b/lib/ssh/test/property_test/ssh_eqc_subsys.erl @@ -0,0 +1,63 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(ssh_eqc_subsys). + +-behaviour(ssh_daemon_channel). + +-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]). + +-export([response/2]). + +-record(state, {id, + cm, + subsyst + }). + +init([SS]) -> + {ok, #state{subsyst=SS}}. + +handle_msg({ssh_channel_up, ChannelId, ConnectionManager}, State) -> + {ok, State#state{id = ChannelId, + cm = ConnectionManager}}. + +handle_ssh_msg({ssh_cm, CM, {data, ChannelId, Type, Data}}, S) -> + ssh_connection:send(CM, ChannelId, Type, response(Data,S)), + {ok, S}; + +handle_ssh_msg({ssh_cm, _ConnectionManager, {eof, _ChannelId}}, State) -> + {ok, State}; + +handle_ssh_msg({ssh_cm, _, {signal, _, _}}, State) -> + %% Ignore signals according to RFC 4254 section 6.9. + {ok, State}; + +handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, _Error, _}}, State) -> + {stop, ChannelId, State}; + +handle_ssh_msg({ssh_cm, _, {exit_status, ChannelId, _Status}}, State) -> + {stop, ChannelId, State}. + +terminate(_Reason, _State) -> + ok. + + +response(Msg, #state{subsyst=SS}) -> response(Msg, SS); +response(Msg, SS) -> <<"Resp: ",Msg/binary,(list_to_binary(SS))/binary>>. diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index bf7fb4c73e..9242731924 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -53,13 +53,21 @@ all() -> {group, hardening_tests} ]. -groups() -> +groups() -> [{dsa_key, [], basic_tests()}, {rsa_key, [], basic_tests()}, {dsa_pass_key, [], [pass_phrase]}, {rsa_pass_key, [], [pass_phrase]}, {internal_error, [], [internal_error]}, - {hardening_tests, [], [max_sessions]} + {hardening_tests, [], [ssh_connect_nonegtimeout_connected_parallel, + ssh_connect_nonegtimeout_connected_sequential, + ssh_connect_negtimeout_parallel, + ssh_connect_negtimeout_sequential, + max_sessions_ssh_connect_parallel, + max_sessions_ssh_connect_sequential, + max_sessions_sftp_start_channel_parallel, + max_sessions_sftp_start_channel_sequential + ]} ]. @@ -743,6 +751,98 @@ ms_passed(N1={_,_,M1}, N2={_,_,M2}) -> 1000 * (Min*60 + Sec + (M2-M1)/1000000). %%-------------------------------------------------------------------- +ssh_connect_negtimeout_parallel(Config) -> ssh_connect_negtimeout(Config,true). +ssh_connect_negtimeout_sequential(Config) -> ssh_connect_negtimeout(Config,false). + +ssh_connect_negtimeout(Config, Parallel) -> + process_flag(trap_exit, true), + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), + NegTimeOut = 2000, % ms + ct:log("Parallel: ~p",[Parallel]), + + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, + {parallel_login, Parallel}, + {negotiation_timeout, NegTimeOut}, + {failfun, fun ssh_test_lib:failfun/2}]), + + {ok,Socket} = gen_tcp:connect(Host, Port, []), + ct:pal("And now sleeping 1.2*NegTimeOut (~p ms)...", [round(1.2 * NegTimeOut)]), + receive after round(1.2 * NegTimeOut) -> ok end, + + case inet:sockname(Socket) of + {ok,_} -> ct:fail("Socket not closed"); + {error,_} -> ok + end. + +%%-------------------------------------------------------------------- +ssh_connect_nonegtimeout_connected_parallel() -> + [{doc, "Test that ssh connection does not timeout if the connection is established (parallel)"}]. +ssh_connect_nonegtimeout_connected_parallel(Config) -> + ssh_connect_nonegtimeout_connected(Config, true). + +ssh_connect_nonegtimeout_connected_sequential() -> + [{doc, "Test that ssh connection does not timeout if the connection is established (non-parallel)"}]. +ssh_connect_nonegtimeout_connected_sequential(Config) -> + ssh_connect_nonegtimeout_connected(Config, false). + + +ssh_connect_nonegtimeout_connected(Config, Parallel) -> + process_flag(trap_exit, true), + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), + NegTimeOut = 20000, % ms + ct:log("Parallel: ~p",[Parallel]), + + {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, + {parallel_login, Parallel}, + {negotiation_timeout, NegTimeOut}, + {failfun, fun ssh_test_lib:failfun/2}]), + ct:sleep(500), + + IO = ssh_test_lib:start_io_server(), + Shell = ssh_test_lib:start_shell(Port, IO, UserDir), + receive + {'EXIT', _, _} -> + ct:fail(no_ssh_connection); + ErlShellStart -> + ct:pal("---Erlang shell start: ~p~n", [ErlShellStart]), + one_shell_op(IO, NegTimeOut), + one_shell_op(IO, NegTimeOut), + ct:pal("And now sleeping 1.2*NegTimeOut (~p ms)...", [round(1.2 * NegTimeOut)]), + receive after round(1.2 * NegTimeOut) -> ok end, + one_shell_op(IO, NegTimeOut) + end, + exit(Shell, kill). + + +one_shell_op(IO, TimeOut) -> + ct:pal("One shell op: Waiting for prompter"), + receive + ErlPrompt0 -> ct:log("Erlang prompt: ~p~n", [ErlPrompt0]) + after TimeOut -> ct:fail("Timeout waiting for promter") + end, + + IO ! {input, self(), "2*3*7.\r\n"}, + receive + Echo0 -> ct:log("Echo: ~p ~n", [Echo0]) + after TimeOut -> ct:fail("Timeout waiting for echo") + end, + + receive + ?NEWLINE -> ct:log("NEWLINE received", []) + after TimeOut -> + receive Any1 -> ct:log("Bad NEWLINE: ~p",[Any1]) + after 0 -> ct:fail("Timeout waiting for NEWLINE") + end + end, + + receive + Result0 -> ct:log("Result: ~p~n", [Result0]) + after TimeOut -> ct:fail("Timeout waiting for result") + end. + +%%-------------------------------------------------------------------- openssh_zlib_basic_test() -> [{doc, "Test basic connection with openssh_zlib"}]. @@ -763,40 +863,87 @@ openssh_zlib_basic_test(Config) -> %%-------------------------------------------------------------------- -max_sessions(Config) -> +max_sessions_ssh_connect_parallel(Config) -> + max_sessions(Config, true, connect_fun(ssh__connect,Config)). +max_sessions_ssh_connect_sequential(Config) -> + max_sessions(Config, false, connect_fun(ssh__connect,Config)). + +max_sessions_sftp_start_channel_parallel(Config) -> + max_sessions(Config, true, connect_fun(ssh_sftp__start_channel, Config)). +max_sessions_sftp_start_channel_sequential(Config) -> + max_sessions(Config, false, connect_fun(ssh_sftp__start_channel, Config)). + + +%%%---- helpers: +connect_fun(ssh__connect, Config) -> + fun(Host,Port) -> + ssh_test_lib:connect(Host, Port, + [{silently_accept_hosts, true}, + {user_dir, ?config(priv_dir,Config)}, + {user_interaction, false}, + {user, "carni"}, + {password, "meat"} + ]) + %% ssh_test_lib returns R when ssh:connect returns {ok,R} + end; +connect_fun(ssh_sftp__start_channel, _Config) -> + fun(Host,Port) -> + {ok,_Pid,ConnRef} = + ssh_sftp:start_channel(Host, Port, + [{silently_accept_hosts, true}, + {user, "carni"}, + {password, "meat"} + ]), + ConnRef + end. + + +max_sessions(Config, ParallelLogin, Connect) when is_function(Connect,2) -> SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), - MaxSessions = 2, - {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + MaxSessions = 5, + {Pid, Host, Port} = ssh_test_lib:daemon([ + {system_dir, SystemDir}, {user_dir, UserDir}, {user_passwords, [{"carni", "meat"}]}, - {parallel_login, true}, + {parallel_login, ParallelLogin}, {max_sessions, MaxSessions} ]), - Connect = fun() -> - R=ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, - {user_dir, UserDir}, - {user_interaction, false}, - {user, "carni"}, - {password, "meat"} - ]), - ct:log("Connection ~p up",[R]) - end, - - try [Connect() || _ <- lists:seq(1,MaxSessions)] + try [Connect(Host,Port) || _ <- lists:seq(1,MaxSessions)] of - _ -> - ct:pal("Expect Info Report:",[]), - try Connect() + Connections -> + %% Step 1 ok: could set up max_sessions connections + ct:log("Connections up: ~p",[Connections]), + [_|_] = Connections, + + %% Now try one more than alowed: + ct:pal("Info Report might come here...",[]), + try Connect(Host,Port) of - _ConnectionRef -> + _ConnectionRef1 -> ssh:stop_daemon(Pid), {fail,"Too many connections accepted"} catch error:{badmatch,{error,"Connection closed"}} -> - ssh:stop_daemon(Pid), - ok + %% Step 2 ok: could not set up max_sessions+1 connections + %% This is expected + %% Now stop one connection and try to open one more + ok = ssh:close(hd(Connections)), + try Connect(Host,Port) + of + _ConnectionRef1 -> + %% Step 3 ok: could set up one more connection after killing one + %% Thats good. + ssh:stop_daemon(Pid), + ok + catch + error:{badmatch,{error,"Connection closed"}} -> + %% Bad indeed. Could not set up one more connection even after killing + %% one existing. Very bad. + ssh:stop_daemon(Pid), + {fail,"Does not decrease # active sessions"} + end end catch error:{badmatch,{error,"Connection closed"}} -> diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index f4f0682b40..c115ccee5f 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -37,7 +37,10 @@ suite() -> all() -> [ {group, openssh_payload}, - interrupted_send + interrupted_send, + start_shell, + start_shell_exec, + start_shell_exec_fun ]. groups() -> [{openssh_payload, [], [simple_exec, @@ -276,6 +279,106 @@ interrupted_send(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +start_shell() -> + [{doc, "Start a shell"}]. + +start_shell(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {shell, fun(U, H) -> start_our_shell(U, H) end} ]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + ok = ssh_connection:shell(ConnectionRef,ChannelId0), + + receive + {ssh_cm,ConnectionRef, {data, ChannelId, 0, <<"Enter command\r\n">>}} -> + ok + after 5000 -> + ct:fail("CLI Timeout") + end, + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). +%%-------------------------------------------------------------------- +start_shell_exec() -> + [{doc, "start shell to exec command"}]. + +start_shell_exec(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {exec, {?MODULE,ssh_exec,[]}} ]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + + success = ssh_connection:exec(ConnectionRef, ChannelId0, + "testing", infinity), + receive + {ssh_cm,ConnectionRef, {data, ChannelId, 0, <<"testing\r\n">>}} -> + ok + after 5000 -> + ct:fail("Exec Timeout") + end, + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- +start_shell_exec_fun() -> + [{doc, "start shell to exec command"}]. + +start_shell_exec_fun(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {exec, fun ssh_exec/1}]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, true}, + {user_dir, UserDir}]), + + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + + success = ssh_connection:exec(ConnectionRef, ChannelId0, + "testing", infinity), + + receive + {ssh_cm,ConnectionRef, {data, ChannelId, 0, <<"testing\r\n">>}} -> + ok + after 5000 -> + ct:fail("Exec Timeout") + end, + + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). +%%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- big_cat_rx(ConnectionRef, ChannelId) -> @@ -308,3 +411,16 @@ collect_data(ConnectionRef, ChannelId, Acc) -> after 5000 -> timeout end. + +%%%------------------------------------------------------------------- +% This is taken from the ssh example code. +start_our_shell(_User, _Peer) -> + spawn(fun() -> + io:format("Enter command\n") + %% Don't actually loop, just exit + end). + +ssh_exec(Cmd) -> + spawn(fun() -> + io:format(Cmd ++ "\n") + end). diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl new file mode 100644 index 0000000000..c6c63d7367 --- /dev/null +++ b/lib/ssh/test/ssh_property_test_SUITE.erl @@ -0,0 +1,109 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%%% Run like this: +%%% ct:run_test([{suite,"ssh_property_test_SUITE"}, {logdir,"/ldisk/OTP/LOG"}]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(ssh_property_test_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +all() -> [{group, messages}, + {group, client_server} + ]. + +groups() -> + [{messages, [], [decode, + decode_encode]}, + {client_server, [], [client_server_sequential, + client_server_parallel, + client_server_parallel_multi]} + ]. + + +%%% First prepare Config and compile the property tests for the found tool: +init_per_suite(Config) -> + ct_property_test:init_per_suite(Config). + +%%% One group in this suite happens to support only QuickCheck, so skip it +%%% if we run proper. +init_per_group(client_server, Config) -> + case ?config(property_test_tool,Config) of + proper -> + {skip, "PropEr is not supported"}; + eqc -> + Config + end; +init_per_group(_, Config) -> + Config. + +end_per_group(_, Config) -> + Config. + +%%% Always skip the testcase that is not quite in phase with the +%%% ssh_message.erl code +init_per_testcase(decode_encode, _) -> {skip, "Fails - testcase is not ok"}; +init_per_testcase(_TestCase, Config) -> Config. + +end_per_testcase(_TestCase, Config) -> Config. + +%%%================================================================ +%%% Test suites +%%% +decode(Config) -> + ct_property_test:quickcheck( + ssh_eqc_encode_decode:prop_ssh_decode(), + Config + ). + +decode_encode(Config) -> + ct_property_test:quickcheck( + ssh_eqc_encode_decode:prop_ssh_decode_encode(), + Config + ). + +client_server_sequential(Config) -> + ct_property_test:quickcheck( + ssh_eqc_client_server:prop_seq(Config), + Config + ). + +client_server_parallel(Config) -> + ct_property_test:quickcheck( + ssh_eqc_client_server:prop_parallel(Config), + Config + ). + +client_server_parallel_multi(Config) -> + ct_property_test:quickcheck( + ssh_eqc_client_server:prop_parallel_multi(Config), + Config + ). diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 8b5343cecc..3500bf012b 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -54,7 +54,9 @@ groups() -> ]}, {erlang_server, [], [erlang_server_openssh_client_exec, erlang_server_openssh_client_exec_compressed, - erlang_server_openssh_client_pulic_key_dsa]} + erlang_server_openssh_client_pulic_key_dsa, + erlang_server_openssh_client_cipher_suites, + erlang_server_openssh_client_macs]} ]. init_per_suite(Config) -> @@ -89,6 +91,12 @@ end_per_group(erlang_server, Config) -> end_per_group(_, Config) -> Config. +init_per_testcase(erlang_server_openssh_client_cipher_suites, Config) -> + check_ssh_client_support(Config); + +init_per_testcase(erlang_server_openssh_client_macs, Config) -> + check_ssh_client_support(Config); + init_per_testcase(_TestCase, Config) -> ssh:start(), Config. @@ -221,6 +229,108 @@ erlang_server_openssh_client_exec(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- +erlang_server_openssh_client_cipher_suites() -> + [{doc, "Test that we can connect with different cipher suites."}]. + +erlang_server_openssh_client_cipher_suites(Config) when is_list(Config) -> + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}]), + + + ct:sleep(500), + + Supports = crypto:supports(), + Ciphers = proplists:get_value(ciphers, Supports), + Tests = [ + {"3des-cbc", lists:member(des3_cbc, Ciphers)}, + {"aes128-cbc", lists:member(aes_cbc128, Ciphers)}, + {"aes128-ctr", lists:member(aes_ctr, Ciphers)}, + {"aes256-cbc", false} + ], + lists:foreach(fun({Cipher, Expect}) -> + Cmd = "ssh -p " ++ integer_to_list(Port) ++ + " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " " ++ + " -c " ++ Cipher ++ " 1+1.", + + ct:pal("Cmd: ~p~n", [Cmd]), + + SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), + + case Expect of + true -> + receive + {SshPort,{data, <<"2\n">>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive answer") + end; + false -> + receive + {SshPort,{data, <<"no matching cipher found", _/binary>>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive no matching cipher message") + end + end + end, Tests), + + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- +erlang_server_openssh_client_macs() -> + [{doc, "Test that we can connect with different MACs."}]. + +erlang_server_openssh_client_macs(Config) when is_list(Config) -> + SystemDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + KnownHosts = filename:join(PrivDir, "known_hosts"), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {failfun, fun ssh_test_lib:failfun/2}]), + + + ct:sleep(500), + + Supports = crypto:supports(), + Hashs = proplists:get_value(hashs, Supports), + MACs = [{"hmac-sha1", lists:member(sha, Hashs)}, + {"hmac-sha2-256", lists:member(sha256, Hashs)}, + {"hmac-md5-96", false}, + {"hmac-ripemd160", false}], + lists:foreach(fun({MAC, Expect}) -> + Cmd = "ssh -p " ++ integer_to_list(Port) ++ + " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " " ++ + " -o MACs=" ++ MAC ++ " 1+1.", + + ct:pal("Cmd: ~p~n", [Cmd]), + + SshPort = open_port({spawn, Cmd}, [binary, stderr_to_stdout]), + + case Expect of + true -> + receive + {SshPort,{data, <<"2\n">>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive answer") + end; + false -> + receive + {SshPort,{data, <<"no matching mac found", _/binary>>}} -> + ok + after ?TIMEOUT -> + ct:fail("Did not receive no matching mac message") + end + end + end, MACs), + + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- erlang_server_openssh_client_exec_compressed() -> [{doc, "Test that exec command works."}]. @@ -433,3 +543,25 @@ receive_hej() -> ct:pal("Extra info: ~p~n", [Info]), receive_hej() end. + +%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- +%% Check if we have a "newer" ssh client that supports these test cases +%%-------------------------------------------------------------------- +check_ssh_client_support(Config) -> + Port = open_port({spawn, "ssh -Q cipher"}, [exit_status, stderr_to_stdout]), + case check_ssh_client_support2(Port) of + 0 -> % exit status from command (0 == ok) + ssh:start(), + Config; + _ -> + {skip, "test case not supported by ssh client"} + end. + +check_ssh_client_support2(P) -> + receive + {P, {data, _A}} -> + check_ssh_client_support2(P); + {P, {exit_status, E}} -> + E + end. diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 8d1a7ae54f..73bf73971f 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 3.0.3 +SSH_VSN = 3.0.5 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl_protocol.xml b/lib/ssl/doc/src/ssl_protocol.xml index cdfafe224b..80d9cc4ee8 100644 --- a/lib/ssl/doc/src/ssl_protocol.xml +++ b/lib/ssl/doc/src/ssl_protocol.xml @@ -83,7 +83,7 @@ <em>subject</em>. The certificate is signed with the private key of the issuer of the certificate. A chain of trust is build by having the issuer in its turn being - certified by an other certificate and so on until you reach the + certified by another certificate and so on until you reach the so called root certificate that is self signed i.e. issued by itself.</p> diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index b186a1015a..53366b060c 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014 All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -232,7 +232,12 @@ find_issuer(OtpCert, CertDbHandle) -> IsIssuerFun = fun({_Key, {_Der, #'OTPCertificate'{} = ErlCertCandidate}}, Acc) -> case public_key:pkix_is_issuer(OtpCert, ErlCertCandidate) of true -> - throw(public_key:pkix_issuer_id(ErlCertCandidate, self)); + case verify_cert_signer(OtpCert, ErlCertCandidate#'OTPCertificate'.tbsCertificate) of + true -> + throw(public_key:pkix_issuer_id(ErlCertCandidate, self)); + false -> + Acc + end; false -> Acc end; @@ -254,3 +259,19 @@ is_valid_extkey_usage(KeyUse, client) -> is_valid_extkey_usage(KeyUse, server) -> %% Server wants to verify client is_valid_key_usage(KeyUse, ?'id-kp-clientAuth'). + +verify_cert_signer(OtpCert, SignerTBSCert) -> + PublicKey = public_key(SignerTBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo), + public_key:pkix_verify(public_key:pkix_encode('OTPCertificate', OtpCert, otp), PublicKey). + +public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorithm = ?'id-ecPublicKey', + parameters = Params}, + subjectPublicKey = Point}) -> + {Point, Params}; +public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorithm = ?'rsaEncryption'}, + subjectPublicKey = Key}) -> + Key; +public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorithm = ?'id-dsa', + parameters = {params, Params}}, + subjectPublicKey = Key}) -> + {Key, Params}. diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index fc67d2c28d..94ffd180c5 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -201,13 +201,13 @@ client_certificate_verify(OwnCert, MasterSecret, Version, end. %%-------------------------------------------------------------------- --spec certificate_request(ssl_cipher:erl_cipher_suite(), db_handle(), certdb_ref(), ssl_record:ssl_version()) -> +-spec certificate_request(ssl_cipher:cipher_suite(), db_handle(), certdb_ref(), ssl_record:ssl_version()) -> #certificate_request{}. %% %% Description: Creates a certificate_request message, called by the server. %%-------------------------------------------------------------------- certificate_request(CipherSuite, CertDbHandle, CertDbRef, Version) -> - Types = certificate_types(CipherSuite), + Types = certificate_types(ssl_cipher:suite_definition(CipherSuite), Version), HashSigns = advertised_hash_signs(Version), Authorities = certificate_authorities(CertDbHandle, CertDbRef), #certificate_request{ @@ -1098,19 +1098,31 @@ supported_ecc(_) -> %%-------------certificate handling -------------------------------- -certificate_types({KeyExchange, _, _, _}) - when KeyExchange == rsa; - KeyExchange == dhe_dss; - KeyExchange == dhe_rsa; - KeyExchange == ecdhe_rsa -> - <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>; +certificate_types(_, {N, M}) when N >= 3 andalso M >= 3 -> + case proplists:get_bool(ecdsa, + proplists:get_value(public_keys, crypto:supports())) of + true -> + <<?BYTE(?ECDSA_SIGN), ?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>; + false -> + <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>> + end; + +certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == rsa; + KeyExchange == dhe_rsa; + KeyExchange == ecdhe_rsa -> + <<?BYTE(?RSA_SIGN)>>; -certificate_types({KeyExchange, _, _, _}) - when KeyExchange == dh_ecdsa; - KeyExchange == dhe_ecdsa -> +certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == dhe_dss; + KeyExchange == srp_dss -> + <<?BYTE(?DSS_SIGN)>>; + +certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == dh_ecdsa; + KeyExchange == dhe_ecdsa; + KeyExchange == ecdh_ecdsa; + KeyExchange == ecdhe_ecdsa -> <<?BYTE(?ECDSA_SIGN)>>; -certificate_types(_) -> +certificate_types(_, _) -> <<?BYTE(?RSA_SIGN)>>. certificate_authorities(CertDbHandle, CertDbRef) -> @@ -1719,6 +1731,11 @@ dec_hello_extensions(<<?UINT16(?EC_POINT_FORMATS_EXT), ?UINT16(Len), dec_hello_extensions(Rest, Acc#hello_extensions{ec_point_formats = #ec_point_formats{ec_point_format_list = ECPointFormats}}); + +dec_hello_extensions(<<?UINT16(?SNI_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, Acc) -> + <<?UINT16(_), NameList/binary>> = ExtData, + dec_hello_extensions(Rest, Acc#hello_extensions{sni = dec_sni(NameList)}); %% Ignore data following the ClientHello (i.e., %% extensions) if not understood. @@ -1731,6 +1748,13 @@ dec_hello_extensions(_, Acc) -> dec_hashsign(<<?BYTE(HashAlgo), ?BYTE(SignAlgo)>>) -> {ssl_cipher:hash_algorithm(HashAlgo), ssl_cipher:sign_algorithm(SignAlgo)}. +%% Ignore unknown names (only host_name is supported) +dec_sni(<<?BYTE(?SNI_NAMETYPE_HOST_NAME), ?UINT16(Len), + HostName:Len/binary, _/binary>>) -> + #sni{hostname = binary_to_list(HostName)}; +dec_sni(<<?BYTE(_), ?UINT16(Len), _:Len, Rest/binary>>) -> dec_sni(Rest); +dec_sni(_) -> undefined. + decode_next_protocols({next_protocol_negotiation, Protocols}) -> decode_next_protocols(Protocols, []). decode_next_protocols(<<>>, Acc) -> diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl index 22dc951ac1..daf4466f11 100644 --- a/lib/ssl/test/erl_make_certs.erl +++ b/lib/ssl/test/erl_make_certs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -325,14 +325,14 @@ sign_algorithm(#'RSAPrivateKey'{}, Opts) -> {Type, 'NULL'}; sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) -> {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}; -sign_algorithm(#'ECPrivateKey'{}, Opts) -> +sign_algorithm(#'ECPrivateKey'{parameters = Parms}, Opts) -> Type = case proplists:get_value(digest, Opts, sha1) of sha1 -> ?'ecdsa-with-SHA1'; sha512 -> ?'ecdsa-with-SHA512'; sha384 -> ?'ecdsa-with-SHA384'; sha256 -> ?'ecdsa-with-SHA256' end, - {Type, 'NULL'}. + {Type, Parms}. make_key(rsa, _Opts) -> %% (OBS: for testing only) diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl index 608f2f11c3..77e4c80bbe 100644 --- a/lib/ssl/test/ssl_ECC_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -57,41 +57,51 @@ all_versions_groups ()-> ]. key_cert_combinations() -> - [client_ec_server_ec, - client_rsa_server_ec, - client_ec_server_rsa, - client_rsa_server_rsa]. + [client_ecdh_server_ecdh, + client_rsa_server_ecdh, + client_ecdh_server_rsa, + client_rsa_server_rsa, + client_ecdsa_server_ecdsa, + client_ecdsa_server_rsa, + client_rsa_server_ecdsa + ]. %%-------------------------------------------------------------------- -init_per_suite(Config) -> - catch crypto:stop(), +init_per_suite(Config0) -> + end_per_suite(Config0), try crypto:start() of ok -> - ssl:start(), - Config + %% make rsa certs using oppenssl + Result = + (catch make_certs:all(?config(data_dir, Config0), + ?config(priv_dir, Config0))), + ct:log("Make certs ~p~n", [Result]), + Config1 = ssl_test_lib:make_ecdsa_cert(Config0), + Config2 = ssl_test_lib:make_ecdh_rsa_cert(Config1), + ssl_test_lib:cert_options(Config2) catch _:_ -> {skip, "Crypto did not start"} end. end_per_suite(_Config) -> - ssl:stop(), + application:stop(ssl), application:stop(crypto). %%-------------------------------------------------------------------- -init_per_group(erlang_client, Config) -> +init_per_group(erlang_client = Group, Config) -> case ssl_test_lib:is_sane_ecc(openssl) of true -> - common_init_per_group(erlang_client, [{server_type, openssl}, - {client_type, erlang} | Config]); + common_init_per_group(Group, [{server_type, openssl}, + {client_type, erlang} | Config]); false -> {skip, "Known ECC bug in openssl"} end; -init_per_group(erlang_server, Config) -> +init_per_group(erlang_server = Group, Config) -> case ssl_test_lib:is_sane_ecc(openssl) of true -> - common_init_per_group(erlang_client, [{server_type, erlang}, - {client_type, openssl} | Config]); + common_init_per_group(Group, [{server_type, erlang}, + {client_type, openssl} | Config]); false -> {skip, "Known ECC bug in openssl"} end; @@ -99,11 +109,21 @@ init_per_group(erlang_server, Config) -> init_per_group(erlang = Group, Config) -> case ssl_test_lib:sufficient_crypto_support(Group) of true -> - common_init_per_group(erlang, [{server_type, erlang}, - {client_type, erlang} | Config]); + common_init_per_group(Group, [{server_type, erlang}, + {client_type, erlang} | Config]); + false -> + {skip, "Crypto does not support ECC"} + end; + +init_per_group(openssl = Group, Config) -> + case ssl_test_lib:sufficient_crypto_support(Group) of + true -> + common_init_per_group(Group, [{server_type, openssl}, + {client_type, openssl} | Config]); false -> {skip, "Crypto does not support ECC"} - end; + end; + init_per_group(Group, Config) -> common_init_per_group(Group, Config). @@ -121,76 +141,118 @@ end_per_group(_GroupName, Config) -> %%-------------------------------------------------------------------- -init_per_testcase(_TestCase, Config) -> +init_per_testcase(TestCase, Config) -> ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]), ct:log("Ciphers: ~p~n ", [ ssl:cipher_suites()]), + end_per_testcase(TestCase, Config), + ssl:start(), Config. -end_per_testcase(_TestCase, Config) -> +end_per_testcase(_TestCase, Config) -> + application:stop(ssl), Config. %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- -client_ec_server_ec(Config) when is_list(Config) -> - basic_test("ec1.crt", "ec1.key", "ec2.crt", "ec2.key", Config). - -client_ec_server_rsa(Config) when is_list(Config) -> - basic_test("ec1.crt", "ec1.key", "rsa1.crt", "rsa1.key", Config). +client_ecdh_server_ecdh(Config) when is_list(Config) -> + COpts = ?config(client_ecdh_rsa_opts, Config), + SOpts = ?config(server_ecdh_rsa_verify_opts, Config), + basic_test(COpts, SOpts, Config). + +client_ecdh_server_rsa(Config) when is_list(Config) -> + COpts = ?config(client_ecdh_rsa_opts, Config), + SOpts = ?config(server_verification_opts, Config), + basic_test(COpts, SOpts, Config). + +client_rsa_server_ecdh(Config) when is_list(Config) -> + COpts = ?config(client_verification_opts, Config), + SOpts = ?config(server_ecdh_rsa_verify_opts, Config), + basic_test(COpts, SOpts, Config). + +client_rsa_server_rsa(Config) when is_list(Config) -> + COpts = ?config(client_verification_opts, Config), + SOpts = ?config(server_verification_opts, Config), + basic_test(COpts, SOpts, Config). + +client_ecdsa_server_ecdsa(Config) when is_list(Config) -> + COpts = ?config(client_ecdsa_opts, Config), + SOpts = ?config(server_ecdsa_verify_opts, Config), + basic_test(COpts, SOpts, Config). -client_rsa_server_ec(Config) when is_list(Config) -> - basic_test("rsa1.crt", "rsa1.key", "ec2.crt", "ec2.key", Config). +client_ecdsa_server_rsa(Config) when is_list(Config) -> + COpts = ?config(client_ecdsa_opts, Config), + SOpts = ?config(server_verification_opts, Config), + basic_test(COpts, SOpts, Config). -client_rsa_server_rsa(Config) when is_list(Config) -> - basic_test("rsa1.crt", "rsa1.key", "rsa2.crt", "rsa2.key", Config). +client_rsa_server_ecdsa(Config) when is_list(Config) -> + COpts = ?config(client_verification_opts, Config), + SOpts = ?config(server_ecdsa_verify_opts, Config), + basic_test(COpts, SOpts, Config). %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- -basic_test(ClientCert, ClientKey, ServerCert, ServerKey, Config) -> - DataDir = ?config(data_dir, Config), +basic_test(COpts, SOpts, Config) -> + basic_test(proplists:get_value(certfile, COpts), + proplists:get_value(keyfile, COpts), + proplists:get_value(cacertfile, COpts), + proplists:get_value(certfile, SOpts), + proplists:get_value(keyfile, SOpts), + proplists:get_value(cacertfile, SOpts), + Config). + +basic_test(ClientCert, ClientKey, ClientCA, ServerCert, ServerKey, ServerCA, Config) -> SType = ?config(server_type, Config), CType = ?config(client_type, Config), {Server, Port} = start_server(SType, - filename:join(DataDir, "CA.pem"), - filename:join(DataDir, ServerCert), - filename:join(DataDir, ServerKey), + ClientCA, ServerCA, + ServerCert, + ServerKey, Config), - Client = start_client(CType, Port, filename:join(DataDir, "CA.pem"), - filename:join(DataDir, ClientCert), - filename:join(DataDir, ClientKey), Config), - check_result(Server, SType, Client, CType). + Client = start_client(CType, Port, ServerCA, ClientCA, + ClientCert, + ClientKey, Config), + check_result(Server, SType, Client, CType), + close(Server, Client). -start_client(openssl, Port, CA, Cert, Key, _) -> +start_client(openssl, Port, CA, OwnCa, Cert, Key, Config) -> + PrivDir = ?config(priv_dir, Config), + NewCA = new_ca(filename:join(PrivDir, "new_ca.pem"), CA, OwnCa), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ Cert ++ " -CAfile " ++ CA - ++ " -key " ++ Key ++ " -host localhost -msg", + Cmd = "openssl s_client -verify 2 -port " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ + " -cert " ++ Cert ++ " -CAfile " ++ NewCA + ++ " -key " ++ Key ++ " -host localhost -msg -debug", OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), true = port_command(OpenSslPort, "Hello world"), OpenSslPort; -start_client(erlang, Port, CA, Cert, Key, Config) -> +start_client(erlang, Port, CA, _, Cert, Key, Config) -> {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, {host, Hostname}, {from, self()}, {mfa, {ssl_test_lib, send_recv_result_active, []}}, - {options, [{verify, verify_peer}, {cacertfile, CA}, + {options, [{verify, verify_peer}, + {cacertfile, CA}, {certfile, Cert}, {keyfile, Key}]}]). -start_server(openssl, CA, Cert, Key, _) -> +start_server(openssl, CA, OwnCa, Cert, Key, Config) -> + PrivDir = ?config(priv_dir, Config), + NewCA = new_ca(filename:join(PrivDir, "new_ca.pem"), CA, OwnCa), + Port = ssl_test_lib:inet_port(node()), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ ssl_test_lib:version_flag(Version) ++ - " -cert " ++ Cert ++ " -CAfile " ++ CA - ++ " -key " ++ Key ++ " -Verify 2 -msg", + " -verify 2 -cert " ++ Cert ++ " -CAfile " ++ NewCA + ++ " -key " ++ Key ++ " -msg -debug", OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), ssl_test_lib:wait_for_openssl_server(), true = port_command(OpenSslPort, "Hello world"), {OpenSslPort, Port}; -start_server(erlang, CA, Cert, Key, Config) -> +start_server(erlang, CA, _, Cert, Key, Config) -> + {_, ServerNode, _} = ssl_test_lib:run_where(Config), Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, {from, self()}, @@ -217,9 +279,31 @@ openssl_check(_, Config) -> TLSVersion = ?config(tls_version, Config), case ssl_test_lib:check_sane_openssl_version(TLSVersion) of true -> - ssl:start(), Config; false -> {skip, "TLS version not supported by openssl"} end. +close(Port1, Port2) when is_port(Port1), is_port(Port2) -> + ssl_test_lib:close_port(Port1), + ssl_test_lib:close_port(Port2); +close(Port, Pid) when is_port(Port) -> + ssl_test_lib:close_port(Port), + ssl_test_lib:close(Pid); +close(Pid, Port) when is_port(Port) -> + ssl_test_lib:close_port(Port), + ssl_test_lib:close(Pid); +close(Client, Server) -> + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%% Work around OpenSSL bug, apparently the same bug as we had fixed in +%% 11629690ba61f8e0c93ef9b2b6102fd279825977 +new_ca(FileName, CA, OwnCa) -> + {ok, P1} = file:read_file(CA), + E1 = public_key:pem_decode(P1), + {ok, P2} = file:read_file(OwnCa), + E2 = public_key:pem_decode(P2), + Pem = public_key:pem_encode(E2 ++E1), + file:write_file(FileName, Pem), + FileName. diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/CA.pem b/lib/ssl/test/ssl_ECC_SUITE_data/CA.pem deleted file mode 100644 index f82efdefc5..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/CA.pem +++ /dev/null @@ -1,14 +0,0 @@ ------BEGIN CERTIFICATE----- -MIICGjCCAYegAwIBAgIQZIIqq4RXfpBKJXV69Jc4BjAJBgUrDgMCHQUAMB0xGzAZ -BgNVBAMTEklTQSBUZXN0IEF1dGhvcml0eTAeFw0xMjAzMjAxNzEzMjFaFw0zOTEy -MzEyMzU5NTlaMB0xGzAZBgNVBAMTEklTQSBUZXN0IEF1dGhvcml0eTCBnzANBgkq -hkiG9w0BAQEFAAOBjQAwgYkCgYEAqnt6FSyFQVSDyP7mY63IhCzgysTxBEg1qDb8 -nBHj9REReZA5UQ5iyEOdTbdLyOaSk2rJyA2wdTjYkNnLzK49nZFlpf89r3/bakAM -wZv69S3FJi9W2z9m4JPv/5+QCYnFNRSnnHw3maNElwoQyknx96I3W7EuVOvKtKhh -4DaD0WsCAwEAAaNjMGEwDwYDVR0TAQH/BAUwAwEB/zBOBgNVHQEERzBFgBBCHwn2 -8AmbN+cvJl1iJ1bsoR8wHTEbMBkGA1UEAxMSSVNBIFRlc3QgQXV0aG9yaXR5ghBk -giqrhFd+kEoldXr0lzgGMAkGBSsOAwIdBQADgYEAIlVecua5Cr1z/cdwQ8znlgOU -U+y/uzg0nupKkopzVnRYhwV4hxZt3izAz4C/SJZB7eL0bUKlg1ceGjbQsGEm0fzF -LEV3vym4G51bxv03Iecwo96G4NgjJ7+9/7ciBVzfxZyfuCpYG1M2LyrbOyuevtTy -2+vIueT0lv6UftgBfIE= ------END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/ec1.crt b/lib/ssl/test/ssl_ECC_SUITE_data/ec1.crt deleted file mode 100644 index 7d2b9cde9d..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/ec1.crt +++ /dev/null @@ -1,11 +0,0 @@ ------BEGIN CERTIFICATE----- -MIIBhjCB8AIBBjANBgkqhkiG9w0BAQUFADAdMRswGQYDVQQDExJJU0EgVGVzdCBB -dXRob3JpdHkwHhcNMTMwODA4MTAxNDI3WhcNMjMwODA2MTAxNDI3WjBFMQswCQYD -VQQGEwJVUzERMA8GA1UECBMIVmlyZ2luaWExFTATBgNVBAcTDEZvcnQgQmVsdm9p -cjEMMAoGA1UEAxMDZWMxMFYwEAYHKoZIzj0CAQYFK4EEAAoDQgAEpiRIxUCESROR -P8IByg+vBv1fDdAg7yXfAh95GxFtvhBqZs6ATwaRKyLmZYgUm/4NUAyUeqmTBb7s -2msKo5mnNzANBgkqhkiG9w0BAQUFAAOBgQAmwzoB1DVO69FQOUdBVnyups4t0c1c -8h+1z/5P4EtPltk4o3mRn0AZogqdXCpNbuSGbSJh+dep5xW30VLxNHdc+tZSLK6j -pT7A3hymMk8qbi13hxeH/VpEP25y1EjHowow9Wmb6ebtT/v7qFQ9AAHD9ONcIM4I -FCC8vdFo7M5GgQ== ------END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/ec1.key b/lib/ssl/test/ssl_ECC_SUITE_data/ec1.key deleted file mode 100644 index 2dc9508b3c..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/ec1.key +++ /dev/null @@ -1,8 +0,0 @@ ------BEGIN EC PARAMETERS----- -BgUrgQQACg== ------END EC PARAMETERS----- ------BEGIN EC PRIVATE KEY----- -MHQCAQEEIOO0WK8znNzLyZIoGRIlaKnCNr2Wy8uk9i+GGFIhDGNAoAcGBSuBBAAK -oUQDQgAEpiRIxUCESRORP8IByg+vBv1fDdAg7yXfAh95GxFtvhBqZs6ATwaRKyLm -ZYgUm/4NUAyUeqmTBb7s2msKo5mnNw== ------END EC PRIVATE KEY----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/ec2.crt b/lib/ssl/test/ssl_ECC_SUITE_data/ec2.crt deleted file mode 100644 index b0558a0ebc..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/ec2.crt +++ /dev/null @@ -1,11 +0,0 @@ ------BEGIN CERTIFICATE----- -MIIBhjCB8AIBBzANBgkqhkiG9w0BAQUFADAdMRswGQYDVQQDExJJU0EgVGVzdCBB -dXRob3JpdHkwHhcNMTMwODA4MTAxNDM0WhcNMjMwODA2MTAxNDM0WjBFMQswCQYD -VQQGEwJVUzERMA8GA1UECBMIVmlyZ2luaWExFTATBgNVBAcTDEZvcnQgQmVsdm9p -cjEMMAoGA1UEAxMDZWMyMFYwEAYHKoZIzj0CAQYFK4EEAAoDQgAEzXaYReUyvoYl -FwGOe0MJEXWCUncMfr2xG4GMjGYlfZsvLGEokefsJIvW+I+9jgUT2UFjxFXYNAvm -uD1A1iWVWjANBgkqhkiG9w0BAQUFAAOBgQBFa6iIlrT9DWptIdB8uSYvp7qwiHxN -hiVH5YhGIHHqjGZqtRHrSxqNEYMXXrgH9Hxc6gDbk9PsHZyVVoh/HgVWddqW1inh -tStZm420PAKCuH4T6Cfsk76GE2m7FRzJvw9TM1f2A5nIy9abyrpup8lZGcIL4Kmq -1Fix1LRtrmLNTA== ------END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/ec2.key b/lib/ssl/test/ssl_ECC_SUITE_data/ec2.key deleted file mode 100644 index 366d13648b..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/ec2.key +++ /dev/null @@ -1,8 +0,0 @@ ------BEGIN EC PARAMETERS----- -BgUrgQQACg== ------END EC PARAMETERS----- ------BEGIN EC PRIVATE KEY----- -MHQCAQEEIPR3ORUpAFMTQhUJ0jllN38LKWziG8yP2H54Y/9vh1PwoAcGBSuBBAAK -oUQDQgAEzXaYReUyvoYlFwGOe0MJEXWCUncMfr2xG4GMjGYlfZsvLGEokefsJIvW -+I+9jgUT2UFjxFXYNAvmuD1A1iWVWg== ------END EC PRIVATE KEY----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.crt b/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.crt deleted file mode 100644 index ed9beacf68..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.crt +++ /dev/null @@ -1,20 +0,0 @@ ------BEGIN CERTIFICATE----- -MIIDVjCCAr8CAQkwDQYJKoZIhvcNAQEFBQAwHTEbMBkGA1UEAxMSSVNBIFRlc3Qg -QXV0aG9yaXR5MB4XDTEzMDgwODEwMTUzNFoXDTQwMTIyNDEwMTUzNFowRjELMAkG -A1UEBhMCVVMxETAPBgNVBAgTCFZpcmdpbmlhMRUwEwYDVQQHEwxGb3J0IEJlbHZv -aXIxDTALBgNVBAMTBHJzYTEwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoIC -AQC62v40w1AjV3oJuyYC2Fw6XhTOi1il6xZFnB9J1WhCmuxAB/VMhBcNypx38mNk -eQ7a/ERQ5ddhZey29DYeFYU8oqfDURgWx5USHufb90xBen9KPmX3VNuQ8ZFP2q8Q -b01/oRHBJQRBuaCtFHzpGIVBjC6dD5yeQgJsYaF4u+PBbonsIGROXMybcvUzXmjU -dwpy2NhjGQL5sWcOdIeRP43APSyRYvq4tuBUZk2XxWfBcvA8LpcoYPMlRTf6jGL1 -/fAAcCYJ9lh3h92w0NZ/7ZRa/ebTplxK6yqCftuSKui1KdL69m0WZqHl79AUSfs9 -lsOwx9lHkyYvJeMofyeDbZ+3OYLmVqEBG1fza2aV2XVh9zJ8fAwmXy/c2IDhw/oD -HAe/rSg/Sgt03ydIKqtZHbl3v0EexQQRlJRULIzdtON02dJMUd4EFUgQ9OUtEmC2 -Psj9Jdu1g5cevU7Mymu8Ot+fjHiGTcBUsXNuXFCbON3Gw7cIDl4+iv+cpDHHVC9L -HK3PMEq3vu3qOGXSz+LDOoqkfROcLG7BclBuN2zoVSsMHFkB4aJhwy7eHhGz0z2W -c6LTVd+GAApdY80kmjOjT//QxHEsX/n1useHza3OszQqZiArr4ub4rtq+l1DxAS/ -DWrZ/JGsbKL8cjWso6qBF94xTi8WhjkKuUYhsm+qLAbNOQIDAQABMA0GCSqGSIb3 -DQEBBQUAA4GBAIcuzqRkfypV/9Z85ZQCCoejPm5Urhv7dfg1/B3QtazogPBZLgL5 -e60fG1uAw5GmqTViHLvW06z73oQvJrFkrCLVvadDNtrKYKXnXqdkgVyk36F/B737 -A43HGnMfSxCfRhIOuKZB9clP5PiNlhw36yi3DratqT6TUvI69hg8a7jA ------END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.key b/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.key deleted file mode 100644 index 6e0d913d79..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/rsa1.key +++ /dev/null @@ -1,51 +0,0 @@ ------BEGIN RSA PRIVATE KEY----- -MIIJKAIBAAKCAgEAutr+NMNQI1d6CbsmAthcOl4UzotYpesWRZwfSdVoQprsQAf1 -TIQXDcqcd/JjZHkO2vxEUOXXYWXstvQ2HhWFPKKnw1EYFseVEh7n2/dMQXp/Sj5l -91TbkPGRT9qvEG9Nf6ERwSUEQbmgrRR86RiFQYwunQ+cnkICbGGheLvjwW6J7CBk -TlzMm3L1M15o1HcKctjYYxkC+bFnDnSHkT+NwD0skWL6uLbgVGZNl8VnwXLwPC6X -KGDzJUU3+oxi9f3wAHAmCfZYd4fdsNDWf+2UWv3m06ZcSusqgn7bkirotSnS+vZt -Fmah5e/QFEn7PZbDsMfZR5MmLyXjKH8ng22ftzmC5lahARtX82tmldl1YfcyfHwM -Jl8v3NiA4cP6AxwHv60oP0oLdN8nSCqrWR25d79BHsUEEZSUVCyM3bTjdNnSTFHe -BBVIEPTlLRJgtj7I/SXbtYOXHr1OzMprvDrfn4x4hk3AVLFzblxQmzjdxsO3CA5e -Por/nKQxx1QvSxytzzBKt77t6jhl0s/iwzqKpH0TnCxuwXJQbjds6FUrDBxZAeGi -YcMu3h4Rs9M9lnOi01XfhgAKXWPNJJozo0//0MRxLF/59brHh82tzrM0KmYgK6+L -m+K7avpdQ8QEvw1q2fyRrGyi/HI1rKOqgRfeMU4vFoY5CrlGIbJvqiwGzTkCAwEA -AQKCAgBkXyaWKSRvF5pSh9lPRfGk2MzMdkXUOofoNIkKHDy5KocljiDSTVIk8mVC -eU2ytuSn9UKtQgmEJEAXtu8rEdxUSftcC7+o3OTSqw9ZNWoc8jRWKVaUmVyoa1rn -Tk0jwuYaXOcwnTXAKHqK/qpqe+V45FhVvgEfcc3jcj5OoH8jdMFZubyn62ltRz83 -rMsa9icCskDqWpEil40IUshP2ZfHYBUEs+qCNpoiPCIKGNw3KgqqCUzhP9LcfmYn -jCnMge/eDGAikdXLv4vyYvwWFATRK/pGTuLcy542IvbHeY0vY5wVezH2CoOFBGD9 -xQ/UcZwE5hVtQToNsYhoRIVxL/3Of0qDk1M6W2Plh2MAstyejIHE3ct0pPfW3rsu -j/9Z/H0P9Q5ghSjarwOp2qGrrz6/4LVbbTDY8V1L928l4SqbUMtEQxcxTBN8YFoD -mPV3Jc3zls9wiiEX53RcH8MK5tjrcRwWqurTZvi/pkLfXlGDgKGCOaa3HgWVQyU+ -L6jVZM+u1nwN+jNXQYGeLEro/6tvG8WQbRMHQoxLG+rm4V3/SwH0DcfrVFDTg+i6 -3wMU1GC/aQEdTFWXvHAkpwrf4M9QWvjtheiaSxtBUoAY6l+ixCVHKrIk6glKLEjx -92HxmcJdopQScFETAyg8eVKV0kOGfVeFEpIqwq7hVedmTflpQQKCAQEA44h4dAta -cYeBqBr8eljWcgs79gmgwBEQxQUnwE/zuzLKn5NxAW324Kh25V/n/MupUzBlLPWn -91UHfw9PCXT8/HvgYQ4S5sXbKRbGmuPSsTmz4Rfe2ix6RggVNUOwORVNDyM7SQh7 -USdzZH5dMxKfF5L/b4Byx7eQZaoeKlfaXcqgikNZZ6pkhVCNxUKi9vvjS9r2wwCd -xtgu5MfTpdEci0zH1+uuRisVRcEbcRX9umUTCiZrmEeddZXNiwTAS3FtX7qGzuq9 -LKIeETwcOZrWj0E48UvbSfK4Axn7sf5J0n7/Qo7I089S5QQEI6ZDP501i71dNFhn -qfcY30c1k3TC7QKCAQEA0juuVHExKNLLNmQejNPfuHYoH0Uk2BH/8x96/Mkj6k6K -SUCHDS3iWOljXGw8YtpS8v5mGBGgMhJ+s/vCRM6R9eXYTc8u2ktY/kjyW0PgW8/Z -vb9VrQpn5svTNwj2Q8qYsTqXnQKO7YuL+hnQpQNAcID6FTeOASVLGObEf810qRfN -4y3RqCWUnYXXTyXj+cJdbXTxfF7HVZPIAQKqE7J5Qo9ynYILY62oSmUGC6m8VKyE -rrvDMK1IVi0X4w+Jx4HX0IC2+DBKxCaLWT69bE1IwjB06Q5zoTQPVi6c6qQp7K0H -kqSyLJ/ctwcEubu0DPNmvMlgWtAbAsoESA5GbIit/QKCAQEAxRzp9OYNAUM6AK74 -QOmLRZsT4+6tUxa1p2jy6fiZlnfG731kra9c630mG0n9iJPK6aWIUO20CGGiL+HM -P84YiIaseIgfucp4NV1kyrRJR31MptjuF6Xme5ru/IjaNmmMq2uDJZ7ybfi2T73k -8aTVLDANl8P4K6qLrnc00MvxAcXTVFRKNLN5h8CkQNqcoUjPvVxA3+g9xxBrd4jh -gsnoZ4kpq5WiEWmrcRV8t3gsqfh8CRQFrBOGhmIzgZapG/J0pTTLKqBTKEJ9t8KS -VRkdfVcshGWJ4MMjxJQS5zz7KR8Z9cgKlOwLzRiwmU2k/owr4hY3k2xuyeClrHBd -KpRBdQKCAQBvDk/dE55gbloi9WieBB6eluxC+IeqDHgkunCBsM9kKvEqGQg+kgqL -5V4zqImNvr8q1fCgrk7tpI+CDHBnYKgCOdS15cheUIdGbMp6I7UVSws/DR/5NRIF -/Y4p+HX/Abr/hHAq5PsTyS+8gn6RbNJRnBB/vMUrHcQ5902+JY6G9KgyZjXmmVOU -kutWSDHR8jbgZ3JZvMeYEWUKA5pMpW8hFh35zoStt0K7afpzlsqCAFBm7ZEC2cbo -nxGLRN4HojObVSNSoFAepi3eiyINYBYbXvWjV5sFgTbI0/7YhLgQ6qahdJcas6go -l3CLnPhUDxAqkkZwMpbSNl1kowXYt6sRAoIBAAOWnXgf9Bdb9OWKGgt42gVfC4cz -zj2JoLpbDTtbEdHNn8XQvPhGbpdtgnsuEMijIMy1UTlmv17jbFWdZTDeN31EUJrC -smgKX0OlVFKD90AI0BiIREK0hJUBV0pV4JoUjwnQBHGvranD06/wAtHEqgqF1Ipp -DCAKwxggM7qtB1R1vkrc/aLQej+mlwA8N6q92rnEsg+EnEbhtLDDZQcV/q5cSDCN -MMcnM+QdyjKwEeCVXHaqNfeSqKg/Ab2eZbS9VxA+XZD73+eUY/JeJsg7LfZrRz0T -ij5LCS7A+nVB5/B5tGkk4fcNhk2n356be6l46S98BEgtuwGLC9pqXf7zyp4= ------END RSA PRIVATE KEY----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.crt b/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.crt deleted file mode 100644 index 06ca92dda3..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.crt +++ /dev/null @@ -1,20 +0,0 @@ ------BEGIN CERTIFICATE----- -MIIDVjCCAr8CAQowDQYJKoZIhvcNAQEFBQAwHTEbMBkGA1UEAxMSSVNBIFRlc3Qg -QXV0aG9yaXR5MB4XDTEzMDgwODEwMTYwMloXDTQwMTIyNDEwMTYwMlowRjELMAkG -A1UEBhMCVVMxETAPBgNVBAgTCFZpcmdpbmlhMRUwEwYDVQQHEwxGb3J0IEJlbHZv -aXIxDTALBgNVBAMTBHJzYTIwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoIC -AQCjQUe0BGOpULjOAmLbXM4SSQzJvxJbCFi3tryyd+OARq6Fdp6/fslVhsr0PhWE -X8yRbAugIjseTpLwz+1OC6LavOGV1ixzGTI/9HDXGKbf8qoCrSdh28sqQJnmqGT4 -UCKLn6Rqjg2iyBBcSK3LrtKEPI4C7NaSOZUtANkppvziEMwm+0r16sgHh2Xx6mxd -22q01kq1lJqwEnIDPMSz3+ESUVQQ4T3ka7yFIhc9PYmILIXkZi0x7AiDeRkIILul -GQrduTWSPGY3prXeDAbmQNazxrHp8fcR2AfFSI6HYxMALq9jWxc4xDIkss6BO2Et -riJOIgXFpbyVsYCbkI1kXhEWFDt3uJBIcmtJKGzro4xv+XLG6BbUeTJgSHXMc7Cb -fX87+CBIFR5a/aqkEKh/mcvsDdaV+kpNKdr7q4wAuIQb8g7IyXEDuAm1VZjQs9WC -KFRGSq9sergEw9gna0iThRZjD+dzNzB17XmlAK4wa98a7MntwqpAt/GsCFOiPM8E -c+8gpuo8WqC0kP8OpImyw9cQhlZ3dca1qkr2cyKyAOGxUxyA67FgiHSsxJJ2Xhse -o49qeKTjMZd8zhSokM2TH6qEf7YfOePU51YRfAHUhzRmE31N/MExqDjFjklksEtM -iHhbPo+cOoxV8x1u13umdUvtTaAUSBA/DpvzWdnORvnaqQIDAQABMA0GCSqGSIb3 -DQEBBQUAA4GBAFD+O7h+5R5S1rIN9eC+oEGpvRhMG4v4G3pJp+c7bbtO7ifFx1WP -bta1b5YtiQYcKP0ORABm/3Kcvsb3VbaMH/zkxWEbASZsmIcBY3ml4f2kkn6WT2hD -Wc6VMIAR3N6Mj1b30yI1qYVIid+zIouiykMB+zqllm+Uar0SPNjKxDU/ ------END CERTIFICATE----- diff --git a/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.key b/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.key deleted file mode 100644 index d415ef0391..0000000000 --- a/lib/ssl/test/ssl_ECC_SUITE_data/rsa2.key +++ /dev/null @@ -1,51 +0,0 @@ ------BEGIN RSA PRIVATE KEY----- -MIIJJwIBAAKCAgEAo0FHtARjqVC4zgJi21zOEkkMyb8SWwhYt7a8snfjgEauhXae -v37JVYbK9D4VhF/MkWwLoCI7Hk6S8M/tTgui2rzhldYscxkyP/Rw1xim3/KqAq0n -YdvLKkCZ5qhk+FAii5+kao4NosgQXEity67ShDyOAuzWkjmVLQDZKab84hDMJvtK -9erIB4dl8epsXdtqtNZKtZSasBJyAzzEs9/hElFUEOE95Gu8hSIXPT2JiCyF5GYt -MewIg3kZCCC7pRkK3bk1kjxmN6a13gwG5kDWs8ax6fH3EdgHxUiOh2MTAC6vY1sX -OMQyJLLOgTthLa4iTiIFxaW8lbGAm5CNZF4RFhQ7d7iQSHJrSShs66OMb/lyxugW -1HkyYEh1zHOwm31/O/ggSBUeWv2qpBCof5nL7A3WlfpKTSna+6uMALiEG/IOyMlx -A7gJtVWY0LPVgihURkqvbHq4BMPYJ2tIk4UWYw/nczcwde15pQCuMGvfGuzJ7cKq -QLfxrAhTojzPBHPvIKbqPFqgtJD/DqSJssPXEIZWd3XGtapK9nMisgDhsVMcgOux -YIh0rMSSdl4bHqOPanik4zGXfM4UqJDNkx+qhH+2Hznj1OdWEXwB1Ic0ZhN9TfzB -Mag4xY5JZLBLTIh4Wz6PnDqMVfMdbtd7pnVL7U2gFEgQPw6b81nZzkb52qkCAwEA -AQKCAgBORLHXwHL3bdfsDIDQooG5ioQzBQQL2MiP63A0L/5GNZzeJ6ycKnDkLCeJ -SWqPeE5fOemo8EBfm1QfV9BxpmqBbCTK7U+KLv5EYzDmLs9ydqjDd7h11iZlL2uZ -hgpCckjdn7/3xfsLm9ccJ0wLZtlOxKlhBaMpn6nBVbLHoWOEDoGR/tBFbjZQRb2+ -aaFirhtOb56Jx6ER4QYAP1Ye1qrVWWBwZ0yBApXzThDOL36MZqwagFISqRK71YcG -uoq78HGhM3ZXkdV/wNFYj3OPWG6W6h/KBVNqnqO7FbofdoRZhghYHgfYE1fm+ELA -+nLwr5eK1gzmYTs0mVELRBZFlEOkCfYNOnuRgysFezEklS+ICp3HzIhYXza3kyTf -B2ZBwZZVCv/94MKyibyANErmv1a5ugY5Hsn9/WKC8qTto+qLYoyFCvBjzj0PSaVX -/3cty2DY0SK16K1Y4AOPtJMYTXYB3tVX8Akgjz1F6REBtZSOXrSQ3Vhy1ORl3Hzf -WCBYDqL8K0hJiBVgkvneIyIjmFHsdM60Nr7EldBEnJ/UrPzsl2VuWFPZlnasfUaW -x+vq1H4Dfz+bHt8coBRHDjKgUvwkfFeBQOBR5DG3vMrxguVRA1EYYMRR5C3yxk2m -ARAtdh4VxUQDQjjrmr7Dl/y1rU34aInXIrrFWpuvIhl8Ht09sQKCAQEA1pXKK5f0 -HkKfM/qk5xzF+WdHClBrPXi0XwLN6UQ+WWMMNhkGZ+FMPXl/6IJDT91s6DA3tPhr -OZF64n9ZFaGgHNBXNiB+Txjv5vZeSBMFt3hSonqt42aijx6gXfmLnkA+TYpa6Wex -YCeEgdH8LocJa7Gj2vzrYliPYk3deh6SnZZ6N8bI+ciwK3ZGF/pkWaTX83dIFq3w -YyZ+0dEpNGbA9812wNVourPg3OfqG3/CdnTfvY1M9KCC3JalpyzQL4Zm5soXF0wj -36C2yTxA02AyFz3TvUIBrvsN6i0gmGfE79+UIp29JYrFRsIgBDt+ze2vQWUz2MX5 -GeX6/yCBgiTXtwKCAQEAwsNf6k2m5Cw+WtuLzzUfBBJCN+t1lrnYJ6lF0HubW6TZ -vX1kBWyc+Rpo4ljr/+f4R9aC/gTEQOmV/hNVZy1RU2dAI8cH+r6JWG9lgif+8h// -5R81txE7gnuK1Na7PmvnQPPN661zsQZ5e1ENPXS3TJmUW/M01JxAMqEQjvAPa/II -H2KjL5NX28k9Hiw9rP6n+qXAfG/LEwXgoVCcehPwfANqQ1l95UgOdKDmjG94dipI -h2DEK70ZbrsgQbT60Wd8I5h0yhiQsik2/bVkqLmcG4SSg0/5cf2vZMApgoH/adUz -rJFdthm7iGPLhwS6fbhXew17Af96FvzfkifUV+cgnwKCAQBNUlYyFSQKz1jMgxFu -kciokNVhWw75bIgaAEmwNz38OZuJ1sSfI+iz8hbr8hxNJ+15UP6RwD3q1YghG2A/ -Uij+mPgD8ftxhvvTDo10jR4vOTUVhP0phq8mwRNqKWRs1ptcl3Egz5NzoWm22bJ0 -FYaIfs8bNq2el2i7NHGM8n1EOZe6h2+dyfno/0pMk5YbUzHZce7Q9UY8g/+InUSq -tCfuYuPaokuFkxGAqDSMSiIJSx3gEI1dTIU69TGlppkxts1XdhSR+YanqyKSKpr1 -T6FdDJNCjAlNQvuFmVM4d5PYF4kqXApu/60MTSD6RXHwxCe1ecEP6G5VLbCew9jG -y33LAoIBAGsWyC9pwQEm/qYwn4AwYjx32acrtX1J9HtiTLvkqzjJvNu/DXcaEHm7 -tr32TNVp9A9z+JS5hDt49Hs+oC/aMCRe2lqRvmZ1y8kvfy4A1eLGC4stDPj65bDK -QzziURRyejYxmCElPz6wI63VlCUdfwgEThn88SiSPY5ZF2SwxJoC+8peDwJCzwVP -cmabxtHPOAfOibciNRPhoHCyhUdunUVjD1O26k1ewGwKaJoBVMgMWdLuNw8hq9FB -3OukGmF3uD9OPbE9rpn3pX/89Dr9y8MpsvG20J6H8Z/BNVHILus/SmlxiIhvP7kv -viIgTHaCHL/RWrhvg+8N3dRcSBqJQFsCggEAFe2TMEq2AlnBn4gsuAOIuZPYKQCg -2a+tl1grQzmNth6AGGQcIqShadICD6SnVMIS64HHV/m18Cuz7GhJ06ZVjXJsHueG -UpTE9wAmI2LxnNkupkLJu+SVcW3N86PujWmQBFpHkd+IRPLS51xjD9W5zLJ7HL4/ -fnKO+B+ZK6Imxbe5C5vJezkGfeOSyQoVtt6MT/XtSKNEGPBX+M6fLKgUMMg2H2Mt -/SsD7DkOzFteKXzaEg/K8oOTpsOPkVDwNl2KErlEqbJv0k7yEVw50mYmsn/OLjh8 -+9EibISwCODbPxB+PhV6u2ue1IvGLRqtsN60lFOvbGn+kSewy9EUVHHQDQ== ------END RSA PRIVATE KEY----- diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index 5f36842f9e..e5e942ce1b 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -38,6 +38,7 @@ all() -> [decode_hello_handshake, decode_supported_elliptic_curves_hello_extension_correctly, decode_unknown_hello_extension_correctly, encode_single_hello_sni_extension_correctly, + decode_single_hello_sni_extension_correctly, select_proper_tls_1_2_rsa_default_hashsign]. %%-------------------------------------------------------------------- @@ -98,6 +99,13 @@ encode_single_hello_sni_extension_correctly(_Config) -> Encoded = ssl_handshake:encode_hello_extensions(Exts), HelloExt = Encoded. +decode_single_hello_sni_extension_correctly(_Config) -> + Exts = #hello_extensions{sni = #sni{hostname = "test.com"}}, + SNI = <<16#00, 16#00, 16#00, 16#0d, 16#00, 16#0b, 16#00, 16#00, 16#08, + $t, $e, $s, $t, $., $c, $o, $m>>, + Decoded = ssl_handshake:decode_hello_extensions(SNI), + Exts = Decoded. + select_proper_tls_1_2_rsa_default_hashsign(_Config) -> % RFC 5246 section 7.4.1.4.1 tells to use {sha1,rsa} as default signature_algorithm for RSA key exchanges {sha, rsa} = ssl_handshake:select_hashsign_algs(undefined, ?rsaEncryption, {3,3}), diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 150b5037d7..74d71263de 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -450,7 +450,7 @@ make_ecdsa_cert(Config) -> {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, {server_ecdsa_verify_opts, [{ssl_imp, new},{reuseaddr, true}, - {cacertfile, ClientCaCertFile}, + {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {verify, verify_peer}]}, {client_ecdsa_opts, [{ssl_imp, new},{reuseaddr, true}, @@ -475,7 +475,7 @@ make_ecdh_rsa_cert(Config) -> {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, {server_ecdh_rsa_verify_opts, [{ssl_imp, new},{reuseaddr, true}, - {cacertfile, ClientCaCertFile}, + {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}, {verify, verify_peer}]}, {client_ecdh_rsa_opts, [{ssl_imp, new},{reuseaddr, true}, @@ -1136,3 +1136,36 @@ filter_suites(Ciphers0) -> Supported1 = ssl_cipher:filter_suites(Supported0), Supported2 = [ssl:suite_definition(S) || S <- Supported1], [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported2)]. + +-define(OPENSSL_QUIT, "Q\n"). +close_port(Port) -> + catch port_command(Port, ?OPENSSL_QUIT), + close_loop(Port, 500, false). + +close_loop(Port, Time, SentClose) -> + receive + {Port, {data,Debug}} when is_port(Port) -> + ct:log("openssl ~s~n",[Debug]), + close_loop(Port, Time, SentClose); + {ssl,_,Msg} -> + ct:log("ssl Msg ~s~n",[Msg]), + close_loop(Port, Time, SentClose); + {Port, closed} -> + ct:log("Port Closed~n",[]), + ok; + {'EXIT', Port, Reason} -> + ct:log("Port Closed ~p~n",[Reason]), + ok; + Msg -> + ct:log("Port Msg ~p~n",[Msg]), + close_loop(Port, Time, SentClose) + after Time -> + case SentClose of + false -> + ct:log("Closing port ~n",[]), + catch erlang:port_close(Port), + close_loop(Port, Time, true); + true -> + ct:log("Timeout~n",[]) + end + end. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index d36e441c7a..942c446ec4 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -226,7 +226,7 @@ basic_erlang_client_openssl_server(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). @@ -259,7 +259,7 @@ basic_erlang_server_openssl_client(Config) when is_list(Config) -> %% Clean close down! Server needs to be closed first !! ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false), ok. %%-------------------------------------------------------------------- @@ -298,7 +298,7 @@ erlang_client_openssl_server(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). @@ -332,11 +332,9 @@ erlang_server_openssl_client(Config) when is_list(Config) -> %% Clean close down! Server needs to be closed first !! ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). -%%-------------------------------------------------------------------- - erlang_client_openssl_server_dsa_cert() -> [{doc,"Test erlang server with openssl client"}]. erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) -> @@ -376,7 +374,7 @@ erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false), ok. @@ -414,7 +412,7 @@ erlang_server_openssl_client_dsa_cert(Config) when is_list(Config) -> %% Clean close down! Server needs to be closed first !! ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). %%-------------------------------------------------------------------- @@ -450,7 +448,7 @@ erlang_server_openssl_client_reuse_session(Config) when is_list(Config) -> %% Clean close down! Server needs to be closed first !! ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false), ok. @@ -496,7 +494,7 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false), ok. @@ -542,7 +540,7 @@ erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). %%-------------------------------------------------------------------- @@ -581,7 +579,7 @@ erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) -> %% Clean close down! Server needs to be closed first !! ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). %%-------------------------------------------------------------------- @@ -624,7 +622,7 @@ erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). @@ -666,7 +664,7 @@ erlang_client_openssl_server_client_cert(Config) when is_list(Config) -> ssl_test_lib:check_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). @@ -708,7 +706,7 @@ erlang_server_openssl_client_client_cert(Config) when is_list(Config) -> ssl_test_lib:check_result(Server, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), ssl_test_lib:close(Server), process_flag(trap_exit, false). @@ -821,7 +819,7 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> [{versions, [Version]} | ClientOpts]}]), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client1), process_flag(trap_exit, false), ok. @@ -878,7 +876,7 @@ expired_session(Config) when is_list(Config) -> {from, self()}, {options, ClientOpts}]), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client2), process_flag(trap_exit, false). @@ -1089,7 +1087,7 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> Result = ssl_test_lib:wait_for_result(Client, ok), %% Clean close down! Server needs to be closed first !! - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), ssl_test_lib:close(Client), Return = case Result of @@ -1136,7 +1134,7 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens Callback(Client, OpensslPort), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). @@ -1175,7 +1173,7 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac Callback(Client, OpensslPort), %% Clean close down! Server needs to be closed first !! - close_port(OpensslPort), + ssl_test_lib:close_port(OpensslPort), ssl_test_lib:close(Client), process_flag(trap_exit, false). @@ -1205,7 +1203,7 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). @@ -1234,7 +1232,7 @@ start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenS ssl_test_lib:close(Server), - close_port(OpenSslPort), + ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). @@ -1282,39 +1280,6 @@ delayed_send(Socket, [ErlData, OpenSslData]) -> ssl:send(Socket, ErlData), erlang_ssl_receive(Socket, OpenSslData). -close_port(Port) -> - catch port_command(Port, ?OPENSSL_QUIT), - close_loop(Port, 500, false). - -close_loop(Port, Time, SentClose) -> - receive - {Port, {data,Debug}} when is_port(Port) -> - ct:log("openssl ~s~n",[Debug]), - close_loop(Port, Time, SentClose); - {ssl,_,Msg} -> - ct:log("ssl Msg ~s~n",[Msg]), - close_loop(Port, Time, SentClose); - {Port, closed} -> - ct:log("Port Closed~n",[]), - ok; - {'EXIT', Port, Reason} -> - ct:log("Port Closed ~p~n",[Reason]), - ok; - Msg -> - ct:log("Port Msg ~p~n",[Msg]), - close_loop(Port, Time, SentClose) - after Time -> - case SentClose of - false -> - ct:log("Closing port ~n",[]), - catch erlang:port_close(Port), - close_loop(Port, Time, true); - true -> - ct:log("Timeout~n",[]) - end - end. - - server_sent_garbage(Socket) -> receive server_sent_garbage -> diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml index b37f7fd7fd..64229fa8d3 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -319,6 +319,23 @@ false</code> </func> <func> + <name name="with" arity="2"/> + <fsummary></fsummary> + <desc> + <p> + Returns a new map <c><anno>Map2</anno></c> with the keys <c>K1</c> through <c>Kn</c> and their associated values from map <c><anno>Map1</anno></c>. + Any key in <c><anno>Ks</anno></c> that does not exist in <c><anno>Map1</anno></c> are ignored. + </p> + <p>Example:</p> + <code type="none"> +> Map = #{42 => value_three,1337 => "value two","a" => 1}, + Ks = ["a",42,"other key"], + maps:without(Ks,Map). +#{42 => value_three,"a" => 1}</code> + </desc> + </func> + + <func> <name name="without" arity="2"/> <fsummary></fsummary> <desc> diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml index a46fa1289f..19605f325b 100644 --- a/lib/stdlib/doc/src/sys.xml +++ b/lib/stdlib/doc/src/sys.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -115,6 +115,9 @@ <datatype> <name name="dbg_fun"/> </datatype> + <datatype> + <name name="format_fun"/> + </datatype> </datatypes> <funcs> <func> diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index c32da1624f..76e03bbfaa 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -440,9 +440,10 @@ insert(Tab, Objs) when is_list(Objs) -> insert(Tab, Obj) -> badarg(treq(Tab, {insert, [Obj]}), [Tab, Obj]). --spec insert_new(Name, Objects) -> boolean() when +-spec insert_new(Name, Objects) -> boolean() | {'error', Reason} when Name :: tab_name(), - Objects :: object() | [object()]. + Objects :: object() | [object()], + Reason :: term(). insert_new(Tab, Objs) when is_list(Objs) -> badarg(treq(Tab, {insert_new, Objs}), [Tab, Objs]); diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 3cfedfee97..639ddfc214 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -77,7 +77,7 @@ %% Only exprs/2 checks the command by calling erl_lint. The reason is %% that if there is a function handler present, then it is possible %% that there are valid constructs in Expression to be taken care of -%% by a function handler but considerad errors by erl_lint. +%% by a function handler but considered errors by erl_lint. -spec(exprs(Expressions, Bindings) -> {value, Value, NewBindings} when Expressions :: expressions(), diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index ae59d5f44f..6fd6bb888b 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -1075,7 +1075,7 @@ scan_number([$#|Cs]=Cs0, St, Line, Col, Toks, Ncs0) -> Ncs = lists:reverse(Ncs0), case catch list_to_integer(Ncs) of B when B >= 2, B =< 1+$Z-$A+10 -> - Bcs = ?STR(St, Ncs++[$#]), + Bcs = Ncs++[$#], scan_based_int(Cs, St, Line, Col, Toks, {B,[],Bcs}); B -> Len = length(Ncs), @@ -1108,7 +1108,7 @@ scan_based_int(Cs, St, Line, Col, Toks, {B,Ncs0,Bcs}) -> Ncs = lists:reverse(Ncs0), case catch erlang:list_to_integer(Ncs, B) of N when is_integer(N) -> - tok3(Cs, St, Line, Col, Toks, integer, ?STR(St, Bcs++Ncs), N); + tok3(Cs, St, Line, Col, Toks, integer, Bcs++Ncs, N); _ -> Len = length(Bcs)+length(Ncs), Ncol = incr_column(Col, Len), diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index e914f7d0b2..5afe3e8b09 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -594,7 +594,8 @@ reply(Name, {To, Tag}, Reply, Debug, StateName) -> terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> case catch Mod:terminate(Reason, StateName, StateData) of {'EXIT', R} -> - error_info(R, Name, Msg, StateName, StateData, Debug), + FmtStateData = format_status(terminate, Mod, get(), StateData), + error_info(R, Name, Msg, StateName, FmtStateData, Debug), exit(R); _ -> case Reason of @@ -605,17 +606,7 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - FmtStateData = - case erlang:function_exported(Mod, format_status, 2) of - true -> - Args = [get(), StateData], - case catch Mod:format_status(terminate, Args) of - {'EXIT', _} -> StateData; - Else -> Else - end; - _ -> - StateData - end, + FmtStateData = format_status(terminate, Mod, get(), StateData), error_info(Reason,Name,Msg,StateName,FmtStateData,Debug), exit(Reason) end @@ -680,21 +671,29 @@ format_status(Opt, StatusData) -> Header = gen:format_status_header("Status for state machine", Name), Log = sys:get_debug(log, Debug, []), - DefaultStatus = [{data, [{"StateData", StateData}]}], - Specfic = - case erlang:function_exported(Mod, format_status, 2) of - true -> - case catch Mod:format_status(Opt,[PDict,StateData]) of - {'EXIT', _} -> DefaultStatus; - StatusList when is_list(StatusList) -> StatusList; - Else -> [Else] - end; - _ -> - DefaultStatus - end, + Specfic = format_status(Opt, Mod, PDict, StateData), + Specfic = case format_status(Opt, Mod, PDict, StateData) of + S when is_list(S) -> S; + S -> [S] + end, [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}, {"Logged events", Log}, {"StateName", StateName}]} | Specfic]. + +format_status(Opt, Mod, PDict, State) -> + DefStatus = case Opt of + terminate -> State; + _ -> [{data, [{"StateData", State}]}] + end, + case erlang:function_exported(Mod, format_status, 2) of + true -> + case catch Mod:format_status(Opt, [PDict, State]) of + {'EXIT', _} -> DefStatus; + Else -> Else + end; + _ -> + DefStatus + end. diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 202a931fae..dadfe56b3d 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -720,7 +720,8 @@ print_event(Dev, Event, Name) -> terminate(Reason, Name, Msg, Mod, State, Debug) -> case catch Mod:terminate(Reason, State) of {'EXIT', R} -> - error_info(R, Name, Msg, State, Debug), + FmtState = format_status(terminate, Mod, get(), State), + error_info(R, Name, Msg, FmtState, Debug), exit(R); _ -> case Reason of @@ -731,17 +732,7 @@ terminate(Reason, Name, Msg, Mod, State, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - FmtState = - case erlang:function_exported(Mod, format_status, 2) of - true -> - Args = [get(), State], - case catch Mod:format_status(terminate, Args) of - {'EXIT', _} -> State; - Else -> Else - end; - _ -> - State - end, + FmtState = format_status(terminate, Mod, get(), State), error_info(Reason, Name, Msg, FmtState, Debug), exit(Reason) end @@ -875,23 +866,29 @@ name_to_pid(Name) -> %%----------------------------------------------------------------- format_status(Opt, StatusData) -> [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData, - Header = gen:format_status_header("Status for generic server", - Name), + Header = gen:format_status_header("Status for generic server", Name), Log = sys:get_debug(log, Debug, []), - DefaultStatus = [{data, [{"State", State}]}], - Specfic = - case erlang:function_exported(Mod, format_status, 2) of - true -> - case catch Mod:format_status(Opt, [PDict, State]) of - {'EXIT', _} -> DefaultStatus; - StatusList when is_list(StatusList) -> StatusList; - Else -> [Else] - end; - _ -> - DefaultStatus - end, + Specfic = case format_status(Opt, Mod, PDict, State) of + S when is_list(S) -> S; + S -> [S] + end, [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}, {"Logged events", Log}]} | Specfic]. + +format_status(Opt, Mod, PDict, State) -> + DefStatus = case Opt of + terminate -> State; + _ -> [{data, [{"State", State}]}] + end, + case erlang:function_exported(Mod, format_status, 2) of + true -> + case catch Mod:format_status(Opt, [PDict, State]) of + {'EXIT', _} -> DefStatus; + Else -> Else + end; + _ -> + DefStatus + end. diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index 56e15a17ec..89ae6fb187 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -255,7 +255,7 @@ term(T, none, _Adj, none, _Pad) -> T; term(T, none, Adj, P, Pad) -> term(T, P, Adj, P, Pad); term(T, F, Adj, P0, Pad) -> L = lists:flatlength(T), - P = case P0 of none -> erlang:min(L, F); _ -> P0 end, + P = erlang:min(L, case P0 of none -> F; _ -> min(P0, F) end), if L > P -> adjust(chars($*, P), chars(Pad, F-P), Adj); diff --git a/lib/stdlib/src/maps.erl b/lib/stdlib/src/maps.erl index 4ef1638e6d..ba4d6a5c87 100644 --- a/lib/stdlib/src/maps.erl +++ b/lib/stdlib/src/maps.erl @@ -24,6 +24,7 @@ map/2, size/1, without/2, + with/2, get/3 ]). @@ -133,10 +134,10 @@ to_list(_) -> erlang:nif_error(undef). update(_,_,_) -> erlang:nif_error(undef). --spec values(Map) -> Keys when +-spec values(Map) -> Values when Map :: map(), - Keys :: [Key], - Key :: term(). + Values :: [Value], + Value :: term(). values(_) -> erlang:nif_error(undef). @@ -201,3 +202,13 @@ size(Map) when is_map(Map) -> without(Ks, M) when is_list(Ks), is_map(M) -> maps:from_list([{K,V}||{K,V} <- maps:to_list(M), not lists:member(K, Ks)]). + + +-spec with(Ks, Map1) -> Map2 when + Ks :: [K], + Map1 :: map(), + Map2 :: map(), + K :: term(). + +with(Ks, M) when is_list(Ks), is_map(M) -> + maps:from_list([{K,V}||{K,V} <- maps:to_list(M), lists:member(K, Ks)]). diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 1eb6fc2e86..bf2a4e7ac5 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -216,10 +216,8 @@ ensure_link(SpawnOpts) -> init_p(Parent, Ancestors, Fun) when is_function(Fun) -> put('$ancestors', [Parent|Ancestors]), - {module,Mod} = erlang:fun_info(Fun, module), - {name,Name} = erlang:fun_info(Fun, name), - {arity,Arity} = erlang:fun_info(Fun, arity), - put('$initial_call', {Mod,Name,Arity}), + Mfa = erlang:fun_info_mfa(Fun), + put('$initial_call', Mfa), try Fun() catch diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 3b90542452..679c13f0cf 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -371,6 +371,14 @@ expand_expr({bc,L,E,Qs}, C) -> {bc,L,expand_expr(E, C),expand_quals(Qs, C)}; expand_expr({tuple,L,Elts}, C) -> {tuple,L,expand_exprs(Elts, C)}; +expand_expr({map,L,Es}, C) -> + {map,L,expand_exprs(Es, C)}; +expand_expr({map,L,Arg,Es}, C) -> + {map,L,expand_expr(Arg, C),expand_exprs(Es, C)}; +expand_expr({map_field_assoc,L,K,V}, C) -> + {map_field_assoc,L,expand_expr(K, C),expand_expr(V, C)}; +expand_expr({map_field_exact,L,K,V}, C) -> + {map_field_exact,L,expand_expr(K, C),expand_expr(V, C)}; expand_expr({record_index,L,Name,F}, C) -> {record_index,L,Name,expand_expr(F, C)}; expand_expr({record,L,Name,Is}, C) -> diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 3585eec342..aa9899da3b 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -103,7 +103,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.4","kernel-3.0.2","erts-6.1.2","crypto-3.3", + {runtime_dependencies, ["sasl-2.4","kernel-3.0.2","erts-6.2","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index e25cc25f57..d3ba09ce82 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -46,7 +46,7 @@ {N :: non_neg_integer(), [{Event :: system_event(), FuncState :: _, - FormFunc :: dbg_fun()}]}} + FormFunc :: format_fun()}]}} | {'statistics', {file:date_time(), {'reductions', non_neg_integer()}, MessagesIn :: non_neg_integer(), @@ -57,6 +57,10 @@ Event :: system_event(), ProcState :: _) -> 'done' | (NewFuncState :: _)). +-type format_fun() :: fun((Device :: io:device() | file:io_device(), + Event :: system_event(), + Extra :: term()) -> any()). + %%----------------------------------------------------------------- %% System messages %%----------------------------------------------------------------- @@ -346,7 +350,7 @@ handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc, Hib) -> %%----------------------------------------------------------------- -spec handle_debug(Debug, FormFunc, Extra, Event) -> [dbg_opt()] when Debug :: [dbg_opt()], - FormFunc :: dbg_fun(), + FormFunc :: format_fun(), Extra :: term(), Event :: system_event(). handle_debug([{trace, true} | T], FormFunc, State, Event) -> diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index 6be37cbecf..119b4dc7cb 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -2032,6 +2032,12 @@ match(Config, Version) -> CrashPos = if Version =:= 8 -> 5; Version =:= 9 -> 1 end, crash(Fname, ObjPos2+CrashPos), {ok, _} = dets:open_file(T, Args), + case dets:insert_new(T, Obj) of % OTP-12024 + ok -> + bad_object(dets:sync(T), Fname); + Else3 -> + bad_object(Else3, Fname) + end, io:format("Expect corrupt table:~n"), case ins(T, N) of ok -> diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 35067e8116..9be9f641c8 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -204,20 +204,20 @@ reserved_words() -> [begin ?line {RW, true} = {RW, erl_scan:reserved_word(RW)}, S = atom_to_list(RW), - Ts = [{RW,1}], + Ts = [{RW,{1,1}}], ?line test_string(S, Ts) end || RW <- L], ok. atoms() -> - ?line test_string("a - b", [{atom,1,a},{atom,2,b}]), - ?line test_string("'a b'", [{atom,1,'a b'}]), - ?line test_string("a", [{atom,1,a}]), - ?line test_string("a@2", [{atom,1,a@2}]), - ?line test_string([39,65,200,39], [{atom,1,'AÈ'}]), - ?line test_string("ärlig östen", [{atom,1,ärlig},{atom,1,östen}]), + test_string("a + b", [{atom,{1,1},a},{atom,{2,18},b}]), + test_string("'a b'", [{atom,{1,1},'a b'}]), + test_string("a", [{atom,{1,1},a}]), + test_string("a@2", [{atom,{1,1},a@2}]), + test_string([39,65,200,39], [{atom,{1,1},'AÈ'}]), + test_string("ärlig östen", [{atom,{1,1},ärlig},{atom,{1,7},östen}]), ?line {ok,[{atom,_,'$a'}],{1,6}} = erl_scan:string("'$\\a'", {1,1}), ?line test("'$\\a'"), @@ -230,7 +230,7 @@ punctuations() -> %% One token at a time: [begin W = list_to_atom(S), - Ts = [{W,1}], + Ts = [{W,{1,1}}], ?line test_string(S, Ts) end || S <- L], Three = ["/=:=", "<=:=", "==:=", ">=:="], % three tokens... @@ -246,53 +246,60 @@ punctuations() -> [begin W1 = list_to_atom(S1), W2 = list_to_atom(S2), - Ts = [{W1,1},{W2,1}], + Ts = [{W1,{1,1}},{W2,{1,-L2+1}}], ?line test_string(S, Ts) - end || {S,[{_,S1,S2}|_]} <- SL], + end || {S,[{L2,S1,S2}|_]} <- SL], - PTs1 = [{'!',1},{'(',1},{')',1},{',',1},{';',1},{'=',1},{'[',1}, - {']',1},{'{',1},{'|',1},{'}',1}], + PTs1 = [{'!',{1,1}},{'(',{1,2}},{')',{1,3}},{',',{1,4}},{';',{1,5}}, + {'=',{1,6}},{'[',{1,7}},{']',{1,8}},{'{',{1,9}},{'|',{1,10}}, + {'}',{1,11}}], ?line test_string("!(),;=[]{|}", PTs1), - PTs2 = [{'#',1},{'&',1},{'*',1},{'+',1},{'/',1}, - {':',1},{'<',1},{'>',1},{'?',1},{'@',1}, - {'\\',1},{'^',1},{'`',1},{'~',1}], + PTs2 = [{'#',{1,1}},{'&',{1,2}},{'*',{1,3}},{'+',{1,4}},{'/',{1,5}}, + {':',{1,6}},{'<',{1,7}},{'>',{1,8}},{'?',{1,9}},{'@',{1,10}}, + {'\\',{1,11}},{'^',{1,12}},{'`',{1,13}},{'~',{1,14}}], ?line test_string("#&*+/:<>?@\\^`~", PTs2), - ?line test_string(".. ", [{'..',1}]), - ?line test("1 .. 2"), - ?line test_string("...", [{'...',1}]), + test_string(".. ", [{'..',{1,1}}]), + test_string("1 .. 2", + [{integer,{1,1},1},{'..',{1,3}},{integer,{1,6},2}]), + test_string("...", [{'...',{1,1}}]), ok. comments() -> ?line test("a %%\n b"), ?line {ok,[],1} = erl_scan:string("%"), ?line test("a %%\n b"), - ?line {ok,[{atom,_,a},{atom,_,b}],{2,3}} = + {ok,[{atom,{1,1},a},{atom,{2,2},b}],{2,3}} = erl_scan:string("a %%\n b",{1,1}), - ?line {ok,[{atom,_,a},{comment,_,"%%"},{atom,_,b}],{2,3}} = + {ok,[{atom,{1,1},a},{comment,{1,3},"%%"},{atom,{2,2},b}],{2,3}} = erl_scan:string("a %%\n b",{1,1}, [return_comments]), - ?line {ok,[{atom,_,a}, - {white_space,_," "}, - {white_space,_,"\n "}, - {atom,_,b}], - {2,3}} = + {ok,[{atom,{1,1},a}, + {white_space,{1,2}," "}, + {white_space,{1,5},"\n "}, + {atom,{2,2},b}], + {2,3}} = erl_scan:string("a %%\n b",{1,1},[return_white_spaces]), - ?line {ok,[{atom,_,a}, - {white_space,_," "}, - {comment,_,"%%"}, - {white_space,_,"\n "}, - {atom,_,b}], - {2,3}} = erl_scan:string("a %%\n b",{1,1},[return]), + {ok,[{atom,{1,1},a}, + {white_space,{1,2}," "}, + {comment,{1,3},"%%"}, + {white_space,{1,5},"\n "}, + {atom,{2,2},b}], + {2,3}} = erl_scan:string("a %%\n b",{1,1},[return]), ok. errors() -> ?line {error,{1,erl_scan,{string,$',"qa"}},1} = erl_scan:string("'qa"), %' + {error,{{1,1},erl_scan,{string,$',"qa"}},{1,4}} = %' + erl_scan:string("'qa", {1,1}, []), %' ?line {error,{1,erl_scan,{string,$","str"}},1} = %" erl_scan:string("\"str"), %" + {error,{{1,1},erl_scan,{string,$","str"}},{1,5}} = %" + erl_scan:string("\"str", {1,1}, []), %" ?line {error,{1,erl_scan,char},1} = erl_scan:string("$"), - ?line test_string([34,65,200,34], [{string,1,"AÈ"}]), - ?line test_string("\\", [{'\\',1}]), + {error,{{1,1},erl_scan,char},{1,2}} = erl_scan:string("$", {1,1}, []), + test_string([34,65,200,34], [{string,{1,1},"AÈ"}]), + test_string("\\", [{'\\',{1,1}}]), ?line {'EXIT',_} = (catch {foo, erl_scan:string('$\\a', {1,1})}), % type error ?line {'EXIT',_} = @@ -304,7 +311,7 @@ errors() -> integers() -> [begin I = list_to_integer(S), - Ts = [{integer,1,I}], + Ts = [{integer,{1,1},I}], ?line test_string(S, Ts) end || S <- [[N] || N <- lists:seq($0, $9)] ++ ["2323","000"] ], ok. @@ -313,14 +320,16 @@ base_integers() -> [begin B = list_to_integer(BS), I = erlang:list_to_integer(S, B), - Ts = [{integer,1,I}], + Ts = [{integer,{1,1},I}], ?line test_string(BS++"#"++S, Ts) end || {BS,S} <- [{"2","11"}, {"5","23234"}, {"12","05a"}, {"16","abcdef"}, {"16","ABCDEF"}] ], ?line {error,{1,erl_scan,{base,1}},1} = erl_scan:string("1#000"), + {error,{{1,1},erl_scan,{base,1}},{1,2}} = + erl_scan:string("1#000", {1,1}, []), - ?line test_string("12#bc", [{integer,1,11},{atom,1,c}]), + test_string("12#bc", [{integer,{1,1},11},{atom,{1,5},c}]), [begin Str = BS ++ "#" ++ S, @@ -329,40 +338,53 @@ base_integers() -> end || {BS,S} <- [{"3","3"},{"15","f"}, {"12","c"}] ], ?line {ok,[{integer,1,239},{'@',1}],1} = erl_scan:string("16#ef@"), - ?line {ok,[{integer,1,14},{atom,1,g@}],1} = erl_scan:string("16#eg@"), + {ok,[{integer,{1,1},239},{'@',{1,6}}],{1,7}} = + erl_scan:string("16#ef@", {1,1}, []), + {ok,[{integer,{1,1},14},{atom,{1,5},g@}],{1,7}} = + erl_scan:string("16#eg@", {1,1}, []), ok. floats() -> [begin F = list_to_float(FS), - Ts = [{float,1,F}], + Ts = [{float,{1,1},F}], ?line test_string(FS, Ts) end || FS <- ["1.0","001.17","3.31200","1.0e0","1.0E17", "34.21E-18", "17.0E+14"]], - ?line test_string("1.e2", [{integer,1,1},{'.',1},{atom,1,e2}]), + test_string("1.e2", [{integer,{1,1},1},{'.',{1,2}},{atom,{1,3},e2}]), ?line {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string("1.0e400"), + {error,{{1,1},erl_scan,{illegal,float}},{1,8}} = + erl_scan:string("1.0e400", {1,1}, []), [begin - ?line {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string(S) + {error,{1,erl_scan,{illegal,float}},1} = erl_scan:string(S), + {error,{{1,1},erl_scan,{illegal,float}},{1,_}} = + erl_scan:string(S, {1,1}, []) end || S <- ["1.14Ea"]], ok. dots() -> - Dot = [{".", {ok,[{dot,1}],1}}, - {". ", {ok,[{dot,1}],1}}, - {".\n", {ok,[{dot,1}],2}}, - {".%", {ok,[{dot,1}],1}}, - {".\210",{ok,[{dot,1}],1}}, - {".% öh",{ok,[{dot,1}],1}}, - {".%\n", {ok,[{dot,1}],2}}, - {".$", {error,{1,erl_scan,char},1}}, - {".$\\", {error,{1,erl_scan,char},1}}, - {".a", {ok,[{'.',1},{atom,1,a}],1}} + Dot = [{".", {ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,2}}}, + {". ", {ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,3}}}, + {".\n", {ok,[{dot,1}],2}, {ok,[{dot,{1,1}}],{2,1}}}, + {".%", {ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,3}}}, + {".\210",{ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,3}}}, + {".% öh",{ok,[{dot,1}],1}, {ok,[{dot,{1,1}}],{1,6}}}, + {".%\n", {ok,[{dot,1}],2}, {ok,[{dot,{1,1}}],{2,1}}}, + {".$", {error,{1,erl_scan,char},1}, + {error,{{1,2},erl_scan,char},{1,3}}}, + {".$\\", {error,{1,erl_scan,char},1}, + {error,{{1,2},erl_scan,char},{1,4}}}, + {".a", {ok,[{'.',1},{atom,1,a}],1}, + {ok,[{'.',{1,1}},{atom,{1,2},a}],{1,3}}} ], - ?line [R = erl_scan:string(S) || {S, R} <- Dot], + [begin + R = erl_scan:string(S), + R2 = erl_scan:string(S, {1,1}, []) + end || {S, R, R2} <- Dot], ?line {ok,[{dot,_}=T1],{1,2}} = erl_scan:string(".", {1,1}, text), ?line [{column,1},{length,1},{line,1},{text,"."}] = @@ -379,55 +401,55 @@ dots() -> ?line {error,{{1,2},erl_scan,char},{1,4}} = erl_scan:string(".$\\", {1,1}), - ?line test(". "), - ?line test(". "), - ?line test(".\n"), - ?line test(".\n\n"), - ?line test(".\n\r"), - ?line test(".\n\n\n"), - ?line test(".\210"), - ?line test(".%\n"), - ?line test(".a"), - - ?line test("%. \n. "), + test_string(". ", [{dot,{1,1}}]), + test_string(". ", [{dot,{1,1}}]), + test_string(".\n", [{dot,{1,1}}]), + test_string(".\n\n", [{dot,{1,1}}]), + test_string(".\n\r", [{dot,{1,1}}]), + test_string(".\n\n\n", [{dot,{1,1}}]), + test_string(".\210", [{dot,{1,1}}]), + test_string(".%\n", [{dot,{1,1}}]), + test_string(".a", [{'.',{1,1}},{atom,{1,2},a}]), + + test_string("%. \n. ", [{dot,{2,1}}]), ?line {more,C} = erl_scan:tokens([], "%. ",{1,1}, return), - ?line {done,{ok,[{comment,_,"%. "}, - {white_space,_,"\n"}, - {dot,_}], - {2,3}}, ""} = + {done,{ok,[{comment,{1,1},"%. "}, + {white_space,{1,4},"\n"}, + {dot,{2,1}}], + {2,3}}, ""} = erl_scan:tokens(C, "\n. ", {1,1}, return), % any loc, any options ?line [test_string(S, R) || - {S, R} <- [{".$\n", [{'.',1},{char,1,$\n}]}, - {"$\\\n", [{char,1,$\n}]}, - {"'\\\n'", [{atom,1,'\n'}]}, - {"$\n", [{char,1,$\n}]}] ], + {S, R} <- [{".$\n", [{'.',{1,1}},{char,{1,2},$\n}]}, + {"$\\\n", [{char,{1,1},$\n}]}, + {"'\\\n'", [{atom,{1,1},'\n'}]}, + {"$\n", [{char,{1,1},$\n}]}] ], ok. chars() -> [begin L = lists:flatten(io_lib:format("$\\~.8b", [C])), - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], %% Leading zeroes... [begin L = lists:flatten(io_lib:format("$\\~3.8.0b", [C])), - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], %% $\^\n now increments the line... [begin L = "$\\^" ++ [C], - Ts = [{char,1,C band 2#11111}], + Ts = [{char,{1,1},C band 2#11111}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255)], [begin L = "$\\" ++ [C], - Ts = [{char,1,V}], + Ts = [{char,{1,1},V}], ?line test_string(L, Ts) end || {C,V} <- [{$n,$\n}, {$r,$\r}, {$t,$\t}, {$v,$\v}, {$b,$\b}, {$f,$\f}, {$e,$\e}, {$s,$\s}, @@ -440,45 +462,45 @@ chars() -> No = EC ++ Ds ++ X ++ New, [begin L = "$\\" ++ [C], - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255) -- No], [begin L = "'$\\" ++ [C] ++ "'", - Ts = [{atom,1,list_to_atom("$"++[C])}], + Ts = [{atom,{1,1},list_to_atom("$"++[C])}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255) -- No], - ?line test_string("\"\\013a\\\n\"", [{string,1,"\va\n"}]), + test_string("\"\\013a\\\n\"", [{string,{1,1},"\va\n"}]), - ?line test_string("'\n'", [{atom,1,'\n'}]), - ?line test_string("\"\n\a\"", [{string,1,"\na"}]), + test_string("'\n'", [{atom,{1,1},'\n'}]), + test_string("\"\n\a\"", [{string,{1,1},"\na"}]), %% No escape [begin L = "$" ++ [C], - Ts = [{char,1,C}], + Ts = [{char,{1,1},C}], ?line test_string(L, Ts) end || C <- lists:seq(0, 255) -- (No ++ [$\\])], - ?line test_string("$\n", [{char,1,$\n}]), + test_string("$\n", [{char,{1,1},$\n}]), ?line {error,{{1,1},erl_scan,char},{1,4}} = erl_scan:string("$\\^",{1,1}), - ?line test_string("$\\\n", [{char,1,$\n}]), + test_string("$\\\n", [{char,{1,1},$\n}]), %% Robert's scanner returns line 1: - ?line test_string("$\\\n", [{char,1,$\n}]), - ?line test_string("$\n\n", [{char,1,$\n}]), + test_string("$\\\n", [{char,{1,1},$\n}]), + test_string("$\n\n", [{char,{1,1},$\n}]), ?line test("$\n\n"), ok. variables() -> - ?line test_string(" \237_Aouåeiyäö", [{var,1,'_Aouåeiyäö'}]), - ?line test_string("A_b_c@", [{var,1,'A_b_c@'}]), - ?line test_string("V@2", [{var,1,'V@2'}]), - ?line test_string("ABDÀ", [{var,1,'ABDÀ'}]), - ?line test_string("Ärlig Östen", [{var,1,'Ärlig'},{var,1,'Östen'}]), + test_string(" \237_Aouåeiyäö", [{var,{1,7},'_Aouåeiyäö'}]), + test_string("A_b_c@", [{var,{1,1},'A_b_c@'}]), + test_string("V@2", [{var,{1,1},'V@2'}]), + test_string("ABDÀ", [{var,{1,1},'ABDÀ'}]), + test_string("Ärlig Östen", [{var,{1,1},'Ärlig'},{var,{1,7},'Östen'}]), ok. eof() -> @@ -508,11 +530,25 @@ eof() -> ?line {done,{ok,[{atom,1,a}],1},eof} = erl_scan:tokens(C5,eof,1), + %% With column. + {more, C6} = erl_scan:tokens([], "a", {1,1}), + %% An error before R13A. + %% {done,{error,{1,erl_scan,scan},1},eof} = + {done,{ok,[{atom,{1,1},a}],{1,2}},eof} = + erl_scan:tokens(C6,eof,1), + %% A dot followed by eof is special: ?line {more, C} = erl_scan:tokens([], "a.", 1), ?line {done,{ok,[{atom,1,a},{dot,1}],1},eof} = erl_scan:tokens(C,eof,1), ?line {ok,[{atom,1,foo},{dot,1}],1} = erl_scan:string("foo."), + %% With column. + {more, CCol} = erl_scan:tokens([], "a.", {1,1}), + {done,{ok,[{atom,{1,1},a},{dot,{1,2}}],{1,3}},eof} = + erl_scan:tokens(CCol,eof,1), + {ok,[{atom,{1,1},foo},{dot,{1,4}}],{1,5}} = + erl_scan:string("foo.", {1,1}, []), + ok. illegal() -> @@ -816,34 +852,34 @@ unicode() -> erl_scan:string([1089]), ?line {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = erl_scan:string([1089], {1,1}), - ?line {error,{1,erl_scan,{illegal,atom}},1} = + {error,{1,erl_scan,{illegal,atom}},1} = erl_scan:string("'a"++[1089]++"b'", 1), - ?line {error,{{1,1},erl_scan,{illegal,atom}},{1,6}} = + {error,{{1,1},erl_scan,{illegal,atom}},{1,6}} = erl_scan:string("'a"++[1089]++"b'", {1,1}), ?line test("\"a"++[1089]++"b\""), - ?line {ok,[{char,1,1}],1} = + {ok,[{char,1,1}],1} = erl_scan:string([$$,$\\,$^,1089], 1), - ?line {error,{1,erl_scan,Error},1} = + {error,{1,erl_scan,Error},1} = erl_scan:string("\"qa\x{aaa}", 1), - ?line "unterminated string starting with \"qa"++[2730]++"\"" = + "unterminated string starting with \"qa"++[2730]++"\"" = erl_scan:format_error(Error), ?line {error,{{1,1},erl_scan,_},{1,11}} = erl_scan:string("\"qa\\x{aaa}",{1,1}), - ?line {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = + {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = erl_scan:string("'qa\\x{aaa}'",{1,1}), - ?line {ok,[{char,1,1089}],1} = + {ok,[{char,1,1089}],1} = erl_scan:string([$$,1089], 1), - ?line {ok,[{char,1,1089}],1} = + {ok,[{char,1,1089}],1} = erl_scan:string([$$,$\\,1089], 1), Qs = "$\\x{aaa}", - ?line {ok,[{char,1,$\x{aaa}}],1} = + {ok,[{char,1,$\x{aaa}}],1} = erl_scan:string(Qs, 1), - ?line {ok,[Q2],{1,9}} = + {ok,[Q2],{1,9}} = erl_scan:string("$\\x{aaa}", {1,1}, [text]), - ?line [{category,char},{column,1},{length,8}, + [{category,char},{column,1},{length,8}, {line,1},{symbol,16#aaa},{text,Qs}] = erl_scan:token_info(Q2), @@ -1164,7 +1200,13 @@ otp_11807(Config) when is_list(Config) -> (catch erl_parse:abstract("string", [{encoding,bad}])), ok. -test_string(String, Expected) -> +test_string(String, ExpectedWithCol) -> + {ok, ExpectedWithCol, _EndWithCol} = erl_scan:string(String, {1, 1}, []), + Expected = [ begin + {L,_C} = element(2, T), + setelement(2, T, L) + end + || T <- ExpectedWithCol ], {ok, Expected, _End} = erl_scan:string(String), test(String). diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index 8aeec07ae8..336065b258 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -31,7 +31,9 @@ -export([shutdown/1]). --export([ sys1/1, call_format_status/1, error_format_status/1, get_state/1, replace_state/1]). +-export([ sys1/1, + call_format_status/1, error_format_status/1, terminate_crash_format/1, + get_state/1, replace_state/1]). -export([hibernate/1,hiber_idle/3,hiber_wakeup/3,hiber_idle/2,hiber_wakeup/2]). @@ -66,7 +68,8 @@ groups() -> start8, start9, start10, start11, start12]}, {abnormal, [], [abnormal1, abnormal2]}, {sys, [], - [sys1, call_format_status, error_format_status, get_state, replace_state]}]. + [sys1, call_format_status, error_format_status, terminate_crash_format, + get_state, replace_state]}]. init_per_suite(Config) -> Config. @@ -403,7 +406,7 @@ error_format_status(Config) when is_list(Config) -> receive {error,_GroupLeader,{Pid, "** State machine"++_, - [Pid,{_,_,badreturn},idle,StateData,_]}} -> + [Pid,{_,_,badreturn},idle,{formatted,StateData},_]}} -> ok; Other -> ?line io:format("Unexpected: ~p", [Other]), @@ -413,6 +416,29 @@ error_format_status(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +terminate_crash_format(Config) when is_list(Config) -> + error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + StateData = crash_terminate, + {ok, Pid} = gen_fsm:start(gen_fsm_SUITE, {state_data, StateData}, []), + stop_it(Pid), + receive + {error,_GroupLeader,{Pid, + "** State machine"++_, + [Pid,{_,_,_},idle,{formatted, StateData},_]}} -> + ok; + Other -> + io:format("Unexpected: ~p", [Other]), + ?t:fail() + after 5000 -> + io:format("Timeout: expected error logger msg", []), + ?t:fail() + end, + [] = ?t:messages_get(), + process_flag(trap_exit, OldFl), + ok. + + get_state(Config) when is_list(Config) -> State = self(), {ok, Pid} = gen_fsm:start(?MODULE, {state_data, State}, []), @@ -867,7 +893,8 @@ init({state_data, StateData}) -> init(_) -> {ok, idle, state_data}. - +terminate(_, _State, crash_terminate) -> + exit({crash, terminate}); terminate({From, stopped}, State, _Data) -> From ! {self(), {stopped, State}}, ok; @@ -1005,6 +1032,6 @@ handle_sync_event({get, _Pid}, _From, State, Data) -> {reply, {state, State, Data}, State, Data}. format_status(terminate, [_Pdict, StateData]) -> - StateData; + {formatted, StateData}; format_status(normal, [_Pdict, _StateData]) -> [format_status_called]. diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 960e7f60e7..42694d8b5d 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -32,7 +32,8 @@ spec_init_local_registered_parent/1, spec_init_global_registered_parent/1, otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1, - error_format_status/1, get_state/1, replace_state/1, call_with_huge_message_queue/1 + error_format_status/1, terminate_crash_format/1, + get_state/1, replace_state/1, call_with_huge_message_queue/1 ]). % spawn export @@ -56,7 +57,8 @@ all() -> call_remote_n3, spec_init, spec_init_local_registered_parent, spec_init_global_registered_parent, otp_5854, hibernate, - otp_7669, call_format_status, error_format_status, + otp_7669, + call_format_status, error_format_status, terminate_crash_format, get_state, replace_state, call_with_huge_message_queue]. @@ -273,7 +275,7 @@ crash(Config) when is_list(Config) -> receive {error,_GroupLeader4,{Pid4, "** Generic server"++_, - [Pid4,crash,state4,crashed]}} -> + [Pid4,crash,{formatted, state4},crashed]}} -> ok; Other4a -> ?line io:format("Unexpected: ~p", [Other4a]), @@ -1024,7 +1026,7 @@ error_format_status(Config) when is_list(Config) -> receive {error,_GroupLeader,{Pid, "** Generic server"++_, - [Pid,crash,State,crashed]}} -> + [Pid,crash,{formatted, State},crashed]}} -> ok; Other -> ?line io:format("Unexpected: ~p", [Other]), @@ -1034,6 +1036,31 @@ error_format_status(Config) when is_list(Config) -> process_flag(trap_exit, OldFl), ok. +%% Verify that error when terminating correctly calls our format_status/2 fun +%% +terminate_crash_format(Config) when is_list(Config) -> + error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + State = crash_terminate, + {ok, Pid} = gen_server:start_link(?MODULE, {state, State}, []), + gen_server:call(Pid, stop), + receive {'EXIT', Pid, {crash, terminate}} -> ok end, + receive + {error,_GroupLeader,{Pid, + "** Generic server"++_, + [Pid,stop, {formatted, State},{crash, terminate}]}} -> + ok; + Other -> + io:format("Unexpected: ~p", [Other]), + ?t:fail() + after 5000 -> + io:format("Timeout: expected error logger msg", []), + ?t:fail() + end, + ?t:messages_get(), + process_flag(trap_exit, OldFl), + ok. + %% Verify that sys:get_state correctly returns gen_server state %% get_state(suite) -> @@ -1323,10 +1350,12 @@ terminate({From, stopped}, _State) -> terminate({From, stopped_info}, _State) -> From ! {self(), stopped_info}, ok; +terminate(_, crash_terminate) -> + exit({crash, terminate}); terminate(_Reason, _State) -> ok. format_status(terminate, [_PDict, State]) -> - State; + {formatted, State}; format_status(normal, [_PDict, _State]) -> format_status_called. diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 5a8971c071..3a76275f31 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -30,7 +30,7 @@ io_fread_newlines/1, otp_8989/1, io_lib_fread_literal/1, printable_range/1, io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1, - otp_10836/1]). + otp_10836/1, io_lib_width_too_small/1]). -export([pretty/2]). @@ -69,7 +69,8 @@ all() -> io_lib_collect_line_3_wb, cr_whitespace_in_string, io_fread_newlines, otp_8989, io_lib_fread_literal, printable_range, - io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836]. + io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836, + io_lib_width_too_small]. groups() -> []. @@ -2213,3 +2214,8 @@ compile_file(File, Text, Config) -> try compile:file(Fname, [return]) after ok %file:delete(Fname) end. + +io_lib_width_too_small(Config) -> + "**" = lists:flatten(io_lib:format("~2.3w", [3.14])), + "**" = lists:flatten(io_lib:format("~2.5w", [3.14])), + ok. diff --git a/lib/stdlib/test/maps_SUITE.erl b/lib/stdlib/test/maps_SUITE.erl index c826ee731a..dda20a615b 100644 --- a/lib/stdlib/test/maps_SUITE.erl +++ b/lib/stdlib/test/maps_SUITE.erl @@ -24,10 +24,7 @@ -include_lib("test_server/include/test_server.hrl"). -% Default timetrap timeout (set in init_per_testcase). -% This should be set relatively high (10-15 times the expected -% max testcasetime). --define(default_timeout, ?t:minutes(4)). +-define(default_timeout, ?t:minutes(1)). % Test server specific exports -export([all/0]). @@ -37,13 +34,13 @@ -export([init_per_testcase/2]). -export([end_per_testcase/2]). --export([get3/1]). +-export([t_get_3/1,t_with_2/1,t_without_2/1]). suite() -> [{ct_hooks, [ts_install_cth]}]. all() -> - [get3]. + [t_get_3,t_with_2,t_without_2]. init_per_suite(Config) -> Config. @@ -52,7 +49,7 @@ end_per_suite(_Config) -> ok. init_per_testcase(_Case, Config) -> - ?line Dog=test_server:timetrap(?default_timeout), + Dog=test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -60,10 +57,24 @@ end_per_testcase(_Case, Config) -> test_server:timetrap_cancel(Dog), ok. -get3(Config) when is_list(Config) -> +t_get_3(Config) when is_list(Config) -> Map = #{ key1 => value1, key2 => value2 }, DefaultValue = "Default value", - ?line value1 = maps:get(key1, Map, DefaultValue), - ?line value2 = maps:get(key2, Map, DefaultValue), - ?line DefaultValue = maps:get(key3, Map, DefaultValue), + value1 = maps:get(key1, Map, DefaultValue), + value2 = maps:get(key2, Map, DefaultValue), + DefaultValue = maps:get(key3, Map, DefaultValue), + ok. + +t_without_2(_Config) -> + Ki = [11,22,33,44,55,66,77,88,99], + M0 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100)]), + M1 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100) -- Ki]), + M1 = maps:without([{k,I}||I <- Ki],M0), + ok. + +t_with_2(_Config) -> + Ki = [11,22,33,44,55,66,77,88,99], + M0 = maps:from_list([{{k,I},{v,I}}||I<-lists:seq(1,100)]), + M1 = maps:from_list([{{k,I},{v,I}}||I<-Ki]), + M1 = maps:with([{k,I}||I <- Ki],M0), ok. diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index e016432f4d..f841e2c4a6 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -2532,6 +2532,11 @@ otp_6554(Config) when is_list(Config) -> "\n end.\nok.\n" = t(<<"begin F = fun() -> foo end, 1 end. B = F(). C = 17. b().">>), + ?line "3: command not found" = comm_err(<<"#{v(3) => v}.">>), + ?line "3: command not found" = comm_err(<<"#{k => v(3)}.">>), + ?line "3: command not found" = comm_err(<<"#{v(3) := v}.">>), + ?line "3: command not found" = comm_err(<<"#{k := v(3)}.">>), + ?line "3: command not found" = comm_err(<<"(v(3))#{}.">>), %% Tests I'd like to do: (you should try them manually) %% "catch spawn_link(fun() -> timer:sleep(1000), exit(foo) end)." %% "** exception error: foo" should be output after 1 second diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index 20ee32c861..f1251fddab 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -61,6 +61,8 @@ locations/1, inspect/1, inspect/2, + histogram/1, + histogram/2, information/0, swap_pid_keys/0, % set options @@ -89,14 +91,14 @@ duration = 0 }). - -record(stats, { - file, - line, - tries, - colls, - time, % us - nt % #timings collected + file :: atom(), + line :: non_neg_integer(), + tries :: non_neg_integer(), + colls :: non_neg_integer(), + time :: non_neg_integer(), % us + nt :: non_neg_integer(), % #timings collected + hist :: tuple() % histogram }). -record(lock, { @@ -115,7 +117,9 @@ colls, cr, % collision ratio time, - dtr % time duration ratio + dtr, % time duration ratio + %% new + hist % log2 histogram of lock wait_time }). @@ -127,7 +131,7 @@ %% -------------------------------------------------------------------- %% start() -> gen_server:start({local, ?MODULE}, ?MODULE, [], []). -stop() -> gen_server:cast(?MODULE, stop). +stop() -> gen_server:call(?MODULE, stop, infinity). init([]) -> {ok, #state{ locks = [], duration = 0 } }. %% -------------------------------------------------------------------- %% @@ -171,6 +175,8 @@ conflicts() -> call({conflicts, []}). conflicts(Opts) -> call({conflicts, Opts}). inspect(Lock) -> call({inspect, Lock, []}). inspect(Lock, Opts) -> call({inspect, Lock, Opts}). +histogram(Lock) -> call({histogram, Lock, []}). +histogram(Lock, Opts)-> call({histogram, Lock, Opts}). information() -> call(information). swap_pid_keys() -> call(swap_pid_keys). raw() -> call(raw). @@ -283,14 +289,14 @@ handle_call({locations, InOpts}, _From, #state{ locks = Locks } = State) when is {reply, ok, State}; -handle_call({inspect, Lockname, InOpts}, _From, #state{ duration = Duration, locks = Locks } = State) when is_list(InOpts) -> +handle_call({inspect, Lockname, InOpts}, _From, #state{ duration=Duration, locks=Locks } = State) when is_list(InOpts) -> Default = [ {sort, time}, {reverse, false}, - {print, [name,id,tries,colls,ratio,time,duration]}, + {print, [name,id,tries,colls,ratio,time,duration,histogram]}, {max_locks, 20}, {combine, false}, - {thresholds, [] }, + {thresholds, []}, {locations, false}], Opts = options(InOpts, Default), @@ -299,7 +305,7 @@ handle_call({inspect, Lockname, InOpts}, _From, #state{ duration = Duration, loc {true, true} -> locks_ids(Filtered); _ -> [] end, - Combos = combine_classes(Filtered, proplists:get_value(combine, Opts)), + Combos = combine_classes(Filtered, proplists:get_value(combine, Opts)), case proplists:get_value(locations, Opts) of true -> lists:foreach(fun @@ -313,17 +319,14 @@ handle_call({inspect, Lockname, InOpts}, _From, #state{ duration = Duration, loc [] -> ok; _ -> - %io:format("Combined ~p~n", [Combined]), print("lock: " ++ term2string(Name)), print("id: " ++ IdString), print("type: " ++ term2string(Type)), Ps = stats2print(Combined, Duration), - Opts1 = options([{print, [entry, tries,colls,ratio,time,duration]}, + Opts1 = options([{print, [entry, tries,colls,ratio,time,duration,histogram]}, {thresholds, [{tries, -1}, {colls, -1}, {time, -1}]}], Opts), print_lock_information(filter_print(Ps, Opts1), proplists:get_value(print, Opts1)) end - % (#lock{ name = Name, id = Id}) -> - % io:format("Empty lock ~p ~p~n", [Name, Id]) end, Combos); _ -> Print1 = locks2print(Combos, Duration), @@ -332,6 +335,34 @@ handle_call({inspect, Lockname, InOpts}, _From, #state{ duration = Duration, loc end, {reply, ok, State}; +%% histogram + +handle_call({histogram, Lockname, InOpts}, _From, #state{ duration=Duration, locks=Locks} = State)-> + Default = [ + {sort, time}, + {reverse, false}, + {print, [name,id,tries,colls,ratio,time,duration,histogram]}, + {max_locks, 20}, + {combine, true}, + {thresholds, []}, + {locations, false}], + + Opts = options(InOpts, Default), + Filtered = filter_locks(Locks, Lockname), + Combos = combine_classes(Filtered, proplists:get_value(combine, Opts)), + lists:foreach(fun + (#lock{ stats = Stats }=L) -> + SumStats = summate_stats(Stats), + Opts1 = options([{print, [name,id,tries,colls,ratio,time,duration]}, + {thresholds, [{tries, -1}, {colls, -1}, {time, -1}]}], Opts), + Prints = locks2print([L], Duration), + print_lock_information(Prints, proplists:get_value(print, Opts1)), + print_full_histogram(SumStats#stats.hist), + io:format("~n") + end, Combos), + + {reply, ok, State}; + handle_call(raw, _From, #state{ locks = Locks} = State)-> {reply, Locks, State}; @@ -347,7 +378,6 @@ handle_call(swap_pid_keys, _From, #state{ locks = Locks } = State)-> (L) -> L end, Locks), - {reply, ok, State#state{ locks = SwappedLocks}}; % settings @@ -380,6 +410,8 @@ handle_call({save, Filename}, _From, State) -> {reply, {error, Error}, State} end; +handle_call(stop, _From, State) -> + {stop, normal, ok, State}; handle_call(Command, _From, State) -> {reply, {error, {undefined, Command}}, State}. @@ -390,8 +422,6 @@ handle_call(Command, _From, State) -> %% %% -------------------------------------------------------------------- %% -handle_cast(stop, State) -> - {stop, normal, State}; handle_cast(_, State) -> {noreply, State}. @@ -432,15 +462,32 @@ code_change(_OldVsn, State, _Extra) -> summate_locks(Locks) -> summate_locks(Locks, #stats{ tries = 0, colls = 0, time = 0, nt = 0}). summate_locks([], Stats) -> Stats; -summate_locks([L|Ls], #stats{ tries = Tries, colls = Colls, time = Time, nt = Nt}) -> +summate_locks([L|Ls], #stats{ tries = Tries, colls = Colls, time = Time, nt = Nt, hist = Hist}) -> S = summate_stats(L#lock.stats), - summate_locks(Ls, #stats{ tries = Tries + S#stats.tries, colls = Colls + S#stats.colls, time = Time + S#stats.time, nt = Nt + S#stats.nt}). + summate_locks(Ls, #stats{ + tries = Tries + S#stats.tries, + colls = Colls + S#stats.colls, + time = Time + S#stats.time, + nt = Nt + S#stats.nt, + hist = summate_histogram(Hist, S#stats.hist) + }). summate_stats(Stats) -> summate_stats(Stats, #stats{ tries = 0, colls = 0, time = 0, nt = 0}). summate_stats([], Stats) -> Stats; -summate_stats([S|Ss], #stats{ tries = Tries, colls = Colls, time = Time, nt = Nt}) -> - summate_stats(Ss, #stats{ tries = Tries + S#stats.tries, colls = Colls + S#stats.colls, time = Time + S#stats.time, nt = Nt + S#stats.nt}). - +summate_stats([S|Ss], #stats{ tries = Tries, colls = Colls, time = Time, nt = Nt, hist = Hist}) -> + summate_stats(Ss, #stats{ + tries = Tries + S#stats.tries, + colls = Colls + S#stats.colls, + time = Time + S#stats.time, + nt = Nt + S#stats.nt, + hist = summate_histogram(Hist, S#stats.hist) + }). + +%% first call is undefined +summate_histogram(Tup,undefined) when is_tuple(Tup) -> Tup; +summate_histogram(undefined,Tup) when is_tuple(Tup) -> Tup; +summate_histogram(Hs1,Hs2) -> + list_to_tuple([ A + B || {A,B} <- lists:zip(tuple_to_list(Hs1),tuple_to_list(Hs2))]). %% manipulators filter_locks_type(Locks, undefined) -> Locks; @@ -465,17 +512,16 @@ filter_print(PLs, Opts) -> TLs = threshold_locks(PLs, proplists:get_value(thresholds, Opts, [])), SLs = sort_locks(TLs, proplists:get_value(sort, Opts, time)), CLs = cut_locks(SLs, proplists:get_value(max_locks, Opts, none)), - reverse_locks(CLs, proplists:get_value(reverse, Opts, false)). - -sort_locks(Locks, Type) -> lists:reverse(sort_locks0(Locks, Type)). -sort_locks0(Locks, name) -> lists:keysort(#print.name, Locks); -sort_locks0(Locks, id) -> lists:keysort(#print.id, Locks); -sort_locks0(Locks, type) -> lists:keysort(#print.type, Locks); -sort_locks0(Locks, tries) -> lists:keysort(#print.tries, Locks); -sort_locks0(Locks, colls) -> lists:keysort(#print.colls, Locks); -sort_locks0(Locks, ratio) -> lists:keysort(#print.cr, Locks); -sort_locks0(Locks, time) -> lists:keysort(#print.time, Locks); -sort_locks0(Locks, _) -> sort_locks0(Locks, time). + reverse_locks(CLs, not proplists:get_value(reverse,Opts, false)). + +sort_locks(Locks, name) -> lists:keysort(#print.name, Locks); +sort_locks(Locks, id) -> lists:keysort(#print.id, Locks); +sort_locks(Locks, type) -> lists:keysort(#print.type, Locks); +sort_locks(Locks, tries) -> lists:keysort(#print.tries, Locks); +sort_locks(Locks, colls) -> lists:keysort(#print.colls, Locks); +sort_locks(Locks, ratio) -> lists:keysort(#print.cr, Locks); +sort_locks(Locks, time) -> lists:keysort(#print.time, Locks); +sort_locks(Locks, _) -> sort_locks(Locks, time). % cut locks not above certain thresholds threshold_locks(Locks, Thresholds) -> @@ -556,45 +602,61 @@ locks_ids(Locks) -> locks_ids(Locks, []). locks_ids([], Out) -> Out; locks_ids([#lock{ name = Key } = L|Ls], Out) -> case proplists:get_value(Key, Out) of - undefined -> - locks_ids(Ls, [{Key, [L#lock.id] } | Out]); - Ids -> - locks_ids(Ls, [{Key, [L#lock.id | Ids] } | proplists:delete(Key,Out)]) + undefined -> locks_ids(Ls, [{Key, [L#lock.id]}|Out]); + Ids -> locks_ids(Ls, [{Key, [L#lock.id|Ids]}|proplists:delete(Key,Out)]) end. stats2print(Stats, Duration) -> lists:map(fun (S) -> - #print{ - entry = term2string("~tp:~p", [S#stats.file, S#stats.line]), - colls = S#stats.colls, - tries = S#stats.tries, - cr = percent(S#stats.colls, S#stats.tries), - time = S#stats.time, - dtr = percent(S#stats.time, Duration) - } + #print{entry = term2string("~tp:~p", [S#stats.file, S#stats.line]), + colls = S#stats.colls, + tries = S#stats.tries, + cr = percent(S#stats.colls, S#stats.tries), + time = S#stats.time, + dtr = percent(S#stats.time, Duration), + hist = format_histogram(S#stats.hist)} end, Stats). locks2print(Locks, Duration) -> lists:map( fun (L) -> - Tries = lists:sum([T || #stats{ tries = T} <- L#lock.stats]), - Colls = lists:sum([C || #stats{ colls = C} <- L#lock.stats]), - Time = lists:sum([T || #stats{ time = T} <- L#lock.stats]), - Cr = percent(Colls, Tries), - Dtr = percent(Time, Duration), - #print{ - name = L#lock.name, - id = L#lock.id, - type = L#lock.type, - tries = Tries, - colls = Colls, - cr = Cr, - time = Time, - dtr = Dtr - } + #stats{tries = Tries, + colls = Colls, + time = Time, + hist = Hist} = summate_stats(L#lock.stats), + Cr = percent(Colls, Tries), + Dtr = percent(Time, Duration), + #print{name = L#lock.name, + id = L#lock.id, + type = L#lock.type, + tries = Tries, + colls = Colls, + hist = format_histogram(Hist), + cr = Cr, + time = Time, + dtr = Dtr} end, Locks). + +format_histogram(Tup) when is_tuple(Tup) -> + Vs = tuple_to_list(Tup), + Max = lists:max(Vs), + case Max of + 0 -> string_histogram(Vs); + _ -> string_histogram([case V of 0 -> 0; _ -> V/Max end || V <- Vs]) + end. + +string_histogram([0|Vs]) -> + [$\s|string_histogram(Vs)]; +string_histogram([V|Vs]) when V > 0.66 -> + [$X|string_histogram(Vs)]; +string_histogram([V|Vs]) when V > 0.33 -> + [$x|string_histogram(Vs)]; +string_histogram([_|Vs]) -> + [$.|string_histogram(Vs)]; +string_histogram([]) -> []. + %% state making data2state(Data, State) -> @@ -606,22 +668,32 @@ data2state(Data, State) -> locks = Locks }. -locks2records(Locks) -> locks2records(Locks, []). -locks2records([], Out) -> Out; -locks2records([{Name, Id, Type, Stats}|Locks], Out) -> - Lock = #lock{ - name = Name, - id = clean_id_creation(Id), - type = Type, - stats = [ #stats{ - file = File, - line = Line, - tries = Tries, - colls = Colls, - time = time2us({S, Ns}), - nt = N - } || {{File, Line}, {Tries, Colls, {S, Ns, N}}} <- Stats] }, - locks2records(Locks, [Lock|Out]). +locks2records([{Name, Id, Type, Stats}|Locks]) -> + [#lock{name = Name, + id = clean_id_creation(Id), + type = Type, + stats = stats2record(Stats)}|locks2records(Locks)]; +locks2records([]) -> []. + +%% new stats with histogram +stats2record([{{File,Line},{Tries,Colls,{S,Ns,N}},Hist}|Stats]) -> + [#stats{file = File, + line = Line, + hist = Hist, + tries = Tries, + colls = Colls, + time = time2us({S, Ns}), + nt = N} | stats2record(Stats)]; +%% old stats without histogram +stats2record([{{File,Line},{Tries,Colls,{S,Ns,N}}}|Stats]) -> + [#stats{file = File, + line = Line, + hist = {}, + tries = Tries, + colls = Colls, + time = time2us({S, Ns}), + nt = N} | stats2record(Stats)]; +stats2record([]) -> []. clean_id_creation(Id) when is_pid(Id) -> Bin = term_to_binary(Id), @@ -647,22 +719,45 @@ state2list(State) -> (X, Y) -> {X,Y} end, record_info(fields, state), Values). -list2state(List) -> list2state(record_info(fields, state), List, [state]). -list2state([], _, Out) -> list_to_tuple(lists:reverse(Out)); -list2state([locks|Fs], List, Out) -> - Locks = [ list2lock(Lock) || Lock <- proplists:get_value(locks, List, [])], - list2state(Fs, List, [Locks|Out]); -list2state([F|Fs], List, Out) -> list2state(Fs, List, [proplists:get_value(F, List, state_default(F))|Out]). - lock_default(Field) -> proplists:get_value(Field, lock2list(#lock{})). lock2list(Lock) -> [_|Values] = tuple_to_list(Lock), lists:zip(record_info(fields, lock), Values). -list2lock(List) -> list2lock(record_info(fields, lock), List, [lock]). -list2lock([], _, Out) -> list_to_tuple(lists:reverse(Out)); -list2lock([F|Fs], List, Out) -> list2lock(Fs, List, [proplists:get_value(F, List, lock_default(F))|Out]). + +list2state(List) -> + list_to_tuple([state|list2state(record_info(fields, state), List)]). +list2state([], _) -> []; +list2state([locks|Fs], List) -> + Locks = [list2lock(Lock) || Lock <- proplists:get_value(locks, List, [])], + [Locks|list2state(Fs,List)]; +list2state([F|Fs], List) -> + [proplists:get_value(F, List, state_default(F))|list2state(Fs, List)]. + +list2lock(Ls) -> + list_to_tuple([lock|list2lock(record_info(fields, lock), Ls)]). + +list2lock([],_) -> []; +list2lock([stats=F|Fs], Ls) -> + Stats = stats2stats(proplists:get_value(F, Ls, lock_default(F))), + [Stats|list2lock(Fs, Ls)]; +list2lock([F|Fs], Ls) -> + [proplists:get_value(F, Ls, lock_default(F))|list2lock(Fs, Ls)]. + +%% process old stats (hack) +%% old stats had no histograms +%% in future versions stats should be serialized as a list, not a record + +stats2stats([]) -> []; +stats2stats([Stat|Stats]) -> + Sz = tuple_size(#stats{}), + [stat2stat(Stat,Sz)|stats2stats(Stats)]. + +stat2stat(Stat,Sz) when tuple_size(Stat) =:= Sz -> Stat; +stat2stat(Stat,_) -> + %% assume no histogram at the end + list_to_tuple(tuple_to_list(Stat) ++ [{0}]). %% printing @@ -683,7 +778,7 @@ auto_print_width(Locks, Print) -> ({print,print}, Out) -> [print|Out]; ({Str, Len}, Out) -> [erlang:min(erlang:max(length(s(Str))+1,Len),80)|Out] end, [], lists:zip(tuple_to_list(L), tuple_to_list(Max))))) - end, #print{ id = 4, type = 5, entry = 5, name = 6, tries = 8, colls = 13, cr = 16, time = 11, dtr = 14 }, + end, #print{ id = 4, type = 5, entry = 5, name = 6, tries = 8, colls = 13, cr = 16, time = 11, dtr = 14, hist=20 }, Locks), % Setup the offsets for later pruning Offsets = [ @@ -695,7 +790,9 @@ auto_print_width(Locks, Print) -> {colls, R#print.colls}, {ratio, R#print.cr}, {time, R#print.time}, - {duration, R#print.dtr}], + {duration, R#print.dtr}, + {histogram, R#print.hist} + ], % Prune offsets to only allow specified print options lists:foldr(fun ({Type, W}, Out) -> [{Type, W}|Out]; @@ -705,9 +802,7 @@ auto_print_width(Locks, Print) -> print_lock_information(Locks, Print) -> % remake Print to autosize entries AutoPrint = auto_print_width(Locks, Print), - print_header(AutoPrint), - lists:foreach(fun (L) -> print_lock(L, AutoPrint) @@ -724,7 +819,8 @@ print_header(Opts) -> colls = "#collisions", cr = "collisions [%]", time = "time [us]", - dtr = "duration [%]" + dtr = "duration [%]", + hist = "histogram" }, Divider = #print{ name = lists:duplicate(1 + length(Header#print.name), 45), @@ -735,39 +831,44 @@ print_header(Opts) -> colls = lists:duplicate(1 + length(Header#print.colls), 45), cr = lists:duplicate(1 + length(Header#print.cr), 45), time = lists:duplicate(1 + length(Header#print.time), 45), - dtr = lists:duplicate(1 + length(Header#print.dtr), 45) + dtr = lists:duplicate(1 + length(Header#print.dtr), 45), + hist = lists:duplicate(1 + length(Header#print.hist), 45) }, print_lock(Header, Opts), print_lock(Divider, Opts), ok. -print_lock(L, Opts) -> print_lock(L, Opts, []). -print_lock(_, [], Formats) -> print(strings(lists:reverse(Formats))); -print_lock(L, [Opt|Opts], Formats) -> +print_lock(L, Opts) -> + print(strings(format_lock(L, Opts))). + +format_lock(_, []) -> []; +format_lock(L, [Opt|Opts]) -> case Opt of - id -> print_lock(L, Opts, [{space, 25, s(L#print.id) } | Formats]); - {id, W} -> print_lock(L, Opts, [{space, W, s(L#print.id) } | Formats]); - type -> print_lock(L, Opts, [{space, 18, s(L#print.type) } | Formats]); - {type, W} -> print_lock(L, Opts, [{space, W, s(L#print.type) } | Formats]); - entry -> print_lock(L, Opts, [{space, 30, s(L#print.entry)} | Formats]); - {entry, W} -> print_lock(L, Opts, [{space, W, s(L#print.entry)} | Formats]); - name -> print_lock(L, Opts, [{space, 22, s(L#print.name) } | Formats]); - {name, W} -> print_lock(L, Opts, [{space, W, s(L#print.name) } | Formats]); - tries -> print_lock(L, Opts, [{space, 12, s(L#print.tries)} | Formats]); - {tries, W} -> print_lock(L, Opts, [{space, W, s(L#print.tries)} | Formats]); - colls -> print_lock(L, Opts, [{space, 14, s(L#print.colls)} | Formats]); - {colls, W} -> print_lock(L, Opts, [{space, W, s(L#print.colls)} | Formats]); - ratio -> print_lock(L, Opts, [{space, 20, s(L#print.cr) } | Formats]); - {ratio, W} -> print_lock(L, Opts, [{space, W, s(L#print.cr) } | Formats]); - time -> print_lock(L, Opts, [{space, 15, s(L#print.time) } | Formats]); - {time, W} -> print_lock(L, Opts, [{space, W, s(L#print.time) } | Formats]); - duration -> print_lock(L, Opts, [{space, 20, s(L#print.dtr) } | Formats]); - {duration, W} -> print_lock(L, Opts, [{space, W, s(L#print.dtr) } | Formats]); - _ -> print_lock(L, Opts, Formats) + id -> [{space, 25, s(L#print.id) } | format_lock(L, Opts)]; + {id, W} -> [{space, W, s(L#print.id) } | format_lock(L, Opts)]; + type -> [{space, 18, s(L#print.type) } | format_lock(L, Opts)]; + {type, W} -> [{space, W, s(L#print.type) } | format_lock(L, Opts)]; + entry -> [{space, 30, s(L#print.entry)} | format_lock(L, Opts)]; + {entry, W} -> [{space, W, s(L#print.entry)} | format_lock(L, Opts)]; + name -> [{space, 22, s(L#print.name) } | format_lock(L, Opts)]; + {name, W} -> [{space, W, s(L#print.name) } | format_lock(L, Opts)]; + tries -> [{space, 12, s(L#print.tries)} | format_lock(L, Opts)]; + {tries, W} -> [{space, W, s(L#print.tries)} | format_lock(L, Opts)]; + colls -> [{space, 14, s(L#print.colls)} | format_lock(L, Opts)]; + {colls, W} -> [{space, W, s(L#print.colls)} | format_lock(L, Opts)]; + ratio -> [{space, 20, s(L#print.cr) } | format_lock(L, Opts)]; + {ratio, W} -> [{space, W, s(L#print.cr) } | format_lock(L, Opts)]; + time -> [{space, 15, s(L#print.time) } | format_lock(L, Opts)]; + {time, W} -> [{space, W, s(L#print.time) } | format_lock(L, Opts)]; + duration -> [{space, 20, s(L#print.dtr) } | format_lock(L, Opts)]; + {duration, W} -> [{space, W, s(L#print.dtr) } | format_lock(L, Opts)]; + histogram -> [{space, 0, s(L#print.hist) } | format_lock(L, Opts)]; + {histogram, W} -> [{space, W, s(L#print.hist) } | format_lock(L, Opts)]; + _ -> format_lock(L, Opts) end. -print_state_information(#state{ locks = Locks} = State) -> +print_state_information(#state{locks = Locks} = State) -> Stats = summate_locks(Locks), print("information:"), print(kv("#locks", s(length(Locks)))), @@ -779,9 +880,25 @@ print_state_information(#state{ locks = Locks} = State) -> print(kv("percent of duration", s(Stats#stats.time/State#state.duration*100) ++ " %")), ok. + +print_full_histogram(T) when is_tuple(T) -> + Vs = tuple_to_list(T), + Max = lists:max(Vs), + W = 60, + print_full_histogram(0,Vs,Max,W). + +print_full_histogram(_,[],_,_) -> ok; +print_full_histogram(Ix,[V|Vs],0,W) -> + io:format("~2w = log2 : ~8w |~n", [Ix,V]), + print_full_histogram(Ix+1,Vs,0,W); +print_full_histogram(Ix,[V|Vs],Max,W) -> + io:format("~2w = log2 : ~8w | ~s~n", [Ix,V,lists:duplicate(trunc(W*(V/Max)), $#)]), + print_full_histogram(Ix+1,Vs,Max,W). + + %% AUX -time2us({S, Ns}) -> round(S*1000000 + Ns/1000). +time2us({S, Ns}) -> S*1000000 + (Ns div 1000). percent(_,0) -> 0.0; percent(T,N) -> T/N*100. @@ -808,7 +925,7 @@ s(T) -> term2string(T). strings(Strings) -> strings(Strings, []). strings([], Out) -> Out; -strings([{space, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string("~~~ps", [N]), [S])); +strings([{space, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string("~~~ws", [N]), [S])); strings([{format, Format, S} | Ss], Out) -> strings(Ss, Out ++ term2string(Format, [S])); strings([S|Ss], Out) -> strings(Ss, Out ++ term2string("~ts", [S])). @@ -825,7 +942,7 @@ term2string(Term) when is_pid(Term) -> term2string(Term) -> term2string("~w", [Term]). term2string(Format, Terms) -> lists:flatten(io_lib:format(Format, Terms)). -%%% AUD id binary +%%% AUX id binary bytes16(Value) -> B0 = Value band 255, diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl index 1bee6021ab..010dffe138 100644 --- a/lib/tools/test/lcnt_SUITE.erl +++ b/lib/tools/test/lcnt_SUITE.erl @@ -27,11 +27,11 @@ %% Test cases -export([ - load_v1/1, - conflicts/1, - locations/1, - swap_keys/1 - ]). + t_load/1, + t_conflicts/1, + t_locations/1, + t_swap_keys/1 + ]). %% Default timetrap timeout (set in init_per_testcase) -define(default_timeout, ?t:minutes(4)). @@ -54,48 +54,52 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> - [load_v1, conflicts, locations, swap_keys]. +all() -> [t_load, t_conflicts, t_locations, t_swap_keys]. -groups() -> - []. +groups() -> []. -init_per_group(_GroupName, Config) -> - Config. +init_per_group(_GroupName, Config) -> Config. -end_per_group(_GroupName, Config) -> - Config. +end_per_group(_GroupName, Config) -> Config. %%---------------------------------------------------------------------- %% Tests %%---------------------------------------------------------------------- -load_v1(suite) -> - []; -load_v1(doc) -> - ["Load data from file."]; -load_v1(Config) when is_list(Config) -> - ?line {ok, _} = lcnt:start(), - ?line Path = ?config(data_dir, Config), - ?line File = filename:join([Path,"big_bang_40.lcnt"]), - ?line ok = lcnt:load(File), - ?line ok = lcnt:stop(), +t_load(suite) -> []; +t_load(doc) -> ["Load data from file."]; +t_load(Config) when is_list(Config) -> + Path = ?config(data_dir, Config), + Files = [filename:join([Path,"big_bang_40.lcnt"]), + filename:join([Path,"ehb_3_3_hist.lcnt"])], + ok = t_load_file(Files), ok. -conflicts(suite) -> - []; -conflicts(doc) -> - ["API: conflicts"]; -conflicts(Config) when is_list(Config) -> - ?line {ok, _} = lcnt:start(), - ?line Path = ?config(data_dir, Config), - ?line File = filename:join([Path,"big_bang_40.lcnt"]), - ?line ok = lcnt:load(File), - ?line ok = lcnt:conflicts(), - THs = [-1, 0, 100, 1000], - Print = [name , id , type , entry , tries , colls , ratio , time , duration], - Opts = [ +t_load_file([]) -> ok; +t_load_file([File|Files]) -> + {ok, _} = lcnt:start(), + ok = lcnt:load(File), + ok = lcnt:stop(), + t_load_file(Files). + +t_conflicts(suite) -> []; +t_conflicts(doc) -> ["API: conflicts"]; +t_conflicts(Config) when is_list(Config) -> + Path = ?config(data_dir, Config), + Files = [filename:join([Path,"big_bang_40.lcnt"]), + filename:join([Path,"ehb_3_3_hist.lcnt"])], + ok = t_conflicts_file(Files), + ok. + +t_conflicts_file([]) -> ok; +t_conflicts_file([File|Files]) -> + {ok, _} = lcnt:start(), + ok = lcnt:load(File), + ok = lcnt:conflicts(), + THs = [-1, 0, 100, 1000], + Print = [name , id , type , entry , tries , colls , ratio , time , duration], + Opts = [ [{sort, Sort}, {reverse, Rev}, {max_locks, ML}, {combine, Combine}, {thresholds, [TH]}, {print, [Print]}] || Sort <- [name , id , type , tries , colls , ratio , time , entry], ML <- [none, 1 , 32, 4096], @@ -103,28 +107,33 @@ conflicts(Config) when is_list(Config) -> TH <- [{tries, Tries} || Tries <- THs] ++ [{colls, Colls} || Colls <- THs] ++ [{time, Time} || Time <- THs], Rev <- [true, false] ], - ?line ok = test_conflicts_opts(Opts), - ?line ok = lcnt:stop(), - ok. + ok = test_conflicts_opts(Opts), + ok = lcnt:stop(), + t_conflicts_file(Files). + test_conflicts_opts([]) -> ok; test_conflicts_opts([Opt|Opts]) -> - ?line ok = lcnt:conflicts(Opt), + ok = lcnt:conflicts(Opt), test_conflicts_opts(Opts). -locations(suite) -> - []; -locations(doc) -> - ["API: locations"]; -locations(Config) when is_list(Config) -> - ?line {ok, _} = lcnt:start(), - ?line Path = ?config(data_dir, Config), - ?line File = filename:join([Path,"big_bang_40.lcnt"]), - ?line ok = lcnt:load(File), - ?line ok = lcnt:locations(), - THs = [-1, 0, 100, 1000], - Print = [name , id , type , entry , tries , colls , ratio , time , duration], - Opts = [ +t_locations(suite) -> []; +t_locations(doc) -> ["API: locations"]; +t_locations(Config) when is_list(Config) -> + Path = ?config(data_dir, Config), + Files = [filename:join([Path,"big_bang_40.lcnt"]), + filename:join([Path,"ehb_3_3_hist.lcnt"])], + ok = t_locations_file(Files), + ok. + +t_locations_file([]) -> ok; +t_locations_file([File|Files]) -> + {ok, _} = lcnt:start(), + ok = lcnt:load(File), + ok = lcnt:locations(), + THs = [-1, 0, 100, 1000], + Print = [name , id , type , entry , tries , colls , ratio , time , duration], + Opts = [ [{full_id, Id}, {sort, Sort}, {max_locks, ML}, {combine, Combine}, {thresholds, [TH]}, {print, Print}] || Sort <- [name , id , type , tries , colls , ratio , time , entry], ML <- [none, 1 , 64], @@ -132,30 +141,34 @@ locations(Config) when is_list(Config) -> TH <- [{tries, Tries} || Tries <- THs] ++ [{colls, Colls} || Colls <- THs] ++ [{time, Time} || Time <- THs], Id <- [true, false] ], - ?line ok = test_locations_opts(Opts), - ?line ok = lcnt:stop(), - ok. + ok = test_locations_opts(Opts), + ok = lcnt:stop(), + t_locations_file(Files). test_locations_opts([]) -> ok; test_locations_opts([Opt|Opts]) -> - ?line ok = lcnt:locations(Opt), + ok = lcnt:locations(Opt), test_locations_opts(Opts). -swap_keys(suite) -> - []; -swap_keys(doc) -> - ["Test interchanging port/process id with class"]; -swap_keys(Config) when is_list(Config) -> - ?line {ok, _} = lcnt:start(), - ?line Path = ?config(data_dir, Config), - ?line File = filename:join([Path,"big_bang_40.lcnt"]), - ?line ok = lcnt:load(File), - ?line ok = lcnt:conflicts(), - ?line ok = lcnt:swap_pid_keys(), - ?line ok = lcnt:conflicts(), - ?line ok = lcnt:stop(), +t_swap_keys(suite) -> []; +t_swap_keys(doc) -> ["Test interchanging port/process id with class"]; +t_swap_keys(Config) when is_list(Config) -> + Path = ?config(data_dir, Config), + Files = [filename:join([Path,"big_bang_40.lcnt"]), + filename:join([Path,"ehb_3_3_hist.lcnt"])], + ok = t_swap_keys_file(Files), ok. +t_swap_keys_file([]) -> ok; +t_swap_keys_file([File|Files]) -> + {ok, _} = lcnt:start(), + ok = lcnt:load(File), + ok = lcnt:conflicts(), + ok = lcnt:swap_pid_keys(), + ok = lcnt:conflicts(), + ok = lcnt:stop(), + t_swap_keys_file(Files). + %%---------------------------------------------------------------------- %% Auxiliary tests diff --git a/lib/tools/test/lcnt_SUITE_data/ehb_3_3_hist.lcnt b/lib/tools/test/lcnt_SUITE_data/ehb_3_3_hist.lcnt Binary files differnew file mode 100644 index 0000000000..ff5bdcbdaa --- /dev/null +++ b/lib/tools/test/lcnt_SUITE_data/ehb_3_3_hist.lcnt diff --git a/lib/wx/configure.in b/lib/wx/configure.in index a96f1f2632..4c4d4f41a8 100644 --- a/lib/wx/configure.in +++ b/lib/wx/configure.in @@ -677,6 +677,27 @@ if test "x$GCC" = xyes; then LM_TRY_ENABLE_CFLAG([-Werror=return-type], [CXXFLAGS]) fi +dnl ---------------------------------------------------------------------- +dnl Enable -fsanitize= flags. +dnl ---------------------------------------------------------------------- + +m4_define(DEFAULT_SANITIZERS, [address,undefined]) +AC_ARG_ENABLE( + sanitizers, + AS_HELP_STRING( + [--enable-sanitizers@<:@=comma-separated list of sanitizers@:>@], + [Default=DEFAULT_SANITIZERS]), +[ +case "$enableval" in + no) sanitizers= ;; + yes) sanitizers="-fsanitize=DEFAULT_SANITIZERS" ;; + *) sanitizers="-fsanitize=$enableval" ;; +esac +CFLAGS="$CFLAGS $sanitizers" +CXXFLAGS="$CXXFLAGS $sanitizers" +LDFLAGS="$LDFLAGS $sanitizers" +]) + ############################################################################# dnl diff --git a/lib/xmerl/doc/src/motorcycles2html.erl b/lib/xmerl/doc/src/motorcycles2html.erl index dfbd19e359..45c713e1ac 100644 --- a/lib/xmerl/doc/src/motorcycles2html.erl +++ b/lib/xmerl/doc/src/motorcycles2html.erl @@ -7,7 +7,7 @@ %%%------------------------------------------------------------------- -module(motorcycles2html). --include("xmerl.hrl"). +-include_lib("xmerl/include/xmerl.hrl"). -import(xmerl_xs, [ xslapply/2, value_of/1, select/2, built_in_rules/2 ]). @@ -57,12 +57,12 @@ template(E) -> built_in_rules(fun template/1, E). %% sorts on the bike name element, unwraps the bike information and %% inserts a line feed and indentation on each bike element. sort_by_manufacturer(L) -> - Tuples=[X1||X1={H,T} <- L], + Tuples=[X1||X1={_,_} <- L], SortedTS = lists:keysort(1,Tuples), InsertRefName_UnWrap= fun([{[Name],V}|Rest],Name,F)-> [V|F(Rest,Name,F)]; - ([{[Name],V}|Rest],PreviousName,F) -> + ([{[Name],V}|Rest],_PreviousName,F) -> [["<a name=\"",Name,"\"></>"],V|F(Rest,Name,F)]; ([],_,_) -> [] end, @@ -71,7 +71,7 @@ sort_by_manufacturer(L) -> WS = "\n ", Fun=fun([H|T],Acc,F)-> F(T,[H,WS|Acc],F); - ([],Acc,F)-> + ([],Acc,_F)-> lists:reverse([WS|Acc]) end, if length(SortedRefed) > 0 -> @@ -96,13 +96,12 @@ remove_duplicates([A|L],Acc) -> end. make_ref([]) -> []; -make_ref([H]) when atom(H) -> +make_ref([H]) when is_atom(H) -> "<ul><a href=\"#"++atom_to_list(H)++"\">"++atom_to_list(H)++"</a></ul>"; -make_ref([H]) when list(H) -> +make_ref([H]) when is_list(H) -> "<ul><a href=\"#"++H++"\">\s"++H++"</a></ul>"; -make_ref([H|T]) when atom(H) -> +make_ref([H|T]) when is_atom(H) -> ["<ul><a href=\"#"++atom_to_list(H)++"\">\s"++atom_to_list(H)++",\n</a></ul>" |make_ref(T)]; -make_ref([H|T]) when list(H) -> +make_ref([H|T]) when is_list(H) -> ["<ul><a href=\"#"++H++"\">\s"++H++",\n</a></ul>"|make_ref(T)]. - diff --git a/otp_versions.table b/otp_versions.table index 3356f2951e..e628c65444 100644 --- a/otp_versions.table +++ b/otp_versions.table @@ -1,3 +1,5 @@ +OTP-17.2.2 : mnesia-4.12.2 # asn1-3.0.1 common_test-1.8.1 compiler-5.0.1 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4 debugger-4.0.1 dialyzer-2.7.1 diameter-1.7 edoc-0.7.14 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.17 erts-6.1.2 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.11 ic-4.3.5 inets-5.10.2 jinterface-1.5.9 kernel-3.0.2 megaco-3.17.1 observer-2.0.1 odbc-2.10.20 orber-3.7 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4 snmp-5.0 ssh-3.0.4 ssl-5.3.5 stdlib-2.1.1 syntax_tools-1.6.16 test_server-3.7.1 tools-2.6.15 typer-0.9.8 webtool-0.8.10 wx-1.3 xmerl-1.3.7 : +OTP-17.2.1 : ssh-3.0.4 # asn1-3.0.1 common_test-1.8.1 compiler-5.0.1 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4 debugger-4.0.1 dialyzer-2.7.1 diameter-1.7 edoc-0.7.14 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.17 erts-6.1.2 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.11 ic-4.3.5 inets-5.10.2 jinterface-1.5.9 kernel-3.0.2 megaco-3.17.1 mnesia-4.12.1 observer-2.0.1 odbc-2.10.20 orber-3.7 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4 snmp-5.0 ssl-5.3.5 stdlib-2.1.1 syntax_tools-1.6.16 test_server-3.7.1 tools-2.6.15 typer-0.9.8 webtool-0.8.10 wx-1.3 xmerl-1.3.7 : OTP-17.2 : orber-3.7 snmp-5.0 # asn1-3.0.1 common_test-1.8.1 compiler-5.0.1 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4 debugger-4.0.1 dialyzer-2.7.1 diameter-1.7 edoc-0.7.14 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.17 erts-6.1.2 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.11 ic-4.3.5 inets-5.10.2 jinterface-1.5.9 kernel-3.0.2 megaco-3.17.1 mnesia-4.12.1 observer-2.0.1 odbc-2.10.20 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4 ssh-3.0.3 ssl-5.3.5 stdlib-2.1.1 syntax_tools-1.6.16 test_server-3.7.1 tools-2.6.15 typer-0.9.8 webtool-0.8.10 wx-1.3 xmerl-1.3.7 : OTP-17.1.2 : erts-6.1.2 kernel-3.0.2 stdlib-2.1.1 # asn1-3.0.1 common_test-1.8.1 compiler-5.0.1 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4 debugger-4.0.1 dialyzer-2.7.1 diameter-1.7 edoc-0.7.14 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.17 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.11 ic-4.3.5 inets-5.10.2 jinterface-1.5.9 megaco-3.17.1 mnesia-4.12.1 observer-2.0.1 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssh-3.0.3 ssl-5.3.5 syntax_tools-1.6.16 test_server-3.7.1 tools-2.6.15 typer-0.9.8 webtool-0.8.10 wx-1.3 xmerl-1.3.7 : OTP-17.1.1 : edoc-0.7.14 erts-6.1.1 syntax_tools-1.6.16 # asn1-3.0.1 common_test-1.8.1 compiler-5.0.1 cosEvent-2.1.15 cosEventDomain-1.1.14 cosFileTransfer-1.1.16 cosNotification-1.1.21 cosProperty-1.1.17 cosTime-1.1.14 cosTransactions-1.2.14 crypto-3.4 debugger-4.0.1 dialyzer-2.7.1 diameter-1.7 eldap-1.0.3 erl_docgen-0.3.5 erl_interface-3.7.17 et-1.5 eunit-2.2.7 gs-1.5.16 hipe-3.11 ic-4.3.5 inets-5.10.2 jinterface-1.5.9 kernel-3.0.1 megaco-3.17.1 mnesia-4.12.1 observer-2.0.1 odbc-2.10.20 orber-3.6.27 os_mon-2.2.15 ose-1.0 otp_mibs-1.0.9 parsetools-2.0.11 percept-0.8.9 public_key-0.22 reltool-0.6.6 runtime_tools-1.8.14 sasl-2.4 snmp-4.25.1 ssh-3.0.3 ssl-5.3.5 stdlib-2.1 test_server-3.7.1 tools-2.6.15 typer-0.9.8 webtool-0.8.10 wx-1.3 xmerl-1.3.7 : diff --git a/system/doc/efficiency_guide/advanced.xml b/system/doc/efficiency_guide/advanced.xml index b5771a5929..51f1b2612c 100644 --- a/system/doc/efficiency_guide/advanced.xml +++ b/system/doc/efficiency_guide/advanced.xml @@ -183,7 +183,7 @@ On 64-bit architectures: 4 words for a reference from the current local node, an <tag><em>Open ports</em></tag> <item> <marker id="ports"></marker> - <p>The maximum number of simultaneously oper Erlang ports is + <p>The maximum number of simultaneously open Erlang ports is often by default 16384. This limit can be configured at startup, for more information see the <seealso marker="erts:erl#max_ports"><c>+Q</c></seealso> diff --git a/system/doc/reference_manual/processes.xml b/system/doc/reference_manual/processes.xml index 20bab1eb48..95ae0672ec 100644 --- a/system/doc/reference_manual/processes.xml +++ b/system/doc/reference_manual/processes.xml @@ -114,8 +114,8 @@ spawn(Module, Name, Args) -> pid() <p>Two processes can be <em>linked</em> to each other. A link between two processes <c>Pid1</c> and <c>Pid2</c> is created by <c>Pid1</c> calling the BIF <c>link(Pid2)</c> (or vice versa). - There also exists a number a <c>spawn_link</c> BIFs, which spawns - and links to a process in one operation.</p> + There also exist a number of <c>spawn_link</c> BIFs, which spawn + and link to a process in one operation.</p> <p>Links are bidirectional and there can only be one link between two processes. Repeated calls to <c>link(Pid)</c> have no effect.</p> <p>A link can be removed by calling the BIF <c>unlink(Pid)</c>.</p> diff --git a/system/doc/system_architecture_intro/sys_arch_intro.xml b/system/doc/system_architecture_intro/sys_arch_intro.xml index 62add510ca..3e88548861 100644 --- a/system/doc/system_architecture_intro/sys_arch_intro.xml +++ b/system/doc/system_architecture_intro/sys_arch_intro.xml @@ -150,7 +150,7 @@ <item>Chapter 8: "Operation and Management Principles" describes the model for operation and maintenance of sub-systems.</item> <item>Chapter 9: "Tutorial" gives an orientation of the different interoperability mechanism, which can be used when integrating an - Erlang program with a program written in an other programming language.</item> + Erlang program with a program written in another programming language.</item> </list> </section> diff --git a/system/doc/system_principles/versions.xml b/system/doc/system_principles/versions.xml index c63913d867..ff042f4a3b 100644 --- a/system/doc/system_principles/versions.xml +++ b/system/doc/system_principles/versions.xml @@ -67,7 +67,7 @@ suffix corresponds to the OTP version of the base system that has been patched. Note that if a development system is updated by other means than <c>otp_patch_apply</c>, the <c>OTP_VERSION</c> file - may identify wrong OTP version.</p> + may identify an incorrect OTP version.</p> <p>No <c>OTP_VERSION</c> file will be placed in a <seealso marker="create_target">target system</seealso> created |