X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/f04d9ac0ffbe96ead372b84dad0786daba7f5ed7..85ef2ce64f0cc31a063fccea69fdcc7281d51548:/lcorernd.pas

diff --git a/lcorernd.pas b/lcorernd.pas
new file mode 100644
index 0000000..006f6ce
--- /dev/null
+++ b/lcorernd.pas
@@ -0,0 +1,427 @@
+{ Copyright (C) 2005 Bas Steendijk and Peter Green
+  For conditions of distribution and use, see copyright notice in zlib_license.txt
+  which is included in the package
+  ----------------------------------------------------------------------------- }
+
+unit lcorernd;
+
+interface
+
+{$include lcoreconfig.inc}
+
+{
+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)
+
+goals:
+
+- for the code to be:
+ - relatively simple and small
+ - reasonably fast
+
+- for the numbers to be
+ - random: pass diehard and similar tests
+ - unique: generate UUID's
+ - 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
+ - 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)
+- needing random numbers at very high rates (disk wiping, some simulations, etc)
+
+performance:
+- 24 MB/s on 2.2 GHz athlon64 core on windows XP 32 bits
+- 6.4 MB/s on 1 GHz p3 on linux
+
+exe size:
+- fpc 2.2, linux: fastmd5: 12 kb; lcorernd: 6 kb.
+- delphi 6: fastmd5: 3 kb; lcorernd: 2 kb
+
+reasoning behind the security of this RNG:
+
+- seeding:
+1: i assume that any attacker has no local access to the machine. if one gained
+  this, then there are more seriousness weaknesses to consider.
+2: i attempt to use enough seeding to be difficult to guess.
+  on windows: GUID, various readouts of hi res timestamps, heap stats, cursor
+  position
+  on *nix: i assume /dev/(u)random output is secure and difficult to guess. if
+  it misses, i use /dev/wtmp, which typically has as lot of entropy in it. i also use hi res timestamps.
+3: on a state compromise, one can easily get up to the hash size worth of previous output, beyond that one has
+  to invert the hash operation.
+
+- mixing/expansion: a secure hash random walk on a buffer with a constant secret and a changing exposed part,
+  the big secret part serves to make it difficult for an attacker to predict next and previous output.
+  the secret part is changed during a reseed.
+
+
+                                       OS randomness
+                                             v
+                              <wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww>
+ ____________________________  ________________________________________________
+[            pool            ][                    seed                        ]
+[hashsize][hashsize][hashsize]
+          <rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr>
+                bighash()             seeding
+                   v
+          <wwwwwwwwwwwwwwwwww>
+<rrrrrrrrrrrrrrrrrrrrrrrrrrrr>
+  hash()                            random walk
+    v
+<wwwwwwww>
+[ output ][      secret      ]
+
+
+this needs testing on platforms other than i386
+
+
+these routines are called by everything else in lcore, and if the app coder desires, by the app.
+because one may want to use their own random number source, the PRNG here can be excluded from linking,
+and the routines here can be hooked.
+}
+
+{$include uint32.inc}
+
+{return a dword with 32 random bits}
+type
+  wordtype=uint32;
+
+var
+  randomdword:function:wordtype;
+
+{fill a buffer with random bytes}
+procedure fillrandom(var buf;length:integer);
+
+{generate an integer of 0 <= N < i}
+function randominteger(i:longint):longint;
+
+{generate an integer with the lowest b bits being random}
+function randombits(b:integer):longint;
+
+{generate a version 4 random uuid}
+function generate_uuid:string;
+
+{$ifndef nolcorernd}
+
+{call this to mix seeding into the pool. is normally done automatically and does not have to be called
+but can be done if one desires more security, for example for key generation}
+procedure seedpool;
+
+{get some raw OS specific randomness. the output is not mixed so it should not be used directly as random numbers}
+function collect_seeding(var output;const bufsize:integer):integer;
+
+function internalrandomdword:wordtype;
+
+var
+  reseedinterval:integer=64;
+{$endif}
+
+implementation
+
+{$ifndef nolcorernd}
+uses
+  {$ifdef win32}windows,activex,types,{$endif}
+  {$ifdef unix}baseunix,unix,unixutil,{$endif}
+  fastmd5,sysutils;
+
+{$ifdef unix}{$include unixstuff.inc}{$endif}
+
+type
+  {hashtype must be array of bytes}
+  hashtype=tmd5;
+
+const
+  wordsizeshift=2;
+  wordsize=1 shl wordsizeshift;
+
+  {$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;
+  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)}
+  pool:array[0..(pooldwords+seeddwords-1)] of wordtype;
+  reseedcountdown:integer;
+
+{$ifdef win32}
+function collect_seeding(var output;const bufsize:integer):integer;
+var
+  l:packed record
+    guid:array[0..3] of longint;
+    qpcbuf:array[0..1] of longint;
+    rdtscbuf:array[0..1] of longint;
+    systemtimebuf:array[0..3] of longint;
+    pid:longint;
+    tid:longint;
+    cursor:tpoint;
+    hs:theapstatus;
+  end absolute output;
+  rdtsc_0,rdtsc_1:integer;
+begin
+  result := 0;
+  if (bufsize < sizeof(l)) then exit;
+  result := sizeof(l);
+  {PID}
+  l.pid := GetCurrentProcessId;
+  l.tid := GetCurrentThreadId;
+
+  {COCREATEGUID}
+  cocreateguid(tguid(l.guid));
+
+  {QUERYPERFORMANCECOUNTER}
+  queryperformancecounter(tlargeinteger(l.qpcbuf));
+
+  {RDTSC}
+  {$ifdef cpu386}
+  asm
+    db $0F; db $31
+    mov rdtsc_0,eax
+    mov rdtsc_1,edx
+  end;
+  l.rdtscbuf[0] := rdtsc_0;
+  l.rdtscbuf[1] := rdtsc_1;
+  {$endif}
+  {GETSYSTEMTIME}
+  getsystemtime(tsystemtime(l.systemtimebuf));
+
+  {cursor position}
+  getcursorpos(l.cursor);
+
+  l.hs := getheapstatus;
+end;
+{$endif}
+
+{$ifdef unix}
+
+var
+  wtmpinited:boolean;
+  wtmpcached:hashtype;
+
+procedure wtmphash;
+var
+  f:file;
+  buf:array[0..4095] of byte;
+  numread:integer;
+  state:tmd5state;
+begin
+  if wtmpinited then exit;
+
+  assignfile(f,'/var/log/wtmp');
+  filemode := 0;
+  {$i-}reset(f,1);{$i+}
+  if (ioresult <> 0) then exit;
+  md5init(state);
+  while not eof(f) do begin
+    blockread(f,buf,sizeof(buf),numread);
+    md5process(state,buf,numread);
+  end;
+  closefile(f);
+  md5finish(state,wtmpcached);
+  wtmpinited := true;
+end;
+
+
+function collect_seeding(var output;const bufsize:integer):integer;
+var
+  f:file;
+  a:integer;
+  l:packed record
+    devrnd:array[0..3] of integer;
+    rdtscbuf:array[0..1] of integer;
+    tv:ttimeval;
+    pid:integer;
+  end absolute output;
+  rdtsc_0,rdtsc_1:integer;
+
+begin
+  result := 0;
+  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');
+    {$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;
+  {get more randomness in case there's no /dev/random}
+  {$ifdef cpu386}{$ASMMODE intel}
+  asm
+    db $0F; db $31
+    mov rdtsc_0,eax
+    mov rdtsc_1,edx
+  end;
+  l.rdtscbuf[0] := rdtsc_0;
+  l.rdtscbuf[1] := rdtsc_1;
+  {$endif}
+
+  gettimeofday(l.tv);
+  l.pid := getpid;
+end;
+{$endif}
+
+{this produces a hash which is twice the native hash size (32 bytes for MD5)}
+procedure bighash(const input;len:integer;var output);
+var
+  inarr:array[0..65535] of byte absolute input;
+  outarr:array[0..65535] of byte absolute output;
+
+  h1,h2,h3,h4:hashtype;
+  a:integer;
+begin
+  a := len div 2;
+  {first hash round}
+  getmd5(inarr[0],a,h1);
+  getmd5(inarr[a],len-a,h2);
+
+  move(h1[0],h3[0],halfhashsize);
+  move(h2[0],h3[halfhashsize],halfhashsize);
+  move(h1[halfhashsize],h4[0],halfhashsize);
+  move(h2[halfhashsize],h4[halfhashsize],halfhashsize);
+
+  getmd5(h3,hashsize,outarr[0]);
+  getmd5(h4,hashsize,outarr[hashsize]);
+end;
+
+procedure seedpool;
+var
+  a:integer;
+begin
+  a := collect_seeding(pool[pooldwords],seeddwords*wordsize);
+  if (a = 0) then halt;
+  bighash(pool[hashdwords],(2*hashsize)+a,pool[hashdwords]);
+  getmd5(pool[0],hashpasssize,pool[0]);
+end;
+
+function internalrandomdword;
+begin
+  if (reseedcountdown <= 0) then begin
+    seedpool;
+    reseedcountdown := reseedinterval * hashdwords;
+  end else if ((reseedcountdown mod hashdwords) = 0) then begin;
+    getmd5(pool[0],hashpasssize,pool[0]);
+  end;
+  dec(reseedcountdown);
+
+  result := pool[reseedcountdown mod hashdwords];
+end;
+{$endif}
+
+procedure fillrandom(var buf;length:integer);
+var
+  a,b:integer;
+  buf_:array[0..16383] of uint32 absolute buf;
+
+begin
+  b := 0;
+  for a := (length shr wordsizeshift)-1 downto 0 do begin
+    buf_[b] := randomdword;
+    inc(b);
+  end;
+  length := length and (wordsize-1);
+  if length <> 0 then begin
+    a := randomdword;
+    move(a,buf_[b],length);
+  end;
+end;
+
+const
+  wordsizebits=32;
+
+function randombits(b:integer):longint;
+begin
+  result := randomdword;
+  result := result and (-1 shr (wordsizebits-b));
+  if (b = 0) then result := 0;
+end;
+
+function randominteger(i:longint):longint;
+var
+  a,b:integer;
+  j:integer;
+begin
+  //bitscounter := bitscounter + numofbitsininteger(i);
+  if (i = 0) then begin
+    result := 0;
+    exit;
+  end;
+  {find number of bits needed}
+  j := i-1;
+  if (j < 0) then begin
+    result := randombits(wordsizebits);
+    exit
+  end else if (j >= (1 shl (wordsizebits-2))) then begin
+    b := wordsizebits-1
+  end else begin
+    b := -1;
+    for a := 0 to (wordsizebits-2) do begin
+      if j < 1 shl a then begin
+        b := a;
+        break;
+      end;
+    end;
+  end;
+  repeat
+    result := randombits(b);
+  until result < i;
+end;
+
+const
+  ch:array[0..15] of char='0123456789abcdef';
+
+function generate_uuid:string;
+var
+  buf:array[0..7] of word;
+function inttohex(w:word):string;
+begin
+  result := ch[w shr 12] + ch[(w shr 8) and $f] + ch[(w shr 4) and $f] + ch[w and $f];
+end;
+begin
+  fillrandom(buf,sizeof(buf));
+
+  {uuid version 4}
+  buf[3] := (buf[3] and $fff) or $4000;
+
+  {uuid version 4}
+  buf[4] := (buf[4] and $3fff) or $8000;
+
+  result := inttohex(buf[0]) + inttohex(buf[1]) + '-' + inttohex(buf[2]) +'-'+ inttohex(buf[3]) + '-' + inttohex(buf[4])
+  + '-' + inttohex(buf[5]) + inttohex(buf[6]) + inttohex(buf[7]);
+end;
+
+{$ifndef nolcorernd}
+initialization randomdword := @internalrandomdword;
+{$endif}
+
+end.
+