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