{
***************************************************
* A binary compatible Cast128 implementation      *
* written by Dave Barton (davebarton@bigfoot.com) *
* Based on C source by                            *
* Steve Reid <sreid@sea-to-sky.net>               *
***************************************************
* 64bit block encryption                          *
* Variable size key - up to 128bit                *
***************************************************
}
unit Cast128;

interface
uses
  Sysutils, Tools;

type
  TCast128Data= record
    InitBlock: array[0..7] of byte;    { initial IV }
    LastBlock: array[0..7] of byte;    { current IV }
    xKey: array[0..31] of DWord;
    Rounds: integer;
  end;

function Cast128SelfTest: boolean;
  { performs a self test on this implementation }
procedure Cast128Init(var Data: TCast128Data; Key: pointer; Len: integer; IV: pointer);
  { initializes the TCast128Data structure with the key information and IV if applicable }
procedure Cast128Burn(var Data: TCast128Data);
  { erases all information about the key }

procedure Cast128EncryptECB(const Data: TCast128Data; InData, OutData: pointer);
  { encrypts the data in a 64bit block using the ECB mode }
procedure Cast128EncryptCBC(var Data: TCast128Data; InData, OutData: pointer);
  { encrypts the data in a 64bit block using the CBC chaining mode }
procedure Cast128EncryptOFB(var Data: TCast128Data; InData, OutData: pointer);
  { encrypts the data in a 64bit block using the OFB chaining mode }
procedure Cast128EncryptCFB(var Data: TCast128Data; InData, OutData: pointer; Len: integer);
  { encrypts Len bytes of data using the CFB chaining mode }
procedure Cast128EncryptOFBC(var Data: TCast128Data; InData, OutData: pointer; Len: integer);
  { encrypts Len bytes of data using the OFB counter chaining mode }

procedure Cast128DecryptECB(const Data: TCast128Data; InData, OutData: pointer);
  { decrypts the data in a 64bit block using the ECB mode }
procedure Cast128DecryptCBC(var Data: TCast128Data; InData, OutData: pointer);
  { decrypts the data in a 64bit block using the CBC chaining mode }
procedure Cast128DecryptOFB(var Data: TCast128Data; InData, OutData: pointer);
  { decrypts the data in a 64bit block using the OFB chaining mode }
procedure Cast128DecryptCFB(var Data: TCast128Data; InData, OutData: pointer; Len: integer);
  { decrypts Len bytes of data using the CFB chaining mode }
procedure Cast128DecryptOFBC(var Data: TCast128Data; InData, OutData: pointer; Len: integer);
  { decrypts Len bytes of data using the OFB counter chaining mode }

procedure Cast128Reset(var Data: TCast128Data);
  { resets the chaining mode information }

{******************************************************************************}
implementation

{$I Cast128.inc}
{$R-}

function Cast128SelfTest;
const
  Key: array[0..15] of byte= ($01,$23,$45,$67,$12,$34,$56,$78,$23,$45,$67,$89,$34,$56,$78,$9A);
  InBlock: array[0..7] of byte= ($01,$23,$45,$67,$89,$AB,$CD,$EF);
  OutBlock: array[0..7] of byte= ($23,$8B,$4F,$E5,$84,$7E,$44,$B2);
var
  Block: array[0..7] of byte;
  Data: TCast128Data;
begin
  Cast128Init(Data,@Key,Sizeof(Key),nil);
  Cast128EncryptECB(Data,@InBlock,@Block);
  Result:= CompareMem(@Block,@OutBlock,Sizeof(Block));
  Cast128DecryptECB(Data,@Block,@Block);
  Result:= Result and CompareMem(@Block,@InBlock,Sizeof(Block));
  Cast128Burn(Data);
end;

procedure Cast128Init;
var
  x, t, z: array[0..3] of DWord;
  i: integer;
