← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/packages/fcl-base/src/inc/idea.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/packages/fcl-base/src/inc/idea.pp
 
1
{
 
2
    This file is part of the Free Component Library (FCL)
 
3
    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
 
4
 
 
5
    See the file COPYING.FPC, included in this distribution,
 
6
    for details about the copyright.
 
7
 
 
8
    This program is distributed in the hope that it will be useful,
 
9
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
11
 
 
12
 **********************************************************************}
 
13
 
 
14
{$ifdef fpc}
 
15
{$mode objfpc}
 
16
{$endif}
 
17
 
 
18
Unit idea;
 
19
 
 
20
{
 
21
 IDEA encryption routines for pascal
 
22
 ported from PGP 2.3
 
23
 
 
24
 IDEA encryption routines for pascal, ported from PGP 2.3
 
25
 Copyright (C) for this port 1998 Ingo Korb
 
26
 Copyright (C) for the stream support 1999 Michael Van Canneyt
 
27
 
 
28
 This library is free software; you can redistribute it and/or
 
29
 modify it under the terms of the GNU Library General Public
 
30
 License as published by the Free Software Foundation; either
 
31
 version 2 of the License, or (at your option) any later version.
 
32
 
 
33
 This library is distributed in the hope that it will be useful,
 
34
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 
35
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 
36
 Library General Public License for more details.
 
37
 
 
38
 You should have received a copy of the GNU Library General Public
 
39
 License along with this library; if not, write to the Free
 
40
 Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
41
}
 
42
 
 
43
 
 
44
{$R-,Q-}
 
45
{ Not nice but fast... }
 
46
 
 
47
INTERFACE
 
48
 
 
49
Uses Sysutils,Classes;
 
50
 
 
51
CONST 
 
52
  IDEAKEYSIZE   = 16;
 
53
  IDEABLOCKSIZE = 8;
 
54
  ROUNDS        = 8;
 
55
  KEYLEN        = (6*ROUNDS+4);
 
56
 
 
57
TYPE 
 
58
  TIDEAKey       = ARRAY[0..keylen-1] OF Word;
 
59
  TIdeaCryptKey  = ARRAY[0..7] OF Word;
 
60
  TIdeaCryptData = ARRAY[0..3] OF Word;
 
61
  
 
62
  { For backward compatibility }
 
63
  IDEAkey = TIDEAkey;
 
64
  IdeaCryptKey = TIdeaCryptKey;
 
65
  IdeaCryptData = TIdeaCryptData;
 
66
  
 
67
PROCEDURE EnKeyIdea(UserKey: TIdeacryptkey; VAR z: TIDEAKey);
 
68
PROCEDURE DeKeyIdea(z: TIDEAKey; VAR dk: TIDEAKey);
 
69
PROCEDURE CipherIdea(Input: TIDEACryptData; VAR outdata: TIDEACryptData; z: TIDEAKey);
 
70
 
 
71
Type
 
72
  EIDEAError = Class(EStreamError);
 
73
 
 
74
  TIDEAStream = Class(TOwnerStream)
 
75
  Private
 
76
    FKey    : TIDEAKey;
 
77
    FData   : TIDEACryptData;
 
78
    FBufpos : Byte;
 
79
    FPos    : Longint;
 
80
  Public
 
81
    Constructor Create(AKey : TIDEAKey; Dest: TStream);
 
82
    Property Key : TIDEAKey Read FKey;
 
83
  end;
 
84
 
 
85
  TIDEAEncryptStream = Class(TIDEAStream)
 
86
  public
 
87
    Destructor Destroy; override;
 
88
    function Read(var Buffer; Count: Longint): Longint; override;
 
89
    function Write(const Buffer; Count: Longint): Longint; override;
 
90
    function Seek(Offset: Longint; Origin: Word): Longint; override;
 
91
    procedure Flush;
 
92
  end;
 
93
 
 
94
  TIDEADeCryptStream = Class(TIDEAStream)
 
95
  public
 
96
    function Read(var Buffer; Count: Longint): Longint; override;
 
97
    function Write(const Buffer; Count: Longint): Longint; override;
 
98
    function Seek(Offset: Longint; Origin: Word): Longint; override;
 
99
  end;
 
100
 
 
101
Implementation
 
102
 
 
103
Const
 
104
  SNoSeekAllowed  = 'Seek not allowed on encryption streams';
 
105
  SNoReadAllowed  = 'Reading from encryption stream not allowed';
 
