Ada binding: add support for PSK client callback

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,68 @@ 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 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
+
+      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);
@@ -107,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;
 
@@ -144,6 +205,7 @@ package body Tls_Client with SPARK_Mode is
 
       Result : WolfSSL.Subprogram_Result;
       DTLS   : Boolean;
+      PSK    : Boolean;
    begin
       Result := WolfSSL.Initialize;
       if Result /= Success then
@@ -153,13 +215,18 @@ package body Tls_Client with SPARK_Mode is
 
       if Argument_Count < 1
          or Argument_Count > 2
-         or (Argument_Count = 2 and then Argument (2) /= "--dtls")
+         or (Argument_Count = 2 and then
+             Argument (2) /= "--dtls" and then
+             Argument (2) /= "--psk")
       then
-         Put_Line ("usage: tls_client_main <IPv4 address> [--dtls]");
+         Put_Line ("usage: tls_client_main <IPv4 address> [--dtls | --psk]");
          return;
       end if;
 
-      DTLS := (SPARK_Terminal.Argument_Count = 2);
+      if Argument_Count = 2 then
+         DTLS := (Argument (2) = "--dtls");
+         PSK  := (Argument (2) = "--psk");
+      end if;
 
       if DTLS then
          SPARK_Sockets.Create_Datagram_Socket (C);
@@ -221,49 +288,52 @@ 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 not PSK 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 +346,13 @@ package body Tls_Client with SPARK_Mode is
          return;
       end if;
 
+      if PSK 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);