Ada Bindings for wolfSSL. Credit Joakim Dahlgren Strandberg <joakimds@kth.se>

2026-05-04 02:20:49 +02:00 · 2023-07-12 10:46:09 -07:00
parent b8119af455
commit d20a096ffa
19 changed files with 2438 additions and 3 deletions
@@ -0,0 +1,597 @@
+with Interfaces.C.Strings;
+
+package body WolfSSL is
+
+   subtype size_t is Interfaces.C.size_t; use type size_t;
+
+   subtype long is Interfaces.C.long;
+
+   function Get_WolfSSL_Success return int with
+     Convention    => C,
+     External_Name => "get_wolfssl_success",
+     Import        => True;
+
+   WOLFSSL_SUCCESS : constant int := Get_WolfSSL_Success;
+
+   function Initialize_WolfSSL return int with
+     Convention    => C,
+     External_Name => "wolfSSL_Init",
+     Import        => True;
+
+   function Finalize_WolfSSL return int with
+     Convention    => C,
+     External_Name => "wolfSSL_Cleanup",
+     Import        => True;
+
+   procedure Finalize is
+      Result : constant int := Finalize_WolfSSL;
+   begin
+      if Result /= WOLFSSL_SUCCESS then
+         raise Cleanup_Error;
+      end if;
+   end Finalize;
+
+   function WolfTLSv1_2_Server_Method return Method_Type with
+     Convention    => C,
+     External_Name => "wolfTLSv1_2_server_method",
+     Import        => True;
+
+   function TLSv1_2_Server_Method return Method_Type is
+   begin
+      return WolfTLSv1_2_Server_Method;
+   end TLSv1_2_Server_Method;
+
+   function WolfTLSv1_3_Server_Method return Method_Type with
+     Convention    => C,
+     External_Name => "wolfTLSv1_3_server_method",
+     Import        => True;
+
+   function TLSv1_3_Server_Method return Method_Type is
+   begin
+      return WolfTLSv1_3_Server_Method;
+   end TLSv1_3_Server_Method;
+
+   function WolfSSL_CTX_new (Method : Method_Type)
+                             return Context_Type with
+     Convention => C, External_Name => "wolfSSL_CTX_new", Import => True;
+
+   procedure Create_Context (Method  : Method_Type;
+                             Context : out Optional_Context) is
+      C : constant Context_Type := WolfSSL_CTX_new (Method);
+   begin
+      if C = null then
+         Context := (Exists => False);
+      else
+         Context := (Exists => True, Instance => C);
+      end if;
+   end Create_Context;
+
+   procedure WolfSSL_CTX_free (Context : Context_Type) with
+     Convention => C, External_Name => "wolfSSL_CTX_free", Import => True;
+
+   procedure Free (Context : in out Optional_Context) is
+   begin
+      WolfSSL_CTX_free (Context.Instance);
+      Context := (Exists => False);
+   end Free;
+
+   type Opaque_X509_Store_Context is limited null record;
+   type X509_Store_Context is access Opaque_X509_Store_Context with
+     Convention => C;
+
+   type Verify_Callback is access function
+     (A : int;
+      Context : X509_Store_Context)
+      return int
+     with Convention => C;
+
+   procedure WolfSSL_CTX_Set_Verify (Context  : Context_Type;
+                                     Mode     : int;
+                                     Callback : Verify_Callback) with
+     Convention    => C,
+     External_Name => "wolfSSL_CTX_set_verify",
+     Import        => True;
+   --  This function sets the verification method for remote peers and
+   --  also allows a verify callback to be registered with the SSL
+   --  context. The verify callback will be called only when a
+   --  verification failure has occurred. If no verify callback is
+   --  desired, the NULL pointer can be used for verify_callback.
+   --  The verification mode of peer certificates is a logically OR'd
+   --  list of flags. The possible flag values include:
+   --  SSL_VERIFY_NONE Client mode: the client will not verify the
+   --  certificate received from the server and the handshake will
+   --  continue as normal. Server mode: the server will not send a
+   --  certificate request to the client. As such, client verification
+   --  will not be enabled. SSL_VERIFY_PEER Client mode: the client will
+   --  verify the certificate received from the server during the
+   --  handshake. This is turned on by default in wolfSSL, therefore,
+   --  using this option has no effect. Server mode: the server will send
+   --  a certificate request to the client and verify the client
+   --  certificate received. SSL_VERIFY_FAIL_IF_NO_PEER_CERT Client mode:
+   --  no effect when used on the client side. Server mode:
+   --  the verification will fail on the server side if the client fails
+   --  to send a certificate when requested to do so (when using
+   --  SSL_VERIFY_PEER on the SSL server).
+   --  SSL_VERIFY_FAIL_EXCEPT_PSK Client mode: no effect when used on
+   --  the client side. Server mode: the verification is the same as
+   --  SSL_VERIFY_FAIL_IF_NO_PEER_CERT except in the case of a
+   --  PSK connection. If a PSK connection is being made then the
+   --  connection will go through without a peer cert.
+
+   function "&" (Left, Right : Mode_Type) return Mode_Type is
+      L : constant Unsigned_32 := Unsigned_32 (Left);
+      R : constant Unsigned_32 := Unsigned_32 (Right);
+   begin
+      return Mode_Type (L and R);
+   end "&";
+
+   procedure Set_Verify (Context : Context_Type;
+                         Mode    : Mode_Type) is
+   begin
+      WolfSSL_CTX_Set_Verify (Context  => Context,
+                              Mode     => int (Mode),
+                              Callback => null);
+   end Set_Verify;
+
+   function Use_Certificate_File (Context : Context_Type;
+                                  File    : char_array;
+                                  Format  : int)
+                                  return int with
+     Convention    => C,
+     External_Name => "wolfSSL_CTX_use_certificate_file",
+     Import        => True;
+
+   function Use_Certificate_File (Context : Context_Type;
+                                  File    : String;
+                                  Format  : File_Format)
+                                  return Subprogram_Result is
+      C : size_t;
+      F : char_array (1 .. File'Length + 1);
+      Result : int;
+   begin
+      Interfaces.C.To_C (Item       => File,
+                         Target     => F,
+                         Count      => C,
+                         Append_Nul => True);
+      Result := Use_Certificate_File (Context, F (1 .. C), int (Format));
+      if Result = WOLFSSL_SUCCESS then
+         return Success;
+      else
+         return Failure;
+      end if;
+   end Use_Certificate_File;
+
+   function Use_Certificate_Buffer (Context : Context_Type;
+                                    Input   : char_array;
+                                    Size    : long;
+                                    Format  : int)
+                                    return int with
+      Convention    => C,
+      External_Name => "wolfSSL_CTX_use_certificate_buffer",
+      Import        => True;
+
+   function Use_Certificate_Buffer (Context : Context_Type;
+                                    Input   : char_array;
+                                    Format  : File_Format)
+                                    return Subprogram_Result is
+      Result : int;
+   begin
+      Result := Use_Certificate_Buffer (Context, Input,
+                                        Input'Length, int (Format));
+      if Result = WOLFSSL_SUCCESS then
+         return Success;
+      else
+         return Failure;
+      end if;
+   end Use_Certificate_Buffer;
+
+   function Use_Private_Key_File (Context : Context_Type;
+                                  File    : char_array;
+                                  Format  : int)
+                                  return int with
+     Convention    => C,
+     External_Name => "wolfSSL_CTX_use_PrivateKey_file",
+     Import        => True;
+
+   function Use_Private_Key_File (Context : Context_Type;
+                                  File    : String;
+                                  Format  : File_Format)
+                                  return Subprogram_Result is
+      C : size_t;
+      F : char_array (1 .. File'Length + 1);
+      Result : int;
+   begin
+      Interfaces.C.To_C (Item       => File,
+                         Target     => F,
+                         Count      => C,
+                         Append_Nul => True);
+      Result := Use_Private_Key_File (Context, F (1 .. C), int (Format));
+      if Result = WOLFSSL_SUCCESS then
+         return Success;
+      else
+         return Failure;
+      end if;
+   end Use_Private_Key_File;
+
+   function Use_Private_Key_Buffer (Context : Context_Type;
+                                    Input   : char_array;
+                                    Size    : long;
+                                    Format  : int)
+                                    return int with
+     Convention    => C,
+     External_Name => "wolfSSL_CTX_use_PrivateKey_buffer",
+     Import        => True;
+
+   function Use_Private_Key_Buffer (Context : Context_Type;
+                                    Input   : Byte_Array;
+                                    Format  : File_Format)
+                                    return Subprogram_Result is
+      Result : int;
+   begin
+      Result := Use_Private_Key_Buffer (Context, Input,
+                                        Input'Length, int (Format));
+      if Result = WOLFSSL_SUCCESS then
+         return Success;
+      else
+         return Failure;
+      end if;
+   end Use_Private_Key_Buffer;
+
+   function Load_Verify_Locations1
+      (Context : Context_Type;
+       File    : char_array;
+       Path    : char_array) return int with
+      Convention    => C,
+      External_Name => "wolfSSL_CTX_load_verify_locations",
+      Import        => True;
+   --  This function loads PEM-formatted CA certificate files into
+   --  the SSL context (WOLFSSL_CTX). These certificates will be treated
+   --  as trusted root certificates and used to verify certs received
+   --  from peers during the SSL handshake. The root certificate file,
+   --  provided by the file argument, may be a single certificate or a
+   --  file containing multiple certificates. If multiple CA certs are
+   --  included in the same file, wolfSSL will load them in the same order
+   --  they are presented in the file. The path argument is a pointer to
+   --  the name of a directory that contains certificates of trusted
+   --  root CAs. If the value of file is not NULL, path may be specified
+   --  as NULL if not needed. If path is specified and NO_WOLFSSL_DIR was
+   --  not defined when building the library, wolfSSL will load all
+   --  CA certificates located in the given directory. This function will
+   --  attempt to load all files in the directory. This function expects
+   --  PEM formatted CERT_TYPE file with header "--BEGIN CERTIFICATE--".
+
+   subtype char_array_ptr is Interfaces.C.Strings.char_array_access;
+
+   function Load_Verify_Locations2
+      (Context : Context_Type;
+       File    : char_array;
+       Path    : char_array_ptr) return int with
+      Convention    => C,
+      External_Name => "wolfSSL_CTX_load_verify_locations",
+      Import        => True;
+
+   function Load_Verify_Locations3
+      (Context : Context_Type;
+       File    : char_array_ptr;
+       Path    : char_array) return int with
+      Convention    => C,
+      External_Name => "wolfSSL_CTX_load_verify_locations",
+      Import        => True;
+
+   function Load_Verify_Locations4
+      (Context : Context_Type;
+       File    : char_array_ptr;
+       Path    : char_array_ptr) return int with
+      Convention    => C,
+      External_Name => "wolfSSL_CTX_load_verify_locations",
+      Import        => True;
+
+   function Load_Verify_Locations (Context : Context_Type;
+                                   File    : String;
+                                   Path    : String)
+                                   return Subprogram_Result is
+      FC : size_t;  -- File Count, specifies the characters used in F.
+      F : aliased char_array := (1 .. File'Length + 1 => '#');
+
+      PC : size_t;  -- Path Count, specifies the characters used in P.
+      P : aliased char_array := (1 .. Path'Length + 1 => '#');
+
+      Result : int;
+   begin
+      if File = "" then
+         if Path = "" then
+            Result := Load_Verify_Locations4 (Context, null, null);
+         else
+            Interfaces.C.To_C (Item       => Path,
+                               Target     => P,
+                               Count      => PC,
+                               Append_Nul => True);
+            Result := Load_Verify_Locations3 (Context, null, P);
+         end if;
+      else
+         Interfaces.C.To_C (Item       => File,
+                            Target     => F,
+                            Count      => FC,
+                            Append_Nul => True);
+         if Path = "" then
+            Result := Load_Verify_Locations2 (Context, F, null);
+         else
+            Interfaces.C.To_C (Item       => Path,
+                               Target     => P,
+                               Count      => PC,
+                               Append_Nul => True);
+            Interfaces.C.To_C (Item       => Path,
+                               Target     => P,
+                               Count      => PC,
+                               Append_Nul => True);
+            Result := Load_Verify_Locations1 (Context, F, P);
+         end if;
+      end if;
+      if Result = WOLFSSL_SUCCESS then
+         return Success;
+      else
+         return Failure;
+      end if;
+   end Load_Verify_Locations;
+
+   function Load_Verify_Buffer1
+      (Context : Context_Type;
+       Input   : char_array;
+       Size    : int;
+       Format  : int) return int with
+      Convention    => C,
+      External_Name => "wolfSSL_CTX_load_verify_buffer",
+      Import        => True;
+   --  This function loads a CA certificate buffer into the WOLFSSL
+   --  Context. It behaves like the non-buffered version, only differing
+   --  in its ability to be called with a buffer as input instead of
+   --  a file. The buffer is provided by the in argument of size sz.
+   --  format specifies the format type of the buffer; SSL_FILETYPE_ASN1
+   --  or SSL_FILETYPE_PEM. More than one CA certificate may be loaded
+   --  per buffer as long as the format is in PEM. Please see
+   --  the examples for proper usage.
+
+   function Load_Verify_Buffer (Context : Context_Type;
+                                Input   : Byte_Array;
+                                Format  : File_Format)
+                                return Subprogram_Result is
+      Result : int;
+   begin
+      Result := Load_Verify_Buffer1 (Context => Context,
+                                     Input   => Input,
+                                     Size    => Input'Length,
+                                     Format  => int(Format));
+      if Result = WOLFSSL_SUCCESS then
+         return Success;
+      else
+         return Failure;
+      end if;
+   end Load_Verify_Buffer;
+
+   function WolfSSL_New (Context : Context_Type)
+                         return WolfSSL_Type with
+     Convention    => C,
+     External_Name => "wolfSSL_new",
+     Import        => True;
+
+   procedure Create_WolfSSL (Context : Context_Type;
+                             Ssl     : out Optional_WolfSSL) is
+      Result : WolfSSL_Type := WolfSSL_New (Context);
+   begin
+      if Result /= null then
+         Ssl := (Exists   => True,
+                 Instance => Result);
+      else
+         Ssl := (Exists => False);
+      end if;
+   end Create_WolfSSL;
+
+   function WolfSSL_Set_Fd (Ssl : WolfSSL_Type; Fd : int) return int with
+     Convention    => C,
+     External_Name => "wolfSSL_set_fd",
+     Import        => True;
+
+   function Attach (Ssl    : WolfSSL_Type;
+                    Socket : Integer)
+                    return Subprogram_Result is
+      Result : int := WolfSSL_Set_Fd (Ssl, int (Socket));
+   begin
+      if Result = WOLFSSL_SUCCESS then
+         return Success;
+      else
+         return Failure;
+      end if;
+   end Attach;
+
+   procedure WolfSSL_Keep_Arrays (Ssl : WolfSSL_Type) with
+      Convention    => C,
+      External_Name => "wolfSSL_KeepArrays",
+      Import        => True;
+
+   procedure Keep_Arrays (Ssl : WolfSSL_Type) is
+   begin
+      WolfSSL_Keep_Arrays (Ssl);
+   end Keep_Arrays;
+
+   function WolfSSL_Accept (Ssl : WolfSSL_Type) return int with
+     Convention    => C,
+     External_Name => "wolfSSL_accept",
+     Import        => True;
+
+   function Accept_Connection (Ssl : WolfSSL_Type)
+                               return Subprogram_Result is
+      Result : int := WolfSSL_Accept (Ssl);
+   begin
+      if Result = WOLFSSL_SUCCESS then
+         return Success;
+      else
+         return Failure;
+      end if;
+   end Accept_Connection;
+
+   procedure WolfSSL_Free_Arrays (Ssl : WolfSSL_Type) with
+     Convention    => C,
+     External_Name => "wolfSSL_FreeArrays",
+     Import        => True;
+
+   procedure Free_Arrays (Ssl : WolfSSL_Type) is
+   begin
+      WolfSSL_Free_Arrays (Ssl);
+   end Free_Arrays;
+
+   function WolfSSL_Read (Ssl  : WolfSSL_Type;
+                          Data : out char_array;
+                          Sz   : int) return int with
+     Convention    => C,
+     External_Name => "wolfSSL_read",
+     Import        => True;
+   --  This function reads sz bytes from the SSL session (ssl) internal
+   --  read buffer into the buffer data. The bytes read are removed from
+   --  the internal receive buffer. If necessary wolfSSL_read() will
+   --  negotiate an SSL/TLS session if the handshake has not already
+   --  been performed yet by wolfSSL_connect() or wolfSSL_accept().
+   --  The SSL/TLS protocol uses SSL records which have a maximum size
+   --  of 16kB (the max record size can be controlled by the
+   --  MAX_RECORD_SIZE define in /wolfssl/internal.h). As such, wolfSSL
+   --  needs to read an entire SSL record internally before it is able
+   --  to process and decrypt the record. Because of this, a call to
+   --  wolfSSL_read() will only be able to return the maximum buffer
+   --  size which has been decrypted at the time of calling. There may
+   --  be additional not-yet-decrypted data waiting in the internal
+   --  wolfSSL receive buffer which will be retrieved and decrypted with
+   --  the next call to wolfSSL_read(). If sz is larger than the number
+   --  of bytes in the internal read buffer, SSL_read() will return
+   --  the bytes available in the internal read buffer. If no bytes are
+   --  buffered in the internal read buffer yet, a call to wolfSSL_read()
+   --  will trigger processing of the next record.
+   --
+   --  The integer returned is the number of bytes read upon success.
+   --  0 will be returned upon failure. This may be caused by a either
+   --  a clean (close notify alert) shutdown or just that the peer closed
+   --  the connection. Call wolfSSL_get_error() for the specific
+   --  error code. SSL_FATAL_ERROR will be returned upon failure when
+   --  either an error occurred or, when using non-blocking sockets,
+   --  the SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE error was received
+   --  and and the application needs to call wolfSSL_read() again.
+   --  Use wolfSSL_get_error() to get a specific error code.
+
+   function Read (Ssl : WolfSSL_Type) return Read_Result is
+      Data   : char_array (1 .. Byte_Index'Last);
+      Size   : int;
+   begin
+      Size := WolfSSL_Read (Ssl, Data, int (Byte_Index'Last));
+      if Size < 0 then
+         return (Result => Failure, Last => 0);
+      else
+         return (Result => Success,
+                 Last   => Byte_Index (Size),
+                 Buffer => Data (1 .. Byte_Index (Size)));
+      end if;
+   end Read;
+
+   function WolfSSL_Write (Ssl  : WolfSSL_Type;
+                           Data : char_array;
+                           Sz   : int) return int with
+     Convention    => C,
+     External_Name => "wolfSSL_write",
+     Import        => True;
+
+   function Write (Ssl  : WolfSSL_Type;
+                   Data : Byte_Array) return Integer is
+      Size   : constant int := Data'Length;
+      Result : int;
+   begin
+      Result := WolfSSL_Write (Ssl, Data, Size);
+      return Integer (Result);
+   end Write;
+
+   function WolfSSL_Shutdown (Ssl : WolfSSL_Type) return int with
+     Convention    => C,
+     External_Name => "wolfSSL_shutdown",
+     Import        => True;
+   --  This function shuts down an active SSL/TLS connection using
+   --  the SSL session, ssl. This function will try to send a
+   --  "close notify" alert to the peer. The calling application can
+   --  choose to wait for the peer to send its "close notify" alert
+   --  in response or just go ahead and shut down the underlying
+   --  connection after directly calling wolfSSL_shutdown (to save
+   --  resources). Either option is allowed by the TLS specification.
+   --  If the underlying connection will be used again in the future,
+   --  the complete two_directional shutdown procedure must be performed
+   --  to keep synchronization intact between the peers.
+   --  wolfSSL_shutdown() works with both blocking and non_blocking I/O.
+   --  When the underlying I/O is non_blocking, wolfSSL_shutdown() will
+   --  return an error if the underlying I/O could not satisfy the needs
+   --  of wolfSSL_shutdown() to continue. In this case, a call to
+   --  wolfSSL_get_error() will yield either SSL_ERROR_WANT_READ or
+   --  SSL_ERROR_WANT_WRITE. The calling process must then repeat
+   --  the call to wolfSSL_shutdown() when the underlying I/O is ready.
+
+   function Shutdown (Ssl : WolfSSL_Type) return Subprogram_Result is
+      Result : constant int := WolfSSL_Shutdown (Ssl);
+   begin
+      if Result = WOLFSSL_SUCCESS then
+         return Success;
+      else
+         return Failure;
+      end if;
+   end Shutdown;
+
+   function WolfSSL_Connect (Ssl : WolfSSL_Type) return int with
+      Convention    => C,
+      External_Name => "wolfSSL_connect",
+      Import        => True;
+   --  This function is called on the client side and initiates
+   --  an SSL/TLS handshake with a server. When this function is called,
+   --  the underlying communication channel has already been set up.
+   --  wolfSSL_connect() works with both blocking and non_blocking I/O.
+   --  When the underlying I/O is non_blocking, wolfSSL_connect() will
+   --  return when the underlying I/O could not satisfy the needs
+   --  of wolfSSL_connect to continue the handshake. In this case,
+   --  a call to wolfSSL_get_error() will yield either
+   --  SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE. The calling process
+   --  must then repeat the call to wolfSSL_connect() when
+   --  the underlying I/O is ready and wolfSSL will pick up where
+   --  it left off. When using a non_blocking socket, nothing needs
+   --  to be done, but select() can be used to check for the required
+   --  condition. If the underlying I/O is blocking, wolfSSL_connect()
+   --  will only return once the handshake has been finished or an error
+   --  occurred. wolfSSL takes a different approach to certificate
+   --  verification than OpenSSL does. The default policy for the client
+   --  is to verify the server, this means that if you don't load CAs
+   --  to verify the server you'll get a connect error,
+   --  unable to verify (_155). It you want to mimic OpenSSL behavior
+   --  of having SSL_connect succeed even if verifying the server fails
+   --  and reducing security you can do this by calling:
+   --  SSL_CTX_set_verify(ctx, SSL_VERIFY_NONE, 0); before calling
+   --  SSL_new(); Though it's not recommended.
+
+   function Connect (Ssl : WolfSSL_Type) return Subprogram_Result is
+      Result : constant int := WolfSSL_Connect (Ssl);
+   begin
+      if Result = WOLFSSL_SUCCESS then
+         return Success;
+      else
+         return Failure;
+      end if;
+   end Connect;
+
+   procedure WolfSSL_Free (Ssl : WolfSSL_Type) with
+      Convention    => C,
+      External_Name => "wolfSSL_free",
+      Import        => True;
+
+   procedure Free (Ssl : in out Optional_WolfSSL) is
+   begin
+      if Ssl.Exists then
+         WolfSSL_Free (Ssl.Instance);
+      end if;
+      Ssl := (Exists => False);
+   end Free;
+
+   Result : constant int := Initialize_WolfSSL;
+begin
+   if Result /= WOLFSSL_SUCCESS then
+      raise Initialization_Error;
+   end if;
+end WolfSSL;