File : acf-hash-message_digests.adb
------------------------------------------------------------------------
-- (c) 2001, Antonio Duran. All rights reserved --
-- aduran@inicia.es --
------------------------------------------------------------------------
-- The Ada Cryptographic Framework (ACF) is free software; you can --
-- redistribute it and/or modify it under terms of the GNU General --
-- Public License as published by the Free Software Foundation; --
-- either version 2, or (at your option) any later version. --
-- --
-- The ACF 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 distributed with the ACF; --
-- see file COPYING. If not, write to the Free Software Foundation, --
-- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
------------------------------------------------------------------------
-- Identification
-- File name : acf-hash-message_digests.adb
-- File kind : Ada package body
-- Author : Antonio Duran
-- Creation date : November 20th., 2001
-- Current version : 1.0
------------------------------------------------------------------------
-- Purpose:
-- Implements the functionality declared in its spec.
------------------------------------------------------------------------
-- Portability issues:
-- TBD.
------------------------------------------------------------------------
-- Performance issues:
-- TBD.
------------------------------------------------------------------------
-- Revision history:
--
-- Ver Who When Why
-- 1.0 ADD 11202001 Initial implementation
--
------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with ACF.Exceptions; use ACF.Exceptions;
with Interfaces; use Interfaces;
package body ACF.Hash.Message_Digests is
---------------------------------------------------------------------
-- Generic instantiations
---------------------------------------------------------------------
procedure Free is new Ada.Unchecked_Deallocation(
Byte_Array,
Byte_Array_Ptr);
---------------------------------------------------------------------
-- Body subprogram specifications
---------------------------------------------------------------------
--+---[Allocate_Byte_Array]------------------------------------------
--| Purpose:
--| Dynamically allocates a byte array of a specific size and
--| returns an access value to that allocated array.
--|
--| Arguments:
--| Size Positive value that specifies the size of
--| the array to allocate.
--|
--| Returned value:
--| Returns a Byte_Array_Ptr that references the allocated array.
--|
--| Exceptions:
--| ACF_Storage_Error if the allocation fails.
--+------------------------------------------------------------------
function Allocate_Byte_Array(
Size : in Positive)
return Byte_Array_Ptr;
---------------------------------------------------------------------
-- Body subprogram bodies
---------------------------------------------------------------------
--+---[Allocate_Byte_Ptr]--------------------------------------------
function Allocate_Byte_Array(
Size : in Positive)
return Byte_Array_Ptr
is
R : Byte_Array_Ptr := null;
begin
R := new Byte_Array(1 .. Size);
R.all := (others => 0);
return R;
exception
when others =>
raise ACF_Storage_Error;
end Allocate_Byte_Array;
---------------------------------------------------------------------
-- Spec subprogram bodies
---------------------------------------------------------------------
--+---[To_Message_Digest]--------------------------------------------
function To_Message_Digest(
Source : in Byte_Array)
return Message_Digest
is
R : Message_Digest := Null_Message_Digest;
begin
if Source'Length > 0 then
R.Bytes := Allocate_Byte_Array(Source'Length);
R.Bytes.all := Source;
end if;
return R;
exception
when ACF_Storage_Error =>
raise;
when others =>
raise;
raise ACF_Unexpected_Error;
end To_Message_Digest;
--+---[To_Message_Digest]--------------------------------------------
function To_Message_Digest(
Source : in String)
return Message_Digest
is
R : Message_Digest;
L : Positive;
M : Integer;
P : Byte_Array_Ptr := null;
N : Byte;
B : Byte;
H : Boolean := True;
J : Positive;
begin
if Source'Length = 0 then
return Null_Message_Digest;
else
M := Source'Length mod 2;
if M /= 0 then
raise ACF_Syntax_Error;
end if;
L := Source'Length / 2;
P := Allocate_Byte_Array(L);
J := 1;
for I in Source'Range loop
case Source(I) is
when '0' .. '9' =>
N := Byte(Character'Pos(Source(I)) -
Character'Pos('0'));
when 'a' .. 'f' =>
N := Byte(10 + Character'Pos(Source(I)) -
Character'Pos('a'));
when 'A' .. 'F' =>
N := Byte(10 + Character'Pos(Source(I)) -
Character'Pos('A'));
when others =>
raise ACF_Syntax_Error;
end case;
if H then
B := Shift_Left(N, 4);
else
B := B or N;
P.all(J) := B;
J := J + 1;
end if;
H := not H;
end loop;
R.Bytes := P;
return R;
end if;
exception
when ACF_Storage_Error |
ACF_Syntax_Error =>
if P /= null then
Free(P);
end if;
raise;
when others =>
if P /= null then
Free(P);
end if;
raise ACF_Unexpected_Error;
end To_Message_Digest;
--+---[Clear]--------------------------------------------------------
procedure Clear(
The_Digest : in out Message_Digest)
is
begin
if The_Digest.Bytes /= null then
The_Digest.Bytes.all := (others => 0);
end if;
end Clear;
--+---[Set_Message_Digest]-------------------------------------------
procedure Set_Message_Digest(
The_Digest : in out Message_Digest;
From : in Byte_Array)
is
T : Byte_Array_Ptr := null;
begin
if From'Length > 0 then
T := Allocate_Byte_Array(From'Length);
T.all := From;
end if;
if The_Digest.Bytes /= null then
Free(The_Digest.Bytes);
end if;
The_Digest.Bytes := T;
exception
when ACF_Storage_Error =>
raise;
when others =>
raise ACF_Unexpected_Error;
end Set_Message_Digest;
--+---[To_Byte_Array]------------------------------------------------
function To_Byte_Array(
From_Digest : in Message_Digest)
return Byte_Array
is
begin
if From_Digest.Bytes = null then
raise ACF_Null_Argument_Error;
else
return From_Digest.Bytes.all;
end if;
end To_Byte_Array;
--+---[To_Hex_String]------------------------------------------------
function To_Hex_String(
From_Digest : in Message_Digest;
Digit_Case : in Hex_Digit_Case := Upper_Case)
return String
is
begin
if From_Digest.Bytes = null then
raise ACF_Null_Argument_Error;
else
declare
R : String(1 .. 2 * From_Digest.Bytes.all'Last);
N : Positive := R'First;
begin
for I in From_Digest.Bytes.all'Range loop
R(N .. N + 1) :=
To_Hex_String(
Value => From_Digest.Bytes.all(I),
Digit_Case => Digit_Case);
N := N + 2;
end loop;
return R;
end;
end if;
end To_Hex_String;
--+---["="]----------------------------------------------------------
function "="(
Left : in Message_Digest;
Right : in Message_Digest)
return Boolean
is
begin
if Left.Bytes = Right.Bytes then
return True;
else
if Left.Bytes = null or else
Right.Bytes = null then
return False;
else
if Left.Bytes.all'Length = Right.Bytes.all'Length then
return Left.Bytes.all = Right.Bytes.all;
else
return False;
end if;
end if;
end if;
end "=";
--+---[Get_Size]-----------------------------------------------------
function Get_Size(
Of_Digest : in Message_Digest)
return Natural
is
begin
if Of_Digest.Bytes = null then
return 0;
else
return Of_Digest.Bytes.all'Length;
end if;
end Get_Size;
--+---[Initialize]---------------------------------------------------
procedure Initialize(
Object : in out Message_Digest)
is
begin
Object.Bytes := null;
end Initialize;
--+---[Adjust]-------------------------------------------------------
procedure Adjust(
Object : in out Message_Digest)
is
T : Byte_Array_Ptr := null;
begin
if Object.Bytes /= null then
T := Allocate_Byte_Array(Object.Bytes.all'Length);
T.all := Object.Bytes.all;
Object.Bytes := T;
end if;
end Adjust;
--+---[Finalize]-----------------------------------------------------
procedure Finalize(
Object : in out Message_Digest)
is
begin
if Object.Bytes /= null then
Free(Object.Bytes);
end if;
end Finalize;
end ACF.Hash.Message_Digests;