* add multiip support to dnsasync

git-svn-id: file:///svnroot/lcore/trunk@13 b1de8a11-f9be-4011-bde0-cc7ace90066a

diff --git a/Makefile b/Makefile
index 2ac49d3cb9ee315579694ebb8d0c97e9064a3e42..4bf4bddf38d2720fee2b24f688bbd4b422eea58a 100755 (executable)
--- a/Makefile
+++ b/Makefile
@@ -1,7 +1,7 @@
 all: lcoretest\r
 \r
 lcoretest: *.pas *.inc lcoretest.dpr\r
 all: lcoretest\r
 \r
 lcoretest: *.pas *.inc lcoretest.dpr\r

-       fpc -Sd -dipv6 lcoretest.dpr\r
+       fpc -Sd -gl -dipv6 lcoretest.dpr\r

        \r
 clean:\r
        -rm *.o\r
        \r
 clean:\r
        -rm *.o\r

diff --git a/binipstuff.pas b/binipstuff.pas
index 59d123b4a59730e81513795928dcbf873c2bbf47..a1433fcc25897c54a057bf667046e868ddd81615 100755 (executable)
--- a/binipstuff.pas
+++ b/binipstuff.pas
@@ -141,6 +141,8 @@ function comparebinip(const ip1,ip2:tbinip):boolean;
 procedure maskbits(var binip:tbinip;bits:integer);\r
 function comparebinipmask(ip1,ip2:tbinip;bits:integer):boolean;\r
 \r
 procedure maskbits(var binip:tbinip;bits:integer);\r
 function comparebinipmask(ip1,ip2:tbinip;bits:integer):boolean;\r
 \r

+procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);\r
+\r

 {deprecated}\r
 function longip(s:string):longint;\r
 \r
 {deprecated}\r
 function longip(s:string):longint;\r
 \r


@@ -565,7 +567,7 @@ end;
 \r
 procedure biniplist_addlist;\r
 begin\r
 \r
 procedure biniplist_addlist;\r
 begin\r

-  l := l + l2;\r
+  l := l + copy(l2,biniplist_prefixlen+1,maxlongint);\r

 end;\r
 \r
 function biniplist_tostr(const l:tbiniplist):string;\r
 end;\r
 \r
 function biniplist_tostr(const l:tbiniplist):string;\r


@@ -593,4 +595,16 @@ begin
   result := true;\r
 end;\r
 \r
   result := true;\r
 end;\r
 \r

+procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);\r
+var\r
+  a:integer;\r
+  biniptemp:tbinip;\r
+begin\r
+  for a := biniplist_getcount(l2)-1 downto 0 do begin\r
+    biniptemp := biniplist_get(l2,a);\r
+    if (biniptemp.family = family) then biniplist_add(l,biniptemp);\r
+  end;\r
+end;\r
+\r
+\r

 end.\r
 end.\r

diff --git a/dnsasync.pas b/dnsasync.pas
index 0a32459af0a5c04c419652fff26cc9d08b49a742..7a10bbfdc7cc0466942906c68617712309317e22 100755 (executable)
--- a/dnsasync.pas
+++ b/dnsasync.pas
@@ -17,8 +17,11 @@ uses
   lsocket,lcore,\r
   classes,binipstuff,dnscore,btime;\r
 \r
   lsocket,lcore,\r
   classes,binipstuff,dnscore,btime;\r
 \r

+const\r
+  numsock=1{$ifdef ipv6}+1{$endif};\r

 \r
 type\r
 \r
 type\r

+\r

   //after completion or cancelation a dnswinasync may be reused\r
   tdnsasync=class(tcomponent)\r
 \r
   //after completion or cancelation a dnswinasync may be reused\r
   tdnsasync=class(tcomponent)\r
 \r


@@ -26,26 +29,26 @@ type
     //made a load of stuff private that does not appear to be part of the main\r
     //public interface. If you make any of it public again please consider the\r
     //consequences when using windows dns. --plugwash.\r
     //made a load of stuff private that does not appear to be part of the main\r
     //public interface. If you make any of it public again please consider the\r
     //consequences when using windows dns. --plugwash.\r

-    sock:twsocket;\r
-\r
-    sockopen:boolean;\r
-\r
+    sockets: array[0..numsock-1] of tlsocket;\r

 \r
 \r

-    state:tdnsstate;\r
+    states: array[0..numsock-1] of tdnsstate;\r

 \r
 \r

