lcorernd.pas

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