X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/6cb6b7ede2d178e03fa817bc28474c175f5a93b9..3dd5a60c6c89a29781e099a9e204b09ffbb2e317:/dnssync.pas
diff --git a/dnssync.pas b/dnssync.pas
old mode 100755
new mode 100644
index 3632b29..f5eafa6
--- a/dnssync.pas
+++ b/dnssync.pas
@@ -13,7 +13,7 @@ interface
uses
dnscore,
binipstuff,
- {$ifdef win32}
+ {$ifdef mswindows}
winsock,
windows,
{$else}
@@ -25,33 +25,28 @@ interface
sockets,
fd_utils,
{$endif}
- sysutils;
+ lcorernd,
+ sysutils,
+ ltimevalstuff;
//convert a name to an IP
//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 fiels are also currently
+//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 miliseconds, 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:string;timeout:integer):tbiniplist;
+function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;
//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;
-{$ifdef linux}{$ifdef ipv6}
-function getv6localips:tbiniplist;
-procedure initpreferredmode;
-var
- preferredmodeinited:boolean;
-
-{$endif}{$endif}
const
tswrap=$4000;
@@ -61,33 +56,27 @@ const
defaulttimeout=10000;
const mintimeout=16;
-var
- dnssyncserver:string;
- id:integer;
+ toport='53';
- sendquerytime:array[0..numsock-1] of integer;
implementation
-{$ifdef win32}
+{$ifdef mswindows}
uses dnswin;
{$endif}
-{$ifndef win32}
+{$ifndef mswindows}
{$define syncdnscore}
{$endif}
{$i unixstuff.inc}
-{$i ltimevalstuff.inc}
-var
- numsockused:integer;
- fd:array[0..numsock-1] of integer;
- state:array[0..numsock-1] of tdnsstate;
+type tdnsstatearr=array[0..numsock-1] of tdnsstate;
{$ifdef syncdnscore}
-{$ifdef win32}
+
+{$ifdef mswindows}
const
winsocket = 'wsock32.dll';
function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external winsocket name 'sendto';
@@ -98,7 +87,7 @@ var
function getts:integer;
-{$ifdef win32}
+{$ifdef mswindows}
begin
result := GetTickCount and tsmask;
{$else}
@@ -110,52 +99,66 @@ begin
{$endif}
end;
-
-function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;
+procedure resolveloop(timeout:integer;var state:tdnsstatearr;numsockused:integer);
var
- a:integer;
- addr : string;
- port : string;
- inaddr : TInetSockAddrV;
-begin
-{ writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
- result := false;
- if len = 0 then exit; {no packet}
+ selectresult : integer;
+ fds : fdset;
+
+ 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;
- if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
- port := '53';
+ Src : TInetSockAddrV;
+ Srcx : {$ifdef mswindows}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;
+ SrcLen : Integer;
+ fromip:tbinip;
+ fromport:ansistring;
- makeinaddrv(ipstrtobinf(addr),port,inaddr);
+ 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[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
- sendquerytime[socknum] := getts;
- result := true;
-end;
procedure setupsocket;
var
inAddrtemp : TInetSockAddrV;
- a:integer;
biniptemp:tbinip;
- addr:string;
+ a,retrycount,porttemp:integer;
+ bindresult:boolean;
begin
- //init both sockets smultaneously, always, so they get succesive fd's
- if fd[0] > 0 then exit;
-
- if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
+ biniptemp := getcurrentsystemnameserverbin(id);
//must get the DNS server here so we know to init v4 or v6
- fillchar(inaddrtemp,sizeof(inaddrtemp),0);
- ipstrtobin(addr,biniptemp);
- if biniptemp.family = 0 then biniptemp.family := AF_INET;
+ if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');
- inaddrtemp.inaddr.family := biniptemp.family;
for a := 0 to numsockused-1 do begin
- fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
+ 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;
- If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin
- {$ifdef win32}
+ 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));
@@ -164,37 +167,53 @@ begin
end;
end;
-procedure resolveloop(timeout:integer);
+procedure cleanupsockets;
var
- selectresult : integer;
- fds : fdset;
+ a:integer;
+begin
+ for a := 0 to numsockused-1 do closesocket(fd[a]);
+end;
- endtime : longint;
- starttime : longint;
- wrapmode : boolean;
- currenttime : integer;
+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}
- lag : ttimeval;
- currenttimeout : ttimeval;
- selecttimeout : ttimeval;
- socknum:integer;
- needprocessing:array[0..numsock-1] of boolean;
- finished:array[0..numsock-1] of boolean;
- a,b:integer;
+ 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
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;
+ 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;
@@ -215,6 +234,7 @@ begin
if finished[a] then inc(b);
end;
if (b = numsockused) then begin
+ cleanupsockets;
exit;
end;
//onrequestdone(self,0);
@@ -249,10 +269,22 @@ begin
fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
- if dnssyncserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
- state[socknum].recvpacketlen := recv(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0);
- state[socknum].parsepacket := true;
- needprocessing[socknum] := true;
+ reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
+
+ 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;
@@ -260,8 +292,9 @@ begin
currenttime := getts;
- if dnssyncserver = '' then reportlag(id,-1);
+ reportlag(id,-1);
if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
+ cleanupsockets;
exit;
end else begin
//resend
@@ -274,24 +307,18 @@ begin
end;
{$endif}
-procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);
-var
- a:integer;
- biniptemp:tbinip;
-begin
- for a := biniplist_getcount(l2)-1 downto 0 do begin
- biniptemp := biniplist_get(l2,a);
- if (biniptemp.family = family) then biniplist_add(l,biniptemp);
- end;
-end;
-function forwardlookuplist(name:string;timeout:integer):tbiniplist;
+function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;
var
dummy : integer;
- a,b:integer;
+ a:integer;
biniptemp:tbinip;
l:tbiniplist;
+
+ numsockused:integer;
+ state:tdnsstatearr;
+
begin
ipstrtobin(name,biniptemp);
if biniptemp.family <> 0 then begin
@@ -300,7 +327,7 @@ begin
exit; //it was an IP address, no need for dns
end;
- {$ifdef win32}
+ {$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);
@@ -324,7 +351,7 @@ begin
{$endif}
begin
{$ifdef syncdnscore}
- {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}
+ {$ifdef ipv6}initpreferredmode;{$endif}
numsockused := 0;
@@ -340,7 +367,7 @@ begin
end;
{$endif}
- resolveloop(timeout);
+ resolveloop(timeout,state,numsockused);
if (numsockused = 1) then begin
biniplist_addlist(result,state[0].resultlist);
@@ -351,13 +378,13 @@ begin
end else begin
biniplist_addlist(result,state[0].resultlist);
biniplist_addlist(result,state[1].resultlist);
- {$endif}
+ {$endif}
end;
{$endif}
end;
end;
-function forwardlookup(name:string;timeout:integer):tbinip;
+function forwardlookup(name:ansistring;timeout:integer):tbinip;
var
listtemp:tbiniplist;
begin
@@ -365,11 +392,13 @@ begin
result := biniplist_get(listtemp,0);
end;
-function reverselookup(ip:tbinip;timeout:integer):string;
+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;
@@ -378,68 +407,12 @@ begin
{$ifdef syncdnscore}
setstate_reverse(ip,state[0]);
numsockused := 1;
- resolveloop(timeout);
+ resolveloop(timeout,state,numsockused);
result := state[0].resultstr;
{$endif}
end;
-{$ifdef linux}{$ifdef ipv6}{$ifdef syncdnscore}
-function getv6localips:tbiniplist;
-var
- t:textfile;
- s,s2:string;
- ip:tbinip;
- a:integer;
-begin
- result := biniplist_new;
-
- assignfile(t,'/proc/net/if_inet6');
- {$i-}reset(t);{$i+}
- if ioresult <> 0 then exit; {none found, return empty list}
-
- while not eof(t) do begin
- readln(t,s);
- s2 := '';
- for a := 0 to 7 do begin
- if (s2 <> '') then s2 := s2 + ':';
- s2 := s2 + copy(s,(a shl 2)+1,4);
- end;
- ipstrtobin(s2,ip);
- if ip.family <> 0 then biniplist_add(result,ip);
- end;
- closefile(t);
-end;
-
-procedure initpreferredmode;
-var
- l:tbiniplist;
- a:integer;
- ip:tbinip;
- ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;
-
-begin
- if preferredmodeinited then exit;
- if useaf <> useaf_default then exit;
- useaf := useaf_preferv4;
- l := getv6localips;
- ipstrtobin('2000::',ipmask_global);
- ipstrtobin('2001::',ipmask_teredo);
- ipstrtobin('2002::',ipmask_6to4);
- {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}
- for a := biniplist_getcount(l)-1 downto 0 do begin
- ip := biniplist_get(l,a);
- if not comparebinipmask(ip,ipmask_global,3) then continue;
- if comparebinipmask(ip,ipmask_teredo,32) then continue;
- if comparebinipmask(ip,ipmask_6to4,16) then continue;
- useaf := useaf_preferv6;
- preferredmodeinited := true;
- exit;
- end;
-end;
-
-{$endif}{$endif}{$endif}
-
-{$ifdef win32}
+{$ifdef mswindows}
var
wsadata : twsadata;