getting v4 local IPs was not working on 64 bits unix

[lcore.git] / lcorernd.pas

diff --git a/lcorernd.pas b/lcorernd.pas
index 643de3ad3a74848409756e0f33590b02da53699c..b7a3bf21dd35a320b04e97fa611e84d9a4a655d6 100644 (file)
--- a/lcorernd.pas
+++ b/lcorernd.pas
@@ -4,7 +4,9 @@
   ----------------------------------------------------------------------------- }\r
 \r
 unit lcorernd;\r
   ----------------------------------------------------------------------------- }\r
 \r
 unit lcorernd;\r

-\r
+{$ifdef fpc}\r
+  {$mode delphi}\r
+{$endif}\r

 interface\r
 \r
 {$include lcoreconfig.inc}\r
 interface\r
 \r
 {$include lcoreconfig.inc}\r


@@ -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\r
 \r
 this unit uses MD5 for performance and code size, but it is made so it is easy to use a different hash,\r
 the aim of this unit is to provide randomness in a consistent way, using OS specific methods for seeding\r
 \r
 this unit uses MD5 for performance and code size, but it is made so it is easy to use a different hash,\r

-as long as it is atleat 128 bits, and a multiple of the "word size" (32 bits)\r
+as long as it is at least 128 bits, and a multiple of the "word size" (32 bits)\r

 \r
 goals:\r
 \r
 \r
 goals:\r
 \r


@@ -25,20 +27,20 @@ goals:
 \r
 - for the numbers to be\r
  - random: pass diehard and similar tests\r
 \r
 - for the numbers to be\r
  - random: pass diehard and similar tests\r

- - unique: generate UUID's\r
+ - unique: generate UUIDs\r

  - secure: difficult for a remote attacker to guess the internal state, even\r
    when given some output\r
 \r
 typical intended uses:\r
  - anything that needs random numbers without extreme demands on security or\r
    speed should be able to use this\r
  - secure: difficult for a remote attacker to guess the internal state, even\r
    when given some output\r
 \r
 typical intended uses:\r
  - anything that needs random numbers without extreme demands on security or\r
    speed should be able to use this\r

- - seeding other (faster) RNG's\r
- - generation of passwords, UUID's, cookies, and session keys\r
+ - seeding other (faster) RNGs\r
+ - generation of passwords, UUIDs, cookies, and session keys\r

  - randomizing protocol fields to protect against spoofing attacks\r
  - randomness for games\r
 \r
 this is not intended to be directly used for:\r
  - randomizing protocol fields to protect against spoofing attacks\r
  - randomness for games\r
 \r
 this is not intended to be directly used for:\r

-- high securirity purposes (generating RSA root keys etc)\r
+- high security purposes (generating RSA root keys etc)\r

 - needing random numbers at very high rates (disk wiping, some simulations, etc)\r
 \r
 performance:\r
 - needing random numbers at very high rates (disk wiping, some simulations, etc)\r
 \r
 performance:\r


@@ -111,7 +113,7 @@ function randominteger(i:longint):longint;
 function randombits(b:integer):longint;\r
 \r
 {generate a version 4 random uuid}\r
 function randombits(b:integer):longint;\r
 \r
 {generate a version 4 random uuid}\r

-function generate_uuid:string;\r
+function generate_uuid:ansistring;\r

 \r
 {$ifndef nolcorernd}\r
 \r
 \r
 {$ifndef nolcorernd}\r
 \r


@@ -130,39 +132,89 @@ var
 \r
 implementation\r
 \r
 \r
 implementation\r
 \r

+{$include pgtypes.inc}\r
+\r

 {$ifndef nolcorernd}\r
 uses\r
 {$ifndef nolcorernd}\r
 uses\r

-  {$ifdef win32}windows,activex,{$endif}\r
-  {$ifdef unix}baseunix,unix,unixutil,{$endif}\r
+  {$ifdef mswindows}windows,activex,{$endif}\r
+  {$ifdef unix}\r
+    {$ifdef ver1_0}\r
+      linux,\r
+    {$else}\r
+      baseunix,unix,unixutil,sockets,\r
+    {$endif}\r
+  {$endif}\r
+  {$ifdef linux}\r
+  syscall,\r
+  {$endif}\r

   fastmd5,sysutils;\r
   fastmd5,sysutils;\r

+{$endif}\r
+\r
+const\r
+  wordsizeshift=2;\r
+  wordsize=1 shl wordsizeshift;\r
+\r
+{$ifndef nolcorernd}\r

 \r
 {$ifdef unix}{$include unixstuff.inc}{$endif}\r
 \r
 \r
 {$ifdef unix}{$include unixstuff.inc}{$endif}\r
 \r

