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