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