aboutsummaryrefslogtreecommitdiffstats
path: root/lib/kernel
diff options
context:
space:
mode:
Diffstat (limited to 'lib/kernel')
-rw-r--r--lib/kernel/doc/src/file.xml43
-rw-r--r--lib/kernel/doc/src/inet_res.xml2
-rw-r--r--lib/kernel/doc/src/os.xml109
-rw-r--r--lib/kernel/examples/Makefile2
-rw-r--r--lib/kernel/examples/gen_tcp_dist/Makefile20
-rw-r--r--lib/kernel/examples/gen_tcp_dist/ebin/.gitignore0
-rw-r--r--lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl781
-rw-r--r--lib/kernel/include/dist.hrl30
-rw-r--r--lib/kernel/include/dist_util.hrl12
-rw-r--r--lib/kernel/src/dist_util.erl252
-rw-r--r--lib/kernel/src/erl_boot_server.erl6
-rw-r--r--lib/kernel/src/erl_epmd.erl8
-rw-r--r--lib/kernel/src/erl_reply.erl4
-rw-r--r--lib/kernel/src/erts_debug.erl19
-rw-r--r--lib/kernel/src/group.erl91
-rw-r--r--lib/kernel/src/inet_config.erl4
-rw-r--r--lib/kernel/src/inet_dns.erl6
-rw-r--r--lib/kernel/src/inet_parse.erl4
-rw-r--r--lib/kernel/src/inet_res.erl12
-rw-r--r--lib/kernel/src/kernel.app.src2
-rw-r--r--lib/kernel/src/kernel.appup.src4
-rw-r--r--lib/kernel/src/net_kernel.erl4
-rw-r--r--lib/kernel/src/os.erl65
-rw-r--r--lib/kernel/test/file_name_SUITE.erl2
-rw-r--r--lib/kernel/test/gen_udp_SUITE.erl120
-rw-r--r--lib/kernel/test/os_SUITE.erl14
-rw-r--r--lib/kernel/test/zlib_SUITE.erl47
27 files changed, 1417 insertions, 246 deletions
diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml
index b674b3ca93..2ab35b9b05 100644
--- a/lib/kernel/doc/src/file.xml
+++ b/lib/kernel/doc/src/file.xml
@@ -41,7 +41,7 @@
<p>Regarding filename encoding, the Erlang VM can operate in
two modes. The current mode can be queried using function
- <seealso marker="#native_name_encoding"><c>native_name_encoding/0</c></seealso>.
+ <seealso marker="#native_name_encoding/0"><c>native_name_encoding/0</c></seealso>.
It returns <c>latin1</c> or <c>utf8</c>.</p>
<p>In <c>latin1</c> mode, the Erlang VM does not change the
@@ -59,7 +59,7 @@
terminal supports UTF-8, otherwise <c>latin1</c>. The default can
be overridden using <c>+fnl</c> (to force <c>latin1</c> mode)
or <c>+fnu</c> (to force <c>utf8</c> mode) when starting
- <seealso marker="erts:erl"><c>erts:erl</c></seealso>.</p>
+ <seealso marker="erts:erl"><c>erl</c></seealso>.</p>
<p>On operating systems with transparent naming, files can be
inconsistently named, for example, some files are encoded in UTF-8 while
@@ -81,6 +81,23 @@
<p>See also section <seealso marker="stdlib:unicode_usage#notes-about-raw-filenames">Notes About Raw Filenames</seealso> in the STDLIB User's Guide.</p>
+ <note><p>
+ File operations used to accept filenames containing
+ null characters (integer value zero). This caused
+ the name to be truncated and in some cases arguments
+ to primitive operations to be mixed up. Filenames
+ containing null characters inside the filename
+ are now <em>rejected</em> and will cause primitive
+ file operations fail.
+ </p></note>
+ <warning><p>
+ Currently null characters at the end of the filename
+ will be accepted by primitive file operations. Such
+ filenames are however still documented as invalid. The
+ implementation will also change in the future and
+ reject such filenames.
+ </p></warning>
+
</description>
<datatypes>
@@ -96,9 +113,21 @@
</datatype>
<datatype>
<name name="filename"/>
+ <desc>
+ <p>
+ See also the documentation of the
+ <seealso marker="#type-name_all"><c>name_all()</c></seealso> type.
+ </p>
+ </desc>
</datatype>
<datatype>
<name name="filename_all"/>
+ <desc>
+ <p>
+ See also the documentation of the
+ <seealso marker="#type-name_all"><c>name_all()</c></seealso> type.
+ </p>
+ </desc>
</datatype>
<datatype>
<name name="io_device"/>
@@ -112,21 +141,23 @@
<name name="name"/>
<desc>
<p>If VM is in Unicode filename mode, <c>string()</c> and <c>char()</c>
- are allowed to be &gt; 255.
+ are allowed to be &gt; 255. See also the documentation of the
+ <seealso marker="#type-name_all"><c>name_all()</c></seealso> type.
</p>
</desc>
</datatype>
<datatype>
<name name="name_all"/>
<desc>
- <p>If VM is in Unicode filename mode, <c>string()</c> and <c>char()</c>
+ <p>If VM is in Unicode filename mode, characters
are allowed to be &gt; 255.
<c><anno>RawFilename</anno></c> is a filename not subject to
Unicode translation,
meaning that it can contain characters not conforming to
the Unicode encoding expected from the file system
(that is, non-UTF-8 characters although the VM is started
- in Unicode filename mode).
+ in Unicode filename mode). Null characters (integer value zero)
+ are <em>not</em> allowed in filenames (not even at the end).
</p>
</desc>
</datatype>
@@ -1825,7 +1856,7 @@ f.txt: {person, "kalle", 25}.
<p>The functions in the module <c>file</c> usually treat binaries
as raw filenames, that is, they are passed "as is" even when the
encoding of the binary does not agree with
- <seealso marker="#native_name_encoding"><c>native_name_encoding()</c></seealso>.
+ <seealso marker="#native_name_encoding/0"><c>native_name_encoding()</c></seealso>.
However, this function expects binaries to be encoded according to the
value returned by <c>native_name_encoding()</c>.</p>
<p>Typical error reasons are:</p>
diff --git a/lib/kernel/doc/src/inet_res.xml b/lib/kernel/doc/src/inet_res.xml
index 4ada4203c0..3454e3c6f9 100644
--- a/lib/kernel/doc/src/inet_res.xml
+++ b/lib/kernel/doc/src/inet_res.xml
@@ -130,7 +130,7 @@ dns_header() = DnsHeader
inet_dns:header(DnsHeader) ->
[ {id, integer()}
| {qr, boolean()}
- | {opcode, 'query' | iquery | status | integer()}
+ | {opcode, query | iquery | status | integer()}
| {aa, boolean()}
| {tc, boolean()}
| {rd, boolean()}
diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml
index 0e9add4161..0a08e2c78a 100644
--- a/lib/kernel/doc/src/os.xml
+++ b/lib/kernel/doc/src/os.xml
@@ -36,8 +36,99 @@
only run on a specific platform. On the other hand, with careful
use, these functions can be of help in enabling a program to run on
most platforms.</p>
+
+ <note>
+ <p>
+ File operations used to accept filenames containing
+ null characters (integer value zero). This caused
+ the name to be truncated and in some cases arguments
+ to primitive operations to be mixed up. Filenames
+ containing null characters inside the filename
+ are now <em>rejected</em> and will cause primitive
+ file operations to fail.
+ </p>
+ <p>
+ Also environment variable operations used to accept
+ names and values of environment variables containing
+ null characters (integer value zero). This caused
+ operations to silently produce erroneous results.
+ Environment variable names and values containing
+ null characters inside the name or value are now
+ <em>rejected</em> and will cause environment variable
+ operations to fail.
+ </p>
+ </note>
+ <warning>
+ <p>
+ Currently null characters at the end of filenames,
+ environment variable names and values will be accepted
+ by the primitive operations. Such filenames, environment
+ variable names and values are however still documented as
+ invalid. The implementation will also change in the
+ future and reject such filenames, environment variable
+ names and values.
+ </p>
+ </warning>
</description>
+ <datatypes>
+ <datatype>
+ <name name="env_var_name"/>
+ <desc>
+ <p>A string containing valid characters on the specific
+ OS for environment variable names using
+ <seealso marker="file#native_name_encoding/0"><c>file:native_name_encoding()</c></seealso>
+ encoding. Note that specifically null characters (integer
+ value zero) and <c>$=</c> characters are not allowed.
+ However, note that not all invalid characters necessarily
+ will cause the primitiv operations to fail, but may instead
+ produce invalid results.
+ </p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="env_var_value"/>
+ <desc>
+ <p>A string containing valid characters on the specific
+ OS for environment variable values using
+ <seealso marker="file#native_name_encoding/0"><c>file:native_name_encoding()</c></seealso>
+ encoding. Note that specifically null characters (integer
+ value zero) are not allowed. However, note that not all
+ invalid characters necessarily will cause the primitiv
+ operations to fail, but may instead produce invalid results.
+ </p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="env_var_name_value"/>
+ <desc>
+ <p>
+ Assuming that environment variables has been correctly
+ set, a strings containing valid characters on the specific
+ OS for environment variable names and values using
+ <seealso marker="file#native_name_encoding/0"><c>file:native_name_encoding()</c></seealso>
+ encoding. The first <c>$=</c> characters appearing in
+ the string separates environment variable name (on the
+ left) from environment variable value (on the right).
+ </p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="command_input"/>
+ <desc>
+ <p>All characters needs to be valid characters on the
+ specific OS using
+ <seealso marker="file#native_name_encoding/0"><c>file:native_name_encoding()</c></seealso>
+ encoding. Note that specifically null characters (integer
+ value zero) are not allowed. However, note that not all
+ invalid characters not necessarily will cause
+ <seealso marker="#cmd/1"><c>os:cmd/1</c></seealso>
+ to fail, but may instead produce invalid results.
+ </p>
+ </desc>
+ </datatype>
+ </datatypes>
+
<funcs>
<func>
<name name="cmd" arity="1"/>
@@ -49,6 +140,15 @@
result as a string. This function is a replacement of
the previous function <c>unix:cmd/1</c>; they are equivalent on a
Unix platform.</p>
+ <warning><p>Previous implementation used to allow all characters
+ as long as they were integer values greater than or equal to zero.
+ This sometimes lead to unwanted results since null characters
+ (integer value zero) often are interpreted as string termination.
+ Current implementation still accepts null characters at the end
+ of <c><anno>Command</anno></c> even though the documentation
+ states that no null characters are allowed. This will however
+ be changed in the future so that no null characters at all will
+ be accepted.</p></warning>
<p><em>Examples:</em></p>
<code type="none">
LsOut = os:cmd("ls"), % on unix platform
@@ -152,6 +252,15 @@ DirOut = os:cmd("dir"), % on Win32 platform</code>
<p>On Unix platforms, the environment is set using UTF-8 encoding
if Unicode filename translation is in effect. On Windows, the
environment is set using wide character interfaces.</p>
+ <note>
+ <p>
+ <c><anno>VarName</anno></c> is not allowed to contain
+ an <c>$=</c> character. Previous implementations used
+ to just let the <c>$=</c> character through which
+ silently caused erroneous results. Current implementation
+ will instead throw a <c>badarg</c> exception.
+ </p>
+ </note>
</desc>
</func>
diff --git a/lib/kernel/examples/Makefile b/lib/kernel/examples/Makefile
index 26ec58f571..f86e662838 100644
--- a/lib/kernel/examples/Makefile
+++ b/lib/kernel/examples/Makefile
@@ -45,7 +45,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/kernel-$(KERNEL_VSN)/examples
# Pack and install the complete directory structure from
# here (CWD) and down, for all examples.
-EXAMPLES = uds_dist
+EXAMPLES = uds_dist gen_tcp_dist
release_spec:
$(INSTALL_DIR) "$(RELSYSDIR)"
diff --git a/lib/kernel/examples/gen_tcp_dist/Makefile b/lib/kernel/examples/gen_tcp_dist/Makefile
new file mode 100644
index 0000000000..65513a1729
--- /dev/null
+++ b/lib/kernel/examples/gen_tcp_dist/Makefile
@@ -0,0 +1,20 @@
+RM=rm -f
+CP=cp
+EBIN=ebin
+ERLC=erlc
+# Works if building in open source source tree
+KERNEL_INCLUDE=$(ERL_TOP)/lib/kernel/include
+ERLCFLAGS+= -W -I$(KERNEL_INCLUDE)
+
+MODULES=gen_tcp_dist
+
+TARGET_FILES=$(MODULES:%=$(EBIN)/%.beam)
+
+opt: $(TARGET_FILES)
+
+$(EBIN)/%.beam: src/%.erl
+ $(ERLC) $(ERLCFLAGS) -o$(EBIN) $<
+
+clean:
+ $(RM) $(TARGET_FILES)
+
diff --git a/lib/kernel/examples/gen_tcp_dist/ebin/.gitignore b/lib/kernel/examples/gen_tcp_dist/ebin/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/examples/gen_tcp_dist/ebin/.gitignore
diff --git a/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl b/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl
new file mode 100644
index 0000000000..98554ed805
--- /dev/null
+++ b/lib/kernel/examples/gen_tcp_dist/src/gen_tcp_dist.erl
@@ -0,0 +1,781 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(gen_tcp_dist).
+
+%%
+%% This is an example of how to plug in an arbitrary distribution
+%% carrier for Erlang using distribution processes.
+%%
+%% This example uses gen_tcp for transportation of data, but
+%% you can use whatever underlying protocol you want as long
+%% as your implementation reliably delivers data chunks to the
+%% receiving VM in the order they were sent from the sending
+%% VM.
+%%
+%% This code is a rewrite of the lib/kernel/src/inet_tcp_dist.erl
+%% distribution impementation for TCP used by default. That
+%% implementation use distribution ports instead of distribution
+%% processes and is more efficient compared to this implementation.
+%% This since this implementation more or less gets the
+%% distribution processes in between the VM and the ports without
+%% any gain specific gain.
+%%
+
+-export([listen/1, accept/1, accept_connection/5,
+ setup/5, close/1, select/1, is_node_name/1]).
+
+%% Optional
+-export([setopts/2, getopts/2]).
+
+%% internal exports
+
+-export([dist_cntrlr_setup/1, dist_cntrlr_input_setup/3,
+ dist_cntrlr_tick_handler/1]).
+
+-export([accept_loop/2,do_accept/6,do_setup/6]).
+
+-import(error_logger,[error_msg/2]).
+
+-include("net_address.hrl").
+
+-include("dist.hrl").
+-include("dist_util.hrl").
+
+%% ------------------------------------------------------------
+%% Select this protocol based on node name
+%% select(Node) => Bool
+%% ------------------------------------------------------------
+
+select(Node) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_, Host] ->
+ case inet:getaddr(Host, inet) of
+ {ok,_} -> true;
+ _ -> false
+ end;
+ _ -> false
+ end.
+
+%% ------------------------------------------------------------
+%% Create the listen socket, i.e. the port that this erlang
+%% node is accessible through.
+%% ------------------------------------------------------------
+
+listen(Name) ->
+ case do_listen([binary, {active, false}, {packet,2}, {reuseaddr, true}]) of
+ {ok, Socket} ->
+ TcpAddress = get_tcp_address(Socket),
+ {_,Port} = TcpAddress#net_address.address,
+ ErlEpmd = net_kernel:epmd_module(),
+ case ErlEpmd:register_node(Name, Port) of
+ {ok, Creation} ->
+ {ok, {Socket, TcpAddress, Creation}};
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end.
+
+do_listen(Options) ->
+ {First,Last} = case application:get_env(kernel,inet_dist_listen_min) of
+ {ok,N} when is_integer(N) ->
+ case application:get_env(kernel,
+ inet_dist_listen_max) of
+ {ok,M} when is_integer(M) ->
+ {N,M};
+ _ ->
+ {N,N}
+ end;
+ _ ->
+ {0,0}
+ end,
+ do_listen(First, Last, listen_options([{backlog,128}|Options])).
+
+do_listen(First,Last,_) when First > Last ->
+ {error,eaddrinuse};
+do_listen(First,Last,Options) ->
+ case gen_tcp:listen(First, Options) of
+ {error, eaddrinuse} ->
+ do_listen(First+1,Last,Options);
+ Other ->
+ Other
+ end.
+
+listen_options(Opts0) ->
+ Opts1 =
+ case application:get_env(kernel, inet_dist_use_interface) of
+ {ok, Ip} ->
+ [{ip, Ip} | Opts0];
+ _ ->
+ Opts0
+ end,
+ case application:get_env(kernel, inet_dist_listen_options) of
+ {ok,ListenOpts} ->
+ ListenOpts ++ Opts1;
+ _ ->
+ Opts1
+ end.
+
+
+%% ------------------------------------------------------------
+%% Accepts new connection attempts from other Erlang nodes.
+%% ------------------------------------------------------------
+
+accept(Listen) ->
+ spawn_opt(?MODULE, accept_loop, [self(), Listen], [link, {priority, max}]).
+
+accept_loop(Kernel, Listen) ->
+ ?trace("~p~n",[{?MODULE, accept_loop, self()}]),
+ case gen_tcp:accept(Listen) of
+ {ok, Socket} ->
+ DistCtrl = spawn_dist_cntrlr(Socket),
+ ?trace("~p~n",[{?MODULE, accept_loop, accepted, Socket, DistCtrl, self()}]),
+ flush_controller(DistCtrl, Socket),
+ gen_tcp:controlling_process(Socket, DistCtrl),
+ flush_controller(DistCtrl, Socket),
+ Kernel ! {accept,self(),DistCtrl,inet,tcp},
+ receive
+ {Kernel, controller, Pid} ->
+ call_ctrlr(DistCtrl, {supervisor, Pid}),
+ Pid ! {self(), controller};
+ {Kernel, unsupported_protocol} ->
+ exit(unsupported_protocol)
+ end,
+ accept_loop(Kernel, Listen);
+ Error ->
+ exit(Error)
+ end.
+
+flush_controller(Pid, Socket) ->
+ receive
+ {tcp, Socket, Data} ->
+ Pid ! {tcp, Socket, Data},
+ flush_controller(Pid, Socket);
+ {tcp_closed, Socket} ->
+ Pid ! {tcp_closed, Socket},
+ flush_controller(Pid, Socket)
+ after 0 ->
+ ok
+ end.
+
+%% ------------------------------------------------------------
+%% Accepts a new connection attempt from another Erlang node.
+%% Performs the handshake with the other side.
+%% ------------------------------------------------------------
+
+accept_connection(AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) ->
+ spawn_opt(?MODULE, do_accept,
+ [self(), AcceptPid, DistCtrl, MyNode, Allowed, SetupTime],
+ [link, {priority, max}]).
+
+do_accept(Kernel, AcceptPid, DistCtrl, MyNode, Allowed, SetupTime) ->
+ ?trace("~p~n",[{?MODULE, do_accept, self(), MyNode}]),
+ receive
+ {AcceptPid, controller} ->
+ Timer = dist_util:start_timer(SetupTime),
+ case check_ip(DistCtrl) of
+ true ->
+ HSData0 = hs_data_common(DistCtrl),
+ HSData = HSData0#hs_data{kernel_pid = Kernel,
+ this_node = MyNode,
+ socket = DistCtrl,
+ timer = Timer,
+ this_flags = 0,
+ allowed = Allowed},
+ dist_util:handshake_other_started(HSData);
+ {false,IP} ->
+ error_msg("** Connection attempt from "
+ "disallowed IP ~w ** ~n", [IP]),
+ ?shutdown(no_node)
+ end
+ end.
+
+%% we may not always want the nodelay behaviour
+%% for performance reasons
+
+nodelay() ->
+ case application:get_env(kernel, dist_nodelay) of
+ undefined ->
+ {nodelay, true};
+ {ok, true} ->
+ {nodelay, true};
+ {ok, false} ->
+ {nodelay, false};
+ _ ->
+ {nodelay, true}
+ end.
+
+%% ------------------------------------------------------------
+%% Setup a new connection to another Erlang node.
+%% Performs the handshake with the other side.
+%% ------------------------------------------------------------
+
+setup(Node, Type, MyNode, LongOrShortNames,SetupTime) ->
+ spawn_opt(?MODULE, do_setup,
+ [self(), Node, Type, MyNode, LongOrShortNames, SetupTime],
+ [link, {priority, max}]).
+
+do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
+ ?trace("~p~n",[{?MODULE, do_setup, self(), Node}]),
+ [Name, Address] = splitnode(Node, LongOrShortNames),
+ case inet:getaddr(Address, inet) of
+ {ok, Ip} ->
+ Timer = dist_util:start_timer(SetupTime),
+ ErlEpmd = net_kernel:epmd_module(),
+ case ErlEpmd:port_please(Name, Ip) of
+ {port, TcpPort, Version} ->
+ ?trace("port_please(~p) -> version ~p~n",
+ [Node,Version]),
+ dist_util:reset_timer(Timer),
+ case
+ gen_tcp:connect(
+ Ip, TcpPort,
+ connect_options([binary, {active, false}, {packet, 2}]))
+ of
+ {ok, Socket} ->
+ DistCtrl = spawn_dist_cntrlr(Socket),
+ call_ctrlr(DistCtrl, {supervisor, self()}),
+ flush_controller(DistCtrl, Socket),
+ gen_tcp:controlling_process(Socket, DistCtrl),
+ flush_controller(DistCtrl, Socket),
+ HSData0 = hs_data_common(DistCtrl),
+ HSData = HSData0#hs_data{kernel_pid = Kernel,
+ other_node = Node,
+ this_node = MyNode,
+ socket = DistCtrl,
+ timer = Timer,
+ this_flags = 0,
+ other_version = Version,
+ request_type = Type},
+ dist_util:handshake_we_started(HSData);
+ _ ->
+ %% Other Node may have closed since
+ %% port_please !
+ ?trace("other node (~p) "
+ "closed since port_please.~n",
+ [Node]),
+ ?shutdown(Node)
+ end;
+ _ ->
+ ?trace("port_please (~p) "
+ "failed.~n", [Node]),
+ ?shutdown(Node)
+ end;
+ _Other ->
+ ?trace("inet_getaddr(~p) "
+ "failed (~p).~n", [Node,_Other]),
+ ?shutdown(Node)
+ end.
+
+connect_options(Opts) ->
+ case application:get_env(kernel, inet_dist_connect_options) of
+ {ok,ConnectOpts} ->
+ ConnectOpts ++ Opts;
+ _ ->
+ Opts
+ end.
+
+%%
+%% Close a socket.
+%%
+close(Listen) ->
+ gen_tcp:close(Listen).
+
+
+%% If Node is illegal terminate the connection setup!!
+splitnode(Node, LongOrShortNames) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [Name|Tail] when Tail =/= [] ->
+ Host = lists:append(Tail),
+ case split_node(Host, $., []) of
+ [_] when LongOrShortNames =:= longnames ->
+ case inet:parse_address(Host) of
+ {ok, _} ->
+ [Name, Host];
+ _ ->
+ error_msg("** System running to use "
+ "fully qualified "
+ "hostnames **~n"
+ "** Hostname ~ts is illegal **~n",
+ [Host]),
+ ?shutdown(Node)
+ end;
+ L when length(L) > 1, LongOrShortNames =:= shortnames ->
+ error_msg("** System NOT running to use fully qualified "
+ "hostnames **~n"
+ "** Hostname ~ts is illegal **~n",
+ [Host]),
+ ?shutdown(Node);
+ _ ->
+ [Name, Host]
+ end;
+ [_] ->
+ error_msg("** Nodename ~p illegal, no '@' character **~n",
+ [Node]),
+ ?shutdown(Node);
+ _ ->
+ error_msg("** Nodename ~p illegal **~n", [Node]),
+ ?shutdown(Node)
+ end.
+
+split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])];
+split_node([H|T], Chr, Ack) -> split_node(T, Chr, [H|Ack]);
+split_node([], _, Ack) -> [lists:reverse(Ack)].
+
+%% ------------------------------------------------------------
+%% Fetch local information about a Socket.
+%% ------------------------------------------------------------
+get_tcp_address(Socket) ->
+ {ok, Address} = inet:sockname(Socket),
+ {ok, Host} = inet:gethostname(),
+ #net_address {
+ address = Address,
+ host = Host,
+ protocol = tcp,
+ family = inet
+ }.
+
+%% ------------------------------------------------------------
+%% Do only accept new connection attempts from nodes at our
+%% own LAN, if the check_ip environment parameter is true.
+%% ------------------------------------------------------------
+check_ip(DistCtrl) ->
+ case application:get_env(check_ip) of
+ {ok, true} ->
+ case get_ifs(DistCtrl) of
+ {ok, IFs, IP} ->
+ check_ip(IFs, IP);
+ _ ->
+ ?shutdown(no_node)
+ end;
+ _ ->
+ true
+ end.
+
+get_ifs(DistCtrl) ->
+ Socket = call_ctrlr(DistCtrl, socket),
+ case inet:peername(Socket) of
+ {ok, {IP, _}} ->
+ case inet:getif(Socket) of
+ {ok, IFs} -> {ok, IFs, IP};
+ Error -> Error
+ end;
+ Error ->
+ Error
+ end.
+
+check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) ->
+ case {inet_tcp:mask(Netmask, PeerIP), inet_tcp:mask(Netmask, OwnIP)} of
+ {M, M} -> true;
+ _ -> check_ip(IFs, PeerIP)
+ end;
+check_ip([], PeerIP) ->
+ {false, PeerIP}.
+
+is_node_name(Node) when is_atom(Node) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_, _Host] -> true;
+ _ -> false
+ end;
+is_node_name(_Node) ->
+ false.
+
+hs_data_common(DistCtrl) ->
+ TickHandler = call_ctrlr(DistCtrl, tick_handler),
+ Socket = call_ctrlr(DistCtrl, socket),
+ #hs_data{f_send = send_fun(),
+ f_recv = recv_fun(),
+ f_setopts_pre_nodeup = setopts_pre_nodeup_fun(),
+ f_setopts_post_nodeup = setopts_post_nodeup_fun(),
+ f_getll = getll_fun(),
+ f_handshake_complete = handshake_complete_fun(),
+ f_address = address_fun(),
+ mf_setopts = setopts_fun(DistCtrl, Socket),
+ mf_getopts = getopts_fun(DistCtrl, Socket),
+ mf_getstat = getstat_fun(DistCtrl, Socket),
+ mf_tick = tick_fun(DistCtrl, TickHandler)}.
+
+%%% ------------------------------------------------------------
+%%% Distribution controller processes
+%%% ------------------------------------------------------------
+
+%%
+%% There will be five parties working together when the
+%% connection is up:
+%% - The gen_tcp socket. Providing a tcp/ip connection
+%% to the other node.
+%% - The output handler. It will dispatch all outgoing
+%% traffic from the VM to the gen_tcp socket. This
+%% process is registered as distribution controller
+%% for this channel with the VM.
+%% - The input handler. It will dispatch all incoming
+%% traffic from the gen_tcp socket to the VM. This
+%% process is also the socket owner and receives
+%% incoming traffic using active-N.
+%% - The tick handler. Dispatches asynchronous tick
+%% requests to the socket. It executes on max priority
+%% since it is important to get ticks through to the
+%% other end.
+%% - The channel supervisor (provided by dist_util). It
+%% monitors traffic. Issue tick requests to the tick
+%% handler when no outgoing traffic is seen and bring
+%% the connection down if no incoming traffic is seen.
+%% This process also executes on max priority.
+%%
+%% These parties are linked togheter so should one
+%% of them fail, all of them are terminated and the
+%% connection is taken down.
+%%
+
+%% In order to avoid issues with lingering signal binaries
+%% we enable off-heap message queue data as well as fullsweep
+%% after 0. The fullsweeps will be cheap since we have more
+%% or less no live data.
+-define(DIST_CNTRL_COMMON_SPAWN_OPTS,
+ [{message_queue_data, off_heap},
+ {fullsweep_after, 0}]).
+
+tick_fun(DistCtrl, TickHandler) ->
+ fun (Ctrl) when Ctrl == DistCtrl ->
+ TickHandler ! tick
+ end.
+
+getstat_fun(DistCtrl, Socket) ->
+ fun (Ctrl) when Ctrl == DistCtrl ->
+ case inet:getstat(Socket, [recv_cnt, send_cnt, send_pend]) of
+ {ok, Stat} ->
+ split_stat(Stat,0,0,0);
+ Error ->
+ Error
+ end
+ end.
+
+split_stat([{recv_cnt, R}|Stat], _, W, P) ->
+ split_stat(Stat, R, W, P);
+split_stat([{send_cnt, W}|Stat], R, _, P) ->
+ split_stat(Stat, R, W, P);
+split_stat([{send_pend, P}|Stat], R, W, _) ->
+ split_stat(Stat, R, W, P);
+split_stat([], R, W, P) ->
+ {ok, R, W, P}.
+
+setopts_fun(DistCtrl, Socket) ->
+ fun (Ctrl, Opts) when Ctrl == DistCtrl ->
+ setopts(Socket, Opts)
+ end.
+
+getopts_fun(DistCtrl, Socket) ->
+ fun (Ctrl, Opts) when Ctrl == DistCtrl ->
+ getopts(Socket, Opts)
+ end.
+
+setopts(S, Opts) ->
+ case [Opt || {K,_}=Opt <- Opts,
+ K =:= active orelse K =:= deliver orelse K =:= packet] of
+ [] -> inet:setopts(S,Opts);
+ Opts1 -> {error, {badopts,Opts1}}
+ end.
+
+getopts(S, Opts) ->
+ inet:getopts(S, Opts).
+
+send_fun() ->
+ fun (Ctrlr, Packet) ->
+ call_ctrlr(Ctrlr, {send, Packet})
+ end.
+
+recv_fun() ->
+ fun (Ctrlr, Length, Timeout) ->
+ case call_ctrlr(Ctrlr, {recv, Length, Timeout}) of
+ {ok, Bin} when is_binary(Bin) ->
+ {ok, binary_to_list(Bin)};
+ Other ->
+ Other
+ end
+ end.
+
+getll_fun() ->
+ fun (Ctrlr) ->
+ call_ctrlr(Ctrlr, getll)
+ end.
+
+address_fun() ->
+ fun (Ctrlr, Node) ->
+ case call_ctrlr(Ctrlr, {address, Node}) of
+ {error, no_node} -> %% No '@' or more than one '@' in node name.
+ ?shutdown(no_node);
+ Res ->
+ Res
+ end
+ end.
+
+setopts_pre_nodeup_fun() ->
+ fun (Ctrlr) ->
+ call_ctrlr(Ctrlr, pre_nodeup)
+ end.
+
+setopts_post_nodeup_fun() ->
+ fun (Ctrlr) ->
+ call_ctrlr(Ctrlr, post_nodeup)
+ end.
+
+handshake_complete_fun() ->
+ fun (Ctrlr, Node, DHandle) ->
+ call_ctrlr(Ctrlr, {handshake_complete, Node, DHandle})
+ end.
+
+call_ctrlr(Ctrlr, Msg) ->
+ Ref = erlang:monitor(process, Ctrlr),
+ Ctrlr ! {Ref, self(), Msg},
+ receive
+ {Ref, Res} ->
+ erlang:demonitor(Ref, [flush]),
+ Res;
+ {'DOWN', Ref, process, Ctrlr, Reason} ->
+ exit({dist_controller_exit, Reason})
+ end.
+
+%%
+%% The tick handler process writes a tick to the
+%% socket when it receives a 'tick' message from
+%% the connection supervisor.
+%%
+%% We are not allowed to block the connection
+%% superviser when writing a tick and we also want
+%% the tick to go through even during a heavily
+%% loaded system. gen_tcp does not have a
+%% non-blocking send operation exposed in its API
+%% and we don't want to run the distribution
+%% controller under high priority. Therefore this
+%% sparate process with max prio that dispatches
+%% ticks.
+%%
+dist_cntrlr_tick_handler(Socket) ->
+ receive
+ tick ->
+ %% May block due to busy port...
+ sock_send(Socket, "");
+ _ ->
+ ok
+ end,
+ dist_cntrlr_tick_handler(Socket).
+
+spawn_dist_cntrlr(Socket) ->
+ spawn_opt(?MODULE, dist_cntrlr_setup, [Socket],
+ [{priority, max}] ++ ?DIST_CNTRL_COMMON_SPAWN_OPTS).
+
+dist_cntrlr_setup(Socket) ->
+ TickHandler = spawn_opt(?MODULE, dist_cntrlr_tick_handler,
+ [Socket],
+ [link, {priority, max}]
+ ++ ?DIST_CNTRL_COMMON_SPAWN_OPTS),
+ dist_cntrlr_setup_loop(Socket, TickHandler, undefined).
+
+%%
+%% During the handshake phase we loop in dist_cntrlr_setup().
+%% When the connection is up we spawn an input handler and
+%% continue as output handler.
+%%
+dist_cntrlr_setup_loop(Socket, TickHandler, Sup) ->
+ receive
+ {tcp_closed, Socket} ->
+ exit(connection_closed);
+
+ {Ref, From, {supervisor, Pid}} ->
+ Res = link(Pid),
+ From ! {Ref, Res},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Pid);
+
+ {Ref, From, tick_handler} ->
+ From ! {Ref, TickHandler},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, socket} ->
+ From ! {Ref, Socket},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, {send, Packet}} ->
+ Res = gen_tcp:send(Socket, Packet),
+ From ! {Ref, Res},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, {recv, Length, Timeout}} ->
+ Res = gen_tcp:recv(Socket, Length, Timeout),
+ From ! {Ref, Res},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, getll} ->
+ From ! {Ref, {ok, self()}},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, {address, Node}} ->
+ Res = case inet:peername(Socket) of
+ {ok, Address} ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_,Host] ->
+ #net_address{address=Address,host=Host,
+ protocol=tcp, family=inet};
+ _ ->
+ {error, no_node}
+ end
+ end,
+ From ! {Ref, Res},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, pre_nodeup} ->
+ Res = inet:setopts(Socket,
+ [{active, false},
+ {packet, 4},
+ nodelay()]),
+ From ! {Ref, Res},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, post_nodeup} ->
+ Res = inet:setopts(Socket,
+ [{active, false},
+ {packet, 4},
+ nodelay()]),
+ From ! {Ref, Res},
+ dist_cntrlr_setup_loop(Socket, TickHandler, Sup);
+
+ {Ref, From, {handshake_complete, _Node, DHandle}} ->
+ From ! {Ref, ok},
+ %% Handshake complete! Begin dispatching traffic...
+
+ %% We use separate process for dispatching input. This
+ %% is not necessary, but it enables parallel execution
+ %% of independent work loads at the same time as it
+ %% simplifies the the implementation...
+ InputHandler = spawn_opt(?MODULE, dist_cntrlr_input_setup,
+ [DHandle, Socket, Sup],
+ [link] ++ ?DIST_CNTRL_COMMON_SPAWN_OPTS),
+
+ flush_controller(InputHandler, Socket),
+ gen_tcp:controlling_process(Socket, InputHandler),
+ flush_controller(InputHandler, Socket),
+
+ ok = erlang:dist_ctrl_input_handler(DHandle, InputHandler),
+
+ InputHandler ! DHandle,
+
+ %% From now on we execute on normal priority
+ process_flag(priority, normal),
+ erlang:dist_ctrl_get_data_notification(DHandle),
+ dist_cntrlr_output_loop(DHandle, Socket)
+ end.
+
+%% We use active 10 for good throughput while still
+%% maintaining back-pressure if the input controller
+%% isn't able to handle all incoming messages...
+-define(ACTIVE_INPUT, 10).
+
+dist_cntrlr_input_setup(DHandle, Socket, Sup) ->
+ link(Sup),
+ %% Ensure we don't try to put data before registerd
+ %% as input handler...
+ receive
+ DHandle ->
+ dist_cntrlr_input_loop(DHandle, Socket, 0)
+ end.
+
+dist_cntrlr_input_loop(DHandle, Socket, N) when N =< ?ACTIVE_INPUT/2 ->
+ inet:setopts(Socket, [{active, ?ACTIVE_INPUT - N}]),
+ dist_cntrlr_input_loop(DHandle, Socket, ?ACTIVE_INPUT);
+dist_cntrlr_input_loop(DHandle, Socket, N) ->
+ receive
+ {tcp_closed, Socket} ->
+ %% Connection to remote node terminated...
+ exit(connection_closed);
+
+ {tcp, Socket, Data} ->
+ %% Incoming data from remote node...
+ try erlang:dist_ctrl_put_data(DHandle, Data)
+ catch _ : _ -> death_row()
+ end,
+ dist_cntrlr_input_loop(DHandle, Socket, N-1);
+
+ _ ->
+ %% Ignore...
+ dist_cntrlr_input_loop(DHandle, Socket, N)
+ end.
+
+dist_cntrlr_send_data(DHandle, Socket) ->
+ case erlang:dist_ctrl_get_data(DHandle) of
+ none ->
+ erlang:dist_ctrl_get_data_notification(DHandle);
+ Data ->
+ sock_send(Socket, Data),
+ dist_cntrlr_send_data(DHandle, Socket)
+ end.
+
+
+dist_cntrlr_output_loop(DHandle, Socket) ->
+ receive
+ dist_data ->
+ %% Outgoing data from this node...
+ try dist_cntrlr_send_data(DHandle, Socket)
+ catch _ : _ -> death_row()
+ end,
+ dist_cntrlr_output_loop(DHandle, Socket);
+
+ {send, From, Ref, Data} ->
+ %% This is for testing only!
+ %%
+ %% Needed by some OTP distribution
+ %% test suites...
+ sock_send(Socket, Data),
+ From ! {Ref, ok},
+ dist_cntrlr_output_loop(DHandle, Socket);
+
+ _ ->
+ %% Drop garbage message...
+ dist_cntrlr_output_loop(DHandle, Socket)
+
+ end.
+
+sock_send(Socket, Data) ->
+ try gen_tcp:send(Socket, Data) of
+ ok -> ok;
+ {error, Reason} -> death_row({send_error, Reason})
+ catch
+ Type : Reason -> death_row({send_error, {Type, Reason}})
+ end.
+
+death_row() ->
+ death_row(connection_closed).
+
+death_row(normal) ->
+ %% We do not want to exit with normal
+ %% exit reason since it wont bring down
+ %% linked processes...
+ death_row();
+death_row(Reason) ->
+ %% When the connection is on its way down operations
+ %% begin to fail. We catch the failures and call
+ %% this function waiting for termination. We should
+ %% be terminated by one of our links to the other
+ %% involved parties that began bringing the
+ %% connection down. By waiting for termination we
+ %% avoid altering the exit reason for the connection
+ %% teardown. We however limit the wait to 5 seconds
+ %% and bring down the connection ourselves if not
+ %% terminated...
+ receive after 5000 -> exit(Reason) end.
diff --git a/lib/kernel/include/dist.hrl b/lib/kernel/include/dist.hrl
index d6bccdf474..db4a5eaebc 100644
--- a/lib/kernel/include/dist.hrl
+++ b/lib/kernel/include/dist.hrl
@@ -40,3 +40,33 @@
-define(DFLAG_UTF8_ATOMS, 16#10000).
-define(DFLAG_MAP_TAG, 16#20000).
-define(DFLAG_BIG_CREATION, 16#40000).
+-define(DFLAG_SEND_SENDER, 16#80000).
+
+%% DFLAGs that require strict ordering or:ed together...
+-define(DFLAGS_STRICT_ORDER_DELIVERY,
+ ?DFLAG_DIST_HDR_ATOM_CACHE).
+
+
+%% Also update dflag2str() in ../src/dist_util.erl
+%% when adding flags...
+
+-define(DFLAGS_ALL,
+ (?DFLAG_PUBLISHED
+ bor ?DFLAG_ATOM_CACHE
+ bor ?DFLAG_EXTENDED_REFERENCES
+ bor ?DFLAG_DIST_MONITOR
+ bor ?DFLAG_FUN_TAGS
+ bor ?DFLAG_DIST_MONITOR_NAME
+ bor ?DFLAG_HIDDEN_ATOM_CACHE
+ bor ?DFLAG_NEW_FUN_TAGS
+ bor ?DFLAG_EXTENDED_PIDS_PORTS
+ bor ?DFLAG_EXPORT_PTR_TAG
+ bor ?DFLAG_BIT_BINARIES
+ bor ?DFLAG_NEW_FLOATS
+ bor ?DFLAG_UNICODE_IO
+ bor ?DFLAG_DIST_HDR_ATOM_CACHE
+ bor ?DFLAG_SMALL_ATOM_TAGS
+ bor ?DFLAG_UTF8_ATOMS
+ bor ?DFLAG_MAP_TAG
+ bor ?DFLAG_BIG_CREATION
+ bor ?DFLAG_SEND_SENDER)).
diff --git a/lib/kernel/include/dist_util.hrl b/lib/kernel/include/dist_util.hrl
index e3d2fe0eb6..eeb0f8dd43 100644
--- a/lib/kernel/include/dist_util.hrl
+++ b/lib/kernel/include/dist_util.hrl
@@ -29,9 +29,9 @@
-endif.
-ifdef(dist_trace).
--define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:timestamp(),node(),lists:flatten(io_lib:format(Fmt, Args))])).
+-define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:convert_time_unit(erlang:monotonic_time()-erlang:system_info(start_time), native, microsecond),node(),lists:flatten(io_lib:format(Fmt, Args))])).
% Use the one below for config-file (early boot) connection tracing
-%-define(trace(Fmt,Args), erlang:display([erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])).
+%-define(trace(Fmt,Args), erlang:display([erlang:convert_time_unit(erlang:monotonic_time()-erlang:system_info(start_time), native, microsecond),node(),lists:flatten(io_lib:format(Fmt, Args))])).
-define(trace_factor,8).
-else.
-define(trace(Fmt,Args), ok).
@@ -78,7 +78,13 @@
%% New in kernel-5.1 (OTP 19.1):
mf_setopts, %% netkernel:setopts on active connection
- mf_getopts %% netkernel:getopts on active connection
+ mf_getopts, %% netkernel:getopts on active connection
+
+ %% New in kernel-6.0 (OTP 21.0)
+ f_handshake_complete, %% Notify handshake complete
+ add_flags, %% dflags to add
+ reject_flags, %% dflags not to use (not all can be rejected)
+ require_flags %% dflags that are required
}).
diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl
index b3507e5d13..08bd5946cd 100644
--- a/lib/kernel/src/dist_util.erl
+++ b/lib/kernel/src/dist_util.erl
@@ -74,6 +74,48 @@
ticked = 0
}).
+dflag2str(?DFLAG_PUBLISHED) ->
+ "PUBLISHED";
+dflag2str(?DFLAG_ATOM_CACHE) ->
+ "ATOM_CACHE";
+dflag2str(?DFLAG_EXTENDED_REFERENCES) ->
+ "EXTENDED_REFERENCES";
+dflag2str(?DFLAG_DIST_MONITOR) ->
+ "DIST_MONITOR";
+dflag2str(?DFLAG_FUN_TAGS) ->
+ "FUN_TAGS";
+dflag2str(?DFLAG_DIST_MONITOR_NAME) ->
+ "DIST_MONITOR_NAME";
+dflag2str(?DFLAG_HIDDEN_ATOM_CACHE) ->
+ "HIDDEN_ATOM_CACHE";
+dflag2str(?DFLAG_NEW_FUN_TAGS) ->
+ "NEW_FUN_TAGS";
+dflag2str(?DFLAG_EXTENDED_PIDS_PORTS) ->
+ "EXTENDED_PIDS_PORTS";
+dflag2str(?DFLAG_EXPORT_PTR_TAG) ->
+ "EXPORT_PTR_TAG";
+dflag2str(?DFLAG_BIT_BINARIES) ->
+ "BIT_BINARIES";
+dflag2str(?DFLAG_NEW_FLOATS) ->
+ "NEW_FLOATS";
+dflag2str(?DFLAG_UNICODE_IO) ->
+ "UNICODE_IO";
+dflag2str(?DFLAG_DIST_HDR_ATOM_CACHE) ->
+ "DIST_HDR_ATOM_CACHE";
+dflag2str(?DFLAG_SMALL_ATOM_TAGS) ->
+ "SMALL_ATOM_TAGS";
+dflag2str(?DFLAG_UTF8_ATOMS) ->
+ "UTF8_ATOMS";
+dflag2str(?DFLAG_MAP_TAG) ->
+ "MAP_TAG";
+dflag2str(?DFLAG_BIG_CREATION) ->
+ "BIG_CREATION";
+dflag2str(?DFLAG_SEND_SENDER) ->
+ "SEND_SENDER";
+dflag2str(_) ->
+ "UNKNOWN".
+
+
remove_flag(Flag, Flags) ->
case Flags band Flag of
0 ->
@@ -82,13 +124,13 @@ remove_flag(Flag, Flags) ->
Flags - Flag
end.
-adjust_flags(ThisFlags, OtherFlags) ->
+adjust_flags(ThisFlags, OtherFlags, RejectFlags) ->
case (?DFLAG_PUBLISHED band ThisFlags) band OtherFlags of
0 ->
{remove_flag(?DFLAG_PUBLISHED, ThisFlags),
remove_flag(?DFLAG_PUBLISHED, OtherFlags)};
_ ->
- {ThisFlags, OtherFlags}
+ {ThisFlags, OtherFlags band (bnot RejectFlags)}
end.
publish_flag(hidden, _) ->
@@ -101,36 +143,71 @@ publish_flag(_, OtherNode) ->
0
end.
-make_this_flags(RequestType, OtherNode) ->
- publish_flag(RequestType, OtherNode) bor
- %% The parenthesis below makes the compiler generate better code.
- (?DFLAG_EXPORT_PTR_TAG bor
- ?DFLAG_EXTENDED_PIDS_PORTS bor
- ?DFLAG_EXTENDED_REFERENCES bor
- ?DFLAG_DIST_MONITOR bor
- ?DFLAG_FUN_TAGS bor
- ?DFLAG_DIST_MONITOR_NAME bor
- ?DFLAG_HIDDEN_ATOM_CACHE bor
- ?DFLAG_NEW_FUN_TAGS bor
- ?DFLAG_BIT_BINARIES bor
- ?DFLAG_NEW_FLOATS bor
- ?DFLAG_UNICODE_IO bor
- ?DFLAG_DIST_HDR_ATOM_CACHE bor
- ?DFLAG_SMALL_ATOM_TAGS bor
- ?DFLAG_UTF8_ATOMS bor
- ?DFLAG_MAP_TAG bor
- ?DFLAG_BIG_CREATION).
-
-handshake_other_started(#hs_data{request_type=ReqType}=HSData0) ->
+-define(DFLAGS_REMOVABLE,
+ (?DFLAG_DIST_HDR_ATOM_CACHE
+ bor ?DFLAG_HIDDEN_ATOM_CACHE
+ bor ?DFLAG_ATOM_CACHE)).
+
+-define(DFLAGS_ADDABLE,
+ (?DFLAGS_ALL
+ band (bnot (?DFLAG_PUBLISHED
+ bor ?DFLAG_HIDDEN_ATOM_CACHE
+ bor ?DFLAG_ATOM_CACHE)))).
+
+-define(DFLAGS_THIS_DEFAULT,
+ (?DFLAG_EXPORT_PTR_TAG
+ bor ?DFLAG_EXTENDED_PIDS_PORTS
+ bor ?DFLAG_EXTENDED_REFERENCES
+ bor ?DFLAG_DIST_MONITOR
+ bor ?DFLAG_FUN_TAGS
+ bor ?DFLAG_DIST_MONITOR_NAME
+ bor ?DFLAG_NEW_FUN_TAGS
+ bor ?DFLAG_BIT_BINARIES
+ bor ?DFLAG_NEW_FLOATS
+ bor ?DFLAG_UNICODE_IO
+ bor ?DFLAG_DIST_HDR_ATOM_CACHE
+ bor ?DFLAG_SMALL_ATOM_TAGS
+ bor ?DFLAG_UTF8_ATOMS
+ bor ?DFLAG_MAP_TAG
+ bor ?DFLAG_BIG_CREATION
+ bor ?DFLAG_SEND_SENDER)).
+
+make_this_flags(RequestType, AddFlags, RemoveFlags, OtherNode) ->
+ case RemoveFlags band (bnot ?DFLAGS_REMOVABLE) of
+ 0 -> ok;
+ Rerror -> exit({"Rejecting non rejectable flags", Rerror})
+ end,
+ case AddFlags band (bnot ?DFLAGS_ADDABLE) of
+ 0 -> ok;
+ Aerror -> exit({"Adding non addable flags", Aerror})
+ end,
+ Flgs0 = ?DFLAGS_THIS_DEFAULT,
+ Flgs1 = Flgs0 bor publish_flag(RequestType, OtherNode),
+ Flgs2 = Flgs1 bor AddFlags,
+ Flgs3 = Flgs2 band (bnot (?DFLAG_HIDDEN_ATOM_CACHE
+ bor ?DFLAG_ATOM_CACHE)),
+ Flgs3 band (bnot RemoveFlags).
+
+handshake_other_started(#hs_data{request_type=ReqType,
+ add_flags=AddFlgs0,
+ reject_flags=RejFlgs0,
+ require_flags=ReqFlgs0}=HSData0) ->
+ AddFlgs = convert_flags(AddFlgs0),
+ RejFlgs = convert_flags(RejFlgs0),
+ ReqFlgs = convert_flags(ReqFlgs0),
{PreOtherFlags,Node,Version} = recv_name(HSData0),
- PreThisFlags = make_this_flags(ReqType, Node),
+ PreThisFlags = make_this_flags(ReqType, AddFlgs, RejFlgs, Node),
{ThisFlags, OtherFlags} = adjust_flags(PreThisFlags,
- PreOtherFlags),
+ PreOtherFlags,
+ RejFlgs),
HSData = HSData0#hs_data{this_flags=ThisFlags,
other_flags=OtherFlags,
other_version=Version,
other_node=Node,
- other_started=true},
+ other_started=true,
+ add_flags=AddFlgs,
+ reject_flags=RejFlgs,
+ require_flags=ReqFlgs},
check_dflags(HSData),
is_allowed(HSData),
?debug({"MD5 connection from ~p (V~p)~n",
@@ -165,23 +242,18 @@ is_allowed(#hs_data{other_node = Node,
end.
%%
-%% Check that both nodes can handle the same types of extended
-%% node containers. If they can not, abort the connection.
+%% Check mandatory flags...
%%
check_dflags(#hs_data{other_node = Node,
other_flags = OtherFlags,
- other_started = OtherStarted} = HSData) ->
-
- Mandatory = [{?DFLAG_EXTENDED_REFERENCES, "EXTENDED_REFERENCES"},
- {?DFLAG_EXTENDED_PIDS_PORTS, "EXTENDED_PIDS_PORTS"},
- {?DFLAG_UTF8_ATOMS, "UTF8_ATOMS"}],
- Missing = lists:filtermap(fun({Bit, Str}) ->
- case Bit band OtherFlags of
- Bit -> false;
- 0 -> {true, Str}
- end
- end,
- Mandatory),
+ other_started = OtherStarted,
+ require_flags = RequiredFlags} = HSData) ->
+ Mandatory = ((?DFLAG_EXTENDED_REFERENCES
+ bor ?DFLAG_EXTENDED_PIDS_PORTS
+ bor ?DFLAG_UTF8_ATOMS)
+ bor RequiredFlags),
+ Missing = check_mandatory(0, ?DFLAGS_ALL, Mandatory,
+ OtherFlags, []),
case Missing of
[] ->
ok;
@@ -201,6 +273,22 @@ check_dflags(#hs_data{other_node = Node,
?shutdown2(Node, {check_dflags_failed, Missing})
end.
+check_mandatory(_Bit, 0, _Mandatory, _OtherFlags, Missing) ->
+ Missing;
+check_mandatory(Bit, Left, Mandatory, OtherFlags, Missing) ->
+ DFlag = (1 bsl Bit),
+ NewLeft = Left band (bnot DFlag),
+ NewMissing = case {DFlag band Mandatory,
+ DFlag band OtherFlags} of
+ {DFlag, 0} ->
+ %% Mandatory and missing...
+ [dflag2str(DFlag) | Missing];
+ _ ->
+ %% Not mandatory or present...
+ Missing
+ end,
+ check_mandatory(Bit+1, NewLeft, Mandatory, OtherFlags, NewMissing).
+
%% No nodedown will be sent if we fail before this process has
%% succeeded to mark the node as pending.
@@ -314,13 +402,24 @@ flush_down() ->
end.
handshake_we_started(#hs_data{request_type=ReqType,
- other_node=Node}=PreHSData) ->
- PreThisFlags = make_this_flags(ReqType, Node),
- HSData = PreHSData#hs_data{this_flags=PreThisFlags},
+ other_node=Node,
+ add_flags=AddFlgs0,
+ reject_flags=RejFlgs0,
+ require_flags=ReqFlgs0}=PreHSData) ->
+ AddFlgs = convert_flags(AddFlgs0),
+ RejFlgs = convert_flags(RejFlgs0),
+ ReqFlgs = convert_flags(ReqFlgs0),
+ PreThisFlags = make_this_flags(ReqType, AddFlgs, RejFlgs, Node),
+ HSData = PreHSData#hs_data{this_flags = PreThisFlags,
+ add_flags = AddFlgs,
+ reject_flags = RejFlgs,
+ require_flags = ReqFlgs},
send_name(HSData),
recv_status(HSData),
{PreOtherFlags,ChallengeA} = recv_challenge(HSData),
- {ThisFlags,OtherFlags} = adjust_flags(PreThisFlags, PreOtherFlags),
+ {ThisFlags,OtherFlags} = adjust_flags(PreThisFlags,
+ PreOtherFlags,
+ RejFlgs),
NewHSData = HSData#hs_data{this_flags = ThisFlags,
other_flags = OtherFlags,
other_started = false},
@@ -336,15 +435,16 @@ handshake_we_started(#hs_data{request_type=ReqType,
handshake_we_started(OldHsData) when element(1,OldHsData) =:= hs_data ->
handshake_we_started(convert_old_hsdata(OldHsData)).
-convert_old_hsdata({hs_data, KP, ON, TN, S, T, TF, A, OV, OF, OS, FS, FR,
- FS_PRE, FS_POST, FG, FA, MFT, MFG, RT}) ->
- #hs_data{
- kernel_pid = KP, other_node = ON, this_node = TN, socket = S, timer = T,
- this_flags = TF, allowed = A, other_version = OV, other_flags = OF,
- other_started = OS, f_send = FS, f_recv = FR, f_setopts_pre_nodeup = FS_PRE,
- f_setopts_post_nodeup = FS_POST, f_getll = FG, f_address = FA,
- mf_tick = MFT, mf_getstat = MFG, request_type = RT}.
+convert_old_hsdata(OldHsData) ->
+ OHSDL = tuple_to_list(OldHsData),
+ NoMissing = tuple_size(#hs_data{}) - tuple_size(OldHsData),
+ true = NoMissing > 0,
+ list_to_tuple(OHSDL ++ lists:duplicate(NoMissing, undefined)).
+convert_flags(Flags) when is_integer(Flags) ->
+ Flags;
+convert_flags(_Undefined) ->
+ 0.
%% --------------------------------------------------------------
%% The connection has been established.
@@ -359,15 +459,20 @@ connection(#hs_data{other_node = Node,
PType = publish_type(HSData#hs_data.other_flags),
case FPreNodeup(Socket) of
ok ->
- do_setnode(HSData), % Succeeds or exits the process.
+ DHandle = do_setnode(HSData), % Succeeds or exits the process.
Address = FAddress(Socket,Node),
mark_nodeup(HSData,Address),
case FPostNodeup(Socket) of
ok ->
+ case HSData#hs_data.f_handshake_complete of
+ undefined -> ok;
+ HsComplete -> HsComplete(Socket, Node, DHandle)
+ end,
con_loop({HSData#hs_data.kernel_pid,
Node,
Socket,
PType,
+ DHandle,
HSData#hs_data.mf_tick,
HSData#hs_data.mf_getstat,
HSData#hs_data.mf_setopts,
@@ -425,18 +530,16 @@ do_setnode(#hs_data{other_node = Node, socket = Socket,
[Node, Port, {publish_type(Flags),
'(', Flags, ')',
Version}]),
- case (catch
- erlang:setnode(Node, Port,
- {Flags, Version, '', ''})) of
- {'EXIT', {system_limit, _}} ->
+ try
+ erlang:setnode(Node, Port, {Flags, Version, '', ''})
+ catch
+ error:system_limit ->
error_msg("** Distribution system limit reached, "
"no table space left for node ~w ** ~n",
[Node]),
?shutdown(Node);
- {'EXIT', Other} ->
- exit(Other);
- _Else ->
- ok
+ error:Other ->
+ exit({Other, erlang:get_stacktrace()})
end;
_ ->
error_msg("** Distribution connection error, "
@@ -468,7 +571,13 @@ mark_nodeup(#hs_data{kernel_pid = Kernel,
?shutdown(Node)
end.
-con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=ConData,
+getstat(DHandle, _Socket, undefined) ->
+ erlang:dist_get_stat(DHandle);
+getstat(_DHandle, Socket, MFGetstat) ->
+ MFGetstat(Socket).
+
+con_loop({Kernel, Node, Socket, Type, DHandle, MFTick, MFGetstat,
+ MFSetOpts, MFGetOpts}=ConData,
Tick) ->
receive
{tcp_closed, Socket} ->
@@ -476,7 +585,7 @@ con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=C
{Kernel, disconnect} ->
?shutdown2(Node, disconnected);
{Kernel, aux_tick} ->
- case MFGetstat(Socket) of
+ case getstat(DHandle, Socket, MFGetstat) of
{ok, _, _, PendWrite} ->
send_tick(Socket, PendWrite, MFTick);
_ ->
@@ -484,7 +593,7 @@ con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=C
end,
con_loop(ConData, Tick);
{Kernel, tick} ->
- case send_tick(Socket, Tick, Type,
+ case send_tick(DHandle, Socket, Tick, Type,
MFTick, MFGetstat) of
{ok, NewTick} ->
con_loop(ConData, NewTick);
@@ -497,7 +606,7 @@ con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=C
?shutdown2(Node, send_net_tick_failed)
end;
{From, get_status} ->
- case MFGetstat(Socket) of
+ case getstat(DHandle, Socket, MFGetstat) of
{ok, Read, Write, _} ->
From ! {self(), get_status, {ok, Read, Write}},
con_loop(ConData, Tick);
@@ -735,14 +844,14 @@ send_status(#hs_data{socket = Socket, other_node = Node,
%% we haven't read anything as a hidden node only ticks when it receives
%% a TICK !!
-send_tick(Socket, Tick, Type, MFTick, MFGetstat) ->
+send_tick(DHandle, Socket, Tick, Type, MFTick, MFGetstat) ->
#tick{tick = T0,
read = Read,
write = Write,
ticked = Ticked} = Tick,
T = T0 + 1,
T1 = T rem 4,
- case MFGetstat(Socket) of
+ case getstat(DHandle, Socket, MFGetstat) of
{ok, Read, _, _} when Ticked =:= T ->
{error, not_responding};
{ok, Read, W, Pend} when Type =:= hidden ->
@@ -771,11 +880,10 @@ send_tick(Socket, Tick, Type, MFTick, MFGetstat) ->
Error
end.
-send_tick(Socket, 0, MFTick) ->
- MFTick(Socket);
-send_tick(_, _Pend, _) ->
- %% Dont send tick if pending write.
- ok.
+send_tick(_, Pend, _) when Pend /= false, Pend /= 0 ->
+ ok; %% Dont send tick if pending write.
+send_tick(Socket, _Pend, MFTick) ->
+ MFTick(Socket).
%% ------------------------------------------------------------
%% Connection setup timeout timer.
diff --git a/lib/kernel/src/erl_boot_server.erl b/lib/kernel/src/erl_boot_server.erl
index ac81cc9689..2a38266579 100644
--- a/lib/kernel/src/erl_boot_server.erl
+++ b/lib/kernel/src/erl_boot_server.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -253,9 +253,9 @@ handle_info({udp, U, IP, Port, Data}, S0) ->
"~w is not a valid address ** ~n", [IP]),
{noreply,S0};
{true,_,_} ->
- case catch string:substr(Data, 1, length(?EBOOT_REQUEST)) of
+ case catch string:slice(Data, 0, length(?EBOOT_REQUEST)) of
?EBOOT_REQUEST ->
- Vsn = string:substr(Data, length(?EBOOT_REQUEST)+1, length(Data)),
+ Vsn = string:slice(Data, length(?EBOOT_REQUEST), length(Data)),
error_logger:error_msg("** Illegal boot server connection attempt: "
"client version is ~s ** ~n", [Vsn]);
_ ->
diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl
index 7bc9e2ede3..f96bc88913 100644
--- a/lib/kernel/src/erl_epmd.erl
+++ b/lib/kernel/src/erl_epmd.erl
@@ -79,7 +79,13 @@ port_please(Node, EpmdAddr, Timeout) ->
port_please1(Node,HostName, Timeout) ->
- case inet:gethostbyname(HostName, inet, Timeout) of
+ Family = case inet_db:res_option(inet6) of
+ true ->
+ inet6;
+ false ->
+ inet
+ end,
+ case inet:gethostbyname(HostName, Family, Timeout) of
{ok,{hostent, _Name, _ , _Af, _Size, [EpmdAddr | _]}} ->
get_port(Node, EpmdAddr, Timeout);
Else ->
diff --git a/lib/kernel/src/erl_reply.erl b/lib/kernel/src/erl_reply.erl
index e1e046cbb4..e1c4ffe839 100644
--- a/lib/kernel/src/erl_reply.erl
+++ b/lib/kernel/src/erl_reply.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -42,7 +42,7 @@ reply(_) ->
%% convert ip number to tuple
ip_string_to_tuple(Ip) ->
- [Ip1,Ip2,Ip3,Ip4] = string:tokens(Ip,"."),
+ [Ip1,Ip2,Ip3,Ip4] = string:lexemes(Ip,"."),
{list_to_integer(Ip1),
list_to_integer(Ip2),
list_to_integer(Ip3),
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index 480db6814e..2887014c1c 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -378,16 +378,11 @@ df(Mod, Func, Arity) when is_atom(Mod), is_atom(Func) ->
catch _:_ -> {undef,Mod}
end.
-dff(File, Fs) when is_pid(File), is_list(Fs) ->
- lists:foreach(fun(Mfa) ->
- disassemble_function(File, Mfa),
- io:nl(File)
- end, Fs);
-dff(Name, Fs) when is_list(Name) ->
- case file:open(Name, [write]) of
+dff(Name, Fs) ->
+ case file:open(Name, [write,raw,delayed_write]) of
{ok,F} ->
try
- dff(F, Fs)
+ dff_1(F, Fs)
after
_ = file:close(F)
end;
@@ -395,12 +390,18 @@ dff(Name, Fs) when is_list(Name) ->
{error,{badopen,Reason}}
end.
+dff_1(File, Fs) ->
+ lists:foreach(fun(Mfa) ->
+ disassemble_function(File, Mfa),
+ file:write(File, "\n")
+ end, Fs).
+
disassemble_function(File, {_,_,_}=MFA) ->
cont_dis(File, erts_debug:disassemble(MFA), MFA).
cont_dis(_, false, _) -> ok;
cont_dis(File, {Addr,Str,MFA}, MFA) ->
- io:put_chars(File, binary_to_list(Str)),
+ ok = file:write(File, Str),
cont_dis(File, erts_debug:disassemble(Addr), MFA);
cont_dis(_, {_,_,_}, _) -> ok.
diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl
index bf785959ff..e1198d2587 100644
--- a/lib/kernel/src/group.erl
+++ b/lib/kernel/src/group.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -261,11 +261,11 @@ io_request({put_chars,latin1,M,F,As}, Drv, From, Buf) ->
end;
io_request({get_chars,Encoding,Prompt,N}, Drv, _From, Buf) ->
- get_chars(Prompt, io_lib, collect_chars, N, Drv, Buf, Encoding);
+ get_chars_n(Prompt, io_lib, collect_chars, N, Drv, Buf, Encoding);
io_request({get_line,Encoding,Prompt}, Drv, _From, Buf) ->
- get_chars(Prompt, io_lib, collect_line, [], Drv, Buf, Encoding);
+ get_chars_line(Prompt, io_lib, collect_line, [], Drv, Buf, Encoding);
io_request({get_until,Encoding, Prompt,M,F,As}, Drv, _From, Buf) ->
- get_chars(Prompt, io_lib, get_until, {M,F,As}, Drv, Buf, Encoding);
+ get_chars_line(Prompt, io_lib, get_until, {M,F,As}, Drv, Buf, Encoding);
io_request({get_password,_Encoding},Drv,_From,Buf) ->
get_password_chars(Drv, Buf);
io_request({setopts,Opts}, Drv, _From, Buf) when is_list(Opts) ->
@@ -434,7 +434,7 @@ getopts(Drv,Buf) ->
{ok,[Exp,Echo,Bin,Uni],Buf}.
-%% get_chars(Prompt, Module, Function, XtraArgument, Drv, Buffer)
+%% get_chars_*(Prompt, Module, Function, XtraArgument, Drv, Buffer)
%% Gets characters from the input Drv until as the applied function
%% returns {stop,Result,Rest}. Does not block output until input has been
%% received.
@@ -452,12 +452,21 @@ get_password_chars(Drv,Buf) ->
{exit, terminated}
end.
-get_chars(Prompt, M, F, Xa, Drv, Buf, Encoding) ->
+get_chars_n(Prompt, M, F, Xa, Drv, Buf, Encoding) ->
+ Pbs = prompt_bytes(Prompt, Encoding),
+ case get(echo) of
+ true ->
+ get_chars_loop(Pbs, M, F, Xa, Drv, Buf, start, Encoding);
+ false ->
+ get_chars_n_loop(Pbs, M, F, Xa, Drv, Buf, start, Encoding)
+ end.
+
+get_chars_line(Prompt, M, F, Xa, Drv, Buf, Encoding) ->
Pbs = prompt_bytes(Prompt, Encoding),
get_chars_loop(Pbs, M, F, Xa, Drv, Buf, start, Encoding).
get_chars_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) ->
- Result = case get(echo) of
+ Result = case get(echo) of
true ->
get_line(Buf0, Pbs, Drv, Encoding);
false ->
@@ -466,8 +475,8 @@ get_chars_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) ->
get_line_echo_off(Buf0, Pbs, Drv)
end,
case Result of
- {done,Line,Buf1} ->
- get_chars_apply(Pbs, M, F, Xa, Drv, Buf1, State, Line, Encoding);
+ {done,Line,Buf} ->
+ get_chars_apply(Pbs, M, F, Xa, Drv, Buf, State, Line, Encoding);
interrupted ->
{error,{error,interrupted},[]};
terminated ->
@@ -476,12 +485,29 @@ get_chars_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) ->
get_chars_apply(Pbs, M, F, Xa, Drv, Buf, State0, Line, Encoding) ->
case catch M:F(State0, cast(Line,get(read_mode), Encoding), Encoding, Xa) of
- {stop,Result,Rest} ->
- {ok,Result,append(Rest, Buf, Encoding)};
- {'EXIT',_} ->
- {error,{error,err_func(M, F, Xa)},[]};
- State1 ->
- get_chars_loop(Pbs, M, F, Xa, Drv, Buf, State1, Encoding)
+ {stop,Result,Rest} ->
+ {ok,Result,append(Rest, Buf, Encoding)};
+ {'EXIT',_} ->
+ {error,{error,err_func(M, F, Xa)},[]};
+ State1 ->
+ get_chars_loop(Pbs, M, F, Xa, Drv, Buf, State1, Encoding)
+ end.
+
+get_chars_n_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) ->
+ try M:F(State, cast(Buf0, get(read_mode), Encoding), Encoding, Xa) of
+ {stop,Result,Rest} ->
+ {ok, Result, Rest};
+ State1 ->
+ case get_chars_echo_off(Pbs, Drv) of
+ interrupted ->
+ {error,{error,interrupted},[]};
+ terminated ->
+ {exit,terminated};
+ Buf ->
+ get_chars_n_loop(Pbs, M, F, Xa, Drv, Buf, State1, Encoding)
+ end
+ catch _:_ ->
+ {error,{error,err_func(M, F, Xa)},[]}
end.
%% Convert error code to make it look as before
@@ -684,6 +710,29 @@ get_line_echo_off1({Chars,[]}, Drv) ->
get_line_echo_off1({Chars,Rest}, _Drv) ->
{done,lists:reverse(Chars),case Rest of done -> []; _ -> Rest end}.
+get_chars_echo_off(Pbs, Drv) ->
+ send_drv_reqs(Drv, [{put_chars, unicode,Pbs}]),
+ get_chars_echo_off1(Drv).
+
+get_chars_echo_off1(Drv) ->
+ receive
+ {Drv, {data, Cs}} ->
+ Cs;
+ {Drv, eof} ->
+ eof;
+ {io_request,From,ReplyAs,Req} when is_pid(From) ->
+ io_request(Req, From, ReplyAs, Drv, []),
+ get_chars_echo_off1(Drv);
+ {reply,{{From,ReplyAs},Reply}} when From =/= undefined ->
+ %% We take care of replies from puts here as well
+ io_reply(From, ReplyAs, Reply),
+ get_chars_echo_off1(Drv);
+ {'EXIT',Drv,interrupt} ->
+ interrupted;
+ {'EXIT',Drv,_} ->
+ terminated
+ end.
+
%% We support line editing for the ICANON mode except the following
%% line editing characters, which already has another meaning in
%% echo-on mode (See Advanced Programming in the Unix Environment, 2nd ed,
@@ -793,9 +842,9 @@ search_up_stack(Stack, Substr) ->
case up_stack(Stack) of
{none,NewStack} -> {none,NewStack};
{L, NewStack} ->
- case string:str(L, Substr) of
- 0 -> search_up_stack(NewStack, Substr);
- _ -> {string:strip(L,right,$\n), NewStack}
+ case string:find(L, Substr) of
+ nomatch -> search_up_stack(NewStack, Substr);
+ _ -> {string:trim(L, trailing, "$\n"), NewStack}
end
end.
@@ -803,9 +852,9 @@ search_down_stack(Stack, Substr) ->
case down_stack(Stack) of
{none,NewStack} -> {none,NewStack};
{L, NewStack} ->
- case string:str(L, Substr) of
- 0 -> search_down_stack(NewStack, Substr);
- _ -> {string:strip(L,right,$\n), NewStack}
+ case string:find(L, Substr) of
+ nomatch -> search_down_stack(NewStack, Substr);
+ _ -> {string:trim(L, trailing, "$\n"), NewStack}
end
end.
diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl
index 4bbc520449..9f76360b8b 100644
--- a/lib/kernel/src/inet_config.erl
+++ b/lib/kernel/src/inet_config.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -369,7 +369,7 @@ win32_load1(Reg,Type,HFileKey) ->
end.
win32_split_line(Line,nt) -> inet_parse:split_line(Line);
-win32_split_line(Line,windows) -> string:tokens(Line, ",").
+win32_split_line(Line,windows) -> string:lexemes(Line, ",").
win32_get_strings(Reg, Names) ->
win32_get_strings(Reg, Names, []).
diff --git a/lib/kernel/src/inet_dns.erl b/lib/kernel/src/inet_dns.erl
index d5f982cc51..f1f58bc872 100644
--- a/lib/kernel/src/inet_dns.erl
+++ b/lib/kernel/src/inet_dns.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -29,7 +29,7 @@
-export([decode/1, encode/1]).
--import(lists, [reverse/1, reverse/2, nthtail/2]).
+-import(lists, [reverse/1]).
-include("inet_int.hrl").
-include("inet_dns.hrl").
@@ -473,7 +473,7 @@ decode_data(<<Order:16,Preference:16,Data0/binary>>, _, ?S_NAPTR, Buffer) ->
{Data2,Services} = decode_string(Data1),
{Data,Regexp} = decode_characters(Data2, utf8),
Replacement = decode_domain(Data, Buffer),
- {Order,Preference,string:to_lower(Flags),string:to_lower(Services),
+ {Order,Preference,string:lowercase(Flags),string:lowercase(Services),
Regexp,Replacement};
%% ?S_OPT falls through to default
decode_data(Data, _, ?S_TXT, _) ->
diff --git a/lib/kernel/src/inet_parse.erl b/lib/kernel/src/inet_parse.erl
index 29804dc50b..e9685c6554 100644
--- a/lib/kernel/src/inet_parse.erl
+++ b/lib/kernel/src/inet_parse.erl
@@ -95,7 +95,7 @@ hosts(Fname,File) ->
%% interface with a %if suffix. These kind of
%% addresses maybe need to be gracefully handled
%% throughout inet* and inet_drv.
- case string:tokens(Address, "%") of
+ case string:lexemes(Address, "%") of
[Addr,_] ->
{ok,_} = address(Addr),
skip;
@@ -407,7 +407,7 @@ is_dom1([C | Cs]) when C >= $a, C =< $z -> is_dom_ldh(Cs);
is_dom1([C | Cs]) when C >= $A, C =< $Z -> is_dom_ldh(Cs);
is_dom1([C | Cs]) when C >= $0, C =< $9 ->
case is_dom_ldh(Cs) of
- true -> is_dom2(string:tokens([C | Cs],"."));
+ true -> is_dom2(string:lexemes([C | Cs],"."));
false -> false
end;
is_dom1(_) -> false.
diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl
index 90e49ddfdf..49aa5f8bda 100644
--- a/lib/kernel/src/inet_res.erl
+++ b/lib/kernel/src/inet_res.erl
@@ -859,15 +859,17 @@ query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I,
{ok,S} ->
Timeout =
inet:timeout( (Tm * (1 bsl I)) div Retry, Timer),
- {S,
case query_udp(
S, Id, Buffer, IP, Port, Timeout, Verbose) of
{ok,#dns_rec{header=H}} when H#dns_header.tc ->
TcpTimeout = inet:timeout(Tm*5, Timer),
- query_tcp(
- TcpTimeout, Id, Buffer, IP, Port, Verbose);
- Reply -> Reply
- end};
+ {S, query_tcp(
+ TcpTimeout, Id, Buffer, IP, Port, Verbose)};
+ {error, econnrefused} = Err ->
+ ok = udp_close(S),
+ {#sock{}, Err};
+ Reply -> {S, Reply}
+ end;
Error ->
{S0,Error}
end
diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src
index 2a88cc7e26..080b11fc4d 100644
--- a/lib/kernel/src/kernel.app.src
+++ b/lib/kernel/src/kernel.app.src
@@ -120,6 +120,6 @@
{applications, []},
{env, [{error_logger, tty}]},
{mod, {kernel, []}},
- {runtime_dependencies, ["erts-9.1", "stdlib-3.4", "sasl-3.0"]}
+ {runtime_dependencies, ["erts-10.0", "stdlib-3.5", "sasl-3.0"]}
]
}.
diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src
index f1ef70a373..fc5417597f 100644
--- a/lib/kernel/src/kernel.appup.src
+++ b/lib/kernel/src/kernel.appup.src
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
{"%VSN%",
%% Up from - max one major revision back
- [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.*, OTP-20.0
+ [{<<"5\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-20.*
%% Down to - max one major revision back
- [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.*, OTP-20.0
+ [{<<"5\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.*
}.
diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl
index 7da89dd7cb..f36b4f1e6a 100644
--- a/lib/kernel/src/net_kernel.erl
+++ b/lib/kernel/src/net_kernel.erl
@@ -423,8 +423,8 @@ handle_call({connect, Type, Node}, From, State) ->
{ok, SetupPid} ->
Owners = [{SetupPid, Node} | State#state.conn_owners],
{noreply,State#state{conn_owners=Owners}};
- _ ->
- ?connect_failure(Node, {setup_call, failed}),
+ _Error ->
+ ?connect_failure(Node, {setup_call, failed, _Error}),
async_reply({reply, false, State}, From)
end
end;
diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl
index 0250783632..b5f19d4b99 100644
--- a/lib/kernel/src/os.erl
+++ b/lib/kernel/src/os.erl
@@ -25,6 +25,8 @@
-include("file.hrl").
+-export_type([env_var_name/0, env_var_value/0, env_var_name_value/0, command_input/0]).
+
%%% BIFs
-export([getenv/0, getenv/1, getenv/2, getpid/0,
@@ -32,21 +34,29 @@
putenv/2, set_signal/2, system_time/0, system_time/1,
timestamp/0, unsetenv/1]).
--spec getenv() -> [string()].
+-type env_var_name() :: nonempty_string().
+
+-type env_var_value() :: string().
+
+-type env_var_name_value() :: nonempty_string().
+
+-type command_input() :: atom() | io_lib:chars().
+
+-spec getenv() -> [env_var_name_value()].
getenv() -> erlang:nif_error(undef).
-spec getenv(VarName) -> Value | false when
- VarName :: string(),
- Value :: string().
+ VarName :: env_var_name(),
+ Value :: env_var_value().
getenv(_) ->
erlang:nif_error(undef).
-spec getenv(VarName, DefaultValue) -> Value when
- VarName :: string(),
- DefaultValue :: string(),
- Value :: string().
+ VarName :: env_var_name(),
+ DefaultValue :: env_var_value(),
+ Value :: env_var_value().
getenv(VarName, DefaultValue) ->
case os:getenv(VarName) of
@@ -75,8 +85,8 @@ perf_counter(Unit) ->
erlang:convert_time_unit(os:perf_counter(), perf_counter, Unit).
-spec putenv(VarName, Value) -> true when
- VarName :: string(),
- Value :: string().
+ VarName :: env_var_name(),
+ Value :: env_var_value().
putenv(_, _) ->
erlang:nif_error(undef).
@@ -99,7 +109,7 @@ timestamp() ->
erlang:nif_error(undef).
-spec unsetenv(VarName) -> true when
- VarName :: string().
+ VarName :: env_var_name().
unsetenv(_) ->
erlang:nif_error(undef).
@@ -178,7 +188,7 @@ verify_executable(Name0, [Ext|Rest], OrigExtensions) ->
end;
verify_executable(Name, [], OrigExtensions) when OrigExtensions =/= [""] -> %% Windows
%% Will only happen on windows, hence case insensitivity
- case can_be_full_name(string:to_lower(Name),OrigExtensions) of
+ case can_be_full_name(string:lowercase(Name),OrigExtensions) of
true ->
verify_executable(Name,[""],[""]);
_ ->
@@ -232,10 +242,9 @@ extensions() ->
%% Executes the given command in the default shell for the operating system.
-spec cmd(Command) -> string() when
- Command :: atom() | io_lib:chars().
+ Command :: os:command_input().
cmd(Cmd) ->
- validate(Cmd),
- {SpawnCmd, SpawnOpts, SpawnInput, Eot} = mk_cmd(os:type(), Cmd),
+ {SpawnCmd, SpawnOpts, SpawnInput, Eot} = mk_cmd(os:type(), validate(Cmd)),
Port = open_port({spawn, SpawnCmd}, [binary, stderr_to_stdout,
stream, in, hide | SpawnOpts]),
MonRef = erlang:monitor(port, Port),
@@ -255,8 +264,6 @@ mk_cmd({win32,Wtype}, Cmd) ->
{Cspec,_} -> lists:concat([Cspec," /c",Cmd])
end,
{Command, [], [], <<>>};
-mk_cmd(OsType,Cmd) when is_atom(Cmd) ->
- mk_cmd(OsType, atom_to_list(Cmd));
mk_cmd(_,Cmd) ->
%% Have to send command in like this in order to make sh commands like
%% cd and ulimit available
@@ -279,17 +286,33 @@ mk_cmd(_,Cmd) ->
<<$\^D>>}.
validate(Atom) when is_atom(Atom) ->
- ok;
+ validate(atom_to_list(Atom));
validate(List) when is_list(List) ->
- validate1(List).
+ case validate1(List) of
+ false ->
+ List;
+ true ->
+ %% Had zeros at end; remove them...
+ string:trim(List, trailing, [0])
+ end.
-validate1([C|Rest]) when is_integer(C) ->
+validate1([0|Rest]) ->
+ validate2(Rest);
+validate1([C|Rest]) when is_integer(C), C > 0 ->
validate1(Rest);
validate1([List|Rest]) when is_list(List) ->
- validate1(List),
- validate1(Rest);
+ validate1(List) or validate1(Rest);
validate1([]) ->
- ok.
+ false.
+
+%% Ensure that the rest is zero only...
+validate2([]) ->
+ true;
+validate2([0|Rest]) ->
+ validate2(Rest);
+validate2([List|Rest]) when is_list(List) ->
+ validate2(List),
+ validate2(Rest).
get_data(Port, MonRef, Eot, Sofar) ->
receive
diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl
index 899102c908..f23529fec9 100644
--- a/lib/kernel/test/file_name_SUITE.erl
+++ b/lib/kernel/test/file_name_SUITE.erl
@@ -302,7 +302,9 @@ check_normal(Mod) ->
{ok, BC} = Mod:read(FD,1024),
ok = file:close(FD)
end || {regular,Name,Content} <- NormalDir ],
+ {error, badarg} = Mod:rename("fil1\0tmp_fil2","tmp_fil1"),
Mod:rename("fil1","tmp_fil1"),
+ {error, badarg} = Mod:read_file("tmp_fil1\0.txt"),
{ok, <<"fil1">>} = Mod:read_file("tmp_fil1"),
{error,enoent} = Mod:read_file("fil1"),
Mod:rename("tmp_fil1","fil1"),
diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl
index aa616d43d6..96e495505a 100644
--- a/lib/kernel/test/gen_udp_SUITE.erl
+++ b/lib/kernel/test/gen_udp_SUITE.erl
@@ -288,58 +288,56 @@ bad_address(Config) when is_list(Config) ->
%%
%% Starts a slave node that on command sends a bunch of messages
%% to our UDP port. The receiving process just receives and
-%% ignores the incoming messages, but counts them.
-%% A tracing process traces the receiving process for
-%% 'receive' and scheduling events. From the trace,
-%% message contents is verified; and, how many messages
-%% are received per in/out scheduling, which should be
-%% the same as the read_packets parameter.
-%%
-%% What happens on the SMP emulator remains to be seen...
-%%
+%% ignores the incoming messages.
+%% A tracing process traces the receiving port for
+%% 'send' and scheduling events. From the trace,
+%% how many messages are received per in/out scheduling,
+%% which should never be more than the read_packet parameter.
%% OTP-6249 UDP option for number of packet reads.
read_packets(Config) when is_list(Config) ->
- case erlang:system_info(smp_support) of
- false ->
- read_packets_1();
- true ->
- %% We would need some new sort of tracing to test this
- %% option reliably in an SMP emulator.
- {skip,"SMP emulator"}
- end.
-
-read_packets_1() ->
N1 = 5,
- N2 = 7,
+ N2 = 1,
+ Msgs = 30000,
{ok,R} = gen_udp:open(0, [{read_packets,N1}]),
{ok,RP} = inet:port(R),
{ok,Node} = start_node(gen_udp_SUITE_read_packets),
Die = make_ref(),
- Loop = erlang:spawn_link(fun () -> infinite_loop(Die) end),
%%
- Msgs1 = [erlang:integer_to_list(M) || M <- lists:seq(1, N1*3)],
- [V1|_] = read_packets_test(R, RP, Msgs1, Node),
+ {V1, Trace1} = read_packets_test(R, RP, Msgs, Node),
{ok,[{read_packets,N1}]} = inet:getopts(R, [read_packets]),
%%
ok = inet:setopts(R, [{read_packets,N2}]),
- Msgs2 = [erlang:integer_to_list(M) || M <- lists:seq(1, N2*3)],
- [V2|_] = read_packets_test(R, RP, Msgs2, Node),
+ {V2, Trace2} = read_packets_test(R, RP, Msgs, Node),
{ok,[{read_packets,N2}]} = inet:getopts(R, [read_packets]),
%%
stop_node(Node),
- Mref = erlang:monitor(process, Loop),
- Loop ! Die,
- receive
- {'DOWN',Mref,_,_, normal} ->
- case {V1,V2} of
- {N1,N2} ->
- ok;
- _ when V1 =/= N1, V2 =/= N2 ->
- ok
- end
+ ct:log("N1=~p, V1=~p vs N2=~p, V2=~p",[N1,V1,N2,V2]),
+
+ dump_terms(Config, "trace1.terms", Trace2),
+ dump_terms(Config, "trace2.terms", Trace2),
+
+ %% Because of the inherit racy-ness of the feature it is
+ %% hard to test that it behaves correctly.
+ %% Right now (OTP 21) a port task takes 5% of the
+ %% allotted port task reductions to execute, so
+ %% the max number of executions a port is allowed to
+ %% do before being re-scheduled is N * 20
+
+ if
+ V1 > (N1 * 20) ->
+ ct:fail("Got ~p msgs, max was ~p", [V1, N1]);
+ V2 > (N2 * 20) ->
+ ct:fail("Got ~p msgs, max was ~p", [V2, N2]);
+ true ->
+ ok
end.
+dump_terms(Config, Name, Terms) ->
+ FName = filename:join(proplists:get_value(priv_dir, Config),Name),
+ file:write_file(FName, term_to_binary(Terms)),
+ ct:log("Logged terms to ~s",[FName]).
+
infinite_loop(Die) ->
receive
Die ->
@@ -350,7 +348,6 @@ infinite_loop(Die) ->
end.
read_packets_test(R, RP, Msgs, Node) ->
- Len = length(Msgs),
Receiver = self(),
Tracer =
spawn_link(
@@ -375,24 +372,24 @@ read_packets_test(R, RP, Msgs, Node) ->
[link,{priority,high}]),
receive
{Sender,{port,SP}} ->
- erlang:trace(self(), true,
- [running,'receive',{tracer,Tracer}]),
+ erlang:trace(R, true,
+ [running_ports,'send',{tracer,Tracer}]),
erlang:yield(),
Sender ! {Receiver,go},
- read_packets_recv(Len),
- erlang:trace(self(), false, [all]),
+ read_packets_recv(Msgs),
+ erlang:trace(R, false, [all]),
Tracer ! {Receiver,get_trace},
receive
{Tracer,{trace,Trace}} ->
- read_packets_verify(R, SP, Msgs, Trace)
+ {read_packets_verify(R, SP, Trace), Trace}
end
end.
-read_packets_send(S, RP, [Msg|Msgs]) ->
- ok = gen_udp:send(S, localhost, RP, Msg),
- read_packets_send(S, RP, Msgs);
-read_packets_send(_S, _RP, []) ->
- ok.
+read_packets_send(_S, _RP, 0) ->
+ ok;
+read_packets_send(S, RP, Msgs) ->
+ ok = gen_udp:send(S, localhost, RP, "UDP FLOOOOOOD"),
+ read_packets_send(S, RP, Msgs - 1).
read_packets_recv(0) ->
ok;
@@ -404,23 +401,24 @@ read_packets_recv(N) ->
timeout
end.
-read_packets_verify(R, SP, Msg, Trace) ->
- lists:reverse(
- lists:sort(read_packets_verify(R, SP, Msg, Trace, 0))).
-
-read_packets_verify(R, SP, Msgs, [{trace,Self,OutIn,_}|Trace], M)
- when Self =:= self(), OutIn =:= out;
- Self =:= self(), OutIn =:= in ->
- push(M, read_packets_verify(R, SP, Msgs, Trace, 0));
-read_packets_verify(R, SP, [Msg|Msgs],
- [{trace,Self,'receive',{udp,R,{127,0,0,1},SP,Msg}}
- |Trace], M)
+read_packets_verify(R, SP, Trace) ->
+ [Max | _] = Pkts = lists:reverse(lists:sort(read_packets_verify(R, SP, Trace, 0))),
+ ct:pal("~p",[lists:sublist(Pkts,10)]),
+ Max.
+
+read_packets_verify(R, SP, [{trace,R,OutIn,_}|Trace], M)
+ when OutIn =:= out; OutIn =:= in ->
+ push(M, read_packets_verify(R, SP, Trace, 0));
+read_packets_verify(R, SP, [{trace, R,'receive',timeout}|Trace], M) ->
+ push(M, read_packets_verify(R, SP, Trace, 0));
+read_packets_verify(R, SP,
+ [{trace,R,'send',{udp,R,{127,0,0,1},SP,_Msg}, Self} | Trace], M)
when Self =:= self() ->
- read_packets_verify(R, SP, Msgs, Trace, M+1);
-read_packets_verify(_R, _SP, [], [], M) ->
+ read_packets_verify(R, SP, Trace, M+1);
+read_packets_verify(_R, _SP, [], M) ->
push(M, []);
-read_packets_verify(_R, _SP, Msgs, Trace, M) ->
- ct:fail({read_packets_verify,mismatch,Msgs,Trace,M}).
+read_packets_verify(_R, _SP, Trace, M) ->
+ ct:fail({read_packets_verify,mismatch,Trace,M}).
push(0, Vs) ->
Vs;
diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl
index 53a9e168ef..8056321448 100644
--- a/lib/kernel/test/os_SUITE.erl
+++ b/lib/kernel/test/os_SUITE.erl
@@ -22,7 +22,8 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2]).
--export([space_in_cwd/1, quoting/1, cmd_unicode/1, space_in_name/1, bad_command/1,
+-export([space_in_cwd/1, quoting/1, cmd_unicode/1,
+ null_in_command/1, space_in_name/1, bad_command/1,
find_executable/1, unix_comment_in_command/1, deep_list_command/1,
large_output_command/1, background_command/0, background_command/1,
message_leak/1, close_stdin/0, close_stdin/1, perf_counter_api/1]).
@@ -34,7 +35,8 @@ suite() ->
{timetrap,{minutes,1}}].
all() ->
- [space_in_cwd, quoting, cmd_unicode, space_in_name, bad_command,
+ [space_in_cwd, quoting, cmd_unicode, null_in_command,
+ space_in_name, bad_command,
find_executable, unix_comment_in_command, deep_list_command,
large_output_command, background_command, message_leak,
close_stdin, perf_counter_api].
@@ -125,6 +127,14 @@ cmd_unicode(Config) when is_list(Config) ->
[] = receive_all(),
ok.
+null_in_command(Config) ->
+ {Ok, Error} = case os:type() of
+ {win32,_} -> {"dir", "di\0r"};
+ _ -> {"ls", "l\0s"}
+ end,
+ true = is_list(try os:cmd(Ok) catch Class0:_ -> Class0 end),
+ error = try os:cmd(Error) catch Class1:_ -> Class1 end,
+ ok.
%% Test that program with a space in its name can be executed.
space_in_name(Config) when is_list(Config) ->
diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl
index d17eded811..131a0685cd 100644
--- a/lib/kernel/test/zlib_SUITE.erl
+++ b/lib/kernel/test/zlib_SUITE.erl
@@ -1008,32 +1008,27 @@ sub_heap_binaries(Config) when is_list(Config) ->
%% Check concurrent access to zlib driver.
smp(Config) ->
- case erlang:system_info(smp_support) of
- true ->
- NumOfProcs = lists:min([8,erlang:system_info(schedulers)]),
- io:format("smp starting ~p workers\n",[NumOfProcs]),
-
- %% Tests to run in parallel.
- Funcs =
- [zip_usage, gz_usage, compress_usage, dictionary_usage,
- crc, adler],
-
- %% We get all function arguments here to avoid repeated parallel
- %% file read access.
- UsageArgs =
- list_to_tuple([{F, ?MODULE:F({get_arg,Config})} || F <- Funcs]),
- Parent = self(),
-
- WorkerFun =
- fun() ->
- worker(rand:uniform(9999), UsageArgs, Parent)
- end,
-
- Pids = [spawn_link(WorkerFun) || _ <- lists:seq(1, NumOfProcs)],
- wait_pids(Pids);
- false ->
- {skipped,"No smp support"}
- end.
+ NumOfProcs = lists:min([8,erlang:system_info(schedulers)]),
+ io:format("smp starting ~p workers\n",[NumOfProcs]),
+
+ %% Tests to run in parallel.
+ Funcs =
+ [zip_usage, gz_usage, compress_usage, dictionary_usage,
+ crc, adler],
+
+ %% We get all function arguments here to avoid repeated parallel
+ %% file read access.
+ UsageArgs =
+ list_to_tuple([{F, ?MODULE:F({get_arg,Config})} || F <- Funcs]),
+ Parent = self(),
+
+ WorkerFun =
+ fun() ->
+ worker(rand:uniform(9999), UsageArgs, Parent)
+ end,
+
+ Pids = [spawn_link(WorkerFun) || _ <- lists:seq(1, NumOfProcs)],
+ wait_pids(Pids).
worker(Seed, FnATpl, Parent) ->
io:format("smp worker ~p, seed=~p~n",[self(),Seed]),