X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/baf753e54d73673524de916757e66ef8c485bc0d..d53fe26eaac895d1e7a0ba2b2b8965cf77932de8:/dnsasync.pas?ds=sidebyside
diff --git a/dnsasync.pas b/dnsasync.pas
index 0a32459..7a10bbf 100755
--- a/dnsasync.pas
+++ b/dnsasync.pas
@@ -17,8 +17,11 @@ uses
lsocket,lcore,
classes,binipstuff,dnscore,btime;
+const
+ numsock=1{$ifdef ipv6}+1{$endif};
type
+
//after completion or cancelation a dnswinasync may be reused
tdnsasync=class(tcomponent)
@@ -26,26 +29,26 @@ type
//made a load of stuff private that does not appear to be part of the main
//public interface. If you make any of it public again please consider the
//consequences when using windows dns. --plugwash.
- sock:twsocket;
-
- sockopen:boolean;
-
+ sockets: array[0..numsock-1] of tlsocket;
- state:tdnsstate;
+ states: array[0..numsock-1] of tdnsstate;
- dnsserverid:integer;
+ dnsserverids : array[0..numsock-1] of integer;
startts:double;
{$ifdef win32}
dwas : tdnswinasync;
{$endif}
-
- procedure asyncprocess;
+ numsockused : integer;
+ fresultlist : tbiniplist;
+ requestaf : integer;
+ procedure asyncprocess(socketno:integer);
procedure receivehandler(sender:tobject;error:word);
- function sendquery(const packet:tdnspacket;len:integer):boolean;
+ function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;
{$ifdef win32}
procedure winrequestdone(sender:tobject;error:word);
{$endif}
+
public
onrequestdone:tsocketevent;
@@ -55,6 +58,8 @@ type
//and special uses.
addr,port:string;
+ 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;
@@ -63,6 +68,7 @@ type
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
+ property dnsresultlist : tbiniplist read fresultlist;
procedure forwardlookup(const name:string); //start forward lookup,
//preffering ipv4
procedure reverselookup(const binip:tbinip); //start reverse lookup
@@ -79,78 +85,150 @@ uses sysutils;
constructor tdnsasync.create;
begin
inherited create(aowner);
- dnsserverid := -1;
- sock := twsocket.create(self);
+ dnsserverids[0] := -1;
+ sockets[0] := twsocket.create(self);
+ sockets[0].tag := 0;
+ {$ifdef ipv6}
+ dnsserverids[1] := -1;
+ sockets[1] := twsocket.Create(self);
+ sockets[1].tag := 1;
+ {$endif}
end;
destructor tdnsasync.destroy;
+var
+ socketno : integer;
begin
- if dnsserverid >= 0 then begin
- reportlag(dnsserverid,-1);
- dnsserverid := -1;
+ for socketno := 0 to numsock -1 do begin
+ if dnsserverids[socketno] >= 0 then begin
+ reportlag(dnsserverids[socketno],-1);
+ dnsserverids[socketno] := -1;
+ end;
+ sockets[socketno].release;
+ setstate_request_init('',states[socketno]);
end;
- sock.release;
- setstate_request_init('',state);
inherited destroy;
end;
-procedure tdnsasync.receivehandler;
+procedure tdnsasync.receivehandler(sender:tobject;error:word);
+var
+ socketno : integer;
begin
- if dnsserverid >= 0 then begin
- reportlag(dnsserverid,trunc((unixtimefloat-startts)*1000));
- dnsserverid := -1;
+ 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));
+ 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));
+ dnsserverids[socketno] := -1;
+ end;
+ { writeln('received reply');}
+
+ asyncprocess(socketno);
+ //writeln('processed it');
+ end else begin
+ //writeln('ignored it because request is done');
end;
-{ writeln('received reply');}
- fillchar(state.recvpacket,sizeof(state.recvpacket),0);
- state.recvpacketlen := twsocket(sender).Receive(@state.recvpacket, SizeOf(state.recvpacket));
- state.parsepacket := true;
- asyncprocess;
end;
-function tdnsasync.sendquery;
+function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;
+var
+ destination : string;
+ inaddr : tinetsockaddrv;
begin
{ writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
+ //writeln('trying to send query on socket number ',socketno);
result := false;
if len = 0 then exit; {no packet}
- if not sockopen then begin
- if addr <> '' then sock.addr := addr else sock.addr := getcurrentsystemnameserver(dnsserverid);//getunixnameservercached;
+ if sockets[socketno].state <> wsconnected then begin
startts := unixtimefloat;
if port = '' then port := '53';
- sock.port := port;
- sock.Proto := 'udp';
- sock.ondataavailable := receivehandler;
+ sockets[socketno].Proto := 'udp';
+ sockets[socketno].ondataavailable := receivehandler;
try
- sock.connect;
+ sockets[socketno].listen;
except
- on e:exception do begin
- //writeln('exception '+e.message);
- exit;
- end;
+ result := false;
+ exit;
end;
- sockopen := true;
+
+ end;
+ if addr <> '' then begin
+ dnsserverids[socketno] := -1;
+ destination := addr
+ end else begin
+ destination := getcurrentsystemnameserver(dnsserverids[socketno]);
end;
- sock.send(@packet,len);
+ makeinaddrv(ipstrtobinf(destination),port,inaddr);
+ sockets[socketno].sendto(inaddr,sizeof(inaddr), @packet,len);
result := true;
+
+
end;
-procedure tdnsasync.asyncprocess;
+procedure tdnsasync.asyncprocess(socketno:integer);
begin
- state_process(state);
- case state.resultaction of
+ state_process(states[socketno]);
+ case states[socketno].resultaction of
action_ignore: begin {do nothing} end;
action_done: begin
- onrequestdone(self,0);
+ {$ifdef ipv6}
+ if (numsockused = 1) or (states[socketno xor 1].resultaction=action_done) then
+ //if using two sockets we need to wait until both sockets are in the done
+ //state before firing the event
+ {$endif}
+ begin
+ fresultlist := biniplist_new;
+ if (numsockused = 1) then begin
+ //writeln('processing for one state');
+ biniplist_addlist(fresultlist,states[0].resultlist);
+ {$ifdef ipv6}
+ end else if (requestaf = useaf_preferv6) then begin
+ //writeln('processing for two states, ipv6 preference');
+ //writeln('merging lists '+biniplist_tostr(states[1].resultlist)+' and '+biniplist_tostr(states[0].resultlist));
+ biniplist_addlist(fresultlist,states[1].resultlist);
+ biniplist_addlist(fresultlist,states[0].resultlist);
+ end else begin
+ //writeln('processing for two states, ipv4 preference');
+ biniplist_addlist(fresultlist,states[0].resultlist);
+ biniplist_addlist(fresultlist,states[1].resultlist);
+ {$endif}
+ end;
+ //writeln(biniplist_tostr(fresultlist));
+ onrequestdone(self,0);
+ end;
end;
action_sendquery:begin
- sendquery(state.sendpacket,state.sendpacketlen);
+ sendquery(socketno,states[socketno].sendpacket,states[socketno].sendpacketlen);
end;
end;
end;
procedure tdnsasync.forwardlookup;
+var
+ bip : tbinip;
+ i : integer;
begin
- ipstrtobin(name,state.resultbin);
+ ipstrtobin(name,bip);
+
+ if bip.family <> 0 then begin
+ // it was an IP address
+ fresultlist := biniplist_new;
+ biniplist_add(fresultlist,bip);
+ onrequestdone(self,0);
+ exit;
+ end;
+
+ if overrideaf = useaf_default then begin
+ {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}
+ requestaf := useaf;
+ end else begin
+ requestaf := overrideaf;
+ end;
{$ifdef win32}
if usewindns or (addr = '') then begin
@@ -165,15 +243,22 @@ begin
end;
{$endif}
-
- if state.resultbin.family <> 0 then begin
- onrequestdone(self,0);
- exit;
+ numsockused := 0;
+ fresultlist := biniplist_new;
+ if (requestaf <> useaf_v6) then begin
+ setstate_forward(name,states[numsockused],af_inet);
+ inc(numsockused);
end;
-
- setstate_forward(name,state,forwardfamily);
- asyncprocess;
+ {$ifdef ipv6}
+ if (requestaf <> useaf_v4) then begin
+ setstate_forward(name,states[numsockused],af_inet6);
+ inc(numsockused);
+ end;
+ {$endif}
+ for i := 0 to numsockused-1 do begin
+ asyncprocess(i);
+ end;
end;
@@ -189,42 +274,47 @@ begin
end;
{$endif}
- setstate_reverse(binip,state);
- asyncprocess;
+ setstate_reverse(binip,states[0]);
+ numsockused := 1;
+ asyncprocess(0);
end;
function tdnsasync.dnsresult;
begin
- if state.resultstr <> '' then result := state.resultstr else begin
- result := ipbintostr(state.resultbin);
+ if states[0].resultstr <> '' then result := states[0].resultstr else begin
+ result := ipbintostr(biniplist_get(fresultlist,0));
end;
end;
procedure tdnsasync.dnsresultbin(var binip:tbinip);
begin
- move(state.resultbin,binip,sizeof(binip));
+ binip := biniplist_get(fresultlist,0);
end;
procedure tdnsasync.cancel;
+var
+ socketno : integer;
begin
{$ifdef win32}
if assigned(dwas) then begin
dwas.release;
dwas := nil;
- end else
+ end else
{$endif}
begin
+ for socketno := 0 to numsock-1 do begin
+ reportlag(dnsserverids[socketno],-1);
+ dnsserverids[socketno] := -1;
- if dnsserverid >= 0 then begin
- reportlag(dnsserverid,-1);
- dnsserverid := -1;
- end;
- if sockopen then begin
- sock.close;
- sockopen := false;
+ sockets[socketno].close;
end;
+
end;
- setstate_failure(state);
+ for socketno := 0 to numsock-1 do begin
+ setstate_failure(states[socketno]);
+
+ end;
+ fresultlist := biniplist_new;
onrequestdone(self,0);
end;
@@ -233,12 +323,28 @@ end;
begin
if dwas.reverse then begin
- state.resultstr := dwas.name;
+ states[0].resultstr := dwas.name;
end else begin
- state.resultbin := dwas.ip;
- if (forwardfamily = AF_INET6) and (state.resultbin.family = AF_INET) then begin
- fillchar(state.resultbin,sizeof(tbinip),0);
+
+ {$ifdef ipv6}
+ if (requestaf = useaf_preferv4) then begin
+ {prefer mode: sort the IP's}
+ fresultlist := biniplist_new;
+ addipsoffamily(fresultlist,dwas.iplist,af_inet);
+ addipsoffamily(fresultlist,dwas.iplist,af_inet6);
+
+ end else if (requestaf = useaf_preferv6) then begin
+ {prefer mode: sort the IP's}
+ fresultlist := biniplist_new;
+ addipsoffamily(fresultlist,dwas.iplist,af_inet6);
+ addipsoffamily(fresultlist,dwas.iplist,af_inet);
+
+ end else
+ {$endif}
+ begin
+ fresultlist := dwas.iplist;
end;
+
end;
dwas.release;
onrequestdone(self,error);