File 5123-ssh-Rename-option-map-key-user_options-to-key_cb_opt.patch of Package erlang

From 5dfb0741f11df1b8210f7efccfa37d92f3116aac Mon Sep 17 00:00:00 2001
From: Hans Nilsson <hans@erlang.org>
Date: Wed, 18 Nov 2020 13:49:56 +0100
Subject: [PATCH 3/3] ssh: Rename option map key user_options to key_cb_options

to avoid missunderstanding due to mix up with the option CLASS user_options
---
 lib/ssh/src/ssh_options.erl   | 12 ++++++------
 lib/ssh/src/ssh_transport.erl |  2 +-
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl
index 361c25f2fc..2135afece4 100644
--- a/lib/ssh/src/ssh_options.erl
+++ b/lib/ssh/src/ssh_options.erl
@@ -161,13 +161,13 @@ delete_key(internal_options, Key, Opts, _CallerMod, _CallerLine) when is_map(Opt
 handle_options(Role, PropList0) ->
     handle_options(Role, PropList0, #{socket_options   => [],
                                       internal_options => #{},
-                                      user_options     => []
+                                      key_cb_options   => []
                                      }).
 
 handle_options(Role, OptsList0, Opts0) when is_map(Opts0),
                          is_list(OptsList0) ->
     OptsList1 = proplists:unfold(
-                  lists:foldl(fun(T,Acc) when is_tuple(T),
+                  lists:foldr(fun(T,Acc) when is_tuple(T),
                                               size(T) =/= 2-> [{special_trpt_args,T} | Acc];
                                  (X,Acc) -> [X|Acc]
                               end,
@@ -187,7 +187,7 @@ handle_options(Role, OptsList0, Opts0) when is_map(Opts0),
                           {ok,V1} ->
                               %% A value set in config or options. Replace the current.
                               {M#{K => V1,
-                                  user_options => [{K,V1} | maps:get(user_options,M)]},
+                                  key_cb_options => [{K,V1} | maps:get(key_cb_options,M)]},
                                [{K,V1} | PL]
                               };
 
@@ -196,8 +196,8 @@ handle_options(Role, OptsList0, Opts0) when is_map(Opts0),
                               %% appended to the existing value
                               NewVal = maps:get(K,M,[]) ++ V1,
                               {M#{K => NewVal,
-                                  user_options => [{K,NewVal} |
-                                                   lists:keydelete(K,1,maps:get(user_options,M))]},
+                                  key_cb_options => [{K,NewVal} |
+                                                     lists:keydelete(K,1,maps:get(key_cb_options,M))]},
                                [{K,NewVal} | lists:keydelete(K,1,PL)]
                               };
                               
@@ -209,7 +209,7 @@ handle_options(Role, OptsList0, Opts0) when is_map(Opts0),
                  %% (_,_,Acc) ->
                  %%      Acc
               end,
-              {Opts0#{user_options => maps:get(user_options,Opts0)},
+              {Opts0#{key_cb_options => maps:get(key_cb_options,Opts0)},
                [{K,V} || {K,V} <- OptsList1,
                          not maps:is_key(K,Opts0) % Keep socket opts
                ]
diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl
index 8147f17e05..813d5ad350 100644
--- a/lib/ssh/src/ssh_transport.erl
+++ b/lib/ssh/src/ssh_transport.erl
@@ -839,7 +839,7 @@ get_host_key(SignAlg, Opts) ->
 
 call_KeyCb(F, Args, Opts) ->
     {KeyCb,KeyCbOpts} = ?GET_OPT(key_cb, Opts),
-    UserOpts = ?GET_OPT(user_options, Opts),
+    UserOpts = ?GET_OPT(key_cb_options, Opts),
     apply(KeyCb, F, Args ++ [[{key_cb_private,KeyCbOpts}|UserOpts]]).
 
 extract_public_key(#'RSAPrivateKey'{modulus = N, publicExponent = E}) ->
-- 
2.26.2

openSUSE Build Service is sponsored by