diff --git a/lib/kernel/src/gen_udp_socket.erl b/lib/kernel/src/gen_udp_socket.erl index 970484126a77..1ec5e03e7d56 100644 --- a/lib/kernel/src/gen_udp_socket.erl +++ b/lib/kernel/src/gen_udp_socket.erl @@ -219,16 +219,28 @@ do_open(Mod, BindAddr, Domain, OpenOpts, Opts, ExtraOpts) -> %% ?DBG(['try start server', {socket, SocketOpts}, {start, StartOpts}]), case start_server(Mod, Domain, start_opts(StartOpts), ExtraOpts) of {ok, Server} -> - {SetOpts0, _} = setopts_split(#{socket => [], - server_read => [], - server_write => []}, - OpenOpts), + {PreBindSetOpts, OpenOpts2} = setopts_split(pre_bind, OpenOpts), + %% ?DBG([{pre_bind_open_opts, PreBindSetOpts}, + %% {open_opts_2, OpenOpts2}]), + + {SetOpts0, _DroppedOpts} = + setopts_split(#{socket => [], + server_read => [], + server_write => []}, + OpenOpts2), + %% ?DBG([{set_opts_0, SetOpts0}, {dropped_opts, _DroppedOpts}]), SetOpts = default_active_true( [{start_opts, StartOpts}] ++ SocketOpts ++ SetOpts0), + %% ?DBG([{set_opts, SetOpts}]), ErrRef = make_ref(), try + %% Set pre-bind opts + %% ?DBG(['maybe pre bind setopts']), + PreBindSetOpts =/= [] andalso + ok(ErrRef, call(Server, {setopts, PreBindSetOpts})), + %% ?DBG(['maybe try bind', {bind_addr, BindAddr}]), ok(ErrRef, call_bind(Server, default_any(Domain, ExtraOpts, BindAddr))), @@ -1019,8 +1031,9 @@ getopt_categories(Opt) -> %% setopt and getopt category opt_categories(Tag) when is_atom(Tag) -> case Tag of - sys_debug -> #{start => []}; - debug -> #{socket => [], start => []}; + sys_debug -> #{start => []}; + debug -> #{socket => [], start => []}; + ipv6_v6only -> #{socket => [], pre_bind => []}; %% Some options may trigger us to choose recvmsg (instead of recvfrom) %% Or trigger us to choose recvfrom *if* was previously selected @@ -1124,7 +1137,7 @@ socket_opt() -> %% %% Level: ipv6 recvtclass => {ipv6, recvtclass}, - ipv6_v6only => {ipv6, v6only}, + ipv6_v6only => {ipv6, v6only}, % pre_bind tclass => {ipv6, tclass}, %% diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index a8aec68e834d..d99e77d73695 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -77,14 +77,14 @@ t_simple_link_local_sockaddr_in6_send_recv/1, otp_18323_opts_processing/1, - otp_18323_open/1 + otp_18323_open/1, + otp_19357_open_with_ipv6_option/1 ]). -include_lib("kernel/src/inet_int.hrl"). +-include("kernel_test_lib.hrl"). --define(TRY_TC(F), try_tc(F)). - suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. @@ -152,7 +152,8 @@ all_cases() -> {group, socket_monitor}, otp_17492, {group, sockaddr}, - {group, otp18323} + {group, otp18323}, + otp_19357_open_with_ipv6_option ]. recv_and_send_opts_cases() -> @@ -3235,6 +3236,65 @@ do_otp_18323_open(#{local_addr := Addr}) -> ok. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +otp_19357_open_with_ipv6_option(Config) when is_list(Config) -> + ct:timetrap(?MINS(1)), + Cond = fun() -> + ?P("cond check: do we support socket"), + case ?LIB:is_socket_supported() of + true -> + ?P("cond check: do we support ipv6"), + ?LIB:has_support_ipv6(); + false -> + ?SKIPT("SOCKET not supported") + end + end, + Pre = fun() -> + {ok, Addr} = ?LIB:which_local_addr(inet6), + #{local_addr => Addr} + end, + Case = fun(State) -> do_otp_19357_open_with_ipv6_option(State) end, + Post = fun(_) -> ok end, + ?TC_TRY(?FUNCTION_NAME, Cond, Pre, Case, Post). + +do_otp_19357_open_with_ipv6_option(#{local_addr := Addr}) -> + %% First without specifying the (bind) address: + TryOpen = fun(No, Opts) -> + try gen_udp:open(0, Opts) of + {ok, Sock} -> + ?P("success ~w", [No]), + (catch gen_udp:close(Sock)); + {error, Reason} -> + ?P("FAILED open socket ~w: " + "~n ~p", [No, Reason]), + exit({Reason, No}) + catch + C:E -> + ?P("CATCHED open socket ~w: " + "~n Error Class: ~p" + "~n Error: ~p" + "~n ~p", [No, C, E]), + exit({C, E, No, Opts}) + end + end, + ?P("try wo address (1)"), + TryOpen(1, [{inet_backend, socket}, + binary, + inet6, {ipv6_v6only, true}, + {reuseaddr, true}]), + + ?P("try w address (2)"), + TryOpen(2, [{inet_backend, socket}, + binary, + inet6, {ipv6_v6only, true}, + {ip, Addr}, + {reuseaddr, true}]), + + ?P("done"), + ok. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ok({ok,V}) -> V; diff --git a/lib/kernel/test/kernel_test_lib.erl b/lib/kernel/test/kernel_test_lib.erl index 079aeefe33a4..952f1e2e7599 100644 --- a/lib/kernel/test/kernel_test_lib.erl +++ b/lib/kernel/test/kernel_test_lib.erl @@ -68,6 +68,9 @@ -include("kernel_test_lib.hrl"). +-define(DBG(F, A), dbg(F, A)). +-define(DBG(F), ?DBG(F, [])). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2739,7 +2742,7 @@ has_support_unix_domain_socket() -> %% This gets the local "proper" address %% (not {127, ...} or {169,254, ...} or {0, ...} or {16#fe80, ...}) -%% We should really implement this using the (new) net module, +%% We should really implement this using the ("new") net module, %% but until that gets the necessary functionality... which_local_addr(Domain) -> case which_local_host_info(false, Domain) of @@ -2771,8 +2774,13 @@ which_local_host_info(Domain) -> which_local_host_info(LinkLocal, Domain) when is_boolean(LinkLocal) andalso ((Domain =:= inet) orelse (Domain =:= inet6)) -> + ?DBG("~w -> entry with" + "~n LinkLocal: ~p" + "~n Domain: ~p", [?FUNCTION_NAME, LinkLocal, Domain]), case inet:getifaddrs() of {ok, IFL} -> + ?DBG("~w -> " + "~n IFL: ~p", [?FUNCTION_NAME, IFL]), which_local_host_info(LinkLocal, Domain, IFL, []); {error, _} = ERROR -> ERROR @@ -2825,17 +2833,29 @@ which_local_host_info(LinkLocal, Domain, [{"stf" ++ _, _}|IFL], Acc) -> which_local_host_info(LinkLocal, Domain, [{"XHCZ" ++ _, _}|IFL], Acc) -> which_local_host_info(LinkLocal, Domain, IFL, Acc); which_local_host_info(LinkLocal, Domain, [{Name, IFO}|IFL], Acc) -> + ?DBG("~w -> entry with" + "~n LinkLocal: ~p" + "~n Domain: ~p" + "~n Name: ~p" + "~n IFO: ~p", + [?FUNCTION_NAME, LinkLocal, Domain, Name, IFO]), case if_is_running_and_not_loopback(IFO) of true -> + ?DBG("~w -> running and not loopback", [?FUNCTION_NAME]), try which_local_host_info2(LinkLocal, Domain, IFO) of Info -> + ?DBG("~w -> " + "~n Info: ~p", [?FUNCTION_NAME, Info]), which_local_host_info(LinkLocal, Domain, IFL, [Info#{name => Name}|Acc]) catch throw:_E:_ -> + ?DBG("~w -> catch" + "~n E: ~p", [?FUNCTION_NAME, _E]), which_local_host_info(LinkLocal, Domain, IFL, Acc) end; false -> + ?DBG("~w -> not running or is loopback", [?FUNCTION_NAME]), which_local_host_info(LinkLocal, Domain, IFL, Acc) end; which_local_host_info(LinkLocal, Domain, [_|IFL], Acc) -> @@ -2851,6 +2871,8 @@ if_is_running_and_not_loopback(If) -> which_local_host_info2(LinkLocal, inet = _Domain, IFO) -> + ?DBG("~w(~w, ~w) -> entry with" + "~n IFO: ~p", [?FUNCTION_NAME, LinkLocal, _Domain, IFO]), Addr = which_local_host_info3( addr, IFO, fun({A, _, _, _}) when (A =:= 127) -> false; @@ -2885,13 +2907,58 @@ which_local_host_info2(LinkLocal, inet = _Domain, IFO) -> broadaddr => BroadAddr, netmask => NetMask}; which_local_host_info2(LinkLocal, inet6 = _Domain, IFO) -> + ?DBG("~w(~w, ~w) -> entry with" + "~n IFO: ~p", [?FUNCTION_NAME, LinkLocal, _Domain, IFO]), Addr = which_local_host_info3(addr, IFO, - fun({A, _, _, _, _, _, _, _}) - when (A =:= 0) -> false; - ({A, _, _, _, _, _, _, _}) - when (A =:= 16#fe80) -> LinkLocal; - ({_, _, _, _, _, _, _, _}) -> not LinkLocal; - (_) -> false + fun({A, _, _, _, _, _, _, _} = _Address) + when (A =:= 0) -> + ?DBG("~w:fun(1) -> no match: " + "~n Address: ~p", + [?FUNCTION_NAME, _Address]), + false; + ({A, _, _, _, _, _, _, _} = _Address) + when (A =:= 16#fe80) -> + if + LinkLocal -> + ?DBG("~w:fun(2) -> " + "link local address " + "accepted: " + "~n ~p", + [?FUNCTION_NAME, + _Address]); + true -> + ?DBG("~w:fun(2) -> " + "link local address " + "rejected: " + "~n ~p", + [?FUNCTION_NAME, + _Address]) + end, + LinkLocal; + ({_, _, _, _, _, _, _, _} = _Address) -> + if + (not LinkLocal) -> + ?DBG("~w:fun(3) -> " + "'normal'" + "local address " + "accepted: " + "~n ~p", + [?FUNCTION_NAME, + _Address]); + true -> + ?DBG("~w:fun(3) -> " + "'normal' address " + "rejected: " + "~n ~p", + [?FUNCTION_NAME, + _Address]) + end, + not LinkLocal; + (_Address) -> + ?DBG("~w:fun(4) -> no match: " + "~n Address: ~p", + [?FUNCTION_NAME, _Address]), + false end), NetMask = which_local_host_info3(netmask, IFO, fun({_, _, _, _, _, _, _, _}) -> true; @@ -2903,15 +2970,22 @@ which_local_host_info2(LinkLocal, inet6 = _Domain, IFO) -> netmask => NetMask}. which_local_host_info3(_Key, [], _) -> + ?DBG("~w -> no address", [?FUNCTION_NAME]), throw({error, no_address}); which_local_host_info3(Key, [{Key, Val}|IFO], Check) -> + ?DBG("~w -> entry with" + "~n Key: ~p" + "~n Val: ~p", [?FUNCTION_NAME, Key, Val]), case Check(Val) of true -> + ?DBG("~w -> validated", [?FUNCTION_NAME]), Val; false -> + ?DBG("~w -> not validated", [?FUNCTION_NAME]), which_local_host_info3(Key, IFO, Check) end; which_local_host_info3(Key, [_|IFO], Check) -> + ?DBG("~w -> key (~w) not found - continue", [?FUNCTION_NAME, Key]), which_local_host_info3(Key, IFO, Check). @@ -2957,4 +3031,17 @@ print(F) -> print(F, []). print(F, A) -> - io:format("~s ~p " ++ F ++ "~n", [formated_timestamp(), self() | A]). + print("", F, A). + +print(Prefix, F, A) -> + io:format("~s[~s , ~p] " ++ F ++ "~n", + [Prefix, formated_timestamp(), self() | A]). + +dbg(F, A) -> + dbg(get(debug), F, A). + +dbg(true, F, A) -> + print("DEBUG", F, A); +dbg(_, _, _) -> + ok. + diff --git a/lib/kernel/test/socket_SUITE.erl b/lib/kernel/test/socket_SUITE.erl index 34940c69acae..1a6478b54968 100644 --- a/lib/kernel/test/socket_SUITE.erl +++ b/lib/kernel/test/socket_SUITE.erl @@ -12616,8 +12616,9 @@ has_support_sctp() -> end. -%% The idea is that this function shall test if the test host has -%% support for IPv4 or IPv6. If not, there is no point in running corresponding tests. +%% The idea is that this function shall test if the host has +%% support for IPv4 or IPv6. +%% If not, there is no point in running corresponding tests. %% Currently we just skip. has_support_ipv4() -> ?KLIB:has_support_ipv4().