+{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
+ For conditions of distribution and use, see copyright notice in zlib_license.txt\r
+ which is included in the package\r
+ ----------------------------------------------------------------------------- }\r
+\r
+unit lcorernd;\r
+\r
+interface\r
+\r
+{$include lcoreconfig.inc}\r
+\r
+{\r
+written by Bas Steendijk (beware)\r
+\r
+the aim of this unit is to provide randomness in a consistent way, using OS specific methods for seeding\r
+\r
+this unit uses MD5 for performance and code size, but it is made so it is easy to use a different hash,\r
+as long as it is atleat 128 bits, and a multiple of the "word size" (32 bits)\r
+\r
+goals:\r
+\r
+- for the code to be:\r
+ - relatively simple and small\r
+ - reasonably fast\r
+\r
+- for the numbers to be\r
+ - random: pass diehard and similar tests\r
+ - unique: generate UUID's\r
+ - secure: difficult for a remote attacker to guess the internal state, even\r
+ when given some output\r
+\r
+typical intended uses:\r
+ - anything that needs random numbers without extreme demands on security or\r
+ speed should be able to use this\r
+ - seeding other (faster) RNG's\r
+ - generation of passwords, UUID's, cookies, and session keys\r
+ - randomizing protocol fields to protect against spoofing attacks\r
+ - randomness for games\r
+\r
+this is not intended to be directly used for:\r
+- high securirity purposes (generating RSA root keys etc)\r
+- needing random numbers at very high rates (disk wiping, some simulations, etc)\r
+\r
+performance:\r
+- 24 MB/s on 2.2 GHz athlon64 core on windows XP 32 bits\r
+- 6.4 MB/s on 1 GHz p3 on linux\r
+\r
+exe size:\r
+- fpc 2.2, linux: fastmd5: 12 kb; lcorernd: 6 kb.\r
+- delphi 6: fastmd5: 3 kb; lcorernd: 2 kb\r
+\r
+reasoning behind the security of this RNG:\r
+\r
+- seeding:\r
+1: i assume that any attacker has no local access to the machine. if one gained\r
+ this, then there are more seriousness weaknesses to consider.\r
+2: i attempt to use enough seeding to be difficult to guess.\r
+ on windows: GUID, various readouts of hi res timestamps, heap stats, cursor\r
+ position\r
+ on *nix: i assume /dev/(u)random output is secure and difficult to guess. if\r
+ it misses, i use /dev/wtmp, which typically has as lot of entropy in it. i also use hi res timestamps.\r
+3: on a state compromise, one can easily get up to the hash size worth of previous output, beyond that one has\r
+ to invert the hash operation.\r
+\r
+- mixing/expansion: a secure hash random walk on a buffer with a constant secret and a changing exposed part,\r
+ the big secret part serves to make it difficult for an attacker to predict next and previous output.\r
+ the secret part is changed during a reseed.\r
+\r
+\r
+ OS randomness\r
+ v\r
+ <wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww>\r
+ ____________________________ ________________________________________________\r
+[ pool ][ seed ]\r
+[hashsize][hashsize][hashsize]\r
+ <rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr>\r
+ bighash() seeding\r
+ v\r
+ <wwwwwwwwwwwwwwwwww>\r
+<rrrrrrrrrrrrrrrrrrrrrrrrrrrr>\r
+ hash() random walk\r
+ v\r
+<wwwwwwww>\r
+[ output ][ secret ]\r
+\r
+\r
+this needs testing on platforms other than i386\r
+\r
+\r
+these routines are called by everything else in lcore, and if the app coder desires, by the app.\r
+because one may want to use their own random number source, the PRNG here can be excluded from linking,\r
+and the routines here can be hooked.\r
+}\r
+\r
+{$include uint32.inc}\r
+\r
+{return a dword with 32 random bits}\r
+type\r
+ wordtype=uint32;\r
+\r
+var\r
+ randomdword:function:wordtype;\r
+\r
+{fill a buffer with random bytes}\r
+procedure fillrandom(var buf;length:integer);\r
+\r
+{generate an integer of 0 <= N < i}\r
+function randominteger(i:longint):longint;\r
+\r
+{generate an integer with the lowest b bits being random}\r
+function randombits(b:integer):longint;\r
+\r
+{generate a version 4 random uuid}\r
+function generate_uuid:string;\r
+\r
+{$ifndef nolcorernd}\r
+\r
+{call this to mix seeding into the pool. is normally done automatically and does not have to be called\r
+but can be done if one desires more security, for example for key generation}\r
+procedure seedpool;\r
+\r
+{get some raw OS specific randomness. the output is not mixed so it should not be used directly as random numbers}\r
+function collect_seeding(var output;const bufsize:integer):integer;\r
+\r
+function internalrandomdword:wordtype;\r
+\r
+var\r
+ reseedinterval:integer=64;\r
+{$endif}\r
+\r
+implementation\r
+\r
+{$ifndef nolcorernd}\r
+uses\r
+ {$ifdef win32}windows,activex,types,{$endif}\r
+ {$ifdef unix}baseunix,unix,unixutil,{$endif}\r
+ fastmd5,sysutils;\r
+\r
+{$ifdef unix}{$include unixstuff.inc}{$endif}\r
+\r
+type\r
+ {hashtype must be array of bytes}\r
+ hashtype=tmd5;\r
+\r
+const\r
+ wordsizeshift=2;\r
+ wordsize=1 shl wordsizeshift;\r
+\r
+ {$if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{$ifend}\r
+\r
+ hashsize=sizeof(hashtype);\r
+ halfhashsize=hashsize div 2;\r
+ hashdwords=hashsize div wordsize;\r
+ pooldwords=3*hashdwords;\r
+ seeddwords=32;\r
+ hashpasssize=48; {this number has to be small enough that hashing this size uses only one block transform}\r
+\r
+var\r
+ {the seed part of this buffer must be atleast as big as the OS seed (windows: 104 bytes, unix: 36 bytes)}\r
+ pool:array[0..(pooldwords+seeddwords-1)] of wordtype;\r
+ reseedcountdown:integer;\r
+\r
+{$ifdef win32}\r
+function collect_seeding(var output;const bufsize:integer):integer;\r
+var\r
+ l:packed record\r
+ guid:array[0..3] of longint;\r
+ qpcbuf:array[0..1] of longint;\r
+ rdtscbuf:array[0..1] of longint;\r
+ systemtimebuf:array[0..3] of longint;\r
+ pid:longint;\r
+ tid:longint;\r
+ cursor:tpoint;\r
+ hs:theapstatus;\r
+ end absolute output;\r
+ rdtsc_0,rdtsc_1:integer;\r
+begin\r
+ result := 0;\r
+ if (bufsize < sizeof(l)) then exit;\r
+ result := sizeof(l);\r
+ {PID}\r
+ l.pid := GetCurrentProcessId;\r
+ l.tid := GetCurrentThreadId;\r
+\r
+ {COCREATEGUID}\r
+ cocreateguid(tguid(l.guid));\r
+\r
+ {QUERYPERFORMANCECOUNTER}\r
+ queryperformancecounter(tlargeinteger(l.qpcbuf));\r
+\r
+ {RDTSC}\r
+ {$ifdef cpu386}\r
+ asm\r
+ db $0F; db $31\r
+ mov rdtsc_0,eax\r
+ mov rdtsc_1,edx\r
+ end;\r
+ l.rdtscbuf[0] := rdtsc_0;\r
+ l.rdtscbuf[1] := rdtsc_1;\r
+ {$endif}\r
+ {GETSYSTEMTIME}\r
+ getsystemtime(tsystemtime(l.systemtimebuf));\r
+\r
+ {cursor position}\r
+ getcursorpos(l.cursor);\r
+\r
+ l.hs := getheapstatus;\r
+end;\r
+{$endif}\r
+\r
+{$ifdef unix}\r
+\r
+var\r
+ wtmpinited:boolean;\r
+ wtmpcached:hashtype;\r
+\r
+procedure wtmphash;\r
+var\r
+ f:file;\r
+ buf:array[0..4095] of byte;\r
+ numread:integer;\r
+ state:tmd5state;\r
+begin\r
+ if wtmpinited then exit;\r
+\r
+ assignfile(f,'/var/log/wtmp');\r
+ filemode := 0;\r
+ {$i-}reset(f,1);{$i+}\r
+ if (ioresult <> 0) then exit;\r
+ md5init(state);\r
+ while not eof(f) do begin\r
+ blockread(f,buf,sizeof(buf),numread);\r
+ md5process(state,buf,numread);\r
+ end;\r
+ closefile(f);\r
+ md5finish(state,wtmpcached);\r
+ wtmpinited := true;\r
+end;\r
+\r
+\r
+function collect_seeding(var output;const bufsize:integer):integer;\r
+var\r
+ f:file;\r
+ a:integer;\r
+ l:packed record\r
+ devrnd:array[0..3] of integer;\r
+ rdtscbuf:array[0..1] of integer;\r
+ tv:ttimeval;\r
+ pid:integer;\r
+ end absolute output;\r
+ rdtsc_0,rdtsc_1:integer;\r
+\r
+begin\r
+ result := 0;\r
+ if (bufsize < sizeof(l)) then exit;\r
+ result := sizeof(l);\r
+\r
+ {/DEV/URANDOM}\r
+ a := 1;\r
+ assignfile(f,'/dev/urandom');\r
+ filemode := 0;\r
+ {$i-}reset(f,1);{$i+}\r
+ a := ioresult;\r
+ if (a <> 0) then begin\r
+ assignfile(f,'/dev/random');\r
+ {$i-}reset(f,1);{$i+}\r
+ a := ioresult;\r
+ end;\r
+ if (a = 0) then begin\r
+ blockread(f,l.devrnd,sizeof(l.devrnd));\r
+ closefile(f);\r
+ end else begin\r
+ {the OS we are on has no /dev/random or /dev/urandom, get a hash from /var/log/wtmp}\r
+ wtmphash;\r
+ move(wtmpcached,l.devrnd,sizeof(l.devrnd));\r
+ end;\r
+ {get more randomness in case there's no /dev/random}\r
+ {$ifdef cpu386}{$ASMMODE intel}\r
+ asm\r
+ db $0F; db $31\r
+ mov rdtsc_0,eax\r
+ mov rdtsc_1,edx\r
+ end;\r
+ l.rdtscbuf[0] := rdtsc_0;\r
+ l.rdtscbuf[1] := rdtsc_1;\r
+ {$endif}\r
+\r
+ gettimeofday(l.tv);\r
+ l.pid := getpid;\r
+end;\r
+{$endif}\r
+\r
+{this produces a hash which is twice the native hash size (32 bytes for MD5)}\r
+procedure bighash(const input;len:integer;var output);\r
+var\r
+ inarr:array[0..65535] of byte absolute input;\r
+ outarr:array[0..65535] of byte absolute output;\r
+\r
+ h1,h2,h3,h4:hashtype;\r
+ a:integer;\r
+begin\r
+ a := len div 2;\r
+ {first hash round}\r
+ getmd5(inarr[0],a,h1);\r
+ getmd5(inarr[a],len-a,h2);\r
+\r
+ move(h1[0],h3[0],halfhashsize);\r
+ move(h2[0],h3[halfhashsize],halfhashsize);\r
+ move(h1[halfhashsize],h4[0],halfhashsize);\r
+ move(h2[halfhashsize],h4[halfhashsize],halfhashsize);\r
+\r
+ getmd5(h3,hashsize,outarr[0]);\r
+ getmd5(h4,hashsize,outarr[hashsize]);\r
+end;\r
+\r
+procedure seedpool;\r
+var\r
+ a:integer;\r
+begin\r
+ a := collect_seeding(pool[pooldwords],seeddwords*wordsize);\r
+ if (a = 0) then halt;\r
+ bighash(pool[hashdwords],(2*hashsize)+a,pool[hashdwords]);\r
+ getmd5(pool[0],hashpasssize,pool[0]);\r
+end;\r
+\r
+function internalrandomdword;\r
+begin\r
+ if (reseedcountdown <= 0) then begin\r
+ seedpool;\r
+ reseedcountdown := reseedinterval * hashdwords;\r
+ end else if ((reseedcountdown mod hashdwords) = 0) then begin;\r
+ getmd5(pool[0],hashpasssize,pool[0]);\r
+ end;\r
+ dec(reseedcountdown);\r
+\r
+ result := pool[reseedcountdown mod hashdwords];\r
+end;\r
+{$endif}\r
+\r
+procedure fillrandom(var buf;length:integer);\r
+var\r
+ a,b:integer;\r
+ buf_:array[0..16383] of uint32 absolute buf;\r
+\r
+begin\r
+ b := 0;\r
+ for a := (length shr wordsizeshift)-1 downto 0 do begin\r
+ buf_[b] := randomdword;\r
+ inc(b);\r
+ end;\r
+ length := length and (wordsize-1);\r
+ if length <> 0 then begin\r
+ a := randomdword;\r
+ move(a,buf_[b],length);\r
+ end;\r
+end;\r
+\r
+const\r
+ wordsizebits=32;\r
+\r
+function randombits(b:integer):longint;\r
+begin\r
+ result := randomdword;\r
+ result := result and (-1 shr (wordsizebits-b));\r
+ if (b = 0) then result := 0;\r
+end;\r
+\r
+function randominteger(i:longint):longint;\r
+var\r
+ a,b:integer;\r
+ j:integer;\r
+begin\r
+ //bitscounter := bitscounter + numofbitsininteger(i);\r
+ if (i = 0) then begin\r
+ result := 0;\r
+ exit;\r
+ end;\r
+ {find number of bits needed}\r
+ j := i-1;\r
+ if (j < 0) then begin\r
+ result := randombits(wordsizebits);\r
+ exit\r
+ end else if (j >= (1 shl (wordsizebits-2))) then begin\r
+ b := wordsizebits-1\r
+ end else begin\r
+ b := -1;\r
+ for a := 0 to (wordsizebits-2) do begin\r
+ if j < 1 shl a then begin\r
+ b := a;\r
+ break;\r
+ end;\r
+ end;\r
+ end;\r
+ repeat\r
+ result := randombits(b);\r
+ until result < i;\r
+end;\r
+\r
+const\r
+ ch:array[0..15] of char='0123456789abcdef';\r
+\r
+function generate_uuid:string;\r
+var\r
+ buf:array[0..7] of word;\r
+function inttohex(w:word):string;\r
+begin\r
+ result := ch[w shr 12] + ch[(w shr 8) and $f] + ch[(w shr 4) and $f] + ch[w and $f];\r
+end;\r
+begin\r
+ fillrandom(buf,sizeof(buf));\r
+\r
+ {uuid version 4}\r
+ buf[3] := (buf[3] and $fff) or $4000;\r
+\r
+ {uuid version 4}\r
+ buf[4] := (buf[4] and $3fff) or $8000;\r
+\r
+ result := inttohex(buf[0]) + inttohex(buf[1]) + '-' + inttohex(buf[2]) +'-'+ inttohex(buf[3]) + '-' + inttohex(buf[4])\r
+ + '-' + inttohex(buf[5]) + inttohex(buf[6]) + inttohex(buf[7]);\r
+end;\r
+\r
+{$ifndef nolcorernd}\r
+initialization randomdword := @internalrandomdword;\r
+{$endif}\r
+\r
+end.\r
+\r
lcore.org gitweb / lcore.git / commitdiff