From: plugwash Date: Mon, 31 Mar 2008 01:26:50 +0000 (+0000) Subject: * add multiip support to dnsasync X-Git-Url: http://www.lcore.org/git/lcore.git/commitdiff_plain/d53fe26eaac895d1e7a0ba2b2b8965cf77932de8?hp=baf753e54d73673524de916757e66ef8c485bc0d * add multiip support to dnsasync git-svn-id: file:///svnroot/lcore/trunk@13 b1de8a11-f9be-4011-bde0-cc7ace90066a --- diff --git a/Makefile b/Makefile index 2ac49d3..4bf4bdd 100755 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ all: lcoretest lcoretest: *.pas *.inc lcoretest.dpr - fpc -Sd -dipv6 lcoretest.dpr + fpc -Sd -gl -dipv6 lcoretest.dpr clean: -rm *.o diff --git a/binipstuff.pas b/binipstuff.pas index 59d123b..a1433fc 100755 --- a/binipstuff.pas +++ b/binipstuff.pas @@ -141,6 +141,8 @@ function comparebinip(const ip1,ip2:tbinip):boolean; procedure maskbits(var binip:tbinip;bits:integer); function comparebinipmask(ip1,ip2:tbinip;bits:integer):boolean; +procedure addipsoffamily(var l:tbiniplist;const l2:tbiniplist;family:integer); + {deprecated} function longip(s:string):longint; @@ -565,7 +567,7 @@ end; procedure biniplist_addlist; begin - l := l + l2; + l := l + copy(l2,biniplist_prefixlen+1,maxlongint); end; function biniplist_tostr(const l:tbiniplist):string; @@ -593,4 +595,16 @@ begin result := true; end; +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; + + end. diff --git a/dnsasync.pas b/dnsasync.pas index 0a32459..7a10bbf 100755 --- a/dnsasync.pas +++ b/dnsasync.pas @@ -17,8 +17,11 @@ uses lsocket,lcore, classes,binipstuff,dnscore,btime; +const + numsock=1{$ifdef ipv6}+1{$endif}; type + //after completion or cancelation a dnswinasync may be reused tdnsasync=class(tcomponent) @@ -26,26 +29,26 @@ type //made a load of stuff private that does not appear to be part of the main //public interface. If you make any of it public again please consider the //consequences when using windows dns. --plugwash. - sock:twsocket; - - sockopen:boolean; - + sockets: array[0..numsock-1] of tlsocket; - state:tdnsstate; + states: array[0..numsock-1] of tdnsstate; - dnsserverid:integer; + dnsserverids : array[0..numsock-1] of integer; startts:double; {$ifdef win32} dwas : tdnswinasync; {$endif} - - procedure asyncprocess; + numsockused : integer; + fresultlist : tbiniplist; + requestaf : integer; + procedure asyncprocess(socketno:integer); procedure receivehandler(sender:tobject;error:word); - function sendquery(const packet:tdnspacket;len:integer):boolean; + function sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean; {$ifdef win32} procedure winrequestdone(sender:tobject;error:word); {$endif} + public onrequestdone:tsocketevent; @@ -55,6 +58,8 @@ type //and special uses. addr,port:string; + overrideaf : integer; + //A family value of AF_INET6 will give only //ipv6 results. Any other value will give ipv4 results in preference and ipv6 //results if ipv4 results are not available; @@ -63,6 +68,7 @@ type procedure cancel;//cancel an outstanding dns request function dnsresult:string; //get result of dnslookup as a string procedure dnsresultbin(var binip:tbinip); //get result of dnslookup as a tbinip + property dnsresultlist : tbiniplist read fresultlist; procedure forwardlookup(const name:string); //start forward lookup, //preffering ipv4 procedure reverselookup(const binip:tbinip); //start reverse lookup @@ -79,78 +85,150 @@ uses sysutils; constructor tdnsasync.create; begin inherited create(aowner); - dnsserverid := -1; - sock := twsocket.create(self); + dnsserverids[0] := -1; + sockets[0] := twsocket.create(self); + sockets[0].tag := 0; + {$ifdef ipv6} + dnsserverids[1] := -1; + sockets[1] := twsocket.Create(self); + sockets[1].tag := 1; + {$endif} end; destructor tdnsasync.destroy; +var + socketno : integer; begin - if dnsserverid >= 0 then begin - reportlag(dnsserverid,-1); - dnsserverid := -1; + for socketno := 0 to numsock -1 do begin + if dnsserverids[socketno] >= 0 then begin + reportlag(dnsserverids[socketno],-1); + dnsserverids[socketno] := -1; + end; + sockets[socketno].release; + setstate_request_init('',states[socketno]); end; - sock.release; - setstate_request_init('',state); inherited destroy; end; -procedure tdnsasync.receivehandler; +procedure tdnsasync.receivehandler(sender:tobject;error:word); +var + socketno : integer; begin - if dnsserverid >= 0 then begin - reportlag(dnsserverid,trunc((unixtimefloat-startts)*1000)); - dnsserverid := -1; + socketno := tlsocket(sender).tag; + //writeln('got a reply on socket number ',socketno); + fillchar(states[socketno].recvpacket,sizeof(states[socketno].recvpacket),0); + states[socketno].recvpacketlen := twsocket(sender).Receive(@(states[socketno].recvpacket), SizeOf(states[socketno].recvpacket)); + states[socketno].parsepacket := true; + if states[socketno].resultaction <> action_done then begin + //we ignore packets that come after we are done + if dnsserverids[socketno] >= 0 then begin + reportlag(dnsserverids[socketno],trunc((unixtimefloat-startts)*1000)); + dnsserverids[socketno] := -1; + end; + { writeln('received reply');} + + asyncprocess(socketno); + //writeln('processed it'); + end else begin + //writeln('ignored it because request is done'); end; -{ writeln('received reply');} - fillchar(state.recvpacket,sizeof(state.recvpacket),0); - state.recvpacketlen := twsocket(sender).Receive(@state.recvpacket, SizeOf(state.recvpacket)); - state.parsepacket := true; - asyncprocess; end; -function tdnsasync.sendquery; +function tdnsasync.sendquery(socketno:integer;const packet:tdnspacket;len:integer):boolean; +var + destination : string; + inaddr : tinetsockaddrv; begin { writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);} + //writeln('trying to send query on socket number ',socketno); result := false; if len = 0 then exit; {no packet} - if not sockopen then begin - if addr <> '' then sock.addr := addr else sock.addr := getcurrentsystemnameserver(dnsserverid);//getunixnameservercached; + if sockets[socketno].state <> wsconnected then begin startts := unixtimefloat; if port = '' then port := '53'; - sock.port := port; - sock.Proto := 'udp'; - sock.ondataavailable := receivehandler; + sockets[socketno].Proto := 'udp'; + sockets[socketno].ondataavailable := receivehandler; try - sock.connect; + sockets[socketno].listen; except - on e:exception do begin - //writeln('exception '+e.message); - exit; - end; + result := false; + exit; end; - sockopen := true; + + end; + if addr <> '' then begin + dnsserverids[socketno] := -1; + destination := addr + end else begin + destination := getcurrentsystemnameserver(dnsserverids[socketno]); end; - sock.send(@packet,len); + makeinaddrv(ipstrtobinf(destination),port,inaddr); + sockets[socketno].sendto(inaddr,sizeof(inaddr), @packet,len); result := true; + + end; -procedure tdnsasync.asyncprocess; +procedure tdnsasync.asyncprocess(socketno:integer); begin - state_process(state); - case state.resultaction of + state_process(states[socketno]); + case states[socketno].resultaction of action_ignore: begin {do nothing} end; action_done: begin - onrequestdone(self,0); + {$ifdef ipv6} + if (numsockused = 1) or (states[socketno xor 1].resultaction=action_done) then + //if using two sockets we need to wait until both sockets are in the done + //state before firing the event + {$endif} + begin + fresultlist := biniplist_new; + if (numsockused = 1) then begin + //writeln('processing for one state'); + biniplist_addlist(fresultlist,states[0].resultlist); + {$ifdef ipv6} + end else if (requestaf = useaf_preferv6) then begin + //writeln('processing for two states, ipv6 preference'); + //writeln('merging lists '+biniplist_tostr(states[1].resultlist)+' and '+biniplist_tostr(states[0].resultlist)); + biniplist_addlist(fresultlist,states[1].resultlist); + biniplist_addlist(fresultlist,states[0].resultlist); + end else begin + //writeln('processing for two states, ipv4 preference'); + biniplist_addlist(fresultlist,states[0].resultlist); + biniplist_addlist(fresultlist,states[1].resultlist); + {$endif} + end; + //writeln(biniplist_tostr(fresultlist)); + onrequestdone(self,0); + end; end; action_sendquery:begin - sendquery(state.sendpacket,state.sendpacketlen); + sendquery(socketno,states[socketno].sendpacket,states[socketno].sendpacketlen); end; end; end; procedure tdnsasync.forwardlookup; +var + bip : tbinip; + i : integer; begin - ipstrtobin(name,state.resultbin); + ipstrtobin(name,bip); + + if bip.family <> 0 then begin + // it was an IP address + fresultlist := biniplist_new; + biniplist_add(fresultlist,bip); + onrequestdone(self,0); + exit; + end; + + if overrideaf = useaf_default then begin + {$ifdef linux}{$ifdef ipv6}initpreferredmode;{$endif}{$endif} + requestaf := useaf; + end else begin + requestaf := overrideaf; + end; {$ifdef win32} if usewindns or (addr = '') then begin @@ -165,15 +243,22 @@ begin end; {$endif} - - if state.resultbin.family <> 0 then begin - onrequestdone(self,0); - exit; + numsockused := 0; + fresultlist := biniplist_new; + if (requestaf <> useaf_v6) then begin + setstate_forward(name,states[numsockused],af_inet); + inc(numsockused); end; - - setstate_forward(name,state,forwardfamily); - asyncprocess; + {$ifdef ipv6} + if (requestaf <> useaf_v4) then begin + setstate_forward(name,states[numsockused],af_inet6); + inc(numsockused); + end; + {$endif} + for i := 0 to numsockused-1 do begin + asyncprocess(i); + end; end; @@ -189,42 +274,47 @@ begin end; {$endif} - setstate_reverse(binip,state); - asyncprocess; + setstate_reverse(binip,states[0]); + numsockused := 1; + asyncprocess(0); end; function tdnsasync.dnsresult; begin - if state.resultstr <> '' then result := state.resultstr else begin - result := ipbintostr(state.resultbin); + if states[0].resultstr <> '' then result := states[0].resultstr else begin + result := ipbintostr(biniplist_get(fresultlist,0)); end; end; procedure tdnsasync.dnsresultbin(var binip:tbinip); begin - move(state.resultbin,binip,sizeof(binip)); + binip := biniplist_get(fresultlist,0); end; procedure tdnsasync.cancel; +var + socketno : integer; begin {$ifdef win32} if assigned(dwas) then begin dwas.release; dwas := nil; - end else + end else {$endif} begin + for socketno := 0 to numsock-1 do begin + reportlag(dnsserverids[socketno],-1); + dnsserverids[socketno] := -1; - if dnsserverid >= 0 then begin - reportlag(dnsserverid,-1); - dnsserverid := -1; - end; - if sockopen then begin - sock.close; - sockopen := false; + sockets[socketno].close; end; + end; - setstate_failure(state); + for socketno := 0 to numsock-1 do begin + setstate_failure(states[socketno]); + + end; + fresultlist := biniplist_new; onrequestdone(self,0); end; @@ -233,12 +323,28 @@ end; begin if dwas.reverse then begin - state.resultstr := dwas.name; + states[0].resultstr := dwas.name; end else begin - state.resultbin := dwas.ip; - if (forwardfamily = AF_INET6) and (state.resultbin.family = AF_INET) then begin - fillchar(state.resultbin,sizeof(tbinip),0); + + {$ifdef ipv6} + if (requestaf = useaf_preferv4) then begin + {prefer mode: sort the IP's} + fresultlist := biniplist_new; + addipsoffamily(fresultlist,dwas.iplist,af_inet); + addipsoffamily(fresultlist,dwas.iplist,af_inet6); + + end else if (requestaf = useaf_preferv6) then begin + {prefer mode: sort the IP's} + fresultlist := biniplist_new; + addipsoffamily(fresultlist,dwas.iplist,af_inet6); + addipsoffamily(fresultlist,dwas.iplist,af_inet); + + end else + {$endif} + begin + fresultlist := dwas.iplist; end; + end; dwas.release; onrequestdone(self,error); diff --git a/dnscore.pas b/dnscore.pas index ef4c2f1..600581d 100755 --- a/dnscore.pas +++ b/dnscore.pas @@ -163,8 +163,7 @@ function makereversename(const binip:tbinip):string; procedure setstate_request_init(const name:string;var state:tdnsstate); //set up state for a foward lookup. A family value of AF_INET6 will give only -//ipv6 results. Any other value will give ipv4 results in preference and ipv6 -//results if ipv4 results are not available; +//ipv6 results. Any other value will give only ipv4 results procedure setstate_forward(const name:string;var state:tdnsstate;family:integer); procedure setstate_reverse(const binip:tbinip;var state:tdnsstate); @@ -188,14 +187,27 @@ var dnsserverlist : tstringlist; // currentdnsserverno : integer; + +//getcurrentsystemnameserver returns the nameserver the app should use and sets +//id to the id of that nameserver. id should later be used to report how laggy +//the servers response was and if it was timed out. function getcurrentsystemnameserver(var id:integer) :string; +procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout //var // unixnameservercache:string; { $endif} -procedure reportlag(id:integer;lag:integer); //lag should be in microseconds and should be -1 to report a timeout +{$ifdef linux}{$ifdef ipv6} +function getv6localips:tbiniplist; +procedure initpreferredmode; + +var + preferredmodeinited:boolean; + +{$endif}{$endif} + var failurereason:string; @@ -516,23 +528,7 @@ begin {no cnames found, no items of correct type found} if state.forwardfamily <> 0 then goto failure; -{$ifdef ipv6} - if (state.requesttype = querytype_a) then begin - {v6 only: in case of forward, look for AAAA in alternative section} - for a := state.numrr1[0]+state.numrr1[1]+state.numrr1[2] to (state.numrr2-1) do begin - rrptemp := @state.rrdata[1+a*sizeof(trrpointer)]; - rrtemp := rrptemp.p; - b := rrptemp.len; - if rrtemp.requesttype = querytype_aaaa then begin - setstate_return(rrptemp^,b,state); - exit; - end; - end; - {no AAAA's found in alternative, do a recursive lookup for them} - state.requesttype := querytype_aaaa; - goto recursed; - end; -{$endif} + goto failure; recursed: {here it needs recursed lookup} @@ -703,6 +699,65 @@ begin end; + + +{$ifdef linux}{$ifdef ipv6} +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} + + { quick and dirty description of dns packet structure to aid writing and understanding of parser code, refer to appropriate RFCs for proper specs - all words are network order diff --git a/dnssync.pas b/dnssync.pas index 3632b29..b682acf 100755 --- a/dnssync.pas +++ b/dnssync.pas @@ -44,14 +44,7 @@ function forwardlookuplist(name:string;timeout:integer):tbiniplist; //details as above function reverselookup(ip:tbinip;timeout:integer):string; -{$ifdef linux}{$ifdef ipv6} -function getv6localips:tbiniplist; -procedure initpreferredmode; -var - preferredmodeinited:boolean; - -{$endif}{$endif} const tswrap=$4000; @@ -274,16 +267,6 @@ 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; @@ -383,62 +366,6 @@ begin {$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; diff --git a/dnswin.pas b/dnswin.pas index ffe472b..73f97ad 100755 --- a/dnswin.pas +++ b/dnswin.pas @@ -30,7 +30,7 @@ type public onrequestdone:tsocketevent; name : string; - ip : tbinip; + iplist : tbiniplist; procedure forwardlookup(name:string;ipv6preffered:boolean); procedure reverselookup(ip:tbinip); @@ -290,7 +290,8 @@ begin end; procedure tdnswinasync.reverselookup(ip:tbinip); begin - self.ip := ip; + iplist := biniplist_new; + biniplist_add(iplist,ip); freverse := true; resume; end; @@ -298,14 +299,14 @@ end; procedure tdnswinasync.execute; var error : integer; - l:tbiniplist; + begin error := 0; if reverse then begin - name := winreverselookup(ip,error); + name := winreverselookup(biniplist_get(iplist,0),error); end else begin - l := winforwardlookuplist(name,0,error); - ip := biniplist_get(l,0); + iplist := winforwardlookuplist(name,0,error); + end; postmessage(hwnddnswin,wm_user,error,taddrint(self)); end; diff --git a/lcoretest.dpr b/lcoretest.dpr index 9c4ec7c..3770b19 100755 --- a/lcoretest.dpr +++ b/lcoretest.dpr @@ -65,7 +65,7 @@ begin receivecount := receivecount +1; if receivecount >50 then begin writeln('received over 50 bits of data, pausing to let the operator take a look'); - readln; + receivecount := 0; end; while pos(#10,receivebuf) > 0 do begin @@ -82,6 +82,7 @@ end; procedure tsc.sessionconnected(sender: tobject;error : word); begin + if error=0 then begin writeln('session is connected, local address is'+clientsocket.getxaddr); @@ -112,6 +113,7 @@ begin das.onrequestdone := sc.dnsrequestdone; //das.forwardfamily := af_inet6; das.forwardlookup('irc.ipv6.p10link.net'); + end; procedure tsc.dnsrequestdone(sender:tobject;error : word); @@ -126,7 +128,7 @@ begin clientsocket.addr := tempbiniplist; clientsocket.port := '6667'; clientsocket.connect; - writeln(clientsocket.getxaddr); + //writeln(clientsocket.getxaddr); das.free; end;