From 85ef2ce64f0cc31a063fccea69fdcc7281d51548 Mon Sep 17 00:00:00 2001
From: beware <beware@bircd.org>
Date: Fri, 26 Dec 2008 19:17:00 +0000
Subject: [PATCH] * fixed NT services not working. app must now call
 lcoreinit() at some point before using sockets etc * made dnssync and
 dnsasync secure with source port randomization and reply packet source
 IP/port verification * created lcorerandom, a secure general purpose random
 number source, replacement of bircrandom * added fastmd5.pas into the
 repository. it wasn't in it, but seemed to belong in it and lcorernd depends
 on it. * added the ability to do "custom" (txt, mx, ns, ptr, etc) lookups in
 dnscore and dnsasync * lsocket.receivefrom now converts a v6 mapped v4 IP to
 a real v4 IP for simplicity in the app * removed "ipv6preferred" from dnswin,
 which was doing nothing

git-svn-id: file:///svnroot/lcore/trunk@20 b1de8a11-f9be-4011-bde0-cc7ace90066a
---
 binipstuff.pas          |  21 +-
 dnsasync.pas            |  91 ++++++---
 dnscore.pas             |  88 +++++++--
 dnssync.pas             |  57 ++++--
 dnswin.pas              |   6 +-
 fastmd5.pas             | 297 ++++++++++++++++++++++++++++
 lcoreconfig.inc         |  11 ++
 lcorernd.pas            | 427 ++++++++++++++++++++++++++++++++++++++++
 lcoreselect.pas         |  10 +-
 lcorewsaasyncselect.pas |  14 +-
 lsocket.pas             |  41 ++--
 todo.txt                |   3 -
 12 files changed, 978 insertions(+), 88 deletions(-)
 create mode 100644 fastmd5.pas
 create mode 100644 lcorernd.pas

diff --git a/binipstuff.pas b/binipstuff.pas
index a1433fc..70ac401 100755
--- a/binipstuff.pas
+++ b/binipstuff.pas
@@ -146,6 +146,7 @@ procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);
 {deprecated}
 function longip(s:string):longint;
 
+function needconverttov4(const ip:tbinip):boolean;
 procedure converttov4(var ip:tbinip);
 
 function inaddrvtobinip(inaddrv:tinetsockaddrv):tbinip;
@@ -501,18 +502,30 @@ begin
   result := comparebinip(ip1,ip2);
 end;
 
-{converts a binary IP to v4 if it is a v6 IP in the v4 range}
-procedure converttov4(var ip:tbinip);
+function needconverttov4(const ip:tbinip):boolean;
 begin
   {$ifdef ipv6}
   if ip.family = AF_INET6 then begin
     if (ip.ip6.u6_addr32[0] = 0) and (ip.ip6.u6_addr32[1] = 0) and
     (ip.ip6.u6_addr16[4] = 0) and (ip.ip6.u6_addr16[5] = $ffff) then begin
-      ip.family := AF_INET;
-      ip.ip := ip.ip6.s6_addr32[3];
+      result := true;
+      exit;
     end;
   end;
   {$endif}
+
+  result := false;
+end;
+
+{converts a binary IP to v4 if it is a v6 IP in the v4 range}
+procedure converttov4(var ip:tbinip);
+begin
+  {$ifdef ipv6}
+  if needconverttov4(ip) then begin
+    ip.family := AF_INET;
+    ip.ip := ip.ip6.s6_addr32[3];
+  end;
+  {$endif}
 end;
 
 {-----------biniplist stuff--------------------------------------------------}
diff --git a/dnsasync.pas b/dnsasync.pas
index 7a10bbf..8c3ce3a 100755
--- a/dnsasync.pas
+++ b/dnsasync.pas
@@ -15,7 +15,9 @@ uses
     dnswin,
   {$endif}
   lsocket,lcore,
-  classes,binipstuff,dnscore,btime;
+  classes,binipstuff,dnscore,btime,lcorernd;
+
+{$include lcoreconfig.inc}
 
 const
   numsock=1{$ifdef ipv6}+1{$endif};
@@ -33,6 +35,8 @@ type
 
     states: array[0..numsock-1] of tdnsstate;
 
+    destinations: array[0..numsock-1] of tbinip;
+
     dnsserverids : array[0..numsock-1] of integer;
     startts:double;
     {$ifdef win32}
@@ -60,11 +64,6 @@ type
 
     overrideaf : integer;
 
-    //A family value of AF_INET6 will give only
-    //ipv6 results. Any other value will give ipv4 results in preference and ipv6
-    //results if ipv4 results are not available;
-    forwardfamily:integer;
-
     procedure cancel;//cancel an outstanding dns request
     function dnsresult:string; //get result of dnslookup as a string
     procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip
@@ -72,6 +71,7 @@ type
     procedure forwardlookup(const name:string); //start forward lookup,
                                                 //preffering ipv4
     procedure reverselookup(const binip:tbinip); //start reverse lookup
+    procedure customlookup(const name:string;querytype:integer); //start custom type lookup
 
     constructor create(aowner:tcomponent); override;
     destructor destroy; override;
@@ -113,16 +113,31 @@ end;
 procedure tdnsasync.receivehandler(sender:tobject;error:word);
 var
   socketno : integer;
+  Src    : TInetSockAddrV;
+  SrcLen : Integer;
+  fromip:tbinip;
+  fromport:string;
 begin
   socketno := tlsocket(sender).tag;
   //writeln('got a reply on socket number ',socketno);
   fillchar(states[socketno].recvpacket,sizeof(states[socketno].recvpacket),0);
