diff --git a/CVE-2025-46712-1.patch b/CVE-2025-46712-1.patch new file mode 100644 index 0000000..55cad79 --- /dev/null +++ b/CVE-2025-46712-1.patch @@ -0,0 +1,623 @@ +From e4b56a9f4a511aa9990dd86c16c61439c828df83 Mon Sep 17 00:00:00 2001 +From: Jakub Witczak +Date: Tue, 6 May 2025 17:01:29 +0200 +Subject: [PATCH] ssh: KEX strict implementation fixes + +- fixed KEX strict implementation +- draft-miller-sshm-strict-kex-01.txt +- ssh_dbg added to ssh_fsm_kexinit module +- CVE-2025-46712 +--- + lib/ssh/src/ssh_connection_handler.erl | 24 ++-- + lib/ssh/src/ssh_fsm_kexinit.erl | 129 ++++++++++++++++++-- + lib/ssh/src/ssh_transport.erl | 13 +- + lib/ssh/test/ssh_protocol_SUITE.erl | 158 ++++++++++++++++++++++--- + lib/ssh/test/ssh_trpt_test_lib.erl | 39 +++++- + 5 files changed, 313 insertions(+), 50 deletions(-) + +diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl +index 5ddafa997567..15f98dfb5c31 100644 +--- a/lib/ssh/src/ssh_connection_handler.erl ++++ b/lib/ssh/src/ssh_connection_handler.erl +@@ -34,7 +34,6 @@ + -include("ssh_transport.hrl"). + -include("ssh_auth.hrl"). + -include("ssh_connect.hrl"). +- + -include("ssh_fsm.hrl"). + + %%==================================================================== +@@ -728,16 +727,6 @@ handle_event(internal, #ssh_msg_disconnect{description=Desc} = Msg, StateName, D + disconnect_fun("Received disconnect: "++Desc, D), + {stop_and_reply, {shutdown,Desc}, Actions, D}; + +-handle_event(internal, #ssh_msg_ignore{}, {_StateName, _Role, init}, +- #data{ssh_params = #ssh{kex_strict_negotiated = true, +- send_sequence = SendSeq, +- recv_sequence = RecvSeq}}) -> +- ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, +- io_lib:format("strict KEX violation: unexpected SSH_MSG_IGNORE " +- "send_sequence = ~p recv_sequence = ~p", +- [SendSeq, RecvSeq]) +- ); +- + handle_event(internal, #ssh_msg_ignore{}, _StateName, _) -> + keep_state_and_data; + +@@ -1141,11 +1130,14 @@ handle_event(info, {Proto, Sock, NewData}, StateName, + of + {packet_decrypted, DecryptedBytes, EncryptedDataRest, Ssh1} -> + D1 = D0#data{ssh_params = +- Ssh1#ssh{recv_sequence = ssh_transport:next_seqnum(Ssh1#ssh.recv_sequence)}, +- decrypted_data_buffer = <<>>, +- undecrypted_packet_length = undefined, +- aead_data = <<>>, +- encrypted_data_buffer = EncryptedDataRest}, ++ Ssh1#ssh{recv_sequence = ++ ssh_transport:next_seqnum(StateName, ++ Ssh1#ssh.recv_sequence, ++ SshParams)}, ++ decrypted_data_buffer = <<>>, ++ undecrypted_packet_length = undefined, ++ aead_data = <<>>, ++ encrypted_data_buffer = EncryptedDataRest}, + try + ssh_message:decode(set_kex_overload_prefix(DecryptedBytes,D1)) + of +diff --git a/lib/ssh/src/ssh_fsm_kexinit.erl b/lib/ssh/src/ssh_fsm_kexinit.erl +index 05f7bdf22f16..b8fdc29079e8 100644 +--- a/lib/ssh/src/ssh_fsm_kexinit.erl ++++ b/lib/ssh/src/ssh_fsm_kexinit.erl +@@ -43,6 +43,11 @@ + -export([callback_mode/0, handle_event/4, terminate/3, + format_status/2, code_change/4]). + ++-behaviour(ssh_dbg). ++-export([ssh_dbg_trace_points/0, ssh_dbg_flags/1, ++ ssh_dbg_on/1, ssh_dbg_off/1, ++ ssh_dbg_format/2]). ++ + %%==================================================================== + %% gen_statem callbacks + %%==================================================================== +@@ -53,8 +58,13 @@ callback_mode() -> + + %%-------------------------------------------------------------------- + +-%%% ######## {kexinit, client|server, init|renegotiate} #### + ++handle_event(Type, Event = prepare_next_packet, StateName, D) -> ++ ssh_connection_handler:handle_event(Type, Event, StateName, D); ++handle_event(Type, Event = {send_disconnect, _, _, _, _}, StateName, D) -> ++ ssh_connection_handler:handle_event(Type, Event, StateName, D); ++ ++%%% ######## {kexinit, client|server, init|renegotiate} #### + handle_event(internal, {#ssh_msg_kexinit{}=Kex, Payload}, {kexinit,Role,ReNeg}, + D = #data{key_exchange_init_msg = OwnKex}) -> + Ssh1 = ssh_transport:key_init(peer_role(Role), D#data.ssh_params, Payload), +@@ -67,11 +77,10 @@ handle_event(internal, {#ssh_msg_kexinit{}=Kex, Payload}, {kexinit,Role,ReNeg}, + end, + {next_state, {key_exchange,Role,ReNeg}, D#data{ssh_params=Ssh}}; + +- + %%% ######## {key_exchange, client|server, init|renegotiate} #### +- + %%%---- diffie-hellman + handle_event(internal, #ssh_msg_kexdh_init{} = Msg, {key_exchange,server,ReNeg}, D) -> ++ ok = check_kex_strict(Msg, D), + {ok, KexdhReply, Ssh1} = ssh_transport:handle_kexdh_init(Msg, D#data.ssh_params), + ssh_connection_handler:send_bytes(KexdhReply, D), + {ok, NewKeys, Ssh2} = ssh_transport:new_keys_message(Ssh1), +@@ -81,6 +90,7 @@ handle_event(internal, #ssh_msg_kexdh_init{} = Msg, {key_exchange,server,ReNeg}, + {next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}}; + + handle_event(internal, #ssh_msg_kexdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) -> ++ ok = check_kex_strict(Msg, D), + {ok, NewKeys, Ssh1} = ssh_transport:handle_kexdh_reply(Msg, D#data.ssh_params), + ssh_connection_handler:send_bytes(NewKeys, D), + {ok, ExtInfo, Ssh} = ssh_transport:ext_info_message(Ssh1), +@@ -89,24 +99,28 @@ handle_event(internal, #ssh_msg_kexdh_reply{} = Msg, {key_exchange,client,ReNeg} + + %%%---- diffie-hellman group exchange + handle_event(internal, #ssh_msg_kex_dh_gex_request{} = Msg, {key_exchange,server,ReNeg}, D) -> ++ ok = check_kex_strict(Msg, D), + {ok, GexGroup, Ssh1} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + ssh_connection_handler:send_bytes(GexGroup, D), + Ssh = ssh_transport:parallell_gen_key(Ssh1), + {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; + + handle_event(internal, #ssh_msg_kex_dh_gex_request_old{} = Msg, {key_exchange,server,ReNeg}, D) -> ++ ok = check_kex_strict(Msg, D), + {ok, GexGroup, Ssh1} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params), + ssh_connection_handler:send_bytes(GexGroup, D), + Ssh = ssh_transport:parallell_gen_key(Ssh1), + {next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}}; + + handle_event(internal, #ssh_msg_kex_dh_gex_group{} = Msg, {key_exchange,client,ReNeg}, D) -> ++ ok = check_kex_strict(Msg, D), + {ok, KexGexInit, Ssh} = ssh_transport:handle_kex_dh_gex_group(Msg, D#data.ssh_params), + ssh_connection_handler:send_bytes(KexGexInit, D), + {next_state, {key_exchange_dh_gex_reply,client,ReNeg}, D#data{ssh_params=Ssh}}; + + %%%---- elliptic curve diffie-hellman + handle_event(internal, #ssh_msg_kex_ecdh_init{} = Msg, {key_exchange,server,ReNeg}, D) -> ++ ok = check_kex_strict(Msg, D), + {ok, KexEcdhReply, Ssh1} = ssh_transport:handle_kex_ecdh_init(Msg, D#data.ssh_params), + ssh_connection_handler:send_bytes(KexEcdhReply, D), + {ok, NewKeys, Ssh2} = ssh_transport:new_keys_message(Ssh1), +@@ -116,16 +130,25 @@ handle_event(internal, #ssh_msg_kex_ecdh_init{} = Msg, {key_exchange,server,ReNe + {next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}}; + + handle_event(internal, #ssh_msg_kex_ecdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) -> ++ ok = check_kex_strict(Msg, D), + {ok, NewKeys, Ssh1} = ssh_transport:handle_kex_ecdh_reply(Msg, D#data.ssh_params), + ssh_connection_handler:send_bytes(NewKeys, D), + {ok, ExtInfo, Ssh} = ssh_transport:ext_info_message(Ssh1), + ssh_connection_handler:send_bytes(ExtInfo, D), + {next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh}}; + ++%%% ######## handle KEX strict ++handle_event(internal, _Event, {key_exchange,_Role,init}, ++ #data{ssh_params = #ssh{algorithms = #alg{kex_strict_negotiated = true}, ++ send_sequence = SendSeq, ++ recv_sequence = RecvSeq}}) -> ++ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, ++ io_lib:format("KEX strict violation: send_sequence = ~p recv_sequence = ~p", ++ [SendSeq, RecvSeq])); + + %%% ######## {key_exchange_dh_gex_init, server, init|renegotiate} #### +- + handle_event(internal, #ssh_msg_kex_dh_gex_init{} = Msg, {key_exchange_dh_gex_init,server,ReNeg}, D) -> ++ ok = check_kex_strict(Msg, D), + {ok, KexGexReply, Ssh1} = ssh_transport:handle_kex_dh_gex_init(Msg, D#data.ssh_params), + ssh_connection_handler:send_bytes(KexGexReply, D), + {ok, NewKeys, Ssh2} = ssh_transport:new_keys_message(Ssh1), +@@ -133,20 +156,33 @@ handle_event(internal, #ssh_msg_kex_dh_gex_init{} = Msg, {key_exchange_dh_gex_in + {ok, ExtInfo, Ssh} = ssh_transport:ext_info_message(Ssh2), + ssh_connection_handler:send_bytes(ExtInfo, D), + {next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}}; +- ++%%% ######## handle KEX strict ++handle_event(internal, _Event, {key_exchange_dh_gex_init,_Role,init}, ++ #data{ssh_params = #ssh{algorithms = #alg{kex_strict_negotiated = true}, ++ send_sequence = SendSeq, ++ recv_sequence = RecvSeq}}) -> ++ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, ++ io_lib:format("KEX strict violation: send_sequence = ~p recv_sequence = ~p", ++ [SendSeq, RecvSeq])); + + %%% ######## {key_exchange_dh_gex_reply, client, init|renegotiate} #### +- + handle_event(internal, #ssh_msg_kex_dh_gex_reply{} = Msg, {key_exchange_dh_gex_reply,client,ReNeg}, D) -> ++ ok = check_kex_strict(Msg, D), + {ok, NewKeys, Ssh1} = ssh_transport:handle_kex_dh_gex_reply(Msg, D#data.ssh_params), + ssh_connection_handler:send_bytes(NewKeys, D), + {ok, ExtInfo, Ssh} = ssh_transport:ext_info_message(Ssh1), + ssh_connection_handler:send_bytes(ExtInfo, D), + {next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh}}; +- ++%%% ######## handle KEX strict ++handle_event(internal, _Event, {key_exchange_dh_gex_reply,_Role,init}, ++ #data{ssh_params = #ssh{algorithms = #alg{kex_strict_negotiated = true}, ++ send_sequence = SendSeq, ++ recv_sequence = RecvSeq}}) -> ++ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, ++ io_lib:format("KEX strict violation: send_sequence = ~p recv_sequence = ~p", ++ [SendSeq, RecvSeq])); + + %%% ######## {new_keys, client|server} #### +- + %% First key exchange round: + handle_event(internal, #ssh_msg_newkeys{} = Msg, {new_keys,client,init}, D0) -> + {ok, Ssh1} = ssh_transport:handle_new_keys(Msg, D0#data.ssh_params), +@@ -162,6 +198,15 @@ handle_event(internal, #ssh_msg_newkeys{} = Msg, {new_keys,server,init}, D) -> + %% ssh_connection_handler:send_bytes(ExtInfo, D), + {next_state, {ext_info,server,init}, D#data{ssh_params=Ssh}}; + ++%%% ######## handle KEX strict ++handle_event(internal, _Event, {new_keys,_Role,init}, ++ #data{ssh_params = #ssh{algorithms = #alg{kex_strict_negotiated = true}, ++ send_sequence = SendSeq, ++ recv_sequence = RecvSeq}}) -> ++ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, ++ io_lib:format("KEX strict violation (send_sequence = ~p recv_sequence = ~p)", ++ [SendSeq, RecvSeq])); ++ + %% Subsequent key exchange rounds (renegotiation): + handle_event(internal, #ssh_msg_newkeys{} = Msg, {new_keys,Role,renegotiate}, D) -> + {ok, Ssh} = ssh_transport:handle_new_keys(Msg, D#data.ssh_params), +@@ -183,7 +228,6 @@ handle_event(internal, #ssh_msg_ext_info{}=Msg, {ext_info,Role,renegotiate}, D0) + handle_event(internal, #ssh_msg_newkeys{}=Msg, {ext_info,_Role,renegotiate}, D) -> + {ok, Ssh} = ssh_transport:handle_new_keys(Msg, D#data.ssh_params), + {keep_state, D#data{ssh_params = Ssh}}; +- + + handle_event(internal, Msg, {ext_info,Role,init}, D) when is_tuple(Msg) -> + %% If something else arrives, goto next state and handle the event in that one +@@ -217,3 +261,70 @@ code_change(_OldVsn, StateName, State, _Extra) -> + peer_role(client) -> server; + peer_role(server) -> client. + ++check_kex_strict(Msg, ++ #data{ssh_params = ++ #ssh{algorithms = ++ #alg{ ++ kex = Kex, ++ kex_strict_negotiated = KexStrictNegotiated}, ++ send_sequence = SendSeq, ++ recv_sequence = RecvSeq}}) -> ++ case check_msg_group(Msg, get_alg_group(Kex), KexStrictNegotiated) of ++ ok -> ++ ok; ++ error -> ++ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, ++ io_lib:format("KEX strict violation: send_sequence = ~p recv_sequence = ~p", ++ [SendSeq, RecvSeq])) ++ end. ++ ++get_alg_group(Kex) when Kex == 'diffie-hellman-group16-sha512'; ++ Kex == 'diffie-hellman-group18-sha512'; ++ Kex == 'diffie-hellman-group14-sha256'; ++ Kex == 'diffie-hellman-group14-sha1'; ++ Kex == 'diffie-hellman-group1-sha1' -> ++ dh_alg; ++get_alg_group(Kex) when Kex == 'diffie-hellman-group-exchange-sha256'; ++ Kex == 'diffie-hellman-group-exchange-sha1' -> ++ dh_gex_alg; ++get_alg_group(Kex) when Kex == 'curve25519-sha256'; ++ Kex == 'curve25519-sha256@libssh.org'; ++ Kex == 'curve448-sha512'; ++ Kex == 'ecdh-sha2-nistp521'; ++ Kex == 'ecdh-sha2-nistp384'; ++ Kex == 'ecdh-sha2-nistp256' -> ++ ecdh_alg. ++ ++check_msg_group(_Msg, _AlgGroup, false) -> ok; ++check_msg_group(#ssh_msg_kexdh_init{}, dh_alg, true) -> ok; ++check_msg_group(#ssh_msg_kexdh_reply{}, dh_alg, true) -> ok; ++check_msg_group(#ssh_msg_kex_dh_gex_request_old{}, dh_gex_alg, true) -> ok; ++check_msg_group(#ssh_msg_kex_dh_gex_request{}, dh_gex_alg, true) -> ok; ++check_msg_group(#ssh_msg_kex_dh_gex_group{}, dh_gex_alg, true) -> ok; ++check_msg_group(#ssh_msg_kex_dh_gex_init{}, dh_gex_alg, true) -> ok; ++check_msg_group(#ssh_msg_kex_dh_gex_reply{}, dh_gex_alg, true) -> ok; ++check_msg_group(#ssh_msg_kex_ecdh_init{}, ecdh_alg, true) -> ok; ++check_msg_group(#ssh_msg_kex_ecdh_reply{}, ecdh_alg, true) -> ok; ++check_msg_group(_Msg, _AlgGroup, _) -> error. ++ ++%%%################################################################ ++%%%# ++%%%# Tracing ++%%%# ++ ++ssh_dbg_trace_points() -> [connection_events]. ++ ++ssh_dbg_flags(connection_events) -> [c]. ++ ++ssh_dbg_on(connection_events) -> dbg:tp(?MODULE, handle_event, 4, x). ++ ++ssh_dbg_off(connection_events) -> dbg:ctpg(?MODULE, handle_event, 4). ++ ++ssh_dbg_format(connection_events, {call, {?MODULE,handle_event, [EventType, EventContent, State, _Data]}}) -> ++ ["Connection event\n", ++ io_lib:format("[~w] EventType: ~p~nEventContent: ~p~nState: ~p~n", [?MODULE, EventType, EventContent, State]) ++ ]; ++ssh_dbg_format(connection_events, {return_from, {?MODULE,handle_event,4}, Ret}) -> ++ ["Connection event result\n", ++ io_lib:format("[~w] ~p~n", [?MODULE, ssh_dbg:reduce_state(Ret, #data{})]) ++ ]. +diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl +index 3e96ca940200..e612ffd0fe30 100644 +--- a/lib/ssh/src/ssh_transport.erl ++++ b/lib/ssh/src/ssh_transport.erl +@@ -26,12 +26,11 @@ + + -include_lib("public_key/include/public_key.hrl"). + -include_lib("kernel/include/inet.hrl"). +- + -include("ssh_transport.hrl"). + -include("ssh.hrl"). + + -export([versions/2, hello_version_msg/1]). +--export([next_seqnum/1, ++-export([next_seqnum/3, + supported_algorithms/0, supported_algorithms/1, + default_algorithms/0, default_algorithms/1, + clear_default_algorithms_env/0, +@@ -295,7 +294,12 @@ random_id(Nlo, Nup) -> + hello_version_msg(Data) -> + [Data,"\r\n"]. + +-next_seqnum(SeqNum) -> ++next_seqnum({State, _Role, init}, 16#ffffffff, ++ #ssh{algorithms = #alg{kex_strict_negotiated = true}}) ++ when State == kexinit; State == key_exchange; State == new_keys -> ++ ?DISCONNECT(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, ++ io_lib:format("KEX strict violation: recv_sequence = 16#ffffffff", [])); ++next_seqnum(_State, SeqNum, _) -> + (SeqNum + 1) band 16#ffffffff. + + is_valid_mac(_, _ , #ssh{recv_mac_size = 0}) -> +@@ -1080,7 +1084,7 @@ known_host_key(#ssh{opts = Opts, peer = {PeerName,{IP,Port}}} = Ssh, + %% algorithm. Each string MUST contain at least one algorithm name. + select_algorithm(Role, Client, Server, + #ssh{opts = Opts, +- kex_strict_negotiated = KexStrictNegotiated0}, ++ kex_strict_negotiated = KexStrictNegotiated0}, + ReNeg) -> + KexStrictNegotiated = + case ReNeg of +@@ -1105,7 +1109,6 @@ select_algorithm(Role, Client, Server, + _ -> + KexStrictNegotiated0 + end, +- + {Encrypt0, Decrypt0} = select_encrypt_decrypt(Role, Client, Server), + {SendMac0, RecvMac0} = select_send_recv_mac(Role, Client, Server), + +diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl +index 537642cff598..2e1c2a6c7685 100644 +--- a/lib/ssh/test/ssh_protocol_SUITE.erl ++++ b/lib/ssh/test/ssh_protocol_SUITE.erl +@@ -55,7 +55,9 @@ + ext_info_c/1, + ext_info_s/1, + kex_strict_negotiated/1, +- kex_strict_msg_ignore/1, ++ kex_strict_violation_key_exchange/1, ++ kex_strict_violation_new_keys/1, ++ kex_strict_violation/1, + kex_strict_msg_unknown/1, + gex_client_init_option_groups/1, + gex_client_init_option_groups_file/1, +@@ -144,7 +146,9 @@ groups() -> + gex_client_old_request_exact, + gex_client_old_request_noexact, + kex_strict_negotiated, +- kex_strict_msg_ignore, ++ kex_strict_violation_key_exchange, ++ kex_strict_violation_new_keys, ++ kex_strict_violation, + kex_strict_msg_unknown]}, + {service_requests, [], [bad_service_name, + bad_long_service_name, +@@ -1007,22 +1011,145 @@ kex_strict_negotiated(Config0) -> + ssh_test_lib:rm_log_handler(), + ok. + +-%% Connect to an erlang server and inject unexpected SSH ignore +-kex_strict_msg_ignore(Config) -> +- ct:log("START: ~p~n=================================", [?FUNCTION_NAME]), +- ExpectedReason = "strict KEX violation: unexpected SSH_MSG_IGNORE", +- TestMessages = +- [{send, ssh_msg_ignore}, +- {match, #ssh_msg_kexdh_reply{_='_'}, receive_msg}, +- {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg}], +- kex_strict_helper(Config, TestMessages, ExpectedReason). ++%% Connect to an erlang server and inject unexpected SSH message ++%% ssh_fsm_kexinit in key_exchange state ++kex_strict_violation_key_exchange(Config) -> ++ ExpectedReason = "KEX strict violation", ++ Injections = [ssh_msg_ignore, ssh_msg_debug, ssh_msg_unimplemented], ++ TestProcedure = ++ fun(M) -> ++ ct:log( ++ "=================== START: ~p Message: ~p Expected Fail =================================", ++ [?FUNCTION_NAME, M]), ++ [receive_hello, ++ {send, hello}, ++ {send, ssh_msg_kexinit}, ++ {match, #ssh_msg_kexinit{_='_'}, receive_msg}, ++ {send, M}, ++ {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg}] ++ end, ++ [kex_strict_helper(Config, TestProcedure(Msg), ExpectedReason) || ++ Msg <- Injections], ++ ct:log("========== END ========"), ++ ok. ++ ++%% Connect to an erlang server and inject unexpected SSH message ++%% ssh_fsm_kexinit in new_keys state ++kex_strict_violation_new_keys(Config) -> ++ ExpectedReason = "KEX strict violation", ++ Injections = [ssh_msg_ignore, ssh_msg_debug, ssh_msg_unimplemented], ++ TestProcedure = ++ fun(M) -> ++ ct:log( ++ "=================== START: ~p Message: ~p Expected Fail =================================", ++ [?FUNCTION_NAME, M]), ++ [receive_hello, ++ {send, hello}, ++ {send, ssh_msg_kexinit}, ++ {match, #ssh_msg_kexinit{_='_'}, receive_msg}, ++ {send, ssh_msg_kexdh_init}, ++ {send, M}, ++ {match, #ssh_msg_kexdh_reply{_='_'}, receive_msg}, ++ {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg}] ++ end, ++ [kex_strict_helper(Config, TestProcedure(Msg), ExpectedReason) || ++ Msg <- Injections], ++ ct:log("========== END ========"), ++ ok. ++ ++%% Connect to an erlang server and inject unexpected SSH message ++%% duplicated KEXINIT ++kex_strict_violation(Config) -> ++ KexDhReply = ++ #ssh_msg_kexdh_reply{ ++ public_host_key = {{{'ECPoint',<<73,72,235,162,96,101,154,59,217,114,123,192,96,105,250,29,214,76,60,63,167,21,221,118,246,168,152,2,7,172,137,125>>}, ++ {namedCurve,{1,3,101,112}}}, ++ 'ssh-ed25519'}, ++ f = 18504393053016436370762156176197081926381112956345797067569792020930728564439992620494295053804030674742529174859108487694089045521619258420515443400605141150065440678508889060925968846155921972385560196703381004650914261218463420313738628465563288022895912907728767735629532940627575655703806353550720122093175255090704443612257683903495753071530605378193139909567971489952258218767352348904221407081210633467414579377014704081235998044497191940270966762124544755076128392259615566530695493013708460088312025006678879288856957348606386230195080105197251789635675011844976120745546472873505352732719507783227210178188, ++ h_sig = <<90,247,44,240,136,196,82,215,56,165,53,33,230,101,253, ++ 34,112,201,21,131,162,169,10,129,174,14,69,25,39,174, ++ 92,210,130,249,103,2,215,245,7,213,110,235,136,134,11, ++ 124,248,139,79,17,225,77,125,182,204,84,137,167,99,186, ++ 167,42,192,10>>}, ++ TestFlows = ++ [ ++ {kexinit, "KEX strict violation", ++ [receive_hello, ++ {send, hello}, ++ {send, ssh_msg_kexinit}, ++ {match, #ssh_msg_kexinit{_='_'}, receive_msg}, ++ {send, ssh_msg_kexinit}, ++ {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg}]}, ++ {ssh_msg_kexdh_init, "KEX strict violation", ++ [receive_hello, ++ {send, hello}, ++ {send, ssh_msg_kexinit}, ++ {match, #ssh_msg_kexinit{_='_'}, receive_msg}, ++ {send, ssh_msg_kexdh_init_dup}, ++ {match,# ssh_msg_kexdh_reply{_='_'}, receive_msg}, ++ {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg}]}, ++ {new_keys, "Message ssh_msg_newkeys in wrong state", ++ [receive_hello, ++ {send, hello}, ++ {send, ssh_msg_kexinit}, ++ {match, #ssh_msg_kexinit{_='_'}, receive_msg}, ++ {send, ssh_msg_kexdh_init}, ++ {match,# ssh_msg_kexdh_reply{_='_'}, receive_msg}, ++ {send, #ssh_msg_newkeys{}}, ++ {match, #ssh_msg_newkeys{_='_'}, receive_msg}, ++ {send, #ssh_msg_newkeys{}}, ++ {match, disconnect(?SSH_DISCONNECT_PROTOCOL_ERROR), receive_msg}]}, ++ {ssh_msg_unexpected_dh_gex, "KEX strict violation", ++ [receive_hello, ++ {send, hello}, ++ {send, ssh_msg_kexinit}, ++ {match, #ssh_msg_kexinit{_='_'}, receive_msg}, ++ %% dh_alg is expected but dh_gex_alg is provided ++ {send, #ssh_msg_kex_dh_gex_request{min = 1000, n = 3000, max = 4000}}, ++ {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg}]}, ++ {wrong_role, "KEX strict violation", ++ [receive_hello, ++ {send, hello}, ++ {send, ssh_msg_kexinit}, ++ {match, #ssh_msg_kexinit{_='_'}, receive_msg}, ++ %% client should not send message below ++ {send, KexDhReply}, ++ {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg}]}, ++ {wrong_role2, "KEX strict violation", ++ [receive_hello, ++ {send, hello}, ++ {send, ssh_msg_kexinit}, ++ {match, #ssh_msg_kexinit{_='_'}, receive_msg}, ++ {send, ssh_msg_kexdh_init}, ++ {match,# ssh_msg_kexdh_reply{_='_'}, receive_msg}, ++ %% client should not send message below ++ {send, KexDhReply}, ++ {match, #ssh_msg_newkeys{_='_'}, receive_msg}, ++ {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg}]} ++ ], ++ TestProcedure = ++ fun({Msg, _, P}) -> ++ ct:log( ++ "==== START: ~p (duplicated ~p) Expected Fail ====~n~p", ++ [?FUNCTION_NAME, Msg, P]), ++ P ++ end, ++ [kex_strict_helper(Config, TestProcedure(Procedure), Reason) || ++ Procedure = {_, Reason, _} <- TestFlows], ++ ct:log("==== END ====="), ++ ok. + + %% Connect to an erlang server and inject unexpected non-SSH binary + kex_strict_msg_unknown(Config) -> + ct:log("START: ~p~n=================================", [?FUNCTION_NAME]), + ExpectedReason = "Bad packet: Size", + TestMessages = +- [{send, ssh_msg_unknown}, ++ [receive_hello, ++ {send, hello}, ++ {send, ssh_msg_kexinit}, ++ {match, #ssh_msg_kexinit{_='_'}, receive_msg}, ++ {send, ssh_msg_kexdh_init}, ++ {send, ssh_msg_unknown}, + {match, #ssh_msg_kexdh_reply{_='_'}, receive_msg}, + {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg}], + kex_strict_helper(Config, TestMessages, ExpectedReason). +@@ -1047,12 +1174,7 @@ kex_strict_helper(Config, TestMessages, ExpectedReason) -> + {user_dir, user_dir(Config)}, + {user_interaction, false} + | proplists:get_value(extra_options,Config,[]) +- ]}, +- receive_hello, +- {send, hello}, +- {send, ssh_msg_kexinit}, +- {match, #ssh_msg_kexinit{_='_'}, receive_msg}, +- {send, ssh_msg_kexdh_init}] ++ ++ ]}] ++ + TestMessages, + InitialState), + ct:sleep(100), +diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl +index f03fee1662ed..e34db487e5a2 100644 +--- a/lib/ssh/test/ssh_trpt_test_lib.erl ++++ b/lib/ssh/test/ssh_trpt_test_lib.erl +@@ -90,7 +90,8 @@ exec(Op, S0=#s{}) -> + report_trace(throw, Term, S1), + throw({Term,Op}); + +- error:Error -> ++ error:Error:St -> ++ ct:log("Stacktrace=~n~p", [St]), + report_trace(error, Error, S1), + error({Error,Op}); + +@@ -335,6 +336,17 @@ send(S0, ssh_msg_ignore) -> + Msg = #ssh_msg_ignore{data = "unexpected_ignore_message"}, + send(S0, Msg); + ++send(S0, ssh_msg_debug) -> ++ Msg = #ssh_msg_debug{ ++ always_display = true, ++ message = "some debug message", ++ language = "en"}, ++ send(S0, Msg); ++ ++send(S0, ssh_msg_unimplemented) -> ++ Msg = #ssh_msg_unimplemented{sequence = 123}, ++ send(S0, Msg); ++ + send(S0, ssh_msg_unknown) -> + Msg = binary:encode_hex(<<"0000000C060900000000000000000000">>), + send(S0, Msg); +@@ -382,6 +394,26 @@ send(S0, ssh_msg_kexdh_init) when ?role(S0) == client -> + end), + send_bytes(NextKexMsgBin, S#s{ssh = C}); + ++send(S0, ssh_msg_kexdh_init_dup) when ?role(S0) == client -> ++ {OwnMsg, PeerMsg} = S0#s.alg_neg, ++ {ok, NextKexMsgBin, C} = ++ try ssh_transport:handle_kexinit_msg(PeerMsg, OwnMsg, S0#s.ssh, init) ++ catch ++ Class:Exc -> ++ fail("Algorithm negotiation failed!", ++ {"Algorithm negotiation failed at line ~p:~p~n~p:~s~nPeer: ~s~n Own: ~s", ++ [?MODULE,?LINE,Class,format_msg(Exc),format_msg(PeerMsg),format_msg(OwnMsg)]}, ++ S0) ++ end, ++ S = opt(print_messages, S0, ++ fun(X) when X==true;X==detail -> ++ #ssh{keyex_key = {{_Private, Public}, {_G, _P}}} = C, ++ Msg = #ssh_msg_kexdh_init{e = Public}, ++ {"Send (reconstructed)~n~s~n",[format_msg(Msg)]} ++ end), ++ send_bytes(NextKexMsgBin, S#s{ssh = C}), ++ send_bytes(NextKexMsgBin, S#s{ssh = C}); ++ + send(S0, ssh_msg_kexdh_reply) -> + Bytes = proplists:get_value(ssh_msg_kexdh_reply, S0#s.reply), + S = opt(print_messages, S0, +@@ -531,7 +563,10 @@ receive_binary_msg(S0=#s{}) -> + S0#s.ssh) + of + {packet_decrypted, DecryptedBytes, EncryptedDataRest, Ssh1} -> +- S1 = S0#s{ssh = Ssh1#ssh{recv_sequence = ssh_transport:next_seqnum(Ssh1#ssh.recv_sequence)}, ++ S1 = S0#s{ssh = Ssh1#ssh{recv_sequence = ++ ssh_transport:next_seqnum(undefined, ++ Ssh1#ssh.recv_sequence, ++ false)}, + decrypted_data_buffer = <<>>, + undecrypted_packet_length = undefined, + aead_data = <<>>, diff --git a/CVE-2025-46712-2.patch b/CVE-2025-46712-2.patch new file mode 100644 index 0000000..6c33322 --- /dev/null +++ b/CVE-2025-46712-2.patch @@ -0,0 +1,22 @@ +From 816b5f70196486e693dd0a3ce59f9dde7ba558db Mon Sep 17 00:00:00 2001 +From: Jakub Witczak +Date: Wed, 7 May 2025 16:58:27 +0200 +Subject: [PATCH] ssh: ssh_test_lib add extra remove_handler to improve + robustness in tests + +--- + lib/ssh/test/ssh_test_lib.erl | 1 + + 1 file changed, 1 insertion(+) + +diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl +index 96b4f10392f1..210944cdb1f8 100644 +--- a/lib/ssh/test/ssh_test_lib.erl ++++ b/lib/ssh/test/ssh_test_lib.erl +@@ -1324,6 +1324,7 @@ set_log_level(Level) -> + ok = logger:set_primary_config(level, Level). + + add_log_handler() -> ++ logger:remove_handler(?MODULE), + TestRef = make_ref(), + ok = logger:add_handler(?MODULE, ?MODULE, + #{level => debug, diff --git a/CVE-2025-46712-pre-ssh-reduce-KEX-strict-message-verbosity.patch b/CVE-2025-46712-pre-ssh-reduce-KEX-strict-message-verbosity.patch new file mode 100644 index 0000000..bfd448e --- /dev/null +++ b/CVE-2025-46712-pre-ssh-reduce-KEX-strict-message-verbosity.patch @@ -0,0 +1,308 @@ +From 68b3f7d18db789845a0027004b53e5051d5a6683 Mon Sep 17 00:00:00 2001 +From: Jakub Witczak +Date: Fri, 23 Feb 2024 16:07:16 +0100 +Subject: [PATCH] ssh: reduce KEX strict message verbosity + +- emit "KEX strict" message as debug +- related test adjustments +--- + lib/ssh/src/ssh_transport.erl | 3 +- + lib/ssh/test/ssh_protocol_SUITE.erl | 35 ++++++------- + lib/ssh/test/ssh_test_lib.erl | 73 ++++++++++++++++++++------- + lib/ssh/test/ssh_to_openssh_SUITE.erl | 52 +++++++++++-------- + 4 files changed, 103 insertions(+), 60 deletions(-) + +diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl +index 7846b356a542..e6161c367ba7 100644 +--- a/lib/ssh/src/ssh_transport.erl ++++ b/lib/ssh/src/ssh_transport.erl +@@ -1097,8 +1097,7 @@ select_algorithm(Role, Client, Server, + end, + case Result of + true -> +- error_logger:info_report( +- lists:concat([Role, " will use strict KEX ordering"])); ++ logger:debug(lists:concat([Role, " will use strict KEX ordering"])); + _ -> + ok + end, +diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl +index 186c867e2fa9..3222686d9bcf 100644 +--- a/lib/ssh/test/ssh_protocol_SUITE.erl ++++ b/lib/ssh/test/ssh_protocol_SUITE.erl +@@ -827,19 +827,19 @@ ext_info_c(Config) -> + %%%-------------------------------------------------------------------- + %%% + kex_strict_negotiated(Config0) -> +- {ok,Pid} = ssh_test_lib:add_report_handler(), ++ {ok, TestRef} = ssh_test_lib:add_log_handler(), + Config = start_std_daemon(Config0, []), + {Server, Host, Port} = proplists:get_value(server, Config), +- #{level := Level} = logger:get_primary_config(), +- logger:set_primary_config(level, notice), ++ Level = ssh_test_lib:get_log_level(), ++ ssh_test_lib:set_log_level(debug), + {ok, ConnRef} = std_connect({Host, Port}, Config, []), + {algorithms, A} = ssh:connection_info(ConnRef, algorithms), + ssh:stop_daemon(Server), +- {ok, Reports} = ssh_test_lib:get_reports(Pid), +- ct:log("Reports = ~p", [Reports]), +- true = ssh_test_lib:kex_strict_negotiated(client, Reports), +- true = ssh_test_lib:kex_strict_negotiated(server, Reports), +- logger:set_primary_config(Level), ++ {ok, Events} = ssh_test_lib:get_log_events(TestRef), ++ true = ssh_test_lib:kex_strict_negotiated(client, Events), ++ true = ssh_test_lib:kex_strict_negotiated(server, Events), ++ ssh_test_lib:set_log_level(Level), ++ ssh_test_lib:rm_log_handler(), + ok. + + %% Connect to an erlang server and inject unexpected SSH ignore +@@ -863,9 +863,9 @@ kex_strict_msg_unknown(Config) -> + kex_strict_helper(Config, TestMessages, ExpectedReason). + + kex_strict_helper(Config, TestMessages, ExpectedReason) -> +- {ok,HandlerPid} = ssh_test_lib:add_report_handler(), +- #{level := Level} = logger:get_primary_config(), +- logger:set_primary_config(level, notice), ++ {ok, TestRef} = ssh_test_lib:add_log_handler(), ++ Level = ssh_test_lib:get_log_level(), ++ ssh_test_lib:set_log_level(debug), + %% Connect and negotiate keys + {ok, InitialState} = ssh_trpt_test_lib:exec( + [{set_options, [print_ops, print_seqnums, print_messages]}] +@@ -891,12 +891,13 @@ kex_strict_helper(Config, TestMessages, ExpectedReason) -> + TestMessages, + InitialState), + ct:sleep(100), +- {ok, Reports} = ssh_test_lib:get_reports(HandlerPid), +- ct:log("HandlerPid = ~p~nReports = ~p", [HandlerPid, Reports]), +- true = ssh_test_lib:kex_strict_negotiated(client, Reports), +- true = ssh_test_lib:kex_strict_negotiated(server, Reports), +- true = ssh_test_lib:event_logged(server, Reports, ExpectedReason), +- logger:set_primary_config(Level), ++ {ok, Events} = ssh_test_lib:get_log_events(TestRef), ++ ssh_test_lib:rm_log_handler(), ++ ct:log("Events = ~p", [Events]), ++ true = ssh_test_lib:kex_strict_negotiated(client, Events), ++ true = ssh_test_lib:kex_strict_negotiated(server, Events), ++ true = ssh_test_lib:event_logged(server, Events, ExpectedReason), ++ ssh_test_lib:set_log_level(Level), + ok. + + %%%---------------------------------------------------------------- +diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl +index e364ab0baebb..04bfd122f98e 100644 +--- a/lib/ssh/test/ssh_test_lib.erl ++++ b/lib/ssh/test/ssh_test_lib.erl +@@ -122,11 +122,13 @@ setup_host_key/3, + setup_known_host/3, + get_addr_str/0, + file_base_name/2, +-add_report_handler/0, +-get_reports/1, + kex_strict_negotiated/2, + event_logged/3 + ]). ++%% logger callbacks and related helpers ++-export([log/2, ++ get_log_level/0, set_log_level/1, add_log_handler/0, ++ rm_log_handler/0, get_log_events/1]). + + -include_lib("common_test/include/ct.hrl"). + -include("ssh_transport.hrl"). +@@ -1271,15 +1273,10 @@ file_base_name(system_src, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key521"; + file_base_name(system_src, Alg) -> file_base_name(system, Alg). + + %%%---------------------------------------------------------------- +-add_report_handler() -> +- ssh_eqc_event_handler:add_report_handler(). +- +-get_reports(Pid) -> +- ssh_eqc_event_handler:get_reports(Pid). +- + -define(SEARCH_FUN(EXP), + begin +- fun({info_report, _, {_, std_info, EXP}}) -> ++ fun(#{msg := {string, EXP}, ++ level := debug}) -> + true; + (_) -> + false +@@ -1287,19 +1284,20 @@ get_reports(Pid) -> + end). + -define(SEARCH_SUFFIX, " will use strict KEX ordering"). + +-kex_strict_negotiated(client, Reports) -> +- kex_strict_negotiated(?SEARCH_FUN("client" ++ ?SEARCH_SUFFIX), Reports); +-kex_strict_negotiated(server, Reports) -> +- kex_strict_negotiated(?SEARCH_FUN("server" ++ ?SEARCH_SUFFIX), Reports); +-kex_strict_negotiated(SearchFun, Reports) when is_function(SearchFun) -> +- case lists:search(SearchFun, Reports) of ++kex_strict_negotiated(client, Events) -> ++ kex_strict_negotiated(?SEARCH_FUN("client" ++ ?SEARCH_SUFFIX), Events); ++kex_strict_negotiated(server, Events) -> ++ kex_strict_negotiated(?SEARCH_FUN("server" ++ ?SEARCH_SUFFIX), Events); ++kex_strict_negotiated(SearchFun, Events) when is_function(SearchFun) -> ++ %% FIXME use event_logged? ++ case lists:search(SearchFun, Events) of + {value, _} -> true; + _ -> false + end. + +-event_logged(Role, Reports, Reason) -> ++event_logged(Role, Events, Reason) -> + SearchF = +- fun({info_msg, _, {_, _Format, Args}}) -> ++ fun(#{msg := {report, #{args := Args}}}) -> + AnyF = fun (E) when is_list(E) -> + case string:find(E, Reason) of + nomatch -> false; +@@ -1310,10 +1308,47 @@ event_logged(Role, Reports, Reason) -> + end, + lists:member(Role, Args) andalso + lists:any(AnyF, Args); +- (_) -> ++ (_Event) -> + false + end, +- case lists:search(SearchF, Reports) of ++ case lists:search(SearchF, Events) of + {value, _} -> true; + _ -> false + end. ++ ++get_log_level() -> ++ #{level := Level} = logger:get_primary_config(), ++ Level. ++ ++set_log_level(Level) -> ++ ok = logger:set_primary_config(level, Level). ++ ++add_log_handler() -> ++ TestRef = make_ref(), ++ ok = logger:add_handler(?MODULE, ?MODULE, ++ #{level => debug, ++ filter_default => log, ++ recipient => self(), ++ test_ref => TestRef}), ++ {ok, TestRef}. ++ ++rm_log_handler() -> ++ ok = logger:remove_handler(?MODULE). ++ ++get_log_events(TestRef) -> ++ {ok, get_log_events(TestRef, [])}. ++ ++get_log_events(TestRef, Acc) -> ++ receive ++ {TestRef, Event} -> ++ get_log_events(TestRef, [Event | Acc]) ++ after ++ 500 -> ++ Acc ++ end. ++ ++%% logger callbacks ++log(LogEvent = #{level:=_Level,msg:=_Msg,meta:=_Meta}, ++ #{test_ref := TestRef, recipient := Recipient}) -> ++ Recipient ! {TestRef, LogEvent}, ++ ok. +diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl +index 5a8f4b31187d..16bedf1763b3 100644 +--- a/lib/ssh/test/ssh_to_openssh_SUITE.erl ++++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl +@@ -146,29 +146,32 @@ end_per_testcase(_TestCase, _Config) -> + %% Test Cases -------------------------------------------------------- + %%-------------------------------------------------------------------- + erlang_shell_client_openssh_server(Config) when is_list(Config) -> +- eclient_oserver_helper(Config). ++ eclient_oserver_helper2(eclient_oserver_helper1(), Config). + + eclient_oserver_kex_strict(Config) when is_list(Config)-> + case proplists:get_value(kex_strict, Config) of + true -> +- {ok, HandlerPid} = ssh_test_lib:add_report_handler(), +- #{level := Level} = logger:get_primary_config(), +- logger:set_primary_config(level, notice), +- Result = eclient_oserver_helper(Config), +- {ok, Reports} = ssh_test_lib:get_reports(HandlerPid), +- ct:pal("Reports = ~p", [Reports]), +- true = ssh_test_lib:kex_strict_negotiated(client, Reports), +- logger:set_primary_config(Level), +- Result; ++ {ok, TestRef} = ssh_test_lib:add_log_handler(), ++ Level = ssh_test_lib:get_log_level(), ++ ssh_test_lib:set_log_level(debug), ++ HelperParams = eclient_oserver_helper1(), ++ {ok, Events} = ssh_test_lib:get_log_events(TestRef), ++ true = ssh_test_lib:kex_strict_negotiated(client, Events), ++ ssh_test_lib:set_log_level(Level), ++ ssh_test_lib:rm_log_handler(), ++ eclient_oserver_helper2(HelperParams, Config); + _ -> + {skip, "KEX strict not support by local OpenSSH"} + end. + +-eclient_oserver_helper(Config) -> ++eclient_oserver_helper1() -> + process_flag(trap_exit, true), + IO = ssh_test_lib:start_io_server(), + Prev = lists:usort(supervisor:which_children(sshc_sup)), + Shell = ssh_test_lib:start_shell(?SSH_DEFAULT_PORT, IO), ++ {Shell, Prev, IO}. ++ ++eclient_oserver_helper2({Shell, Prev, IO}, Config) -> + IO ! {input, self(), "echo Hej\n"}, + case proplists:get_value(ptty_supported, Config) of + true -> +@@ -253,25 +256,28 @@ exec_direct_with_io_in_sshc(Config) when is_list(Config) -> + %%-------------------------------------------------------------------- + %% Test that the Erlang/OTP server can renegotiate with openSSH + erlang_server_openssh_client_renegotiate(Config) -> +- eserver_oclient_renegotiate_helper(Config). ++ eserver_oclient_renegotiate_helper2( ++ eserver_oclient_renegotiate_helper1(Config)). + + eserver_oclient_kex_strict(Config) -> + case proplists:get_value(kex_strict, Config) of + true -> +- {ok, HandlerPid} = ssh_test_lib:add_report_handler(), +- #{level := Level} = logger:get_primary_config(), +- logger:set_primary_config(level, notice), +- Result = eserver_oclient_renegotiate_helper(Config), +- {ok, Reports} = ssh_test_lib:get_reports(HandlerPid), +- ct:log("Reports = ~p", [Reports]), +- true = ssh_test_lib:kex_strict_negotiated(server, Reports), +- logger:set_primary_config(Level), +- Result; ++ {ok, TestRef} = ssh_test_lib:add_log_handler(), ++ Level = ssh_test_lib:get_log_level(), ++ ssh_test_lib:set_log_level(debug), ++ ++ HelperParams = eserver_oclient_renegotiate_helper1(Config), ++ {ok, Events} = ssh_test_lib:get_log_events(TestRef), ++ ct:log("Events = ~n~p", [Events]), ++ true = ssh_test_lib:kex_strict_negotiated(server, Events), ++ ssh_test_lib:set_log_level(Level), ++ ssh_test_lib:rm_log_handler(), ++ eserver_oclient_renegotiate_helper2(HelperParams); + _ -> + {skip, "KEX strict not support by local OpenSSH"} + end. + +-eserver_oclient_renegotiate_helper(Config) -> ++eserver_oclient_renegotiate_helper1(Config) -> + _PubKeyAlg = ssh_rsa, + SystemDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), +@@ -295,7 +301,9 @@ eserver_oclient_renegotiate_helper(Config) -> + + + OpenSsh = ssh_test_lib:open_port({spawn, Cmd++" < "++DataFile}), ++ {Data, OpenSsh, Pid}. + ++eserver_oclient_renegotiate_helper2({Data, OpenSsh, Pid}) -> + Expect = fun({data,R}) -> + try + NonAlphaChars = [C || C<-lists:seq(1,255), diff --git a/erlang.spec b/erlang.spec index 895d8f5..556197b 100644 --- a/erlang.spec +++ b/erlang.spec @@ -10,7 +10,7 @@ %global __with_sources 1 Name: erlang Version: 25.3.2.6 -Release: 6 +Release: 7 Summary: General-purpose programming language and runtime environment License: Apache-2.0 URL: https://www.erlang.org @@ -39,6 +39,9 @@ Patch16: CVE-2025-30211-2.patch Patch17: CVE-2025-30211-3.patch Patch18: CVE-2025-30211-4.patch Patch19: CVE-2025-32433.patch +Patch20: CVE-2025-46712-pre-ssh-reduce-KEX-strict-message-verbosity.patch +Patch21: CVE-2025-46712-1.patch +Patch22: CVE-2025-46712-2.patch BuildRequires: gcc gcc-c++ flex make %if %{with doc} @@ -1761,6 +1764,9 @@ useradd -r -g epmd -d /dev/null -s /sbin/nologin \ %endif %changelog +* Fri May 09 2025 yaoxin <1024769339@qq.com> - 25.3.2.6-7 +- Fix CVE-2025-46712 + * Sat Apr 26 2025 Funda Wang - 25.3.2.6-6 - fix CVE-2025-32433