-{ 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
-unit dnssync;\r
-{$ifdef fpc}\r
- {$mode delphi}\r
-{$endif}\r
-\r
-interface\r
- uses\r
- dnscore,\r
- binipstuff,\r
- {$ifdef win32}\r
- winsock,\r
- windows,\r
- {$else}\r
- {$ifdef VER1_0}\r
- linux,\r
- {$else}\r
- baseunix,unix,\r
- {$endif}\r
- sockets,\r
- fd_utils,\r
- {$endif}\r
- sysutils;\r
-\r
-//convert a name to an IP\r
-//IPV4 is preffered if availible, if not IPV6 will be returned (if ipv6 support\r
-//compiled in)\r
-//on error the binip will have a family of 0 (other fiels are also currently\r
-//zeroed out but may be used for further error information in future)\r
-//timeout is in seconds, it is ignored when using windows dns\r
-function forwardlookup(name:string;timeout:integer):tbinip;\r
-\r
-\r
-//convert an IP to a name, on error a null string will be returned, other \r
-//details as above\r
-function reverselookup(ip:tbinip;timeout:integer):string;\r
-\r
-\r
-var\r
- dnssyncserver:string;\r
- id : integer;\r
- {$ifdef win32}\r
- sendquerytime : integer;\r
- {$else}\r
- sendquerytime : ttimeval;\r
- {$endif}\r
-implementation\r
-{$ifdef win32}\r
- uses dnswin;\r
-{$endif}\r
-\r
-{$i unixstuff.inc}\r
-{$i ltimevalstuff.inc}\r
-\r
-var\r
- fd:integer;\r
- state:tdnsstate;\r
-{$ifdef win32}\r
- const\r
- winsocket = 'wsock32.dll';\r
- function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddr; tolen: Integer): Integer; stdcall; external winsocket name 'sendto';\r
- function bind(s: TSocket; var addr: TinetSockAddr; namelen: Integer): Longbool; stdcall; external winsocket name 'bind';\r
- type\r
- fdset=tfdset;\r
-{$endif}\r
-\r
-function sendquery(const packet:tdnspacket;len:integer):boolean;\r
-var\r
- a:integer;\r
- addr : string;\r
- port : string;\r
- inaddr : TInetSockAddr;\r
-\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
-\r
- if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);\r
- port := '53';\r
-\r
- inAddr.family:=AF_INET;\r
- inAddr.port:=htons(strtointdef(port,0));\r
- inAddr.addr:=htonl(longip(addr));\r
-\r
- sendto(fd,packet,len,0,inaddr,sizeof(inaddr));\r
- {$ifdef win32}\r
- sendquerytime := GetTickCount and $3fff;\r
- {$else}\r
- gettimeofday(sendquerytime);\r
- {$endif}\r
- result := true;\r
-end;\r
-\r
-procedure setupsocket;\r
-var\r
- inAddrtemp : TInetSockAddr;\r
-begin\r
- if fd > 0 then exit;\r
-\r
- fd := Socket(AF_INET,SOCK_DGRAM,0);\r
- inAddrtemp.family:=AF_INET;\r
- inAddrtemp.port:=0;\r
- inAddrtemp.addr:=0;{htonl(longip('0.0.0.0'));}\r
- If {$ifndef win32}Not{$endif} Bind(fd,inAddrtemp,SizeOf(inAddrtemp)) Then begin\r
- {$ifdef win32}\r
- raise Exception.create('unable to bind '+inttostr(WSAGetLastError));\r
- {$else}\r
- raise Exception.create('unable to bind '+inttostr(socketError));\r
- {$endif}\r
- end;\r
-end;\r
-\r
-procedure resolveloop(timeout:integer);\r
-var\r
- selectresult : integer;\r
- fds : fdset;\r
- {$ifdef win32}\r
- endtime : longint;\r
- starttime : longint;\r
- wrapmode : boolean;\r
- currenttime : integer;\r
- {$else}\r
- endtime : ttimeval;\r
- currenttime : ttimeval;\r
-\r
- {$endif}\r
- lag : ttimeval;\r
- currenttimeout : ttimeval;\r
- selecttimeout : ttimeval;\r
-\r
-\r
-begin\r
- {$ifdef win32}\r
- starttime := GetTickCount and $3fff;\r
- endtime := starttime +(timeout*1000);\r
- if (endtime and $4000)=0 then begin\r
- wrapmode := false;\r
- end else begin\r
- wrapmode := true;\r
- end;\r
- endtime := endtime and $3fff;\r
- {$else}\r
- gettimeofday(endtime);\r
- endtime.tv_sec := endtime.tv_sec + timeout;\r
- {$endif}\r
-\r
- setupsocket;\r
- repeat\r
- state_process(state);\r
- case state.resultaction of\r
- action_ignore: begin\r
-{ writeln('ignore');}\r
- {do nothing}\r
- end;\r
- action_done: begin\r
-{ writeln('done');}\r
- exit;\r
- //onrequestdone(self,0);\r
- end;\r
- action_sendquery:begin\r
-{ writeln('send query');}\r
- sendquery(state.sendpacket,state.sendpacketlen);\r
- end;\r
- end;\r
- {$ifdef win32}\r
- currenttime := GetTickCount and $3fff;\r
- msectotimeval(selecttimeout, (endtime-currenttime)and$3fff);\r
- {$else}\r
- gettimeofday(currenttime);\r
- selecttimeout := endtime;\r
- tv_substract(selecttimeout,currenttime);\r
- {$endif}\r
- fd_zero(fds);\r
- fd_set(fd,fds);\r
- if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin\r
- selecttimeout.tv_sec := 0;\r
- selecttimeout.tv_usec := retryafter;\r
- end;\r
- selectresult := select(fd+1,@fds,nil,nil,@selecttimeout);\r
- if selectresult > 0 then begin\r
-{ writeln('selectresult>0');}\r
- //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash\r
- fillchar(state.recvpacket,sizeof(state.recvpacket),0);\r
- {$ifdef win32}\r
- msectotimeval(lag,(currenttime-sendquerytime)and$3fff);\r
- {$else}\r
- lag := currenttime;\r
- tv_substract(lag,sendquerytime);\r
-\r
- {$endif}\r
-\r
- reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);\r
- state.recvpacketlen := recv(fd,state.recvpacket, SizeOf(state.recvpacket),0);\r
- state.parsepacket := true;\r
- end;\r
- if selectresult < 0 then exit;\r
- if selectresult = 0 then begin\r
- {$ifdef win32}\r
- currenttime := GetTickCount;\r
- {$else}\r
- gettimeofday(currenttime);\r
- {$endif}\r
- reportlag(id,-1);\r
- if {$ifdef win32}(currenttime >= endtime)and ((not wrapmode) or (currenttime < starttime)) {$else}tv_compare(currenttime,endtime){$endif} {currenttime >= endtime } then begin\r
- exit;\r
- end else begin\r
- //resend\r
- sendquery(state.sendpacket,state.sendpacketlen);\r
- end;\r
- end;\r
- until false;\r
-end;\r
-\r
-function forwardlookup(name:string;timeout:integer):tbinip;\r
-var\r
- dummy : integer;\r
-begin\r
- ipstrtobin(name,result);\r
- if result.family <> 0 then exit; //it was an IP address, no need for dns\r
- //lookup\r
- {$ifdef win32}\r
- if usewindns then begin\r
- result := winforwardlookup(name,false,dummy);\r
- exit;\r
- end;\r
- {$endif}\r
- setstate_forward(name,state,0);\r
- resolveloop(timeout);\r
- result := state.resultbin;\r
-end;\r
-\r
-function reverselookup(ip:tbinip;timeout:integer):string;\r
-var\r
- dummy : integer;\r
-begin\r
- {$ifdef win32}\r
- if usewindns then begin\r
- result := winreverselookup(ip,dummy);\r
- exit;\r
- end;\r
- {$endif}\r
- setstate_reverse(ip,state);\r
- resolveloop(timeout);\r
- result := state.resultstr;\r
-end;\r
-\r
-{$ifdef win32}\r
- var\r
- wsadata : twsadata;\r
-\r
- initialization\r
- WSAStartUp($2,wsadata);\r
- finalization\r
- WSACleanUp;\r
-{$endif}\r
-end.\r
-\r
-\r
lcore.org gitweb / lcore.git / blobdiff