File : acf-hash-algorithms-md4.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-algorithms-md4.adb

--    File kind         : Ada package body

--    Author            : Antonio Duran

--    Creation date     : November 22th., 2001

--    Current version   : 1.0

------------------------------------------------------------------------

-- Purpose:

--    Implements the RSA-MD4 message digest algorithm.

------------------------------------------------------------------------

-- Portability issues:

-- TBD.

------------------------------------------------------------------------

-- Performance issues:

-- TBD.

------------------------------------------------------------------------

-- Revision history:

--

-- Ver   Who   When     Why

-- 1.0   ADD   11222001 Initial implementation

--

------------------------------------------------------------------------


with Ada.Unchecked_Deallocation;
with ACF.Exceptions;                use ACF.Exceptions;

package body ACF.Hash.Algorithms.MD4 is

   ---------------------------------------------------------------------

   -- Generic instantiations

   ---------------------------------------------------------------------


   procedure Free is new Ada.Unchecked_Deallocation(
                              MD4_Context,
                              MD4_Context_Ptr);

   ---------------------------------------------------------------------

   -- Constant definitions

   ---------------------------------------------------------------------


   --+---[MD4_Block_Words]----------------------------------------------

   --|   Number of 4-byte words in a MD4 block.

   --+------------------------------------------------------------------


   MD4_Block_Words         : constant Positive := MD4_Block_Bytes / 4;

   --+---[Initial_State]------------------------------------------------

   --|   Initial values for state registers.

   --+------------------------------------------------------------------


   Initial_State                 : constant State_Registers :=
      (
         16#6745_2301#,
         16#EFCD_AB89#,
         16#98BA_DCFE#,
         16#1032_5476#
      );

   ---------------------------------------------------------------------

   -- Type definitions

   ---------------------------------------------------------------------


   --+---[Packed_Block]-------------------------------------------------

   --|  Type for handling MD4 input blocks as an array of words.

   --+------------------------------------------------------------------


   subtype Packed_Block is Four_Bytes_Array(1 .. MD4_Block_Words);

   ---------------------------------------------------------------------

   -- Body subprogram specifications

   ---------------------------------------------------------------------


   --+---[Basic MD4 Functions]------------------------------------------


   function    F(
                  X        : in     Four_Bytes;
                  Y        : in     Four_Bytes;
                  Z        : in     Four_Bytes)
      return   Four_Bytes;
   pragma Inline(F);

   function    G(
                  X        : in     Four_Bytes;
                  Y        : in     Four_Bytes;
                  Z        : in     Four_Bytes)
      return   Four_Bytes;
   pragma Inline(G);

   function    H(
                  X        : in     Four_Bytes;
                  Y        : in     Four_Bytes;
                  Z        : in     Four_Bytes)
      return   Four_Bytes;
   pragma Inline(H);

   --+---[MD4 transformation procedures]--------------------------------


   procedure   FF(
                  A        : in out Four_Bytes;
                  B        : in     Four_Bytes;
                  C        : in     Four_Bytes;
                  D        : in     Four_Bytes;
                  X        : in     Four_Bytes;
                  S        : in     Natural);
   pragma Inline(FF);

   procedure   GG(
                  A        : in out Four_Bytes;
                  B        : in     Four_Bytes;
                  C        : in     Four_Bytes;
                  D        : in     Four_Bytes;
                  X        : in     Four_Bytes;
                  S        : in     Natural);
   pragma Inline(GG);

   procedure   HH(
                  A        : in out Four_Bytes;
                  B        : in     Four_Bytes;
                  C        : in     Four_Bytes;
                  D        : in     Four_Bytes;
                  X        : in     Four_Bytes;
                  S        : in     Natural);
   pragma Inline(HH);

   --+---[Transform]----------------------------------------------------

   --|   Purpose:

   --|   Transforms MD4 state based on input block.

   --|

   --|   Arguments:

   --|   Context              Access to the MD4_Context value that

   --|                        mantains the state to transform.

   --|

   --|   Exceptions:

   --|   None.

   --+------------------------------------------------------------------


   procedure   Transform(
                  Context        : access MD4_Context);

   --+---[Pack_Block]---------------------------------------------------

   --|   Purpose:

   --|   Packs an input block (Byte_Array) into a Four_Bytes_Array

   --|   suitable for transformation.

   --|

   --|   Arguments:

   --|   B              Block to pack.

   --|

   --|   Returned value:

   --|   Packed_Block corresponding to B.

   --|

   --|   Exceptions:

   --|   None.

   --+------------------------------------------------------------------


   function    Pack_Block(
                  B              : in     MD4_Block)
      return   Packed_Block;
   pragma Inline(Pack_Block);

   --+---[Unpack_State]-------------------------------------------------

   --|   Purpose:

   --|   Unpacks the state registers rendering a byte array that is the

   --|   computed digest.

   --|

   --|   Arguments:

   --|   S              State registers.

   --|

   --|   Returned value:

   --|   Unpacked Byte_Array corresponding to S.

   --|

   --|   Exceptions:

   --|   None.

   --+------------------------------------------------------------------


   function    Unpack_State(
                  S              : in     State_Registers)
      return   Byte_Array;
   pragma Inline(Unpack_State);

   ---------------------------------------------------------------------

   -- Body subprogram bodies

   ---------------------------------------------------------------------


   --+---[F]------------------------------------------------------------


   function    F(
                  X        : in     Four_Bytes;
                  Y        : in     Four_Bytes;
                  Z        : in     Four_Bytes)
      return   Four_Bytes
   is
   begin
      return ((X and Y) or ((not X) and Z));
   end F;

   --+---[G]------------------------------------------------------------


   function    G(
                  X        : in     Four_Bytes;
                  Y        : in     Four_Bytes;
                  Z        : in     Four_Bytes)
      return   Four_Bytes
   is
   begin
      return ((X and Y) or (X and Z) or (Y and Z));
   end G;

   --+---[H]------------------------------------------------------------


   function    H(
                  X        : in     Four_Bytes;
                  Y        : in     Four_Bytes;
                  Z        : in     Four_Bytes)
      return   Four_Bytes
   is
   begin
      return (X xor Y xor Z);
   end H;

   --+---[FF]-----------------------------------------------------------


   procedure   FF(
                  A        : in out Four_Bytes;
                  B        : in     Four_Bytes;
                  C        : in     Four_Bytes;
                  D        : in     Four_Bytes;
                  X        : in     Four_Bytes;
                  S        : in     Natural)
   is
   begin
      A := A + F(B, C, D) + X;
      A := Rotate_Left(A, S);
   end FF;

   --+---[GG]-----------------------------------------------------------


   procedure   GG(
                  A        : in out Four_Bytes;
                  B        : in     Four_Bytes;
                  C        : in     Four_Bytes;
                  D        : in     Four_Bytes;
                  X        : in     Four_Bytes;
                  S        : in     Natural)
   is
   begin
      A := A + G(B, C, D) + X + 16#5A82_7999#;
      A := Rotate_Left(A, S);
   end GG;

   --+---[HH]-----------------------------------------------------------


   procedure   HH(
                  A        : in out Four_Bytes;
                  B        : in     Four_Bytes;
                  C        : in     Four_Bytes;
                  D        : in     Four_Bytes;
                  X        : in     Four_Bytes;
                  S        : in     Natural)
   is
   begin
      A := A + H(B, C, D) + X + 16#6ED9_EBA1#;
      A := Rotate_Left(A, S);
   end HH;

   --+---[Transform]----------------------------------------------------


   procedure   Transform(
                  Context       : access MD4_Context)
   is
      T              : State_Registers := Context.all.State;
      X              : Packed_Block := Pack_Block(Context.all.Block);
   begin

      --|   Round 1


      FF(T(1), T(2), T(3), T(4), X( 1),  3);
      FF(T(4), T(1), T(2), T(3), X( 2),  7);
      FF(T(3), T(4), T(1), T(2), X( 3), 11);
      FF(T(2), T(3), T(4), T(1), X( 4), 19);
      FF(T(1), T(2), T(3), T(4), X( 5),  3);
      FF(T(4), T(1), T(2), T(3), X( 6),  7);
      FF(T(3), T(4), T(1), T(2), X( 7), 11);
      FF(T(2), T(3), T(4), T(1), X( 8), 19);
      FF(T(1), T(2), T(3), T(4), X( 9),  3);
      FF(T(4), T(1), T(2), T(3), X(10),  7);
      FF(T(3), T(4), T(1), T(2), X(11), 11);
      FF(T(2), T(3), T(4), T(1), X(12), 19);
      FF(T(1), T(2), T(3), T(4), X(13),  3);
      FF(T(4), T(1), T(2), T(3), X(14),  7);
      FF(T(3), T(4), T(1), T(2), X(15), 11);
      FF(T(2), T(3), T(4), T(1), X(16), 19);

      --|   Round 2


      GG(T(1), T(2), T(3), T(4), X( 1),  3);
      GG(T(4), T(1), T(2), T(3), X( 5),  5);
      GG(T(3), T(4), T(1), T(2), X( 9),  9);
      GG(T(2), T(3), T(4), T(1), X(13), 13);
      GG(T(1), T(2), T(3), T(4), X( 2),  3);
      GG(T(4), T(1), T(2), T(3), X( 6),  5);
      GG(T(3), T(4), T(1), T(2), X(10),  9);
      GG(T(2), T(3), T(4), T(1), X(14), 13);
      GG(T(1), T(2), T(3), T(4), X( 3),  3);
      GG(T(4), T(1), T(2), T(3), X( 7),  5);
      GG(T(3), T(4), T(1), T(2), X(11),  9);
      GG(T(2), T(3), T(4), T(1), X(15), 13);
      GG(T(1), T(2), T(3), T(4), X( 4),  3);
      GG(T(4), T(1), T(2), T(3), X( 8),  5);
      GG(T(3), T(4), T(1), T(2), X(12),  9);
      GG(T(2), T(3), T(4), T(1), X(16), 13);

      --|   Round 3


      HH(T(1), T(2), T(3), T(4), X( 1),  3);
      HH(T(4), T(1), T(2), T(3), X( 9),  9);
      HH(T(3), T(4), T(1), T(2), X( 5), 11);
      HH(T(2), T(3), T(4), T(1), X(13), 15);
      HH(T(1), T(2), T(3), T(4), X( 3),  3);
      HH(T(4), T(1), T(2), T(3), X(11),  9);
      HH(T(3), T(4), T(1), T(2), X( 7), 11);
      HH(T(2), T(3), T(4), T(1), X(15), 15);
      HH(T(1), T(2), T(3), T(4), X( 2),  3);
      HH(T(4), T(1), T(2), T(3), X(10),  9);
      HH(T(3), T(4), T(1), T(2), X( 6), 11);
      HH(T(2), T(3), T(4), T(1), X(14), 15);
      HH(T(1), T(2), T(3), T(4), X( 4),  3);
      HH(T(4), T(1), T(2), T(3), X(12),  9);
      HH(T(3), T(4), T(1), T(2), X( 8), 11);
      HH(T(2), T(3), T(4), T(1), X(16), 15);

      --|   Update state.


      for I in Context.all.State'Range loop
         Context.all.State(I) := Context.all.State(I) + T(I);
      end loop;

      --|   Zeroize sensitive information.


      T := (others => 0);
      X := (others => 0);

   end Transform;

   --+---[Pack_Block]---------------------------------------------------


   function    Pack_Block(
                  B              : in     MD4_Block)
      return   Packed_Block
   is
      R              : Packed_Block := (others => 0);
      J              : Positive := B'First;
   begin
      for I in R'Range loop
         R(I) := Make_Four_Bytes(B(J), B(J + 1), B(J + 2), B(J + 3));
         J := J + 4;
      end loop;

      return R;
   end Pack_Block;

   --+---[Unpack_State]-------------------------------------------------


   function    Unpack_State(
                  S              : in     State_Registers)
      return   Byte_Array
   is
      R              : Byte_Array(1 .. MD4_Digest_Bytes) :=
                           (others => 0);
      J              : Positive := R'First;
   begin
      for I in S'Range loop
         R(J .. J + 3) := To_Byte_Array(S(I), Big_Endian);
         J := J + 4;
      end loop;

      return R;
   end Unpack_State;

   ---------------------------------------------------------------------

   -- Specification declared subprogram bodies

   ---------------------------------------------------------------------


   --+---[Allocate_Context]---------------------------------------------


   function    Allocate_Context
      return   MD4_Context_Ptr
   is
   begin
      return new MD4_Context;
   exception
      when others =>
         raise ACF_Storage_Error;
   end Allocate_Context;

   --+---[Deallocate_Context]-------------------------------------------


   procedure   Deallocate_Context(
                  Context     : in out MD4_Context_Ptr)
   is
   begin
      if Context /= null then
         Free(Context);
      end if;
   end Deallocate_Context;

   --+---[Hash_Start]---------------------------------------------------


   procedure   Hash_Start(
                  Context        : access MD4_Context)
   is
   begin
      Context.all.Bit_Count   := 0;
      Context.all.State       := Initial_State;
      Context.all.Block       := (others => 0);
   end Hash_Start;

   --+---[Hash_Update]--------------------------------------------------


   procedure   Hash_Update(
                  Context        : access MD4_Context;
                  Bytes          : in     Byte_Array)
   is
      I              : Positive;
      L              : Natural := Bytes'Length;
      R              : Natural;
      J              : Positive;
   begin

      --|   If input is not empty process it.


      if L > 0 then

         --|   Compute start index of context block.


         I := 1 +
              Natural(Shift_Right(Context.all.Bit_Count, 3) mod
                      Eight_Bytes(MD4_Block_Bytes));

         --|   Increment bit count.


         Context.all.Bit_Count :=
            Context.all.Bit_Count + Shift_Left(Eight_Bytes(L), 3);

         --|   Compute the number of free slots in context block.


         R := 1 + MD4_Block_Bytes - I;

         J := Bytes'First;

         --|   If the input length is greater than or equal to the

         --|   number of free slots perform the needed

         --|   transformations of input.


         if L >= R then

            --|   Fill context block and transform.


            Context.all.Block(I .. MD4_Block_Bytes) :=
               Bytes(J .. J + R - 1);
            Transform(Context);

            --|   Update counters.


            J := J + R;
            L := L - R;

            --|   Transform remaining input bytes in MD4_Block_Bytes

            --|   chunks.


            while L >= MD4_Block_Bytes loop
               Context.all.Block := Bytes(J .. J + MD4_Block_Bytes - 1);
               Transform(Context);
               J := J + MD4_Block_Bytes;
               L := L - MD4_Block_Bytes;
            end loop;

            I := 1;
         end if;

         --|   Fill context block with remaining bytes.


         while J <= Bytes'Last loop
            Context.all.Block(I) := Bytes(J);
            I := I + 1;
            J := J + 1;
         end loop;
      end if;
   end Hash_Update;

   --+---[Hash_End]-----------------------------------------------------


   function    Hash_End(
                  Context        : access MD4_Context)
      return   Message_Digest
   is
      R              : Message_Digest;
      BC             : Byte_Array(1 .. 8);
      I              : Positive;
      BC_Offset      : Positive := 1 + MD4_Block_Bytes - 8;
   begin

      --|   Save bit counter.


      BC := To_Byte_Array(Context.all.Bit_Count, Big_Endian);

     --|   Compute start index of context block.


      I := 1 +
           Natural(Shift_Right(Context.all.Bit_Count, 3) mod
                   Eight_Bytes(MD4_Block_Bytes));

      --|   Perform pad


      Context.all.Block(I) := 16#80#;
      I := I + 1;

      if I <= MD4_Block_Bytes then
         Context.all.Block(I .. MD4_Block_Bytes) := (others => 0);
      end if;

      if I > BC_Offset then
         Transform(Context);
         Context.all.Block := (others => 0);
      end if;

      --|   Append bit count and transform.


      Context.all.Block(BC_Offset .. MD4_Block_Bytes) := BC;
      Transform(Context);

      --|   Get digest from state.


      R := To_Message_Digest(Unpack_State(Context.all.State));

      --|   Zeroize context.


      Context.all.Bit_Count   := 0;
      Context.all.State       := (others => 0);
      Context.all.Block       := (others => 0);

      --|   Return computed digest.


      return R;
   end Hash_End;

   --+---[Initialize]---------------------------------------------------


   procedure   Initialize(
                  Object         : in out MD4_Context)
   is
   begin
      Object.Algo_Id    := ACF.Hash.MD4;
      Object.Bit_Count  := 0;
      Object.State      := Initial_State;
      Object.Block      := (others => 0);
   end Initialize;

   --+---[Finalize]-----------------------------------------------------


   procedure   Finalize(
                  Object         : in out MD4_Context)
   is
   begin
      Object.Bit_Count  := 0;
      Object.State      := (others => 0);
      Object.Block      := (others => 0);
   end Finalize;

end ACF.Hash.Algorithms.MD4;