-    dnsserverid:integer;\r
+    dnsserverids : array[0..numsock-1] of integer;\r

     startts:double;\r
     {$ifdef win32}\r
       dwas : tdnswinasync;\r
     {$endif}\r
 \r
     startts:double;\r
     {$ifdef win32}\r
       dwas : tdnswinasync;\r
     {$endif}\r
 \r

-\r
-    procedure asyncprocess;\r
+    numsockused : integer;\r
+    fresultlist : tbiniplist;\r
+    requestaf : integer;\r
+    procedure asyncprocess(socketno:integer);\r

     procedure receivehandler(sender:tobject;error:word);\r
     procedure receivehandler(sender:tobject;error:word);\r

-    function sendquery(const packet:tdnspacket;len:integer):boolean;\r
+    function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r

     {$ifdef win32}\r
       procedure winrequestdone(sender:tobject;error:word);\r
     {$endif}\r
     {$ifdef win32}\r
       procedure winrequestdone(sender:tobject;error:word);\r
     {$endif}\r

+\r

   public\r
     onrequestdone:tsocketevent;\r
 \r
   public\r
     onrequestdone:tsocketevent;\r
 \r


@@ -55,6 +58,8 @@ type
     //and special uses.\r
     addr,port:string;\r
 \r
     //and special uses.\r
     addr,port:string;\r
 \r

+    overrideaf : integer;\r
+\r

     //A family value of AF_INET6 will give only\r
     //ipv6 results. Any other value will give ipv4 results in preference and ipv6\r
     //results if ipv4 results are not available;\r
     //A family value of AF_INET6 will give only\r
     //ipv6 results. Any other value will give ipv4 results in preference and ipv6\r
     //results if ipv4 results are not available;\r


@@ -63,6 +68,7 @@ type
     procedure cancel;//cancel an outstanding dns request\r
     function dnsresult:string; //get result of dnslookup as a string\r
     procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip\r
     procedure cancel;//cancel an outstanding dns request\r
     function dnsresult:string; //get result of dnslookup as a string\r
     procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip\r

+    property dnsresultlist : tbiniplist read fresultlist;\r

     procedure forwardlookup(const name:string); //start forward lookup,\r
                                                 //preffering ipv4\r
     procedure reverselookup(const binip:tbinip); //start reverse lookup\r
     procedure forwardlookup(const name:string); //start forward lookup,\r
                                                 //preffering ipv4\r
     procedure reverselookup(const binip:tbinip); //start reverse lookup\r


@@ -79,78 +85,150 @@ uses sysutils;
 constructor tdnsasync.create;\r
 begin\r
   inherited create(aowner);\r
 constructor tdnsasync.create;\r
 begin\r
   inherited create(aowner);\r

-  dnsserverid := -1;\r
-  sock := twsocket.create(self);\r
+  dnsserverids[0] := -1;\r
+  sockets[0] := twsocket.create(self);\r
+  sockets[0].tag := 0;\r
+  {$ifdef ipv6}\r
+    dnsserverids[1] := -1;\r
+    sockets[1] := twsocket.Create(self);\r
+    sockets[1].tag := 1;\r
+  {$endif}\r

 end;\r
 \r
 destructor tdnsasync.destroy;\r
 end;\r
 \r
 destructor tdnsasync.destroy;\r

+var\r
+  socketno : integer;\r

 begin\r
 begin\r

-  if dnsserverid >= 0 then begin\r
-    reportlag(dnsserverid,-1);\r
-    dnsserverid := -1;\r
+  for socketno := 0 to numsock -1 do begin\r
+    if dnsserverids[socketno] >= 0 then begin\r
+      reportlag(dnsserverids[socketno],-1);\r
+      dnsserverids[socketno] := -1;\r
+    end;\r
+    sockets[socketno].release;\r
+    setstate_request_init('',states[socketno]);\r

   end;\r
   end;\r

-  sock.release;\r
-  setstate_request_init('',state);\r

   inherited destroy;\r
 end;\r
 \r
   inherited destroy;\r
 end;\r
 \r

-procedure tdnsasync.receivehandler;\r
+procedure tdnsasync.receivehandler(sender:tobject;error:word);\r
+var\r
+  socketno : integer;\r

 begin\r
 begin\r

