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: 120 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 var\r
 189   systemfunction036:function(var v; c:cardinal): boolean;  stdcall;\r
 190   rtlgenrandominited:boolean;\r
 191 \r
 192 procedure initrtlgenrandom;\r
 193 var\r
 194   h:thandle;\r
 195 begin\r
 196   rtlgenrandominited := true;\r
 197   systemfunction036 := nil;  \r
 198   h := loadlibrary('advapi32.dll');\r
 199   if (h <> 0) then begin\r
 200     systemfunction036 := GetProcAddress(h,'SystemFunction036');\r
 201   end;\r
 202 end;\r
 203 \r
 204 function collect_seeding(var output;const bufsize:integer):integer;\r
 205 var\r
 206   l:packed record\r
 207     rtlgenrandom:array[0..3] of longint;\r
 208     guid:array[0..3] of longint;\r
 209     qpcbuf:array[0..1] of longint;\r
 210     rdtscbuf:array[0..1] of longint;\r
 211     systemtimebuf:array[0..3] of longint;\r
 212     pid:longint;\r
 213     tid:longint;\r
 214     cursor:tpoint;\r
 215     hs:theapstatus;\r
 216   end absolute output;\r
 217 begin\r
 218   result := 0;\r
 219   if (bufsize < sizeof(l)) then exit;\r
 220   result := sizeof(l);\r
 221   {PID}\r
 222   l.pid := GetCurrentProcessId;\r
 223   l.tid := GetCurrentThreadId;\r
 224 \r
 225   {COCREATEGUID}\r
 226   cocreateguid(tguid(l.guid));\r
 227 \r
 228   {QUERYPERFORMANCECOUNTER}\r
 229   queryperformancecounter(tlargeinteger(l.qpcbuf));\r
 230 \r
 231   {RDTSC}\r
 232   rdtsc(@l.rdtscbuf);\r
 233 \r
 234   {GETSYSTEMTIME}\r
 235   getsystemtime(tsystemtime(l.systemtimebuf));\r
 236 \r
 237   {cursor position}\r
 238   getcursorpos(l.cursor);\r
 239 \r
 240   l.hs := getheapstatus;\r
 241 \r
 242   {rtlgenrandom}\r
 243   if not rtlgenrandominited then initrtlgenrandom;\r
 244   if assigned(@systemfunction036) then systemfunction036(l.rtlgenrandom,sizeof(l.rtlgenrandom));\r
 245 end;\r
 246 {$endif}\r
 247 \r
 248 {$ifdef unix}\r
 249 \r
 250 var\r
 251   wtmpinited:boolean;\r
 252   wtmpcached:hashtype;\r
 253 \r
 254 procedure wtmphash;\r
 255 var\r
 256   f:file;\r
 257   buf:array[0..4095] of byte;\r
 258   numread:integer;\r
 259   state:tmd5state;\r
 260 begin\r
 261   if wtmpinited then exit;\r
 262 \r
 263   assignfile(f,'/var/log/wtmp');\r
 264   filemode := 0;\r
 265   {$i-}reset(f,1);{$i+}\r
 266   if (ioresult <> 0) then exit;\r
 267   md5init(state);\r
 268   while not eof(f) do begin\r
 269     blockread(f,buf,sizeof(buf),numread);\r
 270     md5process(state,buf,numread);\r
 271   end;\r
 272   closefile(f);\r
 273   md5finish(state,wtmpcached);\r
 274   wtmpinited := true;\r
 275 end;\r
 276 \r
 277 \r
 278 function collect_seeding(var output;const bufsize:integer):integer;\r
 279 var\r
 280   f:file;\r
 281   a:integer;\r
 282   l:packed record\r
 283     devrnd:array[0..7] of integer;\r
 284     rdtscbuf:array[0..1] of integer;\r
 285     tv:ttimeval;\r
 286     pid:integer;\r
 287   end absolute output;\r
 288 \r
 289 begin\r
 290   result := 0;\r
 291   if (bufsize < sizeof(l)) then exit;\r
 292   result := sizeof(l);\r
 293 \r
 294   {/DEV/URANDOM}\r
 295   a := 1;\r
 296   assignfile(f,'/dev/urandom');\r
 297   filemode := 0;\r
 298   {$i-}reset(f,1);{$i+}\r
 299   a := ioresult;\r
 300   if (a <> 0) then begin\r
 301     assignfile(f,'/dev/random');\r
 302     {$i-}reset(f,1);{$i+}\r
 303     a := ioresult;\r
 304   end;\r
 305   if (a = 0) then begin\r
 306     blockread(f,l.devrnd,sizeof(l.devrnd));\r
 307     closefile(f);\r
 308   end else begin\r
 309     {the OS we are on has no /dev/random or /dev/urandom, get a hash from /var/log/wtmp}\r
 310     wtmphash;\r
 311     move(wtmpcached,l.devrnd,sizeof(l.devrnd));\r
 312   end;\r
 313   {get more randomness in case there's no /dev/random}\r
 314   rdtsc(@l.rdtscbuf);\r
 315 \r
 316   gettimeofday(l.tv);\r
 317   l.pid := getpid;\r
 318 end;\r
 319 {$endif}\r
 320 \r
 321 {this produces a hash which is twice the native hash size (32 bytes for MD5)}\r
 322 procedure bighash(const input;len:integer;var output);\r
 323 var\r
 324   inarr:array[0..65535] of byte absolute input;\r
 325   outarr:array[0..65535] of byte absolute output;\r
 326 \r
 327   h1,h2,h3,h4:hashtype;\r
 328   a:integer;\r
 329 begin\r
 330   a := len div 2;\r
 331   {first hash round}\r
 332   getmd5(inarr[0],a,h1);\r
 333   getmd5(inarr[a],len-a,h2);\r
 334 \r
 335   move(h1[0],h3[0],halfhashsize);\r
 336   move(h2[0],h3[halfhashsize],halfhashsize);\r
 337   move(h1[halfhashsize],h4[0],halfhashsize);\r
 338   move(h2[halfhashsize],h4[halfhashsize],halfhashsize);\r
 339 \r
 340   getmd5(h3,hashsize,outarr[0]);\r
 341   getmd5(h4,hashsize,outarr[hashsize]);\r
 342 end;\r
 343 \r
 344 procedure seedpool;\r
 345 var\r
 346   a:integer;\r
 347 begin\r
 348   a := collect_seeding(pool[pooldwords],seeddwords*wordsize);\r
 349   if (a = 0) then halt;\r
 350   bighash(pool[hashdwords],(2*hashsize)+a,pool[hashdwords]);\r
 351   getmd5(pool[0],hashpasssize,pool[0]);\r
 352 end;\r
 353 \r
 354 function internalrandomdword;\r
 355 begin\r
 356   if (reseedcountdown <= 0) then begin\r
 357     seedpool;\r
 358     reseedcountdown := reseedinterval * hashdwords;\r
 359   end else if ((reseedcountdown mod hashdwords) = 0) then begin;\r
 360     getmd5(pool[0],hashpasssize,pool[0]);\r
 361   end;\r
 362   dec(reseedcountdown);\r
 363 \r
 364   result := pool[reseedcountdown mod hashdwords];\r
 365 end;\r
 366 {$endif}\r
 367 \r
 368 procedure fillrandom(var buf;length:integer);\r
 369 var\r
 370   a,b:integer;\r
 371   buf_:array[0..16383] of uint32 absolute buf;\r
 372 \r
 373 begin\r
 374   b := 0;\r
 375   for a := (length shr wordsizeshift)-1 downto 0 do begin\r
 376     buf_[b] := randomdword;\r
 377     inc(b);\r
 378   end;\r
 379   length := length and (wordsize-1);\r
 380   if length <> 0 then begin\r
 381     a := randomdword;\r
 382     move(a,buf_[b],length);\r
 383   end;\r
 384 end;\r
 385 \r
 386 const\r
 387   wordsizebits=32;\r
 388 \r
 389 function randombits(b:integer):longint;\r
 390 begin\r
 391   result := randomdword;\r
 392   result := result and (-1 shr (wordsizebits-b));\r
 393   if (b = 0) then result := 0;\r
 394 end;\r
 395 \r
 396 function randominteger(i:longint):longint;\r
 397 var\r
 398   a,b:integer;\r
 399   j:integer;\r
 400 begin\r
 401   //bitscounter := bitscounter + numofbitsininteger(i);\r
 402   if (i = 0) then begin\r
 403     result := 0;\r
 404     exit;\r
 405   end;\r
 406   {find number of bits needed}\r
 407   j := i-1;\r
 408   if (j < 0) then begin\r
 409     result := randombits(wordsizebits);\r
 410     exit\r
 411   end else if (j >= (1 shl (wordsizebits-2))) then begin\r
 412     b := wordsizebits-1\r
 413   end else begin\r
 414     b := -1;\r
 415     for a := 0 to (wordsizebits-2) do begin\r
 416       if j < 1 shl a then begin\r
 417         b := a;\r
 418         break;\r
 419       end;\r
 420     end;\r
 421   end;\r
 422   repeat\r
 423     result := randombits(b);\r
 424   until result < i;\r
 425 end;\r
 426 \r
 427 const\r
 428   ch:array[0..15] of ansichar='0123456789abcdef';\r
 429 \r
 430 function generate_uuid:ansistring;\r
 431 var\r
 432   buf:array[0..7] of word;\r
 433 function inttohex(w:word):ansistring;\r
 434 begin\r
 435   result := ch[w shr 12] + ch[(w shr 8) and $f] + ch[(w shr 4) and $f] + ch[w and $f];\r
 436 end;\r
 437 begin\r
 438   fillrandom(buf,sizeof(buf));\r
 439 \r
 440   {uuid version 4}\r
 441   buf[3] := (buf[3] and $fff) or $4000;\r
 442 \r
 443   {uuid version 4}\r
 444   buf[4] := (buf[4] and $3fff) or $8000;\r
 445 \r
 446   result := inttohex(buf[0]) + inttohex(buf[1]) + '-' + inttohex(buf[2]) +'-'+ inttohex(buf[3]) + '-' + inttohex(buf[4])\r
 447   + '-' + inttohex(buf[5]) + inttohex(buf[6]) + inttohex(buf[7]);\r
 448 end;\r
 449 \r
 450 {$ifndef nolcorernd}\r
 451 initialization randomdword := @internalrandomdword;\r
 452 {$endif}\r
 453 \r
 454 end.\r
 455 \r