-  states[socketno].recvpacketlen := twsocket(sender).Receive(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket));
+
+  SrcLen := SizeOf(Src);
+  states[socketno].recvpacketlen := twsocket(sender).ReceiveFrom(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket), Src, SrcLen);
+
+  fromip := inaddrvtobinip(Src);
+  fromport := inttostr(htons(src.InAddr.port));
+
+  if ((not comparebinip(fromip,destinations[socketno])) or (fromport <> port)) then begin
+   // writeln('dnsasync received from wrong IP:port ',ipbintostr(fromip),'#',fromport,', expected ',ipbintostr(destinations[socketno]),'#',port);
+    exit;
+  end;
+
   states[socketno].parsepacket := true;
   if states[socketno].resultaction <> action_done then begin
     //we ignore packets that come after we are done
     if dnsserverids[socketno] >= 0 then begin
-      reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000));
+      reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000000));
       dnsserverids[socketno] := -1;
     end;
   {  writeln('received reply');}
@@ -138,6 +153,7 @@ function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:intege
 var
   destination : string;
   inaddr : tinetsockaddrv;
+  trytolisten:integer;
 begin
 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
   //writeln('trying to send query on socket number ',socketno);
@@ -148,11 +164,20 @@ begin
     if port = '' then port := '53';
     sockets[socketno].Proto := 'udp';
     sockets[socketno].ondataavailable := receivehandler;
-    try
-      sockets[socketno].listen;
-    except
-      result := false;
-      exit;
+
+    {we are going to bind on a random local port for the DNS request, against the kaminsky attack
+    there is a small chance that we're trying to bind on an already used port, so retry a few times}
+    for trytolisten := 3 downto 0 do begin
+      try
+        sockets[socketno].port := inttostr(1024 + randominteger(65536 - 1024));
+        sockets[socketno].listen;
+      except
+        {writeln('failed to listen ',sockets[socketno].localport,' ',trytolisten);}
+        if (trytolisten = 0) then begin
+          result := false;
+          exit;
+        end;
+      end;
     end;
 
   end;
@@ -162,7 +187,13 @@ begin
   end else begin
     destination := getcurrentsystemnameserver(dnsserverids[socketno]);
   end;
-  makeinaddrv(ipstrtobinf(destination),port,inaddr);
+  destinations[socketno] := ipstrtobinf(destination);
+
+  {$ifdef ipv6}{$ifdef win32}
+  if destinations[socketno].family = AF_INET6 then if (requestaf = useaf_default) then requestaf := useaf_preferv6;
+  {$endif}{$endif}
+
+  makeinaddrv(destinations[socketno],port,inaddr);
   sockets[socketno].sendto(inaddr,sizeof(inaddr), @packet,len);
   result := true;
 
@@ -212,7 +243,6 @@ var
   bip : tbinip;
   i : integer;
 begin
-
   ipstrtobin(name,bip);
 
   if bip.family <> 0 then begin
@@ -223,22 +253,25 @@ begin
     exit;
   end;
 
+  if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;
+
   if overrideaf = useaf_default then begin
-    {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}
+    {$ifdef ipv6}
+      {$ifdef win32}if not (usewindns and (addr = '')) then{$endif}
+      initpreferredmode;
+    {$endif}
     requestaf := useaf;
   end else begin
     requestaf := overrideaf;
   end;
 
   {$ifdef win32}
-    if usewindns or (addr = '') then begin
+    if usewindns and (addr = '') then begin
       dwas := tdnswinasync.create;
       dwas.onrequestdone := winrequestdone;
-      if forwardfamily = AF_INET6 then begin
-        dwas.forwardlookup(name,true);
-      end else begin
-        dwas.forwardlookup(name,false);
-      end;
+
+      dwas.forwardlookup(name);
+
       exit;
     end;
   {$endif}
@@ -263,10 +296,10 @@ begin
 end;
 
 procedure tdnsasync.reverselookup;
-
 begin
+  if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;
   {$ifdef win32}
-    if usewindns or (addr = '') then begin
+    if usewindns and (addr = '') then begin
       dwas := tdnswinasync.create;
       dwas.onrequestdone := winrequestdone;
       dwas.reverselookup(binip);
@@ -279,6 +312,14 @@ begin
   asyncprocess(0);
 end;
 
+procedure tdnsasync.customlookup;
+begin
+  if (overridednsserver <> '') and (addr = '') then addr := overridednsserver;
+  setstate_custom(name,querytype,states[0]);
+  numsockused := 1;
+  asyncprocess(0);
+end;
+
 function tdnsasync.dnsresult;
 begin
   if states[0].resultstr <> '' then result := states[0].resultstr else begin
@@ -322,7 +363,7 @@ end;
   procedure tdnsasync.winrequestdone(sender:tobject;error:word);
  
   begin
-    if dwas.reverse then begin 
+    if dwas.reverse then begin
       states[0].resultstr := dwas.name;
     end else begin 
 
diff --git a/dnscore.pas b/dnscore.pas
index 600581d..4cb52e2 100755
--- a/dnscore.pas
+++ b/dnscore.pas
@@ -60,7 +60,7 @@ unit dnscore;
 
 interface
 
-uses binipstuff,classes,pgtypes;
+uses binipstuff,classes,pgtypes,lcorernd;
 
 var usewindns : boolean = {$ifdef win32}true{$else}false{$endif};
 {hint to users of this unit that they should use windows dns instead.
@@ -82,6 +82,11 @@ can be set by apps as desired
 }
 var useaf:integer = useaf_default;
 
+{
+(temporarily) use a different nameserver, regardless of the dnsserverlist
+}
+var overridednsserver:string;
+
 const
   maxnamelength=127;
   maxnamefieldlen=63;
@@ -93,12 +98,14 @@ const
   querytype_a=1;
   querytype_cname=5;
   querytype_aaaa=28;
+  querytype_a6=38;
   querytype_ptr=12;
   querytype_ns=2;
   querytype_soa=6;
   querytype_mx=15;
-
-  maxrecursion=10;
+  querytype_txt=16;
+  querytype_spf=99;
+  maxrecursion=50;
   maxrrofakind=20;
 
   retryafter=300000; //microseconds must be less than one second;
@@ -170,16 +177,13 @@ procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);
 procedure setstate_failure(var state:tdnsstate);
 //procedure setstate_return(const rrp:trrpointer;len:integer;var state:tdnsstate);
 
