File 3033-peer-Allow-peers-to-stay-attached-and-use-tty.patch of Package erlang
From 7f7eac7f92b15f2fb570fe62ce891b6fe75f81cc Mon Sep 17 00:00:00 2001
From: Lukas Larsson <lukas@erlang.org>
Date: Sun, 15 May 2022 22:51:29 +0200
Subject: [PATCH 3/4] peer: Allow peers to stay attached and use tty
---
erts/etc/common/erlexec.c | 13 ++++----
lib/kernel/src/user_sup.erl | 7 ++--
lib/stdlib/doc/src/peer.xml | 7 ++++
lib/stdlib/src/peer.erl | 58 ++++++++++++++++++++++++++--------
lib/stdlib/test/peer_SUITE.erl | 36 +++++++++++++++++++--
5 files changed, 94 insertions(+), 27 deletions(-)
diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c
index 9c3dc690ba..b1e2118b7a 100644
--- a/erts/etc/common/erlexec.c
+++ b/erts/etc/common/erlexec.c
@@ -650,13 +650,12 @@ int main(int argc, char **argv)
break;
case 'd':
- if (strcmp(argv[i], "-detached") != 0) {
- add_arg(argv[i]);
- } else {
- start_detached = 1;
- add_args("-noshell", "-noinput", NULL);
- }
- break;
+ add_arg(argv[i]);
+ if (strcmp(argv[i], "-detached") == 0) {
+ start_detached = 1;
+ add_args("-noshell", "-noinput", NULL);
+ }
+ break;
case 'e':
if (strcmp(argv[i], "-extra") == 0) {
diff --git a/lib/kernel/src/user_sup.erl b/lib/kernel/src/user_sup.erl
index c1fb1b1a48..6206a8d0ab 100644
--- a/lib/kernel/src/user_sup.erl
+++ b/lib/kernel/src/user_sup.erl
@@ -39,7 +39,9 @@ start() ->
-spec init([]) -> 'ignore' | {'error', 'nouser'} | {'ok', pid(), pid()}.
init([]) ->
- case get_user() of
+ init(init:get_arguments());
+init(Flags) ->
+ case get_user(Flags) of
nouser ->
ignore;
{master, Master} ->
@@ -112,8 +114,7 @@ wait_for_user_p(N) ->
wait_for_user_p(N-1)
end.
-get_user() ->
- Flags = init:get_arguments(),
+get_user(Flags) ->
check_flags(Flags, {user_drv, start, []}).
%% These flags depend upon what arguments the erl script passes on
diff --git a/lib/stdlib/doc/src/peer.xml b/lib/stdlib/doc/src/peer.xml
index 299a2b1df2..71bf71e75e 100644
--- a/lib/stdlib/doc/src/peer.xml
+++ b/lib/stdlib/doc/src/peer.xml
@@ -308,6 +308,13 @@ build_image(Dir) ->
default bash.
</p>
</item>
+ <tag><c>detached</c></tag>
+ <item>
+ <p>Defines whether to pass the <c>-detached</c> flag to the started peer.
+ This option cannot be set to <c>false</c> using the standard_io alternative
+ connection type. Default is <c>true</c>.
+ </p>
+ </item>
<tag><c>args</c></tag>
<item>
<p>Extra command line arguments to append to the "erl" command. Arguments are
diff --git a/lib/stdlib/src/peer.erl b/lib/stdlib/src/peer.erl
index f9eefe3d0f..fa2cf53f23 100644
--- a/lib/stdlib/src/peer.erl
+++ b/lib/stdlib/src/peer.erl
@@ -115,6 +115,7 @@
%% terminates with underlying reason
connection => connection(), %% alternative connection specification
exec => exec(), %% path to executable, or SSH/Docker support
+ detached => boolean(), %% if the node should be start in detached mode
args => [string()], %% additional command line parameters to append
post_process_args =>
fun(([string()]) -> [string()]),%% fix the arguments
@@ -571,8 +572,13 @@ verify_args(Options) ->
ok;
{ok, Err2} ->
error({shutdown, Err2})
+ end,
+ case maps:find(detached, Options) of
+ {ok, false} when map_get(connection, Options) =:= standard_io ->
+ error({detached, cannot_detach_with_standard_io});
+ _ ->
+ ok
end.
-
make_notify_ref(infinity) ->
{self(), make_ref()};
@@ -788,6 +794,14 @@ command_line(Listen, Options) ->
NameArg = name_arg(maps:find(name, Options), maps:find(host, Options), maps:find(longnames, Options)),
%% additional command line args
CmdOpts = maps:get(args, Options, []),
+
+ %% If we should detach from the node. We use -detached to tell erl to detach
+ %% and -peer_detached to tell peer:start that we are detached.
+ DetachArgs = case maps:get(detached, Options, true) of
+ true -> ["-detached","-peer_detached"];
+ false -> []
+ end,
+
%% start command
StartCmd =
case Listen of
@@ -795,14 +809,14 @@ command_line(Listen, Options) ->
["-user", atom_to_list(?MODULE)];
undefined ->
Self = base64:encode_to_string(term_to_binary(self())),
- ["-detached", "-noinput", "-user", atom_to_list(?MODULE), "-origin", Self];
+ DetachArgs ++ ["-user", atom_to_list(?MODULE), "-origin", Self];
{Ips, Port} ->
IpStr = lists:concat(lists:join(",", [inet:ntoa(Ip) || Ip <- Ips])),
- ["-detached", "-noinput", "-user", atom_to_list(?MODULE), "-origin", IpStr, integer_to_list(Port)]
+ DetachArgs ++ ["-user", atom_to_list(?MODULE), "-origin", IpStr, integer_to_list(Port)]
end,
%% build command line
{Exec, PreArgs} = exec(Options),
- {Exec, PreArgs ++ NameArg ++ StartCmd ++ CmdOpts}.
+ {Exec, PreArgs ++ NameArg ++ CmdOpts ++ StartCmd}.
exec(#{exec := Prog}) when is_list(Prog) ->
{Prog, []};
@@ -1022,23 +1022,41 @@ start_peer_channel_handler() ->
{ok, [[IpStr, PortString]]} ->
%% enter this clause when -origin IpList Port is specified in the command line.
Port = list_to_integer(PortString),
- Ips = [begin {ok, Addr} = inet:parse_address(Ip), Addr end || Ip <- string:lexemes(IpStr, ",")],
- spawn(fun () -> tcp_init(Ips, Port) end);
+ Ips = [begin {ok, Addr} = inet:parse_address(Ip), Addr end ||
+ Ip <- string:lexemes(IpStr, ",")],
+ TCPConnection = spawn(fun () -> tcp_init(Ips, Port) end),
+ case init:get_argument(peer_detached) of
+ {ok, _} ->
+ register(user, TCPConnection),
+ TCPConnection;
+ error ->
+ user_sup:init(
+ [Flag || Flag <- init:get_arguments(), Flag =/= {user,["peer"]}])
+ end;
{ok, [[Base64EncProc]]} ->
%% No alternative connection, but have "-origin Base64EncProc"
OriginProcess = binary_to_term(base64:decode(Base64EncProc)),
- %% setup 'user' process, I/O redirection: ask controlling process
- %% who is the group leader.
- GroupLeader = gen_server:call(OriginProcess, group_leader),
- RelayPid = spawn(fun () -> relay(GroupLeader) end),
- register(user, RelayPid),
spawn(
fun () ->
- link(RelayPid),
MRef = monitor(process, OriginProcess),
notify_when_started(dist, OriginProcess),
origin_link(MRef, OriginProcess)
- end);
+ end),
+ case init:get_argument(peer_detached) of
+ {ok, _} ->
+ %% We are detached, so setup 'user' process, I/O redirection:
+ %% ask controlling process who is the group leader.
+ GroupLeader = gen_server:call(OriginProcess, group_leader),
+ RelayPid = spawn(fun () -> relay(GroupLeader) end),
+ register(user, RelayPid),
+ %% return RelayPid for user_sup to link to
+ RelayPid;
+ error ->
+ %% We are not detached, so after we spawn the link process we
+ %% start the terminal as normal but without the -user peer flag.
+ user_sup:init(
+ [Flag || Flag <- init:get_arguments(), Flag =/= {user,["peer"]}])
+ end;
error ->
%% no -origin specified, meaning that standard I/O is used for alternative
spawn(fun io_server/0)
@@ -949,7 +980,6 @@ io_server() ->
tcp_init(IpList, Port) ->
try
Sock = loop_connect(IpList, Port),
- register(user, self()),
erlang:group_leader(self(), self()),
notify_when_started(tcp, Sock),
io_server_loop(tcp, Sock, #{}, #{}, undefined)
diff --git a/lib/stdlib/test/peer_SUITE.erl b/lib/stdlib/test/peer_SUITE.erl
index 2612cac48d..5de72cea4f 100644
--- a/lib/stdlib/test/peer_SUITE.erl
+++ b/lib/stdlib/test/peer_SUITE.erl
@@ -47,6 +47,7 @@
ssh/0, ssh/1,
docker/0, docker/1,
post_process_args/0, post_process_args/1,
+ attached/0, attached/1,
cntrl_channel_handler_crash/0, cntrl_channel_handler_crash/1,
cntrl_channel_handler_crash_old_release/0, cntrl_channel_handler_crash_old_release/1
]).
@@ -59,13 +60,13 @@ shutdown_alternatives() ->
alternative() ->
[basic, peer_states, cast, detached, dyn_peer, stop_peer,
- io_redirect, multi_node, duplicate_name, cntrl_channel_handler_crash,
- cntrl_channel_handler_crash_old_release | shutdown_alternatives()].
+ io_redirect, multi_node, duplicate_name, attached,
+ cntrl_channel_handler_crash, cntrl_channel_handler_crash_old_release | shutdown_alternatives()].
groups() ->
[
{dist, [parallel], [errors, dist, peer_down_crash, peer_down_continue, peer_down_boot,
- dist_up_down, dist_localhost, post_process_args,
+ dist_up_down, dist_localhost, post_process_args, attached,
cntrl_channel_handler_crash,
cntrl_channel_handler_crash_old_release | shutdown_alternatives()]},
{dist_seq, [], [dist_io_redirect, %% Cannot be run in parallel in dist group
@@ -593,6 +594,35 @@ docker(Config) when is_list(Config) ->
peer:stop(Peer)
end.
+attached() ->
+ [{doc, "Test that it is possible to start a peer node using run_erl aka attached"}].
+
+attached(Config) ->
+ RunErl = os:find_executable("run_erl"),
+ [throw({skip, "Could not find run_erl"}) || RunErl =:= false],
+ Erl = string:split(ct:get_progname()," ",all),
+ RunErlDir = filename:join(proplists:get_value(priv_dir, Config),?FUNCTION_NAME),
+ filelib:ensure_path(RunErlDir),
+ Connection = proplists:get_value(connection, Config),
+ Conn = if Connection =:= undefined -> #{ name => ?CT_PEER_NAME() };
+ true -> #{ connection => Connection }
+ end,
+ try peer:start(
+ Conn#{
+ exec => {RunErl, Erl},
+ detached => false,
+ post_process_args =>
+ fun(Args) ->
+ [RunErlDir ++ "/", RunErlDir,
+ lists:flatten(lists:join(" ",[[$',A,$'] || A <- Args]))]
+ end
+ }) of
+ {ok, Peer, _Node} when Connection =:= undefined; Connection =:= 0 ->
+ peer:stop(Peer)
+ catch error:{detached,_} when Connection =:= standard_io ->
+ ok
+ end.
+
cntrl_channel_handler_crash() ->
[{doc, "Test that peer node is halted if peer control channel handler process crashes"}].
--
2.35.3
