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 linux}\r
 289  {$ifdef i386}\r
 290   const sys_getrandom = 355;\r
 291  {$endif}\r
 292 \r
 293  {$ifdef cpux64}\r
 294   const sys_getrandom = 318;\r
 295  {$endif}\r
 296 {$endif}\r
 297 \r
 298 \r
 299 function collect_seeding(var output;const bufsize:integer):integer;\r
 300 var\r
 301   f:file;\r
 302   a:integer;\r
 303   l:packed record\r
 304     devrnd:array[0..7] of integer;\r
 305     rdtscbuf:array[0..1] of integer;\r
 306     tv:ttimeval;\r
 307     pid:integer;\r
 308   end absolute output;\r
 309 \r
 310 begin\r
 311   result := 0;\r
 312   if (bufsize < sizeof(l)) then exit;\r
 313   result := sizeof(l);\r
 314 \r
 315   a := -1;\r
 316   {$ifdef linux}\r
 317   a := do_syscall(sys_getrandom,tsysparam(@l.devrnd),sizeof(l.devrnd),0);\r
 318   {$endif}\r
 319 \r
 320   if (a < sizeof(l.devrnd)) then begin\r
 321     {if syscall misses or fails, fall back to /dev/urandom}\r
 322     assignfile(f,'/dev/urandom');\r
 323     filemode := 0;\r
 324     {$i-}reset(f,1);{$i+}\r
 325     a := ioresult;\r
 326     if (a <> 0) then begin\r
 327       assignfile(f,'/dev/random');\r
 328       {$i-}reset(f,1);{$i+}\r
 329       a := ioresult;\r
 330     end;\r
 331     if (a = 0) then begin\r
 332       blockread(f,l.devrnd,sizeof(l.devrnd));\r
 333       closefile(f);\r
 334     end else begin\r
 335       {the OS we are on has no /dev/random or /dev/urandom, get a hash from /var/log/wtmp}\r
 336       wtmphash;\r
 337       move(wtmpcached,l.devrnd,sizeof(l.devrnd));\r
 338     end;\r
 339   end;\r
 340   {get more randomness in case there's no /dev/random}\r
 341   rdtsc(@l.rdtscbuf);\r
 342 \r
 343   gettimeofday(l.tv);\r
 344   l.pid := getpid;\r
 345 end;\r
 346 {$endif}\r
 347 \r
 348 {this produces a hash which is twice the native hash size (32 bytes for MD5)}\r
 349 procedure bighash(const input;len:integer;var output);\r
 350 var\r
 351   inarr:array[0..65535] of byte absolute input;\r
 352   outarr:array[0..65535] of byte absolute output;\r
 353 \r
 354   h1,h2,h3,h4:hashtype;\r
 355   a:integer;\r
 356 begin\r
 357   a := len div 2;\r
 358   {first hash round}\r
 359   getmd5(inarr[0],a,h1);\r
 360   getmd5(inarr[a],len-a,h2);\r
 361 \r
 362   move(h1[0],h3[0],halfhashsize);\r
 363   move(h2[0],h3[halfhashsize],halfhashsize);\r
 364   move(h1[halfhashsize],h4[0],halfhashsize);\r
 365   move(h2[halfhashsize],h4[halfhashsize],halfhashsize);\r
 366 \r
 367   getmd5(h3,hashsize,outarr[0]);\r
 368   getmd5(h4,hashsize,outarr[hashsize]);\r
 369 end;\r
 370 \r
 371 procedure seedpool;\r
 372 var\r
 373   a:integer;\r
 374 begin\r
 375   a := collect_seeding(pool[pooldwords],seeddwords*wordsize);\r
 376   if (a = 0) then halt;\r
 377   bighash(pool[hashdwords],(2*hashsize)+a,pool[hashdwords]);\r
 378   getmd5(pool[0],hashpasssize,pool[0]);\r
 379 end;\r
 380 \r
 381 function internalrandomdword;\r
 382 begin\r
 383   if (reseedcountdown <= 0) then begin\r
 384     seedpool;\r
 385     reseedcountdown := reseedinterval * hashdwords;\r
 386   end else if ((reseedcountdown mod hashdwords) = 0) then begin;\r
 387     getmd5(pool[0],hashpasssize,pool[0]);\r
 388   end;\r
 389   dec(reseedcountdown);\r
 390 \r
 391   result := pool[reseedcountdown mod hashdwords];\r
 392 end;\r
 393 {$endif}\r
 394 \r
 395 procedure fillrandom(var buf;length:integer);\r
 396 var\r
 397   a,b:integer;\r
 398   buf_:array[0..16383] of uint32 absolute buf;\r
 399 \r
 400 begin\r
 401   b := 0;\r
 402   for a := (length shr wordsizeshift)-1 downto 0 do begin\r
 403     buf_[b] := randomdword;\r
 404     inc(b);\r
 405   end;\r
 406   length := length and (wordsize-1);\r
 407   if length <> 0 then begin\r
 408     a := randomdword;\r
 409     move(a,buf_[b],length);\r
 410   end;\r
 411 end;\r
 412 \r
 413 const\r
 414   wordsizebits=32;\r
 415 \r
 416 function randombits(b:integer):longint;\r
 417 begin\r
 418   result := randomdword;\r
 419   result := result and (-1 shr (wordsizebits-b));\r
 420   if (b = 0) then result := 0;\r
 421 end;\r
 422 \r
 423 function randominteger(i:longint):longint;\r
 424 var\r
 425   a,b:integer;\r
 426   j:integer;\r
 427 begin\r
 428   //bitscounter := bitscounter + numofbitsininteger(i);\r
 429   if (i = 0) then begin\r
 430     result := 0;\r
 431     exit;\r
 432   end;\r
 433   {find number of bits needed}\r
 434   j := i-1;\r
 435   if (j < 0) then begin\r
 436     result := randombits(wordsizebits);\r
 437     exit\r
 438   end else if (j >= (1 shl (wordsizebits-2))) then begin\r
 439     b := wordsizebits-1\r
 440   end else begin\r
 441     b := -1;\r
 442     for a := 0 to (wordsizebits-2) do begin\r
 443       if j < 1 shl a then begin\r
 444         b := a;\r
 445         break;\r
 446       end;\r
 447     end;\r
 448   end;\r
 449   repeat\r
 450     result := randombits(b);\r
 451   until result < i;\r
 452 end;\r
 453 \r
 454 const\r
 455   ch:array[0..15] of ansichar='0123456789abcdef';\r
 456 \r
 457 function generate_uuid:ansistring;\r
 458 var\r
 459   buf:array[0..7] of word;\r
 460 function inttohex(w:word):ansistring;\r
 461 begin\r
 462   result := ch[w shr 12] + ch[(w shr 8) and $f] + ch[(w shr 4) and $f] + ch[w and $f];\r
 463 end;\r
 464 begin\r
 465   fillrandom(buf,sizeof(buf));\r
 466 \r
 467   {uuid version 4}\r
 468   buf[3] := (buf[3] and $fff) or $4000;\r
 469 \r
 470   {uuid version 4}\r
 471   buf[4] := (buf[4] and $3fff) or $8000;\r
 472 \r
 473   result := inttohex(buf[0]) + inttohex(buf[1]) + '-' + inttohex(buf[2]) +'-'+ inttohex(buf[3]) + '-' + inttohex(buf[4])\r
 474   + '-' + inttohex(buf[5]) + inttohex(buf[6]) + inttohex(buf[7]);\r
 475 end;\r
 476 \r
 477 {$ifndef nolcorernd}\r
 478 initialization randomdword := @internalrandomdword;\r
 479 {$endif}\r
 480 \r
 481 end.\r
 482 \r