+//for custom raw lookups such as TXT, as desired by the user
+procedure setstate_custom(const name:string; requesttype:integer; var state:tdnsstate);
 
 procedure state_process(var state:tdnsstate);
 
 //function decodename(const packet:tdnspacket;len,start,recursion:integer;var numread:integer):string;
 
-//presumablly this is exported to allow more secure random functions
-//to be substituted?
-var randomfunction:function:integer;
-
-
 procedure populatednsserverlist;
 procedure cleardnsservercache;
 
@@ -199,18 +203,20 @@ procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and
 { $endif}
 
 
-{$ifdef linux}{$ifdef ipv6}
+{$ifdef ipv6}
 function getv6localips:tbiniplist;
 procedure initpreferredmode;
 
 var
   preferredmodeinited:boolean;
 
-{$endif}{$endif}
+{$endif}
 
 var
   failurereason:string;
 
+function getquerytype(s:string):integer;
+
 implementation
 
 uses
@@ -220,6 +226,24 @@ uses
 
   sysutils;
 
+
+
+function getquerytype(s:string):integer;
+begin
+  s := uppercase(s);
+  result := 0;
+  if (s = 'A') then result := querytype_a else
+  if (s = 'CNAME') then result := querytype_cname else
+  if (s = 'AAAA') then result := querytype_aaaa else
+  if (s = 'PTR') then result := querytype_ptr else
+  if (s = 'NS') then result := querytype_ns else
+  if (s = 'MX') then result := querytype_mx else
+  if (s = 'A6') then result := querytype_a6 else
+  if (s = 'TXT') then result := querytype_txt else
+  if (s = 'SOA') then result := querytype_soa else
+  if (s = 'SPF') then result := querytype_spf;
+end;
+
 function buildrequest(const name:string;var packet:tdnspacket;requesttype:word):integer;
 var
   a,b:integer;
@@ -229,7 +253,8 @@ begin
  { writeln('buildrequest: name: ',name);}
   result := 0;
   fillchar(packet,sizeof(packet),0);
-  if assigned(randomfunction) then packet.id := (randomfunction and $ffff) else packet.id := random(65536);
+  packet.id := randominteger($10000);
+
   packet.flags := htons($0100);
   packet.rrcount[0] := htons($0001);
 
@@ -360,6 +385,14 @@ end;
 
 {==============================================================================}
 
+function getrawfromrr(const rrp:trrpointer;len:integer):string;
+begin
+  setlength(result,htons(trr(rrp.p^).datalen));
+  uniquestring(result);
+  move(trr(rrp.p^).data,result[1],length(result));
+end;
+
+
 function getipfromrr(const rrp:trrpointer;len:integer):tbinip;
 begin
   fillchar(result,sizeof(result),0);
@@ -391,6 +424,16 @@ begin
     querytype_a{$ifdef ipv6},querytype_aaaa{$endif}: begin
       state.resultbin := getipfromrr(rrp,len);
     end;
+    querytype_txt:begin
+      {TXT returns a raw string}
+      state.resultstr := copy(getrawfromrr(rrp,len),2,9999);
+      fillchar(state.resultbin,sizeof(state.resultbin),0);
+    end;
+    querytype_mx:begin
+      {MX is a name after a 16 bits word}
+      state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+12,0,a);
+      fillchar(state.resultbin,sizeof(state.resultbin),0);
+    end;
   else
     {other reply types (PTR, MX) return a hostname}
     state.resultstr := decodename(state.recvpacket,state.recvpacketlen,taddrint(rrp.p)-taddrint(@state.recvpacket)+10,0,a);
@@ -425,6 +468,13 @@ begin
   state.requesttype := querytype_ptr;
 end;
 
+procedure setstate_custom(const name:string; requesttype:integer; var state:tdnsstate);
+begin
+  setstate_request_init(name,state);
+  state.requesttype := requesttype;
+end;
+
+
 procedure setstate_failure(var state:tdnsstate);
 begin
   state.resultstr := '';
@@ -701,7 +751,9 @@ end;
 
 
 
-{$ifdef linux}{$ifdef ipv6}
+{$ifdef ipv6}
+
+{$ifdef linux}
 function getv6localips:tbiniplist;
 var
   t:textfile;
@@ -728,6 +780,13 @@ begin
   closefile(t);
 end;
 
+{$else}
+function getv6localips:tbiniplist;
+begin
+  result := biniplist_new;
+end;
+{$endif}
+
 procedure initpreferredmode;
 var
   l:tbiniplist;
@@ -738,8 +797,9 @@ var
 begin
   if preferredmodeinited then exit;
   if useaf <> useaf_default then exit;
-  useaf := useaf_preferv4;
   l := getv6localips;