+procedure rdtsc(buf: pointer);\r
+asm\r
+  {$ifdef cpux86}\r
+  mov ecx, buf\r
+  db $0f; db $31 {rdtsc}\r
+  mov [ecx], edx\r
+  mov [ecx+4], eax\r
+  {$endif}\r
+\r
+  {$ifdef cpux64}\r
+  mov rcx, buf\r
+  rdtsc\r
+  mov [rcx], edx\r
+  mov [rcx+4], eax\r
+  {$endif}\r
+end;\r
+\r

 type\r
   {hashtype must be array of bytes}\r
   hashtype=tmd5;\r
 \r
 const\r
 type\r
   {hashtype must be array of bytes}\r
   hashtype=tmd5;\r
 \r
 const\r

-  wordsizeshift=2;\r
-  wordsize=1 shl wordsizeshift;\r

   //wordsize check commented out for d3 compatibility\r
   //{ $if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{ $ifend}\r
   hashsize=sizeof(hashtype);\r
   halfhashsize=hashsize div 2;\r
   hashdwords=hashsize div wordsize;\r
   pooldwords=3*hashdwords;\r
   //wordsize check commented out for d3 compatibility\r
   //{ $if (wordsize <> sizeof(wordtype))}'wordsizeshift must be setcorrectly'{ $ifend}\r
   hashsize=sizeof(hashtype);\r
   halfhashsize=hashsize div 2;\r
   hashdwords=hashsize div wordsize;\r
   pooldwords=3*hashdwords;\r

-  seeddwords=32;\r
+  seeddwords=40;\r

   hashpasssize=48; {this number has to be small enough that hashing this size uses only one block transform}\r
 \r
 var\r
   hashpasssize=48; {this number has to be small enough that hashing this size uses only one block transform}\r
 \r
 var\r

-  {the seed part of this buffer must be atleast as big as the OS seed (windows: 104 bytes, unix: 36 bytes)}\r
+  //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

   pool:array[0..(pooldwords+seeddwords-1)] of wordtype;\r
   reseedcountdown:integer;\r
 \r
   pool:array[0..(pooldwords+seeddwords-1)] of wordtype;\r
   reseedcountdown:integer;\r
 \r

-{$ifdef win32}\r
+{$ifdef mswindows}\r
+var\r
+  systemfunction036:function(var v; c:cardinal): boolean;  stdcall;\r
+  rtlgenrandominited:boolean;\r
+\r
+procedure initrtlgenrandom;\r
+var\r
+  h:thandle;\r
+begin\r
+  rtlgenrandominited := true;\r
+  systemfunction036 := nil;  \r
+  h := loadlibrary('advapi32.dll');\r
+  if (h <> 0) then begin\r
+    systemfunction036 := GetProcAddress(h,'SystemFunction036');\r
+  end;\r
+end;\r
+\r

 function collect_seeding(var output;const bufsize:integer):integer;\r
 var\r
   l:packed record\r
 function collect_seeding(var output;const bufsize:integer):integer;\r
 var\r
   l:packed record\r

+    rtlgenrandom:array[0..3] of longint;\r

     guid:array[0..3] of longint;\r
     qpcbuf:array[0..1] of longint;\r
     rdtscbuf:array[0..1] of longint;\r
     guid:array[0..3] of longint;\r
     qpcbuf:array[0..1] of longint;\r
     rdtscbuf:array[0..1] of longint;\r


@@ -172,7 +224,6 @@ var
     cursor:tpoint;\r
     hs:theapstatus;\r
   end absolute output;\r
     cursor:tpoint;\r
     hs:theapstatus;\r
   end absolute output;\r

-  rdtsc_0,rdtsc_1:integer;\r

 begin\r
   result := 0;\r
   if (bufsize < sizeof(l)) then exit;\r
 begin\r
   result := 0;\r
   if (bufsize < sizeof(l)) then exit;\r


@@ -188,15 +239,8 @@ begin
   queryperformancecounter(tlargeinteger(l.qpcbuf));\r
 \r
   {RDTSC}\r
   queryperformancecounter(tlargeinteger(l.qpcbuf));\r
 \r
   {RDTSC}\r

-  {$ifdef cpu386}\r
-  asm\r
-    db $0F; db $31\r
-    mov rdtsc_0,eax\r
-    mov rdtsc_1,edx\r
-  end;\r
-  l.rdtscbuf[0] := rdtsc_0;\r
-  l.rdtscbuf[1] := rdtsc_1;\r
-  {$endif}\r
+  rdtsc(@l.rdtscbuf);\r
+\r

   {GETSYSTEMTIME}\r
   getsystemtime(tsystemtime(l.systemtimebuf));\r
 \r
   {GETSYSTEMTIME}\r
   getsystemtime(tsystemtime(l.systemtimebuf));\r
 \r


@@ -204,6 +248,10 @@ begin
   getcursorpos(l.cursor);\r
 \r
   l.hs := getheapstatus;\r
   getcursorpos(l.cursor);\r
 \r
   l.hs := getheapstatus;\r

+\r
+  {rtlgenrandom}\r
+  if not rtlgenrandominited then initrtlgenrandom;\r
+  if assigned(@systemfunction036) then systemfunction036(l.rtlgenrandom,sizeof(l.rtlgenrandom));\r

 end;\r
 {$endif}\r
 \r
 end;\r
 {$endif}\r
 \r


