Add kTLS/inet_drv with cryptcookie setup to the repertoire

8 files changed, 327 insertions, 45 deletions

diff --git a/lib/kernel/src/inet_epmd_dist.erl b/lib/kernel/src/inet_epmd_dist.erl
index 1f7a10e288..94ee50193f 100644
--- a/lib/kernel/src/inet_epmd_dist.erl
+++ b/lib/kernel/src/inet_epmd_dist.erl
@@ -27,7 +27,7 @@
          connect/3]).
 %% DistMod helper API
 -export([check_ip/2, wait_for_code_server/1,
-         f_address/2, tick/1, getstat/1, setopts/2, getopts/2,
+         hs_data/2, f_address/2, tick/1, getstat/1, setopts/2, getopts/2,
          nodelay/0, merge_options/3]).
 
 %% net_kernel and dist_util distribution Module API
@@ -156,7 +156,7 @@ flush_to(Socket, Pid) ->
 
 %% ------------------------------------------------------------
 accepted(NetAddress, _Timer, Socket) ->
-    hs_data(Socket, NetAddress).
+    hs_data(NetAddress, Socket).
 
 %% ------------------------------------------------------------
 connect(NetAddress, _Timer, Options) ->
@@ -166,14 +166,14 @@ connect(NetAddress, _Timer, Options) ->
     maybe
         {ok, Socket} ?=
             ?DRIVER:connect(Ip, Port, ConnectOptions),
-        hs_data(Socket, NetAddress)
+        hs_data(NetAddress, Socket)
     else
         {error, _} = Error ->
             Error
     end.
 
 %% -------
-hs_data(Socket, NetAddress) ->
+hs_data(NetAddress, Socket) ->
     Nodelay = nodelay(),
     #hs_data{
        socket = Socket,
@@ -181,33 +181,37 @@ hs_data(Socket, NetAddress) ->
        f_recv = fun ?DRIVER:recv/3,
        f_setopts_pre_nodeup =
            fun (S) when S =:= Socket ->
-                   inet:setopts(
-                     S,
-                     [{active, false}, {packet, 4}, Nodelay])
+                   f_setopts_pre_nodeup(S, Nodelay)
            end,
        f_setopts_post_nodeup =
            fun (S) when S =:= Socket ->
-                   inet:setopts(
-                     S,
-                     [{active, true}, {packet,4},
-                      {deliver, port}, binary, Nodelay])
+                   f_setopts_post_nodeup(S, Nodelay)
+           end,
+       f_address =
+           fun (S, Node) when S =:= Socket ->
+                   f_address(NetAddress, Node)
            end,
-       f_address  = f_address(Socket, NetAddress),
        f_getll    = fun inet:getll/1,
        mf_tick    = fun ?MODULE:tick/1,
        mf_getstat = fun ?MODULE:getstat/1,
        mf_setopts = fun ?MODULE:setopts/2,
        mf_getopts = fun ?MODULE:getopts/2 }.
 
-f_address(Socket, NetAddress) ->
-    fun (S, Node) when S =:= Socket ->
-            case dist_util:split_node(Node) of
-                {node, _Name, Host} ->
-                    NetAddress#net_address{
-                      host = Host };
-                Other ->
-                    ?shutdown2(Node, {split_node, Other})
-            end
+f_setopts_pre_nodeup(Socket, Nodelay) ->
+    inet:setopts(Socket, [{active, false}, {packet, 4}, Nodelay]).
+
+f_setopts_post_nodeup(Socket, Nodelay) ->
+    inet:setopts(
+      Socket,
+      [{active, true}, {packet,4}, {deliver, port}, binary, Nodelay]).
+
+f_address(NetAddress, Node) ->
+    case dist_util:split_node(Node) of
+        {node, _Name, Host} ->
+            NetAddress#net_address{
+              host = Host };
+        Other ->
+            ?shutdown2(Node, {split_node, Other})
     end.
 
 tick(Socket) when is_port(Socket) ->
diff --git a/lib/kernel/src/inet_epmd_socket.erl b/lib/kernel/src/inet_epmd_socket.erl
index 49a56f84d0..cabd8c57c6 100644
--- a/lib/kernel/src/inet_epmd_socket.erl
+++ b/lib/kernel/src/inet_epmd_socket.erl
@@ -187,7 +187,10 @@ start_dist_ctrl(NetAddress, Socket) ->
 %%%                    socket:setopt(S, {otp,debug}, true)
 %%%            end,
        f_setopts_post_nodeup = f_ok(Socket),