+  if biniplist_getcount(l) = 0 then exit;
+  useaf := useaf_preferv4;
   ipstrtobin('2000::',ipmask_global);
   ipstrtobin('2001::',ipmask_teredo);
   ipstrtobin('2002::',ipmask_6to4);
@@ -755,7 +815,7 @@ begin
   end;
 end;
 
-{$endif}{$endif}
+{$endif}
 
 
 {  quick and dirty description of dns packet structure to aid writing and
diff --git a/dnssync.pas b/dnssync.pas
index b682acf..a7ba714 100755
--- a/dnssync.pas
+++ b/dnssync.pas
@@ -25,6 +25,7 @@ interface
       sockets,
       fd_utils,
     {$endif}
+    lcorernd,
     sysutils;
 
 //convert a name to an IP
@@ -54,8 +55,9 @@ const
   defaulttimeout=10000;
   const mintimeout=16;
 
+  toport='53';
+
 var
-  dnssyncserver:string;
   id:integer;
 
   sendquerytime:array[0..numsock-1] of integer;
@@ -77,6 +79,7 @@ var
   numsockused:integer;
   fd:array[0..numsock-1] of integer;
   state:array[0..numsock-1] of tdnsstate;
+  toaddr:array[0..numsock-1] of tbinip;
 
 {$ifdef syncdnscore}
 
@@ -115,10 +118,15 @@ begin
   result := false;
   if len = 0 then exit; {no packet}
 
-  if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
-  port := '53';
+  if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);
+
+  {$ifdef ipv6}{$ifdef win32}
+  if toaddr[socknum].family = AF_INET6 then if (useaf = 0) then useaf := useaf_preferv6;
+  {$endif}{$endif}
 
-  makeinaddrv(ipstrtobinf(addr),port,inaddr);
+  port := toport;
+  toaddr[socknum] := ipstrtobinf(addr);
+  makeinaddrv(toaddr[socknum],port,inaddr);
 
   sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
   sendquerytime[socknum] := getts;
@@ -135,16 +143,17 @@ begin
   //init both sockets smultaneously, always, so they get succesive fd's
   if fd[0] > 0 then exit;
 
-  if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
+  if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);
   //must get the DNS server here so we know to init v4 or v6
 
-  fillchar(inaddrtemp,sizeof(inaddrtemp),0);
   ipstrtobin(addr,biniptemp);
-  if biniptemp.family = 0 then biniptemp.family := AF_INET;
 
-  inaddrtemp.inaddr.family := biniptemp.family;
+  if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');
+
 
   for a := 0 to numsockused-1 do begin
+    makeinaddrv(biniptemp,inttostr( 1024 + randominteger(65536 - 1024) ),inaddrtemp);
+
     fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
 
     If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin
@@ -175,6 +184,12 @@ var
   finished:array[0..numsock-1] of boolean;
   a,b:integer;
 
+  Src    : TInetSockAddrV;
+  Srcx   : {$ifdef win32}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;
+  SrcLen : Integer;
+  fromip:tbinip;
+  fromport:string;
+
 begin
   if timeout < mintimeout then timeout := defaulttimeout;
 
@@ -242,10 +257,22 @@ begin
         fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
         msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
 
-        if dnssyncserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
-        state[socknum].recvpacketlen := recv(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0);
-        state[socknum].parsepacket := true;
-        needprocessing[socknum] := true;
+        if overridednsserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
+
+        SrcLen := SizeOf(Src);
+        state[socknum].recvpacketlen := recvfrom(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0,Srcx,SrcLen);
+
+        if (state[socknum].recvpacketlen > 0) then begin
+          fromip := inaddrvtobinip(Src);
+          fromport := inttostr(htons(src.InAddr.port));
+          if ((not comparebinip(toaddr[socknum],fromip)) or (fromport <> toport)) then begin
+//            writeln('dnssync received from wrong IP:port ',ipbintostr(fromip),'#',fromport);
+            state[socknum].recvpacketlen := 0;
+          end else begin
+            state[socknum].parsepacket := true;
+            needprocessing[socknum] := true;
+          end;
+        end;
       end;
     end;
     if selectresult < 0 then exit;
@@ -253,7 +280,7 @@ begin
 
       currenttime := getts;
 
-      if dnssyncserver = '' then reportlag(id,-1);
+      if overridednsserver = '' then reportlag(id,-1);
       if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
         exit;
       end else begin
@@ -307,7 +334,7 @@ begin
   {$endif}
   begin
   {$ifdef syncdnscore}
-    {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}
+    {$ifdef ipv6}initpreferredmode;{$endif}
 
     numsockused := 0;
 
@@ -334,7 +361,7 @@ begin
     end else begin
       biniplist_addlist(result,state[0].resultlist);
       biniplist_addlist(result,state[1].resultlist);
-    {$endif}  
+    {$endif}
     end;
     {$endif}
   end;
diff --git a/dnswin.pas b/dnswin.pas
index 73f97ad..19eabe4 100755
--- a/dnswin.pas
+++ b/dnswin.pas
@@ -20,7 +20,6 @@ type
   //release should only be called from the main thread
   tdnswinasync=class(tthread)
   private
-    ipv6preffered : boolean;
     freverse : boolean;
     error : integer;
     freewhendone : boolean;
@@ -32,7 +31,7 @@ type
     name : string;
     iplist : tbiniplist;
 
-    procedure forwardlookup(name:string;ipv6preffered:boolean);
+    procedure forwardlookup(name:string);
     procedure reverselookup(ip:tbinip);
     destructor destroy; override;
     procedure release;
