X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/f0a6e6591b3d306641b78dfed4a4066935e82096..8bc22a17b97149d69fd377f5e9f5ed617a4385db:/lcorernd.pas

diff --git a/lcorernd.pas b/lcorernd.pas
index 8f79856..b435305 100644
--- a/lcorernd.pas
+++ b/lcorernd.pas
@@ -4,7 +4,9 @@
   ----------------------------------------------------------------------------- }
 
 unit lcorernd;
-
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
 interface
 
 {$include lcoreconfig.inc}
@@ -15,7 +17,7 @@ written by Bas Steendijk (beware)
 the aim of this unit is to provide randomness in a consistent way, using OS specific methods for seeding
 
 this unit uses MD5 for performance and code size, but it is made so it is easy to use a different hash,
-as long as it is atleat 128 bits, and a multiple of the "word size" (32 bits)
+as long as it is at least 128 bits, and a multiple of the "word size" (32 bits)
 
 goals:
 
@@ -25,20 +27,20 @@ goals:
 
 - for the numbers to be
  - random: pass diehard and similar tests
- - unique: generate UUID's
+ - unique: generate UUIDs
  - secure: difficult for a remote attacker to guess the internal state, even
    when given some output
 
 typical intended uses:
  - anything that needs random numbers without extreme demands on security or
    speed should be able to use this
- - seeding other (faster) RNG's
- - generation of passwords, UUID's, cookies, and session keys
+ - seeding other (faster) RNGs
+ - generation of passwords, UUIDs, cookies, and session keys
  - randomizing protocol fields to protect against spoofing attacks
  - randomness for games
 
 this is not intended to be directly used for:
-- high securirity purposes (generating RSA root keys etc)
+- high security purposes (generating RSA root keys etc)
 - needing random numbers at very high rates (disk wiping, some simulations, etc)
 
 performance:
@@ -143,6 +145,13 @@ uses
     {$endif}
   {$endif}
   fastmd5,sysutils;
+{$endif}
+
+const
+  wordsizeshift=2;
+  wordsize=1 shl wordsizeshift;
+
+{$ifndef nolcorernd}
 
 {$ifdef unix}{$include unixstuff.inc}{$endif}
 
@@ -168,26 +177,41 @@ type
   hashtype=tmd5;
 
 const
-  wordsizeshift=2;
-  wordsize=1 shl wordsizeshift;
   //wordsize check commented out for d3 compatibility
   //{ $if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{ $ifend}
   hashsize=sizeof(hashtype);
   halfhashsize=hashsize div 2;
   hashdwords=hashsize div wordsize;
   pooldwords=3*hashdwords;
-  seeddwords=32;
+  seeddwords=40;
   hashpasssize=48; {this number has to be small enough that hashing this size uses only one block transform}
 
 var
-  {the seed part of this buffer must be atleast as big as the OS seed (windows: 104 bytes, unix: 36 bytes)}
+  //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)
   pool:array[0..(pooldwords+seeddwords-1)] of wordtype;
   reseedcountdown:integer;
 
 {$ifdef mswindows}
+var
+  systemfunction036:function(var v; c:cardinal): boolean;  stdcall;
+  rtlgenrandominited:boolean;
+
+procedure initrtlgenrandom;
+var
+  h:thandle;
+begin
+  rtlgenrandominited := true;
+  systemfunction036 := nil;  
+  h := loadlibrary('advapi32.dll');
+  if (h <> 0) then begin
+    systemfunction036 := GetProcAddress(h,'SystemFunction036');
+  end;
+end;
+
 function collect_seeding(var output;const bufsize:integer):integer;
 var
   l:packed record
+    rtlgenrandom:array[0..3] of longint;
     guid:array[0..3] of longint;
     qpcbuf:array[0..1] of longint;
     rdtscbuf:array[0..1] of longint;
@@ -221,6 +245,10 @@ begin
   getcursorpos(l.cursor);
 
   l.hs := getheapstatus;
+
+  {rtlgenrandom}
+  if not rtlgenrandominited then initrtlgenrandom;
+  if assigned(@systemfunction036) then systemfunction036(l.rtlgenrandom,sizeof(l.rtlgenrandom));
 end;
 {$endif}