X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/6cb6b7ede2d178e03fa817bc28474c175f5a93b9..2579cad7a973072619a7fc17ff6af9cc75264972:/dnssync.pas?ds=sidebyside diff --git a/dnssync.pas b/dnssync.pas old mode 100755 new mode 100644 index 3632b29..79ace01 --- a/dnssync.pas +++ b/dnssync.pas @@ -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 //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; +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,11 +56,8 @@ const defaulttimeout=10000; const mintimeout=16; -var - dnssyncserver:string; - id:integer; + toport='53'; - sendquerytime:array[0..numsock-1] of integer; implementation {$ifdef win32} @@ -78,15 +70,12 @@ implementation {$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} const winsocket = 'wsock32.dll'; @@ -110,51 +99,59 @@ 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 win32}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: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 + makeinaddrv(biniptemp,inttostr( 1024 + randominteger(65536 - 1024) ),inaddrtemp); + + fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0); + bindresult := {$ifdef win32}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 + If (not bindresult) Then begin {$ifdef win32} raise Exception.create('unable to bind '+inttostr(WSAGetLastError)); {$else} @@ -164,37 +161,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 win32} + 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 +228,7 @@ begin if finished[a] then inc(b); end; if (b = numsockused) then begin + cleanupsockets; exit; end; //onrequestdone(self,0); @@ -249,10 +263,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 +286,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 +301,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 @@ -324,7 +345,7 @@ begin {$endif} begin {$ifdef syncdnscore} - {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif} + {$ifdef ipv6}initpreferredmode;{$endif} numsockused := 0; @@ -340,7 +361,7 @@ begin end; {$endif} - resolveloop(timeout); + resolveloop(timeout,state,numsockused); if (numsockused = 1) then begin biniplist_addlist(result,state[0].resultlist); @@ -351,13 +372,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,9 +386,11 @@ 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} if usewindns then begin @@ -378,67 +401,11 @@ 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} var wsadata : twsadata;