-       f_address = inet_epmd_dist:f_address(Socket, NetAddress),
+       f_address =
+           fun (S, Node) when S =:= Socket ->
+                   inet_epmd_dist:f_address(NetAddress, Node)
+           end,
        f_getll =
            fun (S) when S =:= Socket ->
                    {ok, DistCtrl}
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index e27e3870c7..6db638d927 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -100,6 +100,7 @@ MODULES = \
 	dist_cryptcookie \
 	cryptcookie \
 	inet_epmd_inet_cryptcookie \
+	inet_epmd_inet_ktls_cryptcookie \
 	inet_epmd_socket_cryptcookie \
 	openssl_ocsp_SUITE \
 	tls_server_session_ticket_SUITE \
diff --git a/lib/ssl/test/cryptcookie.erl b/lib/ssl/test/cryptcookie.erl
index 28a539f061..1d166fc64c 100644
--- a/lib/ssl/test/cryptcookie.erl
+++ b/lib/ssl/test/cryptcookie.erl
@@ -26,8 +26,15 @@
 -feature(maybe_expr, enable).
 
 -export([supported/0, start_keypair_server/0, init/1, init/2,
-         encrypt_and_send_chunk/4, recv_and_decrypt_chunk/2,
-         record_to_map/2]).
+         encrypt_and_send_chunk/4, recv_and_decrypt_chunk/2]).
+
+%% For kTLS integration
+-export([ktls_info/2]).
+-include_lib("ssl/src/ssl_cipher.hrl").
+-include_lib("ssl/src/ssl_internal.hrl").
+
+
+-define(PROTOCOL, (?MODULE)).
 
 %% -------------------------------------------------------------------------
 %% The curve choice greatly affects setup time,
@@ -40,9 +47,14 @@
 %%
 %%% -define(CURVE, brainpoolP384t1).
 %%% -define(CURVE, brainpoolP256t1).
--define(CURVE, secp256r1). % Portability
--define(CIPHER, aes_gcm).  % kTLS
--define(HMAC, sha256).     % kTLS
+-define(CURVE, secp256r1).     % Portability
+-define(CIPHER, aes_256_gcm).  % kTLS compatible
+-define(HMAC, sha384).
+
+%% kTLS integration
+-define(TLS_VERSION, {3,4}).
+-define(CIPHER_SUITE, (?TLS_AES_256_GCM_SHA384)).
+
 
 supported() ->
     maybe
@@ -116,7 +128,9 @@ start_keypair_server() ->
                           ok
                   end
           end),
-    receive Ref -> ok end.
+    receive Ref ->
+            ?PROTOCOL
+    end.
 
 keypair_server() ->
     keypair_server(undefined, 1).
@@ -248,6 +262,8 @@ compute_shared_secret(
 %% -------------------------------------------------------------------------
 %% Initialize encryption on Stream; initial handshake
 %%
+%% init(Stream, Secret) ->
+%%     {NewStream, ChunkSize, [RecvSeq|RecvParams], [SendSeq|SendParams]}.
 
 init(Stream) ->
     Secret = atom_to_binary(auth:get_cookie(), latin1),
@@ -649,14 +665,40 @@ decrypt_rekey(
 
 
 %% -------------------------------------------------------------------------
+ktls_info(
+  [RecvSeq |
+   #params{
+      iv = {RecvSalt, RecvIV},
+      key = RecvKey,
+      aead_cipher = ?CIPHER } = _RecvParams],
+  [SendSeq |
+   #params{
+      iv = {SendSalt, SendIV},
+      key = SendKey,
+      aead_cipher = ?CIPHER } = _SendParams]) ->
+    %%
+    RecvState =
+        #cipher_state{
+           key = <<RecvKey/bytes>>,
+           iv = <<RecvSalt/bytes, (RecvIV + RecvSeq):48>> },
+    SendState =
+        #cipher_state{
+           key = <<SendKey/bytes>>,
+           iv = <<SendSalt/bytes, (SendIV + SendSeq):48>> },
+    #{ tls_version => ?TLS_VERSION,
+       cipher_suite => ?CIPHER_SUITE,
+       read_state => RecvState,
+       read_seq => RecvSeq,
+       write_state => SendState,
+       write_seq => SendSeq }.
 
