Hi! How are you? With this patch it should be possible to force the handshake before any TLS read/write. This is required in order to retrieve the certificate information just after the connection were established and no information were exchanged. P.D.: Sorry for the whitespace changes! I forgot to disable the minor- mode in Emacs! cngimenez (2): Forcing handshake afer socket is accepted. Updating example to show client certificate when provided. src/example/server_example.adb | 203 +++++++++++++++++---------------- src/tls-contexts-server.adb | 105 +++++++++-------- 2 files changed, 164 insertions(+), 144 deletions(-) -- 2.34.4
Copy & paste the following snippet into your terminal to import this patchset into git:
curl -s https://lists.sr.ht/~nytpu/public-inbox/patches/36019/mbox | git am -3Learn more about email & git
From: cngimenez <cnngimenez@disroot.org> --- src/tls-contexts-server.adb | 105 +++++++++++++++++++----------------- 1 file changed, 57 insertions(+), 48 deletions(-) diff --git a/src/tls-contexts-server.adb b/src/tls-contexts-server.adb index 4a83f46..29f7179 100644 --- a/src/tls-contexts-server.adb +++ b/src/tls-contexts-server.adb @@ -1,9 +1,9 @@ --- The context used for making and managing Server connections. +-- The context used for making and managing Server connections. -- -- --- Copyright (c) 2022 nytpu <alex [at] nytpu.com> --- SPDX-License-Identifier: MPL-2.0 --- For more license details, see LICENSE or <https://www.mozilla.org/en-US/MPL/2.0/>. +-- Copyright (c) 2022 nytpu <alex [at] nytpu.com> +-- SPDX-License-Identifier: MPL-2.0 +-- For more license details, see LICENSE or <https://www.mozilla.org/en-US/MPL/2.0/>. pragma Ada_2012; @@ -13,49 +13,58 @@ pragma Style_Checks(Off, int); package body TLS.Contexts.Server is - package Bs renames libTLS_Bindings; - pragma Style_Checks(Off, Bs); - - - ---------------- - -- Accept_TLS -- - ---------------- - - procedure Accept_TLS - (Server_Ctx : Server_Context; Socket : Socket_Type; - Connected_Context : out Server_Context) - is - R : int; - begin - R := Bs.tls_accept_socket( - Server_Ctx.Context.Context, Connected_Context.Context.Context'Address, int(To_C(Socket)) - ); - if R = -1 then - raise Connect_Error - with "unable to enable tls on socket '" & - Image(Socket) & "': " & - Retrieve_Error_Message(Server_Ctx.Context); - end if; - Connected_Context.Context.Configured := True; - Connected_Context.Context.Connected := True; - end Accept_TLS; - - - -------------------- - -- SNI_Servername -- - -------------------- - - function SNI_Servername (Ctx : Server_Context) return String - is (To_String(Call_String_Function(Bs.tls_conn_servername'Access, Ctx.Context))); - - - ---------------- - -- Initialize -- - ---------------- - - overriding procedure Initialize (Object : in out Controlled_Mixin) is - begin - Initialize_Server(Object.Enclosing.Context); - end Initialize; + package Bs renames libTLS_Bindings; + pragma Style_Checks(Off, Bs); + + + ---------------- + -- Accept_TLS -- + ---------------- + + procedure Accept_TLS + (Server_Ctx : Server_Context; Socket : Socket_Type; + Connected_Context : out Server_Context) + is + R : int; + begin + R := Bs.tls_accept_socket( + Server_Ctx.Context.Context, Connected_Context.Context.Context'Address, int(To_C(Socket)) + ); + if R = -1 then + raise Connect_Error + with "unable to enable tls on socket '" & + Image(Socket) & "': " & + Retrieve_Error_Message(Server_Ctx.Context); + end if; + + R := Bs.tls_handshake(Connected_Context.Context.Context); + if R = -1 then + raise Connect_Error + with "unable to do tls handshake on socket '"& + Image(Socket) & "': " & + Retrieve_Error_Message(Server_Ctx.Context); + end if; + + Connected_Context.Context.Configured := True; + Connected_Context.Context.Connected := True; + end Accept_TLS; + + + -------------------- + -- SNI_Servername -- + -------------------- + + function SNI_Servername (Ctx : Server_Context) return String + is (To_String(Call_String_Function(Bs.tls_conn_servername'Access, Ctx.Context))); + + + ---------------- + -- Initialize -- + ---------------- + + overriding procedure Initialize (Object : in out Controlled_Mixin) is + begin + Initialize_Server(Object.Enclosing.Context); + end Initialize; end TLS.Contexts.Server; -- 2.34.4
From: cngimenez <cnngimenez@disroot.org> --- src/example/server_example.adb | 203 +++++++++++++++++---------------- 1 file changed, 107 insertions(+), 96 deletions(-) diff --git a/src/example/server_example.adb b/src/example/server_example.adb index a185a20..84d59d2 100644 --- a/src/example/server_example.adb +++ b/src/example/server_example.adb @@ -1,118 +1,129 @@ --- A simplistic TLS server example. --- Use with the client example by running the server and then running the --- client like so: +-- A simplistic TLS server example. +-- Use with the client example by running the server and then running the +-- client like so: -- bin/client_example localhost 1965 -- -- --- Copyright (c) 2022 nytpu <alex [at] nytpu.com> --- SPDX-License-Identifier: MPL-2.0 --- For more license details, see LICENSE or <https://www.mozilla.org/en-US/MPL/2.0/>. +-- Copyright (c) 2022 nytpu <alex [at] nytpu.com> +-- SPDX-License-Identifier: MPL-2.0 +-- For more license details, see LICENSE or <https://www.mozilla.org/en-US/MPL/2.0/>. with Ada.Directories; use Ada.Directories; with Ada.Text_IO; use Ada.Text_IO; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with GNAT.Sockets; use GNAT.Sockets; -with TLS; with TLS.Configure; with TLS.Contexts; with TLS.Contexts.Server; procedure Server_Example is - ----------------------------- - -- Configuration constants -- - ----------------------------- + ----------------------------- + -- Configuration constants -- + ----------------------------- - Bind_Address : constant String := "0.0.0.0"; - Bind_Port : constant Port_Type := 1965; + Bind_Address : constant String := "0.0.0.0"; + Bind_Port : constant Port_Type := 1965; - -- These must be generated for the example to run. - -- The following command will generate a suitable cert and key: - -- openssl req -nodes -x509 -newkey rsa:4096 -sha256 -days 9999 \ - -- -subj '/CN=localhost' -keyout key.pem -out cert.pem - Cert_File : constant String := Compose(Current_Directory, "cert", "pem"); - Key_File : constant String := Compose(Current_Directory, "key", "pem"); + -- These must be generated for the example to run. + -- The following command will generate a suitable cert and key: + -- openssl req -nodes -x509 -newkey rsa:4096 -sha256 -days 9999 \ + -- -subj '/CN=localhost' -keyout key.pem -out cert.pem + Cert_File : constant String := Compose(Current_Directory, "cert", "pem"); + Key_File : constant String := Compose(Current_Directory, "key", "pem"); - --------------- - -- Variables -- - --------------- + --------------- + -- Variables -- + --------------- - Conf : TLS.Configure.Config; - Address : Sock_Addr_Type; - Server_Socket : Socket_Type; - Server_TLS : aliased TLS.Contexts.Server.Server_Context; + Conf : TLS.Configure.Config; + Address : Sock_Addr_Type; + Server_Socket : Socket_Type; + Server_TLS : aliased TLS.Contexts.Server.Server_Context; begin - Put_Line("Binding to '" & Bind_Address & "'"); - Put_Line("Press Control-C to exit."); - - -- Set up the unencrypted socket and then listen for incoming connections - -- Basically taken from the example given in GNAT.Sockets, so there'll be a - -- better explaination there: - -- <https://en.wikibooks.org/wiki/Ada_Programming/Libraries/GNAT.Sockets> - Address.Addr := Inet_Addr(Bind_Address); - Address.Port := Bind_Port; - Create_Socket(Server_Socket); - Set_Socket_Option(Server_Socket, Socket_Level, (Reuse_Address, True)); - Bind_Socket(Server_Socket, Address); - Listen_Socket(Server_Socket); - - -- Configure the server - -- A server REQUIRES a Cert_File and Key_File to be specified - Conf.Cert_File := To_Unbounded_String(Cert_File); - Conf.Key_File := To_Unbounded_String(Key_File); - Server_TLS.Configure(Conf); - - -- Accept incoming connections and write output. If you were fancy you - -- could dispatch incoming connections to tasks instead of dealing with - -- them sequentially like here. - loop - declare - Connection_Socket : Socket_Type; - Connection_TLS : aliased TLS.Contexts.Server.Server_Context; - begin - -- First accept the unencrypted connection. If you allow - -- unencrypted connections then do whatever you need to here to - -- check if TLS should be enabled. - Accept_Socket(Server_Socket, Connection_Socket, Address); - - -- Upgrade the socket to an encrypted connection - TLS.Contexts.Server.Accept_TLS(Server_TLS, Connection_Socket, Connection_TLS); - - Put_Line("Got connection from '" & Image(Address.Addr) & "'!"); - - -- Read request header (and discard). Read/write work exactly the - -- same as for Client_Contexts - declare - E : Boolean; - S : constant String := - TLS.Get_Delim(Connection_TLS'Access, ASCII.CR & ASCII.LF, E, 1024); - begin - if not E then - Put_Line("Malformed request: " & S); - String'Write( - Connection_TLS'Access, - "59 malformed request" & ASCII.CR & ASCII.LF - ); - else - String'Write( - Connection_TLS'Access, - "20 text/gemini;charset=utf-8" & - ASCII.CR & ASCII.LF & - "hello, world!" & ASCII.LF - ); - end if; - end; - - Connection_TLS.Close; - Close_Socket(Connection_Socket); - end; - end loop; - - -- To avoid complicating the example don't have a signal handler, but in a - -- real server you should add a signal handler that would close these - -- before exiting. - Server_TLS.Close; - Close_Socket(Server_Socket); + Put_Line("Binding to '" & Bind_Address & "'"); + Put_Line("Press Control-C to exit."); + + -- Set up the unencrypted socket and then listen for incoming connections + -- Basically taken from the example given in GNAT.Sockets, so there'll be a + -- better explaination there: + -- <https://en.wikibooks.org/wiki/Ada_Programming/Libraries/GNAT.Sockets> + Address.Addr := Inet_Addr(Bind_Address); + Address.Port := Bind_Port; + Create_Socket(Server_Socket); + Set_Socket_Option(Server_Socket, Socket_Level, (Reuse_Address, True)); + Bind_Socket(Server_Socket, Address); + Listen_Socket(Server_Socket); + + -- Configure the server + -- A server REQUIRES a Cert_File and Key_File to be specified + Conf.Cert_File := To_Unbounded_String(Cert_File); + Conf.Key_File := To_Unbounded_String(Key_File); + + -- Client certificate validation: client certificate should be Optional + -- also it should not be verified (most of them are self-signed and + -- maybe expired!). + Conf.Verify_Client_Cert := TLS.Configure.Optional; + Conf.Verify_Certs := False; + Conf.Verify_Expirys := False; + + -- Apply the configuration. + Server_TLS.Configure(Conf); + + -- Accept incoming connections and write output. If you were fancy you + -- could dispatch incoming connections to tasks instead of dealing with + -- them sequentially like here. + loop + declare + Connection_Socket : Socket_Type; + Connection_TLS : aliased TLS.Contexts.Server.Server_Context; + begin + Put_Line ("Listening..."); + Flush; + -- First accept the unencrypted connection. If you allow + -- unencrypted connections then do whatever you need to here to + -- check if TLS should be enabled. + Accept_Socket(Server_Socket, Connection_Socket, Address); + + -- Upgrade the socket to an encrypted connection + TLS.Contexts.Server.Accept_TLS(Server_TLS, Connection_Socket, Connection_TLS); + + Put_Line("Got connection from '" & Image(Address.Addr) & "'!"); + if TLS.Contexts.Peer_Certificate_Provided + (TLS.Contexts.Context (Connection_TLS)) + then + Put_Line ("Certificate provided:"); + Put_Line ("Hash: " + & To_String (TLS.Contexts.Get_Certificate_Info + (TLS.Contexts.Context (Connection_TLS)).Hash)); + Put_Line ("Issuer: " + & To_String (TLS.Contexts.Get_Certificate_Info + (TLS.Contexts.Context (Connection_TLS)).Issuer)); + Put_Line ("Subject: " + & To_String (TLS.Contexts.Get_Certificate_Info + (TLS.Contexts.Context (Connection_TLS)).Subject)); + else + Put_Line ("Certificate not provided."); + end if; + + -- Read/write work exactly the same as for Client_Contexts + String'Write( + Connection_TLS'Access, + "20 text/gemini;charset=utf-8" & + ASCII.CR & ASCII.LF & + "hello, world!" & ASCII.LF + ); + + Connection_TLS.Close; + Close_Socket(Connection_Socket); + end; + end loop; + + -- To avoid complicating the example don't have a signal handler, but in a + -- real server you should add a signal handler that would close these + -- before exiting. + Server_TLS.Close; + Close_Socket(Server_Socket); end Server_Example; -- 2.34.4