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