106
  SNoWriteAllowed = 'Writing to decryption stream not allowed';
 
107
 
 
108
PROCEDURE mul(VAR a:Word; b: Word);
 
109
VAR p: LongInt;
 
110
BEGIN
 
111
  IF (a <> 0) THEN BEGIN
 
112
    IF (b <> 0) THEN BEGIN
 
113
      p := LongInt(a)*b;
 
114
      b := p;
 
115
      a := p SHR 16;
 
116
      IF (b < a) THEN a := b - a + 1
 
117
                 ELSE a := b - a;
 
118
    END ELSE a := 1 - a;
 
119
  END ELSE a := 1-b;
 
120
END;
 
121
 
 
122
FUNCTION inv(x: word): Word;
 
123
VAR t0,t1,q,y: Word;
 
124
BEGIN
 
125
  IF x <= 1 THEN BEGIN
 
126
    inv := x;
 
127
    exit;
 
128
  END;
 
129
  t1 := 65537 DIV x;
 
130
  y := 65537 MOD x;
 
131
  IF y = 1 THEN BEGIN
 
132
    inv := Word(1-t1);
 
133
    exit;
 
134
  END;
 
135
  t0 := 1;
 
136
  REPEAT
 
137
    q := x DIV y;
 
138
    x := x MOD y;
 
139
    t0 := t0 + q * t1;
 
140
    IF x = 1 THEN BEGIN
 
141
      inv := t0;
 
142
      exit;
 
143
    END;
 
144
    q := y DIV x;
 
145
    y := y MOD x;
 
146
    t1 := t1 + q*t0;
 
147
  UNTIL y = 1;
 
148
  inv := word(1-t1);
 
149
END;
 
150
 
 
151
PROCEDURE EnKeyIdea(userkey: ideacryptkey; VAR z: ideakey);
 
152
VAR zi,i,j: integer;
 
153
BEGIN
 
154
  FOR j := 0 TO 7 DO z[j] := userkey[j];
 
155
  zi := 0;
 
156
  i := 0;
 
157
  FOR j := 8 TO keylen-1 DO BEGIN
 
158
    Inc(i);
 
159
    z[zi+i+7] := (z[zi+(i AND 7)] SHL 9) OR (z[zi+((i+1) AND 7)] SHR 7);
 
160
    zi := zi + (i AND 8);
 
161
    i := i AND 7;
 
162
  END;
 
163
  FOR i := 0 TO 7 DO userkey[i] := 0;
 
164
END;
 
165
 
 
166
PROCEDURE DeKeyIdea(z: IDEAKey; VAR dk: ideakey);
 
167
VAR j: Integer;
 
168
    t1,t2,t3: Word;
 
169
    p: IDEAKey;
 
170
    ip: Integer;
 
171
    iz: Integer;
 
172
BEGIN
 
173
  iz := 0;
 
174
  ip := keylen;
 
175
  FOR j := 0 TO keylen - 1 DO p[j] := 0;
 
176
  t1 := inv(z[iz]);   Inc(iz);
 
177
  t2 := not(z[iz])+1; Inc(iz);
 
178
  t3 := not(z[iz])+1; Inc(iz);
 
179
  Dec(ip); p[ip] := inv(z[iz]); Inc(iz);
 
180
  Dec(ip); p[ip] := t3;
 
181
  Dec(ip); p[ip] := t2;
 
182
  Dec(ip); p[ip] := t1;
 
183
  FOR j := 1 TO rounds-1 DO BEGIN
 
184
    t1 := z[iz]; Inc(iz);
 
185
    Dec(ip); p[ip] := z[iz]; Inc(iz);
 
186
    Dec(ip); p[ip] := t1;
 
187
    t1 := inv(z[iz]);   Inc(iz);
 
188
    t2 := Not(z[iz])+1; Inc(iz);
 
189
    t3 := Not(z[iz])+1; Inc(iz);
 
190
    Dec(ip); p[ip] := inv(z[iz]); Inc(iz);
 
191
    Dec(ip); p[ip] := t2;
 
192
    Dec(ip); p[ip] := t3;
 
193
    Dec(ip); p[ip] := t1;
 
194
  END;
 
195
  t1 := z[iz]; Inc(iz);
 
196
  Dec(ip); p[ip] := z[iz]; Inc(iz);
 
197
  Dec(ip); p[ip] := t1;
 
198
  t1 := inv(z[iz]);   Inc(iz);
 
199
  t2 := Not(z[iz])+1; Inc(iz);
 