@@ -281,10 +280,9 @@ begin
   end;
 end;
 
-procedure tdnswinasync.forwardlookup(name:string;ipv6preffered:boolean);
+procedure tdnswinasync.forwardlookup(name:string);
 begin
   self.name := name;
-  self.ipv6preffered := ipv6preffered;
   freverse := false;
   resume;
 end;
diff --git a/fastmd5.pas b/fastmd5.pas
new file mode 100644
index 0000000..f0481a9
--- /dev/null
+++ b/fastmd5.pas
@@ -0,0 +1,297 @@
+{ 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 fastmd5;
+
+{
+pascal implementation of MD5
+
+written by Bas Steendijk - steendijk@xs4all.nl
+
+based on RFC1321 - The MD5 Message-Digest Algorithm
+
+optimized for speed: saved on copying and sub calls in the core routine
+
+verified on:
+- Borland Delphi 3
+- Borland Turbo Pascal 7
+- Free Pascal 1.0.6 for i386 (on *nix)
+- various other versions of freepascal on windows and linux i386
+- various other versions of delphi
+- free pascal 1.9.5 on powerpc darwin
+
+this unit is endian portable but is likely to be significantly slower on big endian systems
+}
+
+{$Q-,R-}
+
+interface
+
+
+
+
+
+type
+  Tmd5=array[0..15] of byte;
+
+{$i uint32.inc}
+
+type
+  dvar=array[0..0] of byte;
+  Tmd5state=record
+    buf:array[0..63] of byte;
+    H:array[0..3] of uint32;
+    msglen:longint;
+    msglenhi:longint;
+  end;
+
+procedure md5processblock(var h:array of uint32;const data);
+
+procedure md5init(var state:tmd5state);
+procedure md5process(var state:tmd5state;const data;len:longint);
+procedure md5finish(var state:tmd5state;var result);
+
+procedure getmd5(const data;len:longint;var result);
+
+function md5tostr(const md5:tmd5):string;
+
+implementation
+
+function inttohex(val,bits:integer):string;
+const
+  hexchar:array[0..15] of char='0123456789abcdef';
+begin
+  inttohex := hexchar[val shr 4]+hexchar[val and $f];
+end;
+
+{$ifdef cpu386}
+function rol(w,bits:uint32): uint32; assembler;
+asm
+  {cpu386 is not defined on freepascal. but fpc assembler is incompatible, uses different code}
+  {inline($89/$d1/$d3/$c0);}
+  mov   ecx,edx
+  rol   eax,cl
+end;
+{$else}
+function rol(w,bits:uint32):uint32;
+begin
+  rol := (w shl bits) or (w shr (32-bits));
+end;
+{$endif}
+
+
+{function swapbytes(invalue:uint32):uint32;
+var
+  inbytes  : array[0..3] of byte absolute invalue;
+  outbytes : array[0..3] of byte absolute result;
+
+
+begin
+  outbytes[0] := inbytes[3];
+  outbytes[1] := inbytes[2];
+  outbytes[2] := inbytes[1];
+  outbytes[3] := inbytes[0];
+end;}
+
+procedure md5processblock(var h:array of uint32;const data);
+const
+  S11=7;  S12=12;  S13=17;  S14=22;
+  S21=5;  S22=9;   S23=14;  S24=20;
+  S31=4;  S32=11;  S33=16;  S34=23;
+  S41=6;  S42=10;  S43=15;  S44=21;
+
+var
+  A,B,C,D:uint32;
+  w:array[0..63] of byte absolute data;
+  x:array[0..15] of uint32 {$ifndef ENDIAN_BIG} absolute data{$endif} ;
+  y:array[0..63] of byte absolute x;
+  {$ifdef ENDIAN_BIG}counter : integer;{$endif}
+begin
+  A := h[0];
+  B := h[1];
+  C := h[2];
+  D := h[3];
+  {$ifdef ENDIAN_BIG}
+    for counter := 0 to 63 do begin
+      y[counter] := w[counter xor 3];
+    end;
+  {$endif}
+  a := rol(a + ((b and c) or ((not b) and d)) + x[ 0] + $d76aa478, S11) + b;
+  d := rol(d + ((a and b) or ((not a) and c)) + x[ 1] + $e8c7b756, S12) + a;
+  c := rol(c + ((d and a) or ((not d) and b)) + x[ 2] + $242070db, S13) + d;
+  b := rol(b + ((c and d) or ((not c) and a)) + x[ 3] + $c1bdceee, S14) + c;
+  a := rol(a + ((b and c) or ((not b) and d)) + x[ 4] + $f57c0faf, S11) + b;
+  d := rol(d + ((a and b) or ((not a) and c)) + x[ 5] + $4787c62a, S12) + a;
+  c := rol(c + ((d and a) or ((not d) and b)) + x[ 6] + $a8304613, S13) + d;
+  b := rol(b + ((c and d) or ((not c) and a)) + x[ 7] + $fd469501, S14) + c;
+  a := rol(a + ((b and c) or ((not b) and d)) + x[ 8] + $698098d8, S11) + b;
+  d := rol(d + ((a and b) or ((not a) and c)) + x[ 9] + $8b44f7af, S12) + a;
+  c := rol(c + ((d and a) or ((not d) and b)) + x[10] + $ffff5bb1, S13) + d;
+  b := rol(b + ((c and d) or ((not c) and a)) + x[11] + $895cd7be, S14) + c;
+  a := rol(a + ((b and c) or ((not b) and d)) + x[12] + $6b901122, S11) + b;
+  d := rol(d + ((a and b) or ((not a) and c)) + x[13] + $fd987193, S12) + a;
+  c := rol(c + ((d and a) or ((not d) and b)) + x[14] + $a679438e, S13) + d;
+  b := rol(b + ((c and d) or ((not c) and a)) + x[15] + $49b40821, S14) + c;
+
+  a := rol(a + ((b and d) or (c and (not d))) + x[ 1] + $f61e2562, S21) + b;
+  d := rol(d + ((a and c) or (b and (not c))) + x[ 6] + $c040b340, S22) + a;
+  c := rol(c + ((d and b) or (a and (not b))) + x[11] + $265e5a51, S23) + d;
+  b := rol(b + ((c and a) or (d and (not a))) + x[ 0] + $e9b6c7aa, S24) + c;
+  a := rol(a + ((b and d) or (c and (not d))) + x[ 5] + $d62f105d, S21) + b;
+  d := rol(d + ((a and c) or (b and (not c))) + x[10] + $02441453, S22) + a;
+  c := rol(c + ((d and b) or (a and (not b))) + x[15] + $d8a1e681, S23) + d;
+  b := rol(b + ((c and a) or (d and (not a))) + x[ 4] + $e7d3fbc8, S24) + c;
+  a := rol(a + ((b and d) or (c and (not d))) + x[ 9] + $21e1cde6, S21) + b;
+  d := rol(d + ((a and c) or (b and (not c))) + x[14] + $c33707d6, S22) + a;
+  c := rol(c + ((d and b) or (a and (not b))) + x[ 3] + $f4d50d87, S23) + d;
+  b := rol(b + ((c and a) or (d and (not a))) + x[ 8] + $455a14ed, S24) + c;
+  a := rol(a + ((b and d) or (c and (not d))) + x[13] + $a9e3e905, S21) + b;
+  d := rol(d + ((a and c) or (b and (not c))) + x[ 2] + $fcefa3f8, S22) + a;
+  c := rol(c + ((d and b) or (a and (not b))) + x[ 7] + $676f02d9, S23) + d;
+  b := rol(b + ((c and a) or (d and (not a))) + x[12] + $8d2a4c8a, S24) + c;
+
+  a := rol(a + (b xor c xor d) + x[ 5] + $fffa3942, S31) + b;
+  d := rol(d + (a xor b xor c) + x[ 8] + $8771f681, S32) + a;
+  c := rol(c + (d xor a xor b) + x[11] + $6d9d6122, S33) + d;
+  b := rol(b + (c xor d xor a) + x[14] + $fde5380c, S34) + c;
+  a := rol(a + (b xor c xor d) + x[ 1] + $a4beea44, S31) + b;
+  d := rol(d + (a xor b xor c) + x[ 4] + $4bdecfa9, S32) + a;
+  c := rol(c + (d xor a xor b) + x[ 7] + $f6bb4b60, S33) + d;
+  b := rol(b + (c xor d xor a) + x[10] + $bebfbc70, S34) + c;
+  a := rol(a + (b xor c xor d) + x[13] + $289b7ec6, S31) + b;
+  d := rol(d + (a xor b xor c) + x[ 0] + $eaa127fa, S32) + a;
+  c := rol(c + (d xor a xor b) + x[ 3] + $d4ef3085, S33) + d;
+  b := rol(b + (c xor d xor a) + x[ 6] + $04881d05, S34) + c;
+  a := rol(a + (b xor c xor d) + x[ 9] + $d9d4d039, S31) + b;
+  d := rol(d + (a xor b xor c) + x[12] + $e6db99e5, S32) + a;
+  c := rol(c + (d xor a xor b) + x[15] + $1fa27cf8, S33) + d;
+  b := rol(b + (c xor d xor a) + x[ 2] + $c4ac5665, S34) + c;
+
+  a := rol(a + (c xor (b or (not d))) + x[ 0] + $f4292244, S41) + b;
+  d := rol(d + (b xor (a or (not c))) + x[ 7] + $432aff97, S42) + a;
+  c := rol(c + (a xor (d or (not b))) + x[14] + $ab9423a7, S43) + d;
+  b := rol(b + (d xor (c or (not a))) + x[ 5] + $fc93a039, S44) + c;
+  a := rol(a + (c xor (b or (not d))) + x[12] + $655b59c3, S41) + b;
+  d := rol(d + (b xor (a or (not c))) + x[ 3] + $8f0ccc92, S42) + a;
+  c := rol(c + (a xor (d or (not b))) + x[10] + $ffeff47d, S43) + d;
+  b := rol(b + (d xor (c or (not a))) + x[ 1] + $85845dd1, S44) + c;
+  a := rol(a + (c xor (b or (not d))) + x[ 8] + $6fa87e4f, S41) + b;
+  d := rol(d + (b xor (a or (not c))) + x[15] + $fe2ce6e0, S42) + a;
+  c := rol(c + (a xor (d or (not b))) + x[ 6] + $a3014314, S43) + d;
+  b := rol(b + (d xor (c or (not a))) + x[13] + $4e0811a1, S44) + c;
+  a := rol(a + (c xor (b or (not d))) + x[ 4] + $f7537e82, S41) + b;
+  d := rol(d + (b xor (a or (not c))) + x[11] + $bd3af235, S42) + a;
+  c := rol(c + (a xor (d or (not b))) + x[ 2] + $2ad7d2bb, S43) + d;
+  b := rol(b + (d xor (c or (not a))) + x[ 9] + $eb86d391, S44) + c;
+
+  inc(h[0],A);
+  inc(h[1],B);
+  inc(h[2],C);
+  inc(h[3],D);
+end;
+
+procedure md5init(var state:tmd5state);
+begin
+  state.h[0] := $67452301;
+  state.h[1] := $EFCDAB89;
+  state.h[2] := $98BADCFE;
+  state.h[3] := $10325476;
+  state.msglen := 0;
+  state.msglenhi := 0;
+end;
+
+procedure md5process(var state:tmd5state;const data;len:longint);
+var
+  a,b:longint;
+  ofs:longint;
+  p:dvar absolute data;
+begin
+  b := state.msglen and 63;
+
+  inc(state.msglen,len);
+  while (state.msglen > $20000000) do begin
+    dec(state.msglen,$20000000);
+    inc(state.msglenhi);
+  end;
+  ofs := 0;
+  if b > 0 then begin
+    a := 64-b;
+    if a > len then a := len;
+    move(p[0],state.buf[b],a);
+    inc(ofs,a);
+    dec(len,a);
+    if b+a = 64 then md5processblock(state.h,state.buf);
+    if len = 0 then exit;
+  end;
+  while len >= 64 do begin
+    md5processblock(state.h,p[ofs]);
+    inc(ofs,64);
+    dec(len,64);
+  end;
+  if len > 0 then move(p[ofs],state.buf[0],len);
+end;
+
+procedure md5finish(var state:tmd5state;var result);
+var
+  b       :integer;
+  {$ifdef endian_big}
+    h       :tmd5 absolute state.h;
+    r       :tmd5 absolute result;
+    counter :integer ;
+  {$endif}
+begin
+  b := state.msglen and 63;
+  state.buf[b] := $80;
+  if b >= 56 then begin
+    {-- for a := b+1 to 63 do state.buf[a] := 0; }
+    fillchar(state.buf[b+1],63-b,0);
+    md5processblock(state.h,state.buf);
+    fillchar(state.buf,56,0);
+  end else begin
+    {-- for a := b+1 to 55 do state.buf[a] := 0; }
+    fillchar(state.buf[b+1],55-b,0);
+  end;
+  state.msglen := state.msglen shl 3;
+
+  state.buf[56] := state.msglen;
+  state.buf[57] := state.msglen shr 8;
+  state.buf[58] := state.msglen shr 16;
+  state.buf[59] := state.msglen shr 24;
+  state.buf[60] := state.msglenhi;
+  state.buf[61] := state.msglenhi shr 8;
+  state.buf[62] := state.msglenhi shr 16;
+  state.buf[63] := state.msglenhi shr 24;
+
+  md5processblock(state.h,state.buf);
+  {$ifdef ENDIAN_BIG}
+    for counter := 0 to 15 do begin
+      r[counter] := h[counter xor 3];
+    end;
+  {$else} 
+    move(state.h,result,16);
+  {$endif}
+  fillchar(state,sizeof(state),0);
+end;
+
+procedure getmd5(const data;len:longint;var result);
+var
+  t:tmd5state;
+begin
+  md5init(t);
+  md5process(t,data,len);
+  md5finish(t,result);
+end;
+
+function md5tostr(const md5:tmd5):string;
+var
+  a:integer;
+  s:string;
+begin
+  s := '';
+  for a := 0 to 15 do s := s + inttohex(md5[a],2);
+  md5tostr := s;
+end;
+
+end.
diff --git a/lcoreconfig.inc b/lcoreconfig.inc
index 27b6e82..cda6ec7 100644
--- a/lcoreconfig.inc
+++ b/lcoreconfig.inc
@@ -12,6 +12,7 @@ to disable, undefine it here, or define "noipv6" in the app}
 {$define ipv6}
 {$endif}
 
