/[lcore]/trunk/dnssync.pas
ViewVC logotype

Annotation of /trunk/dnssync.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 57 - (hide annotations)
Sat Oct 31 00:20:41 2009 UTC (11 years ago) by plugwash
File size: 11474 byte(s)
change ltimevalstuff to a unit and move defintion of ttimeval on windows 
there

1 plugwash 1 { Copyright (C) 2005 Bas Steendijk and Peter Green
2     For conditions of distribution and use, see copyright notice in zlib_license.txt
3     which is included in the package
4     ----------------------------------------------------------------------------- }
5     unit dnssync;
6     {$ifdef fpc}
7     {$mode delphi}
8     {$endif}
9    
10 beware 2 {$include lcoreconfig.inc}
11    
12 plugwash 1 interface
13     uses
14     dnscore,
15     binipstuff,
16     {$ifdef win32}
17     winsock,
18     windows,
19     {$else}
20     {$ifdef VER1_0}
21     linux,
22     {$else}
23     baseunix,unix,unixutil,
24     {$endif}
25     sockets,
26     fd_utils,
27     {$endif}
28 beware 20 lcorernd,
29 plugwash 57 sysutils,
30     ltimevalstuff;
31 plugwash 1
32     //convert a name to an IP
33 beware 2 //will return v4 or v6 depending on what seems favorable, or manual preference setting
34 plugwash 1 //on error the binip will have a family of 0 (other fiels are also currently
35     //zeroed out but may be used for further error information in future)
36 beware 2 //timeout is in miliseconds, it is ignored when using windows dns
37 plugwash 1 function forwardlookup(name:string;timeout:integer):tbinip;
38    
39 beware 2 //convert a name to a list of all IP's returned
40     //this returns both v4 and v6 IP's, or possibly only v4 or v6, depending on settings
41     //on error, returns an empty list
42     function forwardlookuplist(name:string;timeout:integer):tbiniplist;
43 plugwash 1
44 beware 2
45     //convert an IP to a name, on error a null string will be returned, other
46 plugwash 1 //details as above
47     function reverselookup(ip:tbinip;timeout:integer):string;
48    
49    
50 beware 2
51     const
52     tswrap=$4000;
53     tsmask=tswrap-1;
54    
55     numsock=1{$ifdef ipv6}+1{$endif};
56     defaulttimeout=10000;
57     const mintimeout=16;
58    
59 beware 20 toport='53';
60    
61 beware 2 var
62     id:integer;
63    
64     sendquerytime:array[0..numsock-1] of integer;
65 plugwash 1 implementation
66 beware 2
67 plugwash 1 {$ifdef win32}
68     uses dnswin;
69     {$endif}
70    
71 beware 2
72     {$ifndef win32}
73     {$define syncdnscore}
74     {$endif}
75    
76 plugwash 1 {$i unixstuff.inc}
77    
78     var
79 beware 2 numsockused:integer;
80     fd:array[0..numsock-1] of integer;
81     state:array[0..numsock-1] of tdnsstate;
82 beware 20 toaddr:array[0..numsock-1] of tbinip;
83 beware 2
84     {$ifdef syncdnscore}
85    
86 plugwash 1 {$ifdef win32}
87     const
88     winsocket = 'wsock32.dll';
89 beware 2 function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external winsocket name 'sendto';
90     function bind(s: TSocket; var addr: TinetSockAddrV; namelen: Integer): Longbool; stdcall; external winsocket name 'bind';
91 plugwash 1 type
92     fdset=tfdset;
93     {$endif}
94    
95 beware 2
96     function getts:integer;
97     {$ifdef win32}
98     begin
99     result := GetTickCount and tsmask;
100     {$else}
101 plugwash 1 var
102 beware 2 temp:ttimeval;
103     begin
104     gettimeofday(temp);
105     result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;
106     {$endif}
107     end;
108    
109    
110     function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;
111     var
112 plugwash 1 a:integer;
113     addr : string;
114     port : string;
115 beware 2 inaddr : TInetSockAddrV;
116 plugwash 1 begin
117     { writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
118     result := false;
119     if len = 0 then exit; {no packet}
120    
121 beware 20 if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);
122 plugwash 1
123 beware 20 {$ifdef ipv6}{$ifdef win32}
124     if toaddr[socknum].family = AF_INET6 then if (useaf = 0) then useaf := useaf_preferv6;
125     {$endif}{$endif}
126 plugwash 1
127 beware 20 port := toport;
128     toaddr[socknum] := ipstrtobinf(addr);
129     makeinaddrv(toaddr[socknum],port,inaddr);
130    
131 beware 2 sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
132     sendquerytime[socknum] := getts;
133 plugwash 1 result := true;
134     end;
135    
136     procedure setupsocket;
137     var
138 beware 2 inAddrtemp : TInetSockAddrV;
139     a:integer;
140     biniptemp:tbinip;
141     addr:string;
142 plugwash 1 begin
143 beware 2 //init both sockets smultaneously, always, so they get succesive fd's
144     if fd[0] > 0 then exit;
145 plugwash 1
146 beware 20 if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);
147 beware 2 //must get the DNS server here so we know to init v4 or v6
148    
149     ipstrtobin(addr,biniptemp);
150    
151 beware 20 if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');
152 beware 2
153 beware 20
154 beware 2 for a := 0 to numsockused-1 do begin
155 beware 20 makeinaddrv(biniptemp,inttostr( 1024 + randominteger(65536 - 1024) ),inaddrtemp);
156    
157 beware 2 fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
158    
159     If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin
160     {$ifdef win32}
161     raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
162     {$else}
163     raise Exception.create('unable to bind '+inttostr(socketError));
164     {$endif}
165     end;
166 plugwash 1 end;
167     end;
168    
169     procedure resolveloop(timeout:integer);
170     var
171     selectresult : integer;
172     fds : fdset;
173    
174 beware 2 endtime : longint;
175     starttime : longint;
176     wrapmode : boolean;
177     currenttime : integer;
178    
179 plugwash 1 lag : ttimeval;
180     currenttimeout : ttimeval;
181     selecttimeout : ttimeval;
182 beware 2 socknum:integer;
183     needprocessing:array[0..numsock-1] of boolean;
184     finished:array[0..numsock-1] of boolean;
185     a,b:integer;
186 plugwash 1
187 beware 20 Src : TInetSockAddrV;
188     Srcx : {$ifdef win32}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;
189     SrcLen : Integer;
190     fromip:tbinip;
191     fromport:string;
192    
193 beware 2 begin
194     if timeout < mintimeout then timeout := defaulttimeout;
195 plugwash 1
196 beware 2 starttime := getts;
197     endtime := starttime + timeout;
198     if (endtime and tswrap)=0 then begin
199 plugwash 1 wrapmode := false;
200     end else begin
201     wrapmode := true;
202     end;
203 beware 2 endtime := endtime and tsmask;
204 plugwash 1
205     setupsocket;
206 beware 2 for socknum := 0 to numsockused-1 do begin
207     needprocessing[socknum] := true;
208     finished[socknum] := false;
209     end;
210    
211 plugwash 1 repeat
212 beware 2 for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin
213     state_process(state[socknum]);
214     case state[socknum].resultaction of
215     action_ignore: begin
216     {do nothing}
217     end;
218     action_done: begin
219     finished[socknum] := true;
220     //exit if all resolvers are finished
221     b := 0;
222     for a := 0 to numsockused-1 do begin
223     if finished[a] then inc(b);
224     end;
225     if (b = numsockused) then begin
226     exit;
227     end;
228     //onrequestdone(self,0);
229     end;
230     action_sendquery:begin
231 plugwash 1 { writeln('send query');}
232 beware 2 sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
233     end;
234 plugwash 1 end;
235 beware 2 needprocessing[socknum] := false;
236 plugwash 1 end;
237 beware 2
238     currenttime := getts;
239     msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);
240    
241 plugwash 1 fd_zero(fds);
242 beware 2 for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);
243 plugwash 1 if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin
244     selecttimeout.tv_sec := 0;
245     selecttimeout.tv_usec := retryafter;
246     end;
247 beware 2 //find the highest of the used fd's
248     b := 0;
249     for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];
250     selectresult := select(b+1,@fds,nil,nil,@selecttimeout);
251 plugwash 1 if selectresult > 0 then begin
252 beware 2 currenttime := getts;
253     for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin
254     { writeln('selectresult>0');}
255     //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash
256 plugwash 1
257 beware 2 fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
258     msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
259 plugwash 1
260 beware 20 if overridednsserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
261    
262     SrcLen := SizeOf(Src);
263     state[socknum].recvpacketlen := recvfrom(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0,Srcx,SrcLen);
264    
265     if (state[socknum].recvpacketlen > 0) then begin
266     fromip := inaddrvtobinip(Src);
267     fromport := inttostr(htons(src.InAddr.port));
268     if ((not comparebinip(toaddr[socknum],fromip)) or (fromport <> toport)) then begin
269     // writeln('dnssync received from wrong IP:port ',ipbintostr(fromip),'#',fromport);
270     state[socknum].recvpacketlen := 0;
271     end else begin
272     state[socknum].parsepacket := true;
273     needprocessing[socknum] := true;
274     end;
275     end;
276 beware 2 end;
277 plugwash 1 end;
278     if selectresult < 0 then exit;
279     if selectresult = 0 then begin
280 beware 2
281     currenttime := getts;
282    
283 beware 20 if overridednsserver = '' then reportlag(id,-1);
284 beware 2 if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
285 plugwash 1 exit;
286     end else begin
287     //resend
288 beware 2 for socknum := numsockused-1 downto 0 do begin
289     sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
290     end;
291 plugwash 1 end;
292     end;
293     until false;
294     end;
295 beware 2 {$endif}
296 plugwash 1
297 beware 2
298    
299     function forwardlookuplist(name:string;timeout:integer):tbiniplist;
300     var
301 plugwash 1 dummy : integer;
302 beware 2 a,b:integer;
303     biniptemp:tbinip;
304     l:tbiniplist;
305 plugwash 1 begin
306 beware 2 ipstrtobin(name,biniptemp);
307     if biniptemp.family <> 0 then begin
308     result := biniplist_new;
309     biniplist_add(result,biniptemp);
310     exit; //it was an IP address, no need for dns
311     end;
312    
313 plugwash 1 {$ifdef win32}
314 beware 2 if usewindns then begin
315     if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;
316     result := winforwardlookuplist(name,a,dummy);
317     {$ifdef ipv6}
318     if (useaf = useaf_preferv4) then begin
319     {prefer mode: sort the IP's}
320     l := biniplist_new;
321     addipsoffamily(l,result,af_inet);
322     addipsoffamily(l,result,af_inet6);
323     result := l;
324 plugwash 1 end;
325 beware 2 if (useaf = useaf_preferv6) then begin
326     {prefer mode: sort the IP's}
327     l := biniplist_new;
328     addipsoffamily(l,result,af_inet6);
329     addipsoffamily(l,result,af_inet);
330     result := l;
331     end;
332     {$endif}
333     end else
334 plugwash 1 {$endif}
335 beware 2 begin
336     {$ifdef syncdnscore}
337 beware 20 {$ifdef ipv6}initpreferredmode;{$endif}
338 beware 2
339     numsockused := 0;
340    
341     result := biniplist_new;
342     if (useaf <> useaf_v6) then begin
343     setstate_forward(name,state[numsockused],af_inet);
344     inc(numsockused);
345     end;
346     {$ifdef ipv6}
347     if (useaf <> useaf_v4) then begin
348     setstate_forward(name,state[numsockused],af_inet6);
349     inc(numsockused);
350     end;
351     {$endif}
352    
353     resolveloop(timeout);
354    
355     if (numsockused = 1) then begin
356     biniplist_addlist(result,state[0].resultlist);
357     {$ifdef ipv6}
358     end else if (useaf = useaf_preferv6) then begin
359     biniplist_addlist(result,state[1].resultlist);
360     biniplist_addlist(result,state[0].resultlist);
361     end else begin
362     biniplist_addlist(result,state[0].resultlist);
363     biniplist_addlist(result,state[1].resultlist);
364 beware 20 {$endif}
365 beware 2 end;
366     {$endif}
367     end;
368 plugwash 1 end;
369    
370 beware 2 function forwardlookup(name:string;timeout:integer):tbinip;
371     var
372     listtemp:tbiniplist;
373     begin
374     listtemp := forwardlookuplist(name,timeout);
375     result := biniplist_get(listtemp,0);
376     end;
377    
378 plugwash 1 function reverselookup(ip:tbinip;timeout:integer):string;
379     var
380     dummy : integer;
381     begin
382     {$ifdef win32}
383     if usewindns then begin
384     result := winreverselookup(ip,dummy);
385     exit;
386     end;
387     {$endif}
388 beware 2 {$ifdef syncdnscore}
389     setstate_reverse(ip,state[0]);
390     numsockused := 1;
391 plugwash 1 resolveloop(timeout);
392 beware 2 result := state[0].resultstr;
393     {$endif}
394 plugwash 1 end;
395    
396     {$ifdef win32}
397     var
398     wsadata : twsadata;
399    
400     initialization
401     WSAStartUp($2,wsadata);
402     finalization
403     WSACleanUp;
404     {$endif}
405     end.
406    
407    

Properties

Name Value
svn:executable

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.22