paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 14:49:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

Initial implementation of encryption stream

Browse Source
This commit is contained in:
michael 1999-07-25 14:29:09 +00:00
parent 5d101ee4f5
commit e1df03febf
5 changed files with 458 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
fcl/inc/Makefile.inc
View File

@ -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\ lists.inc parser.inc persist.inc reader.inc streams.inc stringl.inc\
writer.inc writer.inc
INCUNITS=inifiles ezcgi pipes INCUNITS=inifiles ezcgi pipes rtfpars idea

410
fcl/inc/idea.pp Normal file
View 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.

7
fcl/tests/Makefile
View File

@ -36,7 +36,7 @@ NEEDOPT=-S2
UNITOBJECTS= UNITOBJECTS=
EXEOBJECTS=stringl dparser fstream mstream list threads testrtf\ 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$ # $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 # + Added testcgi program
# #
# Revision 1.7 1999/07/11 22:43:23 michael # Revision 1.7 1999/07/11 22:43:23 michael

3
fcl/tests/README
View File

@ -26,4 +26,5 @@ testrtf.pp TRTFParser object from rtfpars (MVC)
cfgtest.pp Example for using XML read/write as cfg file (SG) cfgtest.pp Example for using XML read/write as cfg file (SG)
xmldump.pp xml dump program (SG) xmldump.pp xml dump program (SG)
htdump.pp htdump dumps XL IDL definition as ObjectPascal classes (MVC) 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
View 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.