+{-------------------------------------------------------------------------------------}
 {there are 2 ways to use DNS in lcore: dnscore, which an entire built in DNS client, and getaddrinfo.
 dnscore is always included on *nix to avoid libc dependency problems, but getaddrinfo is used on windows.
 when getaddrinfo is used, there is no reason to include dnscore, and it increases the exe size,
@@ -19,6 +20,14 @@ unless you want to use custom nameserver addresses. enable this setting to alway
 
 {-$define syncdnscore}
 
+{-------------------------------------------------------------------------------------}
+{lcore contains a built in general purpose secure random number generator, which is used elsewhere in lcore, for
+example by the DNS resolver. the used random function can be hooked to point to one's own RNG as desired.
+it is then also possible to not include the built in RNG in the exe, which reduces code size}
+
+{-$define nolcorernd}
+
+{-------------------------------------------------------------------------------------}
 {on windows up to XP, listening on ipv6 will not listen on ipv4, while on other platforms it does, 
 so a single listener cant get all connections for a port number, only those for one address family.
 also it means a portable app would gave to deal with inconsistent behavior.
@@ -27,3 +36,5 @@ enable this option to simulate the behavior of listening on both v4 and v6}
 {$ifdef win32}{$ifdef ipv6}
 {$define secondlistener}
 {$endif}{$endif}
+
+{-------------------------------------------------------------------------------------}
\ No newline at end of file
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.
+
diff --git a/lcoreselect.pas b/lcoreselect.pas
index 0d99f6a..16134ee 100755
--- a/lcoreselect.pas
+++ b/lcoreselect.pas
@@ -31,6 +31,8 @@ var
 function getfdsrmaster : fdset; {$ifdef useinline}inline;{$endif}
 function getfdswmaster : fdset; {$ifdef useinline}inline;{$endif}
 
+procedure lcoreinit;
+
 implementation
 uses
   lcore,sysutils,
@@ -392,9 +394,13 @@ begin
   fdreverse[fd] := reverseto;
 end;
 
+var
+  inited:boolean;
 
-
+procedure lcoreinit;
 begin
+  if inited then exit;
+  inited := true;
   eventcore := tselecteventcore.create;
 
   absoloutemaxs := absoloutemaxs_select;
@@ -402,4 +408,6 @@ begin
   maxs := 0;
   fd_zero(fdsrmaster);
   fd_zero(fdswmaster);
+end;
+
 end.
diff --git a/lcorewsaasyncselect.pas b/lcorewsaasyncselect.pas
index b64797a..622c92e 100755
--- a/lcorewsaasyncselect.pas
+++ b/lcorewsaasyncselect.pas
@@ -2,8 +2,10 @@ unit lcorewsaasyncselect;
 
 interface
 
+procedure lcoreinit;
 
 implementation
+
 uses wcore,lcore,bsearchtree,sysutils,windows,winsock,pgtypes,messages,classes,lsocket;
 type
   twineventcore=class(teventcore)
@@ -197,7 +199,12 @@ var
                                  lpszClassName : 'lcoreClass');
   GInitData: TWSAData;
 
