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   addr       : ansistring;\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   if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(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] := ipstrtobinf(addr);\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   addr:ansistring;\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   if overridednsserver <> '' then addr := overridednsserver else addr := getcurrentsystemnameserver(id);\r
 146   //must get the DNS server here so we know to init v4 or v6\r
 147 \r
 148   ipstrtobin(addr,biniptemp);\r
 149 \r
 150   if biniptemp.family = AF_INET6 then biniptemp := ipstrtobinf('::') else biniptemp := ipstrtobinf('0.0.0.0');\r
 151 \r
 152 \r
 153   for a := 0 to numsockused-1 do begin\r
 154     makeinaddrv(biniptemp,inttostr( 1024 + randominteger(65536 - 1024) ),inaddrtemp);\r
 155 \r
 156     fd[a] := Socket(biniptemp.family,SOCK_DGRAM,0);\r
 157 \r
 158     If {$ifndef win32}Not{$endif} Bind(fd[a],inAddrtemp,inaddrsize(inaddrtemp)) Then begin\r
 159       {$ifdef win32}\r
 160         raise Exception.create('unable to bind '+inttostr(WSAGetLastError));\r
 161       {$else}\r
 162         raise Exception.create('unable to bind '+inttostr(socketError));\r
 163       {$endif}\r
 164     end;\r
 165   end;\r
 166 end;\r
 167 \r
 168 procedure resolveloop(timeout:integer);\r
 169 var\r
 170   selectresult   : integer;\r
 171   fds            : fdset;\r
 172 \r
 173   endtime      : longint;\r
 174   starttime    : longint;\r
 175   wrapmode     : boolean;\r
 176   currenttime  : integer;\r
 177 \r
 178   lag            : ttimeval;\r
 179   selecttimeout  : ttimeval;\r
 180   socknum:integer;\r
 181   needprocessing:array[0..numsock-1] of boolean;\r
 182   finished:array[0..numsock-1] of boolean;\r
 183   a,b:integer;\r
 184 \r
 185   Src    : TInetSockAddrV;\r
 186   Srcx   : {$ifdef win32}sockaddr_in{$else}TInetSockAddrV{$endif} absolute Src;\r
 187   SrcLen : Integer;\r
 188   fromip:tbinip;\r
 189   fromport:ansistring;\r
 190 \r
 191 begin\r
 192   if timeout < mintimeout then timeout := defaulttimeout;\r
 193 \r
 194     starttime := getts;\r
 195     endtime := starttime + timeout;\r
 196     if (endtime and tswrap)=0 then begin\r
 197       wrapmode := false;\r
 198     end else begin\r
 199       wrapmode := true;\r
 200     end;\r
 201     endtime := endtime and tsmask;\r
 202 \r
 203   setupsocket;\r
 204   for socknum := 0 to numsockused-1 do begin\r
 205     needprocessing[socknum] := true;\r
 206     finished[socknum] := false;\r
 207   end;\r
 208 \r
 209   repeat\r
 210     for socknum := numsockused-1 downto 0 do if needprocessing[socknum] then begin\r
 211       state_process(state[socknum]);\r
 212       case state[socknum].resultaction of\r
 213         action_ignore: begin\r
 214           {do nothing}\r
 215         end;\r
 216         action_done: begin\r
 217           finished[socknum] := true;\r
 218           //exit if all resolvers are finished\r
 219           b := 0;\r
 220           for a := 0 to numsockused-1 do begin\r
 221             if finished[a] then inc(b);\r
 222           end;\r
 223           if (b = numsockused) then begin\r
 224             exit;\r
 225           end;\r
 226           //onrequestdone(self,0);\r
 227         end;\r
 228         action_sendquery:begin\r
 229 {        writeln('send query');}\r
 230           sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);\r
 231         end;\r
 232       end;\r
 233       needprocessing[socknum] := false;\r
 234     end;\r
 235 \r
 236     currenttime := getts;\r
 237     msectotimeval(selecttimeout, (endtime-currenttime) and tsmask);\r
 238 \r
 239     fd_zero(fds);\r
 240     for socknum := numsockused-1 downto 0 do if not finished[socknum] then fd_set(fd[socknum],fds);\r
 241     if (selecttimeout.tv_sec > 0) or (selecttimeout.tv_usec > retryafter) then begin\r
 242       selecttimeout.tv_sec := 0;\r
 243       selecttimeout.tv_usec := retryafter;\r
 244     end;\r
 245     //find the highest of the used fd's\r
 246     b := 0;\r
 247     for socknum := numsockused-1 downto 0 do if fd[socknum] > b then b := fd[socknum];\r
 248     selectresult := select(b+1,@fds,nil,nil,@selecttimeout);\r
 249     if selectresult > 0 then begin\r
 250       currenttime := getts;\r
 251       for socknum := numsockused-1 downto 0 do if fd_isset(fd[socknum],fds) then begin\r
 252   {      writeln('selectresult>0');}\r
 253         //why the hell are we zeroing out the packet buffer before reading into it?! --plugwash\r
 254 \r
 255         fillchar(state[socknum].recvpacket,sizeof(state[socknum].recvpacket),0);\r
 256         msectotimeval(lag,(currenttime-sendquerytime[socknum]) and tsmask);\r
 257 \r
 258         if overridednsserver = '' then reportlag(id,(lag.tv_sec*1000000)+lag.tv_usec);\r
 259 \r
 260         SrcLen := SizeOf(Src);\r
 261         state[socknum].recvpacketlen := recvfrom(fd[socknum],state[socknum].recvpacket, SizeOf(state[socknum].recvpacket),0,Srcx,SrcLen);\r
 262 \r
 263         if (state[socknum].recvpacketlen > 0) then begin\r
 264           fromip := inaddrvtobinip(Src);\r
 265           fromport := inttostr(htons(src.InAddr.port));\r
 266           if ((not comparebinip(toaddr[socknum],fromip)) or (fromport <> toport)) then begin\r
 267 //            writeln('dnssync received from wrong IP:port ',ipbintostr(fromip),'#',fromport);\r
 268             state[socknum].recvpacketlen := 0;\r
 269           end else begin\r
 270             state[socknum].parsepacket := true;\r
 271             needprocessing[socknum] := true;\r
 272           end;\r
 273         end;\r
 274       end;\r
 275     end;\r
 276     if selectresult < 0 then exit;\r
 277     if selectresult = 0 then begin\r
 278 \r
 279       currenttime := getts;\r
 280 \r
 281       if overridednsserver = '' then reportlag(id,-1);\r
 282       if (currenttime >= endtime) and ((not wrapmode) or (currenttime < starttime)) then begin\r
 283         exit;\r
 284       end else begin\r
 285         //resend\r
 286         for socknum := numsockused-1 downto 0 do begin\r
 287           sendquery(socknum,state[socknum].sendpacket,state[socknum].sendpacketlen);\r
 288         end;\r
 289       end;\r
 290     end;\r
 291   until false;\r
 292 end;\r
 293 {$endif}\r
 294 \r
 295 \r
 296 \r
 297 function forwardlookuplist(name:ansistring;timeout:integer):tbiniplist;\r
 298 var\r
 299   dummy : integer;\r
 300   a:integer;\r
 301   biniptemp:tbinip;\r
 302   l:tbiniplist;\r
 303 begin\r
 304   ipstrtobin(name,biniptemp);\r
 305   if biniptemp.family <> 0 then begin\r
 306     result := biniplist_new;\r
 307     biniplist_add(result,biniptemp);\r
 308     exit; //it was an IP address, no need for dns\r
 309   end;\r
 310 \r
 311   {$ifdef win32}\r
 312   if usewindns then begin\r
 313     if (useaf = useaf_v4) then a := af_inet else if (useaf = useaf_v6) then a := af_inet6 else a := 0;\r
 314     result := winforwardlookuplist(name,a,dummy);\r
 315     {$ifdef ipv6}\r
 316     if (useaf = useaf_preferv4) then begin\r
 317       {prefer mode: sort the IP's}\r
 318       l := biniplist_new;\r
 319       addipsoffamily(l,result,af_inet);\r
 320       addipsoffamily(l,result,af_inet6);\r
 321       result := l;\r
 322     end;\r
 323     if (useaf = useaf_preferv6) then begin\r
 324       {prefer mode: sort the IP's}\r
 325       l := biniplist_new;\r
 326       addipsoffamily(l,result,af_inet6);\r
 327       addipsoffamily(l,result,af_inet);\r
 328       result := l;\r
 329     end;\r
 330     {$endif}\r
 331   end else\r
 332   {$endif}\r
 333   begin\r
 334   {$ifdef syncdnscore}\r
 335     {$ifdef ipv6}initpreferredmode;{$endif}\r
 336 \r
 337     numsockused := 0;\r
 338 \r
 339     result := biniplist_new;\r
 340     if (useaf <> useaf_v6) then begin\r
 341       setstate_forward(name,state[numsockused],af_inet);\r
 342       inc(numsockused);\r
 343     end;\r
 344     {$ifdef ipv6}\r
 345     if (useaf <> useaf_v4) then begin\r
 346       setstate_forward(name,state[numsockused],af_inet6);\r
 347       inc(numsockused);\r
 348     end;\r
 349     {$endif}\r
 350 \r
 351     resolveloop(timeout);\r
 352 \r
 353     if (numsockused = 1) then begin\r
 354       biniplist_addlist(result,state[0].resultlist);\r
 355     {$ifdef ipv6}\r
 356     end else if (useaf = useaf_preferv6) then begin\r
 357       biniplist_addlist(result,state[1].resultlist);\r
 358       biniplist_addlist(result,state[0].resultlist);\r
 359     end else begin\r
 360       biniplist_addlist(result,state[0].resultlist);\r
 361       biniplist_addlist(result,state[1].resultlist);\r
 362     {$endif}\r
 363     end;\r
 364     {$endif}\r
 365   end;\r
 366 end;\r
 367 \r
 368 function forwardlookup(name:ansistring;timeout:integer):tbinip;\r
 369 var\r
 370   listtemp:tbiniplist;\r
 371 begin\r
 372   listtemp := forwardlookuplist(name,timeout);\r
 373   result := biniplist_get(listtemp,0);\r
 374 end;\r
 375 \r
 376 function reverselookup(ip:tbinip;timeout:integer):ansistring;\r
 377 var\r
 378   dummy : integer;\r
 379 begin\r
 380   {$ifdef win32}\r
 381     if usewindns then begin\r
 382       result := winreverselookup(ip,dummy);\r
 383       exit;\r
 384     end;\r
 385   {$endif}\r
 386   {$ifdef syncdnscore}\r
 387   setstate_reverse(ip,state[0]);\r
 388   numsockused := 1;\r
 389   resolveloop(timeout);\r
 390   result := state[0].resultstr;\r
 391   {$endif}\r
 392 end;\r
 393 \r
 394 {$ifdef win32}\r
 395   var\r
 396     wsadata : twsadata;\r
 397 \r
 398   initialization\r
 399     WSAStartUp($2,wsadata);\r
 400   finalization\r
 401     WSACleanUp;\r
 402 {$endif}\r
 403 end.\r
 404 \r
 405 \r