-{ Copyright (C) 2005 Bas Steendijk and Peter Green\r
- For conditions of distribution and use, see copyright notice in zlib_license.txt\r
- which is included in the package\r
- ----------------------------------------------------------------------------- }\r
-\r
-//FIXME: this code only ever seems to use one dns server for a request and does\r
-//not seem to have any form of retry code.\r
-\r
-unit dnsasync;\r
-\r
-interface\r
-\r
-uses\r
- {$ifdef win32}\r
- dnswin,\r
- {$endif}\r
- lsocket,lcore,\r
- classes,binipstuff,dnscore,btime;\r
-\r
-\r
-type\r
- //after completion or cancelation a dnswinasync may be reused\r
- tdnsasync=class(tcomponent)\r
-\r
- private\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
-\r
- state:tdnsstate;\r
-\r
- dnsserverid:integer;\r
- startts:double;\r
- {$ifdef win32}
- dwas : tdnswinasync;\r
- {$endif}
-\r
-\r
- procedure asyncprocess;\r
- procedure receivehandler(sender:tobject;error:word);\r
- function sendquery(const packet:tdnspacket;len:integer):boolean;\r
- {$ifdef win32}
- procedure winrequestdone(sender:tobject;error:word);\r
- {$endif}
- 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
- //because it limits the app to one dns server but is kept for compatibility\r
- //and special uses.\r
- addr,port:string;\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
-\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
- procedure forwardlookup(const name:string); //start forward lookup,\r
- //preffering ipv4\r
- procedure reverselookup(const binip:tbinip); //start reverse lookup\r
-\r
- constructor create(aowner:tcomponent); override;\r
- destructor destroy; override;\r
-\r
- end;\r
-\r
-implementation\r
-\r
-uses sysutils;\r
-\r
-constructor tdnsasync.create;\r
-begin\r
- inherited create(aowner);\r
- dnsserverid := -1;\r
- sock := twsocket.create(self);\r
-end;\r
-\r
-destructor tdnsasync.destroy;\r
-begin\r
- if dnsserverid >= 0 then begin\r
- reportlag(dnsserverid,-1);\r
- dnsserverid := -1;\r
- end;\r
- sock.release;\r
- setstate_request_init('',state);\r
- inherited destroy;\r
-end;\r
-\r
-procedure tdnsasync.receivehandler;\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
-end;\r
-\r
-function tdnsasync.sendquery;\r
-begin\r
-{ writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\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 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
- end;\r
- end;\r
- sockopen := true;\r
- end;\r
- sock.send(@packet,len);\r
- result := true;\r
-end;\r
-\r
-procedure tdnsasync.asyncprocess;\r
-begin\r
- state_process(state);\r
- case state.resultaction of\r
- action_ignore: begin {do nothing} end;\r
- action_done: begin\r
- onrequestdone(self,0);\r
- end;\r
- action_sendquery:begin\r
- sendquery(state.sendpacket,state.sendpacketlen);\r
- end;\r
- end;\r
-end;\r
-\r
-procedure tdnsasync.forwardlookup;\r
-begin\r
- {$ifdef win32}\r
- if usewindns or (addr = '') 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
- end;\r
- {$endif}\r
-\r
- ipstrtobin(name,state.resultbin);\r
- if state.resultbin.family <> 0 then begin\r
- onrequestdone(self,0);\r
- exit;\r
- end;\r
-\r
-\r
- setstate_forward(name,state,forwardfamily);\r
- asyncprocess;\r
-\r
-end;\r
-\r
-procedure tdnsasync.reverselookup;\r
-\r
-begin\r
- {$ifdef win32}\r
- if usewindns or (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
-end;\r
-\r
-function tdnsasync.dnsresult;\r
-begin\r
- if state.resultstr <> '' then result := state.resultstr else begin\r
- result := ipbintostr(state.resultbin);\r
- end;\r
-end;\r
-\r
-procedure tdnsasync.dnsresultbin(var binip:tbinip);\r
-begin\r
- move(state.resultbin,binip,sizeof(binip));\r
-end;\r
-\r
-procedure tdnsasync.cancel;\r
-begin\r
- {$ifdef win32}
- if assigned(dwas) then begin\r
- dwas.release;\r
- dwas := nil;\r
- end else
- {$endif}
- begin\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
- end;\r
- end;\r
- setstate_failure(state);\r
- onrequestdone(self,0);\r
-end;\r
-\r
-{$ifdef win32}
- procedure tdnsasync.winrequestdone(sender:tobject;error:word);\r
- begin\r
- if dwas.reverse then begin \r
- state.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
- end;\r
- end;\r
- dwas.release;\r
- onrequestdone(self,error);\r
- end;\r
-{$endif}
-end.\r
lcore.org gitweb / lcore.git / blobdiff