Ada binding: add support for the PSK server callbacks

Plus fix location of the certificate files in the examples.

Tested with both Ada examples:
```
obj/tls_server_main --psk
obj/tls_client_main 127.0.0.1 --psk
```
This commit is contained in:
mgrojo
2025-01-09 00:11:01 +01:00
parent 815f99d0c2
commit 8122181e45
4 changed files with 199 additions and 70 deletions

View File

@ -168,9 +168,9 @@ package body Tls_Client with SPARK_Mode is
Any_Inet_Addr : Inet_Addr_Type renames SPARK_Sockets.Any_Inet_Addr;
CERT_FILE : constant String := "../../../certs/client-cert.pem";
KEY_FILE : constant String := "../../../certs/client-key.pem";
CA_FILE : constant String := "../../../certs/ca-cert.pem";
CERT_FILE : constant String := "../../certs/client-cert.pem";
KEY_FILE : constant String := "../../certs/client-key.pem";
CA_FILE : constant String := "../../certs/ca-cert.pem";
subtype Byte_Array is WolfSSL.Byte_Array;
@ -223,11 +223,10 @@ package body Tls_Client with SPARK_Mode is
return;
end if;
DTLS := (SPARK_Terminal.Argument_Count = 2 and then
Argument (2) = "--dtls");
PSK := (SPARK_Terminal.Argument_Count = 2 and then
Argument (2) = "--psk");
if Argument_Count = 2 then
DTLS := (Argument (2) = "--dtls");
PSK := (Argument (2) = "--psk");
end if;
if DTLS then
SPARK_Sockets.Create_Datagram_Socket (C);
@ -348,7 +347,6 @@ package body Tls_Client with SPARK_Mode is
end if;
if PSK then
-- Use PSK for authentication.
WolfSSL.Set_PSK_Client_Callback
(Ssl => Ssl,

View File

@ -24,6 +24,8 @@ with Ada.Characters.Handling;
with Ada.Strings.Bounded;
with Ada.Text_IO.Bounded_IO;
with Interfaces.C.Strings;
with SPARK_Terminal; pragma Elaborate_All (SPARK_Terminal);
package body Tls_Server with SPARK_Mode is
@ -35,6 +37,9 @@ package body Tls_Server with SPARK_Mode is
Success : WolfSSL.Subprogram_Result renames WolfSSL.Success;
subtype chars_ptr is WolfSSL.chars_ptr;
subtype unsigned is WolfSSL.unsigned;
procedure Put (Char : Character) is
begin
Ada.Text_IO.Put (Char);
@ -87,14 +92,66 @@ package body Tls_Server with SPARK_Mode is
Any_Inet_Addr : Inet_Addr_Type renames SPARK_Sockets.Any_Inet_Addr;
CERT_FILE : constant String := "../../../certs/server-cert.pem";
KEY_FILE : constant String := "../../../certs/server-key.pem";
CA_FILE : constant String := "../../../certs/client-cert.pem";
CERT_FILE : constant String := "../../certs/server-cert.pem";
KEY_FILE : constant String := "../../certs/server-key.pem";
CA_FILE : constant String := "../../certs/client-cert.pem";
subtype Byte_Array is WolfSSL.Byte_Array;
Reply : constant Byte_Array := "I hear ya fa shizzle!";
function PSK_Server_Callback
(Unused : WolfSSL.WolfSSL_Type;
Identity : chars_ptr;
Key : chars_ptr;
Key_Max_Length : unsigned) return unsigned
with Convention => C;
function PSK_Server_Callback
(Unused : WolfSSL.WolfSSL_Type;
Identity : chars_ptr;
Key : chars_ptr;
Key_Max_Length : unsigned) return unsigned
with
SPARK_Mode => Off
is
use type Interfaces.C.unsigned;
-- Identity is OpenSSL testing default for openssl s_client, keep same
Identity_String : constant String := "Client_identity";
-- Test key in hex is 0x1a2b3c4d, in decimal 439,041,101
Key_String : constant String :=
Character'Val (26)
& Character'Val (43)
& Character'Val (60)
& Character'Val (77);
-- These values are aligned with test values in wolfssl/wolfssl/test.h
-- and wolfssl-examples/psk/server-psk.c for testing interoperability.
begin
if Interfaces.C.Strings.Value
(Item => Identity,
Length => Identity_String'Length) /= Identity_String or else
Key_Max_Length < Key_String'Length
then
return 0;
end if;
put_line (Interfaces.C.Strings.Value
(Item => Identity,
Length => Identity_String'Length) );
Interfaces.C.Strings.Update
(Item => Key,
Offset => 0,
Str => Key_String,
Check => False);
return Key_String'Length;
end PSK_Server_Callback;
procedure Run (Ssl : in out WolfSSL.WolfSSL_Type;
Ctx : in out WolfSSL.Context_Type;
L : in out SPARK_Sockets.Optional_Socket;
@ -105,7 +162,7 @@ package body Tls_Server with SPARK_Mode is
Ch : Character;
Result : WolfSSL.Subprogram_Result;
DTLS : Boolean;
DTLS, PSK : Boolean;
Shall_Continue : Boolean := True;
Input : WolfSSL.Read_Result;
@ -119,14 +176,18 @@ package body Tls_Server with SPARK_Mode is
end if;
if SPARK_Terminal.Argument_Count > 1
or (SPARK_Terminal.Argument_Count = 1
and then SPARK_Terminal.Argument (1) /= "--dtls")
or (SPARK_Terminal.Argument_Count = 1 and then
SPARK_Terminal.Argument (1) /= "--dtls" and then
SPARK_Terminal.Argument (1) /= "--psk")
then
Put_Line ("usage: tls_server_main [--dtls]");
Put_Line ("usage: tls_server_main [--dtls | --psk]");
return;
end if;
DTLS := (SPARK_Terminal.Argument_Count = 1);
if SPARK_Terminal.Argument_Count = 1 then
DTLS := (SPARK_Terminal.Argument (1) = "--dtls");
PSK := (SPARK_Terminal.Argument (1) = "--psk");
end if;
if DTLS then
SPARK_Sockets.Create_Datagram_Socket (Socket => L);
@ -197,63 +258,73 @@ package body Tls_Server with SPARK_Mode is
return;
end if;
-- Require mutual authentication.
WolfSSL.Set_Verify
(Context => Ctx,
Mode => WolfSSL.Verify_Peer or WolfSSL.Verify_Fail_If_No_Peer_Cert);
if not PSK then
-- Require mutual authentication.
WolfSSL.Set_Verify
(Context => Ctx,
Mode => WolfSSL.Verify_Peer or WolfSSL.Verify_Fail_If_No_Peer_Cert);
-- Check verify is set correctly (GitHub #7461)
if WolfSSL.Get_Verify(Context => Ctx) /= (WolfSSL.Verify_Peer or WolfSSL.Verify_Fail_If_No_Peer_Cert) then
Put ("Error: Verify does not match requested");
New_Line;
return;
-- Check verify is set correctly (GitHub #7461)
if WolfSSL.Get_Verify(Context => Ctx) /= (WolfSSL.Verify_Peer or WolfSSL.Verify_Fail_If_No_Peer_Cert) then
Put ("Error: Verify does not match requested");
New_Line;
return;
end if;
-- Load server certificates into WOLFSSL_CTX.
Result := WolfSSL.Use_Certificate_File (Context => Ctx,
File => CERT_FILE,
Format => WolfSSL.Format_Pem);
if Result /= Success then
Put ("ERROR: failed to load ");
Put (CERT_FILE);
Put (", please check the file.");
New_Line;
SPARK_Sockets.Close_Socket (L);
WolfSSL.Free (Context => Ctx);
Set (Exit_Status_Failure);
return;
end if;
-- Load server key into WOLFSSL_CTX.
Result := WolfSSL.Use_Private_Key_File (Context => Ctx,
File => KEY_FILE,
Format => WolfSSL.Format_Pem);
if Result /= Success then
Put ("ERROR: failed to load ");
Put (KEY_FILE);
Put (", please check the file.");
New_Line;
SPARK_Sockets.Close_Socket (L);
WolfSSL.Free (Context => Ctx);
Set (Exit_Status_Failure);
return;
end if;
-- Load client certificate as "trusted" into WOLFSSL_CTX.
Result := WolfSSL.Load_Verify_Locations (Context => Ctx,
File => CA_FILE,
Path => "");
if Result /= Success then
Put ("ERROR: failed to load ");
Put (CA_FILE);
Put (", please check the file.");
New_Line;
SPARK_Sockets.Close_Socket (L);
WolfSSL.Free (Context => Ctx);
Set (Exit_Status_Failure);
return;
end if;
end if;
-- Load server certificates into WOLFSSL_CTX.
Result := WolfSSL.Use_Certificate_File (Context => Ctx,
File => CERT_FILE,
Format => WolfSSL.Format_Pem);
if Result /= Success then
Put ("ERROR: failed to load ");
Put (CERT_FILE);
Put (", please check the file.");
New_Line;
SPARK_Sockets.Close_Socket (L);
WolfSSL.Free (Context => Ctx);
Set (Exit_Status_Failure);
return;
if PSK then
-- Use PSK for authentication.
WolfSSL.Set_Context_PSK_Server_Callback
(Context => Ctx,
Callback => PSK_Server_Callback'Access);
end if;
-- Load server key into WOLFSSL_CTX.
Result := WolfSSL.Use_Private_Key_File (Context => Ctx,
File => KEY_FILE,
Format => WolfSSL.Format_Pem);
if Result /= Success then
Put ("ERROR: failed to load ");
Put (KEY_FILE);
Put (", please check the file.");
New_Line;
SPARK_Sockets.Close_Socket (L);
WolfSSL.Free (Context => Ctx);
Set (Exit_Status_Failure);
return;
end if;
-- Load client certificate as "trusted" into WOLFSSL_CTX.
Result := WolfSSL.Load_Verify_Locations (Context => Ctx,
File => CA_FILE,
Path => "");
if Result /= Success then
Put ("ERROR: failed to load ");
Put (CA_FILE);
Put (", please check the file.");
New_Line;
SPARK_Sockets.Close_Socket (L);
WolfSSL.Free (Context => Ctx);
Set (Exit_Status_Failure);
return;
end if;
while Shall_Continue loop
pragma Loop_Invariant (not C.Exists);
pragma Loop_Invariant (not WolfSSL.Is_Valid (Ssl));

View File

@ -592,6 +592,36 @@ package body WolfSSL is
WolfSSL_Set_Psk_Client_Callback (Ssl, Callback);
end Set_PSK_Client_Callback;
procedure WolfSSL_Set_Psk_Server_Callback
(Ssl : WolfSSL_Type;
Cb : PSK_Server_Callback)
with
Convention => C,
External_Name => "wolfSSL_set_psk_server_callback",
Import => True;
procedure Set_PSK_Server_Callback
(Ssl : WolfSSL_Type;
Callback : PSK_Server_Callback) is
begin
WolfSSL_Set_Psk_Server_Callback (Ssl, Callback);
end Set_PSK_Server_Callback;
procedure WolfSSL_CTX_Set_Psk_Server_Callback
(Ctx : Context_Type;
Cb : PSK_Server_Callback)
with
Convention => C,
External_Name => "wolfSSL_CTX_set_psk_server_callback",
Import => True;
procedure Set_Context_PSK_Server_Callback
(Context : Context_Type;
Callback : PSK_Server_Callback) is
begin
WolfSSL_CTX_Set_Psk_Server_Callback (Context, Callback);
end Set_Context_PSK_Server_Callback;
function WolfSSL_Set_Fd (Ssl : WolfSSL_Type; Fd : int) return int with
Convention => C,
External_Name => "wolfSSL_set_fd",

View File

@ -328,6 +328,36 @@ package WolfSSL with SPARK_Mode is
Pre => Is_Valid (Ssl);
-- Sets the PSK client side callback.
type PSK_Server_Callback is access function
(Ssl : WolfSSL_Type;
Identity : chars_ptr;
Key : chars_ptr;
Key_Max_Length : unsigned)
return unsigned with
Convention => C;
-- Return value is the key length on success or zero on error.
-- PSK server callback parameters:
-- Ssl - Reference to the wolfSSL structure
-- Identity - The ID will be stored here.
-- Key - The key will be stored here.
-- Key_Max_Length - The max size of the key.
--
-- The implementation of this callback will need `SPARK_Mode => Off`
-- since it will require the code to use the C memory model.
procedure Set_PSK_Server_Callback
(Ssl : WolfSSL_Type;
Callback : PSK_Server_Callback) with
Pre => Is_Valid (Ssl);
-- Sets the PSK Server side callback.
procedure Set_Context_PSK_Server_Callback
(Context : Context_Type;
Callback : PSK_Server_Callback) with
Pre => Is_Valid (Context);
-- Sets the PSK callback for the server side in the WolfSSL Context.
function Attach (Ssl : WolfSSL_Type;
Socket : Integer)
return Subprogram_Result with