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
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