X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/d53fe26eaac895d1e7a0ba2b2b8965cf77932de8..9951872c6c46881c8b414bcd04a18320c457b811:/dnssync.pas?ds=inline diff --git a/dnssync.pas b/dnssync.pas old mode 100755 new mode 100644 index b682acf..f5eafa6 --- a/dnssync.pas +++ b/dnssync.pas @@ -13,7 +13,7 @@ interface uses dnscore, binipstuff, - {$ifdef win32} + {$ifdef mswindows} winsock, windows, {$else} @@ -25,24 +25,26 @@ 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; @@ -54,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'; @@ -91,7 +87,7 @@ var function getts:integer; -{$ifdef win32} +{$ifdef mswindows} begin result := GetTickCount and tsmask; {$else} @@ -103,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; - if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id); - port := '53'; + lag : ttimeval; + selecttimeout : ttimeval; + socknum:integer; + needprocessing:array[0..numsock-1] of boolean; + finished:array[0..numsock-1] of boolean; + a,b:integer; - makeinaddrv(ipstrtobinf(addr),port,inaddr); + 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[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; + + 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 {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin - {$ifdef win32} + If (not bindresult) Then begin + {$ifdef mswindows} raise Exception.create('unable to bind '+inttostr(WSAGetLastError)); {$else} raise Exception.create('unable to bind '+inttostr(socketError)); @@ -157,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; @@ -208,6 +234,7 @@ begin if finished[a] then inc(b); end; if (b = numsockused) then begin + cleanupsockets; exit; end; //onrequestdone(self,0); @@ -242,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; @@ -253,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 @@ -269,12 +309,16 @@ 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 @@ -283,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); @@ -307,7 +351,7 @@ begin {$endif} begin {$ifdef syncdnscore} - {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif} + {$ifdef ipv6}initpreferredmode;{$endif} numsockused := 0; @@ -323,7 +367,7 @@ begin end; {$endif} - resolveloop(timeout); + resolveloop(timeout,state,numsockused); if (numsockused = 1) then begin biniplist_addlist(result,state[0].resultlist); @@ -334,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 @@ -348,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; @@ -361,12 +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 win32} +{$ifdef mswindows} var wsadata : twsadata;