diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index f6d5e7915cda..a5f8e92d380b 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -1357,6 +1357,10 @@ static struct erl_drv_entry tcp_inet_driver_entry = #ifdef HAVE_UDP + +/* "IS_UDP": tells the difference between a UDP and an SCTP socket: */ +# define IS_UDP(desc)((desc)->sprotocol==IPPROTO_UDP) + static int packet_inet_init(void); static void packet_inet_stop(ErlDrvData); static void packet_inet_command(ErlDrvData, char*, ErlDrvSizeT); @@ -1407,6 +1411,11 @@ static struct erl_drv_entry udp_inet_driver_entry = inet_stop_select, inet_emergency_close }; + +#else + +# define IS_UDP(desc) 0 + #endif #ifdef HAVE_SCTP @@ -14759,18 +14768,44 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len) long code; inet_address other; + DDBG(desc, + ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " + "packet_inet_command -> entry" + "\r\n", + __LINE__, + desc->s, driver_caller(desc->port)) ); + if (! init_caller(&desc->caller, &desc->caller_ref, desc->port, &buf, &len)) { + + DDBG(desc, + ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " + "packet_inet_command -> init caller failed" + "\r\n", __LINE__, desc->s, driver_caller(desc->port)) ); + driver_failure_posix(desc->port, EINVAL); return; } ptr = buf; if (!IS_OPEN(desc)) { + + DDBG(desc, + ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " + "packet_inet_command -> not open" + "\r\n", __LINE__, desc->s, driver_caller(desc->port)) ); + inet_reply_error(desc, EINVAL); return; } + DDBG(desc, + ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " + "packet_inet_command -> data size: %u" + "\r\n", + __LINE__, + desc->s, driver_caller(desc->port), len) ); + #ifdef HAVE_SCTP if (IS_SCTP(desc)) { @@ -14813,6 +14848,12 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len) inet_output_count(desc, data_len); /* Now do the actual sending. NB: "flags" in "sendmsg" itself are NOT used: */ + + DDBG(desc, + ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " + "packet_inet_command -> try sendmsg" + "\r\n", __LINE__, desc->s, driver_caller(desc->port)) ); + code = sock_sendmsg(desc->s, &mhdr, 0); goto check_result_code; @@ -14845,9 +14886,21 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len) inet_output_count(desc, len); if (desc->state & INET_F_ACTIVE) { /* connected (ignore address) */ + + DDBG(desc, + ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " + "packet_inet_command -> try send (connected)" + "\r\n", __LINE__, desc->s, driver_caller(desc->port)) ); + code = sock_send(desc->s, ptr, len, 0); } else { + + DDBG(desc, + ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " + "packet_inet_command -> try sendto" + "\r\n", __LINE__, desc->s, driver_caller(desc->port)) ); + code = sock_sendto(desc->s, ptr, len, 0, &other.sa, sz); } } @@ -14888,6 +14941,12 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len) mhdr.msg_iovlen = 1; mhdr.msg_flags = 0; inet_output_count(desc, len); + + DDBG(desc, + ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " + "packet_inet_command -> try sendmsg" + "\r\n", __LINE__, desc->s, driver_caller(desc->port)) ); + code = sock_sendmsg(desc->s, &mhdr, 0); #endif } @@ -14896,7 +14955,9 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len) #ifdef HAVE_SCTP check_result_code: /* "code" analysis is the same for both SCTP and UDP above, - * although ERRNO_BLOCK | EINTR never happens for UDP + * although ERRNO_BLOCK | EINTR "never" happens for UDP. + * It *can* actually happen, even though it is difficult + * to provoke (virtualization). */ #endif if (IS_SOCKET_ERROR(code)) { @@ -14904,53 +14965,75 @@ static void packet_inet_command(ErlDrvData e, char* buf, ErlDrvSizeT len) DDBG(desc, ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " - "packet_inet_command -> send failed" - "\r\n error: %d (%T)" - "\r\n", - __LINE__, - desc->s, driver_caller(desc->port), - err, error_atom(err)) ); - - if ((err != ERRNO_BLOCK) && (err != EINTR)) { - inet_reply_error(desc, err); - return; - } - // else if (desc->nonBlockSend) { - else if (IS_NON_BLOCK_SEND(desc)) { + "packet_inet_command -> send failed: " + "\r\n error: %d (%s)" + "\r\n", __LINE__, + desc->s, driver_caller(desc->port), err, errno_str(err)) ); + + if (IS_UDP(desc)) { - DDBG(desc, - ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " - "packet_inet_command -> block|intr when non-block send" - "\r\n", - __LINE__, - desc->s, driver_caller(desc->port)) ); - inet_reply_error(desc, err); return; - } - else { - DDBG(desc, - ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " - "packet_inet_command -> block|intr send" - "\r\n", - __LINE__, - desc->s, driver_caller(desc->port)) ); + } else { + + /* SCTP */ + if ((err != ERRNO_BLOCK) && (err != EINTR)) { + + inet_reply_error(desc, err); + return; + + } else if (IS_NON_BLOCK_SEND(desc)) { + + DDBG(desc, + ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " + "packet_inet_command -> " + "[sctp] block|intr when non-block send" + "\r\n", + __LINE__, + desc->s, driver_caller(desc->port)) ); + + inet_reply_error(desc, err); + return; + + } else { + + DDBG(desc, + ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " + "packet_inet_command -> [sctp] block|intr send" + "\r\n", + __LINE__, + desc->s, driver_caller(desc->port)) ); + + /* XXX if(! INET_IGNORED(INETP(desc))) */ + sock_select(desc, (FD_WRITE|FD_CLOSE), 1); + set_busy_port(desc->port, 1); + /* XXX add_multi_timer(... desc->send_timeout, ...); */ + inet_reply_caller_ref(desc); + return; + } - /* XXX if(! INET_IGNORED(INETP(desc))) */ - sock_select(desc, (FD_WRITE|FD_CLOSE), 1); - set_busy_port(desc->port, 1); - /* XXX add_multi_timer(... desc->send_timeout, ...); */ - inet_reply_caller_ref(desc); - return; } - } - else { + + } else { + + DDBG(desc, + ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " + "packet_inet_command -> ok" + "\r\n", __LINE__, desc->s, driver_caller(desc->port)) ); + inet_reply_ok(desc); return; + } return_einval: + + DDBG(desc, + ("INET-DRV-DBG[%d][" SOCKET_FSTR ",%T] " + "packet_inet_command -> einval" + "\r\n", __LINE__, desc->s, driver_caller(desc->port)) ); + inet_reply_error(desc, EINVAL); return; } diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index d99e77d73695..c1e6a539f113 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -78,8 +78,8 @@ otp_18323_opts_processing/1, otp_18323_open/1, + otp_19332/1, otp_19357_open_with_ipv6_option/1 - ]). -include_lib("kernel/src/inet_int.hrl"). @@ -119,7 +119,9 @@ groups() -> {socket_monitor, [], socket_monitor_cases()}, {sockaddr, [], sockaddr_cases()}, - {otp18323, [], otp18323_cases()} + {tickets, [], tickets_cases()}, + {otp18323, [], otp18323_cases()}, + {otp19332, [], otp19332_cases()} ]. inet_backend_default_cases() -> @@ -152,8 +154,7 @@ all_cases() -> {group, socket_monitor}, otp_17492, {group, sockaddr}, - {group, otp18323}, - otp_19357_open_with_ipv6_option + {group, tickets} ]. recv_and_send_opts_cases() -> @@ -191,12 +192,23 @@ sockaddr_cases() -> t_simple_link_local_sockaddr_in6_send_recv ]. +tickets_cases() -> + [ + {group, otp18323}, + {group, otp19332}, + otp_19357_open_with_ipv6_option + ]. + otp18323_cases() -> [ otp_18323_opts_processing, otp_18323_open ]. +otp19332_cases() -> + [ + otp_19332 + ]. init_per_suite(Config0) -> @@ -210,15 +222,33 @@ init_per_suite(Config0) -> Config1 when is_list(Config1) -> - ?P("init_per_suite -> end when " - "~n Config: ~p", [Config1]), - %% We need a monitor on this node also + ?P("init_per_suite -> start (local) system monitor"), kernel_test_sys_monitor:start(), + maybe_display_dgram_qlen(), + + ?P("init_per_suite -> end when " + "~n Config: ~p", [Config1]), + Config1 end. +maybe_display_dgram_qlen() -> + maybe_display_dgram_qlen(os:type()). + +maybe_display_dgram_qlen({unix, linux}) -> + case max_dgram_qlen() of + QLen when is_integer(QLen) -> + ?P("Max DGram QLen: ~w~n", [QLen]), + ok; + _ -> + ok + end; +maybe_display_dgram_qlen(_) -> + ok. + + end_per_suite(Config0) -> ?P("end_per_suite -> entry with" @@ -3236,6 +3266,82 @@ do_otp_18323_open(#{local_addr := Addr}) -> ok. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% On some linux platforms, mostly in "docker"-like environments, +%% send *can* block. This, I think, mostly depends the value of +%% system config *net.unix.max_dgram_qlen*. On Docker this can +%% be small (10). With "normal" machines this is much larger (> 500), +%% which makes this hard tp reproduce. +otp_19332(Config) when is_list(Config) -> + ct:timetrap(?MINS(1)), + Cond = fun() -> + is_linux(), + is_docker(Config), + %% We should really test for UDS support also, + %% but how without using 'socket'? + %% Maybe its enough to open the socket (with 'local'). + has_small_enough_dgram_qlen(20), + ok + end, + Pre = fun() -> + Opts = [local, + {active, false}, + {debug, true}], + case gen_udp:open(0, Opts) of + {ok, Sock} -> + inet:setopts(Sock, [{debug, false}]), + #{sock => Sock}; + {error, Reason} -> + skip(?F("Failed open socket: ~p", [Reason])) + end + end, + Case = fun(State) -> do_otp_19332(State) end, + Post = fun(#{sock := Sock}) -> + (catch gen_udp:close(Sock)) + end, + ?TC_TRY(?FUNCTION_NAME, Cond, Pre, Case, Post). + +do_otp_19332(#{sock := Sock}) -> + ?P("begin"), + + 0 = do_otp_19332_test(Sock), + + ?P("done"), + ok. + +do_otp_19332_test(S) -> + do_otp_19332_test(S, 100000, #{}, 0). + +do_otp_19332_test(_S, 0, Errs, NumR) -> + ?P("send attempts done: " + "~n Errors: ~p" + "~n Number of (inet) replies: ~p", [Errs, NumR]), + NumR; +do_otp_19332_test(S, N, Errs, NumR) -> + Packet = lists:duplicate(100, "hello\n"), + Errs2 = + case gen_udp:send(S, {local, "/tmp/test.sock"}, Packet) of + ok -> + ?P("UNEXPECTED SUCCESS (at ~w)", [N]), + exit(unexpected_success); + {error, Reason} -> + case Errs of + #{Reason := EN} -> + Errs#{Reason => EN + 1}; + _ -> + Errs#{Reason => 1} + end + end, + receive + {inet_reply, S, _Ref} -> + ?P("Got a reply"), + do_otp_19332_test(S, N-1, Errs2, NumR+1) + after 0 -> + do_otp_19332_test(S, N-1, Errs2, NumR) + end. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% otp_19357_open_with_ipv6_option(Config) when is_list(Config) -> @@ -3339,6 +3445,50 @@ get_localaddr([Localhost|Ls]) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +is_docker(Config) -> + case which_label(Config) of + {ok, docker} -> + ok; + _ -> + skip("Is not running in a Docker") + end. + +has_small_enough_dgram_qlen(Max) when is_integer(Max) -> + case max_dgram_qlen() of + QLen when is_integer(QLen) andalso (QLen < Max) -> + ok; + QLen when is_integer(QLen) -> + skip("QLen too large: " ++ + integer_to_list(QLen) ++ " > " ++ integer_to_list(Max)); + _ -> + skip("Could not get qlen") + end. + +-define(QLEN, "net.unix.max_dgram_qlen"). +max_dgram_qlen() -> + case string:strip(sysctl(?QLEN), right, $\n) of + "sysctl: " ++ _ -> + %% Key does not exist...skip + skip; + QLenAttrStr -> + case [string:strip(S) || S <- string:tokens(QLenAttrStr, [$=])] of + [?QLEN, Value] -> + ?P("Max DGram QLen: ~p~n", [Value]), + try list_to_integer(Value) of + QLen -> + QLen + catch + _:_:_ -> + skip + end; + _ -> + skip + end + end. + +sysctl(Key) when is_list(Key) -> + os:cmd(?F("~w ~s", [?FUNCTION_NAME, Key])). + is_net_supported() -> try net:info() of #{} -> @@ -3348,6 +3498,18 @@ is_net_supported() -> not_supported(net) end. +-define(UNIX(Flavor), {unix, Flavor}). + +is_linux() -> + is_platform(?UNIX(linux), "Linux"). + +is_platform(Platform, PlatformStr) -> + case os:type() of + Platform -> + ok; + _ -> + skip("Is not " ++ PlatformStr) + end. is_not_darwin() -> is_not_platform(darwin, "Darwin"). @@ -3367,6 +3529,20 @@ is_not_platform(Platform, PlatformStr) end. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +which_label(Config) -> + config_lookup(label, Config). + +config_lookup(Key, Config) -> + case lists:keysearch(Key, 1, Config) of + {value, {Key, Value}} -> + {ok, Value}; + _ -> + {error, not_found} + end. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% not_supported(What) -> diff --git a/lib/kernel/test/kernel_test_lib.erl b/lib/kernel/test/kernel_test_lib.erl index dd5c4979e881..5bd9a7531fa0 100644 --- a/lib/kernel/test/kernel_test_lib.erl +++ b/lib/kernel/test/kernel_test_lib.erl @@ -1752,9 +1752,9 @@ analyze_and_print_solaris_host_info(Version) -> IS -> IS end, - PtrConf = [list_to_tuple([string:trim(S) || S <- Items]) || Items <- [string:tokens(S, [$:]) || S <- string:tokens(os:cmd("prtconf"), [$\n])], length(Items) > 1], + PrtConf = [list_to_tuple([string:trim(S) || S <- Items]) || Items <- [string:tokens(S, [$:]) || S <- string:tokens(os:cmd("prtconf"), [$\n])], length(Items) > 1], SysConf = - case lists:keysearch("System Configuration", 1, PtrConf) of + case lists:keysearch("System Configuration", 1, PrtConf) of {value, {_, SC}} -> SC; _ -> @@ -1792,7 +1792,7 @@ analyze_and_print_solaris_host_info(Version) -> "-" end, MemSz = - case lists:keysearch("Memory size", 1, PtrConf) of + case lists:keysearch("Memory size", 1, PrtConf) of {value, {_, MS}} -> MS; _ ->