X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/4782a5c5afee47721cc617daa40dd29828342c2b..3dd5a60c6c89a29781e099a9e204b09ffbb2e317:/dnssync.pas
diff --git a/dnssync.pas b/dnssync.pas
old mode 100755
new mode 100644
index 379aa05..f5eafa6
--- a/dnssync.pas
+++ b/dnssync.pas
@@ -7,11 +7,13 @@ unit dnssync;
{$mode delphi}
{$endif}
+{$include lcoreconfig.inc}
+
interface
uses
dnscore,
binipstuff,
- {$ifdef win32}
+ {$ifdef mswindows}
winsock,
windows,
{$else}
@@ -23,232 +25,394 @@ interface
sockets,
fd_utils,
{$endif}
- sysutils;
+ lcorernd,
+ sysutils,
+ ltimevalstuff;
//convert a name to an IP
-//IPV4 is preffered if availible, if not IPV6 will be returned (if ipv6 support
-//compiled in)
-//on error the binip will have a family of 0 (other fiels are also currently
+//will return v4 or v6 depending on what seems favorable, or manual preference setting
+//on error the binip will have a family of 0 (other fields are also currently
//zeroed out but may be used for further error information in future)
-//timeout is in seconds, it is ignored when using windows dns
-function forwardlookup(name:string;timeout:integer):tbinip;
+//timeout is in milliseconds, it is ignored when using windows dns
+function forwardlookup(name:ansistring;timeout:integer):tbinip;
+
+//convert a name to a list of all IP's returned
+//this returns both v4 and v6 IP's, or possibly only v4 or v6, depending on settings
+//on error, returns an empty list
+function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;
-//convert an IP to a name, on error a null string will be returned, other
+//convert an IP to a name, on error a null string will be returned, other
//details as above
-function reverselookup(ip:tbinip;timeout:integer):string;
+function reverselookup(ip:tbinip;timeout:integer):ansistring;
-var
- dnssyncserver:string;
- id : integer;
- {$ifdef win32}
- sendquerytime : integer;
- {$else}
- sendquerytime : ttimeval;
- {$endif}
+
+const
+ tswrap=$4000;
+ tsmask=tswrap-1;
+
+ numsock=1{$ifdef ipv6}+1{$endif};
+ defaulttimeout=10000;
+ const mintimeout=16;
+
+ toport='53';
+
implementation
-{$ifdef win32}
+
+{$ifdef mswindows}
uses dnswin;
{$endif}
+
+{$ifndef mswindows}
+{$define syncdnscore}
+{$endif}
+
{$i unixstuff.inc}
-{$i ltimevalstuff.inc}
-var
- fd:integer;
- state:tdnsstate;
-{$ifdef win32}
+type tdnsstatearr=array[0..numsock-1] of tdnsstate;
+
+{$ifdef syncdnscore}
+
+
+{$ifdef mswindows}
const
winsocket = 'wsock32.dll';
- function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddr; tolen: Integer): Integer; stdcall; external winsocket name 'sendto';
- function bind(s: TSocket; var addr: TinetSockAddr; namelen: Integer): Longbool; stdcall; external winsocket name 'bind';
+ function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external winsocket name 'sendto';
+ function bind(s: TSocket; var addr: TinetSockAddrV; namelen: Integer): Longbool; stdcall; external winsocket name 'bind';
type
fdset=tfdset;
{$endif}
-function sendquery(const packet:tdnspacket;len:integer):boolean;
-var
- a:integer;
- addr : string;
- port : string;
- inaddr : TInetSockAddr;
+function getts:integer;
+{$ifdef mswindows}
begin
-{ writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
- result := false;
- if len = 0 then exit; {no packet}
+ result := GetTickCount and tsmask;
+{$else}
+var
+ temp:ttimeval;
+begin
+ gettimeofday(temp);
+ result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;
+{$endif}
+end;
- if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
- port := '53';
+procedure resolveloop(timeout:integer;var state:tdnsstatearr;numsockused:integer);
+var
+ selectresult : integer;
+ fds : fdset;
- inAddr.family:=AF_INET;
- inAddr.port:=htons(strtointdef(port,0));
- inAddr.addr:=htonl(longip(addr));
+ endtime : longint;
+ starttime : longint;
+ wrapmode : boolean;
+ currenttime : integer;
+
+ lag : ttimeval;
+ selecttimeout : ttimeval;
+ socknum:integer;
+ needprocessing:array[0..numsock-1] of boolean;
+ finished:array[0..numsock-1] of boolean;
+ a,b:integer;
+
+ Src : TInetSockAddrV;
+ Srcx : {$ifdef mswindows}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;
+ SrcLen : Integer;
+ fromip:tbinip;
+ fromport:ansistring;
+
+ fd:array[0..numsock-1] of integer;
+ toaddr:array[0..numsock-1] of tbinip;
+ id:integer;
+ sendquerytime:array[0..numsock-1] of integer;
- sendto(fd,packet,len,0,inaddr,sizeof(inaddr));
- {$ifdef win32}
- sendquerytime := GetTickCount and $3fff;
- {$else}
- gettimeofday(sendquerytime);
- {$endif}
- result := true;
-end;
procedure setupsocket;
var
- inAddrtemp : TInetSockAddr;
+ inAddrtemp : TInetSockAddrV;
+ biniptemp:tbinip;
+ a,retrycount,porttemp:integer;
+ bindresult:boolean;
begin
- if fd > 0 then exit;
-
- fd := Socket(AF_INET,SOCK_DGRAM,0);
- inAddrtemp.family:=AF_INET;
- inAddrtemp.port:=0;
- inAddrtemp.addr:=0;{htonl(longip('0.0.0.0'));}
- If {$ifndef win32}Not{$endif} Bind(fd,inAddrtemp,SizeOf(inAddrtemp)) Then begin
- {$ifdef win32}
- raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
- {$else}
- raise Exception.create('unable to bind '+inttostr(socketError));
- {$endif}
+ biniptemp := getcurrentsystemnameserverbin(id);
+ //must get the DNS server here so we know to init v4 or v6
+
+ if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');
+
+
+ for a := 0 to numsockused-1 do begin
+ retrycount := 5;
+ repeat
+ if (retrycount <= 1) then begin
+ porttemp := 0; //for the last attempt let the OS decide
+ end else begin
+ porttemp := 1024 + randominteger(65536 - 1024);
+ end;
+
+ makeinaddrv(biniptemp,inttostr( porttemp ),inaddrtemp);
+
+ fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
+ bindresult := {$ifdef mswindows}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp));
+ dec(retrycount);
+ until (retrycount <= 0) or (bindresult);
+
+ If (not bindresult) Then begin
+ {$ifdef mswindows}
+ raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
+ {$else}
+ raise Exception.create('unable to bind '+inttostr(socketError));
+ {$endif}
+ end;
end;
end;
-procedure resolveloop(timeout:integer);
+procedure cleanupsockets;
var
- selectresult : integer;
- fds : fdset;
- {$ifdef win32}
- endtime : longint;
- starttime : longint;
- wrapmode : boolean;
- currenttime : integer;
- {$else}
- endtime : ttimeval;
- currenttime : ttimeval;
+ a:integer;
+begin
+ for a := 0 to numsockused-1 do closesocket(fd[a]);
+end;
- {$endif}
- lag : ttimeval;
- currenttimeout : ttimeval;
- selecttimeout : ttimeval;
+function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;
+var
+ ip : tbinip;
+ port : ansistring;
+ inaddr : TInetSockAddrV;
+begin
+{ writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
+ result := false;
+ if len = 0 then exit; {no packet}
+
+ ip := getcurrentsystemnameserverbin(id);
+
+ {$ifdef ipv6}{$ifdef mswindows}
+ if toaddr[socknum].family = AF_INET6 then if (useaf = 0) then useaf := useaf_preferv6;
+ {$endif}{$endif}
+
+ port := toport;
+ toaddr[socknum] := ip;
+ makeinaddrv(toaddr[socknum],port,inaddr);
+ sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
+ sendquerytime[socknum] := getts;
+ result := true;
+end;
begin
- {$ifdef win32}
- starttime := GetTickCount and $3fff;
- endtime := starttime +(timeout*1000);
- if (endtime and $4000)=0 then begin
- wrapmode := false;
- end else begin
- wrapmode := true;
- end;
- endtime := endtime and $3fff;
- {$else}
- gettimeofday(endtime);
- endtime.tv_sec := endtime.tv_sec + timeout;
- {$endif}
+ if timeout < mintimeout then timeout := defaulttimeout;
+
+ starttime := getts;
+ endtime := starttime + timeout;
+ if (endtime and tswrap)=0 then begin
+ wrapmode := false;
+ end else begin
+ wrapmode := true;
+ end;
+ endtime := endtime and tsmask;
setupsocket;
+
+
+ for socknum := 0 to numsockused-1 do begin
+ needprocessing[socknum] := true;
+ finished[socknum] := false;
+ end;
+
repeat
- state_process(state);
- case state.resultaction of
- action_ignore: begin
-{ writeln('ignore');}
- {do nothing}
- end;
- action_done: begin
-{ writeln('done');}
- exit;
- //onrequestdone(self,0);
- end;
- action_sendquery:begin
+ for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin
+ state_process(state[socknum]);
+ case state[socknum].resultaction of
+ action_ignore: begin
+ {do nothing}
+ end;
+ action_done: begin
+ finished[socknum] := true;
+ //exit if all resolvers are finished
+ b := 0;
+ for a := 0 to numsockused-1 do begin
+ if finished[a] then inc(b);
+ end;
+ if (b = numsockused) then begin
+ cleanupsockets;
+ exit;
+ end;
+ //onrequestdone(self,0);
+ end;
+ action_sendquery:begin
{ writeln('send query');}
- sendquery(state.sendpacket,state.sendpacketlen);
+ sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
+ end;
end;
+ needprocessing[socknum] := false;
end;
- {$ifdef win32}
- currenttime := GetTickCount and $3fff;
- msectotimeval(selecttimeout, (endtime-currenttime)and$3fff);
- {$else}
- gettimeofday(currenttime);
- selecttimeout := endtime;
- tv_substract(selecttimeout,currenttime);
- {$endif}
+
+ currenttime := getts;
+ msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);
+
fd_zero(fds);
- fd_set(fd,fds);
+ for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);
if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin
selecttimeout.tv_sec := 0;
selecttimeout.tv_usec := retryafter;
end;
- selectresult := select(fd+1,@fds,nil,nil,@selecttimeout);
+ //find the highest of the used fd's
+ b := 0;
+ for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];
+ selectresult := select(b+1,@fds,nil,nil,@selecttimeout);
if selectresult > 0 then begin
-{ writeln('selectresult>0');}
- //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash
- fillchar(state.recvpacket,sizeof(state.recvpacket),0);
- {$ifdef win32}
- msectotimeval(lag,(currenttime-sendquerytime)and$3fff);
- {$else}
- lag := currenttime;
- tv_substract(lag,sendquerytime);
+ currenttime := getts;
+ for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin
+ { writeln('selectresult>0');}
+ //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash
- {$endif}
+ fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
+ msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
+
+ reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
- reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
- state.recvpacketlen := recv(fd,state.recvpacket, SizeOf(state.recvpacket),0);
- state.parsepacket := true;
+ SrcLen := SizeOf(Src);
+ state[socknum].recvpacketlen := recvfrom(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0,Srcx,SrcLen);
+
+ if (state[socknum].recvpacketlen > 0) then begin
+ fromip := inaddrvtobinip(Src);
+ fromport := inttostr(htons(src.InAddr.port));
+ if ((not comparebinip(toaddr[socknum],fromip)) or (fromport <> toport)) then begin
+// writeln('dnssync received from wrong IP:port ',ipbintostr(fromip),'#',fromport);
+ state[socknum].recvpacketlen := 0;
+ end else begin
+ state[socknum].parsepacket := true;
+ needprocessing[socknum] := true;
+ end;
+ end;
+ end;
end;
if selectresult < 0 then exit;
if selectresult = 0 then begin
- {$ifdef win32}
- currenttime := GetTickCount;
- {$else}
- gettimeofday(currenttime);
- {$endif}
+
+ currenttime := getts;
+
reportlag(id,-1);
- if {$ifdef win32}(currenttime >= endtime)and ((not wrapmode) or (currenttime < starttime)) {$else}tv_compare(currenttime,endtime){$endif} {currenttime >= endtime } then begin
+ if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
+ cleanupsockets;
exit;
end else begin
//resend
- sendquery(state.sendpacket,state.sendpacketlen);
+ for socknum := numsockused-1 downto 0 do begin
+ sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
+ end;
end;
end;
until false;
end;
+{$endif}
+
+
-function forwardlookup(name:string;timeout:integer):tbinip;
+function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;
var
dummy : integer;
+ a:integer;
+ biniptemp:tbinip;
+ l:tbiniplist;
+
+ numsockused:integer;
+ state:tdnsstatearr;
+
begin
- ipstrtobin(name,result);
- if result.family <> 0 then exit; //it was an IP address, no need for dns
- //lookup
- {$ifdef win32}
- if usewindns then begin
- result := winforwardlookup(name,false,dummy);
- exit;
+ ipstrtobin(name,biniptemp);
+ if biniptemp.family <> 0 then begin
+ result := biniplist_new;
+ biniplist_add(result,biniptemp);
+ exit; //it was an IP address, no need for dns
+ end;
+
+ {$ifdef mswindows}
+ if usewindns then begin
+ if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;
+ result := winforwardlookuplist(name,a,dummy);
+ {$ifdef ipv6}
+ if (useaf = useaf_preferv4) then begin
+ {prefer mode: sort the IP's}
+ l := biniplist_new;
+ addipsoffamily(l,result,af_inet);
+ addipsoffamily(l,result,af_inet6);
+ result := l;
+ end;
+ if (useaf = useaf_preferv6) then begin
+ {prefer mode: sort the IP's}
+ l := biniplist_new;
+ addipsoffamily(l,result,af_inet6);
+ addipsoffamily(l,result,af_inet);
+ result := l;
end;
+ {$endif}
+ end else
{$endif}
- setstate_forward(name,state,0);
- resolveloop(timeout);
- result := state.resultbin;
+ begin
+ {$ifdef syncdnscore}
+ {$ifdef ipv6}initpreferredmode;{$endif}
+
+ numsockused := 0;
+
+ result := biniplist_new;
+ if (useaf <> useaf_v6) then begin
+ setstate_forward(name,state[numsockused],af_inet);
+ inc(numsockused);
+ end;
+ {$ifdef ipv6}
+ if (useaf <> useaf_v4) then begin
+ setstate_forward(name,state[numsockused],af_inet6);
+ inc(numsockused);
+ end;
+ {$endif}
+
+ resolveloop(timeout,state,numsockused);
+
+ if (numsockused = 1) then begin
+ biniplist_addlist(result,state[0].resultlist);
+ {$ifdef ipv6}
+ end else if (useaf = useaf_preferv6) then begin
+ biniplist_addlist(result,state[1].resultlist);
+ biniplist_addlist(result,state[0].resultlist);
+ end else begin
+ biniplist_addlist(result,state[0].resultlist);
+ biniplist_addlist(result,state[1].resultlist);
+ {$endif}
+ end;
+ {$endif}
+ end;
end;
-function reverselookup(ip:tbinip;timeout:integer):string;
+function forwardlookup(name:ansistring;timeout:integer):tbinip;
+var
+ listtemp:tbiniplist;
+begin
+ listtemp := forwardlookuplist(name,timeout);
+ result := biniplist_get(listtemp,0);
+end;
+
+function reverselookup(ip:tbinip;timeout:integer):ansistring;
var
dummy : integer;
+ numsockused:integer;
+ state:tdnsstatearr;
begin
- {$ifdef win32}
+ {$ifdef mswindows}
if usewindns then begin
result := winreverselookup(ip,dummy);
exit;
end;
{$endif}
- setstate_reverse(ip,state);
- resolveloop(timeout);
- result := state.resultstr;
+ {$ifdef syncdnscore}
+ setstate_reverse(ip,state[0]);
+ numsockused := 1;
+ resolveloop(timeout,state,numsockused);
+ result := state[0].resultstr;
+ {$endif}
end;
-{$ifdef win32}
+{$ifdef mswindows}
var
wsadata : twsadata;