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

Annotation of /trunk/dnssync.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

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     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