wolfssl-w32/wrapper/Ada/wolfssl.adb

689 lines
26 KiB
Ada

-- wolfssl.adb
--
-- Copyright (C) 2006-2023 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 2 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 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;
subtype unsigned_long is Interfaces.C.unsigned_long;
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 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 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 Context_Type) is
begin
Context := WolfSSL_CTX_new (Method);
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
WolfSSL_CTX_free (Context);
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 "&" (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
Ctx : constant Context_Type := Context;
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 (Ctx, F (1 .. C), int (Format));
return Subprogram_Result (Result);
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));
return Subprogram_Result (Result);
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
Ctx : constant Context_Type := Context;
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 (Ctx, F (1 .. C), int (Format));
return Subprogram_Result (Result);
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));
return Subprogram_Result (Result);
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
Ctx : constant Context_Type := Context;
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 (Ctx, null, null);
else
Interfaces.C.To_C (Item => Path,
Target => P,
Count => PC,
Append_Nul => True);
Result := Load_Verify_Locations3 (Ctx, 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 (Ctx, 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 => Ctx,
File => F,
Path => P);
end if;
end if;
return Subprogram_Result (Result);
end Load_Verify_Locations;
function Load_Verify_Buffer
(Context : Context_Type;
Input : char_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);
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 : char_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
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 (Ssl, F (1 .. C), int (Format));
return Subprogram_Result (Result);
end Use_Certificate_File;
function Use_Certificate_Buffer (Ssl : WolfSSL_Type;
Input : char_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 : char_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);
end Use_Certificate_Buffer;
function Use_Private_Key_File (Ssl : WolfSSL_Type;
File : char_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
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 (Ssl, F (1 .. C), int (Format));
return Subprogram_Result (Result);
end Use_Private_Key_File;
function Use_Private_Key_Buffer (Ssl : WolfSSL_Type;
Input : char_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);
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 : 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 : 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 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 (Success => False,
Last => 0,
Code => Subprogram_Result (Size));
else
return (Success => True,
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 Write_Result is
Size : constant int := Data'Length;
Result : int;
begin
Result := WolfSSL_Write (Ssl, Data, Size);
if Result > 0 then
return (Success => True,
Bytes_Written => Byte_Index (Result));
else
return (Success => False, Code => Subprogram_Result (Result));
end if;
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;
function Error (Code : Error_Code) return Error_Message is
S : String (1 .. Error_Message_Index'Last);
B : Byte_Array (1 .. size_t (Error_Message_Index'Last));
C : Natural;
begin
WolfSSL_Error_String (Error => unsigned_long (Code),
Data => B,
Size => unsigned_long (B'Last));
Interfaces.C.To_Ada (Item => B,
Target => S,
Count => C,
Trim_Nul => True);
return (Last => C,
Text => S (1 .. C));
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;
end WolfSSL;