Skip to content

Commit

Permalink
Ada binding: add support for the PSK server callbacks
Browse files Browse the repository at this point in the history 
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
```
  • Loading branch information
@mgrojo
mgrojo committed Jan 8, 2025
1 parent 815f99d commit 8122181
Show file tree
Hide file tree
Showing 4 changed files with 197 additions and 68 deletions.
16 changes: 7 additions & 9 deletions wrapper/Ada/tls_client.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;

Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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,
Expand Down
189 changes: 130 additions & 59 deletions wrapper/Ada/tls_server.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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);
Expand Down Expand Up @@ -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;
Expand All @@ -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;
Expand All @@ -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);
Expand Down Expand Up @@ -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;
end if;
-- 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 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 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;
-- 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;

if PSK then
-- Use PSK for authentication.
WolfSSL.Set_Context_PSK_Server_Callback
(Context => Ctx,
Callback => PSK_Server_Callback'Access);
end if;

while Shall_Continue loop
pragma Loop_Invariant (not C.Exists);
pragma Loop_Invariant (not WolfSSL.Is_Valid (Ssl));
Expand Down
30 changes: 30 additions & 0 deletions wrapper/Ada/wolfssl.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand Down
30 changes: 30 additions & 0 deletions wrapper/Ada/wolfssl.ads
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit 8122181

Please sign in to comment.