-  if dnsserverid >= 0 then begin\r
-    reportlag(dnsserverid,trunc((unixtimefloat-startts)*1000));\r
-    dnsserverid := -1;\r
+  socketno := tlsocket(sender).tag;\r
+  //writeln('got a reply on socket number ',socketno);\r
+  fillchar(states[socketno].recvpacket,sizeof(states[socketno].recvpacket),0);\r
+  states[socketno].recvpacketlen := twsocket(sender).Receive(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket));\r
+  states[socketno].parsepacket := true;\r
+  if states[socketno].resultaction <> action_done then begin\r
+    //we ignore packets that come after we are done\r
+    if dnsserverids[socketno] >= 0 then begin\r
+      reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000));\r
+      dnsserverids[socketno] := -1;\r
+    end;\r
+  {  writeln('received reply');}\r
+\r
+    asyncprocess(socketno);\r
+    //writeln('processed it');\r
+  end else begin\r
+    //writeln('ignored it because request is done');\r

   end;\r
   end;\r

-{  writeln('received reply');}\r
-  fillchar(state.recvpacket,sizeof(state.recvpacket),0);\r
-  state.recvpacketlen := twsocket(sender).Receive(@state.recvpacket, SizeOf(state.recvpacket));\r
-  state.parsepacket := true;\r
-  asyncprocess;\r

 end;\r
 \r
 end;\r
 \r

