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

Annotation of /trunk/dnssync.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 136 - (hide annotations)
Fri Mar 28 03:18:52 2014 UTC (6 years, 7 months ago) by beware
File size: 11836 byte(s)
fix spelling mistakes
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 beware 127 {$ifdef mswindows}
17 plugwash 1 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 59 sysutils,
30 plugwash 57 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 beware 136 //on error the binip will have a family of 0 (other fields are also currently
35 plugwash 1 //zeroed out but may be used for further error information in future)
36 beware 136 //timeout is in milliseconds, it is ignored when using windows dns
37 zipplet 79 function forwardlookup(name:ansistring;timeout:integer):tbinip;
38 plugwash 1
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 zipplet 79 function forwardlookuplist(name:ansistring;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 zipplet 79 function reverselookup(ip:tbinip;timeout:integer):ansistring;
48 plugwash 1
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 plugwash 1 implementation
62 beware 2
63 beware 127 {$ifdef mswindows}
64 plugwash 1 uses dnswin;
65     {$endif}
66    
67 beware 2
68 beware 127 {$ifndef mswindows}
69 beware 2 {$define syncdnscore}
70     {$endif}
71    
72 plugwash 1 {$i unixstuff.inc}
73    
74 beware 112 type tdnsstatearr=array[0..numsock-1] of tdnsstate;
75 beware 94
76     {$ifdef syncdnscore}
77 beware 2
78 beware 111
79 beware 127 {$ifdef mswindows}
80 plugwash 1 const
81     winsocket = 'wsock32.dll';
82 beware 2 function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddrV; tolen: Integer): Integer; stdcall; external winsocket name 'sendto';
83     function bind(s: TSocket; var addr: TinetSockAddrV; namelen: Integer): Longbool; stdcall; external winsocket name 'bind';
84 plugwash 1 type
85     fdset=tfdset;
86     {$endif}
87    
88 beware 2
89     function getts:integer;
90 beware 127 {$ifdef mswindows}
91 beware 2 begin
92     result := GetTickCount and tsmask;
93     {$else}
94 plugwash 1 var
95 beware 2 temp:ttimeval;
96     begin
97     gettimeofday(temp);
98     result := ((temp.tv_usec div 1000) + (temp.tv_sec * 1000)) and tsmask;
99     {$endif}
100     end;
101    
102 beware 111 procedure resolveloop(timeout:integer;var state:tdnsstatearr;numsockused:integer);
103 beware 2 var
104 beware 111 selectresult : integer;
105     fds : fdset;
106 plugwash 1
107 beware 111 endtime : longint;
108     starttime : longint;
109     wrapmode : boolean;
110     currenttime : integer;
111 plugwash 1
112 beware 111 lag : ttimeval;
113     selecttimeout : ttimeval;
114     socknum:integer;
115     needprocessing:array[0..numsock-1] of boolean;
116     finished:array[0..numsock-1] of boolean;
117     a,b:integer;
118 plugwash 1
119 beware 111 Src : TInetSockAddrV;
120 beware 127 Srcx : {$ifdef mswindows}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;
121 beware 111 SrcLen : Integer;
122     fromip:tbinip;
123     fromport:ansistring;
124 beware 20
125 beware 111 fd:array[0..numsock-1] of integer;
126     toaddr:array[0..numsock-1] of tbinip;
127     id:integer;
128     sendquerytime:array[0..numsock-1] of integer;
129 plugwash 1
130 beware 111
131 plugwash 1 procedure setupsocket;
132     var
133 beware 2 inAddrtemp : TInetSockAddrV;
134 beware 111 biniptemp:tbinip;
135 beware 114 a,retrycount,porttemp:integer;
136 beware 113 bindresult:boolean;
137 plugwash 1 begin
138 beware 97 biniptemp := getcurrentsystemnameserverbin(id);
139 beware 2 //must get the DNS server here so we know to init v4 or v6
140    
141 beware 20 if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');
142 beware 2
143 beware 20
144 beware 2 for a := 0 to numsockused-1 do begin
145 beware 113 retrycount := 5;
146     repeat
147 beware 114 if (retrycount <= 1) then begin
148     porttemp := 0; //for the last attempt let the OS decide
149     end else begin
150     porttemp := 1024 + randominteger(65536 - 1024);
151     end;
152 beware 20
153 beware 114 makeinaddrv(biniptemp,inttostr( porttemp ),inaddrtemp);
154    
155 beware 113 fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);
156 beware 127 bindresult := {$ifdef mswindows}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp));
157 beware 113 dec(retrycount);
158     until (retrycount <= 0) or (bindresult);
159 beware 2
160 beware 113 If (not bindresult) Then begin
161 beware 127 {$ifdef mswindows}
162 beware 2 raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
163     {$else}
164     raise Exception.create('unable to bind '+inttostr(socketError));
165     {$endif}
166     end;
167 plugwash 1 end;
168     end;
169    
170 beware 111 procedure cleanupsockets;
171 plugwash 1 var
172 beware 111 a:integer;
173     begin
174     for a := 0 to numsockused-1 do closesocket(fd[a]);
175     end;
176 plugwash 1
177 beware 111 function sendquery(socknum:integer;const packet:tdnspacket;len:integer):boolean;
178     var
179     ip : tbinip;
180     port : ansistring;
181     inaddr : TInetSockAddrV;
182     begin
183     { writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
184     result := false;
185     if len = 0 then exit; {no packet}
186 beware 2
187 beware 111 ip := getcurrentsystemnameserverbin(id);
188 plugwash 1
189 beware 127 {$ifdef ipv6}{$ifdef mswindows}
190 beware 111 if toaddr[socknum].family = AF_INET6 then if (useaf = 0) then useaf := useaf_preferv6;
191     {$endif}{$endif}
192 beware 20
193 beware 111 port := toport;
194     toaddr[socknum] := ip;
195     makeinaddrv(toaddr[socknum],port,inaddr);
196    
197     sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
198     sendquerytime[socknum] := getts;
199     result := true;
200     end;
201    
202 beware 2 begin
203     if timeout < mintimeout then timeout := defaulttimeout;
204 plugwash 1
205 beware 111 starttime := getts;
206     endtime := starttime + timeout;
207     if (endtime and tswrap)=0 then begin
208     wrapmode := false;
209     end else begin
210     wrapmode := true;
211     end;
212     endtime := endtime and tsmask;
213 plugwash 1
214     setupsocket;
215 beware 111
216    
217 beware 2 for socknum := 0 to numsockused-1 do begin
218     needprocessing[socknum] := true;
219     finished[socknum] := false;
220     end;
221    
222 plugwash 1 repeat
223 beware 2 for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin
224     state_process(state[socknum]);
225     case state[socknum].resultaction of
226     action_ignore: begin
227     {do nothing}
228     end;
229     action_done: begin
230     finished[socknum] := true;
231     //exit if all resolvers are finished
232     b := 0;
233     for a := 0 to numsockused-1 do begin
234     if finished[a] then inc(b);
235     end;
236     if (b = numsockused) then begin
237 beware 111 cleanupsockets;
238 beware 2 exit;
239     end;
240     //onrequestdone(self,0);
241     end;
242     action_sendquery:begin
243 plugwash 1 { writeln('send query');}
244 beware 2 sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
245     end;
246 plugwash 1 end;
247 beware 2 needprocessing[socknum] := false;
248 plugwash 1 end;
249 beware 2
250     currenttime := getts;
251     msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);
252    
253 plugwash 1 fd_zero(fds);
254 beware 2 for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);
255 plugwash 1 if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin
256     selecttimeout.tv_sec := 0;
257     selecttimeout.tv_usec := retryafter;
258     end;
259 beware 2 //find the highest of the used fd's
260     b := 0;
261     for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];
262     selectresult := select(b+1,@fds,nil,nil,@selecttimeout);
263 plugwash 1 if selectresult > 0 then begin
264 beware 2 currenttime := getts;
265     for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin
266     { writeln('selectresult>0');}
267     //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash
268 plugwash 1
269 beware 2 fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
270     msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
271 plugwash 1
272 beware 97 reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
273 beware 20
274     SrcLen := SizeOf(Src);
275     state[socknum].recvpacketlen := recvfrom(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0,Srcx,SrcLen);
276    
277     if (state[socknum].recvpacketlen > 0) then begin
278     fromip := inaddrvtobinip(Src);
279     fromport := inttostr(htons(src.InAddr.port));
280     if ((not comparebinip(toaddr[socknum],fromip)) or (fromport <> toport)) then begin
281     // writeln('dnssync received from wrong IP:port ',ipbintostr(fromip),'#',fromport);
282     state[socknum].recvpacketlen := 0;
283     end else begin
284     state[socknum].parsepacket := true;
285     needprocessing[socknum] := true;
286     end;
287     end;
288 beware 2 end;
289 plugwash 1 end;
290     if selectresult < 0 then exit;
291     if selectresult = 0 then begin
292 beware 2
293     currenttime := getts;
294    
295 beware 97 reportlag(id,-1);
296 beware 2 if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
297 beware 111 cleanupsockets;
298 plugwash 1 exit;
299     end else begin
300     //resend
301 beware 2 for socknum := numsockused-1 downto 0 do begin
302     sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
303     end;
304 plugwash 1 end;
305     end;
306     until false;
307     end;
308 beware 2 {$endif}
309 plugwash 1
310 beware 2
311    
312 zipplet 79 function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;
313 beware 2 var
314 plugwash 1 dummy : integer;
315 beware 94 a:integer;
316 beware 2 biniptemp:tbinip;
317     l:tbiniplist;
318 beware 111
319     numsockused:integer;
320     state:tdnsstatearr;
321    
322 plugwash 1 begin
323 beware 2 ipstrtobin(name,biniptemp);
324     if biniptemp.family <> 0 then begin
325     result := biniplist_new;
326     biniplist_add(result,biniptemp);
327     exit; //it was an IP address, no need for dns
328     end;
329    
330 beware 127 {$ifdef mswindows}
331 beware 2 if usewindns then begin
332     if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;
333     result := winforwardlookuplist(name,a,dummy);
334     {$ifdef ipv6}
335     if (useaf = useaf_preferv4) then begin
336     {prefer mode: sort the IP's}
337     l := biniplist_new;
338     addipsoffamily(l,result,af_inet);
339     addipsoffamily(l,result,af_inet6);
340     result := l;
341 plugwash 1 end;
342 beware 2 if (useaf = useaf_preferv6) then begin
343     {prefer mode: sort the IP's}
344     l := biniplist_new;
345     addipsoffamily(l,result,af_inet6);
346     addipsoffamily(l,result,af_inet);
347     result := l;
348     end;
349     {$endif}
350     end else
351 plugwash 1 {$endif}
352 beware 2 begin
353     {$ifdef syncdnscore}
354 beware 20 {$ifdef ipv6}initpreferredmode;{$endif}
355 beware 2
356     numsockused := 0;
357    
358     result := biniplist_new;
359     if (useaf <> useaf_v6) then begin
360     setstate_forward(name,state[numsockused],af_inet);
361     inc(numsockused);
362     end;
363     {$ifdef ipv6}
364     if (useaf <> useaf_v4) then begin
365     setstate_forward(name,state[numsockused],af_inet6);
366     inc(numsockused);
367     end;
368     {$endif}
369    
370 beware 111 resolveloop(timeout,state,numsockused);
371 beware 2
372     if (numsockused = 1) then begin
373     biniplist_addlist(result,state[0].resultlist);
374     {$ifdef ipv6}
375     end else if (useaf = useaf_preferv6) then begin
376     biniplist_addlist(result,state[1].resultlist);
377     biniplist_addlist(result,state[0].resultlist);
378     end else begin
379     biniplist_addlist(result,state[0].resultlist);
380     biniplist_addlist(result,state[1].resultlist);
381 beware 20 {$endif}
382 beware 2 end;
383     {$endif}
384     end;
385 plugwash 1 end;
386    
387 zipplet 79 function forwardlookup(name:ansistring;timeout:integer):tbinip;
388 beware 2 var
389     listtemp:tbiniplist;
390     begin
391     listtemp := forwardlookuplist(name,timeout);
392     result := biniplist_get(listtemp,0);
393     end;
394    
395 zipplet 79 function reverselookup(ip:tbinip;timeout:integer):ansistring;
396 plugwash 1 var
397     dummy : integer;
398 beware 111 numsockused:integer;
399     state:tdnsstatearr;
400 plugwash 1 begin
401 beware 127 {$ifdef mswindows}
402 plugwash 1 if usewindns then begin
403     result := winreverselookup(ip,dummy);
404     exit;
405     end;
406     {$endif}
407 beware 2 {$ifdef syncdnscore}
408     setstate_reverse(ip,state[0]);
409     numsockused := 1;
410 beware 111 resolveloop(timeout,state,numsockused);
411 beware 2 result := state[0].resultstr;
412     {$endif}
413 plugwash 1 end;
414    
415 beware 127 {$ifdef mswindows}
416 plugwash 1 var
417     wsadata : twsadata;
418    
419     initialization
420     WSAStartUp($2,wsadata);
421     finalization
422     WSACleanUp;
423     {$endif}
424     end.
425    
426    

Properties

Name Value
svn:eol-style CRLF

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