begin
  if (Len<= 0) or (Len> 16) then
    raise Exception.Create('Cast128: Key must be between 1 and 16 bytes long');
  with Data do
  begin
    if IV= nil then
    begin
      FillChar(InitBlock,8,0);
      FillChar(LastBlock,8,0);
    end
    else
    begin
      Move(IV^,InitBlock,8);
      Move(IV^,LastBlock,8);
    end;
    if Len<= 10 then
      Rounds:= 12
    else
      Rounds:= 16;
    FillChar(x,Sizeof(x),0);
    Move(Key^,x,Len);
    x[0]:= (x[0] shr 24) or ((x[0] shr 8) and $FF00) or ((x[0] shl 8) and $FF0000) or (x[0] shl 24);
    x[1]:= (x[1] shr 24) or ((x[1] shr 8) and $FF00) or ((x[1] shl 8) and $FF0000) or (x[1] shl 24);
    x[2]:= (x[2] shr 24) or ((x[2] shr 8) and $FF00) or ((x[2] shl 8) and $FF0000) or (x[2] shl 24);
    x[3]:= (x[3] shr 24) or ((x[3] shr 8) and $FF00) or ((x[3] shl 8) and $FF0000) or (x[3] shl 24);
    i:= 0;
    while i< 32 do
    begin
      case (i and 4) of
        0:
          begin
            z[0]:= x[0] xor cast_sbox5[(x[3] shr 16) and $FF] xor
             cast_sbox6[x[3] and $FF] xor cast_sbox7[x[3] shr 24] xor
             cast_sbox8[(x[3] shr 8) and $FF] xor cast_sbox7[x[2] shr 24];
            t[0]:= z[0];
            z[1]:= x[2] xor cast_sbox5[z[0] shr 24] xor
             cast_sbox6[(z[0] shr 8) and $FF] xor cast_sbox7[(z[0] shr 16) and $FF] xor
             cast_sbox8[z[0] and $FF] xor cast_sbox8[(x[2] shr 8) and $FF];
            t[1]:= z[1];
            z[2]:= x[3] xor cast_sbox5[z[1] and $FF] xor
             cast_sbox6[(z[1] shr 8) and $FF] xor cast_sbox7[(z[1] shr 16) and $FF] xor
             cast_sbox8[z[1] shr 24] xor cast_sbox5[(x[2] shr 16) and $FF];
            t[2]:= z[2];
            z[3]:= x[1] xor cast_sbox5[(z[2] shr 8) and $FF] xor
             cast_sbox6[(z[2] shr 16) and $FF] xor cast_sbox7[z[2] and $FF] xor
             cast_sbox8[z[2] shr 24] xor cast_sbox6[x[2] and $FF];
            t[3]:= z[3];
          end;
        4:
          begin
            x[0]:= z[2] xor cast_sbox5[(z[1] shr 16) and $FF] xor
             cast_sbox6[z[1] and $FF] xor cast_sbox7[z[1] shr 24] xor
             cast_sbox8[(z[1] shr 8) and $FF] xor cast_sbox7[z[0] shr 24];
            t[0]:= x[0];
            x[1]:= z[0] xor cast_sbox5[x[0] shr 24] xor
             cast_sbox6[(x[0] shr 8) and $FF] xor cast_sbox7[(x[0] shr 16) and $FF] xor
             cast_sbox8[x[0] and $FF] xor cast_sbox8[(z[0] shr 8) and $FF];
            t[1]:= x[1];
            x[2]:= z[1] xor cast_sbox5[x[1] and $FF] xor
             cast_sbox6[(x[1] shr 8) and $FF] xor cast_sbox7[(x[1] shr 16) and $FF] xor
             cast_sbox8[x[1] shr 24] xor cast_sbox5[(z[0] shr 16) and $FF];
            t[2]:= x[2];
            x[3]:= z[3] xor cast_sbox5[(x[2] shr 8) and $FF] xor
             cast_sbox6[(x[2] shr 16) and $FF] xor cast_sbox7[x[2] and $FF] xor
             cast_sbox8[x[2] shr 24] xor cast_sbox6[z[0] and $FF];
            t[3]:= x[3];
          end;
      end;
      case (i and 12) of
        0,12:
          begin
            xKey[i+0]:= cast_sbox5[t[2] shr 24] xor cast_sbox6[(t[2] shr 16) and $FF] xor
             cast_sbox7[t[1] and $FF] xor cast_sbox8[(t[1] shr 8) and $FF];
            xKey[i+1]:= cast_sbox5[(t[2] shr 8) and $FF] xor cast_sbox6[t[2] and $FF] xor
             cast_sbox7[(t[1] shr 16) and $FF] xor cast_sbox8[t[1] shr 24];
            xKey[i+2]:= cast_sbox5[t[3] shr 24] xor cast_sbox6[(t[3] shr 16) and $FF] xor
             cast_sbox7[t[0] and $FF] xor cast_sbox8[(t[0] shr 8) and $FF];
            xKey[i+3]:= cast_sbox5[(t[3] shr 8) and $FF] xor cast_sbox6[t[3] and $FF] xor
             cast_sbox7[(t[0] shr 16) and $FF] xor cast_sbox8[t[0] shr 24];
          end;
        4,8:
          begin
            xKey[i+0]:= cast_sbox5[t[0] and $FF] xor cast_sbox6[(t[0] shr 8) and $FF] xor
             cast_sbox7[t[3] shr 24] xor cast_sbox8[(t[3] shr 16) and $FF];
            xKey[i+1]:= cast_sbox5[(t[0] shr 16) and $FF] xor cast_sbox6[t[0] shr 24] xor
             cast_sbox7[(t[3] shr 8) and $FF] xor cast_sbox8[t[3] and $FF];
            xKey[i+2]:= cast_sbox5[t[1] and $FF] xor cast_sbox6[(t[1] shr 8) and $FF] xor
             cast_sbox7[t[2] shr 24] xor cast_sbox8[(t[2] shr 16) and $FF];
            xKey[i+3]:= cast_sbox5[(t[1] shr 16) and $FF] xor cast_sbox6[t[1] shr 24] xor
             cast_sbox7[(t[2] shr 8) and $FF] xor cast_sbox8[t[2] and $FF];
          end;
      end;
      case (i and 12) of
        0:
          begin
            xKey[i+0]:= xKey[i+0] xor cast_sbox5[(z[0] shr 8) and $FF];
            xKey[i+1]:= xKey[i+1] xor cast_sbox6[(z[1] shr 8) and $FF];
            xKey[i+2]:= xKey[i+2] xor cast_sbox7[(z[2] shr 16) and $FF];
            xKey[i+3]:= xKey[i+3] xor cast_sbox8[z[3] shr 24];
          end;
        4:
          begin
            xKey[i+0]:= xKey[i+0] xor cast_sbox5[x[2] shr 24];
            xKey[i+1]:= xKey[i+1] xor cast_sbox6[(x[3] shr 16) and $FF];
            xKey[i+2]:= xKey[i+2] xor cast_sbox7[x[0] and $FF];
            xKey[i+3]:= xKey[i+3] xor cast_sbox8[x[1] and $FF];
          end;
        8:
          begin
            xKey[i+0]:= xKey[i+0] xor cast_sbox5[(z[2] shr 16) and $FF];
            xKey[i+1]:= xKey[i+1] xor cast_sbox6[z[3] shr 24];
            xKey[i+2]:= xKey[i+2] xor cast_sbox7[(z[0] shr 8) and $FF];
            xKey[i+3]:= xKey[i+3] xor cast_sbox8[(z[1] shr 8) and $FF];
          end;
        12:
          begin
            xKey[i+0]:= xKey[i+0] xor cast_sbox5[x[0] and $FF];
            xKey[i+1]:= xKey[i+1] xor cast_sbox6[x[1] and $FF];
            xKey[i+2]:= xKey[i+2] xor cast_sbox7[x[2] shr 24];
            xKey[i+3]:= xKey[i+3] xor cast_sbox8[(x[3] shr 16) and $FF];
          end;
      end;
      if (i >= 16) then
      begin
        xKey[i+0]:= xKey[i+0] and 31;
        xKey[i+1]:= xKey[i+1] and 31;
        xKey[i+2]:= xKey[i+2] and 31;
        xKey[i+3]:= xKey[i+3] and 31;
      end;
      Inc(i,4);
    end;
  end;
end;

procedure Cast128Burn;
begin
  FillChar(Data,Sizeof(Data),0);
end;