X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b..2f03297fba2a10dbc860018fac7ad07c83b08ce8:/dnswin.pas

diff --git a/dnswin.pas b/dnswin.pas
index 7d986d1..e9c2a16 100755
--- a/dnswin.pas
+++ b/dnswin.pas
@@ -1,12 +1,15 @@
 unit dnswin;
 
 interface
+
 uses binipstuff,classes,lcore;
 
+{$include lcoreconfig.inc}
+
 //on failure a null string or zeroed out binip will be retuned and error will be
 //set to a windows error code (error will be left untouched under non error
 //conditions).
-function winforwardlookup(name : string;ipv6preffered : boolean;var error:integer) : tbinip;
+function winforwardlookuplist(name : string;familyhint:integer;var error : integer) : tbiniplist;
 function winreverselookup(ip:tbinip;var error:integer):string;
 
 
@@ -17,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;
@@ -27,9 +29,9 @@ type
   public
     onrequestdone:tsocketevent;
     name : string;
-    ip : tbinip;
+    iplist : tbiniplist;
 
-    procedure forwardlookup(name:string;ipv6preffered:boolean);
+    procedure forwardlookup(name:string);
     procedure reverselookup(ip:tbinip);
     destructor destroy; override;
     procedure release;
@@ -64,9 +66,15 @@ var
   freeaddrinfo : tfreeaddrinfo;
   getnameinfo : tgetnameinfo;
 procedure v4onlyfreeaddrinfo(ai : paddrinfo); stdcall;
+var
+  next:paddrinfo;
 begin
-  freemem(ai.ai_addr);
-  freemem(ai);
+  while assigned(ai) do begin
+    freemem(ai.ai_addr);
+    next := ai.ai_next;
+    freemem(ai);
+    ai := next;
+  end;
 end;
 
 type
@@ -75,31 +83,45 @@ type
 
 function v4onlygetaddrinfo(nodename : pchar; servname : pchar; hints : paddrinfo;res : ppaddrinfo) : longint; stdcall;
 var
-  output : paddrinfo;
+  output,prev,first : paddrinfo;
   hostent : phostent;
+  addrlist:^pointer;
 begin
-  if hints.ai_family = af_inet then begin
+  if hints.ai_family <> af_inet6 then begin
     result := 0;
-    getmem(output,sizeof(taddrinfo));
-    getmem(output.ai_addr,sizeof(tinetsockaddr));
-    output.ai_addr.InAddr.family := af_inet;
-    if servname <> nil then output.ai_addr.InAddr.port := htons(strtoint(servname)) else output.ai_addr.InAddr.port := 0;
+
+
     hostent := gethostbyname(nodename);
     if hostent = nil then begin
       result := wsagetlasterror;
       v4onlyfreeaddrinfo(output);
       exit;
     end;
-    output.ai_addr.InAddr.addr := pplongint(hostent.h_addr_list)^^;
-    output.ai_flags := 0;
-    output.ai_family := af_inet;
-    output.ai_socktype := 0;
-    output.ai_protocol := 0;
-    output.ai_addrlen := sizeof(tinetsockaddr);
-    output.ai_canonname := nil;
-    output.ai_next := nil;
-
-    res^ := output;
+    addrlist := pointer(hostent.h_addr_list);
+
+    //ipint := pplongint(hostent.h_addr_list)^^;
+    prev := nil;
+    first := nil;
+    repeat
+      if not assigned(addrlist^) then break;
+
+      getmem(output,sizeof(taddrinfo));
+      if assigned(prev) then prev.ai_next := output;
+      getmem(output.ai_addr,sizeof(tinetsockaddr));
+      if servname <> nil then output.ai_addr.InAddr.port := htons(strtoint(servname)) else output.ai_addr.InAddr.port := 0;
+      output.ai_addr.InAddr.addr := longint(addrlist^^);
+      inc(integer(addrlist),4);
+      output.ai_flags := 0;
+      output.ai_family := af_inet;
+      output.ai_socktype := 0;
+      output.ai_protocol := 0;
+      output.ai_addrlen := sizeof(tinetsockaddr);
+      output.ai_canonname := nil;
+      output.ai_next := nil;
+      prev := output;
+      if not assigned(first) then first := output;
+    until false;
+    res^ := first;
   end else begin
     result := WSANO_RECOVERY;
   end;
@@ -159,44 +181,46 @@ begin
 end;
 
 
