Ada binding: add support for PSK client callback

mgrojo · mgrojo · commit 11a40a610e84 · 2025-01-04T20:03:04.000+01:00
Tested with:
`wolfSSL/wolfssl-examples/psk/server-psk.c`
after changing `DTLSv1_3_Client_Method` to `DTLSv1_2_Client_Method` to comply with the server example.
diff --git a/wrapper/Ada/tls_client.adb b/wrapper/Ada/tls_client.adb
@@ -23,7 +23,8 @@
 with Ada.Characters.Handling;
 with Ada.Strings.Bounded;
 with Ada.Text_IO;
-with Interfaces.C;
+with Ada.Directories;
+with Interfaces.C.Strings;
 
 with SPARK_Terminal;
 
@@ -40,8 +41,62 @@ package body Tls_Client with SPARK_Mode is
 
    subtype Byte_Type is WolfSSL.Byte_Type;
 
+   subtype chars_ptr is WolfSSL.chars_ptr;
+   subtype unsigned is WolfSSL.unsigned;
+
    package Natural_IO is new Ada.Text_IO.Integer_IO (Natural);
 
+   function PSK_Client_Callback
+     (Unused         : WolfSSL.WolfSSL_Type;
+      Hint           : chars_ptr;
+      Identity       : chars_ptr;
+      Id_Max_Length  : unsigned;
+      Key            : chars_ptr;
+      Key_Max_Length : unsigned) return unsigned
+   with Convention => C;
+
+   function PSK_Client_Callback
+     (Unused         : WolfSSL.WolfSSL_Type;
+      Hint           : chars_ptr;
+      Identity       : chars_ptr;
+      Id_Max_Length  : unsigned;
+      Key            : chars_ptr;
+      Key_Max_Length : unsigned) return unsigned
+   with
+     SPARK_Mode => Off      
+   is
+      use type Interfaces.C.unsigned;
+
+      Hint_String : constant String := Interfaces.C.Strings.Value (Hint);
+      Identity_String : constant String := "Client_identity";
+      Key_String : constant String :=
+        Character'Val   (26)
+        & Character'Val (43)
+        & Character'Val (60)
+        & Character'Val (77);
+   begin
+
+      Ada.Text_IO.Put_Line ("Hint: " & Hint_String);
+
+      pragma Assert (Id_Max_Length >= Identity_String'Length);
+
+      Interfaces.C.Strings.Update
+        (Item   => Identity,
+         Offset => 0,
+         Str    => Identity_String,
+         Check  => False);
+
+      pragma Assert (Key_Max_Length >= Key_String'Length);
+
+      Interfaces.C.Strings.Update
+        (Item   => Key,
+         Offset => 0,
+         Str    => Key_String,
+         Check  => False);
+
+      return Key_String'Length;
+   end PSK_Client_Callback;
+
    procedure Put (Text : String) is
    begin
       Ada.Text_IO.Put (Text);
@@ -221,49 +276,53 @@ package body Tls_Client with SPARK_Mode is
          (Context => Ctx,
           Mode    => WolfSSL.Verify_Peer or WolfSSL.Verify_Fail_If_No_Peer_Cert);
 
-      --  Load client certificate 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 (C);
-         WolfSSL.Free (Context => Ctx);
-         Set (Exit_Status_Failure);
-         return;
-      end if;
+      if Ada.Directories.Exists (CERT_FILE) and then
+         Ada.Directories.Exists (KEY_FILE) then
 
-      --  Load client 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 (C);
-         WolfSSL.Free (Context => Ctx);
-         Set (Exit_Status_Failure);
-         return;
-      end if;
+         --  Load client certificate 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 (C);
+            WolfSSL.Free (Context => Ctx);
+            Set (Exit_Status_Failure);
+            return;
+         end if;
 
-      --  Load CA certificate 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 (C);
-         WolfSSL.Free (Context => Ctx);
-         Set (Exit_Status_Failure);
-         return;
+         --  Load client 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 (C);
+            WolfSSL.Free (Context => Ctx);
+            Set (Exit_Status_Failure);
+            return;
+         end if;
+
+         --  Load CA certificate 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 (C);
+            WolfSSL.Free (Context => Ctx);
+            Set (Exit_Status_Failure);
+            return;
+         end if;
       end if;
 
       --  Create a WOLFSSL object.
@@ -276,6 +335,15 @@ package body Tls_Client with SPARK_Mode is
          return;
       end if;
 
+      if not (Ada.Directories.Exists (CERT_FILE) and then
+              Ada.Directories.Exists (KEY_FILE)) then
+
+         -- Use PSK for authentication.
+         WolfSSL.Set_PSK_Client_Callback
+           (Ssl      => Ssl,
+            Callback => PSK_Client_Callback'Access);
+      end if;
+
       if DTLS then
          Result := WolfSSL.DTLS_Set_Peer(Ssl     => Ssl,
                                          Address => A);
diff --git a/wrapper/Ada/wolfssl.adb b/wrapper/Ada/wolfssl.adb
@@ -577,6 +577,21 @@ package body WolfSSL is
 
    end DTLS_Set_Peer;
 
+   procedure WolfSSL_Set_Psk_Client_Callback
+     (Ssl : WolfSSL_Type;
+      Cb  : PSK_Client_Callback)
+   with
+     Convention    => C,
+     External_Name => "wolfSSL_set_psk_client_callback",
+     Import        => True;
+
+   procedure Set_PSK_Client_Callback
+     (Ssl      : WolfSSL_Type;
+      Callback : PSK_Client_Callback) is
+   begin
+      WolfSSL_Set_Psk_Client_Callback (Ssl, Callback);
+   end Set_PSK_Client_Callback;
+
    function WolfSSL_Set_Fd (Ssl : WolfSSL_Type; Fd : int) return int with
      Convention    => C,
      External_Name => "wolfSSL_set_fd",
diff --git a/wrapper/Ada/wolfssl.ads b/wrapper/Ada/wolfssl.ads
@@ -20,7 +20,7 @@
 --
 
 with GNAT.Sockets;
-with Interfaces.C;
+with Interfaces.C.Strings;
 
 --  This package is annotated "with SPARK_Mode" that SPARK can verify
 --  the API of this package is used correctly.
@@ -39,7 +39,10 @@ package WolfSSL with SPARK_Mode is
    --  Doesn't have to be called, though it will free any resources
    --  used by the library.
 
+   subtype unsigned is Interfaces.C.unsigned;
+
    subtype char_array is Interfaces.C.char_array;  --  Remove?
+   subtype chars_ptr is Interfaces.C.Strings.chars_ptr;
 
    subtype Byte_Type  is Interfaces.C.char;
    subtype Byte_Index is Interfaces.C.size_t range 0 .. 16_000;
@@ -297,6 +300,31 @@ package WolfSSL with SPARK_Mode is
    --  This function wraps the corresponding WolfSSL C function to allow
    --  clients to use Ada socket types when implementing a DTLS client.
 
+   type PSK_Client_Callback is access function
+     (Ssl            : WolfSSL_Type;
+      Hint           : chars_ptr;
+      Identity       : chars_ptr;
+      Id_Max_Length  : unsigned;
+      Key            : chars_ptr;
+      Key_Max_Length : unsigned)
+      return unsigned with
+     Convention => C;
+     --  Return value is the key length on success or zero on error.
+     --  parameters:
+     --  Ssl - Pointer to the wolfSSL structure
+     --  Hint - A stored string that could be displayed to provide a
+     --         hint to the user.
+     --  Identity - The ID will be stored here.
+     --  Id_Max_Length - Size of the ID buffer.
+     --  Key - The key will be stored here.
+     --  Key_Max_Length - The max size of the key.
+
+   procedure Set_PSK_Client_Callback
+     (Ssl      : WolfSSL_Type;
+      Callback : PSK_Client_Callback) with
+     Pre => Is_Valid (Ssl);
+     -- Sets the PSK client side callback.
+
    function Attach (Ssl    : WolfSSL_Type;
                     Socket : Integer)
                     return Subprogram_Result with