@@ -237,52 +285,60 @@ begin
 end;\r
 \r
 \r
 end;\r
 \r
 \r

+{$ifdef linux}\r
+ {$ifdef i386}\r
+  const sys_getrandom = 355;\r
+ {$endif}\r
+\r
+ {$ifdef cpux64}\r
+  const sys_getrandom = 318;\r
+ {$endif}\r
+{$endif}\r
+\r
+\r

 function collect_seeding(var output;const bufsize:integer):integer;\r
 var\r
   f:file;\r
   a:integer;\r
   l:packed record\r
 function collect_seeding(var output;const bufsize:integer):integer;\r
 var\r
   f:file;\r
   a:integer;\r
   l:packed record\r

-    devrnd:array[0..3] of integer;\r
+    devrnd:array[0..7] of integer;\r

     rdtscbuf:array[0..1] of integer;\r
     tv:ttimeval;\r
     pid:integer;\r
   end absolute output;\r
     rdtscbuf:array[0..1] of integer;\r
     tv:ttimeval;\r
     pid:integer;\r
   end absolute output;\r

-  rdtsc_0,rdtsc_1:integer;\r

 \r
 begin\r
   result := 0;\r
   if (bufsize < sizeof(l)) then exit;\r
   result := sizeof(l);\r
 \r
 \r
 begin\r
   result := 0;\r
   if (bufsize < sizeof(l)) then exit;\r
   result := sizeof(l);\r
 \r

-  {/DEV/URANDOM}\r
-  a := 1;\r
-  assignfile(f,'/dev/urandom');\r
-  filemode := 0;\r
-  {$i-}reset(f,1);{$i+}\r
-  a := ioresult;\r
-  if (a <> 0) then begin\r
-    assignfile(f,'/dev/random');\r
+  a := -1;\r
+  {$ifdef linux}\r
+  a := do_syscall(sys_getrandom,tsysparam(@l.devrnd),sizeof(l.devrnd),0);\r
+  {$endif}\r
+\r
+  if (a < sizeof(l.devrnd)) then begin\r
+    {if syscall misses or fails, fall back to /dev/urandom}\r
+    assignfile(f,'/dev/urandom');\r
+    filemode := 0;\r

     {$i-}reset(f,1);{$i+}\r
     a := ioresult;\r
     {$i-}reset(f,1);{$i+}\r
     a := ioresult;\r

-  end;\r
-  if (a = 0) then begin\r
-    blockread(f,l.devrnd,sizeof(l.devrnd));\r
-    closefile(f);\r
-  end else begin\r
-    {the OS we are on has no /dev/random or /dev/urandom, get a hash from /var/log/wtmp}\r
-    wtmphash;\r
-    move(wtmpcached,l.devrnd,sizeof(l.devrnd));\r
+    if (a <> 0) then begin\r
+      assignfile(f,'/dev/random');\r
+      {$i-}reset(f,1);{$i+}\r
+      a := ioresult;\r
+    end;\r
+    if (a = 0) then begin\r
+      blockread(f,l.devrnd,sizeof(l.devrnd));\r
+      closefile(f);\r
+    end else begin\r
+      {the OS we are on has no /dev/random or /dev/urandom, get a hash from /var/log/wtmp}\r
+      wtmphash;\r
+      move(wtmpcached,l.devrnd,sizeof(l.devrnd));\r
+    end;\r

   end;\r
   {get more randomness in case there's no /dev/random}\r
   end;\r
   {get more randomness in case there's no /dev/random}\r

-  {$ifdef cpu386}{$ASMMODE intel}\r
-  asm\r
-    db $0F; db $31\r
-    mov rdtsc_0,eax\r
-    mov rdtsc_1,edx\r
-  end;\r
-  l.rdtscbuf[0] := rdtsc_0;\r
-  l.rdtscbuf[1] := rdtsc_1;\r
-  {$endif}\r
+  rdtsc(@l.rdtscbuf);\r

 \r
   gettimeofday(l.tv);\r
   l.pid := getpid;\r
 \r
   gettimeofday(l.tv);\r
   l.pid := getpid;\r


@@ -396,12 +452,12 @@ begin
 end;\r
 \r
 const\r
 end;\r
 \r
 const\r

-  ch:array[0..15] of char='0123456789abcdef';\r
+  ch:array[0..15] of ansichar='0123456789abcdef';\r

 \r
 \r

-function generate_uuid:string;\r
+function generate_uuid:ansistring;\r

 var\r
   buf:array[0..7] of word;\r
 var\r
   buf:array[0..7] of word;\r

-function inttohex(w:word):string;\r
+function inttohex(w:word):ansistring;\r

 begin\r
   result := ch[w shr 12] + ch[(w shr 8) and $f] + ch[(w shr 4) and $f] + ch[w and $f];\r
 end;\r
 begin\r
   result := ch[w shr 12] + ch[(w shr 8) and $f] + ch[(w shr 4) and $f] + ch[w and $f];\r
 end;\r