-function winforwardlookup(name : string;ipv6preffered : boolean;var error : integer) : tbinip;
+function winforwardlookuplist(name : string;familyhint:integer;var error : integer) : tbiniplist;
 var
   hints: taddrinfo;
-  res : paddrinfo;
-  pass : boolean;
-  ipv6 : boolean;
+  res0,res : paddrinfo;
   getaddrinforesult : integer;
+  biniptemp:tbinip;
 begin
   populateprocvars;
 
-  for pass := false to true do begin
-    ipv6 := ipv6preffered xor pass;
-    hints.ai_flags := 0;
-    if ipv6 then begin
-      hints.ai_family := AF_INET6;
-    end else begin
-      hints.ai_family := AF_INET;
-    end;
-    hints.ai_socktype := 0;
-    hints.ai_protocol := 0;
-    hints.ai_addrlen := 0;
-    hints.ai_canonname := nil;
-    hints.ai_addr := nil;
-    hints.ai_next := nil;
-    getaddrinforesult := getaddrinfo(pchar(name),'1',@hints,@res);
-    if getaddrinforesult = 0 then begin
+  hints.ai_flags := 0;
+  hints.ai_family := familyhint;
+  hints.ai_socktype := 0;
+  hints.ai_protocol := 0;
+  hints.ai_addrlen := 0;
+  hints.ai_canonname := nil;
+  hints.ai_addr := nil;
+  hints.ai_next := nil;
+  getaddrinforesult := getaddrinfo(pchar(name),'1',@hints,@res);
+  res0 := res;
+  result := biniplist_new;
+  if getaddrinforesult = 0 then begin
+
+    while assigned(res) do begin
       if res.ai_family = af_inet then begin
-        result.family := af_inet;
-        result.ip := res.ai_addr.InAddr.addr;
-      end else {$ifdef ipv6}if res.ai_family = af_inet6 then begin
-        result.family := af_inet6;
-        result.ip6 := res.ai_addr.InAddr6.sin6_addr;
-      end;{$endif};
-
-      freeaddrinfo(res);
-      exit;
+        biniptemp.family := af_inet;
+        biniptemp.ip := res.ai_addr.InAddr.addr;
+        biniplist_add(result,biniptemp);
+      {$ifdef ipv6}
+      end else if res.ai_family = af_inet6 then begin
+        biniptemp.family := af_inet6;
+        biniptemp.ip6 := res.ai_addr.InAddr6.sin6_addr;
+        biniplist_add(result,biniptemp);
+      {$endif}
+      end;
+      res := res.ai_next;
     end;
+    freeaddrinfo(res0);
+    exit;
   end;
+
   if getaddrinforesult <> 0 then begin
     fillchar(result,0,sizeof(result));
     error := getaddrinforesult;
@@ -209,17 +233,7 @@ var
   getnameinforesult : integer;
 begin
 
-  if ip.family = AF_INET then begin
-    sa.InAddr.family := AF_INET;
-    sa.InAddr.port := 1;
-    sa.InAddr.addr := ip.ip;
-  end else {$ifdef ipv6}if ip.family = AF_INET6 then begin
-    sa.InAddr6.sin6_family  := AF_INET6;
-    sa.InAddr6.sin6_port := 1;
-    sa.InAddr6.sin6_addr := ip.ip6;
-  end else{$endif} begin
-    raise exception.create('unrecognised address family');
-  end;
+  makeinaddrv(ip,'1',sa);
   populateprocvars;
   setlength(result,1025);
   getnameinforesult := getnameinfo(@sa,sizeof(tinetsockaddrv),pchar(result),length(result),nil,0,0);
@@ -256,35 +270,36 @@ 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;
 procedure tdnswinasync.reverselookup(ip:tbinip);
 begin
-  self.ip := ip;
+  iplist := biniplist_new;
+  biniplist_add(iplist,ip);
   freverse := true;
   resume;
 end;
+
 procedure tdnswinasync.execute;
 var
   error : integer;
+
 begin
   error := 0;
   if reverse then begin
-    name := winreverselookup(ip,error);
+    name := winreverselookup(biniplist_get(iplist,0),error);
   end else begin
-    ip := winforwardlookup(name,ipv6preffered,error);
+    iplist := winforwardlookuplist(name,0,error);
 
   end;
-
   postmessage(hwnddnswin,wm_user,error,taddrint(self));
 end;
 
-destructor tdnswinasync.destroy; 
+destructor tdnswinasync.destroy;
 begin
   WaitFor;
   inherited destroy;