X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/9763940f8849e5c807566157829a1e6d2c9172ee..69598fec083b67c8567293c7b8a397b64175bd45:/lcorernd.pas?ds=sidebyside

diff --git a/lcorernd.pas b/lcorernd.pas
index 7dbd7f1..b7a3bf2 100644
--- a/lcorernd.pas
+++ b/lcorernd.pas
@@ -4,7 +4,9 @@
   ----------------------------------------------------------------------------- }
 
 unit lcorernd;
-
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
 interface
 
 {$include lcoreconfig.inc}
@@ -142,7 +144,17 @@ uses
       baseunix,unix,unixutil,sockets,
     {$endif}
   {$endif}
+  {$ifdef linux}
+  syscall,
+  {$endif}
   fastmd5,sysutils;
+{$endif}
+
+const
+  wordsizeshift=2;
+  wordsize=1 shl wordsizeshift;
+
+{$ifndef nolcorernd}
 
 {$ifdef unix}{$include unixstuff.inc}{$endif}
 
@@ -168,26 +180,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 at least 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 +248,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}
 
@@ -254,6 +285,17 @@ begin
 end;
 
 
+{$ifdef linux}
+ {$ifdef i386}
+  const sys_getrandom = 355;
+ {$endif}
+
+ {$ifdef cpux64}
+  const sys_getrandom = 318;
+ {$endif}
+{$endif}
+
+
 function collect_seeding(var output;const bufsize:integer):integer;
 var
   f:file;
@@ -270,24 +312,30 @@ begin
   if (bufsize < sizeof(l)) then exit;
   result := sizeof(l);
 
-  {/DEV/URANDOM}
-  a := 1;
-  assignfile(f,'/dev/urandom');
-  filemode := 0;
-  {$i-}reset(f,1);{$i+}
-  a := ioresult;
-  if (a <> 0) then begin
-    assignfile(f,'/dev/random');
+  a := -1;
+  {$ifdef linux}
+  a := do_syscall(sys_getrandom,tsysparam(@l.devrnd),sizeof(l.devrnd),0);
+  {$endif}
+
+  if (a < sizeof(l.devrnd)) then begin
+    {if syscall misses or fails, fall back to /dev/urandom}
+    assignfile(f,'/dev/urandom');
+    filemode := 0;
     {$i-}reset(f,1);{$i+}
     a := ioresult;
-  end;
-  if (a = 0) then begin
-    blockread(f,l.devrnd,sizeof(l.devrnd));
-    closefile(f);
-  end else begin
-    {the OS we are on has no /dev/random or /dev/urandom, get a hash from /var/log/wtmp}
-    wtmphash;
-    move(wtmpcached,l.devrnd,sizeof(l.devrnd));
+    if (a <> 0) then begin
+      assignfile(f,'/dev/random');
+      {$i-}reset(f,1);{$i+}
+      a := ioresult;
+    end;
+    if (a = 0) then begin
+      blockread(f,l.devrnd,sizeof(l.devrnd));
+      closefile(f);
+    end else begin
+      {the OS we are on has no /dev/random or /dev/urandom, get a hash from /var/log/wtmp}
+      wtmphash;
+      move(wtmpcached,l.devrnd,sizeof(l.devrnd));
+    end;
   end;
   {get more randomness in case there's no /dev/random}
   rdtsc(@l.rdtscbuf);