Underc0de
Programación General => Delphi => Mensaje iniciado por: Expermicid en Junio 11, 2013, 09:39:39 PM
unit Blowfish;
{
(c) 1998, 1999, 2000 Budi Sukmawan
mailto:budskman [at] yahoo [dot] com
[url]http://www.bimacipta.com/[/url]
1998.04.17 written by Budi Sukmawan <[email protected]>
1999.03.25 Add ECB, CBC, CTS, CFB, OFB routine.
1999.11.06 Change Setup key routine.
Fix CBC, CBC CTS, CFB, OFB routine.
1999.12.03 change type casting at endian conversion
small performance adv. [-12 clock/round)
2000.04.21 Simplify routine for publication
CBC mode only
}
interface
uses Windows, SysUtils;
const
BF_BLOCKSIZE = 8; { Blowfish block size }
BF_SBOX_SIZE = 256; { Number of S-box entries }
BF_SBOX_SIZE_BYTES = ( BF_SBOX_SIZE * 4 );
BF_PARRAY_SIZE = 18; { Number of P-array entries }
BF_NO_ROUNDS = 16;
IVSIZE = BF_BLOCKSIZE;
type
{$ifndef VER80}{$ifndef VER90}{$ifndef VER93}
{$ifndef VER100}{$ifndef VER110}
{$define D4UP}
{$endif}{$endif}{$endif}{$endif}{$endif}
{$ifndef D4UP}
LongWord = LongInt;
{$endif}
TSBox = array [0..BF_SBOX_SIZE-1] of LongWord;
TPArr = array [0..BF_PARRAY_SIZE-1] of LongWord;
TBFBlock = array [0..BF_BLOCKSIZE-1] of Byte;
TIV = array [0..IVSIZE-1] of Byte;
PBA = PByteArray;
PLA = ^TLongArray;
TLongArray = array[0..(4*1024)-1] of LongWord;
{$I BF_Init.Inc}
type
PBlowFishKey = ^TBlowFishKey;
TBlowFishKey = record
P: TPArr; { P-array }
S1, S2, S3, S4: TSBox; { S-boxes }
end;
TCryptCtx = record
{ User encryption key }
key: TBlowFishKey; { kunci Blowfish }
IV, { Initial IV }
currentIV: TIV; { IV }
end;
procedure bfEncrypt(const key: TBlowFishKey;const inBlock;var outBlock);
procedure bfDecrypt(const key: TBlowFishKey;const inBlock;var outBlock);
procedure bfKeySetup(var key: TBlowFishKey;const pUserKey;
userKeyLen: Integer );
function bfSelfTest: Integer;
procedure bfEncryptCBC(var cryptCtx: TCryptCtx; var pBuffer; bufLen: Integer);
procedure bfDecryptCBC(var cryptCtx: TCryptCtx; var pBuffer; bufLen: Integer);
procedure bfResetContext(var cryptCtx: TCryptCtx);
function bfModeSelfTest: Integer;
implementation
procedure bfEncrypt(const key: TBlowFishKey;const inBlock;var outBlock);
var
L, R, i: LongWord;
begin
{ get data }
L := (LongWord(TByteArray(inBlock)[0]) shl 24) or
(LongWord(TByteArray(inBlock)[1]) shl 16) or
(LongWord(TByteArray(inBlock)[2]) shl 8) or
LongWord(TByteArray(inBlock)[3]);
R := (LongWord(TByteArray(inBlock)[4]) shl 24) or
(LongWord(TByteArray(inBlock)[5]) shl 16) or
(LongWord(TByteArray(inBlock)[6]) shl 8) or
LongWord(TByteArray(inBlock)[7]);
{ Perform 16 rounds of encryption }
with key do
begin
i := 1;
L := L xor P[0];
while i <= BF_NO_ROUNDS do
begin
R := R xor P[i] xor
(((S1[L shr 24] + S2[Byte(L shr 16)]) xor
S3[Byte(L shr 8)]) + S4[Byte(L)]);
inc(i);
L := L xor P[i] xor
(((S1[R shr 24] + S2[Byte(R shr 16)]) xor
S3[Byte(R shr 8)]) + S4[Byte(R)]);
inc(i);
end;
R := R xor P[BF_NO_ROUNDS + 1];
end;
{ put data back }
TByteArray(outBlock)[0] := R shr 24;
TByteArray(outBlock)[1] := Byte(R shr 16);
TByteArray(outBlock)[2] := Byte(R shr 8);
TByteArray(outBlock)[3] := Byte(R);
TByteArray(outBlock)[4] := L shr 24;
TByteArray(outBlock)[5] := Byte(L shr 16);
TByteArray(outBlock)[6] := Byte(L shr 8);
TByteArray(outBlock)[7] := Byte(L);
end;
procedure bfDecrypt(const key: TBlowFishKey;const inBlock;var outBlock);
var
L, R, i: LongWord;
begin
{ get data }
R := (LongWord(TByteArray(inBlock)[0]) shl 24) or
(LongWord(TByteArray(inBlock)[1]) shl 16) or
(LongWord(TByteArray(inBlock)[2]) shl 8) or
LongWord(TByteArray(inBlock)[3]);
L := (LongWord(TByteArray(inBlock)[4]) shl 24) or
(LongWord(TByteArray(inBlock)[5]) shl 16) or
(LongWord(TByteArray(inBlock)[6]) shl 8) or
LongWord(TByteArray(inBlock)[7]);
{ Perform 16 rounds of decryption }
with key do
begin
i := BF_NO_ROUNDS;
R := R xor P[BF_NO_ROUNDS + 1];
while i >= 1 do
begin
L := L xor P[i] xor
(((S1[R shr 24] + S2[Byte(R shr 16)]) xor
S3[Byte(R shr 8)]) + S4[Byte(R)]);
dec(i);
R := R xor P[i] xor
(((S1[L shr 24] + S2[Byte(L shr 16)]) xor
S3[Byte(L shr 8)]) + S4[Byte(L)]);
dec(i);
end;
L := L xor P[0];
end;
{ put data back }
TByteArray(outBlock)[0] := L shr 24;
TByteArray(outBlock)[1] := Byte(L shr 16);
TByteArray(outBlock)[2] := Byte(L shr 8);
TByteArray(outBlock)[3] := Byte(L);
TByteArray(outBlock)[4] := R shr 24;
TByteArray(outBlock)[5] := Byte(R shr 16);
TByteArray(outBlock)[6] := Byte(R shr 8);
TByteArray(outBlock)[7] := Byte(R);
end;
{These only for key setup, no endian conversion needed}
procedure bfInitEncrypt(const key: TBlowFishKey;var data1, data2: LongWord);
var
L, R, i: LongWord;
begin
L := data1;
R := data2;
with key do
begin
i := 1;
L := L xor P[0];
while i <= BF_NO_ROUNDS do
begin
R := R xor P[i] xor
(((S1[L shr 24] + S2[Byte(L shr 16)]) xor
S3[Byte(L shr 8)]) + S4[Byte(L)]);
inc(i);
L := L xor P[i] xor
(((S1[R shr 24] + S2[Byte(R shr 16)]) xor
S3[Byte(R shr 8)]) + S4[Byte(R)]);
inc(i);
end;
R := R xor P[BF_NO_ROUNDS + 1];
end;
data1 := R;
data2 := L;
end;
procedure bfKeySetup(var key: TBlowFishKey;const pUserKey; userKeyLen: Integer);
var
userKey: PByte;
keyIndex, i, j, byteIndex: Integer;
data1, data2: LongWord;
sBox: PLA;
begin
userKey := @pUserKey;
for i := 0 to (BF_NO_ROUNDS + 2) - 1 do
key.P[i] := initialParray[i];
for i := 0 to BF_SBOX_SIZE-1 do
begin
key.S1[i] := initialSbox1[i];
key.S2[i] := initialSbox2[i];
key.S3[i] := initialSbox3[i];
key.S4[i] := initialSbox4[i];
end;
keyIndex := 0;
for i := 0 to (BF_NO_ROUNDS + 2) - 1 do
begin
data1 := 0;
for byteIndex := 0 to 3 do
begin
data1 := data1 shl 8;
data1 := data1 or LongWord(PByteArray(userKey)[keyIndex]);
inc(keyIndex);
keyIndex := keyIndex mod userKeyLen;
end;
key.P[i] := key.P[i] xor data1;
end;
data1 := 0;
data2 := 0;
i := 0 ;
while i < (BF_NO_ROUNDS + 2) do
begin
bfInitEncrypt(key, data1, data2);
key.P[i] := data1;
key.P[i+1] := data2;
inc(i,2);
end;
sBox := nil;
for j := 0 to 3 do
begin
case j of
0: sBox := @key.S1;
1: sBox := @key.S2;
2: sBox := @key.S3;
3: sBox := @key.S4;
end;
i := 0;
while i < BF_SBOX_SIZE do
begin
bfInitEncrypt(key, data1, data2);
sBox[i] := data1;
sBox[i+1] := data2;
Inc(i, 2);
end;
end;
end;
(***************************************************************
* Blowfish Mode of Operation *
***************************************************************)
procedure bfResetContext(var cryptCtx: TCryptCtx);
begin
Move(cryptCtx.IV, cryptCtx.currentIV, IVSIZE);
end;
{ Encrypt data in CBC (Cipher Block Chaining) Mode}
procedure bfEncryptCBC(var cryptCtx: TCryptCtx; var pBuffer; bufLen: Integer);
var
buffer, currentIV: PByte;
begin
assert( ( bufLen mod BF_BLOCKSIZE ) = 0,
'Data length is must be multiple of the block size');
buffer := @pBuffer;
currentIV := @cryptCtx.currentIV;
while bufLen >= BF_BLOCKSIZE do
begin
PLA(buffer)^[0] := PLA(buffer)^[0] xor PLA(currentIV)^[0];
PLA(buffer)^[1] := PLA(buffer)^[1] xor PLA(currentIV)^[1];
bfEncrypt(cryptCtx.key, buffer^, buffer^);
currentIV := buffer;
Inc(buffer, BF_BLOCKSIZE);
Dec(bufLen, BF_BLOCKSIZE);
end;
{Move(currentIV^, cryptCtx.currentIV, BF_BLOCKSIZE);}
PLA(@cryptCtx.currentIV)^[0] := PLA(currentIV)^[0];
PLA(@cryptCtx.currentIV)^[1] := PLA(currentIV)^[1];
end;
{ Decrypt data in CBC mode }
procedure bfDecryptCBC(var cryptCtx: TCryptCtx; var pBuffer; bufLen: Integer);
var
buffer: PByte;
temp: TbfBlock;
begin
assert( ( bufLen mod BF_BLOCKSIZE ) = 0,
'Data length is must be multiple of the block size');
buffer := @pBuffer;
while bufLen >= BF_BLOCKSIZE do
begin
{Move(buffer^, temp, BF_BLOCKSIZE);}
PLA(@temp)^[0] := PLA(buffer)^[0];
PLA(@temp)^[1] := PLA(buffer)^[1];
bfDecrypt(cryptCtx.key, buffer^, buffer^);
PLA(buffer)^[0] := PLA(buffer)^[0] xor PLA(@cryptCtx.currentIV)^[0];
PLA(buffer)^[1] := PLA(buffer)^[1] xor PLA(@cryptCtx.currentIV)^[1];
{Move(temp, cryptCtx.currentIV, BF_BLOCKSIZE);}
PLA(@cryptCtx.currentIV)^[0] := PLA(@temp)^[0];
PLA(@cryptCtx.currentIV)^[1] := PLA(@temp)^[1];
Inc(buffer, BF_BLOCKSIZE);
Dec(bufLen, BF_BLOCKSIZE);
end;
end;
(***************************************************************
* Blowfish Self Test *
***************************************************************)
type
TBlock64 = array [0..7] of byte;
TBfTest = record
key: TBlock64;
pt: TBlock64;
ct: TBlock64;
end;
const
plain1: PChar = 'BLOWFISH';
key1: PChar = 'abcdefghijklmnopqrstuvwxyz';
cipher1: TBFBlock = ($32,$4E,$D0,$FE,$F4,$13,$A2,$03);
plain2: TBFBlock = ($FE,$DC,$BA,$98,$76,$54,$32,$10);
key2: PChar = 'Who is John Galt?';
cipher2: TBFBlock = ($CC,$91,$73,$2B,$80,$22,$F6,$84);
plain3: TBFBlock = ($FE, $DC, $BA, $98, $76, $54, $32, $10);
key3: TBFBlock = ($41, $79, $6E, $A0, $52, $61, $6E, $E4);
cipher3: TBFBlock = ($E1, $13, $F4, $10, $2C, $FC, $CE, $43);
bfTest : array[0..33] of TBfTest = (
(key : ($00, $00, $00, $00, $00, $00, $00, $00);
pt : ($00, $00, $00, $00, $00, $00, $00, $00);
ct : ($4E, $F9, $97, $45, $61, $98, $DD, $78)),
(key : ($FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF);
pt : ($FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF);
ct : ($51, $86, $6F, $D5, $B8, $5E, $CB, $8A)),
(key : ($30, $00, $00, $00, $00, $00, $00, $00);
pt : ($10, $00, $00, $00, $00, $00, $00, $01);
ct : ($7D, $85, $6F, $9A, $61, $30, $63, $F2)),
(key : ($11, $11, $11, $11, $11, $11, $11, $11);
pt : ($11, $11, $11, $11, $11, $11, $11, $11);
ct : ($24, $66, $DD, $87, $8B, $96, $3C, $9D)),
(key : ($01, $23, $45, $67, $89, $AB, $CD, $EF);
pt : ($11, $11, $11, $11, $11, $11, $11, $11);
ct : ($61, $F9, $C3, $80, $22, $81, $B0, $96)),
(key : ($11, $11, $11, $11, $11, $11, $11, $11);
pt : ($01, $23, $45, $67, $89, $AB, $CD, $EF);
ct : ($7D, $0C, $C6, $30, $AF, $DA, $1E, $C7)),
(key : ($00, $00, $00, $00, $00, $00, $00, $00);
pt : ($00, $00, $00, $00, $00, $00, $00, $00);
ct : ($4E, $F9, $97, $45, $61, $98, $DD, $78)),
(key : ($FE, $DC, $BA, $98, $76, $54, $32, $10);
pt : ($01, $23, $45, $67, $89, $AB, $CD, $EF);
ct : ($0A, $CE, $AB, $0F, $C6, $A0, $A2, $8D)),
(key : ($7C, $A1, $10, $45, $4A, $1A, $6E, $57);
pt : ($01, $A1, $D6, $D0, $39, $77, $67, $42);
ct : ($59, $C6, $82, $45, $EB, $05, $28, $2B)),
(key : ($01, $31, $D9, $61, $9D, $C1, $37, $6E);
pt : ($5C, $D5, $4C, $A8, $3D, $EF, $57, $DA);
ct : ($B1, $B8, $CC, $0B, $25, $0F, $09, $A0)),
(key : ($07, $A1, $13, $3E, $4A, $0B, $26, $86);
pt : ($02, $48, $D4, $38, $06, $F6, $71, $72);
ct : ($17, $30, $E5, $77, $8B, $EA, $1D, $A4)),
(key : ($38, $49, $67, $4C, $26, $02, $31, $9E);
pt : ($51, $45, $4B, $58, $2D, $DF, $44, $0A);
ct : ($A2, $5E, $78, $56, $CF, $26, $51, $EB)),
(key : ($04, $B9, $15, $BA, $43, $FE, $B5, $B6);
pt : ($42, $FD, $44, $30, $59, $57, $7F, $A2);
ct : ($35, $38, $82, $B1, $09, $CE, $8F, $1A)),
(key : ($01, $13, $B9, $70, $FD, $34, $F2, $CE);
pt : ($05, $9B, $5E, $08, $51, $CF, $14, $3A);
ct : ($48, $F4, $D0, $88, $4C, $37, $99, $18)),
(key : ($01, $70, $F1, $75, $46, $8F, $B5, $E6);
pt : ($07, $56, $D8, $E0, $77, $47, $61, $D2);
ct : ($43, $21, $93, $B7, $89, $51, $FC, $98)),
(key : ($43, $29, $7F, $AD, $38, $E3, $73, $FE);
pt : ($76, $25, $14, $B8, $29, $BF, $48, $6A);
ct : ($13, $F0, $41, $54, $D6, $9D, $1A, $E5)),
(key : ($07, $A7, $13, $70, $45, $DA, $2A, $16);
pt : ($3B, $DD, $11, $90, $49, $37, $28, $02);
ct : ($2E, $ED, $DA, $93, $FF, $D3, $9C, $79)),
(key : ($04, $68, $91, $04, $C2, $FD, $3B, $2F);
pt : ($26, $95, $5F, $68, $35, $AF, $60, $9A);
ct : ($D8, $87, $E0, $39, $3C, $2D, $A6, $E3)),
(key : ($37, $D0, $6B, $B5, $16, $CB, $75, $46);
pt : ($16, $4D, $5E, $40, $4F, $27, $52, $32);
ct : ($5F, $99, $D0, $4F, $5B, $16, $39, $69)),
(key : ($1F, $08, $26, $0D, $1A, $C2, $46, $5E);
pt : ($6B, $05, $6E, $18, $75, $9F, $5C, $CA);
ct : ($4A, $05, $7A, $3B, $24, $D3, $97, $7B)),
(key : ($58, $40, $23, $64, $1A, $BA, $61, $76);
pt : ($00, $4B, $D6, $EF, $09, $17, $60, $62);
ct : ($45, $20, $31, $C1, $E4, $FA, $DA, $8E)),
(key : ($02, $58, $16, $16, $46, $29, $B0, $07);
pt : ($48, $0D, $39, $00, $6E, $E7, $62, $F2);
ct : ($75, $55, $AE, $39, $F5, $9B, $87, $BD)),
(key : ($49, $79, $3E, $BC, $79, $B3, $25, $8F);
pt : ($43, $75, $40, $C8, $69, $8F, $3C, $FA);
ct : ($53, $C5, $5F, $9C, $B4, $9F, $C0, $19)),
(key : ($4F, $B0, $5E, $15, $15, $AB, $73, $A7);
pt : ($07, $2D, $43, $A0, $77, $07, $52, $92);
ct : ($7A, $8E, $7B, $FA, $93, $7E, $89, $A3)),
(key : ($49, $E9, $5D, $6D, $4C, $A2, $29, $BF);
pt : ($02, $FE, $55, $77, $81, $17, $F1, $2A);
ct : ($CF, $9C, $5D, $7A, $49, $86, $AD, $B5)),
(key : ($01, $83, $10, $DC, $40, $9B, $26, $D6);
pt : ($1D, $9D, $5C, $50, $18, $F7, $28, $C2);
ct : ($D1, $AB, $B2, $90, $65, $8B, $C7, $78)),
(key : ($1C, $58, $7F, $1C, $13, $92, $4F, $EF);
pt : ($30, $55, $32, $28, $6D, $6F, $29, $5A);
ct : ($55, $CB, $37, $74, $D1, $3E, $F2, $01)),
(key : ($01, $01, $01, $01, $01, $01, $01, $01);
pt : ($01, $23, $45, $67, $89, $AB, $CD, $EF);
ct : ($FA, $34, $EC, $48, $47, $B2, $68, $B2)),
(key : ($1F, $1F, $1F, $1F, $0E, $0E, $0E, $0E);
pt : ($01, $23, $45, $67, $89, $AB, $CD, $EF);
ct : ($A7, $90, $79, $51, $08, $EA, $3C, $AE)),
(key : ($E0, $FE, $E0, $FE, $F1, $FE, $F1, $FE);
pt : ($01, $23, $45, $67, $89, $AB, $CD, $EF);
ct : ($C3, $9E, $07, $2D, $9F, $AC, $63, $1D)),
(key : ($00, $00, $00, $00, $00, $00, $00, $00);
pt : ($FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF);
ct : ($01, $49, $33, $E0, $CD, $AF, $F6, $E4)),
(key : ($FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF);
pt : ($00, $00, $00, $00, $00, $00, $00, $00);
ct : ($F2, $1E, $9A, $77, $B7, $1C, $49, $BC)),
(key : ($01, $23, $45, $67, $89, $AB, $CD, $EF);
pt : ($00, $00, $00, $00, $00, $00, $00, $00);
ct : ($24, $59, $46, $88, $57, $54, $36, $9A)),
(key : ($FE, $DC, $BA, $98, $76, $54, $32, $10);
pt : ($FF, $FF, $FF, $FF, $FF, $FF, $FF, $FF);
ct : ($6B, $5C, $5A, $9C, $5D, $9E, $0A, $5A))
);
function bfSelfTest: Integer;
var
bfKey: TBlowFishKey;
buffer: TBlock64;
i: Integer;
begin
{ Test #1 }
Move(plain1^, buffer, 8 );
bfKeySetup(bfKey, key1^, StrLen(key1));
bfEncrypt(bfKey, buffer, buffer);
if not (CompareMem(@buffer[0], @cipher1[0], 8 )) then
begin
Result := -11;
exit;
end;
bfDecrypt(bfKey, buffer, buffer);
if not (CompareMem(@buffer[0], @plain1^, 8 )) then
begin
Result := -21;
exit;
end;
{ Test #2 }
Move(plain2, buffer, 8 );
bfKeySetup(bfKey, key2^, StrLen(key2));
bfEncrypt(bfKey, buffer, buffer);
if not (CompareMem(@buffer[0], @cipher2[0], 8 )) then
begin
Result := -12;
exit;
end;
bfDecrypt(bfKey, buffer, buffer);
if not (CompareMem(@buffer[0], @plain2, 8 )) then
begin
Result := -22;
exit;
end;
{ Test #3 }
Move(plain3, buffer, 8);
bfKeySetup(bfKey, key3, SizeOf(key3));
bfEncrypt(bfKey, buffer, buffer);
if not (CompareMem(@buffer[0], @cipher3[0], 8 )) then
begin
Result := -13;
exit;
end;
bfDecrypt(bfKey, buffer, buffer);
if not (CompareMem(@buffer[0], @plain3, 8 )) then
begin
Result := -23;
exit;
end;
{ Test #4 }
for i := 0 to (SizeOf(bfTest) div SizeOf(TBfTest))-1 do
begin
bfKeySetup(bfKey, bfTest[i].key, SizeOf(bfTest[i].key));
Move(bfTest[i].pt, buffer, SizeOf(TBlock64));
bfEncrypt(bfKey, buffer, buffer);
if not CompareMem(@buffer, @bfTest[i].ct, SizeOf(TBlock64)) then
begin
Result := -100 - i ;
Exit;
end;
bfDecrypt(bfKey, buffer, buffer);
if not CompareMem(@buffer, @bfTest[i].pt, SizeOf(TBlock64)) then
begin
Result := -200 - i ;
Exit;
end;
end;
Result := 0;
end;
function bfModeSelfTest: Integer;
var
data: PByte;
retval: Integer;
CryptCtx: TCryptCtx;
begin
retval := 0;
GetMem(data, SizeOf(bfTest));
try
Move(bfTest, data^, SizeOf(bfTest));
{Init.}
FillChar(CryptCtx, SizeOf(TCryptCtx), 0);
bfKeySetup(CryptCtx.key, key1^, StrLen(key1));
{Encrypt}
bfResetContext(cryptCtx);
bfEncryptCBC(cryptCtx, data^, SizeOf(bfTest));
{Decrypt}
bfResetContext(cryptCtx);
bfDecryptCBC(cryptCtx, data^, SizeOf(bfTest));
if not CompareMem(data, @bfTest, SizeOf(bfTest)) then
retval := -300
finally
FreeMem(data, SizeOf(bfTest));
end;
Result := retval;
end;
end.Saludos