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