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