wolfssl/wrapper/Ada/wolfssl.adb

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;