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

Contents of /trunk/dnssync.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 20 - (show annotations)
Fri Dec 26 19:17:00 2008 UTC (11 years, 11 months ago) by beware
File size: 11479 byte(s)
* fixed NT services not working. app must now call lcoreinit() at some point before using sockets etc
* made dnssync and dnsasync secure with source port randomization and reply packet source IP/port verification
* created lcorerandom, a secure general purpose random number source, replacement of bircrandom
* added fastmd5.pas into the repository. it wasn't in it, but seemed to belong in it and lcorernd depends on it.
* added the ability to do "custom" (txt, mx, ns, ptr, etc) lookups in dnscore and dnsasync
* lsocket.receivefrom now converts a v6 mapped v4 IP to a real v4 IP for simplicity in the app
* removed "ipv6preferred" from dnswin, which was doing nothing


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 {$include lcoreconfig.inc}
11
12 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 lcorernd,
29 sysutils;
30
31 //convert a name to an IP
32 //will return v4 or v6 depending on what seems favorable, or manual preference setting
33 //on error the binip will have a family of 0 (other fiels are also currently
34 //zeroed out but may be used for further error information in future)
35 //timeout is in miliseconds, it is ignored when using windows dns
36 function forwardlookup(name:string;timeout:integer):tbinip;
37
38 //convert a name to a list of all IP's returned
39 //this returns both v4 and v6 IP's, or possibly only v4 or v6, depending on settings
40 //on error, returns an empty list
41 function forwardlookuplist(name:string;timeout:integer):tbiniplist;
42
43
44 //convert an IP to a name, on error a null string will be returned, other
45 //details as above
46 function reverselookup(ip:tbinip;timeout:integer):string;
47
48
49
50 const
51 tswrap=$4000;
52 tsmask=tswrap-1;
53
54 numsock=1{$ifdef ipv6}+1{$endif};
55 defaulttimeout=10000;
56 const mintimeout=16;
57
58 toport='53';
59
60 var
61 id:integer;
62
63 sendquerytime:array[0..numsock-1] of integer;
64 implementation
65
66 {$ifdef win32}
67 uses dnswin;
68 {$endif}
69
70
71 {$ifndef win32}
72 {$define syncdnscore}
73 {$endif}
74
75 {$i unixstuff.inc}
76 {$i ltimevalstuff.inc}
77
78 var
79 numsockused:integer;
80 fd:array[0..numsock-1] of integer;
81 state:array[0..numsock-1] of tdnsstate;
82 toaddr:array[0..numsock-1] of tbinip;
83
84 {$ifdef syncdnscore}
85
86 {$ifdef win32}
87 const
88 winsocket = 'wsock32.dll';
89 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 type
92 fdset=tfdset;
93 {$endif}
94
95
96 function getts:integer;
97 {$ifdef win32}
98 begin
99 result := GetTickCount and tsmask;
100 {$else}
101 var
102 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 a:integer;
113 addr : string;
114 port : string;
115 inaddr : TInetSockAddrV;
116 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 if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);
122
123 {$ifdef ipv6}{$ifdef win32}
124 if toaddr[socknum].family = AF_INET6 then if (useaf = 0) then useaf := useaf_preferv6;
125 {$endif}{$endif}
126
127 port := toport;
128 toaddr[socknum] := ipstrtobinf(addr);
129 makeinaddrv(toaddr[socknum],port,inaddr);
130
131 sendto(fd[socknum],packet,len,0,inaddr,inaddrsize(inaddr));
132 sendquerytime[socknum] := getts;
133 result := true;
134 end;
135
136 procedure setupsocket;
137 var
138 inAddrtemp : TInetSockAddrV;
139 a:integer;
140 biniptemp:tbinip;
141 addr:string;
142 begin
143 //init both sockets smultaneously, always, so they get succesive fd's
144 if fd[0] > 0 then exit;
145
146 if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);
147 //must get the DNS server here so we know to init v4 or v6
148
149 ipstrtobin(addr,biniptemp);
150
151 if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');
152
153
154 for a := 0 to numsockused-1 do begin
155 makeinaddrv(biniptemp,inttostr( 1024 + randominteger(65536 - 1024) ),inaddrtemp);
156
157 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 end;
167 end;
168
169 procedure resolveloop(timeout:integer);
170 var
171 selectresult : integer;
172 fds : fdset;
173
174 endtime : longint;
175 starttime : longint;
176 wrapmode : boolean;
177 currenttime : integer;
178
179 lag : ttimeval;
180 currenttimeout : ttimeval;
181 selecttimeout : ttimeval;
182 socknum:integer;
183 needprocessing:array[0..numsock-1] of boolean;
184 finished:array[0..numsock-1] of boolean;
185 a,b:integer;
186
187 Src : TInetSockAddrV;
188 Srcx : {$ifdef win32}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;
189 SrcLen : Integer;
190 fromip:tbinip;
191 fromport:string;
192
193 begin
194 if timeout < mintimeout then timeout := defaulttimeout;
195
196 starttime := getts;
197 endtime := starttime + timeout;
198 if (endtime and tswrap)=0 then begin
199 wrapmode := false;
200 end else begin
201 wrapmode := true;
202 end;
203 endtime := endtime and tsmask;
204
205 setupsocket;
206 for socknum := 0 to numsockused-1 do begin
207 needprocessing[socknum] := true;
208 finished[socknum] := false;
209 end;
210
211 repeat
212 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 { writeln('send query');}
232 sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
233 end;
234 end;
235 needprocessing[socknum] := false;
236 end;
237
238 currenttime := getts;
239 msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);
240
241 fd_zero(fds);
242 for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);
243 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 //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 if selectresult > 0 then begin
252 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
257 fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);
258 msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);
259
260 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 end;
277 end;
278 if selectresult < 0 then exit;
279 if selectresult = 0 then begin
280
281 currenttime := getts;
282
283 if overridednsserver = '' then reportlag(id,-1);
284 if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin
285 exit;
286 end else begin
287 //resend
288 for socknum := numsockused-1 downto 0 do begin
289 sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);
290 end;
291 end;
292 end;
293 until false;
294 end;
295 {$endif}
296
297
298
299 function forwardlookuplist(name:string;timeout:integer):tbiniplist;
300 var
301 dummy : integer;
302 a,b:integer;
303 biniptemp:tbinip;
304 l:tbiniplist;
305 begin
306 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 {$ifdef win32}
314 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 end;
325 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 {$endif}
335 begin
336 {$ifdef syncdnscore}
337 {$ifdef ipv6}initpreferredmode;{$endif}
338
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 {$endif}
365 end;
366 {$endif}
367 end;
368 end;
369
370 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 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 {$ifdef syncdnscore}
389 setstate_reverse(ip,state[0]);
390 numsockused := 1;
391 resolveloop(timeout);
392 result := state[0].resultstr;
393 {$endif}
394 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