200
  t3 := Not(z[iz])+1; Inc(iz);
 
201
  Dec(ip); p[ip] := inv(z[iz]);
 
202
  Dec(ip); p[ip] := t3;
 
203
  Dec(ip); p[ip] := t2;
 
204
  Dec(ip); p[ip] := t1;
 
205
  FOR j := 0 TO KeyLen-1 DO BEGIN
 
206
    dk[j] := p[j];
 
207
    p[j] := 0;
 
208
  END;
 
209
  FOR j := 0 TO 51 DO z[j] := 0;
 
210
END;
 
211
 
 
212
PROCEDURE CipherIdea(input: ideacryptdata; VAR outdata: ideacryptdata; z:IDEAkey);
 
213
VAR x1, x2, x3, x4, t1, t2: Word;
 
214
    r: Integer;
 
215
    zi: Integer;
 
216
BEGIN
 
217
  zi := 0;
 
218
  x1 := input[0];
 
219
  x2 := input[1];
 
220
  x3 := input[2];
 
221
  x4 := input[3];
 
222
  FOR r := 1 TO ROUNDS DO BEGIN
 
223
    mul(x1,z[zi]);    Inc(zi);
 
224
    x2 := x2 + z[zi]; Inc(zi);
 
225
    x3 := x3 + z[zi]; Inc(zi);
 
226
    mul(x4, z[zi]);   Inc(zi);
 
227
    t2 := x1 XOR x3;
 
228
    mul(t2, z[zi]);   Inc(zi);
 
229
    t1 := t2 + (x2 XOR x4);
 
230
    mul(t1, z[zi]);   Inc(zi);
 
231
    t2 := t1+t2;
 
232
    x1 := x1 XOR t1;
 
233
    x4 := x4 XOR t2;
 
234
    t2 := t2 XOR x2;
 
235
    x2 := x3 XOR t1;
 
236
    x3 := t2;
 
237
  END;
 
238
  mul(x1, z[zi]);       Inc(zi);
 
239
  outdata[0] := x1;
 
240
  outdata[1] := x3 + z[zi]; Inc(zi);
 
241
  outdata[2] := x2 + z[zi]; Inc(zi);
 
242
  Mul(x4,z[zi]);
 
243
  outdata[3] := x4;
 
244
  FOR r := 0 TO 3 DO input[r] := 0;
 
245
  FOR r := 0 TO 51 DO z[r] := 0;
 
246
END;
 
247
 
 
248
{ ---------------------------------------------------------------------
 
249
    TIDEAStream
 
250
  ---------------------------------------------------------------------}
 
251
  
 
252
 
 
253
Constructor TIDEAStream.Create(AKey : ideakey; Dest: TStream);
 
254
 
 
255
begin
 
256
  inherited Create(Dest);
 
257
  FKey:=AKey;
 
258
  FBufPos:=0;
 
259
  Fpos:=0;
 
260
end;
 
261
 
 
262
{ ---------------------------------------------------------------------
 
263
    TIDEAEncryptStream
 
264
  ---------------------------------------------------------------------}
 
265
 
 
266
Destructor TIDEAEncryptStream.Destroy;
 
267
 
 
268
 
 
269
begin
 
270
  Flush;
 
271
  Inherited Destroy;
 
272
end;
 
273
 
 
274
Procedure TIDEAEncryptStream.Flush;
 
275
 
 
276
Var
 
277
  OutData : IdeaCryptData;
 
278
 
 
279
begin
 
280
  If FBufPos>0 then
 
281
    begin
 
282
    // Fill with nulls
 
