mirror of
https://github.com/wolfSSL/wolfssl.git
synced 2026-07-05 17:30:51 +02:00
JacobBarthelmeh
1552 lines
52 KiB
Ada
1552 lines
52 KiB
Ada
-- 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;
|