--define(RECORD_TO_MAP(Name, Record),
-        record_to_map(Name, Record = #Name{}) ->
-               record_to_map(record_info(fields, Name), Record, 2, #{})).
 
-%%%record_to_map(params, Record = #params{}) ->
-%%%    record_to_map(record_info(fields, params), Record, 2, #{}).
-?RECORD_TO_MAP(params, Record).
+%% -------------------------------------------------------------------------
+-ifdef(undefined).
+-define(RECORD_TO_MAP(Name),
+        record_to_map(Record) when element(1, (Record)) =:= (Name) ->
+               record_to_map(record_info(fields, Name), Record, 2, #{})).
+?RECORD_TO_MAP(params).
 %%
 record_to_map([Field | Fields], Record, Index, Map) ->
     record_to_map(
@@ -664,6 +706,7 @@ record_to_map([Field | Fields], Record, Index, Map) ->
       Map#{ Field => element(Index, Record) });
 record_to_map([], _Record, _Index, Map) ->
     Map.
+-endif.
 
 timestamp() ->
     erlang:monotonic_time(second).
diff --git a/lib/ssl/test/dist_cryptcookie.erl b/lib/ssl/test/dist_cryptcookie.erl
index 9f59d59607..7a17d262b8 100644
--- a/lib/ssl/test/dist_cryptcookie.erl
+++ b/lib/ssl/test/dist_cryptcookie.erl
@@ -36,15 +36,12 @@
 
 -include_lib("kernel/include/dist_util.hrl").
 
--define(PROTOCOL, cryptcookie).
-
 supported() ->
     cryptcookie:supported().
 
 %% ------------------------------------------------------------
 protocol() ->
-    cryptcookie:start_keypair_server(),
-    ?PROTOCOL.
+    cryptcookie:start_keypair_server().
 
 %% ------------------------------------------------------------
 start_dist_ctrl(Stream) ->
diff --git a/lib/ssl/test/inet_epmd_inet_ktls_cryptcookie.erl b/lib/ssl/test/inet_epmd_inet_ktls_cryptcookie.erl
new file mode 100644
index 0000000000..4a710adea1
--- /dev/null
+++ b/lib/ssl/test/inet_epmd_inet_ktls_cryptcookie.erl
@@ -0,0 +1,215 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2023. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%%     http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% -------------------------------------------------------------------------
+%%
+%% Plug-in module for inet_epmd distribution
+%% with cryptcookie over inet_tcp with kTLS offloading
+%%
+-module(inet_epmd_inet_ktls_cryptcookie).
+-feature(maybe_expr, enable).
+
+%% DistMod API
+-export([net_address/0, listen_open/2, listen_port/3, listen_close/1,
+         accept_open/2, accept_controller/3, accepted/3,
+         connect/3]).
+
+-export([supported/0]).
+
+%% Socket I/O Stream internal exports (export entry fun()s)
+-export([stream_recv/2, stream_send/2,
+         stream_controlling_process/2]).
+
+-include_lib("kernel/include/net_address.hrl").
+-include_lib("kernel/include/dist.hrl").
+-include_lib("kernel/include/dist_util.hrl").
+
+-define(FAMILY, inet).
+-define(DRIVER, inet_tcp).
+
+%% ------------------------------------------------------------
+net_address() ->
+    Family = ?DRIVER:family(),
+    Protocol = cryptcookie:start_keypair_server(),
+    #net_address{
+       protocol = Protocol,
+       family = Family }.
+
+%% ------------------------------------------------------------
+listen_open(_NetAddress, Options) ->
+    {ok,
+     inet_epmd_dist:merge_options(
+       Options,
+       [{active, false}, {mode, binary}, {packet, 0},
+        inet_epmd_dist:nodelay()],
+       [])}.
+
+%% ------------------------------------------------------------
+listen_port(_NetAddress, Port, ListenOptions) ->
+    maybe
+        {ok, ListenSocket} ?=
+            ?DRIVER:listen(Port, ListenOptions),
+        {ok, Address} ?=
+            inet:sockname(ListenSocket),
+        {ok, {ListenSocket, Address}}
+    end.
+
+%% ------------------------------------------------------------
+listen_close(ListenSocket) ->
+    ?DRIVER:close(ListenSocket).
+
+%% ------------------------------------------------------------
+accept_open(_NetAddress, ListenSocket) ->
+    maybe
+        {ok, Socket} ?=
+            ?DRIVER:accept(ListenSocket),
+        {ok, {Ip, _}} ?=
+            inet:sockname(Socket),
+        {ok, {PeerIp, _} = PeerAddress} ?=
+            inet:peername(Socket),
+        inet_epmd_dist:check_ip(Ip, PeerIp),
+        Stream = stream(Socket),
+        {_Stream_1, _ChunkSize, RecvCipherState, SendCipherState} =
+            cryptcookie:init(Stream),
+        KtlsInfo = inet_ktls_info(Socket, RecvCipherState, SendCipherState),
+        ok ?= inet_tls_dist:set_ktls(KtlsInfo),
+        ok ?= inet:setopts(Socket, [{packet, 2}, {mode, list}]),
+        {Socket, PeerAddress}
+    else
+        {error, Reason} ->
+            exit({accept, Reason})
+    end.
+
+%% ------------------------------------------------------------
+accept_controller(_NetAddress, Controller, Socket) ->
+    ok = ?DRIVER:controlling_process(Socket, Controller),
+    Socket.
+
+%% ------------------------------------------------------------
+accepted(NetAddress, _Timer, Socket) ->
+    inet_epmd_dist:hs_data(NetAddress, Socket).
+
+%% ------------------------------------------------------------
+connect(NetAddress, _Timer, Options) ->
+    ConnectOptions =
+        inet_epmd_dist:merge_options(
+          Options,
+          [{active, false}, {mode, binary}, {packet, 0},
+           inet_epmd_dist:nodelay()],
+          []),
+    #net_address{ address = {Ip, Port} } = NetAddress,
+    maybe
+        {ok, Socket} ?=
+            ?DRIVER:connect(Ip, Port, ConnectOptions),
+        Stream = stream(Socket),
+        {_Stream_1, _ChunkSize, RecvCipherState, SendCipherState} =
+            cryptcookie:init(Stream),
+        KtlsInfo = inet_ktls_info(Socket, RecvCipherState, SendCipherState),
+        ok ?= inet_tls_dist:set_ktls(KtlsInfo),
+        ok ?= inet:setopts(Socket, [{packet, 2}, {mode, list}]),
+        inet_epmd_dist:hs_data(NetAddress, Socket)
+    else
+        {error, _} = Error ->
+            Error
+    end.
+
+%% ------------------------------------------------------------
+%% A socket as an I/O Stream
+%%
+%%  Stream    :: {InStream, OutStream, ControllingProcessFun}.
+%%
+%%  InStream  :: [InFun | InState].
+%%  InFun     :: fun (InStream, Size) ->
+%%                   [Data | NewInStream] |
+%%                   [closed | DebugTerm]
+%%  NewInStream :: InStream
+%%  %% If Size == 0 and there is no pending input data;
+%%  %% return immediately with empty Data,
+%%  %% otherwise wait for Size bytes of data
+%%  %% or any amount of data > 0
+%%
+%%  OutStream :: [OutFun | OutState]
+%%  OutFun    :: fun (OutStream, Data) ->
+%%                   NewOutStream |
+%%                   [closed | DebugTerm]
+%%  NewOutStream :: OutStream
+%%
+%%  Data :: binary() or list(binary())
+%%
+%%  ControllingProcessFun :: fun (Stream, pid()) -> NewStream
+%%
+%%  NewSTream :: Stream
+
+stream(Socket) ->
+    {stream_in(Socket), stream_out(Socket),
+     fun ?MODULE:stream_controlling_process/2}.
+
+stream_in(Socket) ->
+    [fun ?MODULE:stream_recv/2 | Socket].
+
+stream_recv(InStream = [_ | Socket], Size) ->
+    case
+        if
+            Size =:= 0 ->
+                ?DRIVER:recv(Socket, 0, 0);
+            true ->
+                ?DRIVER:recv(Socket, Size, infinity)
+        end
+    of
+        {ok, Data} ->
+            [Data | InStream];
+        {error, timeout} ->
+            [<<>> | InStream];
+        {error, closed} ->
+            [closed | InStream];
+        {error, Reason} ->
+            erlang:error({?MODULE, ?FUNCTION_NAME, Reason})
+    end.
+
+stream_out(Socket) ->
+    [fun ?MODULE:stream_send/2 | Socket].
+
+stream_send(OutStream = [_ | Socket], Data) ->
+    case ?DRIVER:send(Socket, Data) of
+        ok ->
+            OutStream;
+        {error, closed} ->
+            [closed | OutStream];
+        {error, Reason} ->
+            erlang:error({?MODULE, ?FUNCTION_NAME, Reason, [OutStream, Data]})
+    end.
+
+stream_controlling_process(Stream = {_, [_ | Socket], _}, Pid) ->
+    %%
+    case ?DRIVER:controlling_process(Socket, Pid) of
+        ok ->
+            Stream;
+        {error, Reason} ->
+            erlang:error({?MODULE, ?FUNCTION_NAME, Reason})
+    end.
+
+%% ------------------------------------------------------------
+supported() ->
+    cryptcookie:supported().
+
+inet_ktls_info(Socket, RecvCipherState, SendCipherState) ->
+    (cryptcookie:ktls_info(RecvCipherState, SendCipherState))
+        #{ socket => Socket,
+           setopt_fun => fun inet_tls_dist:inet_ktls_setopt/3,
+           getopt_fun => fun inet_tls_dist:inet_ktls_getopt/3 }.
diff --git a/lib/ssl/test/inet_epmd_socket_cryptcookie.erl b/lib/ssl/test/inet_epmd_socket_cryptcookie.erl
index fbe3df0f98..a6e6ce4942 100644
--- a/lib/ssl/test/inet_epmd_socket_cryptcookie.erl
+++ b/lib/ssl/test/inet_epmd_socket_cryptcookie.erl
@@ -199,10 +199,14 @@ stream_recv(InStream = [_ | Socket], Size) ->
             stream_recv_error(InStream, Reason)
     end.
 
-stream_recv_error(InStream, closed) ->
-    [closed | InStream];
-stream_recv_error(_, Reason) ->
-    erlang:error({?MODULE, ?FUNCTION_NAME, Reason}).
+stream_recv_error(InStream, Reason) ->
+    if
+        Reason =:= closed;
+        Reason =:= econnreset ->
+            [closed | InStream];
+        true ->
+            erlang:error({?MODULE, ?FUNCTION_NAME, Reason})
+    end.
 
 stream_out(Socket) ->
     [fun ?MODULE:stream_send/2 | Socket].
diff --git a/lib/ssl/test/ssl_dist_bench_SUITE.erl b/lib/ssl/test/ssl_dist_bench_SUITE.erl
index 12f6aab0c1..2fb6044c49 100644
--- a/lib/ssl/test/ssl_dist_bench_SUITE.erl
+++ b/lib/ssl/test/ssl_dist_bench_SUITE.erl
@@ -73,8 +73,9 @@ groups() ->
      {ktls,   categories()},
      %%
      %% crypto_streams()
-     {crypto_socket, categories()},
-     {crypto_inet,   categories()},
+     {crypto_socket,    categories()},
+     {crypto_inet,      categories()},
+     {crypto_inet_ktls, categories()},
      %%
      %% categories()
      {setup, [{repeat, 1}],
@@ -106,7 +107,8 @@ encryption_backends() ->
 
 crypto_streams() ->
     [{group, crypto_socket},
-     {group, crypto_inet}].
+     {group, crypto_inet},
+     {group, crypto_inet_ktls}].
 
 categories() ->
     [{group, setup},
@@ -268,6 +270,19 @@ init_per_group(crypto_inet, Config) ->
         Class : Reason : Stacktrace ->
             {fail, {Class, Reason, Stacktrace}}
     end;
+init_per_group(crypto_inet_ktls, Config) ->
+    try inet_epmd_inet_cryptcookie:supported() of
+        ok ->
+            [{ssl_dist, false}, {ssl_dist_prefix, "Crypto-Inet-kTLS"},
+             {ssl_dist_args,
+              "-proto_dist inet_epmd -inet_epmd inet_ktls_cryptcookie"}
+            | Config];
+        Problem ->
+            {skip, Problem}
+    catch
+        Class : Reason : Stacktrace ->
+            {fail, {Class, Reason, Stacktrace}}
+    end;
 init_per_group(plain, Config) ->
     [{ssl_dist, false}, {ssl_dist_prefix, "Plain"}|Config];
 %%