+var
+  inited:boolean;
+procedure lcoreinit;
 begin
+  if (inited) then exit;
+
   eventcore := twineventcore.create;
   if Windows.RegisterClass(MyWindowClass) = 0 then halt;
   //writeln('about to create lcore handle, hinstance=',hinstance);
@@ -216,6 +223,11 @@ begin
   onaddtask := winaddtask;
   timerwrapperinterface := twintimerwrapperinterface.create(nil);
 
-  WSAStartup($200, GInitData);
+  WSAStartup(2, GInitData);
   absoloutemaxs := maxlongint;
+
+
+  inited := true;
+end;
+
 end.
diff --git a/lsocket.pas b/lsocket.pas
index 898e983..2eb4dbd 100755
--- a/lsocket.pas
+++ b/lsocket.pas
@@ -299,7 +299,7 @@ begin
       If Bind(fdhandlein,inaddrtempx,inaddrtempsize)<> {$ifdef win32}0{$else}true{$endif} Then begin
         state := wsclosed;
         lasterror := {$ifdef win32}getlasterror{$else}socketerror{$endif};
-        raise ESocketException.create('unable to bind, error '+inttostr(lasterror));
+        raise ESocketException.create('unable to bind on address '+localaddr+'#'+localport+', error '+inttostr(lasterror));
       end;
       state := wsbound;
     end;
