File 5241-erts-Unwrap-supervised-shutdown-reasons-for-distr-co.patch of Package erlang

From add7bfb90cbebdefdd51ba3d4a207a66d7199db1 Mon Sep 17 00:00:00 2001
From: Sverker Eriksson <sverker@erlang.org>
Date: Wed, 23 Feb 2022 19:42:05 +0100
Subject: [PATCH] erts: Unwrap supervised shutdown reasons for distr controller

---
 erts/emulator/beam/atom.names   |  1 +
 erts/emulator/beam/dist.c       | 13 ++++++++++
 lib/ssl/test/ssl_dist_SUITE.erl | 43 +++++++++++++++++++++++++++++++++
 3 files changed, 57 insertions(+)

diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index b9022689ba..49062e97a8 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -637,6 +637,7 @@ atom set_on_spawn
 atom set_tcw
 atom set_tcw_fake
 atom short
+atom shutdown
 atom sighup
 atom sigterm
 atom sigusr1
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index bea5f060a8..1287c6616a 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -965,6 +965,19 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason)
             if (erts_port_task_is_scheduled(&dep->dist_cmd))
                 erts_port_task_abort(&dep->dist_cmd);
         }
+        else {
+            ASSERT(is_internal_pid(dep->cid));
+            /*
+             * Supervised distribution controllers may exit "normally" with
+             * {shutdown,Reason}. Unwrap such shutdown tuple to get a correct
+             * documented 'nodedown_reason' from net_kernel:montitor_nodes.
+             */
+            if (is_tuple_arity(reason, 2)) {
+                Eterm* tpl = tuple_val(reason);
+                if (tpl[1] == am_shutdown)
+                    reason = tpl[2];
+            }
+        }
 
 	if (dep->state == ERTS_DE_STATE_EXITING) {
 	    ASSERT(erts_atomic32_read_nob(&dep->qflgs) & ERTS_DE_QFLG_EXIT);
diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl
index 493a19b4fa..4439b63bae 100644
--- a/lib/ssl/test/ssl_dist_SUITE.erl
+++ b/lib/ssl/test/ssl_dist_SUITE.erl
@@ -37,6 +37,7 @@
 %% Test cases
 -export([basic/0,
          basic/1,
+         monitor_nodes/1,
          payload/0,
          payload/1,
          dist_port_overload/0,
@@ -65,6 +66,7 @@
 
 %% Apply export
 -export([basic_test/3,
+         monitor_nodes_test/3,
          payload_test/3,
          plain_options_test/3,
          plain_verify_options_test/3,
@@ -100,6 +102,7 @@ start_ssl_node_name(Name, Args) ->
 %%--------------------------------------------------------------------
 all() ->
     [basic,
+     monitor_nodes,
      payload,
      dist_port_overload,
      plain_options,
@@ -170,6 +173,11 @@ basic() ->
 basic(Config) when is_list(Config) ->
     gen_dist_test(basic_test, Config).
 
+%%--------------------------------------------------------------------
+%% Test net_kernel:monitor_nodes with nodedown_reason (OTP-17838)
+monitor_nodes(Config) when is_list(Config) ->
+    gen_dist_test(monitor_nodes_test, Config).
+
 %%--------------------------------------------------------------------
 payload() ->
     [{doc,"Test that send a lot of data between the ssl distributed nodes"}].
@@ -530,6 +538,41 @@ basic_test(NH1, NH2, _) ->
 		    end)
      end.
 
+monitor_nodes_test(NH1, NH2, _) ->
+    Node2 = NH2#node_handle.nodename,
+
+    Ref = make_ref(),
+    MonitorNodesFun =
+        fun() ->
+                tstsrvr_format("Hi from ~p!~n", [node()]),
+                ok = net_kernel:monitor_nodes(true, [nodedown_reason]),
+                send_to_tstcntrl({self(), ready, Ref}),
+                NodeUp = receive_any(),
+                send_to_tstcntrl({self(), got, NodeUp}),
+                NodeDown = receive_any(),
+                send_to_tstcntrl({self(), got, NodeDown}),
+                ok = net_kernel:monitor_nodes(false, [nodedown_reason])
+        end,
+    spawn_link(fun () ->
+                       ok = apply_on_ssl_node(NH1, MonitorNodesFun)
+               end),
+    {SslPid, ready, Ref} = receive_any(),
+
+    %% Setup connection and expect 'nodeup'
+    pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end),
+    {SslPid, got, {nodeup, Node2, []}} = receive_any(),
+
+    %% Disconnect and expect 'nodedown' with correct reason
+    true = apply_on_ssl_node(NH1, fun () ->
+                                          net_kernel:disconnect(Node2)
+                                  end),
+    {SslPid, got, {nodedown, Node2, [{nodedown_reason, disconnect}]}} = receive_any(),
+    ok.
+
+
+receive_any() ->
+    receive M -> M end.
+
 payload_test(NH1, NH2, _) ->
     Node1 = NH1#node_handle.nodename,
     Node2 = NH2#node_handle.nodename,
-- 
2.34.1