httpserver_20080306/dnssync.pas

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