-- wolfssl.adb
--
-- Copyright (C) 2006-2026 wolfSSL Inc.
--
-- This file is part of wolfSSL.
--
-- wolfSSL is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 3 of the License, or
-- (at your option) any later version.
--
-- wolfSSL is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1335, USA
--
with Ada.Unchecked_Conversion;
package body WolfSSL is
subtype size_t is Interfaces.C.size_t; use type size_t;
subtype long is Interfaces.C.long;
subtype unsigned_long is Interfaces.C.unsigned_long;
-- The first value in the Byte_Type range (Byte_Type'First),
-- used as the null byte (0).
nul : constant Byte_Type := Byte_Type'First;
-- 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;
function Initialize return Subprogram_Result is
Result : constant int := Initialize_WolfSSL;
begin
return Subprogram_Result (Result);
end Initialize;
function Finalize return Subprogram_Result is
Result : constant int := Finalize_WolfSSL;
begin
return Subprogram_Result (Result);
end Finalize;
function Is_Valid (Context : Context_Type) return Boolean is
begin
return Context /= null;
end Is_Valid;
function Is_Valid (Method : Method_Type) return Boolean is
begin
return Method /= null;
end Is_Valid;
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_2_Client_Method return Method_Type with
Convention => C,
External_Name => "wolfTLSv1_2_client_method",
Import => True;
function TLSv1_2_Client_Method return Method_Type is
begin
return WolfTLSv1_2_Client_Method;
end TLSv1_2_Client_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 WolfTLSv1_3_Client_Method return Method_Type with
Convention => C,
External_Name => "wolfTLSv1_3_client_method",
Import => True;
function TLSv1_3_Client_Method return Method_Type is
begin
return WolfTLSv1_3_Client_Method;
end TLSv1_3_Client_Method;
function WolfDTLSv1_2_Server_Method return Method_Type with
Convention => C,
External_Name => "wolfDTLSv1_2_server_method",
Import => True;
function DTLSv1_2_Server_Method return Method_Type is
begin
return WolfDTLSv1_2_Server_Method;
end DTLSv1_2_Server_Method;
function WolfDTLSv1_2_Client_Method return Method_Type with
Convention => C,
External_Name => "wolfDTLSv1_2_client_method",
Import => True;
function DTLSv1_2_Client_Method return Method_Type is
begin
return WolfDTLSv1_2_Client_Method;
end DTLSv1_2_Client_Method;
function WolfDTLSv1_3_Server_Method return Method_Type with
Convention => C,
External_Name => "wolfDTLSv1_3_server_method",
Import => True;
function DTLSv1_3_Server_Method return Method_Type is
begin
return WolfDTLSv1_3_Server_Method;
end DTLSv1_3_Server_Method;
function WolfDTLSv1_3_Client_Method return Method_Type with
Convention => C,
External_Name => "wolfDTLSv1_3_client_method",
Import => True;
function DTLSv1_3_Client_Method return Method_Type is
begin
return WolfDTLSv1_3_Client_Method;
end DTLSv1_3_Client_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 : in out Method_Type;
Context : out Context_Type) is
begin
Context := WolfSSL_CTX_new (Method);
Method := null;
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 Context_Type) is
begin
if Context /= null then
WolfSSL_CTX_free (Context);
end if;
Context := null;
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 "or" (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 or R);
end "or";
procedure Set_Verify (Context : Context_Type;
Mode : Mode_Type) is
pragma Warnings (Off, "pragma Restrictions (No_Exception_Propagation)");
-- The values that Set_Verify may be called with have first
-- been int values, then converted into Mode_Type values and
-- here they are converted back to int. This can never fail
-- unless there is hardware failure or cosmic radiation has
-- done a bit flip.
V : constant int := int (Mode);
pragma Warnings (On, "pragma Restrictions (No_Exception_Propagation)");
begin
WolfSSL_CTX_Set_Verify (Context => Context,
Mode => V,
Callback => null);
end Set_Verify;
function WolfSSL_Get_Verify (Context : Context_Type) return int with
Convention => C,
External_Name => "wolfSSL_CTX_get_verify_mode",
Import => True;
function Get_Verify (Context : Context_Type) return Mode_Type is
begin
return Mode_Type (WolfSSL_Get_Verify (Context));
end Get_Verify;
function Use_Certificate_File (Context : Context_Type;
File : Byte_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
begin
declare
Ctx : constant Context_Type := Context;
F : Byte_Array (1 .. File'Length + 1);
Result : int;
begin
for I in File'Range loop
F (F'First + Byte_Index (I - File'First)) := Byte_Type (File (I));
end loop;
F (F'Last) := nul;
Result := Use_Certificate_File (Ctx, F, int (Format));
return Subprogram_Result (Result);
end;
exception
when others =>
return Exception_Error;
end Use_Certificate_File;
function Use_Certificate_Buffer (Context : Context_Type;
Input : Byte_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 : Byte_Array;
Format : File_Format)
return Subprogram_Result is
Result : int;
begin
Result := Use_Certificate_Buffer (Context, Input,
Input'Length, int (Format));
return Subprogram_Result (Result);
exception
when others =>
return Exception_Error;
end Use_Certificate_Buffer;
function Use_Private_Key_File (Context : Context_Type;
File : Byte_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
begin
declare
Ctx : constant Context_Type := Context;
F : Byte_Array (1 .. File'Length + 1);
Result : int;
begin
for I in File'Range loop
F (F'First + Byte_Index (I - File'First)) := Byte_Type (File (I));
end loop;
F (F'Last) := nul;
Result := Use_Private_Key_File (Ctx, F, int (Format));
return Subprogram_Result (Result);
end;
exception
when others =>
return Exception_Error;
end Use_Private_Key_File;
function Use_Private_Key_Buffer (Context : Context_Type;
Input : Byte_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));
return Subprogram_Result (Result);
exception
when others =>
return Exception_Error;
end Use_Private_Key_Buffer;
function Load_Verify_Locations1
(Context : Context_Type;
File : Byte_Array;
Path : Byte_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--".
function Load_Verify_Locations2
(Context : Context_Type;
File : Byte_Array;
Path : access Interfaces.C.char) return int with
Convention => C,
External_Name => "wolfSSL_CTX_load_verify_locations",
Import => True;
function Load_Verify_Locations3
(Context : Context_Type;
File : access Interfaces.C.char;
Path : Byte_Array) return int with
Convention => C,
External_Name => "wolfSSL_CTX_load_verify_locations",
Import => True;
function Load_Verify_Locations4
(Context : Context_Type;
File : access Interfaces.C.char;
Path : access Interfaces.C.char) 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
begin
declare
Ctx : constant Context_Type := Context;
F : aliased Byte_Array := (1 .. File'Length + 1 => '#');
P : aliased Byte_Array := (1 .. Path'Length + 1 => '#');
Result : int;
begin
if File = "" then
if Path = "" then
Result := Load_Verify_Locations4 (Ctx, null, null);
else
for I in Path'Range loop
P (P'First + Byte_Index (I - Path'First)) :=
Byte_Type (Path (I));
end loop;
P (P'Last) := nul;
Result := Load_Verify_Locations3 (Ctx, null, P);
end if;
else
for I in File'Range loop
F (F'First + Byte_Index (I - File'First)) :=
Byte_Type (File (I));
end loop;
F (F'Last) := nul;
if Path = "" then
Result := Load_Verify_Locations2 (Ctx, F, null);
else
for I in Path'Range loop
P (P'First + Byte_Index (I - Path'First)) :=
Byte_Type (Path (I));
end loop;
P (P'Last) := nul;
Result := Load_Verify_Locations1 (Context => Ctx,
File => F,
Path => P);
end if;
end if;
return Subprogram_Result (Result);
end;
exception
when others =>
return Exception_Error;
end Load_Verify_Locations;
function Load_Verify_Buffer
(Context : Context_Type;
Input : Byte_Array;
Size : int;
Format : int) return int with
Convention => C,
External_Name => "wolfSSL_CTX_load_verify_buffer",
Import => True;
function Load_Verify_Buffer (Context : Context_Type;
Input : Byte_Array;
Format : File_Format)
return Subprogram_Result is
Result : int;
begin
Result := Load_Verify_Buffer (Context => Context,
Input => Input,
Size => Input'Length,
Format => int(Format));
return Subprogram_Result (Result);
exception
when others =>
return Exception_Error;
end Load_Verify_Buffer;
function Is_Valid (Ssl : WolfSSL_Type) return Boolean is
begin
return Ssl /= null;
end Is_Valid;
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 WolfSSL_Type) is
begin
Ssl := WolfSSL_New (Context);
end Create_WolfSSL;
function Use_Certificate_File (Ssl : WolfSSL_Type;
File : Byte_Array;
Format : int)
return int with
Convention => C,
External_Name => "wolfSSL_use_certificate_file",
Import => True;
function Use_Certificate_File (Ssl : WolfSSL_Type;
File : String;
Format : File_Format)
return Subprogram_Result is
begin
declare
F : Byte_Array (1 .. File'Length + 1);
Result : int;
begin
for I in File'Range loop
F (F'First + Byte_Index (I - File'First)) :=
Byte_Type (File (I));
end loop;
F (F'Last) := nul;
Result := Use_Certificate_File (Ssl, F, int (Format));
return Subprogram_Result (Result);
end;
exception
when others =>
return Exception_Error;
end Use_Certificate_File;
function Use_Certificate_Buffer (Ssl : WolfSSL_Type;
Input : Byte_Array;
Size : long;
Format : int)
return int with
Convention => C,
External_Name => "wolfSSL_use_certificate_buffer",
Import => True;
function Use_Certificate_Buffer (Ssl : WolfSSL_Type;
Input : Byte_Array;
Format : File_Format)
return Subprogram_Result is
Result : int;
begin
Result := Use_Certificate_Buffer (Ssl, Input,
Input'Length, int (Format));
return Subprogram_Result (Result);
exception
when others =>
return Exception_Error;
end Use_Certificate_Buffer;
function Use_Private_Key_File (Ssl : WolfSSL_Type;
File : Byte_Array;
Format : int)
return int with
Convention => C,
External_Name => "wolfSSL_use_PrivateKey_file",
Import => True;
function Use_Private_Key_File (Ssl : WolfSSL_Type;
File : String;
Format : File_Format)
return Subprogram_Result is
begin
declare
F : Byte_Array (1 .. File'Length + 1);
Result : int;
begin
for I in File'Range loop
F (F'First + Byte_Index (I - File'First)) := Byte_Type (File (I));
end loop;
F (F'Last) := nul;
Result := Use_Private_Key_File (Ssl, F, int (Format));
return Subprogram_Result (Result);
end;
exception
when others =>
return Exception_Error;
end Use_Private_Key_File;
function Use_Private_Key_Buffer (Ssl : WolfSSL_Type;
Input : Byte_Array;
Size : long;
Format : int)
return int with
Convention => C,
External_Name => "wolfSSL_use_PrivateKey_buffer",
Import => True;
function Use_Private_Key_Buffer (Ssl : WolfSSL_Type;
Input : Byte_Array;
Format : File_Format)
return Subprogram_Result is
Result : int;
begin
Result := Use_Private_Key_Buffer (Ssl, Input,
Input'Length, int (Format));
return Subprogram_Result (Result);
exception
when others =>
return Exception_Error;
end Use_Private_Key_Buffer;
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 : constant int := WolfSSL_Set_Fd (Ssl, int (Socket));
begin
return Subprogram_Result (Result);
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 : constant int := WolfSSL_Accept (Ssl);
begin
return Subprogram_Result (Result);
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 Byte_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.
procedure Read (Ssl : WolfSSL_Type;
Result : out Read_Result) is
begin
Result := (Success => False, -- In case of exception.
Last => 0,
Code => Subprogram_Result (Exception_Error));
declare
Data : Byte_Array (1 .. Byte_Index'Last);
Size : int;
begin
Size := WolfSSL_Read (Ssl, Data, int (Byte_Index'Last));
if Size <= 0 then
Result := (Success => False,
Last => 0,
Code => Subprogram_Result (Size));
else
Result := (Success => True,
Last => Byte_Index (Size),
Buffer => Data (1 .. Byte_Index (Size)));
end if;
end;
exception
when others =>
null;
end Read;
function WolfSSL_Write (Ssl : WolfSSL_Type;
Data : Byte_Array;
Sz : int) return int with
Convention => C,
External_Name => "wolfSSL_write",
Import => True;
procedure Write (Ssl : WolfSSL_Type;
Data : Byte_Array;
Result : out Write_Result) is
begin
Result := (Success => False,
Code => Subprogram_Result (Exception_Error));
declare
Size : constant int := Data'Length;
R : int;
begin
R := WolfSSL_Write (Ssl, Data, Size);
if R > 0 then
Result := (Success => True,
Bytes_Written => Byte_Index (R));
else
Result := (Success => False, Code => Subprogram_Result (R));
end if;
end;
exception
when others =>
null;
end Write;
function WolfSSL_Shutdown (Ssl : WolfSSL_Type) return int with
Convention => C,
External_Name => "wolfSSL_shutdown",
Import => True;
function Shutdown (Ssl : WolfSSL_Type) return Subprogram_Result is
Result : constant int := WolfSSL_Shutdown (Ssl);
begin
return Subprogram_Result (Result);
end Shutdown;
function WolfSSL_Connect (Ssl : WolfSSL_Type) return int with
Convention => C,
External_Name => "wolfSSL_connect",
Import => True;
function Connect (Ssl : WolfSSL_Type) return Subprogram_Result is
Result : constant int := WolfSSL_Connect (Ssl);
begin
return Subprogram_Result (Result);
end Connect;
procedure WolfSSL_Free (Ssl : WolfSSL_Type) with
Convention => C,
External_Name => "wolfSSL_free",
Import => True;
procedure Free (Ssl : in out WolfSSL_Type) is
begin
if Ssl /= null then
WolfSSL_Free (Ssl);
end if;
Ssl := null;
end Free;
function WolfSSL_Get_Error (Ssl : WolfSSL_Type;
Ret : int) return int with
Convention => C,
External_Name => "wolfSSL_get_error",
Import => True;
function Get_Error (Ssl : WolfSSL_Type;
Result : Subprogram_Result) return Error_Code is
begin
return Error_Code (WolfSSL_Get_Error (Ssl, int (Result)));
end Get_Error;
procedure WolfSSL_Error_String (Error : unsigned_long;
Data : out Byte_Array;
Size : unsigned_long) with
Convention => C,
External_Name => "wolfSSL_ERR_error_string_n",
Import => True;
procedure Error (Code : in Error_Code;
Message : in out Error_Message) is
use type Byte_Type;
-- Use unchecked conversion instead of type conversion to mimic C style
-- conversion from int to unsigned long, avoiding the Ada overflow check.
function To_Unsigned_Long is new Ada.Unchecked_Conversion
(Source => long,
Target => unsigned_long);
begin
declare
S : String (1 .. Error_Message_Index'Last);
B : Byte_Array (1 .. size_t (Error_Message_Index'Last));
L : Positive;
begin
WolfSSL_Error_String (Error => To_Unsigned_Long (long (Code)),
Data => B,
Size => To_Unsigned_Long (long (B'Last)));
for I in B'Range loop
L := S'First + Natural (I - B'First);
S (L) := Character (B (I));
exit when B (I) = nul;
end loop;
if S (L) = Character (nul) then
Message := (Last => L - 1,
Text => S (1 .. L - 1));
else
Message := (Last => L,
Text => S (1 .. L));
end if;
end;
exception
when others =>
null;
end Error;
function Get_WolfSSL_Max_Error_Size return int with
Convention => C,
External_Name => "get_wolfssl_max_error_size",
Import => True;
function Max_Error_Size return Natural is
begin
return Natural (Get_WolfSSL_Max_Error_Size);
end Max_Error_Size;
function Is_Valid (Key : RNG_Type) return Boolean is
begin
return Key /= null;
end Is_Valid;
function Ada_New_RNG return RNG_Type with
Convention => C,
External_Name => "ada_new_rng",
Import => True;
procedure Ada_Free_RNG (Key : in RNG_Type) with
Convention => C,
External_Name => "ada_free_rng",
Import => True;
procedure Free_RNG (Key : in out RNG_Type) is
begin
if Key = null then
return;
end if;
-- wc_rng_free() already calls wc_FreeRng() internally.
Ada_Free_RNG (Key);
-- Prevent accidental double-free and make Is_Valid return False.
Key := null;
end Free_RNG;
procedure Create_RNG (Key : in out RNG_Type;
Result : out Integer) is
begin
declare
R : int;
begin
-- Allocate RNG using the C wrapper, which internally calls
-- wc_rng_new(NULL, 0, NULL) as required.
Key := Ada_New_RNG;
if Key = null then
Result := Exception_Error;
return;
end if;
-- wc_rng_new() already calls wc_InitRng() internally, so no extra init.
Result := 0;
end;
exception
when others =>
Result := Exception_Error;
end Create_RNG;
function WC_RNG_Generate_Block (RNG : not null RNG_Type;
Output : out Byte_Array;
Size : int) return int with
Convention => C,
External_Name => "wc_RNG_GenerateBlock",
Import => True;
procedure RNG_Generate_Block (RNG : RNG_Type;
Output : out Byte_Array;
Result : out Integer) is
begin
declare
R : int;
begin
R := WC_RNG_Generate_Block (RNG, Output, Output'Length);
Result := Integer (R);
end;
exception
when others =>
Result := Exception_Error;
end RNG_Generate_Block;
type Unsigned_8 is mod 2 ** 8;
function To_C (Value : Unsigned_8) return WolfSSL.Byte_Type is
begin
return WolfSSL.Byte_Type'Val (Value);
end To_C;
function WC_PBKDF2 (Output : out Byte_Array;
Password : Byte_Array;
P_Length : int;
Salt : Byte_Array;
S_Length : int;
Iterations : int;
Key_Length : int;
Hash_Type : int) return int with
Convention => C,
External_Name => "wc_PBKDF2",
Import => True;
function Ada_MD5 return int with
Convention => C,
External_Name => "ada_md5",
Import => True;
function Ada_SHA return int with
Convention => C,
External_Name => "ada_sha",
Import => True;
function Ada_SHA256 return int with
Convention => C,
External_Name => "ada_sha256",
Import => True;
function Ada_SHA384 return int with
Convention => C,
External_Name => "ada_sha384",
Import => True;
function Ada_SHA512 return int with
Convention => C,
External_Name => "ada_sha512",
Import => True;
function Ada_SHA3_224 return int with
Convention => C,
External_Name => "ada_sha3_224",
Import => True;
function Ada_SHA3_256 return int with
Convention => C,
External_Name => "ada_sha3_256",
Import => True;
function Ada_SHA3_384 return int with
Convention => C,
External_Name => "ada_sha3_384",
Import => True;
function Ada_SHA3_512 return int with
Convention => C,
External_Name => "ada_sha3_512",
Import => True;
procedure PBKDF2 (Output : out Byte_Array;
Password : Byte_Array;
Salt : Byte_Array;
Iterations : Positive;
Key_Length : Positive;
HMAC : HMAC_Hash;
Result : out Integer) is
begin
declare
R : int;
H : int;
begin
case HMAC is
when MD5 => H := Ada_MD5;
when SHA => H := Ada_SHA;
when SHA256 => H := Ada_SHA256;
when SHA384 => H := Ada_SHA384;
when SHA512 => H := Ada_SHA512;
when SHA3_224 => H := Ada_SHA3_224;
when SHA3_256 => H := Ada_SHA3_256;
when SHA3_384 => H := Ada_SHA3_384;
when SHA3_512 => H := Ada_SHA3_512;
end case;
R := WC_PBKDF2 (Output => Output,
Password => Password,
P_Length => Password'Length,
Salt => Salt,
S_Length => Salt'Length,
Iterations => int (Iterations),
Key_Length => int (Key_Length),
Hash_Type => H);
Result := Integer (R);
end;
exception
when others =>
Result := Exception_Error;
end PBKDF2;
function Ada_RSA_Set_RNG (Key : not null RSA_Key_Type;
RNG : not null RNG_Type) return int with
Convention => C,
External_Name => "ada_RsaSetRNG",
Import => True;
procedure Rsa_Set_RNG (Key : in out Rsa_Key_Type;
RNG : in out RNG_Type;
Result : out Integer) is
begin
declare
R : int;
begin
R := Ada_RSA_Set_RNG (Key, RNG);
Result := Integer (R);
end;
exception
when others =>
Result := Exception_Error;
end Rsa_Set_RNG;
function Is_Valid (Key : RSA_Key_Type) return Boolean is
begin
return Key /= null;
end Is_Valid;
function Ada_New_RSA return RSA_Key_Type with
Convention => C,
External_Name => "ada_new_rsa",
Import => True;
procedure Ada_Free_RSA (Key : in RSA_Key_Type) with
Convention => C,
External_Name => "ada_free_rsa",
Import => True;
procedure Free_RSA (Key : in out RSA_Key_Type) is
begin
if Key = null then
return;
end if;
-- wc_DeleteRsaKey() already calls wc_FreeRsaKey() internally.
Ada_Free_RSA (Key);
-- Prevent accidental double-free and make Is_Valid return False.
Key := null;
end Free_RSA;
procedure Create_RSA (Key : in out RSA_Key_Type;
Result : out Integer) is
begin
-- Allocate and initialize RSA key using the C wrapper.
-- The wrapper uses wc_NewRsaKey() and returns NULL on failure.
Key := Ada_New_RSA;
if Key = null then
Result := Exception_Error;
return;
end if;
-- wc_NewRsaKey() already calls wc_InitRsaKey_ex() internally.
Result := 0;
exception
when others =>
-- Avoid leaking the dynamically allocated RSA key on failure.
if Key /= null then
Ada_Free_RSA (Key);
Key := null;
end if;
Result := Exception_Error;
end Create_RSA;
function RSA_Public_Key_Decode (Input : Byte_Array;
Index : in out int;
Key : not null RSA_Key_Type;
Size : int) return int with
Convention => C,
External_Name => "wc_RsaPublicKeyDecode",
Import => True;
procedure Rsa_Public_Key_Decode (Input : Byte_Array;
Index : in out Byte_Index;
Key : in out RSA_Key_Type;
Size : Integer;
Result : out Integer) is
begin
declare
I : aliased int := int (Index);
R : constant int :=
RSA_Public_Key_Decode (Input, I, Key, int (Size));
begin
Index := WolfSSL.Byte_Index (I);
Result := Integer (R);
end;
exception
when others =>
Result := Exception_Error;
end Rsa_Public_Key_Decode;
function RSA_Private_Key_Decode (Input : Byte_Array;
Index : in out int;
Key : not null RSA_Key_Type;
Size : int) return int with
Convention => C,
External_Name => "wc_RsaPrivateKeyDecode",
Import => True;
procedure Rsa_Private_Key_Decode (Input : Byte_Array;
Index : in out Byte_Index;
Key : in out RSA_Key_Type;
Size : Integer;
Result : out Integer) is
begin
declare
I : aliased int := int (Index);
R : constant int :=
RSA_Private_Key_Decode (Input, I, Key, int (Size));
begin
Index := WolfSSL.Byte_Index (I);
Result := Integer (R);
end;
exception
when others =>
Result := Exception_Error;
end Rsa_Private_Key_Decode;
function RSA_SSL_Sign (Input : Byte_Array;
In_Length : int;
Output : in out Byte_Array;
Out_Length : int;
RSA : not null RSA_Key_Type;
RNG : not null RNG_Type)
return int with
Convention => C,
External_Name => "wc_RsaSSL_Sign",
Import => True;
procedure Rsa_SSL_Sign (Input : Byte_Array;
Output : in out Byte_Array;
RSA : in out RSA_Key_Type;
RNG : in out RNG_Type;
Result : out Integer) is
begin
declare
R : constant int :=
RSA_SSL_Sign (Input,
Input'Length,
Output,
Output'Length,
RSA,
RNG);
begin
Result := Integer (R);
end;
exception
when others =>
Result := Exception_Error;
end Rsa_SSL_Sign;
function WC_RSA_SSL_Verify (Input : Byte_Array;
In_Length : int;
Output : in out Byte_Array;
Out_Length : int;
RSA : not null RSA_Key_Type)
return int with
Convention => C,
External_Name => "wc_RsaSSL_Verify",
Import => True;
procedure Rsa_SSL_Verify (Input : Byte_Array;
Output : in out Byte_Array;
RSA : in out RSA_Key_Type;
Result : out Integer) is
begin
declare
R : constant int :=
WC_RSA_SSL_Verify (Input,
Input'Length,
Output,
Output'Length,
RSA);
begin
Result := Integer (R);
end;
exception
when others =>
Result := Exception_Error;
end Rsa_SSL_Verify;
function WC_RSA_Public_Encrypt (Input : Byte_Array;
In_Length : int;
Output : in out Byte_Array;
Out_Length : int;
RSA : not null RSA_Key_Type;
RNG : not null RNG_Type)
return int with
Convention => C,
External_Name => "wc_RsaPublicEncrypt",
Import => True;
procedure RSA_Public_Encrypt (Input : Byte_Array;
Output : in out Byte_Array;
Index : out Byte_Index;
RSA : in out RSA_Key_Type;
RNG : in out RNG_Type;
Result : out Integer) is
begin
Index := 0;
declare
R : constant int :=
WC_RSA_Public_Encrypt (Input,
Input'Length,
Output,
Output'Length,
RSA,
RNG);
begin
Result := Integer (R);
if Result >= 0 then
Index := Byte_Index (Result);
end if;
end;
exception
when others =>
Result := Exception_Error;
end RSA_Public_Encrypt;
function WC_RSA_Private_Decrypt (Input : Byte_Array;
In_Length : int;
Output : in out Byte_Array;
Out_Length : int;
RSA : not null RSA_Key_Type)
return int with
Convention => C,
External_Name => "wc_RsaPrivateDecrypt",
Import => True;
procedure RSA_Private_Decrypt (Input : Byte_Array;
Output : in out Byte_Array;
Index : out Byte_Index;
RSA : in out RSA_Key_Type;
Result : out Integer) is
begin
Index := 0;
declare
R : constant int :=
WC_RSA_Private_Decrypt (Input,
Input'Length,
Output,
Output'Length,
RSA);
begin
Result := Integer (R);
if Result >= 0 then
Index := Byte_Index (Result);
end if;
end;
exception
when others =>
Result := Exception_Error;
end RSA_Private_Decrypt;
function Init_SHA256 (SHA256 : not null Sha256_Type) return int with
Convention => C,
External_Name => "wc_InitSha256",
Import => True;
function SHA256_Update (SHA256 : not null Sha256_Type;
Byte : Byte_Array;
Length : int) return int with
Convention => C,
External_Name => "wc_Sha256Update",
Import => True;
function SHA256_Final (SHA256 : not null Sha256_Type;
Hash : out Byte_Array) return int with
Convention => C,
External_Name => "wc_Sha256Final",
Import => True;
function Is_Valid (SHA256 : SHA256_Type) return Boolean is
begin
return SHA256 /= null;
end Is_Valid;
function Ada_New_SHA256 return SHA256_Type with
Convention => C,
External_Name => "ada_new_sha256",
Import => True;
procedure Ada_Free_SHA256 (SHA256 : in SHA256_Type) with
Convention => C,
External_Name => "ada_free_sha256",
Import => True;
procedure Free_SHA256 (SHA256 : in out SHA256_Type) is
-- Ensure any internal wolfCrypt resources are released (hardware locks,
-- etc.) before releasing the object storage itself.
procedure WC_Sha256_Free (SHA256 : not null SHA256_Type) with
Convention => C,
External_Name => "wc_Sha256Free",
Import => True;
begin
if SHA256 = null then
return;
end if;
WC_Sha256_Free (SHA256);
Ada_Free_SHA256 (SHA256);
-- Prevent accidental double-free and make Is_Valid return False.
SHA256 := null;
end Free_SHA256;
procedure Create_SHA256 (SHA256 : in out SHA256_Type;
Result : out Integer) is
begin
declare
R : int;
begin
SHA256 := Ada_New_SHA256;
if SHA256 = null then
Result := Exception_Error;
return;
end if;
R := Init_SHA256 (SHA256);
Result := Integer (R);
if Result /= 0 then
-- Avoid leaking the dynamically allocated SHA256 on init failure.
-- Also clear the handle to prevent accidental double-free by caller.
Ada_Free_SHA256 (SHA256);
SHA256 := null;
end if;
end;
exception
when others =>
Result := Exception_Error;
end Create_SHA256;
procedure Update_SHA256 (SHA256 : in out SHA256_Type;
Byte : Byte_Array;
Result : out Integer) is
begin
declare
R : int;
begin
R := SHA256_Update (SHA256, Byte, Byte'Length);
Result := Integer (R);
end;
exception
when others =>
Result := Exception_Error;
end Update_SHA256;
procedure Finalize_SHA256 (SHA256 : in out SHA256_Type;
Hash : out SHA256_Hash;
Result : out Integer) is
R : int;
begin
R := SHA256_Final (SHA256, Hash);
Result := Integer (R);
exception
when others =>
Result := Exception_Error;
end Finalize_SHA256;
function WC_Get_Invalid_Device_Identifier return int with
Convention => C,
External_Name => "get_wolfssl_invalid_devid",
Import => True;
function Invalid_Device return Device_Identifier is
begin
return Device_Identifier (WC_Get_Invalid_Device_Identifier);
end Invalid_Device;
function Is_Valid (AES : AES_Type) return Boolean is
begin
return AES /= null;
end Is_Valid;
function Ada_New_AES (Device : int)
return AES_Type with
Convention => C,
External_Name => "ada_new_aes",
Import => True;
procedure Ada_Free_AES (AES : in AES_Type) with
Convention => C,
External_Name => "ada_free_aes",
Import => True;
procedure Create_AES (Device : Device_Identifier;
AES : in out AES_Type;
Result : out Integer) is
begin
declare
R : int;
begin
-- Allocate and initialize AES using the C wrapper.
-- The wrapper is expected to call wc_AesNew(NULL, devId, &ret) and
-- return NULL on failure.
AES := Ada_New_AES (int (Device));
if AES = null then
Result := Exception_Error;
return;
end if;
-- wc_AesNew() already calls wc_AesInit() internally, so no extra init.
Result := 0;
end;
exception
when others =>
-- Avoid leaking the dynamically allocated AES on failure.
if AES /= null then
Ada_Free_AES (AES);
AES := null;
end if;
Result := Exception_Error;
end Create_AES;
function AES_Set_Key (AES : not null AES_Type;
Key : Byte_Array;
Length : int;
IV : Byte_Array;
Dir : int) return int with
Convention => C,
External_Name => "wc_AesSetKey",
Import => True;
procedure AES_Set_Key (AES : AES_Type;
Key : Byte_Array;
Length : Integer;
IV : Byte_Array;
Dir : Integer;
Result : out Integer) is
begin
declare
R : int;
begin
R := AES_Set_Key (AES, Key, int (Length), IV, int (Dir));
Result := Integer (R);
end;
exception
when others =>
Result := Exception_Error;
end AES_Set_Key;
function AES_Set_IV (AES : not null AES_Type;
IV : Byte_Array) return int with
Convention => C,
External_Name => "wc_AesSetIV",
Import => True;
procedure AES_Set_IV (AES : AES_Type;
IV : Byte_Array;
Result : out Integer) is
begin
declare
R : int;
begin
R := AES_Set_IV (AES, IV);
Result := Integer (R);
end;
exception
when others =>
Result := Exception_Error;
end AES_Set_IV;
function AES_Set_Cbc_Encrypt (AES : not null AES_Type;
Output : out Byte_Array;
Input : Byte_Array;
Size : int) return int with
Convention => C,
External_Name => "wc_AesCbcEncrypt",
Import => True;
procedure AES_Set_Cbc_Encrypt (AES : AES_Type;
Output : out Byte_Array;
Input : Byte_Array;
Size : Integer;
Result : out Integer) is
begin
declare
R : int;
begin
R := AES_Set_Cbc_Encrypt (AES, Output, Input, int (Size));
Result := Integer (R);
end;
exception
when others =>
Result := Exception_Error;
end AES_Set_Cbc_Encrypt;
function AES_Set_Cbc_Decrypt (AES : not null AES_Type;
Output : out Byte_Array;
Input : Byte_Array;
Size : int) return int with
Convention => C,
External_Name => "wc_AesCbcDecrypt",
Import => True;
procedure AES_Set_Cbc_Decrypt (AES : AES_Type;
Output : out Byte_Array;
Input : Byte_Array;
Size : Integer;
Result : out Integer) is
begin
declare
R : int;
begin
R := AES_Set_Cbc_Decrypt (AES, Output, Input, int (Size));
Result := Integer (R);
end;
exception
when others =>
Result := Exception_Error;
end AES_Set_Cbc_Decrypt;
procedure AES_Free (AES : in out AES_Type;
Result : out Integer) is
begin
if AES = null then
Result := Exception_Error;
return;
end if;
-- wc_AesDelete() already calls wc_AesFree() internally.
Ada_Free_AES (AES);
AES := null;
Result := 0;
exception
when others =>
Result := Exception_Error;
end AES_Free;
begin
null;
end WolfSSL;