283
    FillChar(PChar(@FData)[FBufPos],SizeOf(FData)-FBufPos,#0);
 
284
    CipherIdea(Fdata,OutData,FKey);
 
285
    Source.Write(OutData,SizeOf(OutData));
 
286
    // fixed: Manual flush and then free will now work
 
287
    FBufPos := 0;
 
288
    end;
 
289
end;
 
290
 
 
291
function TIDEAEncryptStream.Read(var Buffer; Count: Longint): Longint;
 
292
 
 
293
begin
 
294
  Raise EIDEAError.Create(SNoReadAllowed);
 
295
end;
 
296
 
 
297
function TIDEAEncryptStream.Write(const Buffer; Count: Longint): Longint;
 
298
 
 
299
Var
 
300
  mvsize : Longint;
 
301
  OutData : IDEAcryptdata;
 
302
 
 
303
begin
 
304
  Result:=0;
 
305
  While Count>0 do
 
306
    begin
 
307
    MVsize:=Count;
 
308
    If Mvsize>SizeOf(Fdata)-FBufPos then
 
309
      mvsize:=SizeOf(FData)-FBufPos;
 
310
    Move(PChar(@Buffer)[Result],PChar(@FData)[FBufPos],MVSize);
 
311
    If FBufPos+mvSize=Sizeof(FData) then
 
312
      begin
 
313
      // Empty buffer.
 
314
      CipherIdea(Fdata,OutData,FKey);
 
315
      // this will raise an exception if needed.
 
316
      Source.Writebuffer(OutData,SizeOf(OutData));
 
317
      FBufPos:=0;
 
318
      end
 
319
    else
 
320
      inc(FBufPos,mvsize);
 
321
    Dec(Count,MvSize);
 
322
    Inc(Result,mvSize);
 
323
    end;
 
324
  Inc(FPos,Result);
 
325
end;
 
326
 
 
327
 
 
328
function TIDEAEncryptStream.Seek(Offset: Longint; Origin: Word): Longint;
 
329
 
 
330
begin
 
331
  if (Offset = 0) and (Origin = soFromCurrent) then
 
332
    Result := FPos
 
333
  else
 
334
    Raise EIDEAError.Create(SNoSeekAllowed);
 
335
end;
 
336
 
 
337
 
 
338
{ ---------------------------------------------------------------------
 
339
    TIDEADecryptStream
 
340
  ---------------------------------------------------------------------}
 
341
 
 
342
 
 
343
function TIDEADeCryptStream.Read(var Buffer; Count: Longint): Longint;
 
344
 
 
345
Var
 
346
  mvsize : Longint;
 
347
  InData : IDEAcryptdata;
 
348
 
 
349
begin
 
350
  Result:=0;
 
351
  While Count>0 do
 
352
    begin
 
353
    // Empty existing buffer.
 
354
    If (FBufPos>0) then
 
355
      begin
 
356
      mvSize:=FBufPos;
 
357
      If MvSize>count then
 
358
        mvsize:=Count;
 
359
      Move(PChar(@FData)[0],PChar(@Buffer)[Result],MVSize);
 
360
      If ((Sizeof(FData)-MvSize)>0) then
 
361
        Move(PChar(@FData)[mvSize],PChar(@FData)[0],Sizeof(FData)-MvSize);
 
362
      Dec(Count,mvsize);
 
363
      Inc(Result,mvsize);
 
364
      FBufPos:=FBufPos-MvSize;
 
365
      end;
 
366
    // Fill buffer again if needed.
 
367
    If (Count>0) then
 
368
      begin
 
369
      mvsize:=Source.Read(InData,SizeOf(InData));
 
370
      If mvsize>0 then
 
371
        begin
 
372
        If MvSize<SizeOf(InData) Then
 
373
          // Fill with nulls
 
374
          FillChar(PChar(@InData)[mvsize],SizeOf(InData)-mvsize,#0);
 
375
        CipherIdea(InData,FData,FKey);
 
376
        FBufPos:=SizeOf(FData);
 
377
        end
 
378
      else
 
379
        Count:=0; // No more data available from stream; st
 
380
      end;
 
381
    end;
 
382
  Inc(FPos,Result);
 
383
end;
 
384
 
 
385
function TIDEADeCryptStream.Write(const Buffer; Count: Longint): Longint;
 
386
begin
 
387
  Raise EIDEAError.Create(SNoWriteAllowed);
 
388
end;
 
389
 
 
390
function TIDEADeCryptStream.Seek(Offset: Longint; Origin: Word): Longint;
 
391
 
 
392
Var Buffer : Array[0..1023] of byte;
 
393
    i : longint;
 
394
 
 
395
begin
 
396
  // Fake seek if possible by reading and discarding bytes.
 
397
  If ((Offset>=0) and (Origin = soFromCurrent)) or
 
398
    ((Offset>FPos) and (Origin = soFromBeginning)) then
 
399
      begin
 
400
      For I:=1 to (Offset div SizeOf(Buffer)) do
 
401
        ReadBuffer(Buffer,SizeOf(Buffer));
 
402
      ReadBuffer(Buffer,Offset mod SizeOf(Buffer));
 
403
      Result:=FPos;
 
404
      end
 
405
  else
 
406
    Raise EIDEAError.Create(SNoSeekAllowed);
 
407
end;
 
408
 
 
409
END.