@@ -477,7 +477,10 @@ end;
 
 function tlsocket.receivefrom(data:pointer;len:integer;var src:TInetSockAddrV;var srclen:integer):integer;
 var
-  srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute src;
+  tempsrc:TInetSockAddrV;
+  tempsrclen:integer;
+  srcx : {$ifdef win32}winsock.TSockAddr{$else}TInetSockAddrV{$endif} absolute tempsrc;
+  biniptemp:tbinip;
 begin
   {$ifdef secondlistener}
   if assigned(secondlistener) then if lastsessionfromsecond then begin
@@ -486,7 +489,19 @@ begin
     exit;
   end;
   {$endif}
-  result := {$ifdef win32}winsock{$else}sockets{$endif}.recvfrom(self.fdhandlein,data^,len,0,srcx,srclen);
+  tempsrclen := sizeof(tempsrc);
+  result := {$ifdef win32}winsock{$else}sockets{$endif}.recvfrom(self.fdhandlein,data^,len,0,srcx,tempsrclen);
+
+  {$ifdef ipv6}
+  biniptemp := inaddrvtobinip(tempsrc);
+  if needconverttov4(biniptemp) then begin
+    converttov4(biniptemp);
+    tempsrclen := makeinaddrv(biniptemp,inttostr(ntohs(tempsrc.InAddr.port)),tempsrc);
+  end;
+  {$endif}
+
+  move(tempsrc,src,srclen);
+  srclen := tempsrclen;
 end;
 
 procedure tlsocket.connectionfailedhandler(error:word);
@@ -603,15 +618,7 @@ begin
   {$else}
     sockets.getsocketname(self.fdhandlein,addr,i);
   {$endif}
-  binip.family := addr.inaddr.family;
-  {$ifdef ipv6}
-  if addr.inaddr6.sin6_family = AF_INET6 then begin
-    binip.ip6 := addr.inaddr6.sin6_addr;
-  end else
-  {$endif}
-  begin
-    binip.ip := addr.inaddr.addr;
-  end;
+  binip := inaddrvtobinip(addr);
   converttov4(binip);
 end;
 
@@ -628,15 +635,7 @@ begin
     sockets.getpeername(self.fdhandlein,addr,i);
   {$endif}
 
-  binip.family := addr.inaddr.family;
-  {$ifdef ipv6}
-  if addr.inaddr6.sin6_family = AF_INET6 then begin
-    binip.ip6 := addr.inaddr6.sin6_addr;
-  end else
-  {$endif}
-  begin
-    binip.ip := addr.inaddr.addr;
-  end;
+  binip := inaddrvtobinip(addr);
   converttov4(binip);
 end;
 
diff --git a/todo.txt b/todo.txt
index b1e27b0..175f295 100644
--- a/todo.txt
+++ b/todo.txt
@@ -1,4 +1 @@
-* add multilistener support so that a single tlsocket can be used for both
-ipv4 and ipv6 on windows XP
-* fixup dnsasync to support multi-ip responses
 * fixup dnsasync to perform retries and use multiple dns servers
\ No newline at end of file
-- 
2.30.2