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