{$mode delphi}\r
{$endif}\r
\r
+{$include lcoreconfig.inc}\r
+\r
interface\r
uses\r
dnscore,\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
+//will return v4 or v6 depending on what seems favorable, or manual preference setting\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
+//timeout is in miliseconds, it is ignored when using windows dns\r
function forwardlookup(name:string;timeout:integer):tbinip;\r
\r
+//convert a name to a list of all IP's returned\r
+//this returns both v4 and v6 IP's, or possibly only v4 or v6, depending on settings\r
+//on error, returns an empty list\r
+function forwardlookuplist(name:string;timeout:integer):tbiniplist;\r
+\r
\r
-//convert an IP to a name, on error a null string will be returned, other \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
+{$ifdef linux}{$ifdef ipv6}\r
+function getv6localips:tbiniplist;\r
+procedure initpreferredmode;\r
+\r
+var\r
+ preferredmodeinited:boolean;\r
+\r
+{$endif}{$endif}\r
+\r
+const\r
+ tswrap=$4000;\r
+ tsmask=tswrap-1;\r
+\r
+ numsock=1{$ifdef ipv6}+1{$endif};\r
+ defaulttimeout=10000;\r
+ const mintimeout=16;\r
\r
var\r
dnssyncserver:string;\r
- id : integer;\r
- {$ifdef win32}\r
- sendquerytime : integer;\r
- {$else}\r
- sendquerytime : ttimeval;\r
- {$endif}\r
+ id:integer;\r
+\r
+ sendquerytime:array[0..numsock-1] of integer;\r
implementation\r
+\r
{$ifdef win32}\r
uses dnswin;\r
{$endif}\r
\r
+\r
+{$ifndef win32}\r
+{$define syncdnscore}\r
+{$endif}\r
+\r
{$i unixstuff.inc}\r
{$i ltimevalstuff.inc}\r
\r
var\r
- fd:integer;\r
- state:tdnsstate;\r
+ numsockused:integer;\r
+ fd:array[0..numsock-1] of integer;\r
+ state:array[0..numsock-1] of tdnsstate;\r
+\r
+{$ifdef syncdnscore}\r
+\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
+ function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external winsocket name 'sendto';\r
+ function bind(s: TSocket; var addr: TinetSockAddrV; 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
+\r
+function getts:integer;\r
+{$ifdef win32}\r
+begin\r
+ result := GetTickCount and tsmask;\r
+{$else}\r
+var\r
+ temp:ttimeval;\r
+begin\r
+ gettimeofday(temp);\r
+ result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;\r
+{$endif}\r
+end;\r
+\r
+\r
+function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;\r
var\r
a:integer;\r
addr : string;\r
port : string;\r
- inaddr : TInetSockAddr;\r
-\r
+ inaddr : TInetSockAddrV;\r
begin\r
{ writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}\r
result := false;\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
+ makeinaddrv(ipstrtobinf(addr),port,inaddr);\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
+ sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));\r
+ sendquerytime[socknum] := getts;\r
result := true;\r
end;\r
\r
procedure setupsocket;\r
var\r
- inAddrtemp : TInetSockAddr;\r
+ inAddrtemp : TInetSockAddrV;\r
+ a:integer;\r
+ biniptemp:tbinip;\r
+ addr:string;\r
begin\r
- if fd > 0 then exit;\r
+ //init both sockets smultaneously, always, so they get succesive fd's\r
+ if fd[0] > 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
+ if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);\r
+ //must get the DNS server here so we know to init v4 or v6\r
+\r
+ fillchar(inaddrtemp,sizeof(inaddrtemp),0);\r
+ ipstrtobin(addr,biniptemp);\r
+ if biniptemp.family = 0 then biniptemp.family := AF_INET;\r
+\r
+ inaddrtemp.inaddr.family := biniptemp.family;\r
+\r
+ for a := 0 to numsockused-1 do begin\r
+ fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);\r
+\r
+ If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(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
end;\r
\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
+ endtime : longint;\r
+ starttime : longint;\r
+ wrapmode : boolean;\r
+ currenttime : integer;\r
+\r
lag : ttimeval;\r
currenttimeout : ttimeval;\r
selecttimeout : ttimeval;\r
-\r
+ socknum:integer;\r
+ needprocessing:array[0..numsock-1] of boolean;\r
+ finished:array[0..numsock-1] of boolean;\r
+ a,b:integer;\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
+ if timeout < mintimeout then timeout := defaulttimeout;\r
+\r
+ starttime := getts;\r
+ endtime := starttime + timeout;\r
+ if (endtime and tswrap)=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
+ endtime := endtime and tsmask;\r
\r
setupsocket;\r
+ for socknum := 0 to numsockused-1 do begin\r
+ needprocessing[socknum] := true;\r
+ finished[socknum] := false;\r
+ end;\r
+\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
+ for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin\r
+ state_process(state[socknum]);\r
+ case state[socknum].resultaction of\r
+ action_ignore: begin\r
+ {do nothing}\r
+ end;\r
+ action_done: begin\r
+ finished[socknum] := true;\r
+ //exit if all resolvers are finished\r
+ b := 0;\r
+ for a := 0 to numsockused-1 do begin\r
+ if finished[a] then inc(b);\r
+ end;\r
+ if (b = numsockused) then begin\r
+ exit;\r
+ end;\r
+ //onrequestdone(self,0);\r
+ end;\r
+ action_sendquery:begin\r
{ writeln('send query');}\r
- sendquery(state.sendpacket,state.sendpacketlen);\r
+ sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);\r
+ end;\r
end;\r
+ needprocessing[socknum] := false;\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
+\r
+ currenttime := getts;\r
+ msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);\r
+\r
fd_zero(fds);\r
- fd_set(fd,fds);\r
+ for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],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
+ //find the highest of the used fd's\r
+ b := 0;\r
+ for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];\r
+ selectresult := select(b+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
+ currenttime := getts;\r
+ for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin\r
+ { writeln('selectresult>0');}\r
+ //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash\r
\r
- {$endif}\r
+ fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);\r
+ msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);\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
+ if dnssyncserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);\r
+ state[socknum].recvpacketlen := recv(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0);\r
+ state[socknum].parsepacket := true;\r
+ needprocessing[socknum] := true;\r
+ end;\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
+\r
+ currenttime := getts;\r
+\r
+ if dnssyncserver = '' then reportlag(id,-1);\r
+ if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin\r
exit;\r
end else begin\r
//resend\r
- sendquery(state.sendpacket,state.sendpacketlen);\r
+ for socknum := numsockused-1 downto 0 do begin\r
+ sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);\r
+ end;\r
end;\r
end;\r
until false;\r
end;\r
+{$endif}\r
\r
-function forwardlookup(name:string;timeout:integer):tbinip;\r
+procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer);\r
+var\r
+ a:integer;\r
+ biniptemp:tbinip;\r
+begin\r
+ for a := biniplist_getcount(l2)-1 downto 0 do begin\r
+ biniptemp := biniplist_get(l2,a);\r
+ if (biniptemp.family = family) then biniplist_add(l,biniptemp);\r
+ end;\r
+end;\r
+\r
+\r
+function forwardlookuplist(name:string;timeout:integer):tbiniplist;\r
var\r
dummy : integer;\r
+ a,b:integer;\r
+ biniptemp:tbinip;\r
+ l:tbiniplist;\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
+ ipstrtobin(name,biniptemp);\r
+ if biniptemp.family <> 0 then begin\r
+ result := biniplist_new;\r
+ biniplist_add(result,biniptemp);\r
+ exit; //it was an IP address, no need for dns\r
+ end;\r
+\r
{$ifdef win32}\r
- if usewindns then begin\r
- result := winforwardlookup(name,false,dummy);\r
- exit;\r
+ if usewindns then begin\r
+ if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;\r
+ result := winforwardlookuplist(name,a,dummy);\r
+ {$ifdef ipv6}\r
+ if (useaf = useaf_preferv4) then begin\r
+ {prefer mode: sort the IP's}\r
+ l := biniplist_new;\r
+ addipsoffamily(l,result,af_inet);\r
+ addipsoffamily(l,result,af_inet6);\r
+ result := l;\r
+ end;\r
+ if (useaf = useaf_preferv6) then begin\r
+ {prefer mode: sort the IP's}\r
+ l := biniplist_new;\r
+ addipsoffamily(l,result,af_inet6);\r
+ addipsoffamily(l,result,af_inet);\r
+ result := l;\r
end;\r
+ {$endif}\r
+ end else\r
{$endif}\r
- setstate_forward(name,state,0);\r
- resolveloop(timeout);\r
- result := state.resultbin;\r
+ begin\r
+ {$ifdef syncdnscore}\r
+ {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif}\r
+\r
+ numsockused := 0;\r
+\r
+ result := biniplist_new;\r
+ if (useaf <> useaf_v6) then begin\r
+ setstate_forward(name,state[numsockused],af_inet);\r
+ inc(numsockused);\r
+ end;\r
+ {$ifdef ipv6}\r
+ if (useaf <> useaf_v4) then begin\r
+ setstate_forward(name,state[numsockused],af_inet6);\r
+ inc(numsockused);\r
+ end;\r
+ {$endif}\r
+\r
+ resolveloop(timeout);\r
+\r
+ if (numsockused = 1) then begin\r
+ biniplist_addlist(result,state[0].resultlist);\r
+ {$ifdef ipv6}\r
+ end else if (useaf = useaf_preferv6) then begin\r
+ biniplist_addlist(result,state[1].resultlist);\r
+ biniplist_addlist(result,state[0].resultlist);\r
+ end else begin\r
+ biniplist_addlist(result,state[0].resultlist);\r
+ biniplist_addlist(result,state[1].resultlist);\r
+ {$endif} \r
+ end;\r
+ {$endif}\r
+ end;\r
+end;\r
+\r
+function forwardlookup(name:string;timeout:integer):tbinip;\r
+var\r
+ listtemp:tbiniplist;\r
+begin\r
+ listtemp := forwardlookuplist(name,timeout);\r
+ result := biniplist_get(listtemp,0);\r
end;\r
\r
function reverselookup(ip:tbinip;timeout:integer):string;\r
exit;\r
end;\r
{$endif}\r
- setstate_reverse(ip,state);\r
+ {$ifdef syncdnscore}\r
+ setstate_reverse(ip,state[0]);\r
+ numsockused := 1;\r
resolveloop(timeout);\r
- result := state.resultstr;\r
+ result := state[0].resultstr;\r
+ {$endif}\r
end;\r
\r
+{$ifdef linux}{$ifdef ipv6}{$ifdef syncdnscore}\r
+function getv6localips:tbiniplist;\r
+var\r
+ t:textfile;\r
+ s,s2:string;\r
+ ip:tbinip;\r
+ a:integer;\r
+begin\r
+ result := biniplist_new;\r
+\r
+ assignfile(t,'/proc/net/if_inet6');\r
+ {$i-}reset(t);{$i+}\r
+ if ioresult <> 0 then exit; {none found, return empty list}\r
+\r
+ while not eof(t) do begin\r
+ readln(t,s);\r
+ s2 := '';\r
+ for a := 0 to 7 do begin\r
+ if (s2 <> '') then s2 := s2 + ':';\r
+ s2 := s2 + copy(s,(a shl 2)+1,4);\r
+ end;\r
+ ipstrtobin(s2,ip);\r
+ if ip.family <> 0 then biniplist_add(result,ip);\r
+ end;\r
+ closefile(t);\r
+end;\r
+\r
+procedure initpreferredmode;\r
+var\r
+ l:tbiniplist;\r
+ a:integer;\r
+ ip:tbinip;\r
+ ipmask_global,ipmask_6to4,ipmask_teredo:tbinip;\r
+\r
+begin\r
+ if preferredmodeinited then exit;\r
+ if useaf <> useaf_default then exit;\r
+ useaf := useaf_preferv4;\r
+ l := getv6localips;\r
+ ipstrtobin('2000::',ipmask_global);\r
+ ipstrtobin('2001::',ipmask_teredo);\r
+ ipstrtobin('2002::',ipmask_6to4);\r
+ {if there is any v6 IP which is globally routable and not 6to4 and not teredo, prefer v6}\r
+ for a := biniplist_getcount(l)-1 downto 0 do begin\r
+ ip := biniplist_get(l,a);\r
+ if not comparebinipmask(ip,ipmask_global,3) then continue;\r
+ if comparebinipmask(ip,ipmask_teredo,32) then continue;\r
+ if comparebinipmask(ip,ipmask_6to4,16) then continue;\r
+ useaf := useaf_preferv6;\r
+ preferredmodeinited := true;\r
+ exit;\r
+ end;\r
+end;\r
+\r
+{$endif}{$endif}{$endif}\r
+\r
{$ifdef win32}\r
var\r
wsadata : twsadata;\r
lcore.org gitweb / lcore.git / blobdiff