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