X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b..40b538b4671a190ea35502207562edabfcea539b:/dnswin.pas?ds=inline
diff --git a/dnswin.pas b/dnswin.pas
index 7d986d1..573c888 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(sa,ip);
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;