mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 04:59:26 +02:00
Initial implementation of encryption stream
This commit is contained in:
michael
parent
5d101ee4f5
commit
e1df03febf
@ -5,4 +5,4 @@ INCNAMES=classes.inc classesh.inc bits.inc collect.inc compon.inc filer.inc\
|
||||
lists.inc parser.inc persist.inc reader.inc streams.inc stringl.inc\
|
||||
writer.inc
|
||||
|
||||
INCUNITS=inifiles ezcgi pipes
|
||||
INCUNITS=inifiles ezcgi pipes rtfpars idea
|
||||
|
||||
410
fcl/inc/idea.pp
Normal file
410
fcl/inc/idea.pp
Normal file
@ -0,0 +1,410 @@
|
||||
UNIT IDEA;
|
||||
|
||||
{
|
||||
IDEA encryption routines for pascal
|
||||
ported from PGP 2.3
|
||||
|
||||
IDEA encryption routines for pascal, ported from PGP 2.3
|
||||
Copyright (C) for this port 1998 Ingo Korb
|
||||
Copyright (C) for the stream support 1999 Michael Van Canneyt
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Library General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2 of the License, or (at your option) any later version.
|
||||
|
||||
This library is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
Library General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public
|
||||
License along with this library; if not, write to the Free
|
||||
Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
}
|
||||
|
||||
|
||||
{$R-,Q-}
|
||||
{ Not nice but fast... }
|
||||
|
||||
INTERFACE
|
||||
|
||||
Uses Sysutils,Classes;
|
||||
|
||||
CONST IDEAKEYSIZE = 16;
|
||||
IDEABLOCKSIZE = 8;
|
||||
ROUNDS = 8;
|
||||
KEYLEN = (6*ROUNDS+4);
|
||||
|
||||
TYPE IDEAkey = ARRAY[0..keylen-1] OF Word;
|
||||
ideacryptkey = ARRAY[0..7] OF Word;
|
||||
ideacryptdata = ARRAY[0..3] OF Word;
|
||||
|
||||
PROCEDURE EnKeyIdea(userkey: ideacryptkey; VAR z: ideakey);
|
||||
PROCEDURE DeKeyIdea(z: IDEAKey; VAR dk: ideakey);
|
||||
PROCEDURE CipherIdea(input: ideacryptdata; VAR out: ideacryptdata; z: IDEAkey);
|
||||
|
||||
Type
|
||||
|
||||
EIDEAError = Class(Exception);
|
||||
|
||||
TIDEAEncryptStream = Class(TStream)
|
||||
private
|
||||
FDest : TStream;
|
||||
FKey : IDEAKey;
|
||||
FData : IDEACryptData;
|
||||
FBufpos : Byte;
|
||||
FPos : Longint;
|
||||
public
|
||||
constructor Create(AKey : ideakey; Dest: TStream);
|
||||
destructor Destroy; override;
|
||||
function Read(var Buffer; Count: Longint): Longint; override;
|
||||
function Write(const Buffer; Count: Longint): Longint; override;
|
||||
function Seek(Offset: Longint; Origin: Word): Longint; override;
|
||||
procedure Flush;
|
||||
Property Key : IDEAKey Read FKey;
|
||||
end;
|
||||
|
||||
TIDEADeCryptStream = Class(TStream)
|
||||
private
|
||||
FSRC : TStream;
|
||||
FKey : IDEAKey;
|
||||
FData : IDEACryptData;
|
||||
FBufpos : Byte;
|
||||
FPos : Longint;
|
||||
public
|
||||
constructor Create(AKey : ideakey; Src: TStream);
|
||||
destructor Destroy; override;
|
||||
function Read(var Buffer; Count: Longint): Longint; override;
|
||||
function Write(const Buffer; Count: Longint): Longint; override;
|
||||
function Seek(Offset: Longint; Origin: Word): Longint; override;
|
||||
Property Key : IDEAKey Read FKey;
|
||||
end;
|
||||
|
||||
IMPLEMENTATION
|
||||
|
||||
Const
|
||||
SNoSeekAllowed = 'Seek not allowed on encryption streams';
|
||||
SNoReadAllowed = 'Reading from encryption stream not allowed';
|
||||
SNoWriteAllowed = 'Writing to decryption stream not allowed';
|
||||
|
||||
Type
|
||||
PByte = ^Byte;
|
||||
|
||||
PROCEDURE mul(VAR a:Word; b: Word);
|
||||
VAR p: LongInt;
|
||||
BEGIN
|
||||
IF (a <> 0) THEN BEGIN
|
||||
IF (b <> 0) THEN BEGIN
|
||||
p := LongInt(a)*b;
|
||||
b := p;
|
||||
a := p SHR 16;
|
||||
IF (b < a) THEN a := b - a + 1
|
||||
ELSE a := b - a;
|
||||
END ELSE a := 1 - a;
|
||||
END ELSE a := 1-b;
|
||||
END;
|
||||
|
||||
FUNCTION inv(x: word): Word;
|
||||
VAR t0,t1,q,y: Word;
|
||||
BEGIN
|
||||
IF x <= 1 THEN BEGIN
|
||||
inv := x;
|
||||
exit;
|
||||
END;
|
||||
t1 := 65537 DIV x;
|
||||
y := 65537 MOD x;
|
||||
IF y = 1 THEN BEGIN
|
||||
inv := Word(1-t1);
|
||||
exit;
|
||||
END;
|
||||
t0 := 1;
|
||||
REPEAT
|
||||
q := x DIV y;
|
||||
x := x MOD y;
|
||||
t0 := t0 + q * t1;
|
||||
IF x = 1 THEN BEGIN
|
||||
inv := t0;
|
||||
exit;
|
||||
END;
|
||||
q := y DIV x;
|
||||
y := y MOD x;
|
||||
t1 := t1 + q*t0;
|
||||
UNTIL y = 1;
|
||||
inv := word(1-t1);
|
||||
END;
|
||||
|
||||
PROCEDURE EnKeyIdea(userkey: ideacryptkey; VAR z: ideakey);
|
||||
VAR zi,i,j: integer;
|
||||
BEGIN
|
||||
FOR j := 0 TO 7 DO z[j] := userkey[j];
|
||||
i := 0;
|
||||
zi := 0;
|
||||
i := 0;
|
||||
FOR j := 8 TO keylen-1 DO BEGIN
|
||||
Inc(i);
|
||||
z[zi+i+7] := (z[zi+(i AND 7)] SHL 9) OR (z[zi+((i+1) AND 7)] SHR 7);
|
||||
zi := zi + (i AND 8);
|
||||
i := i AND 7;
|
||||
END;
|
||||
FOR i := 0 TO 7 DO userkey[i] := 0;
|
||||
zi := 0;
|
||||
END;
|
||||
|
||||
PROCEDURE DeKeyIdea(z: IDEAKey; VAR dk: ideakey);
|
||||
VAR j: Integer;
|
||||
t1,t2,t3: Word;
|
||||
p: IDEAKey;
|
||||
ip,it,idk: Integer;
|
||||
iz: Integer;
|
||||
BEGIN
|
||||
iz := 0;
|
||||
ip := keylen;
|
||||
FOR j := 0 TO keylen - 1 DO p[j] := 0;
|
||||
idk := 0;
|
||||
t1 := inv(z[iz]); Inc(iz);
|
||||
t2 := not(z[iz])+1; Inc(iz);
|
||||
t3 := not(z[iz])+1; Inc(iz);
|
||||
Dec(ip); p[ip] := inv(z[iz]); Inc(iz);
|
||||
Dec(ip); p[ip] := t3;
|
||||
Dec(ip); p[ip] := t2;
|
||||
Dec(ip); p[ip] := t1;
|
||||
FOR j := 1 TO rounds-1 DO BEGIN
|
||||
t1 := z[iz]; Inc(iz);
|
||||
Dec(ip); p[ip] := z[iz]; Inc(iz);
|
||||
Dec(ip); p[ip] := t1;
|
||||
t1 := inv(z[iz]); Inc(iz);
|
||||
t2 := Not(z[iz])+1; Inc(iz);
|
||||
t3 := Not(z[iz])+1; Inc(iz);
|
||||
Dec(ip); p[ip] := inv(z[iz]); Inc(iz);
|
||||
Dec(ip); p[ip] := t2;
|
||||
Dec(ip); p[ip] := t3;
|
||||
Dec(ip); p[ip] := t1;
|
||||
END;
|
||||
t1 := z[iz]; Inc(iz);
|
||||
Dec(ip); p[ip] := z[iz]; Inc(iz);
|
||||
Dec(ip); p[ip] := t1;
|
||||
t1 := inv(z[iz]); Inc(iz);
|
||||
t2 := Not(z[iz])+1; Inc(iz);
|
||||
t3 := Not(z[iz])+1; Inc(iz);
|
||||
Dec(ip); p[ip] := inv(z[iz]); Inc(iz);
|
||||
Dec(ip); p[ip] := t3;
|
||||
Dec(ip); p[ip] := t2;
|
||||
Dec(ip); p[ip] := t1;
|
||||
FOR j := 0 TO KeyLen-1 DO BEGIN
|
||||
dk[j] := p[j];
|
||||
p[j] := 0;
|
||||
END;
|
||||
FOR j := 0 TO 51 DO z[j] := 0;
|
||||
t1 := 0;
|
||||
t2 := 0;
|
||||
t3 := 0;
|
||||
ip := 0;
|
||||
it := 0;
|
||||
idk := 0;
|
||||
iz := 0;
|
||||
END;
|
||||
|
||||
PROCEDURE CipherIdea(input: ideacryptdata; VAR out: ideacryptdata; z:
|
||||
IDEAkey);
|
||||
VAR x1, x2, x3, x4, t1, t2: Word;
|
||||
r: Integer;
|
||||
zi: Integer;
|
||||
BEGIN
|
||||
zi := 0;
|
||||
x1 := input[0];
|
||||
x2 := input[1];
|
||||
x3 := input[2];
|
||||
x4 := input[3];
|
||||
FOR r := 1 TO ROUNDS DO BEGIN
|
||||
mul(x1,z[zi]); Inc(zi);
|
||||
x2 := x2 + z[zi]; Inc(zi);
|
||||
x3 := x3 + z[zi]; Inc(zi);
|
||||
mul(x4, z[zi]); Inc(zi);
|
||||
t2 := x1 XOR x3;
|
||||
mul(t2, z[zi]); Inc(zi);
|
||||
t1 := t2 + (x2 XOR x4);
|
||||
mul(t1, z[zi]); Inc(zi);
|
||||
t2 := t1+t2;
|
||||
x1 := x1 XOR t1;
|
||||
x4 := x4 XOR t2;
|
||||
t2 := t2 XOR x2;
|
||||
x2 := x3 XOR t1;
|
||||
x3 := t2;
|
||||
END;
|
||||
mul(x1, z[zi]); Inc(zi);
|
||||
out[0] := x1;
|
||||
out[1] := x3 + z[zi]; Inc(zi);
|
||||
out[2] := x2 + z[zi]; Inc(zi);
|
||||
Mul(x4,z[zi]);
|
||||
out[3] := x4;
|
||||
FOR r := 0 TO 3 DO input[r] := 0;
|
||||
FOR r := 0 TO 51 DO z[r] := 0;
|
||||
x1 := 0;
|
||||
x2 := 0;
|
||||
x3 := 0;
|
||||
x4 := 0;
|
||||
t1 := 0;
|
||||
t2 := 0;
|
||||
zi := 0;
|
||||
END;
|
||||
|
||||
constructor TIDEAEncryptStream.Create(AKey : ideakey; Dest: TStream);
|
||||
|
||||
begin
|
||||
FKey:=Key;
|
||||
FDest:=Dest;
|
||||
FBufPos:=0;
|
||||
Fpos:=0;
|
||||
end;
|
||||
|
||||
Destructor TIDEAEncryptStream.Destroy;
|
||||
|
||||
|
||||
begin
|
||||
Flush;
|
||||
Inherited Destroy;
|
||||
end;
|
||||
|
||||
Procedure TIDEAEncryptStream.Flush;
|
||||
|
||||
Var
|
||||
OutData : IdeaCryptData;
|
||||
|
||||
begin
|
||||
If FBufPos>0 then
|
||||
begin
|
||||
// Fill with spaces.
|
||||
FillChar(PByte(@FData)[FBufPos],SizeOf(FData)-FBufPos,' ');
|
||||
CipherIdea(Fdata,OutData,FKey);
|
||||
FDest.Write(OutData,SizeOf(OutData));
|
||||
end;
|
||||
end;
|
||||
|
||||
function TIDEAEncryptStream.Read(var Buffer; Count: Longint): Longint;
|
||||
|
||||
begin
|
||||
Raise EIDEAError.Create(SNoReadAllowed);
|
||||
end;
|
||||
|
||||
function TIDEAEncryptStream.Write(const Buffer; Count: Longint): Longint;
|
||||
|
||||
Var
|
||||
mvsize : Longint;
|
||||
OutData : IDEAcryptdata;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
While Count>0 do
|
||||
begin
|
||||
MVsize:=Count;
|
||||
If Mvsize>SizeOf(Fdata)-FBufPos then
|
||||
mvsize:=SizeOf(FData)-FBufPos;
|
||||
Move(Pbyte(@Buffer)[Result],PByte(@FData)[FBufPos],MVSize);
|
||||
If FBufPos+mvSize=Sizeof(FData) then
|
||||
begin
|
||||
// Empty buffer.
|
||||
CipherIdea(Fdata,OutData,FKey);
|
||||
// this will raise an exception if needed.
|
||||
FDest.Writebuffer(OutData,SizeOf(OutData));
|
||||
FBufPos:=0;
|
||||
end
|
||||
else
|
||||
inc(FBufPos,mvsize);
|
||||
Dec(Count,MvSize);
|
||||
Inc(Result,mvSize);
|
||||
end;
|
||||
Inc(FPos,Result);
|
||||
end;
|
||||
|
||||
|
||||
function TIDEAEncryptStream.Seek(Offset: Longint; Origin: Word): Longint;
|
||||
|
||||
begin
|
||||
if (Offset = 0) and (Origin = soFromCurrent) then
|
||||
Result := FPos
|
||||
else
|
||||
Raise EIDEAError.Create(SNoSeekAllowed);
|
||||
end;
|
||||
|
||||
constructor TIDEADeCryptStream.Create(AKey : ideakey; Src: TStream);
|
||||
|
||||
begin
|
||||
inherited Create;
|
||||
FKey:=Key;
|
||||
FPos:=0;
|
||||
FBufPos:=SizeOf(Fdata);
|
||||
FSrc:=Src;
|
||||
end;
|
||||
|
||||
destructor TIDEADeCryptStream.Destroy;
|
||||
begin
|
||||
Inherited destroy;
|
||||
end;
|
||||
|
||||
function TIDEADeCryptStream.Read(var Buffer; Count: Longint): Longint;
|
||||
|
||||
Var
|
||||
mvsize : Longint;
|
||||
InData : IDEAcryptdata;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
While Count>0 do
|
||||
begin
|
||||
// Empty existing buffer.
|
||||
If FBufPos<SizeOf(FData) then
|
||||
begin
|
||||
mvSize:=Sizeof(FData)-FBufPos;
|
||||
If MvSize>count then
|
||||
mvsize:=Count;
|
||||
Move(PByte(@FData)[FBufPos],Pbyte(@Buffer)[Result],MVSize);
|
||||
Dec(Count,mvsize);
|
||||
Inc(Result,mvsize);
|
||||
inc(fBufPos,mvsize);
|
||||
end;
|
||||
// Fill buffer again if needed.
|
||||
If (FBufPos=SizeOf(FData)) and (Count>0) then
|
||||
begin
|
||||
mvsize:=FSrc.Read(InData,SizeOf(InData));
|
||||
If mvsize>0 then
|
||||
begin
|
||||
If MvSize<SizeOf(InData) Then
|
||||
// Fill with spaces
|
||||
FillChar(PByte(@InData)[mvsize],SizeOf(InData)-mvsize,' ');
|
||||
CipherIdea(InData,FData,FKey);
|
||||
FBufPos:=0;
|
||||
end
|
||||
else
|
||||
Count:=0; // No more data available from stream; st
|
||||
end;
|
||||
end;
|
||||
Inc(FPos,Result);
|
||||
end;
|
||||
|
||||
function TIDEADeCryptStream.Write(const Buffer; Count: Longint): Longint;
|
||||
begin
|
||||
Raise EIDEAError.Create(SNoReadAllowed);
|
||||
end;
|
||||
|
||||
function TIDEADeCryptStream.Seek(Offset: Longint; Origin: Word): Longint;
|
||||
|
||||
Var Buffer : Array[0..1023] of byte;
|
||||
i : longint;
|
||||
|
||||
begin
|
||||
// Fake seek if possible by reading and discarding bytes.
|
||||
If ((Offset>=0) and (Origin = soFromCurrent)) or
|
||||
((Offset>FPos) and (Origin = soFromBeginning)) then
|
||||
begin
|
||||
For I:=1 to (Offset div SizeOf(Buffer)) do
|
||||
ReadBuffer(Buffer,SizeOf(Buffer));
|
||||
ReadBuffer(Buffer,Offset mod SizeOf(Buffer));
|
||||
Result:=FPos;
|
||||
end
|
||||
else
|
||||
Raise EIDEAError.Create(SNoSeekAllowed);
|
||||
end;
|
||||
|
||||
END.
|
||||
|
||||
@ -36,7 +36,7 @@ NEEDOPT=-S2
|
||||
|
||||
UNITOBJECTS=
|
||||
EXEOBJECTS=stringl dparser fstream mstream list threads testrtf\
|
||||
cfgtest testz testz2 xmldump htdump testcgi
|
||||
cfgtest testz testz2 xmldump htdump testcgi tidea
|
||||
|
||||
|
||||
#####################################################################
|
||||
@ -113,7 +113,10 @@ endif
|
||||
|
||||
#
|
||||
# $Log$
|
||||
# Revision 1.8 1999-07-15 12:05:55 michael
|
||||
# Revision 1.9 1999-07-25 14:30:39 michael
|
||||
# Initial implementation of encryption stream
|
||||
#
|
||||
# Revision 1.8 1999/07/15 12:05:55 michael
|
||||
# + Added testcgi program
|
||||
#
|
||||
# Revision 1.7 1999/07/11 22:43:23 michael
|
||||
|
||||
@ -26,4 +26,5 @@ testrtf.pp TRTFParser object from rtfpars (MVC)
|
||||
cfgtest.pp Example for using XML read/write as cfg file (SG)
|
||||
xmldump.pp xml dump program (SG)
|
||||
htdump.pp htdump dumps XL IDL definition as ObjectPascal classes (MVC)
|
||||
testcgi.pp test program or ezcgi class (MH)
|
||||
testcgi.pp test program for ezcgi class (MH)
|
||||
tidea.pp test program for IDEA encryption/decryption streams (MVC)
|
||||
|
||||
40
fcl/tests/tidea.pp
Normal file
40
fcl/tests/tidea.pp
Normal file
@ -0,0 +1,40 @@
|
||||
Program tidea;
|
||||
|
||||
Uses Classes,Idea;
|
||||
|
||||
Type
|
||||
PByte = ^Byte;
|
||||
|
||||
Var M : TMemorystream;
|
||||
ES : TIDeaEncryptStream;
|
||||
DS : TIdeaDecryptStream;
|
||||
StartKey : ideacryptkey;
|
||||
EnKey,DeKey : ideakey;
|
||||
I,J : longint;
|
||||
|
||||
begin
|
||||
M:=TMemoryStream.create;
|
||||
// generate some phoney key;
|
||||
For I:=0 to SizeOf(StartKey)-1 do
|
||||
PByte(@StartKey)[I]:=I;
|
||||
// Get encryption key
|
||||
EnKeyIdea(StartKey,enKey);
|
||||
ES:=TIDeaEncryptStream.Create(EnKey,M);
|
||||
For I:=1 to 65 do
|
||||
ES.Write(I,SizeOf(I));
|
||||
Writeln ('Position after Write : ',ES.Position);
|
||||
ES.Flush;
|
||||
Writeln ('Size of memory stream : ',M.Size);
|
||||
M.Seek(0,soFromBeginning);
|
||||
// Get decryption key
|
||||
DeKeyIdea(EnKey,DeKey);
|
||||
DS:=TIDeaDecryptStream.Create(DEKey,M);
|
||||
For I:=1 to 65 do
|
||||
begin
|
||||
DS.Read(J,SizeOf(J));
|
||||
If J<>I then
|
||||
Writeln ('Error; Read : ',J);
|
||||
end;
|
||||
Writeln ('Position after Reading : ',DS.Position);
|
||||
DS.destroy;
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user