/[lcore]/trunk/lcorernd.pas
ViewVC logotype

Annotation of /trunk/lcorernd.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 149 - (hide annotations)
Sun Sep 10 20:02:13 2017 UTC (3 years, 7 months ago) by plugwash
File size: 12105 byte(s)
Replace obsolete/broken lcoregtklaz with new lcorelazarus
Rename lmessages to lcoremessages due to unit name conflict with Lazarus


1 beware 20 { Copyright (C) 2005 Bas Steendijk and Peter Green
2     For conditions of distribution and use, see copyright notice in zlib_license.txt
3     which is included in the package
4     ----------------------------------------------------------------------------- }
5    
6     unit lcorernd;
7 plugwash 149 {$ifdef fpc}
8     {$mode delphi}
9     {$endif}
10 beware 20 interface
11    
12     {$include lcoreconfig.inc}
13    
14     {
15     written by Bas Steendijk (beware)
16    
17     the aim of this unit is to provide randomness in a consistent way, using OS specific methods for seeding
18    
19     this unit uses MD5 for performance and code size, but it is made so it is easy to use a different hash,
20 beware 136 as long as it is at least 128 bits, and a multiple of the "word size" (32 bits)
21 beware 20
22     goals:
23    
24     - for the code to be:
25     - relatively simple and small
26     - reasonably fast
27    
28     - for the numbers to be
29     - random: pass diehard and similar tests
30 beware 136 - unique: generate UUIDs
31 beware 20 - secure: difficult for a remote attacker to guess the internal state, even
32     when given some output
33    
34     typical intended uses:
35     - anything that needs random numbers without extreme demands on security or
36     speed should be able to use this
37 beware 136 - seeding other (faster) RNGs
38     - generation of passwords, UUIDs, cookies, and session keys
39 beware 20 - randomizing protocol fields to protect against spoofing attacks
40     - randomness for games
41    
42     this is not intended to be directly used for:
43 beware 136 - high security purposes (generating RSA root keys etc)
44 beware 20 - needing random numbers at very high rates (disk wiping, some simulations, etc)
45    
46     performance:
47     - 24 MB/s on 2.2 GHz athlon64 core on windows XP 32 bits
48     - 6.4 MB/s on 1 GHz p3 on linux
49    
50     exe size:
51     - fpc 2.2, linux: fastmd5: 12 kb; lcorernd: 6 kb.
52     - delphi 6: fastmd5: 3 kb; lcorernd: 2 kb
53    
54     reasoning behind the security of this RNG:
55    
56     - seeding:
57     1: i assume that any attacker has no local access to the machine. if one gained
58     this, then there are more seriousness weaknesses to consider.
59     2: i attempt to use enough seeding to be difficult to guess.
60     on windows: GUID, various readouts of hi res timestamps, heap stats, cursor
61     position
62     on *nix: i assume /dev/(u)random output is secure and difficult to guess. if
63     it misses, i use /dev/wtmp, which typically has as lot of entropy in it. i also use hi res timestamps.
64     3: on a state compromise, one can easily get up to the hash size worth of previous output, beyond that one has
65     to invert the hash operation.
66    
67     - mixing/expansion: a secure hash random walk on a buffer with a constant secret and a changing exposed part,
68     the big secret part serves to make it difficult for an attacker to predict next and previous output.
69     the secret part is changed during a reseed.
70    
71    
72     OS randomness
73     v
74     <wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww>
75     ____________________________ ________________________________________________
76     [ pool ][ seed ]
77     [hashsize][hashsize][hashsize]
78     <rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr>
79     bighash() seeding
80     v
81     <wwwwwwwwwwwwwwwwww>
82     <rrrrrrrrrrrrrrrrrrrrrrrrrrrr>
83     hash() random walk
84     v
85     <wwwwwwww>
86     [ output ][ secret ]
87    
88    
89     this needs testing on platforms other than i386
90    
91    
92     these routines are called by everything else in lcore, and if the app coder desires, by the app.
93     because one may want to use their own random number source, the PRNG here can be excluded from linking,
94     and the routines here can be hooked.
95     }
96    
97     {$include uint32.inc}
98    
99     {return a dword with 32 random bits}
100     type
101     wordtype=uint32;
102    
103     var
104     randomdword:function:wordtype;
105    
106     {fill a buffer with random bytes}
107     procedure fillrandom(var buf;length:integer);
108    
109     {generate an integer of 0 <= N < i}
110     function randominteger(i:longint):longint;
111    
112     {generate an integer with the lowest b bits being random}
113     function randombits(b:integer):longint;
114    
115     {generate a version 4 random uuid}
116 zipplet 79 function generate_uuid:ansistring;
117 beware 20
118     {$ifndef nolcorernd}
119    
120     {call this to mix seeding into the pool. is normally done automatically and does not have to be called
121     but can be done if one desires more security, for example for key generation}
122     procedure seedpool;
123    
124     {get some raw OS specific randomness. the output is not mixed so it should not be used directly as random numbers}
125     function collect_seeding(var output;const bufsize:integer):integer;
126    
127     function internalrandomdword:wordtype;
128    
129     var
130     reseedinterval:integer=64;
131     {$endif}
132    
133     implementation
134    
135 beware 132 {$include pgtypes.inc}
136    
137 beware 20 {$ifndef nolcorernd}
138     uses
139 beware 127 {$ifdef mswindows}windows,activex,{$endif}
140 plugwash 35 {$ifdef unix}
141     {$ifdef ver1_0}
142     linux,
143     {$else}
144 plugwash 60 baseunix,unix,unixutil,sockets,
145 plugwash 35 {$endif}
146     {$endif}
147 beware 20 fastmd5,sysutils;
148    
149     {$ifdef unix}{$include unixstuff.inc}{$endif}
150    
151 beware 132 procedure rdtsc(buf: pointer);
152     asm
153     {$ifdef cpux86}
154     mov ecx, buf
155     db $0f; db $31 {rdtsc}
156     mov [ecx], edx
157     mov [ecx+4], eax
158     {$endif}
159    
160     {$ifdef cpux64}
161     mov rcx, buf
162     rdtsc
163     mov [rcx], edx
164     mov [rcx+4], eax
165     {$endif}
166     end;
167    
168 beware 20 type
169     {hashtype must be array of bytes}
170     hashtype=tmd5;
171    
172     const
173     wordsizeshift=2;
174     wordsize=1 shl wordsizeshift;
175 plugwash 32 //wordsize check commented out for d3 compatibility
176     //{ $if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{ $ifend}
177 beware 20 hashsize=sizeof(hashtype);
178     halfhashsize=hashsize div 2;
179     hashdwords=hashsize div wordsize;
180     pooldwords=3*hashdwords;
181     seeddwords=32;
182     hashpasssize=48; {this number has to be small enough that hashing this size uses only one block transform}
183    
184     var
185 beware 141 {the seed part of this buffer must be at least as big as the OS seed (windows: 120 bytes, unix: 36 bytes)}
186 beware 20 pool:array[0..(pooldwords+seeddwords-1)] of wordtype;
187     reseedcountdown:integer;
188    
189 beware 127 {$ifdef mswindows}
190 beware 141 var
191     systemfunction036:function(var v; c:cardinal): boolean; stdcall;
192     rtlgenrandominited:boolean;
193    
194     procedure initrtlgenrandom;
195     var
196     h:thandle;
197     begin
198     rtlgenrandominited := true;
199     systemfunction036 := nil;
200     h := loadlibrary('advapi32.dll');
201     if (h <> 0) then begin
202     systemfunction036 := GetProcAddress(h,'SystemFunction036');
203     end;
204     end;
205    
206 beware 20 function collect_seeding(var output;const bufsize:integer):integer;
207     var
208     l:packed record
209 beware 141 rtlgenrandom:array[0..3] of longint;
210 beware 20 guid:array[0..3] of longint;
211     qpcbuf:array[0..1] of longint;
212     rdtscbuf:array[0..1] of longint;
213     systemtimebuf:array[0..3] of longint;
214     pid:longint;
215     tid:longint;
216     cursor:tpoint;
217     hs:theapstatus;
218     end absolute output;
219     begin
220     result := 0;
221     if (bufsize < sizeof(l)) then exit;
222     result := sizeof(l);
223     {PID}
224     l.pid := GetCurrentProcessId;
225     l.tid := GetCurrentThreadId;
226    
227     {COCREATEGUID}
228     cocreateguid(tguid(l.guid));
229    
230     {QUERYPERFORMANCECOUNTER}
231     queryperformancecounter(tlargeinteger(l.qpcbuf));
232    
233     {RDTSC}
234 beware 132 rdtsc(@l.rdtscbuf);
235    
236 beware 20 {GETSYSTEMTIME}
237     getsystemtime(tsystemtime(l.systemtimebuf));
238    
239     {cursor position}
240     getcursorpos(l.cursor);
241    
242     l.hs := getheapstatus;
243 beware 141
244     {rtlgenrandom}
245     if not rtlgenrandominited then initrtlgenrandom;
246     if assigned(@systemfunction036) then systemfunction036(l.rtlgenrandom,sizeof(l.rtlgenrandom));
247 beware 20 end;
248     {$endif}
249    
250     {$ifdef unix}
251    
252     var
253     wtmpinited:boolean;
254     wtmpcached:hashtype;
255    
256     procedure wtmphash;
257     var
258     f:file;
259     buf:array[0..4095] of byte;
260     numread:integer;
261     state:tmd5state;
262     begin
263     if wtmpinited then exit;
264    
265     assignfile(f,'/var/log/wtmp');
266     filemode := 0;
267     {$i-}reset(f,1);{$i+}
268     if (ioresult <> 0) then exit;
269     md5init(state);
270     while not eof(f) do begin
271     blockread(f,buf,sizeof(buf),numread);
272     md5process(state,buf,numread);
273     end;
274     closefile(f);
275     md5finish(state,wtmpcached);
276     wtmpinited := true;
277     end;
278    
279    
280     function collect_seeding(var output;const bufsize:integer):integer;
281     var
282     f:file;
283     a:integer;
284     l:packed record
285 beware 134 devrnd:array[0..7] of integer;
286 beware 20 rdtscbuf:array[0..1] of integer;
287     tv:ttimeval;
288     pid:integer;
289     end absolute output;
290    
291     begin
292     result := 0;
293     if (bufsize < sizeof(l)) then exit;
294     result := sizeof(l);
295    
296     {/DEV/URANDOM}
297     a := 1;
298     assignfile(f,'/dev/urandom');
299     filemode := 0;
300     {$i-}reset(f,1);{$i+}
301     a := ioresult;
302     if (a <> 0) then begin
303     assignfile(f,'/dev/random');
304     {$i-}reset(f,1);{$i+}
305     a := ioresult;
306     end;
307     if (a = 0) then begin
308     blockread(f,l.devrnd,sizeof(l.devrnd));
309     closefile(f);
310     end else begin
311     {the OS we are on has no /dev/random or /dev/urandom, get a hash from /var/log/wtmp}
312     wtmphash;
313     move(wtmpcached,l.devrnd,sizeof(l.devrnd));
314     end;
315     {get more randomness in case there's no /dev/random}
316 beware 132 rdtsc(@l.rdtscbuf);
317 beware 20
318     gettimeofday(l.tv);
319     l.pid := getpid;
320     end;
321     {$endif}
322    
323     {this produces a hash which is twice the native hash size (32 bytes for MD5)}
324     procedure bighash(const input;len:integer;var output);
325     var
326     inarr:array[0..65535] of byte absolute input;
327     outarr:array[0..65535] of byte absolute output;
328    
329     h1,h2,h3,h4:hashtype;
330     a:integer;
331     begin
332     a := len div 2;
333     {first hash round}
334     getmd5(inarr[0],a,h1);
335     getmd5(inarr[a],len-a,h2);
336    
337     move(h1[0],h3[0],halfhashsize);
338     move(h2[0],h3[halfhashsize],halfhashsize);
339     move(h1[halfhashsize],h4[0],halfhashsize);
340     move(h2[halfhashsize],h4[halfhashsize],halfhashsize);
341    
342     getmd5(h3,hashsize,outarr[0]);
343     getmd5(h4,hashsize,outarr[hashsize]);
344     end;
345    
346     procedure seedpool;
347     var
348     a:integer;
349     begin
350     a := collect_seeding(pool[pooldwords],seeddwords*wordsize);
351     if (a = 0) then halt;
352     bighash(pool[hashdwords],(2*hashsize)+a,pool[hashdwords]);
353     getmd5(pool[0],hashpasssize,pool[0]);
354     end;
355    
356     function internalrandomdword;
357     begin
358     if (reseedcountdown <= 0) then begin
359     seedpool;
360     reseedcountdown := reseedinterval * hashdwords;
361     end else if ((reseedcountdown mod hashdwords) = 0) then begin;
362     getmd5(pool[0],hashpasssize,pool[0]);
363     end;
364     dec(reseedcountdown);
365    
366     result := pool[reseedcountdown mod hashdwords];
367     end;
368     {$endif}
369    
370     procedure fillrandom(var buf;length:integer);
371     var
372     a,b:integer;
373     buf_:array[0..16383] of uint32 absolute buf;
374    
375     begin
376     b := 0;
377     for a := (length shr wordsizeshift)-1 downto 0 do begin
378     buf_[b] := randomdword;
379     inc(b);
380     end;
381     length := length and (wordsize-1);
382     if length <> 0 then begin
383     a := randomdword;
384     move(a,buf_[b],length);
385     end;
386     end;
387    
388     const
389     wordsizebits=32;
390    
391     function randombits(b:integer):longint;
392     begin
393     result := randomdword;
394     result := result and (-1 shr (wordsizebits-b));
395     if (b = 0) then result := 0;
396     end;
397    
398     function randominteger(i:longint):longint;
399     var
400     a,b:integer;
401     j:integer;
402     begin
403     //bitscounter := bitscounter + numofbitsininteger(i);
404     if (i = 0) then begin
405     result := 0;
406     exit;
407     end;
408     {find number of bits needed}
409     j := i-1;
410     if (j < 0) then begin
411     result := randombits(wordsizebits);
412     exit
413     end else if (j >= (1 shl (wordsizebits-2))) then begin
414     b := wordsizebits-1
415     end else begin
416     b := -1;
417     for a := 0 to (wordsizebits-2) do begin
418     if j < 1 shl a then begin
419     b := a;
420     break;
421     end;
422     end;
423     end;
424     repeat
425     result := randombits(b);
426     until result < i;
427     end;
428    
429     const
430 zipplet 79 ch:array[0..15] of ansichar='0123456789abcdef';
431 beware 20
432 zipplet 79 function generate_uuid:ansistring;
433 beware 20 var
434     buf:array[0..7] of word;
435 zipplet 79 function inttohex(w:word):ansistring;
436 beware 20 begin
437     result := ch[w shr 12] + ch[(w shr 8) and $f] + ch[(w shr 4) and $f] + ch[w and $f];
438     end;
439     begin
440     fillrandom(buf,sizeof(buf));
441    
442     {uuid version 4}
443     buf[3] := (buf[3] and $fff) or $4000;
444    
445     {uuid version 4}
446     buf[4] := (buf[4] and $3fff) or $8000;
447    
448     result := inttohex(buf[0]) + inttohex(buf[1]) + '-' + inttohex(buf[2]) +'-'+ inttohex(buf[3]) + '-' + inttohex(buf[4])
449     + '-' + inttohex(buf[5]) + inttohex(buf[6]) + inttohex(buf[7]);
450     end;
451    
452     {$ifndef nolcorernd}
453     initialization randomdword := @internalrandomdword;
454     {$endif}
455    
456     end.
457    

Properties

Name Value
svn:eol-style CRLF

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.26