aboutsummaryrefslogtreecommitdiffstats
path: root/lib/ssh/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/ssh/src')
-rw-r--r--lib/ssh/src/ssh_options.erl270
-rw-r--r--lib/ssh/src/ssh_transport.erl19
2 files changed, 214 insertions, 75 deletions
diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl
index b41ad8b33b..d8931da774 100644
--- a/lib/ssh/src/ssh_options.erl
+++ b/lib/ssh/src/ssh_options.erl
@@ -170,9 +170,10 @@ handle_options(Role, PropList0, Opts0) when is_map(Opts0),
OptionDefinitions),
%% Enter the user's values into the map; unknown keys are
%% treated as socket options
- lists:foldl(fun(KV, Vals) ->
- save(KV, OptionDefinitions, Vals)
- end, InitialMap, PropList1)
+ final_preferred_algorithms(
+ lists:foldl(fun(KV, Vals) ->
+ save(KV, OptionDefinitions, Vals)
+ end, InitialMap, PropList1))
catch
error:{eoptions, KV, undefined} ->
{error, {eoptions,KV}};
@@ -509,6 +510,15 @@ default(common) ->
class => user_options
},
+ %% NOTE: This option is supposed to be used only in this very module (?MODULE). There is
+ %% a final stage in handle_options that "merges" the preferred_algorithms option and this one.
+ %% The preferred_algorithms is the one to use in the rest of the ssh application!
+ {modify_algorithms, def} =>
+ #{default => undefined, % signals error if unsupported algo in preferred_algorithms :(
+ chk => fun check_modify_algorithms/1,
+ class => user_options
+ },
+
{id_string, def} =>
#{default => undefined, % FIXME: see ssh_transport:ssh_vsn/0
chk => fun(random) ->
@@ -820,83 +830,193 @@ valid_hash(L, Ss) when is_list(L) -> lists:all(fun(S) -> valid_hash(S,Ss) end, L
valid_hash(X, _) -> error_in_check(X, "Expect atom or list in fingerprint spec").
%%%----------------------------------------------------------------
-check_preferred_algorithms(Algs) ->
- [error_in_check(K,"Bad preferred_algorithms key")
- || {K,_} <- Algs,
- not lists:keymember(K,1,ssh:default_algorithms())],
+check_modify_algorithms(M) when is_list(M) ->
+ [error_in_check(Op_KVs, "Bad modify_algorithms")
+ || Op_KVs <- M,
+ not is_tuple(Op_KVs)
+ orelse (size(Op_KVs) =/= 2)
+ orelse (not lists:member(element(1,Op_KVs), [append,prepend,rm]))],
+ {true, [{Op,normalize_mod_algs(KVs,false)} || {Op,KVs} <- M]};
+check_modify_algorithms(_) ->
+ error_in_check(modify_algorithms, "Bad option value. List expected.").
+
+
+
+
+normalize_mod_algs(KVs, UseDefaultAlgs) ->
+ normalize_mod_algs(ssh_transport:algo_classes(), KVs, [], UseDefaultAlgs).
+
+normalize_mod_algs([K|Ks], KVs0, Acc, UseDefaultAlgs) ->
+ %% Pick the expected keys in order and check if they are in the user's list
+ {Vs1, KVs} =
+ case lists:keytake(K, 1, KVs0) of
+ {value, {K,Vs0}, KVs1} ->
+ {Vs0, KVs1};
+ false ->
+ {[], KVs0}
+ end,
+ Vs = normalize_mod_alg_list(K, Vs1, UseDefaultAlgs),
+ normalize_mod_algs(Ks, KVs, [{K,Vs} | Acc], UseDefaultAlgs);
+normalize_mod_algs([], [], Acc, _) ->
+ %% No values left in the key-value list after removing the expected entries
+ %% (thats good)
+ lists:reverse(Acc);
+normalize_mod_algs([], [{K,_}|_], _, _) ->
+ %% Some values left in the key-value list after removing the expected entries
+ %% (thats bad)
+ case ssh_transport:algo_class(K) of
+ true -> error_in_check(K, "Duplicate key");
+ false -> error_in_check(K, "Unknown key")
+ end;
+normalize_mod_algs([], [X|_], _, _) ->
+ error_in_check(X, "Bad list element").
+
+
+
+%%% Handle the algorithms list
+normalize_mod_alg_list(K, Vs, UseDefaultAlgs) ->
+ normalize_mod_alg_list(K,
+ ssh_transport:algo_two_spec_class(K),
+ Vs,
+ def_alg(K,UseDefaultAlgs)).
+
+
+normalize_mod_alg_list(_K, _, [], Default) ->
+ Default;
+
+normalize_mod_alg_list(K, true, [{client2server,L1}], [_,{server2client,L2}]) ->
+ [nml1(K,{client2server,L1}),
+ {server2client,L2}];
+
+normalize_mod_alg_list(K, true, [{server2client,L2}], [{client2server,L1},_]) ->
+ [{client2server,L1},
+ nml1(K,{server2client,L2})];
+
+normalize_mod_alg_list(K, true, [{server2client,L2},{client2server,L1}], _) ->
+ [nml1(K,{client2server,L1}),
+ nml1(K,{server2client,L2})];
+
+normalize_mod_alg_list(K, true, [{client2server,L1},{server2client,L2}], _) ->
+ [nml1(K,{client2server,L1}),
+ nml1(K,{server2client,L2})];
+
+normalize_mod_alg_list(K, true, L0, _) ->
+ L = nml(K,L0), % Throws errors
+ [{client2server,L},
+ {server2client,L}];
+
+normalize_mod_alg_list(K, false, L, _) ->
+ nml(K,L).
+
+
+nml1(K, {T,V}) when T==client2server ; T==server2client ->
+ {T, nml({K,T}, V)}.
+
+nml(K, L) ->
+ [error_in_check(K, "Bad value for this key") % This is a throw
+ || V <- L,
+ not is_atom(V)
+ ],
+ case L -- lists:usort(L) of
+ [] -> ok;
+ Dups -> error_in_check({K,Dups}, "Duplicates") % This is a throw
+ end,
+ L.
- try alg_duplicates(Algs, [], [])
- of
- [] ->
- {true,
- [case proplists:get_value(Key, Algs) of
- undefined ->
- {Key,DefAlgs};
- Vals ->
- handle_pref_alg(Key,Vals,SupAlgs)
- end
- || {{Key,DefAlgs}, {Key,SupAlgs}} <- lists:zip(ssh:default_algorithms(),
- ssh_transport:supported_algorithms())
- ]
- };
-
- Dups ->
- error_in_check(Dups, "Duplicates")
- catch
- _:_ ->
- false
- end.
-alg_duplicates([{K,V}|KVs], Ks, Dups0) ->
- Dups =
- case lists:member(K,Ks) of
- true -> [K|Dups0];
- false -> Dups0
- end,
- case V--lists:usort(V) of
- [] -> alg_duplicates(KVs, [K|Ks], Dups);
- Ds -> alg_duplicates(KVs, [K|Ks], Dups++Ds)
+def_alg(K, false) ->
+ case ssh_transport:algo_two_spec_class(K) of
+ false -> [];
+ true -> [{client2server,[]}, {server2client,[]}]
end;
-alg_duplicates([], _Ks, Dups) ->
- Dups.
-
-handle_pref_alg(Key,
- Vs=[{client2server,C2Ss=[_|_]},{server2client,S2Cs=[_|_]}],
- [{client2server,Sup_C2Ss},{server2client,Sup_S2Cs}]
- ) ->
- chk_alg_vs(Key, C2Ss, Sup_C2Ss),
- chk_alg_vs(Key, S2Cs, Sup_S2Cs),
- {Key, Vs};
-
-handle_pref_alg(Key,
- Vs=[{server2client,[_|_]},{client2server,[_|_]}],
- Sup=[{client2server,_},{server2client,_}]
- ) ->
- handle_pref_alg(Key, lists:reverse(Vs), Sup);
-
-handle_pref_alg(Key,
- Vs=[V|_],
- Sup=[{client2server,_},{server2client,_}]
- ) when is_atom(V) ->
- handle_pref_alg(Key, [{client2server,Vs},{server2client,Vs}], Sup);
-
-handle_pref_alg(Key,
- Vs=[V|_],
- Sup=[S|_]
- ) when is_atom(V), is_atom(S) ->
- chk_alg_vs(Key, Vs, Sup),
- {Key, Vs};
-
-handle_pref_alg(Key, Vs, _) ->
- error_in_check({Key,Vs}, "Badly formed list").
-
-chk_alg_vs(OptKey, Values, SupportedValues) ->
- case (Values -- SupportedValues) of
- [] -> Values;
- [none] -> [none]; % for testing only
- Bad -> error_in_check({OptKey,Bad}, "Unsupported value(s) found")
+def_alg(K, true) ->
+ ssh_transport:default_algorithms(K).
+
+
+
+check_preferred_algorithms(Algs) when is_list(Algs) ->
+ check_input_ok(Algs),
+ {true, normalize_mod_algs(Algs, true)};
+
+check_preferred_algorithms(Algs) when is_list(Algs) ->
+ check_preferred_algorithms({false,Algs});
+
+check_preferred_algorithms(_) ->
+ error_in_check(modify_algorithms, "Bad option value. List expected.").
+
+
+check_input_ok(Algs) ->
+ [error_in_check(KVs, "Bad preferred_algorithms")
+ || KVs <- Algs,
+ not is_tuple(KVs)
+ orelse (size(KVs) =/= 2)].
+
+%%%----------------------------------------------------------------
+final_preferred_algorithms(Options) ->
+ Result =
+ case ?GET_OPT(modify_algorithms, Options) of
+ undefined ->
+ rm_non_supported(true,
+ ?GET_OPT(preferred_algorithms, Options));
+ ModAlgs ->
+ rm_non_supported(false,
+ eval_ops(?GET_OPT(preferred_algorithms, Options),
+ ModAlgs))
+ end,
+ error_if_empty(Result), % Throws errors if any value list is empty
+ ?PUT_OPT({preferred_algorithms,Result}, Options).
+
+eval_ops(PrefAlgs, ModAlgs) ->
+ lists:foldl(fun eval_op/2, PrefAlgs, ModAlgs).
+
+eval_op({Op,AlgKVs}, PrefAlgs) ->
+ eval_op(Op, AlgKVs, PrefAlgs, []).
+
+eval_op(Op, [{C,L1}|T1], [{C,L2}|T2], Acc) ->
+ eval_op(Op, T1, T2, [{C,eval_op(Op,L1,L2,[])} | Acc]);
+
+eval_op(_, [], [], Acc) -> lists:reverse(Acc);
+eval_op(rm, Opt, Pref, []) when is_list(Opt), is_list(Pref) -> Pref -- Opt;
+eval_op(append, Opt, Pref, []) when is_list(Opt), is_list(Pref) -> (Pref--Opt) ++ Opt;
+eval_op(prepend, Opt, Pref, []) when is_list(Opt), is_list(Pref) -> Opt ++ (Pref--Opt).
+
+
+rm_non_supported(UnsupIsErrorFlg, KVs) ->
+ [{K,rmns(K,Vs, UnsupIsErrorFlg)} || {K,Vs} <- KVs].
+
+rmns(K, Vs, UnsupIsErrorFlg) ->
+ case ssh_transport:algo_two_spec_class(K) of
+ false ->
+ rm_unsup(Vs, ssh_transport:supported_algorithms(K), UnsupIsErrorFlg, K);
+ true ->
+ [{C, rm_unsup(Vsx, Sup, UnsupIsErrorFlg, {K,C})}
+ || {{C,Vsx},{C,Sup}} <- lists:zip(Vs,ssh_transport:supported_algorithms(K))
+ ]
end.
+rm_unsup(A, B, Flg, ErrInf) ->
+ case A--B of
+ Unsup=[_|_] when Flg==true -> error({eoptions,
+ {preferred_algorithms,{ErrInf,Unsup}},
+ "Unsupported value(s) found"
+ });
+ Unsup -> A -- Unsup
+ end.
+
+
+error_if_empty([{K,[]}|_]) ->
+ error({eoptions, K, "Empty resulting algorithm list"});
+error_if_empty([{K,[{client2server,[]}, {server2client,[]}]}]) ->
+ error({eoptions, K, "Empty resulting algorithm list"});
+error_if_empty([{K,[{client2server,[]}|_]} | _]) ->
+ error({eoptions, {K,client2server}, "Empty resulting algorithm list"});
+error_if_empty([{K,[_,{server2client,[]}|_]} | _]) ->
+ error({eoptions, {K,server2client}, "Empty resulting algorithm list"});
+error_if_empty([_|T]) ->
+ error_if_empty(T);
+error_if_empty([]) ->
+ ok.
+
%%%----------------------------------------------------------------
forbidden_option(K,V) ->
Txt = io_lib:format("The option '~s' is used internally. The "
diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl
index 412f5de9de..c48c0800e4 100644
--- a/lib/ssh/src/ssh_transport.erl
+++ b/lib/ssh/src/ssh_transport.erl
@@ -34,6 +34,8 @@
-export([next_seqnum/1,
supported_algorithms/0, supported_algorithms/1,
default_algorithms/0, default_algorithms/1,
+ algo_classes/0, algo_class/1,
+ algo_two_spec_classes/0, algo_two_spec_class/1,
handle_packet_part/4,
handle_hello_version/1,
key_exchange_init_msg/1,
@@ -81,6 +83,23 @@ default_algorithms() -> [{K,default_algorithms(K)} || K <- algo_classes()].
algo_classes() -> [kex, public_key, cipher, mac, compression].
+algo_class(kex) -> true;
+algo_class(public_key) -> true;
+algo_class(cipher) -> true;
+algo_class(mac) -> true;
+algo_class(compression) -> true;
+algo_class(_) -> false.
+
+
+algo_two_spec_classes() -> [cipher, mac, compression].
+
+algo_two_spec_class(cipher) -> true;
+algo_two_spec_class(mac) -> true;
+algo_two_spec_class(compression) -> true;
+algo_two_spec_class(_) -> false.
+
+
+
default_algorithms(kex) ->
supported_algorithms(kex, [
'diffie-hellman-group1-sha1' % Gone in OpenSSH 7.3.p1