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

Contents of /trunk/lcorernd.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 149 - (show annotations)
Sun Sep 10 20:02:13 2017 UTC (3 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 { 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
149 {$ifdef unix}{$include unixstuff.inc}{$endif}
150
151 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 type
169 {hashtype must be array of bytes}
170 hashtype=tmd5;
171
172 const
173 wordsizeshift=2;
174 wordsize=1 shl wordsizeshift;
175 //wordsize check commented out for d3 compatibility
176 //{ $if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{ $ifend}
177 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 {the seed part of this buffer must be at least as big as the OS seed (windows: 120 bytes, unix: 36 bytes)}
186 pool:array[0..(pooldwords+seeddwords-1)] of wordtype;
187 reseedcountdown:integer;
188
189 {$ifdef mswindows}
190 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 function collect_seeding(var output;const bufsize:integer):integer;
207 var
208 l:packed record
209 rtlgenrandom:array[0..3] of longint;
210 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 rdtsc(@l.rdtscbuf);
235
236 {GETSYSTEMTIME}
237 getsystemtime(tsystemtime(l.systemtimebuf));
238
239 {cursor position}
240 getcursorpos(l.cursor);
241
242 l.hs := getheapstatus;
243
244 {rtlgenrandom}
245 if not rtlgenrandominited then initrtlgenrandom;
246 if assigned(@systemfunction036) then systemfunction036(l.rtlgenrandom,sizeof(l.rtlgenrandom));
247 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 devrnd:array[0..7] of integer;
286 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 rdtsc(@l.rdtscbuf);
317
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 ch:array[0..15] of ansichar='0123456789abcdef';
431
432 function generate_uuid:ansistring;
433 var
434 buf:array[0..7] of word;
435 function inttohex(w:word):ansistring;
436 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.5