sha1.pas

   1 {
   2     This file is part of the Free Pascal packages.
   3     Copyright (c) 2009 by the Free Pascal development team
   4
   5     Implements a SHA-1 digest algorithm (RFC 3174)
   6
   7     See the file COPYING.FPC, included in this distribution,
   8     for details about the copyright.
   9
  10     This program is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13
  14  **********************************************************************}
  15
  16 unit sha1;
  17 {$mode objfpc}{$h+}
  18
  19 interface
  20
  21 type
  22   TSHA1Digest = array[0..19] of Byte;
  23
  24   TSHA1Context = record
  25     State: array[0..4] of Cardinal;
  26     Buffer: array[0..63] of Byte;
  27     BufCnt: PtrUInt;   { in current block, i.e. in range of 0..63 }
  28     Length: QWord;     { total count of bytes processed }
  29   end;
  30
  31 { core }
  32 procedure SHA1Init(out ctx: TSHA1Context);
  33 procedure SHA1Update(var ctx: TSHA1Context; const Buf; BufLen: PtrUInt);
  34 procedure SHA1Final(var ctx: TSHA1Context; out Digest: TSHA1Digest);
  35
  36 { auxiliary }
  37 function SHA1String(const S: String): TSHA1Digest;
  38 function SHA1Buffer(const Buf; BufLen: PtrUInt): TSHA1Digest;
  39 function SHA1File(const Filename: String; const Bufsize: PtrUInt = 1024): TSHA1Digest;
  40
  41 { helpers }
  42 function SHA1Print(const Digest: TSHA1Digest): String;
  43 function SHA1Match(const Digest1, Digest2: TSHA1Digest): Boolean;
  44
  45 implementation
  46
  47 // inverts the bytes of (Count div 4) cardinals from source to target.
  48 procedure Invert(Source, Dest: Pointer; Count: PtrUInt);
  49 var
  50   S: PByte;
  51   T: PCardinal;
  52   I: PtrUInt;
  53 begin
  54   S := Source;
  55   T := Dest;
  56   for I := 1 to (Count div 4) do
  57   begin
  58     T^ := S[3] or (S[2] shl 8) or (S[1] shl 16) or (S[0] shl 24);
  59     inc(S,4);
  60     inc(T);
  61   end;
  62 end;
  63
  64 procedure SHA1Init(out ctx: TSHA1Context);
  65 begin
  66   FillChar(ctx, sizeof(TSHA1Context), 0);
  67   ctx.State[0] := $67452301;
  68   ctx.State[1] := $efcdab89;
  69   ctx.State[2] := $98badcfe;
  70   ctx.State[3] := $10325476;
  71   ctx.State[4] := $c3d2e1f0;
  72 end;
  73
  74 const
  75   K20 = $5A827999;
  76   K40 = $6ED9EBA1;
  77   K60 = $8F1BBCDC;
  78   K80 = $CA62C1D6;
  79
  80 procedure SHA1Transform(var ctx: TSHA1Context; Buf: Pointer);
  81 var
  82   A, B, C, D, E, T: Cardinal;
  83   Data: array[0..15] of Cardinal;
  84   i: Integer;
  85 begin
  86   A := ctx.State[0];
  87   B := ctx.State[1];
  88   C := ctx.State[2];
  89   D := ctx.State[3];
  90   E := ctx.State[4];
  91   Invert(Buf, @Data, 64);
  92 {$push}
  93 {$r-,q-}
  94   i := 0;
  95   repeat
  96     T := (B and C) or (not B and D) + K20 + E;
  97     E := D;
  98     D := C;
  99     C := rordword(B, 2);
 100     B := A;
 101     A := T + roldword(A, 5) + Data[i and 15];
 102     Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
 103     Inc(i);
 104   until i > 19;
 105
 106   repeat
 107     T := (B xor C xor D) + K40 + E;
 108     E := D;
 109     D := C;
 110     C := rordword(B, 2);
 111     B := A;
 112     A := T + roldword(A, 5) + Data[i and 15];
 113     Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
 114     Inc(i);
 115   until i > 39;
 116
 117   repeat
 118     T := (B and C) or (B and D) or (C and D) + K60 + E;
 119     E := D;
 120     D := C;
 121     C := rordword(B, 2);
 122     B := A;
 123     A := T + roldword(A, 5) + Data[i and 15];
 124     Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
 125     Inc(i);
 126   until i > 59;
 127
 128   repeat
 129     T := (B xor C xor D) + K80 + E;
 130     E := D;
 131     D := C;
 132     C := rordword(B, 2);
 133     B := A;
 134     A := T + roldword(A, 5) + Data[i and 15];
 135     Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
 136     Inc(i);
 137   until i > 79;
 138
 139   Inc(ctx.State[0], A);
 140   Inc(ctx.State[1], B);
 141   Inc(ctx.State[2], C);
 142   Inc(ctx.State[3], D);
 143   Inc(ctx.State[4], E);
 144 {$pop}
 145   Inc(ctx.Length,64);
 146 end;
 147
 148 procedure SHA1Update(var ctx: TSHA1Context; const Buf; BufLen: PtrUInt);
 149 var
 150   Src: PByte;
 151   Num: PtrUInt;
 152 begin
 153   if BufLen = 0 then
 154     Exit;
 155
 156   Src := @Buf;
 157   Num := 0;
 158
 159   // 1. Transform existing data in buffer
 160   if ctx.BufCnt > 0 then
 161   begin
 162     // 1.1 Try to fill buffer up to block size
 163     Num := 64 - ctx.BufCnt;
 164     if Num > BufLen then
 165       Num := BufLen;
 166
 167     Move(Src^, ctx.Buffer[ctx.BufCnt], Num);
 168     Inc(ctx.BufCnt, Num);
 169     Inc(Src, Num);
 170
 171     // 1.2 If buffer is filled, transform it
 172     if ctx.BufCnt = 64 then
 173     begin
 174       SHA1Transform(ctx, @ctx.Buffer);
 175       ctx.BufCnt := 0;
 176     end;
 177   end;
 178
 179   // 2. Transform input data in 64-byte blocks
 180   Num := BufLen - Num;
 181   while Num >= 64 do
 182   begin
 183     SHA1Transform(ctx, Src);
 184     Inc(Src, 64);
 185     Dec(Num, 64);
 186   end;
 187
 188   // 3. If there's less than 64 bytes left, add it to buffer
 189   if Num > 0 then
 190   begin
 191     ctx.BufCnt := Num;
 192     Move(Src^, ctx.Buffer, Num);
 193   end;
 194 end;
 195
 196 const
 197   PADDING: array[0..63] of Byte =
 198     ($80,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 199        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 200        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
 201        0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 202     );
 203
 204 procedure SHA1Final(var ctx: TSHA1Context; out Digest: TSHA1Digest);
 205 var
 206   Length: QWord;
 207   Pads: Cardinal;
 208 begin
 209   // 1. Compute length of the whole stream in bits
 210   Length := 8 * (ctx.Length + ctx.BufCnt);
 211
 212   // 2. Append padding bits
 213   if ctx.BufCnt >= 56 then
 214     Pads := 120 - ctx.BufCnt
 215   else
 216     Pads := 56 - ctx.BufCnt;
 217   SHA1Update(ctx, PADDING, Pads);
 218
 219   // 3. Append length of the stream (8 bytes)
 220   Length := NtoBE(Length);
 221   SHA1Update(ctx, Length, 8);
 222
 223   // 4. Invert state to digest
 224   Invert(@ctx.State, @Digest, 20);
 225   FillChar(ctx, sizeof(TSHA1Context), 0);
 226 end;
 227
 228 function SHA1String(const S: String): TSHA1Digest;
 229 var
 230   Context: TSHA1Context;
 231 begin
 232   SHA1Init(Context);
 233   SHA1Update(Context, PChar(S)^, length(S));
 234   SHA1Final(Context, Result);
 235 end;
 236
 237 function SHA1Buffer(const Buf; BufLen: PtrUInt): TSHA1Digest;
 238 var
 239   Context: TSHA1Context;
 240 begin
 241   SHA1Init(Context);
 242   SHA1Update(Context, buf, buflen);
 243   SHA1Final(Context, Result);
 244 end;
 245
 246 function SHA1File(const Filename: String; const Bufsize: PtrUInt): TSHA1Digest;
 247 var
 248   F: File;
 249   Buf: Pchar;
 250   Context: TSHA1Context;
 251   Count: Cardinal;
 252   ofm: Longint;
 253 begin
 254   SHA1Init(Context);
 255
 256   Assign(F, Filename);
 257   {$i-}
 258   ofm := FileMode;
 259   FileMode := 0;
 260   Reset(F, 1);
 261   {$i+}
 262
 263   if IOResult = 0 then
 264   begin
 265     GetMem(Buf, BufSize);
 266     repeat
 267       BlockRead(F, Buf^, Bufsize, Count);
 268       if Count > 0 then
 269         SHA1Update(Context, Buf^, Count);
 270     until Count < BufSize;
 271     FreeMem(Buf, BufSize);
 272     Close(F);
 273   end;
 274
 275   SHA1Final(Context, Result);
 276   FileMode := ofm;
 277 end;
 278
 279 const
 280   HexTbl: array[0..15] of char='0123456789abcdef';     // lowercase
 281
 282 function SHA1Print(const Digest: TSHA1Digest): String;
 283 var
 284   I: Integer;
 285   P: PChar;
 286 begin
 287   SetLength(Result, 40);
 288   P := Pointer(Result);
 289   for I := 0 to 19 do
 290   begin
 291     P[0] := HexTbl[(Digest[i] shr 4) and 15];
 292     P[1] := HexTbl[Digest[i] and 15];
 293     Inc(P,2);
 294   end;
 295 end;
 296
 297 function SHA1Match(const Digest1, Digest2: TSHA1Digest): Boolean;
 298 var
 299   A: array[0..4] of Cardinal absolute Digest1;
 300   B: array[0..4] of Cardinal absolute Digest2;
 301 begin
 302   Result := (A[0] = B[0]) and (A[1] = B[1]) and (A[2] = B[2]) and (A[3] = B[3]) and (A[4] = B[4]);
 303 end;
 304
 305 end.
 306 k