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,types,{$endif}\r
 136   {$ifdef unix}baseunix,unix,unixutil,{$endif}\r
 137   fastmd5,sysutils;\r
 138 \r
 139 {$ifdef unix}{$include unixstuff.inc}{$endif}\r
 140 \r
 141 type\r
 142   {hashtype must be array of bytes}\r
 143   hashtype=tmd5;\r
 144 \r
 145 const\r
 146   wordsizeshift=2;\r
 147   wordsize=1 shl wordsizeshift;\r
 148 \r
 149   {$if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{$ifend}\r
 150 \r
 151   hashsize=sizeof(hashtype);\r
 152   halfhashsize=hashsize div 2;\r
 153   hashdwords=hashsize div wordsize;\r
 154   pooldwords=3*hashdwords;\r
 155   seeddwords=32;\r
 156   hashpasssize=48; {this number has to be small enough that hashing this size uses only one block transform}\r
 157 \r
 158 var\r
 159   {the seed part of this buffer must be atleast as big as the OS seed (windows: 104 bytes, unix: 36 bytes)}\r
 160   pool:array[0..(pooldwords+seeddwords-1)] of wordtype;\r
 161   reseedcountdown:integer;\r
 162 \r
 163 {$ifdef win32}\r
 164 function collect_seeding(var output;const bufsize:integer):integer;\r
 165 var\r
 166   l:packed record\r
 167     guid:array[0..3] of longint;\r
 168     qpcbuf:array[0..1] of longint;\r
 169     rdtscbuf:array[0..1] of longint;\r
 170     systemtimebuf:array[0..3] of longint;\r
 171     pid:longint;\r
 172     tid:longint;\r
 173     cursor:tpoint;\r
 174     hs:theapstatus;\r
 175   end absolute output;\r
 176   rdtsc_0,rdtsc_1:integer;\r
 177 begin\r
 178   result := 0;\r
 179   if (bufsize < sizeof(l)) then exit;\r
 180   result := sizeof(l);\r
 181   {PID}\r
 182   l.pid := GetCurrentProcessId;\r
 183   l.tid := GetCurrentThreadId;\r
 184 \r
 185   {COCREATEGUID}\r
 186   cocreateguid(tguid(l.guid));\r
 187 \r
 188   {QUERYPERFORMANCECOUNTER}\r
 189   queryperformancecounter(tlargeinteger(l.qpcbuf));\r
 190 \r
 191   {RDTSC}\r
 192   {$ifdef cpu386}\r
 193   asm\r
 194     db $0F; db $31\r
 195     mov rdtsc_0,eax\r
 196     mov rdtsc_1,edx\r
 197   end;\r
 198   l.rdtscbuf[0] := rdtsc_0;\r
 199   l.rdtscbuf[1] := rdtsc_1;\r
 200   {$endif}\r
 201   {GETSYSTEMTIME}\r
 202   getsystemtime(tsystemtime(l.systemtimebuf));\r
 203 \r
 204   {cursor position}\r
 205   getcursorpos(l.cursor);\r
 206 \r
 207   l.hs := getheapstatus;\r
 208 end;\r
 209 {$endif}\r
 210 \r
 211 {$ifdef unix}\r
 212 \r
 213 var\r
 214   wtmpinited:boolean;\r
 215   wtmpcached:hashtype;\r
 216 \r
 217 procedure wtmphash;\r
 218 var\r
 219   f:file;\r
 220   buf:array[0..4095] of byte;\r
 221   numread:integer;\r
 222   state:tmd5state;\r
 223 begin\r
 224   if wtmpinited then exit;\r
 225 \r
 226   assignfile(f,'/var/log/wtmp');\r
 227   filemode := 0;\r
 228   {$i-}reset(f,1);{$i+}\r
 229   if (ioresult <> 0) then exit;\r
 230   md5init(state);\r
 231   while not eof(f) do begin\r
 232     blockread(f,buf,sizeof(buf),numread);\r
 233     md5process(state,buf,numread);\r
 234   end;\r
 235   closefile(f);\r
 236   md5finish(state,wtmpcached);\r
 237   wtmpinited := true;\r
 238 end;\r
 239 \r
 240 \r
 241 function collect_seeding(var output;const bufsize:integer):integer;\r
 242 var\r
 243   f:file;\r
 244   a:integer;\r
 245   l:packed record\r
 246     devrnd:array[0..3] of integer;\r
 247     rdtscbuf:array[0..1] of integer;\r
 248     tv:ttimeval;\r
 249     pid:integer;\r
 250   end absolute output;\r
 251   rdtsc_0,rdtsc_1:integer;\r
 252 \r
 253 begin\r
 254   result := 0;\r
 255   if (bufsize < sizeof(l)) then exit;\r
 256   result := sizeof(l);\r
 257 \r
 258   {/DEV/URANDOM}\r
 259   a := 1;\r
 260   assignfile(f,'/dev/urandom');\r
 261   filemode := 0;\r
 262   {$i-}reset(f,1);{$i+}\r
 263   a := ioresult;\r
 264   if (a <> 0) then begin\r
 265     assignfile(f,'/dev/random');\r
 266     {$i-}reset(f,1);{$i+}\r
 267     a := ioresult;\r
 268   end;\r
 269   if (a = 0) then begin\r
 270     blockread(f,l.devrnd,sizeof(l.devrnd));\r
 271     closefile(f);\r
 272   end else begin\r
 273     {the OS we are on has no /dev/random or /dev/urandom, get a hash from /var/log/wtmp}\r
 274     wtmphash;\r
 275     move(wtmpcached,l.devrnd,sizeof(l.devrnd));\r
 276   end;\r
 277   {get more randomness in case there's no /dev/random}\r
 278   {$ifdef cpu386}{$ASMMODE intel}\r
 279   asm\r
 280     db $0F; db $31\r
 281     mov rdtsc_0,eax\r
 282     mov rdtsc_1,edx\r
 283   end;\r
 284   l.rdtscbuf[0] := rdtsc_0;\r
 285   l.rdtscbuf[1] := rdtsc_1;\r
 286   {$endif}\r
 287 \r
 288   gettimeofday(l.tv);\r
 289   l.pid := getpid;\r
 290 end;\r
 291 {$endif}\r
 292 \r
 293 {this produces a hash which is twice the native hash size (32 bytes for MD5)}\r
 294 procedure bighash(const input;len:integer;var output);\r
 295 var\r
 296   inarr:array[0..65535] of byte absolute input;\r
 297   outarr:array[0..65535] of byte absolute output;\r
 298 \r
 299   h1,h2,h3,h4:hashtype;\r
 300   a:integer;\r
 301 begin\r
 302   a := len div 2;\r
 303   {first hash round}\r
 304   getmd5(inarr[0],a,h1);\r
 305   getmd5(inarr[a],len-a,h2);\r
 306 \r
 307   move(h1[0],h3[0],halfhashsize);\r
 308   move(h2[0],h3[halfhashsize],halfhashsize);\r
 309   move(h1[halfhashsize],h4[0],halfhashsize);\r
 310   move(h2[halfhashsize],h4[halfhashsize],halfhashsize);\r
 311 \r
 312   getmd5(h3,hashsize,outarr[0]);\r
 313   getmd5(h4,hashsize,outarr[hashsize]);\r
 314 end;\r
 315 \r
 316 procedure seedpool;\r
 317 var\r
 318   a:integer;\r
 319 begin\r
 320   a := collect_seeding(pool[pooldwords],seeddwords*wordsize);\r
 321   if (a = 0) then halt;\r
 322   bighash(pool[hashdwords],(2*hashsize)+a,pool[hashdwords]);\r
 323   getmd5(pool[0],hashpasssize,pool[0]);\r
 324 end;\r
 325 \r
 326 function internalrandomdword;\r
 327 begin\r
 328   if (reseedcountdown <= 0) then begin\r
 329     seedpool;\r
 330     reseedcountdown := reseedinterval * hashdwords;\r
 331   end else if ((reseedcountdown mod hashdwords) = 0) then begin;\r
 332     getmd5(pool[0],hashpasssize,pool[0]);\r
 333   end;\r
 334   dec(reseedcountdown);\r
 335 \r
 336   result := pool[reseedcountdown mod hashdwords];\r
 337 end;\r
 338 {$endif}\r
 339 \r
 340 procedure fillrandom(var buf;length:integer);\r
 341 var\r
 342   a,b:integer;\r
 343   buf_:array[0..16383] of uint32 absolute buf;\r
 344 \r
 345 begin\r
 346   b := 0;\r
 347   for a := (length shr wordsizeshift)-1 downto 0 do begin\r
 348     buf_[b] := randomdword;\r
 349     inc(b);\r
 350   end;\r
 351   length := length and (wordsize-1);\r
 352   if length <> 0 then begin\r
 353     a := randomdword;\r
 354     move(a,buf_[b],length);\r
 355   end;\r
 356 end;\r
 357 \r
 358 const\r
 359   wordsizebits=32;\r
 360 \r
 361 function randombits(b:integer):longint;\r
 362 begin\r
 363   result := randomdword;\r
 364   result := result and (-1 shr (wordsizebits-b));\r
 365   if (b = 0) then result := 0;\r
 366 end;\r
 367 \r
 368 function randominteger(i:longint):longint;\r
 369 var\r
 370   a,b:integer;\r
 371   j:integer;\r
 372 begin\r
 373   //bitscounter := bitscounter + numofbitsininteger(i);\r
 374   if (i = 0) then begin\r
 375     result := 0;\r
 376     exit;\r
 377   end;\r
 378   {find number of bits needed}\r
 379   j := i-1;\r
 380   if (j < 0) then begin\r
 381     result := randombits(wordsizebits);\r
 382     exit\r
 383   end else if (j >= (1 shl (wordsizebits-2))) then begin\r
 384     b := wordsizebits-1\r
 385   end else begin\r
 386     b := -1;\r
 387     for a := 0 to (wordsizebits-2) do begin\r
 388       if j < 1 shl a then begin\r
 389         b := a;\r
 390         break;\r
 391       end;\r
 392     end;\r
 393   end;\r
 394   repeat\r
 395     result := randombits(b);\r
 396   until result < i;\r
 397 end;\r
 398 \r
 399 const\r
 400   ch:array[0..15] of char='0123456789abcdef';\r
 401 \r
 402 function generate_uuid:string;\r
 403 var\r
 404   buf:array[0..7] of word;\r
 405 function inttohex(w:word):string;\r
 406 begin\r
 407   result := ch[w shr 12] + ch[(w shr 8) and $f] + ch[(w shr 4) and $f] + ch[w and $f];\r
 408 end;\r
 409 begin\r
 410   fillrandom(buf,sizeof(buf));\r
 411 \r
 412   {uuid version 4}\r
 413   buf[3] := (buf[3] and $fff) or $4000;\r
 414 \r
 415   {uuid version 4}\r
 416   buf[4] := (buf[4] and $3fff) or $8000;\r
 417 \r
 418   result := inttohex(buf[0]) + inttohex(buf[1]) + '-' + inttohex(buf[2]) +'-'+ inttohex(buf[3]) + '-' + inttohex(buf[4])\r
 419   + '-' + inttohex(buf[5]) + inttohex(buf[6]) + inttohex(buf[7]);\r
 420 end;\r
 421 \r
 422 {$ifndef nolcorernd}\r
 423 initialization randomdword := @internalrandomdword;\r
 424 {$endif}\r
 425 \r
 426 end.\r
 427 \r