1 (*

     2  * Hedgewars, a free turn based strategy game

     3  * Copyright (c) 2004-2010 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

     5  * This program is free software; you can redistribute it and/or modify

     6  * it under the terms of the GNU General Public License as published by

     7  * the Free Software Foundation; version 2 of the License

     8  *

     9  * This program is distributed in the hope that it will be useful,

    10  * but WITHOUT ANY WARRANTY; without even the implied warranty of

    11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    12  * GNU General Public License for more details.

    13  *

    14  * You should have received a copy of the GNU General Public License

    15  * along with this program; if not, write to the Free Software

    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA

    17  *)

    18 

    19 {$INCLUDE "options.inc"}

    20 

    21 unit uSHA;

    22 interface

    23 uses SDLh;

    24 

    25 type TSHA1Context = packed record

    26                     H: array[0..4] of LongWord;

    27                     Length, CurrLength: Int64;

    28                     Buf: array[0..63] of byte;

    29                     end;

    30      TSHA1Digest =  array[0..4] of LongWord;

    31 

    32 procedure SHA1Init(var Context: TSHA1Context);

    33 procedure SHA1Update(var Context: TSHA1Context; Buf: PByteArray; Length: LongWord);

    34 procedure SHA1UpdateLongwords(var Context: TSHA1Context; Buf: PLongwordArray; Length: LongWord);

    35 function  SHA1Final(Context: TSHA1Context): TSHA1Digest;

    36 

    37 implementation

    38 

    39 function rol(x: LongWord; y: Byte): LongWord;

    40 begin

    41   rol:= (X shl y) or (X shr (32 - y))

    42 end;

    43 

    44 function Ft(t, b, c, d: LongWord): LongWord;

    45 begin

    46 case t of

    47       0..19: Ft := (b and c) or ((not b) and d);

    48      20..39: Ft :=  b xor c xor d;

    49      40..59: Ft := (b and c) or (b and d) or (c and d);

    50      else    Ft :=  b xor c xor d;

    51   end;

    52 end;

    53 

    54 function Kt(t: Byte): LongWord;

    55 begin

    56   case t of

    57      0..19: Kt := $5A827999;

    58     20..39: Kt := $6ED9EBA1;

    59     40..59: Kt := $8F1BBCDC;

    60   else

    61     Kt := $CA62C1D6

    62   end;

    63 end;

    64 

    65 

    66 procedure SHA1Hash(var Context: TSHA1Context);

    67 var S: array[0..4 ] of LongWord;

    68     W: array[0..79] of LongWord;

    69     i, t: LongWord;

    70 begin

    71 {$HINTS OFF}

    72 move(Context.H, S, sizeof(S));

    73 {$HINTS ON}

    74 for i:= 0 to 15 do

    75     SDLNet_Write32(PLongWordArray(@Context.Buf)^[i], @W[i]);

    76 

    77 for i := 16 to 79 do

    78     W[i] := rol(W[i - 3] xor W[i - 8] xor W[i - 14] xor W[i - 16], 1);

    79 

    80 for i := 0 to 79 do

    81     begin

    82     t:= rol(S[0], 5) + Ft(i, S[1], S[2], S[3]) + S[4] + W[i] + Kt(i);

    83     S[4]:= S[3];

    84     S[3]:= S[2];

    85     S[2]:= rol(S[1], 30);

    86     S[1]:= S[0];

    87     S[0]:= t

    88     end;

    89 

    90 for i := 0 to 4 do

    91     Context.H[i]:= Context.H[i] + S[i]

    92 end;

    93 

    94 procedure SHA1Init(var Context: TSHA1Context);

    95 begin

    96   with Context do

    97        begin

    98        Length    := 0;

    99        CurrLength:= 0;

   100        H[0]:= $67452301;

   101        H[1]:= $EFCDAB89;

   102        H[2]:= $98BADCFE;

   103        H[3]:= $10325476;

   104        H[4]:= $C3D2E1F0

   105   end

   106 end;

   107 

   108 procedure SHA1Update(var Context: TSHA1Context; Buf: PByteArray; Length: LongWord);

   109 var i: Longword;

   110 begin

   111 for i:= 0 to Pred(Length) do

   112     begin

   113     Context.Buf[Context.CurrLength]:= Buf^[i];

   114     inc(Context.CurrLength);

   115     if Context.CurrLength = 64 then

   116        begin

   117        SHA1Hash(Context);

   118        inc(Context.Length, 512);

   119        Context.CurrLength:= 0

   120        end

   121     end

   122 end;

   123 

   124 procedure SHA1UpdateLongwords(var Context: TSHA1Context; Buf: PLongwordArray; Length: LongWord);

   125 var i: Longword;

   126 begin

   127     for i:= 0 to Pred(Length div 4) do

   128     begin

   129         SDLNet_Write32(Buf^[i], @Context.Buf[Context.CurrLength]);

   130         inc(Context.CurrLength, 4);

   131         if Context.CurrLength = 64 then

   132         begin

   133             SHA1Hash(Context);

   134             inc(Context.Length, 512);

   135             Context.CurrLength:= 0

   136         end

   137     end

   138 end;

   139 

   140 function  SHA1Final(Context: TSHA1Context): TSHA1Digest;

   141 var i: LongWord;

   142 begin

   143     Context.Length:= Context.Length + Context.CurrLength shl 3;

   144     Context.Buf[Context.CurrLength]:= $80;

   145     inc(Context.CurrLength);

   146 

   147     if Context.CurrLength > 56 then

   148     begin

   149         FillChar(Context.Buf[Context.CurrLength], 64 - Context.CurrLength, 0);

   150         Context.CurrLength:= 64;

   151         SHA1Hash(Context);

   152         Context.CurrLength:=0

   153     end;

   154 

   155     FillChar(Context.Buf[Context.CurrLength], 56 - Context.CurrLength, 0);

   156 

   157     for i:= 56 to 63 do

   158         Context.Buf[i] := (Context.Length shr ((63 - i) * 8)) and $FF;

   159     SHA1Hash(Context);

   160     for i:= 0 to 4 do

   161         SHA1Final[i]:= Context.H[i];

   162 

   163     FillChar(Context, sizeof(Context), 0)

   164 end;

   165 

   166 end.