//not seem to have any form of retry code.\r
\r
unit dnsasync;\r
-\r
+{$ifdef fpc}\r
+ {$mode delphi}\r
+{$endif}\r
interface\r
\r
+{$include lcoreconfig.inc}\r
+\r
uses\r
- {$ifdef win32}\r
+ {$ifdef winasyncdns}\r
dnswin,\r
{$endif}\r
lsocket,lcore,\r
- classes,binipstuff,dnscore,btime;\r
+ classes,binipstuff,dnscore,btime,lcorernd;\r
\r
+const\r
+ numsock=1{$ifdef ipv6}+1{$endif};\r
\r
type\r
+\r
//after completion or cancelation a dnswinasync may be reused\r
tdnsasync=class(tcomponent)\r
\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
+ sockets: array[0..numsock-1] of tlsocket;\r
\r
- sockopen:boolean;\r
+ states: array[0..numsock-1] of tdnsstate;\r
\r
+ destinations: array[0..numsock-1] of tbinip;\r
\r
- state:tdnsstate;\r
-\r
- dnsserverid:integer;\r
+ dnsserverids : array[0..numsock-1] of integer;\r
startts:double;\r
- {$ifdef win32}\r
+ {$ifdef winasyncdns}\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
- function sendquery(const packet:tdnspacket;len:integer):boolean;\r
- {$ifdef win32}\r
+ function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
+ {$ifdef winasyncdns}\r
procedure winrequestdone(sender:tobject;error:word);\r
{$endif}\r
+\r
public\r
onrequestdone:tsocketevent;\r
\r
//addr and port allow the application to specify a dns server specifically\r
- //for this dnsasync object. This is not a reccomended mode of operation\r
+ //for this dnsasync object. This is not a recommended mode of operation\r
//because it limits the app to one dns server but is kept for compatibility\r
//and special uses.\r
- addr,port:string;\r
+ addr,port:ansistring;\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
- forwardfamily:integer;\r
+ overrideaf : integer;\r
\r
procedure cancel;//cancel an outstanding dns request\r
- function dnsresult:string; //get result of dnslookup as a string\r
+ function dnsresult:ansistring; //get result of dnslookup as a string\r
procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip\r
- procedure forwardlookup(const name:string); //start forward lookup,\r
- //preffering ipv4\r
+ property dnsresultlist : tbiniplist read fresultlist;\r
+ procedure forwardlookup(const name:ansistring); //start forward lookup,\r
+ //preferring ipv4\r
procedure reverselookup(const binip:tbinip); //start reverse lookup\r
+ procedure customlookup(const name:ansistring;querytype:integer); //start custom type lookup\r
\r
constructor create(aowner:tcomponent); override;\r
destructor destroy; override;\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
+var\r
+ socketno : integer;\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 assigned(sockets[socketno]) then 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
+\r
+ {$ifdef winasyncdns}\r
+ if assigned(dwas) then begin\r
+ dwas.release;\r
+ dwas := nil;\r
+ end;\r
+ {$endif}\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
+ Src : TInetSockAddrV;\r
+ SrcLen : Integer;\r
+ fromip:tbinip;\r
+ fromport:ansistring;\r
begin\r
- if dnsserverid >= 0 then begin\r
- reportlag(dnsserverid,trunc((unixtimefloat-startts)*1000));\r
- dnsserverid := -1;\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
+ socketno := tlsocket(sender).tag;\r
+ //writeln('got a reply on socket number ',socketno);\r
+ fillchar(states[socketno].recvpacket,sizeof(states[socketno].recvpacket),0);\r
+\r
+ SrcLen := SizeOf(Src);\r
+ states[socketno].recvpacketlen := twsocket(sender).ReceiveFrom(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket), Src, SrcLen);\r
+\r
+ fromip := inaddrvtobinip(Src);\r
+ fromport := inttostr(htons(src.InAddr.port));\r
+\r
+ if ((not comparebinip(fromip,destinations[socketno])) or (fromport <> port)) then begin\r
+ // writeln('dnsasync received from wrong IP:port ',ipbintostr(fromip),'#',fromport,', expected ',ipbintostr(destinations[socketno]),'#',port);\r
+ exit;\r
+ end;\r
+\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((wintimefloat-startts)*1000000));\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
\r
-function tdnsasync.sendquery;\r
+function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean;\r
+var\r
+ destination : tbinip;\r
+ inaddr : tinetsockaddrv;\r
+ trytolisten:integer;\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
- if not sockopen then begin\r
- if addr <> '' then sock.addr := addr else sock.addr := getcurrentsystemnameserver(dnsserverid);//getunixnameservercached;\r
- startts := unixtimefloat;\r
+ if sockets[socketno].state <> wsconnected then begin\r
+ startts := wintimefloat;\r
if port = '' then port := '53';\r
- sock.port := port;\r
- sock.Proto := 'udp';\r
- sock.ondataavailable := receivehandler;\r
- try\r
- sock.connect;\r
- except\r
- on e:exception do begin\r
- //writeln('exception '+e.message);\r
- exit;\r
+ sockets[socketno].Proto := 'udp';\r
+ sockets[socketno].ondataavailable := receivehandler;\r
+\r
+ {we are going to bind on a random local port for the DNS request, against the kaminsky attack\r
+ there is a small chance that we're trying to bind on an already used port, so retry a few times}\r
+ for trytolisten := 3 downto 0 do begin\r
+ try\r
+ sockets[socketno].port := inttostr(1024 + randominteger(65536 - 1024));\r
+ sockets[socketno].listen;\r
+ except\r
+ {writeln('failed to listen ',sockets[socketno].localport,' ',trytolisten);}\r
+ if (trytolisten = 0) then begin\r
+ result := false;\r
+ exit;\r
+ end;\r
end;\r
end;\r
- sockopen := true;\r
+\r
+ end;\r
+ if addr <> '' then begin\r
+ dnsserverids[socketno] := -1;\r
+ destination := ipstrtobinf(addr);\r
+ end else begin\r
+ destination := getcurrentsystemnameserverbin(dnsserverids[socketno]);\r
end;\r
- sock.send(@packet,len);\r
+ destinations[socketno] := destination;\r
+\r
+ {$ifdef ipv6}{$ifdef mswindows}\r
+ if destinations[socketno].family = AF_INET6 then if (requestaf = useaf_default) then requestaf := useaf_preferv6;\r
+ {$endif}{$endif}\r
+\r
+ makeinaddrv(destinations[socketno],port,inaddr);\r
+ sockets[socketno].sendto(inaddr,sizeof(inaddr), @packet,len);\r
result := true;\r
+\r
+\r
end;\r
\r
-procedure tdnsasync.asyncprocess;\r
+procedure tdnsasync.asyncprocess(socketno:integer);\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
- 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
- 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
+var\r
+ bip : tbinip;\r
+ i : integer;\r
begin\r
+ ipstrtobin(name,bip);\r
\r
- ipstrtobin(name,state.resultbin);\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 ipv6}\r
+ {$ifdef winasyncdns}if not (usewindns and (addr = '') and (overridednsserver = '')) then{$endif}\r
+ initpreferredmode;\r
+ {$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
+ {$ifdef winasyncdns}\r
+ if usewindns and (addr = '') and (overridednsserver = '') then begin\r
dwas := tdnswinasync.create;\r
dwas.onrequestdone := winrequestdone;\r
- if forwardfamily = AF_INET6 then begin\r
- dwas.forwardlookup(name,true);\r
- end else begin\r
- dwas.forwardlookup(name,false);\r
- end;\r
+\r
+ dwas.forwardlookup(name);\r
+\r
exit;\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
+ {$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
\r
- setstate_forward(name,state,forwardfamily);\r
- asyncprocess;\r
-\r
+ for i := 0 to numsockused-1 do begin\r
+ asyncprocess(i);\r
+ end;\r
end;\r
\r
procedure tdnsasync.reverselookup;\r
-\r
begin\r
- {$ifdef win32}\r
- if usewindns or (addr = '') then begin\r
+ {$ifdef winasyncdns}\r
+ if usewindns and (addr = '') then begin\r
dwas := tdnswinasync.create;\r
dwas.onrequestdone := winrequestdone;\r
dwas.reverselookup(binip);\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
+procedure tdnsasync.customlookup;\r
+begin\r
+ setstate_custom(name,querytype,states[0]);\r
+ numsockused := 1;\r
+ asyncprocess(0);\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
- move(state.resultbin,binip,sizeof(binip));\r
+ binip := biniplist_get(fresultlist,0);\r
end;\r
\r
procedure tdnsasync.cancel;\r
+var\r
+ socketno : integer;\r
begin\r
- {$ifdef win32}\r
+ {$ifdef winasyncdns}\r
if assigned(dwas) then begin\r
dwas.release;\r
dwas := nil;\r
- end else \r
+ end else\r
{$endif}\r
begin\r
+ for socketno := 0 to numsock-1 do begin\r
+ reportlag(dnsserverids[socketno],-1);\r
+ dnsserverids[socketno] := -1;\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
+\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
-{$ifdef win32}\r
+{$ifdef winasyncdns}\r
procedure tdnsasync.winrequestdone(sender:tobject;error:word);\r
\r
begin\r
- if dwas.reverse then begin \r
- state.resultstr := dwas.name;\r
+ if dwas.reverse then begin\r
+ states[0].resultstr := dwas.name;\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
+\r
end;\r
dwas.release;\r
onrequestdone(self,error);\r
lcore.org gitweb / lcore.git / blobdiff