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

Contents of /trunk/lcorernd.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 165 - (show annotations)
Sat Jan 8 21:57:19 2022 UTC (2 weeks, 1 day ago) by beware
File size: 12183 byte(s)
fixed that lcorernd would not compile if nolcorernd is defined, but should
1 { 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 {$ifdef fpc}
8 {$mode delphi}
9 {$endif}
10 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 as long as it is at least 128 bits, and a multiple of the "word size" (32 bits)
21
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 - unique: generate UUIDs
31 - 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 - seeding other (faster) RNGs
38 - generation of passwords, UUIDs, cookies, and session keys
39 - randomizing protocol fields to protect against spoofing attacks
40 - randomness for games
41
42 this is not intended to be directly used for:
43 - high security purposes (generating RSA root keys etc)
44 - 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 function generate_uuid:ansistring;
117
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 {$include pgtypes.inc}
136
137 {$ifndef nolcorernd}
138 uses
139 {$ifdef mswindows}windows,activex,{$endif}
140 {$ifdef unix}
141 {$ifdef ver1_0}
142 linux,
143 {$else}
144 baseunix,unix,unixutil,sockets,
145 {$endif}
146 {$endif}
147 fastmd5,sysutils;
148 {$endif}
149
150 const
151 wordsizeshift=2;
152 wordsize=1 shl wordsizeshift;
153
154 {$ifndef nolcorernd}
155
156 {$ifdef unix}{$include unixstuff.inc}{$endif}
157
158 procedure rdtsc(buf: pointer);
159 asm
160 {$ifdef cpux86}
161 mov ecx, buf
162 db $0f; db $31 {rdtsc}
163 mov [ecx], edx
164 mov [ecx+4], eax
165 {$endif}
166
167 {$ifdef cpux64}
168 mov rcx, buf
169 rdtsc
170 mov [rcx], edx
171 mov [rcx+4], eax
172 {$endif}
173 end;
174
175 type
176 {hashtype must be array of bytes}
177 hashtype=tmd5;
178
179 const
180 //wordsize check commented out for d3 compatibility
181 //{ $if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{ $ifend}
182 hashsize=sizeof(hashtype);
183 halfhashsize=hashsize div 2;
184 hashdwords=hashsize div wordsize;
185 pooldwords=3*hashdwords;
186 seeddwords=40;
187 hashpasssize=48; {this number has to be small enough that hashing this size uses only one block transform}
188
189 var
190 //the seed part of this buffer must be at least as big as the OS seed (windows: 120 bytes for 32 bits, 160 bytes for 64 bits, unix: 36 bytes)
191 pool:array[0..(pooldwords+seeddwords-1)] of wordtype;
192 reseedcountdown:integer;
193
194 {$ifdef mswindows}
195 var
196 systemfunction036:function(var v; c:cardinal): boolean; stdcall;
197 rtlgenrandominited:boolean;
198
199 procedure initrtlgenrandom;
200 var
201 h:thandle;
202 begin
203 rtlgenrandominited := true;
204 systemfunction036 := nil;
205 h := loadlibrary('advapi32.dll');
206 if (h <> 0) then begin
207 systemfunction036 := GetProcAddress(h,'SystemFunction036');
208 end;
209 end;
210
211 function collect_seeding(var output;const bufsize:integer):integer;
212 var
213 l:packed record
214 rtlgenrandom:array[0..3] of longint;
215 guid:array[0..3] of longint;
216 qpcbuf:array[0..1] of longint;
217 rdtscbuf:array[0..1] of longint;
218 systemtimebuf:array[0..3] of longint;
219 pid:longint;
220 tid:longint;
221 cursor:tpoint;
222 hs:theapstatus;
223 end absolute output;
224 begin
225 result := 0;
226 if (bufsize < sizeof(l)) then exit;
227 result := sizeof(l);
228 {PID}
229 l.pid := GetCurrentProcessId;
230 l.tid := GetCurrentThreadId;
231
232 {COCREATEGUID}
233 cocreateguid(tguid(l.guid));
234
235 {QUERYPERFORMANCECOUNTER}
236 queryperformancecounter(tlargeinteger(l.qpcbuf));
237
238 {RDTSC}
239 rdtsc(@l.rdtscbuf);
240
241 {GETSYSTEMTIME}
242 getsystemtime(tsystemtime(l.systemtimebuf));
243
244 {cursor position}
245 getcursorpos(l.cursor);
246
247 l.hs := getheapstatus;
248
249 {rtlgenrandom}
250 if not rtlgenrandominited then initrtlgenrandom;
251 if assigned(@systemfunction036) then systemfunction036(l.rtlgenrandom,sizeof(l.rtlgenrandom));
252 end;
253 {$endif}
254
255 {$ifdef unix}
256
257 var
258 wtmpinited:boolean;
259 wtmpcached:hashtype;
260
261 procedure wtmphash;
262 var
263 f:file;
264 buf:array[0..4095] of byte;
265 numread:integer;
266 state:tmd5state;
267 begin
268 if wtmpinited then exit;
269
270 assignfile(f,'/var/log/wtmp');
271 filemode := 0;
272 {$i-}reset(f,1);{$i+}
273 if (ioresult <> 0) then exit;
274 md5init(state);
275 while not eof(f) do begin
276 blockread(f,buf,sizeof(buf),numread);
277 md5process(state,buf,numread);
278 end;
279 closefile(f);
280 md5finish(state,wtmpcached);
281 wtmpinited := true;
282 end;
283
284
285 function collect_seeding(var output;const bufsize:integer):integer;
286 var
287 f:file;
288 a:integer;
289 l:packed record
290 devrnd:array[0..7] of integer;
291 rdtscbuf:array[0..1] of integer;
292 tv:ttimeval;
293 pid:integer;
294 end absolute output;
295
296 begin
297 result := 0;
298 if (bufsize < sizeof(l)) then exit;
299 result := sizeof(l);
300
301 {/DEV/URANDOM}
302 a := 1;
303 assignfile(f,'/dev/urandom');
304 filemode := 0;
305 {$i-}reset(f,1);{$i+}
306 a := ioresult;
307 if (a <> 0) then begin
308 assignfile(f,'/dev/random');
309 {$i-}reset(f,1);{$i+}
310 a := ioresult;
311 end;
312 if (a = 0) then begin
313 blockread(f,l.devrnd,sizeof(l.devrnd));
314 closefile(f);
315 end else begin
316 {the OS we are on has no /dev/random or /dev/urandom, get a hash from /var/log/wtmp}
317 wtmphash;
318 move(wtmpcached,l.devrnd,sizeof(l.devrnd));
319 end;
320 {get more randomness in case there's no /dev/random}
321 rdtsc(@l.rdtscbuf);
322
323 gettimeofday(l.tv);
324 l.pid := getpid;
325 end;
326 {$endif}
327
328 {this produces a hash which is twice the native hash size (32 bytes for MD5)}
329 procedure bighash(const input;len:integer;var output);
330 var
331 inarr:array[0..65535] of byte absolute input;
332 outarr:array[0..65535] of byte absolute output;
333
334 h1,h2,h3,h4:hashtype;
335 a:integer;
336 begin
337 a := len div 2;
338 {first hash round}
339 getmd5(inarr[0],a,h1);
340 getmd5(inarr[a],len-a,h2);
341
342 move(h1[0],h3[0],halfhashsize);
343 move(h2[0],h3[halfhashsize],halfhashsize);
344 move(h1[halfhashsize],h4[0],halfhashsize);
345 move(h2[halfhashsize],h4[halfhashsize],halfhashsize);
346
347 getmd5(h3,hashsize,outarr[0]);
348 getmd5(h4,hashsize,outarr[hashsize]);
349 end;
350
351 procedure seedpool;
352 var
353 a:integer;
354 begin
355 a := collect_seeding(pool[pooldwords],seeddwords*wordsize);
356 if (a = 0) then halt;
357 bighash(pool[hashdwords],(2*hashsize)+a,pool[hashdwords]);
358 getmd5(pool[0],hashpasssize,pool[0]);
359 end;
360
361 function internalrandomdword;
362 begin
363 if (reseedcountdown <= 0) then begin
364 seedpool;
365 reseedcountdown := reseedinterval * hashdwords;
366 end else if ((reseedcountdown mod hashdwords) = 0) then begin;
367 getmd5(pool[0],hashpasssize,pool[0]);
368 end;
369 dec(reseedcountdown);
370
371 result := pool[reseedcountdown mod hashdwords];
372 end;
373 {$endif}
374
375 procedure fillrandom(var buf;length:integer);
376 var
377 a,b:integer;
378 buf_:array[0..16383] of uint32 absolute buf;
379
380 begin
381 b := 0;
382 for a := (length shr wordsizeshift)-1 downto 0 do begin
383 buf_[b] := randomdword;
384 inc(b);
385 end;
386 length := length and (wordsize-1);
387 if length <> 0 then begin
388 a := randomdword;
389 move(a,buf_[b],length);
390 end;
391 end;
392
393 const
394 wordsizebits=32;
395
396 function randombits(b:integer):longint;
397 begin
398 result := randomdword;
399 result := result and (-1 shr (wordsizebits-b));
400 if (b = 0) then result := 0;
401 end;
402
403 function randominteger(i:longint):longint;
404 var
405 a,b:integer;
406 j:integer;
407 begin
408 //bitscounter := bitscounter + numofbitsininteger(i);
409 if (i = 0) then begin
410 result := 0;
411 exit;
412 end;
413 {find number of bits needed}
414 j := i-1;
415 if (j < 0) then begin
416 result := randombits(wordsizebits);
417 exit
418 end else if (j >= (1 shl (wordsizebits-2))) then begin
419 b := wordsizebits-1
420 end else begin
421 b := -1;
422 for a := 0 to (wordsizebits-2) do begin
423 if j < 1 shl a then begin
424 b := a;
425 break;
426 end;
427 end;
428 end;
429 repeat
430 result := randombits(b);
431 until result < i;
432 end;
433
434 const
435 ch:array[0..15] of ansichar='0123456789abcdef';
436
437 function generate_uuid:ansistring;
438 var
439 buf:array[0..7] of word;
440 function inttohex(w:word):ansistring;
441 begin
442 result := ch[w shr 12] + ch[(w shr 8) and $f] + ch[(w shr 4) and $f] + ch[w and $f];
443 end;
444 begin
445 fillrandom(buf,sizeof(buf));
446
447 {uuid version 4}
448 buf[3] := (buf[3] and $fff) or $4000;
449
450 {uuid version 4}
451 buf[4] := (buf[4] and $3fff) or $8000;
452
453 result := inttohex(buf[0]) + inttohex(buf[1]) + '-' + inttohex(buf[2]) +'-'+ inttohex(buf[3]) + '-' + inttohex(buf[4])
454 + '-' + inttohex(buf[5]) + inttohex(buf[6]) + inttohex(buf[7]);
455 end;
456
457 {$ifndef nolcorernd}
458 initialization randomdword := @internalrandomdword;
459 {$endif}
460
461 end.
462

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