aboutsummaryrefslogtreecommitdiffstats
path: root/lib/kernel
diff options
context:
space:
mode:
Diffstat (limited to 'lib/kernel')
-rw-r--r--lib/kernel/doc/src/inet.xml2
-rw-r--r--lib/kernel/doc/src/os.xml15
-rw-r--r--lib/kernel/doc/src/packages.xml6
-rw-r--r--lib/kernel/examples/uds_dist/c_src/uds_drv.c4
-rw-r--r--lib/kernel/src/code.erl13
-rw-r--r--lib/kernel/src/code_server.erl4
-rw-r--r--lib/kernel/src/heart.erl4
-rw-r--r--lib/kernel/src/hipe_unified_loader.erl7
-rw-r--r--lib/kernel/src/inet.erl42
-rw-r--r--lib/kernel/src/rpc.erl2
-rw-r--r--lib/kernel/test/code_SUITE.erl3
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE.erl8
-rw-r--r--lib/kernel/test/file_name_SUITE.erl52
-rw-r--r--lib/kernel/test/gen_sctp_SUITE.erl198
14 files changed, 329 insertions, 31 deletions
diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml
index 096ddfd847..b727960d96 100644
--- a/lib/kernel/doc/src/inet.xml
+++ b/lib/kernel/doc/src/inet.xml
@@ -452,8 +452,8 @@ fe80::204:acff:fe17:bf38
Scans every byte in received data-packets and checks if the 8 bit
is set in any of them. Information is retrieved with
<c>inet:getopts/2</c>.
- <note>Deprecated! Will be removed in Erlang/OTP R16.</note>
</p>
+ <p>Note that the <c>bit8</c> option is deprecated and will be removed in Erlang/OTP R16.</p>
</item>
<tag><c>{broadcast, Boolean}</c>(UDP sockets)</tag>
diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml
index e94119845a..09c525b376 100644
--- a/lib/kernel/doc/src/os.xml
+++ b/lib/kernel/doc/src/os.xml
@@ -80,6 +80,10 @@ DirOut = os:cmd("dir"), % on Win32 platform</code>
Each environment variable is given as a single string on
the format <c>"VarName=Value"</c>, where <c>VarName</c> is
the name of the variable and <c>Value</c> its value.</p>
+ <p>If Unicode file name encoding is in effect (see the <seealso
+ marker="erts:erl#file_name_encoding">erl manual
+ page</seealso>), the strings may contain characters with
+ codepoints > 255.</p>
</desc>
</func>
<func>
@@ -93,6 +97,10 @@ DirOut = os:cmd("dir"), % on Win32 platform</code>
<p>Returns the <c>Value</c> of the environment variable
<c>VarName</c>, or <c>false</c> if the environment variable
is undefined.</p>
+ <p>If Unicode file name encoding is in effect (see the <seealso
+ marker="erts:erl#file_name_encoding">erl manual
+ page</seealso>), the strings (both <c>VarName</c> and
+ <c>Value</c>) may contain characters with codepoints > 255.</p>
</desc>
</func>
<func>
@@ -123,6 +131,13 @@ DirOut = os:cmd("dir"), % on Win32 platform</code>
<desc>
<p>Sets a new <c>Value</c> for the environment variable
<c>VarName</c>.</p>
+ <p>If Unicode filename encoding is in effect (see the <seealso
+ marker="erts:erl#file_name_encoding">erl manual
+ page</seealso>), the strings (both <c>VarName</c> and
+ <c>Value</c>) may contain characters with codepoints > 255.</p>
+ <p>On Unix platforms, the environment will be set using UTF-8 encoding
+ if Unicode file name translation is in effect. On Windows the
+ environment is set using wide character interfaces.</p>
</desc>
</func>
<func>
diff --git a/lib/kernel/doc/src/packages.xml b/lib/kernel/doc/src/packages.xml
index 80de2e05fc..81b8693baa 100644
--- a/lib/kernel/doc/src/packages.xml
+++ b/lib/kernel/doc/src/packages.xml
@@ -204,11 +204,5 @@ ok
Explicitly
declaring each use of a module makes for safe code.</p>
</description>
- <funcs>
- <func>
- <name>no functions exported</name>
- <fsummary>x</fsummary>
- </func>
- </funcs>
</erlref>
diff --git a/lib/kernel/examples/uds_dist/c_src/uds_drv.c b/lib/kernel/examples/uds_dist/c_src/uds_drv.c
index 9327ab19dc..9ad6b85a0f 100644
--- a/lib/kernel/examples/uds_dist/c_src/uds_drv.c
+++ b/lib/kernel/examples/uds_dist/c_src/uds_drv.c
@@ -967,7 +967,7 @@ static void *my_malloc(size_t size)
void *ptr;
if ((ptr = driver_alloc(size)) == NULL) {
- erl_exit(1,"Could not allocate %d bytes of memory",(int) size);
+ erl_exit(1,"Could not allocate %lu bytes of memory",(unsigned long) size);
}
return ptr;
}
@@ -977,7 +977,7 @@ static void *my_realloc(void *ptr, size_t size)
void erl_exit(int, char *, ...);
void *nptr;
if ((nptr = driver_realloc(ptr, size)) == NULL) {
- erl_exit(1,"Could not reallocate %d bytes of memory",(int) size);
+ erl_exit(1,"Could not reallocate %lu bytes of memory",(unsigned long) size);
}
return nptr;
}
diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl
index b7fda69ce0..363072951e 100644
--- a/lib/kernel/src/code.erl
+++ b/lib/kernel/src/code.erl
@@ -63,7 +63,7 @@
which/1,
where_is_file/1,
where_is_file/2,
- set_primary_archive/3,
+ set_primary_archive/4,
clash/0]).
-export_type([load_error_rsn/0, load_ret/0]).
@@ -107,7 +107,7 @@
%% unstick_mod(Module) -> true
%% is_sticky(Module) -> boolean()
%% which(Module) -> Filename | loaded_ret_atoms() | non_existing
-%% set_primary_archive((FileName, Bin, FileInfo) -> ok | {error, Reason}
+%% set_primary_archive((FileName, ArchiveBin, FileInfo, ParserFun) -> ok | {error, Reason}
%% clash() -> ok prints out number of clashes
%%----------------------------------------------------------------------------
@@ -481,13 +481,16 @@ where_is_file(Path, File) when is_list(Path), is_list(File) ->
-spec set_primary_archive(ArchiveFile :: file:filename(),
ArchiveBin :: binary(),
- FileInfo :: file:file_info())
+ FileInfo :: file:file_info(),
+ ParserFun :: fun())
-> 'ok' | {'error', atom()}.
-set_primary_archive(ArchiveFile0, ArchiveBin, #file_info{} = FileInfo)
+set_primary_archive(ArchiveFile0, ArchiveBin, #file_info{} = FileInfo,
+ ParserFun)
when is_list(ArchiveFile0), is_binary(ArchiveBin) ->
ArchiveFile = filename:absname(ArchiveFile0),
- case call({set_primary_archive, ArchiveFile, ArchiveBin, FileInfo}) of
+ case call({set_primary_archive, ArchiveFile, ArchiveBin, FileInfo,
+ ParserFun}) of
{ok, []} ->
ok;
{ok, _Mode, Ebins} ->
diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index a2db7c9790..00ad923466 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -394,8 +394,8 @@ handle_call(stop,{_From,_Tag}, S) ->
handle_call({is_cached,_File}, {_From,_Tag}, S=#state{cache=no_cache}) ->
{reply, no, S};
-handle_call({set_primary_archive, File, ArchiveBin, FileInfo}, {_From,_Tag}, S=#state{mode=Mode}) ->
- case erl_prim_loader:set_primary_archive(File, ArchiveBin, FileInfo) of
+handle_call({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}, {_From,_Tag}, S=#state{mode=Mode}) ->
+ case erl_prim_loader:set_primary_archive(File, ArchiveBin, FileInfo, ParserFun) of
{ok, Files} ->
{reply, {ok, Mode, Files}, S};
{error, _Reason} = Error ->
diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl
index 255ae4e51b..218be964a0 100644
--- a/lib/kernel/src/heart.erl
+++ b/lib/kernel/src/heart.erl
@@ -18,6 +18,10 @@
%%
-module(heart).
+-compile(no_native).
+% 'no_native' as part of a crude fix to make init:restart/0 work by clearing
+% all hipe inter-module information (hipe_mfa_info's in hipe_bif0.c).
+
%%%--------------------------------------------------------------------
%%% This is a rewrite of pre_heart from BS.3.
%%%
diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl
index 8b3aa0286d..514c002d87 100644
--- a/lib/kernel/src/hipe_unified_loader.erl
+++ b/lib/kernel/src/hipe_unified_loader.erl
@@ -34,6 +34,13 @@
-module(hipe_unified_loader).
+-compile(no_native).
+% 'no_native' is a workaround to avoid "The code server called unloaded module"
+% caused by Mod:module_info(exports) in patch_to_emu_step1() called by post_beam_load.
+% Reproducable with hipelibs and asn1_SUITE.
+% I think the real solution would be to let BIF erlang:load_module/2 redirect all
+% hipe calls to the module and thereby remove post_beam_load.
+
-export([chunk_name/1,
%% Only the code and code_server modules may call the entries below!
load_native_code/2,
diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl
index 0bb5444dbb..1a03424f88 100644
--- a/lib/kernel/src/inet.erl
+++ b/lib/kernel/src/inet.erl
@@ -763,8 +763,12 @@ sctp_opt([Opt|Opts], Mod, R, As) ->
{Name,Val} -> sctp_opt (Opts, Mod, R, As, Name, Val);
_ -> {error,badarg}
end;
-sctp_opt([], _Mod, R, _SockOpts) ->
- {ok, R}.
+sctp_opt([], _Mod, #sctp_opts{ifaddr=IfAddr}=R, _SockOpts) ->
+ if is_list(IfAddr) ->
+ {ok, R#sctp_opts{ifaddr=lists:reverse(IfAddr)}};
+ true ->
+ {ok, R}
+ end.
sctp_opt(Opts, Mod, R, As, Name, Val) ->
case add_opt(Name, Val, R#sctp_opts.opts, As) of
@@ -1015,11 +1019,7 @@ open(Fd, Addr, Port, Opts, Protocol, Family, Type, Module) when Fd < 0 ->
case prim_inet:setopts(S, Opts) of
ok ->
case if is_list(Addr) ->
- prim_inet:bind(S, add,
- [case A of
- {_,_} -> A;
- _ -> {A,Port}
- end || A <- Addr]);
+ bindx(S, Addr, Port);
true ->
prim_inet:bind(S, Addr, Port)
end of
@@ -1040,6 +1040,34 @@ open(Fd, Addr, Port, Opts, Protocol, Family, Type, Module) when Fd < 0 ->
open(Fd, _Addr, _Port, Opts, Protocol, Family, Type, Module) ->
fdopen(Fd, Opts, Protocol, Family, Type, Module).
+bindx(S, [Addr], Port0) ->
+ {IP, Port} = set_bindx_port(Addr, Port0),
+ prim_inet:bind(S, IP, Port);
+bindx(S, Addrs, Port0) ->
+ [{IP, Port} | Rest] = [set_bindx_port(Addr, Port0) || Addr <- Addrs],
+ case prim_inet:bind(S, IP, Port) of
+ {ok, AssignedPort} when Port =:= 0 ->
+ %% On newer Linux kernels, Solaris and FreeBSD, calling
+ %% bindx with port 0 is ok, but on SuSE 10, it results in einval
+ Rest2 = [change_bindx_0_port(Addr, AssignedPort) || Addr <- Rest],
+ prim_inet:bind(S, add, Rest2);
+ {ok, _} ->
+ prim_inet:bind(S, add, Rest);
+ Error ->
+ Error
+ end.
+
+set_bindx_port({_IP, _Port}=Addr, _OtherPort) ->
+ Addr;
+set_bindx_port(IP, Port) ->
+ {IP, Port}.
+
+change_bindx_0_port({IP, 0}, AssignedPort) ->
+ {IP, AssignedPort};
+change_bindx_0_port({_IP, _Port}=Addr, _AssignedPort) ->
+ Addr.
+
+
-spec fdopen(Fd :: non_neg_integer(),
Opts :: [socket_setopt()],
Protocol :: socket_protocol(),
diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl
index e214ffa404..a3fc57a124 100644
--- a/lib/kernel/src/rpc.erl
+++ b/lib/kernel/src/rpc.erl
@@ -286,7 +286,7 @@ call(N,M,F,A) ->
Reason :: term(),
Timeout :: timeout().
-call(N,M,F,A,_Timeout) when node() =:= N -> %% Optimize local call
+call(N,M,F,A,infinity) when node() =:= N -> %% Optimize local call
local_call(M,F,A);
call(N,M,F,A,infinity) ->
do_call(N, {call,M,F,A,group_leader()}, infinity);
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index 3e8bdaf1ff..827208b048 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -1550,7 +1550,8 @@ native_early_modules_1(Architecture) ->
true ->
?line true = lists:all(fun code:is_module_native/1,
[ets,file,filename,gb_sets,gb_trees,
- hipe_unified_loader,lists,os,packages]),
+ %%hipe_unified_loader, no_native as workaround
+ lists,os,packages]),
ok
end.
diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl
index 6f4f27d594..72239641e9 100644
--- a/lib/kernel/test/erl_prim_loader_SUITE.erl
+++ b/lib/kernel/test/erl_prim_loader_SUITE.erl
@@ -426,7 +426,9 @@ primary_archive(Config) when is_list(Config) ->
ExpectedEbins = [Archive, DictDir ++ "/ebin", DummyDir ++ "/ebin"],
io:format("ExpectedEbins: ~p\n", [ExpectedEbins]),
?line {ok, FileInfo} = prim_file:read_file_info(Archive),
- ?line {ok, Ebins} = rpc:call(Node, erl_prim_loader, set_primary_archive, [Archive, ArchiveBin, FileInfo]),
+ ?line {ok, Ebins} = rpc:call(Node, erl_prim_loader, set_primary_archive,
+ [Archive, ArchiveBin, FileInfo,
+ fun escript:parse_file/1]),
?line ExpectedEbins = lists:sort(Ebins), % assert
?line {ok, TopFiles2} = rpc:call(Node, erl_prim_loader, list_dir, [Archive]),
@@ -435,7 +437,9 @@ primary_archive(Config) when is_list(Config) ->
?line ok = test_archive(Node, Archive, DictDir, BeamName),
%% Cleanup
- ?line {ok, []} = rpc:call(Node, erl_prim_loader, set_primary_archive, [undefined, undefined, undefined]),
+ ?line {ok, []} = rpc:call(Node, erl_prim_loader, set_primary_archive,
+ [undefined, undefined, undefined,
+ fun escript:parse_file/1]),
?line stop_node(Node),
?line ok = file:delete(Archive),
ok.
diff --git a/lib/kernel/test/file_name_SUITE.erl b/lib/kernel/test/file_name_SUITE.erl
index 53bcb1162d..be33ec2c06 100644
--- a/lib/kernel/test/file_name_SUITE.erl
+++ b/lib/kernel/test/file_name_SUITE.erl
@@ -74,7 +74,7 @@
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([normal/1,icky/1,very_icky/1,normalize/1]).
+-export([normal/1,icky/1,very_icky/1,normalize/1,home_dir/1]).
init_per_testcase(_Func, Config) ->
@@ -88,7 +88,7 @@ end_per_testcase(_Func, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [normal, icky, very_icky, normalize].
+ [normal, icky, very_icky, normalize, home_dir].
groups() ->
[].
@@ -105,6 +105,54 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
+home_dir(suite) ->
+ [];
+home_dir(doc) ->
+ ["Check that Erlang can be started with unicode named home directory"];
+home_dir(Config) when is_list(Config) ->
+ try
+ Name=[960,945,964,961,953,954],
+ Priv = ?config(priv_dir, Config),
+ UniMode = file:native_name_encoding() =/= latin1,
+ if
+ not UniMode ->
+ throw(need_unicode_mode);
+ true ->
+ ok
+ end,
+ NewHome=filename:join(Priv,Name),
+ file:make_dir(NewHome),
+ {SaveOldName,SaveOldValue} = case os:type() of
+ {win32,nt} ->
+ HomePath=re:replace(filename:nativename(NewHome),"^[a-zA-Z]:","",[{return,list},unicode]),
+ Save = os:getenv("HOMEPATH"),
+ os:putenv("HOMEPATH",HomePath),
+ {"HOMEPATH",Save};
+ {unix,_} ->
+ Save = os:getenv("HOME"),
+ os:putenv("HOME",NewHome),
+ {"HOME",Save};
+ _ ->
+ rm_rf(prim_file,NewHome),
+ throw(unsupported_os)
+ end,
+ try
+ {ok,Node} = test_server:start_node(test_unicode_homedir,slave,[{args,"-setcookie "++atom_to_list(erlang:get_cookie())}]),
+ test_server:stop_node(Node),
+ ok
+ after
+ os:putenv(SaveOldName,SaveOldValue),
+ rm_rf(prim_file,NewHome)
+ end
+ catch
+ throw:need_unicode_mode ->
+ io:format("Sorry, can only run in unicode mode.~n"),
+ {skipped,"VM needs to be started in Unicode filename mode"};
+ throw:unsupported_os ->
+ io:format("Sorry, can only run on Unix/Windows.~n"),
+ {skipped,"Runs only on Unix/Windows"}
+ end.
+
normalize(suite) ->
[];
normalize(doc) ->
diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl
index 8f490b6643..f4bf6e719e 100644
--- a/lib/kernel/test/gen_sctp_SUITE.erl
+++ b/lib/kernel/test/gen_sctp_SUITE.erl
@@ -31,14 +31,22 @@
[basic/1,
api_open_close/1,api_listen/1,api_connect_init/1,api_opts/1,
xfer_min/1,xfer_active/1,def_sndrcvinfo/1,implicit_inet6/1,
- basic_stream/1, xfer_stream_min/1, peeloff/1, buffers/1]).
+ basic_stream/1, xfer_stream_min/1, peeloff/1, buffers/1,
+ open_multihoming_ipv4_socket/1,
+ open_unihoming_ipv6_socket/1,
+ open_multihoming_ipv6_socket/1,
+ open_multihoming_ipv4_and_ipv6_socket/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[basic, api_open_close, api_listen, api_connect_init,
api_opts, xfer_min, xfer_active, def_sndrcvinfo, implicit_inet6,
- basic_stream, xfer_stream_min, peeloff, buffers].
+ basic_stream, xfer_stream_min, peeloff, buffers,
+ open_multihoming_ipv4_socket,
+ open_unihoming_ipv6_socket,
+ open_multihoming_ipv6_socket,
+ open_multihoming_ipv4_and_ipv6_socket].
groups() ->
[].
@@ -1105,6 +1113,192 @@ mk_data(N, Bytes, Bin) when N < Bytes ->
mk_data(_, _, Bin) ->
Bin.
+
+
+open_multihoming_ipv4_socket(doc) ->
+ "Test opening a multihoming ipv4 socket";
+open_multihoming_ipv4_socket(suite) ->
+ [];
+open_multihoming_ipv4_socket(Config) when is_list(Config) ->
+ ?line case get_addrs_by_family(inet, 2) of
+ {ok, [Addr1, Addr2]} ->
+ ?line do_open_and_connect([Addr1, Addr2], Addr1);
+ {error, Reason} ->
+ {skip, Reason}
+ end.
+
+open_unihoming_ipv6_socket(doc) ->
+ %% This test is mostly aimed to indicate
+ %% whether host has a non-working ipv6 setup
+ "Test opening a unihoming (non-multihoming) ipv6 socket";
+open_unihoming_ipv6_socket(suite) ->
+ [];
+open_unihoming_ipv6_socket(Config) when is_list(Config) ->
+ ?line case get_addrs_by_family(inet6, 1) of
+ {ok, [Addr]} ->
+ ?line do_open_and_connect([Addr], Addr);
+ {error, Reason} ->
+ {skip, Reason}
+ end.
+
+
+open_multihoming_ipv6_socket(doc) ->
+ "Test opening a multihoming ipv6 socket";
+open_multihoming_ipv6_socket(suite) ->
+ [];
+open_multihoming_ipv6_socket(Config) when is_list(Config) ->
+ ?line case get_addrs_by_family(inet6, 2) of
+ {ok, [Addr1, Addr2]} ->
+ ?line do_open_and_connect([Addr1, Addr2], Addr1);
+ {error, Reason} ->
+ {skip, Reason}
+ end.
+
+open_multihoming_ipv4_and_ipv6_socket(doc) ->
+ "Test opening a multihoming ipv6 socket with ipv4 and ipv6 addresses";
+open_multihoming_ipv4_and_ipv6_socket(suite) ->
+ [];
+open_multihoming_ipv4_and_ipv6_socket(Config) when is_list(Config) ->
+ ?line case get_addrs_by_family(inet_and_inet6, 2) of
+ {ok, [[InetAddr1, InetAddr2], [Inet6Addr1, Inet6Addr2]]} ->
+ %% Connect to the first address to test bind
+ ?line do_open_and_connect([InetAddr1, Inet6Addr1, InetAddr2],
+ InetAddr1),
+ ?line do_open_and_connect([Inet6Addr1, InetAddr1],
+ Inet6Addr1),
+
+ %% Connect an address, not the first,
+ %% to test sctp_bindx
+ ?line do_open_and_connect([Inet6Addr1, Inet6Addr2, InetAddr1],
+ Inet6Addr2),
+ ?line do_open_and_connect([Inet6Addr1, Inet6Addr2, InetAddr1],
+ InetAddr1);
+ {error, Reason} ->
+ {skip, Reason}
+ end.
+
+
+get_addrs_by_family(Family, NumAddrs) ->
+ case os:type() of
+ {unix,linux} ->
+ get_addrs_by_family_aux(Family, NumAddrs);
+ {unix,freebsd} ->
+ get_addrs_by_family_aux(Family, NumAddrs);
+ {unix,sunos} ->
+ case get_addrs_by_family_aux(Family, NumAddrs) of
+ {ok, [InetAddrs, Inet6Addrs]} when Family =:= inet_and_inet6 ->
+ %% Man page for sctp_bindx on Solaris says: "If sock is an
+ %% Internet Protocol Version 6 (IPv6) socket, addrs should
+ %% be an array of sockaddr_in6 structures containing IPv6
+ %% or IPv4-mapped IPv6 addresses."
+ {ok, [ipv4_map_addrs(InetAddrs), Inet6Addrs]};
+ {ok, Addrs} ->
+ {ok, Addrs};
+ {error, Reason} ->
+ {error, Reason}
+ end;
+ Os ->
+ Reason = if Family =:= inet_and_inet6 ->
+ f("Mixing ipv4 and ipv6 addresses for multihoming "
+ " has not been verified on ~p", [Os]);
+ true ->
+ f("Multihoming for ~p has not been verified on ~p",
+ [Family, Os])
+ end,
+ {error, Reason}
+ end.
+
+get_addrs_by_family_aux(Family, NumAddrs) when Family =:= inet;
+ Family =:= inet6 ->
+ ?line
+ case inet:getaddr(localhost, Family) of
+ {error,eafnosupport} ->
+ {skip, f("No support for ~p", Family)};
+ {ok, _} ->
+ ?line IfAddrs = ok(inet:getifaddrs()),
+ ?line case filter_addrs_by_family(IfAddrs, Family) of
+ Addrs when length(Addrs) >= NumAddrs ->
+ {ok, lists:sublist(Addrs, NumAddrs)};
+ [] ->
+ {error, f("Need ~p ~p address(es) found none~n",
+ [NumAddrs, Family])};
+ Addrs ->
+ {error,
+ f("Need ~p ~p address(es) found only ~p: ~p~n",
+ [NumAddrs, Family, length(Addrs), Addrs])}
+ end
+ end;
+get_addrs_by_family_aux(inet_and_inet6, NumAddrs) ->
+ ?line catch {ok, [case get_addrs_by_family_aux(Family, NumAddrs) of
+ {ok, Addrs} -> Addrs;
+ {error, Reason} -> throw({error, Reason})
+ end || Family <- [inet, inet6]]}.
+
+filter_addrs_by_family(IfAddrs, Family) ->
+ lists:flatten([[Addr || {addr, Addr} <- Info,
+ is_good_addr(Addr, Family)]
+ || {_IfName, Info} <- IfAddrs]).
+
+is_good_addr(Addr, inet) when tuple_size(Addr) =:= 4 ->
+ true;
+is_good_addr({0,0,0,0,0,16#ffff,_,_}, inet6) ->
+ false; %% ipv4 mapped
+is_good_addr({16#fe80,_,_,_,_,_,_,_}, inet6) ->
+ false; %% link-local
+is_good_addr(Addr, inet6) when tuple_size(Addr) =:= 8 ->
+ true;
+is_good_addr(_Addr, _Family) ->
+ false.
+
+ipv4_map_addrs(InetAddrs) ->
+ [begin
+ <<AB:16>> = <<A,B>>,
+ <<CD:16>> = <<C,D>>,
+ {0, 0, 0, 0, 0, 16#ffff, AB, CD}
+ end || {A,B,C,D} <- InetAddrs].
+
+f(F, A) ->
+ lists:flatten(io_lib:format(F, A)).
+
+do_open_and_connect(ServerAddresses, AddressToConnectTo) ->
+ ?line ServerFamily = get_family_by_addrs(ServerAddresses),
+ ?line io:format("Serving ~p addresses: ~p~n",
+ [ServerFamily, ServerAddresses]),
+ ?line S1 = ok(gen_sctp:open(0, [{ip,Addr} || Addr <- ServerAddresses] ++
+ [ServerFamily])),
+ ?line ok = gen_sctp:listen(S1, true),
+ ?line P1 = ok(inet:port(S1)),
+ ?line ClientFamily = get_family_by_addr(AddressToConnectTo),
+ ?line io:format("Connecting to ~p ~p~n",
+ [ClientFamily, AddressToConnectTo]),
+ ?line S2 = ok(gen_sctp:open(0, [ClientFamily])),
+ %% Verify client can connect
+ ?line #sctp_assoc_change{state=comm_up} =
+ ok(gen_sctp:connect(S2, AddressToConnectTo, P1, [])),
+ %% verify server side also receives comm_up from client
+ ?line recv_comm_up_eventually(S1),
+ ?line ok = gen_sctp:close(S2),
+ ?line ok = gen_sctp:close(S1).
+
+%% If at least one of the addresses is an ipv6 address, return inet6, else inet.
+get_family_by_addrs(Addresses) ->
+ ?line case lists:usort([get_family_by_addr(Addr) || Addr <- Addresses]) of
+ [inet, inet6] -> inet6;
+ [inet] -> inet;
+ [inet6] -> inet6
+ end.
+
+get_family_by_addr(Addr) when tuple_size(Addr) =:= 4 -> inet;
+get_family_by_addr(Addr) when tuple_size(Addr) =:= 8 -> inet6.
+
+recv_comm_up_eventually(S) ->
+ ?line case ok(gen_sctp:recv(S)) of
+ {_Addr, _Port, _Info, #sctp_assoc_change{state=comm_up}} ->
+ ok;
+ {_Addr, _Port, _Info, _OtherSctpMsg} ->
+ ?line recv_comm_up_eventually(S)
+ end.
+
%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% socket gen_server ultra light
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-04 21:20:23 +0000