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

Contents of /trunk/dnssync.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Fri Mar 28 02:26:58 2008 UTC (12 years, 8 months ago) by plugwash
File size: 7004 byte(s)
initial import

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 interface
11 uses
12 dnscore,
13 binipstuff,
14 {$ifdef win32}
15 winsock,
16 windows,
17 {$else}
18 {$ifdef VER1_0}
19 linux,
20 {$else}
21 baseunix,unix,unixutil,
22 {$endif}
23 sockets,
24 fd_utils,
25 {$endif}
26 sysutils;
27
28 //convert a name to an IP
29 //IPV4 is preffered if availible, if not IPV6 will be returned (if ipv6 support
30 //compiled in)
31 //on error the binip will have a family of 0 (other fiels are also currently
32 //zeroed out but may be used for further error information in future)
33 //timeout is in seconds, it is ignored when using windows dns
34 function forwardlookup(name:string;timeout:integer):tbinip;
35
36
37 //convert an IP to a name, on error a null string will be returned, other
38 //details as above
39 function reverselookup(ip:tbinip;timeout:integer):string;
40
41
42 var
43 dnssyncserver:string;
44 id : integer;
45 {$ifdef win32}
46 sendquerytime : integer;
47 {$else}
48 sendquerytime : ttimeval;
49 {$endif}
50 implementation
51 {$ifdef win32}
52 uses dnswin;
53 {$endif}
54
55 {$i unixstuff.inc}
56 {$i ltimevalstuff.inc}
57
58 var
59 fd:integer;
60 state:tdnsstate;
61 {$ifdef win32}
62 const
63 winsocket = 'wsock32.dll';
64 function sendto(s: TSocket; const Buf; len, flags: Integer; var addrto: TinetSockAddr; tolen: Integer): Integer; stdcall; external winsocket name 'sendto';
65 function bind(s: TSocket; var addr: TinetSockAddr; namelen: Integer): Longbool; stdcall; external winsocket name 'bind';
66 type
67 fdset=tfdset;
68 {$endif}
69
70 function sendquery(const packet:tdnspacket;len:integer):boolean;
71 var
72 a:integer;
73 addr : string;
74 port : string;
75 inaddr : TInetSockAddr;
76
77 begin
78 { writeln('sendquery ',decodename(state.packet,state.packetlen,12,0,a),' ',state.requesttype);}
79 result := false;
80 if len = 0 then exit; {no packet}
81
82 if dnssyncserver <> '' then addr := dnssyncserver else addr := getcurrentsystemnameserver(id);
83 port := '53';
84
85 inAddr.family:=AF_INET;
86 inAddr.port:=htons(strtointdef(port,0));
87 inAddr.addr:=htonl(longip(addr));
88
89 sendto(fd,packet,len,0,inaddr,sizeof(inaddr));
90 {$ifdef win32}
91 sendquerytime := GetTickCount and $3fff;
92 {$else}
93 gettimeofday(sendquerytime);
94 {$endif}
95 result := true;
96 end;
97
98 procedure setupsocket;
99 var
100 inAddrtemp : TInetSockAddr;
101 begin
102 if fd > 0 then exit;
103
104 fd := Socket(AF_INET,SOCK_DGRAM,0);
105 inAddrtemp.family:=AF_INET;
106 inAddrtemp.port:=0;
107 inAddrtemp.addr:=0;{htonl(longip('0.0.0.0'));}
108 If {$ifndef win32}Not{$endif} Bind(fd,inAddrtemp,SizeOf(inAddrtemp)) Then begin
109 {$ifdef win32}
110 raise Exception.create('unable to bind '+inttostr(WSAGetLastError));
111 {$else}
112 raise Exception.create('unable to bind '+inttostr(socketError));
113 {$endif}
114 end;
115 end;
116
117 procedure resolveloop(timeout:integer);
118 var
119 selectresult : integer;
120 fds : fdset;
121 {$ifdef win32}
122 endtime : longint;
123 starttime : longint;
124 wrapmode : boolean;
125 currenttime : integer;
126 {$else}
127 endtime : ttimeval;
128 currenttime : ttimeval;
129
130 {$endif}
131 lag : ttimeval;
132 currenttimeout : ttimeval;
133 selecttimeout : ttimeval;
134
135
136 begin
137 {$ifdef win32}
138 starttime := GetTickCount and $3fff;
139 endtime := starttime +(timeout*1000);
140 if (endtime and $4000)=0 then begin
141 wrapmode := false;
142 end else begin
143 wrapmode := true;
144 end;
145 endtime := endtime and $3fff;
146 {$else}
147 gettimeofday(endtime);
148 endtime.tv_sec := endtime.tv_sec + timeout;
149 {$endif}
150
151 setupsocket;
152 repeat
153 state_process(state);
154 case state.resultaction of
155 action_ignore: begin
156 { writeln('ignore');}
157 {do nothing}
158 end;
159 action_done: begin
160 { writeln('done');}
161 exit;
162 //onrequestdone(self,0);
163 end;
164 action_sendquery:begin
165 { writeln('send query');}
166 sendquery(state.sendpacket,state.sendpacketlen);
167 end;
168 end;
169 {$ifdef win32}
170 currenttime := GetTickCount and $3fff;
171 msectotimeval(selecttimeout, (endtime-currenttime)and$3fff);
172 {$else}
173 gettimeofday(currenttime);
174 selecttimeout := endtime;
175 tv_substract(selecttimeout,currenttime);
176 {$endif}
177 fd_zero(fds);
178 fd_set(fd,fds);
179 if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin
180 selecttimeout.tv_sec := 0;
181 selecttimeout.tv_usec := retryafter;
182 end;
183 selectresult := select(fd+1,@fds,nil,nil,@selecttimeout);
184 if selectresult > 0 then begin
185 { writeln('selectresult>0');}
186 //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash
187 fillchar(state.recvpacket,sizeof(state.recvpacket),0);
188 {$ifdef win32}
189 msectotimeval(lag,(currenttime-sendquerytime)and$3fff);
190 {$else}
191 lag := currenttime;
192 tv_substract(lag,sendquerytime);
193
194 {$endif}
195
196 reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);
197 state.recvpacketlen := recv(fd,state.recvpacket, SizeOf(state.recvpacket),0);
198 state.parsepacket := true;
199 end;
200 if selectresult < 0 then exit;
201 if selectresult = 0 then begin
202 {$ifdef win32}
203 currenttime := GetTickCount;
204 {$else}
205 gettimeofday(currenttime);
206 {$endif}
207 reportlag(id,-1);
208 if {$ifdef win32}(currenttime >= endtime)and ((not wrapmode) or (currenttime < starttime)) {$else}tv_compare(currenttime,endtime){$endif} {currenttime >= endtime } then begin
209 exit;
210 end else begin
211 //resend
212 sendquery(state.sendpacket,state.sendpacketlen);
213 end;
214 end;
215 until false;
216 end;
217
218 function forwardlookup(name:string;timeout:integer):tbinip;
219 var
220 dummy : integer;
221 begin
222 ipstrtobin(name,result);
223 if result.family <> 0 then exit; //it was an IP address, no need for dns
224 //lookup
225 {$ifdef win32}
226 if usewindns then begin
227 result := winforwardlookup(name,false,dummy);
228 exit;
229 end;
230 {$endif}
231 setstate_forward(name,state,0);
232 resolveloop(timeout);
233 result := state.resultbin;
234 end;
235
236 function reverselookup(ip:tbinip;timeout:integer):string;
237 var
238 dummy : integer;
239 begin
240 {$ifdef win32}
241 if usewindns then begin
242 result := winreverselookup(ip,dummy);
243 exit;
244 end;
245 {$endif}
246 setstate_reverse(ip,state);
247 resolveloop(timeout);
248 result := state.resultstr;
249 end;
250
251 {$ifdef win32}
252 var
253 wsadata : twsadata;
254
255 initialization
256 WSAStartUp($2,wsadata);
257 finalization
258 WSACleanUp;
259 {$endif}
260 end.
261
262

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