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