File 3032-peer-Add-post-processing-of-peer-args.patch of Package erlang

From c30ca40927aba714d96c591447de7a8fa0afce99 Mon Sep 17 00:00:00 2001
From: Lukas Larsson <lukas@erlang.org>
Date: Wed, 18 May 2022 09:07:32 +0200
Subject: [PATCH 2/4] peer: Add post processing of peer args

If the final arguments into the program that starts the peer
node needs to be quoted somehow it can now be done by providing
a post processing fun. Exmple:

peer:start(#{ exec => {"/bin/sh",["-c","erl"]},
              post_process_args =>
                fun(["-c"|Args]) ->
                  ["-c", lists:join($\s, Args)]
                end }).
---
 lib/stdlib/doc/src/peer.xml    | 14 ++++++++++++++
 lib/stdlib/src/peer.erl        |  9 +++++++--
 lib/stdlib/test/peer_SUITE.erl | 28 ++++++++++++++++++++++++++--
 3 files changed, 47 insertions(+), 4 deletions(-)

diff --git a/lib/stdlib/doc/src/peer.xml b/lib/stdlib/doc/src/peer.xml
index e4a06c75fe..299a2b1df2 100644
--- a/lib/stdlib/doc/src/peer.xml
+++ b/lib/stdlib/doc/src/peer.xml
@@ -313,6 +313,20 @@ build_image(Dir) ->
             <p>Extra command line arguments to append to the "erl" command. Arguments are
               passed as is, no escaping or quoting is needed or accepted.</p>
           </item>
+          <tag><c>post_process_args</c></tag>
+          <item>
+            <p>Allows the user to change the arguments passed to <c>exec</c> before the
+              peer is started. This can for example be useful when the <c>exec</c> program
+              wants the arguments to "erl" as a single argument. Example:
+            </p>
+            <code type="erl">
+peer:start(#{ name => peer:random_name(),
+  exec => {os:find_executable("bash"),["-c","erl"]},
+  post_process_args =>
+     fun(["-c"|Args]) -> ["-c", lists:flatten(lists:join($\s, Args))] end
+  }).
+            </code>
+          </item>
           <tag><c>env</c></tag>
           <item>
             <p>
diff --git a/lib/stdlib/src/peer.erl b/lib/stdlib/src/peer.erl
index dcb6eeeb65..f9eefe3d0f 100644
--- a/lib/stdlib/src/peer.erl
+++ b/lib/stdlib/src/peer.erl
@@ -116,6 +116,8 @@
           connection => connection(),         %% alternative connection specification
           exec => exec(),                     %% path to executable, or SSH/Docker support
           args => [string()],                 %% additional command line parameters to append
+          post_process_args =>
+              fun(([string()]) -> [string()]),%% fix the arguments
           env => [{string(), string()}],      %% additional environment variables
           wait_boot => wait_boot(),           %% default is synchronous start with 15 sec timeout
           shutdown => close |                 %% close supervision channel
@@ -278,14 +280,17 @@ init([Notify, Options]) ->
 
     Env = maps:get(env, Options, []),
 
+    PostProcessArgs = maps:get(post_process_args, Options, fun(As) -> As end),
+    FinalArgs = PostProcessArgs(Args),
+
     %% close port if running detached
     Conn =
         case maps:find(connection, Options)  of
             {ok, standard_io} ->
                 %% Cannot detach a peer that uses stdio. Request exit_status.
-                open_port({spawn_executable, Exec}, [{args, Args}, {env, Env}, hide, binary, exit_status]);
+                open_port({spawn_executable, Exec}, [{args, FinalArgs}, {env, Env}, hide, binary, exit_status]);
             _ ->
-                Port = open_port({spawn_executable, Exec}, [{args, Args}, {env, Env}, hide, binary]),
+                Port = open_port({spawn_executable, Exec}, [{args, FinalArgs}, {env, Env}, hide, binary]),
                 %% peer can close the port before we get here which will cause
                 %%  port_close to throw. Catch this and ignore.
                 catch erlang:port_close(Port),
diff --git a/lib/stdlib/test/peer_SUITE.erl b/lib/stdlib/test/peer_SUITE.erl
index 7c738f6057..2612cac48d 100644
--- a/lib/stdlib/test/peer_SUITE.erl
+++ b/lib/stdlib/test/peer_SUITE.erl
@@ -46,6 +46,7 @@
     old_release/0, old_release/1,
     ssh/0, ssh/1,
     docker/0, docker/1,
+    post_process_args/0, post_process_args/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
 ]).
@@ -64,7 +65,8 @@ alternative() ->
 groups() ->
     [
         {dist, [parallel], [errors, dist, peer_down_crash, peer_down_continue, peer_down_boot,
-                            dist_up_down, dist_localhost, cntrl_channel_handler_crash,
+                            dist_up_down, dist_localhost, post_process_args,
+                            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
                         peer_down_crash_tcp]},
@@ -487,6 +489,29 @@ duplicate_name(Config) when is_list(Config) ->
     ?assertException(exit, _, peer:start_link(#{connection => standard_io, name => ?FUNCTION_NAME})),
     peer:stop(Peer).
 
+post_process_args() ->
+    [{doc, "Test that the post_process_args option works"}].
+
+post_process_args(Config) when is_list(Config) ->
+    case {os:type(),os:find_executable("bash")} of
+        {{win32,_}, _Bash} ->
+            {skip,"Test does not work on windows"};
+        {_, false} ->
+            {skip,"Test needs bash to run"};
+        {_, Bash} ->
+            Erl = string:split(ct:get_progname()," ",all),
+            [throw({skip, "Needs bash to run"}) || Bash =:= false],
+            {ok, Peer, _Node} =
+                peer:start_link(
+                  #{ name => ?CT_PEER_NAME(),
+                     exec => {Bash,["-c"|Erl]},
+                     post_process_args =>
+                         fun(["-c"|Args]) ->
+                                 ["-c", lists:flatten(lists:join($\s, Args))]
+                         end }),
+            peer:stop(Peer)
+    end.
+
 %% -------------------------------------------------------------------
 %% Compatibility: old releases
 old_release() ->
-- 
2.35.3

openSUSE Build Service is sponsored by