comet/test/test_des.pas

{
  DES test suite
  Test vectors from NIST FIPS 46-3 and Argus xDES.pas
}
program test_des;

{$mode objfpc}{$H+}

uses
  SysUtils, cometdes;

var
  Pass, Fail: Integer;

procedure Check(const Name: string; OK: Boolean);
begin
  if OK then
  begin
    WriteLn(Name, '  OK');
    Inc(Pass);
  end
  else
  begin
    WriteLn(Name, '  FAIL');
    Inc(Fail);
  end;
end;

function BlockToHex(const B: TDESBlock): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to 7 do
    Result := Result + LowerCase(IntToHex(B[I], 2));
end;

procedure HexToBlock(const Hex: string; out B: TDESBlock);
var
  I: Integer;
begin
  FillChar(B, SizeOf(B), 0);
  for I := 0 to 7 do
    B[I] := StrToInt('$' + Copy(Hex, I * 2 + 1, 2));
end;

procedure TestECB;
var
  Key, Data, Expected: TDESBlock;
  KS: TDESKeySchedule;
begin
  { NIST test vector: key=0000000000000000 data=0000000000000000 → 8ca64de9c1b123a7 }
  HexToBlock('0000000000000000', Key);
  HexToBlock('0000000000000000', Data);
  DESSetKey(Key, KS);
  DESCrypt(Data, KS, True);
  Check('ECB zeros encrypt = 8ca64de9c1b123a7', BlockToHex(Data) = '8ca64de9c1b123a7');

  { Decrypt back }
  DESCrypt(Data, KS, False);
  Check('ECB zeros decrypt = 0000000000000000', BlockToHex(Data) = '0000000000000000');

  { key=FFFFFFFFFFFFFFFF data=FFFFFFFFFFFFFFFF → 7359b2163e4edc58 }
  HexToBlock('ffffffffffffffff', Key);
  HexToBlock('ffffffffffffffff', Data);
  DESSetKey(Key, KS);
  DESCrypt(Data, KS, True);
  Check('ECB FF encrypt = 7359b2163e4edc58', BlockToHex(Data) = '7359b2163e4edc58');

  DESCrypt(Data, KS, False);
  Check('ECB FF decrypt = ffffffffffffffff', BlockToHex(Data) = 'ffffffffffffffff');

  { key=1111111111111111 data=1111111111111111 → f40379ab9e0ec533 }
  HexToBlock('1111111111111111', Key);
  HexToBlock('1111111111111111', Data);
  DESSetKey(Key, KS);
  DESCrypt(Data, KS, True);
  Check('ECB 11 encrypt = f40379ab9e0ec533', BlockToHex(Data) = 'f40379ab9e0ec533');

  { key=FEFEFEFEFEFEFEFE data=FFFFFFFFFFFFFFFF → 7359b2163e4edc58 }
  HexToBlock('fefefefefefefefe', Key);
  HexToBlock('ffffffffffffffff', Data);
  DESSetKey(Key, KS);
  DESCrypt(Data, KS, True);
  Check('ECB FEFE/FF encrypt = 7359b2163e4edc58', BlockToHex(Data) = '7359b2163e4edc58');

  { key=0101010101010101 data=0000000000000000 → 8ca64de9c1b123a7 }
  HexToBlock('0101010101010101', Key);
  HexToBlock('0000000000000000', Data);
  DESSetKey(Key, KS);
  DESCrypt(Data, KS, True);
  Check('ECB 0101/00 encrypt = 8ca64de9c1b123a7', BlockToHex(Data) = '8ca64de9c1b123a7');
end;

procedure TestCBC;
var
  Key, IV, SaveIV: TDESBlock;
  KS: TDESKeySchedule;
  Buf: array[0..15] of Byte;  { 2 blocks }
begin
  { CBC encrypt 16 zero bytes with zero key and zero IV }
  HexToBlock('1111111111111111', Key);
  FillChar(IV, SizeOf(IV), 0);
  FillChar(Buf, SizeOf(Buf), $11);
  DESSetKey(Key, KS);
  SaveIV := IV;

  DESCryptCBC(Buf, 16, KS, IV, True);

  { Decrypt back }
  IV := SaveIV;
  DESCryptCBC(Buf, 16, KS, IV, False);

  { Should be back to original }
  Check('CBC round-trip block 0', Buf[0] = $11);
  Check('CBC round-trip block 7', Buf[7] = $11);
  Check('CBC round-trip block 8', Buf[8] = $11);
  Check('CBC round-trip block 15', Buf[15] = $11);
end;

procedure TestOddParity;
var
  Key: TDESBlock;
begin
  HexToBlock('0000000000000000', Key);
  DESSetOddParity(Key);
  Check('OddParity(00) = 01', Key[0] = 1);

  HexToBlock('fefefefefefefefe', Key);
  DESSetOddParity(Key);
  Check('OddParity(FE) = FE', Key[0] = $FE);
end;

begin
  Pass := 0;
  Fail := 0;

  WriteLn('--- DES ECB ---');
  TestECB;
  WriteLn('--- DES CBC ---');
  TestCBC;
  WriteLn('--- Odd Parity ---');
  TestOddParity;

  WriteLn;
  WriteLn(Pass, '/', Pass + Fail, ' tests passed.');
  if Fail > 0 then
    Halt(1);
end.