-function tdnsasync.sendquery;\r
+function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
+var\r
+  destination : string;\r
+  inaddr : tinetsockaddrv;\r

 begin\r
 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
 begin\r
 {  writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r

+  //writeln('trying to send query on socket number ',socketno);\r

   result := false;\r
   if len = 0 then exit; {no packet}\r
   result := false;\r
   if len = 0 then exit; {no packet}\r

-  if not sockopen then begin\r
-    if addr <> '' then sock.addr := addr else sock.addr := getcurrentsystemnameserver(dnsserverid);//getunixnameservercached;\r
+  if sockets[socketno].state <> wsconnected then begin\r

     startts := unixtimefloat;\r
     if port = '' then port := '53';\r
     startts := unixtimefloat;\r
     if port = '' then port := '53';\r

-    sock.port := port;\r
-    sock.Proto := 'udp';\r
-    sock.ondataavailable := receivehandler;\r
+    sockets[socketno].Proto := 'udp';\r
+    sockets[socketno].ondataavailable := receivehandler;\r

     try\r
     try\r

-      sock.connect;\r
+      sockets[socketno].listen;\r

     except\r
     except\r

-      on e:exception do begin\r
-        //writeln('exception '+e.message);\r
-        exit;\r
-      end;\r
+      result := false;\r
+      exit;\r

     end;\r
     end;\r

-    sockopen := true;\r
+\r
+  end;\r
+  if addr <> '' then begin\r
+    dnsserverids[socketno] := -1;\r
+    destination := addr\r
+  end else begin\r
+    destination := getcurrentsystemnameserver(dnsserverids[socketno]);\r

   end;\r
   end;\r

-  sock.send(@packet,len);\r
+  makeinaddrv(ipstrtobinf(destination),port,inaddr);\r
+  sockets[socketno].sendto(inaddr,sizeof(inaddr), @packet,len);\r

   result := true;\r
   result := true;\r

+\r
+\r

 end;\r
 \r
 end;\r
 \r

-procedure tdnsasync.asyncprocess;\r
+procedure tdnsasync.asyncprocess(socketno:integer);\r

 begin\r
 begin\r

-  state_process(state);\r
-  case state.resultaction of\r
+  state_process(states[socketno]);\r
+  case states[socketno].resultaction of\r

     action_ignore: begin {do nothing} end;\r
     action_done: begin\r
     action_ignore: begin {do nothing} end;\r
     action_done: begin\r

-      onrequestdone(self,0);\r
+      {$ifdef ipv6}\r
+      if (numsockused = 1) or (states[socketno xor 1].resultaction=action_done) then\r
+      //if using two sockets we need to wait until both sockets are in the done\r
+      //state before firing the event\r
+      {$endif}\r
+      begin\r
+        fresultlist := biniplist_new;\r
+        if (numsockused = 1) then begin\r
+          //writeln('processing for one state');\r
+          biniplist_addlist(fresultlist,states[0].resultlist);\r
+        {$ifdef ipv6}\r
+        end else if (requestaf = useaf_preferv6) then begin\r
+          //writeln('processing for two states, ipv6 preference');\r
+          //writeln('merging lists '+biniplist_tostr(states[1].resultlist)+' and '+biniplist_tostr(states[0].resultlist));\r
+          biniplist_addlist(fresultlist,states[1].resultlist);\r
+          biniplist_addlist(fresultlist,states[0].resultlist);\r
+        end else begin\r
+          //writeln('processing for two states, ipv4 preference');\r
+          biniplist_addlist(fresultlist,states[0].resultlist);\r
+          biniplist_addlist(fresultlist,states[1].resultlist);\r
+        {$endif}\r
+        end;\r
+        //writeln(biniplist_tostr(fresultlist));\r
+        onrequestdone(self,0);\r
+      end;\r

     end;\r
     action_sendquery:begin\r
     end;\r
     action_sendquery:begin\r

-      sendquery(state.sendpacket,state.sendpacketlen);\r
+      sendquery(socketno,states[socketno].sendpacket,states[socketno].sendpacketlen);\r

     end;\r
   end;\r
 end;\r
 \r
 procedure tdnsasync.forwardlookup;\r
     end;\r
   end;\r
 end;\r
 \r
 procedure tdnsasync.forwardlookup;\r

+var\r
+  bip : tbinip;\r
+  i : integer;\r

 begin\r
 \r
 begin\r
 \r

-  ipstrtobin(name,state.resultbin);\r
+  ipstrtobin(name,bip);\r
+\r
+  if bip.family <> 0 then begin\r
+    // it was an IP address\r
+    fresultlist := biniplist_new;\r
+    biniplist_add(fresultlist,bip);\r
+    onrequestdone(self,0);\r
+    exit;\r
+  end;\r
+\r
+  if overrideaf = useaf_default then begin\r
+    {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}\r
+    requestaf := useaf;\r
+  end else begin\r
+    requestaf := overrideaf;\r
+  end;\r

 \r
   {$ifdef win32}\r
     if usewindns or (addr = '') then begin\r
 \r
   {$ifdef win32}\r
     if usewindns or (addr = '') then begin\r


@@ -165,15 +243,22 @@ begin
     end;\r
   {$endif}\r
 \r
     end;\r
   {$endif}\r
 \r

-\r
-  if state.resultbin.family <> 0 then begin\r
-    onrequestdone(self,0);\r
-    exit;\r
+  numsockused := 0;\r
+  fresultlist := biniplist_new;\r
+  if (requestaf <> useaf_v6) then begin\r
+    setstate_forward(name,states[numsockused],af_inet);\r
+    inc(numsockused);\r

   end;\r
 \r
   end;\r
 \r

-\r
-  setstate_forward(name,state,forwardfamily);\r
-  asyncprocess;\r
+  {$ifdef ipv6}\r
+    if (requestaf <> useaf_v4) then begin\r
+      setstate_forward(name,states[numsockused],af_inet6);\r
+      inc(numsockused);\r
+    end;\r
+  {$endif}\r
+  for i := 0 to numsockused-1 do begin\r
+    asyncprocess(i);\r
+  end;\r

 \r
 end;\r
 \r
 \r
 end;\r
 \r


@@ -189,42 +274,47 @@ begin
     end;\r
   {$endif}\r
 \r
     end;\r
   {$endif}\r
 \r

-  setstate_reverse(binip,state);\r
-  asyncprocess;\r
+  setstate_reverse(binip,states[0]);\r
+  numsockused := 1;\r
+  asyncprocess(0);\r

 end;\r
 \r
 function tdnsasync.dnsresult;\r
 begin\r
 end;\r
 \r
 function tdnsasync.dnsresult;\r
 begin\r

-  if state.resultstr <> '' then result := state.resultstr else begin\r
-    result := ipbintostr(state.resultbin);\r
+  if states[0].resultstr <> '' then result := states[0].resultstr else begin\r
+    result := ipbintostr(biniplist_get(fresultlist,0));\r

   end;\r
 end;\r
 \r
 procedure tdnsasync.dnsresultbin(var binip:tbinip);\r
 begin\r
   end;\r
 end;\r
 \r
 procedure tdnsasync.dnsresultbin(var binip:tbinip);\r
 begin\r

-  move(state.resultbin,binip,sizeof(binip));\r
+  binip := biniplist_get(fresultlist,0);\r

 end;\r
 \r
 procedure tdnsasync.cancel;\r
 end;\r
 \r
 procedure tdnsasync.cancel;\r

+var\r
+  socketno : integer;\r

 begin\r
   {$ifdef win32}\r
     if assigned(dwas) then begin\r
       dwas.release;\r
       dwas := nil;\r
 begin\r
   {$ifdef win32}\r
     if assigned(dwas) then begin\r
       dwas.release;\r
       dwas := nil;\r

-    end else \r
+    end else\r

   {$endif}\r
   begin\r
   {$endif}\r
   begin\r

+    for socketno := 0 to numsock-1 do begin\r
+      reportlag(dnsserverids[socketno],-1);\r
+      dnsserverids[socketno] := -1;\r

 \r
 \r

-    if dnsserverid >= 0 then begin\r
-      reportlag(dnsserverid,-1);\r
-      dnsserverid := -1;\r
-    end;\r
-    if sockopen then begin\r
-      sock.close;\r
-      sockopen := false;\r
+      sockets[socketno].close;\r

     end;\r
     end;\r

+\r

   end;\r
   end;\r

-  setstate_failure(state);\r
+  for socketno := 0 to numsock-1 do begin\r
+    setstate_failure(states[socketno]);\r
+\r
+  end;\r
+  fresultlist := biniplist_new;\r

   onrequestdone(self,0);\r
 end;\r
 \r
   onrequestdone(self,0);\r
 end;\r
 \r


@@ -233,12 +323,28 @@ end;
  \r
   begin\r
     if dwas.reverse then begin \r
  \r
   begin\r
     if dwas.reverse then begin \r

-      state.resultstr := dwas.name;\r
+      states[0].resultstr := dwas.name;\r

     end else begin \r
     end else begin \r

-      state.resultbin := dwas.ip;\r
-      if (forwardfamily = AF_INET6) and (state.resultbin.family = AF_INET) then begin\r
-        fillchar(state.resultbin,sizeof(tbinip),0);\r
+\r
+      {$ifdef ipv6}\r
+      if (requestaf = useaf_preferv4) then begin\r
+        {prefer mode: sort the IP's}\r
+        fresultlist := biniplist_new;\r
+        addipsoffamily(fresultlist,dwas.iplist,af_inet);\r
+        addipsoffamily(fresultlist,dwas.iplist,af_inet6);\r
+\r
+      end else if (requestaf = useaf_preferv6) then begin\r
+        {prefer mode: sort the IP's}\r
+        fresultlist := biniplist_new;\r
+        addipsoffamily(fresultlist,dwas.iplist,af_inet6);\r
+        addipsoffamily(fresultlist,dwas.iplist,af_inet);\r
+        \r
+      end else\r
+      {$endif}\r
+      begin\r
+        fresultlist := dwas.iplist;\r

       end;\r
       end;\r

+\r

     end;\r
     dwas.release;\r
     onrequestdone(self,error);\r
     end;\r
     dwas.release;\r
     onrequestdone(self,error);\r

diff --git a/dnscore.pas b/dnscore.pas
index ef4c2f1fd660ee4eac3c8076d5938233aefa3d72..600581dface0910f25ddabd48b44fdfbf31e6880 100755 (executable)
--- a/dnscore.pas
+++ b/dnscore.pas
@@ -163,8 +163,7 @@ function makereversename(const binip:tbinip):string;
 procedure setstate_request_init(const name:string;var state:tdnsstate);\r
 \r
 //set up state for a foward lookup. A family value of AF_INET6 will give only\r
 procedure setstate_request_init(const name:string;var state:tdnsstate);\r
 \r
 //set up state for a foward lookup. A family value of AF_INET6 will give only\r

-//ipv6 results. Any other value will give ipv4 results in preference and ipv6\r
-//results if ipv4 results are not available;\r
+//ipv6 results. Any other value will give only ipv4 results\r

 procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);\r
 \r
 procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);\r
 procedure setstate_forward(const name:string;var state:tdnsstate;family:integer);\r
 \r
 procedure setstate_reverse(const binip:tbinip;var state:tdnsstate);\r


@@ -188,14 +187,27 @@ var
   dnsserverlist : tstringlist;\r
 //  currentdnsserverno : integer;\r
 \r
   dnsserverlist : tstringlist;\r
 //  currentdnsserverno : integer;\r
 \r

+\r
+//getcurrentsystemnameserver returns the nameserver the app should use and sets\r
+//id to the id of that nameserver. id should later be used to report how laggy\r
+//the servers response was and if it was timed out.\r

 function getcurrentsystemnameserver(var id:integer) :string;\r
 function getcurrentsystemnameserver(var id:integer) :string;\r

+procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r

 \r
 //var\r
 //  unixnameservercache:string;\r
 { $endif}\r
 \r
 \r
 \r
 //var\r
 //  unixnameservercache:string;\r
 { $endif}\r
 \r
 \r

-procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout\r
+{$ifdef linux}{$ifdef ipv6}\r
+function getv6localips:tbiniplist;\r
+procedure initpreferredmode;\r
+\r
+var\r
+  preferredmodeinited:boolean;\r
+\r
+{$endif}{$endif}\r
+\r

 var\r
   failurereason:string;\r
 \r
 var\r
   failurereason:string;\r
 \r


@@ -516,23 +528,7 @@ begin
 \r
     {no cnames found, no items of correct type found}\r
     if state.forwardfamily <> 0 then goto failure;\r
 \r
     {no cnames found, no items of correct type found}\r
     if state.forwardfamily <> 0 then goto failure;\r

-{$ifdef ipv6}\r
-    if (state.requesttype = querytype_a) then begin\r
-      {v6 only: in case of forward, look for AAAA in alternative section}\r
-      for a := state.numrr1[0]+state.numrr1[1]+state.numrr1[2] to (state.numrr2-1) do begin\r
-        rrptemp := @state.rrdata[1+a*sizeof(trrpointer)];\r
-        rrtemp := rrptemp.p;\r
-        b := rrptemp.len;\r
-        if rrtemp.requesttype = querytype_aaaa then begin\r
-          setstate_return(rrptemp^,b,state);\r
-          exit;\r
-        end;\r
-      end;\r
-      {no AAAA's found in alternative, do a recursive lookup for them}\r
-      state.requesttype := querytype_aaaa;\r
-      goto recursed;\r
-    end;\r
-{$endif}\r
+\r

     goto failure;\r
 recursed:\r
     {here it needs recursed lookup}\r
     goto failure;\r
 recursed:\r
     {here it needs recursed lookup}\r


@@ -703,6 +699,65 @@ begin
 \r
 end;\r
 \r
 \r
 end;\r
 \r

+\r
+\r
+{$ifdef linux}{$ifdef ipv6}\r
+function getv6localips:tbiniplist;\r
+var\r
+  t:textfile;\r
+  s,s2:string;\r
+  ip:tbinip;\r
+  a:integer;\r
+begin\r
+  result := biniplist_new;\r
+\r
+  assignfile(t,'/proc/net/if_inet6');\r
+  {$i-}reset(t);{$i+}\r
+  if ioresult <> 0 then exit; {none found, return empty list}\r
+\r
+  while not eof(t) do begin\r
+    readln(t,s);\r
+    s2 := '';\r
+    for a := 0 to 7 do begin\r
+      if (s2 <> '') then s2 := s2 + ':';\r
+      s2 := s2 + copy(s,(a shl 2)+1,4);\r
+    end;\r
+    ipstrtobin(s2,ip);\r
+    if ip.family <> 0 then biniplist_add(result,ip);\r
+  end;\r
+  closefile(t);\r
+end;\r
+\r
+procedure initpreferredmode;\r
+var\r
+  l:tbiniplist;\r
+  a:integer;\r
+  ip:tbinip;\r
+  ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;\r
+\r
+begin\r
+  if preferredmodeinited then exit;\r
+  if useaf <> useaf_default then exit;\r
+  useaf := useaf_preferv4;\r
+  l := getv6localips;\r
+  ipstrtobin('2000::',ipmask_global);\r
+  ipstrtobin('2001::',ipmask_teredo);\r
+  ipstrtobin('2002::',ipmask_6to4);\r
+  {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}\r
+  for a := biniplist_getcount(l)-1 downto 0 do begin\r
+    ip := biniplist_get(l,a);\r
+    if not comparebinipmask(ip,ipmask_global,3) then continue;\r
+    if comparebinipmask(ip,ipmask_teredo,32) then continue;\r
+    if comparebinipmask(ip,ipmask_6to4,16) then continue;\r
+    useaf := useaf_preferv6;\r
+    preferredmodeinited := true;\r
+    exit;\r
+  end;\r
+end;\r
+\r
+{$endif}{$endif}\r
+\r
+\r

 {  quick and dirty description of dns packet structure to aid writing and\r
    understanding of parser code, refer to appropriate RFCs for proper specs\r
 - all words are network order\r
 {  quick and dirty description of dns packet structure to aid writing and\r
    understanding of parser code, refer to appropriate RFCs for proper specs\r
 - all words are network order\r

diff --git a/dnssync.pas b/dnssync.pas
index 3632b295f3a65a39ebaa88e700a1f6c221faff4c..b682acf378c2df70d84b2a85bb510c6efb570e56 100755 (executable)
--- a/dnssync.pas
+++ b/dnssync.pas
@@ -44,14 +44,7 @@ function forwardlookuplist(name:string;timeout:integer):tbiniplist;
 //details as above\r
 function reverselookup(ip:tbinip;timeout:integer):string;\r
 \r
 //details as above\r
 function reverselookup(ip:tbinip;timeout:integer):string;\r
 \r

-{$ifdef linux}{$ifdef ipv6}\r
-function getv6localips:tbiniplist;\r
-procedure initpreferredmode;\r

 \r
 \r

-var\r
-  preferredmodeinited:boolean;\r
-\r
-{$endif}{$endif}\r

 \r
 const\r
   tswrap=$4000;\r
 \r
 const\r
   tswrap=$4000;\r


@@ -274,16 +267,6 @@ begin
 end;\r
 {$endif}\r
 \r
 end;\r
 {$endif}\r
 \r

-procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);\r
-var\r
-  a:integer;\r
-  biniptemp:tbinip;\r
-begin\r
-  for a := biniplist_getcount(l2)-1 downto 0 do begin\r
-    biniptemp := biniplist_get(l2,a);\r
-    if (biniptemp.family = family) then biniplist_add(l,biniptemp);\r
-  end;\r
-end;\r

 \r
 \r
 function forwardlookuplist(name:string;timeout:integer):tbiniplist;\r
 \r
 \r
 function forwardlookuplist(name:string;timeout:integer):tbiniplist;\r


@@ -383,62 +366,6 @@ begin
   {$endif}\r
 end;\r
 \r
   {$endif}\r
 end;\r
 \r

-{$ifdef linux}{$ifdef ipv6}{$ifdef syncdnscore}\r
-function getv6localips:tbiniplist;\r
-var\r
-  t:textfile;\r
-  s,s2:string;\r
-  ip:tbinip;\r
-  a:integer;\r
-begin\r
-  result := biniplist_new;\r
-\r
-  assignfile(t,'/proc/net/if_inet6');\r
-  {$i-}reset(t);{$i+}\r
-  if ioresult <> 0 then exit; {none found, return empty list}\r
-\r
-  while not eof(t) do begin\r
-    readln(t,s);\r
-    s2 := '';\r
-    for a := 0 to 7 do begin\r
-      if (s2 <> '') then s2 := s2 + ':';\r
-      s2 := s2 + copy(s,(a shl 2)+1,4);\r
-    end;\r
-    ipstrtobin(s2,ip);\r
-    if ip.family <> 0 then biniplist_add(result,ip);\r
-  end;\r
-  closefile(t);\r
-end;\r
-\r
-procedure initpreferredmode;\r
-var\r
-  l:tbiniplist;\r
-  a:integer;\r
-  ip:tbinip;\r
-  ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;\r
-\r
-begin\r
-  if preferredmodeinited then exit;\r
-  if useaf <> useaf_default then exit;\r
-  useaf := useaf_preferv4;\r
-  l := getv6localips;\r
-  ipstrtobin('2000::',ipmask_global);\r
-  ipstrtobin('2001::',ipmask_teredo);\r
-  ipstrtobin('2002::',ipmask_6to4);\r
-  {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}\r
-  for a := biniplist_getcount(l)-1 downto 0 do begin\r
-    ip := biniplist_get(l,a);\r
-    if not comparebinipmask(ip,ipmask_global,3) then continue;\r
-    if comparebinipmask(ip,ipmask_teredo,32) then continue;\r
-    if comparebinipmask(ip,ipmask_6to4,16) then continue;\r
-    useaf := useaf_preferv6;\r
-    preferredmodeinited := true;\r
-    exit;\r
-  end;\r
-end;\r
-\r
-{$endif}{$endif}{$endif}\r
-\r

 {$ifdef win32}\r
   var\r
     wsadata : twsadata;\r
 {$ifdef win32}\r
   var\r
     wsadata : twsadata;\r

diff --git a/dnswin.pas b/dnswin.pas
index ffe472ba18fe2580d0180d8f256afe4e85fbc869..73f97adfc2431c4a28a6b89fcffc3649f45a0b58 100755 (executable)
--- a/dnswin.pas
+++ b/dnswin.pas
@@ -30,7 +30,7 @@ type
   public\r
     onrequestdone:tsocketevent;\r
     name : string;\r
   public\r
     onrequestdone:tsocketevent;\r
     name : string;\r

-    ip : tbinip;\r
+    iplist : tbiniplist;\r

 \r
     procedure forwardlookup(name:string;ipv6preffered:boolean);\r
     procedure reverselookup(ip:tbinip);\r
 \r
     procedure forwardlookup(name:string;ipv6preffered:boolean);\r
     procedure reverselookup(ip:tbinip);\r


@@ -290,7 +290,8 @@ begin
 end;\r
 procedure tdnswinasync.reverselookup(ip:tbinip);\r
 begin\r
 end;\r
 procedure tdnswinasync.reverselookup(ip:tbinip);\r
 begin\r

-  self.ip := ip;\r
+  iplist := biniplist_new;\r
+  biniplist_add(iplist,ip);\r

   freverse := true;\r
   resume;\r
 end;\r
   freverse := true;\r
   resume;\r
 end;\r


@@ -298,14 +299,14 @@ end;
 procedure tdnswinasync.execute;\r
 var\r
   error : integer;\r
 procedure tdnswinasync.execute;\r
 var\r
   error : integer;\r

-  l:tbiniplist;\r
+\r

 begin\r
   error := 0;\r
   if reverse then begin\r
 begin\r
   error := 0;\r
   if reverse then begin\r

-    name := winreverselookup(ip,error);\r
+    name := winreverselookup(biniplist_get(iplist,0),error);\r

   end else begin\r
   end else begin\r

-    l := winforwardlookuplist(name,0,error);\r
-    ip := biniplist_get(l,0);\r
+    iplist := winforwardlookuplist(name,0,error);\r
+\r

   end;\r
   postmessage(hwnddnswin,wm_user,error,taddrint(self));\r
 end;\r
   end;\r
   postmessage(hwnddnswin,wm_user,error,taddrint(self));\r
 end;\r

diff --git a/lcoretest.dpr b/lcoretest.dpr
index 9c4ec7c8a34a69bac28dde4a43bc7610e9c8c215..3770b19b49116b7f6d53ace2bcde91b04fc492f3 100755 (executable)
--- a/lcoretest.dpr
+++ b/lcoretest.dpr
@@ -65,7 +65,7 @@ begin
   receivecount := receivecount +1;\r
   if receivecount >50 then begin\r
     writeln('received over 50 bits of data, pausing to let the operator take a look');\r
   receivecount := receivecount +1;\r
   if receivecount >50 then begin\r
     writeln('received over 50 bits of data, pausing to let the operator take a look');\r

-    readln;\r
+    \r

     receivecount := 0;\r
   end;\r
   while pos(#10,receivebuf) > 0 do begin\r
     receivecount := 0;\r
   end;\r
   while pos(#10,receivebuf) > 0 do begin\r


@@ -82,6 +82,7 @@ end;
 \r
 procedure tsc.sessionconnected(sender: tobject;error : word);\r
 begin\r
 \r
 procedure tsc.sessionconnected(sender: tobject;error : word);\r
 begin\r

+  \r

   if error=0 then begin\r
     writeln('session is connected, local address is'+clientsocket.getxaddr);\r
 \r
   if error=0 then begin\r
     writeln('session is connected, local address is'+clientsocket.getxaddr);\r
 \r


@@ -112,6 +113,7 @@ begin
   das.onrequestdone := sc.dnsrequestdone;\r
   //das.forwardfamily := af_inet6;\r
   das.forwardlookup('irc.ipv6.p10link.net');\r
   das.onrequestdone := sc.dnsrequestdone;\r
   //das.forwardfamily := af_inet6;\r
   das.forwardlookup('irc.ipv6.p10link.net');\r

+  \r

 end;\r
 \r
 procedure tsc.dnsrequestdone(sender:tobject;error : word);\r
 end;\r
 \r
 procedure tsc.dnsrequestdone(sender:tobject;error : word);\r


@@ -126,7 +128,7 @@ begin
   clientsocket.addr := tempbiniplist;\r
   clientsocket.port := '6667';\r
   clientsocket.connect;\r
   clientsocket.addr := tempbiniplist;\r
   clientsocket.port := '6667';\r
   clientsocket.connect;\r

-  writeln(clientsocket.getxaddr);\r
+  //writeln(clientsocket.getxaddr);\r

   das.free;\r
 end;\r
 \r
   das.free;\r
 end;\r
 \r